Context Navigation

infotrac.F90 @ 5190

Last change on this file since 5190 was 5190, checked in by dcugnet, 10 months ago
Revert to r5182 because r5183 still craches with gfortran for unclear reasons. r5188 and r5189 have been included.
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Id`
File size: 27.8 KB

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

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

Download in other formats:

Original Format