Context Navigation

infotrac_phy.F90 @ 5454

Last change on this file since 5454 was 4523, checked in by evignon, 20 months ago
merge de la branche blowing snow vers la trunk premiere tentative Etienne
File size: 29.2 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, 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_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	#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 class 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 / "b"lowing) \| / \| [g][l][s][b] \|
71	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
72	! \| iGeneration \| Generation (>=1) \| / \| \|
73	! \| iqParent \| Index of the parent tracer \| iqpere \| 1:nqtot \|
74	! \| iqDescen \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
75	! \| nqDescen \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
76	! \| nqChildren \| Number of childs (1st generation only) \| nqfils \| 1:nqtot \|
77	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
78	! \| isAdvected \| advected tracers flag (.TRUE. if iadv >= 0) \| / \| nqtrue .TRUE. values \|
79	! \| isInPhysics \| tracers not extracted from the main table in physics \| / \| nqtottr .TRUE. values \|
80	! \| iso_iGroup \| Isotopes group index in isotopes(:) \| / \| 1:nbIso \|
81	! \| iso_iName \| Isotope name index in isotopes(iso_iGroup)%trac(:) \| iso_indnum \| 1:niso \|
82	! \| iso_iZone \| Isotope zone index in isotopes(iso_iGroup)%zone(:) \| zone_num \| 1:nzone \|
83	! \| iso_iPhas \| Isotope phase index in isotopes(iso_iGroup)%phas(:) \| phase_num \| 1:nphas \|
84	! +-------------+------------------------------------------------------+-------------+------------------------+
85	!
86	!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
87	! Each entry is accessible using "%" sign.
88	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
89	! \| entry \| length \| Meaning \| Former name \| Possible values \|
90	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
91	! \| parent \| Parent tracer (isotopes family name) \| \| \|
92	! \| keys \| niso \| Isotopes keys/values pairs list + number \| \| \|
93	! \| trac \| ntiso \| Isotopes + tagging tracers list + number \| / \| ntraciso \| \|
94	! \| zone \| nzone \| Geographic tagging zones list + number \| / \| ntraceurs_zone \| \|
95	! \| phase \| nphas \| Phases list + number \| \|[g][l][s][b] 1:4 \|
96	! \| iqIsoPha \| Index in "qx" = f(name(1:ntiso)),phas) \| iqiso \| 1:nqtot \|
97	! \| itZonIso \| Index in "trac(1:ntiso)"= f(zone, name(1:niso)) \| index_trac \| 1:ntiso \|
98	! +-----------------+--------------------------------------------------+--------------------+-----------------+
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(s)
107	!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_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 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, texp, ttp !--- String for messages and expanded tracers type
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, 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:30) = ' '
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	lInit = .NOT.ALLOCATED(tracers)
191
192	!##############################################################################################################################
193	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
194	!##############################################################################################################################
195	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
196	msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
197	SELECT CASE(type_trac)
198	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname)
199	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
200	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
201	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
202	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
203	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
204	CASE DEFAULT; CALL abort_physic(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
205	END SELECT
206
207	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
208	SELECT CASE(type_trac)
209	CASE('inca', 'inco')
210	#ifndef INCA
211	CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1)
212	#endif
213	CASE('repr')
214	#ifndef REPROBUS
215	CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
216	#endif
217	CASE('coag')
218	#ifndef CPP_StratAer
219	CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
220	#endif
221	END SELECT
222	!##############################################################################################################################
223	END IF
224	!##############################################################################################################################
225
226	nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
227
228	!==============================================================================================================================
229	! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
230	!==============================================================================================================================
231	texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "\|" SEPARATOR
232	IF(texp == 'inco') texp = 'co2i\|inca'
233	IF(texp /= 'lmdz') texp = 'lmdz\|'//TRIM(texp)
234
235	!=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
236	IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
237
238	ttp = type_trac; IF(fType /= 1) ttp = texp
239
240	!##############################################################################################################################
241	IF(lInit) THEN
242	IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_physic(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	END IF
246	!##############################################################################################################################
247
248	!---------------------------------------------------------------------------------------------------------------------------
249	IF(fType == 0) CALL abort_physic(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
250	!---------------------------------------------------------------------------------------------------------------------------
251	IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== FOUND OLD STYLE INCA "traceur.def"
252	!---------------------------------------------------------------------------------------------------------------------------
253	#ifdef INCA
254	nqo = SIZE(tracers) - nqCO2
255	CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA
256	nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac
257	nqtrue = nbtr + nqo !--- Total number of "true" tracers
258	IF(ALL([2,3] /= nqo)) CALL abort_physic(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
259	ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
260	ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
261	CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
262	ALLOCATE(ttr(nqtrue))
263	ttr(1:nqo+nqCO2) = tracers
264	ttr(1 : nqo )%component = 'lmdz'
265	ttr(1+nqo:nqCO2+nqo )%component = 'co2i'
266	ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
267	ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca]
268	ttr(1+nqo+nqCO2:nqtrue)%parent = tran0
269	ttr(1+nqo+nqCO2:nqtrue)%phase = 'g'
270	lerr = getKey('hadv', had, ky=tracers(:)%keys)
271	lerr = getKey('vadv', vad, ky=tracers(:)%keys)
272	hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
273	vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
274	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
275	DO iq = 1, nqtrue
276	t1 => tracers(iq)
277	CALL addKey('name', t1%name, t1%keys)
278	CALL addKey('component', t1%component, t1%keys)
279	CALL addKey('parent', t1%parent, t1%keys)
280	CALL addKey('phase', t1%phase, t1%keys)
281	END DO
282	IF(setGeneration(tracers)) CALL abort_physic(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name
283	DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
284	#endif
285	!---------------------------------------------------------------------------------------------------------------------------
286	ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
287	!---------------------------------------------------------------------------------------------------------------------------
288	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' &
289	.AND. tracers(:)%component == 'lmdz') !--- Number of water phases
290	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
291	nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
292	.AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
293	#ifdef INCA
294	nqINCA = COUNT(tracers(:)%component == 'inca')
295	#endif
296	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
297	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
298	!---------------------------------------------------------------------------------------------------------------------------
299	END IF
300	!---------------------------------------------------------------------------------------------------------------------------
301
302	!--- Transfert the number of tracers to Reprobus
303	#ifdef REPROBUS
304	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
305	#endif
306
307	!##############################################################################################################################
308	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
309	!##############################################################################################################################
310
311	!==============================================================================================================================
312	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
313	!==============================================================================================================================
314	DO iq = 1, nqtrue
315	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
316	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
317	CALL abort_physic(modname, TRIM(msg1), 1)
318	END DO
319	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
320	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
321	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
322
323	!--- More tracers due to the choice of advection scheme => assign total number of tracers
324	IF( nqtot /= nqtrue ) THEN
325	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
326	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
327	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
328	END IF
329
330	!==============================================================================================================================
331	! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected
332	!==============================================================================================================================
333	ALLOCATE(ttr(nqtot))
334	jq = nqtrue+1; tracers(:)%iadv = -1
335	DO iq = 1, nqtrue
336	t1 => tracers(iq)
337
338	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
339	iad = -1
340	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
341	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
342	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
343	IF(iad == -1) CALL abort_physic(modname, msg1, 1)
344
345	!--- SET FIELDS %longName, %isAdvected, %isInPhysics
346	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
347	t1%isAdvected = iad >= 0
348	t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
349	.OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
350	ttr(iq) = t1
351
352	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
353	nm = 0
354	IF(iad == 20) nm = 3 !--- 2nd order scheme
355	IF(iad == 30) nm = 9 !--- 3rd order scheme
356	IF(nm == 0) CYCLE !--- No higher moments
357	ttr(jq+1:jq+nm) = t1
358	ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
359	ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
360	ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
361	ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ]
362	jq = jq + nm
363	END DO
364	DEALLOCATE(hadv, vadv)
365	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
366
367	!--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
368	CALL indexUpdate(tracers)
369
370	!##############################################################################################################################
371	END IF
372	!##############################################################################################################################
373
374	!##############################################################################################################################
375	IF(.NOT.lInit) THEN
376	!##############################################################################################################################
377	nqtot = SIZE(tracers)
378	!##############################################################################################################################
379	ELSE
380	!##############################################################################################################################
381
382	!=== READ PHYSICAL PARAMETERS FOR ISOTOPES
383	niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
384	IF(readIsotopesFile()) CALL abort_physic(modname, 'Problem when reading isotopes parameters', 1)
385
386	!##############################################################################################################################
387	END IF
388	!##############################################################################################################################
389	!--- Convection / boundary layer activation for all tracers
390	IF (.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
391	IF (.NOT.ALLOCATED(pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
392
393	!--- Note: nqtottr can differ from nbtr when nmom/=0
394	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
395	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
396	CALL abort_physic(modname, 'pb dans le calcul de nqtottr', 1)
397
398	!=== DISPLAY THE RESULTS
399	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
400	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
401	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
402	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
403	CALL msg('niso = '//TRIM(int2str(niso)), modname)
404	CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)
405	#ifdef INCA
406	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
407	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
408	#endif
409	t => tracers
410	CALL msg('Information stored in infotrac_phy :', modname)
411	IF(dispTable('issssssssiiiiiiii', &
412	['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', &
413	'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], &
414	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
415	cat([(iq, iq=1, nqtot)], 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_physic(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
428	#ifdef ISOVERIF
429	CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
430	#endif
431	#ifdef CPP_StratAer
432	IF (type_trac == 'coag') THEN
433	nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
434	nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
435	tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
436	id_BIN01_strat = strIdx(tnames, 'BIN01' )
437	id_OCS_strat = strIdx(tnames, 'GASOCS' )
438	id_SO2_strat = strIdx(tnames, 'GASSO2' )
439	id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
440	id_TEST_strat = strIdx(tnames, 'GASTEST' )
441	CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname)
442	CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname)
443	CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
444	CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname)
445	CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname)
446	CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
447	CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname)
448	END IF
449	#endif
450	CALL msg('end', modname)
451
452	END SUBROUTINE init_infotrac_phy
453
454	END MODULE infotrac_phy

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

Download in other formats:

Original Format