source: LMDZ6/trunk/libf/phylmd/lmdz_wake_ini.f90 @ 5435

Last change on this file since 5435 was 5434, checked in by fhourdin, 15 hours ago

Superessing CPP in lmdz_*

Not possible for lmdz_thermcell_main because of isotopes

File size: 9.6 KB
RevLine 
[4588]1MODULE lmdz_wake_ini
[4085]2IMPLICIT NONE
3
4  ! ============================================================================
5
6
7  ! But : Decrire le comportement des poches froides apparaissant dans les
8  ! grands systemes convectifs, et fournir l'energie disponible pour
9  ! le declenchement de nouvelles colonnes convectives.
10
11  ! State variables :
12  ! deltatw    : temperature difference between wake and off-wake regions
13  ! deltaqw    : specific humidity difference between wake and off-wake regions
14  ! sigmaw     : fractional area covered by wakes.
15  ! wdens      : number of wakes per unit area
16
17  ! -------------------------------------------------------------------------
[4230]18  ! Declaration de variables
[4085]19  ! -------------------------------------------------------------------------
20
[4230]21  ! Variables a fixer
[4085]22!jyg<
23!!  REAL, SAVE                                            :: stark, wdens_ref, coefgw, alpk
[4744]24  INTEGER, SAVE, PROTECTED                                    :: prt_level
25  REAL, SAVE, PROTECTED, DIMENSION(2)                         :: wdens_ref
26  REAL, SAVE, PROTECTED                                       :: stark, coefgw, alpk, wk_pupper
[4085]27!>jyg
[4744]28  REAL, SAVE, PROTECTED                                       :: crep_upper, crep_sol 
[5400]29  !$OMP THREADPRIVATE(prt_level,stark, wdens_ref, coefgw, alpk, wk_pupper, crep_upper, crep_sol)
[4085]30
[4744]31  REAL, SAVE, PROTECTED                                       :: tau_cv
[4085]32  !$OMP THREADPRIVATE(tau_cv)
[4845]33
34   REAL, SAVE, PROTECTED                                       :: wk_delta_t_min
35  !$OMP THREADPRIVATE(wk_delta_t_min)
36
37   REAL, SAVE, PROTECTED                                       :: wk_frac_int_delta_t
38  !$OMP THREADPRIVATE(wk_frac_int_delta_t)
39
[4744]40  REAL, SAVE, PROTECTED                                       :: rzero, aa0 ! minimal wake radius and area
[4085]41  !$OMP THREADPRIVATE(rzero, aa0)
42
[4744]43  LOGICAL, SAVE, PROTECTED                                    :: ok_bug_gfl
[4695]44  !$OMP THREADPRIVATE(ok_bug_gfl)
[4744]45  LOGICAL, SAVE, PROTECTED                                    :: flag_wk_check_trgl
[4085]46  !$OMP THREADPRIVATE(flag_wk_check_trgl)
[4744]47  INTEGER, SAVE, PROTECTED                                    :: iflag_wk_act
[4085]48  !$OMP THREADPRIVATE(iflag_wk_act)
49
[4744]50  INTEGER, SAVE, PROTECTED                                    :: iflag_wk_check_trgl
[4085]51  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
[4744]52  INTEGER, SAVE, PROTECTED                                    :: iflag_wk_pop_dyn
[4085]53  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
54
[4744]55  INTEGER, SAVE, PROTECTED                                    :: iflag_wk_profile
[4294]56  !$OMP THREADPRIVATE(iflag_wk_profile)
57
[4908]58  INTEGER, SAVE, PROTECTED                                    :: wk_nsub
59  !$OMP THREADPRIVATE(wk_nsub)
60
[4842]61  INTEGER, SAVE, PROTECTED                                    :: iflag_wk_new_ptop
62  !$OMP THREADPRIVATE(iflag_wk_new_ptop)
63
[4744]64  REAL, SAVE, PROTECTED                                       :: wdensinit ! Minimum wake density used to restart wakes from a wake-free state
65  !$OMP THREADPRIVATE(wdensinit)
66  REAL, SAVE, PROTECTED                                       :: wdensthreshold ! Threshold wake density below which wakes are killed
67  !$OMP THREADPRIVATE(wdensthreshold)
68  REAL, SAVE, PROTECTED                                       :: sigmad, hwmin, wapecut, cstart
[4085]69  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
[4744]70  REAL, SAVE, PROTECTED                                       :: sigmaw_max
[4085]71  !$OMP THREADPRIVATE(sigmaw_max) 
[4744]72  REAL, SAVE, PROTECTED                                       :: dens_rate
[4085]73  !$OMP THREADPRIVATE(dens_rate)
[4744]74  REAL, SAVE, PROTECTED                                       :: epsilon_loc
[4085]75  !$OMP THREADPRIVATE(epsilon_loc)
[4744]76  REAL, SAVE, PROTECTED                                       :: epsim1,RG,RD
[4085]77  !$OMP THREADPRIVATE(epsim1,RG,RD)
[4744]78  REAL, SAVE, PROTECTED                                        ::smallestreal
79  !$OMP THREADPRIVATE(smallestreal)
[4908]80  REAL, SAVE, PROTECTED                                        :: wk_int_delta_t_min
81  !$OMP THREADPRIVATE(wk_int_delta_t_min)
[4085]82
[5181]83! CPP key used only in this module for debugging purposes. jyg 09/24
[5434]84  LOGICAL, SAVE, PROTECTED :: CPPKEY_IOPHYS_WK = .FALSE.
85  !$OMP THREADPRIVATE(CPPKEY_IOPHYS_WK)
[4085]86
87
[5181]88
[4085]89CONTAINS
90
91  ! =========================================================================
92  SUBROUTINE wake_ini(rg_in,rd_in,rv_in,prt_lev)
93  ! =========================================================================
94
95  ! **************************************************************
96  ! *
97  ! WAKE                                                        *
98  ! retour a un Pupper fixe                                *
99  ! *
100  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
101  ! modified by :   ROEHRIG Romain        01/29/2007            *
102  ! **************************************************************
103
104  ! -------------------------------------------------------------------------
105  ! Initialisations
106  ! -------------------------------------------------------------------------
107
108  USE ioipsl_getin_p_mod, ONLY : getin_p
109  real eps
110  integer, intent(in) :: prt_lev
111  real, intent(in) :: rg_in,rd_in,rv_in
112
[4744]113  smallestreal=tiny(smallestreal)
114!
[4085]115  prt_level=prt_lev
116  epsilon_loc=1.E-15
117  wapecut=1. ! previously 5.
[4744]118!
119  rzero = 5000.
120  CALL getin_p('rzero_wk', rzero)
121  aa0 = 3.14*rzero*rzero
122!
[4085]123  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
[4744]124!!  sigmad=0.005
[4085]125  sigmad=0.02
[4744]126  CALL getin_p('sigmad', sigmad)
[4085]127  hwmin=10.
[4744]128!
129!!wdensthreshold=1.e-12
130  wdensthreshold=1.e-14
131  wdensthreshold=2.e-14
132  CALL getin_p('wdensthreshold', wdensthreshold)
133!
134  IF (sigmad < 0.) THEN
135    sigmad = abs(sigmad)
136!!    wdensmin=sigmad/(3.14*rzero**2)
137    wdensinit=sigmad/(3.14*rzero**2)
138  ELSE
139    wdensinit = wdensthreshold/2.
140  ENDIF
141!
142!
[4085]143  ! cc nrlmd
144  sigmaw_max=0.4
145  dens_rate=0.1
146
147  eps = rd_in/rv_in
148  epsim1 = 1.0/eps - 1.0
149  RG=rg_in
150  RD=rd_in
151
152
153  ! cc
154  ! Longueur de maille (en m)
155  ! -------------------------------------------------------------------------
156
157  ! ALON = 3.e5
158  ! alon = 1.E6
159
160  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
161
[4230]162  ! coefgw : Coefficient pour les ondes de gravite
[4085]163  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
[4230]164  ! wdens : Densite surfacique de poche froide
[4085]165  ! -------------------------------------------------------------------------
166
167  ! cc nrlmd      coefgw=10
168  ! coefgw=1
169  ! wdens0 = 1.0/(alon**2)
170  ! cc nrlmd      wdens = 1.0/(alon**2)
171  ! cc nrlmd      stark = 0.50
172  ! CRtest
173  ! cc nrlmd      alpk=0.1
174  ! alpk = 1.0
175  ! alpk = 0.5
176  ! alpk = 0.05
177
178
179
180  crep_upper = 0.9
181  crep_sol = 1.0
182
[4695]183  ! Flag concerning the bug in gfl computation
184  ok_bug_gfl = .True.
185  call getin_p('ok_bug_gfl', ok_bug_gfl)
186
[4085]187  ! Get wapecut from parameter file
188  wapecut = 1.
189
190print*,'wapecut',wapecut
191  CALL getin_p('wapecut', wapecut)
192print*,'wapecut',wapecut
193
194  ! cc nrlmd Lecture du fichier wake_param.data
195
196
197  ! cc nrlmd Lecture du fichier wake_param.data
198  stark=0.33
199  CALL getin_p('stark',stark)
200  cstart = stark*sqrt(2.*wapecut)
201
202  alpk=0.25
203  CALL getin_p('alpk',alpk)
[4230]204 
[4453]205  wk_pupper=0.6
206  CALL getin_p('wk_pupper',wk_pupper)
[4230]207
208
[4085]209!jyg<
210!!  wdens_ref=8.E-12
211!!  CALL getin_p('wdens_ref',wdens_ref)
212  wdens_ref(1)=8.E-12
213  wdens_ref(2)=8.E-12
214  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
215  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
216!>jyg
217!
218!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
219!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
220!------------------------------------------------------------------------
221
222  iflag_wk_pop_dyn = 0
223  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed
224                                                    ! and wdens prognostic
225  iflag_wk_act = 0
226  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
227                                            ! 1: act(:)=1.
228                                            ! 2: act(:)=f(Wape)
229
[4294]230  iflag_wk_profile = 0
231  CALL getin_p('iflag_wk_profile',iflag_wk_profile) ! switch between wdens prescribed
232                                                    ! and wdens prognostic
[4845]233 ! iflag_wk_profile = 0
234  iflag_wk_new_ptop = 0
[4842]235  CALL getin_p('iflag_wk_new_ptop',iflag_wk_new_ptop)
236
[4908]237  wk_nsub = 10
238  CALL getin_p('wk_nsub',wk_nsub)
239
[4085]240  tau_cv = 4000.
241  CALL getin_p('tau_cv', tau_cv)
[4845]242 
243  wk_delta_t_min = 0.
244  CALL getin_p('wk_delta_t_min', wk_delta_t_min)
245 
[4908]246  wk_int_delta_t_min = 10.
247  CALL getin_p('wk_int_delta_t_min', wk_int_delta_t_min)
248 
[4845]249  wk_frac_int_delta_t = 0.9
250  CALL getin_p('wk_frac_int_delta_t', wk_frac_int_delta_t)
[4085]251
[5434]252  CALL getin_p('CPPKEY_IOPHYS_WK', CPPKEY_IOPHYS_WK)
[4845]253
[5434]254
[4085]255!------------------------------------------------------------------------
256
257  coefgw=4.
258  CALL getin_p('coefgw',coefgw)
259
260  WRITE(*,*) 'stark=', stark
261  WRITE(*,*) 'alpk=', alpk
[4453]262  WRITE(*,*) 'wk_pupper=', wk_pupper
[4085]263!jyg<
264!!  WRITE(*,*) 'wdens_ref=', wdens_ref
265  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
266  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
267!>jyg
268  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
269  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
270  WRITE(*,*) 'coefgw=', coefgw
271
272  flag_wk_check_trgl=.false.
273  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
274  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
275  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
276  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
277  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
278  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
[4845]279 
280  WRITE(*,*) 'wk_delta_t_min=', wk_delta_t_min
[4908]281  WRITE(*,*) 'wk_int_delta_t_min=', wk_int_delta_t_min
[4845]282  WRITE(*,*) 'wk_frac_int_delta_t=', wk_frac_int_delta_t
283  WRITE(*,*) 'iflag_wk_new_ptop=', iflag_wk_new_ptop
[4908]284  WRITE(*,*) 'wk_nsub=', wk_nsub
[4085]285
286 RETURN
287
288END SUBROUTINE wake_ini
289
[4744]290
291
[4588]292END MODULE lmdz_wake_ini
Note: See TracBrowser for help on using the repository browser.