source: LMDZ6/branches/LMDZ-tracers/libf/phylmd/infotrac_phy.F90 @ 3891

MODULE infotrac_phy

  USE       strings_mod, ONLY: msg, fmsg, test, strIdx, int2str

  USE readTracFiles_mod, ONLY: getKey_init, getKey, indexUpdate, delPhase

  USE trac_types_mod,    ONLY: tra, iso, kys

  IMPLICIT NONE

  PRIVATE

  !=== FOR TRACERS:
  PUBLIC :: tra,   tracers,  type_trac                     !--- Derived type, full database, tracers type keyword
  PUBLIC :: nqtot,   nbtr,   nqo                           !--- Main dimensions
  PUBLIC :: init_infotrac_phy                              !--- Initialization
  PUBLIC :: itr_indice                                     !--- Indexes of the tracers passed to phytrac
  PUBLIC :: niadv                                          !--- Indexes of true tracers (<=nqtot, such that iadv(idx)>0)
  PUBLIC :: pbl_flg, conv_flg, solsym

  !=== FOR ISOTOPES: General
  !--- General
  PUBLIC :: iso, isotopes, nbIso                           !--- Derived type, full isotopes families database + nb of families
  PUBLIC :: isoSelect , ixIso                              !--- Isotopes family selection tool + selected family index
  !=== FOR ISOTOPES: Specific to H2O isotopes
  PUBLIC :: iH2O, tnat, alpha_ideal                        !--- H2O isotopes index, natural abundance, fractionning coeff.
  !=== FOR ISOTOPES: Depending on 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, nzon, npha, nitr                         !---  " " numbers + isotopes & tagging tracers number
  PUBLIC :: iZonIso, iTraPha                               !--- 2D index tables to get "iq" index
  PUBLIC :: isoCheck                                       !--- Run isotopes checking routines

  !=== FOR BOTH TRACERS AND ISOTOPES
  PUBLIC :: getKey                                         !--- Get a key from "tracers" or "isotope"

  !=== FOR STRATOSPHERIC AEROSOLS
#ifdef CPP_StratAer
  PUBLIC :: nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat
#endif

  INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect

!=== 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* nzon -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|         
!  |                    |                                        |                                            |
!  |                    |<-- nqo*niso*(nzon+1)  =   nqo*nitr  -->|<--    nqtottr = nbtr + nmom             -->|
!  |                                                                             = nqtot - nqo*(nitr+1)       |
!  |                                                                                                          |
!  |<--                        nqtrue  =  nbtr + nqo*(nitr+1)                 -->|                            |
!  |                                                                                                          |
!  |<--                        nqtot   =  nqtrue + nmom                                                    -->|
!  |                                                                                                          |
!  |----------------------------------------------------------------------------------------------------------|
! NOTES FOR THIS TABLE:
!  * The used "niso", "nzon" and "nitr" are the H2O components of "isotopes(ip)"  (isotopes(ip)%prnt == 'H2O'),
!    since water is so far the sole tracers family removed from the main tracers table.
!  * For water, "nqo" is equal to the more general field "isotopes(ip)%npha".
!  * "niso", "nzon", "nitr", "npha" are defined for other isotopic tracers families, if any.
!
!=== TRACERS DESCRIPTOR: DERIVED TYPE EMBEDDING MOST OF THE USEFUL QUANTITIES (LENGTH: nqtot)
!    Each entry is accessible using "%" sign.
!  |------------+-------------------------------------------------+-------------+------------------------+
!  |  entry     | Meaning                                         | Former name | Possible values        |
!  |------------+-------------------------------------------------+-------------+------------------------+
!  | name       | Name (short)                                    | tname       |                        |
!  | nam1       | Name of the 1st generation ancestor             | /           |                        |
!  | prnt       | Name of the parent                              | /           |                        |
!  | lnam       | Long name (with adv. scheme suffix) for outputs | ttext       |                        |
!  | type       | Type (so far: tracer or tag)                    | /           | tracer,tag             |
!  | phas       | Phases list ("g"as / "l"iquid / "s"olid)        | /           | [g][l][s]              |
!  | comp       | Name(s) of the merged/cumulated section(s)      | /           | coma-separated names   |
!  | iadv       | Advection scheme number                         | iadv        | 1-20,30 exc. 3-9,15,19 |
!  | igen       | Generation (>=1)                                | /           |                        |
!  | itr        | Index in "tr_seri" (0: absent from physics)     | cf. niadv   | 1:nqtottr              |
!  | iprnt      | Index of the parent tracer                      | iqpere      | 1:nqtot                |
!  | idesc      | Indexes of the childs (all generations)         | iqfils      | 1:nqtot                |
!  | ndesc      | Number of the descendants (all generations)     | nqdesc      | 1:nqtot                |
!  | nchld      | Number of childs (first generation only)        | nqfils      | 1:nqtot                |
!  | keys       | key/val pairs accessible with "getKey" routine  | /           |                        |
!  | iso_num    | Isotope name  index in iso(igr)%name(:)         | iso_indnum  | 1:niso                 |
!  | iso_zon    | Isotope zone  index in iso(igr)%zone(:)         | zone_num    | 1:nzon                 |
!  | iso_pha    | Isotope phase index in iso(igr)%phas            | phase_num   | 1:npha                 |
!  +------------+-------------------------------------------------+-------------+------------------------+
!
!=== ISOTOPES DESCRIPTOR: DERIVED TYPE EMBEDDING MOST OF THE USEFUL QUANTITIES (LENGTH: NUMBER OF ISOTOPES FAMILIES USED)
!    Each entry is accessible using "%" sign.
!  |------------+-------------------------------------------------+-------------+-----------------------+
!  |  entry     | Meaning                                         | Former name | Possible values       |
!  |------------+-------------------------------------------------+-------------+-----------------------+
!  | prnt       | Parent tracer (isotopes family name)            |             |                       |
!  | trac, nitr | Isotopes & tagging tracers + number of elements |             |                       |
!  | zone, nzon | Geographic tagging zones   + number of elements |             |                       |
!  | phas, npha | Phases list                + number of elements |             | [g][l][s], 1:3        |
!  | niso       | Number of isotopes, excluding tagging tracers   |             |                       |
!  | iTraPha    | Index in "xt" = f(iname(niso+1:nitr),iphas)     | iqiso       | 1:niso                |
!  | iZonIso    | Index in "xt" = f(izone, iname(1:niso))         | index_trac  | 1:nzon                |
!  |------------+-------------------------------------------------+-------------+-----------------------+

  !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
  INTEGER,            SAVE :: nqtot, &                     !--- Tracers nb in dynamics (incl. higher moments & water)
                              nbtr,  &                     !--- Tracers nb in physics  (excl. higher moments & water)
                              nqo,   &                     !--- Number of water phases
                              nbIso                        !--- Number of available isotopes family
  CHARACTER(LEN=256), SAVE :: type_trac                    !--- Keyword for tracers type
!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, type_trac)

  !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
  TYPE(tra), TARGET,  SAVE, ALLOCATABLE ::  tracers(:)     !=== TRACERS DESCRIPTORS VECTOR
  TYPE(iso), TARGET,  SAVE, ALLOCATABLE :: isotopes(:)     !=== ISOTOPES PARAMETERS VECTOR
!$OMP THREADPRIVATE(tracers, isotopes)

  !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
  TYPE(iso),          SAVE, POINTER     :: isotope         !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
  INTEGER,            SAVE              :: ixIso, iH2O     !--- Index of the selected isotopes family and H2O family
  LOGICAL,            SAVE              :: isoCheck        !--- Flag to trigger the checking routines
  TYPE(kys),          SAVE, POINTER     :: isoKeys(:)      !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
  CHARACTER(LEN=256), SAVE, POINTER     :: isoName(:),   & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
                                           isoZone(:),   & !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
                                           isoPhas         !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
  INTEGER,            SAVE              :: niso, nzon,   & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
                                           npha, nitr      !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
  INTEGER,            SAVE, POINTER     :: iZonIso(:,:)    !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
  INTEGER,            SAVE, POINTER     :: iTraPha(:,:)    !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase)
!$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzon,npha,nitr, iZonIso,iTraPha)

  !=== VARIABLES EMBEDDED IN "tracers", BUT DUPLICATED, AS THEY ARE RATHER FREQUENTLY USED + VARIABLES FOR INCA
  REAL,               SAVE, ALLOCATABLE ::     tnat(:),  & !--- Natural relative abundance of water isotope        (niso)
                                        alpha_ideal(:)     !--- Ideal fractionning coefficient (for initial state) (niso)
  INTEGER,            SAVE, ALLOCATABLE :: conv_flg(:),  & !--- Convection     activation ; needed for INCA        (nbtr)
                                            pbl_flg(:),  & !--- Boundary layer activation ; needed for INCA        (nbtr)
                                         itr_indice(:),  & !--- Indexes of the tracers passed to phytrac        (nqtottr)
                                              niadv(:)     !--- Indexes of true tracers  (<=nqtot, such that iadv(idx)>0)
  CHARACTER(LEN=8),   SAVE, ALLOCATABLE ::   solsym(:)     !--- Names from INCA                                    (nbtr)
!OMP THREADPRIVATE(tnat, alpha_ideal, conv_flg, pbl_flg, itr_indice, niadv, solsym)

#ifdef CPP_StratAer
  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
  INTEGER, SAVE :: nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat
!OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat)
#endif

CONTAINS

SUBROUTINE init_infotrac_phy(tracers_, isotopes_, type_trac_, solsym_, nbtr_, niadv_, pbl_flg_, conv_flg_)
  ! transfer information on tracers from dynamics to physics
  USE print_control_mod, ONLY: prt_level, lunout
  IMPLICIT NONE
  TYPE(tra),        INTENT(IN) ::  tracers_(:)
  TYPE(iso),        INTENT(IN) :: isotopes_(:)
  CHARACTER(LEN=*), INTENT(IN) :: type_trac_, solsym_(:)
  INTEGER,          INTENT(IN) :: nbtr_, niadv_(:), pbl_flg_(:), conv_flg_(:)

  CHARACTER(LEN=256) :: modname="init_infotrac_phy"
  LOGICAL :: lerr

  tracers   = tracers_
  isotopes  = isotopes_
  type_trac = type_trac_
  solsym    = solsym_
  nqtot     = SIZE(tracers_)
  nqo       = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%igen==1)
  nbtr      = nbtr_
  niadv     = niadv_
  nbIso     = SIZE(isotopes_)
  pbl_flg  = pbl_flg_
  conv_flg = conv_flg_

  CALL msg('nqtot = '//TRIM(int2str(nqtot)))
  CALL msg('nbtr  = '//TRIM(int2str(nbtr)))
  CALL msg('nqo   = '//TRIM(int2str(nqo)))

  !=== Specific to water
  CALL getKey_init(tracers, isotopes)
  IF(.NOT.isoSelect('H2O')) THEN
    iH2O = ixIso
    lerr = getKey('tnat' ,tnat,        isoName(1:isotope%niso))
    lerr = getKey('alpha',alpha_ideal, isoName(1:isotope%niso))
  END IF
  itr_indice = PACK(tracers(:)%itr, MASK = tracers(:)%itr/=0)
  !? CDC isoInit => A VOIR !!

#ifdef CPP_StratAer
  IF (type_trac == 'coag') THEN
    nbtr_bin=0
    nbtr_sulgas=0
    DO iq = 1, nqtrue
      IF(tracers(iq)%name(1:3)=='BIN') nbtr_bin    = nbtr_bin   +1
      IF(tracers(iq)%name(1:3)=='GAS') nbtr_sulgas = nbtr_sulgas+1
      SELECT CASE(tracers(iq)%name)
        CASE('BIN01');    id_BIN01_strat = iq - nqo; CALL msg('id_BIN01_strat=', id_BIN01_strat)
        CASE('GASOCS');   id_OCS_strat   = iq - nqo; CALL msg('id_OCS_strat  =', id_OCS_strat)
        CASE('GASSO2');   id_SO2_strat   = iq - nqo; CALL msg('id_SO2_strat  =', id_SO2_strat)
        CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat)
        CASE('GASTEST');  id_TEST_strat  = iq - nqo; CALL msg('id_TEST_strat =', id_TEST_strat)
      END SELECT
    END DO
    CALL msg('nbtr_bin      =',nbtr_bin)
    CALL msg('nbtr_sulgas   =',nbtr_sulgas)
  END IF
#endif

END SUBROUTINE init_infotrac_phy


!==============================================================================================================================
!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
!     Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first call).
!==============================================================================================================================
LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
  IMPLICIT NONE
  CHARACTER(LEN=*),  INTENT(IN)  :: iName
  LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
  INTEGER :: iIso
  LOGICAL :: lV
  lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
  iIso = strIdx(isotopes(:)%prnt, iName)
  lerr = iIso == 0
  CALL msg(lerr .AND. lV, 'no isotope family named "'//TRIM(iName)//'"')
  IF(lerr) RETURN
  lerr = isoSelectByIndex(iIso)
END FUNCTION isoSelectByName
!==============================================================================================================================
LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
  IMPLICIT NONE
  INTEGER,           INTENT(IN) :: iIso
  LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
  LOGICAL :: lv
  lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
  lerr = .FALSE.
  IF(iIso == ixIso) RETURN                                      !--- Nothing to do if the index is already OK
  lerr = iIso<=0 .OR. iIso>nbIso
  CALL msg(lerr .AND. lV, 'Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= ' &
                                                               //TRIM(int2str(nbIso))//'"')
  IF(lerr) RETURN
  ixIso = iIso                                                  !--- Update currently selected family index
  isotope => isotopes(ixIso)                                    !--- Select corresponding component
  isoKeys => isotope%keys;    niso     = isotope%niso
  isoName => isotope%trac;    nitr     = isotope%nitr
  isoZone => isotope%zone;    nzon     = isotope%nzon
  isoPhas => isotope%phas;    npha     = isotope%npha
  iZonIso => isotope%iZonIso; isoCheck = isotope%check
  iTraPha => isotope%iTraPha
END FUNCTION isoSelectByIndex
!==============================================================================================================================

END MODULE infotrac_phy