Changeset 3891


Ignore:
Timestamp:
May 11, 2021, 2:10:34 PM (3 years ago)
Author:
dcugnet
Message:
  • Bugs corrections:
    • sequential gcm fixed
    • parallel gcm compilation fixed ; to be tested
  • Some generic operations moved from infotrac to readTracFile
  • Fixed algebrical reduction routine, used in the isotopes parameters file.
  • Additional component "comp" in the tracers descriptor derived type "tra",

specifying the model component name(s) (cf. tracers sections) it belongs.

  • isotopes class selection tool fixed.
Location:
LMDZ6/branches/LMDZ-tracers/libf
Files:
13 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d/check_isotopes.F90

    r3852 r3891  
    2323  modname = 'check_isotopes'
    2424  IF(first) THEN
     25    iH2O = -1
    2526    IF(isoSelect('H2O')) RETURN
    2627    ixH2O = strIdx(isoName,'H2[16]O')
    … …  
    2930    first = .FALSE.
    3031  ELSE
     32    IF(iH2O == -1)      RETURN
    3133    IF(isoSelect(iH2O)) RETURN
    3234  END IF

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3d_common/infotrac.F90

    r3852 r3891  
    11MODULE infotrac
    22
    3   USE       strings_mod, ONLY: msg, find, strIdx,  strFind,  strHead, dispTable, cat, get_in,  &
    4                               fmsg, test, int2str, strParse, strTail, strReduce, strStack, modname, testFile
     3  USE       strings_mod, ONLY: msg, find, strIdx,  strFind,  strHead, dispTable, testFile, cat, get_in,  &
     4                              fmsg, test, int2str, strParse, strTail, strReduce, strStack, modname
    55  USE readTracFiles_mod, ONLY: readTracersFiles, getKey_init, nphases, delPhase, aliasTracer, &
    6                         tran0, readIsotopesFile, getKey, known_phases, addPhase, indexUpdate
     6                        tran0, readIsotopesFile, getKey, known_phases, addPhase, indexUpdate, initIsotopes
    77  USE trac_types_mod,    ONLY: tra, iso, kys
    88
    … …  
    2323  PUBLIC :: iso, isotopes, nbIso                           !--- Derived type, full isotopes families database + nb of families
    2424  PUBLIC :: isoSelect , ixIso                              !--- Isotopes family selection tool + selected family index
     25  PUBLIC :: qprntmin, massqmin, ratiomin                   !--- Min. values
    2526  !=== FOR ISOTOPES: Specific to H2O isotopes
    2627  PUBLIC :: iH2O, tnat, alpha_ideal                        !--- H2O isotopes index, natural abundance, fractionning coeff.
    … …  
    3132  PUBLIC :: iZonIso, iTraPha                               !--- 2D index tables to get "iq" index
    3233  PUBLIC :: isoCheck                                       !--- Run isotopes checking routines
    33 
    3434  !=== FOR BOTH TRACERS AND ISOTOPES
    3535  PUBLIC :: getKey                                         !--- Get a key from "tracers" or "isotope"
    … …  
    7575!  | type       | Type (so far: tracer or tag)                    | /           | tracer,tag             |
    7676!  | phas       | Phases list ("g"as / "l"iquid / "s"olid)        | /           | [g][l][s]              |
     77!  | comp       | Name(s) of the merged/cumulated section(s)      | /           | coma-separated names   |
    7778!  | iadv       | Advection scheme number                         | iadv        | 1-20,30 exc. 3-9,15,19 |
    7879!  | igen       | Generation (>=1)                                | /           |                        |
    … …  
    103104
    104105
     106  REAL, PARAMETER :: qprntmin=1.E-12, massqmin=1.E-12, ratiomin=1.E-12
    105107
    106108  !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    … …  
    113115
    114116  !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
    115   TYPE(tra), TARGET,  SAVE, ALLOCATABLE ::  tracers(:)      !=== TRACERS DESCRIPTORS VECTOR
    116   TYPE(iso), TARGET,  SAVE, ALLOCATABLE :: isotopes(:)      !=== ISOTOPES PARAMETERS VECTOR
     117  TYPE(tra), TARGET,  SAVE, ALLOCATABLE ::  tracers(:)     !=== TRACERS DESCRIPTORS VECTOR
     118  TYPE(iso), TARGET,  SAVE, ALLOCATABLE :: isotopes(:)     !=== ISOTOPES PARAMETERS VECTOR
    117119!$OMP THREADPRIVATE(tracers, isotopes)
    118120
    119121  !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
    120   TYPE(iso),          SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
    121   INTEGER,            SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
    122   LOGICAL,            SAVE, POINTER :: isoCheck            !--- Flag to trigger the checking routines
    123   TYPE(kys),          SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    124   CHARACTER(LEN=256), SAVE, POINTER :: isoName(:),       & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
    125                                        isoZone(:),       & !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
    126                                        isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
    127   INTEGER,            SAVE          :: niso, nzon, npha, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
    128                                        nitr                !--- NUMBER OF ISOTOPES + ISOTOPIC TAGGING TRACERS
    129   INTEGER,            SAVE, POINTER :: iZonIso(:,:)        !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
    130   INTEGER,            SAVE, POINTER :: iTraPha(:,:)        !=== INDEX IN "isoTrac" AS f(isotopic tracer, phase)
     122  TYPE(iso),          SAVE, POINTER     :: isotope         !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
     123  INTEGER,            SAVE              :: ixIso, iH2O     !--- Index of the selected isotopes family and H2O family
     124  LOGICAL,            SAVE              :: isoCheck        !--- Flag to trigger the checking routines
     125  TYPE(kys),          SAVE, POINTER     :: isoKeys(:)      !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
     126  CHARACTER(LEN=256), SAVE, POINTER     :: isoName(:),   & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
     127                                           isoZone(:),   & !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
     128                                           isoPhas         !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
     129  INTEGER,            SAVE              :: niso, nzon,  & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
     130                                           npha, nitr      !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
     131  INTEGER,            SAVE, POINTER     :: iZonIso(:,:)    !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
     132  INTEGER,            SAVE, POINTER     :: iTraPha(:,:)    !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase)
    131133!$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzon,npha,nitr, iZonIso,iTraPha)
    132134
    … …  
    137139                                            pbl_flg(:),  & !--- Boundary layer activation ; needed for INCA        (nbtr)
    138140                                         itr_indice(:),  & !--- Indexes of the tracers passed to phytrac        (nqtottr)
    139                                               niadv(:)
     141                                              niadv(:)     !--- Indexes of true tracers  (<=nqtot, such that iadv(idx)>0)
    140142  CHARACTER(LEN=8),   SAVE, ALLOCATABLE ::   solsym(:)     !--- Names from INCA                                    (nbtr)
    141 !OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, itr_indice, solsym)
     143!OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, itr_indice, niadv, solsym)
    142144
    143145#ifdef CPP_StratAer
    … …  
    153155#ifdef REPROBUS
    154156  USE chem_rep,    ONLY: Init_chem_rep_trac
     157  IMPLICIT NONE
    155158#endif
    156159!==============================================================================================================================
    … …  
    178181! Local variables
    179182  INTEGER, ALLOCATABLE :: hadv(:), hadv_inca(:), &                   !--- Horizontal/vertical transport scheme number
    180                           vadv(:), vadv_inca(:)                      !--- + specific INCA versions
    181   CHARACTER(LEN=1)   :: ph                                           !--- Phase
     183                          vadv(:), vadv_inca(:)                      !---   + specific INCA versions
    182184  CHARACTER(LEN=2)   ::   suff(9)                                    !--- Suffixes for schemes of order 3 or 4 (Prather)
    183   CHARACTER(LEN=3)   :: descrq(30)                                   !--- Advection scheme description
    184   CHARACTER(LEN=4)   :: oldH2O(3)                                    !--- Old water names
    185   CHARACTER(LEN=256) :: newH2O, iname, isoPhase                      !--- New water and isotope names, phases list
     185  CHARACTER(LEN=3)   :: descrq(30)                                   !--- Advection scheme description tags
     186  CHARACTER(LEN=4)   :: oldH2O(3)                                    !--- Old water name for the three phases
     187  CHARACTER(LEN=256) :: newH2O                                       !--- New water name
    186188  CHARACTER(LEN=256) :: msg1, msg2                                   !--- Strings for messages
    187   CHARACTER(LEN=256), ALLOCATABLE, DIMENSION(:) :: &                 !--- Temporary storage
    188              isoName, isoZone, tra0, zon0, tag0, n, p, z, str
     189  CHARACTER(LEN=256), ALLOCATABLE :: str(:)                          !--- Temporary storage
    189190  INTEGER :: fType                                                   !--- Tracers description file type ; 0: none
    190191                                                                     !--- 1: "traceur.def"  2: "tracer.def"  3: "tracer_*.def"
    191192  INTEGER :: nqtrue                                                  !--- Tracers nb from tracer.def (no higher order moments)
    192   INTEGER :: iad                                                     !--- Advection scheme
    193   INTEGER :: iH2O                                                    !--- Index in "isotopes(:)" of H2O family
    194   INTEGER :: ic,ip,iq,jq, it,nt, im,nm, ix, iz, niso, nzone, ntiso   !--- Indexes and temporary variables
    195   LOGICAL, ALLOCATABLE :: lisoGen2(:), &                             !--- Mask for second generation isotopes
    196                           lisoName(:), &                             !--- Mask for water isotopes
    197                           lisoZone(:), ll(:)                         !--- Mask for water isotopes tagging tracers
     193  INTEGER :: iad                                                     !--- Advection scheme number
     194  INTEGER :: ic, ip, iq, jq, it, nt, im, nm, ix, iz                  !--- Indexes and temporary variables
    198195  LOGICAL :: lerr
    199196  TYPE(tra), ALLOCATABLE, TARGET :: ttr(:)
    200   TYPE(tra), POINTER             :: t1, t(:)
     197  TYPE(tra), POINTER             :: t1
    201198  TYPE(iso), POINTER             :: s
    202199!------------------------------------------------------------------------------------------------------------------------------
    … …  
    204201!------------------------------------------------------------------------------------------------------------------------------
    205202  modname = 'infotrac_init'
    206   type_trac='lmdz'!'lmdz,inca'
    207203  suff          = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
    208204  descrq( 1: 2) = ['LMV','BAK']
    … …  
    310306        IF(nqo/=2 .AND. nqo/=3) CALL abort_gcm(modname,TRIM(msg1),1)
    311307#ifdef INCA
    312         CALL Init_chem_inca_trac(nbtr)                                   !--- Get nbtr from INCA
     308        CALL Init_chem_inca_trac(nbtr)                               !--- Get nbtr from INCA
    313309#endif
    314310        ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr), conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
    … …  
    317313        CALL init_transport(hadv_inca, vadv_inca, conv_flg,   pbl_flg,   solsym)
    318314#endif
    319         nqtrue = nbtr + nqo                                              !--- Total number of tracers
     315        nqtrue = nbtr + nqo                                          !--- Total number of tracers
    320316        ALLOCATE(ttr(nqtrue)); ttr(1:nqo) = tracers(1:nqo)
    321317        DO iq = nqo+1, nqtrue
    … …  
    405401    CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
    406402  END IF
     403  CALL msg('nqtot = '//TRIM(int2str(nqtot)))
     404  CALL msg('nbtr  = '//TRIM(int2str(nbtr)))
     405  CALL msg('nqo   = '//TRIM(int2str(nqo)))
    407406  ALLOCATE(ttr(nqtot))
    408407
    … …  
    424423    t1%lnam = t1%name; IF(iad /= 0) t1%lnam=TRIM(t1%name)//descrq(iad)
    425424
    426     !--- Defining most fields of the tracer derived type
     425    !--- Define most fields of the tracers derived type
    427426    ttr(jq)%name = t1%name
    428427    ttr(jq)%nam1 = t1%nam1
    … …  
    478477
    479478  CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    480   t => tracers
    481 
    482   !=== VARIABLES RELATED TO GENERATIONS
    483   niadv = PACK( [(iq,iq=1,nqtot)], MASK=t(:)%iadv>=0)           !--- Indexes of "true" tracers
    484 
    485   p = PACK(delPhase(t%prnt),MASK=t%type=='tracer'.AND.t%igen==2)!--- Parents of 2nd generation isotopes
    486   CALL strReduce(p, nbIso)
    487   ALLOCATE(isotopes(nbIso))
    488 
    489   IF(nbIso==0) RETURN                                           !=== NO ISOTOPES: FINISHED
    490 
    491   CALL msg('Isotopes families required: '//strStack(p))
    492 
    493   !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
    494   isotopes(:)%prnt = p
    495   DO ip = 1, SIZE(p)                                            !--- Loop on isotopes categories
    496     s => isotopes(ip)
    497     iname = s%prnt
    498 
    499     !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
    500     lisoZone = t(:)%type=='tag'    .AND. delPhase(t(:)%nam1) == iname .AND. t(:)%igen == 3
    501     s%zone = PACK(strTail(t(:)%name,'_'), MASK = lisoZone)      !--- Tagging zones names  for isotopes category "iname"
    502     CALL strReduce(s%zone)
    503     s%nzon = SIZE(s%zone)                                       !--- Tagging zones number for isotopes category "iname"
    504 
    505     !=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
    506     lisoName = t(:)%type=='tracer' .AND. delPhase(t(:)%prnt) == iname .AND. t(:)%phas == 'g'
    507     ALLOCATE(s%keys(COUNT(lisoName)))
    508     s%keys(:)%name = PACK(delPhase(t(:)%name), MASK = lisoName)    !--- Effectively found isotopes of "iname"
    509     s%niso = SIZE(s%keys)                                       !--- Number of "effectively found isotopes of "iname"
    510     s%trac = [s%keys%name, ((TRIM(s%keys(it)%name)//'_'//TRIM(s%zone(iz)), it=1, s%niso), iz=1, s%nzon)]
    511     s%nitr = SIZE(s%trac)                                       !--- " + their geographic tracers               [ntraciso]
    512 
    513     !=== Phases for tracer "iname"
    514     s%phas = ''
    515     DO ix = 1, nphases; IF(strIdx(t%name,addPhase(iname, known_phases(ix:ix))) /= 0) s%phas = TRIM(s%phas)//ph; END DO
    516     s%npha = LEN_TRIM(s%phas)                                   !--- Equal to "nqo" for water
    517 
    518     !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
    519     DO iq = 1, nqtot
    520       t1 => tracers(iq)
    521       IF(t1%nam1 /= iname) CYCLE                                 !--- Only deal with tracers descending on "iname"
    522       t1%iso_igr = ip                                            !--- Index of isotopes family in list "isotopes(:)%prnt"
    523       t1%iso_num = strIdx(s%trac, delPhase(strHead(t1%name,'_')))!--- Index of current isotope       in effective isotopes list
    524       t1%iso_zon = strIdx(s%zone,          strTail(t1%name,'_') )!--- Index of current isotope zone  in effective zones    list
    525       t1%iso_pha =  INDEX(s%phas,TRIM(t1%phas))                  !--- Index of current isotope phase in effective phases   list
    526       IF(t1%igen /= 3) t1%iso_zon = 0                            !--- Skip possible generation 2 tagging tracers
    527     END DO
    528 
    529     !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    530     !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    531     s%iTraPha = RESHAPE( [( (strIdx(t(:)%name,  addPhase(s%trac(it),s%phas(ip:ip))),     it=1, s%nitr), ip=1, s%npha)], &
    532                          [s%nitr, s%npha] )
    533 
    534     !=== Table used to get ix (index in tagging tracers isotopes list, size nitr) from the zone and isotope indexes
    535     s%iZonIso = RESHAPE( [( (strIdx(s%trac(:), TRIM(s%trac(it))//'_'//TRIM(s%zone(iz))), iz=1, s%nzon), it=1, s%niso)], &
    536                          [s%nzon, s%niso] )
    537   END DO
    538 
    539   !=== Indexes, in dynamical tracers list, of the tracers transmitted to phytrac (nqtottr non-vanishing elements)
    540   ll = delPhase(t%name)/='H2O' .AND. t%iso_num ==0              !--- Mask of tracers passed to the physics
    541   t(:)%itr = UNPACK([(iq,iq=1,COUNT(ll))], ll, [(0, iq=1, nqtot)])
    542   itr_indice = PACK(t(:)%itr, MASK = t(:)%itr/=0)               !--- Might be removed (t%itr should be enough)
    543 
    544   !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
     479
     480  !=== Indexes of: "true" tracers, in the dynamical table of tracers transmitted to phytrac (nqtottr non-vanishing elements)
     481  niadv      = PACK([(iq,iq=1,nqtot)], MASK=tracers(:)%iadv>=0) !--- Indexes of "true" tracers
     482  itr_indice = PACK(tracers(:)%itr,    MASK=tracers(:)%itr /=0) !--- Might be removed (t%itr should be enough)
     483
     484  CALL initIsotopes(tracers, isotopes)
     485  nbIso = SIZE(isotopes); IF(nbIso==0) RETURN                   !--- No isotopes: finished.
     486
     487
     488  !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES
    545489  !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
    546   IF(readIsotopesFile('isotopes_params.def',isotopes)) CALL abort_gcm(modname,'Problem when reading isotopes parameters',1)
    547 print*,'coincoin'
    548 
    549   !=== Specific to water
    550490  CALL getKey_init(tracers, isotopes)
    551491  IF(isoSelect('H2O')) RETURN                                   !--- Select water isotopes ; finished if no water isotopes.
    552492  iH2O = ixIso                                                  !--- Keep track of water family index
    553   lerr = getKey('tnat' ,tnat,        isoName)
    554   lerr = getKey('alpha',alpha_ideal, isoName)
     493  IF(getKey('tnat' ,tnat,        isoName(1:niso))) CALL abort_gcm(modname,'can''t read "tnat"',1)
     494  IF(getKey('alpha',alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname,'can''t read "alpha_ideal"',1)
    555495  CALL msg('end')
    556496
    … …  
    560500!==============================================================================================================================
    561501!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
    562 !     Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first time).
     502!     Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first call).
    563503!==============================================================================================================================
    564 LOGICAL FUNCTION isoSelectByName(iName) RESULT(lerr)
    565   CHARACTER(LEN=*), INTENT(IN)  :: iName
     504LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
     505  IMPLICIT NONE
     506  CHARACTER(LEN=*),  INTENT(IN)  :: iName
     507  LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    566508  INTEGER :: iIso
     509  LOGICAL :: lV
     510  lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    567511  iIso = strIdx(isotopes(:)%prnt, iName)
    568   IF(test(fmsg(iIso == 0,'no isotope family named "'//TRIM(iName)//'"'),lerr)) RETURN
    569   IF(isoSelectByIndex(iIso)) RETURN
     512  lerr = iIso == 0
     513  CALL msg(lerr .AND. lV, 'no isotope family named "'//TRIM(iName)//'"')
     514  IF(lerr) RETURN
     515  lerr = isoSelectByIndex(iIso)
    570516END FUNCTION isoSelectByName
    571517!==============================================================================================================================
    572 LOGICAL FUNCTION isoSelectByIndex(iIso) RESULT(lerr)
    573   INTEGER, INTENT(IN) :: iIso
     518LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
     519  IMPLICIT NONE
     520  INTEGER,           INTENT(IN) :: iIso
     521  LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     522  LOGICAL :: lv
     523  lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
    574524  lerr = .FALSE.
    575525  IF(iIso == ixIso) RETURN                                      !--- Nothing to do if the index is already OK
    576   IF(test(fmsg(iIso<=0 .OR. iIso>=nbIso,'Inconsistent isotopes family index '//TRIM(int2str(iIso))),lerr)) RETURN
     526  lerr = iIso<=0 .OR. iIso>nbIso
     527  CALL msg(lerr .AND. lV, 'Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= ' &
     528                                                               //TRIM(int2str(nbIso))//'"')
     529  IF(lerr) RETURN
    577530  ixIso = iIso                                                  !--- Update currently selected family index
    578531  isotope => isotopes(ixIso)                                    !--- Select corresponding component
    579   !--- VARIOUS ALIASES
    580   isoKeys => isotope%keys; niso = isotope%niso
    581   isoName => isotope%trac; nitr = isotope%nitr; isoCheck => isotope%check
    582   isoZone => isotope%zone; nzon = isotope%nzon; iZonIso  => isotope%iZonIso
    583   isoPhas => isotope%phas; npha = isotope%npha; iTraPha  => isotope%iTraPha
     532  isoKeys => isotope%keys;    niso     = isotope%niso
     533  isoName => isotope%trac;    nitr     = isotope%nitr
     534  isoZone => isotope%zone;    nzon     = isotope%nzon
     535  isoPhas => isotope%phas;    npha     = isotope%npha
     536  iZonIso => isotope%iZonIso; isoCheck = isotope%check
     537  iTraPha => isotope%iTraPha
    584538END FUNCTION isoSelectByIndex
    585539!==============================================================================================================================

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/check_isotopes_loc.F90

    r3852 r3891  
    2626  modname = 'check_isotopes'
    2727  IF(first) THEN
     28    iH2O = -1
    2829    IF(isoSelect('H2O')) RETURN
    2930    ixH2O = strIdx(isoName,'H2[16]O')
    … …  
    3233    first = .FALSE.
    3334  ELSE
     35    IF(iH2O == -1)      RETURN
    3436    IF(isoSelect(iH2O)) RETURN
    3537  END IF

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/dynetat0_loc.F90

    r3852 r3891  
    4646  REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
    4747  REAL,             ALLOCATABLE :: teta_glo(:,:)
     48  TYPE(tra), POINTER :: tr
    4849!-------------------------------------------------------------------------------
    4950  modname="dynetat0_loc"

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/dynredem_loc.F90

    r3852 r3891  
    151151  CALL cre_var(nid,"teta" ,"Temperature",[rlonvID,rlatuID,sID,timID])
    152152  DO iq=1,nqtot
    153     CALL cre_var(nid,tracers(iq)%name(iq),tracers(iq)%lnam,[rlonvID,rlatuID,sID,timID])
     153    CALL cre_var(nid,tracers(iq)%name,tracers(iq)%lnam,[rlonvID,rlatuID,sID,timID])
    154154  END DO
    155155  CALL cre_var(nid,"masse","Masse d air"    ,[rlonvID,rlatuID,sID,timID])

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/iniacademic_loc.F90

    r3852 r3891  
    283283              IF(niso > 0 .AND. tr%iso_num > 0) THEN
    284284                IF(tr%iso_zon == 0) &
    285                   q(ijb_u:ije_u,:,i) = q(ijb_u:ije_u,:,tr%iprnt)         *        tnat(tr%iso_num)
     285                  q(ijb_u:ije_u,:,i) = q(ijb_u:ije_u,:,tr%iprnt)         *        tnat(tr%iso_num) &
    286286                                     *(q(ijb_u:ije_u,:,tr%iprnt)/30.e-3)**(alpha_ideal(tr%iso_num)-1)
    287287                IF(tr%iso_zon == 1) &

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/qminimum_loc.F

    r3852 r3891  
    44      SUBROUTINE qminimum_loc( q,nqtot,deltap )
    55      USE parallel_lmdz
    6       USE infotrac, ONLY: nitr, iTraPha, qperemin ! CRisi 23nov2020
     6      USE infotrac, ONLY: nitr, iTraPha, qprntmin ! CRisi 23nov2020
    77      IMPLICIT none
    88c
    … …  
    166166!              write(lunout,*) 'i,k,q_follow(i,k-1,iq_vap)=',
    167167!     :                 i,k,q_follow(i,k-1,iq_vap)         
    168               if (q_follow(i,k-1,iq_vap).lt.qperemin) then
     168              if (q_follow(i,k-1,iq_vap).lt.qprntmin) then
    169169                write(lunout,*) 'tmp qmin: on stoppe'
    170170                write(lunout,*) 'zx_pump(i)=',zx_pump(i)

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/vlsplt_loc.F

    r3852 r3891  
    1414c   --------------------------------------------------------------------
    1515      USE parallel_lmdz
    16       USE infotrac, ONLY : nqtot,tracers, tra,         ! CRisi                 &
    17      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     16      USE infotrac, ONLY : nqtot,tracers, tra,          ! CRisi                &
     17     &                     qprntmin, massqmin, ratiomin ! MVals et CRisi
    1818      IMPLICIT NONE
    1919c
    … …  
    346346           ! les calcule donc que de ijb à ije
    347347           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    348            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    349            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     348           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),massqmin)
     349           if (q(ij,l,iq).gt.qprntmin) then ! modif 13 nov 2020
    350350             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    351351           else
    … …  
    369369         DO ij=ijb+1,ije
    370370            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    371             new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
     371            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),massqmin)
    372372            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    373373     &        u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    425425c   --------------------------------------------------------------------
    426426      USE parallel_lmdz
    427       USE infotrac, ONLY : nqtot, tracers, tra,        ! CRisi                 &
    428      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi   
     427      USE infotrac, ONLY : nqtot, tracers, tra,         ! CRisi                &
     428     &                     qprntmin, massqmin, ratiomin ! MVals et CRisi   
    429429      USE comconst_mod, ONLY: pi
    430430      IMPLICIT NONE
    … …  
    759759          DO ij=ijbm,ijem
    760760           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    761            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     761           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),massqmin)
    762762          enddo !DO ij=ijbm,ijem
    763763
    … …  
    765765         DO ij=ijb,ije
    766766           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    767            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     767           if (q(ij,l,iq).gt.qprntmin) then ! modif 13 nov 2020
    768768             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    769769           else
    … …  
    901901      USE parallel_lmdz
    902902      USE vlz_mod
    903       USE infotrac, ONLY : nqtot, tracers, tra,        ! CRisi                 &
    904      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     903      USE infotrac, ONLY : nqtot, tracers, tra,         ! CRisi                &
     904     &                     qprntmin, massqmin, ratiomin ! MVals et CRisi
    905905     
    906906      IMPLICIT NONE
    … …  
    949949!$OMP THREADPRIVATE(first)
    950950
    951       !REAL masseq(ijb_u:ije_u,llm,nqtot),Ratio(ijb_u:ije_u,llm,nqtot) ! CRisi
     951      !REAL massq(ijb_u:ije_u,llm,nqtot),Ratio(ijb_u:ije_u,llm,nqtot) ! CRisi
    952952      ! Ces varibles doivent être déclarées en pointer et en save dans
    953953      ! vlz_loc si on veut qu'elles soient vues par tous les threads. 
    954954      INTEGER ichld,iq2 ! CRisi
    955 
     955      TYPE(tra), POINTER :: tr
     956      tr => tracers(iq)
    956957
    957958      IF (first) THEN
    … …  
    11741175          DO ij=ijb,ije
    11751176           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    1176            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    1177            if (q(ij,l,iq).gt.qperemin) then
     1177           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),massqmin)
     1178           if (q(ij,l,iq).gt.qprntmin) then
    11781179             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    11791180           else

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/vlspltqs_loc.F

    r3852 r3891  
    1212c   --------------------------------------------------------------------
    1313      USE parallel_lmdz
    14       USE infotrac, ONLY : nqtot, tracers, tra,        ! CRisi                 &
    15      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     14      USE infotrac, ONLY : nqtot, tracers, tra,         ! CRisi                &
     15     &                     qprntmin, massqmin, ratiomin ! MVals et CRisi
    1616      IMPLICIT NONE
    1717c
    … …  
    349349          DO ij=ijb,ije
    350350           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    351            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
    352            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     351           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),massqmin)
     352           if (q(ij,l,iq).gt.qprntmin) then ! modif 13 nov 2020
    353353             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    354354           else
    … …  
    374374         DO ij=ijb+1,ije
    375375            !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    376             new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),masseqmin)
     376            new_m=max(masse(ij,l,iq)+u_m(ij-1,l)-u_m(ij,l),massqmin)
    377377            q(ij,l,iq)=(q(ij,l,iq)*masse(ij,l,iq)+
    378378     &      u_mq(ij-1,l)-u_mq(ij,l))
    … …  
    428428c   --------------------------------------------------------------------
    429429      USE parallel_lmdz
    430       USE infotrac, ONLY : nqtot, tracers, tra,        ! CRisi                 &
    431      &                     qperemin,masseqmin,ratiomin ! MVals et CRisi
     430      USE infotrac, ONLY : nqtot, tracers, tra,         ! CRisi                &
     431     &                     qprntmin, massqmin, ratiomin ! MVals et CRisi
    432432      USE comconst_mod, ONLY: pi
    433433      IMPLICIT NONE
    … …  
    759759          DO ij=ijbm,ijem
    760760           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    761            masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),masseqmin)
     761           masse(ij,l,iq2)=max(masse(ij,l,iq)*q(ij,l,iq),massqmin)
    762762          enddo !DO ij=ijbm,ijem
    763763
    … …  
    766766           !MVals: veiller a ce qu'on n'ait pas de denominateur nul
    767767           !write(lunout,*) 'ij,l,q(ij,l,iq)=',ij,l,q(ij,l,iq)
    768            if (q(ij,l,iq).gt.qperemin) then ! modif 13 nov 2020
     768           if (q(ij,l,iq).gt.qprntmin) then ! modif 13 nov 2020
    769769             Ratio(ij,l,iq2)=q(ij,l,iq2)/q(ij,l,iq)
    770770           else

  • LMDZ6/branches/LMDZ-tracers/libf/dyn3dmem/vlz_mod.F90

    r3852 r3891  
    2525    CALL allocate_u(dzqw,llm,d)
    2626    CALL allocate_u(adzqw,llm,d)
    27     IF(ANY(tracers(:)%ndesc > 0) THEN
     27    IF(ANY(tracers(:)%ndesc > 0)) THEN
    2828      !CALL allocate_u(masseq,llm,nqtot,d)
    2929      CALL allocate_u(Ratio,llm,nqtot,d)
    … …  
    4545    CALL switch_u(adzqw,distrib_vanleer,dist)
    4646    ! CRisi:
    47     if (nqdesc_tot.gt.0) then   
     47    IF(ANY(tracers(:)%ndesc > 0)) then   
    4848    !CALL switch_u(masseq,distrib_vanleer,dist)
    4949    CALL switch_u(Ratio,distrib_vanleer,dist)

  • LMDZ6/branches/LMDZ-tracers/libf/misc/readTracFiles_mod.f90

    r3852 r3891  
    11MODULE readTracFiles_mod
    22
    3   USE strings_mod,    ONLY: msg, testFile,  strFind, strStack, strCount,   strHead, removeComment, dispTable, fmsg, &
    4                             cat, checkList, strIdx,  strParse, strReplace, strTail,  reduceExpr, modname, find, test
     3  USE strings_mod, ONLY: msg, testFile,  strFind, strStack, strReduce,  strHead, strCount,   find, dispTable, fmsg, &
     4          removeComment, cat, checkList, strIdx,  strParse, strReplace, strTail, reduceExpr, test, modname, get_in
    55  USE trac_types_mod, ONLY : tra, iso, db, kys
    66
    … …  
    99  PRIVATE
    1010
     11  PUBLIC :: initIsotopes
    1112  PUBLIC :: readTracersFiles, aliasTracer, tracersSubset, indexUpdate     !--- TOOLS ASSOCIATED TO TRACERS  DESCRIPTORS
    1213  PUBLIC :: readIsotopesFile                                              !--- TOOLS ASSOCIATED TO ISOTOPES DESCRIPTORS
    … …  
    8283!------------------------------------------------------------------------------------------------------------------------------
    8384  lerr = .FALSE.
    84   modname = 'readTracersFiles'
     85!  modname = 'readTracersFiles'
    8586  IF(.NOT.ALLOCATED(dBase)) ALLOCATE(dBase(0))
    8687
    … …  
    225226  CHARACTER(LEN=256), ALLOCATABLE :: sec(:)
    226227  INTEGER,            ALLOCATABLE ::  ix(:)
    227   INTEGER :: n0, idb, ndb
     228  INTEGER :: n0, idb, ndb, i, j
    228229  LOGICAL :: ll
    229230!------------------------------------------------------------------------------------------------------------------------------
    … …  
    272273      ll = strParse(str,' ', keys = s, vals = v, n = n)              !--- Parse <key>=<val> pairs
    273274      tt = dBase(ndb)%trac(:)
    274       tmp%name = s(1); tmp%keys = kys(s(1), s(2:n), v(2:n))
     275      tmp%name = s(1); tmp%comp=secn; tmp%keys = kys(s(1), s(2:n), v(2:n))
    275276      dBase(ndb)%trac = [tt(:), tmp]
    276277      DEALLOCATE(tt)
    … …  
    294295  TYPE(tra), ALLOCATABLE, TARGET, INTENT(INOUT) :: t(:)
    295296  CHARACTER(LEN=*),               INTENT(IN)    :: defName
    296   INTEGER :: i0, it, k
    297   TYPE(kys), POINTER     :: k0
     297  INTEGER :: jd, it, k
     298  TYPE(kys), POINTER :: ky
    298299  TYPE(tra), ALLOCATABLE :: tt(:)
    299   i0 = strIdx(t(:)%name, defName)
    300   IF(i0 == 0) RETURN
    301   k0 => t(i0)%keys
    302   DO k = 1, SIZE(k0%key)                                             !--- Loop on the keys of the tracer named "defName"
    303     CALL addKey_tra(TRIM(k0%key(k)), TRIM(k0%val(k)), t)             !--- Add key to all the tracers (no overwriting)
    304   END DO
    305   tt = [t(1:i0-1),t(i0+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
     300  jd = strIdx(t(:)%name, defName)
     301  IF(jd == 0) RETURN
     302  ky => t(jd)%keys
     303  DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
     304    CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys)                   !--- Add key to all the tracers (no overwriting)
     305  END DO
     306  tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
    306307END SUBROUTINE addDefault
    307308!==============================================================================================================================
    … …  
    338339
    339340
    340 
    341 
    342341!==============================================================================================================================
    343342LOGICAL FUNCTION expandSection(tr, sname, fname) RESULT(lerr)
    … …  
    451450  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: fname                    !--- File name
    452451  CHARACTER(LEN=256) :: mesg
    453   CHARACTER(LEN=256) :: bp(SIZE(tr, DIM=1)), pha
     452  CHARACTER(LEN=256) :: bp(SIZE(tr, DIM=1)), pha                     !--- Bad phases list, phases of current tracer
    454453  CHARACTER(LEN=1) :: p
    455454  INTEGER :: ip, np, iq, nq
    … …  
    814813 
    815814!==============================================================================================================================
    816 !=== READ THE ISOTOPES NAMED "iso" FROM THE TRACERS SECTIONS "tr" IN THE FILE "fnam" ; PUT RESULT IN A TRACERS DESCRIPTOR ====
    817 !===  * SYNTAX IS THE SAME AS IN THE "tracer.def" FILE ; EACH TRACER SECTION CONTAINS ONE LINE EACH OF ITS KNOWN ISOTOPES  ====
    818 !===  * EACH TRACERS SECTION CAN CONTAIN A "params" VIRTUAL ISOTOPE LINE CONTAINING DEFAULT PARAMETERS FOR THE ISOTOPES    ====
    819 !===  * IF SOME KEYS ARE FOUND BOTH IN THE "*.def" FILES AND THE "params" SECTION, TEH VALUE FROM "*.def" FILE IS RETAINED ====
    820 !===  * ON EACH ISOTOPE LINE, A DEFINED KEY CAN BE USED IN THE OTHER KEYS AS A PARAMETER (SIGNLE LEVEL DEPENDENCY !)       ====
    821 !===  * THE DIFFERENT ISOTOPES SETS (ONE EACH PARENT TRACER) ARE MERGED INTO A SINGLE TRACERS DESCRIPTOR VECTOR            ====
    822 !===  * THE ROUTINE GIVES AN ERROR IF A REQUIRED ISOTOPE IS NOT AVAILABLE IN THE DATABASE STORED IN "fnam"                 ====
    823 !==============================================================================================================================
    824 
     815!=== READ FILE "fnam" TO APPEND THE "dBase" TRACERS DATABASE WITH AS MUCH SECTIONS AS PARENTS NAMES IN "isot(:)%prnt":     ====
     816!===  * Each section dBase(i)%name contains the isotopes "dBase(i)%trac(:)" descending on "dBase(i)%name"="iso(i)%prnt"    ====
     817!===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
     818!=== NOTES:                                                                                                                ====
     819!===  * Most of the "isot" components have been defined in the calling routine (initIsotopes):                             ====
     820!===      prnt,   nzon, zone(:),   niso, keys(:)%name,   nitr, trac(:),   npha, phas,  iTraPha(:,:),  iZonPhi(:,:)         ====
     821!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
     822!===  * Each tracers section can contain a "params" virtual isotope line of isotopes parameters default values             ====
     823!===  * In case keys are found both in the "params" section and the "*.def" file, the later value is retained              ====
     824!===  * On each isotope line, defined keys can be used for other keys defintions (single level depth substitution)         ====
     825!===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
     826!==============================================================================================================================
    825827LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
    826828  CHARACTER(LEN=*),  INTENT(IN)    :: fnam                           !--- Input file name
    827829  TYPE(iso), TARGET, INTENT(INOUT) :: isot(:)                        !--- Isotopes descriptors (field "prnt" must be defined !)
    828   INTEGER :: ik, is, it, idb, nk0, i
     830  INTEGER :: ik, is, it, idb, nk0, i, iis
    829831  INTEGER :: nk, ns, nt, ndb, nb0, i0
    830832  CHARACTER(LEN=256), POINTER     :: k(:), v(:), k0(:), v0(:)
    … …  
    832834  CHARACTER(LEN=256)     :: val
    833835  TYPE(kys),    POINTER  ::   ky(:)
    834   TYPE(tra),    POINTER  ::    t(:)
    835   TYPE(tra), ALLOCATABLE ::   tt(:)
     836  TYPE(tra),    POINTER  ::   tt(:), t
    836837  TYPE(db),  ALLOCATABLE ::  tdb(:)
    837838  LOGICAL,   ALLOCATABLE :: liso(:)
    … …  
    844845  IF(test(readSections(fnam,strStack(isot(:)%prnt,',')),lerr)) RETURN!--- Read sections, one each parent tracer
    845846  ndb = SIZE(dBase, DIM=1)                                           !--- Current database size
    846 
    847847  DO idb = nb0, ndb
    848     t => dBase(idb)%trac(:)
    849     nt = SIZE(t)                                                     !--- Number of isotopes in the current database section
    850 
    851 PRINT*
    852 PRINT*,'AVANT:'
    853 DO it=1,SIZE(t); print*,TRIM(t(it)%name)//':  '//strStack([(TRIM(t(it)%keys%key(i))//'='//TRIM(t(it)%keys%val(i)), i=1, SIZE(t(it)%keys%key))]); END DO
     848   iis = idb-nb0+1
     849
    854850    !--- GET FEW GLOBAL KEYS FROM "def" FILES AND ADD THEM TO THE 'params' SECTION
    855851    CALL addKeysFromDef(dBase(idb)%trac, 'params')
    … …  
    858854    CALL subDefault(dBase(idb)%trac, 'params', .TRUE.)
    859855
    860 PRINT*
    861 PRINT*,'AVANT REDUCTION:'
    862     t => dBase(idb)%trac(:)
    863     DO it=1,SIZE(t); print*,TRIM(t(it)%name)//':  '//strStack([(TRIM(t(it)%keys%key(i))//'='//TRIM(t(it)%keys%val(i)), i=1, SIZE(t(it)%keys%key))]); END DO
    864 
    865     !--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS
    866     DO it=1, nt
    867       v => dBase(idb)%trac(it)%keys%val(:)
    868       WHERE(reduceExpr(v, vals)) v = vals
     856    tt => dBase(idb)%trac
     857
     858    !--- REDUCE THE EXPRESSIONS TO OBTAIN SCALARS AND TRANSFER THEM TO THE "isot" ISOTOPES DESCRIPTORS VECTOR
     859    DO it = 1, SIZE(dBase(idb)%trac)
     860      is = strIdx(isot(iis)%keys(:)%name, dBase(idb)%trac(it)%name)  !--- Index of the "isot(iis)%keys(:)%name" tracer named "t%name"
     861      IF(is == 0) CYCLE
     862      t => dBase(idb)%trac(it)
     863      liso = reduceExpr(t%keys%val, vals)                            !--- Reduce expressions (for substituted variables)
     864      isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=liso)
     865      isot(iis)%keys(is)%val = PACK(  vals,     MASK=liso)
    869866    END DO
    870867
    871 PRINT*
    872 PRINT*,'APRES:'
    873     t => dBase(idb)%trac(:)
    874     DO it=1,SIZE(t); print*,TRIM(t(it)%name)//':  '//strStack([(TRIM(t(it)%keys%key(i))//'='//TRIM(t(it)%keys%val(i)), i=1, SIZE(t(it)%keys%key))]); END DO
    875 
    876     !--- TRANSFER THE key=val PAIRS TO THE ISOTOPES DESCRIPTOR
    877 print*
    878 print*,'isot%prnt = '//strStack(isot%prnt)
    879 
    880     ky => isot(strIdx(isot(:)%prnt, dBase(idb)%name))%keys           !--- Keys of "isot" tracers with parent "dBase(idb)%name"
    881 print*,'ky%name = '//strStack(ky%name)
    882     is=1
    883     DO it = 1, nt; IF(it == i0) CYCLE
    884 print*,'AAAAAA '//strStack(ky%name)
    885 print*,'       '//TRIM(t(it)%name)
    886       is = strIdx(ky(:)%name, t(it)%name)                            !--- Index of the "isot(:)" tracer named "t(it)%name"
    887       IF(is == 0) CYCLE                                              !--- Current isotope is not present in "isot" => not needed
    888       k => ky(is)%key; k = t(it)%keys%key
    889       v => ky(is)%val; v = t(it)%keys%val
    890       WHERE(reduceExpr(v, vals)) v = vals
    891       DO ik=1, SIZE(k); IF(reduceExpr(v(ik),val)) v(ik) = val; END DO!--- Reduce operations (for substituted variables)
    892 print*,'(4) '//strStack([(TRIM(k(i))//'='//TRIM(v(i)), i=1, SIZE(k))])
    893     END DO
    894 print*,'(7) i0=',i0
    895 
    896868    !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
    897     liso = [( ALLOCATED(ky(is)%key), is=1, SIZE(ky) )]
    898 print*,'liso=',liso
    899     IF(test(checkList(ky(:)%name, &
    900       .NOT.liso, 'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
     869    liso = [( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )]
     870    IF(test(checkList(isot(iis)%keys(:)%name, .NOT.liso, &
     871      'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
    901872  END DO
    902873
    … …  
    907878    ALLOCATE(tdb(nb0-1)); tdb(1:nb0-1)=dBase(1:nb0-1); CALL MOVE_ALLOC(FROM=tdb, TO=dBase)
    908879  END IF
    909   lerr = dispIsotopes(isot,'isotopes parameters read from file')
     880  lerr = dispIsotopes(isot, 'Isotopes parameters read from file')
    910881
    911882END FUNCTION readIsotopesFile
    912883!==============================================================================================================================
     884
     885!==============================================================================================================================
     886!=== IF ISOTOPES (2ND GENERATION TRACERS) ARE DETECTED:                                                                     ===
     887!===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
     888!===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
     889!===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
     890!===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
     891!==============================================================================================================================
     892SUBROUTINE initIsotopes(trac, isot)
     893  TYPE(tra), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
     894  TYPE(iso), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
     895  CHARACTER(LEN=256), ALLOCATABLE :: p(:), str(:)                    !--- Temporary storage
     896  CHARACTER(LEN=256) :: iname
     897  CHARACTER(LEN=1)   :: ph                                           !--- Phase
     898  INTEGER :: nbIso, ic, ip, iq, it, iz
     899  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
     900  TYPE(tra), POINTER   ::  t(:), t1
     901  TYPE(iso), POINTER   ::  s
     902
     903  t => trac
     904
     905  p = PACK(delPhase(t%prnt), MASK = t%type=='tracer' .AND. t%igen==2)!--- Parents of 2nd generation isotopes
     906  CALL strReduce(p, nbIso)
     907  ALLOCATE(isot(nbIso))
     908
     909  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
     910
     911  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
     912  isot(:)%prnt = p
     913  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
     914    s => isot(ic)
     915    iname = s%prnt                                                   !--- Current isotopes class name (parent tracer name)
     916
     917    !=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
     918    ll = t(:)%type=='tracer' .AND. delPhase(t(:)%prnt) == iname .AND. t(:)%phas == 'g'
     919    str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
     920    s%niso = SIZE(str)                                               !--- Number of "effectively found isotopes of "iname"
     921    ALLOCATE(s%keys(s%niso))
     922    FORALL(it = 1:s%niso) s%keys(it)%name = str(it)
     923
     924    !=== Geographic tagging tracers descending on tracer "iname": mask, names, number
     925    ll = t(:)%type=='tag'    .AND. delPhase(t(:)%nam1) == iname .AND. t(:)%igen == 3
     926    s%zone = PACK(strTail(t(:)%name,'_'), MASK = ll)                 !--- Tagging zones names  for isotopes category "iname"
     927    CALL strReduce(s%zone)
     928    s%nzon = SIZE(s%zone)                                            !--- Tagging zones number for isotopes category "iname"
     929
     930    !=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
     931    !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
     932    str = PACK(delPhase(t(:)%name), MASK=ll)
     933    CALL strReduce(str)
     934    s%nitr = s%niso + SIZE(str)                                      !--- Number of isotopes + their geographic tracers [ntraciso]
     935    ALLOCATE(s%trac(s%nitr))
     936    FORALL(it = 1:s%niso) s%trac(it) = s%keys(it)%name
     937    FORALL(it = s%niso+1:s%nitr) s%trac(it) = str(it-s%niso)
     938
     939    !=== Phases for tracer "iname"
     940    s%phas = ''
     941    DO ip = 1, nphases; ph = known_phases(ip:ip); IF(strIdx(t%name,addPhase(iname, ph)) /= 0) s%phas = TRIM(s%phas)//ph; END DO
     942    s%npha = LEN_TRIM(s%phas)                                        !--- Equal to "nqo" for water
     943
     944    !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
     945    DO iq = 1, SIZE(t)
     946      t1 => trac(iq)
     947      IF(delPhase(t1%nam1) /= iname) CYCLE                            !--- Only deal with tracers descending on "iname"
     948      t1%iso_igr = ic                                                 !--- Isotopes family       idx in list "isotopes(:)%prnt"
     949      t1%iso_num = strIdx(s%trac, delPhase(strHead(t1%name,'_')))     !--- Current isotope       idx in effective isotopes list
     950      t1%iso_zon = strIdx(s%zone,          strTail(t1%name,'_') )     !--- Current isotope zone  idx in effective zones    list
     951      t1%iso_pha =  INDEX(s%phas,TRIM(t1%phas))                       !--- Current isotope phase idx in effective phases   list
     952      IF(t1%igen /= 3) t1%iso_zon = 0                                 !--- Skip possible generation 2 tagging tracers
     953    END DO
     954
     955    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
     956    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
     957    s%iTraPha = RESHAPE( [( (strIdx(t(:)%name,  addPhase(s%trac(it),s%phas(ip:ip))),     it=1, s%nitr), ip=1, s%npha)], &
     958                         [s%nitr, s%npha] )
     959
     960    !=== Table used to get ix (index in tagging tracers isotopes list, size nitr) from the zone and isotope indexes
     961    s%iZonIso = RESHAPE( [( (strIdx(s%trac(:), TRIM(s%trac(it))//'_'//TRIM(s%zone(iz))), iz=1, s%nzon), it=1, s%niso)], &
     962                         [s%nzon, s%niso] )
     963  END DO
     964 
     965  !=== Indexes, in dynamical tracers list, of the tracers transmitted to phytrac (nqtottr non-vanishing elements)
     966  ll = delPhase(t%name)/='H2O' .AND. t%iso_num ==0              !--- Mask of tracers passed to the physics
     967  t(:)%itr = UNPACK([(iq,iq=1,COUNT(ll))], ll, [(0, iq=1, SIZE(t))])
     968
     969  !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
     970  !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
     971  IF(readIsotopesFile('isotopes_params.def',isot)) CALL abort_gcm(modname,'Problem when reading isotopes parameters',1)
     972
     973END SUBROUTINE initIsotopes
     974!==============================================================================================================================
     975
    913976
    914977!==============================================================================================================================
    … …  
    9551018  IF(iky == 0) THEN
    9561019    nky = SIZE(ky%key)
    957     IF(nky == 0) THEN
    958       ky%key = TRIM(key); ky%val = TRIM(val)
    959     ELSE
    960       ALLOCATE(k(nky+1)); k(1:nky) = ky%key; k(nky+1) = TRIM(key); CALL MOVE_ALLOC(FROM=k, TO=ky%key)
    961       ALLOCATE(v(nky+1)); v(1:nky) = ky%val; v(nky+1) = TRIM(val); CALL MOVE_ALLOC(FROM=v, TO=ky%val)
    962     END IF
     1020    IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
    9631021  ELSE IF(lo) THEN                                                   !--- Overwriting
    964     ky%key(iky) = TRIM(key); ky%val(iky) = TRIM(val)
     1022    ky%key(iky) = key; ky%val(iky) = val
    9651023  END IF
    9661024END SUBROUTINE addKey_1
    9671025!==============================================================================================================================
    968 SUBROUTINE addKey_tra(key, val, tr, lOverWrite, tname)
    969 !------------------------------------------------------------------------------------------------------------------------------
    970 ! Purpose: Add the <key>=<val> pair in all the components of the "tr(itr)%keys" keys descriptor:
    971 !          * "tname"   specified: for the index "itr" of the tracer named "tname"
    972 !          * "tname" unspecified: for all the tracers
    973 !------------------------------------------------------------------------------------------------------------------------------
    974   CHARACTER(LEN=*),           INTENT(IN)    :: key, val
    975   TYPE(tra),                  INTENT(INOUT) :: tr(:)
    976   LOGICAL,          OPTIONAL, INTENT(IN)    :: lOverWrite
    977   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)    :: tname
     1026SUBROUTINE addKey_m(key, val, ky, lOverWrite)
     1027!------------------------------------------------------------------------------------------------------------------------------
     1028! Purpose: Add the <key>=<val> pair in all the components of the "ky" keys descriptor.
     1029!------------------------------------------------------------------------------------------------------------------------------
     1030  CHARACTER(LEN=*),  INTENT(IN)    :: key, val
     1031  TYPE(kys),         INTENT(INOUT) :: ky(:)
     1032  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
    9781033  INTEGER :: itr
    9791034  LOGICAL :: lo
    9801035!------------------------------------------------------------------------------------------------------------------------------
    9811036  lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    982   IF(PRESENT(tname)) THEN
    983     itr = strIdx(tr%name, tname)
    984     IF(itr == 0) RETURN
    985     CALL addKey_1(key, val, tr(itr)%keys, lo)
    986   ELSE
    987     DO itr = 1, SIZE(tr); CALL addKey_1(key, val, tr(itr)%keys, lo); END DO
    988   END IF
    989 END SUBROUTINE addKey_tra
    990 !==============================================================================================================================
    991 SUBROUTINE addKeysFromDef(tr, tr0)
    992   USE ioipsl_getin_p_mod, ONLY : getin_p
    993   TYPE(tra), ALLOCATABLE, INTENT(INOUT) :: tr(:)
     1037  DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
     1038END SUBROUTINE addKey_m
     1039!==============================================================================================================================
     1040SUBROUTINE addKeysFromDef(t, tr0)
     1041!------------------------------------------------------------------------------------------------------------------------------
     1042! Purpose: The values of the keys of the tracer named "tr0" are overwritten by the values found in the *.def files, if any.
     1043!------------------------------------------------------------------------------------------------------------------------------
     1044  TYPE(tra), ALLOCATABLE, INTENT(INOUT) :: t(:)
    9941045  CHARACTER(LEN=*),       INTENT(IN)    :: tr0
    9951046  CHARACTER(LEN=256) :: val
    996   INTEGER            :: ik, i0
    997   i0 = strIdx(tr%name, tr0)
    998   IF(i0 == 0) RETURN
    999   DO ik = 1, SIZE(tr(i0)%keys%key)
    1000     val   =   'zzzz'; CALL  getin_p(tr(i0)%keys%key(ik), val)
    1001     IF(val /= 'zzzz') CALL addKey_1(tr(i0)%keys%key(ik), val, tr(i0)%keys, .TRUE.)
     1047  INTEGER            :: ik, jd
     1048  jd = strIdx(t%name, tr0)
     1049  IF(jd == 0) RETURN
     1050  DO ik = 1, SIZE(t(jd)%keys%key)
     1051    CALL get_in(t(jd)%keys%key(ik), val, 'zzzz')
     1052    IF(val /= 'zzzz') CALL addKey_1(t(jd)%keys%key(ik), val, t(jd)%keys, .TRUE.)
    10021053  END DO
    10031054END SUBROUTINE addKeysFromDef
    … …  
    10641115LOGICAL FUNCTION getKeyByName_s1(keyn, val, tname, ky) RESULT(lerr)
    10651116  !--- Purpose: Get the value of the key named "keyn" for the tracer named "tnam".
    1066   !     * "ky" unspecified: try in "tracers" for "tnam" with phase suffix, then in "isotopes" without.
    1067   !     * "ky"   specified: try in "ky"      for "tnam" with, then without phase suffix.
     1117  !     * "ky" unspecified: try in "tracers" for "tnam" with phase and tagging suffixes, then in "isotopes" without.
     1118  !     * "ky"   specified: try in "ky"      for "tnam" with phase and tagging suffixes, then without.
    10681119  !    The returned error code is always .FALSE.: an empty string is returned when the key hasn't been found.
    10691120  CHARACTER(LEN=*),    INTENT(IN)  :: keyn
    … …  
    10741125  lerr = .FALSE.
    10751126  IF(PRESENT(ky)) THEN
    1076     val = getKeyByName_prv(keyn,          tname , ky);    IF(val /= '') RETURN !--- "ky" and "tnam"
    1077     val = getKeyByName_prv(keyn, delPhase(tname), ky)                          !--- "ky" and "tnam" without phase
     1127    val = getKeyByName_prv(keyn, tname , ky);    IF(val /= '') RETURN          !--- "ky" and "tnam"
     1128    val = getKeyByName_prv(keyn, delPhase(strHead(tname,'_')), ky)             !--- "ky" and "tnam" without phase
    10781129  ELSE
    10791130    IF(.NOT.ALLOCATED(tracers))  RETURN
    … …  
    10811132    IF(.NOT.ALLOCATED(isotopes)) RETURN
    10821133    IF(SIZE(isotopes) == 0)      RETURN
    1083     DO is = 1, SIZE(isotopes); IF(strIdx(isotopes(is)%keys(:)%name, tname) /= 0) EXIT; END DO
     1134    DO is = 1, SIZE(isotopes); IF(strIdx(isotopes(is)%keys(:)%name, delPhase(strHead(tname,'_'))) /= 0) EXIT; END DO
    10841135    IF(is /= 0) val = getKeyByName_prv(keyn, tname, isotopes(is)%keys(:))      !--- "isotopes" and "tnam" without phase
    10851136  END IF
    … …  
    11751226ELEMENTAL CHARACTER(LEN=256) FUNCTION delPhase(s) RESULT(out)
    11761227  CHARACTER(LEN=*), INTENT(IN) :: s
    1177   INTEGER :: l
     1228  INTEGER :: l, i
    11781229  out = s
    11791230  IF(s == '') RETURN
    1180   l=LEN_TRIM(s)
    1181   IF(s(l-1:l-1)=='-' .AND. INDEX(known_phases,s(l:l))/=0) out = s(1:l-2)
     1231  i = INDEX(s, '_'); l = LEN_TRIM(s)
     1232  IF(i == 0) THEN
     1233    IF(s(l-1:l-1)=='-' .AND. INDEX(known_phases,s(l:l)) /= 0) out = s(1:l-2)
     1234  ELSE; i=i-1
     1235    IF(s(i-1:i-1)=='-' .AND. INDEX(known_phases,s(i:i)) /= 0) out = s(1:i-2)//s(i+1:l)
     1236  END IF
    11821237END FUNCTION delPhase
    11831238!------------------------------------------------------------------------------------------------------------------------------
    … …  
    11851240  CHARACTER(LEN=*), INTENT(IN) :: s
    11861241  CHARACTER(LEN=1), INTENT(IN) :: pha
    1187   IF(INDEX(s,'_')==0) THEN; out = TRIM(s)//'-'//pha; RETURN; END IF
    1188   out = TRIM(strHead(s,'_'))//'-'//pha//TRIM(strTail(s,'_'))
     1242  INTEGER :: l, i
     1243  out = s
     1244  IF(s == '') RETURN
     1245  i = INDEX(s, '_'); l = LEN_TRIM(s)
     1246  IF(i == 0) out =  TRIM(s)//'-'//pha
     1247  IF(i /= 0) out = s(1:i-1)//'-'//pha//'_'//s(i+1:l)
    11891248END FUNCTION addPhase_1
    11901249!------------------------------------------------------------------------------------------------------------------------------

  • LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90

    r3852 r3891  
    33  USE       strings_mod, ONLY: msg, fmsg, test, strIdx, int2str
    44
    5   USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate
     5  USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate, delPhase
    66
    77  USE trac_types_mod,    ONLY: tra, iso, kys
    … …  
    7575!  | type       | Type (so far: tracer or tag)                    | /           | tracer,tag             |
    7676!  | phas       | Phases list ("g"as / "l"iquid / "s"olid)        | /           | [g][l][s]              |
     77!  | comp       | Name(s) of the merged/cumulated section(s)      | /           | coma-separated names   |
    7778!  | iadv       | Advection scheme number                         | iadv        | 1-20,30 exc. 3-9,15,19 |
    7879!  | igen       | Generation (>=1)                                | /           |                        |
    … …  
    108109                              nbIso                        !--- Number of available isotopes family
    109110  CHARACTER(LEN=256), SAVE :: type_trac                    !--- Keyword for tracers type
     111!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, type_trac)
    110112
    111113  !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
    … …  
    115117
    116118  !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
    117   TYPE(iso),          SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
    118   INTEGER,            SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
    119   LOGICAL,            SAVE, POINTER :: isoCheck            !--- Flag to trigger the checking routines
    120   TYPE(kys),          SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    121   CHARACTER(LEN=256), SAVE, POINTER :: isoName(:),       & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
    122                                        isoZone(:),       & !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
    123                                        isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
    124   INTEGER,            SAVE          :: niso, nzon, npha, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
    125                                        nitr                !--- NUMBER OF ISOTOPES + ISOTOPIC TAGGING TRACERS
    126   INTEGER,            SAVE, POINTER :: iZonIso(:,:)        !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
    127   INTEGER,            SAVE, POINTER :: iTraPha(:,:)        !=== INDEX IN "isoTrac" AS f(isotopic tracer, phase)
     119  TYPE(iso),          SAVE, POINTER     :: isotope         !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
     120  INTEGER,            SAVE              :: ixIso, iH2O     !--- Index of the selected isotopes family and H2O family
     121  LOGICAL,            SAVE              :: isoCheck        !--- Flag to trigger the checking routines
     122  TYPE(kys),          SAVE, POINTER     :: isoKeys(:)      !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
     123  CHARACTER(LEN=256), SAVE, POINTER     :: isoName(:),   & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
     124                                           isoZone(:),   & !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
     125                                           isoPhas         !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
     126  INTEGER,            SAVE              :: niso, nzon,  & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
     127                                           npha, nitr      !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
     128  INTEGER,            SAVE, POINTER     :: iZonIso(:,:)    !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
     129  INTEGER,            SAVE, POINTER     :: iTraPha(:,:)    !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase)
    128130!$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzon,npha,nitr, iZonIso,iTraPha)
    129131
    … …  
    132134                                        alpha_ideal(:)     !--- Ideal fractionning coefficient (for initial state) (niso)
    133135  INTEGER,            SAVE, ALLOCATABLE :: conv_flg(:),  & !--- Convection     activation ; needed for INCA        (nbtr)
    134                                             pbl_flg(:)     !--- Boundary layer activation ; needed for INCA        (nbtr)
    135   INTEGER,            SAVE, ALLOCATABLE ::    niadv(:),  &
    136                                          itr_indice(:)     !--- Indexes of the tracers passed to phytrac        (nqtottr)
    137   CHARACTER(LEN=256), SAVE, ALLOCATABLE ::   solsym(:)     !--- Names from INCA                                    (nbtr)
    138 !OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, niadv, itr_indice, solsym)
     136                                            pbl_flg(:),  & !--- Boundary layer activation ; needed for INCA        (nbtr)
     137                                         itr_indice(:),  & !--- Indexes of the tracers passed to phytrac        (nqtottr)
     138                                              niadv(:)     !--- Indexes of true tracers  (<=nqtot, such that iadv(idx)>0)
     139  CHARACTER(LEN=8),  SAVE, ALLOCATABLE ::   solsym(:)     !--- Names from INCA                                    (nbtr)
     140!OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, itr_indice, niadv, solsym)
    139141
    140142#ifdef CPP_StratAer
    … …  
    163165  solsym    = solsym_
    164166  nqtot     = SIZE(tracers_)
     167  nqo       = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%igen==1)
    165168  nbtr      = nbtr_
    166169  niadv     = niadv_
    … …  
    169172  conv_flg = conv_flg_
    170173
     174  CALL msg('nqtot = '//TRIM(int2str(nqtot)))
     175  CALL msg('nbtr  = '//TRIM(int2str(nbtr)))
     176  CALL msg('nqo   = '//TRIM(int2str(nqo)))
     177
    171178  !=== Specific to water
    172179  CALL getKey_init(tracers, isotopes)
    173180  IF(.NOT.isoSelect('H2O')) THEN
    174181    iH2O = ixIso
    175     lerr = getKey('tnat' ,tnat,        isoName)
    176     lerr = getKey('alpha',alpha_ideal, isoName)
    177     nqo  = isotope%npha
     182    lerr = getKey('tnat' ,tnat,        isoName(1:isotope%niso))
     183    lerr = getKey('alpha',alpha_ideal, isoName(1:isotope%niso))
    178184  END IF
    179   IF(prt_level > 1) WRITE(lunout,*) TRIM(modname)//": nqtot, nqo, nbtr = ",nqtot, nqo, nbtr
    180185  itr_indice = PACK(tracers(:)%itr, MASK = tracers(:)%itr/=0)
    181 print*,'66'
    182 
    183   !? conv_flg, pbl_flg, solsym
    184   !? isoInit
     186  !? CDC isoInit => A VOIR !!
    185187
    186188#ifdef CPP_StratAer
    … …  
    196198        CASE('GASSO2');   id_SO2_strat   = iq - nqo; CALL msg('id_SO2_strat  =', id_SO2_strat)
    197199        CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat)
    198         CASE('GASTEST');  id_TEST_strat  = iq - nqo; CALL msg('id_TEST_strat=' , id_TEST_strat)
     200        CASE('GASTEST');  id_TEST_strat  = iq - nqo; CALL msg('id_TEST_strat =', id_TEST_strat)
    199201      END SELECT
    200202    END DO
    … …  
    209211!==============================================================================================================================
    210212!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
    211 !     Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first time).
    212 !==============================================================================================================================
    213 LOGICAL FUNCTION isoSelectByName(iName) RESULT(lerr)
    214   CHARACTER(LEN=*), INTENT(IN)  :: iName
     213!     Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first call).
     214!==============================================================================================================================
     215LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
     216  IMPLICIT NONE
     217  CHARACTER(LEN=*),  INTENT(IN)  :: iName
     218  LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    215219  INTEGER :: iIso
     220  LOGICAL :: lV
     221  lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    216222  iIso = strIdx(isotopes(:)%prnt, iName)
    217   IF(test(fmsg(iIso == 0,'no isotope family named "'//TRIM(iName)//'"'),lerr)) RETURN
    218   IF(isoSelectByIndex(iIso)) RETURN
     223  lerr = iIso == 0
     224  CALL msg(lerr .AND. lV, 'no isotope family named "'//TRIM(iName)//'"')
     225  IF(lerr) RETURN
     226  lerr = isoSelectByIndex(iIso)
    219227END FUNCTION isoSelectByName
    220228!==============================================================================================================================
    221 LOGICAL FUNCTION isoSelectByIndex(iIso) RESULT(lerr)
    222   INTEGER, INTENT(IN) :: iIso
     229LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
     230  IMPLICIT NONE
     231  INTEGER,           INTENT(IN) :: iIso
     232  LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     233  LOGICAL :: lv
     234  lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
    223235  lerr = .FALSE.
    224236  IF(iIso == ixIso) RETURN                                      !--- Nothing to do if the index is already OK
    225   IF(test(fmsg(iIso<=0 .OR. iIso>=nbIso,'Inconsistent isotopes family index '//TRIM(int2str(iIso))),lerr)) RETURN
     237  lerr = iIso<=0 .OR. iIso>nbIso
     238  CALL msg(lerr .AND. lV, 'Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= ' &
     239                                                               //TRIM(int2str(nbIso))//'"')
     240  IF(lerr) RETURN
    226241  ixIso = iIso                                                  !--- Update currently selected family index
    227242  isotope => isotopes(ixIso)                                    !--- Select corresponding component
    228   !--- VARIOUS ALIASES
    229   isoKeys => isotope%keys; niso = isotope%niso
    230   isoName => isotope%trac; nitr = isotope%nitr; isoCheck => isotope%check
    231   isoZone => isotope%zone; nzon = isotope%nzon; iZonIso  => isotope%iZonIso
    232   isoPhas => isotope%phas; npha = isotope%npha; iTraPha  => isotope%iTraPha
     243  isoKeys => isotope%keys;    niso     = isotope%niso
     244  isoName => isotope%trac;    nitr     = isotope%nitr
     245  isoZone => isotope%zone;    nzon     = isotope%nzon
     246  isoPhas => isotope%phas;    npha     = isotope%npha
     247  iZonIso => isotope%iZonIso; isoCheck = isotope%check
     248  iTraPha => isotope%iTraPha
    233249END FUNCTION isoSelectByIndex
    234250!==============================================================================================================================

  • LMDZ6/branches/LMDZ-tracers/libf/phylmd/phyetat0.F90

    r3852 r3891  
    443443!!        iiq=niadv(it+2)                                                           ! jyg
    444444        iiq=niadv(it+nqo)                                                           ! jyg
    445         found=phyetat0_get(1,trs(:,it),"trs_"//tracers(iiq)%name, &
    446               "Surf trac"//tracers(iiq)%name,0.)
     445        found=phyetat0_get(1,trs(:,it),"trs_"//TRIM(tracers(iiq)%name), &
     446              "Surf trac"//TRIM(tracers(iiq)%name),0.)
    447447     ENDDO
    448448     CALL traclmdz_from_restart(trs)
    … …  
    591591   CALL get_field(name, field, found)
    592592   IF (.NOT. found) THEN
    593      WRITE(lunout,*) "phyetat0: Le champ <",name,"> est absent"
     593     WRITE(lunout,*) "phyetat0: Le champ <",TRIM(name),"> est absent"
    594594     WRITE(lunout,*) "Depart legerement fausse. Mais je continue"
    595595     field(:,:)=default
    596596   ENDIF
    597    WRITE(lunout,*) name, descr, MINval(field),MAXval(field)
     597   WRITE(lunout,*) TRIM(name), descr, MINval(field),MAXval(field)
    598598   phyetat0_get=found
    599599
Note: See TracChangeset for help on using the changeset viewer.