Ignore:
Timestamp:
Jan 24, 2018, 10:24:24 PM (7 years ago)
Author:
jvatant
Message:

Making Titan's hazy again - part II
+ Major updates of J.Burgalat YAMMS library and optical coupling, including :
++ Added the routines for haze optics inside YAMMS
++ Calling rad. transf. with interactive haze is plugged
in but should stay unactive as long as the microphysics is
in test phase : cf "uncoupl_optic_haze" flag : true for now !
++ Also some sanity checks for negative tendencies and
some others upkeep of YAMMS model
+ Also added a temporary CPP key USE_QTEST in physiq_mod
that enables to have microphysical tendencies separated
from dynamics for debugging and test phases
-- JVO and JB

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/LMDZ.TITAN/libf/muphytitan/argparse.F90

    r1814 r1897  
    1 ! Copyright Jérémie Burgalat (2010-2015)
     1! Copyright Jérémie Burgalat (2010-2015,2017)
    22!
    3 ! burgalat.jeremie@gmail.com
     3! jeremie.burgalat@univ-reims.fr
    44!
    55! This software is a computer program whose purpose is to provide configuration
     
    3333
    3434!! file: argparse.F90
    35 !! summary: Command-line parser source file
    36 !! author: burgalat
    37 !! date: 2013-2015
     35!! summary: Command-line parser source file.
     36!! author: J. Burgalat
     37!! date: 2013-2015,2017
    3838
    3939#include "defined.h"
     
    4747  !!
    4848  !! If you only wish to have an overview of argparse usage, you'd better go
    49   !! [p_argparse](here).
     49  !! [here](|url|/page/swift/p01_argparse.html).
     50
    5051  USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY : stdout=>OUTPUT_UNIT, stderr=>ERROR_UNIT
    5152  USE ERRORS
    5253  USE FSYSTEM, ONLY : fs_termsize
    53   USE STRINGS, getpar => format_paragraph, &
    54                splitstr  => format_string, &
    55                ap_string  => st_string,    & !! String value type ID
    56                ap_complex  => st_complex,  & !! Complex value type ID
    57                ap_logical => st_logical,   & !! Logical value type ID
    58                ap_integer => st_integer,   & !! Integer value type ID
    59                ap_real    => st_real         !! Floating point value type ID
     54  USE STRING_OP, getpar => format_paragraph, splitstr  => format_string 
    6055  IMPLICIT NONE
    6156
     
    6661  PUBLIC :: noerror,error, error_to_string,aborting
    6762  ! from strings
    68 #if ! HAVE_FTNDTSTR
    6963  PUBLIC :: st_slen, st_llen
    70 #endif
    71   PUBLIC :: ap_string, ap_complex, ap_logical, ap_integer, ap_real
    7264  PUBLIC :: stderr, stdout
    7365  ! argparse module
     
    9284  ! PARAMETERS (INTRISIC TYPES)
    9385  ! ===========================
     86
     87  INTEGER, PARAMETER, PUBLIC :: ap_string  = st_string
     88    !! String value type identifier.
     89  INTEGER, PARAMETER, PUBLIC :: ap_complex = st_complex
     90    !! Complex value type identifier.
     91  INTEGER, PARAMETER, PUBLIC :: ap_logical = st_logical
     92    !! Logical value type identifier.
     93  INTEGER, PARAMETER, PUBLIC :: ap_integer = st_integer
     94    !! Integer value type identifier.
     95  INTEGER, PARAMETER, PUBLIC :: ap_real = st_real
     96    !! Real value type identifier.
     97
     98  !> List of all available actions
    9499
    95100  INTEGER, PARAMETER, PUBLIC :: ap_store  = 1
     
    120125   
    121126  !> Add an option to the parser
     127  !!
     128  !! ```
     129  !! FUNCTION argparser_add_option(this,dest,sflag,lflag,type,action,default,nrec,help,meta) RESULT(err)
     130  !!          argparser_add_option(this,dest,flag,type,action,default,nrec,help,meta) RESULT(err)
     131  !! ```
     132  !!
     133  !! The function defines a new argument based on input parameters, checks it and finally sets it
     134  !! in the parser.
     135  !!
     136  !! In its first version both short (`sflag`) and long (`lflag`) options flags are mandatory. In its second
     137  !! form, a single flag (`flag`) is expected: the method will automatically deduce if it belongs to short or
     138  !! a long option flag based on the number of hyphens given.
     139  !!
     140  !! `type` value should be one of the following module constants (which are aliases from [[string_op(module)]]):
     141  !!
     142  !! - `ap_string` ([[string_op(module):st_string(variable)]])
     143  !! - `ap_complex` ([[string_op(module):st_complex(variable)]])
     144  !! - `ap_logical` ([[string_op(module):st_logical(variable)]])
     145  !! - `ap_integer` ([[string_op(module):st_integer(variable)]])
     146  !! - `ap_real` ([[string_op(module):st_real(variable)]])
     147  !!
     148  !! `action` value should be one of the following module constants:
     149  !!
     150  !! - [[argparse(module):ap_store(variable)]]
     151  !! - [[argparse(module):ap_append(variable)]]
     152  !! - [[argparse(module):ap_count(variable)]]
     153  !! - [[argparse(module):ap_help(variable)]]
     154  !!
     155  !! `nrec` string can take the following forms:
     156  !!
     157  !! tag   | description
     158  !! :---: | : -------------
     159  !!  "?"  | zero or one argument's value
     160  !!  "*"  | any number of arguments
     161  !!  "+"  | one or more argument's value(s)
     162  !!  "X"  | Exactly X values. Where X is the string representation of an integer (0 is accepted).
     163  !!
     164  !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
     165  !! produced by misuse of the function arguments. In such case, the program should be
     166  !! stopped: note that such error should not occur in _released_ programs.
    122167  INTERFACE argparser_add_option
    123168    MODULE PROCEDURE ap_add_option_1, ap_add_option_2
     
    131176  !> Get optional argument value(s)
    132177  !!
    133   !! This is the generic method that can be used to retrieve any kind of argument value(s) from the parser.
     178  !! ```
     179  !! FUNCTION argparser_get_value(this,name,output) RESULT(err)
     180  !! ```
     181  !!
     182  !! This is the generic method that can be used to retrieve any kind of argument value(s) from the parser for a given
     183  !! argument name (as defined by the `dest` argument of [[argparse(module):argparser_add_option(interface)]].
    134184  !! All the methods have the same dummy arguments only `output` dummy argument differs in type and shape.
    135185  !!
     
    137187  !! For string vector, `output` is expected to be an allocatable vector of **assumed length**
    138188  !! strings (thus string length is left to user responsability).
    139   !! A good compromise for strings length is to use the [[strings(module):st_slen(variable)]]
     189  !! A good compromise for strings length is to use the [[string_op(module):st_slen(variable)]]
    140190  !! parameter.
    141191  INTERFACE argparser_get_value
     
    287337    PROCEDURE, PRIVATE :: ap_get_sv_ve
    288338    PROCEDURE, PRIVATE :: ap_check_state
    289     !PROCEDURE, PUBLIC  :: reset_values       => argparser_reset_values
    290     !  !! Resets values stored in the parser
    291339    PROCEDURE, PUBLIC  :: throw_error        => argparser_throw_error
    292340      !! Throw an error and exit the program
     
    415463
    416464  FUNCTION argparser_add_positionals(this,nargs,meta,help) RESULT(err)
    417     !! Add positional arguments definition to the parser
     465    !! Add positional arguments definition to the parser.
     466    !!
    418467    !! The method initializes the entry for positional arguments in the parser.
    419468    !! Positional arguments are always seen by the parser as strings and the
    420469    !! default associated action is 'store'.
    421 
    422470    OBJECT(argparser), INTENT(inout)                     :: this
    423471      !! An argparser object reference
     
    533581    IF (zauto) THEN
    534582      IF (rhelp) CALL argparser_help(this)
    535       IF (err /= 0.AND. err /= 255) CALL argparser_throw_error(this,err,2)
     583      IF (err /= 0) CALL argparser_throw_error(this,err,2)
    536584    ENDIF
    537585    RETURN
     
    751799    !! in the parser. Both **short and long options flags** are mandatory input arguments of the function.
    752800    !!
    753     !!  `type` value should be one of the following module constants (which are aliases from [[strings(module)]]):
    754     !!  - ap_string ([[strings(module):st_string(variable)]])
    755     !!  - ap_complex ([[strings(module):st_complex(variable)]])
    756     !!  - ap_logical ([[strings(module):st_logical(variable)]])
    757     !!  - ap_integer ([[strings(module):st_integer(variable)]])
    758     !!  - ap_real ([[strings(module):st_real(variable)]])
     801    !!  `type` value should be one of the following module constants (which are aliases from [[string_op(module)]]):
     802    !!  - ap_string ([[string_op(module):st_string(variable)]])
     803    !!  - ap_complex ([[string_op(module):st_complex(variable)]])
     804    !!  - ap_logical ([[string_op(module):st_logical(variable)]])
     805    !!  - ap_integer ([[string_op(module):st_integer(variable)]])
     806    !!  - ap_real ([[string_op(module):st_real(variable)]])
    759807    !!
    760808    !!  `action` value should be one of the following module constants:
     
    772820    !!   X  | Exactly X values. Where X is the string representation of an integer (0 is accepted).
    773821    !!
    774     !! See also [[argparse(module):ap_add_option_2(function)]] documentation.
     822    !! See also ap_add_option_2 documentation.
    775823    OBJECT(argparser), INTENT(inout)                     :: this
    776824      !! An argparser object reference
     
    828876    !! Add an argument to the parser (interface #2)
    829877    !!
    830     !! The function is a wrapper to [[argparse(module):ap_add_option_1(function)]]. In this version,
     878    !! The function is a wrapper to ap_add_option_1. In this version,
    831879    !! only one option flag is required. The method only checks for the (trimmed) length of **flag** in
    832880    !! order to choose wether it is a **short** or **long** option flag. Then the function simply calls
    833     !! [[argparse(module):ap_add_option_1(function)]] to set the argument.
     881    !! ap_add_option_1 to set the argument.
    834882    !!
    835     !! Other dummy arguments have the same meaning as in [[argparse(module):ap_add_option_1(function)]].
     883    !! Other dummy arguments have the same meaning as in ap_add_option_1.
    836884    OBJECT(argparser), INTENT(inout)                     :: this
    837885      !! An argparser object reference
     
    886934      !! An argc object to check
    887935    TYPE(error) :: err
    888       !! Error object with -15 id if object is already set, no error otherwise.
     936      !! Error object with -8 id if object is already set, no error otherwise.
    889937    INTEGER :: i
    890938    err = noerror
     
    914962      !! An argparser object reference
    915963    TYPE(words), INTENT(inout)               :: cmd
    916       !! A [[strings(module):words(type)]] object with the command-line to parse
     964      !! A [[string_op(module):words(type)]] object with the command-line to parse
    917965    LOGICAL, INTENT(out)                     :: help_req
    918966      !! An output logical flag with `.true.` if help option has been found, `.false.` otherwise
     
    9871035      !! An argparser object reference
    9881036    TYPE(words), INTENT(inout)       :: cmd
    989       !! A [[strings(module):words(type)]] object with the command-line to parse
     1037      !! A [[string_op(module):words(type)]] object with the command-line to parse
    9901038    TYPE(error) :: err
    9911039      !! Error object with the first error encountered in the process
     
    10681116    ! Gets values as a function of the expected number of records
    10691117    IF (arg%nrec == 0) THEN
    1070       ! parse_args (main parsing method) reset all values: for 0 nrec
     1118      ! argparser_parse (main parsing method) reset all values: for 0 nrec
    10711119      ! we should have at least one value saved which is the default.
    10721120      ! if it is not the case we set default as values of the argument
     
    11361184    !! @warning
    11371185    !! For compilers that does not support allocatable strings in derived types,
    1138     !! computation are highly dependent of [[strings(module):st_slen(variable):
     1186    !! computation are highly dependent of [[string_op(module):st_slen(variable):
    11391187    !! tokens length are limited by this parameter.
    11401188    IMPLICIT NONE
     
    11441192      !! A string to process
    11451193    TYPE(words), INTENT(out)      :: new_cmd
    1146       !! An output [[strings(module):words(type)]] object with the processed command line
     1194      !! An output [[string_op(module):words(type)]] object with the processed command line
    11471195    LOGICAL, INTENT(out)          :: rhelp   
    11481196      !! An output boolean flag with `.true.` if help is requested, `.false.` otherwise
     
    11551203    err = noerror ; rhelp = .false.
    11561204    IF (LEN_TRIM(string) == 0) THEN
    1157       err = error('internal error (empty string)',-2)
     1205      err = error('internal error (empty string)',-255)
    11581206      RETURN
    11591207    ENDIF
    11601208    ! split input command line in words !
    1161     splitted = new_words(string," ",.true.) ! tokens may be truncated :(
     1209    call words_extend(splitted,string," ",.true.)
    11621210    ! reset iterator
    11631211    CALL words_reset(splitted)
     
    13301378
    13311379  SUBROUTINE ap_format_usage(this,optmw)
    1332     !! Format command line usage
     1380    !! Format command line usage.
     1381    !!
    13331382    !! The subroutine creates and formats the command line usage of the
    13341383    !! given argparser object. If [[argparser(type):usg(variable)]] is already set (i.e. not empty)
     
    16931742    !! The function calls all the tests to perform on argc members. Some of these tests can
    16941743    !! alter argc's member values to fit argparser's requirements.
    1695     !! @note
    1696     !! Normally, program should be stopped if returned error is not 0 !
     1744    !!
     1745    !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
     1746    !! produced by misuse of the function arguments. In such case, the program should be
     1747    !! stopped: note that such ezrror should not occur in _released_ programs.
    16971748    TYPE(argc), INTENT(inout)                            :: this
    16981749      !! An argc object
     
    17401791    !! The method checks if input argument's options are valid and update the argc object
    17411792    !! consequently.
     1793    !!
     1794    !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
     1795    !! produced by misuse of the function arguments.
    17421796    TYPE(argc), INTENT(inout)  :: this
    17431797      !! An argc object to update
     
    17561810    ret = noerror
    17571811    eprf = 'argparse: '//"Invalid argument `"//TRIM(this%name)//"'"
    1758     uty = error(eprf//" (type)",-2)
    1759     ina = error(eprf//" (inconsistent nargs)",-2)
     1812    uty = error(eprf//" (type)",-9)
     1813    ina = error(eprf//" (inconsistent nargs)",-9)
    17601814    zna = TRIM(na)
    17611815    ! Checks action
     
    17631817      this%paction = ac
    17641818    ELSE
    1765       ret = error(eprf//" (action)",-2) ; RETURN
     1819      ret = error(eprf//" (action)",-9) ; RETURN
    17661820    ENDIF
    17671821    ! Checks and sets type and default as a function of the action
     
    18851939            terr = error(eprf//" (inconsistent default value: expected '"// &
    18861940                           TRIM(st_type_names(this%ptype))//"', found '"// &
    1887                            TRIM(st_type_names(t))//"')",-2)
     1941                           TRIM(st_type_names(t))//"')",-9)
    18881942            RETURN
    18891943          ENDIF
     
    19772031      SELECT CASE(this%nrec)
    19782032        CASE(-3,-2,-1)
    1979           zmeta = str_to_upper(meta(1))
     2033          zmeta = to_upper(meta(1))
    19802034          blk = INDEX(TRIM(zmeta),CHAR(32)) - 1
    19812035          IF (blk <= 0) blk=LEN_TRIM(zmeta)
     
    19872041          DO i=1,this%nrec
    19882042            j=j+1 ; IF (j>ms) j=1
    1989             zmeta = str_to_upper(meta(j))
     2043            zmeta = to_upper(meta(j))
    19902044            blk=INDEX(TRIM(zmeta),CHAR(32))-1
    19912045            IF (blk <= 0) blk=LEN_TRIM(zmeta)
     
    19942048      END SELECT
    19952049    ELSE
    1996       zmeta = str_to_upper(TRIM(this%name))
     2050      zmeta = to_upper(TRIM(this%name))
    19972051      SELECT CASE(this%nrec)
    19982052        CASE(-3,-2,-1)
     
    22232277    !! - -7  : argument not found (i.e. does not set in the parser)
    22242278    !! - -19 : parsing not done yet
    2225     !! - -20 : (previous) parsing failed
     2279    !! - -20 : parsing failed
    22262280    !! - -21 : inconsistent destination type
    22272281    !! @note
     
    24802534  !! @param[in,out] this An argc object
    24812535  !! @param[out] output A scalar with the first value of the argument
    2482   !! @return An errors::error object with -12 if the destination variable's type
     2536  !! @return An errors::error object with -21 if the destination variable's type
    24832537  !! is inconsistent, 0 otherwise.
    24842538  FUNCTION ac_get_dv_sc(this, output) RESULT(ret)
     
    24922546      !! Output value
    24932547    TYPE(error) :: ret
    2494       !! Error object with the -12 if the destination variable's type is inconsistent, 0 otherwise
     2548      !! Error object with the -21 if the destination variable's type is inconsistent, 0 otherwise
    24952549    ret = noerror
    24962550    IF (this%ptype /= ap_real) THEN
Note: See TracChangeset for help on using the changeset viewer.