source: LMDZ6/branches/Test_modipsl/libf/phylmdiso/isotopes_mod.F90 @ 5428

Last change on this file since 5428 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
Line 
1#ifdef ISO
2! $Id: $
3
4MODULE 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 
132CONTAINS
133
134SUBROUTINE 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, '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)
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 == 'HTO')) &
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
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
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
317
318   CALL msg('285: verif initialisation:', modname)
319   DO ixt=1,niso
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)
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)
331
332END SUBROUTINE iso_init
333
334
335SUBROUTINE 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
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
344   LOGICAL :: lD
345!$OMP BARRIER
346   IF(is_mpi_root.AND.is_omp_root) THEN
347      IF(PRESENT(def)) val=def; CALL getin(nam,val)
348      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
349      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(val))
350  END IF
351  CALL bcast(val)
352END SUBROUTINE getinp_s
353
354SUBROUTINE 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
361   INTEGER, OPTIONAL, INTENT(IN)    :: def
362   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
363   LOGICAL :: lD
364!$OMP BARRIER
365   IF(is_mpi_root.AND.is_omp_root) THEN
366      IF(PRESENT(def)) val=def; CALL getin(nam,val)
367      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
368      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(int2str(val)))
369  END IF
370  CALL bcast(val)
371END SUBROUTINE getinp_i
372
373SUBROUTINE 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
380   REAL,    OPTIONAL, INTENT(IN)    :: def
381   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
382   LOGICAL :: lD
383!$OMP BARRIER
384   IF(is_mpi_root.AND.is_omp_root) THEN
385      IF(PRESENT(def)) val=def; CALL getin(nam,val)
386      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
387      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(real2str(val)))
388  END IF
389  CALL bcast(val)
390END SUBROUTINE getinp_r
391
392SUBROUTINE 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
399   LOGICAL, OPTIONAL, INTENT(IN)    :: def
400   LOGICAL, OPTIONAL, INTENT(IN)    :: lDisp
401   LOGICAL :: lD
402!$OMP BARRIER
403   IF(is_mpi_root.AND.is_omp_root) THEN
404      IF(PRESENT(def)) val=def; CALL getin(nam,val)
405      lD=.TRUE.; IF(PRESENT(lDisp)) lD=lDisp
406      IF(lD) CALL msg(TRIM(nam)//' = '//TRIM(bool2str(val)))
407  END IF
408  CALL bcast(val)
409END SUBROUTINE getinp_l
410
411END MODULE isotopes_mod
412#endif
413
414
Note: See TracBrowser for help on using the repository browser.