Ignore:
Timestamp:
Nov 7, 2022, 3:09:43 AM (3 years ago)
Author:
dcugnet
Message:
  • simplify the parser usage:
    • the getKey_init routine is now embedded in the readTracersFile routine.
    • the initIsotopes routine is now embedded in the readIsotopesFile routine.
    • the database is now unique, but can be changed using the get/setKeysDBase.
    • the derived types descriptions, originally located in trac_types_mod, are moved to readTracFiles_mod.
    • few checkings moved from infotrac to the routine testIsotopes, contained in the readIsotopesFile function from readTracFiles_mod.
    • the readTracersFiles and readIsotopesFile routines no longer use a tracers/isotopes argument.
  • remove tnat and alpha_ideal from infotrac ; use instead getKey to get them where they are used (check_isotopes, dynetat0, iniacademic)
  • the trac_type field %Childs is renamed %Children
  • move the isoSelect routine and the corresponding variables routine from infotrac and infotrac_phy to readTracFiles_mod
  • infotrac_phy routine is now fully independant of the (very similar) routine infotrac (init_infotrac_phy has no arguments left).
  • all the explicit keys of the trac_type are now included in the embedded keys database, accessible using the getKey function.
  • the getKey/addKey routines are expanded to handle vectors of integers, reals, logicals or strings.
  • few subroutines converted into functions with error return value.
  • corrections for isotopic tagging tracers mode (to be continued).
Location:
LMDZ6/trunk/libf/phylmd
Files:
4 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/phylmd/dyn1d/old_lmdz1d.F90

    r4110 r4325  
    613613      call init_dimphy1D(1,llm)
    614614      call suphel
    615       call infotrac_init
     615      call init_infotrac
    616616
    617617      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'

  • LMDZ6/trunk/libf/phylmd/dyn1d/scm.F90

    r4297 r4325  
    393393      call init_dimphy1D(1,llm)
    394394      call suphel
    395       call infotrac_init
     395      call init_infotrac
    396396
    397397      if (nqtot>nqmx) STOP 'Augmenter nqmx dans lmdz1d.F'

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

    r4293 r4325  
    1 
    2 ! $Id: $
    3 
     1!$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $
     2!
    43MODULE infotrac_phy
    54
    6    USE       strings_mod, ONLY: msg, maxlen, strStack, strHead, strParse, strIdx, int2str
    7    USE readTracFiles_mod, ONLY: trac_type, isot_type, keys_type, delPhase, getKey, tnom_iso => newH2OIso
    8 
     5   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
     6   USE readTracFiles_mod, ONLY: trac_type, nphas, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, &
     7                        getKey, isot_type, nzone, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, &
     8                   indexUpdate, isoSelect, niso,  testTracersFiles, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck
    99   IMPLICIT NONE
    1010
    … …  
    2222
    2323   !=== FOR ISOTOPES: General
    24    PUBLIC :: isotopes, nbIso                              !--- Derived type, full isotopes families database + nb of families
     24   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    2525   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
    2626   !=== FOR ISOTOPES: Specific to water
    … …  
    3030   PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
    3131   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
    32    PUBLIC :: itZonIso                                      !--- iq = function(tagging zone idx, isotope idx)
    33    PUBLIC :: iqIsoPha                                      !--- idx of tagging tracer in iName = function(isotope idx, phase idx)
     32   PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
     33   PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
    3434   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
    3535   !=== FOR BOTH TRACERS AND ISOTOPES
    3636   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
    37 
    38    INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
    3937
    4038!=== CONVENTIONS FOR TRACERS NUMBERS:
    … …  
    7270!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
    7371!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
    74 !  | iadv        | Advection scheme number                              | iadv        | 1-20,30 exc. 3-9,15,19 |
    7572!  | iGeneration | Generation (>=1)                                     | /           |                        |
    76 !  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
    7773!  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
    7874!  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |
    7975!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
    8076!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    81 !  | nqChilds    | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
     77!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    8278!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    8379!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    … …  
    10298
    10399   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
    104    INTEGER,                 SAVE :: nqtot,  &                   !--- Tracers nb in dynamics (incl. higher moments + H2O)
    105                                     nbtr,   &                   !--- Tracers nb in physics  (excl. higher moments + H2O)
    106                                     nqo,    &                   !--- Number of water phases
    107                                     nbIso,  &                   !--- Number of available isotopes family
    108                                     nqtottr, &                  !--- Number of tracers passed to phytrac (TO BE DELETED ?)
    109                                     nqCO2                       !--- Number of tracers of CO2  (ThL)
    110    CHARACTER(LEN=maxlen),   SAVE :: type_trac                   !--- Keyword for tracers type
    111    CHARACTER(LEN=maxlen),   SAVE, ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type
    112 !$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, nqtottr, nqCO2, type_trac, types_trac)
    113 
    114    !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
    115    TYPE(trac_type), TARGET, SAVE, ALLOCATABLE ::  tracers(:)    !=== TRACERS DESCRIPTORS VECTOR
    116    TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:)    !=== ISOTOPES PARAMETERS VECTOR
    117 !$OMP THREADPRIVATE(tracers, isotopes)
    118 
    119    !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
    120    TYPE(isot_type),         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          :: isoCheck           !--- Flag to trigger the checking routines
    123    TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)         !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    124    CHARACTER(LEN=maxlen),   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, nzone, &    !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
    128                                              nphas, ntiso       !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
    129    INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &    !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
    130                                             iqIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    131 !$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqIsoPha)
    132 
    133    !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
    134    INTEGER,          SAVE,    ALLOCATABLE ::conv_flg(:),  &     !--- Convection     activation ; needed for INCA        (nbtr)
    135                                              pbl_flg(:)         !--- Boundary layer activation ; needed for INCA        (nbtr)
     100   INTEGER,               SAVE :: nqtot,  &                     !--- Tracers nb in dynamics (incl. higher moments + H2O)
     101                                  nbtr,   &                     !--- Tracers nb in physics  (excl. higher moments + H2O)
     102                                  nqo,    &                     !--- Number of water phases
     103                                  nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
     104                                  nqCO2                         !--- Number of tracers of CO2  (ThL)
     105   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
     106   CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:)    !--- Keyword for tracers type(s), parsed version
     107!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac, types_trac)
     108
     109   !=== VARIABLES FOR INCA
     110   INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
     111                                                pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)
    136112!$OMP THREADPRIVATE(conv_flg, pbl_flg)
    137113
    … …  
    146122CONTAINS
    147123
    148 SUBROUTINE init_infotrac_phy(type_trac_, tracers_, isotopes_, nqtottr_, nqCO2_, pbl_flg_, conv_flg_)
    149 
    150    USE print_control_mod, ONLY: prt_level, lunout
    151 
     124SUBROUTINE init_infotrac_phy
     125   USE control_mod, ONLY: planet_type, config_inca
     126   USE ioipsl_getin_p_mod, ONLY: getin_p
     127#ifdef REPROBUS
     128   USE CHEM_REP,    ONLY: Init_chem_rep_trac
     129#endif
    152130   IMPLICIT NONE
    153    CHARACTER(LEN=*),INTENT(IN) :: type_trac_
    154    TYPE(trac_type), INTENT(IN) ::  tracers_(:)
    155    TYPE(isot_type), INTENT(IN) :: isotopes_(:)
    156    INTEGER,         INTENT(IN) :: nqtottr_
    157    INTEGER,         INTENT(IN) :: nqCO2_
    158    INTEGER,         INTENT(IN) :: conv_flg_(:)
    159    INTEGER,         INTENT(IN) ::  pbl_flg_(:)
    160 
    161    INTEGER :: iq, ixt
     131!==============================================================================================================================
     132!
     133!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
     134!   -------
     135!
     136!   Modifications:
     137!   --------------
     138!   05/94: F.Forget      Modif special traceur
     139!   02/02: M-A Filiberti Lecture de traceur.def
     140!   01/22: D. Cugnet     Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
     141!
     142!   Objet:
     143!   ------
     144!   GCM LMD nouvelle grille
     145!
     146!==============================================================================================================================
     147!   ... modification de l'integration de q ( 26/04/94 ) ....
     148!------------------------------------------------------------------------------------------------------------------------------
     149! Declarations:
     150   INCLUDE "dimensions.h"
     151   INCLUDE "iniprint.h"
     152
     153!------------------------------------------------------------------------------------------------------------------------------
     154! Local variables
     155   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
     156#ifdef INCA
     157   INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
     158                           vad (:), vadv_inca(:),  pbl_flg_inca(:)
     159   CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
     160   INTEGER :: nqINCA
     161#endif
    162162#ifdef CPP_StratAer
    163163   CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
    164164#endif
    165    CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy"
    166 
    167    type_trac = type_trac_
    168    IF(strParse(type_trac, '|', types_trac)) CALL abort_physic(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
    169    tracers   = tracers_
    170    isotopes  = isotopes_
    171    nqtottr   = nqtottr_
    172    nqCO2     = nqCO2_
    173    pbl_flg   =  pbl_flg_
    174    conv_flg  = conv_flg_
    175    nqtot     = SIZE(tracers_)
    176    nqo       = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%iGeneration==0 .AND. tracers%component=='lmdz')
    177    nbtr      = SIZE(conv_flg)
    178    nbIso     = SIZE(isotopes_)
    179 
    180    !=== Determine selected isotopes class related quantities:
    181    !    ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqIsoPha, isoCheck
    182    IF(.NOT.isoSelect('H2O')) iH2O = ixIso
    183    IF(prt_level > 1) THEN
    184       CALL msg('nqtot   = '//TRIM(int2str(nqtot)),   modname)
    185       CALL msg('nbtr    = '//TRIM(int2str(nbtr )),   modname)
    186       CALL msg('nqo     = '//TRIM(int2str(nqo  )),   modname)
    187       CALL msg('niso    = '//TRIM(int2str(niso )),   modname)
    188       CALL msg('ntiso   = '//TRIM(int2str(ntiso)),   modname)
    189       CALL msg('nqtottr = '//TRIM(int2str(nqtottr)), modname)
    190       CALL msg('nqCO2   = '//TRIM(int2str(nqCO2)),   modname)
    191    END IF
    192 
     165   CHARACTER(LEN=2)      ::   suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
     166   CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags
     167   CHARACTER(LEN=maxlen) :: msg1                                     !--- String for messages
     168   INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
     169                                                                     !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
     170   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
     171   INTEGER :: iad                                                    !--- Advection scheme number
     172   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
     173   LOGICAL :: lerr, ll, lRepr, lInit
     174   CHARACTER(LEN=1) :: p
     175   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
     176   TYPE(trac_type), POINTER             :: t1, t(:)
     177   INTEGER :: ierr
     178
     179   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"
     180!------------------------------------------------------------------------------------------------------------------------------
     181! Initialization :
     182!------------------------------------------------------------------------------------------------------------------------------
     183   suff          = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
     184   descrq( 1: 2) = ['LMV','BAK']
     185   descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH','   ','PPM','PPS','PPP','   ','SLP']
     186   descrq(30)    =  'PRA'
     187
     188   CALL getin_p('type_trac',type_trac)
     189   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
     190   IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
     191   lInit = .NOT.ALLOCATED(tracers)
     192
     193!##############################################################################################################################
     194   IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
     195!##############################################################################################################################
     196   !---------------------------------------------------------------------------------------------------------------------------
     197   DO it = 1, nt                                                     !--- nt>1=> "type_trac": coma-separated keywords list
     198   !---------------------------------------------------------------------------------------------------------------------------
     199      !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
     200      msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":'
     201      SELECT CASE(types_trac(it))
     202         CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname)
     203         CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle',  modname)
     204         CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model',    modname)
     205         CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle',     modname)
     206         CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
     207         CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only',          modname)
     208         CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1)
     209      END SELECT
     210
     211      !--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
     212      IF(ANY(['inca', 'inco'] == types_trac(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) &
     213         CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1)
     214
     215      !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
     216      SELECT CASE(types_trac(it))
     217         CASE('inca', 'inco')
     218#ifndef INCA
     219            CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
     220#endif
     221         CASE('repr')
     222#ifndef REPROBUS
     223            CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
     224#endif
     225         CASE('coag')
     226#ifndef CPP_StratAer
     227            CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
     228#endif
     229      END SELECT
     230
     231   !---------------------------------------------------------------------------------------------------------------------------
     232   END DO
     233   !---------------------------------------------------------------------------------------------------------------------------
     234
     235!##############################################################################################################################
     236   END IF
     237!##############################################################################################################################
     238
     239   !--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none"
     240   IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', &
     241         modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none'
     242
     243   nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] )
     244
     245!==============================================================================================================================
     246! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
     247!==============================================================================================================================
     248   lRepr = ANY(types_trac(:) == 'repr')
     249!##############################################################################################################################
     250   IF(lInit) THEN
     251     IF(readTracersFiles(type_trac,  fType,  lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
     252   ELSE
     253     IF(testTracersFiles(modname, type_trac, fType)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
     254   END IF
     255!##############################################################################################################################
     256
     257   !---------------------------------------------------------------------------------------------------------------------------
     258   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
     259   !---------------------------------------------------------------------------------------------------------------------------
     260   IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN  !=== OLD STYLE INCA "traceur.def" (single type_trac)
     261   !---------------------------------------------------------------------------------------------------------------------------
     262#ifdef INCA
     263      nqo = SIZE(tracers) - nqCO2
     264      CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
     265      nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
     266      nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
     267      IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
     268      ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
     269      ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
     270      CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
     271      ALLOCATE(ttr(nqtrue))
     272      ttr(1:nqo+nqCO2)                    = tracers
     273      ttr(1    :      nqo   )%component   = 'lmdz'
     274      ttr(1+nqo:nqCO2+nqo   )%component   = 'co2i'
     275      ttr(1+nqo+nqCO2:nqtrue)%component   = 'inca'
     276      ttr(1+nqo      :nqtrue)%name        = [('CO2     ', k=1, nqCO2), solsym_inca]
     277      ttr(1+nqo+nqCO2:nqtrue)%parent      = tran0
     278      ttr(1+nqo+nqCO2:nqtrue)%phase       = 'g'
     279      lerr = getKey('hadv', had, ky=tracers(:)%keys)
     280      lerr = getKey('vadv', vad, ky=tracers(:)%keys)
     281      hadv(1:nqo) = had(:); hadv(nqo+1:nqtrue) = hadv_inca
     282      vadv(1:nqo) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca
     283      CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
     284      CALL setGeneration(tracers)                                    !--- SET FIELDS %iGeneration, %gen0Name
     285      DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
     286#endif
     287   !---------------------------------------------------------------------------------------------------------------------------
     288   ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
     289   !---------------------------------------------------------------------------------------------------------------------------
     290      nqo    =        COUNT(delPhase(tracers(:)%name)     == 'H2O' &
     291                               .AND. tracers(:)%component == 'lmdz') !--- Number of water phases
     292      nqtrue = SIZE(tracers)                                         !--- Total number of "true" tracers
     293      nbtr   = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
     294                               .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
     295#ifdef INCA
     296      nqINCA = COUNT(tracers(:)%component == 'inca')
     297#endif
     298      lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
     299      lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
     300   !---------------------------------------------------------------------------------------------------------------------------
     301   END IF
     302   !---------------------------------------------------------------------------------------------------------------------------
     303
     304   !--- Transfert the number of tracers to Reprobus
     305#ifdef REPROBUS
     306   CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
     307#endif
     308
     309!##############################################################################################################################
     310   IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
     311!##############################################################################################################################
     312
     313!==============================================================================================================================
     314! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
     315!==============================================================================================================================
     316   DO iq = 1, nqtrue
     317      IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
     318      WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
     319      CALL abort_gcm(modname, TRIM(msg1), 1)
     320   END DO
     321   nqtot =    COUNT( hadv< 20 .AND. vadv< 20 ) &                     !--- No additional tracer
     322         +  4*COUNT( hadv==20 .AND. vadv==20 ) &                     !--- 3  additional tracers
     323         + 10*COUNT( hadv==30 .AND. vadv==30 )                       !--- 9  additional tracers
     324
     325   !--- More tracers due to the choice of advection scheme => assign total number of tracers
     326   IF( nqtot /= nqtrue ) THEN
     327      CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
     328      CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
     329      CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
     330   END IF
     331
     332!==============================================================================================================================
     333! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot.
     334!==============================================================================================================================
     335   ALLOCATE(ttr(nqtot))
     336   jq = nqtrue+1; tracers(:)%iadv = -1
     337   DO iq = 1, nqtrue
     338      t1 => tracers(iq)
     339
     340      !--- VERIFY THE CHOICE OF ADVECTION SCHEME
     341      iad = -1
     342      IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
     343      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
     344      WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
     345      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
     346
     347      !--- SET FIELDS %longName, %isInPhysics
     348      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
     349      t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
     350                          .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
     351      ttr(iq)       = t1
     352
     353      !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
     354      nm = 0
     355      IF(iad == 20) nm = 3                                           !--- 2nd order scheme
     356      IF(iad == 30) nm = 9                                           !--- 3rd order scheme
     357      IF(nm == 0) CYCLE                                              !--- No higher moments
     358      ttr(jq+1:jq+nm)             = t1
     359      ttr(jq+1:jq+nm)%name        = [(TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
     360      ttr(jq+1:jq+nm)%parent      = [(TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
     361      ttr(jq+1:jq+nm)%longName    = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
     362      jq = jq + nm
     363   END DO
     364   DEALLOCATE(hadv, vadv)
     365   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
     366
     367   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
     368   CALL indexUpdate(tracers)
     369
     370!##############################################################################################################################
     371   END IF
     372!##############################################################################################################################
     373
     374!##############################################################################################################################
     375   IF(.NOT.lInit) THEN
     376!##############################################################################################################################
     377     nqtot = SIZE(tracers)
     378!##############################################################################################################################
     379   ELSE
     380!##############################################################################################################################
     381
     382   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
     383   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     384   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
     385
     386!##############################################################################################################################
     387   END IF
     388!##############################################################################################################################
     389   !--- Convection / boundary layer activation for all tracers
     390   ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
     391   ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
     392
     393   !--- Note: nqtottr can differ from nbtr when nmom/=0
     394   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
     395   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
     396      CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
     397
     398   !=== DISPLAY THE RESULTS
     399!   IF(prt_level > 1) THEN
     400      CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     401      CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     402      CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     403      CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     404      CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     405      CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     406#ifdef INCA
     407      CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
     408      CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
     409#endif
     410!   END IF
     411   t => tracers
     412   CALL msg('Information stored in infotrac_phy :', modname)
     413   IF(dispTable('issssssssiiiiiiii', &
     414      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ',           &
     415                 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
     416      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
     417      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
     418                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
     419      CALL abort_gcm(modname, "problem with the tracers table content", 1)
     420   IF(niso > 0) THEN
     421      CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
     422      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
     423      CALL msg('  isoName = '//strStack(isoName),      modname)
     424      CALL msg('  isoZone = '//strStack(isoZone),      modname)
     425      CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
     426   ELSE
     427      CALL msg('No isotopes identified.', modname)
     428   END IF
     429
     430#ifdef ISOVERIF
     431   CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
     432#endif
    193433#ifdef CPP_StratAer
    194434   IF (ANY(types_trac == 'coag')) THEN
    … …  
    210450   END IF
    211451#endif
    212 #ifdef ISOVERIF
    213    CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
    214 #endif
     452   CALL msg('end', modname)
    215453
    216454END SUBROUTINE init_infotrac_phy
    217455
    218 
    219 !==============================================================================================================================
    220 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
    221 !     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
    222 !==============================================================================================================================
    223 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
    224    IMPLICIT NONE
    225    CHARACTER(LEN=*),  INTENT(IN)  :: iName
    226    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    227    INTEGER :: iIso
    228    LOGICAL :: lV
    229    lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    230    iIso = strIdx(isotopes(:)%parent, iName)
    231    lerr = iIso == 0
    232    IF(lerr) THEN
    233       niso = 0; ntiso = 0; nzone=0; nphas=nqo; isoCheck=.FALSE.
    234       CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
    235       RETURN
    236    END IF
    237    lerr = isoSelectByIndex(iIso, lV)
    238 END FUNCTION isoSelectByName
    239 !==============================================================================================================================
    240 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
    241    IMPLICIT NONE
    242    INTEGER,           INTENT(IN) :: iIso
    243    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    244    LOGICAL :: lv
    245    lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
    246    lerr = .FALSE.
    247    IF(iIso == ixIso) RETURN                                      !--- Nothing to do if the index is already OK
    248    lerr = iIso<=0 .OR. iIso>nbIso
    249    CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',&
    250             ll=lerr .AND. lV)
    251    IF(lerr) RETURN
    252    ixIso = iIso                                                  !--- Update currently selected family index
    253    isotope  => isotopes(ixIso)                                   !--- Select corresponding component
    254    isoKeys  => isotope%keys;     niso     = isotope%niso
    255    isoName  => isotope%trac;     ntiso    = isotope%ntiso
    256    isoZone  => isotope%zone;     nzone    = isotope%nzone
    257    isoPhas  => isotope%phase;    nphas    = isotope%nphas
    258    itZonIso => isotope%itZonIso; isoCheck = isotope%check
    259    iqIsoPha => isotope%iqIsoPha
    260 END FUNCTION isoSelectByIndex
    261 !==============================================================================================================================
    262 
    263 
    264456END MODULE infotrac_phy

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

    r4124 r4325  
    175175    it = 0
    176176    DO iq = 1, nqtot
    177        IF(.NOT.(tracers(iq)%isAdvected .AND. tracers(iq)%isInPhysics)) CYCLE
     177       IF(.NOT.(tracers(iq)%isInPhysics)) CYCLE
    178178       it = it+1
    179179       SELECT CASE(strLower(tracers(iq)%name))
Note: See TracChangeset for help on using the changeset viewer.