Ignore:
Timestamp:
Sep 20, 2024, 1:10:18 PM (3 months ago)
Author:
Laurent Fairhead
Message:

Merge with trunk revision 5202 before reintegration to trunk

Location:
LMDZ6/branches/cirrus
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • LMDZ6/branches/cirrus

  • LMDZ6/branches/cirrus/libf/dyn3d_common/infotrac.F90

    r5202 r5203  
    77        delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
    88        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
     9   USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3
    910   IMPLICIT NONE
    1011
     
    1617   PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
    1718   PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys
     19   PUBLIC :: new2oldH2O, newHNO3, oldHNO3                  !--- For backwards compatibility in dynetat0
     20   PUBLIC :: addPhase, delPhase                            !--- Add/remove the phase from the name of a tracer
    1821
    1922   !=== FOR ISOTOPES: General
     
    2124   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
    2225   !=== FOR ISOTOPES: Specific to water
    23    PUBLIC :: iH2O                                          !--- H2O isotopes class index
     26   PUBLIC :: iH2O                                          !--- Value of "ixIso" for "H2O" isotopes class
    2427   PUBLIC :: min_qParent, min_qMass, min_ratio             !--- Min. values for various isotopic quantities
    2528   !=== FOR ISOTOPES: Depending on the selected isotopes family
    26    PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)
    27    PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
    28    PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
    29    PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
    30    PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
     29   PUBLIC :: isotope                                       !--- Selected isotopes database (argument of getKey)
     30   PUBLIC :: isoKeys, isoName, isoZone, isoPhas            !--- Isotopes keys & names, tagging zones names, phases
     31   PUBLIC ::    niso,   ntiso,   nzone,   nphas            !--- Number of   "   "
     32   PUBLIC :: itZonIso                                      !--- index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx)
     33   PUBLIC :: iqIsoPha                                      !--- index "iq" in "qx"              = f(isotope idx,   phase idx)
    3134   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    3235   !=== FOR BOTH TRACERS AND ISOTOPES
     
    3639!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
    3740!  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
    38 !  | phases: H2O_[gls|      isotopes         |                 |               |  for higher order schemes  |
     41!  | phases: H2O_[glsrb]|      isotopes         |                 |               |  for higher order schemes  |
    3942!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
    4043!  |                    |                       |                 |               |                            |
     
    6164!  |-------------+------------------------------------------------------+-------------+------------------------+
    6265!  | name        | Name (short)                                         | tname       |                        |
     66!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
    6367!  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |
    6468!  | parent      | Name of the parent                                   | /           |                        |
    6569!  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
    6670!  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
    67 !  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
     71!  | phase       | Phases list ("g"as / "l"iquid / "s"olid              |             | [g|l|s|r|b]            |
     72!  |             |              "r"(cloud) / "b"lowing)                 | /           |                        |
    6873!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
    6974!  | iGeneration | Generation (>=1)                                     | /           |                        |
     
    7277!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    7378!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    74 !  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
    7579!  | iadv        | Advection scheme number                              | iadv        | 1,2,10-20(exc.15,19),30|
    76 !  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
    77 !  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
     80!  | isAdvected  | Advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
     81!  | isInPhysics | Tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
    7882!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    7983!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
     
    9195!  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
    9296!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
    93 !  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3 |
     97!  | phase  | nphas  | Phases                     list + number         |                    | [g|l|s|r|b] 1:5 |
    9498!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
    9599!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
     
    99103
    100104   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    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
     105   INTEGER,               SAVE :: nqtot,   &                    !--- Tracers nb in dynamics (incl. higher moments + H2O)
     106                                  nbtr,    &                    !--- Tracers nb in physics  (excl. higher moments + H2O)
     107                                  nqo,     &                    !--- Number of water phases
    104108                                  nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    105109                                  nqCO2                         !--- Number of tracers of CO2  (ThL)
    106    CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type
     110   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
    107111
    108112   !=== VARIABLES FOR INCA
    109    INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
    110                                                 pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)
     113   INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: &
     114                    conv_flg, pbl_flg                           !--- Convection / boundary layer activation (nbtr)
    111115
    112116CONTAINS
     
    115119   USE control_mod, ONLY: planet_type
    116120#ifdef REPROBUS
    117    USE CHEM_REP,    ONLY: Init_chem_rep_trac
     121   USE CHEM_REP, ONLY: Init_chem_rep_trac
    118122#endif
    119123   IMPLICIT NONE
     
    160164   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    161165   TYPE(trac_type), POINTER             :: t1, t(:)
    162    CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
    163 
     166   CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)             !--- Keywords for tracers type(s), parsed version
    164167   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
    165168!------------------------------------------------------------------------------------------------------------------------------
     
    171174   descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH','   ','PPM','PPS','PPP','   ','SLP']
    172175   descrq(30)    =  'PRA'
    173    
    174    CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    175176
    176177   lerr=strParse(type_trac, '|', types_trac, n=nt)
    177178   IF (nt .GT. 1) THEN
    178179      IF (nt .GT. 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
    179       if (nt .EQ. 2) type_trac=types_trac(2)
     180      IF (nt .EQ. 2) type_trac=types_trac(2)
    180181   ENDIF
    181182
     183   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    182184
    183185   
     
    213215
    214216!==============================================================================================================================
    215 ! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
    216 !==============================================================================================================================
    217    texp = type_trac                                                  !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR
     217! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT
     218!==============================================================================================================================
     219   texp = type_trac                                                            !=== EXPANDED (WITH "|" SEPARATOR) "type_trac"
    218220   IF(texp == 'inco') texp = 'co2i|inca'
    219221   IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp)
    220 
    221    !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
    222222   IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    223223   ttp = type_trac; IF(fType /= 1) ttp = texp
    224 
    225224   IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    226    !---------------------------------------------------------------------------------------------------------------------------
    227    IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
    228    !---------------------------------------------------------------------------------------------------------------------------
    229    IF(fType == 1 .AND. ANY(['inca','inco']==type_trac)) THEN         !=== FOUND OLD STYLE INCA "traceur.def"
     225
     226!==============================================================================================================================
     227! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
     228!==============================================================================================================================
     229   !---------------------------------------------------------------------------------------------------------------------------
     230   IF(fType == 0) CALL abort_gcm(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1)
     231   !---------------------------------------------------------------------------------------------------------------------------
     232   IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) THEN      !=== FOUND OLD STYLE INCA "traceur.def"
    230233   !---------------------------------------------------------------------------------------------------------------------------
    231234#ifdef INCA
     
    264267   ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
    265268   !---------------------------------------------------------------------------------------------------------------------------
    266       nqo    =        COUNT(delPhase(tracers(:)%name)     == 'H2O' &
    267                                .AND. tracers(:)%component == 'lmdz') !--- Number of water phases
    268       nqtrue = SIZE(tracers)                                         !--- Total number of "true" tracers
    269       nbtr   = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
    270                                .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
     269   nqtrue = SIZE(tracers)                                                                               !--- "true" tracers
     270   nqo    =      COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name)     == 'H2O')     !--- Water phases
     271   nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O')     !--- Passed to phytrac
     272   nqCO2  =      COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
    271273#ifdef INCA
    272       nqINCA = COUNT(tracers(:)%component == 'inca')
    273 #endif
    274       lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
    275       lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
     274   nqINCA =      COUNT(tracers(:)%component == 'inca')
     275#endif
     276   IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "hadv"', 1)
     277   IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_gcm(modname, 'missing key "vadv"', 1)
    276278   !---------------------------------------------------------------------------------------------------------------------------
    277279   END IF
     
    279281
    280282#ifdef REPROBUS
    281    !--- Transfert the number of tracers to Reprobus
    282283   CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
    283 
    284 #endif
     284#endif
     285
    285286!==============================================================================================================================
    286287! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
     
    332333      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
    333334
    334       !--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics
     335      !--- SET FIELDS longName, iadv, isAdvected, isInPhysics
    335336      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    336337      t1%iadv       = iad
    337338      t1%isAdvected = iad >= 0
    338       t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
    339                           .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
     339      t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O
    340340      ttr(iq)       = t1
    341341
     
    347347      ttr(jq+1:jq+nm)             = t1
    348348      ttr(jq+1:jq+nm)%name        = [ (TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
     349      ttr(jq+1:jq+nm)%gen0Name    = [ (TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
    349350      ttr(jq+1:jq+nm)%parent      = [ (TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
    350351      ttr(jq+1:jq+nm)%longName    = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
     
    356357   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    357358
    358    !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
     359   !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren
    359360   IF(indexUpdate(tracers)) CALL abort_gcm(modname, 'problem with tracers indices update', 1)
    360361
    361362   !=== TEST ADVECTION SCHEME
    362    DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv
     363   DO iq = 1, nqtot ; t1 => tracers(iq); iad = t1%iadv
    363364
    364365      !--- ONLY TESTED VALUES FOR TRACERS FOR NOW:               iadv = 14, 10 (and 0 for non-transported tracers)
     
    405406#endif
    406407   t => tracers
    407    CALL msg('Information stored in infotrac :', modname)
    408 
    409    IF(dispTable('isssssssssiiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',    &
    410                 'isPh', 'isAd', 'iadv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],   &
    411       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
    412                                                                                   bool2str(t%isAdvected)), &
     408   CALL msg('Information stored in '//TRIM(modname)//': ', modname)
     409   IF(dispTable('isssssssiiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
     410                              'iAdv', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
     411      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component),                         &
    413412      cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,  &
    414413                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
  • LMDZ6/branches/cirrus/libf/dyn3d_common/iso_verif_dyn.F

    r4325 r5203  
    6464        function iso_verif_aberrant_nostop
    6565     :           (x,iso,q,err_msg)
     66#ifdef CPP_IOIPSL
     67        USE IOIPSL, ONLY: getin
     68#else
     69        USE ioipsl_getincom, ONLY: getin
     70#endif
    6671        USE infotrac, ONLY: isoName, getKey
    6772        implicit none
     
    7782        parameter (qmin=1e-11)
    7883        parameter (deltaDmax=200.0,deltaDmin=-999.9)
     84        LOGICAL, SAVE :: ltnat1
     85        LOGICAL, SAVE :: lFirst=.TRUE.
    7986
    8087        ! output
    8188        integer iso_verif_aberrant_nostop
    8289
     90        IF(lFirst) THEN
     91           ltnat1 = .TRUE.; CALL getin('tnateq1', ltnat1)
     92           lFirst = .FALSE.
     93        END IF
    8394        iso_verif_aberrant_nostop=0
    8495
    8596        ! verifier que HDO est raisonable
    8697         if (q.gt.qmin) then
    87              IF(getKey('tnat', tnat, isoName(iso))) THEN
     98             IF(ltnat1) THEN
     99                tnat = 1.0
     100             ELSE IF(getKey('tnat', tnat, isoName(iso))) THEN
    88101                  err_msg = 'Missing isotopic parameter "tnat"'
    89102                  iso_verif_aberrant_nostop=1
Note: See TracChangeset for help on using the changeset viewer.