Context Navigation

infotrac_phy.F90 @ 4352

Last change on this file since 4352 was 4328, checked in by dcugnet, 2 years ago

rewrite few routines from "readTracFiles_mod" to avoid crashes with gfortran, in particular "setGeneration" and "addKey".
make "addKey" routine public and replace "addKey_m" and "addKey_mm" with callings to "addKey_1" in loops to avoid a gfortran-specific crash
rewrite the "getKey" functions family so that when "tname" is not specified, result is as expected, even for tracers lists with repeated tracers (use index instead of name search).

File size: 30.0 KB

Line
1	!$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $
2	!
3	MODULE 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 -->\|<-- nqoniso nzone -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
45	! \| \| \| \|
46	! \| \|<-- nqoniso(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	! \| 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	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
122	CONTAINS
123
124	SUBROUTINE init_infotrac_phy
125	USE control_mod, ONLY: planet_type, config_inca
126	USE ioipsl_getin_p_mod, ONLY: getin_p
127	#ifdef REPROBUS
128	USE CHEM_REP, ONLY: Init_chem_rep_trac
129	#endif
130	IMPLICIT NONE
131	!==============================================================================================================================
132	!
133	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
134	! -------
135	!
136	! Modifications:
137	! --------------
138	! 05/94: F.Forget Modif special traceur
139	! 02/02: M-A Filiberti Lecture de traceur.def
140	! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
141	!
142	! Objet:
143	! ------
144	! GCM LMD nouvelle grille
145	!
146	!==============================================================================================================================
147	! ... modification de l'integration de q ( 26/04/94 ) ....
148	!------------------------------------------------------------------------------------------------------------------------------
149	! Declarations:
150	INCLUDE "dimensions.h"
151	INCLUDE "iniprint.h"
152
153	!------------------------------------------------------------------------------------------------------------------------------
154	! Local variables
155	INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number
156	#ifdef INCA
157	INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
158	vad (:), vadv_inca(:), pbl_flg_inca(:)
159	CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA
160	INTEGER :: nqINCA
161	#endif
162	#ifdef CPP_StratAer
163	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
164	#endif
165	CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather)
166	CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags
167	CHARACTER(LEN=maxlen) :: msg1 !--- String for messages
168	INTEGER :: fType !--- Tracers description file type ; 0: none
169	!--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
170	INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments)
171	INTEGER :: iad !--- Advection scheme number
172	INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables
173	LOGICAL :: lerr, ll, lRepr, lInit
174	CHARACTER(LEN=1) :: p
175	TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
176	TYPE(trac_type), POINTER :: t1, t(:)
177	INTEGER :: ierr
178
179	CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"
180	!------------------------------------------------------------------------------------------------------------------------------
181	! Initialization :
182	!------------------------------------------------------------------------------------------------------------------------------
183	suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
184	descrq( 1: 2) = ['LMV','BAK']
185	descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP']
186	descrq(30) = 'PRA'
187
188	CALL getin_p('type_trac',type_trac)
189	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
190	IF(strParse(type_trac, '\|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
191	lInit = .NOT.ALLOCATED(tracers)
192
193	!##############################################################################################################################
194	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
195	!##############################################################################################################################
196	!---------------------------------------------------------------------------------------------------------------------------
197	DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list
198	!---------------------------------------------------------------------------------------------------------------------------
199	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
200	msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":'
201	SELECT CASE(types_trac(it))
202	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname)
203	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
204	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
205	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
206	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
207	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
208	CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1)
209	END SELECT
210
211	!--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
212	IF(ANY(['inca', 'inco'] == types_trac(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) &
213	CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1)
214
215	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
216	SELECT CASE(types_trac(it))
217	CASE('inca', 'inco')
218	#ifndef INCA
219	CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
220	#endif
221	CASE('repr')
222	#ifndef REPROBUS
223	CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
224	#endif
225	CASE('coag')
226	#ifndef CPP_StratAer
227	CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
228	#endif
229	END SELECT
230
231	!---------------------------------------------------------------------------------------------------------------------------
232	END DO
233	!---------------------------------------------------------------------------------------------------------------------------
234
235	!##############################################################################################################################
236	END IF
237	!##############################################################################################################################
238
239	!--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none"
240	IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', &
241	modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none'
242
243	nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] )
244
245	!==============================================================================================================================
246	! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
247	!==============================================================================================================================
248	lRepr = ANY(types_trac(:) == 'repr')
249	!##############################################################################################################################
250	IF(lInit) THEN
251	IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
252	ELSE
253	CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
254	IF(testTracersFiles(modname, type_trac, fType, .FALSE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
255	END IF
256	!##############################################################################################################################
257
258	!---------------------------------------------------------------------------------------------------------------------------
259	IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
260	!---------------------------------------------------------------------------------------------------------------------------
261	IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== OLD STYLE INCA "traceur.def" (single type_trac)
262	!---------------------------------------------------------------------------------------------------------------------------
263	#ifdef INCA
264	nqo = SIZE(tracers) - nqCO2
265	CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA
266	nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac
267	nqtrue = nbtr + nqo !--- Total number of "true" tracers
268	IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
269	ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
270	ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
271	CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
272	ALLOCATE(ttr(nqtrue))
273	ttr(1:nqo+nqCO2) = tracers
274	ttr(1 : nqo )%component = 'lmdz'
275	ttr(1+nqo:nqCO2+nqo )%component = 'co2i'
276	ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
277	ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca]
278	ttr(1+nqo+nqCO2:nqtrue)%parent = tran0
279	ttr(1+nqo+nqCO2:nqtrue)%phase = 'g'
280	lerr = getKey('hadv', had, ky=tracers(:)%keys)
281	lerr = getKey('vadv', vad, ky=tracers(:)%keys)
282	hadv(1:nqo) = had(:); hadv(nqo+1:nqtrue) = hadv_inca
283	vadv(1:nqo) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca
284	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
285	CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name
286	DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
287	#endif
288	!---------------------------------------------------------------------------------------------------------------------------
289	ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
290	!---------------------------------------------------------------------------------------------------------------------------
291	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' &
292	.AND. tracers(:)%component == 'lmdz') !--- Number of water phases
293	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
294	nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
295	.AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
296	#ifdef INCA
297	nqINCA = COUNT(tracers(:)%component == 'inca')
298	#endif
299	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
300	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
301	!---------------------------------------------------------------------------------------------------------------------------
302	END IF
303	!---------------------------------------------------------------------------------------------------------------------------
304
305	!--- Transfert the number of tracers to Reprobus
306	#ifdef REPROBUS
307	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
308	#endif
309
310	!##############################################################################################################################
311	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
312	!##############################################################################################################################
313
314	!==============================================================================================================================
315	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
316	!==============================================================================================================================
317	DO iq = 1, nqtrue
318	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
319	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
320	CALL abort_gcm(modname, TRIM(msg1), 1)
321	END DO
322	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
323	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
324	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
325
326	!--- More tracers due to the choice of advection scheme => assign total number of tracers
327	IF( nqtot /= nqtrue ) THEN
328	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
329	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
330	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
331	END IF
332
333	!==============================================================================================================================
334	! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot.
335	!==============================================================================================================================
336	ALLOCATE(ttr(nqtot))
337	jq = nqtrue+1; tracers(:)%iadv = -1
338	DO iq = 1, nqtrue
339	t1 => tracers(iq)
340
341	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
342	iad = -1
343	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
344	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
345	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
346	IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
347
348	!--- SET FIELDS %longName, %isInPhysics
349	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
350	t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
351	.OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
352	ttr(iq) = t1
353
354	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
355	nm = 0
356	IF(iad == 20) nm = 3 !--- 2nd order scheme
357	IF(iad == 30) nm = 9 !--- 3rd order scheme
358	IF(nm == 0) CYCLE !--- No higher moments
359	ttr(jq+1:jq+nm) = t1
360	ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
361	ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
362	ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
363	jq = jq + nm
364	END DO
365	DEALLOCATE(hadv, vadv)
366	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
367
368	!--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
369	CALL indexUpdate(tracers)
370
371	!##############################################################################################################################
372	END IF
373	!##############################################################################################################################
374
375	!##############################################################################################################################
376	IF(.NOT.lInit) THEN
377	!##############################################################################################################################
378	nqtot = SIZE(tracers)
379	!##############################################################################################################################
380	ELSE
381	!##############################################################################################################################
382
383	!=== READ PHYSICAL PARAMETERS FOR ISOTOPES
384	niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
385	IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
386
387	!##############################################################################################################################
388	END IF
389	!##############################################################################################################################
390	!--- Convection / boundary layer activation for all tracers
391	ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
392	ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
393
394	!--- Note: nqtottr can differ from nbtr when nmom/=0
395	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
396	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
397	CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
398
399	!=== DISPLAY THE RESULTS
400	! IF(prt_level > 1) THEN
401	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
402	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
403	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
404	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
405	CALL msg('niso = '//TRIM(int2str(niso)), modname)
406	CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)
407	#ifdef INCA
408	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
409	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
410	#endif
411	! END IF
412	t => tracers
413	CALL msg('Information stored in infotrac_phy :', modname)
414	IF(dispTable('issssssssiiiiiiii', &
415	['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', &
416	'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], &
417	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
418	cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
419	t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &
420	CALL abort_gcm(modname, "problem with the tracers table content", 1)
421	IF(niso > 0) THEN
422	CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
423	CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname)
424	CALL msg(' isoName = '//strStack(isoName), modname)
425	CALL msg(' isoZone = '//strStack(isoZone), modname)
426	CALL msg(' isoPhas = '//TRIM(isoPhas), modname)
427	ELSE
428	CALL msg('No isotopes identified.', modname)
429	END IF
430
431	#ifdef ISOVERIF
432	CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
433	#endif
434	#ifdef CPP_StratAer
435	IF (ANY(types_trac == 'coag')) THEN
436	nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
437	nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
438	tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
439	id_BIN01_strat = strIdx(tnames, 'BIN01' )
440	id_OCS_strat = strIdx(tnames, 'GASOCS' )
441	id_SO2_strat = strIdx(tnames, 'GASSO2' )
442	id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
443	id_TEST_strat = strIdx(tnames, 'GASTEST' )
444	CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname)
445	CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname)
446	CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
447	CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname)
448	CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname)
449	CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
450	CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname)
451	END IF
452	#endif
453	CALL msg('end', modname)
454
455	END SUBROUTINE init_infotrac_phy
456
457	END MODULE infotrac_phy

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format