Changeset 4325


Ignore:
Timestamp:
Nov 7, 2022, 3:09:43 AM (20 months 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
Files:
1 deleted
26 edited

Legend:

Unmodified
Added
Removed

  • LMDZ6/trunk/libf/dyn3d/check_isotopes.F90

    r4143 r4325  
    22   USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
    33   USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
    4                           ntiso, iH2O, nzone, tracers, isoName,  itZonIso, tnat
     4                          ntiso, iH2O, nzone, tracers, isoName,  itZonIso, getKey
    55   IMPLICIT NONE
    66   include "dimensions.h"
    … …  
    1010   CHARACTER(LEN=maxlen) :: modname, msg1, nm(2)
    1111   INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau, iqpar
    12    INTEGER, ALLOCATABLE :: ix(:)
     12   INTEGER, ALLOCATABLE ::   ix(:)
     13   REAL,    ALLOCATABLE :: tnat(:)
    1314   REAL    :: xtractot, xiiso, deltaD, q1, q2
    1415   REAL, PARAMETER :: borne     = 1e19,  &
    … …  
    3334      iso_O17 = strIdx(isoName,'H2[17]O')
    3435      iso_HTO = strIdx(isoName,'H[3]HO')
     36      IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
    3537      first = .FALSE.
    3638   END IF

  • LMDZ6/trunk/libf/dyn3d/dynetat0.F90

    r4301 r4325  
    66! Purpose: Initial state reading.
    77!-------------------------------------------------------------------------------
    8   USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O
     8  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    99  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str
    1010  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQ_VARID, &
    1111                         NF90_CLOSE, NF90_GET_VAR, NF90_NoErr
    12   USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3
     12  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
    1313  USE control_mod, ONLY: planet_type
    1414  USE assert_eq_m, ONLY: assert_eq
    … …  
    4141  INTEGER, PARAMETER :: length=100
    4242  INTEGER :: iq, fID, vID, idecal, iqParent, iName, iZone, iPhase
    43   REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
     43  REAL    :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
    4444  LOGICAL :: lSkip, ll
    4545!-------------------------------------------------------------------------------
    … …  
    155155      iqParent = tracers(iq)%iqParent
    156156      IF(tracers(iq)%iso_iZone == 0) THEN
     157         IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
     158            CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    157159         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
    158          q(:,:,:,iq) = q(:,:,:,iqParent)*tnat(iName)*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
     160         q(:,:,:,iq) = q(:,:,:,iqParent)*tnat*(q(:,:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
    159161      ELSE
    160162         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)

  • LMDZ6/trunk/libf/dyn3d/gcm.F90

    r3579 r4325  
    2020
    2121  USE filtreg_mod
    22   USE infotrac
     22  USE infotrac, ONLY: nqtot, init_infotrac
    2323  USE control_mod
    2424  USE mod_const_mpi, ONLY: COMM_LMDZ
    … …  
    205205  !  Choix du nombre de traceurs et du schema pour l'advection
    206206  !  dans fichier traceur.def, par default ou via INCA
    207   call infotrac_init
     207  call init_infotrac
    208208
    209209  ! Allocation de la tableau q : champs advectes   

  • LMDZ6/trunk/libf/dyn3d/iniacademic.F90

    r4143 r4325  
    55
    66  USE filtreg_mod, ONLY: inifilr
    7   USE infotrac,    ONLY: nqtot, niso, tnat, alpha_ideal, iqIsoPha, tracers
     7  USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
    88  USE control_mod, ONLY: day_step,planet_type
    99  use exner_hyb_m, only: exner_hyb
    … …  
    7373  integer idum
    7474
    75   REAL zdtvr
     75  REAL zdtvr, tnat, alpha_ideal
    7676 
    7777  character(len=*),parameter :: modname="iniacademic"
    … …  
    286286              iqParent = tracers(iq)%iqParent
    287287              IF(tracers(iq)%iso_iZone == 0) THEN
    288                  q(:,:,iq) = q(:,:,iqParent)*tnat(iName)*(q(:,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
     288                 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
     289                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
     290                 q(:,:,iq) = q(:,:,iqParent)*tnat*(q(:,:,iqParent)/30.e-3)**(alpha_ideal-1.)
    289291              ELSE
    290292                 q(:,:,iq) = q(:,:,iqIsoPha(iName,iPhase))

  • LMDZ6/trunk/libf/dyn3d/vlsplt.F

    r4143 r4325  
    437437        enddo
    438438      enddo
    439       do ifils=1,tracers(iq)%nqChilds
     439      do ifils=1,tracers(iq)%nqChildren
    440440        iq2=tracers(iq)%iqDescen(ifils)
    441441        call vlx(Ratio,pente_max,masseq,u_mq,iq2)
    … …  
    969969! CRisi: appel récursif de l'advection sur les fils.
    970970! Il faut faire ça avant d'avoir mis à jour q et masse
    971       !write(*,*) 'vlsplt 942: iq,nqChilds(iq)=',iq,nqChilds(iq)
     971      !write(*,*) 'vlsplt 942: iq,nqChildren(iq)=',iq,nqChildren(iq)
    972972      do ifils=1,tracers(iq)%nqDescen
    973973        iq2=tracers(iq)%iqDescen(ifils)
    … …  
    987987      enddo
    988988       
    989       do ifils=1,tracers(iq)%nqChilds
     989      do ifils=1,tracers(iq)%nqChildren
    990990        iq2=tracers(iq)%iqDescen(ifils)
    991991        call vlz(Ratio,pente_max,masseq,wq,iq2)

  • LMDZ6/trunk/libf/dyn3d/vlspltqs.F

    r4052 r4325  
    479479! CRisi: appel récursif de l'advection sur les fils.
    480480! Il faut faire ça avant d'avoir mis à jour q et masse
    481       !write(*,*) 'vlspltqs 326: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
     481      !write(*,*) 'vlspltqs 326: iq,nqChildren(iq)=',iq,
     482!     &                 tracers(iq)%nqChildren
    482483     
    483484      do ifils=1,tracers(iq)%nqDescen
    … …  
    491492        enddo
    492493      enddo
    493       do ifils=1,tracers(iq)%nqChilds
     494      do ifils=1,tracers(iq)%nqChildren
    494495        iq2=tracers(iq)%iqDescen(ifils)
    495496        call vlx(Ratio,pente_max,masseq,u_mq,iq2)
    … …  
    786787! CRisi: appel récursif de l'advection sur les fils.
    787788! Il faut faire ça avant d'avoir mis à jour q et masse
    788       !write(*,*) 'vlyqs 689: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
     789      !write(*,*) 'vlyqs 689: iq,nqChildren(iq)=',iq,
     790!     &              tracers(iq)%nqChildren
    789791   
    790792      do ifils=1,tracers(iq)%nqDescen
    … …  
    797799        enddo
    798800      enddo
    799       do ifils=1,tracers(iq)%nqChilds
     801      do ifils=1,tracers(iq)%nqChildren
    800802        iq2=tracers(iq)%iqDescen(ifils)
    801803        !write(*,*) 'vlyqs 783: appel rec de vly, iq2=',iq2

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

    r4301 r4325  
    33MODULE infotrac
    44
    5    USE       strings_mod, ONLY: msg, find, strIdx,  strFind, strParse, dispTable, int2str,  reduceExpr, &
    6                           cat, fmsg, test, strTail, strHead, strStack, strReduce, bool2str, maxlen, testFile
    7    USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, indexUpdate, addPhase, getKey, maxTableWidth, keys_type, &
    8                                 isot_type, setGeneration,   initIsotopes, delPhase, getKey_init, ancestor, tran0
    9                                
     5   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
     6   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, &
     7                        getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, &
     8                   indexUpdate, isoSelect, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck, nphas, nzone, niso
    109   IMPLICIT NONE
    1110
    … …  
    1312
    1413   !=== FOR TRACERS:
    15    PUBLIC :: infotrac_init                                 !--- Initialization of the tracers
     14   PUBLIC :: init_infotrac                                 !--- Initialization of the tracers
    1615   PUBLIC :: tracers, type_trac, types_trac                !--- Full tracers database, tracers type keyword
    1716   PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
    … …  
    1918
    2019   !=== FOR ISOTOPES: General
    21    PUBLIC :: isotopes, nbIso                              !--- Derived type, full isotopes families database + nb of families
     20   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
    2221   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
    2322   !=== FOR ISOTOPES: Specific to water
    24    PUBLIC :: iH2O, tnat, alpha_ideal                       !--- H2O isotopes index, natural abundance, fractionning coeff.
     23   PUBLIC :: iH2O                                          !--- H2O isotopes class index
    2524   PUBLIC :: min_qParent, min_qMass, min_ratio             !--- Min. values for various isotopic quantities
    2625   !=== FOR ISOTOPES: Depending on the selected isotopes family
    … …  
    3332   !=== FOR BOTH TRACERS AND ISOTOPES
    3433   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
    35 
    36    INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
    3734
    3835!=== CONVENTIONS FOR TRACERS NUMBERS:
    … …  
    7774!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
    7875!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
    79 !  | nqChilds    | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
     76!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
    8077!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
    8178!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
    … …  
    10299
    103100   !=== 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(s)
    111    CHARACTER(LEN=maxlen),   SAVE, ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
    112 
    113    !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
    114    TYPE(trac_type), TARGET, SAVE, ALLOCATABLE ::  tracers(:)    !=== TRACERS DESCRIPTORS VECTOR
    115    TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:)    !=== ISOTOPES PARAMETERS VECTOR
    116 
    117    !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
    118    TYPE(isot_type),         SAVE, POINTER :: isotope            !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
    119    INTEGER,                 SAVE          :: ixIso, iH2O        !--- Index of the selected isotopes family and H2O family
    120    LOGICAL,                 SAVE          :: isoCheck           !--- Flag to trigger the checking routines
    121    TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)         !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
    122    CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &    !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
    123                                              isoZone(:),   &    !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
    124                                              isoPhas            !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
    125    INTEGER,                 SAVE          ::  niso, nzone, &    !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
    126                                              nphas, ntiso       !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
    127    INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &    !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
    128                                             iqIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
    129 
    130    !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
    131    REAL,                SAVE, ALLOCATABLE ::     tnat(:), &     !--- Natural relative abundance of water isotope        (niso)
    132                                           alpha_ideal(:)        !--- Ideal fractionning coefficient (for initial state) (niso)
    133    INTEGER,             SAVE, ALLOCATABLE :: conv_flg(:), &     !--- Convection     activation ; needed for INCA        (nbtr)
    134                                               pbl_flg(:)        !--- Boundary layer activation ; needed for INCA        (nbtr)
     101   INTEGER,               SAVE :: nqtot,  &                     !--- Tracers nb in dynamics (incl. higher moments + H2O)
     102                                  nbtr,   &                     !--- Tracers nb in physics  (excl. higher moments + H2O)
     103                                  nqo,    &                     !--- Number of water phases
     104                                  nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)
     105                                  nqCO2                         !--- Number of tracers of CO2  (ThL)
     106   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)
     107   CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:)    !--- Keyword for tracers type(s), parsed version
     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)
    135112
    136113CONTAINS
    137114
    138 SUBROUTINE infotrac_init
     115SUBROUTINE init_infotrac
    139116   USE control_mod, ONLY: planet_type, config_inca
    140117#ifdef REPROBUS
    … …  
    180157   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
    181158   INTEGER :: iad                                                    !--- Advection scheme number
    182    INTEGER :: ic, ip, np, iq, jq, it, nt, im, nm, ix, iz, nz, k      !--- Indexes and temporary variables
     159   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
    183160   LOGICAL :: lerr, ll, lRepr
    184161   CHARACTER(LEN=1) :: p
    185162   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
    186163   TYPE(trac_type), POINTER             :: t1, t(:)
    187    TYPE(isot_type), POINTER             :: iso
    188164   INTEGER :: ierr
    189165
    190    CHARACTER(LEN=*), PARAMETER :: modname="infotrac_init"
     166   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
    191167!------------------------------------------------------------------------------------------------------------------------------
    192168! Initialization :
    … …  
    249225!==============================================================================================================================
    250226   lRepr = ANY(types_trac(:) == 'repr')
    251    IF(readTracersFiles(type_trac, fType, tracers, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
     227   IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
    252228   !---------------------------------------------------------------------------------------------------------------------------
    253229   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
    … …  
    297273   !---------------------------------------------------------------------------------------------------------------------------
    298274
    299    CALL getKey_init(tracers)
    300 
    301275   !--- Transfert the number of tracers to Reprobus
    302276#ifdef REPROBUS
    … …  
    377351   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
    378352
    379    !--- SET FIELDS %iqParent, %nqChilds, %iGeneration, %iqDescen, %nqDescen
     353   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
    380354   CALL indexUpdate(tracers)
    381355
    … …  
    401375   END DO
    402376
    403    niso = 0; nzone=0; nphas=nqo; ntiso = 0; isoCheck=.FALSE.
    404    IF(initIsotopes(tracers, isotopes)) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
    405    nbIso = SIZE(isotopes)
    406    nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    407    IF(nbIso/=0) THEN                        !--- ISOTOPES FOUND
    408 
    409       !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES
    410       !    DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat, alpha_ideal)
    411       CALL getKey_init(tracers, isotopes)
    412       IF(isoSelect('H2O')) RETURN           !--- Select water isotopes ; finished if no water isotopes
    413       iH2O = ixIso                          !--- Keep track of water family index
    414       IF(getKey('tnat' , tnat,        isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "tnat"', 1)
    415       IF(getKey('alpha', alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname, 'can''t read "alpha_ideal"', 1)
    416 
    417       !=== MAKE SURE THE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
    418       DO ix = 1, nbIso
    419          iso => isotopes(ix)
    420          !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
    421          DO it = 1, iso%ntiso
    422             np = SUM([(COUNT(tracers(:)%name == addPhase(iso%trac(it), iso%phase(ip:ip))), ip=1, iso%nphas)])
    423             IF(np == iso%nphas) CYCLE
    424             WRITE(msg1,'("Found ",i0," phases for ",a," instead of ",i0)')np, TRIM(iso%trac(it)), iso%nphas
    425             CALL abort_gcm(modname, msg1, 1)
    426          END DO
    427          DO it = 1, iso%niso
    428             nz = SUM([(COUNT(iso%trac == TRIM(iso%trac(it))//'_'//iso%zone(iz)), iz=1, iso%nzone)])
    429             IF(nz == iso%nzone) CYCLE
    430             WRITE(msg1,'("Found ",i0," tagging zones for ",a," instead of ",i0)')nz, TRIM(iso%trac(it)), iso%nzone
    431             CALL abort_gcm(modname, msg1, 1)
    432          END DO
    433       END DO
    434    END IF
     377   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
     378   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
     379   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
    435380
    436381   !--- Convection / boundary layer activation for all tracers
    … …  
    439384
    440385   !--- Note: nqtottr can differ from nbtr when nmom/=0
     386   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
    441387   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
    442       CALL abort_gcm('infotrac_init', 'pb dans le calcul de nqtottr', 1)
     388      CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
    443389
    444390   !=== DISPLAY THE RESULTS
    445    CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
    446    CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
    447    CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
    448    CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
    449    CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
    450    CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
     391   IF(prt_level > 1) THEN
     392      CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
     393      CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
     394      CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
     395      CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
     396      CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
     397      CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
    451398#ifdef INCA
    452    CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
    453    CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
    454 #endif
     399      CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
     400      CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
     401#endif
     402   END IF
    455403   t => tracers
    456404   CALL msg('Information stored in infotrac :', modname)
    457405   IF(dispTable('isssssssssiiiiiiiii', &
    458       ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isAdv ', 'isPhy ', &
     406      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
    459407       'iadv  ', 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
    460       cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isAdvected), &
    461                                                                                   bool2str(t%isInPhysics)),&
    462       cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChilds, t%iso_iGroup,    &
     408      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
     409                                                                                  bool2str(t%isAdvected)), &
     410      cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,  &
    463411                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
    464412      CALL abort_gcm(modname, "problem with the tracers table content", 1)
    465413   IF(niso > 0) THEN
    466414      CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
    467       CALL msg('  isoKeys = '//strStack(isoKeys%name), modname)
     415      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
    468416      CALL msg('  isoName = '//strStack(isoName),      modname)
    469417      CALL msg('  isoZone = '//strStack(isoZone),      modname)
    … …  
    474422   CALL msg('end', modname)
    475423
    476 END SUBROUTINE infotrac_init
    477 
    478 
    479 !==============================================================================================================================
    480 !=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
    481 !     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
    482 !==============================================================================================================================
    483 LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
    484    IMPLICIT NONE
    485    CHARACTER(LEN=*),  INTENT(IN) :: iName
    486    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    487    INTEGER :: iIso
    488    LOGICAL :: lV
    489    lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
    490    iIso = strIdx(isotopes(:)%parent, iName)
    491    lerr = iIso == 0
    492    IF(lerr) THEN
    493       niso = 0; ntiso = 0; nzone=0; nphas=nqo; isoCheck=.FALSE.
    494       CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
    495       RETURN
    496    END IF
    497    lerr = isoSelectByIndex(iIso, lV)
    498 END FUNCTION isoSelectByName
    499 !==============================================================================================================================
    500 LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
    501    IMPLICIT NONE
    502    INTEGER,           INTENT(IN) :: iIso
    503    LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
    504    LOGICAL :: lv
    505    lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
    506    lerr = .FALSE.
    507    IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
    508    lerr = iIso<=0 .OR. iIso>nbIso
    509    CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',&
    510             ll=lerr .AND. lV)
    511    IF(lerr) RETURN
    512    ixIso = iIso                                                      !--- Update currently selected family index
    513    isotope  => isotopes(ixIso)                                       !--- Select corresponding component
    514    isoKeys  => isotope%keys;     niso     = isotope%niso
    515    isoName  => isotope%trac;     ntiso    = isotope%ntiso
    516    isoZone  => isotope%zone;     nzone    = isotope%nzone
    517    isoPhas  => isotope%phase;    nphas    = isotope%nphas
    518    itZonIso => isotope%itZonIso; isoCheck = isotope%check
    519    iqIsoPha => isotope%iqIsoPha
    520 END FUNCTION isoSelectByIndex
    521 !==============================================================================================================================
     424END SUBROUTINE init_infotrac
    522425
    523426END MODULE infotrac

  • LMDZ6/trunk/libf/dyn3d_common/iso_verif_dyn.F

    r4050 r4325  
    6464        function iso_verif_aberrant_nostop
    6565     :           (x,iso,q,err_msg)
    66         USE infotrac, ONLY: tnat
     66        USE infotrac, ONLY: isoName, getKey
    6767        implicit none
    6868       
    … …  
    7474        ! locals
    7575        real qmin,deltaD
    76         real deltaDmax,deltaDmin
     76        real deltaDmax,deltaDmin,tnat
    7777        parameter (qmin=1e-11)
    7878        parameter (deltaDmax=200.0,deltaDmin=-999.9)
    … …  
    8585        ! verifier que HDO est raisonable
    8686         if (q.gt.qmin) then
    87              deltaD=(x/q/tnat(iso)-1)*1000
     87             IF(getKey('tnat', tnat, isoName(iso))) THEN
     88                  err_msg = 'Missing isotopic parameter "tnat"'
     89                  iso_verif_aberrant_nostop=1
     90                  RETURN
     91             END IF
     92             deltaD=(x/q/tnat-1)*1000
    8893             if ((deltaD.gt.deltaDmax).or.(deltaD.lt.deltaDmin)) then
    8994                  write(*,*) 'erreur detectee par iso_verif_aberrant:'

  • LMDZ6/trunk/libf/dyn3dmem/check_isotopes_loc.F90

    r4143 r4325  
    33   USE strings_mod, ONLY: maxlen, msg, strIdx, strStack, int2str, real2str
    44   USE infotrac,    ONLY: nqtot, niso, nphas, isotope, isoCheck, iqIsoPha, isoSelect, &
    5                           ntiso, iH2O, nzone, tracers, isoName,  itZonIso, tnat
     5                          ntiso, iH2O, nzone, tracers, isoName,  itZonIso, getKey
    66   IMPLICIT NONE
    77   include "dimensions.h"
    … …  
    1111   CHARACTER(LEN=maxlen) :: modname, msg1, nm(2)
    1212   INTEGER :: ixt, ipha, k, i, iq, iiso, izon, ieau, iqeau, iqpar
    13    INTEGER, ALLOCATABLE :: ix(:)
     13   INTEGER, ALLOCATABLE ::   ix(:)
     14   REAL,    ALLOCATABLE :: tnat(:)               !--- OpenMP shared variable
    1415   REAL    :: xtractot, xiiso, deltaD, q1, q2
    1516   REAL, PARAMETER :: borne     = 1e19,  &
    … …  
    3637      iso_O17 = strIdx(isoName,'H2[17]O')
    3738      iso_HTO = strIdx(isoName,'H[3]HO')
     39      IF(getKey('tnat', tnat)) CALL abort_gcm(modname, 'missing isotopic parameter', 1)
    3840!$OMP END MASTER
    3941!$OMP BARRIER

  • LMDZ6/trunk/libf/dyn3dmem/dynetat0_loc.F90

    r4301 r4325  
    77!-------------------------------------------------------------------------------
    88  USE parallel_lmdz
    9   USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, tnat, alpha_ideal, iH2O
     9  USE infotrac,    ONLY: nqtot, tracers, niso, iqIsoPha, iH2O, isoName
    1010  USE strings_mod, ONLY: maxlen, msg, strStack, real2str, int2str
    1111  USE netcdf,      ONLY: NF90_OPEN,  NF90_NOWRITE, NF90_INQUIRE_DIMENSION, NF90_INQ_VARID, &
    1212                         NF90_CLOSE, NF90_GET_VAR, NF90_INQUIRE_VARIABLE,  NF90_NoErr
    13   USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3
     13  USE readTracFiles_mod, ONLY: new2oldH2O, newHNO3, oldHNO3, getKey
    1414  USE control_mod, ONLY: planet_type
    1515  USE assert_eq_m, ONLY: assert_eq
    … …  
    4242  INTEGER, PARAMETER :: length=100
    4343  INTEGER :: iq, fID, vID, idecal, ierr, iqParent, iName, iZone, iPhase, ix
    44   REAL    :: time, tab_cntrl(length)               !--- RUN PARAMS TABLE
     44  REAL    :: time, tnat, alpha_ideal, tab_cntrl(length)    !--- RUN PARAMS TABLE
    4545  REAL,             ALLOCATABLE :: vcov_glo(:,:),masse_glo(:,:),   ps_glo(:)
    4646  REAL,             ALLOCATABLE :: ucov_glo(:,:),    q_glo(:,:), phis_glo(:)
    … …  
    179179      iqParent = tracers(iq)%iqParent
    180180      IF(tracers(iq)%iso_iZone == 0) THEN
     181         IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
     182            CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
    181183         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized with a simplified Rayleigh distillation law.', modname)
    182          q(ijb_u:ije_u,:,iq)= q(ijb_u:ije_u,:,iqParent)*tnat(iName)*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
     184         q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.)
    183185      ELSE
    184186         CALL msg('Tracer <'//TRIM(var)//'> is missing => initialized to its parent isotope concentration.', modname)

  • LMDZ6/trunk/libf/dyn3dmem/gcm.F90

    r4146 r4325  
    1111  USE mod_const_mpi, ONLY: init_const_mpi
    1212  USE parallel_lmdz
    13   USE infotrac, ONLY: nqtot, infotrac_init
     13  USE infotrac, ONLY: nqtot, init_infotrac
    1414!#ifdef CPP_PHYS
    1515!  USE mod_interface_dyn_phys, ONLY: init_interface_dyn_phys
    … …  
    205205  !  Choix du nombre de traceurs et du schema pour l'advection
    206206  !  dans fichier traceur.def, par default ou via INCA
    207   call infotrac_init
     207  call init_infotrac
    208208
    209209  ! Allocation de la tableau q : champs advectes   

  • LMDZ6/trunk/libf/dyn3dmem/iniacademic_loc.F90

    r4143 r4325  
    55
    66  USE filtreg_mod, ONLY: inifilr
    7   USE infotrac,    ONLY: nqtot, niso, tnat, alpha_ideal, iqIsoPha, tracers
     7  USE infotrac,    ONLY: nqtot, niso, iqIsoPha, tracers, getKey, isoName
    88  USE control_mod, ONLY: day_step,planet_type
    99  use exner_hyb_m, only: exner_hyb
    … …  
    7777  integer idum
    7878
    79   REAL zdtvr
     79  REAL zdtvr, tnat, alpha_ideal
    8080 
    8181  character(len=*),parameter :: modname="iniacademic"
    … …  
    290290              iqParent = tracers(iq)%iqParent
    291291              IF(tracers(iq)%iso_iZone == 0) THEN
    292                  q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat(iName) &
    293                                      *(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal(iName)-1.)
     292                 IF(getKey('tnat', tnat, isoName(iName)) .OR. getKey('alpha', alpha_ideal, isoName(iName))) &
     293                    CALL abort_gcm(TRIM(modname), 'missing isotopic parameters', 1)
     294                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqParent)*tnat*(q(ijb_u:ije_u,:,iqParent)/30.e-3)**(alpha_ideal-1.)
    294295              ELSE
    295296                 q(ijb_u:ije_u,:,iq) = q(ijb_u:ije_u,:,iqIsoPha(iName,iPhase))

  • LMDZ6/trunk/libf/dyn3dmem/vlsplt_loc.F

    r4143 r4325  
    351351c$OMP END DO NOWAIT
    352352      enddo !do ifils=1,tracers(iq)%nqDescen
    353       do ifils=1,tracers(iq)%nqChilds
     353      do ifils=1,tracers(iq)%nqChildren
    354354        iq2=tracers(iq)%iqDescen(ifils)
    355355        call vlx_loc(Ratio,pente_max,masse,u_mq,ijb_x,ije_x,iq2)
    … …  
    726726! CRisi: appel récursif de l'advection sur les fils.
    727727! Il faut faire ça avant d'avoir mis à jour q et masse
    728       !write(*,*) 'vly 689: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
     728!     write(*,*)'vly 689: iq,nqChildren(iq)=',iq,tracers(iq)%nqChildren
    729729
    730730      ijb=ij_begin-2*iip1
    … …  
    761761      enddo
    762762
    763       do ifils=1,tracers(iq)%nqChilds
     763      do ifils=1,tracers(iq)%nqChildren
    764764        iq2=tracers(iq)%iqDescen(ifils)
    765765        call vly_loc(Ratio,pente_max,masse,qbyv,iq2)
    … …  
    11481148! CRisi: appel récursif de l'advection sur les fils.
    11491149! Il faut faire ça avant d'avoir mis à jour q et masse
    1150       !write(*,*) 'vlsplt 942: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
     1150!     write(*,*)'vlsplt 942: iq,nqChildren(iq)=',iq,tracers(iq)%nqChildren
    11511151      do ifils=1,tracers(iq)%nqDescen
    11521152        iq2=tracers(iq)%iqDescen(ifils)
    … …  
    11691169c$OMP BARRIER
    11701170
    1171       do ifils=1,tracers(iq)%nqChilds
     1171      do ifils=1,tracers(iq)%nqChildren
    11721172        iq2=tracers(iq)%iqDescen(ifils)
    11731173        call vlz_loc(Ratio,pente_max,masse,w,ijb_x,ije_x,iq2)

  • LMDZ6/trunk/libf/dyn3dmem/vlspltqs_loc.F

    r4143 r4325  
    337337! CRisi: appel recursif de l'advection sur les fils.
    338338! Il faut faire ca avant d'avoir mis a jour q et masse
    339       !write(*,*) 'vlspltqs 336: iq,ijb_x,nqChilds(iq)=',
    340 !     &     iq,ijb_x,tracers(iq)%nqChilds
     339      !write(*,*) 'vlspltqs 336: iq,ijb_x,nqChildren(iq)=',
     340!     &     iq,ijb_x,tracers(iq)%nqChildren
    341341
    342342      do ifils=1,tracers(iq)%nqDescen
    … …  
    356356c$OMP END DO NOWAIT
    357357      enddo
    358       do ifils=1,tracers(iq)%nqChilds
     358      do ifils=1,tracers(iq)%nqChildren
    359359        iq2=tracers(iq)%iqDescen(ifils)
    360360        !write(*,*) 'vlxqs 349: on appelle vlx pour iq2=',iq2
    … …  
    729729! CRisi: appel recursif de l'advection sur les fils.
    730730! Il faut faire ca avant d'avoir mis a jour q et masse
    731       !write(*,*) 'vlyqs 689: iq,nqChilds(iq)=',iq,tracers(iq)%nqChilds
     731!     write(*,*)'vlyqs 689: iq,nqChildren(iq)=',iq,
     732!    &             tracers(iq)%nqChildren
    732733     
    733734      ijb=ij_begin-2*iip1
    … …  
    767768c$OMP END DO NOWAIT
    768769      enddo
    769       do ifils=1,tracers(iq)%nqChilds
     770      do ifils=1,tracers(iq)%nqChildren
    770771        iq2=tracers(iq)%iqDescen(ifils)
    771772        !write(lunout,*) 'vly: appel recursiv vly iq2=',iq2

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/ce0l.F90

    r3815 r4325  
    2323  USE netcdf,         ONLY: NF90_OPEN, NF90_NOWRITE, NF90_CLOSE, NF90_NOERR,    &
    2424         NF90_INQUIRE_DIMENSION, NF90_INQ_DIMID, NF90_INQ_VARID, NF90_GET_VAR
    25   USE infotrac,       ONLY: type_trac, infotrac_init
     25  USE infotrac,       ONLY: type_trac, init_infotrac
    2626  USE dimphy,         ONLY: klon
    2727  USE test_disvert_m, ONLY: test_disvert
    … …  
    132132
    133133!--- Tracers initializations
    134   CALL infotrac_init()
     134  CALL init_infotrac()
    135135
    136136  CALL inifilr()

  • LMDZ6/trunk/libf/dynphy_lonlat/phylmd/iniphysiq_mod.F90

    r4243 r4325  
    1616  USE mod_phys_lmdz_para, ONLY: klon_omp ! number of columns (on local omp grid)
    1717  USE vertical_layers_mod, ONLY : init_vertical_layers
    18   USE infotrac, ONLY: nbtr,nqCO2,tracers,isotopes,type_trac,types_trac,conv_flg,pbl_flg,nqtottr
     18  USE infotrac, ONLY: nbtr, type_trac, types_trac
    1919#ifdef CPP_StratAer
    2020  USE infotrac_phy, ONLY: nbtr_bin, nbtr_sulgas, id_OCS_strat, &
    … …  
    137137
    138138  ! Initialize tracer names, numbers, etc. for physics
    139   CALL init_infotrac_phy(type_trac, tracers, isotopes, nqtottr, nqCO2, pbl_flg, conv_flg)
     139  CALL init_infotrac_phy
    140140
    141141  ! Initializations for Reprobus

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

    r4301 r4325  
    11MODULE readTracFiles_mod
    22
    3   USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce,  strFind, strStack, strHead, &
     3  USE strings_mod,    ONLY: msg, find, get_in, str2int, dispTable, testFile, strReduce,  strFind, strStack, strHead,  &
    44       test, removeComment, cat, fmsg, maxlen, int2str, checkList, strParse, strReplace, strTail, strCount, strIdx, reduceExpr
    5   USE trac_types_mod, ONLY: trac_type, isot_type, keys_type
    65
    76  IMPLICIT NONE
    … …  
    98  PRIVATE
    109
    11   PUBLIC :: maxlen                                                   !--- PARAMETER FOR CASUAL STRING LENGTH
    12   PUBLIC :: trac_type, readTracersFiles, setGeneration, indexUpdate  !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
    13   PUBLIC :: keys_type, getKey, fGetKey,  setDirectKeys, getKey_init  !--- TOOLS TO GET/SET KEYS FROM/TO tracers & isotopes
    14 
    15   PUBLIC :: addPhase, getiPhase,  old_phases, phases_sep, nphases, & !--- FUNCTIONS RELATED TO THE PHASES
    16             delPhase, getPhase, known_phases, phases_names           !--- + ASSOCIATED VARIABLES
    17 
    18   PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O             !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
    19   PUBLIC :: oldHNO3,   newHNO3                                       !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
    20 
    21   PUBLIC :: tran0, idxAncestor, ancestor                             !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
     10  PUBLIC :: maxlen                                              !--- PARAMETER FOR CASUAL STRING LENGTH
     11  PUBLIC :: tracers                                             !--- TRACERS  DESCRIPTION DATABASE
     12  PUBLIC :: trac_type, setGeneration, indexUpdate               !--- TRACERS  DESCRIPTION ASSOCIATED TOOLS
     13  PUBLIC :: testTracersFiles, readTracersFiles                  !--- TRACERS FILES READING ROUTINES
     14  PUBLIC :: getKey, fGetKey, setDirectKeys                      !--- TOOLS TO GET/SET KEYS FROM/TO  tracers & isotopes
     15  PUBLIC :: getKeysDBase,    setKeysDBase                       !--- TOOLS TO GET/SET THE DATABASE (tracers & isotopes)
     16
     17  PUBLIC :: addPhase, getiPhase,  old_phases, phases_sep, &     !--- FUNCTIONS RELATED TO THE PHASES
     18   nphases, delPhase, getPhase, known_phases, phases_names      !--- + ASSOCIATED VARIABLES
     19
     20  PUBLIC :: oldH2OIso, newH2OIso, old2newH2O, new2oldH2O        !--- H2O ISOTOPES BACKWARD COMPATIBILITY (OLD traceur.def)
     21  PUBLIC :: oldHNO3,   newHNO3                                  !--- HNO3 REPRO   BACKWARD COMPATIBILITY (OLD start.nc)
     22
     23  PUBLIC :: tran0, idxAncestor, ancestor                        !--- GENERATION 0 TRACER + TOOLS FOR GENERATIONS
    2224
    2325  !=== FOR ISOTOPES: GENERAL
    24   PUBLIC :: isot_type, readIsotopesFile, initIsotopes                !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
     26  PUBLIC :: isot_type, readIsotopesFile, isoSelect              !--- ISOTOPES DESCRIPTION TYPE + READING ROUTINE
     27  PUBLIC :: ixIso, nbIso                                        !--- INDEX OF SELECTED ISOTOPES CLASS + NUMBER OF CLASSES
     28
     29  !=== FOR ISOTOPES: H2O FAMILY ONLY
     30  PUBLIC :: iH2O
     31
     32  !=== FOR ISOTOPES: DEPENDING ON THE SELECTED ISOTOPES CLASS
     33  PUBLIC :: isotope, isoKeys                                    !--- SELECTED ISOTOPES DATABASE + ASSOCIATED KEYS
     34  PUBLIC :: isoName, isoZone, isoPhas                           !--- ISOTOPES AND TAGGING ZONES NAMES AND PHASES
     35  PUBLIC :: niso,    nzone,   nphas,   ntiso                    !---  " " NUMBERS + ISOTOPES AND TAGGING TRACERS NUMBERS
     36  PUBLIC :: itZonIso                                            !--- Idx IN isoName(1:niso) = f(tagging idx, isotope idx)
     37  PUBLIC :: iqIsoPha                                            !--- Idx IN qx(1:nqtot)     = f(isotope idx,   phase idx)
     38  PUBLIC :: isoCheck                                            !--- FLAG TO RUN ISOTOPES CHECKING ROUTINES
    2539
    2640  PUBLIC :: maxTableWidth
    2741!------------------------------------------------------------------------------------------------------------------------------
    28   TYPE :: dataBase_type                                              !=== TYPE FOR TRACERS SECTION
    29     CHARACTER(LEN=maxlen)  :: name                                   !--- Section name
    30     TYPE(trac_type), ALLOCATABLE :: trac(:)                          !--- Tracers descriptors
     42  TYPE :: keys_type                                        !=== TYPE FOR A SET OF KEYS ASSOCIATED TO AN ELEMENT
     43    CHARACTER(LEN=maxlen)              :: name             !--- Tracer name
     44    CHARACTER(LEN=maxlen), ALLOCATABLE :: key(:)           !--- Keys string list
     45    CHARACTER(LEN=maxlen), ALLOCATABLE :: val(:)           !--- Corresponding values string list
     46  END TYPE keys_type
     47!------------------------------------------------------------------------------------------------------------------------------
     48  TYPE :: trac_type                                        !=== TYPE FOR A SINGLE TRACER NAMED "name"
     49    CHARACTER(LEN=maxlen) :: name        = ''              !--- Name of the tracer
     50    CHARACTER(LEN=maxlen) :: gen0Name    = ''              !--- First generation ancestor name
     51    CHARACTER(LEN=maxlen) :: parent      = ''              !--- Parent name
     52    CHARACTER(LEN=maxlen) :: longName    = ''              !--- Long name (with advection scheme suffix)
     53    CHARACTER(LEN=maxlen) :: type        = 'tracer'        !--- Type  (so far: 'tracer' / 'tag')
     54    CHARACTER(LEN=maxlen) :: phase       = 'g'             !--- Phase ('g'as / 'l'iquid / 's'olid)
     55    CHARACTER(LEN=maxlen) :: component   = ''              !--- Coma-separated list of components (Ex: lmdz,inca)
     56    INTEGER               :: iadv        = 10              !--- Advection scheme used
     57    INTEGER               :: iGeneration = -1              !--- Generation number (>=0)
     58    LOGICAL               :: isAdvected  = .FALSE.         !--- "true" tracers: iadv > 0.   COUNT(isAdvected )=nqtrue
     59    LOGICAL               :: isInPhysics = .TRUE.          !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
     60    INTEGER               :: iqParent    = 0               !--- Parent index
     61    INTEGER,  ALLOCATABLE :: iqDescen(:)                   !--- Descendants index (in growing generation order)
     62    INTEGER               :: nqDescen    = 0               !--- Number of descendants (all generations)
     63    INTEGER               :: nqChildren  = 0               !--- Number of children  (first generation)
     64    INTEGER               :: iso_iGroup  = 0               !--- Isotopes group index in isotopes(:)
     65    INTEGER               :: iso_iName   = 0               !--- Isotope  name  index in isotopes(iso_iGroup)%trac(:)
     66    INTEGER               :: iso_iZone   = 0               !--- Isotope  zone  index in isotopes(iso_iGroup)%zone(:)
     67    INTEGER               :: iso_iPhase  = 0               !--- Isotope  phase index in isotopes(iso_iGroup)%phase
     68    TYPE(keys_type)       :: keys                          !--- <key>=<val> pairs vector
     69  END TYPE trac_type
     70!------------------------------------------------------------------------------------------------------------------------------
     71  TYPE :: isot_type                                        !=== TYPE FOR AN ISOTOPES FAMILY DESCENDING ON TRACER "parent"
     72    CHARACTER(LEN=maxlen)              :: parent           !--- Isotopes family name (parent tracer name ; ex: H2O)
     73    LOGICAL                            :: check=.FALSE.    !--- Triggering of the checking routines
     74    TYPE(keys_type),       ALLOCATABLE :: keys(:)          !--- Isotopes keys/values pairs list     (length: niso)
     75    CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:)          !--- Isotopes + tagging tracers list     (length: ntiso)
     76    CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:)          !--- Geographic tagging zones names list (length: nzone)
     77    CHARACTER(LEN=maxlen)              :: phase = 'g'      !--- Phases list: [g][l][s]              (length: nphas)
     78    INTEGER                            :: niso  = 0        !--- Number of isotopes, excluding tagging tracers
     79    INTEGER                            :: nzone = 0        !--- Number of geographic tagging zones
     80    INTEGER                            :: ntiso = 0        !--- Number of isotopes, including tagging tracers
     81    INTEGER                            :: nphas = 0        !--- Number phases
     82    INTEGER,               ALLOCATABLE :: iqIsoPha(:,:)    !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
     83                                                           !---        "iqIsoPha" former name: "iqiso"
     84    INTEGER,               ALLOCATABLE :: itZonIso(:,:)    !--- Idx in "trac(1:ntiso)" = f(zone, name(1:niso))
     85                                                           !---        "itZonIso" former name: "index_trac"
     86  END TYPE isot_type
     87!------------------------------------------------------------------------------------------------------------------------------
     88  TYPE :: dataBase_type                                         !=== TYPE FOR TRACERS SECTION
     89    CHARACTER(LEN=maxlen)  :: name                              !--- Section name
     90    TYPE(trac_type), ALLOCATABLE :: trac(:)                     !--- Tracers descriptors
    3191  END TYPE dataBase_type
    3292!------------------------------------------------------------------------------------------------------------------------------
    3393  INTERFACE getKey
    3494    MODULE PROCEDURE getKeyByName_s1,  getKeyByName_i1,  getKeyByName_r1, &
    35                      getKeyByName_sm,  getKeyByName_im,  getKeyByName_rm
     95                     getKeyByName_sm,  getKeyByName_im,  getKeyByName_rm, &
     96                     getKeyByName_s1m, getKeyByName_i1m, getKeyByName_r1m
    3697  END INTERFACE getKey
    3798!------------------------------------------------------------------------------------------------------------------------------
    38   INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyByIndex_s1, fgetKeyByName_s1; END INTERFACE fGetKey
     99  INTERFACE    isoSelect;  MODULE PROCEDURE  isoSelectByIndex,  isoSelectByName; END INTERFACE isoSelect
    39100  INTERFACE  old2newH2O;   MODULE PROCEDURE  old2newH2O_1,  old2newH2O_m;        END INTERFACE old2newH2O
    40101  INTERFACE  new2oldH2O;   MODULE PROCEDURE  new2oldH2O_1,  new2oldH2O_m;        END INTERFACE new2oldH2O
     102  INTERFACE fGetKey;       MODULE PROCEDURE fgetKeyIdx_s1, fgetKeyNam_s1, fgetKey_sm;        END INTERFACE fGetKey
    41103  INTERFACE tracersSubset; MODULE PROCEDURE trSubset_Indx, trSubset_Name, trSubset_gen0Name; END INTERFACE tracersSubset
    42   INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m;        END INTERFACE idxAncestor
    43   INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m;        END INTERFACE    ancestor
     104  INTERFACE idxAncestor;   MODULE PROCEDURE idxAncestor_1, idxAncestor_m, idxAncestor_mt;    END INTERFACE idxAncestor
     105  INTERFACE    ancestor;   MODULE PROCEDURE    ancestor_1,    ancestor_m,    ancestor_mt;    END INTERFACE    ancestor
     106  INTERFACE      addKey;   MODULE PROCEDURE      addKey_1,      addKey_m,     addKey_mm;     END INTERFACE addKey
    44107  INTERFACE    addPhase;   MODULE PROCEDURE   addPhase_s1,   addPhase_sm,   addPhase_i1,   addPhase_im; END INTERFACE addPhase
    45108!------------------------------------------------------------------------------------------------------------------------------
    … …  
    54117  INTEGER, PARAMETER :: nphases = LEN_TRIM(known_phases)        !--- Number of phases
    55118  CHARACTER(LEN=maxlen), SAVE      :: phases_names(nphases) &   !--- Known phases names
    56                                 = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
     119                                             = ['gaseous', 'liquid ', 'solid  ', 'cloud  ']
    57120  CHARACTER(LEN=1), SAVE :: phases_sep  =  '_'                  !--- Phase separator
    58121  LOGICAL,          SAVE :: tracs_merge = .TRUE.                !--- Merge/stack tracers lists
    59122  LOGICAL,          SAVE :: lSortByGen  = .TRUE.                !--- Sort by growing generation
     123  CHARACTER(LEN=maxlen), SAVE :: isoFile = 'isotopes_params.def'!--- Name of the isotopes parameters file
    60124
    61125  !--- CORRESPONDANCE BETWEEN OLD AND NEW WATER NAMES
    … …  
    67131  CHARACTER(LEN=maxlen), SAVE ::   newHNO3(2) = ['HNO3   ', 'HNO3tot']
    68132
    69   !=== LOCAL COPIES OF THE TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey (INITIALIZED IN getKey_init)
     133  !=== TRACERS AND ISOTOPES DESCRIPTORS, USED BY getKey
    70134  TYPE(trac_type), ALLOCATABLE, TARGET, SAVE ::  tracers(:)
    71135  TYPE(isot_type), ALLOCATABLE, TARGET, SAVE :: isotopes(:)
    72136
    73   INTEGER,    PARAMETER :: maxTableWidth = 192                       !--- Maximum width of a table displayed with "dispTable"
     137  !=== ALIASES OF VARIABLES FROM SELECTED ISOTOPES FAMILY EMBEDDED IN "isotope" (isotopes(ixIso))
     138  TYPE(isot_type),         SAVE, POINTER :: isotope             !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
     139  INTEGER,                 SAVE          :: ixIso, iH2O         !--- Index of the selected isotopes family and H2O family
     140  INTEGER,                 SAVE          :: nbIso               !--- Number of isotopes classes
     141  LOGICAL,                 SAVE          :: isoCheck            !--- Flag to trigger the checking routines
     142  TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)          !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
     143  CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &     !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
     144                                            isoZone(:),   &     !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
     145                                            isoPhas             !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
     146  INTEGER,                 SAVE          ::  niso, nzone, &     !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
     147                                            nphas, ntiso        !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
     148  INTEGER,                 SAVE, POINTER ::itZonIso(:,:), &     !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
     149                                           iqIsoPha(:,:)        !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
     150
     151  INTEGER,    PARAMETER :: maxTableWidth = 192                  !--- Maximum width of a table displayed with "dispTable"
    74152  CHARACTER(LEN=maxlen) :: modname
    75153
    … …  
    100178!     * If you need to convert a %key/%val pair into a direct-access key, add the corresponding line in "setDirectKeys".
    101179!==============================================================================================================================
    102 LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, tracs, lRepr) RESULT(lerr)
    103 !------------------------------------------------------------------------------------------------------------------------------
    104   CHARACTER(LEN=*),             INTENT(IN)  :: type_trac              !--- List of components used
    105   INTEGER,         OPTIONAL,    INTENT(OUT) :: fTyp                   !--- Type of input file found
    106   TYPE(trac_type), ALLOCATABLE, INTENT(OUT) :: tracs(:)
    107   LOGICAL,         OPTIONAL,    INTENT(IN)  :: lRepr
     180LOGICAL FUNCTION readTracersFiles(type_trac, fTyp, lRepr) RESULT(lerr)
     181!------------------------------------------------------------------------------------------------------------------------------
     182  CHARACTER(LEN=*),  INTENT(IN)  :: type_trac                        !--- List of components used
     183  INTEGER, OPTIONAL, INTENT(OUT) :: fTyp                             !--- Type of input file found
     184  LOGICAL, OPTIONAL, INTENT(IN)  :: lRepr                            !--- Activate the HNNO3 exceptions for REPROBUS
    108185  CHARACTER(LEN=maxlen),  ALLOCATABLE :: s(:), sections(:), trac_files(:)
    109186  CHARACTER(LEN=maxlen) :: str, fname, mesg, tname, pname, cname
    110   INTEGER               :: is, nsec, ierr, it, ntrac, ns, ip, ix, fType
     187  INTEGER               :: nsec, ierr, it, ntrac, ns, ip, ix, fType
    111188  LOGICAL, ALLOCATABLE  :: ll(:), lGen3(:)
    112189  LOGICAL :: lRep
     190  TYPE(keys_type), POINTER :: k
    113191!------------------------------------------------------------------------------------------------------------------------------
    114192  lerr = .FALSE.
    … …  
    117195  lRep=0; IF(PRESENT(lRepr)) lRep = lRepr
    118196
    119   !--- Required sections + corresponding files names (new style single section case)
    120   IF(test(strParse(type_trac, '|', sections), lerr)) RETURN          !--- Parse "type_trac" list
    121 
    122   nsec = SIZE(sections, DIM=1)
    123   ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
    124 
    125   !--- LOOK AT AVAILABLE FILES
    126   ll = .NOT.testFile(trac_files)
    127   fType = 0
    128   IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
    129   IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
    130   IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     197  !--- Required sections + corresponding files names (new style single section case) for tests
     198  IF(test(testTracersFiles(modname, type_trac, fType, trac_files, sections), lerr)) RETURN
    131199  IF(PRESENT(fTyp)) fTyp = fType
    132   IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
    133     IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
    134   END IF
    135 
    136   !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
    137   IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = SIZE(sections)>1 .AND. fType==1), lerr)) RETURN
    138 
    139   !--- TELLS WHAT WAS IS ABOUT TO BE USED
    140   IF (fmsg('No adequate tracers description file(s) found ; default values will be used',          modname, fType==0)) RETURN
    141   CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
    142   CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
    143   CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
     200  nsec = SIZE(sections)
    144201
    145202  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    … …  
    156213
    157214      !--- READ THE REMAINING LINES: <hadv> <vadv> <tracer> [<transporting fluid>]
    158       ALLOCATE(tracs(ntrac))
     215      IF(ALLOCATED(tracers)) DEALLOCATE(tracers)
     216      ALLOCATE(tracers(ntrac))
    159217      DO it=1,ntrac                                                  !=== READ RAW DATA: loop on the line/tracer number
    160218        READ(90,'(a)',IOSTAT=ierr) str
    … …  
    164222        CALL msg('This file is for air tracers only',           modname, ns == 3 .AND. it == 1)
    165223        CALL msg('This files specifies the transporting fluid', modname, ns == 4 .AND. it == 1)
     224        k => tracers(it)%keys
    166225
    167226        !=== NAME OF THE TRACER
    … …  
    169228        ix = strIdx(oldHNO3, s(3))
    170229        IF(ix /= 0 .AND. lRep) tname = newHNO3(ix)                   !--- Exception for HNO3 (REPROBUS ONLY)
    171         tracs(it)%name = tname                                       !--- Set %name
    172         tracs(it)%keys%name = tname                                  !--- Copy tracers names in keys components
     230        tracers(it)%name = tname                                     !--- Set %name
     231        CALL addKey('name', tname, k)                                !--- Set the name of the tracer
     232        tracers(it)%keys%name = tname                                !--- Copy tracers names in keys components
    173233
    174234        !=== NAME OF THE COMPONENT
    175235        cname = type_trac                                            !--- Name of the model component
    176236        IF(ANY([(addPhase('H2O', ip), ip = 1, nphases)] == tname)) cname = 'lmdz'
    177         tracs(it)%component = cname                                  !--- Set %component
     237        tracers(it)%component = cname                                !--- Set %component
     238        CALL addKey('component', cname, k)                           !--- Set the name of the model component
    178239
    179240        !=== NAME OF THE PARENT
    … …  
    184245          IF(ix /= 0 .AND. lRep) pname = newHNO3(ix)                 !--- Exception for HNO3 (REPROBUS ONLY)
    185246        END IF
    186         tracs(it)%parent = pname                                     !--- Set %parent
     247        tracers(it)%parent = pname                                   !--- Set %parent
     248        CALL addKey('parent', pname, k)
    187249
    188250        !=== PHASE AND ADVECTION SCHEMES NUMBERS
    189         tracs(it)%phase = known_phases(ip:ip)                        !--- Set %phase:  tracer phase (default: "g"azeous)
    190         tracs(it)%keys%key = ['hadv', 'vadv']                        !--- Set %keys%key
    191         tracs(it)%keys%val = s(1:2)                                  !--- Set %keys%val
     251        tracers(it)%phase = known_phases(ip:ip)                      !--- Set %phase:  tracer phase (default: "g"azeous)
     252        CALL addKey('phase', known_phases(ip:ip), k)                 !--- Set the phase  of the tracer (default: "g"azeous)
     253        CALL addKey('hadv', s(1),  k)                                !--- Set the horizontal advection schemes number
     254        CALL addKey('vadv', s(2),  k)                                !--- Set the vertical   advection schemes number
    192255      END DO
    193256      CLOSE(90)
    194       CALL setGeneration(tracs)                                      !--- Set %iGeneration and %gen0Name
    195       WHERE(tracs%iGeneration == 2) tracs%type = 'tag'               !--- Set %type:        'tracer' or 'tag'
    196       IF(test(checkTracers(tracs, fname, fname), lerr)) RETURN       !--- Detect orphans and check phases
    197       IF(test(checkUnique (tracs, fname, fname), lerr)) RETURN       !--- Detect repeated tracers
    198       CALL sortTracers  (tracs)                                      !--- Sort the tracers
    199       tracs(:)%keys%name = tracs(:)%name                             !--- Copy tracers names in keys components
     257      IF(test(setGeneration(tracers), lerr)) RETURN                  !--- Set %iGeneration and %gen0Name
     258      WHERE(tracers%iGeneration == 2) tracers(:)%type = 'tag'        !--- Set %type:        'tracer' or 'tag'
     259      CALL addKey('type', tracers(:)%type, tracers(:)%keys)          !--- Set the type of tracers
     260      IF(test(checkTracers(tracers, fname, fname), lerr)) RETURN     !--- Detect orphans and check phases
     261      IF(test(checkUnique (tracers, fname, fname), lerr)) RETURN     !--- Detect repeated tracers
     262      CALL sortTracers    (tracers)                                  !--- Sort the tracers
    200263    !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    201264    CASE(2); IF(test(feedDBase(["tracer.def"], [type_trac], modname), lerr)) RETURN !=== SINGLE   FILE, MULTIPLE SECTIONS
    … …  
    209272
    210273  IF(nsec  == 1) THEN;
    211     tracs = dBase(1)%trac
     274    tracers = dBase(1)%trac
    212275  ELSE IF(tracs_merge) THEN
    213276    CALL msg('The multiple required sections will be MERGED.',    modname)
    214     IF(test(mergeTracers(dBase, tracs), lerr)) RETURN
     277    IF(test(mergeTracers(dBase, tracers), lerr)) RETURN
    215278  ELSE
    216279    CALL msg('The multiple required sections will be CUMULATED.', modname)
    217     IF(test(cumulTracers(dBase, tracs), lerr)) RETURN
     280    IF(test(cumulTracers(dBase, tracers), lerr)) RETURN
    218281  END IF
    219   CALL setDirectKeys(tracs)                                          !--- Set %iqParent, %iqDescen, %nqDescen, %nqChilds
     282  CALL setDirectKeys(tracers)                                        !--- Set %iqParent, %iqDescen, %nqDescen, %nqChildren
    220283END FUNCTION readTracersFiles
     284!==============================================================================================================================
     285
     286
     287!==============================================================================================================================
     288LOGICAL FUNCTION testTracersFiles(modname, type_trac, fType, tracf, sects) RESULT(lerr)
     289  CHARACTER(LEN=*),                             INTENT(IN)  :: modname, type_trac
     290  INTEGER,                                      INTENT(OUT) :: fType
     291  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: tracf(:), sects(:)
     292  CHARACTER(LEN=maxlen), ALLOCATABLE :: trac_files(:), sections(:)
     293  LOGICAL, ALLOCATABLE :: ll(:)
     294  INTEGER :: is, nsec
     295  lerr = .FALSE.
     296
     297  !--- PARSE "type_trac" LIST AND DETERMINE THE TRACERS FILES NAMES (FOR CASE 3: MULTIPLE FILES, SINNGLE SECTION PER FILE)
     298  IF(test(strParse(type_trac, '|', sections,  n=nsec), lerr)) RETURN !--- Parse "type_trac" list
     299  IF(PRESENT(sects)) sects = sections
     300  ALLOCATE(trac_files(nsec)); DO is=1, nsec; trac_files(is) = 'tracer_'//TRIM(sections(is))//'.def'; END DO
     301  IF(PRESENT(tracf)) tracf = trac_files
     302
     303  nsec = SIZE(trac_files, DIM=1)
     304  ll = .NOT.testFile(trac_files)
     305  fType = 0
     306  IF(.NOT.testFile('traceur.def') .AND. nsec==1) fType = 1           !--- OLD STYLE FILE
     307  IF(.NOT.testFile('tracer.def'))                fType = 2           !--- NEW STYLE ; SINGLE  FILE, SEVERAL SECTIONS
     308  IF(ALL(ll))                                    fType = 3           !--- NEW STYLE ; SEVERAL FILES, SINGLE SECTION USED
     309  IF(ANY(ll) .AND. fType/=3) THEN                                    !--- MISSING FILES
     310    IF(test(checkList(trac_files, .NOT.ll, 'Failed reading tracers description', 'files', 'missing'), lerr)) RETURN
     311  END IF
     312
     313  !--- CHECK WHETHER type_trac AND FILE TYPE ARE COMPATIBLE
     314  IF(test(fmsg('No multiple sections for the old format "traceur.def"', ll = nsec>1 .AND. fType==1), lerr)) RETURN
     315
     316  !--- TELLS WHAT WAS IS ABOUT TO BE USED
     317  CALL msg('Trying to read old-style tracers description file "traceur.def"',                      modname, fType==1)
     318  CALL msg('Trying to read the new style multi-sections tracers description file "tracer.def"',    modname, fType==2)
     319  CALL msg('Trying to read the new style single section tracers description files "tracer_*.def"', modname, fType==3)
     320END FUNCTION testTracersFiles
    221321!==============================================================================================================================
    222322
    … …  
    253353    lerr = ANY([(dispTraSection('RAW CONTENT OF SECTION "'//TRIM(snm)//'"', snm, modname), idb=1, SIZE(dBase))])
    254354    IF(test(expandSection(dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- EXPAND NAMES ;  set %parent, %type, %component
    255     CALL setGeneration   (dBase(idb)%trac)                           !---                 set %iGeneration,   %genOName
     355    IF(test(setGeneration(dBase(idb)%trac),           lerr)) RETURN  !---                 set %iGeneration,   %genOName
    256356    IF(test(checkTracers (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK ORPHANS AND PHASES
    257357    IF(test(checkUnique  (dBase(idb)%trac, snm, fnm), lerr)) RETURN  !--- CHECK TRACERS UNIQUENESS
    … …  
    359459  ky => t(jd)%keys
    360460  DO k = 1, SIZE(ky%key)                                             !--- Loop on the keys of the tracer named "defName"
    361 !   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys)                   !--- Add key to all the tracers (no overwriting)
    362     DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys); END DO
     461!   CALL addKey_m(ky%key(k), ky%val(k), t(:)%keys, .FALSE.)           !--- Add key to all the tracers (no overwriting)
     462    DO it = 1, SIZE(t); CALL addKey_1(ky%key(k), ky%val(k), t(it)%keys, .FALSE.); END DO
    363463  END DO
    364464  tt = [t(1:jd-1),t(jd+1:SIZE(t))]; CALL MOVE_ALLOC(FROM=tt, TO=t)   !--- Remove the virtual tracer named "defName"
    … …  
    409509  TYPE(trac_type),       ALLOCATABLE :: ttr(:)
    410510  CHARACTER(LEN=maxlen), ALLOCATABLE :: ta(:), pa(:)
    411   CHARACTER(LEN=maxlen) :: msg1, modname
    412   INTEGER :: it, nt, iq, nq, itr, ntr, ipr, npr, i
     511  CHARACTER(LEN=maxlen) :: msg1, modname, tname, cname , pname
     512  INTEGER :: it, nt, iq, nq, jq, itr, ntr, ipr, npr, i
    413513  LOGICAL :: ll
    414514  modname = 'expandSection'
    … …  
    423523    tr(it)%type      = fgetKey(it, 'type'  , tr(:)%keys, 'tracer')
    424524    tr(it)%component = sname
     525    CALL addKey('component', sname, tr(:)%keys)
    425526
    426527    !--- Determine the number of tracers and parents ; coherence checking
    … …  
    438539  END DO
    439540  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    440   CALL delKey(['parent','type  '], tr)
    441541
    442542  ALLOCATE(ttr(nq))
    … …  
    449549    DO ipr=1,npr                                                     !--- Loop on parents list elts
    450550      DO itr=1,ntr                                                   !--- Loop on tracers list elts
    451         i = iq+itr-1+(ipr-1)*ntr
    452         ttr(i)%name   = TRIM(ta(itr))
    453         ttr(i)%parent = TRIM(pa(ipr))
    454         ttr(i)%keys%name = ta(itr)
    455         ttr(i)%keys%key  = tr(it)%keys%key
    456         ttr(i)%keys%val  = tr(it)%keys%val
    457 !        ttr(i)%keys   = keys_type(ta(itr), tr(it)%keys%key, tr(it)%keys%val)
     551        ttr(iq)%keys%key  = tr(it)%keys%key
     552        ttr(iq)%keys%val  = tr(it)%keys%val
     553        ttr(iq)%keys%name = ta(itr)
     554        ttr(iq)%name      = TRIM(ta(itr));    CALL addKey('name',      ta(itr),          ttr(iq)%keys)
     555        ttr(iq)%parent    = TRIM(pa(ipr));    CALL addKey('parent',    pa(ipr),          ttr(iq)%keys)
     556        ttr(iq)%type      = tr(it)%type;      CALL addKey('type',      tr(it)%type,      ttr(iq)%keys)
     557        ttr(iq)%component = tr(it)%component; CALL addKey('component', tr(it)%component, ttr(iq)%keys)
     558        iq = iq+1
    458559      END DO
    459560    END DO
    460     ttr(iq:iq+ntr*npr-1)%type      = tr(it)%type                     !--- Duplicating type
    461     ttr(iq:iq+ntr*npr-1)%component = tr(it)%component                !--- Duplicating type
    462     iq = iq + ntr*npr
    463561  !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
    464562  END DO
    … …  
    471569
    472570!==============================================================================================================================
    473 SUBROUTINE setGeneration(tr)
     571LOGICAL FUNCTION setGeneration(tr) RESULT(lerr)
    474572!------------------------------------------------------------------------------------------------------------------------------
    475573! Purpose: Determine, for each tracer of "tr(:)":
    … …  
    479577  TYPE(trac_type),     INTENT(INOUT) :: tr(:)                        !--- Tracer derived type vector
    480578  INTEGER                            :: iq, nq, ig
    481   LOGICAL,               ALLOCATABLE :: lg(:)
    482   CHARACTER(LEN=maxlen), ALLOCATABLE :: prn(:)
    483 !------------------------------------------------------------------------------------------------------------------------------
    484   tr(:)%iGeneration = -1                                             !--- error if -1
     579  CHARACTER(LEN=maxlen), ALLOCATABLE :: parent(:), prn(:)
     580  CHARACTER(LEN=maxlen) :: gen0(SIZE(tr))
     581  INTEGER               :: iGen(SIZE(tr))
     582  LOGICAL               ::   lg(SIZE(tr))
     583!------------------------------------------------------------------------------------------------------------------------------
     584  iGen(:) = -1                                                       !--- error if -1
    485585  nq = SIZE(tr, DIM=1)                                               !--- Number of tracers lines
    486   lg = tr(:)%parent == tran0                                         !--- Flag for generation 0 tracers
    487   WHERE(lg) tr(:)%iGeneration = 0                                    !--- Generation 0 tracers
     586  IF(test(fmsg('missing "parent" attribute', 'setGeneration', getKey('parent', parent, ky=tr(:)%keys)), lerr)) RETURN
     587  WHERE(parent == tran0) iGen(:) = 0
    488588
    489589  !=== Determine generation for each tracer
    490590  ig=-1; prn = [tran0]
    491591  DO                                                                 !--- Update current generation flag
    492     IF(ig/=-1) prn = PACK( tr(:)%name, MASK=tr(:)%iGeneration == ig)
    493     lg(:) = [(ANY(prn(:) == tr(iq)%parent), iq=1, nq)]               !--- Current generation tracers flag
     592    IF(ig/=-1) prn = PACK( tr(:)%name, MASK = iGen == ig)
     593    lg(:) = [(ANY(prn(:) == parent(iq)), iq=1, nq)]                  !--- Current generation tracers flag
    494594    IF( ALL( .NOT. lg ) ) EXIT                                       !--- Empty current generation
    495     ig = ig+1; WHERE(lg) tr(:)%iGeneration = ig
    496   END DO
    497   tr(:)%gen0Name = ancestor(tr)                                      !--- First generation ancestor name
    498 
    499 END SUBROUTINE setGeneration
     595    ig = ig+1; WHERE(lg) iGen(:) = ig
     596  END DO
     597  tr%iGeneration = iGen; CALL addKey_mm('iGeneration', int2str(iGen(:)), tr(:)%keys)
     598  CALL ancestor(tr, gen0)                                            !--- First generation ancestor name
     599  tr%gen0Name    = gen0; CALL addKey_mm('gen0Name',    gen0,             tr(:)%keys)
     600
     601END FUNCTION setGeneration
    500602!==============================================================================================================================
    501603
    … …  
    581683  TYPE(trac_type), ALLOCATABLE :: ttr(:)
    582684  INTEGER,   ALLOCATABLE ::  i0(:)
    583   CHARACTER(LEN=maxlen)  :: nam, pha, trn
     685  CHARACTER(LEN=maxlen)  :: nam, pha, tname
     686  CHARACTER(LEN=maxlen), allocatable :: ph(:)
    584687  CHARACTER(LEN=1) :: p
    585688  INTEGER :: ip, np, iq, jq, nq, it, nt, nc, i, n
    … …  
    590693  DO iq = 1, nq                                                      !--- GET THE NUMBER OF TRACERS
    591694    IF(tr(iq)%iGeneration /= 0) CYCLE                                !--- Only deal with generation 0 tracers
    592     nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of childs of tr(iq)
    593     tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list      of tr(iq)
    594     np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases of tr(iq)
     695    nc = COUNT(tr(:)%gen0Name==tr(iq)%name .AND. tr%iGeneration/=0)  !--- Number of children of tr(iq)
     696    tr(iq)%phase = fgetKey(iq, 'phases', tr(:)%keys)                 !--- Phases list        of tr(iq)
     697    np = LEN_TRIM(tr(iq)%phase)                                      !--- Number of phases   of tr(iq)
    595698    nt = nt + (1+nc) * np                                            !--- Number of tracers after expansion
    596699  END DO
    … …  
    609712      DO ip = 1, LEN_TRIM(pha)                                       !=== LOOP ON PHASES LISTS
    610713        p = pha(ip:ip)
    611         trn = TRIM(tr(iq)%name); nam = trn                           !--- Tracer name (regular case)
     714        tname = TRIM(tr(iq)%name); nam = tname                       !--- Tracer name (regular case)
    612715        IF(lTag) nam = TRIM(tr(iq)%parent)                           !--- Parent name (tagging case)
    613716        IF(lExt) nam = addPhase(nam, p )                             !--- Phase extension needed
    614         IF(lTag) nam = TRIM(nam)//'_'//TRIM(trn)                     !--- <parent>_<name> for tags
     717        IF(lTag) nam = TRIM(nam)//'_'//TRIM(tname)                   !--- <parent>_<name> for tags
    615718        ttr(it) = tr(iq)                                             !--- Same <key>=<val> pairs
    616719        ttr(it)%name      = TRIM(nam)                                !--- Name with possibly phase suffix
    617720        ttr(it)%keys%name = TRIM(nam)                                !--- Name inside the keys decriptor
    618721        ttr(it)%phase     = p                                        !--- Single phase entry
     722        CALL addKey('name', nam, ttr(it)%keys)
     723        CALL addKey('phase', p,  ttr(it)%keys)
    619724        IF(lExt .AND. tr(iq)%iGeneration>0) THEN
    620           ttr(it)%parent   = addPhase(ttr(it)%parent,   p)
    621           ttr(it)%gen0Name = addPhase(ttr(it)%gen0Name, p)
     725          ttr(it)%parent   = addPhase(tr(iq)%parent,   p)
     726          ttr(it)%gen0Name = addPhase(tr(iq)%gen0Name, p)
     727          CALL addKey('parent',   ttr(it)%parent,   ttr(it)%keys)
     728          CALL addKey('gen0Name', ttr(it)%gen0Name, ttr(it)%keys)
    622729        END IF
    623730        it = it+1
    … …  
    638745!  * Put water at the beginning of the vector, in the "known_phases" order.
    639746!  * lGrowGen == T: in ascending generations numbers.
    640 !  * lGrowGen == F: tracer + its childs sorted by growing generation, one after the other.
     747!  * lGrowGen == F: tracer + its children sorted by growing generation, one after the other.
    641748!   TO BE ADDED IF NECESSARY: HIGHER MOMENTS AT THE END
    642749!------------------------------------------------------------------------------------------------------------------------------
    … …  
    671778      ix(iq) = jq                                                    !--- Generation 0 ancestor index first
    672779      iq = iq + 1                                                    !--- Next "iq" for next generations tracers
    673       iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" childs in "tr(:)"
     780      iy = strFind(tr(:)%gen0Name, TRIM(tr(jq)%name))                !--- Indexes of "tr(jq)" children in "tr(:)"
    674781      ng = MAXVAL(tr(iy)%iGeneration, MASK=.TRUE., DIM=1)            !--- Number of generations of the "tr(jq)" family
    675782      DO ig = 1, ng                                                  !--- Loop   on generations of the "tr(jq)" family
    … …  
    683790END SUBROUTINE sortTracers
    684791!==============================================================================================================================
     792
    685793
    686794!==============================================================================================================================
    … …  
    793901  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    794902
    795   !--- Update %iqParent, %iqDescen, %nqDescen, %nqChilds
     903  !--- Update %iqParent, %iqDescen, %nqDescen, %nqChildren
    796904  CALL indexUpdate(tr)
    797905
    … …  
    808916  INTEGER :: idb, iq, nq
    809917  INTEGER, ALLOCATABLE :: hadv(:), vadv(:)
    810   CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:)
     918  CHARACTER(LEN=maxlen), ALLOCATABLE :: phas(:), prnt(:)
    811919  TYPE(trac_type), POINTER :: tm(:)
    812920  lerr = .FALSE.
    … …  
    816924  !--- BEWARE ! Can't use the "getKeyByName" functions yet.
    817925  !             Names must first include the phases for tracers defined on multiple lines.
    818   hadv = str2int([(fgetKey(iq, 'hadv',  tm(:)%keys, '10'), iq=1, nq)])
    819   vadv = str2int([(fgetKey(iq, 'vadv',  tm(:)%keys, '10'), iq=1, nq)])
    820   phas =         [(fgetKey(iq, 'phases',tm(:)%keys, 'g' ), iq=1, nq)]
     926  hadv = str2int(fgetKey('hadv',  tm(:)%keys, '10'))
     927  vadv = str2int(fgetKey('vadv',  tm(:)%keys, '10'))
     928  prnt =         fgetKey('parent',tm(:)%keys,  '' )
     929  IF(getKey('phases', phas, ky=tm(:)%keys)) phas = fGetKey('phase', tm(:)%keys, 'g')
    821930  CALL msg(TRIM(message)//':', modname)
    822   IF(ALL(tm(:)%parent == '')) THEN
    823     IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '], cat(tm%name, phas), &
     931  IF(ALL(prnt == 'air')) THEN
     932    IF(test(dispTable('iiiss',   ['iq    ','hadv  ','vadv  ','name  ','phase '],                   cat(tm%name,       phas),  &
     933                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
     934  ELSE IF(ALL(tm%iGeneration == -1)) THEN
     935    IF(test(dispTable('iiisss', ['iq    ','hadv  ','vadv  ','name  ','parent','phase '],           cat(tm%name, prnt, phas),  &
    824936                 cat([(iq, iq=1, nq)], hadv, vadv),                 nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    825937  ELSE
    826     IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, tm%parent, &
    827       tm%phase), cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
     938    IF(test(dispTable('iiissis', ['iq    ','hadv  ','vadv  ','name  ','parent','igen  ','phase '], cat(tm%name, prnt, phas), &
     939                cat([(iq, iq=1, nq)], hadv, vadv, tm%iGeneration), nColMax=maxTableWidth, nHead=2, sub=modname), lerr)) RETURN
    828940  END IF
    829941END FUNCTION dispTraSection
    … …  
    884996SUBROUTINE indexUpdate(tr)
    885997  TYPE(trac_type), INTENT(INOUT) :: tr(:)
    886   INTEGER :: iq, ig, ng, igen, ngen
    887   INTEGER, ALLOCATABLE :: ix(:)
     998  INTEGER :: iq, ig, ng, igen, ngen, ix(SIZE(tr))
    888999  tr(:)%iqParent = strIdx( tr(:)%name, tr(:)%parent )                !--- Parent index
     1000  CALL addKey('iqParent', int2str(tr%iqParent), tr(:)%keys)
    8891001  ngen = MAXVAL(tr(:)%iGeneration, MASK=.TRUE.)
    8901002  DO iq = 1, SIZE(tr)
    … …  
    8921004    IF(ALLOCATED(tr(iq)%iqDescen)) DEALLOCATE(tr(iq)%iqDescen)
    8931005    ALLOCATE(tr(iq)%iqDescen(0))
    894     ix = idxAncestor(tr, igen=ig)                                    !--- Ancestor of generation "ng" for each tr
     1006    CALL idxAncestor(tr, ix, ig)                                     !--- Ancestor of generation "ng" for each tr
    8951007    DO igen = ig+1, ngen
    8961008      tr(iq)%iqDescen = [tr(iq)%iqDescen, find(ix==iq .AND. tr%iGeneration==igen)]
    8971009      tr(iq)%nqDescen = SIZE(tr(iq)%iqDescen)
    898       IF(igen == ig+1) tr(iq)%nqChilds=tr(iq)%nqDescen
     1010      IF(igen == ig+1) THEN
     1011        tr(iq)%nqChildren = tr(iq)%nqDescen
     1012        CALL addKey('nqChildren', int2str(tr(iq)%nqChildren), tr(iq)%keys)
     1013      END IF
    8991014    END DO
    900   END DO
     1015    CALL addKey('iqDescen', strStack(int2str(tr(iq)%iqDescen)), tr(iq)%keys)
     1016  END DO
     1017  CALL addKey('nqDescen', int2str(tr(:)%nqDescen), tr(:)%keys)
    9011018END SUBROUTINE indexUpdate
    9021019!==============================================================================================================================
    … …  
    9081025!===  * For each isotopes class, the <key>=<val> vector of each tracer is moved into the isotopes descriptor "isot"        ====
    9091026!=== NOTES:                                                                                                                ====
    910 !===  * Most of the "isot" components have been defined in the calling routine (initIsotopes):                             ====
     1027!===  * Most of the "isot" components have been defined in the calling routine (readIsotopes):                             ====
    9111028!===      parent,  nzone, zone(:),  niso, keys(:)%name,  ntiso, trac(:),  nphas, phas,  iqIsoPha(:,:),  itZonPhi(:,:)      ====
    9121029!===  * Same syntax for isotopes file and "tracer.def": a tracers section contains one line for each of its isotopes       ====
    … …  
    9161033!===  * The routine gives an error if a required isotope is not available in the database stored in "fnam"                 ====
    9171034!==============================================================================================================================
    918 LOGICAL FUNCTION readIsotopesFile(fnam, isot) RESULT(lerr)
     1035LOGICAL FUNCTION readIsotopesFile_prv(fnam, isot) RESULT(lerr)
    9191036  CHARACTER(LEN=*),        INTENT(IN)    :: fnam                     !--- Input file name
    9201037  TYPE(isot_type), TARGET, INTENT(INOUT) :: isot(:)                  !--- Isotopes descriptors (field %parent must be defined!)
    … …  
    9271044  TYPE(trac_type),           POINTER ::   tt(:), t
    9281045  TYPE(dataBase_type),   ALLOCATABLE ::  tdb(:)
    929   LOGICAL,               ALLOCATABLE :: liso(:)
    9301046  modname = 'readIsotopesFile'
    9311047
    … …  
    9531069      is = strIdx(isot(iis)%keys(:)%name, t%name)                    !--- Index in "isot(iis)%keys(:)%name" of isotope "t%name"
    9541070      IF(is == 0) CYCLE
    955       liso = reduceExpr(t%keys%val, vals)                            !--- Reduce expressions (for substituted variables)
    956       IF(test(ANY(liso), lerr)) RETURN                               !--- Some non-numerical elements were found
    957       isot(iis)%keys(is)%key = PACK(t%keys%key, MASK=.NOT.liso)
    958       isot(iis)%keys(is)%val = PACK(  vals,     MASK=.NOT.liso)
     1071      IF(test(ANY(reduceExpr(t%keys%val, vals)), lerr)) RETURN       !--- Reduce expressions ; detect non-numerical elements
     1072      isot(iis)%keys(is)%key = t%keys%key
     1073      isot(iis)%keys(is)%val = vals
    9591074    END DO
    9601075
    9611076    !--- CHECK FOR MISSING ISOTOPES (NO KEYS ALLOCATED)
    962     liso = [( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )]
    963     IF(test(checkList(isot(iis)%keys(:)%name, .NOT.liso, &
    964       'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'),lerr)) RETURN
     1077    IF(test(checkList(isot(iis)%keys(:)%name, .NOT.[( ALLOCATED(isot(iis)%keys(is)%key), is=1, SIZE(isot(iis)%keys) )], &
     1078      'Check file "'//TRIM(fnam)//'" in section "'//TRIM(dBase(idb)%name)//'"', 'isotopes', 'missing'), lerr)) RETURN
    9651079  END DO
    9661080
    … …  
    9751089  CALL get_in('ok_iso_verif', isot(strIdx(isot%parent, 'H2O'))%check, .FALSE.)
    9761090
    977   lerr = dispIsotopes(isot, 'Isotopes parameters read from file "'//TRIM(fnam)//'"', modname)
    978 
    979 END FUNCTION readIsotopesFile
     1091  lerr = dispIsotopes()
     1092
     1093CONTAINS
     1094
     1095!------------------------------------------------------------------------------------------------------------------------------
     1096LOGICAL FUNCTION dispIsotopes() RESULT(lerr)
     1097  INTEGER :: ik, nk, ip, it, nt
     1098  CHARACTER(LEN=maxlen) :: prf
     1099  CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
     1100  CALL msg('Isotopes parameters read from file "'//TRIM(fnam)//'":', modname)
     1101  DO ip = 1, SIZE(isot)                                              !--- Loop on parents tracers
     1102    nk = SIZE(isot(ip)%keys(1)%key)                                  !--- Same keys for each isotope
     1103    nt = SIZE(isot(ip)%keys)                                         !--- Number of isotopes
     1104    prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
     1105    ALLOCATE(ttl(nk+2), val(nt,nk+1))
     1106    ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = isot(ip)%keys(1)%key(:)!--- Titles line with keys names
     1107    val(:,1) = isot(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
     1108    DO ik = 1, nk
     1109      DO it = 1, nt
     1110        val(it,ik+1) = isot(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
     1111      END DO
     1112    END DO
     1113    IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
     1114            cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
     1115    DEALLOCATE(ttl, val)
     1116  END DO       
     1117END FUNCTION dispIsotopes
     1118!------------------------------------------------------------------------------------------------------------------------------
     1119
     1120END FUNCTION readIsotopesFile_prv
    9801121!==============================================================================================================================
    9811122
    … …  
    9851126!===    * COMPUTE MOST OF THE RELATED QUANTITIES ("isot" COMPONENTS).                                                       ===
    9861127!===    * COMPUTE FEW ISOTOPES-DEDICATED "trac" COMPONENTS                                                                  ===
    987 !===    * CALL readIsotopesFile TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                              ===
     1128!===    * CALL readIsotopesFile_prv TO GET PHYSICAL QUANTITIES (<key>=<val> PAIRS)                                          ===
    9881129!===      NOTE: THIS IS DONE HERE (IN A ROUTINE CALLED BY THE DYNAMIC), BECAUSE THE DYNAMIC NEEDS FEW PHYSICAL PARAMETERS.  ===
    9891130!==============================================================================================================================
    990 LOGICAL FUNCTION initIsotopes(trac, isot) RESULT(lerr)
    991   TYPE(trac_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: trac(:)
    992   TYPE(isot_type), ALLOCATABLE, TARGET, INTENT(INOUT) :: isot(:)
     1131LOGICAL FUNCTION readIsotopesFile(iNames) RESULT(lerr)
     1132  CHARACTER(LEN=maxlen), TARGET, OPTIONAL, INTENT(IN)  :: iNames(:)
    9931133  CHARACTER(LEN=maxlen), ALLOCATABLE :: p(:), str(:)                 !--- Temporary storage
    994   CHARACTER(LEN=maxlen) :: iName
     1134  CHARACTER(LEN=maxlen) :: iName, modname
    9951135  CHARACTER(LEN=1)   :: ph                                           !--- Phase
    996   INTEGER :: nbIso, ic, ip, iq, it, iz
     1136  INTEGER :: ic, ip, iq, it, iz
    9971137  LOGICAL, ALLOCATABLE :: ll(:)                                      !--- Mask
    9981138  TYPE(trac_type), POINTER   ::  t(:), t1
    9991139  TYPE(isot_type), POINTER   ::  i
    10001140  lerr = .FALSE.
    1001 
    1002   t => trac
     1141  modname = 'readIsotopesFile'
     1142
     1143  t => tracers
    10031144
    10041145  !--- GET FROM "tracers" THE FULL LIST OF AVAILABLE ISOTOPES CLASSES
    10051146  p = PACK(delPhase(t%parent), MASK = t%type=='tracer' .AND. t%iGeneration==1)
    10061147  CALL strReduce(p, nbIso)
    1007   ALLOCATE(isot(nbIso))
     1148
     1149  !--- CHECK WHETHER NEEDED ISOTOPES CLASSES "iNames" ARE AVAILABLE OR NOT
     1150  IF(PRESENT(iNames)) THEN
     1151    DO it = 1, SIZE(iNames)
     1152      IF(test(fmsg('No isotopes class "'//TRIM(iNames(it))//'" found among tracers', modname, ALL(p /= iNames(it))), lerr)) RETURN
     1153    END DO
     1154    p = iNames; nbIso = SIZE(p)
     1155  END IF
     1156  IF(ALLOCATED(isotopes)) DEALLOCATE(isotopes)
     1157  ALLOCATE(isotopes(nbIso))
    10081158
    10091159  IF(nbIso==0) RETURN                                                !=== NO ISOTOPES: FINISHED
    10101160
    10111161  !--- ISOTOPES RELATED VARIABLES ; NULL OR EMPTY IF NO ISOTOPES
    1012   isot(:)%parent = p
     1162  isotopes(:)%parent = p
    10131163  DO ic = 1, SIZE(p)                                                 !--- Loop on isotopes classes
    1014     i => isot(ic)
     1164    i => isotopes(ic)
    10151165    iname = i%parent                                                 !--- Current isotopes class name (parent tracer name)
    10161166
    1017     !=== Isotopes childs of tracer "iname": mask, names, number (same for each phase of "iname")
     1167    !=== Isotopes children of tracer "iname": mask, names, number (same for each phase of "iname")
    10181168    ll = t(:)%type=='tracer' .AND. delPhase(t(:)%parent) == iname .AND. t(:)%phase == 'g'
    10191169    str = PACK(delPhase(t(:)%name), MASK = ll)                       !--- Effectively found isotopes of "iname"
    … …  
    10281178    i%nzone = SIZE(i%zone)                                           !--- Tagging zones number for isotopes category "iname"
    10291179
    1030     !=== Geographic tracers of the isotopes childs of tracer "iname" (same for each phase of "iname")
     1180    !=== Geographic tracers of the isotopes children of tracer "iname" (same for each phase of "iname")
    10311181    !    NOTE: One might like to create a similar variable for 2nd generation tagging tracers (tagging the gen1 tracers)
    10321182    str = PACK(delPhase(t(:)%name), MASK=ll)
    … …  
    10441194    !=== Tables giving the index in a table of effectively found items for each dynamical tracer (1<=iq<=nqtot)
    10451195    DO iq = 1, SIZE(t)
    1046       t1 => trac(iq)
     1196      t1 => tracers(iq)
    10471197      IF(delPhase(t1%gen0Name)/=iname .OR. t1%iGeneration==0) CYCLE  !--- Only deal with tracers descending on "iname"
    10481198      t1%iso_iGroup = ic                                             !--- Isotopes family       idx in list "isotopes(:)%parent"
    … …  
    10551205    !=== Table used to get iq (index in dyn array, size nqtot) from the isotope and phase indexes ; the full isotopes list
    10561206    !    (including tagging tracers) is sorted this way:  iso1, iso2, ..., iso1_zone1, iso2_zone1, ..., iso1_zoneN, iso2_zoneN
    1057     i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),      it=1, i%ntiso), ip=1, i%nphas)], &
     1207    i%iqIsoPha = RESHAPE( [( (strIdx(t%name,  addPhase(i%trac(it),i%phase(ip:ip))),       it=1, i%ntiso), ip=1, i%nphas)], &
    10581208                         [i%ntiso, i%nphas] )
    10591209    !=== Table used to get ix (index in tagging tracers isotopes list, size ntiso) from the zone and isotope indexes
    … …  
    10621212  END DO
    10631213
    1064   !=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE
    1065   lerr = readIsotopesFile('isotopes_params.def',isot)
    1066 
    1067 END FUNCTION initIsotopes
    1068 !==============================================================================================================================
    1069 
    1070 
    1071 !==============================================================================================================================
    1072 LOGICAL FUNCTION dispIsotopes(ides, message, modname) RESULT(lerr)
    1073   TYPE(isot_type),  INTENT(IN) :: ides(:)                            !--- Isotopes descriptor vector
    1074   CHARACTER(LEN=*), INTENT(IN) :: message                            !--- Message to display
    1075   CHARACTER(LEN=*), INTENT(IN) :: modname                            !--- Calling subroutine name
    1076   INTEGER :: ik, nk, ip, it, nt
    1077   CHARACTER(LEN=maxlen) :: prf
    1078   CHARACTER(LEN=maxlen), ALLOCATABLE :: ttl(:), val(:,:)
    1079   CALL msg(TRIM(message)//':', modname)
    1080   DO ip = 1, SIZE(ides)                                              !--- Loop on parents tracers
    1081     nk = SIZE(ides(ip)%keys(1)%key)                                  !--- Same keys for each isotope
    1082     nt = SIZE(ides(ip)%keys)                                         !--- Number of isotopes
    1083     prf = 'i'//REPEAT('s',nk+1)                                      !--- Profile for table printing
    1084     ALLOCATE(ttl(nk+2), val(nt,nk+1))
    1085     ttl(1:2) = ['it  ','name']; ttl(3:nk+2) = ides(ip)%keys(1)%key(:)!--- Titles line with keys names
    1086     val(:,1) = ides(ip)%keys(:)%name                                 !--- Values table 1st column: isotopes names 
    1087     DO ik = 1, nk
    1088       DO it = 1, nt
    1089         val(it,ik+1) = ides(ip)%keys(it)%val(ik)                     !--- Other columns: keys values
    1090       END DO
     1214  !=== READ PHYSICAL PARAMETERS FROM isoFile FILE
     1215  IF(test(readIsotopesFile_prv(isoFile, isotopes), lerr)) RETURN
     1216
     1217  !=== CHECK CONSISTENCY
     1218  IF(test(testIsotopes(), lerr)) RETURN
     1219
     1220  !=== SELECT FIRST ISOTOPES CLASS OR, IF POSSIBLE, WATER CLASS
     1221  IF(.NOT.test(isoSelect(1, .TRUE.), lerr)) THEN; IF(isotope%parent == 'H2O') iH2O = ixIso; END IF
     1222
     1223CONTAINS
     1224
     1225!------------------------------------------------------------------------------------------------------------------------------
     1226LOGICAL FUNCTION testIsotopes() RESULT(lerr)     !--- MAKE SURE MEMBERS OF AN ISOTOPES FAMILY ARE PRESENT IN THE SAME PHASES
     1227!------------------------------------------------------------------------------------------------------------------------------
     1228  INTEGER :: ix, it, ip, np, iz, nz
     1229  TYPE(isot_type), POINTER :: i
     1230  DO ix = 1, nbIso
     1231    i => isotopes(ix)
     1232    !--- Check whether each isotope and tagging isotopic tracer is present in the same number of phases
     1233    DO it = 1, i%ntiso
     1234      np = SUM([(COUNT(tracers(:)%name == addPhase(i%trac(it), i%phase(ip:ip))), ip=1, i%nphas)])
     1235      IF(test(fmsg(TRIM(int2str(np))//' phases instead of '//TRIM(int2str(i%nphas))//' for '//TRIM(i%trac(it)), &
     1236        modname, np /= i%nphas), lerr)) RETURN
    10911237    END DO
    1092     IF(test(fmsg('Problem with the table content', modname, dispTable(prf, ttl, val, &
    1093             cat([(it,it=1,nt)]), rFmt='(EN8.4)', nColMax=maxTableWidth, nHead=2, sub=modname)), lerr)) RETURN
    1094     DEALLOCATE(ttl, val)
    1095   END DO       
    1096 END FUNCTION dispIsotopes
     1238    DO it = 1, i%niso
     1239      nz = SUM([(COUNT(i%trac == TRIM(i%trac(it))//'_'//i%zone(iz)), iz=1, i%nzone)])
     1240      IF(test(fmsg(TRIM(int2str(nz))//' tagging zones instead of '//TRIM(int2str(i%nzone))//' for '//TRIM(i%trac(it)), &
     1241        modname, nz /= i%nzone), lerr)) RETURN
     1242    END DO
     1243  END DO
     1244END FUNCTION testIsotopes
     1245!------------------------------------------------------------------------------------------------------------------------------
     1246
     1247END FUNCTION readIsotopesFile
     1248!==============================================================================================================================
     1249
     1250
     1251!==============================================================================================================================
     1252!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
     1253!     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
     1254!==============================================================================================================================
     1255LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
     1256   IMPLICIT NONE
     1257   CHARACTER(LEN=*),  INTENT(IN) :: iName
     1258   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     1259   INTEGER :: iIso
     1260   LOGICAL :: lV
     1261   lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
     1262   iIso = strIdx(isotopes(:)%parent, iName)
     1263   IF(test(iIso == 0, lerr)) THEN
     1264      niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
     1265      CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lV)
     1266      RETURN
     1267   END IF
     1268   lerr = isoSelectByIndex(iIso, lV)
     1269END FUNCTION isoSelectByName
     1270!==============================================================================================================================
     1271LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
     1272   IMPLICIT NONE
     1273   INTEGER,           INTENT(IN) :: iIso
     1274   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
     1275   LOGICAL :: lV
     1276   lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
     1277   lerr = .FALSE.
     1278   IF(iIso == ixIso) RETURN                                          !--- Nothing to do if the index is already OK
     1279   lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
     1280   CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
     1281          //TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
     1282   IF(lerr) RETURN
     1283   ixIso = iIso                                                      !--- Update currently selected family index
     1284   isotope  => isotopes(ixIso)                                       !--- Select corresponding component
     1285   isoKeys  => isotope%keys;     niso     = isotope%niso
     1286   isoName  => isotope%trac;     ntiso    = isotope%ntiso
     1287   isoZone  => isotope%zone;     nzone    = isotope%nzone
     1288   isoPhas  => isotope%phase;    nphas    = isotope%nphas
     1289   itZonIso => isotope%itZonIso; isoCheck = isotope%check
     1290   iqIsoPha => isotope%iqIsoPha
     1291END FUNCTION isoSelectByIndex
    10971292!==============================================================================================================================
    10981293
    … …  
    11091304  INTEGER :: iky, nky
    11101305  LOGICAL :: lo
    1111   lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
     1306  lo=.TRUE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    11121307  iky = strIdx(ky%key,key)
    11131308  IF(iky == 0) THEN
    11141309    nky = SIZE(ky%key)
    11151310    IF(nky == 0) THEN; ky%key = [key]; ky%val = [val]; ELSE; ky%key = [ky%key, key]; ky%val = [ky%val, val]; END IF
    1116   ELSE IF(lo) THEN                                                   !--- Overwriting
     1311  ELSE IF(lo) THEN
    11171312    ky%key(iky) = key; ky%val(iky) = val
    11181313  END IF
    … …  
    11251320!------------------------------------------------------------------------------------------------------------------------------
    11261321  INTEGER :: itr
    1127   LOGICAL :: lo
    1128   lo=.FALSE.; IF(PRESENT(lOverWrite)) lo=lOverWrite
    1129   DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lo); END DO
     1322  DO itr = 1, SIZE(ky); CALL addKey_1(key, val, ky(itr), lOverWrite); END DO
    11301323END SUBROUTINE addKey_m
     1324!==============================================================================================================================
     1325SUBROUTINE addKey_mm(key, val, ky, lOverWrite)
     1326  CHARACTER(LEN=*),  INTENT(IN)    :: key, val(:)
     1327  TYPE(keys_type),   INTENT(INOUT) :: ky(:)
     1328  LOGICAL, OPTIONAL, INTENT(IN)    :: lOverWrite
     1329!------------------------------------------------------------------------------------------------------------------------------
     1330  INTEGER :: itr
     1331  DO itr = 1, SIZE(ky); CALL addKey_1(key, val(itr), ky(itr), lOverWrite); END DO
     1332END SUBROUTINE addKey_mm
    11311333!==============================================================================================================================
    11321334
    … …  
    11791381
    11801382!==============================================================================================================================
    1181 !=== getKey ROUTINE INITIALIZATION (TO BE EMBEDDED SOMEWHERE)  ================================================================
    1182 !==============================================================================================================================
    1183 SUBROUTINE getKey_init(tracers_, isotopes_)
    1184   TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
    1185   TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
    1186   IF(PRESENT( tracers_))  tracers =  tracers_
    1187   IF(PRESENT(isotopes_)) isotopes = isotopes_
    1188 END SUBROUTINE getKey_init
    1189 
    1190 
    1191 !==============================================================================================================================
    11921383!================ GET THE VALUE OF A KEY FROM A "keys_type" DERIVED TYPE ; THE RESULT IS THE RETURNED VALUE ===================
    11931384!==============================================================================================================================
    1194 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByIndex_s1(itr, keyn, ky, def_val) RESULT(val)
    1195   INTEGER,                    INTENT(IN) :: itr
    1196   CHARACTER(LEN=*),           INTENT(IN) :: keyn
    1197   TYPE(keys_type),            INTENT(IN) :: ky(:)
    1198   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def_val
     1385CHARACTER(LEN=maxlen) FUNCTION fgetKeyIdx_s1(itr, keyn, ky, def_val, lerr) RESULT(val)
     1386  INTEGER,                    INTENT(IN)  :: itr
     1387  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1388  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1389  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1390  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    11991391!------------------------------------------------------------------------------------------------------------------------------
    12001392  INTEGER :: iky
    1201   iky = 0;  IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
    1202   val = ''; IF(iky /= 0) val = ky(itr)%val(iky)                      !--- Key was found
    1203   IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
    1204 END FUNCTION fgetKeyByIndex_s1
    1205 !==============================================================================================================================
    1206 CHARACTER(LEN=maxlen) FUNCTION fgetKeyByName_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
     1393  LOGICAL :: ler
     1394  iky = 0; val = ''
     1395  IF(.NOT.test(itr <= 0 .OR. itr > SIZE(ky), ler)) iky = strIdx(ky(itr)%key(:), keyn)    !--- Correct index
     1396  IF(.NOT.test(iky == 0, ler))                     val = ky(itr)%val(iky)                !--- Found key
     1397  IF(iky == 0) THEN
     1398    IF(.NOT.test(.NOT.PRESENT(def_val), ler))      val = def_val                         !--- Default value
     1399  END IF
     1400  IF(PRESENT(lerr)) lerr = ler
     1401END FUNCTION fgetKeyIdx_s1
     1402!==============================================================================================================================
     1403CHARACTER(LEN=maxlen) FUNCTION fgetKeyNam_s1(tname, keyn, ky, def_val, lerr) RESULT(val)
    12071404  CHARACTER(LEN=*),           INTENT(IN)  :: tname, keyn
    12081405  TYPE(keys_type),            INTENT(IN)  :: ky(:)
    … …  
    12101407  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
    12111408!------------------------------------------------------------------------------------------------------------------------------
    1212   INTEGER :: iky, itr
    1213   val = ''; iky = 0
    1214   itr = strIdx(ky(:)%name, tname)                                    !--- Get the index of the wanted tracer
    1215   IF(PRESENT(lerr)) lerr = itr==0; IF(itr == 0) RETURN
    1216   IF(itr >  0 .AND. itr <= SIZE(ky)) iky = strIdx(ky(itr)%key(:), keyn)
    1217   IF(iky /= 0) val = ky(itr)%val(iky)                                !--- Key was found
    1218   IF(PRESENT(def_val) .AND. iky == 0) val = def_val                  !--- Default value from arguments
    1219 END FUNCTION fgetKeyByName_s1
     1409  val = fgetKeyIdx_s1(strIdx(ky(:)%name, tname), keyn, ky, def_val, lerr)
     1410END FUNCTION fgetKeyNam_s1
     1411!==============================================================================================================================
     1412FUNCTION fgetKey_sm(keyn, ky, def_val, lerr) RESULT(val)
     1413CHARACTER(LEN=maxlen),        ALLOCATABLE :: val(:)
     1414  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1415  TYPE(keys_type),            INTENT(IN)  :: ky(:)
     1416  CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: def_val
     1417  LOGICAL,          OPTIONAL, INTENT(OUT) :: lerr
     1418!------------------------------------------------------------------------------------------------------------------------------
     1419  LOGICAL :: ler(SIZE(ky))
     1420  INTEGER :: it
     1421  val = [(fgetKeyIdx_s1(it, keyn, ky, def_val, ler(it)), it = 1, SIZE(ky))]
     1422  IF(PRESENT(lerr)) lerr = ANY(ler)
     1423END FUNCTION fgetKey_sm
    12201424!==============================================================================================================================
    12211425
    … …  
    12361440!------------------------------------------------------------------------------------------------------------------------------
    12371441  CHARACTER(LEN=maxlen) :: tnam
    1238   INTEGER, ALLOCATABLE  :: is(:)
    1239   INTEGER :: i, itr
    1240   tnam = delPhase(strHead(tname,'_',.FALSE.))                        !--- Remove tag and phase
    1241   IF(PRESENT(ky)) THEN
    1242     val = fgetKeyByName_s1(tname, keyn, ky, lerr=lerr)               !--- "ky" and "tname"
    1243     IF(val /= '' .OR. lerr)      RETURN
    1244     val = fgetKeyByName_s1(tnam,  keyn, ky, lerr=lerr)               !--- "ky" and "tnam"
     1442  tnam = strHead(delPhase(tname),'_',.FALSE.)                                            !--- Remove tag and phase
     1443  IF(PRESENT(ky)) THEN                                                                   !=== KEY FROM "ky"
     1444               val = fgetKeyNam_s1(tname, keyn, ky,           lerr=lerr)                 !--- "ky" and "tname"
     1445    IF( lerr ) val = fgetKeyNam_s1(tnam,  keyn, ky,           lerr=lerr)                 !--- "ky" and "tnam"
    12451446  ELSE
    1246     IF(.NOT.ALLOCATED(tracers))  RETURN
    1247     val = fgetKeyByName_s1(tname, keyn, tracers(:)%keys, lerr=lerr)  !--- "tracers" and "tname"
    1248     IF(val /= ''.AND..NOT.lerr)  RETURN
    1249     IF(.NOT.ALLOCATED(isotopes)) RETURN
    1250     IF(SIZE(isotopes) == 0)      RETURN
    1251     !--- Search the "is" isotopes class index of the isotope named "tnam"
    1252     is = find([(ANY(isotopes(i)%keys(:)%name == tnam), i=1, SIZE(isotopes))])
    1253     IF(test(SIZE(is) == 0,lerr)) RETURN
    1254     val = fgetKeyByName_s1(tname, keyn, isotopes(is(1))%keys(:),lerr=lerr)!--- "isotopes" and "tnam"
     1447    IF(         .NOT.test(.NOT.ALLOCATED(tracers ), lerr)) lerr = SIZE(tracers ) == 0    !=== KEY FROM "tracers"
     1448    IF(.NOT.lerr) THEN
     1449               val = fgetKeyNam_s1(tname, keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tname"
     1450      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, tracers%keys, lerr=lerr)                 !--- "ky" and "tnam"
     1451    END IF
     1452    IF(lerr.AND..NOT.test(.NOT.ALLOCATED(isotopes), lerr)) lerr = SIZE(isotopes) == 0    !=== KEY FROM "isotope"
     1453    IF(.NOT.lerr) THEN
     1454               val = fgetKeyNam_s1(tname, keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tname"
     1455      IF(lerr) val = fgetKeyNam_s1(tnam,  keyn, isotope%keys, lerr=lerr)                 !--- "ky" and "tnam"
     1456    END IF
    12551457  END IF
    12561458END FUNCTION getKeyByName_s1
    12571459!==============================================================================================================================
    1258 LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky) RESULT(lerr)
     1460LOGICAL FUNCTION getKeyByName_sm(keyn, val, tname, ky, nam) RESULT(lerr)
     1461  CHARACTER(LEN=*),                             INTENT(IN)  :: keyn
     1462  CHARACTER(LEN=maxlen), ALLOCATABLE,           INTENT(OUT) :: val(:)
     1463  CHARACTER(LEN=*),           TARGET, OPTIONAL, INTENT(IN)  :: tname(:)
     1464  TYPE(keys_type),            TARGET, OPTIONAL, INTENT(IN)  :: ky(:)
     1465  CHARACTER(LEN=maxlen), ALLOCATABLE, OPTIONAL, INTENT(OUT) :: nam(:)
     1466!------------------------------------------------------------------------------------------------------------------------------
     1467  CHARACTER(LEN=maxlen), ALLOCATABLE :: names(:)
     1468  TYPE(keys_type),       POINTER     ::  keys(:)
     1469  LOGICAL :: lk, lt, li, ll
     1470  INTEGER :: iq, nq
     1471
     1472  !--- DETERMINE THE DATABASE TO BE USED (ky, tracers or isotope)
     1473  lk = PRESENT(ky)
     1474  lt = .NOT.lk .AND. ALLOCATED(tracers);  IF(lt) lt = SIZE(tracers)  /= 0; IF(lt) lt = ANY(tracers(1)%keys%key(:) == keyn)
     1475  li = .NOT.lt .AND. ALLOCATED(isotopes); IF(li) li = SIZE(isotopes) /= 0; IF(li) li = ANY(isotope%keys(1)%key(:) == keyn)
     1476
     1477  IF(test(.NOT.ANY([lk,lt,li]), lerr)) RETURN
     1478  IF(lk) keys => ky(:)
     1479  IF(lt) keys => tracers(:)%keys
     1480  IF(li) keys => isotope%keys(:)
     1481
     1482  !--- DETERMINE THE NAMES
     1483  IF(PRESENT(tname)) THEN
     1484    ALLOCATE(names(SIZE(tname))); names(:) = tname(:)
     1485  ELSE
     1486    ALLOCATE(names(SIZE(keys)));  names(:) = keys(:)%name
     1487  END IF
     1488  nq = SIZE(names); ALLOCATE(val(nq)); IF(PRESENT(nam)) THEN; ALLOCATE(nam(nq)); nam(:) = names(:); END IF
     1489
     1490  !--- GET THE DATA
     1491  lerr = ANY([(getKeyByName_s1(keyn, val(iq), names(iq), keys(:)), iq=1, nq)])
     1492
     1493END FUNCTION getKeyByName_sm
     1494!==============================================================================================================================
     1495LOGICAL FUNCTION getKeyByName_s1m(keyn, val, tname, ky) RESULT(lerr)
    12591496  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
    1260   CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) ::   val(:)
    1261   CHARACTER(LEN=*),         OPTIONAL, INTENT(IN)  :: tname(:)
    1262   TYPE(keys_type),          OPTIONAL, INTENT(IN)  ::    ky(:)
    1263 !------------------------------------------------------------------------------------------------------------------------------
    1264   TYPE(keys_type),           POINTER :: k(:)
    1265   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1266   INTEGER :: iq, nq
    1267   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1268   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1269   IF(PRESENT(tname)) nq = SIZE(  tname)
    1270   ALLOCATE(val(nq))
    1271   IF(PRESENT(tname)) THEN
    1272     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1273     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_s1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1274   ELSE;                  lerr = ANY([(getKeyByName_s1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
    1275   END IF
    1276 END FUNCTION getKeyByName_sm
     1497  CHARACTER(LEN=maxlen), ALLOCATABLE, INTENT(OUT) :: val(:)
     1498  CHARACTER(LEN=*),                   INTENT(IN)  :: tname
     1499  TYPE(keys_type),          OPTIONAL, INTENT(IN)  :: ky(:)
     1500!------------------------------------------------------------------------------------------------------------------------------
     1501  CHARACTER(LEN=maxlen) :: sval
     1502  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1503  IF(test(fmsg('missing key "'//TRIM(keyn)//'" for tracer "'//TRIM(tname)//'"', modname, lerr), lerr)) RETURN
     1504  lerr = strParse(sval, ',', val)
     1505END FUNCTION getKeyByName_s1m
    12771506!==============================================================================================================================
    12781507LOGICAL FUNCTION getKeyByName_i1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    12841513  CHARACTER(LEN=maxlen) :: sval
    12851514  INTEGER :: ierr
    1286   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1287   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
    1288   IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',        modname, lerr), lerr)) RETURN
     1515  lerr = getKeyByName_s1(keyn, sval, tname, ky)
     1516  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing', modname, lerr), lerr)) RETURN
    12891517  READ(sval, *, IOSTAT=ierr) val
     1518  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1519END FUNCTION getKeyByName_i1
     1520!==============================================================================================================================
     1521LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
     1522  CHARACTER(LEN=*),                   INTENT(IN)  :: keyn
     1523  INTEGER,               ALLOCATABLE, INTENT(OUT) ::   val(:)
     1524  CHARACTER(LEN=*), OPTIONAL, TARGET, INTENT(IN)  :: tname(:)
     1525  TYPE(keys_type),  OPTIONAL, TARGET, INTENT(IN)  ::    ky(:)
     1526!------------------------------------------------------------------------------------------------------------------------------
     1527  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:)
     1528  INTEGER :: ierr, iq
     1529  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
     1530  ALLOCATE(val(SIZE(sval)))
     1531  DO iq = 1, SIZE(sval)                                              !--- CONVERT THE KEYS TO INTEGERS
     1532    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1533    IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not an integer', modname, ierr/=0), lerr)) RETURN
     1534  END DO
     1535END FUNCTION getKeyByName_im
     1536!==============================================================================================================================
     1537LOGICAL FUNCTION getKeyByName_i1m(keyn, val, tname, ky) RESULT(lerr)
     1538  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1539  INTEGER,       ALLOCATABLE, INTENT(OUT) :: val(:)
     1540  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1541  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1542!------------------------------------------------------------------------------------------------------------------------------
     1543  CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:)
     1544  INTEGER :: ierr, iq
     1545  IF(test(getKeyByName_s1m(keyn, v, tname, ky), lerr)) RETURN
     1546  ALLOCATE(val(SIZE(v)))
     1547  lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
    12901548  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not an integer', modname, lerr), lerr)) RETURN
    1291 END FUNCTION getKeyByName_i1
    1292 !==============================================================================================================================
    1293 LOGICAL FUNCTION getKeyByName_im(keyn, val, tname, ky) RESULT(lerr)
    1294   CHARACTER(LEN=*),           INTENT(IN)  :: keyn
    1295   INTEGER,       ALLOCATABLE, INTENT(OUT) ::   val(:)
    1296   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)  :: tname(:)
    1297   TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    1298 !------------------------------------------------------------------------------------------------------------------------------
    1299   TYPE(keys_type),           POINTER :: k(:)
    1300   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1301   INTEGER :: iq, nq
    1302   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1303   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1304   IF(PRESENT(tname)) nq = SIZE(  tname)
    1305   ALLOCATE(val(nq))
    1306   IF(PRESENT(tname)) THEN
    1307     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1308     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_i1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1309   ELSE;                  lerr = ANY([(getKeyByName_i1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
    1310   END IF
    1311 END FUNCTION getKeyByName_im
     1549END FUNCTION getKeyByName_i1m
    13121550!==============================================================================================================================
    13131551LOGICAL FUNCTION getKeyByName_r1(keyn, val, tname, ky) RESULT(lerr)
    … …  
    13191557  CHARACTER(LEN=maxlen) :: sval
    13201558  INTEGER :: ierr
    1321   IF(     PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname, ky)
    1322   IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1(keyn, sval, tname)
     1559  lerr = getKeyByName_s1(keyn, sval, tname, ky)
    13231560  IF(test(fmsg('key "'//TRIM(keyn)//'" or tracer "'//TRIM(tname)//'" is missing',    modname, lerr), lerr)) RETURN
    13241561  READ(sval, *, IOSTAT=ierr) val
    1325   IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
     1562  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, ierr/=0), lerr)) RETURN
    13261563END FUNCTION getKeyByName_r1
    13271564!==============================================================================================================================
    … …  
    13321569  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::    ky(:)
    13331570!------------------------------------------------------------------------------------------------------------------------------
    1334   TYPE(keys_type),           POINTER :: k(:)
    1335   CHARACTER(LEN=maxlen), ALLOCATABLE :: n(:)
    1336   INTEGER :: iq, nq
    1337   IF(test(.NOT.(PRESENT(tname).OR.PRESENT(ky)), lerr)) RETURN
    1338   IF(PRESENT(ky   )) nq = SIZE(ky%name)
    1339   IF(PRESENT(tname)) nq = SIZE(  tname)
    1340   ALLOCATE(val(nq))
    1341   IF(PRESENT(tname)) THEN
    1342     IF(     PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq),   ky), iq=1, nq)])
    1343     IF(.NOT.PRESENT(ky)) lerr = ANY([(getKeyByName_r1(keyn, val(iq), tname(iq)      ), iq=1, nq)])
    1344   ELSE;                  lerr = ANY([(getKeyByName_r1(keyn, val(iq), ky(iq)%name, ky), iq=1, nq)])
     1571  CHARACTER(LEN=maxlen), ALLOCATABLE :: sval(:), nam(:)
     1572  INTEGER :: ierr, iq
     1573  IF(test(getKeyByName_sm(keyn, sval, tname, ky, nam), lerr)) RETURN
     1574  ALLOCATE(val(SIZE(sval)))
     1575  DO iq = 1, SIZE(sval)                                              !--- CONVERT THE KEYS TO INTEGERS
     1576    READ(sval(iq), *, IOSTAT=ierr) val(iq)
     1577    IF(test(fmsg('key "'//TRIM(keyn)//'" of "'//TRIM(nam(iq))//'" is not a real', modname, ierr/=0), lerr)) RETURN
     1578  END DO
     1579END FUNCTION getKeyByName_rm
     1580!==============================================================================================================================
     1581LOGICAL FUNCTION getKeyByName_r1m(keyn, val, tname, ky) RESULT(lerr)
     1582  CHARACTER(LEN=*),           INTENT(IN)  :: keyn
     1583  REAL,          ALLOCATABLE, INTENT(OUT) :: val(:)
     1584  CHARACTER(LEN=*),           INTENT(IN)  :: tname
     1585  TYPE(keys_type),  OPTIONAL, INTENT(IN)  ::  ky(:)
     1586!------------------------------------------------------------------------------------------------------------------------------
     1587  CHARACTER(LEN=maxlen), ALLOCATABLE :: v(:)
     1588  INTEGER :: ierr, iq
     1589  IF(     PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname, ky)
     1590  IF(.NOT.PRESENT(ky)) lerr = getKeyByName_s1m(keyn, v, tname)
     1591  ALLOCATE(val(SIZE(v)))
     1592  lerr = .FALSE.; DO iq=1, SIZE(v); READ(v(iq), *, IOSTAT=ierr) val(iq); lerr = lerr .OR. ierr /= 0; END DO
     1593  IF(test(fmsg('key "'//TRIM(keyn)//'" of tracer "'//TRIM(tname)//'" is not a real', modname, lerr), lerr)) RETURN
     1594END FUNCTION getKeyByName_r1m
     1595!==============================================================================================================================
     1596
     1597
     1598!==============================================================================================================================
     1599!=== ROUTINES TO GET OR PUT TRACERS AND ISOTOPES DATABASES, SINCE tracers AND isotopes ARE PRIVATE VARIABLES ==================
     1600!==============================================================================================================================
     1601SUBROUTINE setKeysDBase(tracers_, isotopes_, isotope_)
     1602  TYPE(trac_type), OPTIONAL, INTENT(IN) ::  tracers_(:)
     1603  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotopes_(:)
     1604  TYPE(isot_type), OPTIONAL, INTENT(IN) :: isotope_
     1605!------------------------------------------------------------------------------------------------------------------------------
     1606  TYPE(isot_type), ALLOCATABLE :: iso(:)
     1607  INTEGER :: ix, nbIso
     1608  IF(PRESENT( tracers_)) THEN;  tracers =  tracers_; ELSE; ALLOCATE( tracers(0)); END IF
     1609  IF(PRESENT(isotopes_)) THEN; isotopes = isotopes_; ELSE; ALLOCATE(isotopes(0)); END IF
     1610  IF(PRESENT(isotope_ )) THEN
     1611    ix = strIdx(isotopes(:)%parent, isotope%parent)
     1612    IF(ix /= 0) THEN
     1613      isotopes(ix) = isotope_
     1614    ELSE
     1615      nbIso = SIZE(isotopes); ALLOCATE(iso(nbIso+1)); iso(1:nbIso) = isotopes; iso(nbIso+1) = isotope_
     1616      CALL MOVE_ALLOC(FROM=iso, TO=isotopes)
     1617    END IF
    13451618  END IF
    1346 END FUNCTION getKeyByName_rm
     1619END SUBROUTINE setKeysDBase
     1620!==============================================================================================================================
     1621SUBROUTINE getKeysDBase(tracers_, isotopes_, isotope_)
     1622  TYPE(trac_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) ::  tracers_(:)
     1623  TYPE(isot_type), OPTIONAL, ALLOCATABLE, INTENT(OUT) :: isotopes_(:)
     1624  TYPE(isot_type), OPTIONAL,              INTENT(OUT) :: isotope_
     1625!------------------------------------------------------------------------------------------------------------------------------
     1626  INTEGER :: ix
     1627  IF(PRESENT( tracers_)) THEN;  tracers_ =  tracers; ELSE; ALLOCATE( tracers_(0)); END IF
     1628  IF(PRESENT(isotopes_)) THEN; isotopes_ = isotopes; ELSE; ALLOCATE(isotopes_(0)); END IF
     1629  IF(PRESENT(isotope_ )) THEN; ix = strIdx(isotopes(:)%parent, isotope%parent); IF(ix /= 0) isotope_=isotopes(ix); END IF
     1630END SUBROUTINE getKeysDBase
    13471631!==============================================================================================================================
    13481632
    … …  
    13521636!==============================================================================================================================
    13531637ELEMENTAL CHARACTER(LEN=maxlen) FUNCTION delPhase(s) RESULT(out)
    1354   CHARACTER(LEN=*), INTENT(IN)  :: s
     1638  CHARACTER(LEN=*), INTENT(IN) :: s
    13551639!------------------------------------------------------------------------------------------------------------------------------
    13561640  INTEGER :: ix, ip, ns
    … …  
    15181802!=== GET THE NAME(S) OF THE ANCESTOR(S) OF TRACER(S) "tname" AT GENERATION "igen"  IN THE TRACERS DESCRIPTORS LIST "tr" =======
    15191803!==============================================================================================================================
    1520 CHARACTER(LEN=maxlen) FUNCTION ancestor_1(t, tname, igen) RESULT(out)
    1521   TYPE(trac_type),   INTENT(IN) :: t(:)
    1522   CHARACTER(LEN=*),  INTENT(IN) :: tname
    1523   INTEGER, OPTIONAL, INTENT(IN) :: igen
    1524 !------------------------------------------------------------------------------------------------------------------------------
    1525   INTEGER :: ig, ix
    1526   ig = 0; IF(PRESENT(igen)) ig = igen
    1527   ix = idxAncestor_1(t, tname, ig)
     1804SUBROUTINE ancestor_1(t, out, tname, igen)
     1805  TYPE(trac_type),       INTENT(IN) :: t(:)
     1806  CHARACTER(LEN=maxlen), INTENT(OUT) :: out
     1807  CHARACTER(LEN=*),      INTENT(IN)  :: tname
     1808  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1809!------------------------------------------------------------------------------------------------------------------------------
     1810  INTEGER :: ix
     1811  CALL idxAncestor_1(t, ix, tname, igen)
    15281812  out = ''; IF(ix /= 0) out = t(ix)%name
    1529 END FUNCTION ancestor_1
    1530 !==============================================================================================================================
    1531 FUNCTION ancestor_m(t, tname, igen) RESULT(out)
    1532   CHARACTER(LEN=maxlen), ALLOCATABLE     ::   out(:)
    1533   TYPE(trac_type),            INTENT(IN) ::     t(:)
    1534   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    1535   INTEGER,          OPTIONAL, INTENT(IN) :: igen
    1536 !------------------------------------------------------------------------------------------------------------------------------
    1537   INTEGER, ALLOCATABLE :: ix(:)
     1813END SUBROUTINE ancestor_1
     1814!==============================================================================================================================
     1815SUBROUTINE ancestor_mt(t, out, tname, igen)
     1816  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1817  CHARACTER(LEN=*),      INTENT(IN)  :: tname(:)
     1818  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(tname))
     1819  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1820!------------------------------------------------------------------------------------------------------------------------------
     1821  INTEGER :: ix(SIZE(tname))
     1822  CALL idxAncestor_mt(t, ix, tname, igen)
     1823  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
     1824END SUBROUTINE ancestor_mt
     1825!==============================================================================================================================
     1826SUBROUTINE ancestor_m(t, out, igen)
     1827  TYPE(trac_type),       INTENT(IN)  :: t(:)
     1828  CHARACTER(LEN=maxlen), INTENT(OUT) :: out(SIZE(t))
     1829  INTEGER,     OPTIONAL, INTENT(IN)  :: igen
     1830!------------------------------------------------------------------------------------------------------------------------------
     1831  INTEGER :: ix(SIZE(t))
     1832  CALL idxAncestor_m(t, ix, igen)
     1833  out(:) = ''; WHERE(ix /= 0) out = t(ix)%name
     1834END SUBROUTINE ancestor_m
     1835!==============================================================================================================================
     1836
     1837
     1838!==============================================================================================================================
     1839!=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
     1840!==============================================================================================================================
     1841SUBROUTINE idxAncestor_1(t, idx, tname, igen)
     1842  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1843  INTEGER,           INTENT(OUT) :: idx
     1844  CHARACTER(LEN=*),  INTENT(IN)  :: tname
     1845  INTEGER, OPTIONAL, INTENT(IN)  :: igen
    15381846  INTEGER :: ig
    15391847  ig = 0; IF(PRESENT(igen)) ig = igen
    1540   IF(     PRESENT(tname)) ix = idxAncestor_m(t, tname,     ig)
    1541   IF(.NOT.PRESENT(tname)) ix = idxAncestor_m(t, t(:)%name, ig)
    1542   ALLOCATE(out(SIZE(ix))); out(:) = ''
    1543   WHERE(ix /= 0) out = t(ix)%name
    1544 END FUNCTION ancestor_m
    1545 !==============================================================================================================================
    1546 
    1547 
    1548 !==============================================================================================================================
    1549 !=== GET THE INDEX(ES) OF THE GENERATION "igen" ANCESTOR(S) OF "tname" (t%name IF UNSPECIFIED) IN THE "t" LIST ================
    1550 !==============================================================================================================================
    1551 INTEGER FUNCTION idxAncestor_1(t, tname, igen) RESULT(out)
    1552   TYPE(trac_type),   INTENT(IN) :: t(:)
    1553   CHARACTER(LEN=*),  INTENT(IN) :: tname
    1554   INTEGER, OPTIONAL, INTENT(IN) :: igen
    1555 !------------------------------------------------------------------------------------------------------------------------------
    1556   INTEGER :: ig
    1557   ig = 0; IF(PRESENT(igen)) ig = igen
    1558   out = strIdx(t(:)%name, tname)
    1559   IF(out == 0)                 RETURN            !--- Tracer not found
    1560   IF(t(out)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
    1561   DO WHILE(t(out)%iGeneration > ig); out = strIdx(t(:)%name, t(out)%parent); END DO
    1562 END FUNCTION idxAncestor_1
    1563 !==============================================================================================================================
    1564 FUNCTION idxAncestor_m(t, tname, igen) RESULT(out)
    1565   INTEGER,          ALLOCATABLE          ::   out(:)
    1566   TYPE(trac_type),            INTENT(IN) ::     t(:)
    1567   CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: tname(:)
    1568   INTEGER,          OPTIONAL, INTENT(IN) :: igen
    1569 !------------------------------------------------------------------------------------------------------------------------------
    1570   INTEGER :: ig, ix
    1571   ig = 0; IF(PRESENT(igen)) ig = igen
    1572   IF(     PRESENT(tname)) out = [(idxAncestor_1(t, tname(ix),  ig), ix=1, SIZE(tname))]
    1573   IF(.NOT.PRESENT(tname)) out = [(idxAncestor_1(t, t(ix)%name, ig), ix=1, SIZE(t))]
    1574 END FUNCTION idxAncestor_m
     1848  idx = strIdx(t(:)%name, tname)
     1849  IF(idx == 0)                 RETURN            !--- Tracer not found
     1850  IF(t(idx)%iGeneration <= ig) RETURN            !--- Tracer has a lower generation number than asked generation 'igen"
     1851  DO WHILE(t(idx)%iGeneration > ig); idx = strIdx(t(:)%name, t(idx)%parent); END DO
     1852END SUBROUTINE idxAncestor_1
     1853!------------------------------------------------------------------------------------------------------------------------------
     1854SUBROUTINE idxAncestor_mt(t, idx, tname, igen)
     1855  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1856  CHARACTER(LEN=*),  INTENT(IN)  :: tname(:)
     1857  INTEGER,           INTENT(OUT) :: idx(SIZE(tname))
     1858  INTEGER, OPTIONAL, INTENT(IN)  :: igen
     1859  INTEGER :: ix
     1860  DO ix = 1, SIZE(tname); CALL idxAncestor_1(t, idx(ix), tname(ix), igen); END DO
     1861END SUBROUTINE idxAncestor_mt
     1862!------------------------------------------------------------------------------------------------------------------------------
     1863SUBROUTINE idxAncestor_m(t, idx, igen)
     1864  TYPE(trac_type),   INTENT(IN)  :: t(:)
     1865  INTEGER,           INTENT(OUT) :: idx(SIZE(t))
     1866  INTEGER, OPTIONAL, INTENT(IN)  :: igen
     1867  INTEGER :: ix
     1868  DO ix = 1, SIZE(t); CALL idxAncestor_1(t, idx(ix), t(ix)%name, igen); END DO
     1869END SUBROUTINE idxAncestor_m
    15751870!==============================================================================================================================
    15761871

  • LMDZ6/trunk/libf/misc/strings_mod.F90

    r4193 r4325  
    12481248  INTEGER      :: i, ni, io
    12491249
    1250 !  modname = 'reduceExpr_basic'
    12511250  lerr = .FALSE.
    12521251  IF(is_numeric(str)) THEN; val=TRIM(str); RETURN; END IF

  • 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))

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

    r4319 r4325  
    133133
    134134SUBROUTINE iso_init()
    135    USE ioipsl_getin_p_mod, ONLY: getin_p
    136135   USE infotrac_phy,       ONLY: ntiso, niso, getKey
    137136    USE strings_mod,       ONLY: maxlen
    … …  
    181180   iso_HTO = strIdx(isoName, 'H[3]HO');  CALL msg('iso_HTO='//int2str(iso_HTO), modname)
    182181
    183    ! initialisation
    184    ! lecture des parametres isotopiques:
    185    ! pour que ca marche en openMP, il faut utiliser getin_p. Car le getin ne peut
    186    ! etre appele que par un thread a la fois, et ca pose tout un tas de problemes,
    187    ! d'ou tout un tas de magouilles comme dans conf_phys_m. A terme, tout le monde
    188    ! lira par getin_p.
     182   !--- Initialiaation: reading the isotopic parameters.
    189183   CALL get_in('lambda',     lambda_sursat, 0.004)
    190184   CALL get_in('thumxt1',    thumxt1,       0.75*1.2)
    … …  
    339333   USE mod_phys_lmdz_omp_data, ONLY :  is_omp_root
    340334   USE mod_phys_lmdz_transfert_para, ONLY : bcast
    341    CHARACTER(LEN=*),  INTENT(IN)    :: nam
    342    CHARACTER(LEN=*),  INTENT(INOUT) :: val
    343    CHARACTER(LEN=*), INTENT(IN)    :: def
    344    LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
     335   CHARACTER(LEN=*),           INTENT(IN)    :: nam
     336   CHARACTER(LEN=*),           INTENT(INOUT) :: val
     337   CHARACTER(LEN=*), OPTIONAL, INTENT(IN)    :: def
     338   LOGICAL,          OPTIONAL, INTENT(IN)    :: lDisp
    345339   LOGICAL :: lD
    346340!$OMP BARRIER
    347341   IF(is_mpi_root.AND.is_omp_root) THEN
    348       val=def; CALL getin(nam,val)
     342      IF(PRESENT(def)) val=def; CALL getin(nam,val)
    349343      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    350344      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
    351    END IF
    352    CALL bcast(val)
     345  END IF
     346  CALL bcast(val)
    353347END SUBROUTINE getinp_s
    354348
    … …  
    360354   CHARACTER(LEN=*),  INTENT(IN)    :: nam
    361355   INTEGER,           INTENT(INOUT) :: val
    362    INTEGER,           INTENT(IN)    :: def
     356   INTEGER, OPTIONAL, INTENT(IN)    :: def
    363357   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
    364358   LOGICAL :: lD
    365359!$OMP BARRIER
    366360   IF(is_mpi_root.AND.is_omp_root) THEN
    367       val=def; CALL getin(nam,val)
     361      IF(PRESENT(def)) val=def; CALL getin(nam,val)
    368362      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    369363      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(int2str(val)))
    370    END IF
    371    CALL bcast(val)
     364  END IF
     365  CALL bcast(val)
    372366END SUBROUTINE getinp_i
    373367
    … …  
    379373   CHARACTER(LEN=*),  INTENT(IN)    :: nam
    380374   REAL,              INTENT(INOUT) :: val
    381    REAL,              INTENT(IN)    :: def
     375   REAL,    OPTIONAL, INTENT(IN)    :: def
    382376   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
    383377   LOGICAL :: lD
    384378!$OMP BARRIER
    385379   IF(is_mpi_root.AND.is_omp_root) THEN
    386       Val=def; CALL getin(nam,val)
     380      IF(PRESENT(def)) val=def; CALL getin(nam,val)
    387381      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    388382      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(real2str(val)))
    389    ENDIF
    390    CALL bcast(val)
     383  END IF
     384  CALL bcast(val)
    391385END SUBROUTINE getinp_r
    392386
    … …  
    398392   CHARACTER(LEN=*),  INTENT(IN)    :: nam
    399393   LOGICAL,           INTENT(INOUT) :: val
    400    LOGICAL,           INTENT(IN)    :: def
     394   LOGICAL, OPTIONAL, INTENT(IN)    :: def
    401395   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
    402396   LOGICAL :: lD
    403397!$OMP BARRIER
    404398   IF(is_mpi_root.AND.is_omp_root) THEN
    405       val=def; CALL getin(nam,val)
     399      IF(PRESENT(def)) val=def; CALL getin(nam,val)
    406400      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
    407401      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(bool2str(val)))
    408    END IF
    409    CALL bcast(val)
     402  END IF
     403  CALL bcast(val)
    410404END SUBROUTINE getinp_l
    411405

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

    r4149 r4325  
    1653216532 USE isotrac_mod, ONLY: strtrac,initialisation_isotrac,index_iso, &
    1653316533&       index_zone,izone_init
     16534 USE readTracFiles_mod, ONLY: newH2Oiso, oldH2Oiso
     16535 USE strings_mod, ONLY: strIdx, strHead, strTail
     16536
    1653416537#endif
    1653516538        implicit none
    … …  
    1656316566        CHARACTER*5 str5
    1656416567        real xmin,xmax   
    16565         CHARACTER*50 outiso 
     16568        CHARACTER*50 outiso, oldIso
    1656616569        integer lnblnk
    1656716570        LOGICAL :: found,phyetat0_get,phyetat0_srf
    … …  
    1658516588   do ixt=1,ntraciso
    1658616589
    16587       outiso=TRIM(isoName(ixt))
    16588       i = INDEX(outiso, '_', .TRUE.)
    16589       outiso = outiso(1:i-1)//outiso(i+1:LEN_TRIM(outiso))
    16590       write(*,*) 'phyiso_etat0_fichier 16621: ixt,outiso=',ixt,TRIM(outiso)
    16591 
     16590      outiso = isoName(ixt)
     16591      k = strIdx(newH2Oiso, strHead(outiso, '_'))
     16592      oldIso = outiso; IF(k /= 0) oldIso = oldH2Oiso(k)
     16593      IF(INDEX(outiso, '_') /= 0) THEN
     16594        outiso = TRIM(outiso)//TRIM(strTail(outiso, '_'))
     16595        oldIso = TRIM(oldIso)//TRIM(strTail(outiso, '_'))
     16596      END IF
    1659216597           
    1659316598      ! on lit seulement si ixt<=niso ou si on initialise les traceurs d'après
    … …  
    1659816603
    1659916604      found=phyetat0_srf(1,iso_tmp_lonsrf,"XTSNOW"//TRIM(outiso),"Surface snow",0.)
    16600       if (.NOT.found) CALL abort_physic('isotopes_routines_mod', &
    16601                             'phyiso_etat0_fichier 16581: variable isotopique not found',1)
     16605      if (.NOT.found.AND.k/=0) found=phyetat0_srf(1,iso_tmp_lonsrf,"XTSNOW"//TRIM(oldIso),"Surface snow",0.)
     16606      if (.NOT.found) CALL abort_physic('isotopes_routines_mod', 'phyiso_etat0_fichier 16581: variable isotopique not found',1)
    1660216607      xtsnow(ixt,:,:)=iso_tmp_lonsrf(:,:)
    1660316608     
    1660416609      found=phyetat0_srf(1,iso_tmp_lonsrf,"XTEVAP"//TRIM(outiso),"evaporation",0.)
     16610      if (.NOT.found.AND.k/=0) found=phyetat0_srf(1,iso_tmp_lonsrf,"XTEVAP"//TRIM(oldIso),"evaporation",0.)
    1660516611      fxtevap(ixt,:,:)=iso_tmp_lonsrf(:,:)
    1660616612
    1660716613      found=phyetat0_get(1,iso_tmp,"xtrain_f"//TRIM(outiso),"xrain fall",0.)
     16614      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"xtrain_f"//TRIM(oldIso),"xrain fall",0.)
    1660816615      xtrain_fall(ixt,:)=iso_tmp(:)
    1660916616
    1661016617      found=phyetat0_get(1,iso_tmp,"xtsnow_f"//TRIM(outiso),"snow fall",0.)
     16618      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"xtsnow_f"//TRIM(oldIso),"snow fall",0.)
    1661116619      xtsnow_fall(ixt,:)=iso_tmp(:)
    1661216620
    1661316621      found=phyetat0_get(klev,iso_tmp_lonlev,"XTANCIEN"//TRIM(outiso),"QANCIEN",0.)
     16622      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"XTANCIEN"//TRIM(oldIso),"QANCIEN",0.)
    1661416623      xt_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    1661516624
    1661616625      found=phyetat0_get(klev,iso_tmp_lonlev,"XTLANCIEN"//TRIM(outiso),"QLANCIEN",0.)
     16626      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"XTLANCIEN"//TRIM(oldIso),"QLANCIEN",0.)
    1661716627      xtl_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    1661816628
    1661916629      found=phyetat0_get(klev,iso_tmp_lonlev,"XTSANCIEN"//TRIM(outiso),"QSANCIEN",0.)
     16630      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"XTSANCIEN"//TRIM(oldIso),"QSANCIEN",0.)
    1662016631      xts_ancien(ixt,:,:)=iso_tmp_lonlev(:,:)
    1662116632
    1662216633      found=phyetat0_get(1,iso_tmp,"XTRUNOFFLIC0"//TRIM(outiso),"RUNOFFLIC0",0.) 
     16634      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"XTRUNOFFLIC0"//TRIM(oldIso),"RUNOFFLIC0",0.)
    1662316635      xtrun_off_lic_0(ixt,:)=iso_tmp(:)
    1662416636
    1662516637      found=phyetat0_get(klev,iso_tmp_lonlev,"WAKE_DELTAXT"//TRIM(outiso),"Delta hum. wake/env",0.) 
     16638      if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp_lonlev,"WAKE_DELTAXT"//TRIM(oldIso),"Delta hum. wake/env",0.)
    1662616639      wake_deltaxt(ixt,:,:)=iso_tmp_lonlev(:,:)
    1662716640
    … …  
    1666616679       if (ixt.le.niso) then
    1666716680        found=phyetat0_get(1,iso_tmp,"XTSOL"//TRIM(outiso),"Surface hmidity / bucket",0.) 
     16681        if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"XTSOL"//TRIM(oldIso),"Surface hmidity / bucket",0.)
    1666816682        xtsol(ixt,:)=iso_tmp(:)
    1666916683
    1667016684        found=phyetat0_get(1,iso_tmp,"Rland_ice"//TRIM(outiso),"R land ice",0.)
     16685        if (.NOT.found.AND.k/=0) found=phyetat0_get(1,iso_tmp,"Rland_ice"//TRIM(oldIso),"R land ice",0.)
    1667116686        Rland_ice(ixt,:)=iso_tmp(:)
    1667216687

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

    r4143 r4325  
    11#ifdef ISO
    22#ifdef ISOTRAC
    3 ! $Id: $
    43
    54MODULE isotrac_mod
    6 use infotrac_phy, ONLY: niso,ntiso,ntraceurs_zone=>nzone
    7 use isotopes_mod, only: ridicule
    8 
    9 IMPLICIT NONE
    10 SAVE
    11 
    12 ! contient toutes les variables traceurs isotopiques + les routines specifiquement
    13 ! traceurs isotopiques
    14 
    15       real ridicule_trac
    16       parameter (ridicule_trac=ridicule*1e4)
    17 
    18 integer, save ::  option_traceurs
    19 integer, save ::  ntraceurs_zone_opt ! ntraceurs_zone propre à l'option
    20 ! on vérifie que ça correspond bien à ntraceurs_zone d'infotrac
    21 integer, save ::  ntraceurs_zoneOR
    22 !$OMP THREADPRIVATE(option_traceurs,ntraceurs_zone_opt,ntraceurs_zoneOR)
    23 integer, save ::  initialisation_isotrac
    24                 ! 1 pour idéalisé
    25                 ! 0 pour lecture dans fichier
    26 !$OMP THREADPRIVATE(initialisation_isotrac)
    27 
    28 ! variables spécifiques aux différentes options, mais necessaires au
    29 ! calcul du nombre de zones de traceurs
    30 ! si option=3
    31 integer, save :: use_bassin_atlantic
    32 !$OMP THREADPRIVATE(use_bassin_atlantic)
    33 integer, save :: use_bassin_medit
    34 !$OMP THREADPRIVATE(use_bassin_medit)
    35 integer, save :: use_bassin_indian
    36 !$OMP THREADPRIVATE(use_bassin_indian)
    37 integer, save :: use_bassin_austral
    38 !$OMP THREADPRIVATE(use_bassin_austral)
    39 integer, save :: use_bassin_pacific
    40 !$OMP THREADPRIVATE(use_bassin_pacific)
    41 integer, save :: use_bassin_merarabie
    42 !$OMP THREADPRIVATE(use_bassin_merarabie)
    43 integer, save :: use_bassin_golfebengale
    44 !$OMP THREADPRIVATE(use_bassin_golfebengale)
    45 integer, save :: use_bassin_indiansud
    46 !$OMP THREADPRIVATE(use_bassin_indiansud)
    47 integer, save :: use_bassin_tropics
    48 !$OMP THREADPRIVATE(use_bassin_tropics)
    49 integer, save :: use_bassin_midlats
    50 !$OMP THREADPRIVATE(use_bassin_midlats)
    51 integer, save :: use_bassin_hauteslats
    52 !$OMP THREADPRIVATE(use_bassin_hauteslats)
    53 integer, save :: bassin_atlantic
    54 !$OMP THREADPRIVATE(bassin_atlantic)
    55 integer, save :: bassin_medit
    56 !$OMP THREADPRIVATE(bassin_medit)
    57 integer, save :: bassin_indian
    58 !$OMP THREADPRIVATE(bassin_indian)
    59 integer, save :: bassin_austral
    60 !$OMP THREADPRIVATE(bassin_austral)
    61 integer, save :: bassin_pacific
    62 !$OMP THREADPRIVATE(bassin_pacific)
    63 integer, save :: bassin_merarabie
    64 !$OMP THREADPRIVATE(bassin_merarabie)
    65 integer, save :: bassin_golfebengale
    66 !$OMP THREADPRIVATE(bassin_golfebengale)
    67 integer, save :: bassin_indiansud
    68 !$OMP THREADPRIVATE(bassin_indiansud)
    69 integer, save :: bassin_tropics
    70 !$OMP THREADPRIVATE(bassin_tropics)
    71 integer, save :: bassin_midlats
    72 !$OMP THREADPRIVATE(bassin_midlats)
    73 integer, save :: bassin_hauteslats
    74 !$OMP THREADPRIVATE(bassin_hauteslats)
    75 ! si option=4
    76 integer nzone_temp
    77 parameter (nzone_temp=1)
    78 real, save :: zone_temp1,zone_tempf,zone_tempa 
    79 !$OMP THREADPRIVATE(zone_temp1,zone_tempf,zone_tempa)
    80 ! si option 14
    81 integer nzone_lat
    82 parameter (nzone_lat=4)
    83 integer nzone_pres
    84 parameter (nzone_pres=3)
    85 real, save :: zone_pres1,zone_presf,zone_presa
    86 !$OMP THREADPRIVATE(zone_pres1,zone_presf,zone_presa)
    87 real, save :: dlattag,lattag_min
    88 !$OMP THREADPRIVATE(dlattag,lattag_min)
    89 
    90 
    91 ! option 1: on trace evap ocean et continent séparement 
     5  USE infotrac_phy,      ONLY: niso, ntiso, nzone
     6  USE readTracFiles_mod, ONLY: delPhase
     7  USE isotopes_mod,      ONLY: ridicule, get_in
     8
     9  IMPLICIT NONE
     10  SAVE
     11
     12!=== CONTENT: ALL THE ISOTOPIC TRACERS RELATED VARIABLES ===
     13!
     14! option 1: on trace evap ocean et continent separement 
    9215! option 2: on trace evap ocean, continent et evap precip
    93 ! option 3: on trace evap différents bassins océaniques
    94 !       + continents + résidu
    95 !       attention, choisir dans ce cas les bassins océaniques
     16! option 3: on trace evap differents bassins oceaniques
     17!       + continents + residu
     18!       attention, choisir dans ce cas les bassins oceaniques
    9619!       dans iso_traceurs_opt3F90.h
    97 ! option 4: tracage par température minimale
    98 !       dans ce cas, on définit des bins dans iso_traceurs_opt4.h
    99 ! option 5: pour AMMA: on taggue résidu/AEJ/flux mousson/Harmattan
     20! option 4: tracage par temperature minimale
     21!       dans ce cas, on definit des bins dans iso_traceurs_opt4.h
     22! option 5: pour AMMA: on taggue residu/AEJ/flux mousson/Harmattan
    10023! option 6: taggage des ddfts
    101 ! option 7: pour Sandrine: taggage de la vapeur à 700hPa pour omega500<-20 TODO
    102 ! option 8: pour Sandrine: taggage de la vapeur entre 950 et 800hPa, omega de 0 à 25 hPa et de l'évaoration en omega<-20. TODO
     24! option 7: pour Sandrine: taggage de la vapeur a 700hPa pour omega500<-20 TODO
     25! option 8: pour Sandrine: taggage de la vapeur entre 950 et 800hPa, omega de 0 a 25 hPa et de l'evaoration en omega<-20. TODO
    10326! option 9: taggage du condensat et de la revap precip
    10427! option 10: taggage evap oce, transpiration et evaporation
    … …  
    10730! option 12: taggage evap oce, sol nu, canop et reste evap cont.
    10831! A utiliser quand on couple avec ORCHIDEE
    109 ! option 13: taggage température minimale + revap precip
    110 ! option 14: taggage lat et altitude de dernière saturation (niveaux de pression) + evap surf
     32! option 13: taggage temperature minimale + revap precip
     33! option 14: taggage lat et altitude de derniere saturation (niveaux de pression) + evap surf
    11134! otion 15: taggage irrigation
    11235! option 16: taggage precip selon saisons et fonte neige: seulement pour ORCHIDEE
    113 ! option 17: taggage température minimum de condensation directement dans la convection et la cond LS, + evap sfc, condensat et precipitation
     36! option 17: taggage temperature minimum de condensation directement dans la convection et la cond LS, + evap sfc, condensat et precipitation
    11437! option 18: idem 17 mais on tague qsmin au lieu de Tmin
    11538! option 19: on tag vap residuelle, vap residuelle dans ddfts, sfc, cond, rev
    11639! option 20: on taggue vapeur tropicale vs vapeur extratropicale
    11740! option 21: taggage de 2 boites 3D: extratropiques (>35°) et UT tropicale (15-15°, > 500hPa)
    118 ! option 22: tagage de la vapeur proccessée dans les zones très convectives
     41! option 22: tagage de la vapeur proccessee dans les zones tres convectives
    11942               
    120         ! ces variables sont initialisées dans traceurs_init
     43   !--- nzone_opt (value of nzone for the selected option) must be equal to nzone as defined in onfotrac
     44   REAL, PARAMETER :: ridicule_trac = ridicule * 1e4
     45   INTEGER, SAVE :: option_traceurs, nzone_opt, nzoneOR
     46!$OMP THREADPRIVATE(option_traceurs,nzone_opt,nzoneOR)
     47   INTEGER, SAVE :: initialisation_isotrac
     48!$OMP THREADPRIVATE(initialisation_isotrac)     
     49                ! 1 pour idealise
     50                ! 0 pour lecture dans fichier
     51
     52   !=== VARIABLES SPECIFIC TO THE SELECTED OPTION, BUT NEEDED FOR THE COMPUTATION OF THE NUMBER OF ZONES ; TO BE INITIALIZED IN traceurs_init
     53
     54   !--- option 3
     55   LOGICAL, SAVE :: use_bassin_Austral, use_bassin_Atlantic, use_bassin_MidLats, use_bassin_SouthIndian, use_bassin_MerArabie
     56!$OMP THREADPRIVATE(use_bassin_Austral, use_bassin_Atlantic, use_bassin_MidLats, use_bassin_SouthIndian, use_bassin_MerArabie)
     57   INTEGER, SAVE ::     bassin_Austral,     bassin_Atlantic,     bassin_MidLats,     bassin_SouthIndian,     bassin_MerArabie
     58!$OMP THREADPRIVATE(    bassin_Austral,     bassin_Atlantic,     bassin_MidLats,     bassin_SouthIndian,     bassin_MerArabie)
     59   LOGICAL, SAVE :: use_bassin_Pacific, use_bassin_Indian,   use_bassin_Tropics, use_bassin_BengalGolf,  use_bassin_HighLats, use_bassin_Medit
     60!$OMP THREADPRIVATE(use_bassin_Pacific, use_bassin_Indian,   use_bassin_Tropics, use_bassin_BengalGolf,  use_bassin_HighLats, use_bassin_Medit)
     61   INTEGER, SAVE ::     bassin_Pacific,     bassin_Indian,       bassin_Tropics,     bassin_BengalGolf,      bassin_HighLats,     bassin_Medit
     62!$OMP THREADPRIVATE(    bassin_Pacific,     bassin_Indian,       bassin_Tropics,     bassin_BengalGolf,      bassin_HighLats,     bassin_Medit)
     63
     64   !--- option 4
     65   INTEGER, PARAMETER :: nzone_temp = 1
     66   REAL,   SAVE ::  zone_temp1, zone_tempf, zone_tempa 
     67!$OMP THREADPRIVATE(zone_temp1, zone_tempf, zone_tempa)
     68   REAL,   SAVE ::  zone_temp(nzone_temp-1)
     69!$OMP THREADPRIVATE(zone_temp)
     70
     71   !--- option 5
     72   INTEGER, SAVE :: izone_aej, izone_harmattan, izone_mousson
     73!$OMP THREADPRIVATE(izone_aej, izone_harmattan, izone_mousson)
     74
     75   !--- option 6
     76   INTEGER, SAVE :: izone_ddft
     77!$OMP THREADPRIVATE(izone_ddft)
     78
     79   !--- option 10
     80   INTEGER, SAVE :: izone_contfrac
     81!$OMP THREADPRIVATE(izone_contfrac)
     82
     83   !--- option 12       
     84   INTEGER, SAVE :: izone_contcanop
     85!$OMP THREADPRIVATE(izone_contcanop)
     86
     87   !--- option 13
     88   INTEGER, PARAMETER :: nzone_pres = 3
     89   REAL, SAVE ::  zone_pres(nzone_pres-1)
     90!$OMP THREADPRIVATE(zone_pres)
     91
     92   !--- option 14
     93   INTEGER, PARAMETER :: nzone_lat = 4
     94   REAL,    SAVE :: zone_pres1, zone_presf, zone_presa
     95!$OMP THREADPRIVATE(zone_pres1, zone_presf, zone_presa)
     96   REAL,    SAVE :: dlattag, lattag_min, zone_lat(nzone_lat-1)
     97!$OMP THREADPRIVATE(dlattag, lattag_min, zone_lat)
     98
     99   !--- option 15
     100   INTEGER, SAVE :: izone_irrig
     101!$OMP THREADPRIVATE(izone_irrig)
     102
     103   !--- option 17
     104   REAL,    SAVE :: seuil_tag_tmin, seuil_tag_tmin_ls
     105!$OMP THREADPRIVATE(seuil_tag_tmin, seuil_tag_tmin_ls)
     106  INTEGER,  SAVE :: option_seuil_tag_tmin
     107!$OMP THREADPRIVATE(option_seuil_tag_tmin)
     108
     109   !--- option 20
     110   INTEGER, SAVE :: izone_trop, izone_extra
     111!$OMP THREADPRIVATE(izone_trop, izone_extra)
     112   REAL,    SAVE :: lim_tag20
     113!$OMP THREADPRIVATE(lim_tag20)
     114
     115   !--- option 21: on garde izone_trop, izone_extra 
     116
     117   !--- option 22
     118   INTEGER, SAVE :: izone_conv_BT, izone_conv_UT
     119!$OMP THREADPRIVATE(izone_conv_BT, izone_conv_UT)
     120   REAL,    SAVE :: lim_precip_tag22
     121!$OMP THREADPRIVATE(lim_precip_tag22)
     122
    121123       
    122 integer, ALLOCATABLE, DIMENSION(:), save :: index_iso
    123 !$OMP THREADPRIVATE(index_iso)
    124 integer, ALLOCATABLE, DIMENSION(:), save ::  index_zone
    125 !$OMP THREADPRIVATE(index_zone)
    126 integer, ALLOCATABLE, DIMENSION(:,:), save ::  itZonIso_loc ! il y a déjà un itZonIso dans infotrac: vérifier que c'est le même
    127 !$OMP THREADPRIVATE(itZonIso_loc)
    128 character*3, ALLOCATABLE, DIMENSION(:), save :: strtrac
    129 !$OMP THREADPRIVATE(strtrac)
    130 ! -> tout ça passe maintenant par infotrac
    131 
    132 integer, ALLOCATABLE, DIMENSION(:), save :: bassin_map
    133 integer, ALLOCATABLE, DIMENSION(:,:), save :: boite_map
    134 !$OMP THREADPRIVATE(bassin_map,boite_map)
    135 
    136 
    137         ! traitement recyclage et evap
    138 integer, save :: izone_cont ! pour le recyclage continental
    139 !$OMP THREADPRIVATE(izone_cont)
    140 integer, save :: izone_oce ! pour l'océan
    141 !$OMP THREADPRIVATE(izone_oce)
    142 integer, save :: izone_poubelle ! pour les petits résidus numériques
     124  INTEGER, ALLOCATABLE, SAVE :: index_iso(:), index_zone(:), itZonIso_loc(:,:)
     125!$OMP THREADPRIVATE(            index_iso,    index_zone,    itZonIso_loc)
     126  CHARACTER(LEN=3), ALLOCATABLE :: strtrac(:)
     127!$OMP THREADPRIVATE(               strtrac)
     128  INTEGER, ALLOCATABLE, SAVE :: bassin_map(:), boite_map(:,:)
     129!$OMP THREADPRIVATE(            bassin_map,    boite_map)
     130
     131   !=== RECYCLING AND EVAPORATION TREATMENT
     132   INTEGER, SAVE :: izone_cont, izone_oce        !--- For land and ocean recycling
     133!$OMP THREADPRIVATE(izone_cont, izone_oce)
     134   INTEGER, SAVE :: izone_poubelle               !--- For small numerical residues
    143135!$OMP THREADPRIVATE(izone_poubelle)
    144 integer, save :: izone_init ! pour l'initialisation par défaut
     136   INTEGER, SAVE :: izone_init                   !--- For default initialization
    145137!$OMP THREADPRIVATE(izone_init)
    146 integer, save :: izone_revap ! pour l'évap des gouttes
     138   INTEGER, SAVE :: izone_revap                  !--- For droplets evaporation
    147139!$OMP THREADPRIVATE(izone_revap)
    148 integer, save :: option_revap
    149 !$OMP THREADPRIVATE(option_revap)
    150 integer, save :: option_tmin
    151 !$OMP THREADPRIVATE(option_tmin)
    152 integer, save :: option_cond
    153 !$OMP THREADPRIVATE(option_cond)
    154 integer, save :: izone_cond
    155 !$OMP THREADPRIVATE(izone_cond)
    156 real evap_franche
    157 parameter (evap_franche=1e-6) ! en kg/m2/s
    158 
    159 ! specifique à option 4:
    160 real, save ::  zone_temp(nzone_temp-1)
    161 !$OMP THREADPRIVATE(zone_temp)
    162 ! si option 5
    163 integer, save :: izone_aej
    164 !$OMP THREADPRIVATE(izone_aej)
    165 integer, save :: izone_harmattan
    166 !$OMP THREADPRIVATE(izone_harmattan)
    167 integer, save :: izone_mousson
    168 !$OMP THREADPRIVATE(izone_mousson)
    169 ! si option 6
    170 integer, save :: izone_ddft
    171 !$OMP THREADPRIVATE(izone_ddft)
    172 ! si option 10
    173 integer, save :: izone_contfrac
    174 !$OMP THREADPRIVATE(izone_contfrac)
    175 ! si option 12 
    176 integer, save :: izone_contcanop
    177 !$OMP THREADPRIVATE(izone_contcanop)
    178 ! specifique à option 13:
    179 real, save ::  zone_pres(nzone_pres-1)
    180 !$OMP THREADPRIVATE(zone_pres)
    181 ! si option 14
    182 real, save ::  zone_lat(nzone_lat-1)
    183 !$OMP THREADPRIVATE(zone_lat)
    184 ! si option 15
    185 integer, save :: izone_irrig
    186 !$OMP THREADPRIVATE(izone_irrig)
    187 ! si option 17
    188 real, save ::  seuil_tag_tmin
    189 !$OMP THREADPRIVATE(seuil_tag_tmin)
    190 real, save ::  seuil_tag_tmin_ls
    191 !$OMP THREADPRIVATE(seuil_tag_tmin_ls)
    192 integer, save :: option_seuil_tag_tmin
    193 !$OMP THREADPRIVATE(option_seuil_tag_tmin)
    194 ! si option 20
    195 integer, save :: izone_trop,izone_extra
    196 real, save ::  lim_tag20
    197 !$OMP THREADPRIVATE(izone_trop,izone_extra,lim_tag20)
    198 ! si option 21: on garde izone_trop,izone_extra 
    199 ! si opt 22
    200 integer, save :: izone_conv_BT,izone_conv_UT
    201 real, save ::  lim_precip_tag22
    202 !$OMP THREADPRIVATE(izone_conv_BT,izone_conv_UT,lim_precip_tag22)
    203 
     140   INTEGER, SAVE :: option_revap, option_tmin, option_cond, izone_cond
     141!$OMP THREADPRIVATE(option_revap, option_tmin, option_cond, izone_cond)
     142   REAL, PARAMETER :: evap_franche = 1e-6        !--- In kg/m2/s
    204143
    205144CONTAINS
    206145
    207       subroutine iso_traceurs_init()
    208 
    209       use IOIPSL ! getin
    210       USE infotrac_phy, ONLY: itZonIso
    211       USE isotopes_mod, ONLY: iso_eau,ntracisoOR,initialisation_iso
    212       USE dimphy, only: klon,klev
    213 
    214         implicit none
    215 
    216 
    217         ! définition de quelles zones et quelles isotopes représentent
    218         ! les traceurs
    219 
    220         ! inputs, outputs
    221         ! ! c'est les variables dans traceurs.h qui sont modifiées
    222 
    223         ! locals
    224         integer itrac,izone,ixt,k
    225         integer izone_pres,izone_lat
    226         character*2 strz,strz_preslat
    227         character*1 strz_pres,strz_lat
    228         integer ntraceurs_zone_opt
    229 
    230         ! vérifier que on a bien l'eau comme traceurs
    231         if (iso_eau.eq.0) then
    232             write(*,*) 'traceurs_init 18: isotrac ne marche que si ', &
    233      &            'on met l''eau comme isotope'
    234             stop
    235         endif
    236 
    237         ! initialiser
    238         option_traceurs=0
    239         initialisation_isotrac=0
    240 
    241         ! allouer
    242         allocate (index_iso(ntiso))
    243         allocate (index_zone(ntiso))
    244         allocate (itZonIso_loc(ntraceurs_zone,niso))
    245         allocate (strtrac(ntraceurs_zone))
    246         allocate (bassin_map(klon))
    247         allocate (boite_map(klon,klev))
    248 
    249         if (initialisation_iso.eq.0) then
    250           call getin('initialisation_isotrac',initialisation_isotrac)
    251           write(*,*) 'initialisation_isotrac=',initialisation_isotrac
    252         endif !if (initialisation_iso.eq.0) then
    253 
    254         ! lire l'option de traçage
    255         call getin('option_traceurs',option_traceurs)
    256         write(*,*) 'option_traceurs=',option_traceurs
    257 
    258         ! cas général: pas de traceurs dans ORCHIDEE
    259         ntracisoOR=niso
    260 
    261         ! partie à éditer ! pour définir les différentes zones
    262         if (option_traceurs.eq.1) then
    263           ! on trace continents/ocean 
    264 
    265           ntraceurs_zone_opt=2
    266           izone_cont=1
    267           izone_oce=2         
    268           izone_poubelle=2 ! zone où on met les flux non physiques, de
    269                 ! réajustement
    270           izone_init=2 ! zone d'initialisation par défaut         
    271           option_revap=0
    272           option_tmin=0
    273           izone_revap=0
    274           option_cond=0
    275 
    276           strtrac(izone_cont)='con'
    277           strtrac(izone_oce)='oce'
    278 
    279         elseif (option_traceurs.eq.2) then
    280           ! on trace continent/ ocean/reevap des gouttes
    281 
    282           ntraceurs_zone_opt=3
    283           izone_cont=1
    284           izone_oce=2
    285           izone_poubelle=2 ! zone où on met les flux non physiques, de
    286                 ! réajustement
    287           izone_init=2 ! zone d'initialisation par défaut
    288           option_revap=1
    289           option_tmin=0
    290           izone_revap=3
    291           option_cond=0
    292 
    293           strtrac(izone_cont)='con'
    294           strtrac(izone_oce)='oce'
    295           strtrac(izone_revap)='rev'
    296          
    297 
    298         else if (option_traceurs.eq.3) then
    299             ! on trace des bassins océaniques + un résidu. On ne trace
    300             ! pas l'évap des gouttes à part
    301             ! le résidu est la dernère dimension
    302            
    303           ! lire les use_bassin
    304           call getin('use_bassin_atlantic',use_bassin_atlantic)     
    305           call getin('use_bassin_medit',use_bassin_medit)     
    306           call getin('use_bassin_indian',use_bassin_indian)     
    307           call getin('use_bassin_austral',use_bassin_austral)     
    308           call getin('use_bassin_pacific',use_bassin_pacific)     
    309           call getin('use_bassin_merarabie',use_bassin_merarabie)     
    310           call getin('use_bassin_golfebengale',use_bassin_golfebengale)     
    311           call getin('use_bassin_indiansud',use_bassin_indiansud)     
    312           call getin('use_bassin_tropics',use_bassin_tropics)     
    313           call getin('use_bassin_midlats',use_bassin_midlats)     
    314           call getin('use_bassin_hauteslats',use_bassin_hauteslats)
    315 
    316           write(*,*) 'use_bassin_atlantic=' ,use_bassin_atlantic 
    317           write(*,*) 'use_bassin_medit=' ,use_bassin_medit
    318           write(*,*) 'use_bassin_indian=' ,use_bassin_indian
    319           write(*,*) 'use_bassin_austral=' ,use_bassin_austral
    320           write(*,*) 'use_bassin_merarabie=' ,use_bassin_merarabie
    321           write(*,*) 'use_bassin_golfebengale=' ,use_bassin_golfebengale
    322           write(*,*) 'use_bassin_indiansud=' ,use_bassin_indiansud
    323           write(*,*) 'use_bassin_tropics=' ,use_bassin_tropics
    324           write(*,*) 'use_bassin_midlats=' ,use_bassin_midlats
    325           write(*,*) 'use_bassin_hauteslats=' ,use_bassin_hauteslats
    326 
    327        
    328           ntraceurs_zone_opt=2 &
    329      &                   +use_bassin_atlantic &
    330      &                   +use_bassin_medit &
    331      &                   +use_bassin_indian &
    332      &                   +use_bassin_austral &
    333      &                   +use_bassin_pacific &
    334      &                   +use_bassin_merarabie &
    335      &                   +use_bassin_golfebengale &
    336      &                   +use_bassin_indiansud &
    337      &                   +use_bassin_tropics &
    338      &                   +use_bassin_midlats &
    339      &                   +use_bassin_hauteslats
    340 
    341           izone_cont=ntraceurs_zone
    342           izone_oce=0 ! pas de sens car séparée en bassins         
    343           izone_poubelle=ntraceurs_zone-1 ! zone où on met les flux non physiques, de
    344                 ! réajustement
    345           izone_init=ntraceurs_zone-1 ! zone d'initialisation par défaut
    346           option_revap=0 ! on ne trace pas les gouttes
    347           option_tmin=0
    348           izone_revap=0 ! pas de sens car on taggue pas les gouttes séparemment 
    349           option_cond=0
    350 
    351           ! si on a use_bassin_indian, on n'a pas le découpage détaillé
    352           ! de l'indian:
     146   SUBROUTINE iso_traceurs_init()
     147
     148   USE infotrac_phy, ONLY: itZonIso, isoName, isoZone
     149   USE isotopes_mod, ONLY: iso_eau, ntracisoOR, initialisation_iso
     150   USE dimphy,       ONLY: klon, klev
     151   USE  strings_mod, ONLY: int2str, strStack, strTail, strHead, fmsg
     152
     153   IMPLICIT NONE
     154   ! Define which zones and isotopes correspond to isotopic tagging tracers
     155   ! Modify traceurs.h variables
     156   INTEGER :: izone, ixt, k
     157   INTEGER :: izone_pres, izone_lat
     158   INTEGER :: nzone_opt
     159
     160   IF(fmsg("traceurs_init 18: isotrac ne marche que si on met l'eau comme isotope", 'iso_traceurs_init', iso_eau==0)) STOP
     161
     162   !--- Initialize
     163   option_traceurs = 0
     164   initialisation_isotrac = 0
     165
     166   !--- Allocate
     167   ALLOCATE(index_iso (ntiso))
     168   ALLOCATE(index_zone(ntiso))
     169   ALLOCATE(itZonIso_loc(nzone,niso))
     170   ALLOCATE(strtrac(nzone))
     171   ALLOCATE(bassin_map(klon))
     172   ALLOCATE( boite_map(klon,klev))
     173
     174   IF(initialisation_iso == 0) CALL get_in('initialisation_isotrac', initialisation_isotrac)
     175
     176   !--- Read tracing option
     177   CALL get_in('option_traceurs', option_traceurs)
     178
     179   !--- Genral case: no traceurs in ORCHIDEE
     180   ntracisoOR=niso
     181
     182   ! partie a editer ! pour definir les differentes zones
     183   SELECT CASE(option_traceurs)
     184      !========================================================================================================================
     185      CASE(1)      !=== TRACING LAND/OCEAN
     186      !========================================================================================================================
     187         nzone_opt=2
     188         izone_cont=1
     189         izone_oce=2
     190         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     191         izone_init=2        ! zone d'initialisation par defaut         
     192         option_revap=0
     193         option_tmin=0
     194         izone_revap=0
     195         option_cond=0
     196         strtrac(izone_cont) = 'con'
     197         strtrac(izone_oce)  = 'oce'
     198      !========================================================================================================================
     199      CASE(2)      !=== TRACING LAND/OCEAN/DROPLETS REEVAPORATION
     200      !========================================================================================================================
     201         nzone_opt=3
     202         izone_cont=1
     203         izone_oce=2
     204         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     205         izone_init=2        ! zone d'initialisation par defaut         
     206         option_revap=1
     207         option_tmin=0
     208         izone_revap=3
     209         option_cond=0
     210         strtrac(izone_cont) = 'con'
     211         strtrac(izone_oce)  = 'oce'
     212         strtrac(izone_revap)= 'rev'
     213      !========================================================================================================================
     214      CASE(3)      !=== TRACING OCEANS BASINS + RESIDUE (LAST DIMENSION). NO DROPLETS EVAPORATION TRACING.
     215      !========================================================================================================================
     216         ! lire les use_bassin
     217         CALL get_in('use_bassin_Atlantic',   use_bassin_Atlantic)
     218         CALL get_in('use_bassin_Medit',      use_bassin_Medit)
     219         CALL get_in('use_bassin_Indian',     use_bassin_Indian)
     220         CALL get_in('use_bassin_Austral',    use_bassin_Austral)
     221         CALL get_in('use_bassin_Pacific',    use_bassin_Pacific)
     222         CALL get_in('use_bassin_MerArabie',  use_bassin_MerArabie)
     223         CALL get_in('use_bassin_BengalGolf', use_bassin_BengalGolf)
     224         CALL get_in('use_bassin_SouthIndian',use_bassin_SouthIndian)
     225         CALL get_in('use_bassin_Tropics',    use_bassin_Tropics)
     226         CALL get_in('use_bassin_Midlats',    use_bassin_Midlats)
     227         CALL get_in('use_bassin_HighLats',   use_bassin_HighLats)
     228         nzone_opt  =  2  +  COUNT([use_bassin_Atlantic, use_bassin_Medit,     use_bassin_Indian,     &
     229            use_bassin_Austral,     use_bassin_Pacific,  use_bassin_MerArabie, use_bassin_BengalGolf, &
     230            use_bassin_SouthIndian, use_bassin_Tropics,  use_bassin_Midlats,   use_bassin_HighLats])
     231         izone_cont=nzone
     232         izone_oce=0             ! pas de sens car separee en bassins         
     233         izone_poubelle=nzone-1  ! zone ou on met les flux non physiques, de reajustement
     234         izone_init=nzone-1      ! zone d'initialisation par defaut
     235         option_revap=0          ! on ne trace pas les gouttes
     236         option_tmin=0
     237         izone_revap=0           ! pas de sens car on taggue pas les gouttes separemment 
     238         option_cond=0
    353239#ifdef ISOVERIF
    354           if (use_bassin_indian.eq.1) then
    355 !              call iso_verif_egalite(float(use_bassin_merarabie), &
    356 !     &            0.0,'iso_traceurs_init 73: revoir def des bassins')
    357                if ((use_bassin_merarabie.ne.0).or. &
    358       &            (use_bassin_indiansud.ne.0).or. &
    359       &            (use_bassin_golfebengale.ne.0)) then
    360                 write(*,*) 'traceurs_init 73'
    361                 stop
    362                endif
    363 !              call iso_verif_egalite(float(use_bassin_golfebengale), &
    364 !     &            0.0,'iso_traceurs_init 73: revoir def des bassins')
    365 !              call iso_verif_egalite(float(use_bassin_indiansud), &
    366 !     &            0.0,'iso_traceurs_init 73: revoir def des bassins')
    367           endif
     240         IF(use_bassin_Indian) THEN   !=== NON COMPATIBLE WITH A DETAILED INDIAN CUTTING
     241            IF(use_bassin_MerArabie .OR. use_bassin_SouthIndian .OR. use_bassin_BengalGolf) THEN
     242               WRITE(*,*) 'traceurs_init 73'; STOP
     243            END IF
     244!           CALL iso_verif_egalite(float(use_bassin_MerArabie),   0.0, 'iso_traceurs_init 73: revoir def des bassins')
     245!           CALL iso_verif_egalite(float(use_bassin_BengalGolf),  0.0, 'iso_traceurs_init 73: revoir def des bassins')
     246!           CALL iso_verif_egalite(float(use_bassin_SouthIndian), 0.0, 'iso_traceurs_init 73: revoir def des bassins')
     247         END IF
    368248#endif   
    369          
    370           bassin_atlantic= max(use_bassin_atlantic,1)
    371           bassin_medit=max(use_bassin_atlantic &
    372      &           +use_bassin_medit,1)
    373           bassin_indian=max(use_bassin_atlantic &
    374      &           +use_bassin_medit &
    375      &           +use_bassin_indian,1)
    376           bassin_austral=max(use_bassin_atlantic &
    377      &           +use_bassin_medit &
    378      &           +use_bassin_indian &
    379      &           +use_bassin_austral,1)
    380           bassin_pacific=max(use_bassin_atlantic &
    381      &           +use_bassin_medit &
    382      &           +use_bassin_indian &
    383      &           +use_bassin_austral &
    384      &           +use_bassin_pacific,1)
    385           bassin_merarabie=max(use_bassin_atlantic &
    386      &           +use_bassin_medit &
    387      &           +use_bassin_indian &
    388      &           +use_bassin_austral &
    389      &           +use_bassin_pacific &
    390      &           +use_bassin_merarabie,1)
    391           bassin_golfebengale=max(use_bassin_atlantic&
    392      &           +use_bassin_medit &
    393      &           +use_bassin_indian &
    394      &           +use_bassin_austral &
    395      &           +use_bassin_pacific &
    396      &           +use_bassin_merarabie &
    397      &           +use_bassin_golfebengale,1)
    398           bassin_indiansud=max(use_bassin_atlantic &
    399      &           +use_bassin_medit &
    400      &           +use_bassin_indian &
    401      &           +use_bassin_austral &
    402      &           +use_bassin_pacific &
    403      &           +use_bassin_merarabie &
    404      &           +use_bassin_golfebengale &
    405      &           +use_bassin_indiansud,1)
    406           bassin_tropics=max(use_bassin_atlantic &
    407      &                       +use_bassin_medit &
    408      &                       +use_bassin_indian &
    409      &                       +use_bassin_austral &
    410      &                       +use_bassin_pacific &
    411      &                       +use_bassin_merarabie &
    412      &                       +use_bassin_golfebengale &
    413      &                       +use_bassin_indiansud, &
    414      &                       +use_bassin_tropics,1)
    415           bassin_midlats=max(use_bassin_atlantic &
    416      &                       +use_bassin_medit &
    417      &                       +use_bassin_indian &
    418      &                       +use_bassin_austral &
    419      &                       +use_bassin_pacific &
    420      &                       +use_bassin_merarabie &
    421      &                       +use_bassin_golfebengale &
    422      &                       +use_bassin_indiansud &
    423      &                       +use_bassin_tropics &
    424      &                       +use_bassin_midlats,1)
    425           bassin_hauteslats=max(use_bassin_atlantic &
    426      &                       +use_bassin_medit &
    427      &                       +use_bassin_indian &
    428      &                       +use_bassin_austral &
    429      &                       +use_bassin_pacific &
    430      &                       +use_bassin_merarabie &
    431      &                       +use_bassin_golfebengale &
    432      &                       +use_bassin_indiansud &
    433      &                       +use_bassin_tropics &
    434      &                       +use_bassin_midlats &
    435      &                       +use_bassin_hauteslats,1)
    436 
    437           write(*,*) 'bassin_atlantic=' ,bassin_atlantic 
    438           write(*,*) 'bassin_medit=' ,bassin_medit
    439           write(*,*) 'bassin_indian=' ,bassin_indian
    440           write(*,*) 'bassin_austral=' ,bassin_austral
    441           write(*,*) 'bassin_merarabie=' ,bassin_merarabie
    442           write(*,*) 'bassin_golfebengale=' ,bassin_golfebengale
    443           write(*,*) 'bassin_indiansud=' ,bassin_indiansud
    444           write(*,*) 'bassin_tropics=' ,bassin_tropics
    445           write(*,*) 'bassin_midlats=' ,bassin_midlats
    446           write(*,*) 'bassin_hauteslats=' ,bassin_hauteslats
    447 
    448           if (use_bassin_atlantic.eq.1) then
    449             strtrac(bassin_atlantic)='atl'
    450           endif
    451           if (use_bassin_medit.eq.1) then
    452             strtrac(bassin_medit)='med'
    453           endif
    454           if (use_bassin_indian.eq.1) then
    455             strtrac(bassin_indian)='ind'
    456           endif
    457           if (use_bassin_austral.eq.1) then
    458             strtrac(bassin_austral)='aus'
    459           endif
    460           if (use_bassin_pacific.eq.1) then
    461             strtrac(bassin_pacific)='pac'
    462           endif
    463           if (use_bassin_merarabie.eq.1) then
    464             strtrac(bassin_merarabie)='ara'
    465           endif
    466           if (use_bassin_golfebengale.eq.1) then
    467             strtrac(bassin_golfebengale)='ben'
    468           endif
    469           if (use_bassin_indiansud.eq.1) then
    470             strtrac(bassin_indiansud)='ins'
    471           endif
    472           if (use_bassin_tropics.eq.1) then
    473             strtrac(bassin_tropics)='tro'
    474           endif
    475           if (use_bassin_midlats.eq.1) then
    476             strtrac(bassin_midlats)='mid'
    477           endif
    478           if (use_bassin_hauteslats.eq.1) then
    479             strtrac(bassin_hauteslats)='hau'
    480           endif
    481           strtrac(ntraceurs_zone-1)='res'
    482           strtrac(ntraceurs_zone)='con'
    483 
    484         else if (option_traceurs.eq.4) then
    485           ! on trace les température minimales vécues
    486           ! comme dans article sur LdG sauf pas de revap
    487            
    488           zone_temp1=293.0 ! en K
    489 !          zone_tempf=223.0 ! en K
    490           zone_tempf=243.0 ! en K
    491  ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détal en bas
    492 
     249         bassin_Atlantic   = 1
     250         bassin_Medit      = bassin_Atlantic    + COUNT([use_bassin_Medit]);       WRITE(*,*) 'bassin_Atlantic    =' ,bassin_Atlantic
     251         bassin_Indian     = bassin_Medit       + COUNT([use_bassin_Indian]);      WRITE(*,*) 'bassin_Medit       =' ,bassin_Medit
     252         bassin_Austral    = bassin_Indian      + COUNT([use_bassin_Austral]);     WRITE(*,*) 'bassin_Indian      =' ,bassin_Indian
     253         bassin_Pacific    = bassin_Austral     + COUNT([use_bassin_Pacific]);     WRITE(*,*) 'bassin_Austral     =' ,bassin_Austral
     254         bassin_MerArabie  = bassin_Pacific     + COUNT([use_bassin_MerArabie]);   WRITE(*,*) 'bassin_MerArabie   =' ,bassin_MerArabie
     255         bassin_BengalGolf = bassin_MerArabie   + COUNT([use_bassin_BengalGolf]);  WRITE(*,*) 'bassin_BengalGolf  =' ,bassin_BengalGolf
     256         bassin_SouthIndian= bassin_BengalGolf  + COUNT([use_bassin_SouthIndian]); WRITE(*,*) 'bassin_SouthIndian =' ,bassin_SouthIndian
     257         bassin_Tropics    = bassin_SouthIndian + COUNT([use_bassin_Tropics]);     WRITE(*,*) 'bassin_Tropics     =' ,bassin_Tropics
     258         bassin_MidLats    = bassin_Tropics     + COUNT([use_bassin_MidLats]);     WRITE(*,*) 'bassin_MidLats     =' ,bassin_MidLats
     259         bassin_HighLats   = bassin_MidLats     + COUNT([use_bassin_HighLats]);    WRITE(*,*) 'bassin_HighLats    =' ,bassin_HighLats
     260         IF(use_bassin_atlantic   ) strtrac(bassin_atlantic)   = 'atl'
     261         IF(use_bassin_medit      ) strtrac(bassin_medit)      = 'med'
     262         IF(use_bassin_indian     ) strtrac(bassin_indian)     = 'ind'
     263         IF(use_bassin_austral    ) strtrac(bassin_austral)    = 'aus'
     264         IF(use_bassin_pacific    ) strtrac(bassin_pacific)    = 'pac'
     265         IF(use_bassin_merarabie  ) strtrac(bassin_merarabie)  = 'ara'
     266         IF(use_bassin_BengalGolf ) strtrac(bassin_BengalGolf) = 'ben'
     267         IF(use_bassin_SouthIndian) strtrac(bassin_SouthIndian)= 'ins'
     268         IF(use_bassin_tropics    ) strtrac(bassin_tropics)    = 'tro'
     269         IF(use_bassin_midlats    ) strtrac(bassin_midlats)    = 'mid'
     270         IF(use_bassin_HighLats   ) strtrac(bassin_HighLats)   = 'hau'
     271         strtrac(nzone-1)='res'
     272         strtrac(nzone)='con'
     273      !========================================================================================================================
     274      CASE(4)      !=== TRACING MINIMAL EXPERIENCED TEMPERATURE AS IN THE ARTICLE ON LfG, EXCEPT NO REVAPORATION
     275      !========================================================================================================================
     276         zone_temp1 = 293.0  ! en K
     277!        zone_tempf = 223.0  ! en K
     278         zone_tempf = 243.0  ! en K
     279        ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire, <0 pour plus de detal en bas
    493280        ! zone 1: >= zone_temp1
    494         ! zone 2 à 4: intermédiaire,
     281        ! zone 2 a 4: intermediaire,
    495282        ! zone 5: <zone_tempf
    496        
    497           ntraceurs_zone_opt=nzone_temp+1
    498 
    499           zone_tempa=-4.0 ! en K
    500           izone_cont=ntraceurs_zone
    501           izone_oce=ntraceurs_zone 
    502           izone_poubelle=ntraceurs_zone
    503           izone_init=ntraceurs_zone ! zone d'initialisation par défaut
    504           option_revap=0
    505           option_tmin=0 
    506           izone_revap=0
    507           option_cond=0
    508           do izone=1,nzone_temp
    509             write(strz,'(i2.2)') izone
    510             strtrac(izone)='t'//strz
    511             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    512           enddo
    513           strtrac(izone_poubelle)='pou'
    514 
    515           ! initialisation des zones de tempéarture
    516           do izone=1,nzone_temp-1
    517             zone_temp(izone)=zone_temp1+float(izone-1) &
    518      &                      *(zone_tempa*float(izone-nzone_temp+1) &
    519      &                      +(zone_tempf-zone_temp1)/float(nzone_temp-2))
    520           enddo
    521           write(*,*) 'iso_trac_init 183: zone_temp=',zone_temp         
    522 
    523         elseif (option_traceurs.eq.5) then
    524           ! on trace AEJ/flux de mousson/Harmattan
    525 !          write(*,*) 'iso_traceurs_init 129'
    526 
    527           ntraceurs_zone_opt=4
    528           izone_cont=1
    529           izone_oce=1
    530           izone_poubelle=1 ! zone où on met les flux non physiques, de
    531                 ! réajustement
    532           izone_init=1 ! zone d'initialisation par défaut
    533           option_revap=0
    534           option_tmin=0
    535           izone_revap=0
    536           izone_aej=2
    537           izone_mousson=3
    538           izone_harmattan=4
    539           option_cond=0
    540 
    541           strtrac(izone_poubelle)='res'
    542           strtrac(izone_aej)='aej'
    543           strtrac(izone_mousson)='mou'
    544           strtrac(izone_harmattan)='sah'
    545 
    546         elseif (option_traceurs.eq.6) then
    547           ! on trace les ddfts
    548 
    549           ntraceurs_zone_opt=2
    550           izone_cont=1
    551           izone_oce=1
    552           izone_poubelle=1 ! zone où on met les flux non physiques, de
    553                 ! réajustement
    554           izone_init=1 ! zone d'initialisation par défaut
    555           option_revap=0
    556           option_tmin=0
    557           izone_revap=0
    558           izone_ddft=2
    559           option_cond=0
    560 
    561           strtrac(izone_poubelle)='res'
    562           strtrac(izone_ddft)='dft'
    563 
    564         elseif (option_traceurs.eq.9) then
    565           ! on trace le condensat
    566 
    567           ntraceurs_zone_opt=3
    568           izone_cont=1
    569           izone_oce=1
    570           izone_poubelle=1 ! zone où on met les flux non physiques, de
    571                 ! réajustement
    572           izone_init=1 ! zone d'initialisation par défaut
    573           option_revap=1
    574           option_tmin=0
    575           izone_revap=2
    576           izone_cond=3
    577           option_cond=1
    578 
    579           ! 1 par défaut pour colorier à la fois condensat LS et
    580           ! condensat convectif. Mais on peut mettre 2 si on ne veut que
    581           ! collorier que le condensat convectif.
    582           call getin('option_cond',option_cond)
    583           write(*,*) 'option_cond=',option_cond
    584 
    585           strtrac(izone_poubelle)='res'
    586           strtrac(izone_cond)='con'
    587           strtrac(izone_revap)='rev'
    588 
    589         elseif (option_traceurs.eq.10) then
    590           ! on trace l'évap venant de ocean/continent no frac/continent frac
    591           !  utilse seulement si couplé avec ORCHIDEE
    592 #ifdef CPP_VEGET
    593 #else
    594           write(*,*) 'iso_traceurs_init 219: option_traceurs=10 ', &
    595      &                      'inutile si on ne couple pas avec ORCHIDEE'
    596           stop
     283         nzone_opt=nzone_temp+1
     284         zone_tempa=-4.0     ! en K
     285         izone_cont=nzone
     286         izone_oce=nzone 
     287         izone_poubelle=nzone
     288         izone_init=nzone    ! zone d'initialisation par defaut
     289         option_revap=0
     290         option_tmin=0 
     291         izone_revap=0
     292         option_cond=0
     293         DO izone=1,nzone_temp
     294            strtrac(izone) = 't'//TRIM(int2str(izone))
     295            WRITE(*,*) 'izone, strtrac=', izone, strtrac(izone)
     296         END DO
     297         strtrac(izone_poubelle)='pou'
     298         ! Initialization of temperatures zones
     299         DO izone=1,nzone_temp-1
     300            zone_temp(izone) = zone_temp1+float(izone-1)            &
     301                            * (zone_tempa*float(izone-nzone_temp+1) &
     302                            + (zone_tempf-zone_temp1)/float(nzone_temp-2))
     303         END DO
     304         WRITE(*,*) 'iso_trac_init 183: zone_temp=', zone_temp
     305      !========================================================================================================================
     306      CASE(5)      !=== TRACING AEJ/MOONSOON FLUX/Harmattan
     307      !========================================================================================================================
     308!        WRITE*,*) 'iso_traceurs_init 129'
     309         nzone_opt=4
     310         izone_cont=1
     311         izone_oce=1
     312         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     313         izone_init=1        ! zone d'initialisation par defaut         
     314         option_revap=0
     315         option_tmin=0
     316         izone_revap=0
     317         izone_aej=2
     318         izone_mousson=3
     319         izone_harmattan=4
     320         option_cond=0
     321         strtrac(izone_poubelle) = 'res'
     322         strtrac(izone_aej)      = 'aej'
     323         strtrac(izone_mousson)  = 'mou'
     324         strtrac(izone_harmattan)= 'sah'
     325      !========================================================================================================================
     326      CASE(6)      !=== TRACING DDFTS
     327      !========================================================================================================================
     328         nzone_opt=2
     329         izone_cont=1
     330         izone_oce=1
     331         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     332         izone_init=1        ! zone d'initialisation par defaut         
     333         option_revap=0
     334         option_tmin=0
     335         izone_revap=0
     336         izone_ddft=2
     337         option_cond=0
     338         strtrac(izone_poubelle)='res'
     339         strtrac(izone_ddft)='dft'
     340      !========================================================================================================================
     341      CASE(9)      !=== TRACING CONDENSATION
     342      !========================================================================================================================
     343         nzone_opt=3
     344         izone_cont=1
     345         izone_oce=1
     346         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     347         izone_init=1        ! zone d'initialisation par defaut         
     348         option_revap=1
     349         option_tmin=0
     350         izone_revap=2
     351         izone_cond=3
     352         option_cond=1
     353         ! 1 par defaut pour colorier a la fois condensat LS et condensat convectif.
     354         ! Mais on peut mettre 2 si on ne veut que colorier que le condensat convectif.
     355         CALL get_in('option_cond',option_cond)
     356         strtrac(izone_poubelle)='res'
     357         strtrac(izone_cond)='con'
     358         strtrac(izone_revap)='rev'
     359      !========================================================================================================================
     360      CASE(10)     !=== TRACING EVAPORATION FROM OCEAN/LAND, NON FRAC/LAND FRAC ; ONLY WHEN COUPLED WITH ORCHIDEE
     361      !========================================================================================================================
     362#ifndef CPP_VEGET
     363         WRITE(*,*) 'iso_traceurs_init 219: option_traceurs=10 inutile si on ne couple pas avec ORCHIDEE'; STOP
    597364#endif         
    598 
    599           ntraceurs_zone_opt=3
    600           izone_cont=1 ! sous-entendu non fractionnant
    601           izone_oce=2
    602           izone_poubelle=2 ! zone où on met les flux non physiques, de
    603                 ! réajustement
    604           izone_init=2 ! zone d'initialisation par défaut
    605           option_revap=0
    606           option_tmin=0
    607           izone_revap=0
    608           izone_contfrac=3
    609           izone_contcanop=3
    610           izone_irrig=0
    611           option_cond=0
    612 
    613           strtrac(izone_oce)='oce'
    614           strtrac(izone_cont)='con' 
    615           strtrac(izone_contfrac)='enu'  ! evap sol nu
    616 
    617         elseif (option_traceurs.eq.11) then
    618           ! on trace reevap des gouttes et le reste
    619 
    620           ntraceurs_zone_opt=2
    621           izone_cont=1
    622           izone_oce=1
    623           izone_poubelle=1 ! zone où on met les flux non physiques, de
    624                 ! réajustement
    625           izone_init=1 ! zone d'initialisation par défaut
    626           option_revap=1
    627           option_tmin=0
    628           izone_revap=2
    629           izone_irrig=0
    630           option_cond=0
    631 
    632           strtrac(izone_poubelle)='res'
    633           strtrac(izone_revap)='rev'
    634 
    635         elseif (option_traceurs.eq.12) then
    636           ! on trace evap du sol nu, evap de la canopée, reste de l'evap cont et
    637           ! evap oce
    638 #ifdef CPP_VEGET
    639 #else
    640           write(*,*) 'iso_traceurs_init 257: option_traceurs=10 ', &
    641      &                      'inutile si on ne couple pas avec ORCHIDEE'
    642           stop
     365         nzone_opt=3
     366         izone_cont=1        ! sous-entendu non fractionnant
     367         izone_oce=2
     368         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     369         izone_init=2        ! zone d'initialisation par defaut
     370         option_revap=0
     371         option_tmin=0
     372         izone_revap=0
     373         izone_contfrac=3
     374         izone_contcanop=3
     375         izone_irrig=0
     376         option_cond=0
     377         strtrac(izone_oce)='oce'
     378         strtrac(izone_cont)='con' 
     379         strtrac(izone_contfrac)='enu'  ! evap sol nu
     380      !========================================================================================================================
     381      CASE(11)     !=== TRACING DROPLETS REEVAPORATION + REST
     382      !========================================================================================================================
     383         nzone_opt=2
     384         izone_cont=1
     385         izone_oce=1
     386         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     387         izone_init=1        ! zone d'initialisation par defaut
     388         option_revap=1
     389         option_tmin=0
     390         izone_revap=2
     391         izone_irrig=0
     392         option_cond=0
     393         strtrac(izone_poubelle)='res'
     394         strtrac(izone_revap)='rev'
     395      !========================================================================================================================
     396      CASE(12)     !=== TRACING NAKED GROUND EVAPORATION, CANOPY EVAPORATION, REST OF LAND EVAPORATION AND OCEAN EVAPORATION
     397      !========================================================================================================================
     398#ifndef CPP_VEGET
     399         WRITE(*,*) 'iso_traceurs_init 257: option_traceurs=10 inutile si on ne couple pas avec ORCHIDEE'; STOP
    643400#endif           
    644 
    645           ntraceurs_zone_opt=2
    646           izone_cont=1
    647           izone_oce=2
    648           izone_poubelle=2 ! zone où on met les flux non physiques, de
    649                 ! réajustement
    650           izone_init=2 ! zone d'initialisation par défaut
    651           option_revap=0
    652           option_tmin=0
    653           izone_revap=0
    654           izone_contfrac=3
    655           izone_contcanop=4
    656           izone_irrig=0   
    657           option_cond=0
    658 
    659           strtrac(izone_oce)='oce'
    660           strtrac(izone_cont)='con'
    661           strtrac(izone_contfrac)='enu'  ! evap sol nu
    662           strtrac(izone_contcanop)='eca'  ! evap canop
    663 
    664        else if (option_traceurs.eq.13) then
    665           ! on trace les température minimales vécues + la revap
    666           ! comme dans article sur LdG
    667            
    668         zone_temp1=293.0         ! en K       
    669 !        parameter (zone_tempf=223.0) ! en K
    670         zone_tempf=243.0 ! en K
    671         zone_tempa=-4.0 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détal en bas
    672 
    673         ! zone 1: >= zone_temp1
    674         ! zone 2 à 4: intermédiaire,
    675         ! zone 5: <zone_tempf
    676        
    677           ntraceurs_zone_opt=nzone_temp+1
    678          
    679           izone_cont=1
    680           izone_oce=1 
    681           izone_poubelle=1
    682           izone_init=1 ! zone d'initialisation par défaut
    683           option_revap=1   
    684           option_tmin=0
    685           izone_revap=ntraceurs_zone
    686           izone_irrig=0
    687           option_cond=0
    688           do izone=1,nzone_temp
    689             write(strz,'(i2.2)') izone
    690             strtrac(izone)='t'//strz
    691             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    692           enddo
    693           strtrac(izone_revap)='rev'
    694 
    695           ! initialisation des zones de tempéarture
    696           do izone=1,nzone_temp-1
    697             zone_temp(izone)=zone_temp1+float(izone-1) &
    698      &                      *(zone_tempa*float(izone-nzone_temp+1) &
    699      &                      +(zone_tempf-zone_temp1)/float(nzone_temp-2))
    700           enddo
    701           write(*,*) 'zone_temp=',zone_temp
    702 
    703        else if (option_traceurs.eq.14) then
    704           ! on trace les pres et lat de dernière saturation définies
    705           ! comme rh>90%
    706            
    707         zone_pres1=600.0*100.0 ! en Pa       
    708         zone_presf=300.0*100.0 ! en Pa
    709         zone_presa=0.0 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détal en bas
    710 
    711         lattag_min=10.0 ! en degrès
    712         dlattag=15.0
    713 
    714         ! zone 1: >= zone_pres1
    715         ! zone 2 à 4: intermédiaire,
    716         ! zone 5: <zone_presf
    717        
    718          ntraceurs_zone_opt=nzone_pres*nzone_lat+1         
    719           izone_cont=ntraceurs_zone
    720           izone_oce=ntraceurs_zone
    721           izone_poubelle=ntraceurs_zone
    722           izone_init=ntraceurs_zone ! zone d'initialisation par défaut
    723           option_revap=0 
    724           option_tmin=0
    725           izone_revap=0
    726           izone_irrig=0
    727           option_cond=0
    728           do izone_pres=1,nzone_pres
    729            do izone_lat=1,nzone_lat
    730             write(strz_pres,'(i1.1)') izone_pres
    731             write(strz_lat,'(i1.1)') izone_lat
    732             strz_preslat=strz_pres//strz_lat
    733             izone=izone_lat+(izone_pres-1)*nzone_lat
    734             strtrac(izone)='t'//strz_preslat
    735             write(*,*) 'izone_pres,izone_lat,strtrac=', &
    736      &                        izone_pres,izone_lat,izone,strtrac(izone)
    737            enddo !do izone_lat=1,nzone_lat
    738           enddo !do izone_pres=1,nzone_pres
    739           strtrac(ntraceurs_zone)='sfc'
    740 
    741           ! initialisation des zones de tempéarture
    742           do izone=1,nzone_pres-1
    743             zone_pres(izone)=zone_pres1+float(izone-1) &
    744      &                      *(zone_presa*float(izone-nzone_pres+1) &
    745      &                      +(zone_presf-zone_pres1)/float(nzone_pres-2))
    746           enddo !do izone=1,nzone_pres-1
    747           write(*,*) 'traceurs_init 332: zone_pres=',zone_pres
    748 !          stop
    749 !
    750        elseif (option_traceurs.eq.15) then
    751           ! on trace l'irrigation dans ORCHIDEE
    752 #ifdef CPP_VEGET
    753 #else
    754           write(*,*) 'iso_traceurs_init 257: option_traceurs=15 ', &
    755      &                      'inutile si on ne couple pas avec ORCHIDEE'
    756           stop
     401         nzone_opt=2
     402         izone_cont=1
     403         izone_oce=2
     404         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     405         izone_init=2        ! zone d'initialisation par defaut
     406         option_revap=0
     407         option_tmin=0
     408         izone_revap=0
     409         izone_contfrac=3
     410         izone_contcanop=4
     411         izone_irrig=0   
     412         option_cond=0
     413         strtrac(izone_oce)='oce'
     414         strtrac(izone_cont)='con'
     415         strtrac(izone_contfrac)='enu' ! evap sol nu
     416         strtrac(izone_contcanop)='eca'! evap canop
     417      !========================================================================================================================
     418      CASE(13)     !=== TRACING MINIMUM EXPERIENCED TEMPERATIRES + REEVAPORATION AS IN THE ARTICLE ON LdG
     419      !========================================================================================================================
     420         zone_temp1=293.0    ! en K       
     421!        zone_tempf=223.0    ! en K
     422         zone_tempf=243.0    ! en K
     423         zone_tempa=-4.0     ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire, <0 pour plus de detal en bas
     424         ! zone 1: >= zone_temp1
     425         ! zone 2 a 4: intermediaire,
     426         ! zone 5: <zone_tempf
     427         nzone_opt=nzone_temp+1
     428         izone_cont=1
     429         izone_oce=1 
     430         izone_poubelle=1
     431         izone_init=1        ! zone d'initialisation par defaut
     432         option_revap=1   
     433         option_tmin=0
     434         izone_revap=nzone
     435         izone_irrig=0
     436         option_cond=0
     437         DO izone=1,nzone_temp
     438            strtrac(izone) = 't'//TRIM(int2str(izone))
     439            WRITE(*,*) 'izone, strtrac = ', izone, strtrac(izone)
     440         END DO
     441         strtrac(izone_revap)='rev'
     442         ! initialisation des zones de tempearture
     443         DO izone=1,nzone_temp-1
     444            zone_temp(izone) = zone_temp1+float(izone-1) &
     445                             *(zone_tempa*float(izone-nzone_temp+1) &
     446                             +(zone_tempf-zone_temp1)/float(nzone_temp-2))
     447         END DO
     448         WRITE(*,*) 'zone_temp=',zone_temp
     449      !========================================================================================================================
     450      CASE(14)     !=== TRACING PRES AND LAT OF LAST SATURATION DEFINED AS rh>90%
     451      !========================================================================================================================
     452         zone_pres1=600.0*100.0   ! en Pa       
     453         zone_presf=300.0*100.0   ! en Pa
     454         zone_presa=0.0           ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire
     455         lattag_min=10.0          ! en degres
     456         dlattag=15.0
     457         ! zone 1: >= zone_pres1
     458         ! zone 2 a 4: intermediaire,
     459         ! zone 5: <zone_presf
     460         nzone_opt=nzone_pres*nzone_lat+1         
     461         izone_cont=nzone
     462         izone_oce=nzone
     463         izone_poubelle=nzone
     464         izone_init=nzone         ! zone d'initialisation par defaut
     465         option_revap=0 
     466         option_tmin=0
     467         izone_revap=0
     468         izone_irrig=0
     469         option_cond=0
     470         DO izone_pres=1,nzone_pres
     471            DO izone_lat=1,nzone_lat
     472               izone=izone_lat+(izone_pres-1)*nzone_lat
     473               strtrac(izone) = 't'//TRIM(int2str(izone_pres))//TRIM(int2str(izone_lat))
     474               write(*,*) 'izone_pres, izone_lat, izone, strtrac = ',izone_pres, izone_lat, izone, strtrac(izone)
     475            END DO
     476         END DO
     477         strtrac(nzone)='sfc'
     478         ! initialisation des zones de temperature
     479         DO izone=1,nzone_pres-1
     480            zone_pres(izone) = zone_pres1+float(izone-1) &
     481                             *(zone_presa*float(izone-nzone_pres+1) &
     482                             +(zone_presf-zone_pres1)/float(nzone_pres-2))
     483         END DO
     484         WRITE(*,*) 'traceurs_init 332: zone_pres=',zone_pres
     485      !========================================================================================================================
     486      CASE(15)     !=== TRACING IRRIGATION IN ORCHIDEE
     487      !========================================================================================================================
     488#ifndef CPP_VEGET
     489         WRITE(*,*) 'iso_traceurs_init 257: option_traceurs=15 inutile si on ne couple pas avec ORCHIDEE'; STOP
    757490#endif
    758 
    759           ntraceurs_zone_opt=1
    760           izone_cont=1
    761           izone_oce=1
    762           izone_poubelle=1 ! zone où on met les flux non physiques, de
    763                 ! réajustement
    764           izone_init=1 ! zone d'initialisation par défaut
    765           option_revap=0
    766           option_tmin=0
    767           izone_revap=0
    768           izone_contfrac=0
    769           izone_contcanop=0
    770           izone_irrig=2
    771           option_cond=0
    772          
    773           strtrac(izone_poubelle)='res'
    774           strtrac(izone_irrig)='irrig'
    775 
    776           ! dans ce cas particulier, il y a des traceurs dans ORCHIDEE
    777           ntracisoOR=ntiso
    778 
    779         else if ((option_traceurs.eq.17).or. &
    780      &           (option_traceurs.eq.18)) then
    781           ! on trace les température minimales vécues
    782           ! comme dans article sur LdG sauf pas de revap
    783            
    784         zone_temp1=12.0e-3 ! en kg/kg       
    785         zone_tempf=0.2e-3 ! en kg/kg
    786         zone_tempa=1.2e-3 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détail en bas
    787 
    788 !       parameter (zone_temp1=14.0e-3) ! en kg/kg       
    789 !       parameter (zone_tempf=0.2e-3) ! en kg/kg
    790 !       parameter (zone_tempa=0.5e-3)       
    791 
    792 !        parameter (zone_temp1=10.0e-3) ! en kg/kg
    793 !       parameter (zone_tempf=0.5e-3) ! en kg/kg
    794 !       parameter (zone_tempa=0.5e-3)
    795 
    796         ! zone 1: >= zone_temp1
    797         ! zone 2 à 4: intermédiaire,
    798         ! zone 5: <zone_tempf
    799        
    800         ntraceurs_zone_opt=nzone_temp+3
    801        
    802           izone_cont=nzone_temp+1
    803           izone_oce=nzone_temp+1
    804           izone_poubelle=nzone_temp+1
    805           izone_init=nzone_temp+1 ! zone d'initialisation par défaut
    806           option_revap=1 
    807           option_tmin=1
    808           option_cond=1
    809 
    810           izone_revap=nzone_temp+3
    811           izone_cond=nzone_temp+2
    812           do izone=1,nzone_temp
    813             write(strz,'(i2.2)') izone
    814             strtrac(izone)='t'//strz
    815             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    816           enddo !do izone=1,nzone_temp
    817           strtrac(izone_poubelle)='sfc'
    818           strtrac(izone_cond)='con'
    819           strtrac(izone_revap)='rev'
    820 
    821           ! initialisation des zones de tempéarture
    822           do izone=1,nzone_temp-1
    823             zone_temp(izone)=zone_temp1+float(izone-1) &
    824      &                      *(zone_tempa*float(izone-nzone_temp+1) &
    825      &             +(zone_tempf-zone_temp1)/float(nzone_temp-2))
    826           enddo
    827          write(*,*) 'zone_temp1,zone_tempf,zone_tempa=', &
    828      &              zone_temp1,zone_tempf,zone_tempa
    829           write(*,*) 'zone_temp=',zone_temp
    830 !          stop         
    831 
    832         else if (option_traceurs.eq.19) then
    833 
    834         zone_temp1=12.0e-3 ! en kg/kg       
    835         zone_tempf=0.2e-3 ! en kg/kg
    836         zone_tempa=1.2e-3 ! courbure de la relation entre l'indice et la température: 0 pour linéaire, <0 pour plus de détail en bas
    837 
    838 !       parameter (zone_temp1=14.0e-3) ! en kg/kg       
    839 !       parameter (zone_tempf=0.2e-3) ! en kg/kg
    840 !       parameter (zone_tempa=0.5e-3)       
    841 
    842 !        parameter (zone_temp1=10.0e-3) ! en kg/kg
    843 !       parameter (zone_tempf=0.5e-3) ! en kg/kg
    844 !       parameter (zone_tempa=0.5e-3)
    845 
    846         ! zone 1: >= zone_temp1
    847         ! zone 2 à 4: intermédiaire,
    848         ! zone 5: <zone_tempf
    849        
    850         ntraceurs_zone_opt=nzone_temp+4
    851        
    852           izone_cont=nzone_temp+1
    853           izone_oce=nzone_temp+1
    854           izone_poubelle=nzone_temp+1
    855           if (option_seuil_tag_tmin.eq.1) then
    856             izone_init=nzone_temp+1 ! zone d'initialisation par défaut
    857           else
     491         nzone_opt=1
     492         izone_cont=1
     493         izone_oce=1
     494         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     495         izone_init=1        ! zone d'initialisation par defaut
     496         option_revap=0
     497         option_tmin=0
     498         izone_revap=0
     499         izone_contfrac=0
     500         izone_contcanop=0
     501         izone_irrig=2
     502         option_cond=0
     503         strtrac(izone_poubelle)='res'
     504         strtrac(izone_irrig)='irrig'
     505         ! dans ce cas particulier, il y a des traceurs dans ORCHIDEE
     506         ntracisoOR=ntiso
     507      !========================================================================================================================
     508      CASE(17,18)  !=== TRACING MINIMAL EXPERIENCES TEMPERATURES AS IN THE ARTICLE ABOUT LdG, BUT NO EVAPORATION
     509      !========================================================================================================================
     510         zone_temp1=12.0e-3  ! en kg/kg       
     511         zone_tempf=0.2e-3   ! en kg/kg
     512         zone_tempa=1.2e-3   ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire
     513!        zone_temp1=14.0e-3  ! en kg/kg       
     514!        zone_tempf=0.2e-3   ! en kg/kg
     515!        zone_tempa=0.5e-3       
     516!        zone_temp1=10.0e-3  ! en kg/kg
     517!        zone_tempf=0.5e-3   ! en kg/kg
     518!        zone_tempa=0.5e-3
     519         ! zone 1: >= zone_temp1
     520         ! zone 2 a 4: intermediaire,
     521         ! zone 5: <zone_tempf
     522         nzone_opt=nzone_temp+3
     523         izone_cont=nzone_temp+1
     524         izone_oce=nzone_temp+1
     525         izone_poubelle=nzone_temp+1
     526         izone_init=nzone_temp+1 ! zone d'initialisation par defaut
     527         option_revap=1 
     528         option_tmin=1
     529         option_cond=1
     530         izone_revap=nzone_temp+3
     531         izone_cond=nzone_temp+2
     532         DO izone=1,nzone_temp
     533            strtrac(izone) = 't'//TRIM(int2str(izone))
     534            WRITE(*,*) 'izone, strtrac = ', izone, strtrac(izone)
     535         END DO !do izone=1,nzone_temp
     536         strtrac(izone_poubelle)='sfc'
     537         strtrac(izone_cond)='con'
     538         strtrac(izone_revap)='rev'
     539         ! initialisation des zones de tempearture
     540         DO izone=1,nzone_temp-1
     541            zone_temp(izone) = zone_temp1+float(izone-1) &
     542                             *(zone_tempa*float(izone-nzone_temp+1) &
     543                             +(zone_tempf-zone_temp1)/float(nzone_temp-2))
     544         END DO
     545         WRITE(*,*) 'zone_temp1,zone_tempf,zone_tempa=',zone_temp1,zone_tempf,zone_tempa
     546         WRITE(*,*) 'zone_temp=',zone_temp
     547!        STOP         
     548      !========================================================================================================================
     549      CASE(19)     !=== TRACING TROPICAL AND EXTRATROPICAL VAPOUR
     550      !========================================================================================================================
     551         zone_temp1=12.0e-3  ! en kg/kg       
     552         zone_tempf=0.2e-3   ! en kg/kg
     553         zone_tempa=1.2e-3   ! courbure de la relation entre l'indice et la temperature: 0 pour lineaire, <0 pour plus de detail en bas
     554!        zone_temp1=14.0e-3  ! en kg/kg       
     555!        zone_tempf=0.2e-3   ! en kg/kg
     556!        zone_tempa=0.5e-3
     557!        zone_temp1=10.0e-3  ! en kg/kg       
     558!        zone_tempf=0.5e-3   ! en kg/kg
     559!        zone_tempa=0.5e-3
     560         ! zone 1: >= zone_temp1
     561         ! zone 2 a 4: intermediaire,
     562         ! zone 5: <zone_tempf
     563         nzone_opt=nzone_temp+4
     564         izone_cont=nzone_temp+1
     565         izone_oce=nzone_temp+1
     566         izone_poubelle=nzone_temp+1
     567         IF(option_seuil_tag_tmin == 1) THEN
     568            izone_init=nzone_temp+1 ! zone d'initialisation par defaut
     569         ELSE
    858570            izone_init=nzone_temp
    859           endif
    860           option_revap=1   
    861           izone_revap=nzone_temp+3
    862           izone_cond=nzone_temp+2
    863           izone_ddft=nzone_temp+4
    864           option_tmin=1         
    865           option_cond=1
    866           do izone=1,nzone_temp
    867             write(strz,'(i2.2)') izone
    868             strtrac(izone)='t'//strz
    869             write(*,*) 'izone,strz,strtrac=',izone,strz,strtrac(izone)
    870           enddo !do izone=1,nzone_temp
    871           strtrac(izone_poubelle)='sfc'
    872           strtrac(izone_cond)='con'
    873           strtrac(izone_revap)='rev'
    874           strtrac(izone_ddft)='dft'
    875 
    876         elseif (option_traceurs.eq.20) then
    877           ! on vapeur tropical/extractropicale/recyclage extractropical
    878           ! pour comprendre controles humidité et isotopes subtropicaux.       
    879          
    880           lim_tag20=35.0
    881           call getin('lim_tag20',lim_tag20)
    882           write(*,*) 'lim_tag20=',lim_tag20
    883 
    884           ntraceurs_zone_opt=3
    885           izone_cont=1
    886           izone_oce=1
    887           izone_poubelle=2 ! zone où on met les flux non physiques, de
    888                 ! réajustement
    889           izone_init=2 ! zone d'initialisation par défaut
    890           option_revap=0
    891           option_tmin=0
    892           izone_revap=0
    893           izone_trop=2
    894           izone_extra=3
    895 
    896           strtrac(izone_trop)='tro' ! vapeur tropicale
    897           strtrac(izone_extra)='ext' ! vapeur extractropicale evaporée
    898                 ! dans les tropiques
    899           strtrac(izone_cont)='rec' ! recyclage
    900 
    901         elseif (option_traceurs.eq.21) then
    902           ! on trace 2 boites 3D: UT tropicale et extratropiques
    903           ! fonctionnement similaire à option 5 pour taggage des zones
    904           ! AMMA
    905 !          write(*,*) 'iso_traceurs_init 129'
    906 
    907           ntraceurs_zone_opt=3
    908           izone_cont=1
    909           izone_oce=1
    910           izone_poubelle=1 ! zone où on met les flux non physiques, de
    911                 ! réajustement
    912           izone_init=1 ! zone d'initialisation par défaut
    913           option_revap=0
    914           option_tmin=0
    915           izone_revap=0
    916           izone_trop=2
    917           izone_extra=3
    918           option_cond=0
    919 
    920           strtrac(izone_poubelle)='res'
    921           strtrac(izone_trop)='tro'
    922           strtrac(izone_extra)='ext'
    923 
    924         elseif (option_traceurs.eq.22) then
    925           ! on trace la vapeur qui a été processée dans zones de
    926           ! convections à 3 niveaux: BT, MT et UT
    927 
    928           lim_precip_tag22=20.0
    929           call getin('lim_precip_tag22',lim_precip_tag22)
    930           write(*,*) 'lim_precip_tag22=',lim_precip_tag22
    931 
    932           ntraceurs_zone_opt=3
    933           izone_cont=1
    934           izone_oce=1
    935           izone_poubelle=1 ! zone où on met les flux non physiques, de
    936                 ! réajustement
    937           izone_init=1 ! zone d'initialisation par défaut
    938           option_revap=0
    939           option_tmin=0
    940           izone_revap=0
    941           izone_conv_BT=2
    942           izone_conv_UT=3
    943           option_cond=0
    944 
    945           strtrac(izone_poubelle)='res'
    946           strtrac(izone_conv_BT)='cbt'
    947           strtrac(izone_conv_UT)='cut'
    948 
    949         else
    950             write(*,*) 'traceurs_init 36: option pas encore prévue'
    951             stop
    952         endif
    953 
    954        
    955           if (ntraceurs_zone_opt.ne.ntraceurs_zone) then
    956                 write(*,*) 'ntraceurs_zone_opt,ntraceurs_zone=', &
    957                         & ntraceurs_zone_opt,ntraceurs_zone
    958                 call abort_physic ('isotrac_mod','ntraceurs_zone incoherent',1)
    959           endif
    960 
    961        
    962         ! seuil sur le taux de condensation
    963         if (option_tmin.eq.1) then
    964           seuil_tag_tmin=0.01
    965           call getin('seuil_tag_tmin',seuil_tag_tmin)
    966           write(*,*) 'seuil_tag_tmin=',seuil_tag_tmin
    967 
    968           seuil_tag_tmin_ls=seuil_tag_tmin
    969           call getin('seuil_tag_tmin_ls',seuil_tag_tmin_ls)
    970           write(*,*) 'seuil_tag_tmin_ls=',seuil_tag_tmin_ls
    971 
    972           option_seuil_tag_tmin=1
    973           call getin('option_seuil_tag_tmin',option_seuil_tag_tmin)
    974           write(*,*) 'option_seuil_tag_tmin=',option_seuil_tag_tmin
    975         endif
    976 
    977 
    978         do ixt=1,niso
    979            index_zone(ixt)=0
    980            index_iso(ixt)=ixt
    981         enddo
    982         itrac=niso       
    983         do izone=1,ntraceurs_zone
    984           do ixt=1,niso
    985             itrac=itrac+1
    986             index_zone(itrac)=izone
    987             index_iso(itrac)=ixt
    988             itZonIso_loc(izone,ixt)=itrac
    989             if (itZonIso(izone,ixt).ne.itZonIso_loc(izone,ixt)) then
    990                 write(*,*) 'isotrac 989: izone,ixt,itrac=',izone,ixt,itrac
    991                 CALL abort_physic ('isotrac','isotrac 989',1)
    992             endif
    993           enddo
    994         enddo
     571         END IF
     572         option_revap=1   
     573         izone_revap=nzone_temp+3
     574         izone_cond=nzone_temp+2
     575         izone_ddft=nzone_temp+4
     576         option_tmin=1         
     577         option_cond=1
     578         DO izone=1,nzone_temp
     579            strtrac(izone) = 't'//TRIM(int2str(izone))
     580            WRITE(*,*) 'izone, strtrac = ', izone, strtrac(izone)
     581         END DO
     582         strtrac(izone_poubelle)='sfc'
     583         strtrac(izone_cond)='con'
     584         strtrac(izone_revap)='rev'
     585         strtrac(izone_ddft)='dft'
     586      !========================================================================================================================
     587      CASE(20)     !=== TRACING TROPICAL/EXTRATROPICAL/EXTRATROPICAL RECYCLING TO STUDY HUMIDITY AND SUBTROPICAL ISOTOPES CONTROL
     588      !========================================================================================================================
     589         CALL get_in('lim_tag20', lim_tag20, 35.0)
     590         nzone_opt=3
     591         izone_cont=1
     592         izone_oce=1
     593         izone_poubelle=2    ! zone ou on met les flux non physiques, de reajustement
     594         izone_init=2        ! zone d'initialisation par defaut
     595         option_revap=0
     596         option_tmin=0
     597         izone_revap=0
     598         izone_trop=2
     599         izone_extra=3
     600         strtrac(izone_trop)='tro'     ! tropical vapour
     601         strtrac(izone_extra)='ext'    ! extratropical vapour evaporated in the tropics
     602         strtrac(izone_cont)='rec'     ! recycling
     603      !========================================================================================================================
     604      CASE(21)     !=== TRACING TWO 3D BOXES: TROPICAL UT AND EXTRATROPICS ; SIMILAR TO 5 FOR AMMA ZONES TAGGING
     605      !========================================================================================================================
     606!        WRITE(*,*) 'iso_traceurs_init 129'
     607         nzone_opt=3
     608         izone_cont=1
     609         izone_oce=1
     610         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     611         izone_init=1        ! zone d'initialisation par defaut
     612         option_revap=0
     613         option_tmin=0
     614         izone_revap=0
     615         izone_trop=2
     616         izone_extra=3
     617         option_cond=0
     618         strtrac(izone_poubelle)='res'
     619         strtrac(izone_trop)='tro'
     620         strtrac(izone_extra)='ext'
     621      !========================================================================================================================
     622      CASE(22)     !=== TRACING WATER VAPOUR PROCESSED IN THE 3-LEVELS SCONVECTION ZONES BT, MT AND UT
     623      !========================================================================================================================
     624         CALL get_in('lim_precip_tag22', lim_precip_tag22, 20.0)
     625         nzone_opt=3
     626         izone_cont=1
     627         izone_oce=1
     628         izone_poubelle=1    ! zone ou on met les flux non physiques, de reajustement
     629         izone_init=1        ! zone d'initialisation par defaut
     630         option_revap=0
     631         option_tmin=0
     632         izone_revap=0
     633         izone_conv_BT=2
     634         izone_conv_UT=3
     635         option_cond=0
     636         strtrac(izone_poubelle)='res'
     637         strtrac(izone_conv_BT)='cbt'
     638         strtrac(izone_conv_UT)='cut'
     639      CASE DEFAULT
     640         WRITE(*,*) 'traceurs_init 36: option pas encore prevue' ; STOP
     641   END SELECT
     642
     643   IF(nzone_opt /= nzone) THEN
     644      WRITE(*,*) 'nzone_opt, nzone=', nzone_opt, nzone
     645      CALL abort_physic ('isotrac_mod','nzone incoherent',1)
     646   END IF
     647
     648   !--- Condensation rate threshold
     649   IF(option_tmin == 1) THEN
     650      seuil_tag_tmin = 0.01
     651      CALL get_in('seuil_tag_tmin',        seuil_tag_tmin,        0.01)
     652      CALL get_in('seuil_tag_tmin_ls',     seuil_tag_tmin_ls,     seuil_tag_tmin)
     653      CALL get_in('option_seuil_tag_tmin', option_seuil_tag_tmin, 1)
     654   END IF
     655   DO ixt=1,niso
     656      index_zone(ixt)=0
     657      index_iso(ixt)=ixt
     658   END DO
     659
     660   index_zone = [(INDEX(isoZone, strTail(         isoName(ixt) ,'_')), ixt=1, ntiso)]
     661   index_iso  = [(INDEX(isoName, strHead(delPhase(isoName(ixt)),'_')), ixt=1, ntiso)]
     662   itZonIso_loc = itZonIso(:,:)
    995663#ifdef ISOVERIF
    996 !        call iso_verif_egalite(float(itrac),float(ntiso), &
    997 !     &           'traceurs_init 50')
    998         if (itrac.ne.ntiso) then
    999           write(*,*) 'traceurs_init 50'
    1000           stop
    1001         endif
    1002      
    1003         write(*,*) 'traceurs_init 65: bilan de l''init:'
    1004         write(*,*) 'index_zone=',index_zone(1:ntiso)
    1005         write(*,*) 'index_iso=',index_iso(1:ntiso)
    1006         write(*,*) 'itZonIso=',itZonIso(1:ntraceurs_zone,1:niso)
    1007         do izone=1,ntraceurs_zone
    1008           write(*,*) 'strtrac(',izone,')=',strtrac(izone)
    1009         enddo !do izone=1,ntraceurs_zone
    1010         write(*,*) 'ntracisoOR=',ntracisoOR
     664   WRITE(*,*) 'traceurs_init 65: bilan de l''init:'
     665   WRITE(*,*) 'index_zone = '//TRIM(strStack(int2str(index_zone(1:ntiso))))
     666   WRITE(*,*) 'index_iso  = '//TRIM(strStack(int2str(index_iso (1:ntiso))))
     667   DO izone=1,nzone
     668      WRITE(*,*)'itZonIso('//TRIM(int2str(izone))//',:) = '//strStack(int2str(itZonIso(izone,:)))
     669   END DO
     670   DO izone=1,nzone
     671      WRITE(*,*)'strtrac('//TRIM(int2str(izone))//',:) = '//TRIM(strtrac(izone))
     672   END DO
     673   WRITE(*,*) 'ntracisoOR=',ntracisoOR
    1011674#endif 
    1012675
    1013         end subroutine iso_traceurs_init
    1014 
     676END SUBROUTINE iso_traceurs_init
    1015677
    1016678END MODULE isotrac_mod

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

    r4300 r4325  
    11131113      USE isotrac_mod, only: use_bassin_atlantic,use_bassin_medit, &
    11141114&       use_bassin_indian,use_bassin_austral,use_bassin_pacific, &
    1115 &       use_bassin_merarabie,use_bassin_golfebengale,use_bassin_indiansud, &
    1116 &       use_bassin_tropics,use_bassin_midlats,use_bassin_hauteslats, &
     1115&       use_bassin_MerArabie,use_bassin_BengalGolf,use_bassin_SouthIndian, &
     1116&       use_bassin_tropics,use_bassin_midlats,use_bassin_HighLats, &
    11171117&       bassin_atlantic,bassin_medit, &
    11181118&       bassin_indian,bassin_austral,bassin_pacific, &
    1119 &       bassin_merarabie,bassin_golfebengale,bassin_indiansud, &
    1120 &       bassin_tropics,bassin_midlats,bassin_hauteslats
     1119&       bassin_MerArabie,bassin_BengalGolf,bassin_SouthIndian, &
     1120&       bassin_tropics,bassin_midlats,bassin_HighLats
    11211121      implicit none
    11221122      ! répond true si lat,lon se trouve dans le bassin numéroté bassin
    … …  
    11371137      write(*,*) 'is_in_basin 84: entree,bassin=',bassin
    11381138#endif
    1139       if ((use_bassin_atlantic.eq.1).and. &
    1140      &           (bassin.eq.bassin_atlantic)) then
     1139      if (use_bassin_atlantic .and. bassin==bassin_atlantic) then
    11411140#ifdef ISOVERIF           
    11421141          write(*,*) 'bassin Atlantique?'
    … …  
    11691168          endif
    11701169
    1171       else if ((use_bassin_medit.eq.1).and. &
    1172      &           (bassin.eq.bassin_medit)) then
     1170      else if (use_bassin_medit .and. bassin==bassin_medit) then
    11731171#ifdef ISOVERIF           
    11741172          write(*,*) 'bassin Medit?'
    … …  
    11831181          endif
    11841182
    1185       else if ((use_bassin_indian.eq.1).and. &
    1186      &           (bassin.eq.bassin_indian)) then
     1183      else if (use_bassin_indian .and. bassin==bassin_indian) then
    11871184#ifdef ISOVERIF           
    11881185          write(*,*) 'bassin indian?'
    … …  
    11991196          endif   
    12001197
    1201       else if ((use_bassin_indiansud.eq.1).and. &
    1202      &           (bassin.eq.bassin_indiansud)) then
     1198      else if (use_bassin_SouthIndian .and. bassin==bassin_SouthIndian) then
    12031199#ifdef ISOVERIF           
    12041200          write(*,*) 'bassin indian hemisphere Sud?'
    … …  
    12091205          endif
    12101206         
    1211       else if ((use_bassin_merarabie.eq.1).and. &
    1212      &           (bassin.eq.bassin_merarabie)) then
     1207      else if (use_bassin_MerArabie .and. bassin==bassin_MerArabie) then
    12131208#ifdef ISOVERIF           
    12141209          write(*,*) 'bassin Mer d''Arabie?'
    … …  
    12191214          endif
    12201215
    1221       else if ((use_bassin_golfebengale.eq.1).and. &
    1222      &           (bassin.eq.bassin_golfebengale)) then
     1216      else if (use_bassin_BengalGolf .and. bassin==bassin_BengalGolf) then
    12231217#ifdef ISOVERIF           
    12241218          write(*,*) 'bassin Golfe du Bengale?'
    … …  
    12291223          endif         
    12301224
    1231       else if ((use_bassin_pacific.eq.1).and. &
    1232      &           (bassin.eq.bassin_pacific)) then
     1225      else if (use_bassin_pacific .and. bassin==bassin_pacific) then
    12331226#ifdef ISOVERIF           
    12341227          write(*,*) 'bassin Pacific?'
    … …  
    12671260          endif
    12681261
    1269       else if ((use_bassin_austral.eq.1).and. &
    1270      &           (bassin.eq.bassin_austral)) then 
     1262      else if (use_bassin_austral .and. bassin==bassin_austral) then 
    12711263#ifdef ISOVERIF           
    12721264          write(*,*) 'bassin austral?'
    … …  
    12771269          endif 
    12781270
    1279       else if ((use_bassin_hauteslats.eq.1).and. &
    1280      &           (bassin.eq.bassin_hauteslats)) then 
     1271      else if (use_bassin_HighLats .and. bassin==bassin_HighLats) then 
    12811272#ifdef ISOVERIF           
    12821273          write(*,*) 'bassin hautes lats?'
    … …  
    12871278          endif
    12881279
    1289       else if ((use_bassin_tropics.eq.1).and. &
    1290      &           (bassin.eq.bassin_tropics)) then 
     1280      else if (use_bassin_tropics .and. bassin==bassin_tropics) then 
    12911281#ifdef ISOVERIF           
    12921282          write(*,*) 'bassin tropics?'
    … …  
    12971287          endif
    12981288
    1299        else if ((use_bassin_midlats.eq.1).and. &
    1300      &           (bassin.eq.bassin_midlats)) then 
     1289       else if (use_bassin_midlats .and. bassin==bassin_midlats) then 
    13011290#ifdef ISOVERIF           
    13021291          write(*,*) 'bassin mid lats?'
    … …  
    13141303          write(*,*) 'bassin_indian=' ,bassin_indian
    13151304          write(*,*) 'bassin_austral=' ,bassin_austral
    1316           write(*,*) 'bassin_merarabie=' ,bassin_merarabie
    1317           write(*,*) 'bassin_golfebengale=' ,bassin_golfebengale
    1318           write(*,*) 'bassin_indiansud=' ,bassin_indiansud
     1305          write(*,*) 'bassin_MerArabie=' ,bassin_MerArabie
     1306          write(*,*) 'bassin_BengalGolf=' ,bassin_BengalGolf
     1307          write(*,*) 'bassin_SouthIndian=' ,bassin_SouthIndian
    13191308          write(*,*) 'use_bassin_atlantic=' ,use_bassin_atlantic 
    13201309          write(*,*) 'use_bassin_medit=' ,use_bassin_medit
    13211310          write(*,*) 'use_bassin_indian=' ,use_bassin_indian
    13221311          write(*,*) 'use_bassin_austral=' ,use_bassin_austral
    1323           write(*,*) 'use_bassin_merarabie=' ,use_bassin_merarabie
    1324           write(*,*) 'use_bassin_golfebengale=' ,use_bassin_golfebengale
    1325           write(*,*) 'use_bassin_indiansud=' ,use_bassin_indiansud
     1312          write(*,*) 'use_bassin_MerArabie=' ,use_bassin_MerArabie
     1313          write(*,*) 'use_bassin_BengalGolf=' ,use_bassin_BengalGolf
     1314          write(*,*) 'use_bassin_SouthIndian=' ,use_bassin_SouthIndian
    13261315          stop
    13271316      endif
Note: See TracChangeset for help on using the changeset viewer.