Context Navigation

isotopes_mod.F90 @ 4722

Last change on this file since 4722 was 4491, checked in by crisi, 21 months ago
Bug corrections in LMDZiso, especially for water tagging
Property svn:executable set to ``*
File size: 17.9 KB

Rev	Line
[3927]	1	#ifdef ISO
	2	! $Id: $
	3
	4	MODULE isotopes_mod
[4149]	5	USE strings_mod, ONLY: msg, real2str, int2str, bool2str, maxlen, strIdx, strStack
	6	USE infotrac_phy, ONLY: isoName
[4143]	7	IMPLICIT NONE
	8	INTERFACE get_in; MODULE PROCEDURE getinp_s, getinp_i, getinp_r, getinp_l; END INTERFACE get_in
	9	SAVE
[3927]	10
[4143]	11	!--- Contains all isotopic variables + their initialization
	12	!--- Isotopes-specific routines are in isotopes_routines_mod to avoid circular dependencies with isotopes_verif_mod.
[3927]	13
[4143]	14	!--- Isotopes indices (in [1,niso] ; non-existing => 0 index)
	15	INTEGER, SAVE :: iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO
	16	!$OMP THREADPRIVATE(iso_eau, iso_HDO, iso_O18, iso_O17, iso_HTO)
[3927]	17
[4143]	18	INTEGER, SAVE :: ntracisoOR
[3927]	19	!$OMP THREADPRIVATE(ntracisoOR)
	20
[4143]	21	!--- Variables not depending on isotopes
	22	REAL, SAVE :: pxtmelt, pxtice, pxtmin, pxtmax
	23	!$OMP THREADPRIVATE(pxtmelt, pxtice, pxtmin, pxtmax)
	24	REAL, SAVE :: tdifexp, tv0cin, thumxt1
[3927]	25	!$OMP THREADPRIVATE(tdifexp, tv0cin, thumxt1)
[4143]	26	INTEGER, SAVE :: ntot
[3927]	27	!$OMP THREADPRIVATE(ntot)
[4143]	28	REAL, SAVE :: h_land_ice
[3927]	29	!$OMP THREADPRIVATE(h_land_ice)
[4143]	30	REAL, SAVE :: P_veg
[3927]	31	!$OMP THREADPRIVATE(P_veg)
[4143]	32	REAL, SAVE :: musi, lambda_sursat
	33	!$OMP THREADPRIVATE(musi, lambda_sursat)
	34	REAL, SAVE :: Kd
[3927]	35	!$OMP THREADPRIVATE(Kd)
[4143]	36	REAL, SAVE :: rh_cste_surf_cond, T_cste_surf_cond
	37	!$OMP THREADPRIVATE(rh_cste_surf_cond, T_cste_surf_cond)
	38	LOGICAL, SAVE :: bidouille_anti_divergence ! T: regularly, xteau <- q to avoid slow drifts
[3927]	39	!$OMP THREADPRIVATE(bidouille_anti_divergence)
[4143]	40	LOGICAL, SAVE :: essai_convergence ! F: as in LMDZ without isotopes (bad for isotopes)
[3927]	41	!$OMP THREADPRIVATE(essai_convergence)
[4143]	42	INTEGER, SAVE :: initialisation_iso ! 0: file ; 1: R=0 ; 2: R=distill. Rayleigh ; 3: R=Rsmow
[3927]	43	!$OMP THREADPRIVATE(initialisation_iso)
[4143]	44	INTEGER, SAVE :: modif_SST ! 0: default ; 1: modified SST ; 2, 3: SST profiles
[3927]	45	!$OMP THREADPRIVATE(modif_SST)
[4143]	46	REAL, SAVE :: deltaTtest ! Uniform modification of the SST
[3927]	47	!$OMP THREADPRIVATE(deltaTtest)
[4143]	48	INTEGER, SAVE :: modif_sic ! Holes in the Sea Ice
[3927]	49	!$OMP THREADPRIVATE(modif_sic)
[4143]	50	REAL, SAVE :: deltasic ! Minimal holes fraction
[3927]	51	!$OMP THREADPRIVATE(deltasic)
[4143]	52	REAL, SAVE :: deltaTtestpoles
[3927]	53	!$OMP THREADPRIVATE(deltaTtestpoles)
[4143]	54	REAL, SAVE :: sstlatcrit, dsstlatcrit
	55	!$OMP THREADPRIVATE(sstlatcrit, dsstlatcrit)
	56	REAL, SAVE :: deltaO18_oce
[3927]	57	!$OMP THREADPRIVATE(deltaO18_oce)
[4143]	58	INTEGER, SAVE :: albedo_prescrit ! 0: default ; 1: constant albedo
[3927]	59	!$OMP THREADPRIVATE(albedo_prescrit)
[4143]	60	REAL, SAVE :: lon_min_albedo, lon_max_albedo, lat_min_albedo, lat_max_albedo
	61	!$OMP THREADPRIVATE(lon_min_albedo, lon_max_albedo, lat_min_albedo, lat_max_albedo)
	62	REAL, SAVE :: deltaP_BL,tdifexp_sol
[3927]	63	!$OMP THREADPRIVATE(deltaP_BL,tdifexp_sol)
[4143]	64	INTEGER, SAVE :: ruissellement_pluie, alphak_stewart
	65	!$OMP THREADPRIVATE(ruissellement_pluie, alphak_stewart)
	66	INTEGER, SAVE :: calendrier_guide
[3927]	67	!$OMP THREADPRIVATE(calendrier_guide)
[4143]	68	INTEGER, SAVE :: cste_surf_cond
[3927]	69	!$OMP THREADPRIVATE(cste_surf_cond)
[4143]	70	REAL, SAVE :: mixlen
[3927]	71	!$OMP THREADPRIVATE(mixlen)
[4143]	72	INTEGER, SAVE :: evap_cont_cste
[3927]	73	!$OMP THREADPRIVATE(evap_cont_cste)
[4143]	74	REAL, SAVE :: deltaO18_evap_cont, d_evap_cont
	75	!$OMP THREADPRIVATE(deltaO18_evap_cont, d_evap_cont)
	76	INTEGER, SAVE :: nudge_qsol, region_nudge_qsol
	77	!$OMP THREADPRIVATE(nudge_qsol, region_nudge_qsol)
	78	INTEGER, SAVE :: nlevmaxO17
[3927]	79	!$OMP THREADPRIVATE(nlevmaxO17)
[4143]	80	INTEGER, SAVE :: no_pce
[3927]	81	!$OMP THREADPRIVATE(no_pce)
[4143]	82	REAL, SAVE :: A_satlim
[3927]	83	!$OMP THREADPRIVATE(A_satlim)
[4143]	84	INTEGER, SAVE :: ok_restrict_A_satlim, modif_ratqs
	85	!$OMP THREADPRIVATE(ok_restrict_A_satlim, modif_ratqs)
	86	REAL, SAVE :: Pcrit_ratqs, ratqsbasnew
	87	!$OMP THREADPRIVATE(Pcrit_ratqs, ratqsbasnew)
	88	REAL, SAVE :: fac_modif_evaoce
[3927]	89	!$OMP THREADPRIVATE(fac_modif_evaoce)
[4143]	90	INTEGER, SAVE :: ok_bidouille_wake
[3927]	91	!$OMP THREADPRIVATE(ok_bidouille_wake)
[4143]	92	LOGICAL, SAVE :: cond_temp_env
[3927]	93	!$OMP THREADPRIVATE(cond_temp_env)
	94
[4143]	95	!--- Vectors of length "niso"
	96	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
	97	tnat, toce, tcorr, tdifrel
	98	!$OMP THREADPRIVATE(tnat, toce, tcorr, tdifrel)
	99	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
	100	talph1, talph2, talph3, talps1, talps2
	101	!$OMP THREADPRIVATE(talph1, talph2, talph3, talps1, talps2)
	102	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
	103	tkcin0, tkcin1, tkcin2
[3927]	104	!$OMP THREADPRIVATE(tkcin0, tkcin1, tkcin2)
[4143]	105	REAL, ALLOCATABLE, DIMENSION(:), SAVE :: &
	106	alpha_liq_sol, Rdefault, Rmethox
	107	!$OMP THREADPRIVATE(alpha_liq_sol, Rdefault, Rmethox)
	108	REAL, SAVE :: fac_coeff_eq17_liq, fac_coeff_eq17_ice
[3927]	109	!$OMP THREADPRIVATE(fac_coeff_eq17_liq, fac_coeff_eq17_ice)
	110
[4143]	111	!--- Negligible lower thresholds: no need to check for absurd values under these lower limits
	112	REAL, PARAMETER :: &
	113	ridicule = 1e-12, & ! For mixing ratios
	114	ridicule_rain = 1e-8, & ! For rain fluxes (rain, zrfl...) in kg/s <-> 1e-3 mm/day
	115	ridicule_evap = ridicule_rain*1e-2, & ! For evaporations in kg/s <-> 1e-3 mm/day
	116	ridicule_qsol = ridicule_rain, & ! For qsol in kg <-> 1e-8 kg
	117	ridicule_snow = ridicule_qsol ! For snow in kg <-> 1e-8 kg
	118	REAL, PARAMETER :: expb_max = 30.0
[3927]	119
[4143]	120	!--- Specific to HTO:
	121	LOGICAL, SAVE :: ok_prod_nucl_tritium !--- TRUE => HTO production by nuclear tests
[3927]	122	!$OMP THREADPRIVATE(ok_prod_nucl_tritium)
[4143]	123	INTEGER, PARAMETER :: nessai = 486
	124	INTEGER, DIMENSION(nessai), SAVE :: &
	125	day_nucl, month_nucl, year_nucl
	126	!$OMP THREADPRIVATE(day_nucl, month_nucl, year_nucl)
	127	REAL, DIMENSION(nessai), SAVE :: &
	128	lat_nucl, lon_nucl, zmin_nucl, zmax_nucl, HTO_nucl
	129	!$OMP THREADPRIVATE(lat_nucl, lon_nucl, zmin_nucl, zmax_nucl, HTO_nucl)
[3927]	130
[4143]	131
[3927]	132	CONTAINS
	133
[4143]	134	SUBROUTINE iso_init()
[4149]	135	USE infotrac_phy, ONLY: ntiso, niso, getKey
	136	USE strings_mod, ONLY: maxlen
[4143]	137	IMPLICIT NONE
[3927]	138
[4143]	139	!=== Local variables:
	140	INTEGER :: ixt
[3927]	141
[4143]	142	!--- H2[18]O reference
	143	REAL :: fac_enrichoce18, alpha_liq_sol_O18, &
	144	talph1_O18, talph2_O18, talph3_O18, talps1_O18, talps2_O18, &
	145	tkcin0_O18, tkcin1_O18, tkcin2_O18, tdifrel_O18
	146
	147	!--- For H2[17]O
	148	REAL :: fac_kcin, pente_MWL
[3927]	149
[4143]	150	!--- Sensitivity tests
	151	LOGICAL, PARAMETER :: ok_nocinsfc = .FALSE. ! if T: no kinetic effect in sfc evap
	152	LOGICAL, PARAMETER :: ok_nocinsat = .FALSE. ! if T: no sursaturation effect for ice
	153	LOGICAL, PARAMETER :: Rdefault_smow = .FALSE. ! if T: Rdefault=smow; if F: nul
[3927]	154
[4143]	155	!--- For [3]H
	156	INTEGER :: iessai
[3927]	157
[4143]	158	CHARACTER(LEN=maxlen) :: modname, sxt
[4149]	159	REAL, ALLOCATABLE :: tmp(:)
[3927]	160
[4143]	161	modname = 'iso_init'
	162	CALL msg('219: entree', modname)
[3927]	163
[4143]	164	!--------------------------------------------------------------
	165	! General:
	166	!--------------------------------------------------------------
[3927]	167
[4143]	168	!--- Check number of isotopes
	169	CALL msg('64: niso = '//TRIM(int2str(niso)), modname)
[3927]	170
[4143]	171	!--- Init de ntracisoOR: on ecrasera en cas de traceurs de tagging isotopiques
	172	! (nzone>0) si complications avec ORCHIDEE
	173	ntracisoOR = ntiso
[3927]	174
[4143]	175	!--- Type of water isotopes:
[4399]	176	iso_eau = strIdx(isoName, 'H216O'); CALL msg('iso_eau='//int2str(iso_eau), modname)
	177	iso_HDO = strIdx(isoName, 'HDO'); CALL msg('iso_HDO='//int2str(iso_HDO), modname)
	178	iso_O18 = strIdx(isoName, 'H218O'); CALL msg('iso_O18='//int2str(iso_O18), modname)
	179	iso_O17 = strIdx(isoName, 'H217O'); CALL msg('iso_O17='//int2str(iso_O17), modname)
	180	iso_HTO = strIdx(isoName, 'HTO'); CALL msg('iso_HTO='//int2str(iso_HTO), modname)
[3927]	181
[4325]	182	!--- Initialiaation: reading the isotopic parameters.
[4143]	183	CALL get_in('lambda', lambda_sursat, 0.004)
	184	CALL get_in('thumxt1', thumxt1, 0.75*1.2)
	185	CALL get_in('ntot', ntot, 20, .FALSE.)
	186	CALL get_in('h_land_ice', h_land_ice, 20., .FALSE.)
	187	CALL get_in('P_veg', P_veg, 1.0, .FALSE.)
	188	CALL get_in('bidouille_anti_divergence', bidouille_anti_divergence, .FALSE.)
	189	CALL get_in('essai_convergence', essai_convergence, .FALSE.)
	190	CALL get_in('initialisation_iso', initialisation_iso, 0)
	191
	192	! IF(nzone>0 .AND. initialisation_iso==0) &
	193	! CALL get_in('initialisation_isotrac',initialisation_isotrac)
	194	CALL get_in('modif_sst', modif_sst, 0)
	195	CALL get_in('deltaTtest', deltaTtest, 0.0) !--- For modif_sst>=1
	196	CALL get_in('deltaTtestpoles',deltaTtestpoles, 0.0) !--- For modif_sst>=2
	197	CALL get_in( 'sstlatcrit', sstlatcrit, 30.0) !--- For modif_sst>=3
	198	CALL get_in('dsstlatcrit', dsstlatcrit, 0.0) !--- For modif_sst>=3
[3927]	199	#ifdef ISOVERIF
[4143]	200	CALL msg('iso_init 270: sstlatcrit='//real2str( sstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=2
	201	CALL msg('iso_init 279: dsstlatcrit='//real2str(dsstlatcrit), modname, sstlatcrit < 0.0) !--- For modif_sst>=3
	202	IF(modif_sst >= 2 .AND. sstlatcrit < 0.0) STOP
[3927]	203	#endif
	204
[4143]	205	CALL get_in('modif_sic', modif_sic, 0)
	206	IF(modif_sic >= 1) &
	207	CALL get_in('deltasic', deltasic, 0.1)
[3927]	208
[4143]	209	CALL get_in('albedo_prescrit', albedo_prescrit, 0)
	210	IF(albedo_prescrit == 1) THEN
	211	CALL get_in('lon_min_albedo', lon_min_albedo, -200.)
	212	CALL get_in('lon_max_albedo', lon_max_albedo, 200.)
	213	CALL get_in('lat_min_albedo', lat_min_albedo, -100.)
	214	CALL get_in('lat_max_albedo', lat_max_albedo, 100.)
	215	END IF
[4149]	216	deltaO18_oce=0.0
[4143]	217	CALL get_in('deltaP_BL', deltaP_BL, 10.0)
	218	CALL get_in('ruissellement_pluie', ruissellement_pluie, 0)
	219	CALL get_in('alphak_stewart', alphak_stewart, 1)
	220	CALL get_in('tdifexp_sol', tdifexp_sol, 0.67)
	221	CALL get_in('calendrier_guide', calendrier_guide, 0)
	222	CALL get_in('cste_surf_cond', cste_surf_cond, 0)
	223	CALL get_in('mixlen', mixlen, 35.0)
	224	CALL get_in('evap_cont_cste', evap_cont_cste, 0)
	225	CALL get_in('deltaO18_evap_cont', deltaO18_evap_cont,0.0)
	226	CALL get_in('d_evap_cont', d_evap_cont, 0.0)
	227	CALL get_in('nudge_qsol', nudge_qsol, 0)
	228	CALL get_in('region_nudge_qsol', region_nudge_qsol, 1)
	229	nlevmaxO17 = 50
	230	CALL msg('nlevmaxO17='//TRIM(int2str(nlevmaxO17)))
	231	CALL get_in('no_pce', no_pce, 0)
	232	CALL get_in('A_satlim', A_satlim, 1.0)
	233	CALL get_in('ok_restrict_A_satlim', ok_restrict_A_satlim, 0)
	234	#ifdef ISOVERIF
	235	CALL msg(' 315: A_satlim='//real2str(A_satlim), modname, A_satlim > 1.0)
	236	IF(A_satlim > 1.0) STOP
	237	#endif
	238	! CALL get_in('slope_limiterxy', slope_limiterxy, 2.0)
	239	! CALL get_in('slope_limiterz', slope_limiterz, 2.0)
	240	CALL get_in('modif_ratqs', modif_ratqs, 0)
	241	CALL get_in('Pcrit_ratqs', Pcrit_ratqs, 500.0)
	242	CALL get_in('ratqsbasnew', ratqsbasnew, 0.05)
	243	CALL get_in('fac_modif_evaoce', fac_modif_evaoce, 1.0)
	244	CALL get_in('ok_bidouille_wake', ok_bidouille_wake, 0)
	245	! si oui, la temperature de cond est celle de l'environnement, pour eviter
	246	! bugs quand temperature dans ascendances convs est mal calculee
	247	CALL get_in('cond_temp_env', cond_temp_env, .FALSE.)
[4399]	248	IF(ANY(isoName == 'HTO')) &
[4143]	249	CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.)
[3927]	250
[4143]	251	!--------------------------------------------------------------
	252	! Parameters that do not depend on the nature of water isotopes:
	253	!--------------------------------------------------------------
	254	! -- temperature at which ice condensate starts to form (valeur ECHAM?):
	255	pxtmelt = 273.15
[3927]	256
[4143]	257	! -- temperature at which all condensate is ice:
	258	pxtice = 273.15-10.0
[3927]	259
[4143]	260	!- -- test PHASE
	261	! pxtmelt = 273.15 - 10.0
	262	! pxtice = 273.15 - 30.0
[3927]	263
[4143]	264	! -- minimum temperature to calculate fractionation coeff
	265	pxtmin = 273.15 - 120.0 ! On ne calcule qu'au dessus de -120°C
	266	pxtmax = 273.15 + 60.0 ! On ne calcule qu'au dessus de +60°C
	267	! Remarque: les coeffs ont ete mesures seulement jusq'à -40!
[3927]	268
[4143]	269	! -- a constant for alpha_eff for equilibrium below cloud base:
	270	tdifexp = 0.58
	271	tv0cin = 7.0
[3927]	272
[4143]	273	! facteurs lambda et mu dans Si=musi-lambda*T
	274	musi=1.0
	275	if (ok_nocinsat) lambda_sursat = 0.0 ! no sursaturation effect
[3927]	276
[4143]	277	! diffusion dans le sol
	278	Kd=2.5e-9 ! m2/s
[3927]	279
[4143]	280	! cas où cste_surf_cond: on met rhs ou/et Ts cste pour voir
	281	rh_cste_surf_cond = 0.6
	282	T_cste_surf_cond = 288.0
	283
[4149]	284	CALL msg('iso_O18, iso_HDO, iso_eau = '//TRIM(strStack(int2str([iso_O18, iso_HDO, iso_eau]))), modname)
	285
[4143]	286	!--------------------------------------------------------------
	287	! Parameters that depend on the nature of water isotopes:
	288	!--------------------------------------------------------------
[4149]	289	IF(getKey('tnat', tnat, isoName)) CALL abort_physic(modname, 'can''t get tnat', 1)
	290	IF(getKey('toce', toce, isoName)) CALL abort_physic(modname, 'can''t get toce', 1)
	291	IF(getKey('tcorr', tcorr, isoName)) CALL abort_physic(modname, 'can''t get tcorr', 1)
	292	IF(getKey('talph1', talph1, isoName)) CALL abort_physic(modname, 'can''t get talph1', 1)
	293	IF(getKey('talph2', talph2, isoName)) CALL abort_physic(modname, 'can''t get talph2', 1)
	294	IF(getKey('talph3', talph3, isoName)) CALL abort_physic(modname, 'can''t get talph3', 1)
	295	IF(getKey('talps1', talps1, isoName)) CALL abort_physic(modname, 'can''t get talps1', 1)
	296	IF(getKey('talps2', talps2, isoName)) CALL abort_physic(modname, 'can''t get talps2', 1)
	297	IF(getKey('tkcin0', tkcin0, isoName)) CALL abort_physic(modname, 'can''t get tkcin0', 1)
	298	IF(getKey('tkcin1', tkcin1, isoName)) CALL abort_physic(modname, 'can''t get tkcin1', 1)
	299	IF(getKey('tkcin2', tkcin2, isoName)) CALL abort_physic(modname, 'can''t get tkcin2', 1)
	300	IF(getKey('tdifrel', tdifrel, isoName)) CALL abort_physic(modname, 'can''t get tdifrel', 1)
	301	IF(getKey('alpha_liq_sol', alpha_liq_sol, isoName)) CALL abort_physic(modname, 'can''t get alpha_liq_sol', 1)
	302	IF(getKey('Rdefault',Rdefault,isoName)) CALL abort_physic(modname, 'can''t get Rdefault',1)
	303	IF(getKey('Rmethox', Rmethox, isoName)) CALL abort_physic(modname, 'can''t get Rmethox', 1)
	304
[4491]	305	IF(.NOT.Rdefault_smow) then
	306	Rdefault(:) = 0.0
	307	if (iso_eau.gt.0) Rdefault(iso_eau) = 1.0 ! correction Camille 30 mars 2023
	308	ENDIF
	309	write(,) 'Rdefault=',Rdefault
	310
[4143]	311	!--- Sensitivity test: no kinetic effect in sfc evaporation
	312	IF(ok_nocinsfc) THEN
	313	tkcin0(1:niso) = 0.0
	314	tkcin1(1:niso) = 0.0
	315	tkcin2(1:niso) = 0.0
	316	END IF
[3927]	317
[4143]	318	CALL msg('285: verif initialisation:', modname)
	319	DO ixt=1,niso
[4149]	320	sxt=int2str(ixt)
	321	CALL msg(' * isoName('//TRIM(sxt)//') = <'//TRIM(isoName(ixt))//'>', modname)
	322	CALL msg( ' tnat('//TRIM(sxt)//') = '//TRIM(real2str(tnat(ixt))), modname)
	323	! CALL msg(' alpha_liq_sol('//TRIM(sxt)//') = '//TRIM(real2str(alpha_liq_sol(ixt))), modname)
	324	! CALL msg( ' tkcin0('//TRIM(sxt)//') = '//TRIM(real2str(tkcin0(ixt))), modname)
	325	! CALL msg( ' tdifrel('//TRIM(sxt)//') = '//TRIM(real2str(tdifrel(ixt))), modname)
[4143]	326	END DO
	327	CALL msg('69: lambda = '//TRIM(real2str(lambda_sursat)), modname)
	328	CALL msg('69: thumxt1 = '//TRIM(real2str(thumxt1)), modname)
	329	CALL msg('69: h_land_ice = '//TRIM(real2str(h_land_ice)), modname)
	330	CALL msg('69: P_veg = '//TRIM(real2str(P_veg)), modname)
[3927]	331
[4143]	332	END SUBROUTINE iso_init
[3927]	333
	334
[4143]	335	SUBROUTINE getinp_s(nam, val, def, lDisp)
	336	USE ioipsl_getincom, ONLY: getin
	337	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
	338	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
	339	USE mod_phys_lmdz_transfert_para, ONLY : bcast
[4325]	340	CHARACTER(LEN=*), INTENT(IN) :: nam
	341	CHARACTER(LEN=*), INTENT(INOUT) :: val
	342	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
	343	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
[4143]	344	LOGICAL :: lD
	345	!$OMP BARRIER
[4319]	346	IF(is_mpi_root.AND.is_omp_root) THEN
[4325]	347	IF(PRESENT(def)) val=def; CALL getin(nam,val)
[4319]	348	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
	349	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
[4325]	350	END IF
	351	CALL bcast(val)
[4143]	352	END SUBROUTINE getinp_s
[3927]	353
[4143]	354	SUBROUTINE getinp_i(nam, val, def, lDisp)
	355	USE ioipsl_getincom, ONLY: getin
	356	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
	357	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
	358	USE mod_phys_lmdz_transfert_para, ONLY : bcast
	359	CHARACTER(LEN=*), INTENT(IN) :: nam
	360	INTEGER, INTENT(INOUT) :: val
[4325]	361	INTEGER, OPTIONAL, INTENT(IN) :: def
[4143]	362	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	363	LOGICAL :: lD
	364	!$OMP BARRIER
[4319]	365	IF(is_mpi_root.AND.is_omp_root) THEN
[4325]	366	IF(PRESENT(def)) val=def; CALL getin(nam,val)
[4319]	367	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
	368	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(int2str(val)))
[4325]	369	END IF
	370	CALL bcast(val)
[4143]	371	END SUBROUTINE getinp_i
[3927]	372
[4143]	373	SUBROUTINE getinp_r(nam, val, def, lDisp)
	374	USE ioipsl_getincom, ONLY: getin
	375	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
	376	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
	377	USE mod_phys_lmdz_transfert_para, ONLY : bcast
	378	CHARACTER(LEN=*), INTENT(IN) :: nam
	379	REAL, INTENT(INOUT) :: val
[4325]	380	REAL, OPTIONAL, INTENT(IN) :: def
[4143]	381	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	382	LOGICAL :: lD
	383	!$OMP BARRIER
[4319]	384	IF(is_mpi_root.AND.is_omp_root) THEN
[4325]	385	IF(PRESENT(def)) val=def; CALL getin(nam,val)
[4319]	386	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
	387	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(real2str(val)))
[4325]	388	END IF
	389	CALL bcast(val)
[4143]	390	END SUBROUTINE getinp_r
[3927]	391
[4143]	392	SUBROUTINE getinp_l(nam, val, def, lDisp)
	393	USE ioipsl_getincom, ONLY: getin
	394	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
	395	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
	396	USE mod_phys_lmdz_transfert_para, ONLY : bcast
	397	CHARACTER(LEN=*), INTENT(IN) :: nam
	398	LOGICAL, INTENT(INOUT) :: val
[4325]	399	LOGICAL, OPTIONAL, INTENT(IN) :: def
[4143]	400	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
	401	LOGICAL :: lD
	402	!$OMP BARRIER
[4319]	403	IF(is_mpi_root.AND.is_omp_root) THEN
[4325]	404	IF(PRESENT(def)) val=def; CALL getin(nam,val)
[4319]	405	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
	406	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(bool2str(val)))
[4325]	407	END IF
	408	CALL bcast(val)
[4143]	409	END SUBROUTINE getinp_l
[3927]	410
	411	END MODULE isotopes_mod
	412	#endif
	413
	414

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

Download in other formats:

Original Format