Context Navigation

infotrac.f90 @ 5355

Last change on this file since 5355 was 5282, checked in by abarral, 12 months ago
Turn iniprint.h clesphys.h into modules Remove unused description.h
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.5 KB

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

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

Download in other formats:

Original Format