source: LMDZ6/branches/Portage_acc/libf/phylmdiso/wake_ini_mod.F90 @ 4500

Last change on this file since 4500 was 4447, checked in by Laurent Fairhead, 17 months ago

Added some routines from the trunk that were previously links and that svn did not want to commit on the previous commit (with an
"Node filename has unexpectedly changed kind" error)
File size: 7.3 KB
Line 
1MODULE wake_ini_mod
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, pupperbyphs
28!>jyg
29  REAL, SAVE, PROTECTED                                            :: crep_upper, crep_sol 
30  !$OMP THREADPRIVATE(stark, wdens_ref, coefgw, alpk, pupperbyphs, 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                                         :: flag_wk_check_trgl
38  !$OMP THREADPRIVATE(flag_wk_check_trgl)
39  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_act
40  !$OMP THREADPRIVATE(iflag_wk_act)
41
42  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_check_trgl
43  !$OMP THREADPRIVATE(iflag_wk_check_trgl)
44  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_pop_dyn
45  !$OMP THREADPRIVATE(iflag_wk_pop_dyn)
46
47  INTEGER, SAVE, PROTECTED                                         :: iflag_wk_profile
48  !$OMP THREADPRIVATE(iflag_wk_profile)
49
50  REAL, SAVE, PROTECTED                                            :: wdensmin
51  !$OMP THREADPRIVATE(wdensmin)
52  REAL, SAVE, PROTECTED                                            :: sigmad, hwmin, wapecut, cstart
53  !$OMP THREADPRIVATE(sigmad, hwmin, wapecut, cstart)
54  REAL, SAVE, PROTECTED                                            :: sigmaw_max
55  !$OMP THREADPRIVATE(sigmaw_max) 
56  REAL, SAVE, PROTECTED                                            :: dens_rate
57  !$OMP THREADPRIVATE(dens_rate)
58  REAL, SAVE, PROTECTED                                            :: epsilon_loc
59  !$OMP THREADPRIVATE(epsilon_loc)
60  REAL, SAVE, PROTECTED                                            :: epsim1,RG,RD
61  !$OMP THREADPRIVATE(epsim1,RG,RD)
62
63
64
65CONTAINS
66
67  ! =========================================================================
68  SUBROUTINE wake_ini(rg_in,rd_in,rv_in,prt_lev)
69  ! =========================================================================
70
71  ! **************************************************************
72  ! *
73  ! WAKE                                                        *
74  ! retour a un Pupper fixe                                *
75  ! *
76  ! written by   :  GRANDPEIX Jean-Yves   09/03/2000            *
77  ! modified by :   ROEHRIG Romain        01/29/2007            *
78  ! **************************************************************
79
80  ! -------------------------------------------------------------------------
81  ! Initialisations
82  ! -------------------------------------------------------------------------
83
84  USE ioipsl_getin_p_mod, ONLY : getin_p
85  real eps
86  integer, intent(in) :: prt_lev
87  real, intent(in) :: rg_in,rd_in,rv_in
88
89  prt_level=prt_lev
90  epsilon_loc=1.E-15
91  wapecut=1. ! previously 5.
92  ! Essais d'initialisation avec sigmaw = 0.02 et hw = 10.
93  sigmad=0.02
94  hwmin=10.
95!!  DATA wdensmin/1.e-12/
96  wdensmin=1.e-14
97  ! cc nrlmd
98  sigmaw_max=0.4
99  dens_rate=0.1
100
101  eps = rd_in/rv_in
102  epsim1 = 1.0/eps - 1.0
103  RG=rg_in
104  RD=rd_in
105
106
107  ! cc
108  ! Longueur de maille (en m)
109  ! -------------------------------------------------------------------------
110
111  ! ALON = 3.e5
112  ! alon = 1.E6
113
114  ! Configuration de coefgw,stark,wdens (22/02/06 by YU Jingmei)
115
116  ! coefgw : Coefficient pour les ondes de gravite
117  ! stark : Coefficient k dans Cstar=k*sqrt(2*WAPE)
118  ! wdens : Densite surfacique de poche froide
119  ! -------------------------------------------------------------------------
120
121  ! cc nrlmd      coefgw=10
122  ! coefgw=1
123  ! wdens0 = 1.0/(alon**2)
124  ! cc nrlmd      wdens = 1.0/(alon**2)
125  ! cc nrlmd      stark = 0.50
126  ! CRtest
127  ! cc nrlmd      alpk=0.1
128  ! alpk = 1.0
129  ! alpk = 0.5
130  ! alpk = 0.05
131
132
133
134  crep_upper = 0.9
135  crep_sol = 1.0
136
137  ! Get wapecut from parameter file
138  wapecut = 1.
139
140print*,'wapecut',wapecut
141  CALL getin_p('wapecut', wapecut)
142print*,'wapecut',wapecut
143
144  ! cc nrlmd Lecture du fichier wake_param.data
145
146
147  ! cc nrlmd Lecture du fichier wake_param.data
148  stark=0.33
149  CALL getin_p('stark',stark)
150  cstart = stark*sqrt(2.*wapecut)
151
152  alpk=0.25
153  CALL getin_p('alpk',alpk)
154 
155  pupperbyphs=0.6
156  CALL getin_p('pupperbyphs',pupperbyphs)
157
158
159!jyg<
160!!  wdens_ref=8.E-12
161!!  CALL getin_p('wdens_ref',wdens_ref)
162  wdens_ref(1)=8.E-12
163  wdens_ref(2)=8.E-12
164  CALL getin_p('wdens_ref_o',wdens_ref(1))    !wake number per unit area ; ocean
165  CALL getin_p('wdens_ref_l',wdens_ref(2))    !wake number per unit area ; land
166!>jyg
167!
168!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
169!!!!!!!!!  Population dynamics parameters    !!!!!!!!!!!!!!!!!!!!!!!!!!!!
170!------------------------------------------------------------------------
171
172  iflag_wk_pop_dyn = 0
173  CALL getin_p('iflag_wk_pop_dyn',iflag_wk_pop_dyn) ! switch between wdens prescribed
174                                                    ! and wdens prognostic
175  iflag_wk_act = 0
176  CALL getin_p('iflag_wk_act',iflag_wk_act) ! 0: act(:)=0.
177                                            ! 1: act(:)=1.
178                                            ! 2: act(:)=f(Wape)
179
180  iflag_wk_profile = 0
181  CALL getin_p('iflag_wk_profile',iflag_wk_profile) ! switch between wdens prescribed
182                                                    ! and wdens prognostic
183  rzero = 5000.
184  CALL getin_p('rzero_wk', rzero)
185  aa0 = 3.14*rzero*rzero
186!
187  tau_cv = 4000.
188  CALL getin_p('tau_cv', tau_cv)
189
190!------------------------------------------------------------------------
191
192  coefgw=4.
193  CALL getin_p('coefgw',coefgw)
194
195  WRITE(*,*) 'stark=', stark
196  WRITE(*,*) 'alpk=', alpk
197  WRITE(*,*) 'pupperbyphs=', pupperbyphs
198!jyg<
199!!  WRITE(*,*) 'wdens_ref=', wdens_ref
200  WRITE(*,*) 'wdens_ref_o=', wdens_ref(1)
201  WRITE(*,*) 'wdens_ref_l=', wdens_ref(2)
202!>jyg
203  WRITE(*,*) 'iflag_wk_pop_dyn=',iflag_wk_pop_dyn
204  WRITE(*,*) 'iflag_wk_act',iflag_wk_act
205  WRITE(*,*) 'coefgw=', coefgw
206
207  flag_wk_check_trgl=.false.
208  CALL getin_p('flag_wk_check_trgl ', flag_wk_check_trgl)
209  WRITE(*,*) 'flag_wk_check_trgl=', flag_wk_check_trgl
210  WRITE(*,*) 'flag_wk_check_trgl OBSOLETE. Utilisr iflag_wk_check_trgl plutot'
211  iflag_wk_check_trgl=0 ; IF (flag_wk_check_trgl) iflag_wk_check_trgl=1
212  CALL getin_p('iflag_wk_check_trgl ', iflag_wk_check_trgl)
213  WRITE(*,*) 'iflag_wk_check_trgl=', iflag_wk_check_trgl
214
215 RETURN
216
217END SUBROUTINE wake_ini
218
219END MODULE wake_ini_mod
Note: See TracBrowser for help on using the repository browser.