Context Navigation

infotrac.F90 @ 5490

Last change on this file since 5490 was 4485, checked in by evignon, 23 months ago
premier commit pour l'ajout de la neige soufflee sur la nouvelle branche
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Id`
File size: 27.5 KB

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

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

Download in other formats:

Original Format