Ignore:
Timestamp:
Jul 28, 2025, 7:23:15 PM (7 days ago)
Author:
aborella
Message:

Merge with trunk r5789

Location:
LMDZ6/branches/contrails
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/contrails

  • LMDZ6/branches/contrails/libf/phylmd/infotrac_phy.F90

    r5790 r5791  
    33MODULE infotrac_phy
    44
    5    USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx
     5   USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, num2str, strStack, strParse, strCount, strIdx, maxTableWidth
    66   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers,  addPhase,  addKey, iH2O,  &
    77       isoSelect,  indexUpdate, isot_type, testTracersFiles, isotope,  delPhase,  getKey, tran0, &
    88       isoKeys, isoName, isoZone, isoPhas, processIsotopes,  isoCheck, itZonIso,  nbIso,         &
    9           niso,   ntiso,   nzone,   nphas,   maxTableWidth,  iqIsoPha, iqWIsoPha, ixIso, new2oldH2O
     9          niso,   ntiso,   nzone,   nphas, isoF=>isoFamilies,iqIsoPha, iqWIsoPha, ixIso, new2oldH2O
    1010   IMPLICIT NONE
    1111
    … …  
    1515   PUBLIC :: init_infotrac_phy                             !--- Initialization of the tracers
    1616   PUBLIC :: tracers, type_trac                            !--- Full tracers database, tracers type keyword
    17    PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
     17   PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr, nqtke       !--- Main dimensions
    1818   PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys
    1919   PUBLIC :: new2oldH2O                                    !--- For backwards compatibility in phyetat0
    … …  
    2424   !=== FOR ISOTOPES: General
    2525   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    26    PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
     26   PUBLIC :: isoSelect, ixIso, isoFamilies                 !--- Isotopes family selection tool + selected family index
    2727   !=== FOR ISOTOPES: Specific to water
    2828   PUBLIC :: iH2O                                          !--- Value of "ixIso" for "H2O" isotopes class
    29    PUBLIC :: ivap, iliq, isol, ibs, icf, iqvc, icfc, iqtc, inic
     29   PUBLIC :: ivap, iliq, isol, ibs, icf, iqvc, itke, icfc, iqtc, inic
    3030   !=== FOR ISOTOPES: Depending on the selected isotopes family
    3131   PUBLIC :: isotope                                       !--- Selected isotopes database (argument of getKey)
    … …  
    8484!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    8585!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
    86 !  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
     86!  | iso_iPhase  | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
    8787!  +-------------+------------------------------------------------------+-------------+------------------------+
    8888!
    … …  
    103103
    104104   !=== INDICES FOR WATER
    105    INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, iqvc, icfc, iqtc, inic
    106 !$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, iqvc, icfc, iqtc, inic)
    107 
    108    !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
     105   INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, iqvc, itke, icfc, iqtc, inic
     106!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, iqvc, itke, icfc, iqtc, inic)
     107
     108   !=== DIMENSIONS OF THE TRACERS TABLES, TRACERS TYPE(S)
    109109   INTEGER, SAVE :: nqtot                                       !--- Tracers nb in dynamics (incl. higher moments + H2O)
    110110   INTEGER, SAVE :: nbtr                                        !--- Tracers nb in physics  (excl. higher moments + H2O)
    … …  
    112112   INTEGER, SAVE :: nqtottr                                     !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    113113   INTEGER, SAVE :: nqCO2                                       !--- Number of tracers of CO2  (ThL)
     114   INTEGER, SAVE :: nqtke                                       !--- Number of TKE tracers
    114115   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
    115 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
     116!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, nqtke, type_trac)
    116117
    117118   !=== VARIABLES FOR INCA
    118119   INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:)        !--- Convection / boundary layer activation (nbtr)
    119120!$OMP THREADPRIVATE(conv_flg, pbl_flg)
     121
     122   !=== LIST OF DEFINED ISOTOPES FAMILIES
     123   CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: isoFamilies(:)   !--- Generation 0 tracer name for each isotopes family (nbIso)
     124!$OMP THREADPRIVATE(isoFamilies)
    120125
    121126  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
    … …  
    167172   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    168173   INTEGER :: iad                                                    !--- Advection scheme number
    169    INTEGER :: iq, jq, nt, im, nm                                     !--- Indexes and temporary variables
     174   INTEGER :: iq, jq, it, nt, im, nm                                 !--- Indexes and temporary variables
    170175   LOGICAL :: lerr, lInit
    171176   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    … …  
    253258       ((delPhase(tracers(:)%gen0Name)     == 'H2O') .OR. &    !--- Passed to phytrac
    254259        (delPhase(tracers(:)%gen0Name)     == 'CLDFRA')))
     260   nqtke  =      COUNT(tracers(:)%component == 'lmdz' .AND. tracers(:)%name               == 'TKE')     !--- TKE tracers
    255261   nqCO2  =      COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
    256262   IF(CPPKEY_INCA) &
    … …  
    275281   IF( nqtot /= nqtrue ) THEN
    276282      CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
    277       CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
    278       CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
     283      CALL msg('The number of true tracers is '//TRIM(num2str(nqtrue)))
     284      CALL msg('The total number of tracers needed is '//TRIM(num2str(nqtot)))
    279285   END IF
    280286
    … …  
    298304      IF(iad == -1) CALL abort_physic(modname, msg1, 1)
    299305
    300       !--- SET FIELDS longName, isInPhysics
     306      !--- SET FIELDS longName AND isInPhysics
    301307      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    302308      t1%isInPhysics= iad >= 0 .AND. (t1%component /= 'lmdz' .OR. &
    … …  
    318324      jq = jq + nm
    319325   END DO
     326
    320327   DEALLOCATE(hadv, vadv)
    321328   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    322329
    323    !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren, iGeneration
     330   !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren
    324331   IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1)
    325332
    326    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    327    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     333   !=== DETERMINE ISOTOPES RELATED PARAMETERS ; DEFINE THE EXPLICIT KEYS iso_i*
    328334   IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1)
     335   iH2O = -1
     336   IF(nbIso /= 0) THEN
     337      IF(isoSelect('H2O', .TRUE.)) THEN
     338         IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, "Can't select the first isotopes family", 1)
     339      ELSE
     340         iH2O = ixIso; CALL getin_p('ok_iso_verif', isotope%check)
     341      END IF
     342   END IF
    329343
    330344!##############################################################################################################################
    … …  
    332346!##############################################################################################################################
    333347   DO iq = 1, nqtrue
    334       t1 => tracers(iq)
    335348      IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
    336349      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
    337       tracers(iq)%isInPhysics= iad >= 0 .AND. (t1%component /= 'lmdz' .OR. &
    338                      ((delPhase(t1%gen0Name) /= 'H2O') .AND. &
    339                       (delPhase(t1%gen0Name) /= 'CLDFRA')))
     350      tracers(iq)%isInPhysics= iad >= 0 .AND. (tracers(iq)%component /= 'lmdz' .OR. &
     351                     ((delPhase(tracers(iq)%gen0Name) /= 'H2O') .AND. &
     352                      (delPhase(tracers(iq)%gen0Name) /= 'CLDFRA')))
    340353   END DO
    341 !##############################################################################################################################
    342    END IF
    343 !##############################################################################################################################
     354   tracers(nqtrue+1:nqtot)%isInPhysics = .FALSE.
     355!##############################################################################################################################
     356   END IF
     357!##############################################################################################################################
     358   isoFamilies = isoF(:)
     359
     360
    344361
    345362   !--- Convection / boundary layer activation for all tracers
    … …  
    374391   IF (iqtc.EQ.0) iqtc = strIdx(tracers(:)%name, addPhase('H2O', 'y'))
    375392   IF (inic.EQ.0) inic = strIdx(tracers(:)%name, addPhase('H2O', 'z'))
     393   !--- Compute indices for TKE when it is advected
     394   itke = strIdx(tracers(:)%name, 'TKE')
     395   IF (nqtke .GE. 1) THEN
     396       !--- For TKE, we force isInPhysics=.False.
     397       tracers(itke)%isInPhysics = .FALSE.
     398   ENDIF
    376399
    377400   IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN
    … …  
    388411   !=== DISPLAY THE RESULTS
    389412   IF(.NOT.is_master) RETURN
    390    CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    391    CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    392    CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    393    CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    394    CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    395    CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    396    CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname, CPPKEY_INCA)
    397    CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA)
     413   CALL msg('nqo    = '//TRIM(num2str(nqo)),    modname)
     414   CALL msg('nbtr   = '//TRIM(num2str(nbtr)),   modname)
     415   CALL msg('nqtrue = '//TRIM(num2str(nqtrue)), modname)
     416   CALL msg('nqtot  = '//TRIM(num2str(nqtot)),  modname)
     417   CALL msg('niso   = '//TRIM(num2str(niso)),   modname)
     418   CALL msg('ntiso  = '//TRIM(num2str(ntiso)),  modname)
     419   CALL msg('nqtke  = '//TRIM(num2str(nqtke)),  modname)
     420   CALL msg('nqCO2  = '//TRIM(num2str(nqCO2)),  modname, CPPKEY_INCA)
     421   CALL msg('nqINCA = '//TRIM(num2str(nqINCA)), modname, CPPKEY_INCA)
    398422   t => tracers
    399423   CALL msg('Information stored in '//TRIM(modname)//': ', modname)
    400424   IF(dispTable('issssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
    401425                              'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
    402       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
     426      cat(t%name, t%longName,  t%gen0Name, t%parent, t%type, t%phase, t%component, num2str(t%isInPhysics)),&
    403427      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
    404428                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    … …  
    406430   CALL msg('No isotopes identified.', modname, nbIso == 0)
    407431   IF(nbIso == 0) RETURN
    408    CALL msg('For isotopes family "H2O":', modname)
    409    CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    410    CALL msg('  isoName = '//strStack(isoName),      modname)
    411    CALL msg('  isoZone = '//strStack(isoZone),      modname)
    412    CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
     432   DO it = 1, nbIso
     433      IF(isoSelect(it, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1)
     434      CALL msg('For isotopes family "'//TRIM(isoFamilies(it))//'":', modname)
     435      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
     436      CALL msg('  isoName = '//strStack(isoName), modname)
     437      CALL msg('  isoZone = '//strStack(isoZone), modname)
     438      CALL msg('  isoPhas = '//TRIM(isoPhas),     modname)
     439   END DO
     440   IF(isoSelect(iH2O, .TRUE.)) lerr = isoSelect(1, .TRUE.)
    413441
    414442   IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN
    415       CALL msg('nbtr_bin       ='//TRIM(int2str(nbtr_bin      )), modname)
    416       CALL msg('nbtr_sulgas    ='//TRIM(int2str(nbtr_sulgas   )), modname)
    417       CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
    418       CALL msg('id_OCS_strat   ='//TRIM(int2str(id_OCS_strat  )), modname)
    419       CALL msg('id_SO2_strat   ='//TRIM(int2str(id_SO2_strat  )), modname)
    420       CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
    421       CALL msg('id_TEST_strat  ='//TRIM(int2str(id_TEST_strat )), modname)
     443      CALL msg('nbtr_bin       ='//TRIM(num2str(nbtr_bin      )), modname)
     444      CALL msg('nbtr_sulgas    ='//TRIM(num2str(nbtr_sulgas   )), modname)
     445      CALL msg('id_BIN01_strat ='//TRIM(num2str(id_BIN01_strat)), modname)
     446      CALL msg('id_OCS_strat   ='//TRIM(num2str(id_OCS_strat  )), modname)
     447      CALL msg('id_SO2_strat   ='//TRIM(num2str(id_SO2_strat  )), modname)
     448      CALL msg('id_H2SO4_strat ='//TRIM(num2str(id_H2SO4_strat)), modname)
     449      CALL msg('id_TEST_strat  ='//TRIM(num2str(id_TEST_strat )), modname)
    422450   END IF
    423451
Note: See TracChangeset for help on using the changeset viewer.