Context Navigation

infotrac_phy.F90 @ 4667

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

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

Download in other formats:

Original Format