!------------------------------------------------------------------------------------------- !Copyright (c) 2013-2016 by Wolfgang Kurtz and Guowei He (Forschungszentrum Juelich GmbH) ! !This file is part of TSMP-PDAF ! !TSMP-PDAF is free software: you can redistribute it and/or modify !it under the terms of the GNU Lesser General Public License as published by !the Free Software Foundation, either version 3 of the License, or !(at your option) any later version. ! !TSMP-PDAF is distributed in the hope that it will be useful, !but WITHOUT ANY WARRANTY; without even the implied warranty of !MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the !GNU LesserGeneral Public License for more details. ! !You should have received a copy of the GNU Lesser General Public License !along with TSMP-PDAF. If not, see <http://www.gnu.org/licenses/>. !------------------------------------------------------------------------------------------- ! ! !------------------------------------------------------------------------------------------- !parser_mpi.F90: TSMP-PDAF implementation of routine ! 'parser_mpi' (PDAF online coupling) !------------------------------------------------------------------------------------------- !$Id: parser_mpi.F90 1442 2013-10-04 10:35:19Z lnerger $ !BOP ! ! !MODULE: MODULE parser ! !DESCRIPTION: ! This module provides routine to parse command line ! arguments of different types. This version is for ! use with MPI parallelization. ! By default, this routine uses the intrinsics ! 'get\_command\_count' and 'get\_command\_argument' ! that are define by the Fortran 2003 standard. ! If a compiler does not support these functions, you ! can use '-DF77' as a definition for the preprocessor. ! In this case the Fortran77 standard 'iargc()' and ! 'getarg()' are used. ! ! The module provides a generic subroutine to parse ! variables of type INTEGER, REAL, or CHARACTER ! (with length up to 100) from the command line. ! ! Usage: \begin{verbatim} ! SUBROUTINE PARSE(char(len=32) handle, variable) ! The string 'handle' determines the name of ! the parsed variable. ! Example: handle='iters' parses a variable ! specified on the command line by ! '-iters value' ! ! Usage: ! CALL PARSE(handle, int_variable) ! Parses a variable of type integer ! whose name is given by the string ! handle. ! ! CALL PARSE(handle, real_variable) ! Parses a variable of type real ! whose name is given by the string ! handle. ! ! CALL PARSE(handle, character_variable) ! Parses a string variable of maxmimal ! length of 100 characters whose name is ! given by the string handle. ! ! CALL PARSE(handle, logical_variable) ! Parses a variable of type logical ! whose name is given by the string ! handle. In the command line it has ! to be specified as 'T' or 'F'. ! \end{verbatim} ! ! !REVISION HISTORY: ! 2003-02 - Stephan Frickenhaus, Lars Nerger - Initial code ! Later revisions - see svn log ! ! !USES: USE mpi USE mod_parallel_pdaf, & ONLY: abort_parallel IMPLICIT NONE SAVE ! !PUBLIC MEMBER FUNCTIONS: PUBLIC :: parse CHARACTER(len=32), PUBLIC :: handle ! handle for command line parser !EOP PRIVATE CHARACTER(len=100) :: str1, str2 INTEGER :: i INTEGER :: mype, MPIerr ! INTEGER,EXTERNAL :: iargc ! *** define interface *** INTERFACE parse MODULE PROCEDURE parse_int MODULE PROCEDURE parse_real MODULE PROCEDURE parse_string MODULE PROCEDURE parse_logical END INTERFACE CONTAINS SUBROUTINE parse_int(handle, intvalue) ! ****************************** ! *** Parse an integer value *** ! ****************************** ! *** subroutine arguments *** CHARACTER(len=32), INTENT(in) :: handle INTEGER,INTENT(inout) :: intvalue ! *** local variables *** CHARACTER(len=32) :: string INTEGER :: parsed_int LOGICAL :: modified ! *** Initialization *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) string = '-' // TRIM(handle) modified = .FALSE. ! *** Parsing *** #ifdef F77 write (*,*) 'PARSE for F77!!!!!!!!!!!!!!!' IF (iargc() > 0) THEN DO i = 1, iargc() - 1 CALL getarg(i, str1) CALL getarg(i + 1, str2) #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 CALL get_command_argument(i, str1) CALL get_command_argument(i+1, str2) #endif IF (str1 == TRIM(string)) THEN READ(str2, *) parsed_int modified = .TRUE. END IF ENDDO ENDIF ! *** Finalize *** IF (modified) THEN intvalue = parsed_int ! IF (mype == 0) WRITE (*, '(2x, a, a, a, i)') & IF (mype == 0) WRITE (*, '(2x, a, a, a, i10)') & 'PARSER: ', TRIM(handle), '=', parsed_int END IF END SUBROUTINE parse_int SUBROUTINE parse_real(handle, realvalue) ! ************************** ! *** Parse a real value *** ! ************************** ! *** function arguments *** CHARACTER(len=32), INTENT(in) :: handle REAL, INTENT(inout) :: realvalue ! *** local variables *** CHARACTER(len=32) :: string REAL :: parsed_real LOGICAL :: modified ! *** Initialize *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) string = '-' // TRIM(handle) modified = .FALSE. ! *** Parsing *** #ifdef F77 IF (iargc() > 0) THEN DO i = 1, iargc() - 1 CALL getarg(i, str1) CALL getarg(i + 1, str2) #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 CALL get_command_argument(i, str1) CALL get_command_argument(i+1, str2) #endif IF (str1 == TRIM(string)) THEN READ(str2, *) parsed_real modified = .TRUE. END IF ENDDO ENDIF ! *** Finalize *** IF (modified) THEN realvalue = parsed_real IF (mype == 0) WRITE (*, '(2x, a, a, a, es12.4)') & 'PARSER: ', TRIM(handle), '=', parsed_real END IF END SUBROUTINE parse_real SUBROUTINE parse_string(handle, charvalue) ! ********************** ! *** Parse a string *** ! ********************** ! *** function arguments *** CHARACTER(len=32), INTENT(in) :: handle CHARACTER(len=*), INTENT(inout) :: charvalue ! *** local variables *** CHARACTER(len=100) :: string CHARACTER(len=100) :: parsed_string CHARACTER(len=110) :: str1_check CHARACTER(len=110) :: str2_check LOGICAL :: modified ! *** Initialize *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) string = '-' // TRIM(handle) modified = .FALSE. ! *** Parsing *** #ifdef F77 IF (iargc() > 0) THEN DO i = 1, iargc() - 1 CALL getarg(i, str1) CALL getarg(i + 1, str2) #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 CALL get_command_argument(i, str1) CALL get_command_argument(i+1, str2) ! Add check for inadmissible strings longer than 100 ! characters CALL get_command_argument(i, str1_check) CALL get_command_argument(i+1, str2_check) IF (mype == 0) THEN IF (.NOT. TRIM(str2_check) == TRIM(str2)) THEN WRITE (*,'(2x, a)') "PARSER: ERROR, command line input too long." WRITE (*,'(2x, a, 1x, a)') "called handle=", TRIM(string) WRITE (*,'(2x, a, 1x, a)') "parsed handle=", TRIM(str1) WRITE (*,'(2x, a, 1x, a)') "parsed input(cut)=", TRIM(str2) call abort_parallel() END IF END IF #endif IF (str1 == TRIM(string)) THEN ! Format specifier is needed for reading paths. Using ! `*` as format specifier, reading stops at a `/` READ(str2, '(a)') parsed_string modified = .TRUE. END IF ENDDO ENDIF ! *** Finalize *** IF (modified) THEN charvalue = parsed_string IF (mype == 0) WRITE (*, '(2x, a, a, a, a)') & 'PARSER: ', TRIM(handle), '= ', TRIM(parsed_string) END IF END SUBROUTINE parse_string SUBROUTINE parse_logical(handle, logvalue) ! ****************************** ! *** Parse an logical value *** ! ****************************** ! *** subroutine arguments *** CHARACTER(len=32), INTENT(in) :: handle LOGICAL, INTENT(inout) :: logvalue ! *** local variables *** CHARACTER(len=32) :: string LOGICAL :: parsed_log LOGICAL :: modified ! *** Initialization *** CALL MPI_Comm_Rank(MPI_COMM_WORLD, mype, MPIerr) string = '-' // TRIM(handle) modified = .FALSE. ! *** Parsing *** #ifdef F77 IF (iargc() > 0) THEN DO i = 1, iargc() - 1 CALL getarg(i, str1) CALL getarg(i + 1, str2) #else IF (command_argument_count() > 0) THEN DO i = 1, command_argument_count() - 1 CALL get_command_argument(i, str1) CALL get_command_argument(i+1, str2) #endif IF (str1 == TRIM(string)) THEN READ(str2, *) parsed_log modified = .TRUE. END IF ENDDO ENDIF ! *** Finalize *** IF (modified) THEN logvalue = parsed_log IF (mype == 0) WRITE (*, '(2x, a, a, a, l1)') & 'PARSER: ', TRIM(handle), '=', parsed_log END IF END SUBROUTINE parse_logical END MODULE parser