Context Navigation

isotopes_mod.F90 @ 4359

Last change on this file since 4359 was 4325, checked in by dcugnet, 2 years ago
simplify the parser usage: the getKey_init routine is now embedded in the readTracersFile routine. the initIsotopes routine is now embedded in the readIsotopesFile routine. the database is now unique, but can be changed using the get/setKeysDBase. the derived types descriptions, originally located in trac_types_mod, are moved to readTracFiles_mod. few checkings moved from infotrac to the routine testIsotopes, contained in the readIsotopesFile function from readTracFiles_mod. the readTracersFiles and readIsotopesFile routines no longer use a tracers/isotopes argument. remove tnat and alpha_ideal from infotrac ; use instead getKey to get them where they are used (check_isotopes, dynetat0, iniacademic) the trac_type field %Childs is renamed %Children move the isoSelect routine and the corresponding variables routine from infotrac and infotrac_phy to readTracFiles_mod infotrac_phy routine is now fully independant of the (very similar) routine infotrac (init_infotrac_phy has no arguments left). all the explicit keys of the trac_type are now included in the embedded keys database, accessible using the getKey function. the getKey/addKey routines are expanded to handle vectors of integers, reals, logicals or strings. few subroutines converted into functions with error return value. corrections for isotopic tagging tracers mode (to be continued).
Property svn:executable set to ``*
File size: 17.8 KB

Line
1	#ifdef ISO
2	! $Id: $
3
4	MODULE isotopes_mod
5	USE strings_mod, ONLY: msg, real2str, int2str, bool2str, maxlen, strIdx, strStack
6	USE infotrac_phy, ONLY: isoName
7	IMPLICIT NONE
8	INTERFACE get_in; MODULE PROCEDURE getinp_s, getinp_i, getinp_r, getinp_l; END INTERFACE get_in
9	SAVE
10
11	!--- Contains all isotopic variables + their initialization
12	!--- Isotopes-specific routines are in isotopes_routines_mod to avoid circular dependencies with isotopes_verif_mod.
13
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)
17
18	INTEGER, SAVE :: ntracisoOR
19	!$OMP THREADPRIVATE(ntracisoOR)
20
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
25	!$OMP THREADPRIVATE(tdifexp, tv0cin, thumxt1)
26	INTEGER, SAVE :: ntot
27	!$OMP THREADPRIVATE(ntot)
28	REAL, SAVE :: h_land_ice
29	!$OMP THREADPRIVATE(h_land_ice)
30	REAL, SAVE :: P_veg
31	!$OMP THREADPRIVATE(P_veg)
32	REAL, SAVE :: musi, lambda_sursat
33	!$OMP THREADPRIVATE(musi, lambda_sursat)
34	REAL, SAVE :: Kd
35	!$OMP THREADPRIVATE(Kd)
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
39	!$OMP THREADPRIVATE(bidouille_anti_divergence)
40	LOGICAL, SAVE :: essai_convergence ! F: as in LMDZ without isotopes (bad for isotopes)
41	!$OMP THREADPRIVATE(essai_convergence)
42	INTEGER, SAVE :: initialisation_iso ! 0: file ; 1: R=0 ; 2: R=distill. Rayleigh ; 3: R=Rsmow
43	!$OMP THREADPRIVATE(initialisation_iso)
44	INTEGER, SAVE :: modif_SST ! 0: default ; 1: modified SST ; 2, 3: SST profiles
45	!$OMP THREADPRIVATE(modif_SST)
46	REAL, SAVE :: deltaTtest ! Uniform modification of the SST
47	!$OMP THREADPRIVATE(deltaTtest)
48	INTEGER, SAVE :: modif_sic ! Holes in the Sea Ice
49	!$OMP THREADPRIVATE(modif_sic)
50	REAL, SAVE :: deltasic ! Minimal holes fraction
51	!$OMP THREADPRIVATE(deltasic)
52	REAL, SAVE :: deltaTtestpoles
53	!$OMP THREADPRIVATE(deltaTtestpoles)
54	REAL, SAVE :: sstlatcrit, dsstlatcrit
55	!$OMP THREADPRIVATE(sstlatcrit, dsstlatcrit)
56	REAL, SAVE :: deltaO18_oce
57	!$OMP THREADPRIVATE(deltaO18_oce)
58	INTEGER, SAVE :: albedo_prescrit ! 0: default ; 1: constant albedo
59	!$OMP THREADPRIVATE(albedo_prescrit)
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
63	!$OMP THREADPRIVATE(deltaP_BL,tdifexp_sol)
64	INTEGER, SAVE :: ruissellement_pluie, alphak_stewart
65	!$OMP THREADPRIVATE(ruissellement_pluie, alphak_stewart)
66	INTEGER, SAVE :: calendrier_guide
67	!$OMP THREADPRIVATE(calendrier_guide)
68	INTEGER, SAVE :: cste_surf_cond
69	!$OMP THREADPRIVATE(cste_surf_cond)
70	REAL, SAVE :: mixlen
71	!$OMP THREADPRIVATE(mixlen)
72	INTEGER, SAVE :: evap_cont_cste
73	!$OMP THREADPRIVATE(evap_cont_cste)
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
79	!$OMP THREADPRIVATE(nlevmaxO17)
80	INTEGER, SAVE :: no_pce
81	!$OMP THREADPRIVATE(no_pce)
82	REAL, SAVE :: A_satlim
83	!$OMP THREADPRIVATE(A_satlim)
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
89	!$OMP THREADPRIVATE(fac_modif_evaoce)
90	INTEGER, SAVE :: ok_bidouille_wake
91	!$OMP THREADPRIVATE(ok_bidouille_wake)
92	LOGICAL, SAVE :: cond_temp_env
93	!$OMP THREADPRIVATE(cond_temp_env)
94
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
104	!$OMP THREADPRIVATE(tkcin0, tkcin1, tkcin2)
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
109	!$OMP THREADPRIVATE(fac_coeff_eq17_liq, fac_coeff_eq17_ice)
110
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
119
120	!--- Specific to HTO:
121	LOGICAL, SAVE :: ok_prod_nucl_tritium !--- TRUE => HTO production by nuclear tests
122	!$OMP THREADPRIVATE(ok_prod_nucl_tritium)
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)
130
131
132	CONTAINS
133
134	SUBROUTINE iso_init()
135	USE infotrac_phy, ONLY: ntiso, niso, getKey
136	USE strings_mod, ONLY: maxlen
137	IMPLICIT NONE
138
139	!=== Local variables:
140	INTEGER :: ixt
141
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
149
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
154
155	!--- For [3]H
156	INTEGER :: iessai
157
158	CHARACTER(LEN=maxlen) :: modname, sxt
159	REAL, ALLOCATABLE :: tmp(:)
160
161	modname = 'iso_init'
162	CALL msg('219: entree', modname)
163
164	!--------------------------------------------------------------
165	! General:
166	!--------------------------------------------------------------
167
168	!--- Check number of isotopes
169	CALL msg('64: niso = '//TRIM(int2str(niso)), modname)
170
171	!--- Init de ntracisoOR: on ecrasera en cas de traceurs de tagging isotopiques
172	! (nzone>0) si complications avec ORCHIDEE
173	ntracisoOR = ntiso
174
175	!--- Type of water isotopes:
176	iso_eau = strIdx(isoName, 'H2[16]O'); CALL msg('iso_eau='//int2str(iso_eau), modname)
177	iso_HDO = strIdx(isoName, 'H[2]HO'); CALL msg('iso_HDO='//int2str(iso_HDO), modname)
178	iso_O18 = strIdx(isoName, 'H2[18]O'); CALL msg('iso_O18='//int2str(iso_O18), modname)
179	iso_O17 = strIdx(isoName, 'H2[17]O'); CALL msg('iso_O17='//int2str(iso_O17), modname)
180	iso_HTO = strIdx(isoName, 'H[3]HO'); CALL msg('iso_HTO='//int2str(iso_HTO), modname)
181
182	!--- Initialiaation: reading the isotopic parameters.
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
199	#ifdef ISOVERIF
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
203	#endif
204
205	CALL get_in('modif_sic', modif_sic, 0)
206	IF(modif_sic >= 1) &
207	CALL get_in('deltasic', deltasic, 0.1)
208
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
216	deltaO18_oce=0.0
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.)
248	IF(ANY(isoName == 'H[3]HO')) &
249	CALL get_in('ok_prod_nucl_tritium', ok_prod_nucl_tritium, .FALSE., .FALSE.)
250
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
256
257	! -- temperature at which all condensate is ice:
258	pxtice = 273.15-10.0
259
260	!- -- test PHASE
261	! pxtmelt = 273.15 - 10.0
262	! pxtice = 273.15 - 30.0
263
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!
268
269	! -- a constant for alpha_eff for equilibrium below cloud base:
270	tdifexp = 0.58
271	tv0cin = 7.0
272
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
276
277	! diffusion dans le sol
278	Kd=2.5e-9 ! m2/s
279
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
284	CALL msg('iso_O18, iso_HDO, iso_eau = '//TRIM(strStack(int2str([iso_O18, iso_HDO, iso_eau]))), modname)
285
286	!--------------------------------------------------------------
287	! Parameters that depend on the nature of water isotopes:
288	!--------------------------------------------------------------
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	IF(.NOT.Rdefault_smow) Rdefault(:) = 0.0
305
306	!--- Sensitivity test: no kinetic effect in sfc evaporation
307	IF(ok_nocinsfc) THEN
308	tkcin0(1:niso) = 0.0
309	tkcin1(1:niso) = 0.0
310	tkcin2(1:niso) = 0.0
311	END IF
312
313	CALL msg('285: verif initialisation:', modname)
314	DO ixt=1,niso
315	sxt=int2str(ixt)
316	CALL msg(' * isoName('//TRIM(sxt)//') = <'//TRIM(isoName(ixt))//'>', modname)
317	CALL msg( ' tnat('//TRIM(sxt)//') = '//TRIM(real2str(tnat(ixt))), modname)
318	! CALL msg(' alpha_liq_sol('//TRIM(sxt)//') = '//TRIM(real2str(alpha_liq_sol(ixt))), modname)
319	! CALL msg( ' tkcin0('//TRIM(sxt)//') = '//TRIM(real2str(tkcin0(ixt))), modname)
320	! CALL msg( ' tdifrel('//TRIM(sxt)//') = '//TRIM(real2str(tdifrel(ixt))), modname)
321	END DO
322	CALL msg('69: lambda = '//TRIM(real2str(lambda_sursat)), modname)
323	CALL msg('69: thumxt1 = '//TRIM(real2str(thumxt1)), modname)
324	CALL msg('69: h_land_ice = '//TRIM(real2str(h_land_ice)), modname)
325	CALL msg('69: P_veg = '//TRIM(real2str(P_veg)), modname)
326
327	END SUBROUTINE iso_init
328
329
330	SUBROUTINE getinp_s(nam, val, def, lDisp)
331	USE ioipsl_getincom, ONLY: getin
332	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
333	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
334	USE mod_phys_lmdz_transfert_para, ONLY : bcast
335	CHARACTER(LEN=*), INTENT(IN) :: nam
336	CHARACTER(LEN=*), INTENT(INOUT) :: val
337	CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: def
338	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
339	LOGICAL :: lD
340	!$OMP BARRIER
341	IF(is_mpi_root.AND.is_omp_root) THEN
342	IF(PRESENT(def)) val=def; CALL getin(nam,val)
343	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
344	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
345	END IF
346	CALL bcast(val)
347	END SUBROUTINE getinp_s
348
349	SUBROUTINE getinp_i(nam, val, def, lDisp)
350	USE ioipsl_getincom, ONLY: getin
351	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
352	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
353	USE mod_phys_lmdz_transfert_para, ONLY : bcast
354	CHARACTER(LEN=*), INTENT(IN) :: nam
355	INTEGER, INTENT(INOUT) :: val
356	INTEGER, OPTIONAL, INTENT(IN) :: def
357	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
358	LOGICAL :: lD
359	!$OMP BARRIER
360	IF(is_mpi_root.AND.is_omp_root) THEN
361	IF(PRESENT(def)) val=def; CALL getin(nam,val)
362	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
363	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(int2str(val)))
364	END IF
365	CALL bcast(val)
366	END SUBROUTINE getinp_i
367
368	SUBROUTINE getinp_r(nam, val, def, lDisp)
369	USE ioipsl_getincom, ONLY: getin
370	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
371	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
372	USE mod_phys_lmdz_transfert_para, ONLY : bcast
373	CHARACTER(LEN=*), INTENT(IN) :: nam
374	REAL, INTENT(INOUT) :: val
375	REAL, OPTIONAL, INTENT(IN) :: def
376	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
377	LOGICAL :: lD
378	!$OMP BARRIER
379	IF(is_mpi_root.AND.is_omp_root) THEN
380	IF(PRESENT(def)) val=def; CALL getin(nam,val)
381	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
382	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(real2str(val)))
383	END IF
384	CALL bcast(val)
385	END SUBROUTINE getinp_r
386
387	SUBROUTINE getinp_l(nam, val, def, lDisp)
388	USE ioipsl_getincom, ONLY: getin
389	USE mod_phys_lmdz_mpi_data, ONLY : is_mpi_root
390	USE mod_phys_lmdz_omp_data, ONLY : is_omp_root
391	USE mod_phys_lmdz_transfert_para, ONLY : bcast
392	CHARACTER(LEN=*), INTENT(IN) :: nam
393	LOGICAL, INTENT(INOUT) :: val
394	LOGICAL, OPTIONAL, INTENT(IN) :: def
395	LOGICAL, OPTIONAL, INTENT(IN) :: lDisp
396	LOGICAL :: lD
397	!$OMP BARRIER
398	IF(is_mpi_root.AND.is_omp_root) THEN
399	IF(PRESENT(def)) val=def; CALL getin(nam,val)
400	lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
401	IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(bool2str(val)))
402	END IF
403	CALL bcast(val)
404	END SUBROUTINE getinp_l
405
406	END MODULE isotopes_mod
407	#endif
408
409

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

Download in other formats:

Original Format