!$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $

!

MODULE infotrac_phy

   USE       strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx

   USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nzone, tran0, isoZone, &

        delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &

        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName

   IMPLICIT NONE

   PRIVATE

   !=== FOR TRACERS:

   PUBLIC :: init_infotrac_phy                             !--- Initialization of the tracers

   PUBLIC :: tracers, type_trac                            !--- Full tracers database, tracers type keyword

   PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions

   PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys

#ifdef CPP_StratAer

   PUBLIC :: nbtr_bin, nbtr_sulgas                         !--- Number of aerosols bins and sulfur gases for StratAer model

   PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat

#endif

   !=== FOR ISOTOPES: General

   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families

   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index

   !=== FOR ISOTOPES: Specific to water

   PUBLIC :: iH2O                                          !--- H2O isotopes class index

   !=== FOR ISOTOPES: Depending on the selected isotopes family

   PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)

   PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases

   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number

   PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)

   PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases

   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines

   !=== FOR BOTH TRACERS AND ISOTOPES

   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"

!=== CONVENTIONS FOR TRACERS NUMBERS:

!  |--------------------+-----------------------+-----------------+---------------+----------------------------|

!  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |

!  | phases: H2O_[gls]  |      isotopes         |                 |               |  for higher order schemes  |

!  |--------------------+-----------------------+-----------------+---------------+----------------------------|

!  |                    |                       |                 |               |                            |

!  |<--     nqo      -->|<-- nqo*niso* nzone -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|

!  |                    |                                         |                                            |

!  |                    |<-- nqo*niso*(nzone+1)  =   nqo*ntiso -->|<--    nqtottr = nbtr + nmom             -->|

!  |                                                                              = nqtot - nqo*(ntiso+1)      |

!  |                                                                                                           |

!  |<--                        nqtrue  =  nbtr + nqo*(ntiso+1)                 -->|                            |

!  |                                                                                                           |

!  |<--                        nqtot   =  nqtrue + nmom                                                     -->|

!  |                                                                                                           |

!  |-----------------------------------------------------------------------------------------------------------|

!  NOTES FOR THIS TABLE:

!  * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),

!    since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.

!  * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".

!  * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.

!

!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)

!    Each entry is accessible using "%" sign.

!  |-------------+------------------------------------------------------+-------------+------------------------+

!  |  entry      | Meaning                                              | Former name | Possible values        |

!  |-------------+------------------------------------------------------+-------------+------------------------+

!  | name        | Name (short)                                         | tname       |                        |

!  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |

!  | parent      | Name of the parent                                   | /           |                        |

!  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |

!  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |

!  | phase       | Phases list ("g"as / "l"iquid / "s"olid / "b"lowing) | /           | [g][l][s][b]           |

!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |

!  | iGeneration | Generation (>=1)                                     | /           |                        |

!  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |

!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |

!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |

!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |

!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |

!  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |

!  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |

!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |

!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |

!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |

!  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |

!  +-------------+------------------------------------------------------+-------------+------------------------+

!

!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)

!    Each entry is accessible using "%" sign.

!  |-----------------+--------------------------------------------------+--------------------+-----------------+

!  |  entry | length | Meaning                                          |    Former name     | Possible values |

!  |-----------------+--------------------------------------------------+--------------------+-----------------+

!  | parent          | Parent tracer (isotopes family name)             |                    |                 |

!  | keys   | niso   | Isotopes keys/values pairs list + number         |                    |                 |

!  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |

!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |

!  | phase  | nphas  | Phases                     list + number         |                    |[g][l][s][b] 1:4 |

!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |

!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |

!  +-----------------+--------------------------------------------------+--------------------+-----------------+

   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES

   INTEGER,               SAVE :: nqtot,  &                     !--- Tracers nb in dynamics (incl. higher moments + H2O)

                                  nbtr,   &                     !--- Tracers nb in physics  (excl. higher moments + H2O)

                                  nqo,    &                     !--- Number of water phases

                                  nqtottr, &                    !--- Number of tracers passed to phytrac (TO BE DELETED ?)

                                  nqCO2                         !--- Number of tracers of CO2  (ThL)

   CHARACTER(LEN=maxlen), SAVE :: type_trac                     !--- Keyword for tracers type(s)

!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)

   !=== VARIABLES FOR INCA

   INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)

                                                pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)

!$OMP THREADPRIVATE(conv_flg, pbl_flg)

#ifdef CPP_StratAer

  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)

  INTEGER, SAVE ::  nbtr_bin, nbtr_sulgas         !--- number of aerosols bins and sulfur gases for StratAer model

!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)

  INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat

!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)

#endif

CONTAINS

   USE ioipsl_getin_p_mod, ONLY: getin_p

#ifdef REPROBUS

   USE CHEM_REP, ONLY: Init_chem_rep_trac

#endif

   IMPLICIT NONE

!==============================================================================================================================

!

!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin

!   -------

!

!   Modifications:

!   --------------

!   05/94: F.Forget      Modif special traceur

!   02/02: M-A Filiberti Lecture de traceur.def

!   01/22: D. Cugnet     Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)

!

!   Objet:

!   ------

!   GCM LMD nouvelle grille

!

!==============================================================================================================================

!   ... modification de l'integration de q ( 26/04/94 ) ....

!------------------------------------------------------------------------------------------------------------------------------

! Declarations:

   INCLUDE "dimensions.h"

   INCLUDE "iniprint.h"

!------------------------------------------------------------------------------------------------------------------------------

! Local variables

#ifdef INCA

   INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA

                           vad (:), vadv_inca(:),  pbl_flg_inca(:)

   CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA

   INTEGER :: nqINCA

#endif

#ifdef CPP_StratAer

   CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)

#endif

   CHARACTER(LEN=2)      ::   suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)

   CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags

   CHARACTER(LEN=maxlen) :: msg1, texp, ttp                          !--- String for messages and expanded tracers type

   INTEGER :: fType                                                  !--- Tracers description file type ; 0: none

                                                                     !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"

   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)

   INTEGER :: iad                                                    !--- Advection scheme number

   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables

   LOGICAL :: lerr, ll, lInit

   CHARACTER(LEN=1) :: p

   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)

   TYPE(trac_type), POINTER             :: t1, t(:)

   INTEGER :: ierr

   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"

!------------------------------------------------------------------------------------------------------------------------------

! Initialization :

!------------------------------------------------------------------------------------------------------------------------------

!##############################################################################################################################

!##############################################################################################################################

   !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION

   END SELECT

   !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS

      CASE('inca', 'inco')

#ifndef INCA

#endif

      CASE('repr')

#ifndef REPROBUS

#endif

      CASE('coag')

#ifndef CPP_StratAer

#endif

   END SELECT

!##############################################################################################################################

   END IF

!##############################################################################################################################

!==============================================================================================================================

! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)

!==============================================================================================================================

   !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE

!##############################################################################################################################

   ELSE

   END IF

!##############################################################################################################################

   !---------------------------------------------------------------------------------------------------------------------------

   !---------------------------------------------------------------------------------------------------------------------------

   !---------------------------------------------------------------------------------------------------------------------------

#ifdef INCA

      nqo = SIZE(tracers) - nqCO2

      CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA

      nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac

      nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers

      IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)

      ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))

      ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))

      CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)

      ALLOCATE(ttr(nqtrue))

      ttr(1:nqo+nqCO2)                  = tracers

      ttr(1    :      nqo   )%component = 'lmdz'

      ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'

      ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'

      ttr(1+nqo      :nqtrue)%name      = [('CO2     ', k=1, nqCO2), solsym_inca]

      ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0

      ttr(1+nqo+nqCO2:nqtrue)%phase     = 'g'

      lerr = getKey('hadv', had, ky=tracers(:)%keys)

      lerr = getKey('vadv', vad, ky=tracers(:)%keys)

      hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca

      vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca

      CALL MOVE_ALLOC(FROM=ttr, TO=tracers)

      DO iq = 1, nqtrue

         t1 => tracers(iq)

         CALL addKey('name',      t1%name,      t1%keys)

         CALL addKey('component', t1%component, t1%keys)

         CALL addKey('parent',    t1%parent,    t1%keys)

         CALL addKey('phase',     t1%phase,     t1%keys)

      END DO

      IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name

      DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)

#endif

   !---------------------------------------------------------------------------------------------------------------------------

   ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)

   !---------------------------------------------------------------------------------------------------------------------------

      nqo    =        COUNT(delPhase(tracers(:)%name)     == 'H2O' &

      nbtr   = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &

#ifdef INCA

      nqINCA = COUNT(tracers(:)%component == 'inca')

#endif

   !---------------------------------------------------------------------------------------------------------------------------

   END IF

   !---------------------------------------------------------------------------------------------------------------------------

   !--- Transfert the number of tracers to Reprobus

#ifdef REPROBUS

   CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)

#endif

!##############################################################################################################################

!##############################################################################################################################

!==============================================================================================================================

! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).

!==============================================================================================================================

   END DO

   nqtot =    COUNT( hadv< 20 .AND. vadv< 20 ) &                     !--- No additional tracer

         +  4*COUNT( hadv==20 .AND. vadv==20 ) &                     !--- 3  additional tracers

   !--- More tracers due to the choice of advection scheme => assign total number of tracers

   END IF

!==============================================================================================================================

! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected

!==============================================================================================================================

      !--- VERIFY THE CHOICE OF ADVECTION SCHEME

      iad = -1

      !--- SET FIELDS %longName, %isAdvected, %isInPhysics

      t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &

      !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY

      nm = 0

   END DO

   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen

!##############################################################################################################################

   END IF

!##############################################################################################################################

!##############################################################################################################################

!##############################################################################################################################

!##############################################################################################################################

   ELSE

!##############################################################################################################################

   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES

!##############################################################################################################################

   END IF

!##############################################################################################################################

   !--- Convection / boundary layer activation for all tracers

   !--- Note: nqtottr can differ from nbtr when nmom/=0

   !=== DISPLAY THE RESULTS

#ifdef INCA

   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)

   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)

#endif

      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ',           &

                 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &

      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&

      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &

                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &

   ELSE

   END IF

#ifdef ISOVERIF

   CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)

#endif

#ifdef CPP_StratAer

   IF (type_trac == 'coag') THEN

      nbtr_bin    = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])

      nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])

      tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)

      id_BIN01_strat = strIdx(tnames, 'BIN01'   )

      id_OCS_strat   = strIdx(tnames, 'GASOCS'  )

      id_SO2_strat   = strIdx(tnames, 'GASSO2'  )

      id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')

      id_TEST_strat  = strIdx(tnames, 'GASTEST' )

      CALL msg('nbtr_bin       ='//TRIM(int2str(nbtr_bin      )), modname)

      CALL msg('nbtr_sulgas    ='//TRIM(int2str(nbtr_sulgas   )), modname)

      CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)

      CALL msg('id_OCS_strat   ='//TRIM(int2str(id_OCS_strat  )), modname)

      CALL msg('id_SO2_strat   ='//TRIM(int2str(id_SO2_strat  )), modname)

      CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)

      CALL msg('id_TEST_strat  ='//TRIM(int2str(id_TEST_strat )), modname)

   END IF

#endif

END MODULE infotrac_phy