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.
File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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!==============================================================================================================================
Note: See TracChangeset for help on using the changeset viewer.