Ignore:
Timestamp:
Oct 13, 2024, 8:10:20 PM (4 days ago)
Author:
dcugnet
Message:

Cancel revisions 5216 and 5234

File:
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/infotrac_phy.F90

    r5234 r5237  
    33MODULE infotrac_phy
    44
    5    USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx
    6    USE readTracFiles_mod, ONLY: readTracersFiles, maxTableWidth, isot_type, addPhase, addKey, iH2O, &
    7         indexUpdate, trac_type, testTracersFiles, processIsotopes, tracers, delPhase, getKey, tran0, &
    8         isoKeys, isoName, isoZone, isoPhas, isoSelect, itZonIso, nbIso, isotope, & 
    9            niso,   ntiso,   nzone,   nphas, iqWIsoPha, iqIsoPha, ixIso, isoCheck
     5   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
     6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &
     7        delPhase, niso, getKey, isot_type, processIsotopes,  isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
     8        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,  iqWIsoPha, nbIso, ntiso, isoName, isoCheck
    109   USE readTracFiles_mod, ONLY: new2oldH2O
    1110   IMPLICIT NONE
    … …  
    136135SUBROUTINE init_infotrac_phy
    137136   USE ioipsl_getin_p_mod, ONLY: getin_p
    138    USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master
    139137#ifdef REPROBUS
    140138   USE CHEM_REP, ONLY: Init_chem_rep_trac
    … …  
    198196
    199197   CALL getin_p('type_trac',type_trac)
    200    CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master)
    201    IF(strCount(type_trac, '|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "|"', 1)
    202    IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
    203    IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1)
    204    IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON
     198
     199   lerr=strParse(type_trac, '|', types_trac, n=nt)
     200   IF (nt .GT. 1) THEN
     201      IF (nt .GT. 2) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
     202      IF (nt .EQ. 2) type_trac=types_trac(2)
     203   ENDIF
    205204
    206205   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
    … …  
    208207
    209208!##############################################################################################################################
    210    IF(lInit .AND. is_master) THEN                                    !=== SKIPED IF ALREADY DONE
     209   IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
    211210!##############################################################################################################################
    212211   !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
    … …  
    241240!##############################################################################################################################
    242241
     242   nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
     243
    243244!==============================================================================================================================
    244245! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT
    … …  
    247248   IF(texp == 'inco') texp = 'co2i|inca'
    248249   IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp)
    249    IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
     250   IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    250251   ttp = type_trac; IF(fType /= 1) ttp = texp
     252
     253!##############################################################################################################################
     254   IF(lInit) THEN
     255      IF(readTracersFiles(ttp, lRepr=type_trac=='repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
     256   ELSE
     257      CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
     258   END IF
     259!##############################################################################################################################
     260
     261!==============================================================================================================================
     262! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
     263!==============================================================================================================================
    251264   !---------------------------------------------------------------------------------------------------------------------------
    252265   IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1)
    253266   !---------------------------------------------------------------------------------------------------------------------------
    254    IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) &                   !=== FOUND OLD STYLE INCA "traceur.def"
    255       CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1)
    256    !---------------------------------------------------------------------------------------------------------------------------
    257 
    258 !##############################################################################################################################
    259    IF(lInit) THEN
    260       IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
    261    END IF
    262    CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master)
    263 !##############################################################################################################################
    264 
    265 !==============================================================================================================================
    266 ! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
    267 !==============================================================================================================================
     267   IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac) .AND. lInit) THEN  !=== FOUND OLD STYLE INCA "traceur.def"
     268   !---------------------------------------------------------------------------------------------------------------------------
     269#ifdef INCA
     270      nqo = SIZE(tracers) - nqCO2
     271      CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
     272      nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
     273      nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
     274      IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
     275      ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
     276      ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
     277      CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
     278      ALLOCATE(ttr(nqtrue))
     279      ttr(1:nqo+nqCO2)                  = tracers
     280      ttr(1    :      nqo   )%component = 'lmdz'
     281      ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'
     282      ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
     283      ttr(1+nqo      :nqtrue)%name      = [('CO2     ', iq=1, nqCO2), solsym_inca]
     284      ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0
     285      ttr(1+nqo+nqCO2:nqtrue)%phase     = 'g'
     286      lerr = getKey('hadv', had, ky=tracers(:)%keys)
     287      lerr = getKey('vadv', vad, ky=tracers(:)%keys)
     288      hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
     289      vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
     290      CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
     291      DO iq = 1, nqtrue
     292         t1 => tracers(iq)
     293         CALL addKey('name',      t1%name,      t1%keys)
     294         CALL addKey('component', t1%component, t1%keys)
     295         CALL addKey('parent',    t1%parent,    t1%keys)
     296         CALL addKey('phase',     t1%phase,     t1%keys)
     297      END DO
     298      IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name
     299      DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
     300#endif
     301   !---------------------------------------------------------------------------------------------------------------------------
     302   ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
     303   !---------------------------------------------------------------------------------------------------------------------------
    268304   nqtrue = SIZE(tracers)                                                                               !--- "true" tracers
    269305   nqo    =      COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name)     == 'H2O')     !--- Water phases
    … …  
    273309   nqINCA =      COUNT(tracers(:)%component == 'inca')
    274310#endif
     311   IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1)
     312   IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1)
     313   !---------------------------------------------------------------------------------------------------------------------------
     314   END IF
     315   !---------------------------------------------------------------------------------------------------------------------------
     316
    275317#ifdef REPROBUS
    276318   CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)                         !--- Transfert the number of tracers to Reprobus
    … …  
    284326! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
    285327!==============================================================================================================================
    286    IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1)
    287    IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1)
    288328   DO iq = 1, nqtrue
    289329      IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
    … …  
    371411      CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
    372412
     413   !=== DISPLAY THE RESULTS
     414   CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     415   CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     416   CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     417   CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     418   CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     419   CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     420#ifdef INCA
     421   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
     422   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
     423#endif
     424   t => tracers
     425   CALL msg('Information stored in '//TRIM(modname)//': ', modname)
     426   IF(dispTable('isssssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',     &
     427                       'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],    &
     428      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component,                          &
     429                                                         bool2str(t%isInPhysics), bool2str(t%isAdvected)), &
     430      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
     431                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
     432      CALL abort_physic(modname, "problem with the tracers table content", 1)
     433   IF(niso > 0) THEN
     434      CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', 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   ELSE
     440      CALL msg('No isotopes identified.', modname)
     441   END IF
     442
     443#ifdef ISOVERIF
     444   CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
     445#endif
    373446#ifdef CPP_StratAer
    374447   IF (type_trac == 'coag') THEN
    … …  
    381454      id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
    382455      id_TEST_strat  = strIdx(tnames, 'GASTEST' )
    383    END IF
    384 #endif
    385 
    386    !=== DISPLAY THE RESULTS
    387    IF(.NOT.is_master) RETURN
    388    CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    389    CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    390    CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    391    CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    392    CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    393    CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    394 #ifdef INCA
    395    CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    396    CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    397 #endif
    398    t => tracers
    399    CALL msg('Information stored in '//TRIM(modname)//': ', modname)
    400    IF(dispTable('isssssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',     &
    401                        'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],    &
    402       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component,                          &
    403                                                          bool2str(t%isInPhysics), bool2str(t%isAdvected)), &
    404       cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
    405                   t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    406       CALL abort_physic(modname, "problem with the tracers table content", 1)
    407    CALL msg('No isotopes identified.', modname, nbIso == 0)
    408    IF(nbIso == 0) RETURN
    409       CALL msg('For isotopes family "H2O":', modname)
    410       CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    411       CALL msg('  isoName = '//strStack(isoName),  modname)
    412       CALL msg('  isoZone = '//strStack(isoZone),  modname)
    413       CALL msg('  isoPhas = '//    TRIM(isoPhas),  modname)
    414 
    415 #ifdef ISOVERIF
    416    CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
    417 #endif
    418 #ifdef CPP_StratAer
    419    IF (type_trac == 'coag') THEN
    420456      CALL msg('nbtr_bin       ='//TRIM(int2str(nbtr_bin      )), modname)
    421457      CALL msg('nbtr_sulgas    ='//TRIM(int2str(nbtr_sulgas   )), modname)
    … …  
    427463   END IF
    428464#endif
     465   CALL msg('end', modname)
    429466
    430467END SUBROUTINE init_infotrac_phy
Note: See TracChangeset for help on using the changeset viewer.