1 | SUBROUTINE alpale( debut, itap, dtime, paprs, omega, t_seri, & |
---|
2 | alp_offset, it_wape_prescr, wape_prescr, fip_prescr, & |
---|
3 | ale_bl_prescr, alp_bl_prescr, & |
---|
4 | wake_pe, wake_fip, & |
---|
5 | Ale_bl, Ale_bl_trig, Alp_bl, & |
---|
6 | Ale, Alp, Ale_wake, Alp_wake ) |
---|
7 | |
---|
8 | ! ************************************************************** |
---|
9 | ! * |
---|
10 | ! ALPALE * |
---|
11 | ! * |
---|
12 | ! * |
---|
13 | ! written by : Jean-Yves Grandpeix, 12/05/2016 * |
---|
14 | ! modified by : * |
---|
15 | ! ************************************************************** |
---|
16 | |
---|
17 | USE dimphy |
---|
18 | USE lmdz_ioipsl_getin_p, ONLY: getin_p |
---|
19 | USE lmdz_print_control, ONLY: mydebug=>debug , lunout, prt_level |
---|
20 | USE phys_local_var_mod, ONLY: zw2 ! Variables internes non sauvegardees de la physique |
---|
21 | USE lmdz_abort_physic, ONLY: abort_physic |
---|
22 | |
---|
23 | IMPLICIT NONE |
---|
24 | |
---|
25 | !================================================================ |
---|
26 | ! Auteur(s) : Jean-Yves Grandpeix, 12/05/2016 |
---|
27 | ! Objet : Sums up all contributions to Ale and Alp |
---|
28 | !================================================================ |
---|
29 | |
---|
30 | ! Input arguments |
---|
31 | !---------------- |
---|
32 | LOGICAL, INTENT(IN) :: debut |
---|
33 | INTEGER, INTENT(IN) :: itap |
---|
34 | REAL, INTENT(IN) :: dtime |
---|
35 | INTEGER, INTENT(IN) :: it_wape_prescr |
---|
36 | REAL, INTENT(IN) :: wape_prescr, fip_prescr |
---|
37 | REAL, INTENT(IN) :: Ale_bl_prescr, Alp_bl_prescr |
---|
38 | REAL, INTENT(IN) :: alp_offset |
---|
39 | REAL, DIMENSION(klon,klev+1), INTENT(IN) :: paprs |
---|
40 | REAL, DIMENSION(klon,klev), INTENT(IN) :: t_seri |
---|
41 | REAL, DIMENSION(klon,klev), INTENT(IN) :: omega |
---|
42 | REAL, DIMENSION(klon), INTENT(IN) :: wake_pe, wake_fip |
---|
43 | REAL, DIMENSION(klon), INTENT(IN) :: Ale_bl, Ale_bl_trig, Alp_bl |
---|
44 | |
---|
45 | |
---|
46 | ! Output arguments |
---|
47 | !---------------- |
---|
48 | REAL, DIMENSION(klon), INTENT(OUT) :: Ale, Alp |
---|
49 | REAL, DIMENSION(klon), INTENT(OUT) :: Ale_wake, Alp_wake |
---|
50 | |
---|
51 | include "alpale.h" |
---|
52 | include "YOMCST.h" |
---|
53 | include "YOETHF.h" |
---|
54 | |
---|
55 | ! Local variables |
---|
56 | !---------------- |
---|
57 | INTEGER :: i, k |
---|
58 | REAL, DIMENSION(klon) :: www |
---|
59 | REAL, SAVE :: ale_max=1000. |
---|
60 | REAL, SAVE :: alp_max=2. |
---|
61 | CHARACTER*20 modname |
---|
62 | CHARACTER*80 abort_message |
---|
63 | |
---|
64 | |
---|
65 | !$OMP THREADPRIVATE(ale_max,alp_max) |
---|
66 | |
---|
67 | ! Calcul de l'energie disponible ALE (J/kg) et de la puissance |
---|
68 | ! disponible ALP (W/m2) pour le soulevement des particules dans |
---|
69 | ! le modele convectif |
---|
70 | |
---|
71 | do i = 1,klon |
---|
72 | ALE(i) = 0. |
---|
73 | ALP(i) = 0. |
---|
74 | enddo |
---|
75 | |
---|
76 | !calcul de ale_wake et alp_wake |
---|
77 | IF (iflag_wake>=1) THEN |
---|
78 | IF (itap <= it_wape_prescr) THEN |
---|
79 | do i = 1,klon |
---|
80 | ale_wake(i) = wape_prescr |
---|
81 | alp_wake(i) = fip_prescr |
---|
82 | enddo |
---|
83 | else |
---|
84 | do i = 1,klon |
---|
85 | !jyg ALE=WAPE au lieu de ALE = 1/2 Cstar**2 |
---|
86 | !cc ale_wake(i) = 0.5*wake_cstar(i)**2 |
---|
87 | ale_wake(i) = wake_pe(i) |
---|
88 | alp_wake(i) = wake_fip(i) |
---|
89 | enddo |
---|
90 | endif |
---|
91 | else |
---|
92 | do i = 1,klon |
---|
93 | ale_wake(i) = 0. |
---|
94 | alp_wake(i) = 0. |
---|
95 | enddo |
---|
96 | endif |
---|
97 | !combinaison avec ale et alp de couche limite: constantes si pas |
---|
98 | !de couplage, valeurs calculees dans le thermique sinon |
---|
99 | IF (iflag_coupl==0) THEN |
---|
100 | IF (debut.AND.prt_level>9) & |
---|
101 | WRITE(lunout,*)'ALE et ALP imposes' |
---|
102 | do i = 1,klon |
---|
103 | !on ne couple que ale |
---|
104 | ! ALE(i) = max(ale_wake(i),Ale_bl(i)) |
---|
105 | ALE(i) = max(ale_wake(i),ale_bl_prescr) |
---|
106 | !on ne couple que alp |
---|
107 | ! ALP(i) = alp_wake(i) + Alp_bl(i) |
---|
108 | ALP(i) = alp_wake(i) + alp_bl_prescr |
---|
109 | enddo |
---|
110 | else |
---|
111 | IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique' |
---|
112 | ! do i = 1,klon |
---|
113 | ! ALE(i) = max(ale_wake(i),Ale_bl(i)) |
---|
114 | ! avant ALP(i) = alp_wake(i) + Alp_bl(i) |
---|
115 | ! ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb |
---|
116 | ! WRITE(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i) |
---|
117 | ! WRITE(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i) |
---|
118 | ! enddo |
---|
119 | |
---|
120 | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
121 | ! Modif FH 2010/04/27. Sans doute temporaire. |
---|
122 | ! Deux options pour le alp_offset : constant si >?? 0 ou |
---|
123 | ! proportionnel ??a w si <0 |
---|
124 | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
125 | ! Estimation d'une vitesse verticale effective pour ALP |
---|
126 | IF (1==0) THEN |
---|
127 | www(1:klon)=0. |
---|
128 | do k=2,klev-1 |
---|
129 | do i=1,klon |
---|
130 | www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k) & |
---|
131 | /(RG*paprs(i,k)) *zw2(i,k)*zw2(i,k)) |
---|
132 | ! if (paprs(i,k)>pbase(i)) THEN |
---|
133 | ! calcul approche de la vitesse verticale en m/s |
---|
134 | ! www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k)) |
---|
135 | ! endif |
---|
136 | ! Le 0.1 est en gros H / ps = 1e4 / 1e5 |
---|
137 | enddo |
---|
138 | enddo |
---|
139 | do i=1,klon |
---|
140 | IF (www(i)>0. .AND. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i) |
---|
141 | enddo |
---|
142 | ENDIF |
---|
143 | |
---|
144 | |
---|
145 | do i = 1,klon |
---|
146 | ALE(i) = max(ale_wake(i),Ale_bl(i)) |
---|
147 | !cc nrlmd le 10/04/2012----------Stochastic triggering------------ |
---|
148 | IF (iflag_trig_bl>=1) THEN |
---|
149 | ALE(i) = max(ale_wake(i),Ale_bl_trig(i)) |
---|
150 | endif |
---|
151 | !cc fin nrlmd le 10/04/2012 |
---|
152 | IF (alp_offset>=0.) THEN |
---|
153 | ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb |
---|
154 | else |
---|
155 | abort_message ='Ne pas passer la car www non calcule' |
---|
156 | CALL abort_physic (modname,abort_message,1) |
---|
157 | |
---|
158 | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
159 | ! _ _ |
---|
160 | ! Ajout d'une composante 3 * A * w w'2 a w'3 avec |
---|
161 | ! w=www : w max sous pbase ou A est la fraction |
---|
162 | ! couverte par les ascendances w' on utilise le fait |
---|
163 | ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE) |
---|
164 | ! (on ajoute 0.1 pour les singularites) |
---|
165 | ALP(i)=alp_wake(i)*(1.+3.*www(i)/( sqrt(ale_wake(i))+0.1) ) & |
---|
166 | +alp_bl(i) *(1.+3.*www(i)/( sqrt(ale_bl(i)) +0.1) ) |
---|
167 | ! ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.) |
---|
168 | ! if (alp(i)<0.) THEN |
---|
169 | ! PRINT*,'ALP ',alp(i),alp_wake(i) & |
---|
170 | ! ,Alp_bl(i),alp_offset*min(omega(i,6),0.) |
---|
171 | ! endif |
---|
172 | endif |
---|
173 | enddo |
---|
174 | ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
---|
175 | |
---|
176 | endif |
---|
177 | do i=1,klon |
---|
178 | IF (alp(i)>alp_max) THEN |
---|
179 | IF(prt_level>9)WRITE(lunout,*) & |
---|
180 | 'WARNING SUPER ALP (seuil=',alp_max, & |
---|
181 | '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i) |
---|
182 | alp(i)=alp_max |
---|
183 | endif |
---|
184 | IF (ale(i)>ale_max) THEN |
---|
185 | IF(prt_level>9)WRITE(lunout,*) & |
---|
186 | 'WARNING SUPER ALE (seuil=',ale_max, & |
---|
187 | '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i) |
---|
188 | ale(i)=ale_max |
---|
189 | endif |
---|
190 | enddo |
---|
191 | |
---|
192 | !fin calcul ale et alp |
---|
193 | !======================================================================= |
---|
194 | |
---|
195 | |
---|
196 | RETURN |
---|
197 | END |
---|
198 | |
---|