source: LMDZ6/trunk/libf/phylmd/infotrac_phy.F90 @ 4143

Last change on this file since 4143 was 4143, checked in by dcugnet, 2 years ago
  • Some variables are renamed or replaced by direct equivalents:
    • iso_indnum -> tracers(:)%iso_iName
    • niso_possibles -> niso
    • iqiso -> iqIsoPha ; index_trac -> itZonIso
    • ok_iso_verif -> isoCheck
    • ntraceurs_zone -> nzone ; ntraciso -> ntiso
    • qperemin -> min_qparent ; masseqmin -> min_qmass ; ratiomin -> min_ratio
  • Some renamed variables are only aliased with the older name (using USE <module>, ONLY: <oldName> => <newName>) in routines where they are repeated many times.
  • Few hard-coded indexes are now computed (examples: ilic, iso, ivap, irneb, iq_vap, iq_liq, iso_H2O, iso_HDO, iso_HTO, iso_O17, iso_O18).
  • The IF(isoCheck) test is now embedded in the check_isotopes_seq and check_isotopes_loc routines (lighter calling).
File size: 16.9 KB
Line 
1
2! $Id: $
3
4MODULE infotrac_phy
5
6   USE       strings_mod, ONLY: msg, maxlen, strStack, strHead, strIdx, int2str
7   USE readTracFiles_mod, ONLY: trac_type, isot_type, keys_type, delPhase, getKey, tnom_iso => newH2OIso
8
9   IMPLICIT NONE
10
11   PRIVATE
12
13   !=== FOR TRACERS:
14   PUBLIC :: init_infotrac_phy                             !--- Initialization of the tracers
15   PUBLIC :: tracers, type_trac                            !--- Full tracers database, tracers type keyword
16   PUBLIC :: nqtot,   nbtr,   nqo,   nqCO2,   nqtottr      !--- Main dimensions
17   PUBLIC :: conv_flg, pbl_flg                             !--- Convection & boundary layer activation keys
18
19   !=== FOR ISOTOPES: General
20   PUBLIC :: isotopes,  nbIso                              !--- Derived type, full isotopes families database + nb of families
21   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
22   !=== FOR ISOTOPES: Specific to water
23   PUBLIC :: iH2O                                          !--- H2O isotopes index
24   !=== FOR ISOTOPES: Depending on the selected isotopes family
25   PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)
26   PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
27   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
28   PUBLIC :: itZonIso                                      !--- iq = function(tagging zone idx, isotope idx)
29   PUBLIC :: iqIsoPha                                      !--- idx of tagging tracer in iName = function(isotope idx, phase idx)
30   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
31   !=== FOR BOTH TRACERS AND ISOTOPES
32   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
33
34   INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
35
36!=== CONVENTIONS FOR TRACERS NUMBERS:
37!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
38!  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
39!  | phases: H2O_[gls]  |      isotopes         |                 |               |  for higher order schemes  |
40!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
41!  |                    |                       |                 |               |                            |
42!  |<--     nqo      -->|<-- nqo*niso* nzone -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|         
43!  |                    |                                         |                                            |
44!  |                    |<-- nqo*niso*(nzone+1)  =   nqo*ntiso -->|<--    nqtottr = nbtr + nmom             -->|
45!  |                                                                              = nqtot - nqo*(ntiso+1)      |
46!  |                                                                                                           |
47!  |<--                        nqtrue  =  nbtr + nqo*(ntiso+1)                 -->|                            |
48!  |                                                                                                           |
49!  |<--                        nqtot   =  nqtrue + nmom                                                     -->|
50!  |                                                                                                           |
51!  |-----------------------------------------------------------------------------------------------------------|
52!  NOTES FOR THIS TABLE:
53!  * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
54!    since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
55!  * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
56!  * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
57!
58!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
59!    Each entry is accessible using "%" sign.
60!  |-------------+------------------------------------------------------+-------------+------------------------+
61!  |  entry      | Meaning                                              | Former name | Possible values        |
62!  |-------------+------------------------------------------------------+-------------+------------------------+
63!  | name        | Name (short)                                         | tname       |                        |
64!  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |
65!  | parent      | Name of the parent                                   | /           |                        |
66!  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
67!  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
68!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
69!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
70!  | iadv        | Advection scheme number                              | iadv        | 1-20,30 exc. 3-9,15,19 |
71!  | iGeneration | Generation (>=1)                                     | /           |                        |
72!  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
73!  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
74!  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |
75!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
76!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
77!  | nqChilds    | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
78!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
79!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
80!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
81!  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
82!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
83!  +-------------+------------------------------------------------------+-------------+------------------------+
84!
85!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
86!    Each entry is accessible using "%" sign.
87!  |-----------------+--------------------------------------------------+--------------------+-----------------+
88!  |  entry | length | Meaning                                          |    Former name     | Possible values |
89!  |-----------------+--------------------------------------------------+--------------------+-----------------+
90!  | parent          | Parent tracer (isotopes family name)             |                    |                 |
91!  | keys   | niso   | Isotopes keys/values pairs list + number         |                    |                 |
92!  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
93!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
94!  | phase  | nphas  | Phases                     list + number         |                    | [g][l][s], 1:3  |
95!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
96!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
97!  +-----------------+--------------------------------------------------+--------------------+-----------------+
98
99   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
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                                    nbIso,  &                   !--- Number of available isotopes family
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
107!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nbIso, nqtottr, nqCO2, type_trac)
108
109   !=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
110   TYPE(trac_type), TARGET, SAVE, ALLOCATABLE ::  tracers(:)    !=== TRACERS DESCRIPTORS VECTOR
111   TYPE(isot_type), TARGET, SAVE, ALLOCATABLE :: isotopes(:)    !=== ISOTOPES PARAMETERS VECTOR
112!$OMP THREADPRIVATE(tracers, isotopes)
113
114   !=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
115   TYPE(isot_type),         SAVE, POINTER :: isotope            !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
116   INTEGER,                 SAVE          :: ixIso, iH2O        !--- Index of the selected isotopes family and H2O family
117   LOGICAL,                 SAVE, POINTER :: isoCheck           !--- Flag to trigger the checking routines
118   TYPE(keys_type),         SAVE, POINTER :: isoKeys(:)         !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
119   CHARACTER(LEN=maxlen),   SAVE, POINTER :: isoName(:),   &    !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
120                                             isoZone(:),   &    !--- TAGGING ZONES  FOR THE CURRENTLY SELECTED FAMILY
121                                             isoPhas            !--- USED PHASES    FOR THE CURRENTLY SELECTED FAMILY
122   INTEGER,                 SAVE, POINTER ::  niso, nzone, &    !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
123                                             nphas, ntiso, &    !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
124                                            itZonIso(:,:), &    !--- INDEX IN "isoTrac" AS f(tagging zone idx,  isotope idx)
125                                            iqIsoPha(:,:)       !--- INDEX IN "qx"      AS f(isotopic tracer idx, phase idx)
126!$OMP THREADPRIVATE(isotope, ixIso,iH2O, isoCheck, isoKeys, isoName,isoZone,isoPhas, niso,nzone,nphas,ntiso, itZonIso,iqIsoPha)
127
128   !=== VARIABLES FOR ISOTOPES INITIALIZATION AND FOR INCA
129   INTEGER,          SAVE,    ALLOCATABLE ::conv_flg(:),  &     !--- Convection     activation ; needed for INCA        (nbtr)
130                                             pbl_flg(:)         !--- Boundary layer activation ; needed for INCA        (nbtr)
131!$OMP THREADPRIVATE(conv_flg, pbl_flg)
132
133#ifdef CPP_StratAer
134  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
135  INTEGER, SAVE ::  nbtr_bin, nbtr_sulgas         !--- number of aerosols bins and sulfur gases for StratAer model
136!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
137  INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
138!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
139#endif
140
141CONTAINS
142
143SUBROUTINE init_infotrac_phy(type_trac_, tracers_, isotopes_, nqtottr_, nqCO2_, pbl_flg_, conv_flg_)
144
145   USE print_control_mod, ONLY: prt_level, lunout
146
147   IMPLICIT NONE
148   CHARACTER(LEN=*),INTENT(IN) :: type_trac_
149   TYPE(trac_type), INTENT(IN) ::  tracers_(:)
150   TYPE(isot_type), INTENT(IN) :: isotopes_(:)
151   INTEGER,         INTENT(IN) :: nqtottr_
152   INTEGER,         INTENT(IN) :: nqCO2_
153   INTEGER,         INTENT(IN) :: conv_flg_(:)
154   INTEGER,         INTENT(IN) ::  pbl_flg_(:)
155
156   INTEGER :: iq, ixt
157#ifdef CPP_StratAer
158   CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
159#endif
160   CHARACTER(LEN=maxlen) :: modname="init_infotrac_phy"
161
162   type_trac = type_trac_
163   tracers   = tracers_
164   isotopes  = isotopes_
165   nqtottr   = nqtottr_
166   nqCO2     = nqCO2_
167   pbl_flg   =  pbl_flg_
168   conv_flg  = conv_flg_
169   nqtot     = SIZE(tracers_)
170   nqo       = COUNT(delPhase(tracers%name)=='H2O' .AND. tracers%iGeneration==0 .AND. tracers%component=='lmdz')
171   nbtr      = SIZE(conv_flg)
172   nbIso     = SIZE(isotopes_)
173
174   !=== Determine selected isotopes class related quantities:
175   !    ixIso, isotope, niso,isoKeys, ntiso,isoName, nzone,isoZone, nphas,isoPhas, itZonIso, iqIsoPha, isoCheck
176   IF(.NOT.isoSelect('H2O')) iH2O = ixIso
177   IF(prt_level > 1) THEN
178      CALL msg('nqtot   = '//TRIM(int2str(nqtot)),   modname)
179      CALL msg('nbtr    = '//TRIM(int2str(nbtr )),   modname)
180      CALL msg('nqo     = '//TRIM(int2str(nqo  )),   modname)
181      CALL msg('niso    = '//TRIM(int2str(niso )),   modname)
182      CALL msg('ntiso   = '//TRIM(int2str(ntiso)),   modname)
183      CALL msg('nqtottr = '//TRIM(int2str(nqtottr)), modname)
184      CALL msg('nqCO2   = '//TRIM(int2str(nqCO2)),   modname)
185   END IF
186
187#ifdef CPP_StratAer
188   IF (type_trac == 'coag') THEN
189      nbtr_bin    = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
190      nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
191      tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
192      id_BIN01_strat = strIdx(tnames, 'BIN01'   )
193      id_OCS_strat   = strIdx(tnames, 'GASOSC'  )
194      id_SO2_strat   = strIdx(tnames, 'GASSO2'  )
195      id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
196      id_TEST_strat  = strIdx(tnames, 'GASTEST' )
197      CALL msg('nbtr_bin       ='//TRIM(int2str(nbtr_bin      )), modname)
198      CALL msg('nbtr_sulgas    ='//TRIM(int2str(nbtr_sulgas   )), modname)
199      CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
200      CALL msg('id_OCS_strat   ='//TRIM(int2str(id_OCS_strat  )), modname)
201      CALL msg('id_SO2_strat   ='//TRIM(int2str(id_SO2_strat  )), modname)
202      CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
203      CALL msg('id_TEST_strat  ='//TRIM(int2str(id_TEST_strat )), modname)
204   END IF
205#endif
206#ifdef ISOVERIF
207   CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
208#endif
209
210END SUBROUTINE init_infotrac_phy
211
212
213!==============================================================================================================================
214!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
215!     Single generic "isoSelect" routine, using the predefined index of the parent (fast version) or its name (first call).
216!==============================================================================================================================
217LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
218   IMPLICIT NONE
219   CHARACTER(LEN=*),  INTENT(IN)  :: iName
220   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
221   INTEGER :: iIso
222   LOGICAL :: lV
223   lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
224   iIso = strIdx(isotopes(:)%parent, iName)
225   lerr = iIso == 0
226   CALL msg('no isotope family named "'//TRIM(iName)//'"', ll=lerr .AND. lV)
227   IF(lerr) RETURN
228   lerr = isoSelectByIndex(iIso, lV)
229END FUNCTION isoSelectByName
230!==============================================================================================================================
231LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
232   IMPLICIT NONE
233   INTEGER,           INTENT(IN) :: iIso
234   LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
235   LOGICAL :: lv
236   lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
237   lerr = .FALSE.
238   IF(iIso == ixIso) RETURN                                      !--- Nothing to do if the index is already OK
239   lerr = iIso<=0 .OR. iIso>nbIso
240   CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '//TRIM(int2str(nbIso))//'"',&
241            ll=lerr .AND. lV)
242   IF(lerr) RETURN
243   ixIso = iIso                                                  !--- Update currently selected family index
244   isotope  => isotopes(ixIso)                                   !--- Select corresponding component
245   isoKeys  => isotope%keys;     niso     => isotope%niso
246   isoName  => isotope%trac;     ntiso    => isotope%ntiso
247   isoZone  => isotope%zone;     nzone    => isotope%nzone
248   isoPhas  => isotope%phase;    nphas    => isotope%nphas
249   itZonIso => isotope%itZonIso; isoCheck => isotope%check
250   iqIsoPha => isotope%iqIsoPha
251END FUNCTION isoSelectByIndex
252!==============================================================================================================================
253
254
255END MODULE infotrac_phy
Note: See TracBrowser for help on using the repository browser.