source: LMDZ6/branches/Ocean_skin/libf/phylmd/infotrac_phy.F90

Last change on this file was 4368, checked in by lguez, 18 months ago

Sync latest trunk changes to Ocean_skin

File size: 29.4 KB
Line 
1!$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $
2!
3MODULE infotrac_phy
4
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
9   IMPLICIT NONE
10
11   PRIVATE
12
13   !=== FOR TRACERS:
14   PUBLIC :: init_infotrac_phy                             !--- Initialization of the tracers
15   PUBLIC :: tracers, type_trac, types_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#ifdef CPP_StratAer
19   PUBLIC :: nbtr_bin, nbtr_sulgas                         !--- Number of aerosols bins and sulfur gases for StratAer model
20   PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
21#endif
22
23   !=== FOR ISOTOPES: General
24   PUBLIC :: isot_type, nbIso                              !--- Derived type, full isotopes families database + nb of families
25   PUBLIC :: isoSelect, ixIso                              !--- Isotopes family selection tool + selected family index
26   !=== FOR ISOTOPES: Specific to water
27   PUBLIC :: iH2O                                          !--- H2O isotopes index
28   !=== FOR ISOTOPES: Depending on the selected isotopes family
29   PUBLIC :: isotope, isoKeys                              !--- Selected isotopes database + associated keys (cf. getKey)
30   PUBLIC :: isoName, isoZone, isoPhas                     !--- Isotopes and tagging zones names, phases
31   PUBLIC :: niso,    nzone,   nphas,   ntiso              !---  " " numbers + isotopes & tagging tracers number
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
34   PUBLIC :: isoCheck                                      !--- Run isotopes checking routines
35   !=== FOR BOTH TRACERS AND ISOTOPES
36   PUBLIC :: getKey                                        !--- Get a key from "tracers" or "isotope"
37
38!=== CONVENTIONS FOR TRACERS NUMBERS:
39!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
40!  | water in different |    water tagging      |  water isotopes | other tracers | additional tracers moments |
41!  | phases: H2O_[gls]  |      isotopes         |                 |               |  for higher order schemes  |
42!  |--------------------+-----------------------+-----------------+---------------+----------------------------|
43!  |                    |                       |                 |               |                            |
44!  |<--     nqo      -->|<-- nqo*niso* nzone -->|<-- nqo*niso  -->|<--  nbtr   -->|<--        (nmom)        -->|         
45!  |                    |                                         |                                            |
46!  |                    |<-- nqo*niso*(nzone+1)  =   nqo*ntiso -->|<--    nqtottr = nbtr + nmom             -->|
47!  |                                                                              = nqtot - nqo*(ntiso+1)      |
48!  |                                                                                                           |
49!  |<--                        nqtrue  =  nbtr + nqo*(ntiso+1)                 -->|                            |
50!  |                                                                                                           |
51!  |<--                        nqtot   =  nqtrue + nmom                                                     -->|
52!  |                                                                                                           |
53!  |-----------------------------------------------------------------------------------------------------------|
54!  NOTES FOR THIS TABLE:
55!  * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
56!    since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
57!  * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
58!  * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
59!
60!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
61!    Each entry is accessible using "%" sign.
62!  |-------------+------------------------------------------------------+-------------+------------------------+
63!  |  entry      | Meaning                                              | Former name | Possible values        |
64!  |-------------+------------------------------------------------------+-------------+------------------------+
65!  | name        | Name (short)                                         | tname       |                        |
66!  | gen0Name    | Name of the 1st generation ancestor                  | /           |                        |
67!  | parent      | Name of the parent                                   | /           |                        |
68!  | longName    | Long name (with adv. scheme suffix) for outputs      | ttext       |                        |
69!  | type        | Type (so far: tracer or tag)                         | /           | tracer,tag             |
70!  | phase       | Phases list ("g"as / "l"iquid / "s"olid)             | /           | [g][l][s]              |
71!  | component   | Name(s) of the merged/cumulated section(s)           | /           | coma-separated names   |
72!  | iGeneration | Generation (>=1)                                     | /           |                        |
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!  | nqChildren  | Number of childs            (1st generation only)    | nqfils      | 1:nqtot                |
78!  | keys        | key/val pairs accessible with "getKey" routine       | /           |                        |
79!  | iso_iGroup  | Isotopes group index in isotopes(:)                  | /           | 1:nbIso                |
80!  | iso_iName   | Isotope  name  index in isotopes(iso_iGroup)%trac(:) | iso_indnum  | 1:niso                 |
81!  | iso_iZone   | Isotope  zone  index in isotopes(iso_iGroup)%zone(:) | zone_num    | 1:nzone                |
82!  | iso_iPhas   | Isotope  phase index in isotopes(iso_iGroup)%phas(:) | phase_num   | 1:nphas                |
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                                  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)
112!$OMP THREADPRIVATE(conv_flg, pbl_flg)
113
114#ifdef CPP_StratAer
115  !=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
116  INTEGER, SAVE ::  nbtr_bin, nbtr_sulgas         !--- number of aerosols bins and sulfur gases for StratAer model
117!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
118  INTEGER, SAVE ::  id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
119!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
120#endif
121
122CONTAINS
123
124SUBROUTINE init_infotrac_phy
125   USE ioipsl_getin_p_mod, ONLY: getin_p
126#ifdef REPROBUS
127   USE CHEM_REP, ONLY: Init_chem_rep_trac
128#endif
129   IMPLICIT NONE
130!==============================================================================================================================
131!
132!   Auteur:  P. Le Van /L. Fairhead/F.Hourdin
133!   -------
134!
135!   Modifications:
136!   --------------
137!   05/94: F.Forget      Modif special traceur
138!   02/02: M-A Filiberti Lecture de traceur.def
139!   01/22: D. Cugnet     Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
140!
141!   Objet:
142!   ------
143!   GCM LMD nouvelle grille
144!
145!==============================================================================================================================
146!   ... modification de l'integration de q ( 26/04/94 ) ....
147!------------------------------------------------------------------------------------------------------------------------------
148! Declarations:
149   INCLUDE "dimensions.h"
150   INCLUDE "iniprint.h"
151
152!------------------------------------------------------------------------------------------------------------------------------
153! Local variables
154   INTEGER, ALLOCATABLE :: hadv(:), vadv(:)                          !--- Horizontal/vertical transport scheme number
155#ifdef INCA
156   INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
157                           vad (:), vadv_inca(:),  pbl_flg_inca(:)
158   CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:)                   !--- Tracers names for INCA
159   INTEGER :: nqINCA
160#endif
161#ifdef CPP_StratAer
162   CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
163#endif
164   CHARACTER(LEN=2)      ::   suff(9)                                !--- Suffixes for schemes of order 3 or 4 (Prather)
165   CHARACTER(LEN=3)      :: descrq(30)                               !--- Advection scheme description tags
166   CHARACTER(LEN=maxlen) :: msg1                                     !--- String for messages
167   INTEGER :: fType                                                  !--- Tracers description file type ; 0: none
168                                                                     !--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
169   INTEGER :: nqtrue                                                 !--- Tracers nb from tracer.def (no higher order moments)
170   INTEGER :: iad                                                    !--- Advection scheme number
171   INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k                      !--- Indexes and temporary variables
172   LOGICAL :: lerr, ll, lRepr, lInit
173   CHARACTER(LEN=1) :: p
174   TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
175   TYPE(trac_type), POINTER             :: t1, t(:)
176   INTEGER :: ierr
177
178   CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"
179!------------------------------------------------------------------------------------------------------------------------------
180! Initialization :
181!------------------------------------------------------------------------------------------------------------------------------
182   suff          = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
183   descrq( 1: 2) = ['LMV','BAK']
184   descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH','   ','PPM','PPS','PPP','   ','SLP']
185   descrq(30)    =  'PRA'
186
187   CALL getin_p('type_trac',type_trac)
188   CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
189   IF(strParse(type_trac, '|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
190   lInit = .NOT.ALLOCATED(tracers)
191
192!##############################################################################################################################
193   IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
194!##############################################################################################################################
195   !---------------------------------------------------------------------------------------------------------------------------
196   DO it = 1, nt                                                     !--- nt>1=> "type_trac": coma-separated keywords list
197   !---------------------------------------------------------------------------------------------------------------------------
198      !--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
199      msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":'
200      SELECT CASE(types_trac(it))
201         CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model',        modname)
202         CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle',  modname)
203         CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model',    modname)
204         CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle',     modname)
205         CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
206         CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only',          modname)
207         CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1)
208      END SELECT
209
210      !--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
211      SELECT CASE(types_trac(it))
212         CASE('inca', 'inco')
213#ifndef INCA
214            CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
215#endif
216         CASE('repr')
217#ifndef REPROBUS
218            CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
219#endif
220         CASE('coag')
221#ifndef CPP_StratAer
222            CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
223#endif
224      END SELECT
225
226   !---------------------------------------------------------------------------------------------------------------------------
227   END DO
228   !---------------------------------------------------------------------------------------------------------------------------
229
230!##############################################################################################################################
231   END IF
232!##############################################################################################################################
233
234   nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] )
235
236!==============================================================================================================================
237! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
238!==============================================================================================================================
239   lRepr = ANY(types_trac(:) == 'repr')
240!##############################################################################################################################
241   IF(lInit) THEN
242     IF(readTracersFiles(type_trac,  fType,  lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
243   ELSE
244     CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
245     IF(testTracersFiles(modname, type_trac, fType, .FALSE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
246   END IF
247!##############################################################################################################################
248
249   !---------------------------------------------------------------------------------------------------------------------------
250   IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
251   !---------------------------------------------------------------------------------------------------------------------------
252   IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN  !=== OLD STYLE INCA "traceur.def" (single type_trac)
253   !---------------------------------------------------------------------------------------------------------------------------
254#ifdef INCA
255      nqo = SIZE(tracers) - nqCO2
256      CALL Init_chem_inca_trac(nqINCA)                               !--- Get nqINCA from INCA
257      nbtr = nqINCA + nqCO2                                          !--- Number of tracers passed to phytrac
258      nqtrue = nbtr + nqo                                            !--- Total number of "true" tracers
259      IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
260      ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
261      ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA),  pbl_flg_inca(nqINCA))
262      CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
263      ALLOCATE(ttr(nqtrue))
264      ttr(1:nqo+nqCO2)                    = tracers
265      ttr(1    :      nqo   )%component   = 'lmdz'
266      ttr(1+nqo:nqCO2+nqo   )%component   = 'co2i'
267      ttr(1+nqo+nqCO2:nqtrue)%component   = 'inca'
268      ttr(1+nqo      :nqtrue)%name        = [('CO2     ', k=1, nqCO2), solsym_inca]
269      ttr(1+nqo+nqCO2:nqtrue)%parent      = tran0
270      ttr(1+nqo+nqCO2:nqtrue)%phase       = 'g'
271      lerr = getKey('hadv', had, ky=tracers(:)%keys)
272      lerr = getKey('vadv', vad, ky=tracers(:)%keys)
273      hadv(1:nqo) = had(:); hadv(nqo+1:nqtrue) = hadv_inca
274      vadv(1:nqo) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca
275      CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
276      CALL setGeneration(tracers)                                    !--- SET FIELDS %iGeneration, %gen0Name
277      DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
278#endif
279   !---------------------------------------------------------------------------------------------------------------------------
280   ELSE                                                              !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
281   !---------------------------------------------------------------------------------------------------------------------------
282      nqo    =        COUNT(delPhase(tracers(:)%name)     == 'H2O' &
283                               .AND. tracers(:)%component == 'lmdz') !--- Number of water phases
284      nqtrue = SIZE(tracers)                                         !--- Total number of "true" tracers
285      nbtr   = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
286                               .AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
287#ifdef INCA
288      nqINCA = COUNT(tracers(:)%component == 'inca')
289#endif
290      lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
291      lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
292   !---------------------------------------------------------------------------------------------------------------------------
293   END IF
294   !---------------------------------------------------------------------------------------------------------------------------
295
296   !--- Transfert the number of tracers to Reprobus
297#ifdef REPROBUS
298   CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
299#endif
300
301!##############################################################################################################################
302   IF(lInit) THEN                                                    !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac  ####
303!##############################################################################################################################
304
305!==============================================================================================================================
306! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
307!==============================================================================================================================
308   DO iq = 1, nqtrue
309      IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
310      WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
311      CALL abort_gcm(modname, TRIM(msg1), 1)
312   END DO
313   nqtot =    COUNT( hadv< 20 .AND. vadv< 20 ) &                     !--- No additional tracer
314         +  4*COUNT( hadv==20 .AND. vadv==20 ) &                     !--- 3  additional tracers
315         + 10*COUNT( hadv==30 .AND. vadv==30 )                       !--- 9  additional tracers
316
317   !--- More tracers due to the choice of advection scheme => assign total number of tracers
318   IF( nqtot /= nqtrue ) THEN
319      CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
320      CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
321      CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
322   END IF
323
324!==============================================================================================================================
325! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot.
326!==============================================================================================================================
327   ALLOCATE(ttr(nqtot))
328   jq = nqtrue+1; tracers(:)%iadv = -1
329   DO iq = 1, nqtrue
330      t1 => tracers(iq)
331
332      !--- VERIFY THE CHOICE OF ADVECTION SCHEME
333      iad = -1
334      IF(hadv(iq)     ==    vadv(iq)    ) iad = hadv(iq)
335      IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
336      WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
337      IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
338
339      !--- SET FIELDS %longName, %isInPhysics
340      t1%longName   = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
341      t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
342                          .OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
343      ttr(iq)       = t1
344
345      !--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
346      nm = 0
347      IF(iad == 20) nm = 3                                           !--- 2nd order scheme
348      IF(iad == 30) nm = 9                                           !--- 3rd order scheme
349      IF(nm == 0) CYCLE                                              !--- No higher moments
350      ttr(jq+1:jq+nm)             = t1
351      ttr(jq+1:jq+nm)%name        = [(TRIM(t1%name)    //'-'//TRIM(suff(im)), im=1, nm) ]
352      ttr(jq+1:jq+nm)%parent      = [(TRIM(t1%parent)  //'-'//TRIM(suff(im)), im=1, nm) ]
353      ttr(jq+1:jq+nm)%longName    = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
354      jq = jq + nm
355   END DO
356   DEALLOCATE(hadv, vadv)
357   CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
358
359   !--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
360   CALL indexUpdate(tracers)
361
362!##############################################################################################################################
363   END IF
364!##############################################################################################################################
365
366!##############################################################################################################################
367   IF(.NOT.lInit) THEN
368!##############################################################################################################################
369     nqtot = SIZE(tracers)
370!##############################################################################################################################
371   ELSE
372!##############################################################################################################################
373
374   !=== READ PHYSICAL PARAMETERS FOR ISOTOPES
375   niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
376   IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
377
378!##############################################################################################################################
379   END IF
380!##############################################################################################################################
381   !--- Convection / boundary layer activation for all tracers
382   ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
383   ALLOCATE( pbl_flg(nbtr));  pbl_flg(1:nbtr) = 1
384
385   !--- Note: nqtottr can differ from nbtr when nmom/=0
386   nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
387   IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
388      CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
389
390   !=== DISPLAY THE RESULTS
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)
398#ifdef INCA
399      CALL msg('nqCO2  = '//TRIM(int2str(nqCO2)),  modname)
400      CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
401#endif
402!   END IF
403   t => tracers
404   CALL msg('Information stored in infotrac_phy :', modname)
405   IF(dispTable('issssssssiiiiiiii', &
406      ['iq    ', 'name  ', 'lName ', 'gen0N ', 'parent', 'type  ', 'phase ', 'compon', 'isPhy ',           &
407                 'iGen  ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'],          &
408      cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
409      cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup,          &
410                  t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname))   &
411      CALL abort_gcm(modname, "problem with the tracers table content", 1)
412   IF(niso > 0) THEN
413      CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
414      CALL msg('  isoKeys%name = '//strStack(isoKeys%name), modname)
415      CALL msg('  isoName = '//strStack(isoName),      modname)
416      CALL msg('  isoZone = '//strStack(isoZone),      modname)
417      CALL msg('  isoPhas = '//TRIM(isoPhas),          modname)
418   ELSE
419      CALL msg('No isotopes identified.', modname)
420   END IF
421
422#ifdef ISOVERIF
423   CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
424#endif
425#ifdef CPP_StratAer
426   IF (ANY(types_trac == 'coag')) THEN
427      nbtr_bin    = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
428      nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
429      tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
430      id_BIN01_strat = strIdx(tnames, 'BIN01'   )
431      id_OCS_strat   = strIdx(tnames, 'GASOCS'  )
432      id_SO2_strat   = strIdx(tnames, 'GASSO2'  )
433      id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
434      id_TEST_strat  = strIdx(tnames, 'GASTEST' )
435      CALL msg('nbtr_bin       ='//TRIM(int2str(nbtr_bin      )), modname)
436      CALL msg('nbtr_sulgas    ='//TRIM(int2str(nbtr_sulgas   )), modname)
437      CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
438      CALL msg('id_OCS_strat   ='//TRIM(int2str(id_OCS_strat  )), modname)
439      CALL msg('id_SO2_strat   ='//TRIM(int2str(id_SO2_strat  )), modname)
440      CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
441      CALL msg('id_TEST_strat  ='//TRIM(int2str(id_TEST_strat )), modname)
442   END IF
443#endif
444   CALL msg('end', modname)
445
446END SUBROUTINE init_infotrac_phy
447
448END MODULE infotrac_phy
Note: See TracBrowser for help on using the repository browser.