Context Navigation

infotrac.F90 @ 3960

Last change on this file since 3960 was 3960, checked in by acozic, 3 years ago
remove !$OMP directives to allow parallelisation in openmp infotrac is call outside of a parallel omp zone, all variables in SAVE are shared by all process when we enter in OMP zone. If we put these variables in THREADPRIVATE we need to call bcast to share them.
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: 33.4 KB

Line
1	MODULE infotrac
2
3	USE strings_mod, ONLY: msg, find, strIdx, strFind, strHead, dispTable, testFile, cat, get_in, &
4	fmsg, test, int2str, strParse, strTail, strReduce, strStack, modname
5	USE readTracFiles_mod, ONLY: readTracersFiles, getKey_init, nphases, delPhase, old_phases, aliasTracer, &
6	phases_sep, tran0, readIsotopesFile, getKey, known_phases, addPhase, indexUpdate, initIsotopes
7	USE trac_types_mod, ONLY: tra, iso, kys
8
9	IMPLICIT NONE
10
11	PRIVATE
12
13	!=== FOR TRACERS:
14	PUBLIC :: tra, tracers, type_trac !--- Derived type, full database, tracers type keyword
15	PUBLIC :: nqtot, nbtr, nqo !--- Main dimensions
16	PUBLIC :: infotrac_init, aliasTracer !--- Initialization, tracers alias creation
17	PUBLIC :: itr_indice !--- Indexes of the tracers passed to phytrac
18	PUBLIC :: niadv !--- Indexes of true tracers (<=nqtot, such that iadv(idx)>0)
19	PUBLIC :: solsym, conv_flg, pbl_flg
20
21	!=== FOR ISOTOPES: General
22	!--- General
23	PUBLIC :: iso, isotopes, nbIso !--- Derived type, full isotopes families database + nb of families
24	PUBLIC :: isoSelect , ixIso !--- Isotopes family selection tool + selected family index
25	PUBLIC :: qprntmin, massqmin, ratiomin !--- Min. values
26	!=== FOR ISOTOPES: Specific to H2O isotopes
27	PUBLIC :: iH2O, tnat, alpha_ideal !--- H2O isotopes index, natural abundance, fractionning coeff.
28	!=== FOR ISOTOPES: Depending on 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, nzon, npha, nitr !--- " " numbers + isotopes & tagging tracers number
32	PUBLIC :: iZonIso, iTraPha !--- 2D index tables to get "iq" index
33	PUBLIC :: isoCheck !--- Run isotopes checking routines
34	!=== FOR BOTH TRACERS AND ISOTOPES
35	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
36
37	!=== FOR STRATOSPHERIC AEROSOLS
38	#ifdef CPP_StratAer
39	PUBLIC :: nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat
40	#endif
41
42	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
43
44	!=== CONVENTIONS FOR TRACERS NUMBERS:
45	! \|--------------------+----------------------+-----------------+---------------+----------------------------\|
46	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
47	! \| phases: H2O_[gls] \| isotopes \| \| \| for higher order schemes \|
48	! \|--------------------+----------------------+-----------------+---------------+----------------------------\|
49	! \| \| \| \| \| \|
50	! \|<-- nqo -->\|<-- nqoniso nzon -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
51	! \| \| \| \|
52	! \| \|<-- nqoniso(nzon+1) = nqo*nitr -->\|<-- nqtottr = nbtr + nmom -->\|
53	! \| = nqtot - nqo*(nitr+1) \|
54	! \| \|
55	! \|<-- nqtrue = nbtr + nqo*(nitr+1) -->\| \|
56	! \| \|
57	! \|<-- nqtot = nqtrue + nmom -->\|
58	! \| \|
59	! \|----------------------------------------------------------------------------------------------------------\|
60	! NOTES FOR THIS TABLE:
61	! * The used "niso", "nzon" and "nitr" are the H2O components of "isotopes(ip)" (isotopes(ip)%prnt == 'H2O'),
62	! since water is so far the sole tracers family removed from the main tracers table.
63	! * For water, "nqo" is equal to the more general field "isotopes(ip)%npha".
64	! * "niso", "nzon", "nitr", "npha" are defined for other isotopic tracers families, if any.
65	!
66	!=== TRACERS DESCRIPTOR: DERIVED TYPE EMBEDDING MOST OF THE USEFUL QUANTITIES (LENGTH: nqtot)
67	! Each entry is accessible using "%" sign.
68	! \|------------+-------------------------------------------------+-------------+------------------------+
69	! \| entry \| Meaning \| Former name \| Possible values \|
70	! \|------------+-------------------------------------------------+-------------+------------------------+
71	! \| name \| Name (short) \| tname \| \|
72	! \| nam1 \| Name of the 1st generation ancestor \| / \| \|
73	! \| prnt \| Name of the parent \| / \| \|
74	! \| lnam \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
75	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
76	! \| phas \| Phases list ("g"as / "l"iquid / "s"olid) \| / \| [g][l][s] \|
77	! \| comp \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
78	! \| iadv \| Advection scheme number \| iadv \| 1-20,30 exc. 3-9,15,19 \|
79	! \| igen \| Generation (>=1) \| / \| \|
80	! \| itr \| Index in "tr_seri" (0: absent from physics) \| cf. niadv \| 1:nqtottr \|
81	! \| iprnt \| Index of the parent tracer \| iqpere \| 1:nqtot \|
82	! \| idesc \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
83	! \| ndesc \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
84	! \| nchld \| Number of childs (first generation only) \| nqfils \| 1:nqtot \|
85	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
86	! \| iso_num \| Isotope name index in iso(igr)%name(:) \| iso_indnum \| 1:niso \|
87	! \| iso_zon \| Isotope zone index in iso(igr)%zone(:) \| zone_num \| 1:nzon \|
88	! \| iso_pha \| Isotope phase index in iso(igr)%phas \| phase_num \| 1:npha \|
89	! +------------+-------------------------------------------------+-------------+------------------------+
90	!
91	!=== ISOTOPES DESCRIPTOR: DERIVED TYPE EMBEDDING MOST OF THE USEFUL QUANTITIES (LENGTH: NUMBER OF ISOTOPES FAMILIES USED)
92	! Each entry is accessible using "%" sign.
93	! \|------------+-------------------------------------------------+-------------+-----------------------+
94	! \| entry \| Meaning \| Former name \| Possible values \|
95	! \|------------+-------------------------------------------------+-------------+-----------------------+
96	! \| prnt \| Parent tracer (isotopes family name) \| \| \|
97	! \| trac, nitr \| Isotopes & tagging tracers + number of elements \| \| \|
98	! \| zone, nzon \| Geographic tagging zones + number of elements \| \| \|
99	! \| phas, npha \| Phases list + number of elements \| \| [g][l][s], 1:3 \|
100	! \| niso \| Number of isotopes, excluding tagging tracers \| \| \|
101	! \| iTraPha \| Index in "xt" = f(iname(niso+1:nitr),iphas) \| iqiso \| 1:niso \|
102	! \| iZonIso \| Index in "xt" = f(izone, iname(1:niso)) \| index_trac \| 1:nzon \|
103	! \|------------+-------------------------------------------------+-------------+-----------------------+
104
105
106	REAL, PARAMETER :: qprntmin=1.E-12, massqmin=1.E-12, ratiomin=1.E-12
107
108	!=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
109	INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments & water)
110	nbtr, & !--- Tracers nb in physics (excl. higher moments & water)
111	nqo, & !--- Number of water phases
112	nbIso !--- Number of available isotopes family
113	CHARACTER(LEN=256), SAVE :: type_trac !--- Keyword for tracers type
114
115	!=== DERIVED TYPES EMBEDDING MOST INFORMATIONS ABOUT TRACERS AND ISOTOPES FAMILIES
116	TYPE(tra), TARGET, SAVE, ALLOCATABLE :: tracers(:) !=== TRACERS DESCRIPTORS VECTOR
117	TYPE(iso), TARGET, SAVE, ALLOCATABLE :: isotopes(:) !=== ISOTOPES PARAMETERS VECTOR
118
119	!=== ALIASES FOR CURRENTLY SELECTED ISOTOPES FAMILY OF VARIABLES EMBEDDED IN THE VECTOR "isotopes"
120	TYPE(iso), SAVE, POINTER :: isotope !--- CURRENTLY SELECTED ISOTOPES FAMILY DESCRIPTOR
121	INTEGER, SAVE :: ixIso, iH2O !--- Index of the selected isotopes family and H2O family
122	LOGICAL, SAVE :: isoCheck !--- Flag to trigger the checking routines
123	TYPE(kys), SAVE, POINTER :: isoKeys(:) !--- ONE SET OF KEYS FOR EACH ISOTOPE (LISTED IN isoName)
124	CHARACTER(LEN=256), SAVE, POINTER :: isoName(:), & !--- ISOTOPES NAMES FOR THE CURRENTLY SELECTED FAMILY
125	isoZone(:), & !--- TAGGING ZONES FOR THE CURRENTLY SELECTED FAMILY
126	isoPhas !--- USED PHASES FOR THE CURRENTLY SELECTED FAMILY
127	INTEGER, SAVE :: niso, nzon, & !--- NUMBER OF ISOTOPES, TAGGING ZONES AND PHASES
128	npha, nitr !--- NUMBER OF PHASES AND ISOTOPES + ISOTOPIC TAGGING TRACERS
129	INTEGER, SAVE, POINTER :: iZonIso(:,:) !--- INDEX IN "isoTrac" AS f(tagging zone, isotope)
130	INTEGER, SAVE, POINTER :: iTraPha(:,:) !--- INDEX IN "isoTrac" AS f(isotopic tracer, phase)
131
132	!=== VARIABLES EMBEDDED IN "tracers", BUT DUPLICATED, AS THEY ARE RATHER FREQUENTLY USED + VARIABLES FOR INCA
133	REAL, SAVE, ALLOCATABLE :: tnat(:), & !--- Natural relative abundance of water isotope (niso)
134	alpha_ideal(:) !--- Ideal fractionning coefficient (for initial state) (niso)
135	INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr)
136	pbl_flg(:), & !--- Boundary layer activation ; needed for INCA (nbtr)
137	itr_indice(:), & !--- Indexes of the tracers passed to phytrac (nqtottr)
138	niadv(:) !--- Indexes of true tracers (<=nqtot, such that iadv(idx)>0)
139	CHARACTER(LEN=8), SAVE, ALLOCATABLE :: solsym(:) !--- Names from INCA (nbtr)
140
141	#ifdef CPP_StratAer
142	!=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
143	INTEGER, SAVE :: nbtr_bin, nbtr_sulgas, id_OCS_strat, id_H2SO4_strat, id_SO2_strat, id_BIN01_strat, id_TEST_strat
144	#endif
145
146	CONTAINS
147
148	SUBROUTINE infotrac_init
149	USE control_mod, ONLY: planet_type, config_inca
150	#ifdef REPROBUS
151	USE chem_rep, ONLY: Init_chem_rep_trac
152	IMPLICIT NONE
153	#endif
154	!==============================================================================================================================
155	!
156	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
157	! -------
158	!
159	! Modifications:
160	! --------------
161	! 05/94: F.Forget Modif special traceur
162	! 02/02: M-A Filiberti Lecture de traceur.def
163	! 06/20: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types tr et iso)
164	!
165	! Objet:
166	! ------
167	! GCM LMD nouvelle grille
168	!
169	!==============================================================================================================================
170	! ... modification de l'integration de q ( 26/04/94 ) ....
171	!------------------------------------------------------------------------------------------------------------------------------
172	! Declarations:
173	! INCLUDE "dimensions.h"
174
175	!------------------------------------------------------------------------------------------------------------------------------
176	! Local variables
177	INTEGER, ALLOCATABLE :: hadv(:), hadv_inca(:), & !--- Horizontal/vertical transport scheme number
178	vadv(:), vadv_inca(:) !--- + specific INCA versions
179	CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather)
180	CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags
181	CHARACTER(LEN=256) :: oldH2O(3) !--- Old water name for the three phases
182	CHARACTER(LEN=256) :: newH2O !--- New water name
183	CHARACTER(LEN=256) :: msg1, msg2 !--- Strings for messages
184	CHARACTER(LEN=256), ALLOCATABLE :: str(:) !--- Temporary storage
185	INTEGER :: fType !--- Tracers description file type ; 0: none
186	!--- 1: "traceur.def" 2: "tracer.def" 3: "tracer_*.def"
187	INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments)
188	INTEGER :: iad !--- Advection scheme number
189	INTEGER :: ic, ip, iq, jq, it, nt, im, nm, ix, iz !--- Indexes and temporary variables
190	LOGICAL :: lerr
191	TYPE(tra), ALLOCATABLE, TARGET :: ttr(:)
192	TYPE(tra), POINTER :: t1
193	TYPE(iso), POINTER :: s
194	!------------------------------------------------------------------------------------------------------------------------------
195	! Initialization :
196	!------------------------------------------------------------------------------------------------------------------------------
197	modname = 'infotrac_init'
198	suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
199	descrq( 1: 2) = ['LMV','BAK']
200	descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP']
201	descrq(30) = 'PRA'
202	oldH2O = ['H2Ov','H2Ol','H2Oi']
203
204	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
205	CALL msg('type_trac='//TRIM(type_trac))
206	IF(strParse(type_trac, ',', str, n=nt)) CALL abort_gcm(modname,'can''t parse "type_trac = '//TRIM(type_trac)//'"',1)
207	DO it = 1, nt !--- nt>1 if "type_trac" is a coma-separated keywords list
208	msg1 = 'For type_trac = "'//TRIM(str(it))//'":'
209	SELECT CASE(str(it))
210	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model, config_inca='//config_inca)
211	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model')
212	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle')
213	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests')
214	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only')
215	CASE DEFAULT
216	CALL abort_gcm(modname,'type_trac='//TRIM(str(it))//' not possible yet.',1)
217	END SELECT
218	END DO
219
220	!--- COHERENCE TEST BETWEEN "type_trac", "config_inca" AND PREPROCESSING KEYS
221	DO it=1,nt
222	SELECT CASE(type_trac)
223	CASE('inca'); IF(ALL(['aero', 'aeNP', 'chem']/=config_inca)) &
224	CALL abort_gcm(modname, 'Mismatch between type_trac and config_inca. Please modify "run.def"',1)
225	#ifndef INCA
226	CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code',1)
227	#endif
228	CASE('repr')
229	#ifndef REPROBUS
230	CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code',1)
231	#endif
232	CASE('coag')
233	#ifndef CPP_StratAer
234	CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code',1)
235	#endif
236	END SELECT
237	END DO
238
239	!--- Disable "config_inca" option for a run without INCA if it differs from "none"
240	IF (ALL(str(:) /= 'inca') .AND. config_inca /= 'none') THEN
241	CALL msg('setting config_inca="none" as you do not couple with INCA model')
242	config_inca = 'none'
243	END IF
244
245	!------------------------------------------------------------------------------------------------------------------------------
246	! 1) Get the numbers of: true tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
247	! (here, "true" tracers means declared tracers, first order only)
248	! Deal with the advection scheme choice for water and tracers:
249	! iadv = 1 "LMDZ-specific humidity transport" (for H2O vapour) LMV
250	! iadv = 2 backward (for H2O liquid) BAK
251	! iadv = 14 Van-Leer + specific humidity, modified by Francis Codron VLH
252	! iadv = 10 Van-Leer (chosen for vapour and liquid water) VL1
253	! iadv = 11 Van-Leer for hadv and PPM version (Monotonic) for vadv VLP
254	! iadv = 12 Frederic Hourdin I FH1
255	! iadv = 13 Frederic Hourdin II FH2
256	! iadv = 16 Monotonic PPM (Collela & Woodward 1984) PPM
257	! iadv = 17 Semi-monotonic PPM (overshoots allowed) PPS
258	! iadv = 18 Definite positive PPM (overshoots and undershoots allowed) PPP
259	! iadv = 20 Slopes SLP
260	! iadv = 30 Prather PRA
261	!
262	! In array q(ij,l,iq) : iq = 1 for vapour water
263	! iq = 2 for liquid water
264	! [iq = 3 for ice water]
265	! And optionaly: iq = 3[4],nqtot for other tracers
266	!------------------------------------------------------------------------------------------------------------------------------
267	! Get choice of advection scheme from file tracer.def or from INCA
268	!------------------------------------------------------------------------------------------------------------------------------
269
270	IF(readTracersFiles(type_trac, fType, tracers)) CALL abort_gcm(modname,'problem with tracers file(s)',1)
271	CALL msg(fType == 0, 'WARNING: USING DEFAULT VALUES !')
272
273	!----------------------------------------------------------------------------------------------------------------------------
274	SELECT CASE(fType)
275	!----------------------------------------------------------------------------------------------------------------------------
276	CASE(0) !=== NO READABLE TRACERS CONFIG FILE => DEFAULT
277	!--------------------------------------------------------------------------------------------------------------------------
278	IF(planet_type=='earth') THEN !--- Default for Earth
279	nqo = 2; nbtr = 2
280	tracers(:)%name = ['H2O'//phases_sep//'g', 'H2O'//phases_sep//'l', 'RN ', 'PB ']
281	tracers(:)%prnt = [tran0, tran0, tran0, tran0]
282	tracers(:)%igen = [1 , 1 , 1 , 1 ]
283	hadv = [14 , 10 , 10 , 10 ]
284	vadv = [14 , 10 , 10 , 10 ]
285	ELSE !--- Default for other planets
286	nqo = 0; nbtr = 1
287	tracers(:)%name = ['dummy']
288	tracers(:)%prnt = ['dummy']
289	tracers(:)%igen = [1 ]
290	hadv = [10 ]
291	vadv = [10 ]
292	END IF
293	nqtrue = nbtr + nqo
294	!--------------------------------------------------------------------------------------------------------------------------
295	CASE(1)
296	!--------------------------------------------------------------------------------------------------------------------------
297	IF(type_trac=='inca') THEN !=== OLD STYLE "traceur.def" FOR INCA FOUND
298	!------------------------------------------------------------------------------------------------------------------------
299	nqo = SIZE(tracers(:), DIM=1)
300	WRITE(msg1,'(a,i0)')'Only 2 or 3 water phases allowed ; found nqo=',nqo
301	IF(nqo/=2 .AND. nqo/=3) CALL abort_gcm(modname,TRIM(msg1),1)
302	#ifdef INCA
303	CALL Init_chem_inca_trac(nbtr) !--- Get nbtr from INCA
304	#endif
305	ALLOCATE(hadv_inca(nbtr), vadv_inca(nbtr), conv_flg(nbtr), pbl_flg(nbtr), solsym(nbtr))
306	#ifdef INCA
307	!--- Activation of: Convection, Boundary layer
308	CALL init_transport(hadv_inca, vadv_inca, conv_flg, pbl_flg, solsym)
309	#endif
310	nqtrue = nbtr + nqo !--- Total number of tracers
311	ALLOCATE(ttr(nqtrue)); ttr(1:nqo) = tracers(1:nqo)
312	DO iq = nqo+1, nqtrue
313	ttr(iq)%name = solsym(iq)
314	ttr(iq)%prnt = tran0
315	ttr(iq)%igen = 1
316	hadv = hadv_inca(iq-nqo)
317	vadv = vadv_inca(iq-nqo)
318	END DO
319	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
320	!------------------------------------------------------------------------------------------------------------------------
321	ELSE !=== OLD STYLE "traceur.def" CONFIG FILE FOUND
322	!------------------------------------------------------------------------------------------------------------------------
323	nqo = 0
324	DO ip = 1, SIZE(oldH2O)
325	ix = strIdx(tracers(:)%name,oldH2O(ip)) !--- Old name of water in a specific phase (ix/=0)
326	newH2O = 'H2O'//phases_sep//known_phases(ip:ip) !--- Corresponding new name
327	IF(ix == 0) ix = strIdx(tracers(:)%name,newH2O) !--- New name in an old format file (to be avoided...)
328	IF(ix == 0) CYCLE
329	nqo = nqo+1; tracers(ix)%name = newH2O !--- One more water phase ; replace old name with one
330	tracers(strFind(tracers(:)%nam1,oldH2O(ip)))%nam1 = newH2O
331	tracers(strFind(tracers(:)%prnt,oldH2O(ip)))%prnt = newH2O
332	END DO
333	nqtrue = SIZE(tracers,DIM=1)
334	nbtr = nqtrue - nqo
335	END IF
336	!--------------------------------------------------------------------------------------------------------------------------
337	CASE DEFAULT !=== FOUND NEW STYLE TRACERS CONFIG FILE(S)
338	!--------------------------------------------------------------------------------------------------------------------------
339	nqo = 2; IF(ANY(tracers(:)%name == 'H2O'//phases_sep//'s')) nqo=3
340	nqtrue = SIZE(tracers, DIM=1)
341	nbtr = nqtrue - nqo
342	!----------------------------------------------------------------------------------------------------------------------------
343	END SELECT
344	!----------------------------------------------------------------------------------------------------------------------------
345	CALL getKey_init(tracers)
346	IF(.NOT.ALLOCATED(hadv)) lerr = getKey('hadv', hadv)
347	IF(.NOT.ALLOCATED(vadv)) lerr = getKey('vadv', vadv)
348	IF(.NOT.ALLOCATED(solsym)) ALLOCATE(solsym(nbtr))
349	IF(.NOT.ALLOCATED(conv_flg)) conv_flg = [(1, it=1, nbtr)]
350	IF(.NOT.ALLOCATED( pbl_flg)) pbl_flg = [(1, it=1, nbtr)]
351	!print*,'nqo, nbtr = ',nqo,nbtr
352	!stop
353
354	#ifdef CPP_StratAer
355	IF (type_trac == 'coag') THEN
356	nbtr_bin=0
357	nbtr_sulgas=0
358	DO iq = 1, nqtrue
359	IF(tracers(iq)%name(1:3)=='BIN') nbtr_bin = nbtr_bin +1
360	IF(tracers(iq)%name(1:3)=='GAS') nbtr_sulgas = nbtr_sulgas+1
361	SELECT CASE(tracers(iq)%name)
362	CASE('BIN01'); id_BIN01_strat = iq - nqo; CALL msg('id_BIN01_strat=', id_BIN01_strat)
363	CASE('GASOCS'); id_OCS_strat = iq - nqo; CALL msg('id_OCS_strat =', id_OCS_strat)
364	CASE('GASSO2'); id_SO2_strat = iq - nqo; CALL msg('id_SO2_strat =', id_SO2_strat)
365	CASE('GASH2SO4'); id_H2SO4_strat = iq - nqo; CALL msg('id_H2SO4_strat=', id_H2SO4_strat)
366	CASE('GASTEST'); id_TEST_strat = iq - nqo; CALL msg('id_TEST_strat=' , id_TEST_strat)
367	END SELECT
368	END DO
369	CALL msg('nbtr_bin =',nbtr_bin)
370	CALL msg('nbtr_sulgas =',nbtr_sulgas)
371	END IF
372	#endif
373
374	!--- Transfert number of tracers to Reprobus
375	#ifdef REPROBUS
376	IF(type_trac == 'repr') CALL Init_chem_rep_trac(nbtr,nqo,tracers(:)%name)
377	#endif
378
379	!------------------------------------------------------------------------------------------------------------------------------
380	! 2) Verify if the advection scheme 20 or 30 have been chosen.
381	! Calculate total number of tracers needed: nqtot
382	! Allocate variables depending on total number of tracers
383	!------------------------------------------------------------------------------------------------------------------------------
384	DO iq = 1, nqtrue
385	t1 => tracers(iq)
386	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
387	WRITE(msg1,'(2(a,i0))')' is not available: hadv=',hadv(iq),', vadv=',vadv(iq)
388	CALL msg('This choice of advection scheme for "'//TRIM(t1%name)//'"'//TRIM(msg1))
389	CALL abort_gcm(modname,'Bad choice of advection scheme',1)
390	END DO
391	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
392	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
393	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
394
395	! More tracers due to the choice of advection scheme => assign total number of tracers
396	IF( nqtot /= nqtrue ) THEN
397	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
398	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
399	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
400	END IF
401	CALL msg('nqtot = '//TRIM(int2str(nqtot)))
402	CALL msg('nbtr = '//TRIM(int2str(nbtr)))
403	CALL msg('nqo = '//TRIM(int2str(nqo)))
404	ALLOCATE(ttr(nqtot))
405
406	!------------------------------------------------------------------------------------------------------------------------------
407	! 3) Determine iadv, long and short name, generation number, phase and region
408	!------------------------------------------------------------------------------------------------------------------------------
409	jq = 0; ttr(:)%iadv = -1
410	DO iq = 1, nqtrue
411	jq = jq + 1
412	t1 => tracers(iq)
413
414	!--- Verify choice of advection schema
415	iad = -1
416	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
417	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
418	CALL msg(iad == -1, 'This choice of advection scheme for "'//TRIM(t1%name)//'" '//'is not available: hadv = ' &
419	//TRIM(int2str(hadv(iq)))//', vadv='//TRIM(int2str(vadv(iq))) )
420	IF(iad == -1) CALL abort_gcm(modname,'Bad choice of advection scheme - 2',1)
421	t1%lnam = t1%name; IF(iad /= 0) t1%lnam=TRIM(t1%name)//descrq(iad)
422
423	!--- Define most fields of the tracers derived type
424	ttr(jq)%name = t1%name
425	ttr(jq)%nam1 = t1%nam1
426	ttr(jq)%prnt = t1%prnt
427	ttr(jq)%lnam = t1%lnam
428	ttr(jq)%type = t1%type
429	ttr(jq)%phas = t1%phas
430	ttr(jq)%iadv = iad
431	ttr(jq)%igen = t1%igen
432
433	IF(ALL([20,30] /= iad)) CYCLE !--- 1st order scheme: finished
434	IF(iad == 20) nm = 3 !--- 2nd order scheme
435	IF(iad == 30) nm = 9 !--- 3rd order scheme
436	ttr(jq+1:jq+nm)%name = [ (TRIM(t1%name)//'-'//TRIM(suff(im)), im=1, nm) ]
437	ttr(jq+1:jq+nm)%nam1 = [ (TRIM(t1%nam1)//'-'//TRIM(suff(im)), im=1, nm) ]
438	ttr(jq+1:jq+nm)%lnam = [ (TRIM(t1%lnam)//'-'//TRIM(suff(im)), im=1, nm) ]
439	ttr(jq+1:jq+nm)%prnt = t1%prnt
440	ttr(jq+1:jq+nm)%type = t1%type
441	ttr(jq+1:jq+nm)%phas = t1%phas
442	ttr(jq+1:jq+nm)%iadv = -iad
443	ttr(jq+1:jq+nm)%igen = t1%igen
444	jq = jq + nm
445	END DO
446	DEALLOCATE(hadv, vadv)
447
448	!--- Determine parent and childs indexes
449	CALL indexUpdate(ttr)
450
451	!=== TEST ADVECTION SCHEME
452	DO iq=1,nqtot ; t1 => ttr(iq); iad = t1%iadv
453	WRITE(msg1,'(a,i0)')'This LMDZ version has not been tested for option iadv=',iad
454	WRITE(msg2,'(a,i2,a)')'iadv=',iad,' not implemented yet for'
455
456	!--- ONLY TESTED VALUES FOR TRACERS FOR NOW: iadv = 14, 10 (and 0)
457	IF(ALL( [10,14,0] /= iad) ) CALL abort_gcm(modname, TRIM(msg1)//' ; only iadv=10 and iadv=14 are tested !', 1)
458
459	!--- ONLY TESTED VALUES FOR CHILDS FOR NOW: iadv = 10 (CHILDS: TRACERS OF GENERATION GREATER THAN 1)
460	IF(fmsg(iad/=10.AND.t1%igen>1,'WARNING ! '//TRIM(msg2)//' childs. Setting iadv=10 for "'//TRIM(t1%name)//'".')) t1%iadv=10
461
462	!--- ONLY TESTED VALUES FOR PARENTS FOR NOW: iadv = 14, 10 (PARENTS: TRACERS OF GENERATION 1)
463	IF(t1%igen==1 .AND. ALL([10,14]/=iad)) CALL abort_gcm(modname, TRIM(msg2)//' parents: schemes 10 or 14 only !', 1)
464
465	!--- iadv = 14 IS ONLY VALID FOR WATER VAPOUR
466	IF(fmsg(iad==14 .AND. t1%name(1:5)/='H2O'//phases_sep//'g', 'WARNING ! '//TRIM(msg1)//', found for "' &
467	//TRIM(t1%name)//'" but only valid for water vapour ! Setting iadv=10 for "'//TRIM(t1%name)//'".')) t1%iadv=10
468	END DO
469
470	!=== DISPLAY THE RESULTING LIST
471	CALL msg('Information stored in infotrac :')
472	IF(dispTable('isssiii', ['iq ','name ','long name','parent ','iadv ','ipar ','igen '], &
473	cat(ttr(:)%name, ttr(:)%lnam, ttr(:)%prnt), cat([(iq, iq=1, nqtot)], ttr(:)%iadv, ttr(:)%iprnt, ttr(:)%igen))) &
474	CALL abort_gcm(modname,"problem with the tracers table content",1)
475
476	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
477
478	!=== Indexes of: "true" tracers, in the dynamical table of tracers transmitted to phytrac (nqtottr non-vanishing elements)
479	niadv = PACK([(iq,iq=1,nqtot)], MASK=tracers(:)%iadv>=0) !--- Indexes of "true" tracers
480	itr_indice = PACK(tracers(:)%itr, MASK=tracers(:)%itr /=0) !--- Might be removed (t%itr should be enough)
481
482	CALL initIsotopes(tracers, isotopes)
483	nbIso = SIZE(isotopes); IF(nbIso==0) RETURN !--- No isotopes: finished.
484
485
486	!=== READ PHYSICAL PARAMETERS FROM "isotopes_params.def" FILE SPECIFIC TO WATER ISOTOPES
487	! DONE HERE, AND NOT ONLY IN "infotrac_phy", BECAUSE SOME PHYSICAL PARAMS ARE NEEDED FOR RESTARTS (tnat AND alpha_ideal)
488	CALL getKey_init(tracers, isotopes)
489	IF(isoSelect('H2O')) RETURN !--- Select water isotopes ; finished if no water isotopes.
490	iH2O = ixIso !--- Keep track of water family index
491	IF(getKey('tnat' ,tnat, isoName(1:niso))) CALL abort_gcm(modname,'can''t read "tnat"',1)
492	IF(getKey('alpha',alpha_ideal, isoName(1:niso))) CALL abort_gcm(modname,'can''t read "alpha_ideal"',1)
493	CALL msg('end')
494
495	END SUBROUTINE infotrac_init
496
497
498	!==============================================================================================================================
499	!=== THE ROUTINE isoSelect IS USED TO SWITCH FROM AN ISOTOPE FAMILY TO ANOTHER: ISOTOPES DEPENDENT PARAMETERS ARE UPDATED
500	! Singe generic "isoSelect" routine, using the predefined parent index (fast version) or its name (first call).
501	!==============================================================================================================================
502	LOGICAL FUNCTION isoSelectByName(iName, lVerbose) RESULT(lerr)
503	IMPLICIT NONE
504	CHARACTER(LEN=*), INTENT(IN) :: iName
505	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
506	INTEGER :: iIso
507	LOGICAL :: lV
508	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
509	iIso = strIdx(isotopes(:)%prnt, iName)
510	lerr = iIso == 0
511	CALL msg(lerr .AND. lV, 'no isotope family named "'//TRIM(iName)//'"')
512	IF(lerr) RETURN
513	lerr = isoSelectByIndex(iIso)
514	END FUNCTION isoSelectByName
515	!==============================================================================================================================
516	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
517	IMPLICIT NONE
518	INTEGER, INTENT(IN) :: iIso
519	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
520	LOGICAL :: lv
521	lv = .FALSE.; IF(PRESENT(lVerbose)) lv = lVerbose
522	lerr = .FALSE.
523	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
524	lerr = iIso<=0 .OR. iIso>nbIso
525	CALL msg(lerr .AND. lV, 'Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= ' &
526	//TRIM(int2str(nbIso))//'"')
527	IF(lerr) RETURN
528	ixIso = iIso !--- Update currently selected family index
529	isotope => isotopes(ixIso) !--- Select corresponding component
530	isoKeys => isotope%keys; niso = isotope%niso
531	isoName => isotope%trac; nitr = isotope%nitr
532	isoZone => isotope%zone; nzon = isotope%nzon
533	isoPhas => isotope%phas; npha = isotope%npha
534	iZonIso => isotope%iZonIso; isoCheck = isotope%check
535	iTraPha => isotope%iTraPha
536	END FUNCTION isoSelectByIndex
537	!==============================================================================================================================
538
539	END MODULE infotrac

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

Download in other formats:

Original Format