Changeset 5756 for LMDZ6/trunk


Ignore:
Timestamp:
Jul 3, 2025, 3:25:59 PM (3 days ago)
Author:
dcugnet
Message:

Add "isoFamilies", the list of defined isotopes families (==H2O? for now).

Location:
LMDZ6/trunk/libf
Files:
4 edited

Legend:

Unmodified
Added
Removed

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

    r5748 r5756  
    33MODULE infotrac
    44
    5    USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, num2str,  strStack, strParse, strCount, strIdx
    6    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers,  addPhase,  addKey, iH2O,  &
    7        isoSelect,  indexUpdate, isot_type, testTracersFiles, isotope,  delPhase,  getKey, tran0, &
    8        isoKeys, isoName, isoZone, isoPhas, processIsotopes,  isoCheck, itZonIso,  nbIso,         &
    9           niso,   ntiso,   nzone,   nphas,   maxTableWidth,  iqIsoPha, iqWIsoPha, ixIso, new2oldH2O, newHNO3, oldHNO3
     5   USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, num2str, strStack, strParse, strCount, strIdx, maxTableWidth
     6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers,  addPhase,  addKey, iH2O,    &
     7       isoSelect,  indexUpdate, isot_type, testTracersFiles, isotope,  delPhase,  getKey, tran0,   &
     8       isoKeys, isoName, isoZone, isoPhas, processIsotopes,  isoCheck, itZonIso,  nbIso, newHNO3,  &
     9          niso,   ntiso,   nzone,   nphas, isoF=>isoFamilies,iqIsoPha, iqWIsoPha, ixIso, oldHNO3, new2oldH2O
    1010   IMPLICIT NONE
    1111
    … …  
    2222   !=== FOR ISOTOPES: General
    2323   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    24    PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
     24   PUBLIC :: isoSelect, ixIso, isoFamilies                 !--- Isotopes families selection tool + selected family index
    2525   !=== FOR ISOTOPES: Specific to water
    2626   PUBLIC :: iH2O                                          !--- Value of "ixIso" for "H2O" isotopes class
    … …  
    8181!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    8282!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
    83 !  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
     83!  | iso_iPhase  | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
    8484!  +-------------+------------------------------------------------------+-------------+------------------------+
    8585!
    … …  
    9898!  +-----------------+--------------------------------------------------+--------------------+-----------------+
    9999
     100   !=== THRESHOLDS FOR WATER
    100101   REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
    101102
    102    !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
     103   !=== DIMENSIONS OF THE TRACERS TABLES, TRACERS TYPE(S)
    103104   INTEGER, SAVE :: nqtot                                       !--- Tracers nb in dynamics (incl. higher moments + H2O)
    104105   INTEGER, SAVE :: nbtr                                        !--- Tracers nb in physics  (excl. higher moments + H2O)
    … …  
    111112   INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:)        !--- Convection / boundary layer activation (nbtr)
    112113
     114   !=== LIST OF DEFINED ISOTOPES FAMILIES
     115   CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: isoFamilies(:)   !--- Generation 0 tracer name for each isotopes family (nbIso)
     116
    113117CONTAINS
    114118
    … …  
    116120   USE iniprint_mod_h
    117121   USE control_mod, ONLY: planet_type
     122   USE ioipsl, ONLY: getin
    118123   USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac
    119124   USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER
    120125   USE dimensions_mod, ONLY: iim, jjm, llm, ndm
    121 IMPLICIT NONE
     126   IMPLICIT NONE
    122127!==============================================================================================================================
    123128!
    … …  
    152157   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    153158   INTEGER :: iad                                                    !--- Advection scheme number
    154    INTEGER :: iq, jq, nt, im, nm, ig                                 !--- Indexes and temporary variables
     159   INTEGER :: iq, jq, it, nt, im, nm, ig                             !--- Indexes and temporary variables
    155160   LOGICAL :: lerr
    156161   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    … …  
    284289      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
    285290
    286       !--- SET FIELDS longName and iadv
     291      !--- SET FIELDS longName AND iadv
    287292      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    288293      t1%iadv       = iad
    … …  
    329334   END DO
    330335
    331    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
    332    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     336   !=== DETERMINE ISOTOPES RELATED PARAMETERS ; DEFINE THE EXPLICIT KEYS iso_i*
    333337   IF(processIsotopes()) CALL abort_gcm(modname, 'problem when processing isotopes parameters', 1)
     338   iH2O = -1
     339   IF(nbIso /= 0) THEN
     340      IF(isoSelect('H2O', .TRUE.)) THEN
     341         IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, "Can't select the first isotopes family", 1)
     342      ELSE
     343         iH2O = ixIso; CALL getin('ok_iso_verif', isotope%check)
     344      END IF
     345   END IF
     346   isoFamilies = isoF(:)
    334347
    335348   !--- Convection / boundary layer activation for all tracers
    … …  
    362375   CALL msg('No isotopes identified.', modname, nbIso == 0)
    363376   IF(nbIso == 0) RETURN
    364    CALL msg('For isotopes family "H2O":', modname)
    365    CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    366    CALL msg('  isoName = '//strStack(isoName),      modname)
    367    CALL msg('  isoZone = '//strStack(isoZone),      modname)
    368    CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
     377   DO it = 1, nbIso
     378      IF(isoSelect(it, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1)
     379      CALL msg('For isotopes family "'//TRIM(isoFamilies(it))//'":', modname)
     380      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
     381      CALL msg('  isoName = '//strStack(isoName), modname)
     382      CALL msg('  isoZone = '//strStack(isoZone), modname)
     383      CALL msg('  isoPhas = '//TRIM(isoPhas),     modname)
     384   END DO
     385   IF(isoSelect(iH2O, .TRUE.)) lerr = isoSelect(1, .TRUE.)
    369386
    370387END SUBROUTINE init_infotrac

  • LMDZ6/trunk/libf/misc/readTracFiles_mod.f90

    r5755 r5756  
    22
    33  USE ioipsl_getin_p_mod, ONLY : getin_p
    4   USE strings_mod,    ONLY: msg, find, dispTable, strHead,  strReduce,  strFind, strStack, strIdx, &
    5              removeComment, cat,       maxlen, checkList, strParse, strReplace, strTail, strCount, reduceExpr, &
    6              num2str, str2int, str2real, str2bool
     4  USE strings_mod, ONLY: msg, strIdx, dispTable, strHead,  strReduce,  strFind, strStack, removeComment, num2str, str2real, &
     5       reduceExpr, find, cat, maxlen, checkList, strParse, strReplace, strTail, strCount, maxTableWidth, str2int, str2bool
    76
    87  IMPLICIT NONE
    … …  
    1514  PUBLIC :: getKeysDBase, setKeysDBase                          !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
    1615  PUBLIC :: addTracer, delTracer                                !--- ADD/REMOVE A TRACER FROM
    17   PUBLIC :: addKey,    delKey,    getKey,    keys_type          !--- TOOLS TO SET/DEL/GET KEYS FROM/TO  tracers & isotopes
    18   PUBLIC :: addPhase,  delPhase,  getPhase,  getiPhase,  &      !--- FUNCTIONS RELATED TO THE PHASES
    19    nphases, old_phases, phases_sep, known_phases, phases_names  !--- + ASSOCIATED VARIABLES
     16  PUBLIC :: addKey,    delKey,    getKey,    keys_type          !--- TOOLS TO SET/DEL/GET A KEY   FROM/TO "tracers" / "isotopes"
     17  PUBLIC :: addPhase,  delPhase,  getPhase,  getiPhase          !--- TOOLS TO SET/DEL/GET A PHASE FROM/TO A TRACER'S NAME
     18  PUBLIC ::   old_phases, phases_sep, nphases                   !--- VARIABLES RELATED TO THE PHASES
     19  PUBLIC :: known_phases, phases_names
    2020
    2121  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
    … …  
    2525
    2626  !=== FOR ISOTOPES: GENERAL
    27   PUBLIC :: isot_type, processIsotopes, isoSelect, ixIso, nbIso !--- PROCESS [AND READ] & SELECT ISOTOPES + CLASS IDX & NUMBER
     27  PUBLIC :: isot_type, processIsotopes, isoSelect, isoFamilies  !--- ISOTOPES: TYPE, PROCESSING/SELECTION ROUTINES, FAMILIES NAMES
     28  PUBLIC :: ixIso, nbIso                                        !--- CURRENTLY SELECTED ISOTOPES FAMILY INDEX, NUMBER OF FAMILIES
    2829
    2930  !=== FOR ISOTOPES: H2O FAMILY ONLY
    3031  PUBLIC :: iH2O
    3132
    32   !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
     33  !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES FAMILY
    3334  PUBLIC :: isotope, isoKeys                                    !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
    3435  PUBLIC :: isoName, isoZone, isoPhas                           !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
    … …  
    3940  PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
    4041
    41   PUBLIC :: maxTableWidth
    4242!------------------------------------------------------------------------------------------------------------------------------
    4343  TYPE :: keys_type                                             !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
    … …  
    142142  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
    143143
     144  !--- NAMES OF THE ISOTOPES FAMILIES
     145  CHARACTER(LEN=maxlen),   SAVE, ALLOCATABLE :: isoFamilies(:)
     146
    144147  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
    145148  TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
    146   INTEGER,                 SAVE          :: ixIso, iH2O=0       !--- Index of the selected isotopes family and H2O family
    147   INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
    148   LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
     149  INTEGER,                 SAVE          :: ixIso, iH2O=-1      !--- INDEX OF THE SELECTED ISOTOPES FAMILY, H2O FAMILY INDEX
     150  INTEGER,                 SAVE          :: nbIso               !--- NUMBER OF ISOTOPES FAMILIES
     151  LOGICAL,                 SAVE          :: isoCheck            !--- FLAG TO TRIGGER THE CHECKING ROUTINES
    149152  TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    150153  CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
    … …  
    161164  LOGICAL, PARAMETER :: lSortByGen  = .TRUE.                    !--- Sort by growing generation
    162165
    163   INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
    164166  CHARACTER(LEN=maxlen) :: modname
    165167
    … …  
    793795! Purpose: Sort tracers:
    794796!  * Put water at the beginning of the vector, in the "known_phases" order.
    795 !  * lGrowGen == T: in ascending generations numbers.
    796 !  * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
     797!  * lSortByGen == T: in ascending generations numbers.
     798!  * lSortByGen == F: tracer + its children sorted by growing generation, one after the other.
    797799!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    798800!------------------------------------------------------------------------------------------------------------------------------
    … …  
    11001102!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%parent":   ====
    11011103!===  * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%parent"  ====
    1102 !===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
     1104!===  * For each isotopes family, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"       ====
    11031105!=== NOTES:                                                                                                                ====
    11041106!===  * Most of the "isot" components have been defined in the calling routine (processIsotopes):                          ====
    … …  
    11251127  CALL msg('Missing isotopes parameters file "'//TRIM(fnam)//'"', modname, lerr); IF(lerr) RETURN
    11261128
    1127   !--- READ THE FILE SECTIONS, ONE EACH PARENT TRACER
     1129  !--- READ THE FILE SECTIONS, ONE EACH ISOTOPES FAMILY
    11281130  nb0 = SIZE(dBase, DIM=1)+1                                         !--- Next database element index
    1129   lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each parent tracer
     1131  lerr = readSections(fnam,strStack(isot(:)%parent,'|')); IF(lerr) RETURN !--- Read sections, one each isotopes family
    11301132  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
    11311133  DO idb = nb0, ndb
    … …  
    11631165  END IF
    11641166
    1165   !--- GET THE isoCheck ENTRY FROM THE *.DEF FILES (MIGHT BE CHANGED TO A CLASS-DEPENDANT KEYWORD)
    1166   CALL getin_p('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
    1167 
    11681167  lerr = dispIsotopes()
    11691168
    … …  
    11761175  CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
    11771176  CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
    1178   DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
     1177  DO ip = 1, SIZE(isot)                                              !--- Loop on isotopes families
    11791178    nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
    11801179    nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
    … …  
    12301229  lerr = getKey('iGeneration', iGen, t%keys); IF(lerr) RETURN       !--- Generation number
    12311230
    1232   !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
     1231  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES FAMILIES
    12331232  p = PACK(delPhase(parent), MASK = dType=='tracer' .AND. iGen==1)
    12341233  CALL strReduce(p, nbIso)
    12351234
    1236   !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
     1235  !--- CHECK WHETHER NEEDED ISOTOPES FAMILIES "iNames" ARE AVAILABLE OR NOT
    12371236  IF(PRESENT(iNames)) THEN
    12381237    DO it = 1, SIZE(iNames)
    12391238      lerr = ALL(p /= iNames(it))
    1240       CALL msg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN
     1239      CALL msg('No isotopes family "'//TRIM(iNames(it))//'" found among tracers', modname, lerr); IF(lerr) RETURN
    12411240    END DO
    12421241    p = iNames; nbIso = SIZE(p)
    12431242  END IF
    12441243  IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
    1245   ALLOCATE(isotopes(nbIso))
     1244  ALLOCATE(isotopes(nbIso), isoFamilies(nbIso))
    12461245
    12471246  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
    … …  
    12491248  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
    12501249  isotopes(:)%parent = p
    1251   DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
     1250  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes families
    12521251    i => isotopes(ic)
    1253     iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
     1252    iname = i%parent                                                 !--- Current isotopes family name (parent tracer name)
    12541253
    12551254    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
    … …  
    13151314  !=== SELECT WATER ISOTOPES CLASS OR, IF UNFOUND, THE FIRST ISOTOPES CLASS
    13161315  IF(.NOT.isoSelect('H2O', .TRUE.)) THEN; iH2O = ixIso; ELSE; lerr = isoSelect(1, .TRUE.); END IF
     1316
     1317  !=== COLLECT THE NAMES OF THE ISOTOPES FAMILIES
     1318  isoFamilies = isotopes(:)%parent
    13171319
    13181320CONTAINS
    … …  
    13481350!==============================================================================================================================
    13491351!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
    1350 !     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
     1352!     Single generic "isoSelect" routine, using the predefined index of the family (fast version) or its name (first call).
    13511353!==============================================================================================================================
    13521354LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
    … …  
    15401542!  IF(jd == 0) RETURN
    15411543!  DO ik = 1, SIZE(t(jd)%keys%key)
    1542 !    CALL get_in(t(jd)%keys%key(ik), val, '*none*')
     1544!    CALL getin_p(t(jd)%keys%key(ik), val, '*none*')
    15431545!    IF(val /= '*none*') CALL addKey(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
    15441546!  END DO

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

    r5748 r5756  
    33MODULE infotrac_phy
    44
    5    USE       strings_mod, ONLY: msg, maxlen, cat, dispTable, num2str, 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
    … …  
    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
    … …  
    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!
    … …  
    106106!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc)
    107107
    108    !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
     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)
    … …  
    118118   INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:)        !--- Convection / boundary layer activation (nbtr)
    119119!$OMP THREADPRIVATE(conv_flg, pbl_flg)
     120
     121   !=== LIST OF DEFINED ISOTOPES FAMILIES
     122   CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: isoFamilies(:)   !--- Generation 0 tracer name for each isotopes family (nbIso)
     123!$OMP THREADPRIVATE(isoFamilies)
    120124
    121125  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
    … …  
    167171   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    168172   INTEGER :: iad                                                    !--- Advection scheme number
    169    INTEGER :: iq, jq, nt, im, nm                                     !--- Indexes and temporary variables
     173   INTEGER :: iq, jq, it, nt, im, nm                                 !--- Indexes and temporary variables
    170174   LOGICAL :: lerr, lInit
    171175   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    … …  
    294298      IF(iad == -1) CALL abort_physic(modname, msg1, 1)
    295299
    296       !--- SET FIELDS longName, isInPhysics
     300      !--- SET FIELDS longName AND isInPhysics
    297301      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
    298302      t1%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz')
    … …  
    315319   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    316320
    317    !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren, iGeneration
     321   !--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren
    318322   IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1)
    319323
    320    !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
    321    niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     324   !=== DETERMINE ISOTOPES RELATED PARAMETERS ; DEFINE THE EXPLICIT KEYS iso_i*
    322325   IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1)
     326   iH2O = -1
     327   IF(nbIso /= 0) THEN
     328      IF(isoSelect('H2O', .TRUE.)) THEN
     329         IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, "Can't select the first isotopes family", 1)
     330      ELSE
     331         iH2O = ixIso; CALL getin_p('ok_iso_verif', isotope%check)
     332      END IF
     333   END IF
    323334
    324335!##############################################################################################################################
    … …  
    326337!##############################################################################################################################
    327338   DO iq = 1, nqtrue
    328       t1 => tracers(iq)
    329339      IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
    330340      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
    331       tracers(iq)%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz')
     341      tracers(iq)%isInPhysics= iad >= 0 .AND. (delPhase(tracers(iq)%gen0Name) /= 'H2O' .OR. tracers(iq)%component /= 'lmdz')
    332342   END DO
    333 !##############################################################################################################################
    334    END IF
    335 !##############################################################################################################################
     343   tracers(nqtrue+1:nqtot)%isInPhysics = .FALSE.
     344!##############################################################################################################################
     345   END IF
     346!##############################################################################################################################
     347   isoFamilies = isoF(:)
    336348
    337349   !--- Convection / boundary layer activation for all tracers
    … …  
    377389   IF(dispTable('issssssssiiiiiiii', ['iq  ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp',      &
    378390                              'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'],     &
    379       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, num2str(t%isInPhysics)), &
     391      cat(t%name, t%longName,  t%gen0Name, t%parent, t%type, t%phase, t%component, num2str(t%isInPhysics)),&
    380392      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
    381393                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    … …  
    383395   CALL msg('No isotopes identified.', modname, nbIso == 0)
    384396   IF(nbIso == 0) RETURN
    385    CALL msg('For isotopes family "H2O":', modname)
    386    CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    387    CALL msg('  isoName = '//strStack(isoName),      modname)
    388    CALL msg('  isoZone = '//strStack(isoZone),      modname)
    389    CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
     397   DO it = 1, nbIso
     398      IF(isoSelect(it, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1)
     399      CALL msg('For isotopes family "'//TRIM(isoFamilies(it))//'":', modname)
     400      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
     401      CALL msg('  isoName = '//strStack(isoName), modname)
     402      CALL msg('  isoZone = '//strStack(isoZone), modname)
     403      CALL msg('  isoPhas = '//TRIM(isoPhas),     modname)
     404   END DO
     405   IF(isoSelect(iH2O, .TRUE.)) lerr = isoSelect(1, .TRUE.)
    390406
    391407   IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN

  • LMDZ6/trunk/libf/phylmdiso/isotopes_mod.F90

    r5754 r5756  
    44MODULE isotopes_mod
    55   USE strings_mod,  ONLY: msg, num2str, maxlen, strIdx, strStack
    6    USE infotrac_phy, ONLY: isoName, niso, ntiso
     6   USE infotrac_phy, ONLY: isoName, niso, ntiso, nbIso, isoFamilies, isoSelect, isoCheck
    77   USE iso_params_mod
    88   USE ioipsl_getin_p_mod, ONLY : getin_p
    … …  
    150150
    151151   !=== Local variables:
    152    INTEGER :: ixt, is
     152   INTEGER :: ixt, is, ii
    153153   LOGICAL :: ltnat1
    154154   CHARACTER(LEN=maxlen) :: modname, sxt
    … …  
    175175   CALL msg('64: niso = '//TRIM(num2str(niso)), modname)
    176176
     177   DO ii = 1, nbIso
     178      CALL msg('Can''t select isotopes class "'//TRIM(isoFamilies(ii))//'"', modname, isoSelect(ii, lVerbose=.TRUE.))
     179
     180!==============================================================================================================================
     181      IF(isoFamilies(ii) == 'H2O') THEN
     182!==============================================================================================================================
    177183         !--- Init de ntracisoOR: on ecrasera en cas de traceurs de tagging isotopiques
    178184         !                     (nzone>0) si complications avec ORCHIDEE
    … …  
    203209         CALL getin_p( 'sstlatcrit',    sstlatcrit,     30.0)     !--- For modif_sst>=3
    204210         CALL getin_p('dsstlatcrit',   dsstlatcrit,      0.0)     !--- For modif_sst>=3
    205 #ifdef ISOVERIF
     211         IF(isoCheck) THEN
    206212         CALL msg('iso_init 270:  sstlatcrit='//num2str( sstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=2
    207213         CALL msg('iso_init 279: dsstlatcrit='//num2str(dsstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=3
    208214         IF(modif_sst >= 2 .AND. sstlatcrit < 0.0) STOP
    209 #endif             
    210 
     215         END IF
    211216         CALL getin_p('modif_sic', modif_sic,  0)
    212217         IF(modif_sic >= 1) &
    … …  
    238243         CALL getin_p('A_satlim', A_satlim, 1.0)
    239244         CALL getin_p('ok_restrict_A_satlim', ok_restrict_A_satlim, 0)
    240 #ifdef ISOVERIF
     245         IF(isoCheck) THEN
    241246         CALL msg(' 315: A_satlim='//TRIM(num2str(A_satlim)), modname, A_satlim > 1.0)
    242247         IF(A_satlim > 1.0) STOP
    243 #endif
     248         END IF
    244249!        CALL getin_p('slope_limiterxy',   slope_limiterxy,  2.0)
    245250!        CALL getin_p('slope_limiterz',    slope_limiterz,   2.0)
    … …  
    374379         CALL msg('69: h_land_ice = '//TRIM(num2str(h_land_ice)),    modname)
    375380         CALL msg('69:      P_veg = '//TRIM(num2str(P_veg)),         modname)
     381!==============================================================================================================================
     382      ELSE
     383!==============================================================================================================================
     384         CALL abort_physic('"isotopes_mod" is not set up yet for isotopes family "'//TRIM(isoFamilies(ii))//'"', modname, 1)
     385!==============================================================================================================================
     386      END IF
     387!==============================================================================================================================
     388   END DO
    376389
    377390END SUBROUTINE iso_init
    378 
    379 
    380 SUBROUTINE getinp_s(nam, val, def, lDisp)
    381    USE ioipsl, ONLY: getin
    382    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    383    USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
    384    USE mod_phys_lmdz_transfert_para, ONLY : bcast
    385    CHARACTER(LEN=*),           INTENT(IN)    :: nam
    386    CHARACTER(LEN=*),           INTENT(INOUT) :: val
    387    CHARACTER(LEN=*), OPTIONAL, INTENT(IN)    :: def
    388    LOGICAL,          OPTIONAL, INTENT(IN)    :: lDisp
    389    LOGICAL :: lD
    390 !$OMP BARRIER
    391    IF(is_mpi_root.AND.is_omp_root) THEN
    392       IF(PRESENT(def)) val=def; CALL getin(nam,val)
    393       lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    394       IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
    395   END IF
    396   CALL bcast(val)
    397 END SUBROUTINE getinp_s
    398 
    399 SUBROUTINE getinp_i(nam, val, def, lDisp)
    400    USE ioipsl, ONLY: getin
    401    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    402    USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
    403    USE mod_phys_lmdz_transfert_para, ONLY : bcast
    404    CHARACTER(LEN=*),  INTENT(IN)    :: nam
    405    INTEGER,           INTENT(INOUT) :: val
    406    INTEGER, OPTIONAL, INTENT(IN)    :: def
    407    LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
    408    LOGICAL :: lD
    409 !$OMP BARRIER
    410    IF(is_mpi_root.AND.is_omp_root) THEN
    411       IF(PRESENT(def)) val=def; CALL getin(nam,val)
    412       lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    413       IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(num2str(val)))
    414   END IF
    415   CALL bcast(val)
    416 END SUBROUTINE getinp_i
    417 
    418 SUBROUTINE getinp_r(nam, val, def, lDisp)
    419    USE ioipsl, ONLY: getin
    420    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    421    USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
    422    USE mod_phys_lmdz_transfert_para, ONLY : bcast
    423    CHARACTER(LEN=*),  INTENT(IN)    :: nam
    424    REAL,              INTENT(INOUT) :: val
    425    REAL,    OPTIONAL, INTENT(IN)    :: def
    426    LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
    427    LOGICAL :: lD
    428 !$OMP BARRIER
    429    IF(is_mpi_root.AND.is_omp_root) THEN
    430       IF(PRESENT(def)) val=def; CALL getin(nam,val)
    431       lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    432       IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(num2str(val)))
    433   END IF
    434   CALL bcast(val)
    435 END SUBROUTINE getinp_r
    436 
    437 SUBROUTINE getinp_l(nam, val, def, lDisp)
    438    USE ioipsl, ONLY: getin
    439    USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
    440    USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
    441    USE mod_phys_lmdz_transfert_para, ONLY : bcast
    442    CHARACTER(LEN=*),  INTENT(IN)    :: nam
    443    LOGICAL,           INTENT(INOUT) :: val
    444    LOGICAL, OPTIONAL, INTENT(IN)    :: def
    445    LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
    446    LOGICAL :: lD
    447 !$OMP BARRIER
    448    IF(is_mpi_root.AND.is_omp_root) THEN
    449       IF(PRESENT(def)) val=def; CALL getin(nam,val)
    450       lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    451       IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(num2str(val)))
    452   END IF
    453   CALL bcast(val)
    454 END SUBROUTINE getinp_l
    455391
    456392END MODULE isotopes_mod
Note: See TracChangeset for help on using the changeset viewer.