Context Navigation

infotrac_phy.F90 @ 5189

Last change on this file since 5189 was 5184, checked in by dcugnet, 11 months ago
Few corrections, more is needed to fix the previous commit.
File size: 41.6 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: readTracersFiles, maxTableWidth, tisot=>isot_type, addPhase, addKey, iH2O, &
7	indexUpdate, keys_type, testTracersFiles, processIsotopes, trac=>tracers, delPhase, getKey, tran0
8	USE readTracFiles_mod, ONLY: new2oldH2O
9
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	#if defined CPP_StratAer \|\| defined REPROBUS
22	PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model
23	PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
24	#endif
25
26	!=== FOR ISOTOPES: General
27	PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families
28	PUBLIC :: isoSelect, ixIso, isoFamilies !--- Isotopes families selection tool + selected index + list
29	!=== FOR ISOTOPES: Specific to water
30	PUBLIC :: iH2O !--- Value of "ixIso" for "H2O" isotopes class
31	PUBLIC :: ivap, iliq, isol
32	!=== FOR ISOTOPES: Depending on the selected isotopes family
33	PUBLIC :: isotope !--- Selected isotopes database (argument of getKey)
34	PUBLIC :: isoKeys, isoName, isoZone, isoPhas !--- Isotopes keys & names, tagging zones names, phases
35	PUBLIC :: niso, ntiso, nzone, nphas !--- Number of " "
36	PUBLIC :: itZonIso !--- index "it" in "isoName(1:niso)" = f(tagging idx, isotope idx)
37	PUBLIC :: iqIsoPha !--- index "iq" in "qx" = f(isotope idx, phase idx)
38	PUBLIC :: iqWIsoPha !--- Same as iqIsoPha but with normal water phases
39	PUBLIC :: isoCheck !--- Run isotopes checking routines
40	!=== FOR BOTH TRACERS AND ISOTOPES
41	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
42
43	!=== CONVENTIONS FOR TRACERS NUMBERS:
44	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
45	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
46	! \| phases: H2O_[glsrb]\| isotopes \| \| \| for higher order schemes \|
47	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
48	! \| \| \| \| \| \|
49	! \|<-- nqo -->\|<-- nqoniso nzone -->\|<-- nqo*niso -->\|<-- nbtr -->\|<-- (nmom) -->\|
50	! \| \| \| \|
51	! \| \|<-- nqoniso(nzone+1) = nqo*ntiso -->\|<-- nqtottr = nbtr + nmom -->\|
52	! \| = nqtot - nqo*(ntiso+1) \|
53	! \| \|
54	! \|<-- nqtrue = nbtr + nqo*(ntiso+1) -->\| \|
55	! \| \|
56	! \|<-- nqtot = nqtrue + nmom -->\|
57	! \| \|
58	! \|-----------------------------------------------------------------------------------------------------------\|
59	! NOTES FOR THIS TABLE:
60	! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%name == 'H2O'),
61	! since water is so far the sole tracers family, except passive CO2, removed from the main tracers table.
62	! * For water, "nqo" is equal to the more general field "isotopes(ip)%nphas".
63	! * "niso", "nzone", "ntiso", "nphas" are defined for other isotopic tracers families, if any.
64	! * If you deal with an isotopes family other than "H2O" ("Sulf" in the example), a good practice is to keep
65	! track of the isotopes class (of its index) before switching to it at the beginning of the dedicated code:
66	! - first time (use selection by name and compute the corresponding index iSulf) :
67	! i0=ixIso; IF(.NOT.isoSelect('Sulf')) CALL abort_physic("Can't select isotopes class", modname, 1); iS=ixIso
68	! - next times (use selection by index - "iS" has been computed at first call):
69	! i0=ixIso; IF(.NOT.isoSelect(iS)) CALL abort_physic("Can't select isotopes class", modname, 1)
70	! and to switch back to the original category when you're done with "Sulf":
71	! IF(.NOT.isoSelect(i0)) CALL abort_physic("Can't select isotopes class", modname, 1)
72	! to restore the original isotopes category (before dealing with "Sulf" (most of the time "H2O").
73	!
74	!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
75	! Each entry is accessible using "%" sign.
76	! \|-------------+------------------------------------------------------+-------------+------------------------+
77	! \| entry \| Meaning \| Former name \| Possible values \|
78	! \|-------------+------------------------------------------------------+-------------+------------------------+
79	! \| name \| Name (short) \| tname \| \|
80	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
81	! \| gen0Name \| Name of the 1st generation ancestor \| / \| \|
82	! \| parent \| Name of the parent \| / \| \|
83	! \| longName \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
84	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
85	! \| phase \| Phases list ("g"as / "l"iquid / "s"olid \| \| [g\|l\|s\|r\|b] \|
86	! \| \| "r"(cloud) / "b"lowing) \| / \| \|
87	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
88	! \| iGeneration \| Generation (>=1) \| / \| \|
89	! \| iqParent \| Index of the parent tracer \| iqpere \| 1:nqtot \|
90	! \| iqDescen \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
91	! \| nqDescen \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
92	! \| nqChildren \| Number of childs (1st generation only) \| nqfils \| 1:nqtot \|
93	! \| isAdvected \| Advected tracers flag (.TRUE. if iadv >= 0) \| / \| nqtrue .TRUE. values \|
94	! \| isInPhysics \| Tracers not extracted from the main table in physics \| / \| nqtottr .TRUE. values \|
95	! \| iso_iGroup \| Isotopes group index in isotopes(:) \| / \| 1:nbIso \|
96	! \| iso_iName \| Isotope name index in isotopes(iso_iGroup)%trac(:) \| iso_indnum \| 1:niso \|
97	! \| iso_iZone \| Isotope zone index in isotopes(iso_iGroup)%zone(:) \| zone_num \| 1:nzone \|
98	! \| iso_iPhas \| Isotope phase index in isotopes(iso_iGroup)%phas(:) \| phase_num \| 1:nphas \|
99	! +-------------+------------------------------------------------------+-------------+------------------------+
100	!
101	!=== DERIVED TYPE EMBEDDING MOST OF THE ISOTOPES-RELATED QUANTITIES (LENGTH: nbIso, NUMBER OF ISOTOPES FAMILIES)
102	! Each entry is accessible using "%" sign.
103	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
104	! \| entry \| length \| Meaning \| Former name \| Possible values \|
105	! \|-----------------+--------------------------------------------------+--------------------+-----------------+
106	! \| name \| Name of the isotopes class (family) \| \| \|
107	! \| keys \| niso \| Isotopes keys/values pairs list + number \| \| \|
108	! \| trac \| ntiso \| Isotopes + tagging tracers list + number \| / \| ntraciso \| \|
109	! \| zone \| nzone \| Geographic tagging zones list + number \| / \| ntraceurs_zone \| \|
110	! \| phase \| nphas \| Phases list + number \| \| [g\|l\|s\|r\|b] 1:5 \|
111	! \| iqIsoPha \| Index in "qx" = f(name(1:ntiso)),phas) \| iqiso \| 1:nqtot \|
112	! \| iqWIsoPha \| Index in "qx" = f(name(1:ntiso+nqo)),phas) \| ? \| 1:nqtot \|
113	! \| itZonIso \| Index in "trac(1:ntiso)"= f(zone, name(1:niso)) \| index_trac \| 1:ntiso \|
114	! +-----------------+--------------------------------------------------+--------------------+-----------------+
115
116	!------------------------------------------------------------------------------------------------------------------------------
117	TYPE :: trac_type !=== TYPE FOR A SINGLE TRACER NAMED "name"
118	CHARACTER(LEN=maxlen) :: name = '' !--- Name of the tracer
119	TYPE(keys_type) :: keys !--- <key>=<val> pairs vector (general container)
120	CHARACTER(LEN=maxlen) :: gen0Name = '' !--- First generation ancestor name
121	CHARACTER(LEN=maxlen) :: parent = '' !--- Parent name
122	CHARACTER(LEN=maxlen) :: longName = '' !--- Long name (with advection scheme suffix)
123	CHARACTER(LEN=maxlen) :: type = 'tracer' !--- Type (so far: 'tracer' / 'tag')
124	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phase ('g'as / 'l'iquid / 's'olid)
125	CHARACTER(LEN=maxlen) :: component = '' !--- Coma-separated list of components (Ex: lmdz,inca)
126	INTEGER :: iGeneration = -1 !--- Generation number (>=0)
127	INTEGER :: iqParent = 0 !--- Parent index
128	INTEGER, ALLOCATABLE :: iqDescen(:) !--- Descendants index (in growing generation order)
129	INTEGER :: nqDescen = 0 !--- Number of descendants (all generations)
130	INTEGER :: nqChildren = 0 !--- Number of children (first generation)
131	LOGICAL :: isAdvected = .FALSE. !--- "true" tracers: iadv > 0. COUNT(isAdvected )=nqtrue
132	LOGICAL :: isInPhysics = .TRUE. !--- "true" tracers: in tr_seri. COUNT(isInPhysics)=nqtottr
133	INTEGER :: iso_iGroup = 0 !--- Isotopes group index in isotopes(:)
134	INTEGER :: iso_iName = 0 !--- Isotope name index in isotopes(iso_iGroup)%trac(:)
135	INTEGER :: iso_iZone = 0 !--- Isotope zone index in isotopes(iso_iGroup)%zone(:)
136	INTEGER :: iso_iPhase = 0 !--- Isotope phase index in isotopes(iso_iGroup)%phase
137	END TYPE trac_type
138	!------------------------------------------------------------------------------------------------------------------------------
139	TYPE :: isot_type !=== TYPE FOR THE ISOTOPES FAMILY DESCENDING ON TRACER "name"
140	CHARACTER(LEN=maxlen) :: name !--- Isotopes family name (ex: H2O)
141	TYPE(keys_type), ALLOCATABLE :: keys(:) !--- Isotopes keys/values pairs list (length: niso)
142	LOGICAL :: check=.FALSE. !--- Flag for checking routines triggering
143	CHARACTER(LEN=maxlen), ALLOCATABLE :: trac(:) !--- Isotopes + tagging tracers list (length: ntiso)
144	CHARACTER(LEN=maxlen), ALLOCATABLE :: zone(:) !--- Geographic tagging zones names list (length: nzone)
145	CHARACTER(LEN=maxlen) :: phase = 'g' !--- Phases list: [g\|l\|s\|r\|b] (length: nphas)
146	INTEGER :: niso = 0 !--- Number of isotopes, excluding tagging tracers
147	INTEGER :: ntiso = 0 !--- Number of isotopes, including tagging tracers
148	INTEGER :: nzone = 0 !--- Number of geographic tagging zones
149	INTEGER :: nphas = 0 !--- Number of phases
150	INTEGER, ALLOCATABLE :: iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f( name(1:ntiso) ,phas)
151	INTEGER, ALLOCATABLE :: iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f([H2O,name(1:ntiso)],phas)
152	INTEGER, ALLOCATABLE :: itZonIso(:,:) !--- Idx in "trac(1:ntiso)" = f(zone,name(1:niso))
153	END TYPE isot_type
154	!------------------------------------------------------------------------------------------------------------------------------
155	INTERFACE isoSelect; MODULE PROCEDURE isoSelectByIndex, isoSelectByName; END INTERFACE isoSelect
156	!------------------------------------------------------------------------------------------------------------------------------
157
158	!=== INDICES FOR WATER
159	INTEGER, SAVE :: ivap, iliq, isol
160	!$OMP THREADPRIVATE(ivap, iliq, isol)
161
162	!=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
163	INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O)
164	nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O)
165	nqo, & !--- Number of water phases
166	nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?)
167	nqCO2 !--- Number of tracers of CO2 (ThL)
168	CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s)
169	!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
170
171	!=== NUMBER AND LIST OF DEFINED ISOTOPES FAMILIES
172	INTEGER, SAVE :: nbIso !--- Number of defined isotopes classes
173	CHARACTER(LEN=maxlen), SAVE, ALLOCATABLE :: isoFamilies(:) !--- Generation 0 tracer name for each isotopes family (nbIso)
174	!$OMP THREADPRIVATE(isoFamilies)
175
176	!=== QUANTITIES RELATED TO THE CURRENTLY SELECTED ISOTOPES CLASS (USUALLY H2O)
177	TYPE(isot_type), SAVE, POINTER :: isotope !--- Selected isotopes database (=isotopes(ixIso))
178	TYPE(keys_type), SAVE, POINTER :: isoKeys(:) !--- Database to get isotopes keys using "getKey" (niso)
179	CHARACTER(LEN=maxlen), SAVE, POINTER :: isoName(:), & !--- Isotopes list including tagging tracers, no phase (ntiso)
180	isoZone(:), & !--- Geographic tagging zones list (nzone)
181	isoPhas !--- Used phases names ([g\|l\|s\|r\|b]) (nphas)
182	INTEGER, SAVE, POINTER :: itZonIso(:,:), & !--- Idx "it" in isoName(1:niso) = f(tagging idx, isotope idx)
183	iqIsoPha(:,:), & !--- Idx "iq" in qx = f(isotope idx, phase idx)
184	iqWIsoPha(:,:) !--- Idx "iq" in qx = f([parent trac,isotope idx], phase idx)
185	INTEGER, SAVE :: ixIso, & !--- Idx in "isoFamilies" of currently selectd class
186	niso, & !--- Number of isotopes
187	ntiso, & !--- Number of isotopes + tagging tracers
188	nzone, & !--- Number of tagging zones
189	nphas !--- Number of phases
190	LOGICAL, SAVE :: isoCheck !--- Isotopes checking routines triggering flag
191	!$OMP THREADPRIVATE(isotope, isoKeys, isoName, isoZone, isoPhas, itZonIso, iqIsoPha, iqWIsoPha, niso, ntiso, nzone, nphas, isoCheck)
192
193	!=== VARIABLES FOR INCA
194	INTEGER, DIMENSION(:), SAVE, ALLOCATABLE :: &
195	conv_flg, pbl_flg !--- Convection / boundary layer activation (nbtr)
196	!$OMP THREADPRIVATE(conv_flg, pbl_flg)
197
198	!=== TRACERS/ISOTOPES DESCRIPTORS: EFFECTIVE STORAGE (LOCAL DERIVED TYPES)
199	TYPE(trac_type), SAVE, ALLOCATABLE, TARGET :: tracers(:)
200	TYPE(isot_type), SAVE, ALLOCATABLE, TARGET :: isotopes(:)
201	!$OMP THREADPRIVATE(tracers, isotopes)
202
203	#if defined CPP_StratAer \|\| defined REPROBUS
204	!=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
205	INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model
206	!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
207	INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
208	!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
209	#endif
210
211	CONTAINS
212
213	SUBROUTINE init_infotrac_phy
214	USE ioipsl_getin_p_mod, ONLY: getin_p
215	USE mod_phys_lmdz_para, ONLY: is_master, is_omp_master
216	#ifdef REPROBUS
217	USE CHEM_REP, ONLY: Init_chem_rep_trac
218	#endif
219	IMPLICIT NONE
220	!==============================================================================================================================
221	!
222	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
223	! -------
224	!
225	! Modifications:
226	! --------------
227	! 05/94: F.Forget Modif special traceur
228	! 02/02: M-A Filiberti Lecture de traceur.def
229	! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
230	!
231	! Objet:
232	! ------
233	! GCM LMD nouvelle grille
234	!
235	!==============================================================================================================================
236	! ... modification de l'integration de q ( 26/04/94 ) ....
237	!------------------------------------------------------------------------------------------------------------------------------
238	! Declarations:
239	INCLUDE "dimensions.h"
240	INCLUDE "iniprint.h"
241
242	!------------------------------------------------------------------------------------------------------------------------------
243	! Local variables
244	INTEGER, ALLOCATABLE :: hadv(:), vadv(:), itmp(:) !--- Horizontal/vertical transport scheme number
245	#ifdef INCA
246	INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
247	vad (:), vadv_inca(:), pbl_flg_inca(:)
248	CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA
249	INTEGER :: nqINCA
250	#endif
251	#ifdef CPP_StratAer
252	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
253	#endif
254	CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather)
255	CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags
256	CHARACTER(LEN=maxlen) :: msg1, texp, ttp, ky !--- Strings for messages and expanded tracers type
257	INTEGER :: fType !--- Tracers description file type ; 0: none
258	!--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
259	INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments)
260	INTEGER :: iad !--- Advection scheme number
261	INTEGER :: iq, jq, it, nt, im, nm !--- Indexes and temporary variables
262	LOGICAL :: lInit
263	TYPE(keys_type), ALLOCATABLE, TARGET :: tra(:) !--- Tracers descriptor as in readTracFiles_mod
264	TYPE(tisot), ALLOCATABLE :: iso(:) !--- Isotopes descriptor as in readTracFiles_mod
265	TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
266	TYPE(trac_type), POINTER :: t(:), t1
267	TYPE(keys_type), POINTER :: k(:)
268	CHARACTER(LEN=maxlen), ALLOCATABLE :: types_trac(:) !--- Keywords for tracers type(s), parsed version
269	CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"
270	!------------------------------------------------------------------------------------------------------------------------------
271	! Initialization :
272	!------------------------------------------------------------------------------------------------------------------------------
273	suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
274	descrq( 1:30) = ' '
275	descrq( 1: 2) = ['LMV','BAK']
276	descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP']
277	descrq(30) = 'PRA'
278
279	CALL getin_p('type_trac',type_trac)
280	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname, is_master)
281	IF(strCount(type_trac, '\|', nt)) CALL abort_physic(modname, 'Could''nt parse the "type_trac" string with delimiter "\|"', 1)
282	IF(nt >= 3) CALL abort_physic(modname, 'you need to modify type_trac, this version is not supported by lmdz', 1)
283	IF(strParse(type_trac, '\|', types_trac, n=nt)) CALL abort_physic(modname, "couldn't parse "//'"type_trac"', 1)
284	IF(nt == 2) type_trac = types_trac(2) ! TO BE DELETED SOON
285
286	lInit = .NOT.ALLOCATED(trac)
287
288	!##############################################################################################################################
289	IF(lInit .AND. is_master) THEN !=== SKIPED IF ALREADY DONE
290	!##############################################################################################################################
291	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
292	msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
293	SELECT CASE(type_trac)
294	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname)
295	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
296	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
297	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
298	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
299	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
300	CASE DEFAULT; CALL abort_physic(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
301	END SELECT
302
303	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
304	SELECT CASE(type_trac)
305	CASE('inca', 'inco')
306	#ifndef INCA
307	CALL abort_physic(modname, 'You must add cpp key INCA and compile with INCA code', 1)
308	#endif
309	CASE('repr')
310	#ifndef REPROBUS
311	CALL abort_physic(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
312	#endif
313	CASE('coag')
314	#ifndef CPP_StratAer
315	CALL abort_physic(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
316	#endif
317	END SELECT
318	!##############################################################################################################################
319	END IF
320	!##############################################################################################################################
321
322	!==============================================================================================================================
323	! 0) DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE AND READ IT ; TRANSFER THE NEEDED QUANTITIES TO LOCAL "tracers".
324	!==============================================================================================================================
325	texp = type_trac !=== EXPANDED (WITH "\|" SEPARATOR) "type_trac"
326	IF(texp == 'inco') texp = 'co2i\|inca'
327	IF(texp /= 'lmdz') texp = 'lmdz\|'//TRIM(texp)
328	IF(testTracersFiles(modname, texp, fType, lInit.AND.is_master)) CALL abort_physic(modname, 'problem with tracers file(s)',1)
329	ttp = type_trac; IF(fType /= 1) ttp = texp
330	!---------------------------------------------------------------------------------------------------------------------------
331	IF(fType == 0) CALL abort_physic(modname, 'Missing "traceur.def", "tracer.def" or "tracer_<keyword>.def tracers file.',1)
332	!---------------------------------------------------------------------------------------------------------------------------
333	IF(fType == 1 .AND. ANY(['inca', 'inco'] == type_trac)) & !=== FOUND OLD STYLE INCA "traceur.def"
334	CALL abort_physic(modname, 'retro-compatibility with old-style INCA traceur.def files has been disabled.', 1)
335	!---------------------------------------------------------------------------------------------------------------------------
336
337	!##############################################################################################################################
338	IF(lInit .AND. is_omp_master) THEN
339	IF(readTracersFiles(ttp, tra, type_trac == 'repr')) CALL abort_physic(modname, 'problem with tracers file(s)',1)
340	ELSE
341	tra = trac
342	END IF
343	CALL msg('No tracers description file(s) reading needed: already done', modname, .NOT.lInit.AND.is_master)
344	!##############################################################################################################################
345
346	!--- POPULATE SOME EXPLICIT (ACCESSIBLE THROUGH "%") KEYS OF THE LOCAL TRACERS DESCRIPTION DERIVED TYPE
347	! To be defined: iqParent, iq/nqDescen, nqChildren (in indexUpdate), longName, iso_i*, isAdvected, isInPhysics (later)
348	ALLOCATE(tracers(SIZE(tra)))
349	DO iq = 1, SIZE(tra); t1 => tracers(iq)
350	t1%keys = tra(iq)
351	msg1 = '" for tracer nr. '//TRIM(int2str(iq))
352	ky='name '; IF(getKey(ky, t1%name, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
353	msg1 = '" for "'//TRIM(t1%name)//'"'
354	ky='gen0Name '; IF(getKey(ky, t1%gen0Name, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
355	ky='parent '; IF(getKey(ky, t1%parent, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
356	ky='type '; IF(getKey(ky, t1%type, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
357	ky='phase '; IF(getKey(ky, t1%phase, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
358	ky='component '; IF(getKey(ky, t1%component, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
359	ky='iGeneration'; IF(getKey(ky, t1%iGeneration, iq, tra)) CALL abort_physic(modname, 'No key "'//TRIM(ky)//TRIM(msg1), 1)
360	END DO
361
362	!==============================================================================================================================
363	! 1) Get various numbers: "nqtrue" (first order only tracers), "nqo" (water phases), 'nbtr' (tracers passed to physics), etc.
364	!==============================================================================================================================
365	nqtrue = SIZE(tracers) !--- "true" tracers
366	nqo = COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%name) == 'H2O') !--- Water phases
367	nbtr = nqtrue-COUNT(tracers(:)%component == 'lmdz' .AND. delPhase(tracers(:)%gen0Name) == 'H2O') !--- Passed to phytrac
368	nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
369	#ifdef INCA
370	nqINCA = COUNT(tracers(:)%component == 'inca')
371	#endif
372	#ifdef REPROBUS
373	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name) !--- Transfert the number of tracers to Reprobus
374	#endif
375
376	!==============================================================================================================================
377	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
378	!==============================================================================================================================
379	IF(getKey('hadv', hadv, ky=tra)) CALL abort_physic(modname, 'missing key "hadv"', 1)
380	IF(getKey('vadv', vadv, ky=tra)) CALL abort_physic(modname, 'missing key "vadv"', 1)
381	DO iq = 1, nqtrue
382	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
383	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
384	CALL abort_physic(modname, TRIM(msg1), 1)
385	END DO
386	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
387	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
388	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
389
390	!--- More tracers due to the choice of advection scheme => assign total number of tracers
391	IF( nqtot /= nqtrue ) THEN
392	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
393	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
394	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
395	END IF
396
397	!==============================================================================================================================
398	! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names, nqtot and %isAdvected
399	!==============================================================================================================================
400	ALLOCATE(ttr(nqtot))
401	jq = nqtrue+1
402	DO iq = 1, nqtrue
403	t1 => tracers(iq)
404
405	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
406	iad = -1
407	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
408	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
409	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
410	IF(iad == -1) CALL abort_physic(modname, msg1, 1)
411
412	!--- SET FIELDS longName, isAdvected, isInPhysics
413	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
414	t1%isAdvected = iad >= 0
415	t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' .OR. t1%component /= 'lmdz' !=== MORE EXCEPTIONS ? CO2i, SURSAT CLOUD H2O
416	ttr(iq) = t1
417
418	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
419	nm = 0
420	IF(iad == 20) nm = 3 !--- 2nd order scheme
421	IF(iad == 30) nm = 9 !--- 3rd order scheme
422	IF(nm == 0) CYCLE !--- No higher moments
423	ttr(jq+1:jq+nm) = t1
424	ttr(jq+1:jq+nm)%name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
425	ttr(jq+1:jq+nm)%gen0Name = [ (TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
426	ttr(jq+1:jq+nm)%parent = [ (TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
427	ttr(jq+1:jq+nm)%longName = [ (TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
428	ttr(jq+1:jq+nm)%isAdvected = [ (.FALSE., im=1, nm) ]
429	ttr(jq+1:jq+nm)%isInPhysics = [ (.FALSE., im=1, nm) ]
430	jq = jq + nm
431	END DO
432	DEALLOCATE(hadv, vadv)
433	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
434
435	!--- SET FIELDS iqParent, iqDescen, nqDescen, nqChildren
436	IF(indexUpdate(tracers%keys)) CALL abort_physic(modname, 'problem with tracers indices update', 1)
437	k => tracers(:)%keys
438	DO iq = 1, SIZE(tracers); t1 => tracers(iq); msg1 = '" for "'//TRIM(t1%name)//'"'
439	ky='iqParent '; IF(getKey(ky, t1%iqParent, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1)
440	ky='iqDescen '; IF(getKey(ky, t1%iqDescen, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1)
441	ky='nqDescen '; IF(getKey(ky, t1%nqDescen, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1)
442	ky='nqChildren'; IF(getKey(ky, t1%nqChildren, iq, k)) CALL abort_physic(modname, 'missing key "'//TRIM(ky)//TRIM(msg1), 1)
443	END DO
444
445	!=== DETERMINE ISOTOPES RELATED PARAMETERS ; DEFINE THE EXPLICIT KEYS iso_i*
446	IF(processIsotopes(tracers%keys, iso)) CALL abort_physic(modname, 'problem while processing isotopes parameters', 1)
447
448	!--- POPULATE SOME EXPLICIT (ACCESSIBLE THROUGH "%") KEYS OF THE LOCAL ISOTOPES DESCRIPTION DERIVED TYPE
449	nbIso = SIZE(iso)
450	ALLOCATE(isotopes(nbIso))
451	IF(nbIso /= 0) THEN
452	k => tracers(:)%keys
453	IF(getKey('iso_iGroup', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iGroup"', 1); tracers%iso_iGroup = itmp
454	IF(getKey('iso_iName', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iName"', 1); tracers%iso_iName = itmp
455	IF(getKey('iso_iZone', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iZone"', 1); tracers%iso_iZone = itmp
456	IF(getKey('iso_iPhas', itmp, ky=k)) CALL abort_physic(modname, 'missing key "iso_iPhas"', 1); tracers%iso_iPhase = itmp
457	isotopes(:)%name = iso(:)%name !--- Isotopes family name (ex: H2O)
458	isotopes(:)%phase = iso(:)%phase !--- Phases list: [g][l][s] (length: nphas)
459	isotopes(:)%niso = iso(:)%niso !--- Number of isotopes, excluding tagging tracers
460	isotopes(:)%ntiso = iso(:)%ntiso !--- Number of isotopes, including tagging tracers
461	isotopes(:)%nzone = iso(:)%nzone !--- Number of geographic tagging zones
462	isotopes(:)%nphas = iso(:)%nphas !--- Number of phases
463	isotopes(:)%check = .FALSE. !--- Flag for checking routines triggering
464	CALL getin_p('ok_iso_verif', isotopes(:)%check)
465	DO it = 1, nbIso
466	isotopes(it)%keys = iso(it)%keys !--- Isotopes keys/values pairs list (length: niso)
467	isotopes(it)%trac = iso(it)%trac !--- Isotopes + tagging tracers list (length: ntiso)
468	isotopes(it)%zone = iso(it)%zone !--- Geographic tagging zones names list (length: nzone)
469	isotopes(it)%iqIsoPha = iso(it)%iqIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f(name(1:ntiso)),phas)
470	isotopes(it)%iqWIsoPha= iso(it)%iqWIsoPha(:,:) !--- Idx in "tracers(1:nqtot)" = f([trPrnt,name(1:ntiso)],phas)
471	isotopes(it)%itZonIso = iso(it)%itZonIso(:,:) !--- Idx in "tracers(1:ntiso)" = f( zone,name(1:niso))
472	END DO
473	IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, "Can't select the first isotopes family", 1)
474	IF(.NOT.isoSelect('H2O', .TRUE.)) iH2O = ixIso
475	END IF
476	isoFamilies = isotopes(:)%name
477
478	!--- Convection / boundary layer activation for all tracers
479	IF(.NOT.ALLOCATED(conv_flg)) ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
480	IF(.NOT.ALLOCATED( pbl_flg)) ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
481
482	!--- Note: nqtottr can differ from nbtr when nmom/=0
483	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
484	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
485	CALL abort_physic(modname, 'problem with the computation of nqtottr', 1)
486
487	!=== DISPLAY THE RESULTS
488	IF(.NOT.is_master) RETURN
489	CALL msg('nqo = '//TRIM(int2str(nqo)), modname)
490	CALL msg('nbtr = '//TRIM(int2str(nbtr)), modname)
491	CALL msg('nqtrue = '//TRIM(int2str(nqtrue)), modname)
492	CALL msg('nqtot = '//TRIM(int2str(nqtot)), modname)
493	CALL msg('niso = '//TRIM(int2str(niso)), modname)
494	CALL msg('ntiso = '//TRIM(int2str(ntiso)), modname)
495	#ifdef INCA
496	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
497	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
498	#endif
499	t => tracers
500	CALL msg('Information stored in '//TRIM(modname)//': ', modname)
501	IF(dispTable('isssssssssiiiiiiii', ['iq ', 'name', 'lNam', 'g0Nm', 'prnt', 'type', 'phas', 'comp', &
502	'isPh', 'isAd', 'iGen', 'iqPr', 'nqDe', 'nqCh', 'iGrp', 'iNam', 'iZon', 'iPha'], &
503	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, &
504	bool2str(t%isInPhysics), bool2str(t%isAdvected)), &
505	cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
506	t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &
507	CALL abort_physic(modname, "problem with the tracers table content", 1)
508	#ifdef CPP_StratAer
509	IF (type_trac == 'coag') THEN
510	nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
511	nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
512	tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
513	id_BIN01_strat = strIdx(tnames, 'BIN01' )
514	id_OCS_strat = strIdx(tnames, 'GASOCS' )
515	id_SO2_strat = strIdx(tnames, 'GASSO2' )
516	id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
517	id_TEST_strat = strIdx(tnames, 'GASTEST' )
518	CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname)
519	CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname)
520	CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
521	CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname)
522	CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname)
523	CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
524	CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname)
525	END IF
526	#endif
527	CALL msg('No isotopes identified.', modname, nbIso == 0)
528	IF(nbIso == 0) RETURN
529	DO it = 1, nbIso
530	IF(isoSelect(it, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1)
531	CALL msg('For isotopes family "'//TRIM(isoFamilies(it))//'":', modname)
532	CALL msg(' isoName = '//strStack(isotope%trac), modname)
533	CALL msg(' isoZone = '//strStack(isotope%zone), modname)
534	CALL msg(' isoPhas = '// TRIM(isotope%phase), modname)
535	END DO
536	IF(isoSelect('H2O', .TRUE.)) THEN
537	IF(isoSelect(1, .TRUE.)) CALL abort_physic(modname, 'Problem when selecting isotopes class', 1)
538	ELSE
539	iH2O = ixIso
540	END IF
541	IF(ALLOCATED(isotope%keys(ixIso)%key)) &
542	CALL msg(' isoKeys('//TRIM(int2str(ixIso))//') = '//TRIM(strStack(isotope%keys(ixIso)%key)), modname)
543	#ifdef ISOVERIF
544	CALL msg('iso_iName(H2O) = '//TRIM(strStack(int2str(PACK(tracers%iso_iName, MASK=tracers%iso_iGroup==iH2O)))),modname)
545	#endif
546
547	END SUBROUTINE init_infotrac_phy
548
549	!==============================================================================================================================
550	LOGICAL FUNCTION isoSelectByName(iClass, lVerbose) RESULT(lerr)
551	IMPLICIT NONE
552	CHARACTER(LEN=*), INTENT(IN) :: iClass
553	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
554	INTEGER :: iIso
555	LOGICAL :: lV
556	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
557	iIso = strIdx(isotopes(:)%name, iClass)
558	lerr = iIso == 0
559	IF(lerr) THEN
560	niso = 0; ntiso = 0; nzone = 0; nphas = 0; isoCheck=.FALSE.
561	CALL msg('no isotope family named "'//TRIM(iClass)//'"', ll=lV)
562	RETURN
563	END IF
564	lerr = isoSelectByIndex(iIso, lV)
565	END FUNCTION isoSelectByName
566	!==============================================================================================================================
567	LOGICAL FUNCTION isoSelectByIndex(iIso, lVerbose) RESULT(lerr)
568	IMPLICIT NONE
569	INTEGER, INTENT(IN) :: iIso
570	LOGICAL, OPTIONAL, INTENT(IN) :: lVerbose
571	LOGICAL :: lV
572	lV = .FALSE.; IF(PRESENT(lVerbose)) lV = lVerbose
573	lerr = .FALSE.
574	IF(iIso == ixIso) RETURN !--- Nothing to do if the index is already OK
575	lerr = iIso<=0 .OR. iIso>SIZE(isotopes)
576	CALL msg('Inconsistent isotopes family index '//TRIM(int2str(iIso))//': should be > 0 and <= '&
577	//TRIM(int2str(SIZE(isotopes)))//'"', ll = lerr .AND. lV)
578	IF(lerr) RETURN
579	ixIso = iIso !--- Update currently selected family index
580	isotope => isotopes(ixIso) !--- Select corresponding component
581	isoKeys => isotope%keys; niso = isotope%niso
582	isoName => isotope%trac; ntiso = isotope%ntiso
583	isoZone => isotope%zone; nzone = isotope%nzone
584	isoPhas => isotope%phase; nphas = isotope%nphas
585	itZonIso => isotope%itZonIso; isoCheck = isotope%check
586	iqIsoPha => isotope%iqIsoPha
587	iqWIsoPha=> isotope%iqWIsoPha
588	END FUNCTION isoSelectByIndex
589	!==============================================================================================================================
590
591	END MODULE infotrac_phy

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

Download in other formats:

Original Format