Ignore:
Timestamp:
Nov 7, 2022, 3:09:43 AM (2 years ago)
Author:
dcugnet
Message:
  • simplify the parser usage:
    • the getKey_init routine is now embedded in the readTracersFile routine.
    • the initIsotopes routine is now embedded in the readIsotopesFile routine.
    • the database is now unique, but can be changed using the get/setKeysDBase.
    • the derived types descriptions, originally located in trac_types_mod, are moved to readTracFiles_mod.
    • few checkings moved from infotrac to the routine testIsotopes, contained in the readIsotopesFile function from readTracFiles_mod.
    • the readTracersFiles and readIsotopesFile routines no longer use a tracers/isotopes argument.
  • remove tnat and alpha_ideal from infotrac ; use instead getKey to get them where they are used (check_isotopes, dynetat0, iniacademic)
  • the trac_type field %Childs is renamed %Children
  • move the isoSelect routine and the corresponding variables routine from infotrac and infotrac_phy to readTracFiles_mod
  • infotrac_phy routine is now fully independant of the (very similar) routine infotrac (init_infotrac_phy has no arguments left).
  • all the explicit keys of the trac_type are now included in the embedded keys database, accessible using the getKey function.
  • the getKey/addKey routines are expanded to handle vectors of integers, reals, logicals or strings.
  • few subroutines converted into functions with error return value.
  • corrections for isotopic tagging tracers mode (to be continued).
Location:
LMDZ6/trunk/libf/dyn3d_common
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d_common/infotrac.F90

    r4301 r4325  
    33MODULE infotrac
    44
    5    USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable, int2str,  reduceExpr, &
    6                           cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile
    7    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, indexUpdate, addPhase, getKey, maxTableWidth, keys_type, &
    8                                 isot_type, setGeneration,   initIsotopes, delPhase, getKey_init, ancestor, tran0
    9                                
     5   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
     6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, &
     7                        getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, &
     8                   indexUpdate, isoSelect, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck, nphas, nzone, niso
    109   IMPLICIT NONE
    1110
    … …  
    1312
    1413   !=== FOR TRACERS:
    15    PUBLIC :: infotrac_init                                 !--- Initialization of the tracers
     14   PUBLIC :: init_infotrac                                 !--- Initialization of the tracers
    1615   PUBLIC :: tracers, type_trac, types_trac                !--- Full tracers database, tracers type keyword
    1716   PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
    … …  
    1918
    2019   !=== FOR ISOTOPES: General
    21    PUBLIC :: isotopes, nbIso                              !--- Derived type, full isotopes families database + nb of families
     20   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    2221   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
    2322   !=== FOR ISOTOPES: Specific to water
    24    PUBLIC :: iH2O, tnat, alpha_ideal                       !--- H2O isotopes index, natural abundance, fractionning coeff.
     23   PUBLIC :: iH2O                                          !--- H2O isotopes class index
    2524   PUBLIC :: min_qParent, min_qMass, min_ratio             !--- Min. values for various isotopic quantities
    2625   !=== FOR ISOTOPES: Depending on the selected isotopes family
    … …  
    3332   !=== FOR BOTH TRACERS AND ISOTOPES
    3433   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
    35 
    36    INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
    3734
    3835!=== CONVENTIONS FOR TRACERS NUMBERS:
    … …  
    7774!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
    7875!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    79 !  | nqChilds    | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
     76!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    8077!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    8178!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    … …  
    10299
    103100   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    104    INTEGER,                 SAVE :: nqtot,  &                   !--- Tracers nb in dynamics (incl. higher moments + H2O)
    105                                     nbtr,   &                   !--- Tracers nb in physics  (excl. higher moments + H2O)
    106                                     nqo,    &                   !--- Number of water phases
    107                                     nbIso,  &                   !--- Number of available isotopes family
    108                                     nqtottr, &                  !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    109                                     nqCO2                       !--- Number of tracers of CO2  (ThL)
    110    CHARACTER(LEN=maxlen),   SAVE :: type_trac                   !--- Keyword for tracers type(s)
    111    CHARACTER(LEN=maxlen),   SAVE, ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
    112 
    113    !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
    114    TYPE(trac_type), TARGET, SAVE, ALLOCATABLE ::  tracers(:)    !=== TRACERS DESCRIPTORS VECTOR
    115    TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:)    !=== ISOTOPES PARAMETERS VECTOR
    116 
    117    !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
    118    TYPE(isot_type),         SAVE, POINTER :: isotope            !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
    119    INTEGER,                 SAVE          :: ixIso, iH2O        !--- Index of the selected isotopes family and H2O family
    120    LOGICAL,                 SAVE          :: isoCheck           !--- Flag to trigger the checking routines
    121    TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)         !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    122    CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &    !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
    123                                              isoZone(:),   &    !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
    124                                              isoPhas            !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
    125    INTEGER,                 SAVE          ::  niso, nzone, &    !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
    126                                              nphas, ntiso       !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
    127    INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &    !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
    128                                             iqIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    129 
    130    !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
    131    REAL,                SAVE, ALLOCATABLE ::     tnat(:), &     !--- Natural relative abundance of water isotope        (niso)
    132                                           alpha_ideal(:)        !--- Ideal fractionning coefficient (for initial state) (niso)
    133    INTEGER,             SAVE, ALLOCATABLE :: conv_flg(:), &     !--- Convection     activation ; needed for INCA        (nbtr)
    134                                               pbl_flg(:)        !--- Boundary layer activation ; needed for INCA        (nbtr)
     101   INTEGER,               SAVE :: nqtot,  &                     !--- Tracers nb in dynamics (incl. higher moments + H2O)
     102                                  nbtr,   &                     !--- Tracers nb in physics  (excl. higher moments + H2O)
     103                                  nqo,    &                     !--- Number of water phases
     104                                  nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
     105                                  nqCO2                         !--- Number of tracers of CO2  (ThL)
     106   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
     107   CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:)    !--- Keyword for tracers type(s), parsed version
     108
     109   !=== VARIABLES FOR INCA
     110   INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
     111                                                pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)
    135112
    136113CONTAINS
    137114
    138 SUBROUTINE infotrac_init
     115SUBROUTINE init_infotrac
    139116   USE control_mod, ONLY: planet_type, config_inca
    140117#ifdef REPROBUS
    … …  
    180157   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    181158   INTEGER :: iad                                                    !--- Advection scheme number
    182    INTEGER :: ic, ip, np, iq, jq, it, nt, im, nm, ix, iz, nz, k      !--- Indexes and temporary variables
     159   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
    183160   LOGICAL :: lerr, ll, lRepr
    184161   CHARACTER(LEN=1) :: p
    185162   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    186163   TYPE(trac_type), POINTER             :: t1, t(:)
    187    TYPE(isot_type), POINTER             :: iso
    188164   INTEGER :: ierr
    189165
    190    CHARACTER(LEN=*), PARAMETER :: modname="infotrac_init"
     166   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
    191167!------------------------------------------------------------------------------------------------------------------------------
    192168! Initialization :
    … …  
    249225!==============================================================================================================================
    250226   lRepr = ANY(types_trac(:) == 'repr')
    251    IF(readTracersFiles(type_trac, fType, tracers, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
     227   IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    252228   !---------------------------------------------------------------------------------------------------------------------------
    253229   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
    … …  
    297273   !---------------------------------------------------------------------------------------------------------------------------
    298274
    299    CALL getKey_init(tracers)
    300 
    301275   !--- Transfert the number of tracers to Reprobus
    302276#ifdef REPROBUS
    … …  
    377351   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    378352
    379    !--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %iqDescen, %nqDescen
     353   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
    380354   CALL indexUpdate(tracers)
    381355
    … …  
    401375   END DO
    402376
    403    niso = 0; nzone=0; nphas=nqo; ntiso = 0; isoCheck=.FALSE.
    404    IF(initIsotopes(tracers, isotopes)) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
    405    nbIso = SIZE(isotopes)
    406    nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    407    IF(nbIso/=0) THEN                        !--- ISOTOPES FOUND
    408 
    409       !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES
    410       !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat, alpha_ideal)
    411       CALL getKey_init(tracers, isotopes)
    412       IF(isoSelect('H2O')) RETURN           !--- Select water isotopes ; finished if no water isotopes
    413       iH2O = ixIso                          !--- Keep track of water family index
    414       IF(getKey('tnat' , tnat,        isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "tnat"', 1)
    415       IF(getKey('alpha', alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "alpha_ideal"', 1)
    416 
    417       !=== MAKE SURE THE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
    418       DO ix = 1, nbIso
    419          iso => isotopes(ix)
    420          !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
    421          DO it = 1, iso%ntiso
    422             np = SUM([(COUNT(tracers(:)%name == addPhase(iso%trac(it), iso%phase(ip:ip))), ip=1, iso%nphas)])
    423             IF(np == iso%nphas) CYCLE
    424             WRITE(msg1,'("Found ",i0," phases for ",a," instead of ",i0)')np, TRIM(iso%trac(it)), iso%nphas
    425             CALL abort_gcm(modname, msg1, 1)
    426          END DO
    427          DO it = 1, iso%niso
    428             nz = SUM([(COUNT(iso%trac == TRIM(iso%trac(it))//'_'//iso%zone(iz)), iz=1, iso%nzone)])
    429             IF(nz == iso%nzone) CYCLE
    430             WRITE(msg1,'("Found ",i0," tagging zones for ",a," instead of ",i0)')nz, TRIM(iso%trac(it)), iso%nzone
    431             CALL abort_gcm(modname, msg1, 1)
    432          END DO
    433       END DO
    434    END IF
     377   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
     378   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     379   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
    435380
    436381   !--- Convection / boundary layer activation for all tracers
    … …  
    439384
    440385   !--- Note: nqtottr can differ from nbtr when nmom/=0
     386   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    441387   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    442       CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1)
     388      CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
    443389
    444390   !=== DISPLAY THE RESULTS
    445    CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    446    CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    447    CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    448    CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    449    CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    450    CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     391   IF(prt_level > 1) THEN
     392      CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     393      CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     394      CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     395      CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     396      CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     397      CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    451398#ifdef INCA
    452    CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    453    CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    454 #endif
     399      CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
     400      CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
     401#endif
     402   END IF
    455403   t => tracers
    456404   CALL msg('Information stored in infotrac :', modname)
    457405   IF(dispTable('isssssssssiiiiiiiii', &
    458       ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isAdv ', 'isPhy ', &
     406      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
    459407       'iadv  ', 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
    460       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isAdvected), &
    461                                                                                   bool2str(t%isInPhysics)),&
    462       cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChilds, t%iso_iGroup,    &
     408      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
     409                                                                                  bool2str(t%isAdvected)), &
     410      cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,  &
    463411                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    464412      CALL abort_gcm(modname, "problem with the tracers table content", 1)
    465413   IF(niso > 0) THEN
    466414      CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
    467       CALL msg('  isoKeys = '//strStack(isoKeys%name), modname)
     415      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    468416      CALL msg('  isoName = '//strStack(isoName),      modname)
    469417      CALL msg('  isoZone = '//strStack(isoZone),      modname)
    … …  
    474422   CALL msg('end', modname)
    475423
    476 END SUBROUTINE infotrac_init
    477 
    478 
    479 !==============================================================================================================================
    480 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
    481 !     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
    482 !==============================================================================================================================
    483 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
    484    IMPLICIT NONE
    485    CHARACTER(LEN=*),  INTENT(IN) :: iName
    486    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    487    INTEGER :: iIso
    488    LOGICAL :: lV
    489    lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    490    iIso = strIdx(isotopes(:)%parent, iName)
    491    lerr = iIso == 0
    492    IF(lerr) THEN
    493       niso = 0; ntiso = 0; nzone=0; nphas=nqo; isoCheck=.FALSE.
    494       CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
    495       RETURN
    496    END IF
    497    lerr = isoSelectByIndex(iIso, lV)
    498 END FUNCTION isoSelectByName
    499 !==============================================================================================================================
    500 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
    501    IMPLICIT NONE
    502    INTEGER,           INTENT(IN) :: iIso
    503    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    504    LOGICAL :: lv
    505    lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
    506    lerr = .FALSE.
    507    IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
    508    lerr = iIso<=0 .OR. iIso>nbIso
    509    CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',&
    510             ll=lerr .AND. lV)
    511    IF(lerr) RETURN
    512    ixIso = iIso                                                      !--- Update currently selected family index
    513    isotope  => isotopes(ixIso)                                       !--- Select corresponding component
    514    isoKeys  => isotope%keys;     niso     = isotope%niso
    515    isoName  => isotope%trac;     ntiso    = isotope%ntiso
    516    isoZone  => isotope%zone;     nzone    = isotope%nzone
    517    isoPhas  => isotope%phase;    nphas    = isotope%nphas
    518    itZonIso => isotope%itZonIso; isoCheck = isotope%check
    519    iqIsoPha => isotope%iqIsoPha
    520 END FUNCTION isoSelectByIndex
    521 !==============================================================================================================================
     424END SUBROUTINE init_infotrac
    522425
    523426END MODULE infotrac

  • LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F

    r4050 r4325  
    6464        function iso_verif_aberrant_nostop
    6565     :           (x,iso,q,err_msg)
    66         USE infotrac, ONLY: tnat
     66        USE infotrac, ONLY: isoName, getKey
    6767        implicit none
    6868       
    … …  
    7474        ! locals
    7575        real qmin,deltaD
    76         real deltaDmax,deltaDmin
     76        real deltaDmax,deltaDmin,tnat
    7777        parameter (qmin=1e-11)
    7878        parameter (deltaDmax=200.0,deltaDmin=-999.9)
    … …  
    8585        ! verifier que HDO est raisonable
    8686         if (q.gt.qmin) then
    87              deltaD=(x/q/tnat(iso)-1)*1000
     87             IF(getKey('tnat', tnat, isoName(iso))) THEN
     88                  err_msg = 'Missing isotopic parameter "tnat"'
     89                  iso_verif_aberrant_nostop=1
     90                  RETURN
     91             END IF
     92             deltaD=(x/q/tnat-1)*1000
    8893             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    8994                  write(*,*) 'erreur detectee par iso_verif_aberrant:'
Note: See TracChangeset for help on using the changeset viewer.