source: LMDZ6/branches/LMDZ_ECRad/libf/dyn3d_common/infotrac.F90 @ 5403

Last change on this file since 5403 was 4727, checked in by idelkadi, 14 months ago

Merged trunk changes -r4488:4726 LMDZ_ECRad branch

  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:keywords set to Id
File size: 27.8 KB
Line 
1!$Id: infotrac.F90 4727 2023-10-19 14:02:57Z abarral $
2!
3MODULE infotrac
4
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, nzone, tran0, isoZone, &
7        delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
8        addPhase, iH2O, addKey, isoSelect, testTracersFiles, isoKeys, indexUpdate,   isoCheck, nbIso, ntiso, isoName
9   IMPLICIT NONE
10
11   PRIVATE
12
13   !=== FOR TRACERS:
14   PUBLIC :: init_infotrac                                 !--- 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 :: isot_type, 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 class index
24   PUBLIC :: min_qParent, min_qMass, min_ratio             !--- Min. values for various isotopic quantities
25   !=== FOR ISOTOPES: Depending on the selected isotopes family
26   PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)
27   PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
28   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
29   PUBLIC :: itZonIso                                      !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
30   PUBLIC :: iqIsoPha                                      !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
31   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
32   !=== FOR BOTH TRACERS AND ISOTOPES
33   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
34
35!=== CONVENTIONS FOR TRACERS NUMBERS:
36!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
37!  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
38!  | phases: H2O_[glsb] |      isotopes         |                 |               |  for higher order schemes  |
39!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
40!  |                    |                       |                 |               |                            |
41!  |<--     nqo      -->|<-- nqo*niso* nzone -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|         
42!  |                    |                                         |                                            |
43!  |                    |<-- nqo*niso*(nzone+1)  =   nqo*ntiso -->|<--    nqtottr = nbtr + nmom             -->|
44!  |                                                                              = nqtot - nqo*(ntiso+1)      |
45!  |                                                                                                           |
46!  |<--                        nqtrue  =  nbtr + nqo*(ntiso+1)                 -->|                            |
47!  |                                                                                                           |
48!  |<--                        nqtot   =  nqtrue + nmom                                                     -->|
49!  |                                                                                                           |
50!  |-----------------------------------------------------------------------------------------------------------|
51!  NOTES FOR THIS TABLE:
52!  * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
53!    since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
54!  * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
55!  * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
56!
57!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
58!    Each entry is accessible using "%" sign.
59!  |-------------+------------------------------------------------------+-------------+------------------------+
60!  |  entry      | Meaning                                              | Former name | Possible values        |
61!  |-------------+------------------------------------------------------+-------------+------------------------+
62!  | name        | Name (short)                                         | tname       |                        |
63!  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |
64!  | parent      | Name of the parent                                   | /           |                        |
65!  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
66!  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
67!  | phase       | Phases list ("g"as / "l"iquid / "s"olid / "b"lowing) | /           | [g][l][s][b]           |
68!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
69!  | iGeneration | Generation (>=1)                                     | /           |                        |
70!  | iqParent    | Index of the parent tracer                           | iqpere      | 1:nqtot                |
71!  | iqDescen    | Indexes of the childs       (all generations)        | iqfils      | 1:nqtot                |
72!  | nqDescen    | Number of the descendants   (all generations)        | nqdesc      | 1:nqtot                |
73!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
74!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
75!  | iadv        | Advection scheme number                              | iadv        | 1,2,10-20(exc.15,19),30|
76!  | isAdvected  | advected tracers flag (.TRUE. if iadv >= 0)          | /           | nqtrue  .TRUE. values  |
77!  | isInPhysics | tracers not extracted from the main table in physics | /           | nqtottr .TRUE. values  |
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!  +-------------+------------------------------------------------------+-------------+------------------------+
83!
84!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
85!    Each entry is accessible using "%" sign.
86!  |-----------------+--------------------------------------------------+--------------------+-----------------+
87!  |  entry | length | Meaning                                          |    Former name     | Possible values |
88!  |-----------------+--------------------------------------------------+--------------------+-----------------+
89!  | parent          | Parent tracer (isotopes family name)             |                    |                 |
90!  | keys   | niso   | Isotopes keys/values pairs list + number         |                    |                 |
91!  | trac   | ntiso  | Isotopes + tagging tracers list + number         | / | ntraciso       |                 |
92!  | zone   | nzone  | Geographic tagging zones   list + number         | / | ntraceurs_zone |                 |
93!  | phase  | nphas  | Phases                     list + number         |                    |[g][l][s][b],1:4 |
94!  | iqIsoPha        | Index in "qx"           = f(name(1:ntiso)),phas) | iqiso              | 1:nqtot         |
95!  | itZonIso        | Index in "trac(1:ntiso)"= f(zone, name(1:niso))  | index_trac         | 1:ntiso         |
96!  +-----------------+--------------------------------------------------+--------------------+-----------------+
97
98   REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
99
100   !=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
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
107
108   !=== VARIABLES FOR INCA
109   INTEGER,               SAVE, ALLOCATABLE :: conv_flg(:), &   !--- Convection     activation ; needed for INCA        (nbtr)
110                                                pbl_flg(:)      !--- Boundary layer activation ; needed for INCA        (nbtr)
111
112CONTAINS
113
114SUBROUTINE init_infotrac
115   USE control_mod, ONLY: planet_type
116#ifdef REPROBUS
117   USE CHEM_REP,    ONLY: Init_chem_rep_trac
118#endif
119   IMPLICIT NONE
120!==============================================================================================================================
121!
122!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
123!   -------
124!
125!   Modifications:
126!   --------------
127!   05/94: F.Forget      Modif special traceur
128!   02/02: M-A Filiberti Lecture de traceur.def
129!   01/22: D. Cugnet     Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
130!
131!   Objet:
132!   ------
133!   GCM LMD nouvelle grille
134!
135!==============================================================================================================================
136!   ... modification de l'integration de q ( 26/04/94 ) ....
137!------------------------------------------------------------------------------------------------------------------------------
138! Declarations:
139   INCLUDE "dimensions.h"
140   INCLUDE "iniprint.h"
141
142!------------------------------------------------------------------------------------------------------------------------------
143! Local variables
144   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
145#ifdef INCA
146   INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
147                           vad (:), vadv_inca(:),  pbl_flg_inca(:)
148   CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
149   INTEGER :: nqINCA
150#endif
151   CHARACTER(LEN=2)      ::   suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
152   CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags
153   CHARACTER(LEN=maxlen) :: msg1, texp, ttp                          !--- Strings for messages and expanded tracers type
154   INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
155                                                                     !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
156   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
157   INTEGER :: iad                                                    !--- Advection scheme number
158   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
159   LOGICAL :: lerr, ll
160   CHARACTER(LEN=1) :: p
161   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
162   TYPE(trac_type), POINTER             :: t1, t(:)
163   INTEGER :: ierr
164   CHARACTER(LEN=maxlen),   ALLOCATABLE :: types_trac(:)  !--- Keyword for tracers type(s), parsed version
165
166   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
167!------------------------------------------------------------------------------------------------------------------------------
168! Initialization :
169!------------------------------------------------------------------------------------------------------------------------------
170   suff          = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
171   descrq( 1:30) =  '   '
172   descrq( 1: 2) = ['LMV','BAK']
173   descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH','   ','PPM','PPS','PPP','   ','SLP']
174   descrq(30)    =  'PRA'
175   
176   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
177
178   lerr=strParse(type_trac, '|', types_trac, n=nt)
179   IF (nt .GT. 1) THEN
180      IF (nt .GT. 2) CALL abort_gcm(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
181      if (nt .EQ. 2) type_trac=types_trac(2)
182   ENDIF
183
184
185   
186   !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
187   msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
188   SELECT CASE(type_trac)
189      CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model',        modname)
190      CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle',  modname)
191      CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model',    modname)
192      CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle',     modname)
193      CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
194      CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only',          modname)
195      CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
196   END SELECT
197
198   !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
199   SELECT CASE(type_trac)
200      CASE('inca', 'inco')
201#ifndef INCA
202         CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
203#endif
204      CASE('repr')
205#ifndef REPROBUS
206         CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
207#endif
208      CASE('coag')
209#ifndef CPP_StratAer
210         CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
211#endif
212   END SELECT
213
214   nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
215
216!==============================================================================================================================
217! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
218!==============================================================================================================================
219   texp = type_trac                                                  !=== EXPANDED VERSION OF "type_trac", WITH "|" SEPARATOR
220   IF(texp == 'inco') texp = 'co2i|inca'
221   IF(texp /= 'lmdz') texp = 'lmdz|'//TRIM(texp)
222
223   !=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
224   IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
225   ttp = type_trac; IF(fType /= 1) ttp = texp
226
227   IF(readTracersFiles(ttp, type_trac == 'repr'))     CALL abort_gcm(modname, 'problem with tracers file(s)',1)
228   !---------------------------------------------------------------------------------------------------------------------------
229   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
230   !---------------------------------------------------------------------------------------------------------------------------
231   IF(fType == 1 .AND. ANY(['inca','inco']==type_trac)) THEN         !=== FOUND OLD STYLE INCA "traceur.def"
232   !---------------------------------------------------------------------------------------------------------------------------
233#ifdef INCA
234      nqo = SIZE(tracers) - nqCO2
235      CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
236      nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
237      nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
238      IF(ALL([2,3,4,5] /= nqo)) CALL abort_gcm(modname, 'Only 2, 3, 4 , 5 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
239      ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
240      ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
241      CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
242      ALLOCATE(ttr(nqtrue))
243      ttr(1:nqo+nqCO2)                  = tracers
244      ttr(1    :      nqo   )%component = 'lmdz'
245      ttr(1+nqo:nqCO2+nqo   )%component = 'co2i'
246      ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
247      ttr(1+nqo      :nqtrue)%name      = [('CO2     ', k=1, nqCO2), solsym_inca]
248      ttr(1+nqo+nqCO2:nqtrue)%parent    = tran0
249      ttr(1+nqo+nqCO2:nqtrue)%phase     = 'g'
250      lerr = getKey('hadv', had, ky=tracers(:)%keys)
251      lerr = getKey('vadv', vad, ky=tracers(:)%keys)
252      hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
253      vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
254      CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
255      DO iq = 1, nqtrue
256         t1 => tracers(iq)
257         CALL addKey('name',      t1%name,      t1%keys)
258         CALL addKey('component', t1%component, t1%keys)
259         CALL addKey('parent',    t1%parent,    t1%keys)
260         CALL addKey('phase',     t1%phase,     t1%keys)
261      END DO
262      IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name
263      DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
264#endif
265   !---------------------------------------------------------------------------------------------------------------------------
266   ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
267   !---------------------------------------------------------------------------------------------------------------------------
268      nqo    =        COUNT(delPhase(tracers(:)%name)     == 'H2O' &
269                               .AND. tracers(:)%component == 'lmdz') !--- Number of water phases
270      nqtrue = SIZE(tracers)                                         !--- Total number of "true" tracers
271      nbtr   = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
272                               .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
273#ifdef INCA
274      nqINCA = COUNT(tracers(:)%component == 'inca')
275#endif
276      lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
277      lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
278   !---------------------------------------------------------------------------------------------------------------------------
279   END IF
280   !---------------------------------------------------------------------------------------------------------------------------
281
282#ifdef REPROBUS
283   !--- Transfert the number of tracers to Reprobus
284   CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
285
286#endif
287!==============================================================================================================================
288! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
289!==============================================================================================================================
290   DO iq = 1, nqtrue
291      IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
292      WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
293      CALL abort_gcm(modname, TRIM(msg1), 1)
294   END DO
295   nqtot =    COUNT( hadv< 20 .AND. vadv< 20 ) &                     !--- No additional tracer
296         +  4*COUNT( hadv==20 .AND. vadv==20 ) &                     !--- 3  additional tracers
297         + 10*COUNT( hadv==30 .AND. vadv==30 )                       !--- 9  additional tracers
298
299   !--- More tracers due to the choice of advection scheme => assign total number of tracers
300   IF( nqtot /= nqtrue ) THEN
301      CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
302      CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
303      CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
304   END IF
305
306!==============================================================================================================================
307! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
308!     iadv = 1    "LMDZ-specific humidity transport" (for H2O vapour)          LMV
309!     iadv = 2    backward                           (for H2O liquid)          BAK
310!     iadv = 14   Van-Leer + specific humidity, modified by Francis Codron     VLH
311!     iadv = 10   Van-Leer (chosen for vapour and liquid water)                VL1
312!     iadv = 11   Van-Leer for hadv and PPM version (Monotonic) for vadv       VLP
313!     iadv = 12   Frederic Hourdin I                                           FH1
314!     iadv = 13   Frederic Hourdin II                                          FH2
315!     iadv = 16   Monotonic         PPM (Collela & Woodward 1984)              PPM
316!     iadv = 17   Semi-monotonic    PPM (overshoots allowed)                   PPS
317!     iadv = 18   Definite positive PPM (overshoots and undershoots allowed)   PPP
318!     iadv = 20   Slopes                                                       SLP
319!     iadv = 30   Prather                                                      PRA
320!
321!        In array q(ij,l,iq) : iq = 1/2[/3]    for vapour/liquid[/ice] water
322!        And optionaly:        iq = 3[4],nqtot for other tracers
323!==============================================================================================================================
324   ALLOCATE(ttr(nqtot))
325   jq = nqtrue+1; tracers(:)%iadv = -1
326   DO iq = 1, nqtrue
327      t1 => tracers(iq)
328
329      !--- VERIFY THE CHOICE OF ADVECTION SCHEME
330      iad = -1
331      IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
332      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
333      WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
334      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
335
336      !--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics
337      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
338      t1%iadv       = iad
339      t1%isAdvected = iad >= 0
340      t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
341                          .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
342      ttr(iq)       = t1
343
344      !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
345      nm = 0
346      IF(iad == 20) nm = 3                                           !--- 2nd order scheme
347      IF(iad == 30) nm = 9                                           !--- 3rd order scheme
348      IF(nm == 0) CYCLE                                              !--- No higher moments
349      ttr(jq+1:jq+nm)             = t1
350      ttr(jq+1:jq+nm)%name        = [(TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
351      ttr(jq+1:jq+nm)%parent      = [(TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
352      ttr(jq+1:jq+nm)%longName    = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
353      ttr(jq+1:jq+nm)%iadv        = [(-iad,    im=1, nm) ]
354      ttr(jq+1:jq+nm)%isAdvected  = [(.FALSE., im=1, nm) ]
355      jq = jq + nm
356   END DO
357   DEALLOCATE(hadv, vadv)
358   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
359
360   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
361   CALL indexUpdate(tracers)
362
363   !=== TEST ADVECTION SCHEME
364   DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv
365
366      !--- ONLY TESTED VALUES FOR TRACERS FOR NOW:               iadv = 14, 10 (and 0 for non-transported tracers)
367      IF(ALL([10,14,0] /= iad)) &
368         CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1)
369
370      !--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
371      IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
372         CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1)
373
374      !--- ONLY TESTED VALUES FOR CHILDS FOR NOW:                iadv = 10     (CHILDS:  TRACERS OF GENERATION GREATER THAN 1)
375      IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',&
376         modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
377
378      !--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR:            iadv = 14
379      ll = t1%name /= addPhase('H2O','g')
380      IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', &
381         modname, iad == 14 .AND. ll))                 t1%iadv = 10
382   END DO
383
384   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
385   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
386   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
387
388   !--- Convection / boundary layer activation for all tracers
389   ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
390   ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
391
392   !--- Note: nqtottr can differ from nbtr when nmom/=0
393   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
394   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
395      CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
396
397   !=== DISPLAY THE RESULTS
398   CALL msg('nqo    = '//TRIM(int2str(nqo)),    modname)
399   CALL msg('nbtr   = '//TRIM(int2str(nbtr)),   modname)
400   CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
401   CALL msg('nqtot  = '//TRIM(int2str(nqtot)),  modname)
402   CALL msg('niso   = '//TRIM(int2str(niso)),   modname)
403   CALL msg('ntiso  = '//TRIM(int2str(ntiso)),  modname)
404#ifdef INCA
405   CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
406   CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
407#endif
408   t => tracers
409   CALL msg('Information stored in infotrac :', modname)
410   IF(dispTable('isssssssssiiiiiiiii', &
411      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
412       'iadv  ', 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
413      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
414                                                                                  bool2str(t%isAdvected)), &
415      cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,  &
416                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
417      CALL abort_gcm(modname, "problem with the tracers table content", 1)
418   IF(niso > 0) THEN
419      CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
420      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
421      CALL msg('  isoName = '//strStack(isoName),      modname)
422      CALL msg('  isoZone = '//strStack(isoZone),      modname)
423      CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
424   ELSE
425      CALL msg('No isotopes identified.', modname)
426   END IF
427   CALL msg('end', modname)
428
429END SUBROUTINE init_infotrac
430
431END MODULE infotrac
Note: See TracBrowser for help on using the repository browser.