Changeset 3083 for trunk/LMDZ.TITAN/libf/muphytitan

trunk/LMDZ.TITAN/libf/muphytitan/argparse.F90

-                      r1897
+                      r3083
+! Copyright Jérémie Burgalat (2010-2015,2017)
+!
+! jeremie.burgalat@univ-reims.fr
+!
+! This software is a computer program whose purpose is to provide configuration
+! file and command line arguments parsing features to Fortran programs.
+!
+! This software is governed by the CeCILL-B license under French law and
+! abiding by the rules of distribution of free software.  You can  use,
+! modify and/ or redistribute the software under the terms of the CeCILL-B
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and  rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty  and the software's author,  the holder of the
+! economic rights,  and the successive licensors  have only  limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading,  using,  modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean  that it is complicated to manipulate,  and  that  also
+! therefore means  that it is reserved for developers  and  experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The fact that you are presently reading this means that you have had
+! knowledge of the CeCILL-B license and that you accept its terms.
+! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+!
+! This file is part of SWIFT
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy of
+! this software and associated documentation files (the "Software"), to deal in
+! the Software without restriction, including without limitation the rights to
+! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+! the Software, and to permit persons to whom the Software is furnished to do so,
+! subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in all
+! copies or substantial portions of the Software.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 !! file: argparse.F90
 !! summary: Command-line parser source file.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 #include "defined.h"
 …
   !! For your own sanity, private methods that call Ancient Gods powers through
   !! evil black magic rituals are not described here.
   !!
+  !!
   !! If you only wish to have an overview of argparse usage, you'd better go
   !! [here](|url|/page/swift/p01_argparse.html).
 …
   USE ERRORS
   USE FSYSTEM, ONLY : fs_termsize
   USE STRING_OP, getpar => format_paragraph, splitstr  => format_string
+  USE STRING_OP, getpar => format_paragraph, splitstr  => format_string
   IMPLICIT NONE
 …
             argparser_add_option,       &
             argparser_add_positionals,  &
             argparser_throw_error,      &
+            argparser_throw_error,      &
             argparser_parse,            &
             argparser_help,             &
 …
   ! ===========================
   INTEGER, PARAMETER, PUBLIC :: ap_string  = st_string
+  INTEGER, PARAMETER, PUBLIC :: ap_string  = st_string
     !! String value type identifier.
   INTEGER, PARAMETER, PUBLIC :: ap_complex = st_complex
 …
   !> List of all available actions
   INTEGER, PARAMETER, PUBLIC :: ap_store  = 1
+  INTEGER, PARAMETER, PUBLIC :: ap_store   = 1
     !! store action ID : Each time the option is seen, values are replaced.
   INTEGER, PARAMETER, PUBLIC :: ap_append = 2
     !! append action ID : Each time the option is seen, values are appended.
   INTEGER, PARAMETER, PUBLIC :: ap_count  = 3
+  INTEGER, PARAMETER, PUBLIC :: ap_append  = 2
+    !! append action ID : Each time the option is seen, values are appended.
+  INTEGER, PARAMETER, PUBLIC :: ap_count   = 3
     !! count action ID : increase a counter each time the option is seen.
   INTEGER, PARAMETER, PUBLIC :: ap_help   = 4
+  INTEGER, PARAMETER, PUBLIC :: ap_help    = 4
     !! help action ID : help is requested !
+  INTEGER, PARAMETER, PUBLIC :: ap_version = 5
+    !! version action ID : version is requested !
   !> List of all available actions
   INTEGER, DIMENSION(4), PARAMETER, PRIVATE :: ap_actions = (/ap_store,  &
+  INTEGER, DIMENSION(5), PARAMETER, PRIVATE :: ap_actions = (/ap_store,  &
                                                               ap_append, &
                                                               ap_count,  &
+                                                              ap_help/)
+                                                              ap_help,   &
+                                                              ap_version/)
   !> List of all recognized types by the parser
   INTEGER, DIMENSION(5), PARAMETER, PRIVATE :: ap_types = (/ap_string,  &
+  INTEGER, DIMENSION(5), PARAMETER, PRIVATE :: ap_types = (/ap_string,  &
                                                             ap_logical, &
                                                             ap_complex, &
                                                             ap_integer, &
                                                             ap_real/)
+                                                            ap_real/)
   !> The unknown flag
   !!
   !! This flag is only intended to initialize flags. It is set by default during initialization
+  !! This flag is only intended to initialize flags. It is set by default during initialization
   !! and quielty replaced by default flags, if user does not provide the relevant feature.
   INTEGER, PARAMETER :: ap_undef = -1
   !> Add an option to the parser
   !!
 …
   !! ```
   !!
   !! The function defines a new argument based on input parameters, checks it and finally sets it
   !! in the parser.
   !!
+  !! The function defines a new argument based on input parameters, checks it and finally sets it
+  !! in the parser.
+  !!
   !! In its first version both short (`sflag`) and long (`lflag`) options flags are mandatory. In its second
   !! form, a single flag (`flag`) is expected: the method will automatically deduce if it belongs to short or
   !! a long option flag based on the number of hyphens given.
   !!
+  !!
   !! `type` value should be one of the following module constants (which are aliases from [[string_op(module)]]):
   !!
 …
   !! - `ap_integer` ([[string_op(module):st_integer(variable)]])
   !! - `ap_real` ([[string_op(module):st_real(variable)]])
   !!
+  !!
   !! `action` value should be one of the following module constants:
   !!
 …
   !!  "X"  | Exactly X values. Where X is the string representation of an integer (0 is accepted).
   !!
   !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
+  !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
   !! produced by misuse of the function arguments. In such case, the program should be
   !! stopped: note that such error should not occur in _released_ programs.
 …
     MODULE PROCEDURE ap_add_option_1, ap_add_option_2
   END INTERFACE
   !> Get positional argument value(s)
   INTERFACE argparser_get_positional
     MODULE PROCEDURE ap_get_positional_sc, ap_get_positional_ve
   END INTERFACE
+  END INTERFACE
   !> Get optional argument value(s)
 …
   !! FUNCTION argparser_get_value(this,name,output) RESULT(err)
   !! ```
   !!
+  !!
   !! This is the generic method that can be used to retrieve any kind of argument value(s) from the parser for a given
   !! argument name (as defined by the `dest` argument of [[argparse(module):argparser_add_option(interface)]].
   !! All the methods have the same dummy arguments only `output` dummy argument differs in type and shape.
   !!
+  !!
   !! @note
   !! For string vector, `output` is expected to be an allocatable vector of **assumed length**
   !! strings (thus string length is left to user responsability).
   !! A good compromise for strings length is to use the [[string_op(module):st_slen(variable)]]
+  !! A good compromise for strings length is to use the [[string_op(module):st_slen(variable)]]
   !! parameter.
   INTERFACE argparser_get_value
 …
   !> Interface to [[argparse(module):argc(type)]] getters
   !!
   !! All the functions have the same prototype, only kind and type of arguments changed
+  !! All the functions have the same prototype, only kind and type of arguments changed
   !! from a function to the other.
   INTERFACE argc_get_value
+  INTERFACE argc_get_value
     MODULE PROCEDURE ac_get_dv_sc, ac_get_rv_sc, ac_get_iv_sc, ac_get_lv_sc, &
                      ac_get_cv_sc, ac_get_sv_sc, ac_get_dv_ve, ac_get_rv_ve, &
 …
     !! Defines a command-line argument.
     !!
     !! An [[argparse(module):argc(type)]] object stores all information about a command-line
+    !! An [[argparse(module):argc(type)]] object stores all information about a command-line
     !! argument, that is:
     !!
     !! - its name
     !! - its optional flags
+    !! - its optional flags
     !! - its type
     !! - its action
 …
     TYPE(words)      :: meta
       !! Meta variable name(s) of the argument
 #if HAVE_FTNDTSTR
+#if HAVE_FTNDTSTR
     CHARACTER(len=:), ALLOCATABLE :: default
       !! Default flag
+      !! Default flag
     CHARACTER(len=:), ALLOCATABLE :: name
       !! Name of the argument (needed to check and retrieve its value(s))
     CHARACTER(len=:), ALLOCATABLE :: lflag
+    CHARACTER(len=:), ALLOCATABLE :: lflag
       !! Long flag option (st_short_len max chars !)
     CHARACTER(len=:), ALLOCATABLE :: help
 …
 #else
     CHARACTER(len=st_slen) :: default = ""
       !! Default flag
+      !! Default flag
     CHARACTER(len=st_slen) :: name
       !! Name of the argument (needed to check and retrieve its value(s))
 …
     !! Command-line parser
     !!
     !! This is the main object of the module. It stores definitions of CLI arguments and
+    !! This is the main object of the module. It stores definitions of CLI arguments and
     !! their value(s) once the command-line have been parsed.
     TYPE(argc), PRIVATE, ALLOCATABLE, DIMENSION(:) :: args
 …
 #if HAVE_FTNDTSTR
     CHARACTER(len=:), PRIVATE, ALLOCATABLE :: usg
       !! Program command usage
+      !! Program command usage
     CHARACTER(len=:), PRIVATE, ALLOCATABLE :: descr
       !! Program help description
     CHARACTER(len=:), PRIVATE, ALLOCATABLE :: eplg
+    CHARACTER(len=:), PRIVATE, ALLOCATABLE :: eplg
       !! Program help epilog
+    CHARACTER(len=:), PRIVATE, ALLOCATABLE :: vers
+      !! Application version string
 #else
     CHARACTER(len=st_llen), PRIVATE :: usg
       !! Program command usage
+      !! Program command usage
     CHARACTER(len=st_llen), PRIVATE :: descr
       !! Program help description
     CHARACTER(len=st_llen), PRIVATE :: eplg
+    CHARACTER(len=st_llen), PRIVATE :: eplg
       !! Program help epilog
+    CHARACTER(len=st_llen), PRIVATE :: vers
+      !! Application version string
 #endif
     INTEGER, PRIVATE :: mxhlpos = 20
+    INTEGER, PRIVATE :: mxhlpos = 20
       !! Position of the short help for options
     INTEGER, PRIVATE :: width = 0
       !! Maximum width of the help
+      !! Maximum width of the help
     LOGICAL, PRIVATE :: init = .false.
       !! Initialization control flag
 #if HAVE_FTNPROC
+#if HAVE_FTNPROC
     CONTAINS
 …
     PROCEDURE, PUBLIC  :: parse              => argparser_parse
       !! Parse the command-line (or the given input string).
     PROCEDURE, PUBLIC  :: help               => argparser_help
+    PROCEDURE, PUBLIC  :: help               => argparser_help
       !! Compute and print help
+    PROCEDURE, PUBLIC  :: version            => argparser_version
+      !! print version string
     PROCEDURE, PUBLIC  :: found              => argparser_found
       !! Check if an optional argument has been found on the command-line
 …
     GENERIC, PUBLIC    :: add_option         => ap_add_option_1, &
                                                 ap_add_option_2
     !> Get the values of the positionals stored in the parser.
+    !> Get the values of the positionals stored in the parser.
     GENERIC, PUBLIC    :: get_positional     => ap_get_positional_sc, &
                                                 ap_get_positional_ve
 …
                                                 ap_get_cv_ve, &
                                                 ap_get_sv_ve
 #endif
+#endif
   END TYPE argparser
 …
   ! -------------------------------
   FUNCTION new_argparser(usg, dsc, epg, add_help, width, max_help_pos) RESULT(this)
+  FUNCTION new_argparser(usg, dsc, epg, add_help, add_version, version_string,width, max_help_pos) RESULT(this)
     !! Initialize an argparser object.
     !!
+    !!
     !! The method initializes (properly) an [[argparse(module):argparser(type)]] object.
     !! Even if all the arguments are optional, it is mandatory to **call** the method
+    !! Even if all the arguments are optional, it is mandatory to **call** the method
     !! before using an argparser object.
     CHARACTER(len=*), INTENT(in), OPTIONAL :: usg
 …
       !! An optional string with the epilog of the program's help
     LOGICAL, INTENT(in), OPTIONAL          :: add_help
       !! An optional boolean flag with `.true.` to automatically set an option for program's help.
+      !! An optional boolean flag with `.true.` to automatically set an option for program's help.
       !! Note that, the option flags `-h` and `--help` are no more available in that case.
+    LOGICAL, INTENT(in), OPTIONAL          :: add_version
+      !! An optional boolean flag with `.true.` to automatically set an option for program's help.
+      !! Note that, the option flags `-V` and `--version` are no more available in that case.
+    CHARACTER(len=*), INTENT(in), OPTIONAL :: version_string
+      !! An optional string with the text to display if the *version* option is found on the
+      !! command line. The text is displayed without any format.
     INTEGER, INTENT(in), OPTIONAL          :: width
       !! An optional integer with the maximum width the help text.
     INTEGER, INTENT(in), OPTIONAL          :: max_help_pos
       !! An optional integer with the maximum position of the help string for each option of
       !! the program when help is requested. Note that this value is just an indicator. The
       !! helper computes the minimum position between this value and the maximum length of the
+      !! An optional integer with the maximum position of the help string for each option of
+      !! the program when help is requested. Note that this value is just an indicator. The
+      !! helper computes the minimum position between this value and the maximum length of the
       !! options flags.
     TYPE(argparser) :: this
+    TYPE(argparser) :: this
       !! An initialized argparse object.
     INTEGER     :: zh
 …
     IF (PRESENT(dsc)) THEN ; this%descr=dsc ; ELSE ; this%descr='' ; ENDIF
     IF (PRESENT(epg)) THEN ; this%eplg=epg  ; ELSE ; this%eplg=''  ; ENDIF
     CALL fs_termsize(zh,this%width)
+    CALL fs_termsize(zh,this%width)
     IF (PRESENT(width)) this%width = MAX(width,50)
     IF(PRESENT(max_help_pos)) this%mxhlpos = MAX(5,max_help_pos)
 …
                     action=ap_help, help="Print this help and quit")
     ENDIF
+    IF (PRESENT(add_version)) THEN
+      IF (add_version) &
+        err = argparser_add_option(this,'version',sflag='-V',lflag='--version', &
+                    action=ap_version, help="Print the application version and quit")
+      this%vers = ''
+      if (PRESENT(version_string)) this%vers = TRIM(version_string)
+    ENDIF
     RETURN
   END FUNCTION new_argparser
 …
     !! @note If **fccp** has not been built with support for finalization subroutine,
     !! it should be called whenever the argparser object is no more used.
     TYPE(argparser), INTENT(inout) :: this
+    TYPE(argparser), INTENT(inout) :: this
       !! An argparser object
     IF (ALLOCATED(this%args)) THEN
 …
     !!
     !! The method initializes the entry for positional arguments in the parser.
     !! Positional arguments are always seen by the parser as strings and the
+    !! Positional arguments are always seen by the parser as strings and the
     !! default associated action is 'store'.
     OBJECT(argparser), INTENT(inout)                     :: this
 …
       !! A vector of strings with the the displayed value name(s) of the positionals in the help command
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: help
       !! An optional string with a short description of the positional argument(s)
+      !! An optional string with a short description of the positional argument(s)
     TYPE(error) :: err
       !! Error object with the first error encountered in the process.
 …
     CHARACTER(len=:), ALLOCATABLE :: sf,lf,de
     err = noerror
     IF (.NOT.this%init) THEN
       err = error("argparse: parser not initialized yet",-1)
+    IF (.NOT.this%init) THEN
+      err = error("argparse: parser not initialized yet",-1)
       RETURN
     ENDIF
 …
         RETURN
       ENDIF
       this%have_posal = this%posals%nrec /= 0
+      this%have_posal = this%posals%nrec /= 0
     ENDIF
     RETURN
 …
     !! given as optional argument and fills the parser's arguments.
     !! @note
     !! If `cmd_line` is provided it should not contains the name of the program or
     !! the parsing process will certainly failed: program name will be seen as the
     !! first positional argument and all tokens of the string will then be seen as
+    !! If `cmd_line` is provided it should not contains the name of the program or
+    !! the parsing process will certainly failed: program name will be seen as the
+    !! first positional argument and all tokens of the string will then be seen as
     !! positional.
     OBJECT(argparser), INTENT(inout)       :: this
 …
       !! An optional string to parse that substitute for the actual command-line.
     LOGICAL, INTENT(in), OPTIONAL          :: auto
       !! An optional boolean flag with `.true.` to instruct the parser wether to perform
+      !! An optional boolean flag with `.true.` to instruct the parser wether to perform
       !! automatic actions or not when error occur during parsing. If `auto` is enabled,
       !! then the parser dumps program's usage and stops the program on error.
 …
     CHARACTER(len=:), ALLOCATABLE :: cline,z
     LOGICAL                       :: zauto
+    LOGICAL                       :: rhelp
+    INTEGER                       :: l
+    LOGICAL                       :: rhelp
+    LOGICAL                       :: rvers
+    INTEGER                       :: l
     TYPE(words)                   :: cmd_tokens
     err = noerror
 …
       err = error("parser not initialized yet",-1) ; RETURN
     ENDIF
     rhelp = .false.
+    rhelp = .false. ; rvers = .false.
     zauto = .false. ; IF (PRESENT(auto)) zauto = auto
     IF (PRESENT(cmd_line)) THEN
       ALLOCATE(cline,source=cmd_line)
     ELSE
       CALL GET_COMMAND(length=l)
+      CALL GET_COMMAND(length=l)
       ALLOCATE(CHARACTER(len=l) :: z) ; CALL GET_COMMAND(z)
       CALL GET_COMMAND_ARGUMENT(0,length=l)
 …
         EXIT ! ... No :)
       ELSE
         err = ap_split_cmd(this,cline,cmd_tokens,rhelp)
+        err = ap_split_cmd(this,cline,cmd_tokens,rhelp)
         ! we only stops processing if :
         !   - the internal error (string length) is raised
 …
       CALL words_reset(cmd_tokens) ! not mandatory... at least theoretically
       ! Parses the options
       err = ap_parse_options(this,cmd_tokens,rhelp)
+      err = ap_parse_options(this,cmd_tokens,rhelp,rvers)
       IF (err /= noerror) EXIT
       ! exit loop if help is requested. Parser is not completely filled but we
       ! expect someone to use the help action..
       IF (rhelp) EXIT
+      ! exit loop if help or version is requested. Parser is not completely filled but we
+      ! expect someone to use the help or version actions...
+      IF (rhelp.OR.rvers) EXIT
       ! Parses positionals
       err = ap_parse_positionals(this,cmd_tokens)
+      err = ap_parse_positionals(this,cmd_tokens)
       EXIT ! A one iterated loop :)
     ENDDO
 …
     IF (zauto) THEN
       IF (rhelp) CALL argparser_help(this)
+      IF (rvers) CALL argparser_version(this)
       IF (err /= 0) CALL argparser_throw_error(this,err,2)
     ENDIF
     RETURN
+    RETURN
   END FUNCTION argparser_parse
+  SUBROUTINE argparser_version(this)
+    !! Print version string and exit program
+    OBJECT(argparser), INTENT(inout) :: this
+      !! An argparser object reference
+    WRITE(stdout,'(a)') TRIM(this%vers)
+    CALL argparser_clear(this)
+    CALL EXIT(0)
+  END SUBROUTINE argparser_version
   SUBROUTINE argparser_help(this)
 …
     !!
     !! The method performs the following actions:
     !!
+    !!
     !! - Print the usage command of the program
     !! - Dump the provided @p error message
 …
     !!
     !! The error message is always printed in standard error output.
     !! @note
+    !! @note
     !! If errors::error::id is 0 the method does nothing.
     OBJECT(argparser), INTENT(inout) :: this
 …
   FUNCTION argparser_found(this,argname) RESULT(found)
     !! Check wether an argument has been found in the command-line.
     !! @note
+    !! @note
     !! Keep in mind that arguments in the parser always have a default
     !! value. This method is not intended to check if an argument has a value but
 …
     CHARACTER(len=*), INTENT(in)  :: argname
       !! Name of the argument to check.
     INTEGER :: num
+    INTEGER :: num
       !! The number of actual values stored in the argument
     INTEGER  :: idx
 …
     INTEGER :: ret
       !! The number of actual positionals arguments
     ret = 0
+    ret = 0
     IF (this%have_posal) THEN
       ret = words_length(this%posals%values)
     ENDIF
   END FUNCTION argparser_get_num_positional
+  END FUNCTION argparser_get_num_positional
   ! argparser private methods
 …
   FUNCTION ap_check_state(this) RESULT(err)
     !! Check current parser state
+    !! Check current parser state
     !! The method returns an error based on the current parser's state:
     !! - Parser is ready (0)
 …
       !! An argparser object reference
     TYPE(error) :: err
       !! Error object with the *status* of the parser
+      !! Error object with the *status* of the parser
     err = noerror
     IF (this%parsed == -1) THEN
 …
       err = error("argparse: command-line parsing failed",-20)
     ELSE IF (.NOT.this%init) THEN
       err = error("argparse: parser not initialized yet",-1)
+      err = error("argparse: parser not initialized yet",-1)
     ENDIF
     RETURN
 …
     INTEGER                               :: i
     TYPE(argc), ALLOCATABLE, DIMENSION(:) :: tmp
     TYPE(error) :: err
+    TYPE(error) :: err
     IF (.NOT.this%init)  THEN
       err = error("parser not initialized yet",-1) ; RETURN
 …
     IF (this%nargs == 0) THEN
       ALLOCATE(this%args(1))
       this%args(1) = arg
       this%nargs = 1
+      this%args(1) = arg
+      this%nargs = 1
       RETURN
     ENDIF
 …
     ALLOCATE(tmp(this%nargs))
     DO i=1,this%nargs ; tmp(i) = this%args(i) ; ENDDO
     CALL clear_argc(this%args)
     DEALLOCATE(this%args)
+    CALL clear_argc(this%args)
+    DEALLOCATE(this%args)
     this%nargs = this%nargs+1 ; ALLOCATE(this%args(this%nargs))
     DO i=1,this%nargs-1 ; this%args(i) = tmp(i) ; ENDDO
 …
     ! empty parser
     IF (this%nargs == 0) RETURN
     DO i=1, this%nargs
+    DO i=1, this%nargs
       IF ((nn /= 0 .AND. TRIM(this%args(i)%name)  == TRIM(lna)) .OR. &
           (ns /= 0 .AND. TRIM(this%args(i)%sflag) == TRIM(lsf)) .OR. &
 …
     !! Add an argument to the parser (interface #1)
     !!
     !! The function defines a new argument based on input parameters, checks it and finally sets it
+    !! The function defines a new argument based on input parameters, checks it and finally sets it
     !! in the parser. Both **short and long options flags** are mandatory input arguments of the function.
     !!
+    !!
     !!  `type` value should be one of the following module constants (which are aliases from [[string_op(module)]]):
     !!  - ap_string ([[string_op(module):st_string(variable)]])
 …
     !!  - ap_integer ([[string_op(module):st_integer(variable)]])
     !!  - ap_real ([[string_op(module):st_real(variable)]])
     !!
+    !!
     !!  `action` value should be one of the following module constants:
     !!  - [[argparse(module):ap_store(variable)]]
 …
       !! A string (3 characters minimum) with the long option flag of the argument
     INTEGER, INTENT(in), OPTIONAL                        :: type
       !! An integer with the type of the argument
+      !! An integer with the type of the argument
     INTEGER, INTENT(in), OPTIONAL                        :: action
       !! An integer with the action of the argument
+      !! An integer with the action of the argument
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: default
       !! A string with the default value of the argument if not provided in the CLI
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: nrec
       !! A string with the expected number of specified values for the argument in the CLI.
+      !! A string with the expected number of specified values for the argument in the CLI.
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: help
       !! A string with a short description of the argument
 …
     de =''        ; IF (PRESENT(default)) de = TRIM(default)
     IF (.NOT.this%init)  THEN
       err = error("argparse: parser not initialized yet",-1)
+      err = error("argparse: parser not initialized yet",-1)
       RETURN
     ENDIF
 …
     !! Add an argument to the parser (interface #2)
     !!
     !! The function is a wrapper to ap_add_option_1. In this version,
+    !! The function is a wrapper to ap_add_option_1. In this version,
     !! only one option flag is required. The method only checks for the (trimmed) length of **flag** in
     !! order to choose wether it is a **short** or **long** option flag. Then the function simply calls
+    !! order to choose wether it is a **short** or **long** option flag. Then the function simply calls
     !! ap_add_option_1 to set the argument.
     !!
+    !!
     !! Other dummy arguments have the same meaning as in ap_add_option_1.
     OBJECT(argparser), INTENT(inout)                     :: this
 …
       !! A string with the type of the argument
     INTEGER, INTENT(in), OPTIONAL                        :: action
       !! A string with the action of the argument
+      !! A string with the action of the argument
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: default
       !! A string with the default value of the argument if not provided in the CLI
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: nrec
       !! A string with the expected number of specified values for the argument in the CLI.
+      !! A string with the expected number of specified values for the argument in the CLI.
     CHARACTER(len=*), INTENT(in), OPTIONAL               :: help
       !! A string with a short description of the argument
 …
   END FUNCTION ap_check_in_parser
   FUNCTION ap_parse_options(this,cmd,help_req) RESULT(err)
+  FUNCTION ap_parse_options(this,cmd,help_req,vers_req) RESULT(err)
     !! Parse options of the internal command line
     !! This (internal) function manages the parsing of the command line options.
+    !! This (internal) function manages the parsing of the command line options.
     OBJECT(argparser), INTENT(inout), TARGET :: this
       !! An argparser object reference
 …
     LOGICAL, INTENT(out)                     :: help_req
       !! An output logical flag with `.true.` if help option has been found, `.false.` otherwise
+    LOGICAL, INTENT(out)                     :: vers_req
+      !! An output logical flag with `.true.` if version option has been found, `.false.` otherwise
     TYPE(error) :: err
       !! Error object with the first error encountered in the process
 …
       ! get current element
       elt = words_current(cmd)
       ! check element kind: is it an option flag (-1/0)or a value (1)?
+      ! check element kind: is it an option flag (-1/0) or a value (1)?
       ic = ap_check_string(this,elt,arg_idx)
       IF (ic <= 0) THEN
         IF (arg_idx /= -1) THEN
           err = ap_fill_argument(this,cmd,this%args(arg_idx))
+          IF (err == 0 .AND. this%args(arg_idx)%paction == ap_help) THEN
+            this%parsed = 1
+            err = argparser_get_value(this,'help',help_req)
+            EXIT
+          IF (err == 0) THEN
+            IF (this%args(arg_idx)%paction == ap_help) THEN
+              this%parsed = 1
+              err = argparser_get_value(this,'help',help_req)
+              EXIT
+            ELSE IF (this%args(arg_idx)%paction == ap_version) THEN
+              this%parsed = 1
+              err = argparser_get_value(this,'version',vers_req)
+              EXIT
+            ENDIF
           ENDIF
           IF (err /= 0) EXIT
 …
       ! iterates to next value
       CALL words_next(cmd)
     ENDDO
+    ENDDO
     ! Do we need to check for error here ?
 …
         IF (this%args(i)%nrec < nv) THEN
           err = ac_fmt_val_err(this%args(i),-18) ! extra values
         ELSE
+        ELSE
           err = ac_fmt_val_err(this%args(i),-17) ! missing values
         ENDIF
       ENDIF
+      ENDIF
     ENDDO
     IF (err /= 0) this%parsed = 0
     RETURN
   END FUNCTION ap_parse_options
+  END FUNCTION ap_parse_options
   FUNCTION ap_parse_positionals(this,cmd) RESULT(err)
     !! Parse positional arguments of the internal command line
     !! This (internal) function manages the parsing of the command line positional arguments.
+    !! This (internal) function manages the parsing of the command line positional arguments.
     OBJECT(argparser), INTENT(inout) :: this
       !! An argparser object reference
 …
     ! no positional required but current word is valid
     ! Either : no positional required but valid element is present
+    ! Either : no positional required but valid element is present
     !     Or : positional required but no valid element is present
     IF ((this%have_posal.AND..NOT.words_valid(cmd)) .OR. &
 …
     CALL words_clear(this%posals%values)
     this%posals%fnd = .true.
     DO
+    DO
       na = words_length(this%posals%values)
       IF (words_valid(cmd)) THEN
 …
     !! Fill an argument with values
     !!
     !! The function parses remaining parts of the command line from the position of
     !! the given argument and attempts to retrieve its value(s) (if any).
+    !! The function parses remaining parts of the command line from the position of
+    !! the given argument and attempts to retrieve its value(s) (if any).
     !! Several tests are performed and may raise errors. The function always stops
     !! at the first error encountered which can be one of the following :
 …
       !! The command line
     TYPE(argc), INTENT(inout), TARGET :: arg
       !! An argc object reference with the argument currently processed.
+      !! An argc object reference with the argument currently processed.
     TYPE(error) :: err
       !! Error object with the first error encountered in the process
     INTEGER                       :: ca, isopt, itmp
+    INTEGER                       :: ca, isopt, itmp
     LOGICAL                       :: ltmp
     CHARACTER(len=:), ALLOCATABLE :: elt
 …
       IF (arg%paction == ap_count) THEN
         elt = words_pop(arg%values)
         READ(elt,*) itmp ; itmp = itmp + 1
+        READ(elt,*) itmp ; itmp = itmp + 1
         CALL words_append(arg%values,TO_STRING(itmp))
       ELSE IF (arg%ptype == ap_logical) THEN
+      ELSE IF (arg%ptype == ap_logical) THEN
         elt = words_pop(arg%values)
         READ(elt,*) ltmp
+        READ(elt,*) ltmp
         CALL words_append(arg%values,TO_STRING(.NOT.ltmp))
       ENDIF
     ELSE
       ! For any other case, the algorithm is quite simple :
       ! We consume tokens of the command-line until either the end or
+      ! We consume tokens of the command-line until either the end or
       ! the next option (or '--' separator)
       ! When the exit condition is met we perform some tests based on the
 …
           !    1) we have consumed all argument of command line
           !    2) current argument is not a value !
           !    3) current argument the separator '--'
+          !    3) current argument the separator '--'
           IF (isopt <= 0 .OR. TRIM(elt)=='--') CALL words_previous(cmd)
           IF (arg%nrec == -2 .AND. words_length(arg%values) == 0) &
+          IF (arg%nrec == -2 .AND. words_length(arg%values) == 0) &
             err = ac_fmt_val_err(arg,-17)
           IF (arg%paction /= ap_append .AND. arg%nrec > 0 .AND. ca /= arg%nrec) &
 …
   END FUNCTION ap_fill_argument
   FUNCTION ap_split_cmd(this,string,new_cmd,rhelp) RESULT(err)
+  FUNCTION ap_split_cmd(this,string,new_cmd,rhelp) RESULT(err)
     !! Preprocess the command line
     !! The function reads and splits the given string so merged options/values
+    !! The function reads and splits the given string so merged options/values
     !! are splitted and saves the resulting string elements in a list of words.
     !! @warning
     !! For compilers that does not support allocatable strings in derived types,
     !! computation are highly dependent of [[string_op(module):st_slen(variable):
     !! tokens length are limited by this parameter.
+    !! tokens length are limited by this parameter.
     IMPLICIT NONE
     OBJECT(argparser), INTENT(in) :: this
 …
     TYPE(words), INTENT(out)      :: new_cmd
       !! An output [[string_op(module):words(type)]] object with the processed command line
     LOGICAL, INTENT(out)          :: rhelp
+    LOGICAL, INTENT(out)          :: rhelp
       !! An output boolean flag with `.true.` if help is requested, `.false.` otherwise
     TYPE(error) :: err
 …
     INTEGER                       :: isopt,j,tl,res
     CHARACTER(len=:), ALLOCATABLE :: elt
     TYPE(words)                   :: splitted
+    TYPE(words)                   :: splitted
     INTEGER                       :: arg_idx
     err = noerror ; rhelp = .false.
     IF (LEN_TRIM(string) == 0) THEN
       err = error('internal error (empty string)',-255)
+      err = error('internal error (empty string)',-255)
       RETURN
     ENDIF
 …
           res = ap_check_string(this,"-"//elt(j:j),arg_idx)
           ! great we have another short option flag
           IF (res == -1 .AND. arg_idx /= -1) THEN ! another short option !
+          IF (res == -1 .AND. arg_idx /= -1) THEN ! another short option !
             rhelp = (this%args(arg_idx)%paction == ap_help.OR.rhelp)
             ! we must not set some argument's values here  for help argument
             ! if auto is not set the parse method will disable the option
+            ! if auto is not set the parse method will disable the option
             ! during next! parsing process
             CALL words_append(new_cmd,"-"//elt(j:j))
 …
         rhelp = (this%args(arg_idx)%paction == ap_help.OR.rhelp)
         ! we must not set some argument's values here for help argument
         ! if auto is not set the parse method will disable the option during
+        ! if auto is not set the parse method will disable the option during
         ! next parsing process
         CALL words_append(new_cmd,TRIM(elt))
 …
     RETURN
   END FUNCTION ap_split_cmd
   FUNCTION ap_check_string(this,string,idx) RESULT(ret)
     !! Check if a string is an option flag
 …
     INTEGER, INTENT(out), OPTIONAL             :: idx
       !! An optional output intger with the index of the afferent argument in the parser (-1 if not found)
     INTEGER :: ret
+    INTEGER :: ret
       !! Return code with the following possible values:
       !! - -1 if the string is a SHORT option flag
 …
     ! The combination of the (optional) output index and the return code
     ! allows to check if an option is known or not
     ret = 1
+    ret = 1
     ! '--' is special : it is a separator that is seen as a value.
     IF (TRIM(string) == '--') RETURN
 …
     CHARACTER(len=:), ALLOCATABLE :: copt,spc,opts,text
     INTEGER                       :: i,j,ia,optmw,i1,io,n,zw,zh
     IF (this%width == 0) CALL fs_termsize(zh,this%width)
+    IF (this%width == 0) CALL fs_termsize(zh,this%width)
     zw = this%width
     ! Sets usage
 …
     hlp = TRIM(this%usg)//NEW_LINE('A')//NEW_LINE('A')
     ! Sets description
     IF (LEN_TRIM(this%descr) /= 0) &
+    IF (LEN_TRIM(this%descr) /= 0) &
       hlp=hlp//getpar(this%descr,zw,2)//NEW_LINE('A')//NEW_LINE('A')
     ! Sets positionals
 …
     !! Format command line usage.
     !!
     !! The subroutine creates and formats the command line usage of the
     !! given argparser object. If [[argparser(type):usg(variable)]] is already set (i.e. not empty)
     !! then the method only computes the maximum width of the option part of the usage command
     !! (see `optmw` argument description) if needed. In the other case, the method builds the usage
+    !! The subroutine creates and formats the command line usage of the
+    !! given argparser object. If [[argparser(type):usg(variable)]] is already set (i.e. not empty)
+    !! then the method only computes the maximum width of the option part of the usage command
+    !! (see `optmw` argument description) if needed. In the other case, the method builds the usage
     !! line based on the arguments stored in the parser.
     OBJECT(argparser), INTENT(inout) :: this
       !! An argparser object reference
     INTEGER, INTENT(out), OPTIONAL   :: optmw
       !! An optional integer with the maximum length of the option part of the usage command.
+      !! An optional integer with the maximum length of the option part of the usage command.
       !! This variable is intended to set a fancy indentation while printing option in the helper.
     CHARACTER(len=:), ALLOCATABLE :: usage, idts, copt,pgn
 …
           usage = usage(:)//TRIM(copt)
         ENDIF
       ENDIF
+      ENDIF
       this%usg = usage
     ELSE
 …
         optmw = omw
       ENDIF
     ENDIF
+    ENDIF
   END SUBROUTINE ap_format_usage
 …
     IF (ALLOCATED(other%descr)) this%descr = other%descr
     IF (ALLOCATED(other%eplg))  this%eplg  = other%eplg
+    IF (ALLOCATED(other%vers))  this%vers  = other%vers
 #else
     this%usg   = other%usg
     this%descr = other%descr
     this%eplg  = other%eplg
+    this%vers  = other%vers
 #endif
     this%mxhlpos = other%mxhlpos
 …
   FUNCTION ac_equals_arg(this,other) RESULT(ret)
     !! Check if two arguments are identical
     !! The method checks if two arguments are equal based on their name, short option flag and long
     !! option flag.Two arguments are considered equals if at least one of these three members is equal
+    !! The method checks if two arguments are equal based on their name, short option flag and long
+    !! option flag.Two arguments are considered equals if at least one of these three members is equal
     !! and not empty.
     TYPE(argc), INTENT(in) :: this
 …
     tlf=TRIM(this%lflag) ; olf=TRIM(other%lflag)
 #endif
     tn=LEN_TRIM(tna) ; on=LEN_TRIM(ona)
+    tn=LEN_TRIM(tna) ; on=LEN_TRIM(ona)
     tl=LEN_TRIM(tlf) ; ol=LEN_TRIM(olf)
     ts=LEN_TRIM(tsf) ; os=LEN_TRIM(osf)
+    ts=LEN_TRIM(tsf) ; os=LEN_TRIM(osf)
     ! check on name :
     ! Returns True if at least of name, sflag and lflag is set to non-empty
 …
     ret = ((tn/=0 .AND. on==tn) .AND. tna == ona) .OR. &
           ((tl/=0 .AND. ol==tl) .AND. tlf == olf) .OR. &
           ((ts/=0 .AND. os==ol) .AND. tsf == osf)
+          ((ts/=0 .AND. os==ol) .AND. tsf == osf)
     DEALLOCATE(tna,ona,tsf,osf,tlf,olf)
   END FUNCTION ac_equals_arg
 …
   FUNCTION ac_differs_arg(this,other) RESULT(ret)
     !! Check if two arguments are different
     !! The method checks if two arguments are different based on their names, short option flag
+    !! The method checks if two arguments are different based on their names, short option flag
     !! and long option flag.
     !! @note
+    !! @note
     !! This function is the extact contrary of [[argparse(module):ac_equals_arg(function)]] !
     TYPE(argc), INTENT(in) :: this
 …
   SUBROUTINE ac_clear_arg_sc(arg)
     !! argc destructor (scalar)
     !! The subroutine frees all memory used by an argc object and resets its member to
+    !! The subroutine frees all memory used by an argc object and resets its member to
     !! default values.
     TYPE(argc), INTENT(inout) :: arg
 …
       args(i)%lflag   = ""
 #endif
     ENDDO
+    ENDDO
   END SUBROUTINE ac_clear_arg_ve
 …
     TYPE(argc), INTENT(in) :: this
       !! An argc object
     INTEGER :: num
+    INTEGER :: num
       !! The number of values stored in the argument
     num = words_length(this%values)
 …
   FUNCTION ac_get_usg_opt_str(arg) RESULT(line)
     !! Build and format the option string for the usage part of the help message
     !! The function is private part of the help builder. It creates the
+    !! The function is private part of the help builder. It creates the
     !! option string part of a given argument.
     TYPE(argc), INTENT(in), TARGET :: arg
 …
   FUNCTION ac_get_opt_str(arg) RESULT(line)
     !! Build and format the option flag string for the option part of the help message
     !! The function is private part of the help builder. It creates the
+    !! The function is private part of the help builder. It creates the
     !! option string part of a given argument for the options part of the help.
     TYPE(argc), INTENT(in), TARGET :: arg
 …
     !! The function formats argparse specific errors when extra (missing) values
     !! are (not) set or when given values are not consistent with argument's type.
     !! For each of these errors, the basic error is updated with a more precise
     !! message.
+    !! For each of these errors, the basic error is updated with a more precise
+    !! message.
     TYPE(argc), INTENT(in) :: arg
       !! An argc object
 …
         IF (arg%nrec == -2) THEN
           msg = msg//' takes at least '//nv//' value(s))'
         ELSE
+        ELSE
           msg = msg//' takes exactly '//nv//' value(s))'
         ENDIF
       CASE (-18) ! extra values -> -18
         IF (arg%nrec == -3) THEN
+        IF (arg%nrec == -3) THEN
           msg = msg//' takes at most '//nv//' value(s))'
         ELSE
 …
   FUNCTION ac_check_and_set(this,sf,lf,ty,ac,de,na,meta,check_flag) RESULT(ret)
     !! Interface to all argc's member tests
     !! The function calls all the tests to perform on argc members. Some of these tests can
     !! alter argc's member values to fit argparser's requirements.
+    !! The function calls all the tests to perform on argc members. Some of these tests can
+    !! alter argc's member values to fit argparser's requirements.
     !!
     !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
+    !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
     !! produced by misuse of the function arguments. In such case, the program should be
     !! stopped: note that such ezrror should not occur in _released_ programs.
 …
       !! An optional vector of strings with the Meta-name of the values
     LOGICAL, INTENT(in), OPTIONAL                        :: check_flag
       !! An optional boolean flag hat instructs the method wether to check for option flag
       !! or not. By default this test is enabled but it should be disabled if one wants to
+      !! An optional boolean flag hat instructs the method wether to check for option flag
+      !! or not. By default this test is enabled but it should be disabled if one wants to
       !! check for POSITIONAL arguments as they do not have option flags.
     TYPE(error) :: ret
 …
   FUNCTION ac_check_ac_ty_de_na(this,ac,ty,de,na) RESULT(ret)
     !! Check and set argc's action, type and default value
     !! The method checks if input argument's options are valid and update the argc object
     !! consequently.
+    !! The method checks if input argument's options are valid and update the argc object
+    !! consequently.
     !!
     !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
+    !! On success, `noerror` is returned. Otherwise -9 error code is returned. Errors are only
     !! produced by misuse of the function arguments.
     TYPE(argc), INTENT(inout)  :: this
       !! An argc object to update
     INTEGER, INTENT(in)          :: ac
       !! An integer with the action to set and check
+      !! An integer with the action to set and check
     INTEGER, INTENT(in)          :: ty
       !! An integer with the type to set and check
     CHARACTER(len=*), INTENT(in) :: de
       !! A string with the default value to set and check
     CHARACTER(len=*), INTENT(in) :: na
+    CHARACTER(len=*), INTENT(in) :: na
       !! A string with the expected number of value to set and check
     TYPE(error) :: ret
 …
     ret = noerror
     eprf = 'argparse: '//"Invalid argument `"//TRIM(this%name)//"'"
     uty = error(eprf//" (type)",-9)
+    uty = error(eprf//" (type)",-9)
     ina = error(eprf//" (inconsistent nargs)",-9)
     zna = TRIM(na)
     ! Checks action
     IF(ANY(ap_actions == ac).OR.ac == ap_undef) THEN
       this%paction = ac
+      this%paction = ac
     ELSE
       ret = error(eprf//" (action)",-9) ; RETURN
+      ret = error(eprf//" (action)",-9) ; RETURN
     ENDIF
     ! Checks and sets type and default as a function of the action
     SELECT CASE(this%paction)
       ! HELP: fixed in any case:
+      ! HELP: fixed in any case:
       CASE(ap_help)
         this%default = 'F'
         this%ptype = ap_logical
         this%nrec = 0
+      ! VERSION: fixed in any case:
+      CASE(ap_version)
+        this%default = 'F'
+        this%ptype = ap_logical
+        this%nrec = 0
       ! COUNT:
+      ! we always use "hard-coded" stuff and do not warn if dev has made
+      ! mistakes...
+      ! we always use "hard-coded" stuff and do not warn if dev has made mistakes...
       CASE(ap_count)
         ! default settings of the count action
 …
         ret = set_def_val()
       ! STORE, APPEND actions
       CASE (ap_store, ap_append)
         ! set type
+      CASE (ap_store, ap_append)
+        ! set type
         IF (ty == ap_undef) THEN
           this%ptype= ap_integer
+          this%ptype= ap_integer
         ELSEIF (ANY(ap_types == ty)) THEN
           this%ptype = ty
 …
         ret = set_def_val() ; IF (ret /= 0) RETURN
         ! check for nargs (if na is empty then we set "*")
         ret = set_nrec("*")
+        ret = set_nrec("*")
       ! UNDEFINED:
       !   -> 1) set to action to store
 …
       CASE (ap_undef)
         ! 1) always define store action
         this%paction = ap_store
+        this%paction = ap_store
         ! 2) set type and nrec:
         !    2.1) If type is undef:
         !         - to default value type if default is given
         !         - ap_logical otherwiset type
+        !         - ap_logical otherwiset type
         !    2.2) set nrec
         !        - if final type is ap_logical set nrec to 0
 …
         If (ty == ap_undef) THEN
           ! no explicit type : define logical trigger first
           this%ptype = ap_logical ; this%nrec = 0
+          this%ptype = ap_logical ; this%nrec = 0
           ! icheck the default value given
           IF (LEN_TRIM(de) > 0) THEN
 …
           ENDIF
           IF (this%ptype == ap_logical) THEN
             ret = set_nrec("0")
+            ret = set_nrec("0")
           ELSE
             ret = set_nrec("1")
+            ret = set_nrec("1")
           ENDIF
           ret = set_def_val()
+          ret = set_def_val()
           IF (ret /= 0) RETURN
         ! type is given
 …
           ! known type given :
           !  check default value and nrec: -> if na not given set "*"
           this%ptype = ty
+          this%ptype = ty
           ret = set_def_val() ; IF (ret /= 0) RETURN
           IF (this%ptype == ap_logical) THEN
             ret = set_nrec("0")
+            ret = set_nrec("0")
           ELSE
             ret = set_nrec("1")
 …
         ELSE
           ! unknown type => bad end !
           ret = uty ; RETURN
+          ret = uty ; RETURN
         ENDIF
     END SELECT
+    END SELECT
     ! set default value as first value if ret is noerror ....
     IF (ret == 0) CALL words_append(this%values,this%default)
 …
         !! Check and set argument's expected number of records
         !! The method compares `na` value with the expected and known flags and decides
         !! wether to raise an error or defines nrec member of the argument object. If `na`
+        !! wether to raise an error or defines nrec member of the argument object. If `na`
         !! is empty then `base` is used.
         CHARACTER(len=1),INTENT(in) :: base
 …
             ! check numeric characters
             IF (VERIFY(zna,"0123456789")==0) READ(zna,*) this%nrec
             IF (this%nrec == 0) terr = ina
+            IF (this%nrec == 0) terr = ina
         END SELECT
       END FUNCTION set_nrec
 …
       FUNCTION set_def_val() RESULT(terr)
         !! Check and set argument's default value
         !! The method compares `de` value with the type already stored in the argument and
+        !! The method compares `de` value with the type already stored in the argument and
         !! decides wether to raise an error or to save `de` as argument's default value.
         !! If `de` is empty then it sets a default value according to argument's type.
 …
         terr = noerror
         IF (LEN_TRIM(de) /= 0) THEN
           this%default = de ; t = string_is(de)
+          this%default = de ; t = string_is(de)
           IF (t /= this%ptype) THEN
             terr = error(eprf//" (inconsistent default value: expected '"// &
 …
         ENDIF
         RETURN
       END FUNCTION set_def_val
+      END FUNCTION set_def_val
   END FUNCTION ac_check_ac_ty_de_na
 …
     CHARACTER(len=2), INTENT(in) :: sflag
       !! A 2-characters wide string with the short option flag
     CHARACTER(len=*), INTENT(in) :: lflag
+    CHARACTER(len=*), INTENT(in) :: lflag
       !! A string (at least 3 characters wide) with the long option flag
     TYPE(error) :: ret
 …
     !! Set meta-variable of the given argc object
     !! The method set meta-variable in the argc object. If no `meta` are given, the method
     !! uses argument's name to set the values.
+    !! uses argument's name to set the values.
     !! @warning
     !! To be effective, this subroutine must be called after argparse::chk_opt_nargs
 …
             j=j+1 ; IF (j>ms) j=1
             zmeta = to_upper(meta(j))
             blk=INDEX(TRIM(zmeta),CHAR(32))-1
+            blk=INDEX(TRIM(zmeta),CHAR(32))-1
             IF (blk <= 0) blk=LEN_TRIM(zmeta)
             CALL words_append(this%meta,zmeta(1:blk))
 …
   FUNCTION ac_check_value(this,str) RESULT(err)
     !! Check if given string is a valid value for the argument
     TYPE(argc), INTENT(in)       :: this
+    TYPE(argc), INTENT(in)       :: this
       !! An argc object reference
     CHARACTER(len=*), INTENT(in) :: str
 …
   FUNCTION ap_get_positional_sc(this,idx,value) RESULT(ret)
     !! Get positional arguments value at given index
     !! @warning
+    !! @warning
     !! On error, the status of `value` is undefined.
     OBJECT(argparser), INTENT(in)              :: this
 …
       !! Subscript of the positional argument value to get
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: value
       !! Output raw value of the positional. If `idx` is out of range, `value` is set to an
+      !! Output raw value of the positional. If `idx` is out of range, `value` is set to an
       !! empty string.
     TYPE(error) :: ret
 …
   FUNCTION ap_get_positional_ve(this,values) RESULT(ret)
     !! Get all positional arguments value
     !! @warning
+    !! @warning
     !! On error, the status of `values` is undefined.
     OBJECT(argparser), INTENT(in)                                  :: this
       !! An argparser object reference
     CHARACTER(len=st_slen), INTENT(out), ALLOCATABLE, DIMENSION(:) :: values
       !! An allocatable vector of **assumed length** strings with the value(s) of all
       !! positionals arguments found.
+      !! An allocatable vector of **assumed length** strings with the value(s) of all
+      !! positionals arguments found.
     TYPE(error) :: ret
       !! Error object with the first error encountered in the process
 …
   !> Gets a scalar @p REAL(kind=8) value from given argument
   !! @param[in,out] this An argc object
+  !! @param[in,out] this An argc object
   !! @param[out] output A scalar with the first value of the argument
   !! @return An errors::error object with -21 if the destination variable's type
 …
   FUNCTION ac_get_dv_sc(this, output) RESULT(ret)
     !! Get a scalar `REAL(kind=8)` value from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` value is undefined.
 …
   FUNCTION ac_get_rv_sc(this, output) RESULT(ret)
     !! Get a scalar `REAL(kind=4)` value from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` value is undefined.
 …
   FUNCTION ac_get_iv_sc(this, output) RESULT(ret)
     !! Get a scalar `INTEGER` value from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` value is undefined.
 …
   FUNCTION ac_get_lv_sc(this, output) RESULT(ret)
     !! Get a scalar `INTEGER` value from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` value is undefined.
 …
   FUNCTION ac_get_cv_sc(this, output) RESULT(ret)
     !! Get a scalar `COMPLEX` value from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` value is undefined.
 …
   FUNCTION ac_get_sv_sc(this, output) RESULT(ret)
     !! Get a scalar `STRING` value from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION ac_get_dv_ve(this, output) RESULT(ret)
     !! Get a vector of `REAL(kind=8)` values from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION ac_get_rv_ve(this, output) RESULT(ret)
     !! Get a vector of `REAL(kind=4)` values from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION ac_get_iv_ve(this, output) RESULT(ret)
     !! Get a vector of `INTEGER` values from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION ac_get_lv_ve(this, output) RESULT(ret)
     !! Get a vector of `LOGICAL` values from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION ac_get_cv_ve(this, output) RESULT(ret)
     !! Get a vector of `COMPLEX` values from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION ac_get_sv_ve(this, output) RESULT(ret)
     !! Get a vector of `STRING` values from given argument
     !! If no error occured, the function always returns at least a value (whatever the parser's
+    !! If no error occured, the function always returns at least a value (whatever the parser's
     !! state is) which is the default value if no specific values are set in the argument.
     !! Otherwise, `output` status is undefined.
 …
   FUNCTION apa2str(ap_a) RESULT(str)
     !! Get the string representation of argparse actions constants
+    !! Get the string representation of argparse actions constants
     INTEGER, INTENT(in) :: ap_a
      !! One of ap_store, ap_append,cap_count or ap_help module constants
 …
       CASE(ap_count)  ; str = 'count'
       CASE(ap_help)   ; str = 'help'
+      CASE(ap_version); str = 'version'
       CASE DEFAULT    ; str = 'unknown'
     END SELECT

trunk/LMDZ.TITAN/libf/muphytitan/asciiread.f90

-                      r1897
+                      r3083
+! Copyright Jérémie Burgalat (2010-2015,2017)
+!
+! jeremie.burgalat@univ-reims.fr
+!
+! This software is a computer program whose purpose is to provide configuration
+! file and command line arguments parsing features to Fortran programs.
+!
+! This software is governed by the CeCILL-B license under French law and
+! abiding by the rules of distribution of free software.  You can  use,
+! modify and/ or redistribute the software under the terms of the CeCILL-B
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and  rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty  and the software's author,  the holder of the
+! economic rights,  and the successive licensors  have only  limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading,  using,  modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean  that it is complicated to manipulate,  and  that  also
+! therefore means  that it is reserved for developers  and  experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The fact that you are presently reading this means that you have had
+! knowledge of the CeCILL-B license and that you accept its terms.
+! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+!
+! This file is part of SWIFT
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy of
+! this software and associated documentation files (the "Software"), to deal in
+! the Software without restriction, including without limitation the rights to
+! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+! the Software, and to permit persons to whom the Software is furnished to do so,
+! subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in all
+! copies or substantial portions of the Software.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 !! file: asciiread.f90
 !! summary: ASCII data file reader source file
 !! author: burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 MODULE ASCIIREAD
   !! ASCII data file reader module
 …
   !! data array from ASCII file.
   !!
   !! ```
+  !! ```
   !! FUNCTION read_data(path,data) RESULT(err)
   !! ```
 …
   !!   - must use blank space(s) as value delimiter.
   !!   - must have a regular number of columns, that is each data line must
   !!     have the same number of columns.
+  !!     have the same number of columns.
   !!   - can contains any number of empty lines and/or comment line (i.e. line
   !!     where first non-blank character is "#"). All other lines are assumed
   !!     to be data.
   !! Moreover, in the case of 3D data, it must use a SINGLE empty line for "depth" block separator.
+  !! Moreover, in the case of 3D data, it must use a SINGLE empty line for "depth" block separator.
   !!
   !! Error occured when:
 …
   !! of _R_ lines with _C_ columns. Each block must be separated by a single empty line
   !! and each columns must separated by one or more blank spaces (no tabulation ALLOWED).
   !!
+  !!
   !! On success, the shape of the 3D output array will be _data(R,C,D)_.
   USE, INTRINSIC :: ISO_FORTRAN_ENV, ONLY: IOSTAT_END, IOSTAT_EOR
 …
   END INTERFACE
   CONTAINS
+  CONTAINS
 …
     !!
     !! The function reads an ASCII file and saves its values in a real(kind=8) 3D-array.
     !!
+    !!
     !! The input file:
     !!
     !! - must have a regular number of columns, that is each data line must have the same number
     !!   of columns (according to the delimiter used).
+    !!   of columns (according to the delimiter used).
     !! - must use a SINGLE empty line for "depth" block separator.
     !! - can contains any number of comment lines (i.e. line where first non-blank character is "#").
     !!   All other lines (except empty lines) are assumed to be data.
     !!
+    !!
     !! Error occured when:
     !!    - Path does not refer to a existing file (-11)
 …
     !! with _C_ columns. Each block must be separated by a single empty line and
     !! each columns must separated by one or more blank spaces (no tabulation ALLOWED).
     !!
+    !!
     !! On success, the shape of the 3D output array will be _output(R,C,D)_.
     !! On error, the 3D output array is __not allocated__.
     CHARACTER(len=*), INTENT(in)                             :: path      !! Path of the input data file
+    CHARACTER(len=*), INTENT(in)                             :: path      !! Path of the input data file
     REAL(kind=8), INTENT(out), DIMENSION(:,:,:), ALLOCATABLE :: data3d    !! 3D-array with the output values (double precision)
     CHARACTER(len=*), INTENT(in), OPTIONAL                   :: delimiter !! Optional column delimiter(s)
 …
       err = error(trim(path)//": no such file",-1) ; RETURN
     ENDIF
     lu = free_lun()
+    lu = free_lun()
     IF (lu == -1) THEN ; err = error("Cannot find available logical unit...",-1) ; RETURN ; ENDIF
     ! Open file
     OPEN(lu,FILE=TRIM(path),STATUS='OLD',ACTION='READ')
     ! First pass :
+    ! First pass :
     ! ------------
     !   - get size (rows, columns, depth)
+    !   - get size (rows, columns, depth)
     !   - check size consistendcy
     !   - check value type
     lc = 0 ; tlc = 0
     ndr = -1 ; ndc = -1 ; ndd = 1
     DO WHILE(readline(lu,line))
+    lc = 0 ; tlc = 0
+    ndr = -1 ; ndc = -1 ; ndd = 1
+    DO WHILE(readline(lu,line))
       lm1 = line
       ! Read the line
 …
       ! skip comment line
       IF (INDEX(TRIM(ADJUSTL(line)),"#") == 1) CYCLE
       ! An empty line: new 2D block
+      ! An empty line: new 2D block
       IF (LEN_TRIM(line) == 0) THEN
         ndd = ndd + 1
 …
       tlc = tlc + 1
       ! Splits line in words
       IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN
+      IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN
         ! cannot tokenize
         err = error(trim(path)//": Cannot parse line "//TRIM(slc),-5)
 …
         err = error(trim(path)//": Cannot cast values at line "//TRIM(slc),-5)
         RETURN
       ELSEIF (ndc > 0 .AND. ndc /= SIZE(wrds)) THEN
+      ELSEIF (ndc > 0 .AND. ndc /= SIZE(wrds)) THEN
         ! current number of columns not equal to last one
         err = error(trim(path)//": Invalid number of columns (line "//TRIM(slc)//")",-5)
 …
     ! Allocate memory
     ALLOCATE(data3d(ndr,ndc,ndd))
     ir = 0 ; kd = 1 ;
     DO WHILE(readline(lu,line))
+    ir = 0 ; kd = 1 ;
+    DO WHILE(readline(lu,line))
       IF (INDEX(TRIM(ADJUSTL(line)),"#") == 1) CYCLE
       ir = ir + 1
       ! empty line update block subscripts
+      ! empty line update block subscripts
       IF (LEN_TRIM(line) == 0) THEN
         kd = kd + 1 ; ir = 0 ; CYCLE
 …
     !!
     !! The function reads an ASCII file and saves its values in a real(kind=8) 2D-array.
     !!
+    !!
     !! The input file:
     !!
     !! - can contains any number of empty lines and/or comment line (i.e. line where first
+    !! - can contains any number of empty lines and/or comment line (i.e. line where first
     !!   non-blank character is "#"). All other lines are assumed to be data.
     !! - must have a regular number of columns, that is each data line must have the same
     !!   number of columns.
+    !! - must have a regular number of columns, that is each data line must have the same
+    !!   number of columns.
     !! - must use blank space(s) as value delimiter.
     !!
+    !!
     !! Error occured when:
     !!
 …
     !! On error, the 2D output array is __not allocated__.
     USE FSYSTEM
     CHARACTER(len=*), INTENT(in)                           :: path      !! Path of the input data file
+    CHARACTER(len=*), INTENT(in)                           :: path      !! Path of the input data file
     REAL(kind=8), INTENT(out), DIMENSION(:,:), ALLOCATABLE :: data2d    !! 2D-array with the output values (double precision)
     CHARACTER(len=*), INTENT(in), OPTIONAL                 :: delimiter !! Optional column delimiter(s)
 …
       err = error(trim(path)//": no such file",-1) ; RETURN
     ENDIF
     lu = free_lun()
+    lu = free_lun()
     IF (lu == -1) THEN ; err = error("Cannot find available logical unit...",-1) ; RETURN ; ENDIF
     OPEN(lu,FILE=TRIM(path),STATUS='OLD',ACTION='READ')
 …
     lc=0 ; vc = 0 ; nc=-1
     ! First pass : get number of row values and checks everything !
     DO
+    DO
       ! Read the line
       IF (.NOT.readline(lu,line)) EXIT
 …
       ! update row counter
       vc = vc + 1
       IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN
+      IF (.NOT.tokenize(line,wrds,zdelim,.true.)) THEN
         ! cannot tokenize
         err = error(trim(path)//": Cannot parse line "//TRIM(slc),-5)
 …
         err = error(trim(path)//": Cannot cast values at line "//TRIM(slc),-5)
         RETURN
       ELSEIF (nc > 0 .AND. nc /= SIZE(tmp)) THEN
+      ELSEIF (nc > 0 .AND. nc /= SIZE(tmp)) THEN
         ! current number of columns not equal to last one
         err = error(trim(path)//": Invalid number of columns (line "//TRIM(slc)//")",-5)
 …
     ALLOCATE(data2d(nl,nc))
     ! Second pass : saves values :)
     vc = 0
+    vc = 0
     DO WHILE(vc <= nl)
       ! Reads the line
 …
   FUNCTION readline(lun,line) RESULT(not_eof)
     !! Read a complete line
     !!
     !! Each time, it is called, the function reads a complete of the file opened in __lun__
+    !!
+    !! Each time, it is called, the function reads a complete of the file opened in __lun__
     !! logical unit and returns .false. if EOF has been reached, .true. otherwise.
     !!
 …
     !! CLOSE(1)
     !! ```
     INTEGER, INTENT(in)                        :: lun  !! Logical unit with the opened file to read.
     CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: line !! Processed line
+    INTEGER, INTENT(in)                        :: lun  !! Logical unit with the opened file to read.
+    CHARACTER(len=:), ALLOCATABLE, INTENT(out) :: line !! Processed line
     LOGICAL  :: not_eof                                !! .true. if EOF has NOT been reached yet, .false. otherwise
     CHARACTER(len=50) :: buf

trunk/LMDZ.TITAN/libf/muphytitan/cfgparse.F90

-                      r1897
+                      r3083
 ! Copyright Jérémie Burgalat (2010-2015,2017)
+! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+!
 ! jeremie.burgalat@univ-reims.fr
+! This file is part of SWIFT
+!
+! This software is a computer program whose purpose is to provide configuration
+! file and command line arguments parsing features to Fortran programs.
+! Permission is hereby granted, free of charge, to any person obtaining a copy of
+! this software and associated documentation files (the "Software"), to deal in
+! the Software without restriction, including without limitation the rights to
+! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+! the Software, and to permit persons to whom the Software is furnished to do so,
+! subject to the following conditions:
+!
+! This software is governed by the CeCILL-B license under French law and
+! abiding by the rules of distribution of free software.  You can  use,
+! modify and/ or redistribute the software under the terms of the CeCILL-B
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+! The above copyright notice and this permission notice shall be included in all
+! copies or substantial portions of the Software.
+!
+! As a counterpart to the access to the source code and  rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty  and the software's author,  the holder of the
+! economic rights,  and the successive licensors  have only  limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading,  using,  modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean  that it is complicated to manipulate,  and  that  also
+! therefore means  that it is reserved for developers  and  experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The fact that you are presently reading this means that you have had
+! knowledge of the CeCILL-B license and that you accept its terms.
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 !! file: cfgparse.F90
 !! summary: Configuration file parser source file.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 #include "defined.h"
 …
     oname = zsname//"/"//zpname
     IF (PRESENT(sname)) sname = zsname
     IF (PRESENT(pname)) pname = zpname
+    IF (PRESENT(pname)) pname = zpname
   END FUNCTION op_format
 …
     !!
     !! Otherwise it is assumed to be the basename of the option.
     !!
+    !!
     !! A valid option (base) name is an alphanumeric sequence in lower-case that always begin by
     !! a letter.
 …
     IF(.NOT.ALLOCATED(this%options)) RETURN
     IF (.NOT.PRESENT(section)) THEN
       num = SIZE(this%options)
+      num = SIZE(this%options)
     ELSE
       DO i=1, SIZE(this%options)

trunk/LMDZ.TITAN/libf/muphytitan/csystem.c

-                      r1897
+                      r3083
+/* Copyright Jérémie Burgalat (2010-2015,2017)
+ *
+ * jeremie.burgalat@univ-reims.fr
+ *
+ * This software is a computer program whose purpose is to provide configuration
+ * file and command line arguments parsing features to Fortran programs.
+ *
+ * This software is governed by the CeCILL-B license under French law and
+ * abiding by the rules of distribution of free software.  You can  use,
+ * modify and/ or redistribute the software under the terms of the CeCILL-B
+ * license as circulated by CEA, CNRS and INRIA at the following URL
+ * "http://www.cecill.info".
+ *
+ * As a counterpart to the access to the source code and  rights to copy,
+ * modify and redistribute granted by the license, users are provided only
+ * with a limited warranty  and the software's author,  the holder of the
+ * economic rights,  and the successive licensors  have only  limited
+ * liability.
+ *
+ * In this respect, the user's attention is drawn to the risks associated
+ * with loading,  using,  modifying and/or developing or reproducing the
+ * software by the user in light of its specific status of free software,
+ * that may mean  that it is complicated to manipulate,  and  that  also
+ * therefore means  that it is reserved for developers  and  experienced
+ * professionals having in-depth computer knowledge. Users are therefore
+ * encouraged to load and test the software's suitability as regards their
+ * requirements in conditions enabling the security of their systems and/or
+ * data to be ensured and,  more generally, to use and operate it in the
+ * same conditions as regards security.
+ *
+ * The fact that you are presently reading this means that you have had
+ * knowledge of the CeCILL-B license and that you accept its terms.
+/*
+ * Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+ *
+ * This file is part of SWIFT
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a copy of
+ * this software and associated documentation files (the "Software"), to deal in
+ * the Software without restriction, including without limitation the rights to
+ * use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+ * the Software, and to permit persons to whom the Software is furnished to do so,
+ * subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in all
+ * copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+ * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+ * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+ * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  */
 …
     free(tmp);
     tmp = NULL;
+  }
+  }
   return tmp;
+}
 /* Get the realpath of input path and saves it in output path */
+/* Get the realpath of input path and saves it in output path */
 char* c_realpath(const char *input){
   if (!strlen(input)) {
 …
         continue;
+      }
       len = path_len + strlen(p->d_name) + 2;
+      len = path_len + strlen(p->d_name) + 2;
       buf = malloc(len);
       if (buf) {
 …
   if (!r) {
     r = rmdir(path);
         return r?errno:0;
+  return r?errno:0;
+  }
   return r;
 …
 /* Get some file informations */
 int c_fstat(const char *p, int *pe, int *nl, int *ty, int *ui, int *gi,
+int c_fstat(const char *p, int *pe, int *nl, int *ty, int *ui, int *gi,
             long *si, char a[20], char m[20], char c[20]){
   struct stat stb;
 …
     else *ty = 4;
     *ui = (int)stb.st_uid ; *gi = (int)stb.st_gid ; *si = (long)stb.st_size ;
     t = localtime(&stb.st_atime) ; ret = strftime(tmp, 20, "%F,%T", t);
+    t = localtime(&stb.st_atime) ; ret = strftime(tmp, 20, "%F,%T", t);
     if(ret != 0) {strncpy(a,tmp,20); a[19] = '\0';}else{a[0] = '\0';}
     t = localtime(&stb.st_mtime) ; ret = strftime(tmp, 20, "%F,%T", t);
 …
     if (forced){
       p = strdup(path) ; if(p == NULL) {return errno;}
       d = dirname(p) ; free(p) ;
+      d = dirname(p) ; free(p) ;
       if(d == NULL) {return -9;}
       // we attempts to create parent directory first
 …
       perm =((S_IRWXU | S_IRWXG | S_IRWXO) & ~(cmask & ~(S_IWUSR | S_IXUSR)));
       (void)umask(cmask) ;
       eval = c_mkdirp(d,perm);
+      eval = c_mkdirp(d,perm);
       if(eval){return eval;}
+    }
     eval = open(path,O_CREAT|O_EXCL,mode);
     if (eval == -1) {eval=errno;}else{close(eval);eval=0;}
+  }
+  }
   return eval ;
+}
 …
  *  Copyright (c) 1983, 1992, 1993
  *   The Regents of the University of California.  All rights reserved.
+ *
+ *
  *  Redistribution and use in source and binary forms, with or without
  *  modification, are permitted provided that the following conditions
 …
  *     may be used to endorse or promote products derived from this software
  *     without specific prior written permission.
+ *
+ *
  *  THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  *  ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 …
         retval = 1; break;
+      }
+    }
+    }
     if (!last) *p = '/';
+  }
 …
+ *
  * @APPLE_LICENSE_HEADER_START@
+ *
+ *
  * "Portions Copyright (c) 1999 Apple Computer, Inc.  All Rights
  * Reserved.  This file contains Original Code and/or Modifications of
 …
  * License at http://www.apple.com/publicsource and read it before using
  * this file.
+ *
+ *
  * The Original Code and all software distributed under the License are
  * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER
 …
  * License for the specific language governing rights and limitations
  * under the License."
+ *
+ *
  * @APPLE_LICENSE_HEADER_END@
+ *
 …
   buf = NULL;
   if (realpath(reldir,start_path) == NULL)
+  if (realpath(reldir,start_path) == NULL)
     return buf;
   if (realpath(path,end_path) == NULL)
+  if (realpath(path,end_path) == NULL)
     return buf;
   // stat the starting path
   if (stat(start_path, &st) < 0)
+  if (stat(start_path, &st) < 0)
     return buf;
   if ((st.st_mode & S_IFMT) != S_IFDIR) {
     errno = ENOTDIR;
     return buf;
+  }
+  }
   if (start_path[strlen(start_path) - 1] != '/')
     strcat(start_path, "/");
   // stat the ending path path
   if (stat(end_path, &st) < 0)
+  if (stat(end_path, &st) < 0)
     return buf;
   if ((st.st_mode & S_IFMT) == S_IFDIR
       && end_path[strlen(end_path) - 1] != '/')
 …
 #elif defined(__APPLE__) && defined(__MACH__)
     /* OSX ------------------------------------------------------ */
     struct mach_task_basic_info info;
     mach_msg_type_number_t infoCount = MACH_TASK_BASIC_INFO_COUNT;
     if (task_info(mach_task_self(), MACH_TASK_BASIC_INFO, (task_info_t)&info, &infoCount) != KERN_SUCCESS)
+    struct task_basic_info info;
+    mach_msg_type_number_t infoCount = TASK_BASIC_INFO_COUNT;
+    if (task_info(mach_task_self(), TASK_BASIC_INFO, (task_info_t)&info, &infoCount) != KERN_SUCCESS)
         return (size_t)0L; /* Can't access? */
     return (size_t)info.resident_size;
 …
 /* Get some informatiosn about the OS memory usage (from /proc/meminfo) */
 int c_getSystemMemory(long long int *m_total,long long int *m_available,long long int *m_free){
 …
     if (m_available) (*m_free) = mem2;
     if (m_free) (*m_free) = mem3;
     if ((fp = fopen("/proc/meminfo", "r")) == NULL)
+    if ((fp = fopen("/proc/meminfo", "r")) == NULL)
         return 1;
     while (fgets(buf, sizeof(buf), fp) != NULL){
+        ts = strlen(buf) - 1; buf[ts] = '\0';
+        tmp = strndup(&buf[0],ts);
+        ts = strlen(buf) - 1; buf[ts] = '\0';
+        tmp = strdup(&buf[0]);
+        //tmp = strndup(&buf[0],ts); // GNU extension
         // check our 3 cases
         if (ts >= 9 && !strncmp(tmp,"MemTotal:",9)){
 …
+        }
         if (ts >= 13 && !strncmp(tmp,"MemAvailable:",13)){
             p=strtok(tmp, " "); p=strtok(NULL, " ");
+            p=strtok(tmp, " "); p=strtok(NULL, " ");
             mem2 = strtoll(p,NULL,10);
+        }
+        }
         if (ts >= 8 && !strncmp(tmp,"MemFree:",8)){
             p=strtok(tmp, " "); p=strtok(NULL, " ");
+            p=strtok(tmp, " "); p=strtok(NULL, " ");
             mem3 = strtoll(p,NULL,10);
+        }

trunk/LMDZ.TITAN/libf/muphytitan/csystem.h

-                      r1897
+                      r3083
+/* Copyright Jérémie Burgalat (2010-2015,2017)
+ *
+ * jeremie.burgalat@univ-reims.fr
+ *
+ * This software is a computer program whose purpose is to provide configuration
+ * file and command line arguments parsing features to Fortran programs.
+ *
+ * This software is governed by the CeCILL-B license under French law and
+ * abiding by the rules of distribution of free software.  You can  use,
+ * modify and/ or redistribute the software under the terms of the CeCILL-B
+ * license as circulated by CEA, CNRS and INRIA at the following URL
+ * "http://www.cecill.info".
+ *
+ * As a counterpart to the access to the source code and  rights to copy,
+ * modify and redistribute granted by the license, users are provided only
+ * with a limited warranty  and the software's author,  the holder of the
+ * economic rights,  and the successive licensors  have only  limited
+ * liability.
+ *
+ * In this respect, the user's attention is drawn to the risks associated
+ * with loading,  using,  modifying and/or developing or reproducing the
+ * software by the user in light of its specific status of free software,
+ * that may mean  that it is complicated to manipulate,  and  that  also
+ * therefore means  that it is reserved for developers  and  experienced
+ * professionals having in-depth computer knowledge. Users are therefore
+ * encouraged to load and test the software's suitability as regards their
+ * requirements in conditions enabling the security of their systems and/or
+ * data to be ensured and,  more generally, to use and operate it in the
+ * same conditions as regards security.
+ *
+ * The fact that you are presently reading this means that you have had
+ * knowledge of the CeCILL-B license and that you accept its terms.
+/*
+ * Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+ *
+ * This file is part of SWIFT
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a copy of
+ * this software and associated documentation files (the "Software"), to deal in
+ * the Software without restriction, including without limitation the rights to
+ * use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+ * the Software, and to permit persons to whom the Software is furnished to do so,
+ * subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in all
+ * copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+ * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+ * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+ * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  */
 …
 int c_umask();
 /**
  * Get directory name of input path
+/**
+ * Get directory name of input path
  * @param[in] in A C string with the input path
  * @return A pointer to a char array with the directory name of @bti{input} path.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 char * c_dirname(const char *in);
 /**
  * Get base name of input path
+/**
+ * Get base name of input path
  * @param[in] in A C string with the input path
  * @return A pointer to a char array with the base name of @bti{input} path.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 char* c_basename(const char *in);
 /**
+/**
  * Get the current working directory.
  * @return A pointer to a char array with the current workind directory.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 …
 /**
+/**
  * Get the realpath of input path.
  * @param[in] input A C string with the input path
  * @return A pointer to a char array with the realpath of @bti{input} path.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 …
  * @return A pointer to a char array with the relative path.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 …
  * @return A pointer to a char array with the user name.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 …
  * @return A pointer to a char array with the group name.
  * @note On error, a NULL pointer is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 …
 int c_get_errno();
 /**
+/**
  * Get the error message of the given error id
  * @param err An integer with the error id
  * @return A pointer to a char array with the group name.
  * @note On error, the hard-coded message "Unknown error" is returned.
  * @warning In any case, the returned pointer must be freed in the Fortran counterpart
+ * @warning In any case, the returned pointer must be freed in the Fortran counterpart
  * (using fsystem::free_c).
  */
 …
  * @return An integer with 0 on success, last errno on failure
  */
 int c_mkdirp(const char *path, mode_t mode);
+int c_mkdirp(const char *path, mode_t mode);
 /**
 …
 /**
  * Change path permissions
  * @param path A string with the path
+ * @param path A string with the path
  * @param mode A integer with the new permissions to set
  * @return An integer with 0 on success, last errno on failure
 …
  *                 (as well as all the parent directorie created, if any).
  * @return An integer with 0 on success, last errno on failure
  */
+ */
 int c_mkdir(const char *path, mode_t mode);
 …
  * Remove a directory and its contents recursively
+ *
  * This method mimics 'rm -rf' command.
+ * This method mimics 'rm -rf' command.
  * @param path A C string with the path of the directory to remove.
  * @return An integer with 0 on success, last errno on failure
 …
 /**
  * Get some file informations
  * @note If the path cannot be "stat", most of the output parameters are set
+ * @note If the path cannot be "stat", most of the output parameters are set
  * to -1.
  * @param[in] p A C string with the path of a file (or directory)
  * @param[out] pe An int with the permissions of the path
+ * @param[out] pe An int with the permissions of the path
  * @param[out] nl An int with the inumber of links
  * @param[out] ty An int with the type of the file :
 …
  *    - 3 -> link to a directory
  *    - 4 -> Other (fifo, socket, block special, char special ...)
  * @param[out] ui An int with the user id of the path
  * @param[out] gi An int with the group id of the path
  * @param[out] si An int with the size of the path
+ * @param[out] ui An int with the user id of the path
+ * @param[out] gi An int with the group id of the path
+ * @param[out] si An int with the size of the path
  * @param[out] a A C string (20 chars wide, including NULL character) with the
  * last access date
  * @param[out] m A C string (20 chars wide, including NULL character) with the
  * last modification date
  * @param[out] c A C string (20 chars wide, including NULL character) with the
+ * @param[out] c A C string (20 chars wide, including NULL character) with the
  * creation date
  * @return An integer with 0 on success, last errno on failure
  */
 int c_fstat(const char *p, int *pe, int *nl, int *ty, int *ui, int *gi,
+ * @return An integer with 0 on success, last errno on failure
+ */
+int c_fstat(const char *p, int *pe, int *nl, int *ty, int *ui, int *gi,
             long *si, char a[20], char m[20], char c[20]);
 …
  * @param[in] perm An integer with the user's permission to check :
  *   - 0 do not check for permissions
  *   - 1 check for execute permission
+ *   - 1 check for execute permission
  *   - 2 check for write permission
  *   - 4 check for read permission
 …
  * @param[out] rows Number of rows of the current terminal window
  * @param[out] cols Number of columns of the current terminal window
  * @return An int with 0 on success, errno on failure. On failure, rows is set
+ * @return An int with 0 on success, errno on failure. On failure, rows is set
  * to 80 and cols to 20.
  */

trunk/LMDZ.TITAN/libf/muphytitan/defined.h

-                      r1897
+                      r3083
+/* Copyright Jérémie Burgalat (2010-2015,2017)
+ *
+ * jeremie.burgalat@univ-reims.fr
+ *
+ * This software is a computer program whose purpose is to provide configuration
+ * file and command line arguments parsing features to Fortran programs.
+ *
+ * This software is governed by the CeCILL-B license under French law and
+ * abiding by the rules of distribution of free software.  You can  use,
+ * modify and/ or redistribute the software under the terms of the CeCILL-B
+ * license as circulated by CEA, CNRS and INRIA at the following URL
+ * "http://www.cecill.info".
+ *
+ * As a counterpart to the access to the source code and  rights to copy,
+ * modify and redistribute granted by the license, users are provided only
+ * with a limited warranty  and the software's author,  the holder of the
+ * economic rights,  and the successive licensors  have only  limited
+ * liability.
+ *
+ * In this respect, the user's attention is drawn to the risks associated
+ * with loading,  using,  modifying and/or developing or reproducing the
+ * software by the user in light of its specific status of free software,
+ * that may mean  that it is complicated to manipulate,  and  that  also
+ * therefore means  that it is reserved for developers  and  experienced
+ * professionals having in-depth computer knowledge. Users are therefore
+ * encouraged to load and test the software's suitability as regards their
+ * requirements in conditions enabling the security of their systems and/or
+ * data to be ensured and,  more generally, to use and operate it in the
+ * same conditions as regards security.
+ *
+ * The fact that you are presently reading this means that you have had
+ * knowledge of the CeCILL-B license and that you accept its terms.
+/*
+ * Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+ *
+ * This file is part of SWIFT
+ *
+ * Permission is hereby granted, free of charge, to any person obtaining a copy of
+ * this software and associated documentation files (the "Software"), to deal in
+ * the Software without restriction, including without limitation the rights to
+ * use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+ * the Software, and to permit persons to whom the Software is furnished to do so,
+ * subject to the following conditions:
+ *
+ * The above copyright notice and this permission notice shall be included in all
+ * copies or substantial portions of the Software.
+ *
+ * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+ * FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+ * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+ * IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+ * CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
  */
  /**
+ /**
   * @file defined.h
   * @brief CPP macro definitions files
   * @details This header defines few CPP symbols and macros that are used
+  * @details This header defines few CPP symbols and macros that are used
   * in the library source code.
   */
 …
+ *
  *  This macro definition depends on compiler's support for Bounded procedures
  *  in derived type (more precisely, Fortran 2003 PROCEDURE keyword support):
+ *  in derived type (more precisely, Fortran 2003 PROCEDURE keyword support):
  *    - If it actually supports this feature, the macro defines derived type
  *      declaration as dummy argument of subroutine/function using CLASS keyword.

trunk/LMDZ.TITAN/libf/muphytitan/errors.F90

-                      r1897
+                      r3083
+! Copyright Jérémie Burgalat (2010-2015,2017)
+!
+! jeremie.burgalat@univ-reims.fr
+!
+! This software is a computer program whose purpose is to provide configuration
+! file and command line arguments parsing features to Fortran programs.
+!
+! This software is governed by the CeCILL-B license under French law and
+! abiding by the rules of distribution of free software.  You can  use,
+! modify and/ or redistribute the software under the terms of the CeCILL-B
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and  rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty  and the software's author,  the holder of the
+! economic rights,  and the successive licensors  have only  limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading,  using,  modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean  that it is complicated to manipulate,  and  that  also
+! therefore means  that it is reserved for developers  and  experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The fact that you are presently reading this means that you have had
+! knowledge of the CeCILL-B license and that you accept its terms.
+! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+!
+! This file is part of SWIFT
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy of
+! this software and associated documentation files (the "Software"), to deal in
+! the Software without restriction, including without limitation the rights to
+! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+! the Software, and to permit persons to whom the Software is furnished to do so,
+! subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in all
+! copies or substantial portions of the Software.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 !! file: errors.F90
 !! summary: Errors handling source file.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 #include "defined.h"
 …
     !! Define an error
     !!
     !! The following derived type represents in the simplest way (I believe) an error which
+    !! The following derived type represents in the simplest way (I believe) an error which
     !! stores:
     !!
     !! - An integer to numerically identify the error
     !! - A string (250 chars max) with an appropriate error message
     !! - A bounded procedure to get a string representation of the error (if bounded
+    !! - A bounded procedure to get a string representation of the error (if bounded
     !!   procedures are supported by the library).
     !! - internal subroutines for derived type IO WRITE statement (if Derived IO
+    !! - internal subroutines for derived type IO WRITE statement (if Derived IO
     !!   subroutines are supported by the library).
     !!
 …
     INTEGER :: id = 0
       !! Numerical identifier of the error
       !! @note
       !! The error identifier is used to test the equality/inequality of two error objects.
+      !! @note
+      !! The error identifier is used to test the equality/inequality of two error objects.
 #if HAVE_FTNPROC
     CONTAINS
 …
   END TYPE error
   INTERFACE
+  INTERFACE
     !! Clean subroutine interface
     SUBROUTINE clean_callback(err)
 …
       IMPLICIT NONE
       TYPE(error), INTENT(in) :: err
         !! An error object with the input error
+        !! An error object with the input error
     END SUBROUTINE clean_callback
   END INTERFACE
   INTERFACE
+  INTERFACE
     subroutine abort_() bind(C, name="abort")
     end subroutine
 …
   END INTERFACE assert
   !> error equality operator
+  !> error equality operator
   INTERFACE OPERATOR(==)
     MODULE PROCEDURE error_equals, error_equals_int
   END INTERFACE
   !> error inequality operator
+  !> error inequality operator
   INTERFACE OPERATOR(/=)
     MODULE PROCEDURE error_differs, error_differs_int
 …
   FUNCTION error_equals(this, other) RESULT(res)
     !! Check if two error objects are equivalent
     TYPE(error), INTENT(in) :: this, & !! The first error object to compare
                                other   !! The second error object to compare
+    TYPE(error), INTENT(in) :: this, & !! The first error object to compare
+                               other   !! The second error object to compare
     LOGICAL :: res                     !! .true. if __this__ and __other__ identifiers are the same, .false. otherwise
     res = (this%id == other%id)
 …
   FUNCTION error_differs(this, other) RESULT(res)
     !! Check if two error objects are different
     TYPE(error), INTENT(in) :: this, & !! The first error object to compare
                                other   !! The second error object to compare
+    TYPE(error), INTENT(in) :: this, & !! The first error object to compare
+                               other   !! The second error object to compare
     LOGICAL :: res                     !! .false. if __this__ and __other__ identifiers are the same, .true. otherwise
     res = (this%id /= other%id)
 …
     CHARACTER(len=*), INTENT(in), OPTIONAL :: progname
       !! An optional string with the name of the program
     LOGICAL, INTENT(in), OPTIONAL          :: as_warning
+    LOGICAL, INTENT(in), OPTIONAL          :: as_warning
       !! An optional boolean flag to print the message as warning rather than as error (default to .false.).
     CHARACTER(len=:), ALLOCATABLE :: str
       !! An allocatable string with the string representation of the error
     CHARACTER(len=:), ALLOCATABLE :: pref
+    CHARACTER(len=:), ALLOCATABLE :: pref
     pref = "error: "
     IF (PRESENT(as_warning)) THEN ; IF (as_warning) pref = "warning: " ; ENDIF
 …
       str = pref//TRIM(this%msg)
     ENDIF
     RETURN
+    RETURN
   END FUNCTION error_to_string
 …
   SUBROUTINE assert_r(test,reason)
     !! _Raise_ an assertion.
     !!
+    !!
     !! The method raises an assertion and stops the execution if __test__ is .false.
     !!
+    !!
     !! @note
     !! If ISO_C_BINDING module is available, the method calls the method abort from the C standard library. Doing so,
     !! developer is able to debug the source code by getting the backtrace of the execution.
     !! In other situation, the method simply uses the Fortran STOP statement which makes its usage... useless.
+    !! In other situation, the method simply uses the Fortran STOP statement which makes its usage... useless.
    LOGICAL, INTENT(in)          :: test
      !! Expression to test.
 …
   SUBROUTINE assert_w(test,where,reason)
     !! _Raise_ an assertion.
     !!
+    !!
     !! The method raises an assertion and stops the execution if __test__ is .false.
     !!
+    !!
     !! See [[errors(module):assert_r(subroutine)]] remark.
     LOGICAL, INTENT(in)         :: test
 …
     !! @note
     !! According to Fortran standard, the maximum value for a lun is processor
     !! dependent. I just assume that [7,9999] is a valid range and I believe that
+    !! dependent. I just assume that [7,9999] is a valid range and I believe that
     !! 9992 files to be opened is far enough for any program !
     !! @note
 …
     !! mind that loggers open files with the first free logical unit. Consequently
     !! if you need to perform I/O operations you should use this function to get a
     !! free lun instead of just randomly set a lun !
+    !! free lun instead of just randomly set a lun !
     INTEGER :: lu
       !! First free logical unit in the range [7,9999]  or -1 if no lun is available

trunk/LMDZ.TITAN/libf/muphytitan/fsystem.F90

-                      r1897
+                      r3083
+! Copyright Jérémie Burgalat (2010-2015,2017)
+!
+! jeremie.burgalat@univ-reims.fr
+!
+! This software is a computer program whose purpose is to provide configuration
+! file and command line arguments parsing features to Fortran programs.
+!
+! This software is governed by the CeCILL-B license under French law and
+! abiding by the rules of distribution of free software.  You can  use,
+! modify and/ or redistribute the software under the terms of the CeCILL-B
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and  rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty  and the software's author,  the holder of the
+! economic rights,  and the successive licensors  have only  limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading,  using,  modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean  that it is complicated to manipulate,  and  that  also
+! therefore means  that it is reserved for developers  and  experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The fact that you are presently reading this means that you have had
+! knowledge of the CeCILL-B license and that you accept its terms.
+! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+!
+! This file is part of SWIFT
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy of
+! this software and associated documentation files (the "Software"), to deal in
+! the Software without restriction, including without limitation the rights to
+! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+! the Software, and to permit persons to whom the Software is furnished to do so,
+! subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in all
+! copies or substantial portions of the Software.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 !! file: fsystem.F90
 !! summary: File system methods source file.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 …
   IMPLICIT NONE
   PUBLIC
+  PUBLIC
   PRIVATE :: get_umask
 …
     !!
     !! This object can be used to get an approximation of the execution of some piece of code.
     REAL(kind=8), PRIVATE    :: cpu_start = 0d0
+    REAL(kind=8), PRIVATE    :: cpu_start = 0d0
       !! Starting CPU time
     INTEGER(kind=8), PRIVATE :: clock_start = 0d0
+    INTEGER(kind=8), PRIVATE :: clock_start = 0d0
       !! Starting clock time
     LOGICAL, PRIVATE         :: on_run = .false.
       !! Chrono running state.
 #if HAVE_FTNPROC
     CONTAINS
       PROCEDURE :: is_running => chrono_is_running
+    CONTAINS
+      PROCEDURE :: is_running => chrono_is_running
       PROCEDURE :: start      => chrono_start
       PROCEDURE :: stop       => chrono_stop
 …
     END FUNCTION errno_c
     FUNCTION usleep_c(usec) BIND(C,name="usleep")
+    FUNCTION usleep_c(usec) BIND(C,name="usleep")
       !! (attemps to) Sleep for a given number of microseconds
       IMPORT C_INT
 …
     FUNCTION access_c(path,perm) BIND(C,name="c_access")
       !! Check if path is accessible for current user
+      !! Check if path is accessible for current user
       IMPORT c_char, C_INT
       CHARACTER(len=c_char), INTENT(in)      :: path(*)  !! Path to check
 …
     END FUNCTION access_c
     FUNCTION create_c(path,mode,asfile,forced) BIND(C,name="c_create")
+    FUNCTION create_c(path,mode,asfile,forced) BIND(C,name="c_create")
       !! Create a directory or a file in given path
       IMPORT c_char, C_INT
 …
       INTEGER(kind=C_INT), INTENT(in), VALUE :: uid     !! User id
       TYPE(C_PTR)                            :: uname_c !! C_PTR to the underlying char* pointer storing user name
     END FUNCTION uname_c
+    END FUNCTION uname_c
     FUNCTION gname_c(gid) BIND(C, name="c_gname")
 …
       INTEGER(kind=C_INT), INTENT(in), VALUE :: gid     !! Group id
       TYPE(C_PTR)                            :: gname_c !! C_PTR to the underlying char* pointer storing group name
     END FUNCTION gname_c
     FUNCTION dirname_c(path) BIND(C,name="c_dirname")
+    END FUNCTION gname_c
+    FUNCTION dirname_c(path) BIND(C,name="c_dirname")
       !! Get the directory name of the path
       IMPORT c_char, c_ptr
 …
     END FUNCTION basename_c
     FUNCTION getcwd_c() BIND(C,name="c_getcwd")
+    FUNCTION getcwd_c() BIND(C,name="c_getcwd")
       !! Get the current working directory
       IMPORT c_ptr
 …
       CHARACTER(kind=c_char), INTENT(in) :: input(*)  !! Path to rename
       CHARACTER(kind=c_char), INTENT(in) :: output(*) !! New name of the path
       INTEGER(kind=C_INT)                :: rename_c  !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)                :: rename_c  !! 0 on success, last errno on failure
     END FUNCTION rename_c
 …
       CHARACTER(kind=c_char), INTENT(in)     :: path(*) !! Path to modify
       INTEGER(kind=C_INT), INTENT(in), VALUE :: mode    !! New decimal permissions of the path to set
       INTEGER(kind=C_INT)                    :: chmod_c !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)                    :: chmod_c !! 0 on success, last errno on failure
     END FUNCTION chmod_c
 …
       IMPORT c_char, C_INT
       CHARACTER(kind=c_char), INTENT(in)  :: new(*)  !! Path of the new working directory
       INTEGER(kind=C_INT)                 :: chdir_c !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)                 :: chdir_c !! 0 on success, last errno on failure
     END FUNCTION chdir_c
 …
       IMPORT c_char, C_INT
       CHARACTER(kind=c_char), INTENT(in)     :: dirname(*) !! Path of the directory to create
       INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set
       INTEGER(kind=C_INT)                    :: mkdir_c    !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set
+      INTEGER(kind=C_INT)                    :: mkdir_c    !! 0 on success, last errno on failure
     END FUNCTION mkdir_c
 …
       IMPORT c_char, C_INT
       CHARACTER(kind=c_char), INTENT(in)     :: dirname(*) !! Path of the directory to create
       INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set
       INTEGER(kind=C_INT)                    :: mkdirp_c   !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT), INTENT(in), VALUE :: mode       !! Decimal permission to set
+      INTEGER(kind=C_INT)                    :: mkdirp_c   !! 0 on success, last errno on failure
     END FUNCTION mkdirp_c
     FUNCTION copy_c(to,from) BIND(C,name="c_copy")
+    FUNCTION copy_c(to,from) BIND(C,name="c_copy")
       !! Copy a file.
       IMPORT c_char, C_INT
 …
     END FUNCTION copy_c
     FUNCTION remove_c(path) BIND(C,name="c_remove")
+    FUNCTION remove_c(path) BIND(C,name="c_remove")
       !! Remove a file (or a directory) from the filesystem
       IMPORT c_char, C_INT
       CHARACTER(kind=c_char), INTENT(in)  :: path(*)  !! Path to delete
       INTEGER(kind=C_INT)                 :: remove_c !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)                 :: remove_c !! 0 on success, last errno on failure
     END FUNCTION remove_c
 …
       IMPORT c_char, C_INT
       CHARACTER(kind=c_char), INTENT(in) :: dirpath(*) !! Directory to delete
       INTEGER(kind=C_INT)                :: rmdir_c    !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)                :: rmdir_c    !! 0 on success, last errno on failure
     END FUNCTION rmdir_c
 …
       IMPORT c_char, C_INT
       CHARACTER(kind=c_char), INTENT(in) :: dirpath(*) !! Directory to delete
       INTEGER(kind=C_INT)                :: rmdirf_c   !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)                :: rmdirf_c   !! 0 on success, last errno on failure
     END FUNCTION rmdirf_c
 …
       INTEGER(kind=C_INT), INTENT(out) :: r, &       !! Number of rows
                                           c          !! Number of columns
       INTEGER(kind=C_INT)              :: termsize_c !! 0 on success, last errno on failure
+      INTEGER(kind=C_INT)              :: termsize_c !! 0 on success, last errno on failure
     END FUNCTION termsize_c
 …
       IMPORT  C_SIZE_T
       INTEGER(kind=C_SIZE_T) :: getCurrentRSS_c !! Current resident set size in bytes (0 if not available).
     END FUNCTION getCurrentRSS_c
+    END FUNCTION getCurrentRSS_c
     FUNCTION getPeakRSS_c() BIND(C, name="c_getPeakRSS")
 …
       IMPORT  C_SIZE_T
       INTEGER(kind=C_SIZE_T) :: getPeakRSS_c !! Peak resident set size in bytes (0 if not available).
     END FUNCTION getPeakRSS_c
+    END FUNCTION getPeakRSS_c
     FUNCTION getSystemMemory_c(total,avail,free) BIND(C, name='c_getSystemMemory')
 …
       INTEGER(kind=C_LONG_LONG), INTENT(out) :: avail             !! Current available memory.
       INTEGER(kind=C_LONG_LONG), INTENT(out) :: free              !! Current free memory.
       INTEGER(kind=C_INT)                    :: getSystemMemory_c !! status, 0 on success, 1 otherwise.
+      INTEGER(kind=C_INT)                    :: getSystemMemory_c !! status, 0 on success, 1 otherwise.
     END FUNCTION getSystemMemory_c
   END INTERFACE
 …
   FUNCTION fstring(string) RESULT(str)
     !! Convert C string to  Fortran string
+    !! Convert C string to  Fortran string
     !!
     !! The method copies the input C string up to the last C_NULL_CHAR found (not including it),
     !! and returns the converted Fortran string.
     !! All other C_NULL_CHAR found in the C string are removed.
     CHARACTER(len=*), INTENT(in) :: string !! A string from C
+    CHARACTER(len=*), INTENT(in) :: string !! A string from C
     CHARACTER(len=:), ALLOCATABLE :: str   !! Converted fortran string
     INTEGER :: i,idx
+    INTEGER :: i,idx
     str = ""
     idx = INDEX(string,C_NULL_CHAR,.true.)
 …
     !!
     !! The method build the fortran string from a TYPE(C_PTR) object that represent a
     !! C char\* pointer string.
+    !! C char\* pointer string.
     !! @note
     !! If __cstr__ is not allocated (i.e. the C_PTR is not associated) or if it is set
     !! to a C empty string (i.e. '\0') then the method returns an empty string.
     !! @attention
     !! The method does not free the underlying C string and it should be free using
+    !! The method does not free the underlying C string and it should be free using
     !! the subroutine free_c(_cstr_).
     TYPE(C_PTR), INTENT(in) :: cstr
 …
   FUNCTION cstring(string) RESULT(str)
     !> convert Fortran string to cstring
+    !> convert Fortran string to cstring
     !!
     !! The method returns a copy of the input string suitable for C functions argument.
     !! @note
+    !! @note
     !! Input string is trimmed during computations
     CHARACTER(len=*), INTENT(in) :: string
 …
 !===============================================================================
   FUNCTION fs_getgid() RESULT(ret)
+  FUNCTION fs_getgid() RESULT(ret)
     !! Get Group ID
     INTEGER(kind=4) :: ret !! An integer with the group identifier
     ret = INT(getgid_c(),kind=4)
+    ret = INT(getgid_c(),kind=4)
     RETURN
   END FUNCTION fs_getgid
 …
   END FUNCTION fs_getpid
   FUNCTION fs_getuid() RESULT(ret)
+  FUNCTION fs_getuid() RESULT(ret)
     !! Get User ID
     INTEGER(kind=4) :: ret !! An integer with the user identifier
 …
     zname = gname_c(gid)
     IF (.NOT.C_ASSOCIATED(zname)) THEN
       gname = ""
+      gname = ""
     ELSE
       gname = cstr2fstr(zname)
 …
     zname = gname_c(uid)
     IF (.NOT.C_ASSOCIATED(zname)) THEN
       uname = ""
+      uname = ""
     ELSE
       uname = cstr2fstr(zname)
 …
     CHARACTER(len=*), INTENT(in)  :: path
       !! A string with a (valid) path
     CHARACTER(len=:), ALLOCATABLE :: opath
+    CHARACTER(len=:), ALLOCATABLE :: opath
       !! A Fortran allocated string with the parent directory path or an empty string if method fails
     TYPE(C_PTR) :: zpath
 …
     CHARACTER(len=*), INTENT(in)  :: path
       !! A string with a (valid) path
     CHARACTER(len=:), ALLOCATABLE :: opath
+    CHARACTER(len=:), ALLOCATABLE :: opath
       !! The basename of the path or an empty string if method fails
     TYPE(C_PTR) :: zpath
 …
     !!
     !! The method computes the absolute path of the given path using C realpath function.
     !! @note
+    !! @note
     !! If the input path is empty then current working directory is returned.
     CHARACTER(len=*), INTENT(in)  :: path
       !! A string with a (valid) path
     CHARACTER(len=:), ALLOCATABLE :: opath
+    CHARACTER(len=:), ALLOCATABLE :: opath
       !! The absolute of the path or an empty string if method fails
     TYPE(C_PTR) :: zpath
 …
     !! Get the relative representation of two paths
     !!
     !! The method computes the relative representation of __path__ from __reldir__ if possible.
+    !! The method computes the relative representation of __path__ from __reldir__ if possible.
     !! If no common prefix is found, the method returns __path__.
     CHARACTER(len=*), INTENT(in) :: path, & !! Path to be computed relative to reldir
 …
     ELSE
       res = cstr2fstr(zpath)
     ENDIF
+    ENDIF
     CALL free_c(zpath)
   END FUNCTION fs_relpath
   FUNCTION fs_getcwd() RESULT(path)
+  FUNCTION fs_getcwd() RESULT(path)
     !! Get the current working directory
     CHARACTER(len=:), ALLOCATABLE :: path
 …
     LOGICAL :: ret                         !! True on success, false otherwise.
     IF (LEN_TRIM(old) == 0.OR.LEN_TRIM(new) == 0) THEN
       ret = .false.
+      ret = .false.
     ELSE
       ret = INT(rename_c(cstring(ADJUSTL(old)),cstring(ADJUSTL(new)))) == 0
 …
     INTEGER(kind=C_INT) :: zmode
     IF (LEN_TRIM(path) == 0) THEN
       ret = .false.
+      ret = .false.
     ELSE
       zmode = INT(oct_2_dec(mode),kind=C_INT)
 …
     LOGICAL :: ret                       !! True on success, false otherwise.
     IF (LEN_TRIM(path) == 0) THEN
       ret = .false.
+      ret = .false.
     ELSE
       ret = INT(chdir_c(cstring(ADJUSTL(path)))) == 0
 …
     !! The method attempts to create a new directory pointed by __path__ with the permission
     !! given by mode.
     CHARACTER(len=*), INTENT(in)  :: path
+    CHARACTER(len=*), INTENT(in)  :: path
       !! The path to modify
     INTEGER, INTENT(in), OPTIONAL :: mode
 …
     LOGICAL :: zperm
     IF (LEN_TRIM(path) == 0) THEN
       ret = .false.
     ELSE
       zmode = oct_2_dec(744)
+      ret = .false.
+    ELSE
+      zmode = oct_2_dec(744)
       IF (PRESENT(mode)) THEN
         IF (.NOT.chk_pm(mode)) THEN
+        IF (.NOT.chk_pm(mode)) THEN
           ret = .false. ; RETURN
         ENDIF
         zmode = oct_2_dec(mode)
       ENDIF
       zperm = .false. ; IF (PRESENT(permissive)) zperm = permissive
+      zperm = .false. ; IF (PRESENT(permissive)) zperm = permissive
       IF (zperm) THEN
         ret = INT(mkdirp_c(cstring(ADJUSTL(path)),INT(zmode,kind=C_INT))) == 0
 …
     !! Remove directory
     !!
     !! By default, the function removes an __empty__ directory. If __forced__ is given and set
+    !! By default, the function removes an __empty__ directory. If __forced__ is given and set
     !! to .true. then the function recursively deletes the directory and __ALL__ its content.
     CHARACTER(len=*), INTENT(in)  :: path
 …
     LOGICAL :: ret
       !! True on success, false otherwise.
     LOGICAL :: zforce
+    LOGICAL :: zforce
     IF (LEN_TRIM(path) == 0) THEN
       ret = .false.
+      ret = .false.
     ELSE
       zforce = .false. ; IF (PRESENT(forced)) zforce = forced
 …
     !! Get some informations about a path
     !!
     !! The method retrieves various informations about the input path using fstat C function.
+    !! The method retrieves various informations about the input path using fstat C function.
     !! The type of path as returned in __type__ argument is can take the following values:
     !!
 …
     INTEGER, INTENT(out), OPTIONAL           :: type,  & !! Optional type of path (see function documentation).
                                                 perm,  & !! Optional permission of the path
                                                 nlnks, & !! Optional number of links to the path
+                                                nlnks, & !! Optional number of links to the path
                                                 uid,   & !! Optional user id
                                                 gid      !! Optional group id
 …
                                                 ctime    !! Optional creation time
     LOGICAL :: ret                                       !! True on success, false otherwise.
     INTEGER                       :: ty,pe,ln,ud,gd
+    INTEGER                       :: ty,pe,ln,ud,gd
     INTEGER(kind=8)               :: fs
     CHARACTER(len=:), ALLOCATABLE :: at,mt,ct
 …
       ret = INT(fstat_c(cstring(ADJUSTL(path)),p,l,t,u,g,f,ta,tm,tc)) == 0
       IF (ret) THEN
         pe=INT(p) ; ln=INT(l) ; ty=INT(t) ; ud=INT(u) ; gd=INT(g)
         fs=INT(f,kind=8)
+        pe=INT(p) ; ln=INT(l) ; ty=INT(t) ; ud=INT(u) ; gd=INT(g)
+        fs=INT(f,kind=8)
         at = fstring(ta)
         mt = fstring(tm)
         ct = fstring(tc)
       ENDIF
       IF (PRESENT(type))  type  = ty
+      IF (PRESENT(type))  type  = ty
       IF (PRESENT(perm))  perm  = pe
       IF (PRESENT(nlnks)) nlnks = ln
 …
     !! Check if a path is a directory
     !!
     !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
+    !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
     !! information about __path__ type.
     CHARACTER(len=*), INTENT(in) :: path !! The path to check
     LOGICAL :: ret                       !! .true. if the path is a directory, .false. otherwise.
+    LOGICAL :: ret                       !! .true. if the path is a directory, .false. otherwise.
     INTEGER :: ty
     ret = fs_stat(path,type=ty)
     ret = ret.AND.(ty==2.or.ty==3)
+    ret = ret.AND.(ty==2.or.ty==3)
     RETURN
   END FUNCTION fs_isdir
   FUNCTION fs_isfile(path) RESULT (ret)
     !! Check if a path is a file
     !!
     !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
+    !! Check if a path is a file
+    !!
+    !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
     !! information about __path__ type.
     CHARACTER(len=*), INTENT(in) :: path !! The path to check
     LOGICAL :: ret                       !! .true. if the path is a file, .false. otherwise.
+    LOGICAL :: ret                       !! .true. if the path is a file, .false. otherwise.
     INTEGER :: ty
     ret=fs_stat(path,type=ty)
 …
   FUNCTION fs_islink(path) RESULT (ret)
     !! Check if a path is a link
     !!
     !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
+    !! Check if a path is a link
+    !!
+    !! The method is just a wrapper of [[fsystem(module):fs_stat(function)]] to get only specific
     !! information about __path__ type.
     CHARACTER(len=*), INTENT(in) :: path !! The path to check
     LOGICAL :: ret                       !! .true. if the path is a link, .false. otherwise.
     INTEGER :: ty
+    LOGICAL :: ret                       !! .true. if the path is a link, .false. otherwise.
+    INTEGER :: ty
     ret=fs_stat(path,type=ty)
     ret = ret.and.(ty==1.or.ty==3)
 …
     !! - 1 : Checks for EXECUTE permission
     !! - 2 : Checks for WRITE permission
     !! - 4 : Checks for READ permission
+    !! - 4 : Checks for READ permission
     CHARACTER(len=*), INTENT(in)  :: path       !! Path to check
     INTEGER, INTENT(in), OPTIONAL :: permission !! Optional permission to check
 …
     INTEGER(kind=C_INT) :: zp
     IF (LEN_TRIM(path) == 0) THEN
       ret = .false.
+      ret = .false.
     ELSE
       zp = 0 ; IF (PRESENT(permission)) zp = INT(permission,kind=C_INT)
 …
     !! Split given path into base,extension
     !!
     !! The __base__ of a path is conventionnally defined as all characters before the last dot of the path.
     !! The extension (__ext__) of the path gathers consequently all characters from the last dot to the end
+    !! The __base__ of a path is conventionnally defined as all characters before the last dot of the path.
+    !! The extension (__ext__) of the path gathers consequently all characters from the last dot to the end
     !! of the string.
     !! @note
     !! If the basename of the path begins by a dot then the path is assumed to be an hidden file (directory).
+    !! If the basename of the path begins by a dot then the path is assumed to be an hidden file (directory).
     !! __ext__ will then be empty.
     CHARACTER(len=*), INTENT(in)               :: path     !! Path to split
+    CHARACTER(len=*), INTENT(in)               :: path     !! Path to split
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: base, &  !! Output base of the path
                                                   ext      !! Output extension of the path
     LOGICAL, INTENT(in), OPTIONAL              :: absolute !! .true. to return absolute path
     LOGICAL                       :: ret                   !! .true. on success, .false. otherwise.
+    LOGICAL, INTENT(in), OPTIONAL              :: absolute !! .true. to return absolute path
+    LOGICAL                       :: ret                   !! .true. on success, .false. otherwise.
     LOGICAL                       :: zabs
     INTEGER                       :: p
     CHARACTER(len=:), ALLOCATABLE :: d,b,apath
     base = "" ; ext = ""
+    base = "" ; ext = ""
     ret = .false.
     IF (LEN_TRIM(path) == 0) THEN
 …
     IF (zabs) THEN
       apath = fs_realpath(path) ; IF (LEN_TRIM(apath) == 0) RETURN
     ENDIF
+    ENDIF
     d = fs_dirname(apath) ; IF (LEN_TRIM(d) == 0) RETURN
     b = fs_basename(apath) ; IF (LEN_TRIM(b) == 0) RETURN
 …
     ! If dot is set as first char of basename : it's an hidden file
     IF (p > 1) THEN
       ext = b(p:) ; base = TRIM(d)//"/"//b(:p-1)
     ELSE
       base = TRIM(apath)
+      ext = b(p:) ; base = TRIM(d)//"/"//b(:p-1)
+    ELSE
+      base = TRIM(apath)
     ENDIF
     ret = .true.
 …
   FUNCTION fs_create(path, mode, type, permissive) RESULT(ret)
     !! Create a directory/file
+    !! Create a directory/file
     !!
     !! The method creates the file/directory pointed by given __path__.
 …
     !! Unless __permissive__ is set to .true., the method will fails if intermediate
     !! directories in the path do not exist.
     CHARACTER(len=*), INTENT(in)           :: path        !! Path to create
+    CHARACTER(len=*), INTENT(in)           :: path        !! Path to create
     INTEGER, INTENT(in), OPTIONAL          :: mode        !! Optional octal permisions to set
     CHARACTER(len=1), INTENT(in), OPTIONAL :: type        !! Optional type of path to create
 …
     LOGICAL :: ret                                        !! True on success, false otherwise.
     INTEGER                       :: zmd,zt,zp
     CHARACTER(len=:), ALLOCATABLE :: b,e
+    CHARACTER(len=:), ALLOCATABLE :: b,e
     ret = .false.
     ! Checking for existence
 …
       RETURN
     ELSE IF (fs_access(path)) THEN
       RETURN
+      RETURN
     ENDIF
     ! Set type of path
     IF (PRESENT(type)) THEN
       IF (.NOT.(type(1:1)=="f".OR.type(1:1)=="d")) THEN
         RETURN
+        RETURN
       ELSE
         zt=0 ; IF (type(1:1)=="f") zt = 1
 …
     ! set permissions according to type
     IF (zt == 0) THEN
       zmd = oct_2_dec(777)-get_umask()
+      zmd = oct_2_dec(777)-get_umask()
     ELSE
       zmd = oct_2_dec(666) -get_umask()
 …
   FUNCTION fs_get_parent(path, n) RESULT(opath)
     !! Get the nth parent of the given path
     !!
     !! The method first resolves the given path using [[fsystem(module):fs_realpath(function)]]
+    !!
+    !! The method first resolves the given path using [[fsystem(module):fs_realpath(function)]]
     !! to get an absolute path.
     !! @note
+    !! @note
     !! If __n__ is greater than the maximum parent level of the path, "/" is returned.
     CHARACTER(len=*), INTENT(in)  :: path
       !! Input path
     INTEGER, INTENT(in), OPTIONAL :: n
+    INTEGER, INTENT(in), OPTIONAL :: n
       !! The level of the parent to get
     CHARACTER(len=:), ALLOCATABLE :: opath
       !! The nth parent of the given path, or an empty string if the parent can not be computed
+      !! The nth parent of the given path, or an empty string if the parent can not be computed
     CHARACTER(len=:), ALLOCATABLE :: zp
     INTEGER                       :: i,mx,zl,mzl
     opath = ""
+    opath = ""
     zl = 1 ; IF (PRESENT(n)) zl = MAX(n,1)
     IF (LEN_TRIM(path) == 0) THEN
 …
     mzl = 1 ; DO i=1,mx ; IF(zp(i:i) == '/') mzl=mzl+1 ; ENDDO
     i=0
     DO
+    DO
       mx = INDEX(zp(1:mx),'/',.true.) ; i=i+1
       IF (mx==0.OR.i>=zl.OR.i>=mzl) EXIT
+      IF (mx==0.OR.i>=zl.OR.i>=mzl) EXIT
       mx = mx - 1
     ENDDO
     IF (mx >= 1) THEN
       opath = zp(1:MAX(1,mx-1))
     ELSE
       opath = "/"
+    ELSE
+      opath = "/"
     ENDIF
     RETURN
 …
   SUBROUTINE fs_usleep(usec)
     !! Sleep for a given number of microseconds
     !! @note
     !! Currently if C usleep function failed, the system... does not sleep !
+    !! @note
+    !! Currently if C usleep function failed, the system... does not sleep !
     INTEGER, INTENT(in) :: usec !! The number of microseconds to sleep for
     INTEGER(kind=C_INT) :: ret
+    INTEGER(kind=C_INT) :: ret
     ! usleep expects useconds_t (unsigned int) which is given here as a 4-bytes int
     ret = usleep_c(INT(usec,kind=C_INT))
 …
     LOGICAL          :: zpeak
     CHARACTER(len=2) :: zunits
     INTEGER(kind=8)  :: ztot,zava,zfre
+    INTEGER(kind=8)  :: ztot,zava,zfre
     zunits = 'B '   ; IF (PRESENT(units)) zunits = units
     IF (zunits /= 'B' .AND. zunits /= 'KB' .AND. zunits /= 'MB' .AND. zunits /= 'GB') zunits = 'B '
     ret = INT(getSystemMemory_c(ztot,zava,zfre),kind=4) == 0
     ztot = ztot * 1024 ; zava = zava * 1024 ; zfre = zfre * 1024
+    ztot = ztot * 1024 ; zava = zava * 1024 ; zfre = zfre * 1024
     IF (PRESENT(total))     total     = ztot
 …
   FUNCTION oct_2_dec(octal) RESULT(res)
     !> Octal to decimal conversion
     !!
+    !!
     !! The method converts the octal number ranging from 0 to 777 in the decimal system.
     !! @attention
 …
     ENDDO
     res=d
     RETURN
+    RETURN
   END FUNCTION oct_2_dec
 …
     !! Get octal number of string representation's permission
     CHARACTER(len=3),INTENT(in) :: str !! The permission to convert
     INTEGER :: oct                     !! Octal value of the string permission on succes, -1 otherwise.
+    INTEGER :: oct                     !! Octal value of the string permission on succes, -1 otherwise.
     oct = -1
     IF (LEN_TRIM(str) /= 3) RETURN
     SELECT CASE(str)
       CASE("---")  ; oct = 0
+      CASE("---")  ; oct = 0
       CASE("--x")  ; oct = 1
       CASE("-w-")  ; oct = 2
 …
       CASE("rw-")  ; oct = 6
       CASE("rwx")  ; oct = 7
       CASE DEFAULT
+      CASE DEFAULT
         oct = -1 ; RETURN
     END SELECT
+    END SELECT
     RETURN
   END FUNCTION sp_2_op
 …
       CASE(6) ; str="rw-"
       CASE(7) ; str="rwx"
       CASE DEFAULT
+      CASE DEFAULT
         str='ukn' ; RETURN
     END SELECT
+    END SELECT
     RETURN
   END FUNCTION op_2_sp
 …
   FUNCTION str_perm(oct_perm) RESULT(ret)
     !! Get the string representation of the given permission mask
     INTEGER, INTENT(in) :: oct_perm !! The octal representation of the permission
+    INTEGER, INTENT(in) :: oct_perm !! The octal representation of the permission
     CHARACTER(len=9) :: ret      !! String representation of the octal number on succes, 'ukn' otherwise
     INTEGER :: u,g,o
     IF (.NOT.chk_pm(oct_perm)) THEN
+    IF (.NOT.chk_pm(oct_perm)) THEN
       ret = "ukn" ; RETURN
     ENDIF
 …
   SUBROUTINE chrono_start(this)
     !! Start the chrono.
+    !! Start the chrono.
     !!
     !! @note
 …
     ENDIF
     this%on_run = .true.
   END SUBROUTINE chrono_start
+  END SUBROUTINE chrono_start
   SUBROUTINE chrono_stop(this)
 …
   END SUBROUTINE chrono_reset
   SUBROUTINE chrono_get(this,cpu,clock,units)
+  SUBROUTINE chrono_get(this,cpu,clock,units)
     !! Get elapsed time since last call of start or reset methods.
     !!
+    !!
     !! The method computes the time elapsed in two ways :
     !!
     !! - If the [[fsystem(module):chrono(type)]] is not running, the method retruns 0.
     !! - Otherwise, elapsed time since the last call of
+    !! - Otherwise, elapsed time since the last call of
     !!   [[chrono(type):start(bound)]] (or [[chrono(type):reset(bound)]]).
     OBJECT(chrono), INTENT(in)             :: this
 …
     REAL(kind=8), INTENT(out), OPTIONAL    :: cpu
       !! Elapsed cpu time in seconds by default (see units argument).
     REAL(kind=8), INTENT(out), OPTIONAL    :: clock
+    REAL(kind=8), INTENT(out), OPTIONAL    :: clock
       !! Elapsed system clock time in seconds by default (see units argument).
     CHARACTER(len=2), INTENT(in), OPTIONAL :: units
       !! A two characters wide string with the units to convert in. Units should
       !! be one of the following : 'ms', 's' (default), 'm', 'h' or 'd'.
+      !! be one of the following : 'ms', 's' (default), 'm', 'h' or 'd'.
     CHARACTER(len=2) :: zu
     REAL(kind=8)     :: cu, fact
 …
       ENDIF
       IF (PRESENT(clock)) THEN
         CALL SYSTEM_CLOCK(ck,r,m)
+        CALL SYSTEM_CLOCK(ck,r,m)
         clock = c2t(ck,this%clock_start,r,m)
       ENDIF
 …
     ENDIF
     fact = 1d0
     zu = 's'
+    zu = 's'
     IF (PRESENT(units))  THEN
       zu = units
 …
       END SELECT
     ENDIF
     IF (PRESENT(cpu)) cpu = cpu / fact
+    IF (PRESENT(cpu)) cpu = cpu / fact
     IF (PRESENT(clock)) clock = clock / fact
   END SUBROUTINE chrono_get
 …
     !! Get the real-time between two clock counts from system_clock.
     INTEGER(kind=8), INTENT(in) :: e !! Final clock count
     INTEGER(kind=8), INTENT(in) :: i !! Initial clock count
+    INTEGER(kind=8), INTENT(in) :: i !! Initial clock count
     INTEGER(kind=8), INTENT(in) :: r !! Clock count rate
     INTEGER(kind=8), INTENT(in) :: m !! Maximum Clock count value

trunk/LMDZ.TITAN/libf/muphytitan/mm_clouds.f90

-                      r1897
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
+! Contributors: J. Burgalat (GSMA, URCA), B. de Batz de Trenquelléon (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: Clouds microphysics module
 !! author: J. Burgalat
+!! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
+!! corrections: B. de Batz de Trenquelléon (2023)
 MODULE MM_CLOUDS
   !! Clouds microphysics module.
   !!
   !! The module contains all definitions of the microphysics processes related to clouds:
+  !! The module contains all definitions of the microphysics processes related to clouds:
   !!
   !! - [nucleation](page/clouds.html#nucleation)
 …
   !! - [sedimentation](page/clouds.html#sedimentation)
   !!
   !!
   !! The interface methods always use the global variables defined in [[mm_globals(module)]] when values
   !! (any kind, temperature, pressure, moments...) over the vertical grid are required.
   !! Consequently, all these functions only deals with output argument which are most of the time the
+  !!
+  !! The interface methods always use the global variables defined in [[mm_globals(module)]] when values
+  !! (temperature, pressure, moments...) over the vertical grid are required.
+  !! Consequently, all these functions only deal with output arguments which are most of the time the
   !! tendencies of relevant variables on the atmospheric column.
   !!
   !! @note
   !! Tendencies returned by public methods are always defined from  __TOP__ of the atmosphere to the
+  !! @note
+  !! Tendencies returned by public methods are always defined from  __TOP__ of the atmosphere to the
   !! __GROUND__.
   USE MM_MPREC
 …
   PRIVATE
   PUBLIC :: mm_cloud_microphysics, mm_cloud_sedimentation, mm_cloud_nucond
   CONTAINS
+  PUBLIC :: mm_cloud_microphysics, mm_cloud_sedimentation, mm_cloud_nucond
+CONTAINS
   !============================================================================
 …
     !! Get the evolution of moments tracers through clouds microphysics processes.
     !!
     !! The subroutine is a wrapper to the clouds microphysics methods. It computes the tendencies of moments
+    !! The subroutine is a wrapper to the clouds microphysics methods. It computes the tendencies of moments
     !! tracers for nucleation, condensation and sedimentation processes for the atmospheric column.
     !!
     !! @note
     !! Both __dm3i__ and __dgazs__ are 2D-array with the vertical layers in first dimension and the number
     !! of ice components in the second.
+    !! @note
+    !! Both __dm3i__ and __dgazs__ are 2D-array with the vertical layers in first dimension and the number
+    !! of ice components in the second.
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm0a
       !! Tendency of the 0th order moment of the aerosols (fractal mode) (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the aerosols (fractal mode) (\(m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm3a
       !! Tendency of the 3rd order moment of the aerosols distribution (fractal mode) (\(m^{3}.m^{-3}\)) .
+    !! Tendency of the 3rd order moment of the aerosols distribution (fractal mode) (\(m^{3}.m^{-3}\)) .
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm0n
       !! Tendency of the 0th order moment of the aerosols distribution (fractal mode) (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the ccn distribution (\(m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm3n
       !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:,:), INTENT(out) :: dm3i
       !! Tendencies of the 3rd order moments of each ice components (\(m^{3}.m^{-3}\)).
+    !! Tendencies of the 3rd order moments of each ice components (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:,:), INTENT(out) :: dgazs
       !! Tendencies of each condensible gaz species (\(mol.mol^{-1}\)).
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE   :: zdm0n,zdm3n
+    !! Tendencies of each condensible gaz species (\(mol.mol^{-1}\)).
+    REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE   :: zdm0n,zdm3n
     REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE :: zdm3i
     INTEGER                                    :: i
     dm0a = 0._mm_wp ; dm3a = 0._mm_wp
     dm0n = 0._mm_wp ; dm3n = 0._mm_wp
+    dm0a = 0._mm_wp ; dm3a = 0._mm_wp
+    dm0n = 0._mm_wp ; dm3n = 0._mm_wp
     dm3i = 0._mm_wp ; dgazs = 0._mm_wp
 …
       call mm_cloud_sedimentation(zdm0n,zdm3n,zdm3i)
       ! computes precipitations / ice fluxes
+      ! computes precipitation, settling velocity and flux of ices
       mm_ccn_prec = SUM(zdm3n*mm_dzlev)
+      mm_ccn_flux(:) = get_mass_flux(mm_rhoaer,mm_m3ccn(:))
+      DO i=1, mm_nesp
+      mm_ccn_w(:) = wsettle(mm_play,mm_temp,mm_zlay,mm_drho,mm_drad)
+      mm_ccn_flux(:) = get_mass_flux(mm_rhoaer,mm_m3ccn(:))
+      DO i=1, mm_nesp
         mm_ice_prec(i) = SUM(zdm3i(:,i)*mm_dzlev)
         mm_ice_fluxes(:,i) = get_mass_flux(mm_xESPS(i)%rho,mm_m3ice(:,i))
       ENDDO
+        mm_ice_fluxes(:,i) = get_mass_flux(mm_xESPS(i)%rho,mm_m3ice(:,i))
+      ENDDO
       ! updates tendencies
       dm0n = dm0n + zdm0n
 …
     !! Get moments tendencies through nucleation/condensation/evaporation.
     !!
     !! The method is a wrapper of [[mm_clouds(module):nc_esp(subroutine)]] which computes the
+    !! The method is a wrapper of [[mm_clouds(module):nc_esp(subroutine)]] which computes the
     !! tendencies of tracers for all the condensible species given in the vector __xESPS__.
     !!
+    !! Aerosols and CCN distribution evolution depends on the ice components:
+    !!   - For nucleation only creation of CCN can occur.
+    !!   - For condensation only loss of CCN can occur.
+    !!
+    !! We use the simple following rule to compute the variation of CCN and aerosols:
+    !! The global variation of CCN (and thus aerosols) is determined from the most intense activity
+    !! of the ice components.
+    !!
     !! @warning
     !! __xESPS__, __m3i__ and __gazes__ must share the same indexing. For example if __xESPS(IDX)__
     !! corresponds to \(CH_{4}\) properties then __m3i(IDX)__ must be the total volume of solid
+    !! __xESPS__, __m3i__ and __gazes__ must share the same indexing. For example if __xESPS(IDX)__
+    !! corresponds to \(CH_{4}\) properties then __m3i(IDX)__ must be the total volume of solid
     !! \(CH_{4}\) (ice) and  __gazs(IDX)__ its vapor mole fraction.
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm0a
       !! Tendency of the 0th order moment of the aerosols (fractal mode) (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the aerosols (fractal mode) (\(m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm3a
       !! Tendency of the 3rd order moment of the aerosols distribution (fractal mode) (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the aerosols distribution (fractal mode) (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm0n
       !! Tendency of the 0th order moment of the aerosols distribution (fractal mode) (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the aerosols distribution (fractal mode) (\(m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), INTENT(out)   :: dm3n
       !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:,:), INTENT(out) :: dm3i
       !! Tendencies of the 3rd order moments of each ice components (\(m^{3}.m^{-3}\)).
+    !! Tendencies of the 3rd order moments of each ice components (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:,:), INTENT(out) :: dgazs
       !! Tendencies of each condensible gaz species (\(mol.mol^{-1}\)) .
+    !! Tendencies of each condensible gaz species (\(mol.mol^{-1}\)) .
     REAL(kind=mm_wp), DIMENSION(:,:), INTENT(out) :: gazsat
+      !! Saturation ratio of each condensible specie.
+    INTEGER                                   :: i,idx,ng
+    TYPE(mm_esp)                                 :: xESP
+    !! Saturation ratio of each condensible specie.
+    INTEGER                                       :: i,idx
     REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE :: zdm0a,zdm3a,zdm0n,zdm3n
     ALLOCATE(zdm0a(mm_nla,mm_nesp),zdm3a(mm_nla,mm_nesp), &
              zdm0n(mm_nla,mm_nesp),zdm3n(mm_nla,mm_nesp))
 …
     ENDDO
-    ! Computes balance :
-    ! Each ice components has been treated independently from the others, and
-    ! their tendencies are returned as is (just converted in input units).
+    !
-    ! Aerosols and CCN distribution evolution depends on the ice components:
-    !   - For nucleation only creation of CCN can occur.
-    !   - For condensation only loss of CCN can occur.
-    ! We use the simple following rule :
-    !   The global variation of CCN (and thus aerosols) is determined from the
-    !   most intense activity of the ice components.
-    !   that is the maximum value of the CCN tendencies regardless of its sign.
     DO i=1, mm_nla
+      idx = MAXLOC(zdm0n(i,:),DIM=1) ! WARNING this is not the definition above (should be in ABS() func)
+      dm0n(i) = zdm0n(i,idx)
+      dm3n(i) = zdm3n(i,idx)
+      dm0a(i) = zdm0a(i,idx)
+      dm3a(i) = zdm3a(i,idx)
+      ! all ice are returned but we must convert their units
+      dm3i(i,:) = dm3i(i,:)
+      ! retrieve the index of the maximum tendency of CCN where ice variation is not null.
+      idx = MAXLOC(zdm0n(i,:),DIM=1,MASK=(dm3i(i,:) /= 0._mm_wp .OR. mm_m3ice(i,:)+dm3i(i,:) >= 0._mm_wp))
+      IF (idx == 0) THEN
+        dm0n(i) = 0._mm_wp
+        dm3n(i) = 0._mm_wp
+        dm0a(i) = 0._mm_wp
+        dm3a(i) = 0._mm_wp
+      ELSE
+        IF (mm_debug .AND. ABS(zdm0n(i,idx)) > 1e3) THEN
+          WRITE(*,'((a),I2.2,(a),ES10.3,(a))') "Z(",i,") = ",mm_play(i)*1e2, &
+            " mbar: Max aer/ccn exchange variation due to specie: "//TRIM(mm_xESPS(idx)%name)
+        ENDIF
+        dm0n(i) = zdm0n(i,idx)
+        dm3n(i) = zdm3n(i,idx)
+        dm0a(i) = zdm0a(i,idx)
+        dm3a(i) = zdm3a(i,idx)
+      ENDIF
     ENDDO
   END SUBROUTINE mm_cloud_nucond
 …
     !! Get moments tendencies through nucleation/condensation/evaporation of a given condensible specie.
     !!
     !! The method computes the global tendencies of the aerosols, ccn and "ice" moments through cloud
+    !! The method computes the global tendencies of the aerosols, ccn and "ice" moments through cloud
     !! microphysics processes (nucleation & condensation).
     !!
     !! @warning
     !! Input quantities __m3iX__,__m3iO__, __m0aer__,__m3aer__, __m0ccn__,__m3ccn__ are assumed to be in
     !! \(X.kg^{-1}\) (where X is the unit of the moment that is, a number for M0 and a volume - \(m^3\)
+    !! Input quantities __m3iX__,__m3iO__, __m0aer__,__m3aer__, __m0ccn__,__m3ccn__ are assumed to be in
+    !! \(X.m^{-3}\) (where X is the unit of the moment that is, a number for M0 and a volume - \(m^3\)
     !! for M3) ; __vapX__ must be expressed in term of molar fraction.
     TYPE(mm_esp), INTENT(in)                   :: xESP
       !! Condensate specie properties.
+    !! Condensate specie properties.
     REAL(kind=mm_wp),INTENT(in), DIMENSION(:)  :: vapX
       !! Gas specie molar fraction on the vertical grid from __TOP__ to __GROUND__ (\(mol.mol^{-1}\)).
+    !! Gas specie molar fraction on the vertical grid from __TOP__ to __GROUND__ (\(mol.mol^{-1}\)).
     REAL(kind=mm_wp),INTENT(in), DIMENSION(:)  :: m3iX
       !! 3rd order moment of the ice component (\(m^{3}.m^{-3}\)).
+    !! 3rd order moment of the ice component (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: dvapX
       !! Tendency of gas specie (\(mol.mol^{-1}\)).
+    !! Tendency of gas specie (\(mol.mol^{-1}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: dm3iX
       !! Tendency of the 3rd order moment of the ice component (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the ice component (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: dm0aer
       !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-3}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: dm3aer
       !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: dm0ccn
       !! Tendency of the 0th order moment of the ccn distribution (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the ccn distribution (\(m^{-3}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: dm3ccn
       !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp),INTENT(out), DIMENSION(:) :: Xsat
       !! Saturation ratio values on the vertical grid (--).
+    !! Saturation ratio values on the vertical grid (--).
     INTEGER                                 :: i
     REAL(kind=mm_wp)                        :: bef,aft
     REAL(kind=mm_wp), DIMENSION(SIZE(vapX)) :: sm0a,sm3a,sm0n,sm3n,sm3iX
     REAL(kind=mm_wp), DIMENSION(SIZE(vapX)) :: zm0a,zm3a,zm0n,zm3n,zm3iX,zvapX
+    REAL(kind=mm_wp), DIMENSION(SIZE(vapX)) :: pX,sig,qsat,lheat,seq,up,down, &
+                                               ctot,newvap,nucr,grate,cm0,cm3
+    ! Initialization :
+    ! Copy input argument and convert units X.m-3 -> X.kg-1)
+    REAL(kind=mm_wp), DIMENSION(SIZE(vapX)) :: pX,sig,qsat,seq,up,down,ctot,newvap,nucr,grate,cm0,cm3,drad
+    ! get a copy of drop radius.
+    drad(:) = mm_drad(:)
+    ! Initialization :
+    ! Copy input argument and convert units X.m-3 -> X.kg-1
     ! sXXX is the initial converted value saved
     sm3iX = m3iX/mm_rhoair
+    sm3iX = m3iX/mm_rhoair
     sm0a = mm_m0aer_f/mm_rhoair ; sm3a = mm_m3aer_f/mm_rhoair
     sm0n = mm_m0ccn/mm_rhoair ; sm3n = mm_m3ccn/mm_rhoair
     ! zXXX is our working copy
     zm3ix = sm3ix ; zm0a = sm0a ; zm3a = sm3a ; zm0n = sm0n ; zm3n = sm3n
     ! Molar fraction of X specie is set in mass mixing ratio
+    zm3iX = sm3iX ; zm0a = sm0a ; zm3a = sm3a ; zm0n = sm0n ; zm3n = sm3n
+    ! Molar fraction of X specie is set in mass mixing ratio [kg.kg-1]
     zvapX  = vapX  * xESP%fmol2fmas
     ! Surface tension
+    ! Surface tension [N.m-1]
     sig = mm_sigX(mm_temp,xESP)
     ! X specie mass mixing ratio at saturation
     qsat = mm_qsatX(mm_temp,mm_play,xESP)
+    ! X specie mass mixing ratio at saturation [kg.kg-1]
+    qsat = mm_ysatX(mm_temp,mm_play,xESP) * xESP%fmol2fmas
     ! partial pressure of X specie
     pX = vapX * mm_play
     ! Saturation ratio
     Xsat = zvapX / qsat
+    ! Equilibrium saturation near the drop
+    seq = dexp(2._mm_wp*sig*xESP%masmol/(xESP%rho*mm_rgas*mm_temp*mm_drad))
+    ! Latent heat released
+    lheat = mm_lheatX(mm_temp,xESP)
     ! Gets nucleation rate (ccn radius is the monomer !)
     call nuc_rate((/(mm_rm, i=1,mm_nla)/),mm_temp,xESP,pX,Xsat,nucr)
+    ! IMPORTANT: update CCN and aerosols moment from nucleation NOW !
+    ! Doing so should prevent a nasty bug that occurs if we want to generate clouds from scratch (i.e. a "dry" atmosphere without any clouds tracers already present).
+    !
+    ! In such case, we do not produce ice variation on the first call of the method, at most only CCN are produced (i.e. dm3i == 0, dm3n != 0)
+    ! But the rules for computing the global tendencies in mm_cloud_nucond state that the global variation for CCN is due to the most active specie exchange.
+    !
+    ! for nucleation we have the following equations:
+    !   dMa(k)/dt = - dMn(k)/dt (conservation of aerosols+ccn)           (1)
+    !   dMa(k)/dt = - 4*PI*nucr/rm * Ma(k+3)                             (2)
+    !             = - 4*PI*nucr/rm * alpha(k+3)/alpha(k) * rc**3 * Ma(k)
+    ! With:
+    !   - Ma(k): k-th order moment of aerosol
+    !   - Mn(k): k-th order moment of ccn
+    !   - nucr : the nucleation rate.
+    ! We solve (implicit scheme) :
+    !   CST_M(k) = 4*PI*nucr/rm * alpha(k+3)/alpha(k)*rc**3 * dt
+    !   Ma(k)[t+dt] = 1/(1+CST_M(k)) * Ma(k)[t]                          (3)
+    ! Then, from eq. 2:
+    ! Mn(k)[t+dt] = Mn(k)[t] + CST_M(k)/(1+CST_M(k))*Ma(k)[t]            (4)
+    cm0 = 4._mm_wp*mm_pi*nucr/mm_rm*mm_alpha_f(3._mm_wp)*mm_rcf**3*mm_dt
+    cm3 = 4._mm_wp*mm_pi*nucr/mm_rm*mm_alpha_f(6._mm_wp)/mm_alpha_f(3._mm_wp)*mm_rcf**3*mm_dt
+    zm0a = 1._mm_wp/(1._mm_wp+cm0) * zm0a
+    zm3a = 1._mm_wp/(1._mm_wp+cm3) * zm3a
+    WHERE (zm0a <= 0._mm_wp .OR. zm3a <= 0._mm_wp)
+      zm0a = 0._mm_wp
+      zm3a = 0._mm_wp
+      zm0n = zm0n + sm0a
+      zm3n = zm3n + sm3a
+    ELSEWHERE
+      zm0n = zm0n + cm0*zm0a
+      zm3n = zm3n + cm3*zm3a
+    ENDWHERE
+    ! update the drop radius (we probably should recompute totally the radius to be in better agreement with the other moments)
+    ! We must manage the case where there is no ices and no ccn ==> drop radius is ZERO,
+    ! but conditions are met to spawn nucleation process: creation of ccn.
+    ! Then we set the drop radius to the monomer radius.
+    !
+    ! Doing so will prevent a nasty bug to occur later when ice volume is updated !
+    WHERE (nucr > 0._mm_wp .AND. drad <= mm_drad_min)
+      drad = mm_rm
+    ENDWHERE
+    ! Equilibrium saturation near the drop
+    seq = exp(min(30._mm_wp,2._mm_wp*sig*xESP%masmol/(xESP%rho*mm_rgas*mm_temp*drad)))
     ! Gets growth rate
     call growth_rate(mm_temp,mm_play,pX/Xsat,xESP,seq,mm_drad,grate)
     ctot = zvapx + xESP%rho * m3iX
     up = vapx + mm_dt * grate * 4._mm_wp * mm_pi * xESP%rho * mm_drad * seq * zm0n
     down = 1._mm_wp + mm_dt * grate * 4._mm_wp * mm_pi * xESP%rho * mm_drad / qsat * zm0n
+    call growth_rate(mm_temp,mm_play,pX/Xsat,xESP,seq,drad,grate)
+    ctot = zvapx + xESP%rho * zm3iX
+    up = zvapx + mm_dt * grate * 4._mm_wp * mm_pi * xESP%rho * drad * seq * zm0n
+    down = 1._mm_wp + mm_dt * grate * 4._mm_wp * mm_pi * xESP%rho * drad / qsat * zm0n
     ! gets new vapor X specie mass mixing ratio : cannot be greater than the
     ! total gas + ice and lower than nothing :)
 …
     ! gets "true" growth rate
     grate = grate * (newvap/qsat - seq)
     ! computes tendencies through condensation
+    ! 1) check for the specific case : NO ICE and SUBLIMATION
+    WHERE (zm3iX <= 0._mm_wp .AND. grate <= 0._mm_wp)
+      ! no ice and sublimation : reset ice to 0
+      zm3iX = 0._mm_wp
+    ELSEWHERE
+      ! update ice volume ...
+      zm3iX = zm3iX + mm_dt*grate*4._mm_wp*mm_pi*mm_drad*zm0n
+      ! ... and check if there ice left in the ccn
+      WHERE (zm3ix <= 0._mm_wp)
+        zm3ix = 0._mm_wp
+        zm0a = zm0a + zm0n ; zm0n = 0._mm_wp
+        zm3a = zm3a + zm3n ; zm3n = 0._mm_wp
+      ENDWHERE
+    ENDWHERE
+    ! computes tendencies
+    ! all of these tendencies are in X.kg-1
+    dm0aer = zm0a - sm0a
+    dm3aer = zm3a - sm3a
+    dm0ccn = zm0n - sm0n
+    dm3ccn = zm3n - sm3n
+    dm3ix  = zm3ix - sm3ix
+    ! and this one is in mol.mol-1
+    dvapx  = -xESP%rho * dm3ix / xESP%fmol2fmas
+    ! reset temporary arrays to initial values
+    zm3ix = sm3ix ; zm0a = sm0a ; zm3a = sm3a ; zm0n = sm0n ; zm3n = sm3n
+    ! Computes global tendencies (nucleation && condensation)
+    !
+    ! for nucleation we have the following equations:
+    !   dMaer_(k)/dt = - dMccn_(k)/dt (conservation of aerosols+ccn)       (1)
+    !   dMaer_(k)/dt = - 4*PI*nucr/rm * Maer_(k+3)                         (2)
+    !                = - 4*PI*nucr/rm * alpha(k+3)/alpha(k) * Maer_(k)
+    !   where alpha(k+3) = Maer_(k+3)/Maer_(0) /  rc**(k+3)
+    ! We solve (implicit scheme) :
+    !   CONST_M(k) = 4*PI*nucr/rm * alpha(k+3)/alpha(k)*rc**3 * dt
+    !   Maer_(k)[t+dt] = 1/(1+CONST_M(k)) * Maer_(k)[t]                    (3)
+    ! Then, from eq. 2:
+    ! Mccn_(k)[t+dt] = Mccn_(k)[t] + CONST_M(k)/(1+CONST_M(k))*Maer_(k)[t] (4)
+    !
+    cm0 = 4._mm_wp*mm_pi*nucr/mm_rm*mm_alpha_f(3._mm_wp)*mm_rcf**3*mm_dt
+    cm3 = 4._mm_wp*mm_pi*nucr/mm_rm*mm_alpha_f(6._mm_wp)/mm_alpha_f(3._mm_wp)*mm_rcf**3*mm_dt
+    zm0a = 1._mm_wp/(1._mm_wp+cm0) * zm0a
+    zm3a = 1._mm_wp/(1._mm_wp+cm0) * zm3a
+    WHERE (zm0a <= 0._mm_wp .OR. zm3a <= 0._mm_wp)
+      zm0a=0._mm_wp
+      zm3a=0._mm_wp
+      zm0n = zm0n + sm0a
+      zm3n = zm3n + sm3a
+    ELSEWHERE
+      zm0n = zm0n + cm0/(1.+cm0)*zm0a
+      zm3n = zm3n + cm3/(1.+cm3)*zm3a
+    ENDWHERE
+    ! Adds condensation tendencies
+    zm0a = zm0a + dm0aer
+    zm3a = zm3a + dm3aer
+    zm0n = zm0n + dm0ccn
+    zm3n = zm3n + dm3ccn
+    DO i=1,mm_nla
+      ! check for the specific case : NO ICE and SUBLIMATION
+      IF (zm3iX(i) <= 0._mm_wp .AND. grate(i) <= 0._mm_wp) THEN
+        zm3iX(i) = 0._mm_wp
+      ELSE
+        ! update ice volume ...
+        zm3iX(i) = zm3iX(i) + mm_dt*grate(i)*4._mm_wp*mm_pi*drad(i)*zm0n(i)
+        ! ... and check if there is ice left in the ccn
+        IF (zm3iX(i) <= 0._mm_wp) THEN
+          zm3iX(i) = 0._mm_wp
+          zm0a(i) = zm0a(i) + zm0n(i) ; zm0n(i) = 0._mm_wp
+          zm3a(i) = zm3a(i) + zm3n(i) ; zm3n(i) = 0._mm_wp
+        ENDIF
+      ENDIF
+    ENDDO
     ! Computes balance
     IF (mm_debug) THEN
-      WRITE(*,'(a)') "Condensation/nucleation balance :"
       DO i=1,mm_nla
         bef = sm0a(i) + sm0n(i)
         aft = zm0a(i)  + zm0n(i)
+        IF (ABS(bef-aft)/bef > 1e-10_mm_wp) WRITE(*,'((a),I2.2,(a))') &
+        "[WARNING] nc_esp speaking: Total number not conserved (z=",i,")"
+        IF (ABS(bef-aft)/bef > 1e-10_mm_wp) THEN
+          WRITE(*,'((a),I2.2,(a),ES20.12,(a),ES20.12)') &
+            "[DEBUG] nc_esp("//TRIM(xESP%name)//"): M0 not conserved (z=",i,")",bef," <-> ",aft
+        ENDIF
         bef = sm3a(i) + sm3n(i)
         aft = zm3a(i)  + zm3n(i)
+        IF (ABS(bef-aft)/bef > 1e-10_mm_wp) WRITE(*,'((a),I2.2,(a))') &
+        "[WARNING] nc_esp speaking: Total volume not conserved (z=",i,")"
+        IF (ABS(bef-aft)/bef > 1e-10_mm_wp) THEN
+          WRITE(*,'((a),I2.2,(a),ES20.12,(a),ES20.12)') &
+            "[DEBUG] nc_esp("//TRIM(xESP%name)//"): M3 not conserved (z=",i,")",bef," <-> ",aft
+        ENDIF
       ENDDO
     ENDIF
+    ! Now updates tendencies
+    dm0aer = (zm0a-sm0a)*mm_rhoair
+    dm3aer = (zm3a-sm3a)*mm_rhoair
+    dm0ccn = (zm0n-sm0n)*mm_rhoair
+    dm3ccn = (zm3n-sm3n)*mm_rhoair
+    ! compute tendencies:
+    ! all of these tendencies are in X.m-3 !
+    dm0aer = (zm0a - sm0a)*mm_rhoair
+    dm3aer = (zm3a - sm3a)*mm_rhoair
+    dm0ccn = (zm0n - sm0n)*mm_rhoair
+    dm3ccn = (zm3n - sm3n)*mm_rhoair
+    dm3iX  = (zm3iX - sm3iX)                    ! this one in X.kg-1 (temporary) !
+    dvapX  = -xESP%rho * dm3iX / xESP%fmol2fmas ! in order to compute this one in mol.mol-1
+    dm3iX  = dm3iX*mm_rhoair                    ! update ice tendencies in X.m-3 !
   END SUBROUTINE nc_esp
   SUBROUTINE nuc_rate(rccn,temp,xESP,pvp,sat,rate)
     !! Get nucleation rate.
     !!
     !! The method computes the heterogeneous nucleation rate for the given specie on a fractal particle
+    !! The method computes the heterogeneous nucleation rate for the given specie on a fractal particle
     !! of size __rccn__.
     !! Except __xESP__, all arguments are vectors of the same size (vertical grid).
 …
     TYPE(mm_esp), INTENT(in)                    :: xESP !! X specie properties (--).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: rate !! The nucleation rate (\(m^-{2}.s^{-1}\)).
+    INTEGER                                 :: nv
+    REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: nX,rstar,gstar,x,zeldov,deltaf, &
+                                               fsh,fstar,sig
+    nv = SIZE(rccn)
+    ALLOCATE(nX(nv), rstar(nv), gstar(nv), x(nv), zeldov(nv), &
+             deltaf(nv), fsh(nv), fstar(nv))
+    INTEGER          :: i
+    REAL(kind=mm_wp) :: r,t,s,sig,nX,rstar,gstar,x,zeldov,deltaf,fsh,fstar
+    rate(:) = 0._mm_wp
     ! Activation condition
+    WHERE (sat > 1._mm_wp)
+      sig = mm_sigX(temp,xESP)
+      nX    = pvp/mm_kboltz/temp
+      rstar = 2._mm_wp*sig*xESP%vol/(mm_kboltz*temp*dlog(sat))
+      ! curvature radius
+      x     = rccn/rstar
+      fsh   = mm_fshape(xESP%mteta,x)
+      fstar = (4._mm_wp/3._mm_wp*mm_pi)*sig*(rstar**2.)*fsh
+      deltaf=MIN(MAX((2.*mm_fdes-mm_fdif-fstar)/(mm_kboltz*temp),-100._mm_wp),100._mm_wp)
+      WHERE (deltaf == -100._mm_wp)
+        rate = 0._mm_wp
+      ELSEWHERE
+        gstar  = 4._mm_wp*mm_pi*(rstar**3)/(3._mm_wp*xESP%vol)
+        zeldov = dsqrt(fstar/(3._mm_wp*mm_pi*mm_kboltz*temp*(gstar**2)))
+        rate   = zeldov*mm_kboltz*temp*(nX*rstar)**2._mm_wp*dexp(deltaf)/ &
+                  (fsh*mm_nus*xESP%mas)
+      ENDWHERE
+    ELSEWHERE
+      rate = 0._mm_wp
+    ENDWHERE
+    DEALLOCATE(nX,rstar,gstar,x,zeldov,deltaf,fsh,fstar)
+    DO i=1, SIZE(rccn)
+      s = sat(i)
+      IF (s > 1._mm_wp) THEN
+        t = temp(i) ; r = rccn(i)
+        sig = mm_sigX(t,xESP)
+        nX    = pvp(i)/mm_kboltz/t
+        rstar = 2._mm_wp*sig*xESP%vol/(mm_kboltz*t*dlog(s))
+        ! curvature radius
+        x     = r/rstar
+        fsh   = mm_fshape(xESP%mteta,x)
+        fstar = (4._mm_wp*mm_pi/3._mm_wp)*sig*(rstar**2.)*fsh
+        deltaf=MIN(MAX((2.*mm_fdes-mm_fdif-fstar)/(mm_kboltz*t),-100._mm_wp),100._mm_wp)
+        IF (deltaf > -100._mm_wp) THEN
+          gstar  = 4._mm_wp*mm_pi*(rstar**3)/(3._mm_wp*xESP%vol)
+          zeldov = dsqrt(fstar/(3._mm_wp*mm_pi*mm_kboltz*t*(gstar**2)))
+          rate(i)= zeldov*mm_kboltz*t*(nX*rstar)**2._mm_wp*dexp(deltaf)/(fsh*mm_nus*xESP%mas)
+        ENDIF
+      ENDIF
+    ENDDO
     RETURN
   END SUBROUTINE nuc_rate
 …
     !!
     !! The method computes the growth rate a drop through condensation/evaporation processes:
     !!
+    !!
     !! $$ r \times \frac{dr}{dt} = g_{rate} \times (S - S_{eq}) $$
     !!
 …
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: temp  !! Temperature (K).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: pres  !! Pressure level (Pa).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: seq   !! Saturation vapor pressure of specie (Pa).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: drad  !! Specie properties.
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: pXsat !! Equilibrium saturation near the drop.
     TYPE(mm_esp), INTENT(in)                    :: xESP  !! Drop radius (m).
+    REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: pXsat !! Saturation vapor pressure of specie (Pa).
+    TYPE(mm_esp), INTENT(in)                    :: xESP  !! Specie properties.
+    REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: seq   !! Equilibrium saturation near the drop.
+    REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: drad  !! Drop radius (m).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: rate  !! Growth rate (\(m^{2}.s^{-1}\)).
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: k,knu,slf,rkc,rdc,l,dv
 …
     ! Diffusion coefficient of X gas
     Dv(:) = 1._mm_wp/3._mm_wp*dsqrt(8._mm_wp*mm_rgas*temp(:)/(mm_pi*xESP%masmol))*mm_kboltz*temp(:) / &
          (mm_pi*pres(:)*(mm_air_rad+xESP%ray)**2* dsqrt(1._mm_wp+xESP%fmol2fmas))
+      (mm_pi*pres(:)*(mm_air_rad+xESP%ray)**2* dsqrt(1._mm_wp+xESP%fmol2fmas))
     knu(:) = l(:)/drad(:)                                         ! The knudsen number of the drop
     slf(:) = (1.333_mm_wp+0.71_mm_wp/knu(:))/(1._mm_wp+1._mm_wp/knu(:)) ! Slip flow correction
 …
     RETURN
   END SUBROUTINE growth_rate
   !-----------------------------------------------------------------------------
 …
     !! Compute the tendency of _clouds_ related moments through sedimentation process.
     !!
     !! The method computes the tendencies of moments related to cloud microphysics through
     !! sedimentation process. The algorithm used here differs from
     !! [[mm_haze(module):mm_haze_sedimentation(subroutine)]] as all moments settle with the same
     !! terminal velocity which is computed with the average drop radius of the size distribution.
     !! We simply compute an _exchange matrix_ that stores the new positions of each cells through
+    !! The method computes the tendencies of moments related to cloud microphysics through
+    !! sedimentation process. The algorithm used here differs from
+    !! [[mm_haze(module):mm_haze_sedimentation(subroutine)]] as all moments settle with the same
+    !! terminal velocity which is computed with the average drop radius of the size distribution.
+    !! We simply compute an _exchange matrix_ that stores the new positions of each cells through
     !! sedimentation process and then computes the matrix
     !! product with input moments values to get final tendencies.
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm0n
       !! Tendency of the 0th order moment of the ccn distribution (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the ccn distribution (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm3n
       !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the ccn distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:,:) :: dm3i
       !! Tendencies of the 3rd order moment of each ice component of the cloud (\(m^{3}m^{-3}\)).
+    !! Tendencies of the 3rd order moment of each ice component of the cloud (\(m^{3}m^{-3}\)).
     INTEGER                                   :: im,nm
     REAL(kind=mm_wp), DIMENSION(:,:), ALLOCATABLE :: moms, momsf,chg_matrix
     nm = 2 + mm_nesp
     ALLOCATE(moms(mm_nla,nm),momsf(mm_nla,nm),chg_matrix(mm_nla,mm_nla))
     ! Initializes moms
+    ! Initializes moms
     moms(:,1)  = mm_m0ccn * mm_dzlev
     moms(:,2)  = mm_m3ccn * mm_dzlev
+    DO im=1,mm_nesp
+      moms(:,2+im) = mm_m3ice(:,im) * mm_dzlev
+    ENDDO
+    DO im=1,mm_nesp ; moms(:,2+im) = mm_m3ice(:,im) * mm_dzlev ; ENDDO
     ! Computes exchange matrix
     CALL exchange(mm_drad,mm_drho,mm_dt,chg_matrix)
 …
     dm0n = (momsf(:,1)-moms(:,1))/mm_dzlev
     dm3n = (momsf(:,2)-moms(:,2))/mm_dzlev
+    DO im=1,mm_nesp
+      dm3i(:,im) = (momsf(:,2+im)-moms(:,2+im))/mm_dzlev
+    ENDDO
+    DO im=1,mm_nesp ; dm3i(:,im) = (momsf(:,2+im)-moms(:,2+im))/mm_dzlev ; ENDDO
     RETURN
   END SUBROUTINE mm_cloud_sedimentation
 …
     !! Compute the exchange matrix.
     !!
     !! The subroutine computes the matrix exchange used by
     !! [[mm_clouds(module):mm_cloud_sedimentation(subroutine)]] to compute moments tendencies
     !! through sedimentation process. Both __rad__ and __rhog__ must be vector with relevant
+    !! The subroutine computes the matrix exchange used by
+    !! [[mm_clouds(module):mm_cloud_sedimentation(subroutine)]] to compute moments tendencies
+    !! through sedimentation process. Both __rad__ and __rhog__ must be vector with relevant
     !! values over the atmospheric vertical structure. __matrix__ is square 2D-array with same
     !! dimension size than __rad__.
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: rad
       !! Cloud drop radius over the atmospheric vertical structure (m).
+    !! Cloud drop radius over the atmospheric vertical structure (m).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: rhog
       !! Cloud drop density over the atmospheric vertical structure (\(kg.m^{-3}\)).
+    !! Cloud drop density over the atmospheric vertical structure (\(kg.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(in)               :: dt
       !! Timestep (s).
+    !! Timestep (s).
     REAL(kind=mm_wp), INTENT(out)              :: matrix(:,:)
       !! The output _exchange matrix_.
     INTEGER                                 :: nz,i,j,jj,jinf,jsup
+    !! The output _exchange matrix_.
+    INTEGER                                     :: nz,i,j,jj,jinf,jsup
     REAL(kind=mm_wp)                            :: zni,znip1,xf,xft,xcnt
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: puit
     REAL(kind=mm_wp)                            :: cpte,cpte2
+    INTEGER, PARAMETER                      :: ichx  = 1
+    REAL(kind=mm_wp)                            :: zsurf
+    INTEGER, PARAMETER                          :: ichx  = 1
     matrix = 0._mm_wp ; nz = SIZE(rad) ; ALLOCATE(puit(nz))
+    ! compute exchange matrix
+    zsurf = mm_zlev(nz)
+    ! compute exchange matrix
     DO i=1,nz
       puit(i) = 0._mm_wp
       xcnt = 0._mm_wp
       ! computes drop move (i.e. its new positions)
       CALL getnzs(ichx,i,rad,rhog,dt,zni,znip1)
       ! Peculiar case : Ground level precipitation [znip1<0 && (zni<0 || zni>0)]
       ! Complete precipitation [ znip1 <= 0 && zni <= 0 ] :
       IF(zni<=0._mm_wp.and.znip1<=0._mm_wp) THEN
+      ! computes drop move (i.e. its new positions)
+      CALL getnzs(ichx,i,rad,rhog,dt,zni,znip1)
+      ! Peculiar case : Ground level precipitation [znip1 < zsurf && (zni < zsurf || zni > zsurf)]
+      ! - complete precipitation [ znip1 <= 0 && zni <= 0 ] :
+      IF(zni <= zsurf .and. znip1 <= zsurf) THEN
         xft=0._mm_wp
         xf=1._mm_wp
 …
         puit(i)=puit(i)+xf
       ENDIF
       ! partial precipitation [ znip1 <= 0 && zni > 0 ] :
       IF (zni>0._mm_wp .and. znip1 <= 0._mm_wp) THEN
         xft=zni/(zni-znip1)
+      ! - partial precipitation [ znip1 <= zsurf && zni > zsurf ] :
+      IF (zni > zsurf .and. znip1 <= zsurf) THEN
+        xft=(zni-zsurf)/(zni-znip1)
         xf=(1.-xft)
         xcnt=xcnt+xf
         puit(i)=puit(i)+xf
       ENDIF
       ! General case: no ground precipitation [ znip1 > 0 && zni > 0 ]
       IF (zni>0._mm_wp.and.znip1>0._mm_wp) THEN
         xft = 1._mm_wp       ! on a la totalite de la case
+      ! General case : no ground precipitation [ znip1 > zsurf && zni > zsurf ]
+      IF (zni > zsurf .and. znip1 > zsurf) THEN
+        xft = 1._mm_wp ! on a la totalite de la case
         xf  = 0._mm_wp
         xcnt=xcnt+xf
         puit(i)=puit(i)+xf
       ENDIF
+      ! Fix minimum level to the ground
+      znip1 = MAX(znip1,0.)
+      zni   = MAX(zni,0.)
+      IF (zni < znip1) THEN
+        WRITE(*,'("[EXCHANGES] WARNING, missing this case :",2(2X,ES10.3))') zni, znip1
+      ENDIF
+      ! Fix minimum level to the ground
+      znip1 = MAX(znip1,zsurf)
+      zni   = MAX(zni,zsurf)
       ! Locate new "drop" position in the verical grid
       jsup=nz+1
 …
       ENDDO
       ! Volume is out of range: (all drops have touched the ground!)
       ! Note: can happen here,it has been treated previously :)
       IF (jsup>=nz+1.and.jinf==jsup) THEN
+      ! Note: cannot happen here, it has been treated previously :)
+      IF (jsup>=nz+1.and.jinf==jsup) THEN
         WRITE(*,'(a)') "[EXCHANGE] speaking: The impossible happened !"
         call EXIT(666)
       ENDIF
       ! Volume inside a single level
       IF (jsup==jinf.and.jsup<=nz) THEN
+      IF (jsup==jinf.and.jsup<=nz) THEN
         xf=1._mm_wp
         xcnt=xcnt+xft*xf
         matrix(jinf,i)=matrix(jinf,i)+xft*xf
       ENDIF
       ! Volume over 2 levels
       IF (jinf==jsup+1) THEN
+      ENDIF
+      ! Volume over 2 levels
+      IF (jinf==jsup+1) THEN
         xf=(zni-mm_zlev(jinf))/(zni-znip1)
         xcnt=xcnt+xf*xft
 …
         ENDIF
       ENDIF
       ! Volume over 3 or more levels
       IF (jinf > jsup+1) THEN
 …
           matrix(jj,i)=matrix(jj,i)+xft*xf
         ENDDO
+      ENDIF
+    ENDDO
+    ! checking if everything is alright if debug enabled...
+      ENDIF
+    ENDDO
+    ! checking if everything is alright if debug enabled...
     IF (mm_debug) THEN
       cpte=0._mm_wp ; cpte2=0._mm_wp
 …
           cpte=cpte+matrix(jj,j)
         ENDDO
-        cpte2=cpte+puit(j)
       ENDDO
+      cpte2=cpte+sum(puit)
       IF (abs(cpte2-nz)>1.e-4_mm_wp) THEN
+        WRITE(*,'(a)')"[EXCHANGE] speaking :"
+        WRITE(*,'("tx expl (/nz):",2(2X,ES10.3))') cpte,cpte2
+        WRITE(*,'("[EXCHANGE] speaking: tx expl (/nz):",2(2X,ES10.3))') cpte,cpte2
       ENDIF
     ENDIF
+    RETURN
+    RETURN
   END SUBROUTINE exchange
 …
     !! Compute displacement of a cell under sedimentation process.
     !!
     !! The method computes the new position of a _drop cell_ through sedimentation process as
+    !! The method computes the new position of a _drop cell_ through sedimentation process as
     !! descibed in the following scheme:
     !!
 …
     !! @note
     !! The method uses directly [[mm_globals(module):mm_play(variable)]], [[mm_globals(module):mm_plev(variable)]],
     !! [[mm_globals(module):mm_temp(variable)]],[[mm_globals(module):mm_btemp(variable)]],
+    !! [[mm_globals(module):mm_temp(variable)]],[[mm_globals(module):mm_btemp(variable)]],
     !! [[mm_globals(module):mm_zlay(variable)]] and [[mm_globals(module):mm_zlev(variable)]] and uses __idx__ to
     !! get the relevant value to use on the vertical grid.
     INTEGER, INTENT(in)                        :: ichx
       !! Velocity extrapolation control flag (0 for linear, 1 for exponential -preferred -).
+    !! Velocity extrapolation control flag (0 for linear, 1 for exponential -preferred -).
     INTEGER, INTENT(in)                        :: idx
       !! Initial position of the drop (subscript of vertical layers vectors).
+    !! Initial position of the drop (subscript of vertical layers vectors).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: rad
       !! Cloud drop radius over the atmospheric vertical structure (m).
+    !! Cloud drop radius over the atmospheric vertical structure (m).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: rho
       !! Cloud drop density over the atmospheric vertical structure (\(kg.m^{-3}\)).
+    !! Cloud drop density over the atmospheric vertical structure (\(kg.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(in)               :: dt
       !! Timestep (s).
+    !! Timestep (s).
     REAL(kind=mm_wp), INTENT(out)              :: zni
       !! Final layer center position (m).
+    !! Final layer upper boundary position (m).
     REAL(kind=mm_wp), INTENT(out)              :: zns
       !! Final layer upper boundary position (m).
     REAL(kind=mm_wp)            :: ws,wi,w,zi,zs
+    !! Final layer lower boundary position (m).
+    REAL(kind=mm_wp)            :: ws,wi,w,zi,zs
     REAL(kind=mm_wp)            :: alpha,argexp,v0,arg1,arg2
     INTEGER                 :: i,nz
     REAL(kind=mm_wp), PARAMETER :: es = 30._mm_wp
     nz = SIZE(rad)
     ! Linear extrapolation of velocity
 …
         ! velocity lower interface
         wi = wsettle(mm_plev(idx+1),mm_btemp(idx+1),mm_zlev(idx+1), &
                      rho(idx+1),rad(idx+1))
       ELSE
         WRITE(*,'(a)') "[getnzs] speaking:"
+          rho(idx+1),rad(idx+1))
+      ELSE
+        WRITE(*,'(a)') "[getnzs] speaking:"
         WRITE(*,'(a)') "This is the fatal error..."
         WRITE(*,'(a)') "index is higher than number of levels"
 …
       zns = mm_zlev(idx)-mm_dzlev(idx)-w*dt
       RETURN
+    ! Exponential extrapolation of velocity
+      ! Exponential extrapolation of velocity
     ELSEIF(ichx==1) THEN
-      ws = wsettle(mm_plev(idx),mm_btemp(idx),mm_zlev(idx),rho(idx),rad(idx))
       zs = mm_zlev(idx)
       wi = wsettle(mm_play(idx),mm_temp(idx),mm_zlay(idx),rho(idx),rad(idx))
+      ws = wsettle(mm_plev(idx),mm_btemp(idx),zs,rho(idx),rad(idx))
       zi=mm_zlay(idx)
+      wi = wsettle(mm_play(idx),mm_temp(idx),zi,rho(idx),rad(idx))
       ! ws & wi must be different !
       IF(dabs(wi-ws)/wi <= 1.e-3_mm_wp)  wi=ws/1.001_mm_wp
       IF (wi /= 0._mm_wp) alpha = dlog(ws/wi)/(zs-zi)  ! alpha < 0 if wi > ws
       !   -es < argexp < es
       argexp=MAX(MIN(alpha*zs,es),-es)
+      !   -es < argexp < es
+      argexp=MAX(MIN(alpha*zs,es),-es)
       v0 = ws/dexp(argexp)
       arg1=1._mm_wp+v0*alpha*dexp(argexp)*dt
       argexp=MAX(MIN(alpha*(mm_zlev(idx)-mm_dzlev(idx)),es),-es)
       arg2=1._mm_wp+v0*alpha*dexp(argexp)*dt
       IF (arg1<=0._mm_wp.OR.arg2<=0._mm_wp) THEN
+      IF (arg1<=0._mm_wp.OR.arg2<=0._mm_wp) THEN
         ! correct velocity
         ! divides the velocity argument in arg1 and arg2 :
 …
         DO i=1,25
           IF (arg1<=0._mm_wp.OR.arg2<=0._mm_wp) THEN
             IF (mm_debug) &
             WRITE(*,'((a),I2.2,(a))') "[getnzs] must adjust velocity (",i,"/25)"
+            IF (mm_debug) &
+              WRITE(*,'((a),I2.2,(a))') "[getnzs] must adjust velocity (iter:",i,"/25)"
             arg1=(arg1+1._mm_wp)/2._mm_wp ; arg2=(arg2+1._mm_wp)/2._mm_wp
           ELSE
             EXIT
+            EXIT
           ENDIF
         ENDDO
 …
         ENDIF
       ENDIF
       zni = mm_zlev(idx)-dlog(arg1)/alpha
       zns = mm_zlev(idx)-mm_dzlev(idx)-dlog(arg2)/alpha
       RETURN
     ENDIF
+    ENDIF
   END SUBROUTINE getnzs
   ELEMENTAL FUNCTION wsettle(p,t,z,rho,rad) RESULT(w)
     !! Compute the settling velocity of a spherical particle.
     !!
     !! The method computes the effective settling velocity of spherical particle of
+    !! Compute the settling velocity of a spherical particle.
+    !!
+    !! The method computes the effective settling velocity of spherical particle of
     !! radius __rad__. It accounts for the slip-flow transition (no approximation).
     REAL(kind=mm_wp), INTENT(in) :: p   !! The pressure level (Pa).
 …
     REAL(kind=mm_wp), INTENT(in) :: rad !! Radius of the particle (m).
     REAL(kind=mm_wp) :: w               !! Settling velocity (\(m.s^{-1}\)).
     REAL(kind=mm_wp)            :: g,a,kn,nu
     REAL(kind=mm_wp), PARAMETER :: ra = 1.75e-10_mm_wp, nu0 = 1.74e-4_mm_wp, c = 109._mm_wp
     ! Computes corrected gravity
     g = mm_effg(z)
     ! Knudsen number
     kn = mm_kboltz*t/(p*4._mm_wp*sqrt(2._mm_wp)*mm_pi*ra**2)/rad
     ! Air viscosity
+    nu=nu0*sqrt(t/293._mm_wp)*(1._mm_wp+c/293._mm_wp)/(1._mm_wp+c/t)
+    REAL(kind=mm_wp) :: Us, Fc
+    ! Computes Stokes settling velocity
+    Us = (2._mm_wp * rad**2 * rho * mm_effg(z)) / (9._mm_wp * mm_eta_g(t))
+    ! Apply slip-flow correction
+    Fc = 1 + (mm_akn * mm_lambda_g(t,p) / rad)
     ! Computes settling velocity
+    w = 2._mm_wp/9._mm_wp * rad**2*g*rho/nu
+    ! apply slip-flow correction
+    w = w*(1._mm_wp+1.2517_mm_wp*kn+0.4_mm_wp*kn*dexp(-1.1_mm_wp/kn))
+    w = Us * Fc
+    !>>> [TEMPO : BBT]
+    !w = Us * Fc * 5.
+    !<<< [TEMPO : BBT]
   END FUNCTION wsettle
 …
     !!
     !! @note
     !! The computed flux is always positive.
+    !! The computed flux is always positive.
     REAL(kind=mm_wp), INTENT(in)               :: rho
       !! Tracer density (\(kg.m^{-3}\)).
+    !! Tracer density (\(kg.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: m3
       !! Vertical profile of the total volume of tracer (i.e. M3) from __TOP__ to __GROUND__ (\(m^{3}.m^{-3}\)).
+    !! Vertical profile of the total volume of tracer (i.e. M3) from __TOP__ to __GROUND__ (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(SIZE(m3)) :: flx
       !! Mass sedimentation fluxes at each layer from __TOP__ to __GROUND__ (\(kg.m^{-2}.s^{-1}\)).
+    !! Mass sedimentation fluxes at each layer from __TOP__ to __GROUND__ (\(kg.m^{-2}.s^{-1}\)).
     REAL(kind=mm_wp), SAVE :: fac = 4._mm_wp/3._mm_wp * mm_pi
     flx = fac * rho * m3 * wsettle(mm_play,mm_temp,mm_zlay,mm_drho,mm_drad)

trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90

-                      r2242
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: Parameters and global variables module.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 MODULE MM_GLOBALS
   !! Parameters and global variables module.
   !!
+  !!
   !! # Module overview
   !!
   !! The module defines all the parameters and global variables that are common
   !! to all other modules of the library.
   !!
+  !!
   !! It is separated in two parts :
   !!
 …
   !!   method.
   !! - The second part defines a set of vectors that defines the vertical structure of the atmosphere.
   !!   Each time a new atmospheric column has to be computed (either on a new timestep or on a new couple
   !!   of longitude/latitude), these vectors should be intialized with new values by calling
   !!   [[mm_globals(module):mm_column_init(function)]] method.
   !!   This part is separated in two sets :
   !!
   !!   - The atmospheric structure with temperature, pressure levels and altitude definitions.
   !!   - The vertical profiles of tracers with the moments of the two aerosols modes (both \(M_{0}\)
   !!     and \(M_{3}\) for a total of 4 vectors), the _clouds_ microphysics moments tracers (i.e.
+  !!   Each time a new atmospheric column has to be computed (either on a new timestep or on a new couple
+  !!   of longitude/latitude), these vectors should be intialized with new values by calling
+  !!   [[mm_globals(module):mm_column_init(function)]] method.
+  !!   This part is separated in two sets :
+  !!
+  !!   - The atmospheric structure with temperature, pressure levels and altitude definitions.
+  !!   - The vertical profiles of tracers with the moments of the two aerosols modes (both \(M_{0}\)
+  !!     and \(M_{3}\) for a total of 4 vectors), the _clouds_ microphysics moments tracers (i.e.
   !!     \(M_{0}\) and \(M_{3}\) for the ccn and \(M_{3}\) for the ice components).
   !!     Additionally, the module also stores intermediates variables of interest such as the
   !!     characteristic radii of the aerosols modes, the mean drop radius and the drop density,
+  !!     Additionally, the module also stores intermediates variables of interest such as the
+  !!     characteristic radii of the aerosols modes, the mean drop radius and the drop density,
   !!     the molar fraction of each condensible species (related to ice components) and some
   !!     scalar variables that holds arrays sizes.
   !!
   !! @note
   !! All the vectors that represent the vertical structure of the atmosphere (altitude, pressure and
+  !! All the vectors that represent the vertical structure of the atmosphere (altitude, pressure and
   !! temperature...) are oriented from the __TOP__ of the atmosphere to the __GROUND__.
   !!
   !! @note
   !! The module also imports errors module from __FCCP__ library to get definitions of the error object
+  !! @note
+  !! The module also imports errors module from __SWIFT__ library to get definitions of the error object
   !! everywhere in the library ([[mm_globals(module)]] is always imported, except in [[mm_mprec(module)]]).
   !!
   !! # Global variables
+  !! # Global variables
   !!
   !! [[mm_globals(module)]] module contains the declaration of all global/common variable that are shared
 …
   !! the following sections list all the global variables by category.
   !!
   !! ## Control flags
   !!
+  !! ## Control flags
+  !!
   !! | Name               | Description
   !! | :----------------- | :-----------------
 …
   !! | mm_w_clouds_sed    | Enable/Disable clouds microphysics sedimentation
   !! | mm_w_clouds_nucond | Enable/Disable clouds microphysics nucleation/condensation
   !! | mm_wsed_m0         | Force all aerosols moments to fall at M0 settling velocity
+  !! | mm_wsed_m0         | Force all aerosols moments to fall at M0 settling velocity
   !! | mm_wsed_m3         | Force all aerosols moments to fall at M3 settling velocity
   !! | mm_no_fiadero_w    | Enable/Disable __Fiadero__ correction
 …
   !! | Name            | Description
   !! | :-------------- | :-----------------
   !! | mm_fiadero_min  | Minimum ratio for __Fiadero__'s correction
+  !! | mm_fiadero_min  | Minimum ratio for __Fiadero__'s correction
   !! | mm_fiadero_max  | Maximum ratio for __Fiadero__'s correction
   !! | mm_coag_choice  | Coagulation interaction activation flag. It should be a combination of [[mm_globals(module):mm_coag_no(variable)]], [[mm_globals(module):mm_coag_ss(variable)]], [[mm_globals(module):mm_coag_sf(variable)]] and [[mm_globals(module):mm_coag_ff(variable)]].
   !!
   !! ## Physical constants
+  !! | mm_coag_choice  | Coagulation interaction activation flag. It should be a combination of [[mm_globals(module):mm_coag_no(variable)]], [[mm_globals(module):mm_coag_ss(variable)]], [[mm_globals(module):mm_coag_sf(variable)]] and [[mm_globals(module):mm_coag_ff(variable)]].
+  !!
+  !! ## Physical constants
   !!
   !! | Name      | Description
 …
   !! | mm_w_prod   | Angular frequency of the time-dependent production rate.
   !! | mm_ne       | Electric charging of aerosols (\(e^{-}.m^{-1}\)) (unused)
   !! | mm_rb2ra    | Bulk to apparent radius conversion pre-factor (\(m^X\))
+  !! | mm_rb2ra    | Bulk to apparent radius conversion pre-factor (\(m^X\))
   !! | mm_rpla     | Planet radius (m)
   !! | mm_g0       | Planet acceleration due to gravity constant (ground) (\(m.s^{-2}\))
 …
   ! the following variables are read-only outside this module.
   ! One must call the afferent subroutine to update them.
   ! initialization control flags (cannot be updated)
   PROTECTED :: mm_ini,mm_ini_col,mm_ini_aer,mm_ini_cld
 …
   ! Moments parameters (derived, are updated with moments parameters)
   PROTECTED :: mm_rcs, mm_rcf, mm_drad, mm_drho
+  LOGICAL, SAVE :: mm_debug = .true.  !! Enable QnD debug mode (can be used for devel).
+  LOGICAL, SAVE :: mm_log = .false.   !! Enable log mode (for configuration only).
+  ! Thresholds parameters
+  PROTECTED :: mm_m0as_min, mm_m3as_min, mm_rcs_min, mm_m0af_min, mm_m3af_min, mm_rcf_min, mm_m0n_min, mm_m3cld_min
+  LOGICAL, SAVE :: mm_debug = .false.  !! Enable QnD debug mode (can be used for devel).
+  LOGICAL, SAVE :: mm_log   = .false.   !! Enable log mode (for configuration only).
   LOGICAL, SAVE :: mm_w_haze_prod = .true. !! Enable/Disable haze production.
 …
   !> Enable/Disable __Fiadero__'s correction.
   !!
   !! This flag enables/disables the __Fiadero__ correction alogrithm for fractal mode settling velocity
   !! computation.
+  !! This flag enables/disables the __Fiadero__ correction alogrithm for fractal mode settling velocity
+  !! computation.
   !!
   !! @bug
   !! Currently, the Fiadero correction creates instatibilities on the vertical structure. It seems to be
+  !! Currently, the Fiadero correction creates instatibilities on the vertical structure. It seems to be
   !! related to the coupling between the two moments. In order to reduce the instabilities, settling
   !! velocity of moments are forced to be the same, see [[mm_globals(module):mm_wsed_m0(variable)]] and
   !! [[mm_globals(module):mm_wsed_m3(variable)]]).
   LOGICAL, SAVE          :: mm_no_fiadero_w = .false.
+  LOGICAL, SAVE          :: mm_no_fiadero_w = .false.
   !> Minimum ratio for __Fiadero__ correction.
   !!
   !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the minimum
+  !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the minimum
   !! value of the moment's ratio between two adjacents vertical cells to be used within the correction.
   REAL(kind=mm_wp), SAVE :: mm_fiadero_min  = 0.1_mm_wp
 …
   !> Maximum ratio for __Fiadero__ correction.
   !!
   !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the maximum
+  !! When [[mm_globals(module):mm_no_fiadero_w(variable)]] is disabled, this variable defines the maximum
   !! value of the moment's ratio between two adjacents vertical cells to be used within the correction.
   REAL(kind=mm_wp), SAVE :: mm_fiadero_max  = 10._mm_wp
 …
   INTEGER, PARAMETER :: mm_coag_ff = 4 !! FF mode interaction for coagulation.
   !> Default interactions to activate (all by default).
   INTEGER, SAVE      :: mm_coag_choice = mm_coag_ss+mm_coag_sf+mm_coag_ff
+  INTEGER, SAVE      :: mm_coag_choice = mm_coag_ss+mm_coag_sf+mm_coag_ff
   !> Pi number.
   REAL(kind=mm_wp), PARAMETER :: mm_pi = 4._mm_wp*atan(1._mm_wp)
   !> Avogadro number.
   REAL(kind=mm_wp), PARAMETER :: mm_navo = 6.0221367e23_mm_wp
+  REAL(kind=mm_wp), PARAMETER :: mm_navo = 6.0221367e23_mm_wp
   !> Boltzmann constant (\(J.K^{-1}\)).
   REAL(kind=mm_wp), PARAMETER :: mm_kboltz = 1.3806488e-23_mm_wp
 …
   !> Bulk to apparent radius conversion pre-factor (\(m^{X}\)).
   !!
   !! It is initialized using [[mm_globals(module):mm_rm(variable)]] in
+  !!
+  !! It is initialized using [[mm_globals(module):mm_rm(variable)]] in
   !! [[mm_globals(module):mm_global_init(interface)]] from the following equation:
   !!
   !! $$ r_{a} = r_{b}^{3/D_{f}}\times r_{m}^{\frac{D_{f}-3}{D_{f}}} $$
   !!
   !! Where \(r_{a}\) is the apparent radius, \(r_{b}\) the bulk radius and
+  !! Where \(r_{a}\) is the apparent radius, \(r_{b}\) the bulk radius and
   !! \(rb2ra = r_{m}^{\frac{D_{f}-3}{D_{f}}}\) is the returned pre-factor
+  REAL(kind=mm_wp), SAVE :: mm_rb2ra = 1._mm_wp
+  REAL(kind=mm_wp), SAVE :: mm_rb2ra = 1._mm_wp
+  ! Thresholds !
+  !> (min.) Total number of aerosols minimum threshold for the spherical mode.
+  REAL(kind=mm_wp), SAVE :: mm_m0as_min = 1.e-10_mm_wp
+  !> (min.) Total volume of aerosols minimum threshold for the spherical mode.
+  REAL(kind=mm_wp), SAVE :: mm_m3as_min = 1.e-40_mm_wp
+  !> Characteristic radius minimum threshold for the spherical mode.
+  REAL(kind=mm_wp), SAVE :: mm_rcs_min = 1.e-9_mm_wp
+  !> (min.) Total number of aerosols minimum threshold for the fractal mode.
+  REAL(kind=mm_wp), SAVE :: mm_m0af_min = 1.e-10_mm_wp
+  !> (min.) Total volume of aerosols minimum threshold for the fractal mode.
+  REAL(kind=mm_wp), SAVE :: mm_m3af_min = 1.e-40_mm_wp
+  !> Characteristic radius minimum threshold for the fractal mode.
+  REAL(kind=mm_wp), SAVE :: mm_rcf_min = 1.e-9_mm_wp
+  !> (min.) Total number of cloud drop minimum threshold.
+  REAL(kind=mm_wp), SAVE :: mm_m0n_min = 1.e-10_mm_wp
+  !> (min.) Total volume of cloud drop minimum threshold.
+  REAL(kind=mm_wp), SAVE :: mm_m3cld_min = 1.e-40_mm_wp
   !> Characteristic radius threshold.
   REAL(kind=mm_wp), SAVE :: mm_rc_min = 1.e-200_mm_wp
+  !> Minimum cloud drop radius
+  REAL(kind=mm_wp), SAVE :: mm_drad_min = 1.e-9_mm_wp
+  !> Maximum cloud drop radius
+  REAL(kind=mm_wp), SAVE :: mm_drad_max = 1.e-3_mm_wp
   !> Name of condensible species.
 …
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_temp
   !>  Air density vertical profile (\(kg.m^{-3}\)).
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rhoair
+  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_rhoair
   !> Temperature vertical profil at interfaces (K).
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_btemp
   !> Atmospheric levels thickness (m).
   !!
   !! Atmospheric thickness between two adjacent levels (\(m\)) from the
+  !!
+  !! Atmospheric thickness between two adjacent levels (\(m\)) from the
   !! __TOP__ to the __GROUND__.
   !! @note __mm_dzlev__ is defined on the total number of layers and actually
 …
   !> Atmospheric layers "thickness" (m).
   !!
+  !!
   !! Atmospheric thickness between the center of two adjacent layers (\(m\))
   !! from the __TOP__ to the __GROUND__.
   !! @note
   !! __mm_dzlay__ is defined on the total number of layers. The last
+  !! @note
+  !! __mm_dzlay__ is defined on the total number of layers. The last
   !! value of __mm_dzlay__ is set to twice the altitude of the ground layer.
   !! @note This value corresponds to the thickness between the center of the
+  !! @note This value corresponds to the thickness between the center of the
   !! __GROUND__ layer and below the surface. It is arbitrary and not used.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_dzlay
 …
   !> Ice components 3rd order moments (\(m^{3}.m^{-3}\)).
   !!
   !! It is a 2D array with the vertical layers in first dimension, and the number of ice
+  !! It is a 2D array with the vertical layers in first dimension, and the number of ice
   !! components in the second.
   !! @note
+  !! @note
   !! Both [[mm_globals(module):mm_m3ice(variable)]] and [[mm_globals(module):mm_gazs(variable)]]
   !! share the same indexing (related to species order).
 …
   !!
   !! It is a 2D array with the vertical layers in first dimension, and
   !! the number of condensible species in the second.
   !! @note
+  !! the number of condensible species in the second.
+  !! @note
   !! Both [[mm_globals(module):mm_m3ice(variable)]] and [[mm_globals(module):mm_gazs(variable)]]
   !! share the same indexing (related to species order).
 …
   !> Spherical mode \(M_{0}\) settling velocity (\(m.s^{-1}\)).
   !!
   !! It is a vector with the vertical layers that contains the settling velocity for
+  !! It is a vector with the vertical layers that contains the settling velocity for
   !! the \(0^{th}\) order moment of the spherical mode.
   !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
   !! @note
+  !! @note
   !! This variable is always negative.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0as_vsed
 …
   !> Spherical mode \(M_{3}\) settling velocity (\(m.s^{-1}\)).
   !!
   !! It is a vector with the vertical layers that contains the settling velocity for the
+  !! It is a vector with the vertical layers that contains the settling velocity for the
   !! \(3^{rd}\) order moment of the spherical mode.
   !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
   !! @note
+  !! @note
   !! This variable is always negative.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3as_vsed
 …
   !> Fractal mode \(M_{0}\) settling velocity (\(m.s^{-1}\)).
   !!
   !! It is a vector with the vertical layers that contains the settling velocity for the
+  !! It is a vector with the vertical layers that contains the settling velocity for the
   !! \(0^{th}\) order moment of the fractal mode.
   !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
   !! @note
+  !! @note
   !! This variable is always negative.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m0af_vsed
 …
   !> Fractal mode \(M_{3}\) settling velocity (\(m.s^{-1}\)).
   !!
   !! It is a vector with the vertical layers that contains the settling velocity for the
+  !! It is a vector with the vertical layers that contains the settling velocity for the
   !! \(3^{rd}\) order moment of the fractal mode.
   !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
   !! @note
+  !! @note
   !! This variable is always negative.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_m3af_vsed
 …
   !! It is a vector with the vertical layers that contains the mass fluxes for spherical aerosols.
   !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
   !! @note
+  !! @note
   !! This variable is always negative.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_aer_s_flux
 …
   !! It is a vector with the vertical layers that contains the mass fluxes for fractal aerosols
   !! It is updated in [[mm_haze(module):mm_haze_sedimentation(subroutine)]].
   !! @note
+  !! @note
   !! This variable is always negative.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_aer_f_flux
 …
   REAL(kind=mm_wp), SAVE :: mm_ccn_prec = 0._mm_wp
   !> CCN mass fluxes (\(kg.m^{-2}.s^{-1}\)).
   !!
   !! It is a vector with the vertical layers that contains the
   !! mass fluxes for CCN.
+  !> CCN settling velocity (\(m.s^{-1}\)).
+  !!
+  !! It is a vector with the vertical layers that contains the
+  !! settling velocity for CCN (and ices).
   !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
   !! @note
+  !! This variable is always negative.
+  !! This variable is always positive.
+  REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_ccn_w
+  !> CCN mass fluxes (\(kg.m^{-2}.s^{-1}\)).
+  !!
+  !! It is a vector with the vertical layers that contains the
+  !! mass fluxes for CCN.
+  !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
+  !! @note
+  !! This variable is always positive.
   REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE, SAVE :: mm_ccn_flux
   !> Ice components precipitations (m).
   !!
   !! It is a vector of [[mm_globals(module):mm_nesp(variable)]] values which share the same indexing
+  !! It is a vector of [[mm_globals(module):mm_nesp(variable)]] values which share the same indexing
   !! than [[mm_globals(module):mm_m3ice(variable)]] and [[mm_globals(module):mm_gazs(variable)]].
   !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
 …
   !> Ice components sedimentation fluxes (\(kg.m^{-2}.s-1\)).
   !!
   !! It is a 2D-array with the vertical layers in first dimension and the number of ice components
+  !! It is a 2D-array with the vertical layers in first dimension and the number of ice components
   !! in the second. It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
   !! @note
 …
   !> Condensible species saturation ratio (--).
   !!
   !! It is a 2D-array with the vertical layers in first dimension and the number of condensible
+  !! It is a 2D-array with the vertical layers in first dimension and the number of condensible
   !! species in the second.
   !! It is updated in [[mm_clouds(module):mm_cloud_microphysics(subroutine)]].
 …
   INTERFACE mm_cloud_properties
     MODULE PROCEDURE cldprop_sc,cldprop_ve
   END INTERFACE
+  END INTERFACE mm_cloud_properties
   !> Interface to global initialization.
 …
   !! The method performs the global initialization of the model.
   !! @warning
   !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
+  !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
   !! initializes global variable that are not thread private.
   !!
+  !! '''
+  !! !$OMP SINGLE
+  !! call mm_global_init(...)
+  !! !$OMP END SINGLE
+  !!   !$OMP SINGLE
+  !!   call mm_global_init(...)
+  !!   !$OMP END SINGLE
   INTERFACE mm_global_init
     MODULE PROCEDURE mm_global_init_0,mm_global_init_1
   END INTERFACE
+  END INTERFACE mm_global_init
   !> Check an option from the configuration system.
 …
   !! set a default value if the option is not found. This is an overloaded method
   !! that can take in input either a floating point, integer, logical or string
   !! option value.
+  !! option value.
   INTERFACE mm_check_opt
     MODULE PROCEDURE check_r1,check_i1,check_l1,check_s1
   END INTERFACE
+  END INTERFACE mm_check_opt
   ! --- OPENMP ---------------
   ! All variable related to column computations should be private to each thread
+  ! All variables related to column computations should be private to each thread
+  !
   !$OMP THREADPRIVATE(mm_ini_col,mm_ini_aer,mm_ini_cld)
 …
   !$OMP THREADPRIVATE(mm_m0ccn,mm_m3ccn,mm_m3ice,mm_gazs)
   !$OMP THREADPRIVATE(mm_rcs,mm_rcf,mm_drad,mm_drho)
   !$OMP THREADPRIVATE(mm_aer_s_flux,mm_aer_f_flux,mm_ccn_flux,mm_ice_prec,mm_ice_fluxes,mm_gazs_sat)
+  !$OMP THREADPRIVATE(mm_aer_s_flux,mm_aer_f_flux,mm_ccn_w,mm_ccn_flux,mm_ice_prec,mm_ice_fluxes,mm_gazs_sat)
   !$OMP THREADPRIVATE(mm_m0as_vsed,mm_m3as_vsed,mm_m0af_vsed,mm_m3af_vsed)
+  !$OMP THREADPRIVATE(mm_m0as_min,mm_m3as_min,mm_rcs_min,mm_m0af_min,mm_m3af_min,mm_rcf_min,mm_m0n_min,mm_m3cld_min)
   !$OMP THREADPRIVATE(mm_nla,mm_nle)
 …
+  CONTAINS
+CONTAINS
   FUNCTION mm_global_init_0(dt,df,rm,rho_aer,p_prod,tx_prod,rc_prod,rplanet,g0, &
+                            air_rad,air_mmol,coag_interactions,clouds,spcfile,  &
+                            w_haze_prod,w_haze_sed,w_haze_coag,w_cloud_nucond,  &
+                            w_cloud_sed,force_wsed_to_m0,force_wsed_to_m3,      &
+                            no_fiadero,fiadero_min,fiadero_max) RESULT(err)
+    air_rad,air_mmol,coag_interactions,clouds,spcfile,  &
+    w_haze_prod,w_haze_sed,w_haze_coag,w_cloud_nucond,  &
+    w_cloud_sed,force_wsed_to_m0,force_wsed_to_m3,      &
+    no_fiadero,fiadero_min,fiadero_max,                 &
+    m0as_min,rcs_min,m0af_min,rcf_min,m0n_min,debug) RESULT(err)
     !! Initialize global parameters of the model.
     !!
+    !!
     !! The function initializes all the global parameters of the model from direct input.
     !! Boolean (and Fiadero) parameters are optional as they are rather testing parameters. Their
     !! default values are suitable for production runs.
+    !! Boolean, Fiadero and thresholds parameters are optional as they are rather testing parameters.
+    !! Their default values are suitable for production runs.
     !! @note
     !! If the method fails to initialize parameters (i.e. returned error is not 0). Then the model
     !! should probably be aborted as the global variables of the model will not be correctly setup.
     !! @warning
+    !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
+    !! initializes global variable that are not thread private.
+    !!
+    !! '''
+    !! !$OMP SINGLE
+    !! call mm_global_init_0(...)
+    !! !$OMP END SINGLE
+    !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
+    !! initializes (only) global variables that are not thread private.
+    !!
+    !!   !$OMP SINGLE
+    !!   call mm_global_init_0(...)
+    !!   !$OMP END SINGLE
     REAL(kind=mm_wp), INTENT(in)           :: dt
       !! Microphysics timestep in seconds.
+    !! Microphysics timestep in seconds.
     REAL(kind=mm_wp), INTENT(in)           :: df
       !! Fractal dimension of fractal aerosol.
+    !! Fractal dimension of fractal aerosol.
     REAL(kind=mm_wp), INTENT(in)           :: rm
       !! Monomer radius in meter.
+    !! Monomer radius in meter.
     REAL(kind=mm_wp), INTENT(in)           :: rho_aer
       !! Aerosol density in \(kg.m^{-3}\).
+    !! Aerosol density in \(kg.m^{-3}\).
     REAL(kind=mm_wp), INTENT(in)           :: p_prod
       !!  Aerosol production pressure level in Pa.
+    !!  Aerosol production pressure level in Pa.
     REAL(kind=mm_wp), INTENT(in)           :: tx_prod
       !! Spherical aerosol mode production rate in \(kg.m^{-2}.s^{-1}\).
+    !! Spherical aerosol mode production rate in \(kg.m^{-2}.s^{-1}\).
     REAL(kind=mm_wp), INTENT(in)           :: rc_prod
       !! Spherical mode characteristic radius for production in meter.
+    !! Spherical mode characteristic radius for production in meter.
     REAL(kind=mm_wp), INTENT(in)           :: rplanet
       !! Planet radius in meter
+    !! Planet radius in meter
     REAL(kind=mm_wp), INTENT(in)           :: g0
       !! Planet gravity acceleration at ground level in \(m.s^{-2}\).
+    !! Planet gravity acceleration at ground level in \(m.s^{-2}\).
     REAL(kind=mm_wp), INTENT(in)           :: air_rad
       !! Air molecules mean radius in meter.
+    !! Air molecules mean radius in meter.
     REAL(kind=mm_wp), INTENT(in)           :: air_mmol
       !! Air molecules mean molar mass in \(kg.mol^{-1}\).
+    !! Air molecules mean molar mass in \(kg.mol^{-1}\).
     INTEGER, INTENT(in)                    :: coag_interactions
       !! Coagulation interactions process control flag.
+    !! Coagulation interactions process control flag.
     LOGICAL, INTENT(in)                    :: clouds
       !! Clouds microphysics control flag.
+    !! Clouds microphysics control flag.
     CHARACTER(len=*), INTENT(in)           :: spcfile
       !! Clouds microphysics condensible species properties file.
+    !! Clouds microphysics condensible species properties file.
     REAL(kind=mm_wp), INTENT(in), OPTIONAL :: fiadero_max
       !! Maximum moment ratio threshold for Fiadero correction (default: 10.) .
+    !! Maximum moment ratio threshold for Fiadero correction (default: 10.) .
     REAL(kind=mm_wp), INTENT(in), OPTIONAL :: fiadero_min
       !! Minimum moment ratio threshold for Fiadero correction (default: 0.1).
+    !! Minimum moment ratio threshold for Fiadero correction (default: 0.1).
     LOGICAL, INTENT(in), OPTIONAL          :: w_haze_prod
       !! Haze microphysics production process control flag (default: T).
+    !! Haze microphysics production process control flag (default: T).
     LOGICAL, INTENT(in), OPTIONAL          :: w_haze_sed
       !! Haze microphysics sedimentation process control flag (default: T).
+    !! Haze microphysics sedimentation process control flag (default: T).
     LOGICAL, INTENT(in), OPTIONAL          :: w_haze_coag
       !! Haze microphysics coagulation process control flag (default: T).
+    !! Haze microphysics coagulation process control flag (default: T).
     LOGICAL, INTENT(in), OPTIONAL          :: w_cloud_sed
       !! Cloud microphysics nucleation/conensation process control flag (default: __clouds__ value).
+    !! Cloud microphysics nucleation/conensation process control flag (default: __clouds__ value).
     LOGICAL, INTENT(in), OPTIONAL          :: w_cloud_nucond
       !! Cloud microphysics production process control flag (default: __clouds__ value).
+    !! Cloud microphysics production process control flag (default: __clouds__ value).
     LOGICAL, INTENT(in), OPTIONAL          :: no_fiadero
       !! Disable Fiadero correction for haze sedimentation process (default: F).
+    !! Disable Fiadero correction for haze sedimentation process (default: F).
     LOGICAL, INTENT(in), OPTIONAL          :: force_wsed_to_m0
+      !! force __all__ aerosols moments to fall at M0 settling velocity (default: T).
+    LOGICAL, INTENT(in), OPTIONAL          :: force_wsed_to_m3
+      !! Force __all__ aerosols moments to fall at M3 settling velocity (default: F).
+    !! force __all__ aerosols moments to fall at M0 settling velocity (default: T).
+    LOGICAL, INTENT(in), OPTIONAL          :: force_wsed_to_m3
+    !! Force __all__ aerosols moments to fall at M3 settling velocity (default: F).
+    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: m0as_min
+    !! Minimum threshold for M0 of the spherical mode (default: 1e-10).
+    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: rcs_min
+    !! Minimum threshold for the characteristic radius of the spherical mode in meter (default: 1e-9).
+    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: m0af_min
+    !! Minimum threshold for M0 of the factal mode (default: 1e-10).
+    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: rcf_min
+    !! Minimum threshold for the characteristic radius of the fractal mode in meter (default: _monomer radius_).
+    REAL(kind=mm_wp), INTENT(in), OPTIONAL :: m0n_min
+    !! Minimum threshold for M0 of cloud drop (default: 1e-10).
+    LOGICAL, INTENT(in), OPTIONAL          :: debug
+    !! Debug mode control flag (may print lot of stuff if enabled)
     TYPE(error) :: err
       !! Error status of the function.
+    !! Error status of the function.
     INTEGER                                           :: i
     TYPE(cfgparser)                                   :: cp
-    CHARACTER(len=st_slen)                            :: spcpath
-    CHARACTER(len=:), ALLOCATABLE                     :: defmsg
     CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: species
     REAL(kind=mm_wp)                                  :: zfiamin,zfiamax
     LOGICAL                                           :: zwhp,zwhs,zwhc,zwcs,zwcn,znofia, &
                                                          zwstom0,zwstom3
     zwhp = .true. ; zwhs = .true. ; zwhc = .true.
     zwcs = clouds ; zwcn = clouds
+    zwcs = clouds ; zwcn = clouds
     znofia = .false. ; zfiamin = 0.1_mm_wp ; zfiamax = 10._mm_wp
     zwstom0 = .true. ; zwstom3 = .false.
 …
     ! Store options values in global variables...
     mm_df          = df
     mm_rm          = rm
+    mm_df          = df
+    mm_rm          = rm
     mm_rb2ra       = mm_rm**((mm_df-3._mm_wp)/mm_df) ! conversion factor for bulk -> fractal radius
     mm_rhoaer      = rho_aer
+    mm_rhoaer      = rho_aer
     mm_p_prod      = p_prod
     mm_tx_prod     = tx_prod
 …
     mm_g0          = g0
     mm_dt          = dt
     mm_air_rad     = mm_air_rad
+    mm_air_rad     = air_rad
     mm_air_mmol    = air_mmol
     mm_coag_choice = coag_interactions
 …
       RETURN
     ENDIF
+    ! force fractal radius minimum threshold to monomer radius ^^
+    mm_rcf_min = mm_rm
     mm_w_clouds = clouds
 …
         RETURN
       ENDIF
       ! Reads species properties configuration file
+      ! Reads species properties configuration file
       err = cfg_read_config(cp,TRIM(spcfile)) ; IF (err /= 0) RETURN
       err = cfg_get_value(cp,"used_species",species)
+      err = cfg_get_value(cp,"used_species",species)
       IF (err /= 0) THEN
         err = error("mm_global_init: cannot retrieve 'used_species' values",-1)
 …
       ALLOCATE(mm_spcname(mm_nesp),mm_xESPS(mm_nesp))
       DO i=1,mm_nesp
         mm_spcname(i) = to_lower(species(i))
+        mm_spcname(i) = TRIM(species(i))
         IF(.NOT.cfg_has_section(cp,TRIM(mm_spcname(i)))) THEN
           err = error("mm_global_init: Cannot find "//TRIM(mm_spcname(i))//" properties",-1)
 …
     ! optional flags
+    ! debug mode
+    IF (PRESENT(debug)) THEN
+      mm_debug = debug
+    ELSE
+      mm_debug = .false.
+      call printw("mm_debug",to_string(mm_debug))
+    ENDIF
     ! haze control flags
     IF (PRESENT(w_haze_prod)) THEN
+    IF (PRESENT(w_haze_prod)) THEN
       mm_w_haze_prod = w_haze_prod
     ELSE
       mm_w_haze_prod = zwhp
+    ELSE
+      mm_w_haze_prod = zwhp
       call printw("mm_haze_production",to_string(mm_w_haze_prod))
     ENDIF
     IF (PRESENT(w_haze_sed)) THEN
+    IF (PRESENT(w_haze_sed)) THEN
       mm_w_haze_sed = w_haze_sed
     ELSE
       mm_w_haze_sed = zwhs
+    ELSE
+      mm_w_haze_sed = zwhs
       call printw("mm_haze_sedimentation",to_string(mm_w_haze_sed))
     ENDIF
     IF (PRESENT(w_haze_coag)) THEN
+    IF (PRESENT(w_haze_coag)) THEN
       mm_w_haze_coag = w_haze_coag
     ELSE
+    ELSE
       mm_w_haze_coag = zwhc
       call printw("mm_haze_coagulation",to_string(mm_w_haze_coag))
     ENDIF
     IF (PRESENT(force_wsed_to_m0)) THEN
+    IF (PRESENT(force_wsed_to_m0)) THEN
       mm_wsed_m0 = force_wsed_to_m0
     ELSE
+    ELSE
       mm_wsed_m0 = zwstom0
       call printw("mm_wsed_m0",to_string(mm_wsed_m0))
     ENDIF
     IF (PRESENT(force_wsed_to_m3)) THEN
+    IF (PRESENT(force_wsed_to_m3)) THEN
       mm_wsed_m3 = force_wsed_to_m3
     ELSE
+    ELSE
       mm_wsed_m3 = zwstom3
       call printw("mm_wsed_m3",to_string(mm_wsed_m3))
     ENDIF
     IF (PRESENT(no_fiadero)) THEN
+    IF (PRESENT(no_fiadero)) THEN
       mm_no_fiadero_w = no_fiadero
     ELSE
       mm_no_fiadero_w = znofia
+    ELSE
+      mm_no_fiadero_w = znofia
       call printw("mm_no_fiadero",to_string(mm_no_fiadero_w))
     ENDIF
     IF (PRESENT(fiadero_min)) THEN
+    IF (PRESENT(fiadero_min)) THEN
       mm_fiadero_min = fiadero_min
     ELSE
+    ELSE
       mm_fiadero_min = zfiamin
       call printw("mm_fiadero_min",to_string(mm_fiadero_min))
     ENDIF
     IF (PRESENT(fiadero_max)) THEN
+    IF (PRESENT(fiadero_max)) THEN
       mm_fiadero_max = fiadero_max
     ELSE
+    ELSE
       mm_fiadero_max = zfiamax
       call printw("mm_fiadero_max",to_string(mm_fiadero_max))
     ENDIF
+    ! moments threshold flags
+    IF (PRESENT(m0as_min)) THEN
+      mm_m0as_min = MAX(0._mm_wp,m0as_min)
+    ELSE
+      call printw("mm_m0as_min",to_string(mm_m0as_min))
+    ENDIF
+    IF (PRESENT(rcs_min)) THEN
+      mm_rcs_min = MAX(1.e-9_mm_wp,rcs_min)
+    ELSE
+      call printw("mm_rcs_min",to_string(mm_rcs_min))
+    ENDIF
+    IF (PRESENT(m0af_min)) THEN
+      mm_m0af_min = MAX(0._mm_wp,m0af_min)
+    ELSE
+      call printw("mm_m0af_min",to_string(mm_m0af_min))
+    ENDIF
+    IF (PRESENT(rcf_min)) THEN
+      mm_rcf_min = MAX(rcf_min,mm_rm)
+    ELSE
+      mm_rcf_min = mm_rm
+      call printw("mm_rcf_min",to_string(mm_rcf_min))
+    ENDIF
+    IF (PRESENT(m0n_min)) THEN
+      mm_m0n_min = MAX(0._mm_wp,m0n_min)
+    ELSE
+      call printw("mm_m0n_min",to_string(mm_m0n_min))
+    ENDIF
+    ! compute m3 thresholds from user-defined thresholds.
+    mm_m3as_min  =  mm_m0as_min*mm_alpha_s(3._mm_wp) * mm_rcs_min**3._mm_wp
+    mm_m3af_min  =  mm_m0af_min*mm_alpha_f(3._mm_wp) * mm_rcf_min**3._mm_wp
+    mm_m3cld_min =  mm_m0n_min * (4._mm_wp * mm_pi / 3._mm_wp) * mm_drad_min**3._mm_wp
     ! clouds control flags
     IF (mm_w_clouds) THEN
       IF (PRESENT(w_cloud_sed)) THEN
+      IF (PRESENT(w_cloud_sed)) THEN
         mm_w_cloud_sed = w_cloud_sed
       ELSE
         mm_w_cloud_sed = zwcs
         call printw("mm_cloud_sed",to_string(mm_w_cloud_sed))
+      ELSE
+        mm_w_cloud_sed = zwcs
+        call printw("mm_cloud_sed",to_string(mm_w_cloud_sed))
       ENDIF
       IF (PRESENT(w_cloud_nucond)) THEN
+      IF (PRESENT(w_cloud_nucond)) THEN
         mm_w_cloud_nucond = w_cloud_nucond
       ELSE
+      ELSE
         mm_w_cloud_nucond = zwcs
         call printw("mm_cloud_nucond",to_string(mm_w_cloud_nucond))
+        call printw("mm_cloud_nucond",to_string(mm_w_cloud_nucond))
       ENDIF
     ENDIF
 …
     mm_ini = err == noerror
     CONTAINS
+  CONTAINS
     SUBROUTINE printw(string,value)
 …
       CHARACTER(len=*), INTENT(in) :: value  !! (string) Value of the option.
       IF (mm_log) &
       WRITE(*,'(a,a,a)') "warning: Parameter "//string//"not given... Using default value: "//value
     END SUBROUTINE printw
+        WRITE(*,'(a,a,a)') "warning: Parameter "//string//"not given... Using default value: "//value
+    END SUBROUTINE printw
   END FUNCTION mm_global_init_0
 …
     !!
     !! See [[mm_globals(module):mm_global_init_0(function)]].
+    TYPE(cfgparser), INTENT(in) :: cfg  !! Configuration file path.
+    TYPE(error) :: err                  !! Error status of the function.
+    TYPE(cfgparser), INTENT(in) :: cfg
+    !! Configuration file path.
+    TYPE(error) :: err
+    !! Error status of the function.
     INTEGER                                           :: i
     TYPE(cfgparser)                                   :: spccfg
     CHARACTER(len=st_slen)                            :: spcpath
-    CHARACTER(len=:), ALLOCATABLE                     :: defmsg
     CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: species
     REAL(kind=mm_wp)                                  :: zfiamin,zfiamax
     LOGICAL                                           :: zwhp,zwhs,zwhc,zwcs,zwcn,znofia, &
                                                          zwstom0,zwstom3
+      zwstom0,zwstom3
     err = noerror
 …
       ! Gets species property file path
       err = cfg_get_value(cfg,'specie_cfg',spcpath) ; IF (err /= 0) RETURN
       ! Reads species properties configuration file
+      ! Reads species properties configuration file
       err = cfg_read_config(spccfg,trim(spcpath)) ; IF (err /= 0) RETURN
       err = cfg_get_value(spccfg,"used_species",species)
+      err = cfg_get_value(spccfg,"used_species",species)
       IF (err /= 0) THEN
         err = error("mm_global_init: cannot retrieve 'used_species' values",-1)
 …
       !mm_spcname(1:mm_nesp) = species(:)
       DO i=1,mm_nesp
         mm_spcname(i) = to_lower(species(i))
+        mm_spcname(i) = TRIM(species(i))
         IF (.NOT.cfg_has_section(spccfg,TRIM(mm_spcname(i)))) THEN
           err = error("mm_global_init: Cannot find "//TRIM(mm_spcname(i))//" properties",-1)
 …
     ! MP2M Optional parameters
+    err = mm_check_opt(cfg_get_value(cfg,"debug",mm_debug),mm_debug,.false.,wlog=mm_log)
     err = mm_check_opt(cfg_get_value(cfg,"haze_production",mm_w_haze_prod),mm_w_haze_prod,zwhp,wlog=mm_log)
     err = mm_check_opt(cfg_get_value(cfg,"haze_sedimentation",mm_w_haze_sed),mm_w_haze_sed,zwhs,wlog=mm_log)
 …
     err = mm_check_opt(cfg_get_value(cfg,"fiadero_max_ratio",mm_fiadero_max),mm_fiadero_max,zfiamax,wlog=mm_log)
+    err = mm_check_opt(cfg_get_value(cfg,"m0as_min",mm_m0as_min),mm_m0as_min,1e-10_mm_wp,wlog=mm_log)
+    err = mm_check_opt(cfg_get_value(cfg,"rcs_min",mm_rcs_min),mm_rcs_min,1e-9_mm_wp,wlog=mm_log)
+    err = mm_check_opt(cfg_get_value(cfg,"m0af_min",mm_m0af_min),mm_m0af_min,1e-10_mm_wp,wlog=mm_log)
+    err = mm_check_opt(cfg_get_value(cfg,"rcf_min",mm_rcf_min),mm_rcf_min,mm_rm,wlog=mm_log)
+    err = mm_check_opt(cfg_get_value(cfg,"m0n_min",mm_m0n_min),mm_m0n_min,1e-10_mm_wp,wlog=mm_log)
+    ! force fractal radius minimum threshold to monomer radius ^^
+    mm_rcf_min = MAX(mm_rm,mm_rcf_min)
+    ! compute m3 thresholds from user-defined thresholds.
+    mm_m3as_min  =  mm_m0as_min*mm_alpha_s(3._mm_wp) * mm_rcs_min**3._mm_wp
+    mm_m3af_min  =  mm_m0af_min*mm_alpha_f(3._mm_wp) * mm_rcf_min**3._mm_wp
+    mm_m3cld_min =  mm_m0n_min * (4._mm_wp * mm_pi / 3._mm_wp) * mm_drad_min**3._mm_wp
     err = noerror
     ! special check for settling velocity
 …
   FUNCTION mm_column_init(plev,zlev,play,zlay,temp) RESULT(err)
     !! Initialize vertical atmospheric fields.
     !!
+    !!
     !! This subroutine initializes vertical fields needed by the microphysics:
     !!
     !! 1. Save reversed input field into "local" array
+    !! 1. Save reversed input field into "local" array
     !! 2. Compute thicknesses layers and levels
     !! 3. Interpolate temperature at levels
 …
     !! @attention
     !! All the input vectors should be defined from __GROUND__ to __TOP__ of the atmosphere,
     !! otherwise nasty things will occur in computations.
+    !! otherwise nasty things will occur in computations.
     REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: plev !! Pressure levels (Pa).
     REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: zlev !! Altitude levels (m).
 …
     TYPE(error) :: err                                 !! Error status of the function.
     INTEGER :: i
     mm_ini_col = .false.
+    mm_ini_col = .false.
     err = noerror
     IF (.NOT.mm_ini) THEN
 …
     ! Hydrostatic equilibrium
     mm_rhoair(1:mm_nla) = (mm_plev(2:mm_nle)-mm_plev(1:mm_nla)) / &
                           (mm_effg(mm_zlay)*mm_dzlev)
     mm_ini_col = .true.
+      (mm_effg(mm_zlay)*mm_dzlev)
+    mm_ini_col = .true.
     ! write out profiles (only if BOTH debug and log are enabled).
     IF (mm_log.AND.mm_debug) THEN
 …
   FUNCTION mm_aerosols_init(m0aer_s,m3aer_s,m0aer_f,m3aer_f) RESULT(err)
     !! Initialize clouds tracers vertical grid.
     !!
     !! The subroutine initializes aerosols microphysics tracers columns. It allocates variables if
     !! required and stores input vectors in reversed order. It also computes the characteristic radii
     !! of each mode.
+    !!
+    !! The subroutine initializes aerosols microphysics tracers columns. It allocates variables if
+    !! required and stores input vectors in reversed order. It also computes the characteristic radii
+    !! of each mode.
     !! @note
     !! All the input arguments should be defined from ground to top.
+    !! All the input arguments should be defined from ground to top.
     !!
     !! @attention
     !! [[mm_globals(module):mm_global_init(interface)]] and [[mm_globals(module):mm_column_init(function)]]
     !! must have been called at least once before this method is called. Moreover, this method should be
     !! after each call of [[mm_globals(module):mm_column_init(function)]] to reflect changes in the
+    !! after each call of [[mm_globals(module):mm_column_init(function)]] to reflect changes in the
     !! vertical atmospheric structure.
     REAL(kind=mm_wp), DIMENSION(:), INTENT(in) :: m0aer_s !! \(0^{th}\) order moment of the spherical mode (\(m^{-2}\)).
 …
     mm_m0aer_f = m0aer_f(mm_nla:1:-1)/mm_dzlev(:)
     mm_m3aer_f = m3aer_f(mm_nla:1:-1)/mm_dzlev(:)
+    ! Setup threshold:
+    call mm_set_moments_thresholds()
     ! aerosols characteristic radii
-    ! il faudrait peut etre revoir la gestion des zeros ici et la
-    ! remplacer par une valeur seuil des moments.
+    !
-    !-> JVO 19 : Done. Zero threshold set at espilon from dynamics on the
-    ! input moments in calmufi (safer than here). Might still be some unphysical
-    ! values after the dynamics near the threshold. Could be a could idea to add
-    ! a sanity check filtering too high values of radii.
+    !
-    ! TBD : Add a sanity check for high radii ????
     WHERE(mm_m3aer_s > 0._mm_wp .AND. mm_m0aer_s > 0._mm_wp)
       mm_rcs = mm_get_rcs(mm_m0aer_s,mm_m3aer_s)
 …
   FUNCTION mm_clouds_init(m0ccn,m3ccn,m3ice,gazs) RESULT(err)
     !! Initialize clouds tracers vertical grid.
     !!
     !! The subroutine initializes cloud microphysics tracers columns. It allocates variables if
     !! required and stores input vectors in reversed order. It also computes the mean drop radius
+    !!
+    !! The subroutine initializes cloud microphysics tracers columns. It allocates variables if
+    !! required and stores input vectors in reversed order. It also computes the mean drop radius
     !! and density and allocates diagnostic vectors.
     !! @note
     !! All the input arguments should be defined from ground to top.
+    !! All the input arguments should be defined from ground to top.
     !!
     !! @attention
     !! [[mm_globals(module):mm_global_init(interface)]] and [[mm_globals(module):mm_column_init(function)]]
     !! must have been called at least once before this method is called. Moreover, this method should be
     !! after each call of [[mm_globals(module):mm_column_init(function)]] to reflect changes in the
+    !! after each call of [[mm_globals(module):mm_column_init(function)]] to reflect changes in the
     !! vertical atmospheric structure.
     REAL(kind=mm_wp), DIMENSION(:), INTENT(in)   :: m0ccn !! 0th order moment of the CCN distribution (\(m^{-2}\)).
 …
     !  Actually, mm_nla should always initialized the first time mm_column_init is called, NOT HERE.
     IF (mm_nla < 0)  mm_nla  = SIZE(gazs,DIM=1)
     ! Note:
+    ! Note:
     !   here we could check that mm_nesp is the same size of gazs(DIM=2)
     !   Actually, mm_nesp should be always initialized in mm_global_init, NOT HERE.
 …
     IF (.NOT.ALLOCATED(mm_drho))    ALLOCATE(mm_drho(mm_nla))
     ! Allocate memory for diagnostics
+    IF (.NOT.ALLOCATED(mm_ccn_w)) THEN
+      ALLOCATE(mm_ccn_w(mm_nla)) ; mm_ccn_w(:) = 0._mm_wp
+    ENDIF
     IF (.NOT.ALLOCATED(mm_ccn_flux)) THEN
       ALLOCATE(mm_ccn_flux(mm_nla)) ; mm_ccn_flux(:) = 0._mm_wp
 …
       mm_gazs(:,i)  = gazs(mm_nla:1:-1,i)
     ENDDO
+    ! Setup threshold :
+    call mm_set_moments_cld_thresholds()
     ! drop mean radius
     call mm_cloud_properties(mm_m0ccn,mm_m3ccn,mm_m3ice,mm_drad,mm_drho)
 …
     !! Dump model global parameters on stdout.
     WRITE(*,'(a)')         "========= YAMMS PARAMETERS ============"
+    WRITE(*,'(a,a)')       "mm_fp_precision        : ", mm_wp_s
+    WRITE(*,'(a,L2)')      "mm_debug               : ", mm_debug
     WRITE(*,'(a,L2)')      "mm_w_haze_prod         : ", mm_w_haze_prod
     WRITE(*,'(a,ES14.7)')  "   mm_p_prod           : ", mm_p_prod
 …
     WRITE(*,'(a,L2)')      "mm_w_haze_coag         : ", mm_w_haze_coag
     WRITE(*,'(a,I2.2)')    "   mm_coag_interactions: ", mm_coag_choice
     WRITE(*,'(a,L2)')      "mm_w_haze_sed          : ", mm_w_haze_sed
+    WRITE(*,'(a,L2)')      "mm_w_haze_sed          : ", mm_w_haze_sed
     WRITE(*,'(a,L2)')      "   mm_wsed_m0          : ", mm_wsed_m0
     WRITE(*,'(a,L2)')      "   mm_wsed_m3          : ", mm_wsed_m3
 …
     WRITE(*,'(a,L2)')      "   mm_w_cloud_nucond   : ", mm_w_cloud_nucond
     WRITE(*,'(a)')         "---------------------------------------"
+    WRITE(*,'(a)')         "Thresholds spherical mode"
+    WRITE(*,'(a,ES14.7)')  "  mm_m0as_min          : ", mm_m0as_min
+    WRITE(*,'(a,ES14.7)')  "  mm_rcs_min           : ", mm_rcs_min
+    WRITE(*,'(a)')         "Thresholds fractal mode"
+    WRITE(*,'(a,ES14.7)')  "  mm_m0af_min          : ", mm_m0af_min
+    WRITE(*,'(a,ES14.7)')  "  mm_rcf_min           : ", mm_rcf_min
+    WRITE(*,'(a)')         "Thresholds clouds drop"
+    WRITE(*,'(a,ES14.7)')  "  mm_m0n_min           : ", mm_m0n_min
+    WRITE(*,'(a,ES14.7)')  "  mm_drad_min          : ", mm_drad_min
+    WRITE(*,'(a,ES14.7)')  "  mm_drad_max          : ", mm_drad_max
+    WRITE(*,'(a)')         "---------------------------------------"
     WRITE(*,'(a,ES14.7)')  "mm_dt                  : ", mm_dt
     IF (mm_nla > -1) THEN
 …
   END SUBROUTINE mm_dump_parameters
+  SUBROUTINE mm_set_moments_thresholds()
+    !! Apply minimum threshold for the aerosols moments.
+    !!
+    !! The method resets moments (for both modes and orders, 0 and 3) values to zero if
+    !! their current value is below the minimum threholds.
+    !!
+    !! See also [[mm_globals(module):mm_m0as_min(variable)]], [[mm_globals(module):mm_rcs_min(variable)]],
+    !! [[mm_globals(module):mm_rcf_min(variable)]] and [[mm_globals(module):mm_m0as_min(variable)]].
+    INTEGER :: i
+    DO i=1,mm_nla
+      IF ((mm_m0aer_s(i) < mm_m0as_min) .OR. (mm_m3aer_s(i) < mm_m3as_min)) THEN
+        mm_m0aer_s(i) = 0._mm_wp ! mm_m0as_min
+        mm_m3aer_s(i) = 0._mm_wp ! mm_m0as_min * mm_rcs_min**3._mm_wp * mm_alpha_s(3._mm_wp)
+      ENDIF
+      IF ((mm_m0aer_f(i) < mm_m0af_min) .OR. (mm_m3aer_f(i) < mm_m3af_min)) THEN
+        mm_m0aer_f(i) = 0._mm_wp ! mm_m0af_min
+        mm_m3aer_f(i) = 0._mm_wp ! mm_m0af_min * mm_rcf_min**3._mm_wp * mm_alpha_f(3._mm_wp)
+      ENDIF
+    ENDDO
+  END SUBROUTINE mm_set_moments_thresholds
+  SUBROUTINE mm_set_moments_cld_thresholds()
+    !! Apply minimum threshold for the cloud drop moments.
+    !!
+    !! The method resets moments (for both modes and orders, 0 and 3) values to zero if
+    !! their current value is below the minimum threholds.
+    INTEGER :: i, j
+    REAL(kind=mm_wp) :: m3cld
+    DO i = 1, mm_nla
+      m3cld = mm_m3ccn(i)
+      DO j = 1, mm_nesp
+        m3cld = m3cld + mm_m3ice(i,j)
+      ENDDO
+      IF ((mm_m0ccn(i) < mm_m0n_min) .OR. (m3cld < mm_m3cld_min)) THEN
+        mm_m0ccn(i) = 0._mm_wp
+        mm_m3ccn(i) = 0._mm_wp
+        DO j = 1, mm_nesp
+          mm_m3ice(i,j) = 0._mm_wp
+        ENDDO
+      ENDIF
+    ENDDO
+  END SUBROUTINE mm_set_moments_cld_thresholds
+  ELEMENTAL SUBROUTINE mm_check_tendencies(v,dv)
+    !! Check that tendencies is not greater than value.
+    !!
+    !! the purpose of the subroutine is to update dvalue so that v+dv is not negative.
+    REAL(kind=mm_wp), INTENT(in)    :: v  !! Value to check.
+    REAL(kind=mm_wp), INTENT(inout) :: dv !! Value tendencies to check and update consequently.
+    REAL(kind=mm_wp), PARAMETER :: a = (epsilon(1._mm_wp)-1._mm_wp)
+    IF (v+dv < 0._mm_wp) THEN
+      dv = a*v
+    ENDIF
+  END SUBROUTINE mm_check_tendencies
   ELEMENTAL FUNCTION mm_get_rcs(m0,m3) RESULT(res)
     !! Get the characteristic radius for the spherical aerosols size distribution.
     !!
+    !!
     !! The method computes the characteristic radius of the size distribution law
     !! of the spherical aerosols mode according to its moments and its inter-moments
     !! relation.
     REAL(kind=mm_wp), INTENT(in) :: m0 !! \(0^{th}\) order moment
+    REAL(kind=mm_wp), INTENT(in) :: m0 !! \(0^{th}\) order moment
     REAL(kind=mm_wp), INTENT(in) :: m3 !! \(3^{rd}\) order moment
     REAL(kind=mm_wp) :: res            !! Radius
-    ! arbitrary: if there is no way to compute radius
-    IF (m3 <= 0._mm_wp .OR. m0 <= 0._mm_wp) res = 1._mm_wp
     res = (m3/m0/mm_alpha_s(3._mm_wp))**(1._mm_wp/3._mm_wp)
   END FUNCTION mm_get_rcs
 …
   ELEMENTAL FUNCTION mm_get_rcf(m0,m3) RESULT(res)
     !! Get the characteristic radius for the fractal aerosols size distribution.
     !!
+    !!
     !! The method computes the characteristic radius of the size distribution law
     !! of the fractal aerosols mode according to its moments and its inter-moments
     !! relation.
     REAL(kind=mm_wp), INTENT(in) :: m0 !! \(0^{th}\) order moment
+    REAL(kind=mm_wp), INTENT(in) :: m0 !! \(0^{th}\) order moment
     REAL(kind=mm_wp), INTENT(in) :: m3 !! \(3^{rd}\) order moment
     REAL(kind=mm_wp) :: res            !! Radius
-    ! arbitrary: if there is no way to compute radius
-    IF (m3 <= 0._mm_wp .OR. m0 <= 0._mm_wp) res = 1._mm_wp
     res = (m3/m0/mm_alpha_f(3._mm_wp))**(1._mm_wp/3._mm_wp)
   END FUNCTION mm_get_rcf
   ELEMENTAL FUNCTION mm_effg(z) RESULT(effg)
+  ELEMENTAL FUNCTION mm_effg(z) RESULT(effg)
     !! Compute effective gravitational acceleration.
     REAL(kind=mm_wp), INTENT(in) :: z !! Altitude in meters
 …
     IF (mm_use_effg) effg = effg * (mm_rpla/(mm_rpla+z))**2
     RETURN
   END FUNCTION mm_effg
+  END FUNCTION mm_effg
   !==================================
 …
     !! The method computes the mean radius and mean density of cloud drops.
     !!
     !! @bug
     !! A possible bug can happen because of threshold snippet. If __drad__ is greater than
     !! __drmax__ (== 100 microns) it is automatically set to __drmax__, but computation of
+    !! @bug
+    !! A possible bug can happen because of threshold snippet. If __drad__ is greater than
+    !! __drmax__ (== 1e3 microns) it is automatically set to __drmax__, but computation of
     !! __drho__ remains unmodified. So __drho__ is not correct in that case.
     !!
     !! @todo
     !! Fix the bug of the subroutine, but it is rather minor, since theoretically we do not
+    !! @todo
+    !! Fix the bug of the subroutine, but it is rather minor, since theoretically we do not
     !! need the density of the drop.
     !!
     !! @todo
     !! Think about a better implementation of thresholds, and get sure of their consequences in
     !! the other parts of the model.
     REAL(kind=mm_wp), INTENT(in)               :: m0ccn !! \(0^{th}\) order moment of the ccn
     REAL(kind=mm_wp), INTENT(in)               :: m3ccn !! \(3^{rd}\) order moment of the ccn
+    !! @todo
+    !! Think about a better implementation of thresholds, and get sure of their consequences in
+    !! the other parts of the model.
+    REAL(kind=mm_wp), INTENT(in)               :: m0ccn !! \(0^{th}\) order moment of the ccn
+    REAL(kind=mm_wp), INTENT(in)               :: m3ccn !! \(3^{rd}\) order moment of the ccn
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: m3ice !! \(3^{rd}\) order moments of each ice component
     REAL(kind=mm_wp), INTENT(out)              :: drad  !! Output mean drop radius
+    REAL(kind=mm_wp), INTENT(out)              :: drad  !! Output mean drop radius
     REAL(kind=mm_wp), INTENT(out), OPTIONAL    :: drho  !! Optional output mean drop density
+    REAL(kind=mm_wp)            :: vtot, wtot, ntot
+    REAL(kind=mm_wp), PARAMETER :: threshold = 1.e-25_mm_wp,         &
+                                       drmin = 1.e-10_mm_wp,         &
+                                       drmax = 1.e-4_mm_wp,          &
+                                      athird = 1._mm_wp/3._mm_wp,    &
+                                       pifac = 4._mm_wp/3._mm_wp*mm_pi
+    REAL(kind=mm_wp)            :: Ntot, Vtot, Wtot
+    REAL(kind=mm_wp), PARAMETER :: athird = 1._mm_wp / 3._mm_wp
+    REAL(kind=mm_wp), PARAMETER :: pifac  = (4._mm_wp * mm_pi) / 3._mm_wp
+    ! Set to zero :
     drad = 0._mm_wp
+    ntot = m0ccn
+    vtot = pifac*m3ccn+SUM(m3ice)
+    wtot = pifac*m3ccn*mm_rhoaer+SUM(m3ice*mm_xESPS(:)%rho)
+    IF (ntot <= threshold .OR. vtot <= 0._mm_wp) THEN
+      drad  = drmin
+      IF (PRESENT(drho)) drho  = mm_rhoaer
+    ELSE
+      drad = (vtot/ntot/pifac)**athird
+      drad = MAX(MIN(drad,drmax),drmin)
+      IF (PRESENT(drho)) drho = wtot/vtot
+    ENDIF
+    IF (PRESENT(drho)) drho  = 0._mm_wp
+    ! Initialization :
+    Ntot = m0ccn
+    Vtot = pifac * m3ccn + SUM(m3ice)
+    Wtot = pifac * ((m3ccn*mm_rhoaer) + SUM(m3ice*mm_xESPS(:)%rho))
+    IF (Ntot <= mm_m0n_min .OR. Vtot <= mm_m3cld_min) THEN
+      drad = mm_drad_min
+      IF (PRESENT(drho)) drho = mm_rhoaer
+    ELSE
+      drad = (Vtot / (pifac*Ntot))**athird
+      drad = MAX(MIN(drad,mm_drad_max),mm_drad_min)
+      IF (PRESENT(drho)) drho = Wtot / Vtot
+    ENDIF
     RETURN
   END SUBROUTINE cldprop_sc
 …
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)           :: drad  !! Output mean drop radius.
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: drho  !! Optional output mean drop density.
+    INTEGER                                     :: i,ns
+    REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: vtot,wtot,ntot,rho
+    REAL(kind=mm_wp), PARAMETER                 :: threshold = 1.e-25_mm_wp,         &
+                                                       drmin = 1.e-10_mm_wp,         &
+                                                       drmax = 1.e-4_mm_wp,          &
+                                                      athird = 1._mm_wp/3._mm_wp,    &
+                                                       pifac = 4._mm_wp/3._mm_wp*mm_pi
+    ns = SIZE(m0ccn) ; ALLOCATE(vtot(ns),wtot(ns),ntot(ns),rho(ns))
+    drad = 0._mm_wp
+    ntot = m0ccn
+    vtot = pifac*m3ccn+SUM(m3ice,DIM=2)
+    wtot = pifac*m3ccn*mm_rhoaer
+    DO i=1,SIZE(m3ice,DIM=2)
+      wtot = wtot+m3ice(:,i)*mm_xESPS(i)%rho
+    ENDDO
+    WHERE(ntot <= threshold .OR. vtot <= 0._mm_wp)
+      drad  = drmin
+      rho = mm_rhoaer
+    ELSEWHERE
+      drad = (vtot/ntot/pifac)**athird
+      drad = MAX(MIN(drad,drmax),drmin)
+      rho = wtot/vtot
+    END WHERE
+    IF (PRESENT(drho)) drho  = rho
+    INTEGER :: i
+    IF (PRESENT(drho)) THEN
+      DO i = 1, SIZE(m0ccn) ; call cldprop_sc(m0ccn(i),m3ccn(i),m3ice(i,:),drad(i),drho(i)) ; ENDDO
+    ELSE
+      DO i = 1, SIZE(m0ccn) ; call cldprop_sc(m0ccn(i),m3ccn(i),m3ice(i,:),drad(i)) ; ENDDO
+    ENDIF
     RETURN
   END SUBROUTINE cldprop_ve
   ! For configuration file (requires fccp library).
+  ! For configuration file (requires swift library).
   FUNCTION read_esp(parser,sec,pp) RESULT (err)
 …
     TYPE(mm_esp), INTENT(out)     :: pp     !! [[mm_globals(module):mm_esp(type)]] object that stores the parameters.
     TYPE(error)                   :: err    !! Error status of the function.
     err = cfg_get_value(parser,TRIM(sec)//'name',pp%name)       ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'mas',pp%mas)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'vol',pp%vol)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'ray',pp%ray)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'mas',pp%mas)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'vol',pp%vol)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'ray',pp%ray)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'masmol',pp%masmol)   ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'rho',pp%rho)         ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'tc',pp%tc)           ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'pc',pp%pc)           ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'tb',pp%tb)           ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'w',pp%w)             ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'a_sat',pp%a_sat)     ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'b_sat',pp%b_sat)     ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'c_sat',pp%c_sat)     ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'d_sat',pp%d_sat)     ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'mteta',pp%mteta)     ; IF (err /= 0) RETURN
     err = cfg_get_value(parser,TRIM(sec)//'tx_prod',pp%tx_prod) ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/name',pp%name)       ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/mas',pp%mas)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/vol',pp%vol)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/ray',pp%ray)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/mas',pp%mas)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/vol',pp%vol)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/ray',pp%ray)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/masmol',pp%masmol)   ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/rho',pp%rho)         ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/tc',pp%tc)           ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/pc',pp%pc)           ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/tb',pp%tb)           ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/w',pp%w)             ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/a_sat',pp%a_sat)     ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/b_sat',pp%b_sat)     ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/c_sat',pp%c_sat)     ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/d_sat',pp%d_sat)     ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/mteta',pp%mteta)     ; IF (err /= 0) RETURN
+    err = cfg_get_value(parser,TRIM(sec)//'/tx_prod',pp%tx_prod) ; IF (err /= 0) RETURN
     RETURN
   END FUNCTION read_esp
 …
   ! =========================================================================
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   !                CONFIGURATION PARSER checking methods
+  !                CONFIGURATION PARSER checking methods
   ! %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   ! =========================================================================
 …
   FUNCTION check_r1(err,var,def,wlog) RESULT(ret)
     !! Check an option value (float).
     !!
     !! The method checks an option value and optionally set a default value, __def__ to initialize
+    !!
+    !! The method checks an option value and optionally set a default value, __def__ to initialize
     !! __var__ on error if given.
     TYPE(error), INTENT(in)                :: err  !! Error object from value getter.
 …
     LOGICAL, INTENT(in), OPTIONAL          :: wlog !! .true. to print warning/error message.
     TYPE(error) :: ret                             !! Input error.
     CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
+    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
     LOGICAL                     :: zlog
     ret = err
 …
   FUNCTION check_l1(err,var,def,wlog) RESULT(ret)
     !! Check an option value (logical).
     !!
     !! The method checks an option value and optionally set a default value, __def__ to initialize
+    !!
+    !! The method checks an option value and optionally set a default value, __def__ to initialize
     !! __var__ on error if given.
     TYPE(error), INTENT(in)       :: err  !! Error object from value getter.
 …
     LOGICAL, INTENT(in), OPTIONAL :: wlog !! .true. to print warning/error message.
     TYPE(error) :: ret                    !! Input error.
     CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
+    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
     LOGICAL                     :: zlog
     ret = err
      zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
+    zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
     IF (err == 0) RETURN
     IF (PRESENT(def)) THEN
 …
   FUNCTION check_i1(err,var,def,wlog) RESULT(ret)
     !! Check an option value (integer).
     !!
     !! The method checks an option value and optionally set a default value, __def__ to initialize
+    !!
+    !! The method checks an option value and optionally set a default value, __def__ to initialize
     !! __var__ on error if given.
     TYPE(error), INTENT(in)       :: err  !! Error object from value getter.
 …
     LOGICAL                     :: zlog
     ret = err
      zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
+    zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
     IF (err == 0) RETURN
     IF (PRESENT(def)) THEN
 …
   FUNCTION check_s1(err,var,def,wlog) RESULT(ret)
     !! Check an option value (string).
     !!
     !! The method checks an option value and optionally set a default value, __def__ to initialize
+    !!
+    !! The method checks an option value and optionally set a default value, __def__ to initialize
     !! __var__ on error if given.
     TYPE(error), INTENT(in)                      :: err  !! Error object from value getter.
 …
     LOGICAL, INTENT(in), OPTIONAL                :: wlog !! .true. to print warning/error message.
     TYPE(error) :: ret                                   !! Input error.
     CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
+    CHARACTER(len=*), PARAMETER :: defmsg = '... Using default value: '
     LOGICAL                     :: zlog
     ret = err
+    ret = err
     zlog = .false. ; IF (PRESENT(wlog)) zlog = wlog
     IF (err == 0) RETURN

trunk/LMDZ.TITAN/libf/muphytitan/mm_haze.f90

-                      r2109
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: Haze microphysics module.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 MODULE MM_HAZE
   !! Haze microphysics module.
 …
   !!
   !! @note
   !! The production function is specific to Titan, where aerosols are created above the detached
   !! haze layer. No other source is taken into account.  This process is controled by two parameters,
   !! the pressure level of production and the production rate. Then both M0 and M3 of the aerosols
+  !! The production function is specific to Titan, where aerosols are created above the detached
+  !! haze layer. No other source is taken into account.  This process is controled by two parameters,
+  !! the pressure level of production and the production rate. Then both M0 and M3 of the aerosols
   !! distribution are updated in the production zone by addition of the production rate along a
   !! gaussian shape.
   !!
   !! @note
   !! The interface methods always uses the global variables defined in [[mm_globals(module)]] when
+  !! The interface methods always uses the global variables defined in [[mm_globals(module)]] when
   !! values (any kind, temperature, pressure, moments...) over the vertical grid are required.
   !!
   !! @warning
   !! The tendencies returned by the method are always defined over the vertical grid from __TOP__
+  !! The tendencies returned by the method are always defined over the vertical grid from __TOP__
   !! to __GROUND__.
   !!
   !! @todo
+  !! @todo
   !! Modify tests on tendencies vectors to get sure that allocation is done:
   !! Currently, we assume the compiler handles automatic allocation of arrays.
 …
   PUBLIC :: mm_haze_microphysics, mm_haze_coagulation, mm_haze_sedimentation, &
             mm_haze_production
   CONTAINS
+    mm_haze_production
+CONTAINS
   !============================================================================
 …
     !! Get the evolution of moments tracers through haze microphysics processes.
     !!
     !! The subroutine is a wrapper to the haze microphysics methods. It computes the tendencies
     !! of moments tracers for coagulation, sedimentation and production processes for the
+    !! The subroutine is a wrapper to the haze microphysics methods. It computes the tendencies
+    !! of moments tracers for coagulation, sedimentation and production processes for the
     !! atmospheric column.
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm0a_s
       !! Tendency of the 0th order moment of the spherical mode distribution (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the spherical mode distribution (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3a_s
       !! Tendency of the 3rd order moment of the spherical mode distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the spherical mode distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm0a_f
       !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3a_f
       !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: zdm0as
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: zdm3as
 …
     zdm3af(1:mm_nla) = 0._mm_wp
     IF (mm_w_haze_coag) THEN
+    IF (mm_w_haze_coag) THEN
       ! Calls coagulation
       call mm_haze_coagulation(dm0a_s,dm3a_s,dm0a_f,dm3a_f)
 …
       ! Updates tendencies
       dm0a_s=dm0a_s+zdm0as ; dm3a_s=dm3a_s+zdm3as
+      dm0a_s=dm0a_s+zdm0as ; dm3a_s=dm3a_s+zdm3as
       dm0a_f=dm0a_f+zdm0af ; dm3a_f=dm3a_f+zdm3af
     ENDIF
 …
       call mm_haze_production(zdm0as,zdm3as)
       ! We only produce spherical aerosols
       dm0a_s=dm0a_s+zdm0as ; dm3a_s=dm3a_s+zdm3as
+      dm0a_s=dm0a_s+zdm0as ; dm3a_s=dm3a_s+zdm3as
     ENDIF
 …
   ! COAGULATION PROCESS RELATED METHODS
   !============================================================================
   SUBROUTINE mm_haze_coagulation(dM0s,dM3s,dM0f,dM3f)
     !! Get the evolution of the aerosols moments vertical column due to coagulation process.
     !!
+    !!
     !! This is main method of the coagulation process:
     !!
 …
     !! 5. Finally computes the tendencies of the moments.
     !!
     !! All arguments are assumed vectors of __N__ elements where __N__ is the total number of
+    !! All arguments are assumed vectors of __N__ elements where __N__ is the total number of
     !! vertical __layers__.
     !!
     !! @note
     !! The method uses directly the global variables related to the vertical atmospheric structure
     !! stored in [[mm_globals(module)]]. Consequently they must be updated before calling the subroutine.
+    !! The method uses directly the global variables related to the vertical atmospheric structure
+    !! stored in [[mm_globals(module)]]. Consequently they must be updated before calling the subroutine.
     !!
     !! @bug
     !! If the transfert probabilities are set to 1 for the two flow regimes (pco and pfm),
+    !! If the transfert probabilities are set to 1 for the two flow regimes (pco and pfm),
     !! a floating point exception occured (i.e. a NaN) as we perform a division by zero
     !!
 …
     !! Get rid of the fu\*\*\*\* STOP statement...
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dM0s
       !! Tendency of the 0th order moment of the spherical size-distribution over a time step (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the spherical size-distribution over a time step (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dM3s
       !! Tendency of the 3rd order moment of the spherical size-distribution (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the spherical size-distribution (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dM0f
       !! Tendency of the 0th order moment of the fractal size-distribution over a time step (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the fractal size-distribution over a time step (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dM3f
       !! Tendency of the 3rd order moment of the fractal size-distribution over a time step (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the fractal size-distribution over a time step (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: c_kco,c_kfm,c_slf,tmp, &
                                                    kco,kfm,pco,pfm,mq
+      kco,kfm,pco,pfm,mq
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: a_ss,a_sf,b_ss,b_ff,c_ss,c_sf
     INTEGER                                     :: i
 …
     ! Alloctes local arrays
     ALLOCATE(kco(mm_nla),kfm(mm_nla),c_slf(mm_nla), &
              c_kco(mm_nla),c_kfm(mm_nla),mq(mm_nla), &
              pco(mm_nla),pfm(mm_nla))
+      c_kco(mm_nla),c_kfm(mm_nla),mq(mm_nla), &
+      pco(mm_nla),pfm(mm_nla))
     ALLOCATE(a_ss(mm_nla),a_sf(mm_nla), &
              b_ss(mm_nla),b_ff(mm_nla), &
              c_ss(mm_nla),c_sf(mm_nla))
+      b_ss(mm_nla),b_ff(mm_nla), &
+      c_ss(mm_nla),c_sf(mm_nla))
     a_ss(:) = 0._mm_wp ; a_sf(:) = 0._mm_wp
     b_ss(:) = 0._mm_wp ; b_ff(:) = 0._mm_wp
+    b_ss(:) = 0._mm_wp ; b_ff(:) = 0._mm_wp
     c_ss(:) = 0._mm_wp ; c_sf(:) = 0._mm_wp
 …
     c_kco(:) = mm_get_kco(mm_temp) ; c_kfm(:) = mm_get_kfm(mm_temp)
     ! get slf (slip-flow factor)
     c_slf(:) = mm_akn * mm_lambda_g(mm_temp,mm_play)
+    c_slf(:) = mm_akn * mm_lambda_g(mm_temp,mm_play)
     DO i=1,mm_nla
 …
         pfm(i) = mm_ps2s(mm_rcs(i),0,1,mm_temp(i),mm_play(i))
         ! (A_SS_CO x A_SS_FM) / (A_SS_CO + A_SS_FM)
         kco(i) = g0ssco(mm_rcs(i),c_slf(i),c_kco(i))
         kfm(i) = g0ssfm(mm_rcs(i),c_kfm(i))
+        kco(i) = g0ssco(mm_rcs(i),c_slf(i),c_kco(i))
+        kfm(i) = g0ssfm(mm_rcs(i),c_kfm(i))
         IF (kco(i)*(pco(i)-2._mm_wp)+kfm(i)*(pfm(i)-2._mm_wp) /=0) THEN
           a_ss(i) = (kco(i)*(pco(i)-2._mm_wp)*kfm(i)*(pfm(i)-2._mm_wp))/(kco(i)*(pco(i)-2._mm_wp)+kfm(i)*(pfm(i)-2._mm_wp))
 …
       ENDIF
     ENDDO
     DEALLOCATE(kco,kfm,c_kco,c_kfm,pco,pfm,c_slf)
 …
     !! Get &gamma; pre-factor for the 0th order moment with SS interactions in the continuous flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcs__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
     !! Get &gamma; pre-factor for the 0th order moment with SF interactions in the continuous flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcs__ or __rcf__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
     REAL(kind=mm_wp) :: a1, a2, a3, a4, a5, a6, e, rcff
     res = 0._mm_wp ; IF (rcs <= 0._mm_wp .OR. rcf <= 0._mm_wp) RETURN
     e=3._mm_wp/mm_df ; rcff = rcf**e*mm_rb2ra
     ! computes mm_alpha coefficients
     a1=mm_alpha_s(1._mm_wp)   ; a2=mm_alpha_f(-e)   ; a3=mm_alpha_f(e)
+    e=3._mm_wp/mm_df ; rcff = rcf**e*mm_rb2ra
+    ! computes mm_alpha coefficients
+    a1=mm_alpha_s(1._mm_wp)   ; a2=mm_alpha_f(-e)   ; a3=mm_alpha_f(e)
     a4=mm_alpha_s(-1._mm_wp) ; a5=mm_alpha_s(-2._mm_wp) ; a6=mm_alpha_f(-2._mm_wp*e)
     ! Computes gamma pre-factor
     res = c_kco*( 2._mm_wp + a1*a2*rcs/rcff + a4*a3*rcff/rcs + c_slf*( a4/rcs + &
                          a2/rcff + a5*a3*rcff/rcs**2 + a1*a6*rcs/rcff**2))
+      a2/rcff + a5*a3*rcff/rcs**2 + a1*a6*rcs/rcff**2))
     RETURN
   END FUNCTION g0sfco
 …
     !! Get &gamma; pre-factor for the 0th order moment with FF interactions in the continuous flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcf__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcf   !! Characteristic radius of the fractal size-distribution.
 …
     !! Get &gamma; pre-factor for the 3rd order moment with SS interactions in the continuous flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcs__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
     res = 0._mm_wp ; IF (rcs <= 0._mm_wp) RETURN
     ! computes mm_alpha coefficients
     a1=mm_alpha_s(3._mm_wp) ; a2=mm_alpha_s(2._mm_wp)  ; a3=mm_alpha_s(1._mm_wp)
+    a1=mm_alpha_s(3._mm_wp) ; a2=mm_alpha_s(2._mm_wp)  ; a3=mm_alpha_s(1._mm_wp)
     a4=mm_alpha_s(4._mm_wp) ; a5=mm_alpha_s(-1._mm_wp) ; a6=mm_alpha_s(-2._mm_wp)
     ! Computes gamma pre-factor
     res = (2._mm_wp*a1 + a2*a3 + a4*a5 + c_slf/rcs*(a3**2 + a4*a6 + a1*a5 + a2))* &
           c_kco/(a1**2*rcs**3)
+    res = (2._mm_wp*a1 + a2*a3 + a4*a5 + c_slf/rcs*(a3**2 + a4*a6 + a1*a5 + a2))* &
+      c_kco/(a1**2*rcs**3)
     RETURN
   END FUNCTION g3ssco
 …
     !! Get &gamma; pre-factor for the 3rd order moment with SF interactions in the continuous flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcs__ or __rcf__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
     res = 0._mm_wp ; IF (rcs <= 0._mm_wp .OR. rcf <= 0._mm_wp) RETURN
     ! computes mm_alpha coefficients
     e=3._mm_wp/mm_df ; rcff = rcf**e*mm_rb2ra
     a1=mm_alpha_s(3._mm_wp)    ; a2=mm_alpha_s(4._mm_wp) ; a3=mm_alpha_f(-e)
+    e=3._mm_wp/mm_df ; rcff = rcf**e*mm_rb2ra
+    a1=mm_alpha_s(3._mm_wp)    ; a2=mm_alpha_s(4._mm_wp) ; a3=mm_alpha_f(-e)
     a4=mm_alpha_s(2._mm_wp)    ; a5=mm_alpha_f(e)    ; a6=mm_alpha_s(1._mm_wp)
     a7=mm_alpha_f(-2._mm_wp*e) ; a8=mm_alpha_f(3._mm_wp)
     ! Computes gamma pre-factor
     res = (2._mm_wp*a1*rcs**3 + a2*rcs**4*a3/rcff + a4*rcs**2*a5*rcff + &
                 c_slf *( a4*rcs**2 + a1*rcs**3*a3/rcff + a6*rcs*a5*rcff + &
                 a2*rcs**4*a7/rcff**2))* c_kco/(a1*a8*(rcs*rcf)**3)
+      c_slf *( a4*rcs**2 + a1*rcs**3*a3/rcff + a6*rcs*a5*rcff + &
+      a2*rcs**4*a7/rcff**2))* c_kco/(a1*a8*(rcs*rcf)**3)
     RETURN
   END FUNCTION g3sfco
 …
     !! Get &gamma; pre-factor for the 0th order moment with SS interactions in the Free Molecular flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcs__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
   ELEMENTAL FUNCTION g0sffm(rcs, rcf, c_kfm) RESULT(res)
     !> Get &gamma; pre-factor for the 0th order moment with SF interactions in the Free Molecular flow regime.
     !!
     !! @note
+    !> Get &gamma; pre-factor for the 0th order moment with SF interactions in the Free Molecular flow regime.
+    !!
+    !! @note
     !! If __rcs__ or __rcf__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
     res = 0._mm_wp ; IF (rcs <= 0._mm_wp .OR. rcf <= 0._mm_wp) RETURN
     ! computes mm_alpha coefficients
     e1 = 3._mm_wp/mm_df
     e2 = 6._mm_wp/mm_df
+    e1 = 3._mm_wp/mm_df
+    e2 = 6._mm_wp/mm_df
     e3 = (6._mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
     e4 = (12._mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
     rcff1 = mm_rb2ra * rcf**e1
+    rcff1 = mm_rb2ra * rcf**e1
     rcff2 = rcff1**2
     rcff3 = mm_rb2ra * rcf**e3
+    rcff3 = mm_rb2ra * rcf**e3
     rcff4 = mm_rb2ra**2 * rcf**e4
     a1=mm_alpha_s(0.5_mm_wp)  ; a2=mm_alpha_s(-0.5_mm_wp) ; a3=mm_alpha_f(e1)
+    a1=mm_alpha_s(0.5_mm_wp)  ; a2=mm_alpha_s(-0.5_mm_wp) ; a3=mm_alpha_f(e1)
     a4=mm_alpha_s(-1.5_mm_wp) ; a5=mm_alpha_f(e2)      ; a6=mm_alpha_s(2._mm_wp)
     a7=mm_alpha_f(-1.5_mm_wp) ; a8=mm_alpha_s(1._mm_wp)   ; a9=mm_alpha_f(e3)
+    a7=mm_alpha_f(-1.5_mm_wp) ; a8=mm_alpha_s(1._mm_wp)   ; a9=mm_alpha_f(e3)
     a10=mm_alpha_f(e4)
     ! Computes gamma pre-factor
     res = (a1*rcs**0.5_mm_wp + 2._mm_wp*rcff1*a2*a3/rcs**0.5_mm_wp + a4*a5*rcff2/rcs**1.5_mm_wp + &
            a6*a7*rcs**2/rcf**1.5_mm_wp + 2._mm_wp*a8*a9*rcs*rcff3 + a10*rcff4 &
           )*mm_get_btk(4,0)*c_kfm
+      a6*a7*rcs**2/rcf**1.5_mm_wp + 2._mm_wp*a8*a9*rcs*rcff3 + a10*rcff4 &
+      )*mm_get_btk(4,0)*c_kfm
     RETURN
   END FUNCTION g0sffm
   ELEMENTAL FUNCTION g0fffm(rcf, c_kfm) RESULT(res)
     !! Get &gamma; pre-factor for the 0th order moment with FF interactions in the Free Molecular flow regime.
     !!
     !! @note
+    !! Get &gamma; pre-factor for the 0th order moment with FF interactions in the Free Molecular flow regime.
+    !!
+    !! @note
     !! If __rcf__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcf   !! Characteristic radius of the fractal size-distribution.
     REAL(kind=mm_wp), INTENT(in) :: c_kfm !! Thermodynamic free molecular flow regime pre-factor.
     REAL(kind=mm_wp) :: res               !! &gamma; coagulation kernel pre-factor.
+    REAL(kind=mm_wp) :: res               !! &gamma; coagulation kernel pre-factor.
     REAL(kind=mm_wp) :: a1, a2, a3, a4, a5, e1, e2, e3, rcff
     res = 0._mm_wp ; IF (rcf <= 0._mm_wp) RETURN
     ! computes mm_alpha coefficients
     e1=3._mm_wp/mm_df ; e2=(6_mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
+    e1=3._mm_wp/mm_df ; e2=(6_mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
     e3=(12._mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
     rcff=mm_rb2ra**2*rcf**e3
 …
     res = 0._mm_wp ; IF (rcs <= 0._mm_wp) RETURN
     ! computes mm_alpha coefficients
     a1=mm_alpha_s(3.5_mm_wp)  ; a2=mm_alpha_s(1._mm_wp)  ; a3=mm_alpha_s(2.5_mm_wp)
+    a1=mm_alpha_s(3.5_mm_wp)  ; a2=mm_alpha_s(1._mm_wp)  ; a3=mm_alpha_s(2.5_mm_wp)
     a4=mm_alpha_s(2._mm_wp)   ; a5=mm_alpha_s(1.5_mm_wp) ; a6=mm_alpha_s(5._mm_wp)
     a7=mm_alpha_s(-1.5_mm_wp) ; a8=mm_alpha_s(4._mm_wp)  ; a9=mm_alpha_s(-0.5_mm_wp)
+    a7=mm_alpha_s(-1.5_mm_wp) ; a8=mm_alpha_s(4._mm_wp)  ; a9=mm_alpha_s(-0.5_mm_wp)
     a10=mm_alpha_s(3._mm_wp) ; a11=mm_alpha_s(0.5_mm_wp)
     ! Computes gamma pre-factor
     res = (a1 + 2._mm_wp*a2*a3 + a4*a5 + a6*a7 + 2._mm_wp*a8*a9 + a10*a11) &
           *mm_get_btk(1,3)*c_kfm/(a10**2*rcs**2.5_mm_wp)
+      *mm_get_btk(1,3)*c_kfm/(a10**2*rcs**2.5_mm_wp)
     RETURN
   END FUNCTION g3ssfm
 …
     !! Get &gamma; pre-factor for the 3rd order moment with SF interactions in the Free Molecular flow regime.
     !!
     !! @note
+    !! @note
     !! If __rcs__ or __rcf__ is 0, the function returns 0.
     REAL(kind=mm_wp), INTENT(in) :: rcs   !! Characteristic radius of the spherical size-distribution.
 …
     res = 0._mm_wp ; IF (rcs <= 0._mm_wp .OR. rcf <= 0._mm_wp) RETURN
     ! computes mm_alpha coefficients
     e1=3._mm_wp/mm_df
     e2=(6._mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
+    e1=3._mm_wp/mm_df
+    e2=(6._mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
     e3=(12._mm_wp-3._mm_wp*mm_df)/(2._mm_wp*mm_df)
     rcff1=mm_rb2ra*rcf**e1 ; rcff2=mm_rb2ra*rcf**e2 ; rcff3=mm_rb2ra**2*rcf**e3
     a1=mm_alpha_s(3.5_mm_wp)  ; a2=mm_alpha_s(2.5_mm_wp)   ; a3=mm_alpha_f(e1)
     a4=mm_alpha_s(1.5_mm_wp)  ; a5=mm_alpha_f(2._mm_wp*e1) ; a6=mm_alpha_s(5._mm_wp)
     a7=mm_alpha_f(-1.5_mm_wp) ; a8=mm_alpha_s(4._mm_wp)    ; a9=mm_alpha_f(e2)
+    a1=mm_alpha_s(3.5_mm_wp)  ; a2=mm_alpha_s(2.5_mm_wp)   ; a3=mm_alpha_f(e1)
+    a4=mm_alpha_s(1.5_mm_wp)  ; a5=mm_alpha_f(2._mm_wp*e1) ; a6=mm_alpha_s(5._mm_wp)
+    a7=mm_alpha_f(-1.5_mm_wp) ; a8=mm_alpha_s(4._mm_wp)    ; a9=mm_alpha_f(e2)
     a10=mm_alpha_s(3._mm_wp)  ; a11=mm_alpha_f(e3)         ; a12=mm_alpha_f(3._mm_wp)
     ! Computes gamma pre-factor
     res = (a1*rcs**3.5_mm_wp + 2._mm_wp*a2*a3*rcs**2.5_mm_wp*rcff1 + a4*a5*rcs**1.5_mm_wp*rcff1**2 + &
           a6*a7*rcs**5/rcf**1.5_mm_wp + 2._mm_wp*a8*a9*rcs**4*rcff2 + &
           a10*a11*rcs**3*rcff3)*mm_get_btk(4,3)*c_kfm/(a10*a12*(rcs*rcf)**3)
+      a6*a7*rcs**5/rcf**1.5_mm_wp + 2._mm_wp*a8*a9*rcs**4*rcff2 + &
+      a10*a11*rcs**3*rcff3)*mm_get_btk(4,3)*c_kfm/(a10*a12*(rcs*rcf)**3)
     RETURN
   END FUNCTION g3sffm
 …
   ! SEDIMENTATION PROCESS RELATED METHODS
   !============================================================================
   SUBROUTINE mm_haze_sedimentation(dm0s,dm3s,dm0f,dm3f)
     !! Interface to sedimentation algorithm.
     !!
     !! The subroutine computes the evolution of each moment of the aerosols tracers
     !! through sedimentation process and returns their tendencies for a timestep.
+    !! through sedimentation process and returns their tendencies for a timestep.
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm0s
       !! Tendency of the 0th order moment of the spherical mode (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the spherical mode (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3s
       !! Tendency of the 3rd order moment of the spherical mode (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the spherical mode (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm0f
       !! Tendency of the 0th order moment of the fractal mode (\(m^{-3}\)).
+    !! Tendency of the 0th order moment of the fractal mode (\(m^{-3}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3f
       !! Tendency of the 3rd order moment of the fractal mode (\(m^{3}.m^{-3}\)).
+    !! Tendency of the 3rd order moment of the fractal mode (\(m^{3}.m^{-3}\)).
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: ft,fdcor,wth
+    REAL(kind=mm_wp)                            :: m,n,p
+    REAL(kind=mm_wp), PARAMETER                 :: fac = 4._mm_wp/3._mm_wp * mm_pi
+    REAL(kind=mm_wp), PARAMETER                 :: fac = 4._mm_wp/3._mm_wp * mm_pi
     ALLOCATE(ft(mm_nle),wth(mm_nle),fdcor(mm_nle))
 …
     !! Compute the tendency of the moment through sedimentation process.
     !!
     !!
+    !!
     !! The method computes the time evolution of the \(k^{th}\) order moment through sedimentation:
     !!
 …
     !!
     !! The equation is resolved using a [Crank-Nicolson algorithm](http://en.wikipedia.org/wiki/Crank-Nicolson_method).
     !!
     !! Sedimentation algorithm is quite messy. It appeals to the dark side of the Force and uses evil black magic spells
+    !!
+    !! Sedimentation algorithm is quite messy. It appeals to the dark side of the Force and uses evil black magic spells
     !! from ancient times. It is based on \cite{toon1988b,fiadeiro1977,turco1979} and is an update of the algorithm
     !! originally implemented in the LMDZ-Titan 2D GCM.
 …
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:)  :: ft  !! Downward sedimentation flux  (effective velocity of the moment).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dmk !! Tendency of \(k^{th}\) order moment (in \(m^{k}.m^{-3}\)).
     INTEGER                                 :: i
+    INTEGER                                 :: i
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: as,bs,cs,mko
     ALLOCATE(as(mm_nla), bs(mm_nla), cs(mm_nla), mko(mm_nla))
 …
       bs(1:mm_nla) = -(ft(2:mm_nle)+mm_dzlay(1:mm_nla)/dt)
       cs(1:mm_nla) = -mm_dzlay(1:mm_nla)/dt*mk(1:mm_nla)
       ! (Tri)diagonal matrix inversion
+      ! (Tri)diagonal matrix inversion
       mko(1) = cs(1)/bs(1)
       DO i=2,mm_nla ; mko(i) = (cs(i)-mko(i-1)*as(i))/bs(i) ; ENDDO
 …
       ! interior
       mko(2:mm_nla-1)=(bs(2:mm_nla-1)*mk(1:mm_nla-2) + &
                        cs(2:mm_nla-1)*mk(2:mm_nla-1)   &
                       )/as(2:mm_nla-1)
+        cs(2:mm_nla-1)*mk(2:mm_nla-1)   &
+        )/as(2:mm_nla-1)
     ENDIF
     dmk = mko - mk
 …
   SUBROUTINE get_weff(mk,k,df,rc,dt,afun,wth,corf)
     !! Get the effective settling velocity for aerosols moments.
     !!
     !! This method computes the effective settling velocity of the \(k^{th}\) order moment of aerosol
     !! tracers. The basic settling velocity (\(v^{eff}_{M_{k}}\)) is computed using the following
+    !!
+    !! This method computes the effective settling velocity of the \(k^{th}\) order moment of aerosol
+    !! tracers. The basic settling velocity (\(v^{eff}_{M_{k}}\)) is computed using the following
     !! equation:
     !!
     !! $$
+    !!
+    !! $$
     !! \begin{eqnarray*}
     !! \Phi^{sed}_{M_{k}} &=& \int_{0}^{\infty} n(r) r^{k} \times w(r) dr
+    !! \Phi^{sed}_{M_{k}} &=& \int_{0}^{\infty} n(r) r^{k} \times w(r) dr
     !!                     == M_{k}  \times v^{eff}_{M_{k}} \\
     !!     v^{eff}_{M_{k} &=& \dfrac{2 \rho g r_{c}^{\dfrac{3D_{f}-3}{D_{f}}}}
 …
     !! $$
     !!
     !! \(v^{eff}_{M_{k}\) is then corrected to reduce numerical diffusion of the sedimentation algorithm
+    !! \(v^{eff}_{M_{k}\) is then corrected to reduce numerical diffusion of the sedimentation algorithm
     !! as defined in \cite{toon1988b}.
     !!
     !! @warning
     !! Both __df__, __rc__ and __afun__ must be consistent with each other otherwise wrong values will
+    !! Both __df__, __rc__ and __afun__ must be consistent with each other otherwise wrong values will
     !! be computed.
     REAL(kind=mm_wp), INTENT(in), DIMENSION(mm_nla)            :: mk
       !! Moment of order __k__ (\(m^{k}.m^{-3}\)) at each layer.
+    !! Moment of order __k__ (\(m^{k}.m^{-3}\)) at each layer.
     REAL(kind=mm_wp), INTENT(in), DIMENSION(mm_nla)            :: rc
       !! Characteristic radius associated to the moment at each layer.
+    !! Characteristic radius associated to the moment at each layer.
     REAL(kind=mm_wp), INTENT(in)                               :: k
       !! The order of the moment.
+    !! The order of the moment.
     REAL(kind=mm_wp), INTENT(in)                               :: df
       !! Fractal dimension of the aersols.
+    !! Fractal dimension of the aersols.
     REAL(kind=mm_wp), INTENT(in)                               :: dt
       !! Time step (s).
+    !! Time step (s).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(mm_nle)           :: wth
       !! Theoretical Settling velocity at each vertical __levels__ (\( wth \times corf = weff\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(mm_nle), OPTIONAL :: corf
       !! _Fiadero_ correction factor applied to the theoretical settling velocity at each vertical __levels__.
+    !! Theoretical Settling velocity at each vertical __levels__ (\( wth \times corf = weff\)).
+    REAL(kind=mm_wp), INTENT(out), DIMENSION(mm_nle), OPTIONAL :: corf
+    !! _Fiadero_ correction factor applied to the theoretical settling velocity at each vertical __levels__.
     INTERFACE
       FUNCTION afun(order)
 …
         REAL(kind=mm_wp) :: afun              !! Alpha value.
       END FUNCTION afun
     END INTERFACE
+    END INTERFACE
     INTEGER                             :: i
     REAL(kind=mm_wp)                    :: af1,af2,ar1,ar2
 …
     REAL(kind=mm_wp), DIMENSION(mm_nle) :: zcorf
     ! ------------------
     wth(:) = 0._mm_wp ; zcorf(:) = 1._mm_wp
     ar1 = (3._mm_wp*df -3._mm_wp)/df    ; ar2 = (3._mm_wp*df -6._mm_wp)/df
     af1 = (df*(k+3._mm_wp)-3._mm_wp)/df ; af2 = (df*(k+3._mm_wp)-6._mm_wp)/df
+    af1 = (df*(k+3._mm_wp)-3._mm_wp)/df ; af2 = (df*(k+3._mm_wp)-6._mm_wp)/df
     rb2ra = mm_rm**((df-3._mm_wp)/df)
     DO i=2,mm_nla
       IF (rc(i-1) <= 0._mm_wp) CYCLE
+      IF (rc(i-1) <= 0._mm_wp) CYCLE
       dzb = (mm_dzlay(i)+mm_dzlay(i-1))/2._mm_wp
       csto = 2._mm_wp*mm_rhoaer*mm_effg(mm_zlev(i))/(9._mm_wp*mm_eta_g(mm_btemp(i)))
       cslf = mm_akn * mm_lambda_g(mm_btemp(i),mm_plev(i))
+      wth(i) = - csto/(rb2ra*afun(k)) * (rc(i-1)**ar1 * afun(af1) + cslf/rb2ra * rc(i-1)**ar2 * afun(af2))
+      wth(i) = - csto/(rb2ra*afun(k)) * (rc(i-1)**ar1 * afun(af1) + cslf/rb2ra * rc(i-1)**ar2 * afun(af2))
+      ! >>> [TEMPO : BBT]
+      !wth(i) = wth(i) * (2574e3 / (2574e3+mm_zlev(i)))**4
+      ! <<< [TEMPO : BBT]
       ! now correct velocity to reduce numerical diffusion
       IF (.NOT.mm_no_fiadero_w) THEN
         IF (mk(i) <= 0._mm_wp) THEN
           ratio = mm_fiadero_max
+          ratio = mm_fiadero_max
         ELSE
           ratio = MAX(MIN(mk(i-1)/mk(i),mm_fiadero_max),mm_fiadero_min)
+          ratio = MAX(MIN(mk(i-1)/mk(i),mm_fiadero_max),mm_fiadero_min)
         ENDIF
         ! apply correction
 …
   SUBROUTINE mm_haze_production(dm0s,dm3s)
     !! Compute the production of aerosols moments.
     !!
     !! The method computes the tendencies of M0 and M3 for the spherical mode through production process.
     !! Production values are distributed along a normal law in altitude, centered  at
+    !!
+    !! The method computes the tendencies of M0 and M3 for the spherical mode through production process.
+    !! Production values are distributed along a normal law in altitude, centered  at
     !! [[mm_globals(module):mm_p_prod(variable)]] pressure level with a fixed sigma of 20km.
     !!
     !! First M3 tendency is computed and M0 is retrieved using the inter-moments relation a spherical
+    !! First M3 tendency is computed and M0 is retrieved using the inter-moments relation a spherical
     !! characteristic radius set to [[mm_globals(module):mm_rc_prod(variable)]].
     !!
 …
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3s !! Tendency of M3 (\(m^{3}.m^{-3}\)).
     INTEGER                     :: i
     REAL(kind=mm_wp)            :: zprod,cprod,timefact
+    REAL(kind=mm_wp)            :: zprod,cprod,timefact
     REAL(kind=mm_wp), PARAMETER :: sigz  = 20e3_mm_wp, &
                                    fnorm = 1._mm_wp/(dsqrt(2._mm_wp*mm_pi)*sigz), &
 …
     dm3s(:)= mm_tx_prod *0.75_mm_wp/mm_pi *mm_dt / mm_rhoaer / 2._mm_wp / mm_dzlev(1:mm_nla) * &
              (erf((mm_zlev(1:mm_nla)-zprod)/znorm) - &
              erf((mm_zlev(2:mm_nla+1)-zprod)/znorm))
+             erf((mm_zlev(2:mm_nla+1)-zprod)/znorm))
     dm0s(:) = dm3s(:)/(mm_rc_prod**3*mm_alpha_s(3._mm_wp))
 …
     ENDIF
   END SUBROUTINE mm_haze_production

trunk/LMDZ.TITAN/libf/muphytitan/mm_interfaces.f90

-                      r1897
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: Interfaces module for external functions
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 MODULE MM_INTERFACES
   !! Interfaces to external functions.
-  !!
-  !! The module contains the definitions of all "external" functions used by moments model which are
-  !! left to the developer's responsibility.
   !!
+  !! # Functions
+  !! The module contains the definitions of all "external" functions used by moments model which are
+  !! left to the developer's responsibility.
   !!
+  !! - [[mm_interfaces(module):mm_alpha_s(interface)]] should compute the inter-moments relation coefficient
+  !! # Functions
+  !!
+  !! - [[mm_interfaces(module):mm_alpha_s(interface)]] should compute the inter-moments relation coefficient
   !!   as a function of the moment's order for the spherical mode.
   !! - [[mm_interfaces(module):mm_alpha_f(interface)]] should perform the same computations as
+  !! - [[mm_interfaces(module):mm_alpha_f(interface)]] should perform the same computations as
   !!   [[mm_interfaces(module):mm_alpha_s(interface)]] but for the fractal mode.
   !! - [[mm_interfaces(module):mm_ps2s(interface)]] should compute the probability for particles of the
+  !! - [[mm_interfaces(module):mm_ps2s(interface)]] should compute the probability for particles of the
   !!   spherical mode to remain in that mode during coagulation process.
   !! - [[mm_interfaces(module):mm_qmean(interface)]] should compute the mean eletric charge correction to be
+  !! - [[mm_interfaces(module):mm_qmean(interface)]] should compute the mean eletric charge correction to be
   !!   applied on each coagulation sub-kernels computed in mm_haze module.
   !! - [[mm_interfaces(module):mm_get_btk(interface)]] should compute the \(b_{k}^{T}\) coefficient of the
 …
   PUBLIC
   INTERFACE
+  INTERFACE
     PURE FUNCTION mm_alpha_s(k) RESULT (res)
 …
       REAL(kind=mm_wp), INTENT(in) :: k !! Order of the moment.
       REAL(kind=mm_wp) :: res           !! Alpha value.
     END FUNCTION mm_alpha_s
+    END FUNCTION mm_alpha_s
     PURE FUNCTION mm_alpha_f(k) RESULT (res)
 …
       !! kernel as a function of the temperature, pressure and the characteristic radius of
       !! the mode involved in the coagulation.
       !!
+      !!
       !! Modes are referred by a two letters uppercase string with the combination of:
       !!
       !! - S : spherical mode
       !! - F : fractal mode
       !!
+      !!
       !! For example, SS means intra-modal coagulation for spherical particles.
       IMPORT mm_wp
 …
     PURE FUNCTION mm_get_btk(t,k) RESULT(res)
       !! Get the \(b_{k}^{T}\) coefficient of the Free Molecular regime.
       !!
+      !!
       !! The method computes and returns the value of the pre-factor \(b_{k}^{T}\) used to
       !! approximate free-molecular regime coagulation kernels.
       !! @note
       !! For more details about \(b_{k}^{T}\) coefficient, please read the
+      !! @note
+      !! For more details about \(b_{k}^{T}\) coefficient, please read the
       !! [scientific documentation](page/haze.html#free-molecular).
       !!

trunk/LMDZ.TITAN/libf/muphytitan/mm_lib.f90

-                      r1897
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: MP2M library interface module.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 MODULE MM_LIB
   !! MP2M library interface module.
   !!
   !! This module is only intended to get a overall acces to all library module. It contains no
+  !! This module is only intended to get a overall acces to all library module. It contains no
   !! definitions and just __uses__ all others modules of the library.
   USE MM_MPREC

trunk/LMDZ.TITAN/libf/muphytitan/mm_methods.f90

-                      r1897
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
+! Contributors: J. Burgalat (GSMA, URCA), B. de Batz de Trenquelléon (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: Model miscellaneous methods module.
 !! author: J. Burgalat
+!! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
+!! corrections: B. de Batz de Trenquelléon (2023)
 MODULE MM_METHODS
 …
   !!
   !! All thermodynamic functions related to cloud microphysics (i.e. [[mm_methods(module):mm_lHeatX(interface)]],
   !! [[mm_methods(module):mm_sigX(interface)]] and [[mm_methods(module):mm_psatX(interface)]]) compute related equations
+  !! [[mm_methods(module):mm_sigX(interface)]] and [[mm_methods(module):mm_psatX(interface)]]) compute related equations
   !! from \cite{reid1986}. A version of the book is freely available [here](http://f3.tiera.ru/3/Chemistry/References/Poling%20B.E.,%20Prausnitz%20J.M.,%20O'Connell%20J.P.%20The%20Properties%20of%20Gases%20and%20Liquids%20(5ed.,%20MGH,%202000)(ISBN%200070116822)(803s).pdf).
   !!
   !! The module defines the following functions/subroutines/interfaces:
   !!
   !! | name        | description
+  !! | name        | description
   !! | :---------: | :-------------------------------------------------------------------------------------
   !! | mm_lheatx   | Compute latent heat released
 …
   IMPLICIT NONE
   PRIVATE
   PUBLIC  :: mm_sigX, mm_LheatX, mm_psatX, mm_qsatx, mm_fshape, &
              mm_get_kco, mm_get_kfm, mm_eta_g, mm_lambda_g
+  PRIVATE
+  PUBLIC  :: mm_sigX, mm_LheatX, mm_psatX, mm_qsatx, mm_ysatX, mm_fshape, &
+    mm_get_kco, mm_get_kfm, mm_eta_g, mm_lambda_g
   ! ---- INTERFACES
 …
   !! FUNCTION mm_sigX(temp,xESP)
   !! ```
   !!
   !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method
+  !!
+  !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method
   !! computes the result for all the temperatures and returns a vector of same size than __temp__.
   INTERFACE mm_sigX
     MODULE PROCEDURE sigx_sc,sigx_ve
   END INTERFACE
+  END INTERFACE mm_sigX
   !> Interface to Latent heat computation functions.
   !!
+  !!
   !! The method computes the latent heat released of a given specie at given temperature(s).
   !!
 …
   !! ```
   !!
   !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method
+  !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method
   !! computes the result for all the temperatures and returns a vector of same size than __temp__.
   INTERFACE mm_LheatX
     MODULE PROCEDURE lheatx_sc,lheatx_ve
   END INTERFACE
+  END INTERFACE mm_LheatX
   !> Interface to saturation vapor pressure computation functions.
 …
   !! FUNCTION mm_psatX(temp,xESP)
   !! ```
   !!
+  !!
   !! The method computes the saturation vapor pressure of a given specie at given temperature(s).
   !!
   !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method
+  !! __xESP__ must always be given as a scalar. If __temp__ is given as a vector, then the method
   !! computes the result for all the temperatures and returns a vector of same size than __temp__.
   INTERFACE mm_psatX
     MODULE PROCEDURE psatx_sc,psatx_ve
   END INTERFACE
   !! Interface to saturation mass mixing ratio computaiton functions.
   !!
   !! The method computes the mass mixing ratio at saturation of a given specie at given temperature(s)
+  END INTERFACE mm_psatX
+  !> Interface to saturation mass mixing ratio computation functions.
+  !!
+  !! The method computes the mass mixing ratio at saturation of a given specie at given temperature(s)
   !! and pressure level(s).
   !!
   !! ```fortran
   !! FUNCTION mm_qsatX(temp,pres,xESP)
   !! ```
   !!
   !! __xESP__ must always be given as a scalar. If __temp__ and __pres__  are given as a vector (of same
+  !! FUNCTION mm_qsatX(temp,pres,xESP)
+  !! ```
+  !!
+  !! __xESP__ must always be given as a scalar. If __temp__ and __pres__  are given as a vector (of same
   !! size !), then the method computes the result for each couple of (temperature, pressure) and returns
   !! a vector of same size than __temp__.
   INTERFACE mm_qsatx
     MODULE PROCEDURE qsatx_sc,qsatx_ve
+  END INTERFACE
+  END INTERFACE mm_qsatx
+  !> Interface to saturation molar mixing ratio computation functions.
+  !!
+  !! The method computes the molar mixing ratio at saturation of a given specie at given temperature(s)
+  !! and pressure level(s) [Fray and Schmidt (2009)].
+  !!
+  !! ```fortran
+  !! FUNCTION mm_ysatX(temp,pres,xESP)
+  !! ```
+  !!
+  !! __xESP__ must always be given as a scalar. If __temp__ and __pres__  are given as a vector (of same
+  !! size !), then the method computes the result for each couple of (temperature, pressure) and returns
+  !! a vector of same size than __temp__.
+  INTERFACE mm_ysatX
+    MODULE PROCEDURE ysatX_sc,ysatX_ve
+  END INTERFACE mm_ysatX
   !> Interface to shape factor computation functions.
 …
   !! ```
   !!
   !! Where __m__ is cosine of the contact angle and __x__ the curvature radius. __m__ must always be
   !! given as a scalar. If __x__ is given as a vector, then the method compute the result for each
+  !! Where __m__ is cosine of the contact angle and __x__ the curvature radius. __m__ must always be
+  !! given as a scalar. If __x__ is given as a vector, then the method compute the result for each
   !! value of __x__ and and returns a vector of same size than __x__.
   INTERFACE mm_fshape
     MODULE PROCEDURE fshape_sc,fshape_ve
   END INTERFACE
   CONTAINS
+  END INTERFACE mm_fshape
+CONTAINS
   FUNCTION fshape_sc(cost,rap) RESULT(res)
     !! Get the shape factor of a ccn (scalar).
     !!
     !! The method computes the shape factor for the heterogeneous nucleation on a fractal particle.
+    !! The method computes the shape factor for the heterogeneous nucleation on a fractal particle.
     !! Details about the shape factor can be found in \cite{prup1978}.
     REAL(kind=mm_wp), INTENT(in) :: cost !! Cosine of the contact angle.
 …
       phi = dsqrt(1._mm_wp-2._mm_wp*cost*rap+rap**2)
       a = 1._mm_wp + ( (1._mm_wp-cost*rap)/phi )**3
       b = (rap**3) * (2._mm_wp-3._mm_wp*(rap-cost)/phi+((rap-cost)/phi)**3)
+      b = (rap**3) * (2._mm_wp - 3._mm_wp*(rap-cost)/phi + ((rap-cost)/phi)**3)
       c = 3._mm_wp * cost * (rap**2) * ((rap-cost)/phi-1._mm_wp)
       res = 0.5_mm_wp*(a+b+c)
 …
     WHERE(rap > 3000._mm_wp)
       res = ((2._mm_wp+cost)*(1._mm_wp-cost)**2)/4._mm_wp
     ELSEWHERE
+    ELSEWHERE
       phi = dsqrt(1._mm_wp-2._mm_wp*cost*rap+rap**2)
       a = 1._mm_wp + ((1._mm_wp-cost*rap)/phi )**3
 …
     !! The method computes the latent heat equation as given in \cite{reid1986} p. 220 (eq. 7-9.4).
     IMPLICIT NONE
     ! - DUMMY
+    ! - DUMMY
     REAL(kind=mm_wp), INTENT(in) :: temp !! temperature (K).
     TYPE(mm_esp), INTENT(in)     :: xESP !! Specie properties.
     REAL(kind=mm_wp) :: res              !! Latent heat of given specie at given temperature (\(J.kg^{-1}\)).
     REAL(kind=mm_wp) :: ftm
     ftm=MIN(1._mm_wp-temp/xESP%tc,1.e-3_mm_wp)
+    ftm=MAX(1._mm_wp-temp/xESP%tc,1.e-3_mm_wp)
     res = mm_rgas*xESP%tc*(7.08_mm_wp*ftm**0.354_mm_wp+10.95_mm_wp*xESP%w*ftm**0.456_mm_wp)/xESP%masmol
   END FUNCTION LHeatX_sc
   FUNCTION LHeatX_ve(temp,xESP) RESULT(res)
     !! Compute latent heat of a given specie at given temperature (vector).
 …
     TYPE(mm_esp), INTENT(in)                   :: xESP !! Specie properties.
     REAL(kind=mm_wp), DIMENSION(SIZE(temp))    :: res  !! Latent heat of given specie at given temperatures (\(J.kg^{-1}\)).
     REAL(kind=mm_wp) :: ftm
+    REAL(kind=mm_wp) :: ftm
     INTEGER      :: i
     DO i=1,SIZE(temp)
       ftm=MIN(1._mm_wp-temp(i)/xESP%tc,1.e-3_mm_wp)
+      ftm=MAX(1._mm_wp-temp(i)/xESP%tc,1.e-3_mm_wp)
       res(i) = mm_rgas*xESP%tc*(7.08_mm_wp*ftm**0.354_mm_wp+10.95_mm_wp*xESP%w*ftm**0.456_mm_wp) / &
                xESP%masmol
+        xESP%masmol
     ENDDO
   END FUNCTION LHeatX_ve
 …
   FUNCTION sigX_sc(temp,xESP) RESULT(res)
     !! Get the surface tension between a given specie and the air (scalar).
     !!
+    !!
     !! The method computes the surface tension equation as given in \cite{reid1986} p. 637 (eq. 12-3.6).
     REAL(kind=mm_wp), INTENT(in) :: temp !! temperature (K).
 …
     sig = 0.1196_mm_wp*(1._mm_wp+(tbr*dlog(xESP%pc/1.01325_mm_wp))/(1._mm_wp-tbr))-0.279_mm_wp
     sig = xESP%pc**(2._mm_wp/3._mm_wp)*xESP%tc**(1._mm_wp/3._mm_wp)*sig*(1._mm_wp-tr)**(11._mm_wp/9._mm_wp)
     res = sig*1e3_mm_wp ! dyn/cm2 -> N/m
+    res = sig*1e-3_mm_wp ! dyn/cm -> N/m
   END FUNCTION sigX_sc
   FUNCTION sigX_ve(temp,xESP) RESULT(res)
     !! Get the surface tension between a given specie and the air (vector).
 …
     REAL(kind=mm_wp), DIMENSION(SIZE(temp)) :: res     !! Surface tensions (\(N.m^{-1}\)).
     INTEGER      :: i
     REAL(kind=mm_wp) :: tr,tbr,sig
+    REAL(kind=mm_wp) :: tr,tbr,sig0,sig
     tbr = xESP%tb/xESP%tc
     sig = 0.1196_mm_wp*(1._mm_wp+(tbr*dlog(xESP%pc/1.01325_mm_wp))/(1._mm_wp-tbr))-0.279_mm_wp
+    sig0 = 0.1196_mm_wp*(1._mm_wp+(tbr*dlog(xESP%pc/1.01325_mm_wp))/(1._mm_wp-tbr))-0.279_mm_wp
     DO i=1,SIZE(temp)
       tr     = MIN(temp(i)/xESP%tc,0.99_mm_wp)
       sig    = xESP%pc**(2._mm_wp/3._mm_wp)*xESP%tc**(1._mm_wp/3._mm_wp)*sig*(1._mm_wp-tr)**(11._mm_wp/9._mm_wp)
       res(i) = sig*1e3_mm_wp ! dyn/cm2 -> N/m
+      sig    = xESP%pc**(2._mm_wp/3._mm_wp)*xESP%tc**(1._mm_wp/3._mm_wp)*sig0*(1._mm_wp-tr)**(11._mm_wp/9._mm_wp)
+      res(i) = sig*1e-3_mm_wp ! dyn/cm -> N/m
     ENDDO
   END FUNCTION sigX_ve
 …
   FUNCTION psatX_sc(temp,xESP) RESULT(res)
     !! Get saturation vapor pressure for a given specie at given temperature (scalar).
     !!
+    !!
     !! The method computes the saturation vapor pressure equation given in \cite{reid1986} p. 657 (eq. 1).
-    !!
-    !! @warning
-    !! This subroutine accounts for a specific Titan feature:
-    !! If __xESP__ corresponds to \(CH_{4}\), the saturation vapor presure is multiplied by 0.85
-    !! to take into account its dissolution in \(N_{2}\).
     REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K).
     TYPE(mm_esp), INTENT(in)     :: xESP !! Specie properties.
 …
     IF (x > 0._mm_wp) THEN
       qsat = (1._mm_wp-x)**(-1) * &
       (xESP%a_sat*x + xESP%b_sat*x**1.5_mm_wp + xESP%c_sat*x**3 + xESP%d_sat*x**6)
+        (xESP%a_sat*x + xESP%b_sat*x**1.5_mm_wp + xESP%c_sat*x**2.5_mm_wp + xESP%d_sat*x**5_mm_wp)
     ELSE
+      qsat = XESP%a_sat*x/abs(1._mm_wp-x)     ! approx for  t > tc
+    ENDIF
+    !  Special case : ch4 : x0.85 (dissolution in N2)
+    IF (xESP%name == "ch4") THEN
+      res = xESP%pc*dexp(qsat)*0.85_mm_wp
+    ELSE
+      res = xESP%pc*dexp(qsat)
+    ENDIF
+      qsat = XESP%a_sat*x/abs(1._mm_wp-x) ! approx for t > tc
+    ENDIF
+    res = xESP%pc*exp(qsat)
     ! now convert bar to Pa
     res = res * 1e5_mm_wp
 …
   FUNCTION psatX_ve(temp,xESP) RESULT(res)
     !! Get saturation vapor pressure for a given specie at given temperature (vector).
     !!
+    !!
     !! See [[mm_methods(module):psatX_sc(function)]].
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K).
 …
       x = 1._mm_wp-temp(i)/xESP%tc
       IF (x > 0._mm_wp) THEN
         qsat = (1._mm_wp-x)**(-1) * &
         (xESP%a_sat*x + xESP%b_sat*x**1.5_mm_wp + xESP%c_sat*x**3 + xESP%d_sat*x**6)
+        qsat = (1._mm_wp-x)**(-1) * &
+          (xESP%a_sat*x + xESP%b_sat*x**1.5_mm_wp + xESP%c_sat*x**2.5_mm_wp + xESP%d_sat*x**5_mm_wp)
       ELSE
         qsat = XESP%a_sat*x/abs(1._mm_wp-x)     ! approx for  t > tc
+        qsat = XESP%a_sat*x/abs(1._mm_wp-x) ! approx for t > tc
       ENDIF
+      res(i) = xESP%pc*dexp(qsat)
+      !  Peculiar case : ch4 : x0.85 (dissolution in N2)
+      IF (xESP%name == "ch4") res(i) = res(i)* 0.85_mm_wp
+      res(i) = xESP%pc*exp(qsat)
     ENDDO
+    res = res * 1e5_mm_wp  ! bar -> Pa
+    ! now convert bar to Pa
+    res = res * 1e5_mm_wp
   END FUNCTION psatX_ve
   FUNCTION qsatX_sc(temp,pres,xESP) RESULT(res)
     !! Get the mass mixing ratio of a given specie at saturation (scalar).
+    !!
+    !! @warning
+    !! The method applies a multiplicative factor of 0.85 if the specie is CH4 :
+    !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere.
     REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K).
     REAL(kind=mm_wp), INTENT(in) :: pres !! Pressure level (Pa).
     TYPE(mm_esp), INTENT(in)    :: xESP  !! Specie properties.
     REAL(kind=mm_wp) :: res              !! Mass mixing ratio of the specie.
     REAL(kind=mm_wp) :: x,psat
+    REAL(kind=mm_wp) :: psat
     psat = mm_psatX(temp,xESP)
     res = (psat / pres) * xESP%fmol2fmas
+    ! Peculiar case : CH4 : x0.85 (dissolution in N2)
+    IF (xESP%name == "CH4") THEN
+      res = res * 0.85_mm_wp
+      IF (mm_debug) WRITE(*,'(a)') "[DEBUG] mm_qsat: applying .85 factor to qsat for CH4 specie (N2 dissolution)"
+    ENDIF
   END FUNCTION qsatX_sc
   FUNCTION qsatX_ve(temp,pres,xESP) RESULT(res)
     !! Get the mass mixing ratio of a given specie at saturation (vector).
+    !!
+    !! @warning
+    !! The method applies a multiplicative factor of 0.85 if the specie is CH4 :
+    !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere.
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K).
     REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: pres !! Pressure levels (Pa).
 …
     psat = mm_psatX(temp,xESP)
     res = (psat / pres) * xESP%fmol2fmas
+    ! Peculiar case : CH4 : x0.85 (dissolution in N2)
+    IF (xESP%name == "CH4") THEN
+      res = res * 0.85_mm_wp
+      IF (mm_debug) WRITE(*,'(a)') "[DEBUG] mm_qsat: applying .85 factor to qsat for CH4 specie (N2 dissolution)"
+    ENDIF
   END FUNCTION qsatX_ve
+  FUNCTION ysatX_sc(temp,pres,xESP) RESULT(res)
+    !! Get the molar mixing ratio of a given specie at saturation (scalar).
+    !!
+    !! @warning
+    !! The method applies a multiplicative factor of 0.85 if the specie is CH4 :
+    !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere.
+    REAL(kind=mm_wp), INTENT(in) :: temp !! Temperature (K).
+    REAL(kind=mm_wp), INTENT(in) :: pres !! Pressure level (Pa).
+    TYPE(mm_esp), INTENT(in)     :: xESP !! Specie properties.
+    REAL(kind=mm_wp)             :: res  !! Molar mixing ratio of the specie.
+    ! Fray and Schmidt (2009)
+    IF(xESP%name == "C2H2") THEN
+      res = (1.0e5 / pres) * exp(1.340e1 - 2.536e3/temp)
+    ELSE IF(xESP%name == "C2H6") THEN
+      res = (1.0e5 / pres) * exp(1.511e1 - 2.207e3/temp - 2.411e4/temp**2 + 7.744e5/temp**3 - 1.161e7/temp**4 + 6.763e7/temp**5)
+    ELSE IF(xESP%name == "HCN") THEN
+      res = (1.0e5 / pres) * exp(1.393e1 - 3.624e3/temp - 1.325e5/temp**2 + 6.314e6/temp**3 - 1.128e8/temp**4)
+    ELSE IF (xESP%name == "CH4") THEN
+      res = (1.0e5 / pres) * exp(1.051e1 - 1.110e3/temp - 4.341e3/temp**2 + 1.035e5/temp**3 - 7.910e5/temp**4)
+      res = res * 0.85_mm_wp
+      !IF (res < 0.014) THEN
+      !  res = 0.014
+      !ENDIF
+    ENDIF
+  END FUNCTION ysatX_sc
+  FUNCTION ysatX_ve(temp,pres,xESP) RESULT(res)
+    !! Get the molar mixing ratio of a given specie at saturation (vector).
+    !!
+    !! @warning
+    !! The method applies a multiplicative factor of 0.85 if the specie is CH4 :
+    !! this is done to account for dissolution in N2 and is somehow specific to Titan atmosphere.
+    REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: temp !! Temperatures (K).
+    REAL(kind=mm_wp), INTENT(in), DIMENSION(:) :: pres !! Pressure levels (Pa).
+    TYPE(mm_esp), INTENT(in)                   :: xESP !! Specie properties.
+    REAL(kind=mm_wp), DIMENSION(SIZE(temp))    :: res  !! Molar mixing ratios of the specie.
+    ! Fray and Schmidt (2009)
+    IF(xESP%name == "C2H2") THEN
+      res = (1.0e5 / pres) * exp(1.340e1 - 2.536e3/temp)
+    ELSE IF(xESP%name == "C2H6") THEN
+      res = (1.0e5 / pres) * exp(1.511e1 - 2.207e3/temp - 2.411e4/temp**2 + 7.744e5/temp**3 - 1.161e7/temp**4 + 6.763e7/temp**5)
+    ELSE IF(xESP%name == "HCN") THEN
+      res = (1.0e5 / pres) * exp(1.393e1 - 3.624e3/temp - 1.325e5/temp**2 + 6.314e6/temp**3 - 1.128e8/temp**4)
+    ! Peculiar case : CH4 : x0.85 (dissolution in N2)
+    ELSE IF (xESP%name == "CH4") THEN
+      res = (1.0e5 / pres) * exp(1.051e1 - 1.110e3/temp - 4.341e3/temp**2 + 1.035e5/temp**3 - 7.910e5/temp**4)
+      res = res * 0.85_mm_wp
+      !WHERE (res(:) < 0.014) res(:) = 0.014
+    ENDIF
+  END FUNCTION ysatX_ve
   ELEMENTAL FUNCTION mm_get_kco(t) RESULT(res)

trunk/LMDZ.TITAN/libf/muphytitan/mm_microphysic.f90

-                      r2109
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! brief: Microphysic processes interface module.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 MODULE MM_MICROPHYSIC
 …
   !! Interface to main microphysics subroutine.
   !!
   !! The interface computes calls either all the microphysics processes ([[mm_microphysic(module):muphys_all(function)]]
+  !!
+  !! The interface computes calls either all the microphysics processes ([[mm_microphysic(module):muphys_all(function)]]
   !! or only aerosols microphysics ([[mm_microphysic(module):muphys_nocld(function)]]) in a single call.
   INTERFACE mm_muphys
     MODULE PROCEDURE muphys_all, muphys_nocld
   END INTERFACE
   CONTAINS
+  END INTERFACE mm_muphys
+CONTAINS
   FUNCTION muphys_all(dm0a_s,dm3a_s,dm0a_f,dm3a_f,dm0n,dm3n,dm3i,dgazs) RESULT(ret)
     !! Compute the evolution of moments tracers through haze and clouds microphysics processes.
     !!
     !! This method computes the evolution of all the microphysics tracers, given under the form of moments
+    !!
+    !! This method computes the evolution of all the microphysics tracers, given under the form of moments
     !! (and molar fraction for cloud condensible species) during a time step.
     !!
     !! The method requires that global variables of the model (i.e. variables declared in [[mm_globals(module)]]
+    !!
+    !! The method requires that global variables of the model (i.e. variables declared in [[mm_globals(module)]]
     !! module) are initialized/updated correctly (see [[mm_globals(module):mm_global_init(interface)]],
     !! [[mm_globals(module):mm_column_init(function)]],[[mm_globals(module):mm_aerosols_init(function)]] and
     !! [[mm_globals(module):mm_clouds_init(function)]]).
     !!
     !! The tendencies returned by the method are defined on the vertical __layers__ of the model from the __GROUND__ to
     !! the __TOP__ of the atmosphere. They should be added to the input variables used in the initialization methods
+    !!
+    !! The tendencies returned by the method are defined on the vertical __layers__ of the model from the __GROUND__ to
+    !! the __TOP__ of the atmosphere. They should be added to the input variables used in the initialization methods
     !! before the latter are called to initialize a new step.
     !! @note
     !! __dm3i__ and __dgazs__ are 2D-arrays with vertical __layers__ in the 1st dimension and the number of
     !! ice components in the 2nd. They share the same _species_ indexing.
+    !! ice components in the 2nd. They share the same _species_ indexing.
     !!
     !! It should be a 2D-array with the vertical layers in first dimension and the number of ice components in the second.
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm0a_s
       !! Tendency of the 0th order moment of the spherical mode distribution (\(m^{-2}\)).
+    !! Tendency of the 0th order moment of the spherical mode distribution (\(m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm3a_s
       !! Tendency of the 3rd order moment of the spherical mode distribution (\(m^{3}.m^{-2}\)).
+    !! Tendency of the 3rd order moment of the spherical mode distribution (\(m^{3}.m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm0a_f
       !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-2}\)).
+    !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm3a_f
       !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-2}\)).
+    !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm0n
       !! Tendency of the 0th order moment of the _CCN_ distribution (\(m^{-2}\)).
+    !! Tendency of the 0th order moment of the _CCN_ distribution (\(m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:)   :: dm3n
       !! Tendency of the 3rd order moment of the _CCN_ distribution (\(m^{3}.m^{-2}\)).
+    !! Tendency of the 3rd order moment of the _CCN_ distribution (\(m^{3}.m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:,:) :: dm3i
       !! Tendencies of the 3rd order moments of each ice components (\(m^{3}.m^{-2}\)).
+    !! Tendencies of the 3rd order moments of each ice components (\(m^{3}.m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:,:) :: dgazs
       !! Tendencies of each condensible gaz species (\(mol.mol^{-1}\)).
+    !! Tendencies of each condensible gaz species (\(mol.mol^{-1}\)).
     LOGICAL :: ret
       !! .true. on success (i.e. model has been initialized at least once previously), .false. otherwise.
+    !! .true. on success (i.e. model has been initialized at least once previously), .false. otherwise.
     REAL(kind=mm_wp), DIMENSION(SIZE(dm0a_s)) :: zdm0a_f,zdm3a_f
     INTEGER                                   :: i
 …
       ! add temporary aerosols tendencies (-> m-3)
       dm0a_f = dm0a_f + zdm0a_f  ; dm3a_f = dm3a_f + zdm3a_f
       ! reverse clouds tendencies (-> m-2)
+      ! reverse directly clouds tendencies (-> m-2)
       dm0n   = dm0n(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
       dm3n   = dm3n(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
+      ! sanity check for clouds tendencies : call mm_check_tendencies(mm_m0ccn,dm0n)
+      ! sanity check for clouds tendencies : call mm_check_tendencies(mm_m3ccn,dm3n)
       DO i=1,mm_nesp
+        dm3i(:,i)  = dm3i(mm_nla:1:-1,i)  * mm_dzlev(mm_nla:1:-1)
+        dgazs(:,i) = dgazs(mm_nla:1:-1,i)
+        dm3i(:,i)  = dm3i(mm_nla:1:-1,i) * mm_dzlev(mm_nla:1:-1)
+        ! sanity check for clouds tendencies : call mm_check_tendencies(mm_m3ice,dm3i)
+        dgazs(:,i) = dgazs(mm_nla:1:-1,i)
+        ! no sanity check for gazs, let's prey.
       ENDDO
     ELSE
 …
     dm0a_f = dm0a_f(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
     dm3a_f = dm3a_f(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
+    ! sanity check
+    ! sanity check : call mm_check_tendencies(mm_m0aer_s,dm0a_s)
+    ! sanity check : call mm_check_tendencies(mm_m3aer_s,dm3a_s)
+    ! sanity check : call mm_check_tendencies(mm_m0aer_f,dm0a_f)
+    ! sanity check : call mm_check_tendencies(mm_m3aer_f,dm3a_f)
     RETURN
   END FUNCTION muphys_all
 …
   FUNCTION muphys_nocld(dm0a_s,dm3a_s,dm0a_f,dm3a_f) RESULT(ret)
     !! Compute the evolution of moments tracers through haze microphysics only.
     !!
     !! This method is a __light__ version of [[mm_microphysic(module):muphys_all(function)]] where
+    !!
+    !! This method is a __light__ version of [[mm_microphysic(module):muphys_all(function)]] where
     !! only haze microphysics is computed and its tendencies returned.
     !!
     !! The method has the same requirements and remarks than [[mm_microphysic(module):muphys_all(function)]].
+    !! The method has the same requirements and remarks than [[mm_microphysic(module):muphys_all(function)]].
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm0a_s
       !! Tendency of the 0th order moment of the spherical mode distribution (\(m^{-2}\)).
+    !! Tendency of the 0th order moment of the spherical mode distribution (\(m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3a_s
       !! Tendency of the 3rd order moment of the spherical mode distribution (\(m^{3}.m^{-2}\)).
+    !! Tendency of the 3rd order moment of the spherical mode distribution (\(m^{3}.m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm0a_f
       !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-2}\)).
+    !! Tendency of the 0th order moment of the fractal mode distribution (\(m^{-2}\)).
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:) :: dm3a_f
       !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-2}\)).
+    !! Tendency of the 3rd order moment of the fractal mode distribution (\(m^{3}.m^{-2}\)).
     LOGICAL :: ret
       !! .true. on succes (i.e. model has been initialized at least once previously), .false. otherwise.
+    !! .true. on succes (i.e. model has been initialized at least once previously), .false. otherwise.
     ret = (mm_ini_col.AND.mm_ini_aer)
     IF (.NOT.ret) RETURN
     IF (mm_w_clouds.AND.mm_debug) THEN
       WRITE(*,'(a)') "WARNING: clouds microphysics enabled but will not be &
                      &computed... (wrong interface)"
+      &computed... (wrong interface)"
     ENDIF
     ! Calls haze microphysics
     call mm_haze_microphysics(dm0a_s,dm3a_s,dm0a_f,dm3a_f)
     ! reverse vectors so they go from ground to top :)
     dm0a_s = dm0a_s(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
+    dm0a_s = dm0a_s(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
     dm3a_s = dm3a_s(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
     dm0a_f = dm0a_f(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
+    dm0a_f = dm0a_f(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
     dm3a_f = dm3a_f(mm_nla:1:-1) * mm_dzlev(mm_nla:1:-1)
+    ! sanity check
+    ! sanity check : call mm_check_tendencies(mm_m0aer_s,dm0a_s)
+    ! sanity check : call mm_check_tendencies(mm_m3aer_s,dm3a_s)
+    ! sanity check : call mm_check_tendencies(mm_m0aer_f,dm0a_f)
+    ! sanity check : call mm_check_tendencies(mm_m3aer_f,dm3a_f)
     RETURN
   END FUNCTION muphys_nocld
+  SUBROUTINE mm_diagnostics(aer_prec,aer_s_flux,aer_f_flux,         &
+                            ccn_prec,ccn_flux, ice_prec,ice_fluxes, &
+                            gazs_sat)
+  SUBROUTINE mm_diagnostics(aer_prec,aer_s_w,aer_f_w,aer_s_flux,aer_f_flux,ccn_prec,ccn_w,ccn_flux,ice_prec,ice_fluxes,gazs_sat)
     !! Get various diagnostic fields of the microphysics.
     !!
 …
     !!
     !! - Mass fluxes (aerosols -both mode-, CCN and ices)
+    !! - Settling velocity (aerosols -total-, CCN and ices)
     !! - Precipitations (aerosols -total-, CCN and ices)
     !! - condensible gazes saturation ratio
     !!
     !! @note
     !! Fluxes values are always negative as they account for sedimentation fluxes. They are set as
+    !! @note
+    !! Fluxes values are always negative as they account for sedimentation fluxes. They are set as
     !! vector (for aerosols and CCN) or 2D-array (with the vertical structure in the first dimension
     !! and number of species in the second, for ice) and are ordered from __GROUND__ to __TOP__.
     !!
     !! @note
     !! Precipitations are always positive and defined in meters. For ice, it is set as a vector with
+    !! Precipitations are always positive and defined in meters. For ice, it is set as a vector with
     !! the precipitations of each cloud ice components.
     !!
     !! @note
     !! __ccnprec__, __iceprec__, __icefluxes__ and __gazsat__ are always set to 0 if clouds
+    !! __ccnprec__, __iceprec__, __icefluxes__ and __gazsat__ are always set to 0 if clouds
     !! microphysics is disabled (see [[mm_globals(module):mm_w_clouds(variable)]] documentation).
     REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: aer_prec   !! Aerosols precipitations (both modes) (m).
+    REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: ccn_prec   !! CCN precipitations (m).
+    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: aer_s_w    !! Spherical aerosol settling velocity (\(m.s^{-1}\)).
+    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: aer_f_w    !! Fractal aerosol settling velocity (\(m.s^{-1}\)).
+    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: ccn_w      !! CCN settling velocity (\(m.s^{-1}\)).
     REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: aer_s_flux !! Spherical aerosol mass flux (\(kg.m^{-2}.s^{-1}\)).
     REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: aer_f_flux !! Fractal aerosol mass flux (\(kg.m^{-2}.s^{-1}\)).
-    REAL(kind=mm_wp), INTENT(out), OPTIONAL                 :: ccn_prec   !! CCN precipitations (m).
     REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: ccn_flux   !! CCN mass flux (\(kg.m^{-2}.s^{-1}\)).
-    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: ice_prec   !! Ice precipitations (m).
     REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:,:) :: ice_fluxes !! Ice sedimentation fluxes (\(kg.m^{-2}.s^{-1}\)).
     REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:,:) :: gazs_sat   !! Condensible gaz saturation ratios (--).
+    IF (PRESENT(aer_prec))   aer_prec   = ABS(mm_aer_prec)
+    REAL(kind=mm_wp), INTENT(out), OPTIONAL, DIMENSION(:)   :: ice_prec   !! Ice precipitations (m).
+    IF (PRESENT(aer_prec))   aer_prec   = ABS(mm_aer_prec)
+    IF (PRESENT(aer_s_w))    aer_s_w    = -mm_m3as_vsed(mm_nla:1:-1)
+    IF (PRESENT(aer_f_w))    aer_f_w    = -mm_m3af_vsed(mm_nla:1:-1)
     IF (PRESENT(aer_s_flux)) aer_s_flux = -mm_aer_s_flux(mm_nla:1:-1)
     IF (PRESENT(aer_f_flux)) aer_f_flux = -mm_aer_f_flux(mm_nla:1:-1)
 …
       IF (PRESENT(ccn_prec))   ccn_prec   = ABS(mm_ccn_prec)
       IF (PRESENT(ice_prec))   ice_prec   = ABS(mm_ice_prec)
+      IF (PRESENT(ccn_w))      ccn_w      = mm_ccn_w(mm_nla:1:-1)
       IF (PRESENT(ccn_flux))   ccn_flux   = -mm_ccn_flux(mm_nla:1:-1)
       IF (PRESENT(ice_fluxes)) ice_fluxes = -mm_ice_fluxes(mm_nla:1:-1,:)
+      IF (PRESENT(ice_fluxes)) ice_fluxes = mm_ice_fluxes(mm_nla:1:-1,:)
       IF (PRESENT(gazs_sat))   gazs_sat   =  mm_gazs_sat(mm_nla:1:-1,:)
     ELSE
+    ELSE
       IF (PRESENT(ccn_prec))   ccn_prec   = 0._mm_wp
       IF (PRESENT(ice_prec))   ice_prec   = 0._mm_wp
+      IF (PRESENT(ccn_w))      ccn_w      = 0._mm_wp
       IF (PRESENT(ccn_flux))   ccn_flux   = 0._mm_wp
       IF (PRESENT(ice_fluxes)) ice_fluxes = 0._mm_wp
 …
   SUBROUTINE mm_get_radii(rcsph,rcfra,rccld)
     !! Get characteristic radii of microphysical tracers on the vertical grid.
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: rcsph !! Spherical mode characteristic radius
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: rcfra !! Fractal mode characteristic radius
+    REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: rcsph !! Spherical mode characteristic radius
+    REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: rcfra !! Fractal mode characteristic radius
     REAL(kind=mm_wp), INTENT(out), DIMENSION(:), OPTIONAL :: rccld !! Cloud drops mean radius
     IF (mm_ini_aer) THEN
       IF (PRESENT(rcsph)) rcsph = mm_rcs(mm_nla:1:-1)
       IF (PRESENT(rcfra)) rcfra = mm_rcf(mm_nla:1:-1)
+      IF (PRESENT(rcsph)) rcsph = mm_rcs(mm_nla:1:-1)
+      IF (PRESENT(rcfra)) rcfra = mm_rcf(mm_nla:1:-1)
     ELSE
       IF (PRESENT(rcsph)) rcsph = 0._mm_wp
       IF (PRESENT(rcfra)) rcfra = 0._mm_wp
+      IF (PRESENT(rcsph)) rcsph = 0._mm_wp
+      IF (PRESENT(rcfra)) rcfra = 0._mm_wp
     ENDIF
     IF (PRESENT(rccld)) THEN

trunk/LMDZ.TITAN/libf/muphytitan/mm_mprec.F90

-                      r1897
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL-B license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL-B
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL-B license and that you accept its terms.
 …
 !! summary: Library floating point precision module.
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 #ifdef HAVE_CONFIG_H
 …
 #ifndef PREC
 #define PREC 64
+#define PREC 64
 #elif (PREC != 32 && PREC != 64 && PREC != 80)
 #undef PREC
 …
   !!
   !! This module only defines a single variable [[mm_mprec(module):mm_wp(variable)]] which sets
   !! the kind of floating point value used in all other part of the library (REAL(kind=mm_wp)
+  !! the kind of floating point value used in all other part of the library (REAL(kind=mm_wp)
   !! declaration statement).
   IMPLICIT NONE
 …
 #if (PREC == 32)
   !> Size of floating point variables in the library (single).
+  INTEGER, PUBLIC, PARAMETER :: mm_wp = SELECTED_REAL_KIND(p=6)  ! 32 bits
+  INTEGER, PUBLIC, PARAMETER          :: mm_wp = SELECTED_REAL_KIND(p=6)  ! 32 bits
+  CHARACTER(len=è), PUBLIC, PARAMETER :: mm_wp_s = "32 bits"
 #elif (PREC == 64)
   !> Size of floating point variables in the library (double).
+  INTEGER, PUBLIC, PARAMETER :: mm_wp = SELECTED_REAL_KIND(p=15) ! 64 bits
+  INTEGER, PUBLIC, PARAMETER          :: mm_wp = SELECTED_REAL_KIND(p=15) ! 64 bits
+  CHARACTER(len=7), PUBLIC, PARAMETER :: mm_wp_s = "64 bits"
 #elif (PREC == 80)
   !> Size of floating point variables in the library (extended-double).
+  INTEGER, PUBLIC, PARAMETER :: mm_wp = SELECTED_REAL_KIND(p=18) ! 80 bits
+  INTEGER, PUBLIC, PARAMETER          :: mm_wp = SELECTED_REAL_KIND(p=18) ! 80 bits
+  CHARACTER(len=7), PUBLIC, PARAMETER :: mm_wp_s = "80 bits"
 #endif
 END MODULE MM_MPREC

trunk/LMDZ.TITAN/libf/muphytitan/mmp_gcm.f90

-                      r1926
+                      r3083
 ! Copyright 2017 Université de Reims Champagne-Ardenne
+! Copyright 2017 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL license and that you accept its terms.
 …
   IMPLICIT NONE
   CONTAINS
+  CONTAINS
   SUBROUTINE mmp_initialize(dt,p_prod,tx_prod,rc_prod,rplanet,g0, air_rad,air_mmol,clouds,cfgpath)
     !! Initialize global parameters of the model.
     !!
+    !!
     !! The function initializes all the global parameters of the model from direct input.
     !! Boolean (and Fiadero) parameters are optional as they are rather testing parameters. Their
     !! default values are suitable for production runs.
+    !! Boolean (and Fiadero) parameters are optional as they are rather testing parameters. Their
+    !! default values are suitable for production runs.
     !! @note
     !! If the subroutine fails to initialize parameters, the run is aborted.
     !!
     !! @warning
     !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
+    !! If OpenMP is activated, this subroutine must be called in an $OMP SINGLE statement as it
     !! initializes global variable that are not thread private.
     !!
 …
     INTEGER                                           :: coag_choice
     REAL(kind=mm_wp)                                  :: fiad_max, fiad_min,df,rm,rho_aer
     LOGICAL                                           :: w_h_prod, w_h_sed, w_h_coag, w_c_sed, w_c_nucond, &
                                                          no_fiadero, fwsed_m0, fwsed_m3
+    REAL(kind=mm_wp)                                  :: fiad_max,fiad_min,df,rm,rho_aer
+    LOGICAL                                           :: w_h_prod,w_h_sed,w_h_coag,w_c_sed,w_c_nucond, &
+                                                         no_fiadero,fwsed_m0,fwsed_m3
     TYPE(error)                                       :: err
     INTEGER                                           :: i
 …
     CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: species
     REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE       :: tmp
+    REAL(kind=mm_wp)                                  :: m0as_min,rcs_min,m0af_min,rcf_min,m0n_min
+    LOGICAL                                           :: wdebug
     w_h_prod    = .true.
 …
     fwsed_m0    = .true.
     fwsed_m3    = .false.
     no_fiadero  = .false.
+    no_fiadero  = .true.
     fiad_min    = 0.1_mm_wp
     fiad_max    = 10._mm_wp
     coag_choice = 7
+    wdebug      = .false.
+    m0as_min    = 1e-10_mm_wp
+    rcs_min     = 1e-9_mm_wp
+    m0af_min    = 1e-10_mm_wp
+    rcf_min     = 1e-9_mm_wp
+    m0n_min     = 1e-10_mm_wp
     WRITE(*,'(a)') "##### MMP_GCM SPEAKING #####"
     WRITE(*,'(a)') "I will initialize ze microphysics model in moments YAMMS"
+    WRITE(*,'(a)') "I will initialize the microphysics model in moments YAMMS"
     WRITE(*,'(a)') "On error I will simply abort the program. Stay near your computer !"
     WRITE(*,*)
     WRITE(*,'(a)') "Reading muphys configuration file ("//trim(cfgpath)//")..."
     err = cfg_read_config(cparser,TRIM(cfgpath),.true.)
+    err = cfg_read_config(cparser,TRIM(cfgpath),.true.)
     IF (err /= 0) THEN
       ! RETURN AN ERROR !!
       call abort_program(err)
     ENDIF
     ! YAMMS internal parameters:
     err = mm_check_opt(cfg_get_value(cparser,"rm",rm),rm,50e-9_mm_wp,mm_log)
 …
     ! the following parameters are primarily used to test and debug YAMMS.
     ! They are set in an optional configuration file and default to suitable values for production runs.
+    err = mm_check_opt(cfg_get_value(cparser,"haze_production",w_h_prod)    ,w_h_prod   ,.true.   ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"haze_sedimentation",w_h_sed)  ,w_h_sed    ,.true.   ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"haze_coagulation",w_h_coag)   ,w_h_coag   ,.true.   ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"clouds_sedimentation",w_c_sed),w_c_sed    ,clouds   ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"clouds_nucl_cond",w_c_nucond) ,w_c_nucond ,clouds   ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"wsed_m0",fwsed_m0)            ,fwsed_m0   ,.true.   ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"wsed_m3",fwsed_m3)            ,fwsed_m3   ,.false.  ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"no_fiadero",no_fiadero)       ,no_fiadero ,.false.  ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"fiadero_min_ratio",fiad_min)  ,fiad_min   ,0.1_mm_wp,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"fiadero_max_ratio",fiad_max)  ,fiad_max   ,10._mm_wp,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"haze_coag_interactions",coag_choice),coag_choice,7,mm_log)
+    ! optic look-up table file path.
+    mmp_optic_file = ''
+    opt_file = ''
+    err = mm_check_opt(cfg_get_value(cparser,"optics/optic_file",opt_file),opt_file,'',mm_log)
+    IF (err /= 0) THEN
+      WRITE(*,'(a)') "Warning: I was unable to retrieve the path of the optic look-up table file:"
+      WRITE(*,'(a)') "  The GCM may abort if it uses YAMMS optical properties calculation module !"
+    ELSE
+      mmp_optic_file = TRIM(opt_file)
+    ENDIF
+    err = mm_check_opt(cfg_get_value(cparser,"haze_production",w_h_prod)          ,w_h_prod   ,.true.     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"haze_sedimentation",w_h_sed)        ,w_h_sed    ,.true.     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"haze_coagulation",w_h_coag)         ,w_h_coag   ,.true.     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"clouds_sedimentation",w_c_sed)      ,w_c_sed    ,clouds     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"clouds_nucl_cond",w_c_nucond)       ,w_c_nucond ,clouds     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"wsed_m0",fwsed_m0)                  ,fwsed_m0   ,.true.     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"wsed_m3",fwsed_m3)                  ,fwsed_m3   ,.false.    ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"no_fiadero",no_fiadero)             ,no_fiadero ,.true.     ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"fiadero_min_ratio",fiad_min)        ,fiad_min   ,0.1_mm_wp  ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"fiadero_max_ratio",fiad_max)        ,fiad_max   ,10._mm_wp  ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"haze_coag_interactions",coag_choice),coag_choice,7          ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"m0as_min",m0as_min)                 ,m0as_min   ,1e-10_mm_wp,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"rcs_min",rcs_min)                   ,rcs_min    ,1e-9_mm_wp ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"m0af_min",m0af_min)                 ,m0af_min   ,1e-10_mm_wp,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"rcf_min",rcf_min)                   ,rcf_min    ,rm         ,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"m0n_min",m0n_min)                   ,m0n_min    ,1e-10_mm_wp,mm_log)
+    err = mm_check_opt(cfg_get_value(cparser,"debug",wdebug)                      ,wdebug     ,.false.    ,mm_log)
     ! Retrieve clouds species configuration file
 …
     ENDIF
+    ! YAMMS initialization.
+    err = mm_global_init_0(dt,df,rm,rho_aer,p_prod,tx_prod,rc_prod,rplanet,g0, &
+                           air_rad,air_mmol,coag_choice,clouds,spcpath,  &
+                           w_h_prod,w_h_sed,w_h_coag,w_c_nucond,  &
+                           w_c_sed,fwsed_m0,fwsed_m3, &
+                           no_fiadero,fiad_min,fiad_max)
+    IF (err /= 0) call abort_program(err)
+    ! Extra initialization (needed for YAMMS method interfaces)
+    err = mm_check_opt(cfg_get_value(cparser, "transfert_probability", mmp_w_ps2s), mmp_w_ps2s, wlog=mm_log)
+    IF (err/=0) call abort_program(err)
+    err = mm_check_opt(cfg_get_value(cparser, "electric_charging"    , mmp_w_qe  ), mmp_w_qe, wlog=mm_log)
+    IF (err/=0) call abort_program(err)
+    ! initialize transfert probabilities look-up tables
+    IF (mm_w_haze_coag .AND. mmp_w_ps2s) THEN
+      err = mm_check_opt(cfg_get_value(cparser, "ps2s_file", pssfile), pssfile)
+      IF (err /= 0) call abort_program(err)
+      IF (.NOT.read_dset(pssfile,'p_m0_co',mmp_pco0p)) THEN
+        call abort_program(error("Cannot get 'p_m0_co' from "//pssfile,-1))
+      ENDIF
+      IF (.NOT.read_dset(pssfile,'p_m3_co',mmp_pco3p)) THEN
+        call abort_program(error("Cannot get 'p_m3_co' from "//pssfile,-1))
+      ENDIF
+      IF (.NOT.read_dset(pssfile,'p_m0_fm',mmp_pfm0p)) THEN
+        call abort_program(error("Cannot get 'p_m0_fm' from "//pssfile,-1))
+      ENDIF
+      IF (.NOT.read_dset(pssfile,'p_m3_fm',mmp_pfm3p)) THEN
+        call abort_program(error("Cannot get 'p_m3_fm' from "//pssfile,-1))
+      ENDIF
+    ENDIF
+    ! initialize mean electric correction look-up tables
+    IF (mm_w_haze_coag .AND. mmp_w_qe) THEN
+      err = mm_check_opt(cfg_get_value(cparser, "mq_file", mqfile), mqfile)
+      IF (err /= 0) call abort_program(err)
+      IF (.NOT.read_dset(mqfile,'qbsf0',mmp_qbsf0)) THEN
+        call abort_program(error("Cannot get 'qbsf0' from "//mqfile,-1))
+      ELSE
+        mmp_qbsf0_e(1,1) = MINVAL(mmp_qbsf0%x)
+        mmp_qbsf0_e(1,2) = MAXVAL(mmp_qbsf0%x)
+        mmp_qbsf0_e(2,1) = MINVAL(mmp_qbsf0%y)
+        mmp_qbsf0_e(2,2) = MAXVAL(mmp_qbsf0%y)
+      ENDIF
+      IF (.NOT.read_dset(mqfile,'qbsf3',mmp_qbsf3)) THEN
+        call abort_program(error("Cannot get 'qbsf3' from "//mqfile,-1))
+      ELSE
+        mmp_qbsf3_e(1,1) = MINVAL(mmp_qbsf3%x)
+        mmp_qbsf3_e(1,2) = MAXVAL(mmp_qbsf3%x)
+        mmp_qbsf3_e(2,1) = MINVAL(mmp_qbsf3%y)
+        mmp_qbsf3_e(2,2) = MAXVAL(mmp_qbsf3%y)
+      ENDIF
+      IF (.NOT.read_dset(mqfile,'qbff0',mmp_qbff0)) THEN
+        call abort_program(error("Cannot get 'qbff0' from "//mqfile,-1))
+      ELSE
+        mmp_qbff0_e(1,1) = MINVAL(mmp_qbff0%x)
+        mmp_qbff0_e(1,2) = MAXVAL(mmp_qbff0%x)
+        mmp_qbff0_e(2,1) = MINVAL(mmp_qbff0%y)
+        mmp_qbff0_e(2,2) = MAXVAL(mmp_qbff0%y)
+      ENDIF
+    ENDIF
+    ! Setup alpha function: THEY ARE REQUIRED IN YAMMS global initialization !
     ! spherical mode inter-moments function parameters
     IF (.NOT.cfg_has_section(cparser,'alpha_s')) call abort_program(error("Cannot find [alpha_s] section",-1))
 …
     IF (err /= 0) call abort_program(error("alpha_s: "//TRIM(err%msg),-1))
+    ! get size-distribution laws parameters
+    IF (.NOT.cfg_has_section(cparser,'dndr_s')) call abort_program(error("Cannot find [dndr_s] section",-2))
+    err = read_nprm(cparser,'dndr_s',mmp_pns)
+    IF (err /= 0) call abort_program(error("dndr_s: "//TRIM(err%msg),-2))
+    IF (.NOT.cfg_has_section(cparser,'dndr_f')) call abort_program(error("Cannot find [dndr_f] section",-2))
+    err = read_nprm(cparser,'dndr_f',mmp_pnf)
+    IF (err /= 0) call abort_program(error("dndr_f: "//TRIM(err%msg),-2))
+    ! YAMMS initialization.
+    err = mm_global_init_0(dt,df,rm,rho_aer,p_prod,tx_prod,rc_prod,rplanet,g0, &
+                           air_rad,air_mmol,coag_choice,clouds,spcpath,  &
+                           w_h_prod,w_h_sed,w_h_coag,w_c_nucond,  &
+                           w_c_sed,fwsed_m0,fwsed_m3, &
+                           no_fiadero,fiad_min,fiad_max, &
+                           m0as_min,rcs_min,m0af_min,rcf_min,m0n_min,wdebug)
+    IF (err /= 0) call abort_program(err)
+    ! Extra initialization (needed for YAMMS method interfaces)
+    err = mm_check_opt(cfg_get_value(cparser, "transfert_probability", mmp_w_ps2s), mmp_w_ps2s, wlog=mm_log)
+    IF (err/=0) call abort_program(err)
+    err = mm_check_opt(cfg_get_value(cparser, "electric_charging"    , mmp_w_qe  ), mmp_w_qe, wlog=mm_log)
+    IF (err/=0) call abort_program(err)
+    ! initialize transfert probabilities look-up tables
+    IF (mm_w_haze_coag .AND. mmp_w_ps2s) THEN
+      err = mm_check_opt(cfg_get_value(cparser, "ps2s_file", pssfile), pssfile)
+      IF (err /= 0) call abort_program(err)
+      IF (.NOT.read_dset(pssfile,'p_m0_co',mmp_pco0p)) THEN
+        call abort_program(error("Cannot get 'p_m0_co' from "//pssfile,-1))
+      ENDIF
+      IF (.NOT.read_dset(pssfile,'p_m3_co',mmp_pco3p)) THEN
+        call abort_program(error("Cannot get 'p_m3_co' from "//pssfile,-1))
+      ENDIF
+      IF (.NOT.read_dset(pssfile,'p_m0_fm',mmp_pfm0p)) THEN
+        call abort_program(error("Cannot get 'p_m0_fm' from "//pssfile,-1))
+      ENDIF
+      IF (.NOT.read_dset(pssfile,'p_m3_fm',mmp_pfm3p)) THEN
+        call abort_program(error("Cannot get 'p_m3_fm' from "//pssfile,-1))
+      ENDIF
+    ENDIF
+    ! initialize mean electric correction look-up tables
+    IF (mm_w_haze_coag .AND. mmp_w_qe) THEN
+      err = mm_check_opt(cfg_get_value(cparser, "mq_file", mqfile), mqfile)
+      IF (err /= 0) call abort_program(err)
+      IF (.NOT.read_dset(mqfile,'qbsf0',mmp_qbsf0)) THEN
+        call abort_program(error("Cannot get 'qbsf0' from "//mqfile,-1))
+      ELSE
+        mmp_qbsf0_e(1,1) = MINVAL(mmp_qbsf0%x)
+        mmp_qbsf0_e(1,2) = MAXVAL(mmp_qbsf0%x)
+        mmp_qbsf0_e(2,1) = MINVAL(mmp_qbsf0%y)
+        mmp_qbsf0_e(2,2) = MAXVAL(mmp_qbsf0%y)
+      ENDIF
+      IF (.NOT.read_dset(mqfile,'qbsf3',mmp_qbsf3)) THEN
+        call abort_program(error("Cannot get 'qbsf3' from "//mqfile,-1))
+      ELSE
+        mmp_qbsf3_e(1,1) = MINVAL(mmp_qbsf3%x)
+        mmp_qbsf3_e(1,2) = MAXVAL(mmp_qbsf3%x)
+        mmp_qbsf3_e(2,1) = MINVAL(mmp_qbsf3%y)
+        mmp_qbsf3_e(2,2) = MAXVAL(mmp_qbsf3%y)
+      ENDIF
+      IF (.NOT.read_dset(mqfile,'qbff0',mmp_qbff0)) THEN
+        call abort_program(error("Cannot get 'qbff0' from "//mqfile,-1))
+      ELSE
+        mmp_qbff0_e(1,1) = MINVAL(mmp_qbff0%x)
+        mmp_qbff0_e(1,2) = MAXVAL(mmp_qbff0%x)
+        mmp_qbff0_e(2,1) = MINVAL(mmp_qbff0%y)
+        mmp_qbff0_e(2,2) = MAXVAL(mmp_qbff0%y)
+      ENDIF
+    ENDIF
     ! btk coefficients
 …
     WRITE(*,'(a,L2)')     "electric_charging    : ", mmp_w_qe
     call mm_dump_parameters()
+    IF (clouds) THEN
+      DO i=1, size(mm_xESPS)
+        print*, TRIM(mm_xESPS(i)%name), " fmol2fmas = ", mm_xESPS(i)%fmol2fmas
+      ENDDO
+    ENDIF
   END SUBROUTINE mmp_initialize
   FUNCTION read_aprm(parser,sec,pp) RESULT(err)
     !! Read and store [[mmp_gcm(module):aprm(type)]] parameters.
     TYPE(cfgparser), INTENT(in)  :: parser !! Configuration parser
+    !! Read and store [[mmp_gcm(module):aprm(type)]] parameters.
+    TYPE(cfgparser), INTENT(in)  :: parser !! Configuration parser
     CHARACTER(len=*), INTENT(in) :: sec    !! Name of the section that contains the parameters.
     TYPE(aprm), INTENT(out)      :: pp     !! [[mmp_gcm(module):aprm(type)]] object that stores the parameters values.
 …
   END FUNCTION read_aprm
-  FUNCTION read_nprm(parser,sec,pp) RESULT(err)
-    !! Read and store [[mmp_gcm(module):nprm(type)]] parameters.
-    TYPE(cfgparser), INTENT(in)  :: parser !! Configuration parser
-    CHARACTER(len=*), INTENT(in) :: sec    !! Name of the section that contains the parameters.
-    TYPE(nprm), INTENT(out)      :: pp     !! [[mmp_gcm(module):nprm(type)]] object that stores the parameters values.
-    TYPE(error) :: err                     !! Error status of the function.
-    err = cfg_get_value(parser,TRIM(sec)//'/rc',pp%rc) ; IF (err /= 0) RETURN
-    err = cfg_get_value(parser,TRIM(sec)//'/a0',pp%a0) ; IF (err /= 0) RETURN
-    err = cfg_get_value(parser,TRIM(sec)//'/c',pp%c)   ; IF (err /= 0) RETURN
-    err = cfg_get_value(parser,TRIM(sec)//'/a',pp%a)   ; IF (err /= 0) RETURN
-    err = cfg_get_value(parser,TRIM(sec)//'/b',pp%b)   ; IF (err /= 0) RETURN
-    IF (SIZE(pp%a) /= SIZE(pp%b)) &
-      err = error("Inconsistent number of coefficients (a and b must have the same size)",3)
-    RETURN
-  END FUNCTION read_nprm
 END MODULE MMP_GCM

trunk/LMDZ.TITAN/libf/muphytitan/mmp_globals.f90

-                      r1926
+                      r3083
   END TYPE
-  !> Size distribution parameters derived type.
-  !!
-  !! It stores the parameters of the size distribution law for Titan.
-  !!
-  !! The size distribution law is represented by the minimization of a sum of
-  !! power law functions:
-  !!
-  !! $$
-  !! \displaystyle n\left(r\right) = \frac{A_{0}}{C+\sum_{i=1}^{n} A_{i}\times
-  !!                                    \left(\frac{r}{r_{c}}\right)^{-b_{i}}}
-  !! $$
-  TYPE, PUBLIC :: nprm
-    !> Scaling factor.
-    REAL(kind=mm_wp)                            :: a0
-    !> Characterisitic radius.
-    REAL(kind=mm_wp)                            :: rc
-    !> Additional constant to the sum of power law.
-    REAL(kind=mm_wp)                            :: c
-    !> Scaling factor of each power law.
-    REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: a
-    !> Power of each power law.
-    REAL(kind=mm_wp), DIMENSION(:), ALLOCATABLE :: b
-  END TYPE
   !> Inter-moment relation set of parameters for the spherical mode.
   TYPE(aprm), PUBLIC, SAVE :: mmp_asp
   !> Inter-moment relation set of parameters for the fractal mode.
   TYPE(aprm), PUBLIC, SAVE :: mmp_afp
-  !> Size-distribution law parameters of the spherical mode.
-  TYPE(nprm), PUBLIC, SAVE :: mmp_pns
-  !> Size-distribution law parameters of the fractal mode.
-  TYPE(nprm), PUBLIC, SAVE :: mmp_pnf
   !> Data set for @f$<Q>_{SF}^{M0}@f$.
 …
   !> Aerosol electric charge correction control flag.
   LOGICAL, SAVE :: mmp_w_qe   = .true.
-  !> Optic look-up table file path.
-  CHARACTER(len=:), ALLOCATABLE, SAVE :: mmp_optic_file
   CONTAINS

trunk/LMDZ.TITAN/libf/muphytitan/mmp_moments.f90

-                      r1897
+                      r3083
 ! Copyright 2013-2015,2017 Université de Reims Champagne-Ardenne
+! Copyright 2013-2015,2017,2022 Université de Reims Champagne-Ardenne
 ! Contributor: J. Burgalat (GSMA, URCA)
 ! email of the author : jeremie.burgalat@univ-reims.fr
+!
+!
 ! This software is a computer program whose purpose is to compute
 ! microphysics processes using a two-moments scheme.
+!
+!
 ! This library is governed by the CeCILL license under French law and
 ! abiding by the rules of distribution of free software.  You can  use,
+! abiding by the rules of distribution of free software.  You can  use,
 ! modify and/ or redistribute the software under the terms of the CeCILL
 ! license as circulated by CEA, CNRS and INRIA at the following URL
 ! "http://www.cecill.info".
+!
+! "http://www.cecill.info".
+!
 ! As a counterpart to the access to the source code and  rights to copy,
 ! modify and redistribute granted by the license, users are provided only
 ! with a limited warranty  and the software's author,  the holder of the
 ! economic rights,  and the successive licensors  have only  limited
 ! liability.
+!
+! liability.
+!
 ! In this respect, the user's attention is drawn to the risks associated
 ! with loading,  using,  modifying and/or developing or reproducing the
 …
 ! professionals having in-depth computer knowledge. Users are therefore
 ! encouraged to load and test the software's suitability as regards their
 ! requirements in conditions enabling the security of their systems and/or
 ! data to be ensured and,  more generally, to use and operate it in the
 ! same conditions as regards security.
+!
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
 ! The fact that you are presently reading this means that you have had
 ! knowledge of the CeCILL license and that you accept its terms.
 …
 !! summary: YAMMS/MP2M model external methods
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 !!
 !! This file contains the definitions of all external methods that should be defined
 !! for mp2m library.
 !!
 !! All the methods defined here satisify the interfaces defined in __m_interfaces__ module
+!! for mp2m library.
+!!
+!! All the methods defined here satisify the interfaces defined in __m_interfaces__ module
 !! of YAMMS library.
 PURE FUNCTION mm_alpha_s(k) RESULT (res)
   !! Inter-moment relation for spherical aerosols size distribution law.
   !!
   !! The method computes the relation between the kth order moment and the 0th
+  !!
+  !! The method computes the relation between the kth order moment and the 0th
   !! order moment of the size-distribution law:
   !!
 …
   res = SUM(dexp(mmp_asp%a*k**2+mmp_asp%b*k+mmp_asp%c))
   RETURN
 END FUNCTION mm_alpha_s
+END FUNCTION mm_alpha_s
 PURE FUNCTION mm_alpha_f(k) RESULT (res)
 …
   !!
   !! @warning
   !! Here, the method assumes the datasets define the probability for __spherical__ particles to
+  !! Here, the method assumes the datasets define the probability for __spherical__ particles to
   !! be transferred in the __fractal__ mode, but returns the proportion of particles that remains
   !! in the mode (which is expected by mp2m model).
   !!
   !! @attention
   !! If value cannot be interpolated, the method aborts the program. Normally, it cannot happen
+  !! If value cannot be interpolated, the method aborts the program. Normally, it cannot happen
   !! since we extrapolate the probability for characteristic radius value out of range.
   !!
   !! @attention
   !! Consequently, as the probability can only range from 0 to 1, it is wise to ensure that the
   !! look-up table limits this range: To do so, one can just add two values at the start and end
+  !! Consequently, as the probability can only range from 0 to 1, it is wise to ensure that the
+  !! look-up table limits this range: To do so, one can just add two values at the start and end
   !! of the table with probabilities respectively set to 0 and 1.
   USE LINTDSET
 …
   TYPE(dset1d), POINTER :: pp
   res = 1._mm_wp
   IF (rcs <= 0.0_mm_wp .OR. .NOT.mmp_w_ps2s) RETURN
+  IF (rcs <= 0.0_mm_wp .OR. .NOT.mmp_w_ps2s) RETURN
   SELECT CASE(k+flow)
     CASE(0)      ; pp => mmp_pco0p ! 0 = 0 + 0 -> M0 / CO
 …
     CASE DEFAULT ; RETURN
   END SELECT
   IF (.NOT.hdcd_lint_dset(rcs,pp,locate_reg_ext,res)) THEN
+  IF (.NOT.hdcd_lint_dset(rcs,pp,locate_reg_ext,res)) THEN
     WRITE(*,'(a)') "mm_moments:ps2s_sc: Cannot interpolate transfert probability"
     call EXIT(10)
   ELSE
     ! 05102017: do not care anymore for bad extrapolation:
+    ! 05102017: do not care anymore for bad extrapolation:
     ! Bound probability value between 0 and 1
     ! note: The input look-up table still must have strict monotic variation or
 …
   !! kernel as a function of the temperature, pressure and the characteristic radius of
   !! the mode involved in the coagulation.
   !!
+  !!
   !! Modes are referred by a two letters uppercase string with the combination of:
   !!
   !! - S : spherical mode
   !! - F : fractal mode
   !!
+  !!
   !! For example, SS means intra-modal coagulation for spherical particles.
   !!
 …
   CHARACTER(len=2), INTENT(in)  :: modes !! Interaction mode (a combination of [S,F]).
   REAL(kind=mm_wp), INTENT(in)  :: temp  !! Temperature (K).
   REAL(kind=mm_wp), INTENT(in)  :: pres  !! Pressure level (Pa).
+  REAL(kind=mm_wp), INTENT(in)  :: pres  !! Pressure level (Pa).
   REAL(kind=mm_wp) :: res                !! Electric charging correction.
   INTEGER       :: chx,np
   REAL(kind=mm_wp) :: vmin,vmax
   REAL(kind=mm_wp) :: r_tmp, t_tmp
   chx = 0
+  chx = 0
   IF (.NOT.mmp_w_qe) THEN
     res = 1._mm_wp
 …
   SELECT CASE(chx)
     CASE(2)      ! M0/SS
       res = 1._mm_wp
+      res = 1._mm_wp
     CASE(4)      ! M0/SF
       ! Fix max values of input parameters
 …
 PURE FUNCTION mm_get_btk(t,k) RESULT(res)
   !! Get the \(b_{k}^{T}\) coefficient of the Free Molecular regime.
   !!
+  !!
   !! The method get the value of the Free-molecular regime coagulation pre-factor \(b_{k}^{T}\).
   !! For more details about this coefficient, please read [Coagulation](page/haze.html#coagulation)
+  !! For more details about this coefficient, please read [Coagulation](page/haze.html#coagulation)
   !! documentation page.
   !!
 …
                                   tsut = 109._mm_wp,    &
                                   tref = 293._mm_wp
   res = eta0 *dsqrt(t/tref)*(1._mm_wp+tsut/tref)/(1._mm_wp+tsut/t)
+  res = eta0 * dsqrt(t/tref) * (1._mm_wp + tsut/tref) / (1._mm_wp + tsut/t)
   RETURN
 END FUNCTION mm_eta_g

trunk/LMDZ.TITAN/libf/muphytitan/string_op.F90

-                      r1897
+                      r3083
+! Copyright Jérémie Burgalat (2013-2015,2017)
+!
+! jeremie.burgalat@univ-reims.fr
+!
+! This software is a computer program whose purpose is to provide configuration
+! file and command line arguments parsing features to Fortran programs.
+!
+! This software is governed by the CeCILL-B license under French law and
+! abiding by the rules of distribution of free software.  You can  use,
+! modify and/ or redistribute the software under the terms of the CeCILL-B
+! license as circulated by CEA, CNRS and INRIA at the following URL
+! "http://www.cecill.info".
+!
+! As a counterpart to the access to the source code and  rights to copy,
+! modify and redistribute granted by the license, users are provided only
+! with a limited warranty  and the software's author,  the holder of the
+! economic rights,  and the successive licensors  have only  limited
+! liability.
+!
+! In this respect, the user's attention is drawn to the risks associated
+! with loading,  using,  modifying and/or developing or reproducing the
+! software by the user in light of its specific status of free software,
+! that may mean  that it is complicated to manipulate,  and  that  also
+! therefore means  that it is reserved for developers  and  experienced
+! professionals having in-depth computer knowledge. Users are therefore
+! encouraged to load and test the software's suitability as regards their
+! requirements in conditions enabling the security of their systems and/or
+! data to be ensured and,  more generally, to use and operate it in the
+! same conditions as regards security.
+!
+! The fact that you are presently reading this means that you have had
+! knowledge of the CeCILL-B license and that you accept its terms.
+! Copyright (c) (2013-2015,2017) Jeremie Burgalat (jeremie.burgalat@univ-reims.fr).
+!
+! This file is part of SWIFT
+!
+! Permission is hereby granted, free of charge, to any person obtaining a copy of
+! this software and associated documentation files (the "Software"), to deal in
+! the Software without restriction, including without limitation the rights to
+! use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+! the Software, and to permit persons to whom the Software is furnished to do so,
+! subject to the following conditions:
+!
+! The above copyright notice and this permission notice shall be included in all
+! copies or substantial portions of the Software.
+!
+! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+! FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+! COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+! IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+! CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
 !! file: strings.F90
 !! summary: Strings manipulation source file
 !! author: J. Burgalat
 !! date: 2013-2015,2017
+!! date: 2013-2015,2017,2022
 #include "defined.h"
 …
 MODULE STRING_OP
   !! Fortran strings manipulation module
   !!
+  !!
   !! This module provides methods and objects to manipulate Fortran (allocatable) strings. It defines
   !! a doubly linked-list of strings, [[string_op(module):words(type)]] and several methods to format
   !! strings or convert them in other intrinsic types.
+  !! strings or convert them in other intrinsic types.
   USE ERRORS
   IMPLICIT NONE
   PRIVATE
 …
   ! errors module (not used but propagated)
   PUBLIC :: stdout,stderr,noerror,error, error_to_string,aborting
   ! misc module methods
   PUBLIC :: to_string, from_string, string_is, remove_quotes, format_string,     &
 …
   INTEGER, PUBLIC, PARAMETER :: st_integer = 4 !! Integer type ID
   INTEGER, PUBLIC, PARAMETER :: st_real    = 5 !! Real type ID
   !> List of types names
   CHARACTER(len=*), DIMENSION(5), PARAMETER, PUBLIC :: st_type_names = &
 …
   INTEGER, PUBLIC, PARAMETER :: FC_BLACK     = 30 !! Black foreground csi code
   INTEGER, PUBLIC, PARAMETER :: FC_RED       = 31 !! Red foreground csi code
 …
   INTEGER, PUBLIC, PARAMETER, DIMENSION(21) :: attributes = [FC_BLACK,     &
                                                              FC_RED,       &
                                                              FC_GREEN,     &
+                                                             FC_GREEN,     &
                                                              FC_YELLOW,    &
                                                              FC_BLUE,      &
 …
                                                              BG_MAGENTA,   &
                                                              BG_CYAN,      &
                                                              BG_WHITE,     &
+                                                             BG_WHITE,     &
                                                              ST_NORMAL,    &
                                                              ST_BOLD,      &
 …
                                                              ST_UNDERLINE, &
                                                              ST_BLINK      &
+                                                            ]
+                                                            ]
   !> Aliases for CSI codes.
   CHARACTER(len=2), DIMENSION(21), PARAMETER, PUBLIC :: csis =(/ &
 …
     MODULE PROCEDURE ws_affect
   END INTERFACE
   !> Clear either a scalar or a vector of list of [[words(type)]]
   !!
   !! The interface encapsulates words _destructors_, that deallocate memory used
   !! by the given list(s) of words. This method should be called anytime words
+  !! The interface encapsulates words _destructors_, that deallocate memory used
+  !! by the given list(s) of words. This method should be called anytime words
   !! object(s) is no longer used to avoid memory leaks.
   !! @note
 …
   !! The interface encapsulates two subroutines:
   !!
   !! - [[ws_extend_ws(subroutine)]](this,other) which extends __this__ by __other__
+  !! - [[ws_extend_ws(subroutine)]](this,other) which extends __this__ by __other__
   !!   (both are words objects).
   !! - [[ws_extend_str(subroutine)]](this,str,delimiter,merge) which splits __str__
   !!   according to __delimiter__ (and optionally __merge__) and then extends
+  !!   according to __delimiter__ (and optionally __merge__) and then extends
   !!   __this__ with the resulting tokens.
   INTERFACE words_extend
 …
   !!   parenthesis can be omitted.
   !! - __str__ is an allocatable string with the converted value in output, or an empty
   !!   string if the conversion failed.
+  !!   string if the conversion failed.
   INTERFACE to_string
     MODULE PROCEDURE int2str_as,int2str_fs
 …
     MODULE PROCEDURE dcplx2str_as,dcplx2str_fs
   END INTERFACE
   !> Convert a string into an intrisinc type
   !!
   !! All methods defined in the interface are functions which take in arguments,
   !! a string (input) and an output variable with the relevant type (or vectors of both).
+  !! a string (input) and an output variable with the relevant type (or vectors of both).
   !! They always return an error object which is set to -5 error code (i.e. cannot cast value)
   !! on error, otherwise [[errors(module):noerror(variable)]].
 …
   !! The generic interface adds CSI codes to the given value and returns a fortran intrinsic string.
   !!
   !! This is convinient wrapper to [[string_op(module):to_string(interface)]] and
+  !! This is convinient wrapper to [[string_op(module):to_string(interface)]] and
   !! [[string_op(module):add_csi(function)]].
   !!
 …
   !! It's part of the doubly linked list words.
   TYPE, PUBLIC :: word
 #if HAVE_FTNDTSTR
+#if HAVE_FTNDTSTR
     CHARACTER(len=:), ALLOCATABLE :: value !! Value of the word
 #else
+#else
     !> Value of the word
     !!
     !! @warning
+    !! @warning
     !! It is always limited to [[string_op(module):st_slen(variable)]] characters.
     CHARACTER(len=st_slen)        :: value = ''
 …
     TYPE(word), PRIVATE, POINTER  :: prev => null() !! Previous word in the list of words
   END TYPE word
   !> Define a list of words
   TYPE, PUBLIC :: words
 …
     TYPE(word), PRIVATE, POINTER :: tail => null() !! Last word in the list
     TYPE(word), PRIVATE, POINTER :: iter => null() !! Current word (iterator)
 #if HAVE_FTNPROC
+#if HAVE_FTNPROC
     CONTAINS
     PROCEDURE, PRIVATE :: ws_extend_ws
 …
       !! Insert a word at given index
     PROCEDURE, PUBLIC :: append      => words_append
       !! Append a word at the end of the list
+      !! Append a word at the end of the list
     PROCEDURE, PUBLIC :: prepend     => words_prepend
       !! Prepend a word at the beginning of the list
+      !! Prepend a word at the beginning of the list
     PROCEDURE, PUBLIC :: get         => words_get
       !! Get the word at given index
 …
       !! Reverse the list in place
     PROCEDURE, PUBLIC :: reversed    => words_reversed
       !! Get a reversed copy of the list
+      !! Get a reversed copy of the list
     PROCEDURE, PUBLIC :: dump        => words_dump
       !! Dump words of the list (on per line)
 …
       !! Convert the list in a vector
     PROCEDURE, PUBLIC :: pop         => words_pop
       !! Pop a word from the list and returns it
+      !! Pop a word from the list and returns it
     PROCEDURE, PUBLIC :: remove      => words_remove
       !! Remove a word from the list
 …
 #endif
   END TYPE words
   CONTAINS
   FUNCTION word_length(this) RESULT(lgth)
     !! Get the trimmed length of the word object
 …
     INTEGER :: lgth
       !! The length of the word's value (without trailing spaces)
 #if HAVE_FTNDTSTR
+#if HAVE_FTNDTSTR
     IF (.NOT.ALLOCATED(this%value)) THEN
       lgth = 0 ; RETURN
     ENDIF
 #endif
+#endif
     lgth = LEN_TRIM(this%value)
     RETURN
   END FUNCTION word_length
   SUBROUTINE disconnect_word(this)
     !! Disconnect a word object
     !!
     !! The object is no more connected to its neighbours which are connected together.
     !! @note
     !! After this method is called the object is no longer connected to its parent words
+    !! @note
+    !! After this method is called the object is no longer connected to its parent words
     !! object and should be deallocated in order to avoid memory leaks.
     TYPE(word), INTENT(inout) :: this
 …
     RETURN
   END SUBROUTINE disconnect_word
   SUBROUTINE ws_affect(this,other)
     !! words object assignment operator subroutine
 …
       cur => other%head
       DO WHILE(associated(cur))
 #if HAVE_FTNDTSTR
+#if HAVE_FTNDTSTR
         IF (.NOT.ALLOCATED(cur%value)) THEN
           CALL words_append(this,"")
 …
     RETURN
   END SUBROUTINE ws_affect
   SUBROUTINE ini_word(this,value)
     !! Initialize the first word of a list of words
     !!
     !! This subroutine is not a constructor. It is only intended to set the first word
+    !! This subroutine is not a constructor. It is only intended to set the first word
     !! object in a words object.
     TYPE(words), INTENT(inout)   :: this
       !! A words object reference
     CHARACTER(len=*), INTENT(in) :: value
       !! A string with the word used to initialize the list
+      !! A string with the word used to initialize the list
     ALLOCATE(this%head)
     this%tail => this%head
 …
     !!
     !! This subroutine deallocates all memory used by the given words object.
     !! @warning
     !! The subroutine should be called whenever a words is no more used (e.g. at
+    !! @warning
+    !! The subroutine should be called whenever a words is no more used (e.g. at
     !! the end of the current scope), otherwise memory leaks could occur.
     TYPE(words),INTENT(inout), TARGET :: obj
 …
     TYPE(word), POINTER :: cur,next
     IF (obj%nw == 0) RETURN
     cur => obj%head
+    cur => obj%head
     DO WHILE(ASSOCIATED(cur))
       next => cur%next
 …
     !!
     !! This subroutine deallocates all memory used by the given vector of words objects.
     !! @warning
     !! The subroutine should be called whenever a words is no more used (e.g. at the end
+    !! @warning
+    !! The subroutine should be called whenever a words is no more used (e.g. at the end
     !! of the current scope), otherwise memory leaks could occur.
     TYPE(words),INTENT(inout), DIMENSION(:) :: objs
 …
   END SUBROUTINE ws_extend_ws
   SUBROUTINE ws_extend_str(this,str,delimiter,merge,protect)
+  SUBROUTINE ws_extend_str(this,str,delimiter,merge,protect)
     !> Extend a list of word with a given string
     !! @details The method adds a new list of words to the current list by
+    !! @details The method adds a new list of words to the current list by
     !! splitting a string using a set of delimiters.
     !!
+    !!
     !!   - If __delimiter__ is not given, THEN blank space is used.
     !!   - __delimiter__ can be a string of any length, but each character of
     !!     the sequence is seen as a single delimiter. Each time one of these
+    !!   - __delimiter__ can be a string of any length, but each character of
+    !!     the sequence is seen as a single delimiter. Each time one of these
     !!     special character is seen on the string, it is splitted.
     !!   - If __protect__ is set to .true. THEN delimiter enclosed by
 …
     !!   - The optional argument __merge__ instructs the method wether to merge
     !!     or not successive delimiters in the string.
     !!
+    !!
     !! For example, considering the following string:
     !! <center>@verbatim "I like coffee and bananas." @endverbatim</center>
 …
       !! A string to split in words
     CHARACTER(len=*), INTENT(in), OPTIONAL :: delimiter
       !! An optional string with the words delimiters (default to blank space).
+      !! An optional string with the words delimiters (default to blank space).
     LOGICAL, INTENT(in), OPTIONAL          :: merge
       !! An optional boolean control flag that instructs the method
       !! wether to merge or not successive delimiters (default to .false.)
     LOGICAL, INTENT(in), OPTIONAL          :: protect
       !! An optional boolean flag with .true. to indicate that
+      !! An optional boolean flag with .true. to indicate that
       !! delimiter characters between quotes are protected
     ! - LOCAL
 …
     CHARACTER(len=1), PARAMETER   :: sq = CHAR(39) ! single quote ascii code
     CHARACTER(len=1), PARAMETER   :: dq = CHAR(34) ! double quotes ascii code
     stat=0 ; p=1 ; indq = .false. ; insq = .false.
+    stat=0 ; p=1 ; indq = .false. ; insq = .false.
     seps = ' '
     zmerge = .false. ; IF (PRESENT(merge)) zmerge = merge
 …
     ENDIF
     sl = LEN(str) ; IF (sl == 0) RETURN
     outer =     (INDEX(str,sq) == 1 .AND. INDEX(str,sq,.true.) == LEN(str)) &
+    outer =     (INDEX(str,sq) == 1 .AND. INDEX(str,sq,.true.) == LEN(str)) &
             .OR.(INDEX(str,dq) == 1 .AND. INDEX(str,dq,.true.) == LEN(str))
     ! no delimiter found or (have outer quotes and should protect)
     IF (SCAN(str,seps) == 0.OR.(outer.AND.zprotect)) THEN
       CALL words_append(this,remove_quotes(str))
+      CALL words_append(this,remove_quotes(str))
       RETURN
     ENDIF
     ! We have to loop...
+    ! We have to loop...
     i = 1 ; curw=''
     DO
 …
     !! Get the pointer of the word object at given index
     !!
     !! The method returns the pointer of the word object at the given index.
+    !! The method returns the pointer of the word object at the given index.
     !! If index is out of range a null poitner is returned.
     OBJECT(words), INTENT(in) :: this
       !! A words object
+      !! A words object
     INTEGER, INTENT(in)       :: idx
       !! An integer with the index of the desired object in __this__
 …
     ELSE
       IF (idx > (this%nw+1)/2) THEN
         nx => this%tail
+        nx => this%tail
         DO i=1, this%nw - idx ; nx => nx%prev ; ENDDO
       ELSE
         nx => this%head
+        nx => this%head
         DO i=1, idx-1 ; nx => nx%next ; ENDDO
       ENDIF
 …
   SUBROUTINE words_append(this,value)
     !! Append a word to the list of word
     !!
     !! The method appends a word to the list of word. This is a convinient wrapper to
+    !!
+    !! The method appends a word to the list of word. This is a convinient wrapper to
     !! [[string_op(module)::words_insert(subroutine)]] to add a new word at the beginning of the list.
     OBJECT(words), INTENT(inout) :: this  !! A words object
+    OBJECT(words), INTENT(inout) :: this  !! A words object
     CHARACTER(len=*), INTENT(in) :: value !! A string to append
     !CALL words_insert(this,this%nw+1,value)
 …
     !this%tail%value = TRIM(value)
     !this%tail%prev => np
     !this%tail%prev%next => this%tail
+    !this%tail%prev%next => this%tail
     RETURN
   END SUBROUTINE words_append
 …
     !! The method prepends a word to the list of word. This is a convinient wrapper to
     !! [[string_op(module)::words_insert(subroutine)]] to add a new word at the end of the list.
     OBJECT(words), INTENT(inout) :: this  !! A words object
+    OBJECT(words), INTENT(inout) :: this  !! A words object
     CHARACTER(len=*), INTENT(in) :: value !! A string to prepend
     CALL words_insert(this,0,value)
 …
   FUNCTION words_get(this,idx,case) RESULT (res)
     !! Get the word's value at given index
     !!
+    !!
     !! The method attempts to get the word's value at the given index. If index is out of range
     !! an empty string is returned.
     !! @note
+    !! @note
     !! The returned string is always trimmed.
     OBJECT(words), INTENT(in)              :: this
 …
     INTEGER, INTENT(in)                    :: idx
       !! An integer with the index of a word in the list
     CHARACTER(len=5), INTENT(in), OPTIONAL :: case
+    CHARACTER(len=5), INTENT(in), OPTIONAL :: case
       !! An optional string with either 'upper' or 'lower' to get the value converted in the relevant case
     CHARACTER(len=:), ALLOCATABLE :: res
 …
     ENDIF
     IF (PRESENT(case)) THEN
       IF (case == "upper") res = to_upper(cur%value)
+      IF (case == "upper") res = to_upper(cur%value)
       IF (case == "lower") res = to_lower(cur%value)
     ELSE
 …
     !!
     !! The method computes and returns the longest (trimmed) word's width in the words object.
     OBJECT(words), INTENT(in) :: this !! A words object
+    OBJECT(words), INTENT(in) :: this !! A words object
     INTEGER :: res                    !! An integer with the maximum width (0 if the list is empty)
     TYPE(word), POINTER :: cur
 …
   FUNCTION words_get_total_width(this) RESULT(width)
     !! Get the total width of all words stored in the list of words
     !!
     !! The method computes and returns the total width of all words stored in
+    !!
+    !! The method computes and returns the total width of all words stored in
     !! the list of words.
     !! @note
+    !! @note
     !! Total width is computed using strings::word_length so it only takes
     !! into account trimmed words (without trailing blanks)
     !! @note
+    !! @note
     !! If csi codes have been added to words elements they are counted in the width.
     OBJECT(words), INTENT(in) :: this !! A words object
 …
     DO WHILE(ASSOCIATED(cur))
       CALL words_append(res,cur%value)
       IF (ASSOCIATED(cur,this%iter)) res%iter => res%tail
+      IF (ASSOCIATED(cur,this%iter)) res%iter => res%tail
       cur => cur%prev
     ENDDO
 …
   SUBROUTINE words_dump(this,lun)
     !! Dump the list of words
     !!
+    !!
     !! The method dumps on the given logical unit the elements of the list one by line.
     OBJECT(words), INTENT(in)     :: this
       !! A words object to dump
     INTEGER, INTENT(in), OPTIONAL :: lun
       !! An optional integer with the printing logical unit. If not given, the list is dumped on
+      !! An optional integer with the printing logical unit. If not given, the list is dumped on
       !! standard output stream.
     TYPE(word), POINTER :: cur
 …
     !! setting it back as values of the list of words.
     OBJECT(words), INTENT(in)              :: this
       !! A words object
+      !! A words object
     CHARACTER(len=*), INTENT(in), OPTIONAL :: delimiter
       !! An optional string used as delimiter between each words
 …
     !! .false., otherwise it returns .true.
     !! @note
     !! If elements in __this__ words object are wider than [[string_op(module):st_slen(variable)]], output
+    !! If elements in __this__ words object are wider than [[string_op(module):st_slen(variable)]], output
     !! values will be truncated.
     OBJECT(words), INTENT(in)                                      :: this
 …
     !! Pop a word in the list of words
     !!
     !! The method removes the word of the list at given index and returns it. If no index is given,
+    !! The method removes the word of the list at given index and returns it. If no index is given,
     !! last word of the list is removed.
     !!
 …
     INTEGER, INTENT(in), OPTIONAL :: idx
       !! Optional index of the word to delete
     LOGICAL, INTENT(in), OPTIONAL :: move_forward
       !! Move the iterator forward if needed. By default the iterator is moved backward.
+    LOGICAL, INTENT(in), OPTIONAL :: move_forward
+      !! Move the iterator forward if needed. By default the iterator is moved backward.
     CHARACTER(len=:), ALLOCATABLE :: value
       !! The word's value at given index
+      !! The word's value at given index
     LOGICAL             :: zforward
     INTEGER             :: zidx
 …
     !! Remove the word of the list at given index
     !!
     !! The method removes the word of the list at given index. If no index is given, last word
+    !! The method removes the word of the list at given index. If no index is given, last word
     !! of the list is removed.
     !!
 …
       !! Index of the word to delete
     LOGICAL, INTENT(in), OPTIONAL :: move_forward
       !! Move the iterator forward if needed. By default the iterator is moved backward.
     LOGICAL             :: zforward
+      !! Move the iterator forward if needed. By default the iterator is moved backward.
+    LOGICAL             :: zforward
     INTEGER             :: zidx
     TYPE(word), POINTER :: cur
 …
   FUNCTION words_valid(this) RESULT(ret)
     !! Check if the current iterated word is valid
+    !! Check if the current iterated word is valid
     OBJECT(words), INTENT(in) :: this !! A words object
     LOGICAL :: ret                    !! A logical flag with .true. if the current iterated word is valid
 …
       !! A words object
     CHARACTER(len=:), ALLOCATABLE :: wrd
       !! A string with the value of the current word or __an unallocated string__ if current word
+      !! A string with the value of the current word or __an unallocated string__ if current word
       !! is not valid (see [[string_op(module):words_valid(function)]]).
     IF (ASSOCIATED(this%iter)) THEN
 …
   SUBROUTINE words_reset(this,to_end)
     !! Reset the iterator
     !!
     !! The method resets the iterator either at the beginning or at the end of the list of words
+    !! Reset the iterator
+    !!
+    !! The method resets the iterator either at the beginning or at the end of the list of words
     !! (if __to_end__ is set to .true.).
     OBJECT(words), INTENT(inout)  :: this   !! A words object
+    OBJECT(words), INTENT(inout)  :: this   !! A words object
     LOGICAL, INTENT(in), OPTIONAL :: to_end !! An optional logical flag with .true. to reset the iterator at the end of the list
     this%iter => this%head
 …
   FUNCTION tokenize(str,vector,delimiter,merge,protect) RESULT(ok)
     !! Tokenize a string.
     CHARACTER(len=*), INTENT(in)                             :: str
+    CHARACTER(len=*), INTENT(in)                                   :: str
       !! A string to tokenize
     CHARACTER(len=*), INTENT(out), DIMENSION(:), ALLOCATABLE :: vector
       !! An allocatable vector of strings with the tokens found. If string cannot be tokenized,
+    CHARACTER(len=st_slen), INTENT(out), DIMENSION(:), ALLOCATABLE :: vector
+      !! An allocatable vector of strings with the tokens found. If string cannot be tokenized,
       !! the vector is __allocated to 0 elements__ and the method returns .false..
     CHARACTER(len=*), INTENT(in), OPTIONAL                   :: delimiter
       !! An optional string with the words delimiters. It is set to blank space by default.
+    CHARACTER(len=*), INTENT(in), OPTIONAL                         :: delimiter
+      !! An optional string with the words delimiters. It is set to blank space by default.
       !! Note that each character is seen as a single delimiter.
     LOGICAL, INTENT(in), OPTIONAL                            :: merge
       !! An optional boolean control flag with .true. that instructs the method whether to
+    LOGICAL, INTENT(in), OPTIONAL                                  :: merge
+      !! An optional boolean control flag with .true. that instructs the method whether to
       !! merge or not successive delimiters. Default to .false.
     LOGICAL, INTENT(in), OPTIONAL                            :: protect
       !! An optional boolean flag with .true. to indicate that delimiter characters between
+    LOGICAL, INTENT(in), OPTIONAL                                  :: protect
+      !! An optional boolean flag with .true. to indicate that delimiter characters between
       !! quotes are protected. Default to .true.
     LOGICAL :: ok
 …
     integer                       :: i,nw
     ok = .true.
     zmerge = .false. ; zprotect = .true. ; seps = ' '
+    zmerge = .false. ; zprotect = .true. ; seps = ' '
     IF (PRESENT(merge)) zmerge = merge
     IF (PRESENT(protect)) zprotect = protect
 …
     !! The output string is trimmed from leading and trailing blank spaces (after quotes removal !)
     CHARACTER(len=*), INTENT(in)  :: str  !! A string to check
     CHARACTER(len=:), ALLOCATABLE :: ostr !! A string without external quotes (if any).
+    CHARACTER(len=:), ALLOCATABLE :: ostr !! A string without external quotes (if any).
     CHARACTER(len=1), PARAMETER   :: sq=CHAR(39), dq=CHAR(34)
     CHARACTER(len=2), PARAMETER   :: dsq=CHAR(39)//CHAR(34)
 …
     !! Check if string represents an intrinsic type
     !!
     !! The method checks if the given string represents an intrinsic type. Both logical and complex type
+    !! The method checks if the given string represents an intrinsic type. Both logical and complex type
     !! are checked in a strict way :
     !!
     !! - A string is a logical if it is one of the following value: __.false.__, __.true.__, __F__, __T__.
     !! - A string is potentially a complex if it has the following format: __(\*\*\*,\*\*\*)__ where
+    !! - A string is potentially a complex if it has the following format: __(\*\*\*,\*\*\*)__ where
     !!   __\*\*\*__ is checked to see wether it is numerical or not.
     !!
 …
     !!   [0-9]*.?[0-9]*?([ed][+-]?[0-9]+)?
     !! ```
     !! Obviously if returned value is greater than 3, the string can be converted in
+    !! Obviously if returned value is greater than 3, the string can be converted in
     !! floating point value.
     !!
     !! Empty input string is simply considered to be of string type !
+    !! Empty input string is simply considered to be of string type !
     CHARACTER(len=*), INTENT(in) :: str
       !! A string to check
 …
       ALLOCATE(output,source='') ; RETURN
     ENDIF
     i=0 ; IF (PRESENT(idt1)) i = MAX(i,idt1)
     ALLOCATE(CHARACTER(len=i) :: output)
     IF (i > 0) output(1:i) = CHAR(32)
+    i=0 ; IF (PRESENT(idt1)) i = MAX(i,idt1)
+    ALLOCATE(CHARACTER(len=i) :: output)
+    IF (i > 0) output(1:i) = CHAR(32)
     ! i0 is relative to i1 and must be >= 0
     IF (PRESENT(idto)) i = MAX(i+idto,0)
     ALLOCATE(CHARACTER(len=i+1) :: idts)
     idts(1:1) = NEW_LINE('A') ; IF (i>1) idts(2:) = CHAR(32)
     ! Builds output string
+    idts(1:1) = NEW_LINE('A') ; IF (i>1) idts(2:) = CHAR(32)
+    ! Builds output string
     c=1 ; mx = LEN_TRIM(str)
     i = INDEX(str(c:),'\n') ; ti = c+i-1
     IF (i == 0) THEN
       output=output//TRIM(str(ti+1:mx))
+      output=output//TRIM(str(ti+1:mx))
     ELSE
       output=output//TRIM(str(c:ti-1)) ; c=ti+2
+      output=output//TRIM(str(c:ti-1)) ; c=ti+2
       DO
         i = INDEX(str(c:),"\n") ; ti = c+i-1
         IF (i == 0) THEN
           output=output//TRIM(str(ti+1:mx)) ; c = mx+1
+          output=output//TRIM(str(ti+1:mx)) ; c = mx+1
         ELSE
           output=output//idts//str(c:ti-1) ; c = ti+2
 …
   FUNCTION format_paragraph(str,width,idt1,idto) RESULT(output)
     !! Split and format a string over several lines
     !!
     !! The function splits an input string in words so output lines fit (almost) in __width__ characters.
     !! The method handles indentation level (defined as leading blank spaces). It also accounts for known
+    !! Split and format a string over several lines
+    !!
+    !! The function splits an input string in words so output lines fit (almost) in __width__ characters.
+    !! The method handles indentation level (defined as leading blank spaces). It also accounts for known
     !! csi (see [[string_op(module):attributes(variable)]]).
     !! @note
     !! Words are considered indivisible and thus output lines can sometimes exceed the maximum width if
+    !! Words are considered indivisible and thus output lines can sometimes exceed the maximum width if
     !! there is not enough space to put a word (with the associated indentation if given). The default
     !! behavior in that case is to print the word in a new line (with the correct leading blank spaces).
 …
     !! method still computes the paragraph, but each words will be set on a new line with the appropriate
     !! indentation.
     CHARACTER(len=*), INTENT(in)  :: str    !! string with the content to split
+    CHARACTER(len=*), INTENT(in)  :: str    !! string with the content to split
     INTEGER, INTENT(in)           :: width  !! An positive integer with the maximum width of a line
     INTEGER, INTENT(in), OPTIONAL :: idt1   !! An optional integer with the indentation level of the first output line
 …
       output = str ; RETURN
     ENDIF
     ! check if can just return the string as is
+    ! check if can just return the string as is
     IF (zmx + l1 <= zw) THEN
       output=output//TRIM(zs) ; RETURN
     ENDIF
     j=1 ; jj=1+l1
     DO
+    j=1 ; jj=1+l1
+    DO
       ! Gets next blank in input string
       cc = INDEX(TRIM(zs(j:)),CHAR(32))
 …
       ! this value will be substracted to each length test
       IF (cc == 0) THEN
         l = csis_length(zs(j:))
+        l = csis_length(zs(j:))
         IF (jj-1+LEN_TRIM(zs(j:))-l > zw) THEN
           output = output//idts
 …
         EXIT ! we are at the last word : we must exit the infinite loop !
       ELSE
         l = csis_length(zs(j:j+cc-1))
+        l = csis_length(zs(j:j+cc-1))
         IF (cc+jj-1-l > zw) THEN
           output=output//idts//zs(j:j+cc-1) ; jj = lo+1+cc+1 - l
 …
       INTEGER :: jc,iesc,im
       LOGICAL :: tcsi
       value = 0
+      value = 0
       jc=1
       DO
+      DO
         IF (jc>LEN(str)) EXIT
         ! search for escape
         iesc = INDEX(str(jc:),CHAR(27))
         IF (iesc == 0) EXIT
+        IF (iesc == 0) EXIT
         ! search for m
         im = INDEX(str(jc+iesc:),"m")
 …
         ! check if this is really a csi and updates length
         tcsi = is_csi(str(jc+iesc-1:jc+iesc+im-1))
         jc = jc + iesc
+        jc = jc + iesc
         IF (tcsi) THEN
           value=value+im+1
 …
     !! Replace newline escape sequences by spaces
     !!
     !! The function replaces newline (both '\\n' escape sequence and Fortran NEW_LINE() character) in the
+    !! The function replaces newline (both '\\n' escape sequence and Fortran NEW_LINE() character) in the
     !! given string and returns the resulting string.
     CHARACTER(len=*), INTENT(in)           :: str !! A string to process
     CHARACTER(len=1), INTENT(in), OPTIONAL :: rpl !! A optional single character used as substitution of escape sequences (blank space by default)
     CHARACTER(len=:), ALLOCATABLE :: stripped     !! An allocatable string with all newline sequences replaced by blank space or __rpl__ if given
+    CHARACTER(len=:), ALLOCATABLE :: stripped     !! An allocatable string with all newline sequences replaced by blank space or __rpl__ if given
     CHARACTER(len=1) :: zrp
     INTEGER          :: i, j, ns
+    INTEGER          :: i, j, ns
     zrp = CHAR(32) ; IF(PRESENT(rpl)) zrp = rpl
     IF (str == NEW_LINE('A')) THEN
       stripped = zrp ; RETURN
+      stripped = zrp ; RETURN
     ENDIF
     ns = LEN_TRIM(str)
 …
     ALLOCATE(CHARACTER(len=ns) :: stripped) ; stripped(1:ns) = CHAR(32)
     i=1 ; j=1
     DO
+    DO
       IF (str(i:i) == NEW_LINE('A')) THEN
         stripped(j:j) = zrp
+        stripped(j:j) = zrp
       ELSE IF (i < ns) THEN
           IF (str(i:i+1) == "\n") THEN
             stripped(j:j) = zrp ; i=i+1
           ELSE
             stripped(j:j) = str(i:i)
+            stripped(j:j) = str(i:i)
           ENDIF
       ELSE
         stripped(j:j) = str(i:i)
+        stripped(j:j) = str(i:i)
       ENDIF
       j=j+1 ; i=i+1
 …
   FUNCTION str_length(str) RESULT(res)
     !! Get the length of the string object
     !!
+    !!
     !! The method computes the length of the string. It differs from LEN intrinsic function as
     !! it does not account for extra-characters of csi codes.
 …
     INTEGER :: res                      !! The actual length of string (i.e. does not account for csi codes)
     CHARACTER(len=:), ALLOCATABLE :: tmp
     res = 0
+    res = 0
     IF (LEN(str) /= 0) THEN
       tmp = reset_csi(str)
 …
     INTEGER :: j,i,ic,icsi,lcsi
     IF (LEN(str1) > 0) THEN
       str = str1
+      str = str1
       i = 1
       DO
 …
             IF (ic >= 97 .AND. ic < 122) str(j:j) = char(ic-32)
           ENDDO
           i = i + icsi + lcsi-1
+          i = i + icsi + lcsi-1
         ENDIF
       ENDDO
 …
  FUNCTION str_remove(string,substring,back,all) RESULT(str)
    !! Remove substring from current string
    !!
    !! The function removes the first occurence of __substring__ in __string__ or all
+   !! Remove substring from current string
+   !!
+   !! The function removes the first occurence of __substring__ in __string__ or all
    !! its occurences if __all__ is explicitly set to .true..
     CHARACTER(len=*), INTENT(in)  :: string    !! A string to search in
 …
     zboff = 0 ; IF (zb) zboff = 1
     IF (LEN(string) == 0) RETURN
     j=1
     DO
+    j=1
+    DO
       IF (j>LEN(string)) EXIT
       ! search for substring
 …
       IF (is == 0) THEN
         ! substring is not found : we get the last part of the string and return
         str = str//string(j:) ; RETURN
+        str = str//string(j:) ; RETURN
       ELSE IF (is == 1) THEN
         j = j + LEN(substring)
 …
       ! if we only want to str_remove ONE occurence we exit if substring
       ! has been found
       IF (.NOT.(is==0.OR.za)) EXIT
+      IF (.NOT.(is==0.OR.za)) EXIT
     ENDDO
     IF (j <= LEN(string).AND..NOT.zb) str=str//string(j:)
     RETURN
+    RETURN
   END FUNCTION str_remove
  FUNCTION str_replace(string,old,new,back,all) RESULT(str)
     !! Replace substring from current string
     !!
     !! The function replaces the first occurence of __old__ in __string__ by
+    !! Replace substring from current string
+    !!
+    !! The function replaces the first occurence of __old__ in __string__ by
     !! __new__ or all its occurence(s) if __all__ is explicitly set to .true..
     CHARACTER(len=*), INTENT(in)  :: string  !! A string to search in
 …
     IF (PRESENT(all)) za = all
     IF (za) zb = .NOT.za
     IF (LEN(string) == 0) RETURN
     j=1
     DO
+    IF (LEN(string) == 0) RETURN
+    j=1
+    DO
       IF (j>LEN(string)) EXIT
       ! search for "old"
 …
       IF (is == 0) THEN
         ! "old" is not found : we get the last part of the string and return
         str = str//string(j:) ; RETURN
+        str = str//string(j:) ; RETURN
       ELSE IF (is == 1) THEN
         str = str//new
 …
         ! "old" is not at the begin of the string : saves the string
         str = str//string(j:j+is-2)//new
         j = j + is + LEN(old) - 1
+        j = j + is + LEN(old) - 1
       ENDIF
       IF (.NOT.(is==0.OR.za)) EXIT
+      IF (.NOT.(is==0.OR.za)) EXIT
     ENDDO
     IF (j <= LEN(str)) str=str//string(j:)
     RETURN
+    RETURN
   END FUNCTION str_replace
   FUNCTION endswith(string,substring,icase) RESULT(ret)
     !! Check if string ends by substring
+    !! Check if string ends by substring
     CHARACTER(len=*), INTENT(in)  :: string
       !! @param[in] string A string to check
     CHARACTER(len=*), INTENT(in)  :: substring
       !! A string to search in __string__
     LOGICAL, INTENT(in), OPTIONAL :: icase
+    LOGICAL, INTENT(in), OPTIONAL :: icase
       !! An optional boolean flag with .true. to perform insensitive case search
     LOGICAL :: ret
       !! .true. if __string__ ends by __substring__, .false. otherwise.
     CHARACTER(len=:), ALLOCATABLE :: zthis,zstr
     INTEGER                       :: idx
     LOGICAL                       :: noc
+    INTEGER                       :: idx
+    LOGICAL                       :: noc
     ret = .false.
     noc = .false. ; IF (PRESENT(icase)) noc = icase
 …
   FUNCTION startswith(string,substring,icase) RESULT(ret)
     !! Check if string starts by substring
+    !! Check if string starts by substring
     CHARACTER(len=*), INTENT(in)  :: string
       !! A string to check
     CHARACTER(len=*), INTENT(in)  :: substring
       !! A string to search in __string__
     LOGICAL, INTENT(in), OPTIONAL :: icase
+    LOGICAL, INTENT(in), OPTIONAL :: icase
       !! An optional boolean flag with .true. to perform insensitive case search
     LOGICAL :: ret
       !! .true. if __string__ starts by __substring__, .false. otherwise.
     CHARACTER(len=:), ALLOCATABLE :: zthis,zstr
     INTEGER                       :: idx
     LOGICAL                       :: noc
+    INTEGER                       :: idx
+    LOGICAL                       :: noc
     ret = .false.
     noc = .false. ; IF (PRESENT(icase)) noc = icase
 …
   END FUNCTION startswith
   ! CSI related functions
+  ! CSI related functions
   ! ---------------------
 …
     !! returns a copy of it.
     CHARACTER(len=*), INTENT(in)      :: string
       !! @param[in] string A string object reference
+      !! @param[in] string A string object reference
     INTEGER, INTENT(in), DIMENSION(:) :: attrs
       !! A vector of integers with the code to add. Each __attrs__ value should refers to one i
 …
       tmp = string
     ENDIF
     ! 3) Add all the given csi preceded by <ESC>[0m at the beginning of the string
+    ! 3) Add all the given csi preceded by <ESC>[0m at the beginning of the string
     !    if it does not start by an ANSI sequence
     IF (INDEX(tmp,CHAR(27)//"[") /= 1) &
     tmp = str_add_to_csi(rcsi,attrs)//tmp
     ! Loops on new string and updates csi codes
     j=1
     DO
+    j=1
+    DO
       IF (j>LEN(tmp)) EXIT
       ! search for escape
 …
     ENDDO
     IF (INDEX(str,rcsi,.true.) /= LEN(str)-3) str = str//rcsi
     RETURN
+    RETURN
   END FUNCTION add_csi
 …
     !! Remove attributes to the given string
     !!
     !! The function removes list of csi (ANSI escape sequences) from the given
+    !! The function removes list of csi (ANSI escape sequences) from the given
     !! string and returns a copy of it.
     CHARACTER(len=*), INTENT(in)      :: string
       !! Input string
     INTEGER, INTENT(in), DIMENSION(:) :: attrs
       !! A vector of integers with the code to remove. Each __attrs__ value should
+      !! Input string
+    INTEGER, INTENT(in), DIMENSION(:) :: attrs
+      !! A vector of integers with the code to remove. Each __attrs__ value should
       !! refers to one of [[string_op(module):attributes(variable)]] values.
     CHARACTER(len=:), ALLOCATABLE :: str
 …
     ! Loops on new string and updates csi codes
     j=1 ; csis=""
     DO
+    DO
       IF (j>LEN(tmp)) EXIT
       ! search for escape
 …
     ! Add <ESC>[0m at the end of string if not found
     IF (INDEX(str,rcsi,.true.) /= LEN(str)-3) str = str//rcsi
     ! resets all attributes if we only have <ESC>[0m in final list
     ok = tokenize(csis(1:LEN(csis)-1),tks,"|")
+    ! resets all attributes if we only have <ESC>[0m in final list
+    ok = tokenize(csis(1:LEN(csis)-1),tks,"|")
     IF (ALL(tks == rcsi)) str = reset_csi(str)
     DEALLOCATE(tks)
     RETURN
+    RETURN
   END FUNCTION del_csi
   FUNCTION reset_csi(string) RESULT(str)
     !! Reset all csi codes of the string
     !!
+    !!
     !! The method removes __all__ the known escape sequences from the input string.
     CHARACTER(len=*), INTENT(in) :: string
       !! Input string
     CHARACTER(len=:), ALLOCATABLE :: str
+    CHARACTER(len=:), ALLOCATABLE :: str
       !! An allocatable string with the copy of input string stripped off csi codes.
     INTEGER :: j,iesc,im
     LOGICAL :: tcsi
     str = ""
     IF (LEN(string) == 0) RETURN
     j=1
     DO
+    IF (LEN(string) == 0) RETURN
+    j=1
+    DO
       IF (j>LEN(string)) EXIT
       ! search for escape
 …
       j = j + iesc ; IF (tcsi) j=j+im
     ENDDO
     RETURN
+    RETURN
   END FUNCTION reset_csi
   FUNCTION is_csi(value) RESULT(yes)
     !! Check if string is a known csi
     !!
+    !!
     !! The function only check for known csi code which are defined in [[string_op(module):attributes(variable)]].
     CHARACTER(len=*), INTENT(in) :: value
 …
       !! .true. if it is a known csi, .false. otherwise
     LOGICAL                                           :: ok
     CHARACTER(len=:), ALLOCATABLE                     :: tmp
+    CHARACTER(len=:), ALLOCATABLE                     :: tmp
     TYPE(words)                                       :: wtks
     CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE :: stks
 …
   FUNCTION str_add_to_csi(csi,list) RESULT(ncsi)
     !! Add a new list of codes to the input csi string
     !!
+    !!
     !! The method adds all the csi codes given in __list__ that are known by the module and not
     !! already present in the input csi.
 …
       !! A string with the input csi. It __must__ begin with "<ESC>[" and ends with "m".
     INTEGER, INTENT(in), DIMENSION(:) :: list
       !! A vector of integers with the csi code to add. Each value of __list__ should be one of
       !! [[string_op(module):attributes(variable)]] values. All unknown values are filtered out as well
+      !! A vector of integers with the csi code to add. Each value of __list__ should be one of
+      !! [[string_op(module):attributes(variable)]] values. All unknown values are filtered out as well
       !! as csi code already present in input __csi__.
     CHARACTER(len=:), ALLOCATABLE :: ncsi
       !! A new csi string or the input __csi__ if some "errors" occured (the input csi could not
+    CHARACTER(len=:), ALLOCATABLE :: ncsi
+      !! A new csi string or the input __csi__ if some "errors" occured (the input csi could not
       !! be tokenized or none of __list__ values are left after filtering).
     LOGICAL                                            :: ok
+    LOGICAL                                            :: ok
     CHARACTER(len=st_slen), DIMENSION(:), ALLOCATABLE  :: tks
     CHARACTER(len=:), ALLOCATABLE                      :: tmp
 …
     INTEGER                                            :: i,j,ni,no
     ! 1) Filter input list :
     ! 1.1) Gets the list of current csi codes
     ncsi = csi(3:len(csi)-1)
+    ! 1.1) Gets the list of current csi codes
+    ncsi = csi(3:len(csi)-1)
     ok = tokenize(ncsi,tks,"; ",merge=.true.)
     IF (.NOT.from_string(tks,nums)) THEN
 …
     ENDIF
     DEALLOCATE(tks)
     ! 1.2) Filter input list of new flags to add
+    ! 1.2) Filter input list of new flags to add
     ! counts number of valid flags
     j=0
     DO i=1,SIZE(list)
+    j=0
+    DO i=1,SIZE(list)
       ! new flags must be in attributes but NOT in nums
       IF (ANY(attributes==list(i).AND..NOT.ANY(nums == list(i)))) j=j+1
 …
     ni = SIZE(nums) ; no = j + ni
     ALLOCATE(zlist(no)) ; zlist(1:ni) = nums(:) ; j = ni
     DO i=1,SIZE(list)
+    DO i=1,SIZE(list)
       ! new flags must be in attributes but NOT in nums
       IF (ANY(attributes==list(i).AND..NOT.ANY(nums == list(i)))) THEN
         j=j+1 ; zlist(j) = list(i)
       ENDIF
+      ENDIF
     ENDDO
     DEALLOCATE(nums)
 …
     ncsi = CHAR(27)//"[0;"
     DO i=1,no
       ! ... So we get rid of all "0" flag in the list
+      ! ... So we get rid of all "0" flag in the list
       IF (zlist(i) /= 0) THEN
         tmp = to_string(zlist(i))
 …
       ENDIF
     ENDDO
     ncsi = ncsi//"m"
+    ncsi = ncsi//"m"
   END FUNCTION str_add_to_csi
 …
       !! An intrinsic Fortran string with the input csi. It __must__ begin with "<ESC>[" and ends with "m".
     INTEGER, INTENT(in), DIMENSION(:) :: list
       !! A vector of integers with the csi code to remove. Each value of __list__ should be one of
+      !! A vector of integers with the csi code to remove. Each value of __list__ should be one of
       !! [[string_op(module):attributes(variable)]] values. All unknown values are filtered out.
     CHARACTER(len=:), ALLOCATABLE :: ncsi
       !! A new csi string or the input __csi__ if some "errors" occured (the input csi could not
+    CHARACTER(len=:), ALLOCATABLE :: ncsi
+      !! A new csi string or the input __csi__ if some "errors" occured (the input csi could not
       !! be tokenized or none of __list__ values are left after filtering).
     LOGICAL                                            :: ok
 …
     INTEGER, DIMENSION(:), ALLOCATABLE                 :: nums
     INTEGER                                            :: i
     ncsi = csi(3:len(csi)-1)
     ok = tokenize(ncsi,tks,"; ",merge=.true.)
     IF (.NOT.from_string(tks,nums)) THEN
       ncsi = csi
       RETURN
+    ncsi = csi(3:len(csi)-1)
+    ok = tokenize(ncsi,tks,"; ",merge=.true.)
+    IF (.NOT.from_string(tks,nums)) THEN
+      ncsi = csi
+      RETURN
     ENDIF
     DEALLOCATE(tks)
 …
     !! Get the position of the first known csi in string
     !!
     !! The method searches for the first known csi in string. The csi must contain known codes
+    !! The method searches for the first known csi in string. The csi must contain known codes
     !! (i.e. values of [[string_op(module):attributes(variable)]]).
     CHARACTER(len=*), INTENT(in) :: str    !! A string to search in
 …
     pos = 0 ; length = 0
     ! we need at least 4 chars to create a csi
     IF (LEN_TRIM(str) < 4) RETURN
+    IF (LEN_TRIM(str) < 4) RETURN
     iesc = INDEX(str,CHAR(27))
     IF (iesc == 0) RETURN
 …
     COMPLEX(kind=4), INTENT(out) :: value !! Output value
     LOGICAL :: ret                        !! Return status (.true. on success)
     ! - LOCAL
+    ! - LOCAL
     CHARACTER(len=:), ALLOCATABLE :: zs
     ret = .true. ; zs = remove_quotes(str)
 …
     CHARACTER(len=*), INTENT(in), DIMENSION(:)           :: str   !! Vector of strings to convert
     REAL(kind=4), INTENT(out), DIMENSION(:), ALLOCATABLE :: value !! Vector of output values
     LOGICAL :: ret                                                !! Return status (.true. on success)
+    LOGICAL :: ret                                                !! Return status (.true. on success)
     INTEGER                       :: i,ns
     CHARACTER(len=:), ALLOCATABLE :: zs
 …
   FUNCTION int2str_as(value) RESULT(str)
     !! Convert an integer value to string (auto format / string result)
+    !! Convert an integer value to string (auto format / string result)
     INTEGER, INTENT(in)           :: value !! Value to convert
     CHARACTER(len=:), ALLOCATABLE :: str   !! String with the converted value in output
 …
     WRITE(str,*,iostat=err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION int2str_as
   FUNCTION log2str_as(value) RESULT(str)
     !! Convert a logical value to string (auto format / string result)
+    !! Convert a logical value to string (auto format / string result)
     LOGICAL, INTENT(in)           :: value !! Value to convert
     CHARACTER(len=:), ALLOCATABLE :: str   !! String with the converted value in output
 …
   FUNCTION real2str_as(value) RESULT(str)
     !! Convert a simple precision floating point value to string (auto format / string result)
+    !! Convert a simple precision floating point value to string (auto format / string result)
     REAL(kind=4), INTENT(in)      :: value !! Value to convert
     CHARACTER(len=:), ALLOCATABLE :: str   !! String with the converted value in output
 …
     WRITE(str,*, IOSTAT = err) value
     str=TRIM(ADJUSTL(str))
     IF (err /= 0)  str = ''
+    IF (err /= 0)  str = ''
     RETURN
   END FUNCTION real2str_as
   FUNCTION dble2str_as(value) RESULT(str)
     !! Convert a double precision floating point value to string (auto format / string result)
+    !! Convert a double precision floating point value to string (auto format / string result)
     REAL(kind=8), INTENT(in)      :: value !! Value to convert
     CHARACTER(len=:), ALLOCATABLE :: str   !! String with the converted value in output
 …
     WRITE(str,*, IOSTAT = err) value
     str=TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION dble2str_as
   FUNCTION cplx2str_as(value) RESULT(str)
     !! Convert a complex value to string (auto format / string result)
+    !! Convert a complex value to string (auto format / string result)
     COMPLEX(kind=4), INTENT(in)   :: value !! Value to convert
     CHARACTER(len=:), ALLOCATABLE :: str   !! String with the converted value in output
 …
     WRITE(str, *, IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION cplx2str_as
   FUNCTION dcplx2str_as(value) RESULT(str)
     !! Convert a complex value to string (auto format / string result)
+    !! Convert a complex value to string (auto format / string result)
     COMPLEX(kind=8), INTENT(in)   :: value !! Value to convert
     CHARACTER(len=:), ALLOCATABLE :: str   !! String with the converted value in output
 …
     WRITE(str, *, IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION dcplx2str_as
   FUNCTION int2str_fs(value, fmt) RESULT(str)
     !! Convert an integer value to string (user format / string result)
+    !! Convert an integer value to string (user format / string result)
     INTEGER, INTENT(in)           :: value !! Value to convert
     CHARACTER(len=*), INTENT(in)  :: fmt   !! String format
 …
     WRITE(str, '('//fmt//')', IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION int2str_fs
   FUNCTION log2str_fs(value, fmt) RESULT(str)
     !! Convert a logical value to string (user format / string result)
+    !! Convert a logical value to string (user format / string result)
     LOGICAL, INTENT(in)           :: value !! Value to convert
     CHARACTER(len=*), INTENT(in)  :: fmt   !! String format
 …
     WRITE(str, '('//fmt//')', IOSTAT = err) value
     str=TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION log2str_fs
   FUNCTION real2str_fs(value, fmt) RESULT(str)
     !! Convert a simple precision floating point value to string (user format / string result)
+    !! Convert a simple precision floating point value to string (user format / string result)
     REAL(kind=4), INTENT(in)      :: value !! Value to convert
     CHARACTER(len=*), INTENT(in)  :: fmt   !! String format
 …
     WRITE(str, '('//fmt//')', IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION real2str_fs
   FUNCTION dble2str_fs(value, fmt) RESULT(str)
     !! Convert a double precision floating point value to string (user format / string result)
+    !! Convert a double precision floating point value to string (user format / string result)
     REAL(kind=8), INTENT(in)      :: value !! Value to convert
     CHARACTER(len=*), INTENT(in)  :: fmt   !! String format
 …
     WRITE(str, '('//fmt//')', IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION dble2str_fs
   FUNCTION cplx2str_fs(value, fmt) RESULT(str)
     !! Convert a complex value to string (user format / string result)
+    !! Convert a complex value to string (user format / string result)
     COMPLEX(kind=4), INTENT(in)   :: value !! Value to convert
     CHARACTER(len=*), INTENT(in)  :: fmt   !! String format
 …
     WRITE(str, '('//fmt//')', IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION cplx2str_fs
   FUNCTION dcplx2str_fs(value, fmt) RESULT(str)
     !! Convert a complex value to string (user format / string result)
+    !! Convert a complex value to string (user format / string result)
     COMPLEX(kind=8), INTENT(in)   :: value !! Value to convert
     CHARACTER(len=*), INTENT(in)  :: fmt   !! String format
 …
     WRITE(str, '('//fmt//')', IOSTAT = err) value
     str = TRIM(ADJUSTL(str))
     IF (err /= 0) str = ''
+    IF (err /= 0) str = ''
     RETURN
   END FUNCTION dcplx2str_fs
 …
     INTEGER, INTENT(in)           :: int2 !! Integer to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str  !! Output string
     ALLOCATE(CHARACTER(len=DIGITS(int2)) :: str)
+    ALLOCATE(CHARACTER(len=DIGITS(int2)) :: str)
     WRITE(str,*) int2 ; str = TRIM(ADJUSTL(str))
     IF (LEN(str1) /= 0) str = str1//str
 …
   FUNCTION fis_cat_int_inv(int2,str1) RESULT(str)
     !! Concatenate a fortran intrinsic string with a integer (reversed).
     INTEGER, INTENT(in)           :: int2 !! Integer to concatenate
+    INTEGER, INTENT(in)           :: int2 !! Integer to concatenate
     CHARACTER(len=*), INTENT(in)  :: str1 !! String to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str  !! Output string
     ALLOCATE(CHARACTER(len=DIGITS(int2)) :: str)
+    ALLOCATE(CHARACTER(len=DIGITS(int2)) :: str)
     WRITE(str,*) int2 ; str = TRIM(ADJUSTL(str))
     IF (LEN(str1) /= 0) str = str//str1
 …
     CHARACTER(len=:), ALLOCATABLE :: str   !! Output string
     CHARACTER(len=2) ::tmp
     WRITE(tmp,*) bool2
+    WRITE(tmp,*) bool2
     str=TRIM(ADJUSTL(tmp))
     IF (LEN(str1) /= 0) str = str1//str
 …
     CHARACTER(len=*), INTENT(in)  :: str1    !! String to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str     !! Output string
     CHARACTER(len=2) ::tmp
     WRITE(tmp,*) bool2
+    CHARACTER(len=2) ::tmp
+    WRITE(tmp,*) bool2
     str = TRIM(ADJUSTL(tmp))
     IF (LEN(str1) /= 0) str = str//str1
 …
     REAL(kind=4), INTENT(in)      :: real2 !! Simple precision real to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str     !! Output string
     ALLOCATE(CHARACTER(len=DIGITS(real2)) :: str)
+    ALLOCATE(CHARACTER(len=DIGITS(real2)) :: str)
     WRITE(str,*) real2 ; str = TRIM(ADJUSTL(str))
     IF (LEN(str1) /= 0) str=str1//str
+    IF (LEN(str1) /= 0) str=str1//str
     RETURN
   END FUNCTION fis_cat_real
 …
     CHARACTER(len=*), INTENT(in)  :: str1  !! String to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str   !! Output string
     ALLOCATE(CHARACTER(len=DIGITS(real2)) :: str)
+    ALLOCATE(CHARACTER(len=DIGITS(real2)) :: str)
     WRITE(str,*) real2  ; str = TRIM(ADJUSTL(str))
     IF (LEN(str1) /= 0) str = str//str1
 …
     REAL(kind=8), INTENT(in)      :: double2 !! Double precision real to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str     !! Output string
     ALLOCATE(CHARACTER(len=DIGITS(double2)) :: str)
+    ALLOCATE(CHARACTER(len=DIGITS(double2)) :: str)
     WRITE(str,*) double2 ; str = TRIM(ADJUSTL(str))
     IF (LEN(str1) /= 0) str=str1//str
+    IF (LEN(str1) /= 0) str=str1//str
     RETURN
   END FUNCTION fis_cat_double
 …
     CHARACTER(len=*), INTENT(in)  :: str1    !! String to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str     !! Output string
     ALLOCATE(CHARACTER(len=DIGITS(double2)) :: str)
+    ALLOCATE(CHARACTER(len=DIGITS(double2)) :: str)
     WRITE(str,*) double2  ; str = TRIM(ADJUSTL(str))
     IF (LEN(str1) /= 0) str = str//str1
 …
   FUNCTION fis_cat_cplx(str1,cplx2) RESULT(str)
     !! Concatenate a string with a complex
     CHARACTER(len=*), INTENT(in)  :: str1  !! String to concatenate
     COMPLEX(kind=4), INTENT(in)   :: cplx2 !! Complex value to concatenate
+    !! Concatenate a string with a complex
+    CHARACTER(len=*), INTENT(in)  :: str1  !! String to concatenate
+    COMPLEX(kind=4), INTENT(in)   :: cplx2 !! Complex value to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str   !! Output string
     INTEGER :: sl
 …
   FUNCTION fis_cat_cplx_inv(cplx2,str1) RESULT(str)
     !! Concatenate a string with a complex (reversed)
     COMPLEX(kind=4), INTENT(in)   :: cplx2 !! Complex value to concatenate
     CHARACTER(len=*), INTENT(in)  :: str1  !! String to concatenate
+    COMPLEX(kind=4), INTENT(in)   :: cplx2 !! Complex value to concatenate
+    CHARACTER(len=*), INTENT(in)  :: str1  !! String to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str   !! Output string
     INTEGER :: sl
 …
   FUNCTION fis_cat_dcplx(str1,dcplx2) RESULT(str)
     !! Concatenate a string with a double precision complex
+    !! Concatenate a string with a double precision complex
     CHARACTER(len=*), INTENT(in)  :: str1   !! String to concatenate
     COMPLEX(kind=8), INTENT(in)   :: dcplx2 !! Complex value to concatenate
+    COMPLEX(kind=8), INTENT(in)   :: dcplx2 !! Complex value to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str    !! Output string
     INTEGER :: sl
 …
   FUNCTION fis_cat_dcplx_inv(dcplx2,str1) RESULT(str)
     !! Concatenate a string with a double precision complex (reversed)
     COMPLEX(kind=8), INTENT(in)   :: dcplx2 !! Complex value to concatenate
+    COMPLEX(kind=8), INTENT(in)   :: dcplx2 !! Complex value to concatenate
     CHARACTER(len=*), INTENT(in)  :: str1   !! string to concatenate
     CHARACTER(len=:), ALLOCATABLE :: str    !! Output string
 …
   SUBROUTINE fis_affect_int(str,int)
     !! Assignment subroutine (using intrinsic integer)
+    !! Assignment subroutine (using intrinsic integer)
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str !! Output string to be assigned
     INTEGER, INTENT(in)                        :: int !! Input value to assign
+    INTEGER, INTENT(in)                        :: int !! Input value to assign
     str = fis_cat_int('',int)
   END SUBROUTINE fis_affect_int
   SUBROUTINE fis_affect_bool(str,bool)
     !! Assignment subroutine (using intrinsic logical)
+    !! Assignment subroutine (using intrinsic logical)
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str  !! Output string to be assigned
     LOGICAL, INTENT(in)                        :: bool !! Input value to assign
 …
   SUBROUTINE fis_affect_real(str,float)
     !! Assignment subroutine (using intrinsic real)
+    !! Assignment subroutine (using intrinsic real)
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str   !! Output string to be assigned
     REAL(kind=4), INTENT(in)                   :: float !! Input value to assign
 …
   SUBROUTINE fis_affect_double(str,double)
     !! Assignment subroutine (using intrinsic real(kind=8))
+    !! Assignment subroutine (using intrinsic real(kind=8))
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str    !! Output string to be assigned
     REAL(kind=8), INTENT(in)                   :: double !! Input value to assign
+    REAL(kind=8), INTENT(in)                   :: double !! Input value to assign
     str = fis_cat_double('',double)
   END SUBROUTINE fis_affect_double
   SUBROUTINE fis_affect_cplx(str,cplx)
     !! Assignment subroutine (using intrinsic complex)
+    !! Assignment subroutine (using intrinsic complex)
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str  !! Output string to be assigned
     COMPLEX(kind=4), INTENT(in)                :: cplx !! Input value to assign
 …
   SUBROUTINE fis_affect_dcplx(str,dcplx)
     !! Assignment subroutine (using intrinsic complex(kind=8))
+    !! Assignment subroutine (using intrinsic complex(kind=8))
     CHARACTER(len=:), INTENT(out), ALLOCATABLE :: str   !! Output string to be assigned
     COMPLEX(kind=8), INTENT(in)                :: dcplx !! Input value to assign
 …
     !! Only know CSI codes are returned. If no known CSI are found the outputput vector is
     !! allocated with 0 elements.
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
+    CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags !! CSI attributes flags
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes         !! CSI codes.
     INTEGER :: i,j,n
 …
   FUNCTION fancy_fstr(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given (fortran intrinsic) string.
     CHARACTER(len=*), INTENT(in)               :: value  !! String object reference
+    CHARACTER(len=*), INTENT(in)               :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format (unused for this overload)
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     codes = get_attrs_indexes(flags)
+    codes = get_attrs_indexes(flags)
     IF (SIZE(codes) == 0) THEN
       output = value ; RETURN
 …
   FUNCTION fancy_int(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given integer value.
     INTEGER, INTENT(in)                        :: value  !! String object reference
+    INTEGER, INTENT(in)                        :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format. If given it must be a valid Fortran format.
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     CHARACTER(len=:), ALLOCATABLE      :: tmp
     codes = get_attrs_indexes(flags)
+    CHARACTER(len=:), ALLOCATABLE      :: tmp
+    codes = get_attrs_indexes(flags)
     IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
     IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
 …
   FUNCTION fancy_bool(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given logical value.
     LOGICAL, INTENT(in)                        :: value  !! String object reference
+    LOGICAL, INTENT(in)                        :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format. If given it must be a valid Fortran format.
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     CHARACTER(len=:), ALLOCATABLE      :: tmp
     codes = get_attrs_indexes(flags)
+    CHARACTER(len=:), ALLOCATABLE      :: tmp
+    codes = get_attrs_indexes(flags)
     IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
     IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
 …
   FUNCTION fancy_real(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given real value (simple precision).
     REAL(kind=4), INTENT(in)                   :: value  !! String object reference
+    REAL(kind=4), INTENT(in)                   :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format. If given it must be a valid Fortran format.
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     CHARACTER(len=:), ALLOCATABLE      :: tmp
     codes = get_attrs_indexes(flags)
+    CHARACTER(len=:), ALLOCATABLE      :: tmp
+    codes = get_attrs_indexes(flags)
     IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
     IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
   END FUNCTION fancy_real
+  END FUNCTION fancy_real
   FUNCTION fancy_double(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given real value (double precision).
     REAL(kind=8), INTENT(in)                   :: value  !! String object reference
+    REAL(kind=8), INTENT(in)                   :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format. If given it must be a valid Fortran format.
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     CHARACTER(len=:), ALLOCATABLE      :: tmp
     codes = get_attrs_indexes(flags)
+    CHARACTER(len=:), ALLOCATABLE      :: tmp
+    codes = get_attrs_indexes(flags)
     IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
     IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
 …
   FUNCTION fancy_cplx(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given complex value (simple precision).
     COMPLEX(kind=4), INTENT(in)                :: value  !! String object reference
+    COMPLEX(kind=4), INTENT(in)                :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format. If given it must be a valid Fortran format.
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     CHARACTER(len=:), ALLOCATABLE      :: tmp
     codes = get_attrs_indexes(flags)
+    CHARACTER(len=:), ALLOCATABLE      :: tmp
+    codes = get_attrs_indexes(flags)
     IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
     IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF
   END FUNCTION fancy_cplx
   FUNCTION fancy_dcplx(value,flags,fmt) RESULT(output)
     !! Compute a fancy string from the given complex value (double precision).
     COMPLEX(kind=8), INTENT(in)                :: value  !! String object reference
+    COMPLEX(kind=8), INTENT(in)                :: value  !! String object reference
     CHARACTER(len=2), DIMENSION(:), INTENT(in) :: flags  !! CSI attributes flags
     CHARACTER(len=*), INTENT(in), OPTIONAL     :: fmt    !! Optional format. If given it must be a valid Fortran format.
     CHARACTER(len=:), ALLOCATABLE              :: output !! Output fortran instrinsic string
     INTEGER, DIMENSION(:), ALLOCATABLE :: codes
     CHARACTER(len=:), ALLOCATABLE      :: tmp
     codes = get_attrs_indexes(flags)
+    CHARACTER(len=:), ALLOCATABLE      :: tmp
+    codes = get_attrs_indexes(flags)
     IF (PRESENT(fmt)) THEN ; tmp = to_string(value,fmt) ; ELSE ; tmp = to_string(value) ; ENDIF
     IF (SIZE(codes) /= 0) THEN ; output = add_csi(tmp,codes) ; ELSE ; output = tmp ; ENDIF

Context Navigation

Legend:

trunk/LMDZ.TITAN/libf/muphytitan/argparse.F90

trunk/LMDZ.TITAN/libf/muphytitan/asciiread.f90

trunk/LMDZ.TITAN/libf/muphytitan/cfgparse.F90

trunk/LMDZ.TITAN/libf/muphytitan/csystem.c

trunk/LMDZ.TITAN/libf/muphytitan/csystem.h

trunk/LMDZ.TITAN/libf/muphytitan/defined.h

trunk/LMDZ.TITAN/libf/muphytitan/errors.F90

trunk/LMDZ.TITAN/libf/muphytitan/fsystem.F90

trunk/LMDZ.TITAN/libf/muphytitan/mm_clouds.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_globals.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_haze.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_interfaces.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_lib.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_methods.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_microphysic.f90

trunk/LMDZ.TITAN/libf/muphytitan/mm_mprec.F90

trunk/LMDZ.TITAN/libf/muphytitan/mmp_gcm.f90

trunk/LMDZ.TITAN/libf/muphytitan/mmp_globals.f90

trunk/LMDZ.TITAN/libf/muphytitan/mmp_moments.f90

trunk/LMDZ.TITAN/libf/muphytitan/string_op.F90

Download in other formats: