Context Navigation

infotrac.F90 @ 5008

Last change on this file since 5008 was 4485, checked in by evignon, 20 months ago
premier commit pour l'ajout de la neige soufflee sur la nouvelle branche
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: 27.5 KB

Line
1	!$Id: infotrac.F90 4485 2023-03-30 07:07:40Z abarral $
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, nzone, tran0, isoZone, &
7	delPhase, niso, getKey, isot_type, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, nphas, ixIso, isoPhas, &
8	addPhase, iH2O, nbIso, isoSelect, testTracersFiles, isoKeys, indexUpdate, isoCheck, nzone, ntiso, isoName, &
9	addKey
10	IMPLICIT NONE
11
12	PRIVATE
13
14	!=== FOR TRACERS:
15	PUBLIC :: init_infotrac !--- 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
20	!=== FOR ISOTOPES: General
21	PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families
22	PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index
23	!=== FOR ISOTOPES: Specific to water
24	PUBLIC :: iH2O !--- H2O isotopes class index
25	PUBLIC :: min_qParent, min_qMass, min_ratio !--- Min. values for various isotopic quantities
26	!=== FOR ISOTOPES: Depending on the selected isotopes family
27	PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey)
28	PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases
29	PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number
30	PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
31	PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
32	PUBLIC :: isoCheck !--- Run isotopes checking routines
33	!=== FOR BOTH TRACERS AND ISOTOPES
34	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
35
36	!=== CONVENTIONS FOR TRACERS NUMBERS:
37	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
38	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
39	! \| phases: H2O_[glsb] \| isotopes \| \| \| for higher order schemes \|
40	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
41	! \| \| \| \| \| \|
42	! \|<-- nqo -->\|<-- nqoniso nzone -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
43	! \| \| \| \|
44	! \| \|<-- nqoniso(nzone+1) = nqo*ntiso -->\|<-- nqtottr = nbtr + nmom -->\|
45	! \| = nqtot - nqo*(ntiso+1) \|
46	! \| \|
47	! \|<-- nqtrue = nbtr + nqo*(ntiso+1) -->\| \|
48	! \| \|
49	! \|<-- nqtot = nqtrue + nmom -->\|
50	! \| \|
51	! \|-----------------------------------------------------------------------------------------------------------\|
52	! NOTES FOR THIS TABLE:
53	! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
54	! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
55	! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
56	! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
57	!
58	!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
59	! Each entry is accessible using "%" sign.
60	! \|-------------+------------------------------------------------------+-------------+------------------------+
61	! \| entry \| Meaning \| Former name \| Possible values \|
62	! \|-------------+------------------------------------------------------+-------------+------------------------+
63	! \| name \| Name (short) \| tname \| \|
64	! \| gen0Name \| Name of the 1st generation ancestor \| / \| \|
65	! \| parent \| Name of the parent \| / \| \|
66	! \| longName \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
67	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
68	! \| phase \| Phases list ("g"as / "l"iquid / "s"olid / "b"lowing) \| / \| [g][l][s][b] \|
69	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
70	! \| iGeneration \| Generation (>=1) \| / \| \|
71	! \| iqParent \| Index of the parent tracer \| iqpere \| 1:nqtot \|
72	! \| iqDescen \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
73	! \| nqDescen \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
74	! \| nqChildren \| Number of childs (1st generation only) \| nqfils \| 1:nqtot \|
75	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
76	! \| iadv \| Advection scheme number \| iadv \| 1,2,10-20(exc.15,19),30\|
77	! \| isAdvected \| advected tracers flag (.TRUE. if iadv >= 0) \| / \| nqtrue .TRUE. values \|
78	! \| isInPhysics \| tracers not extracted from the main table in physics \| / \| nqtottr .TRUE. values \|
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	REAL, PARAMETER :: min_qParent = 1.e-30, min_qMass = 1.e-18, min_ratio = 1.e-16 ! MVals et CRisi
100
101	!=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
102	INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O)
103	nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O)
104	nqo, & !--- Number of water phases
105	nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?)
106	nqCO2 !--- Number of tracers of CO2 (ThL)
107	CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type
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
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, texp, ttp !--- Strings for messages and expanded tracers type
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
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
177	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
178	msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
179	SELECT CASE(type_trac)
180	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname)
181	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
182	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
183	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
184	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
185	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
186	CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
187	END SELECT
188
189	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
190	SELECT CASE(type_trac)
191	CASE('inca', 'inco')
192	#ifndef INCA
193	CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
194	#endif
195	CASE('repr')
196	#ifndef REPROBUS
197	CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
198	#endif
199	CASE('coag')
200	#ifndef CPP_StratAer
201	CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
202	#endif
203	END SELECT
204
205	nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
206
207	!==============================================================================================================================
208	! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
209	!==============================================================================================================================
210	texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "\|" SEPARATOR
211	IF(texp == 'inco') texp = 'co2i\|inca'
212	IF(texp /= 'lmdz') texp = 'lmdz\|'//TRIM(texp)
213
214	!=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
215	IF(testTracersFiles(modname, texp, fType, .TRUE.)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
216	ttp = type_trac; IF(fType /= 1) ttp = texp
217
218	IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
219	!---------------------------------------------------------------------------------------------------------------------------
220	IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
221	!---------------------------------------------------------------------------------------------------------------------------
222	IF(fType == 1 .AND. ANY(['inca','inco']==type_trac)) THEN !=== FOUND OLD STYLE INCA "traceur.def"
223	!---------------------------------------------------------------------------------------------------------------------------
224	#ifdef INCA
225	nqo = SIZE(tracers) - nqCO2
226	CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA
227	nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac
228	nqtrue = nbtr + nqo !--- Total number of "true" tracers
229	IF(ALL([2,3,4,5] /= nqo)) CALL abort_gcm(modname, 'Only 2, 3, 4 , 5 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
230	ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
231	ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
232	CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
233	ALLOCATE(ttr(nqtrue))
234	ttr(1:nqo+nqCO2) = tracers
235	ttr(1 : nqo )%component = 'lmdz'
236	ttr(1+nqo:nqCO2+nqo )%component = 'co2i'
237	ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
238	ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca]
239	ttr(1+nqo+nqCO2:nqtrue)%parent = tran0
240	ttr(1+nqo+nqCO2:nqtrue)%phase = 'g'
241	lerr = getKey('hadv', had, ky=tracers(:)%keys)
242	lerr = getKey('vadv', vad, ky=tracers(:)%keys)
243	hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
244	vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
245	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
246	DO iq = 1, nqtrue
247	t1 => tracers(iq)
248	CALL addKey('name', t1%name, t1%keys)
249	CALL addKey('component', t1%component, t1%keys)
250	CALL addKey('parent', t1%parent, t1%keys)
251	CALL addKey('phase', t1%phase, t1%keys)
252	END DO
253	IF(setGeneration(tracers)) CALL abort_gcm(modname,'See above',1) !- SET FIELDS %iGeneration, %gen0Name
254	DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
255	#endif
256	!---------------------------------------------------------------------------------------------------------------------------
257	ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
258	!---------------------------------------------------------------------------------------------------------------------------
259	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' &
260	.AND. tracers(:)%component == 'lmdz') !--- Number of water phases
261	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
262	nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
263	.AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
264	#ifdef INCA
265	nqINCA = COUNT(tracers(:)%component == 'inca')
266	#endif
267	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
268	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
269	!---------------------------------------------------------------------------------------------------------------------------
270	END IF
271	!---------------------------------------------------------------------------------------------------------------------------
272
273	#ifdef REPROBUS
274	!--- Transfert the number of tracers to Reprobus
275	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
276
277	#endif
278	!==============================================================================================================================
279	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
280	!==============================================================================================================================
281	DO iq = 1, nqtrue
282	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
283	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
284	CALL abort_gcm(modname, TRIM(msg1), 1)
285	END DO
286	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
287	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
288	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
289
290	!--- More tracers due to the choice of advection scheme => assign total number of tracers
291	IF( nqtot /= nqtrue ) THEN
292	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
293	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
294	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
295	END IF
296
297	!==============================================================================================================================
298	! 3) Determine the advection scheme choice for water and tracers "iadv" and the fields long name, isAdvected.
299	! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV
300	! iadv = 2 backward (for H2O liquid) BAK
301	! iadv = 14 Van-Leer + specific humidity, modified by Francis Codron VLH
302	! iadv = 10 Van-Leer (chosen for vapour and liquid water) VL1
303	! iadv = 11 Van-Leer for hadv and PPM version (Monotonic) for vadv VLP
304	! iadv = 12 Frederic Hourdin I FH1
305	! iadv = 13 Frederic Hourdin II FH2
306	! iadv = 16 Monotonic PPM (Collela & Woodward 1984) PPM
307	! iadv = 17 Semi-monotonic PPM (overshoots allowed) PPS
308	! iadv = 18 Definite positive PPM (overshoots and undershoots allowed) PPP
309	! iadv = 20 Slopes SLP
310	! iadv = 30 Prather PRA
311	!
312	! In array q(ij,l,iq) : iq = 1/2[/3] for vapour/liquid[/ice] water
313	! And optionaly: iq = 3[4],nqtot for other tracers
314	!==============================================================================================================================
315	ALLOCATE(ttr(nqtot))
316	jq = nqtrue+1; tracers(:)%iadv = -1
317	DO iq = 1, nqtrue
318	t1 => tracers(iq)
319
320	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
321	iad = -1
322	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
323	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
324	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
325	IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
326
327	!--- SET FIELDS %longName, %iadv, %isAdvected, %isInPhysics
328	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
329	t1%iadv = iad
330	t1%isAdvected = iad >= 0
331	t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
332	.OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
333	ttr(iq) = t1
334
335	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
336	nm = 0
337	IF(iad == 20) nm = 3 !--- 2nd order scheme
338	IF(iad == 30) nm = 9 !--- 3rd order scheme
339	IF(nm == 0) CYCLE !--- No higher moments
340	ttr(jq+1:jq+nm) = t1
341	ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
342	ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
343	ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
344	ttr(jq+1:jq+nm)%iadv = [(-iad, im=1, nm) ]
345	ttr(jq+1:jq+nm)%isAdvected = [(.FALSE., im=1, nm) ]
346	jq = jq + nm
347	END DO
348	DEALLOCATE(hadv, vadv)
349	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
350
351	!--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
352	CALL indexUpdate(tracers)
353
354	!=== TEST ADVECTION SCHEME
355	DO iq=1,nqtot ; t1 => tracers(iq); iad = t1%iadv
356
357	!--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0 for non-transported tracers)
358	IF(ALL([10,14,0] /= iad)) &
359	CALL abort_gcm(modname, 'Not tested for iadv='//TRIM(int2str(iad))//' ; 10 or 14 only are allowed !', 1)
360
361	!--- ONLY TESTED VALUES FOR PARENTS HAVING CHILDS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
362	IF(ALL([10,14] /= iad) .AND. t1%iGeneration == 1 .AND. ANY(tracers(:)%iGeneration > 1)) &
363	CALL abort_gcm(modname, 'iadv='//TRIM(int2str(iad))//' not implemented for parents ; 10 or 14 only are allowed !', 1)
364
365	!--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1)
366	IF(fmsg('WARNING ! iadv='//TRIM(int2str(iad))//' not implemented for childs. Setting iadv=10 for "'//TRIM(t1%name)//'"',&
367	modname, iad /= 10 .AND. t1%iGeneration > 1)) t1%iadv = 10
368
369	!--- ONLY VALID SCHEME NUMBER FOR WATER VAPOUR: iadv = 14
370	ll = t1%name /= addPhase('H2O','g')
371	IF(fmsg('WARNING ! iadv=14 is valid for water vapour only. Setting iadv=10 for "'//TRIM(t1%name)//'".', &
372	modname, iad == 14 .AND. ll)) t1%iadv = 10
373	END DO
374
375	!=== READ PHYSICAL PARAMETERS FOR ISOTOPES ; DONE HERE BECAUSE dynetat0 AND iniacademic NEED "tnat" AND "alpha_ideal"
376	niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
377	IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
378
379	!--- Convection / boundary layer activation for all tracers
380	ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
381	ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
382
383	!--- Note: nqtottr can differ from nbtr when nmom/=0
384	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
385	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
386	CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
387
388	!=== DISPLAY THE RESULTS
389	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
390	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
391	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
392	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
393	CALL msg('niso = '//TRIM(int2str(niso)), modname)
394	CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)
395	#ifdef INCA
396	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
397	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
398	#endif
399	t => tracers
400	CALL msg('Information stored in infotrac :', modname)
401	IF(dispTable('isssssssssiiiiiiiii', &
402	['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', 'isAdv ', &
403	'iadv ', 'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], &
404	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics), &
405	bool2str(t%isAdvected)), &
406	cat([(iq, iq=1, nqtot)], t%iadv, t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
407	t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &
408	CALL abort_gcm(modname, "problem with the tracers table content", 1)
409	IF(niso > 0) THEN
410	CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
411	CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname)
412	CALL msg(' isoName = '//strStack(isoName), modname)
413	CALL msg(' isoZone = '//strStack(isoZone), modname)
414	CALL msg(' isoPhas = '//TRIM(isoPhas), modname)
415	ELSE
416	CALL msg('No isotopes identified.', modname)
417	END IF
418	CALL msg('end', modname)
419
420	END SUBROUTINE init_infotrac
421
422	END MODULE infotrac

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

Download in other formats:

Original Format