Context Navigation

infotrac_phy.F90 @ 5049

Last change on this file since 5049 was 4485, checked in by evignon, 18 months ago
premier commit pour l'ajout de la neige soufflee sur la nouvelle branche
File size: 28.9 KB

Rev	Line
[4325]	1	!$Id: infotrac.F90 4301 2022-10-20 11:57:21Z dcugnet $
	2	!
[2320]	3	MODULE infotrac_phy
	4
[4325]	5	USE strings_mod, ONLY: msg, fmsg, maxlen, cat, dispTable, int2str, bool2str, strStack, strParse, strIdx
	6	USE readTracFiles_mod, ONLY: trac_type, nphas, readTracersFiles, tracers, setGeneration, itZonIso, nbIso, tran0, delPhase, &
	7	getKey, isot_type, nzone, readIsotopesFile, isotope, maxTableWidth, iqIsoPha, ntiso, ixIso, addPhase, &
[4432]	8	indexUpdate, isoSelect, niso, testTracersFiles, isoPhas, isoZone, isoName, isoKeys, iH2O, isoCheck, addKey
[4120]	9	IMPLICIT NONE
[4046]	10
[4120]	11	PRIVATE
[2320]	12
[4120]	13	!=== FOR TRACERS:
	14	PUBLIC :: init_infotrac_phy !--- Initialization of the tracers
[4389]	15	PUBLIC :: tracers, type_trac !--- Full tracers database, tracers type keyword
[4120]	16	PUBLIC :: nqtot, nbtr, nqo, nqCO2, nqtottr !--- Main dimensions
[4124]	17	PUBLIC :: conv_flg, pbl_flg !--- Convection & boundary layer activation keys
[4293]	18	#ifdef CPP_StratAer
	19	PUBLIC :: nbtr_bin, nbtr_sulgas !--- Number of aerosols bins and sulfur gases for StratAer model
	20	PUBLIC :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
	21	#endif
[2320]	22
[4120]	23	!=== FOR ISOTOPES: General
[4325]	24	PUBLIC :: isot_type, nbIso !--- Derived type, full isotopes families database + nb of families
[4120]	25	PUBLIC :: isoSelect, ixIso !--- Isotopes family selection tool + selected family index
	26	!=== FOR ISOTOPES: Specific to water
	27	PUBLIC :: iH2O !--- H2O isotopes index
	28	!=== FOR ISOTOPES: Depending on the selected isotopes family
	29	PUBLIC :: isotope, isoKeys !--- Selected isotopes database + associated keys (cf. getKey)
	30	PUBLIC :: isoName, isoZone, isoPhas !--- Isotopes and tagging zones names, phases
	31	PUBLIC :: niso, nzone, nphas, ntiso !--- " " numbers + isotopes & tagging tracers number
[4325]	32	PUBLIC :: itZonIso !--- idx "it" (in "isoName(1:niso)") = function(tagging idx, isotope idx)
	33	PUBLIC :: iqIsoPha !--- idx "iq" (in "qx") = function(isotope idx, phase idx) + aliases
[4120]	34	PUBLIC :: isoCheck !--- Run isotopes checking routines
	35	!=== FOR BOTH TRACERS AND ISOTOPES
	36	PUBLIC :: getKey !--- Get a key from "tracers" or "isotope"
[2320]	37
[4120]	38	!=== CONVENTIONS FOR TRACERS NUMBERS:
	39	! \|--------------------+-----------------------+-----------------+---------------+----------------------------\|
	40	! \| water in different \| water tagging \| water isotopes \| other tracers \| additional tracers moments \|
	41	! \| phases: H2O_[gls] \| isotopes \| \| \| for higher order schemes \|
	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:
	55	! * Used "niso", "nzone" and "ntiso" are components of "isotopes(ip)" for water (isotopes(ip)%parent == 'H2O'),
	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	!
	60	!=== DERIVED TYPE EMBEDDING MOST OF THE TRACERS-RELATED QUANTITIES (LENGTH: nqtot)
	61	! Each entry is accessible using "%" sign.
	62	! \|-------------+------------------------------------------------------+-------------+------------------------+
	63	! \| entry \| Meaning \| Former name \| Possible values \|
	64	! \|-------------+------------------------------------------------------+-------------+------------------------+
	65	! \| name \| Name (short) \| tname \| \|
	66	! \| gen0Name \| Name of the 1st generation ancestor \| / \| \|
	67	! \| parent \| Name of the parent \| / \| \|
	68	! \| longName \| Long name (with adv. scheme suffix) for outputs \| ttext \| \|
	69	! \| type \| Type (so far: tracer or tag) \| / \| tracer,tag \|
[4485]	70	! \| phase \| Phases list ("g"as / "l"iquid / "s"olid / "b"lowing) \| / \| [g][l][s][b] \|
[4120]	71	! \| component \| Name(s) of the merged/cumulated section(s) \| / \| coma-separated names \|
	72	! \| iGeneration \| Generation (>=1) \| / \| \|
	73	! \| isInPhysics \| tracers not extracted from the main table in physics \| / \| nqtottr .TRUE. values \|
	74	! \| iqParent \| Index of the parent tracer \| iqpere \| 1:nqtot \|
	75	! \| iqDescen \| Indexes of the childs (all generations) \| iqfils \| 1:nqtot \|
	76	! \| nqDescen \| Number of the descendants (all generations) \| nqdesc \| 1:nqtot \|
[4325]	77	! \| nqChildren \| Number of childs (1st generation only) \| nqfils \| 1:nqtot \|
[4358]	78	! \| keys \| key/val pairs accessible with "getKey" routine \| / \| \|
[4120]	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.
	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	! +-----------------+--------------------------------------------------+--------------------+-----------------+
	98
	99	!=== DIMENSIONS OF THE TRACERS TABLES AND OTHER SCALAR VARIABLES
[4325]	100	INTEGER, SAVE :: nqtot, & !--- Tracers nb in dynamics (incl. higher moments + H2O)
	101	nbtr, & !--- Tracers nb in physics (excl. higher moments + H2O)
	102	nqo, & !--- Number of water phases
	103	nqtottr, & !--- Number of tracers passed to phytrac (TO BE DELETED ?)
	104	nqCO2 !--- Number of tracers of CO2 (ThL)
	105	CHARACTER(LEN=maxlen), SAVE :: type_trac !--- Keyword for tracers type(s)
[4389]	106	!$OMP THREADPRIVATE(nqtot, nbtr, nqo, nqtottr, nqCO2, type_trac)
[4170]	107
[4325]	108	!=== VARIABLES FOR INCA
	109	INTEGER, SAVE, ALLOCATABLE :: conv_flg(:), & !--- Convection activation ; needed for INCA (nbtr)
	110	pbl_flg(:) !--- Boundary layer activation ; needed for INCA (nbtr)
[4124]	111	!$OMP THREADPRIVATE(conv_flg, pbl_flg)
[4120]	112
[3677]	113	#ifdef CPP_StratAer
[4056]	114	!=== SPECIFIC TO STRATOSPHERIC AEROSOLS (CK/OB)
	115	INTEGER, SAVE :: nbtr_bin, nbtr_sulgas !--- number of aerosols bins and sulfur gases for StratAer model
	116	!$OMP THREADPRIVATE(nbtr_bin, nbtr_sulgas)
	117	INTEGER, SAVE :: id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat
	118	!$OMP THREADPRIVATE(id_OCS_strat, id_SO2_strat, id_H2SO4_strat, id_BIN01_strat, id_TEST_strat)
[3677]	119	#endif
	120
[4120]	121	CONTAINS
[2320]	122
[4325]	123	SUBROUTINE init_infotrac_phy
	124	USE ioipsl_getin_p_mod, ONLY: getin_p
	125	#ifdef REPROBUS
[4358]	126	USE CHEM_REP, ONLY: Init_chem_rep_trac
[4325]	127	#endif
[4120]	128	IMPLICIT NONE
[4325]	129	!==============================================================================================================================
	130	!
	131	! Auteur: P. Le Van /L. Fairhead/F.Hourdin
	132	! -------
	133	!
	134	! Modifications:
	135	! --------------
	136	! 05/94: F.Forget Modif special traceur
	137	! 02/02: M-A Filiberti Lecture de traceur.def
	138	! 01/22: D. Cugnet Nouveaux tracer.def et tracer_*.def + encapsulation (types trac_type et isot_type)
	139	!
	140	! Objet:
	141	! ------
	142	! GCM LMD nouvelle grille
	143	!
	144	!==============================================================================================================================
	145	! ... modification de l'integration de q ( 26/04/94 ) ....
	146	!------------------------------------------------------------------------------------------------------------------------------
	147	! Declarations:
	148	INCLUDE "dimensions.h"
	149	INCLUDE "iniprint.h"
[3924]	150
[4325]	151	!------------------------------------------------------------------------------------------------------------------------------
	152	! Local variables
	153	INTEGER, ALLOCATABLE :: hadv(:), vadv(:) !--- Horizontal/vertical transport scheme number
	154	#ifdef INCA
	155	INTEGER, ALLOCATABLE :: had (:), hadv_inca(:), conv_flg_inca(:), &!--- Variables specific to INCA
	156	vad (:), vadv_inca(:), pbl_flg_inca(:)
	157	CHARACTER(LEN=8), ALLOCATABLE :: solsym_inca(:) !--- Tracers names for INCA
	158	INTEGER :: nqINCA
	159	#endif
[4120]	160	#ifdef CPP_StratAer
	161	CHARACTER(LEN=maxlen), ALLOCATABLE :: tnames(:)
	162	#endif
[4325]	163	CHARACTER(LEN=2) :: suff(9) !--- Suffixes for schemes of order 3 or 4 (Prather)
	164	CHARACTER(LEN=3) :: descrq(30) !--- Advection scheme description tags
[4389]	165	CHARACTER(LEN=maxlen) :: msg1, texp, ttp !--- String for messages and expanded tracers type
[4325]	166	INTEGER :: fType !--- Tracers description file type ; 0: none
	167	!--- 1/2/3: "traceur.def"/"tracer.def"/"tracer_*.def"
	168	INTEGER :: nqtrue !--- Tracers nb from tracer.def (no higher order moments)
	169	INTEGER :: iad !--- Advection scheme number
	170	INTEGER :: ic, iq, jq, it, nt, im, nm, iz, k !--- Indexes and temporary variables
[4389]	171	LOGICAL :: lerr, ll, lInit
[4325]	172	CHARACTER(LEN=1) :: p
	173	TYPE(trac_type), ALLOCATABLE, TARGET :: ttr(:)
	174	TYPE(trac_type), POINTER :: t1, t(:)
	175	INTEGER :: ierr
[2320]	176
[4325]	177	CHARACTER(LEN=*), PARAMETER :: modname="init_infotrac_phy"
	178	!------------------------------------------------------------------------------------------------------------------------------
	179	! Initialization :
	180	!------------------------------------------------------------------------------------------------------------------------------
	181	suff = ['x ','y ','z ','xx','xy','xz','yy','yz','zz']
[4389]	182	descrq( 1:30) = ' '
[4325]	183	descrq( 1: 2) = ['LMV','BAK']
	184	descrq(10:20) = ['VL1','VLP','FH1','FH2','VLH',' ','PPM','PPS','PPP',' ','SLP']
	185	descrq(30) = 'PRA'
[2690]	186
[4325]	187	CALL getin_p('type_trac',type_trac)
	188	CALL msg('type_trac = "'//TRIM(type_trac)//'"', modname)
	189	lInit = .NOT.ALLOCATED(tracers)
	190
	191	!##############################################################################################################################
	192	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
	193	!##############################################################################################################################
[4389]	194	!--- MESSAGE ABOUT THE CHOSEN CONFIGURATION
	195	msg1 = 'For type_trac = "'//TRIM(type_trac)//'":'
	196	SELECT CASE(type_trac)
	197	CASE('inca'); CALL msg(TRIM(msg1)//' coupling with INCA chemistry model', modname)
	198	CASE('inco'); CALL msg(TRIM(msg1)//' coupling jointly with INCA and CO2 cycle', modname)
	199	CASE('repr'); CALL msg(TRIM(msg1)//' coupling with REPROBUS chemistry model', modname)
	200	CASE('co2i'); CALL msg(TRIM(msg1)//' you have chosen to run with CO2 cycle', modname)
	201	CASE('coag'); CALL msg(TRIM(msg1)//' tracers are treated for COAGULATION tests', modname)
	202	CASE('lmdz'); CALL msg(TRIM(msg1)//' tracers are treated in LMDZ only', modname)
	203	CASE DEFAULT; CALL abort_gcm(modname,'type_trac='//TRIM(type_trac)//' not possible yet.',1)
	204	END SELECT
[4325]	205
[4389]	206	!--- COHERENCE TEST BETWEEN "type_trac" AND PREPROCESSING KEYS
	207	SELECT CASE(type_trac)
	208	CASE('inca', 'inco')
[4325]	209	#ifndef INCA
[4389]	210	CALL abort_gcm(modname, 'You must add cpp key INCA and compile with INCA code', 1)
[4325]	211	#endif
[4389]	212	CASE('repr')
[4325]	213	#ifndef REPROBUS
[4389]	214	CALL abort_gcm(modname, 'You must add cpp key REPROBUS and compile with REPROBUS code', 1)
[4325]	215	#endif
[4389]	216	CASE('coag')
[4325]	217	#ifndef CPP_StratAer
[4389]	218	CALL abort_gcm(modname, 'You must add cpp key StratAer and compile with StratAer code', 1)
[4325]	219	#endif
[4389]	220	END SELECT
[4325]	221	!##############################################################################################################################
[4120]	222	END IF
[4325]	223	!##############################################################################################################################
[2690]	224
[4389]	225	nqCO2 = COUNT( [type_trac == 'inco', type_trac == 'co2i'] )
[4325]	226
	227	!==============================================================================================================================
	228	! 1) Get the numbers of: true (first order only) tracers "nqtrue", water tracers "nqo" (vapor/liquid/solid)
	229	!==============================================================================================================================
[4389]	230	texp = type_trac !=== EXPANDED VERSION OF "type_trac", WITH "\|" SEPARATOR
	231	IF(texp == 'inco') texp = 'co2i\|inca'
	232	IF(texp /= 'lmdz') texp = 'lmdz\|'//TRIM(texp)
	233
	234	!=== DETERMINE THE TYPE OF THE INPUT TRACERS DESCRIPTION FILE
	235	IF(testTracersFiles(modname, texp, fType, lInit)) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
	236	ttp = type_trac; IF(fType /= 1) ttp = texp
	237
[4325]	238	!##############################################################################################################################
	239	IF(lInit) THEN
[4389]	240	IF(readTracersFiles(ttp, type_trac == 'repr')) CALL abort_gcm(modname, 'problem with tracers file(s)',1)
[4325]	241	ELSE
[4389]	242	CALL msg('No tracers description file(s) reading needed: already done in the dynamics', modname)
[4325]	243	END IF
	244	!##############################################################################################################################
	245
	246	!---------------------------------------------------------------------------------------------------------------------------
	247	IF(fType == 0) CALL abort_gcm(modname, 'Missing tracers file: "traceur.def", "tracer.def" or "tracer_<keyword>.def file.',1)
	248	!---------------------------------------------------------------------------------------------------------------------------
	249	IF(fType == 1 .AND. ANY(['inca','inco']==type_trac) .AND. lInit) THEN !=== OLD STYLE INCA "traceur.def" (single type_trac)
	250	!---------------------------------------------------------------------------------------------------------------------------
	251	#ifdef INCA
	252	nqo = SIZE(tracers) - nqCO2
	253	CALL Init_chem_inca_trac(nqINCA) !--- Get nqINCA from INCA
	254	nbtr = nqINCA + nqCO2 !--- Number of tracers passed to phytrac
	255	nqtrue = nbtr + nqo !--- Total number of "true" tracers
	256	IF(ALL([2,3] /= nqo)) CALL abort_gcm(modname, 'Only 2 or 3 water phases allowed ; found nqo='//TRIM(int2str(nqo)), 1)
	257	ALLOCATE(hadv(nqtrue), hadv_inca(nqINCA), conv_flg_inca(nqINCA), solsym_inca(nqINCA))
	258	ALLOCATE(vadv(nqtrue), vadv_inca(nqINCA), pbl_flg_inca(nqINCA))
	259	CALL init_transport(solsym_inca, conv_flg_inca, pbl_flg_inca, hadv_inca, vadv_inca)
	260	ALLOCATE(ttr(nqtrue))
[4389]	261	ttr(1:nqo+nqCO2) = tracers
	262	ttr(1 : nqo )%component = 'lmdz'
	263	ttr(1+nqo:nqCO2+nqo )%component = 'co2i'
	264	ttr(1+nqo+nqCO2:nqtrue)%component = 'inca'
	265	ttr(1+nqo :nqtrue)%name = [('CO2 ', k=1, nqCO2), solsym_inca]
	266	ttr(1+nqo+nqCO2:nqtrue)%parent = tran0
	267	ttr(1+nqo+nqCO2:nqtrue)%phase = 'g'
[4325]	268	lerr = getKey('hadv', had, ky=tracers(:)%keys)
	269	lerr = getKey('vadv', vad, ky=tracers(:)%keys)
[4389]	270	hadv(1:nqo+nqCO2) = had(:); hadv(1+nqo+nqCO2:nqtrue) = hadv_inca
	271	vadv(1:nqo+nqCO2) = vad(:); vadv(1+nqo+nqCO2:nqtrue) = vadv_inca
[4325]	272	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
[4429]	273	DO iq = 1, nqtrue
	274	t1 => tracers(iq)
[4431]	275	CALL addKey('name', t1%name, t1%keys)
	276	CALL addKey('component', t1%component, t1%keys)
	277	CALL addKey('parent', t1%parent, t1%keys)
	278	CALL addKey('phase', t1%phase, t1%keys)
[4429]	279	END DO
[4389]	280	IF(setGeneration(tracers)) CALL abort_gcm(modname,'See below',1) !- SET FIELDS %iGeneration, %gen0Name
[4325]	281	DEALLOCATE(had, hadv_inca, vad, vadv_inca, conv_flg_inca, pbl_flg_inca, solsym_inca)
	282	#endif
	283	!---------------------------------------------------------------------------------------------------------------------------
	284	ELSE !=== OTHER CASES (OLD OR NEW FORMAT, NO INCA MODULE)
	285	!---------------------------------------------------------------------------------------------------------------------------
	286	nqo = COUNT(delPhase(tracers(:)%name) == 'H2O' &
	287	.AND. tracers(:)%component == 'lmdz') !--- Number of water phases
	288	nqtrue = SIZE(tracers) !--- Total number of "true" tracers
	289	nbtr = nqtrue-COUNT(delPhase(tracers(:)%gen0Name) == 'H2O' &
	290	.AND. tracers(:)%component == 'lmdz') !--- Number of tracers passed to phytrac
	291	#ifdef INCA
	292	nqINCA = COUNT(tracers(:)%component == 'inca')
	293	#endif
	294	lerr = getKey('hadv', hadv, ky=tracers(:)%keys)
	295	lerr = getKey('vadv', vadv, ky=tracers(:)%keys)
	296	!---------------------------------------------------------------------------------------------------------------------------
	297	END IF
	298	!---------------------------------------------------------------------------------------------------------------------------
	299
	300	!--- Transfert the number of tracers to Reprobus
	301	#ifdef REPROBUS
	302	CALL Init_chem_rep_trac(nbtr, nqo, tracers(:)%name)
	303	#endif
	304
	305	!##############################################################################################################################
	306	IF(lInit) THEN !=== SKIPED IF ALREADY DONE IN dyn3d_common/infotrac ####
	307	!##############################################################################################################################
	308
	309	!==============================================================================================================================
	310	! 2) Calculate nqtot, number of tracers needed (greater if advection schemes 20 or 30 have been chosen).
	311	!==============================================================================================================================
	312	DO iq = 1, nqtrue
	313	IF( hadv(iq)<20 .OR. (ANY(hadv(iq)==[20,30]) .AND. hadv(iq)==vadv(iq)) ) CYCLE
	314	WRITE(msg1,'("The choice hadv=",i0,", vadv=",i0,a)')hadv(iq),vadv(iq),' for "'//TRIM(tracers(iq)%name)//'" is not available'
	315	CALL abort_gcm(modname, TRIM(msg1), 1)
	316	END DO
	317	nqtot = COUNT( hadv< 20 .AND. vadv< 20 ) & !--- No additional tracer
	318	+ 4*COUNT( hadv==20 .AND. vadv==20 ) & !--- 3 additional tracers
	319	+ 10*COUNT( hadv==30 .AND. vadv==30 ) !--- 9 additional tracers
	320
	321	!--- More tracers due to the choice of advection scheme => assign total number of tracers
	322	IF( nqtot /= nqtrue ) THEN
	323	CALL msg('The choice of advection scheme for one or more tracers makes it necessary to add tracers')
	324	CALL msg('The number of true tracers is '//TRIM(int2str(nqtrue)))
	325	CALL msg('The total number of tracers needed is '//TRIM(int2str(nqtot)))
	326	END IF
	327
	328	!==============================================================================================================================
	329	! 3) Determine the advection scheme ; needed to compute the full tracers list, the long names and nqtot.
	330	!==============================================================================================================================
	331	ALLOCATE(ttr(nqtot))
	332	jq = nqtrue+1; tracers(:)%iadv = -1
	333	DO iq = 1, nqtrue
	334	t1 => tracers(iq)
	335
	336	!--- VERIFY THE CHOICE OF ADVECTION SCHEME
	337	iad = -1
	338	IF(hadv(iq) == vadv(iq) ) iad = hadv(iq)
	339	IF(hadv(iq)==10 .AND. vadv(iq)==16) iad = 11
	340	WRITE(msg1,'("Bad choice of advection scheme for ",a,": hadv = ",i0,", vadv = ",i0)')TRIM(t1%name), hadv(iq), vadv(iq)
	341	IF(iad == -1) CALL abort_gcm(modname, msg1, 1)
	342
	343	!--- SET FIELDS %longName, %isInPhysics
	344	t1%longName = t1%name; IF(iad > 0) t1%longName=TRIM(t1%name)//descrq(iad)
	345	t1%isInPhysics= delPhase(t1%gen0Name) /= 'H2O' &
	346	.OR. t1%component /= 'lmdz' !=== OTHER EXCEPTIONS TO BE ADDED: CO2i, SURSATURATED WATER CLOUD...
	347	ttr(iq) = t1
	348
	349	!--- DEFINE THE HIGHER ORDER TRACERS, IF ANY
	350	nm = 0
	351	IF(iad == 20) nm = 3 !--- 2nd order scheme
	352	IF(iad == 30) nm = 9 !--- 3rd order scheme
	353	IF(nm == 0) CYCLE !--- No higher moments
	354	ttr(jq+1:jq+nm) = t1
	355	ttr(jq+1:jq+nm)%name = [(TRIM(t1%name) //'-'//TRIM(suff(im)), im=1, nm) ]
	356	ttr(jq+1:jq+nm)%parent = [(TRIM(t1%parent) //'-'//TRIM(suff(im)), im=1, nm) ]
	357	ttr(jq+1:jq+nm)%longName = [(TRIM(t1%longName)//'-'//TRIM(suff(im)), im=1, nm) ]
	358	jq = jq + nm
	359	END DO
	360	DEALLOCATE(hadv, vadv)
	361	CALL MOVE_ALLOC(FROM=ttr, TO=tracers)
	362
	363	!--- SET FIELDS %iqParent, %nqChildren, %iGeneration, %iqDescen, %nqDescen
	364	CALL indexUpdate(tracers)
	365
	366	!##############################################################################################################################
	367	END IF
	368	!##############################################################################################################################
	369
	370	!##############################################################################################################################
	371	IF(.NOT.lInit) THEN
	372	!##############################################################################################################################
	373	nqtot = SIZE(tracers)
	374	!##############################################################################################################################
	375	ELSE
	376	!##############################################################################################################################
	377
	378	!=== READ PHYSICAL PARAMETERS FOR ISOTOPES
	379	niso = 0; nzone = 0; nphas = nqo; ntiso = 0; isoCheck = .FALSE.
	380	IF(readIsotopesFile()) CALL abort_gcm(modname, 'Problem when reading isotopes parameters', 1)
	381
	382	!##############################################################################################################################
	383	END IF
	384	!##############################################################################################################################
	385	!--- Convection / boundary layer activation for all tracers
	386	ALLOCATE(conv_flg(nbtr)); conv_flg(1:nbtr) = 1
	387	ALLOCATE( pbl_flg(nbtr)); pbl_flg(1:nbtr) = 1
	388
	389	!--- Note: nqtottr can differ from nbtr when nmom/=0
	390	nqtottr = nqtot - COUNT(delPhase(tracers%gen0Name) == 'H2O' .AND. tracers%component == 'lmdz')
	391	IF(COUNT(tracers%iso_iName == 0) - COUNT(delPhase(tracers%name) == 'H2O' .AND. tracers%component == 'lmdz') /= nqtottr) &
	392	CALL abort_gcm(modname, 'pb dans le calcul de nqtottr', 1)
	393
	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)
[4325]	401	#ifdef INCA
[4403]	402	CALL msg('nqCO2 = '//TRIM(int2str(nqCO2)), modname)
	403	CALL msg('nqINCA = '//TRIM(int2str(nqINCA)), modname)
[4325]	404	#endif
	405	t => tracers
	406	CALL msg('Information stored in infotrac_phy :', modname)
	407	IF(dispTable('issssssssiiiiiiii', &
	408	['iq ', 'name ', 'lName ', 'gen0N ', 'parent', 'type ', 'phase ', 'compon', 'isPhy ', &
	409	'iGen ', 'iqPar ', 'nqDes ', 'nqChld', 'iGroup', 'iName ', 'iZone ', 'iPhase'], &
	410	cat(t%name, t%longName, t%gen0Name, t%parent, t%type, t%phase, t%component, bool2str(t%isInPhysics)),&
	411	cat([(iq, iq=1, nqtot)], t%iGeneration, t%iqParent, t%nqDescen, t%nqChildren, t%iso_iGroup, &
	412	t%iso_iName, t%iso_iZone, t%iso_iPhase), nColMax=maxTableWidth, nHead=2, sub=modname)) &
	413	CALL abort_gcm(modname, "problem with the tracers table content", 1)
	414	IF(niso > 0) THEN
	415	CALL msg('Where, for isotopes family "'//TRIM(isotope%parent)//'":', modname)
	416	CALL msg(' isoKeys%name = '//strStack(isoKeys%name), modname)
	417	CALL msg(' isoName = '//strStack(isoName), modname)
	418	CALL msg(' isoZone = '//strStack(isoZone), modname)
	419	CALL msg(' isoPhas = '//TRIM(isoPhas), modname)
	420	ELSE
	421	CALL msg('No isotopes identified.', modname)
	422	END IF
	423
	424	#ifdef ISOVERIF
	425	CALL msg('iso_iName = '//strStack(int2str(PACK(tracers(:)%iso_iName, MASK=tracers(:)%iso_iGroup==iH2O))), modname)
	426	#endif
[3677]	427	#ifdef CPP_StratAer
[4389]	428	IF (type_trac == 'coag') THEN
[4056]	429	nbtr_bin = COUNT([(tracers(iq)%name(1:3)=='BIN', iq=1, nqtot)])
	430	nbtr_sulgas = COUNT([(tracers(iq)%name(1:3)=='GAS', iq=1, nqtot)])
[4071]	431	tnames = PACK(tracers(:)%name, MASK=tracers(:)%isInPhysics)
[4056]	432	id_BIN01_strat = strIdx(tnames, 'BIN01' )
[4232]	433	id_OCS_strat = strIdx(tnames, 'GASOCS' )
[4056]	434	id_SO2_strat = strIdx(tnames, 'GASSO2' )
	435	id_H2SO4_strat = strIdx(tnames, 'GASH2SO4')
	436	id_TEST_strat = strIdx(tnames, 'GASTEST' )
[4120]	437	CALL msg('nbtr_bin ='//TRIM(int2str(nbtr_bin )), modname)
	438	CALL msg('nbtr_sulgas ='//TRIM(int2str(nbtr_sulgas )), modname)
	439	CALL msg('id_BIN01_strat ='//TRIM(int2str(id_BIN01_strat)), modname)
	440	CALL msg('id_OCS_strat ='//TRIM(int2str(id_OCS_strat )), modname)
	441	CALL msg('id_SO2_strat ='//TRIM(int2str(id_SO2_strat )), modname)
	442	CALL msg('id_H2SO4_strat ='//TRIM(int2str(id_H2SO4_strat)), modname)
	443	CALL msg('id_TEST_strat ='//TRIM(int2str(id_TEST_strat )), modname)
	444	END IF
[3677]	445	#endif
[4325]	446	CALL msg('end', modname)
[4056]	447
[4120]	448	END SUBROUTINE init_infotrac_phy
[2320]	449
	450	END MODULE infotrac_phy

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

Download in other formats:

Original Format