Context Navigation

infotrac.F90 @ 4325

Last change on this file since 4325 was 4325, checked in by dcugnet, 20 months ago
simplify the parser usage: the getKey_init routine is now embedded in the readTracersFile routine. the initIsotopes routine is now embedded in the readIsotopesFile routine. the database is now unique, but can be changed using the get/setKeysDBase. the derived types descriptions, originally located in trac_types_mod, are moved to readTracFiles_mod. few checkings moved from infotrac to the routine testIsotopes, contained in the readIsotopesFile function from readTracFiles_mod. the readTracersFiles and readIsotopesFile routines no longer use a tracers/isotopes argument. remove tnat and alpha_ideal from infotrac ; use instead getKey to get them where they are used (check_isotopes, dynetat0, iniacademic) the trac_type field %Childs is renamed %Children move the isoSelect routine and the corresponding variables routine from infotrac and infotrac_phy to readTracFiles_mod infotrac_phy routine is now fully independant of the (very similar) routine infotrac (init_infotrac_phy has no arguments left). all the explicit keys of the trac_type are now included in the embedded keys database, accessible using the getKey function. the getKey/addKey routines are expanded to handle vectors of integers, reals, logicals or strings. few subroutines converted into functions with error return value. corrections for isotopic tagging tracers mode (to be continued).
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Id`
File size: 28.4 KB

Line
1	!$Id: infotrac.F90 4325 2022-11-07 02:09:43Z dcugnet $
2	!
3	MODULE infotrac
4
5	USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse
6	USE readTracFiles_mod, ONLY: trac_type, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, &
7	getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, &
8	indexUpdate, isoSelect, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck, nphas, nzone, niso
9	IMPLICIT NONE
10
11	PRIVATE
12
13	!=== FOR TRACERS:
14	PUBLIC :: init_infotrac !--- 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
19	!=== FOR ISOTOPES: General
20	PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families
21	PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index
22	!=== FOR ISOTOPES: Specific to water
23	PUBLIC :: iH2O !--- H2O isotopes class index
24	PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities
25	!=== FOR ISOTOPES: Depending on the selected isotopes family
26	PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey)
27	PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases
28	PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number
29	PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
30	PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
31	PUBLIC :: isoCheck !--- Run isotopes checking routines
32	!=== FOR BOTH TRACERS AND ISOTOPES
33	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
34
35	!=== CONVENTIONS FOR TRACERS NUMBERS:
36	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
37	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
38	! \| phases: H2O_[gls] \| isotopes \| \| \| for higher order schemes \|
39	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
40	! \| \| \| \| \| \|
41	! \|<-- nqo -->\|<-- nqoniso nzone -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
42	! \| \| \| \|
43	! \| \|<-- nqoniso(nzone+1) = nqo*ntiso -->\|<-- nqtottr = nbtr + nmom -->\|
44	! \| = nqtot - nqo*(ntiso+1) \|
45	! \| \|
46	! \|<-- nqtrue = nbtr + nqo*(ntiso+1) -->\| \|
47	! \| \|
48	! \|<-- nqtot = nqtrue + nmom -->\|
49	! \| \|
50	! \|-----------------------------------------------------------------------------------------------------------\|
51	! NOTES FOR THIS TABLE:
52	! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
53	! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
54	! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
55	! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
56	!
57	!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
58	! Each entry is accessible using "%" sign.
59	! \|-------------+------------------------------------------------------+-------------+------------------------+
60	! \| entry \| Meaning \| Former name \| Possible values \|
61	! \|-------------+------------------------------------------------------+-------------+------------------------+
62	! \| name \| Name (short) \| tname \| \|
63	! \| gen0Name \| Name of the 1st generation ancestor \| / \| \|
64	! \| parent \| Name of the parent \| / \| \|
65	! \| longName \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
66	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
67	! \| phase \| Phases list ("g"as / "l"iquid / "s"olid) \| / \| [g][l][s] \|
68	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
69	! \| iadv \| Advection scheme number \| iadv \| 1-20,30 exc. 3-9,15,19 \|
70	! \| iGeneration \| Generation (>=1) \| / \| \|
71	! \| isAdvected \| advected tracers flag (.TRUE. if iadv >= 0) \| / \| nqtrue .TRUE. values \|
72	! \| isInPhysics \| tracers not extracted from the main table in physics \| / \| nqtottr .TRUE. values \|
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	! \| iso_iGroup \| Isotopes group index in isotopes(:) \| / \| 1:nbIso \|
78	! \| iso_iName \| Isotope name index in isotopes(iso_iGroup)%trac(:) \| iso_indnum \| 1:niso \|
79	! \| iso_iZone \| Isotope zone index in isotopes(iso_iGroup)%zone(:) \| zone_num \| 1:nzone \|
80	! \| iso_iPhas \| Isotope phase index in isotopes(iso_iGroup)%phas(:) \| phase_num \| 1:nphas \|
81	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
82	! +-------------+------------------------------------------------------+-------------+------------------------+
83	!
84	!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
85	! Each entry is accessible using "%" sign.
86	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
87	! \| entry \| length \| Meaning \| Former name \| Possible values \|
88	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
89	! \| parent \| Parent tracer (isotopes family name) \| \| \|
90	! \| keys \| niso \| Isotopes keys/values pairs list + number \| \| \|
91	! \| trac \| ntiso \| Isotopes + tagging tracers list + number \| / \| ntraciso \| \|
92	! \| zone \| nzone \| Geographic tagging zones list + number \| / \| ntraceurs_zone \| \|
93	! \| phase \| nphas \| Phases list + number \| \| [g][l][s], 1:3 \|
94	! \| iqIsoPha \| Index in "qx" = f(name(1:ntiso)),phas) \| iqiso \| 1:nqtot \|
95	! \| itZonIso \| Index in "trac(1:ntiso)"= f(zone, name(1:niso)) \| index_trac \| 1:ntiso \|
96	! +-----------------+--------------------------------------------------+--------------------+-----------------+
97
98	REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
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	CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: types_trac(:) !--- Keyword for tracers type(s), parsed version
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
113	CONTAINS
114
115	SUBROUTINE init_infotrac
116	USE control_mod, ONLY: planet_type, config_inca
117	#ifdef REPROBUS
118	USE CHEM_REP, ONLY: Init_chem_rep_trac
119	#endif
120	IMPLICIT NONE
121	!==============================================================================================================================
122	!
123	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
124	! -------
125	!
126	! Modifications:
127	! --------------
128	! 05/94: F.Forget Modif special traceur
129	! 02/02: M-A Filiberti Lecture de traceur.def
130	! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
131	!
132	! Objet:
133	! ------
134	! GCM LMD nouvelle grille
135	!
136	!==============================================================================================================================
137	! ... modification de l'integration de q ( 26/04/94 ) ....
138	!------------------------------------------------------------------------------------------------------------------------------
139	! Declarations:
140	INCLUDE "dimensions.h"
141	INCLUDE "iniprint.h"
142
143	!------------------------------------------------------------------------------------------------------------------------------
144	! Local variables
145	INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number
146	#ifdef INCA
147	INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
148	vad (:), vadv_inca(:), pbl_flg_inca(:)
149	CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA
150	INTEGER :: nqINCA
151	#endif
152	CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather)
153	CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags
154	CHARACTER(LEN=maxlen) :: msg1 !--- String for messages
155	INTEGER :: fType !--- Tracers description file type ; 0: none
156	!--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
157	INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments)
158	INTEGER :: iad !--- Advection scheme number
159	INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables
160	LOGICAL :: lerr, ll, lRepr
161	CHARACTER(LEN=1) :: p
162	TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
163	TYPE(trac_type), POINTER :: t1, t(:)
164	INTEGER :: ierr
165
166	CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac"
167	!------------------------------------------------------------------------------------------------------------------------------
168	! Initialization :
169	!------------------------------------------------------------------------------------------------------------------------------
170	suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
171	descrq( 1: 2) = ['LMV','BAK']
172	descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP']
173	descrq(30) = 'PRA'
174
175	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
176	IF(strParse(type_trac, '\|', types_trac, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
177
178	!---------------------------------------------------------------------------------------------------------------------------
179	DO it = 1, nt !--- nt>1=> "type_trac": coma-separated keywords list
180	!---------------------------------------------------------------------------------------------------------------------------
181	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
182	msg1 = 'For type_trac = "'//TRIM(types_trac(it))//'":'
183	SELECT CASE(types_trac(it))
184	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca, modname)
185	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
186	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
187	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
188	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
189	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
190	CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(types_trac(it))//' not possible yet.',1)
191	END SELECT
192
193	!--- COHERENCE TEST BETWEEN "type_trac" AND "config_inca"
194	IF(ANY(['inca', 'inco'] == types_trac(it)) .AND. ALL(['aero', 'aeNP', 'chem'] /= config_inca)) &
195	CALL abort_gcm(modname, 'Incoherence between type_trac and config_inca. Please modify "run.def"',1)
196
197	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
198	SELECT CASE(types_trac(it))
199	CASE('inca', 'inco')
200	#ifndef INCA
201	CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
202	#endif
203	CASE('repr')
204	#ifndef REPROBUS
205	CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
206	#endif
207	CASE('coag')
208	#ifndef CPP_StratAer
209	CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
210	#endif
211	END SELECT
212
213	!---------------------------------------------------------------------------------------------------------------------------
214	END DO
215	!---------------------------------------------------------------------------------------------------------------------------
216
217	!--- DISABLE "config_inca" OPTION FOR A RUN WITHOUT "INCA" IF IT DIFFERS FROM "none"
218	IF(fmsg('Setting config_inca="none" as you do not couple with INCA model', &
219	modname, ALL(types_trac /= 'inca') .AND. ALL(types_trac /= 'inco') .AND. config_inca /= 'none')) config_inca = 'none'
220
221	nqCO2 = COUNT( [ANY(types_trac == 'inco') .OR. (ANY(types_trac == 'co2i') .AND. ANY(types_trac == 'inca'))] )
222
223	!==============================================================================================================================
224	! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
225	!==============================================================================================================================
226	lRepr = ANY(types_trac(:) == 'repr')
227	IF(readTracersFiles(type_trac, fType, lRepr)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
228	!---------------------------------------------------------------------------------------------------------------------------
229	IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
230	!---------------------------------------------------------------------------------------------------------------------------
231	IF(fType == 1 .AND. ANY(['inca','inco'] == type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def" (single type_trac)
232	!---------------------------------------------------------------------------------------------------------------------------
233	#ifdef INCA
234	nqo = SIZE(tracers) - nqCO2
235	CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA
236	nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac
237	nqtrue = nbtr + nqo !--- Total number of "true" tracers
238	IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
239	ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
240	ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
241	CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
242	ALLOCATE(ttr(nqtrue))
243	ttr(1:nqo+nqCO2) = tracers
244	ttr(1 : nqo )%component = 'lmdz'
245	ttr(1+nqo:nqCO2+nqo )%component = 'co2i'
246	ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
247	ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca]
248	ttr(1+nqo+nqCO2:nqtrue)%parent = tran0
249	ttr(1+nqo+nqCO2:nqtrue)%phase = 'g'
250	lerr = getKey('hadv', had, ky=tracers(:)%keys)
251	lerr = getKey('vadv', vad, ky=tracers(:)%keys)
252	hadv(1:nqo) = had(:); hadv(nqo+1:nqtrue) = hadv_inca
253	vadv(1:nqo) = vad(:); vadv(nqo+1:nqtrue) = vadv_inca
254	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
255	CALL setGeneration(tracers) !--- SET FIELDS %iGeneration, %gen0Name
256	DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
257	#endif
258	!---------------------------------------------------------------------------------------------------------------------------
259	ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
260	!---------------------------------------------------------------------------------------------------------------------------
261	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' &
262	.AND. tracers(:)%component == 'lmdz') !--- Number of water phases
263	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
264	nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
265	.AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
266	#ifdef INCA
267	nqINCA = COUNT(tracers(:)%component == 'inca')
268	#endif
269	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
270	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
271	!---------------------------------------------------------------------------------------------------------------------------
272	END IF
273	!---------------------------------------------------------------------------------------------------------------------------
274
275	!--- Transfert the number of tracers to Reprobus
276	#ifdef REPROBUS
277	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
278	#endif
279
280	!==============================================================================================================================
281	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
282	!==============================================================================================================================
283	DO iq = 1, nqtrue
284	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
285	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
286	CALL abort_gcm(modname, TRIM(msg1), 1)
287	END DO
288	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
289	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
290	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
291
292	!--- More tracers due to the choice of advection scheme => assign total number of tracers
293	IF( nqtot /= nqtrue ) THEN
294	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
295	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
296	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
297	END IF
298
299	!==============================================================================================================================
300	! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
301	! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV
302	! iadv = 2 backward (for H2O liquid) BAK
303	! iadv = 14 Van-Leer + specific humidity, modified by Francis Codron VLH
304	! iadv = 10 Van-Leer (chosen for vapour and liquid water) VL1
305	! iadv = 11 Van-Leer for hadv and PPM version (Monotonic) for vadv VLP
306	! iadv = 12 Frederic Hourdin I FH1
307	! iadv = 13 Frederic Hourdin II FH2
308	! iadv = 16 Monotonic PPM (Collela & Woodward 1984) PPM
309	! iadv = 17 Semi-monotonic PPM (overshoots allowed) PPS
310	! iadv = 18 Definite positive PPM (overshoots and undershoots allowed) PPP
311	! iadv = 20 Slopes SLP
312	! iadv = 30 Prather PRA
313	!
314	! In array q(ij,l,iq) : iq = 1/2[/3] for vapour/liquid[/ice] water
315	! And optionaly: iq = 3[4],nqtot for other tracers
316	!==============================================================================================================================
317	ALLOCATE(ttr(nqtot))
318	jq = nqtrue+1; tracers(:)%iadv = -1
319	DO iq = 1, nqtrue
320	t1 => tracers(iq)
321
322	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
323	iad = -1
324	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
325	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
326	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
327	IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
328
329	!--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics
330	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
331	t1%iadv = iad
332	t1%isAdvected = iad >= 0
333	t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
334	.OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
335	ttr(iq) = t1
336
337	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
338	nm = 0
339	IF(iad == 20) nm = 3 !--- 2nd order scheme
340	IF(iad == 30) nm = 9 !--- 3rd order scheme
341	IF(nm == 0) CYCLE !--- No higher moments
342	ttr(jq+1:jq+nm) = t1
343	ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
344	ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
345	ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
346	ttr(jq+1:jq+nm)%iadv = [(-iad, im=1, nm) ]
347	ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ]
348	jq = jq + nm
349	END DO
350	DEALLOCATE(hadv, vadv)
351	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
352
353	!--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
354	CALL indexUpdate(tracers)
355
356	!=== TEST ADVECTION SCHEME
357	DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv
358
359	!--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers)
360	IF(ALL([10,14,0] /= iad)) &
361	CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1)
362
363	!--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
364	IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
365	CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1)
366
367	!--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1)
368	IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',&
369	modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
370
371	!--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14
372	ll = t1%name /= addPhase('H2O','g')
373	IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', &
374	modname, iad == 14 .AND. ll)) t1%iadv = 10
375	END DO
376
377	!=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
378	niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
379	IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
380
381	!--- Convection / boundary layer activation for all tracers
382	ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
383	ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
384
385	!--- Note: nqtottr can differ from nbtr when nmom/=0
386	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
387	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
388	CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
389
390	!=== DISPLAY THE RESULTS
391	IF(prt_level > 1) THEN
392	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
393	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
394	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
395	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
396	CALL msg('niso = '//TRIM(int2str(niso)), modname)
397	CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)
398	#ifdef INCA
399	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
400	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
401	#endif
402	END IF
403	t => tracers
404	CALL msg('Information stored in infotrac :', modname)
405	IF(dispTable('isssssssssiiiiiiiii', &
406	['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
407	'iadv ', 'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], &
408	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
409	bool2str(t%isAdvected)), &
410	cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
411	t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &
412	CALL abort_gcm(modname, "problem with the tracers table content", 1)
413	IF(niso > 0) THEN
414	CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
415	CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname)
416	CALL msg(' isoName = '//strStack(isoName), modname)
417	CALL msg(' isoZone = '//strStack(isoZone), modname)
418	CALL msg(' isoPhas = '//TRIM(isoPhas), modname)
419	ELSE
420	CALL msg('No isotopes identified.', modname)
421	END IF
422	CALL msg('end', modname)
423
424	END SUBROUTINE init_infotrac
425
426	END MODULE infotrac

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

Download in other formats:

Original Format