Context Navigation

infotrac_phy.F90 @ 5481

Last change on this file since 5481 was 5481, checked in by dcugnet, 13 hours ago
Remove tracers attributes "isAdvected" and "isInPhysics" from infotrac (iadv is enough). Remove tracers attribute "isAdvected" from infotrac_phy (isInPhysics is now equivalent to former isInPhysics .AND. iadv > 0
File size: 28.4 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, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strCount, strIdx
6	USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, addPhase, addKey, iH2O, &
7	isoSelect, indexUpdate, isot_type, testTracersFiles, isotope, delPhase, getKey, tran0, &
8	isoKeys, isoName, isoZone, isoPhas, processIsotopes, isoCheck, itZonIso, nbIso, &
9	niso, ntiso, nzone, nphas, maxTableWidth, iqIsoPha, iqWIsoPha, ixIso, new2oldH2O
10	IMPLICIT NONE
11
12	PRIVATE
13
14	!=== FOR TRACERS:
15	PUBLIC :: init_infotrac_phy !--- Initialization of the tracers
16	PUBLIC :: tracers, type_trac !--- Full tracers database, tracers type keyword
17	PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions
18	PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys
19	PUBLIC :: new2oldH2O !--- For backwards compatibility in phyetat0
20	PUBLIC :: addPhase, delPhase !--- Add/remove the phase from the name of a tracer
21	PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model
22	PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
23
24	!=== FOR ISOTOPES: General
25	PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families
26	PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index
27	!=== FOR ISOTOPES: Specific to water
28	PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class
29	PUBLIC :: ivap, iliq, isol, ibs, icf, irvc
30	!=== FOR ISOTOPES: Depending on the selected isotopes family
31	PUBLIC :: isotope !--- Selected isotopes database (argument of getKey)
32	PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases
33	PUBLIC :: niso, ntiso, nzone, nphas !--- Number of " "
34	PUBLIC :: itZonIso !--- Index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx)
35	PUBLIC :: iqIsoPha !--- Index "iq" in "qx" = f(isotope idx, phase idx)
36	PUBLIC :: iqWIsoPha !--- Same as iqIsoPha but with normal water phases
37	PUBLIC :: isoCheck !--- Run isotopes checking routines
38	!=== FOR BOTH TRACERS AND ISOTOPES
39	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
40
41	!=== CONVENTIONS FOR TRACERS NUMBERS:
42	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
43	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
44	! \| phases: H2O_[glsrb]\| isotopes \| \| \| for higher order schemes \|
45	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
46	! \| \| \| \| \| \|
47	! \|<-- nqo -->\|<-- nqoniso nzone -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
48	! \| \| \| \|
49	! \| \|<-- nqoniso(nzone+1) = nqo*ntiso -->\|<-- nqtottr = nbtr + nmom -->\|
50	! \| = nqtot - nqo*(ntiso+1) \|
51	! \| \|
52	! \|<-- nqtrue = nbtr + nqo*(ntiso+1) -->\| \|
53	! \| \|
54	! \|<-- nqtot = nqtrue + nmom -->\|
55	! \| \|
56	! \|-----------------------------------------------------------------------------------------------------------\|
57	! NOTES FOR THIS TABLE:
58	! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
59	! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
60	! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
61	! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
62	!
63	!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
64	! Each entry is accessible using "%" sign.
65	! \|-------------+------------------------------------------------------+-------------+------------------------+
66	! \| entry \| Meaning \| Former name \| Possible values \|
67	! \|-------------+------------------------------------------------------+-------------+------------------------+
68	! \| name \| Name (short) \| tname \| \|
69	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
70	! \| gen0Name \| Name of the 1st generation ancestor \| / \| \|
71	! \| parent \| Name of the parent \| / \| \|
72	! \| longName \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
73	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
74	! \| phase \| Phases list ("g"as / "l"iquid / "s"olid \| \| [g\|l\|s\|r\|b] \|
75	! \| \| "r"(cloud) / "b"lowing) \| / \| \|
76	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
77	! \| iGeneration \| Generation (>=1) \| / \| \|
78	! \| iqParent \| Index of the parent tracer \| iqpere \| 1:nqtot \|
79	! \| iqDescen \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
80	! \| nqDescen \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
81	! \| nqChildren \| Number of childs (1st generation only) \| nqfils \| 1:nqtot \|
82	! \| isInPhysics \| Advected tracers from the main table kept in physics \| / \| nqtottr .TRUE. values \|
83	! \| iso_iGroup \| Isotopes group index in isotopes(:) \| / \| 1:nbIso \|
84	! \| iso_iName \| Isotope name index in isotopes(iso_iGroup)%trac(:) \| iso_indnum \| 1:niso \|
85	! \| iso_iZone \| Isotope zone index in isotopes(iso_iGroup)%zone(:) \| zone_num \| 1:nzone \|
86	! \| iso_iPhas \| Isotope phase index in isotopes(iso_iGroup)%phas(:) \| phase_num \| 1:nphas \|
87	! +-------------+------------------------------------------------------+-------------+------------------------+
88	!
89	!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
90	! Each entry is accessible using "%" sign.
91	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
92	! \| entry \| length \| Meaning \| Former name \| Possible values \|
93	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
94	! \| parent \| Parent tracer (isotopes family name) \| \| \|
95	! \| keys \| niso \| Isotopes keys/values pairs list + number \| \| \|
96	! \| trac \| ntiso \| Isotopes + tagging tracers list + number \| / \| ntraciso \| \|
97	! \| zone \| nzone \| Geographic tagging zones list + number \| / \| ntraceurs_zone \| \|
98	! \| phase \| nphas \| Phases list + number \| \| [g\|l\|s\|r\|b] 1:5 \|
99	! \| iqIsoPha \| Index in "qx" = f(name(1:ntiso)),phas) \| iqiso \| 1:nqtot \|
100	! \| iqWIsoPha \| Index in "qx" = f(name(1:ntiso+nqo)),phas) \| / \| 1:nqtot \|
101	! \| itZonIso \| Index in "trac(1:ntiso)"= f(zone, name(1:niso)) \| index_trac \| 1:ntiso \|
102	! +-----------------+--------------------------------------------------+--------------------+-----------------+
103
104	!=== INDICES FOR WATER
105	INTEGER, SAVE :: ivap, iliq, isol, ibs, icf, irvc
106	!$OMP THREADPRIVATE(ivap, iliq, isol, ibs, icf, irvc)
107
108	!=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
109	INTEGER, SAVE :: nqtot !--- Tracers nb in dynamics (incl. higher moments + H2O)
110	INTEGER, SAVE :: nbtr !--- Tracers nb in physics (excl. higher moments + H2O)
111	INTEGER, SAVE :: nqo !--- Number of water phases
112	INTEGER, SAVE :: nqtottr !--- Number of tracers passed to phytrac (TO BE DELETED ?)
113	INTEGER, SAVE :: nqCO2 !--- Number of tracers of CO2 (ThL)
114	CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s)
115	!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
116
117	!=== VARIABLES FOR INCA
118	INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), pbl_flg(:) !--- Convection / boundary layer activation (nbtr)
119	!$OMP THREADPRIVATE(conv_flg, pbl_flg)
120
121	!=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
122	INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model
123	!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
124	INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
125	!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
126
127	CONTAINS
128
129	SUBROUTINE init_infotrac_phy
130	USE iniprint_mod_h
131	USE ioipsl_getin_p_mod, ONLY: getin_p
132	USE lmdz_reprobus_wrappers, ONLY: Init_chem_rep_trac
133	USE lmdz_cppkeys_wrapper, ONLY: CPPKEY_INCA, CPPKEY_REPROBUS, CPPKEY_STRATAER
134	USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master
135	IMPLICIT NONE
136	!==============================================================================================================================
137	!
138	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
139	! -------
140	!
141	! Modifications:
142	! --------------
143	! 05/94: F.Forget Modif special traceur
144	! 02/02: M-A Filiberti Lecture de traceur.def
145	! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
146	!
147	! Objet:
148	! ------
149	! GCM LMD nouvelle grille
150	!
151	!==============================================================================================================================
152	! ... modification de l'integration de q ( 26/04/94 ) ....
153	!------------------------------------------------------------------------------------------------------------------------------
154	! Declarations:
155
156
157	!------------------------------------------------------------------------------------------------------------------------------
158	! Local variables
159	INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number
160	INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
161	vad (:), vadv_inca(:), pbl_flg_inca(:)
162	CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA
163	INTEGER :: nqINCA
164	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
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, texp, ttp !--- Strings for messages and expanded tracers type
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 :: iq, jq, nt, im, nm !--- Indexes and temporary variables
173	LOGICAL :: lerr, lInit
174	TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
175	TYPE(trac_type), POINTER :: t1, t(:)
176	CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keywords for tracers type(s), parsed version
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
189	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master)
190	IF(strCount(type_trac, '\|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "\|"', 1)
191	IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
192	IF(strParse(type_trac, '\|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1)
193	IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON
194
195	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
196	lInit = .NOT.ALLOCATED(tracers)
197
198	!##############################################################################################################################
199	IF(lInit .AND. is_master) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
200	!##############################################################################################################################
201	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
202	msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
203	SELECT CASE(type_trac)
204	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname)
205	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
206	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
207	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
208	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
209	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
210	CASE DEFAULT; CALL abort_physic(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
211	END SELECT
212
213	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
214	SELECT CASE(type_trac)
215	CASE('inca', 'inco')
216	IF(.NOT.CPPKEY_INCA) CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1)
217	CASE('repr')
218	IF(.NOT.CPPKEY_REPROBUS) CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
219	CASE('coag')
220	IF(.NOT.CPPKEY_STRATAER) CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
221	END SELECT
222	!##############################################################################################################################
223	END IF
224	!##############################################################################################################################
225
226	!==============================================================================================================================
227	! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT
228	!==============================================================================================================================
229	texp = type_trac !=== EXPANDED (WITH "\|" SEPARATOR) "type_trac"
230	IF(texp == 'inco') texp = 'co2i\|inca'
231	IF(texp /= 'lmdz') texp = 'lmdz\|'//TRIM(texp)
232	IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
233	ttp = type_trac; IF(fType /= 1) ttp = texp
234	!---------------------------------------------------------------------------------------------------------------------------
235	IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1)
236	!---------------------------------------------------------------------------------------------------------------------------
237	IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def"
238	CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1)
239	!---------------------------------------------------------------------------------------------------------------------------
240
241	!##############################################################################################################################
242	IF(lInit) THEN
243	IF(readTracersFiles(ttp, lRepr=type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
244	END IF
245	CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master)
246	!##############################################################################################################################
247
248	!==============================================================================================================================
249	! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
250	!==============================================================================================================================
251	nqtrue = SIZE(tracers) !--- "true" tracers
252	nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases
253	nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac
254	nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
255	IF(CPPKEY_INCA) &
256	nqINCA = COUNT(tracers(:)%component == 'inca')
257	IF(CPPKEY_REPROBUS) CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus
258
259	!##############################################################################################################################
260	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
261	!##############################################################################################################################
262
263	!==============================================================================================================================
264	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
265	!==============================================================================================================================
266	IF(getKey('hadv', hadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "hadv"', 1)
267	IF(getKey('vadv', vadv, ky=tracers(:)%keys)) CALL abort_physic(modname, 'missing key "vadv"', 1)
268	DO iq = 1, nqtrue
269	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
270	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
271	CALL abort_physic(modname, TRIM(msg1), 1)
272	END DO
273	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
274	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
275	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
276
277	!--- More tracers due to the choice of advection scheme => assign total number of tracers
278	IF( nqtot /= nqtrue ) THEN
279	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
280	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
281	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
282	END IF
283
284	!==============================================================================================================================
285	! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot
286	!==============================================================================================================================
287	ALLOCATE(ttr(nqtot))
288	jq = nqtrue+1
289	DO iq = 1, nqtrue
290	t1 => tracers(iq)
291
292	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
293	iad = -1
294	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
295	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
296	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
297	IF(iad == -1) CALL abort_physic(modname, msg1, 1)
298
299	!--- SET FIELDS longName, isInPhysics
300	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
301	t1%isInPhysics= iad >= 0 .AND. (delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz')
302	ttr(iq) = t1
303
304	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
305	nm = 0
306	IF(iad == 20) nm = 3 !--- 2nd order scheme
307	IF(iad == 30) nm = 9 !--- 3rd order scheme
308	IF(nm == 0) CYCLE !--- No higher moments
309	ttr(jq+1:jq+nm) = t1
310	ttr(jq+1:jq+nm)%name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
311	ttr(jq+1:jq+nm)%gen0Name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
312	ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
313	ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
314	ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ]
315	jq = jq + nm
316	END DO
317	DEALLOCATE(hadv, vadv)
318	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
319
320	!--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren, iGeneration
321	IF(indexUpdate(tracers)) CALL abort_physic(modname, 'problem with tracers indices update', 1)
322
323	!##############################################################################################################################
324	END IF
325	!##############################################################################################################################
326
327	!##############################################################################################################################
328	IF(.NOT.lInit) THEN
329	!##############################################################################################################################
330	nqtot = SIZE(tracers)
331	!##############################################################################################################################
332	ELSE
333	!##############################################################################################################################
334
335	!=== READ PHYSICAL PARAMETERS FOR ISOTOPES
336	niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
337	IF(processIsotopes()) CALL abort_physic(modname, 'Problem when processing isotopes parameters', 1)
338
339	!##############################################################################################################################
340	END IF
341	!##############################################################################################################################
342	!--- Convection / boundary layer activation for all tracers
343	IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
344	IF(.NOT.ALLOCATED( pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
345
346	!--- Note: nqtottr can differ from nbtr when nmom/=0
347	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
348	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
349	CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
350
351	!--- Compute indices for water
352	ivap = strIdx(tracers(:)%name, addPhase('H2O', 'g'))
353	iliq = strIdx(tracers(:)%name, addPhase('H2O', 'l'))
354	isol = strIdx(tracers(:)%name, addPhase('H2O', 's'))
355	ibs = strIdx(tracers(:)%name, addPhase('H2O', 'b'))
356	icf = strIdx(tracers(:)%name, addPhase('H2O', 'f'))
357	irvc = strIdx(tracers(:)%name, addPhase('H2O', 'c'))
358
359	IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN
360	nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
361	nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
362	tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
363	id_BIN01_strat = strIdx(tnames, 'BIN01' )
364	id_OCS_strat = strIdx(tnames, 'GASOCS' )
365	id_SO2_strat = strIdx(tnames, 'GASSO2' )
366	id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
367	id_TEST_strat = strIdx(tnames, 'GASTEST' )
368	END IF
369
370	!=== DISPLAY THE RESULTS
371	IF(.NOT.is_master) RETURN
372	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
373	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
374	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
375	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
376	CALL msg('niso = '//TRIM(int2str(niso)), modname)
377	CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)
378	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname, CPPKEY_INCA)
379	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname, CPPKEY_INCA)
380	t => tracers
381	CALL msg('Information stored in '//TRIM(modname)//': ', modname)
382	IF(dispTable('issssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', &
383	'isPh', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], &
384	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
385	cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
386	t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &
387	CALL abort_physic(modname, "problem with the tracers table content", 1)
388	CALL msg('No isotopes identified.', modname, nbIso == 0)
389	IF(nbIso == 0) RETURN
390	CALL msg('For isotopes family "H2O":', modname)
391	CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname)
392	CALL msg(' isoName = '//strStack(isoName), modname)
393	CALL msg(' isoZone = '//strStack(isoZone), modname)
394	CALL msg(' isoPhas = '//TRIM(isoPhas), modname)
395
396	IF(CPPKEY_STRATAER .AND. type_trac == 'coag') THEN
397	CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname)
398	CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname)
399	CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
400	CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname)
401	CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname)
402	CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
403	CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname)
404	END IF
405
406	END SUBROUTINE init_infotrac_phy
407
408	END MODULE infotrac_phy

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

Download in other formats:

Original Format