source: LMDZ6/trunk/libf/phylmd/lmdz_wake_ini.F90 @ 4695

Last change on this file since 4695 was 4695, checked in by jyg, 9 months ago

Bug fix in lmdz_wake.F90 and associated flag ok_bug_gfl

File size: 7.5 KB
Line 
1MODULE lmdz_wake_ini
2IMPLICIT NONE
3
4
5  ! ============================================================================
6
7
8  ! But : Decrire le comportement des poches froides apparaissant dans les
9  ! grands systemes convectifs, et fournir l'energie disponible pour
10  ! le declenchement de nouvelles colonnes convectives.
11
12  ! State variables :
13  ! deltatw    : temperature difference between wake and off-wake regions
14  ! deltaqw    : specific humidity difference between wake and off-wake regions
15  ! sigmaw     : fractional area covered by wakes.
16  ! wdens      : number of wakes per unit area
17
18  ! -------------------------------------------------------------------------
19  ! Declaration de variables
20  ! -------------------------------------------------------------------------
21
22  ! Variables a fixer
23!jyg<
24!!  REAL, SAVE                                            :: stark, wdens_ref, coefgw, alpk
25  INTEGER, SAVE, PROTECTED                                         :: prt_level
26  REAL, SAVE, PROTECTED, DIMENSION(2)                              :: wdens_ref
27  REAL, SAVE, PROTECTED                                            :: stark, coefgw, alpk, wk_pupper
28!>jyg
29  REAL, SAVE, PROTECTED                                            :: crep_upper, crep_sol 
30  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, wk_pupper, crep_upper, crep_sol)
31
32  REAL, SAVE, PROTECTED                                            :: tau_cv
33  !$OMP THREADPRIVATE(tau_cv)
34  REAL, SAVE, PROTECTED                                            :: rzero, aa0 ! minimal wake radius and area
35  !$OMP THREADPRIVATE(rzero, aa0)
36
37  LOGICAL, SAVE, PROTECTED                                         :: ok_bug_gfl
38  !$OMP THREADPRIVATE(ok_bug_gfl)
39  LOGICAL, SAVE, PROTECTED                                         :: flag_wk_check_trgl
40  !$OMP THREADPRIVATE(flag_wk_check_trgl)
41  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_act
42  !$OMP THREADPRIVATE(iflag_wk_act)
43
44  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_check_trgl
45  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
46  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_pop_dyn
47  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
48
49  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_profile
50  !$OMP THREADPRIVATE(iflag_wk_profile)
51
52  REAL, SAVE, PROTECTED                                            :: wdensmin
53  !$OMP THREADPRIVATE(wdensmin)
54  REAL, SAVE, PROTECTED                                            :: sigmad, hwmin, wapecut, cstart
55  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
56  REAL, SAVE, PROTECTED                                            :: sigmaw_max
57  !$OMP THREADPRIVATE(sigmaw_max) 
58  REAL, SAVE, PROTECTED                                            :: dens_rate
59  !$OMP THREADPRIVATE(dens_rate)
60  REAL, SAVE, PROTECTED                                            :: epsilon_loc
61  !$OMP THREADPRIVATE(epsilon_loc)
62  REAL, SAVE, PROTECTED                                            :: epsim1,RG,RD
63  !$OMP THREADPRIVATE(epsim1,RG,RD)
64
65
66
67CONTAINS
68
69  ! =========================================================================
70  SUBROUTINE wake_ini(rg_in,rd_in,rv_in,prt_lev)
71  ! =========================================================================
72
73  ! **************************************************************
74  ! *
75  ! WAKE                                                        *
76  ! retour a un Pupper fixe                                *
77  ! *
78  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
79  ! modified by :   ROEHRIG Romain        01/29/2007            *
80  ! **************************************************************
81
82  ! -------------------------------------------------------------------------
83  ! Initialisations
84  ! -------------------------------------------------------------------------
85
86  USE ioipsl_getin_p_mod, ONLY : getin_p
87  real eps
88  integer, intent(in) :: prt_lev
89  real, intent(in) :: rg_in,rd_in,rv_in
90
91  prt_level=prt_lev
92  epsilon_loc=1.E-15
93  wapecut=1. ! previously 5.
94  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
95  sigmad=0.02
96  hwmin=10.
97!!  DATA wdensmin/1.e-12/
98  wdensmin=1.e-14
99  ! cc nrlmd
100  sigmaw_max=0.4
101  dens_rate=0.1
102
103  eps = rd_in/rv_in
104  epsim1 = 1.0/eps - 1.0
105  RG=rg_in
106  RD=rd_in
107
108
109  ! cc
110  ! Longueur de maille (en m)
111  ! -------------------------------------------------------------------------
112
113  ! ALON = 3.e5
114  ! alon = 1.E6
115
116  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
117
118  ! coefgw : Coefficient pour les ondes de gravite
119  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
120  ! wdens : Densite surfacique de poche froide
121  ! -------------------------------------------------------------------------
122
123  ! cc nrlmd      coefgw=10
124  ! coefgw=1
125  ! wdens0 = 1.0/(alon**2)
126  ! cc nrlmd      wdens = 1.0/(alon**2)
127  ! cc nrlmd      stark = 0.50
128  ! CRtest
129  ! cc nrlmd      alpk=0.1
130  ! alpk = 1.0
131  ! alpk = 0.5
132  ! alpk = 0.05
133
134
135
136  crep_upper = 0.9
137  crep_sol = 1.0
138
139  ! Flag concerning the bug in gfl computation
140  ok_bug_gfl = .True.
141  call getin_p('ok_bug_gfl', ok_bug_gfl)
142
143  ! Get wapecut from parameter file
144  wapecut = 1.
145
146print*,'wapecut',wapecut
147  CALL getin_p('wapecut', wapecut)
148print*,'wapecut',wapecut
149
150  ! cc nrlmd Lecture du fichier wake_param.data
151
152
153  ! cc nrlmd Lecture du fichier wake_param.data
154  stark=0.33
155  CALL getin_p('stark',stark)
156  cstart = stark*sqrt(2.*wapecut)
157
158  alpk=0.25
159  CALL getin_p('alpk',alpk)
160 
161  wk_pupper=0.6
162  CALL getin_p('wk_pupper',wk_pupper)
163
164
165!jyg<
166!!  wdens_ref=8.E-12
167!!  CALL getin_p('wdens_ref',wdens_ref)
168  wdens_ref(1)=8.E-12
169  wdens_ref(2)=8.E-12
170  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
171  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
172!>jyg
173!
174!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
175!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
176!------------------------------------------------------------------------
177
178  iflag_wk_pop_dyn = 0
179  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed
180                                                    ! and wdens prognostic
181  iflag_wk_act = 0
182  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
183                                            ! 1: act(:)=1.
184                                            ! 2: act(:)=f(Wape)
185
186  iflag_wk_profile = 0
187  CALL getin_p('iflag_wk_profile',iflag_wk_profile) ! switch between wdens prescribed
188                                                    ! and wdens prognostic
189  rzero = 5000.
190  CALL getin_p('rzero_wk', rzero)
191  aa0 = 3.14*rzero*rzero
192!
193  tau_cv = 4000.
194  CALL getin_p('tau_cv', tau_cv)
195
196!------------------------------------------------------------------------
197
198  coefgw=4.
199  CALL getin_p('coefgw',coefgw)
200
201  WRITE(*,*) 'stark=', stark
202  WRITE(*,*) 'alpk=', alpk
203  WRITE(*,*) 'wk_pupper=', wk_pupper
204!jyg<
205!!  WRITE(*,*) 'wdens_ref=', wdens_ref
206  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
207  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
208!>jyg
209  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
210  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
211  WRITE(*,*) 'coefgw=', coefgw
212
213  flag_wk_check_trgl=.false.
214  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
215  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
216  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
217  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
218  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
219  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
220
221 RETURN
222
223END SUBROUTINE wake_ini
224
225END MODULE lmdz_wake_ini
Note: See TracBrowser for help on using the repository browser.