1 |
|
2 |
SUBROUTINE SUPHEC(KULOUT) |
2 |
|
|
|
3 |
|
|
!**** *SUPHEC - INITIALISES PHYSICAL CONSTANTS OF UNCERTAIN VALUE. |
4 |
|
|
! WITHIN THE E.C.M.W.F. PHYSICS PACKAGE |
5 |
|
|
|
6 |
|
|
! PURPOSE. |
7 |
|
|
! -------- |
8 |
|
|
|
9 |
|
|
! THIS ROUTINE SETS THE VALUES FOR THE PHYSICAL CONSTANTS USED |
10 |
|
|
! IN THE PARAMETERIZATION ROUTINES WHENEVER THESE VALUES ARE NOT |
11 |
|
|
! KNOWN WELL ENOUGH TO FORBID ANY TUNING OR WHENEVER THEY ARE |
12 |
|
|
! SUBJECT TO AN ARBITRARY CHOICE OF THE MODELLER. THESE CONSTANTS |
13 |
|
|
! ARE DISTRIBUTED IN COMMON DECKS *YOEXXXX* WHERE XXXX CORRESPONDS |
14 |
|
|
! TO THE INDIVIDUAL PHYSICAL PARAMETRIZATION |
15 |
|
|
|
16 |
|
|
!** INTERFACE. |
17 |
|
|
! ---------- |
18 |
|
|
|
19 |
|
|
! *SUPHEC* IS CALLED FROM *SUPHY* |
20 |
|
|
|
21 |
|
|
! METHOD. |
22 |
|
|
! ------- |
23 |
|
|
|
24 |
|
|
! NONE. |
25 |
|
|
|
26 |
|
|
! EXTERNALS. |
27 |
|
|
! ---------- |
28 |
|
|
|
29 |
|
|
! *SUECRAD*, *SUCUMF*, *SUCUMF2*,*SUVDFS*, *SUSURF* |
30 |
|
|
! *SUECRAD15*, *SUCLOP15* |
31 |
|
|
! *SUGWD*, *SUCLD*, *SUCOND*, *SUPHLI*, *SUMETHOX* |
32 |
|
|
|
33 |
|
|
! REFERENCE. |
34 |
|
|
! ---------- |
35 |
|
|
|
36 |
|
|
! SEE PHYSICAL ROUTINES FOR AN EXACT DEFINITION OF THE |
37 |
|
|
! CONSTANTS. |
38 |
|
|
|
39 |
|
|
! AUTHOR. |
40 |
|
|
! ------- |
41 |
|
|
! J.-J. MORCRETTE E.C.M.W.F. 91/06/15 ADAPTATION TO I.F.S. |
42 |
|
|
|
43 |
|
|
! MODIFICATIONS |
44 |
|
|
! ------------- |
45 |
|
|
! MAY 1997 : M. Deque - Frozen FMR |
46 |
|
|
! APRIL 1998: C. JAKOB - ADD METHANE OXIDATION |
47 |
|
|
! M.Hamrud 01-Oct-2003 CY28 Cleaning |
48 |
|
|
! P.Viterbo 24-May-2004 surf library |
49 |
|
|
! P.Viterbo 03-Dec-2004 Include user-defined RTHRFRTI |
50 |
|
|
! M.Ko"hler 03-Dec-2004 cp,moist=cp,dry |
51 |
|
|
! P.Viterbo 10-Jun-2005 Externalise surf |
52 |
|
|
! R. El Khatib & J-F Estrade 20-Jan-2005 Default PRSUN for FMR15 |
53 |
|
|
! D.Salmond 22-Nov-2005 Mods for coarser/finer physics |
54 |
|
|
! P. Lopez 21-Aug-2006 Added call to SUCUMF2 |
55 |
|
|
! (new linearized convec) |
56 |
|
|
! JJMorcrette 20060525 MODIS albedo |
57 |
|
|
! ------------------------------------------------------------------ |
58 |
|
|
|
59 |
|
|
USE PARKIND1 ,ONLY : JPIM ,JPRB |
60 |
|
|
USE YOMHOOK ,ONLY : LHOOK, DR_HOOK |
61 |
|
|
|
62 |
|
|
USE YOMDPHY , ONLY : NTILES |
63 |
|
|
USE SURFACE_FIELDS, ONLY : YSP_SBD |
64 |
|
|
USE YOELW , ONLY : NSIL ,TSTAND ,XP |
65 |
|
|
USE YOESW , ONLY : RSUN |
66 |
|
|
USE YOMSW15 , ONLY : RSUN15 |
67 |
|
|
USE YOMDIM , ONLY : NFLEVG ,NSMAX, NGPBLKS, NPROMA |
68 |
|
|
USE YOMGEM , ONLY : VBH ,VAH ,VP00, VAF , VBF |
69 |
|
|
USE YOMCST , ONLY : RD ,RV ,RCPD ,& |
70 |
|
|
& RLVTT ,RLSTT ,RLMLT ,RTT ,RATM |
71 |
|
|
!USE YOETHF , ONLY : R2ES ,R3LES ,R3IES ,R4LES ,& |
72 |
|
|
! & R4IES ,R5LES ,R5IES ,RVTMP2 ,RHOH2O ,& |
73 |
|
|
! & R5ALVCP ,R5ALSCP ,RALVDCP ,RALSDCP ,RALFDCP ,& |
74 |
|
|
! & RTWAT ,RTBER ,RTBERCU ,RTICE ,RTICECU ,& |
75 |
|
|
! & RTWAT_RTICE_R ,RTWAT_RTICECU_R ,& |
76 |
|
|
! & RKOOP1 ,RKOOP2 |
77 |
|
|
USE YOMPHY , ONLY : LRAYFM15 |
78 |
|
|
!USE YOERAD , ONLY : NSW ,NTSW ,& |
79 |
|
|
! NSW mis dans .def MPL 20140211 |
80 |
|
|
USE YOERAD , ONLY : NTSW ,& |
81 |
|
|
& LCCNL ,LCCNO ,& |
82 |
|
|
& RCCNSEA ,RCCNLND |
83 |
|
|
USE YOE_TILE_PROP, ONLY : RUSTRTI, RVSTRTI, RAHFSTI, REVAPTI, RTSKTI |
84 |
|
|
USE YOEPHY , ONLY : RTHRFRTI ,LEOCWA ,LEOCCO ,LEOCSA, LE4ALB |
85 |
|
|
USE YOEVDF , ONLY : NVTYPES |
86 |
|
|
USE YOMCOAPHY , ONLY : NPHYINT |
87 |
|
|
USE YOM_PHYS_GRID ,ONLY : PHYS_GRID |
88 |
|
|
USE YOMCT0 , ONLY : LSCMEC ,LROUGH ,REXTZ0M ,REXTZ0H |
89 |
|
|
USE vertical_layers_mod, ONLY: ap,bp |
90 |
|
|
|
91 |
|
|
IMPLICIT NONE |
92 |
|
|
include "YOETHF.h" |
93 |
|
|
include "clesphys.h" |
94 |
|
|
|
95 |
|
|
INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT |
96 |
|
|
INTERFACE |
97 |
|
|
#include "susurf.h" |
98 |
|
|
#include "surf_inq.h" |
99 |
|
|
END INTERFACE |
100 |
|
|
|
101 |
|
|
#include "gppre.intfb.h" |
102 |
|
|
#include "sucld.intfb.h" |
103 |
|
|
#include "sucldp.intfb.h" |
104 |
|
|
#include "suclop.intfb.h" |
105 |
|
|
#include "suclop15.intfb.h" |
106 |
|
|
#include "sucond.intfb.h" |
107 |
|
|
#include "sucumf.intfb.h" |
108 |
|
|
#include "sucumf2.intfb.h" |
109 |
|
|
#include "suecrad.intfb.h" |
110 |
|
|
#include "suecrad15.intfb.h" |
111 |
|
|
#include "sugwd.intfb.h" |
112 |
|
|
#include "sumethox.intfb.h" |
113 |
|
|
#include "suphli.intfb.h" |
114 |
|
|
#include "suvdf.intfb.h" |
115 |
|
|
#include "suvdfs.intfb.h" |
116 |
|
|
#include "suwcou.intfb.h" |
117 |
|
|
|
118 |
|
|
! ------------------------------------------------------------------ |
119 |
|
|
|
120 |
|
2 |
REAL(KIND=JPRB) :: ZPRES(0:NFLEVG),ZPRESF(NFLEVG), ZETA(NFLEVG),ZETAH(0:NFLEVG) |
121 |
|
|
|
122 |
|
|
INTEGER(KIND=JPIM) :: JK,ISMAX,JLEV |
123 |
|
|
REAL(KIND=JPRB) :: ZHOOK_HANDLE |
124 |
|
|
|
125 |
|
|
! ------------------------------------------------------------------ |
126 |
|
|
|
127 |
|
|
!* 0.2 DEFINING DERIVED CONSTANTS FROM UNIVERSAL CONSTANTS |
128 |
|
|
! --------------------------------------------------- |
129 |
|
|
|
130 |
✓✗ |
1 |
IF (LHOOK) CALL DR_HOOK('SUPHEC',0,ZHOOK_HANDLE) |
131 |
|
|
! |
132 |
✗✓ |
1 |
IF (OK_BAD_ECMWF_THERMO) THEN |
133 |
|
|
! |
134 |
|
|
! Modify constants defined in suphel.F90 and set RVTMP2 to 0. |
135 |
|
|
! CALL GSTATS(1811,0) ! MPL 28.11.08 |
136 |
|
|
! RVTMP2=RCPV/RCPD-1.0_JPRB !use cp,moist |
137 |
|
|
RVTMP2=0.0_JPRB !neglect cp,moist |
138 |
|
|
RHOH2O=RATM/100._JPRB |
139 |
|
|
R2ES=611.21_JPRB*RD/RV |
140 |
|
|
R3LES=17.502_JPRB |
141 |
|
|
R3IES=22.587_JPRB |
142 |
|
|
R4LES=32.19_JPRB |
143 |
|
|
R4IES=-0.7_JPRB |
144 |
|
|
R5LES=R3LES*(RTT-R4LES) |
145 |
|
|
R5IES=R3IES*(RTT-R4IES) |
146 |
|
|
R5ALVCP=R5LES*RLVTT/RCPD |
147 |
|
|
R5ALSCP=R5IES*RLSTT/RCPD |
148 |
|
|
RALVDCP=RLVTT/RCPD |
149 |
|
|
RALSDCP=RLSTT/RCPD |
150 |
|
|
RALFDCP=RLMLT/RCPD |
151 |
|
|
RTWAT=RTT |
152 |
|
|
RTBER=RTT-5._JPRB |
153 |
|
|
RTBERCU=RTT-5.0_JPRB |
154 |
|
|
RTICE=RTT-23._JPRB |
155 |
|
|
RTICECU=RTT-23._JPRB |
156 |
|
|
|
157 |
|
|
RTWAT_RTICE_R=1.0_JPRB/(RTWAT-RTICE) |
158 |
|
|
RTWAT_RTICECU_R=1.0_JPRB/(RTWAT-RTICECU) |
159 |
|
|
IF(NPHYINT == 0) THEN |
160 |
|
|
ISMAX=NSMAX |
161 |
|
|
ELSE |
162 |
|
|
ISMAX=PHYS_GRID%NSMAX |
163 |
|
|
ENDIF |
164 |
|
|
|
165 |
|
|
RKOOP1=2.583_JPRB |
166 |
|
|
RKOOP2=0.48116E-2_JPRB |
167 |
|
|
|
168 |
|
|
ELSE |
169 |
|
|
! Keep constants defined in suphel.F90 |
170 |
|
1 |
RTICE=RTT-23._JPRB |
171 |
|
|
! |
172 |
|
|
ENDIF ! (OK_BAD_ECMWF_THERMO) |
173 |
|
|
|
174 |
|
|
! ------------------------------------------------------------------ |
175 |
|
|
!* 0.5 DEFINE STANDARD ATMOSPHERE VERTICAL CONFIGURATION |
176 |
|
|
! ------------------------------------------------- |
177 |
|
|
!ALLOCATE(VBH (0:MAX(JPMXLE,NFLEVG))) from suallo.F90 |
178 |
|
|
!! |
179 |
✓✗✗✓
✗✓ |
1 |
ALLOCATE(VAH (0:NFLEVG)) ! Ajout ALLOCATE MPL 200509 |
180 |
✗✓✗✓
|
1 |
ALLOCATE(VBH (0:NFLEVG)) |
181 |
✓✗✗✓
✗✓ |
1 |
ALLOCATE(VAF (NFLEVG)) |
182 |
✗✓✗✓
|
1 |
ALLOCATE(VBF (NFLEVG)) |
183 |
|
|
! Commente par MPL 28.11.08, puis decommente le 19.05.09 |
184 |
|
1 |
VP00=101325. !!!!! A REVOIR (MPL) |
185 |
|
1 |
ZPRES(NFLEVG)=VP00 |
186 |
|
|
! on recupere ap et bp de dyn3d (vertical_layers_mod) MPL 19.05.09 |
187 |
|
|
! Attention, VAH et VBH sont inverses, comme les niveaux |
188 |
|
|
! plev(l)=PAPRS(klon,nlayer+1-l) de 1 a nlayer (apllmd.F) |
189 |
✓✓ |
41 |
DO JLEV = 0, NFLEVG |
190 |
|
|
! VAH(JLEV)=ap(JLEV+1)ap(JLEV+1) |
191 |
|
|
! VBH(JLEV)=bp(JLEV+1) |
192 |
|
|
! print *,'SUPHEC: jlev ap bp',JLEV,ap(JLEV+1),bp(JLEV+1) |
193 |
|
40 |
VAH(JLEV)=ap(NFLEVG+1-JLEV) |
194 |
|
41 |
VBH(JLEV)=bp(NFLEVG+1-JLEV) |
195 |
|
|
ENDDO |
196 |
|
|
! Calcul de VAF et VBF, analogues de VAH et VBH mais aux niveaux pleins |
197 |
✓✓ |
40 |
DO JLEV = 1, NFLEVG |
198 |
|
39 |
VAF(JLEV)=(VAH(JLEV)+VAH(JLEV-1))/2. |
199 |
|
40 |
VBF(JLEV)=(VBH(JLEV)+VBH(JLEV-1))/2. |
200 |
|
|
ENDDO |
201 |
|
|
|
202 |
|
|
! Appel a GPPRE commente par MPL 28.11.08, puis decommente le 19.05.09 |
203 |
|
1 |
CALL GPPRE ( 1 ,1, 1, NFLEVG, VAH, VBH, ZPRES, ZPRESF ) |
204 |
|
|
|
205 |
✓✓ |
41 |
DO JK=0,NFLEVG |
206 |
|
41 |
ZETAH(JK)= ZPRES(JK)/ZPRES(NFLEVG) |
207 |
|
|
ENDDO |
208 |
✓✓ |
40 |
DO JK=1,NFLEVG |
209 |
|
40 |
ZETA(JK)= ZPRESF(JK)/ZPRES(NFLEVG) |
210 |
|
|
ENDDO |
211 |
|
|
|
212 |
|
|
! ------------------------------------------------------------------ |
213 |
|
|
!* 1. SETTING CONSTANTS FOR DIAGNOSTIC CLOUD SCHEME |
214 |
|
|
! --------------------------------------------- |
215 |
|
|
|
216 |
|
|
!CALL SUCLD ( NFLEVG , ZETA ) ! MPL 28.11.08 |
217 |
|
|
|
218 |
|
|
! ------------------------------------------------------------------ |
219 |
|
|
|
220 |
|
|
!* 2. SETTING CONSTANTS FOR LARGE-SCALE CONDENSATION SCHEME |
221 |
|
|
! ----------------------------------------------------- |
222 |
|
|
|
223 |
|
|
!CALL SUCOND ( KULOUT , NFLEVG , ZETA ) ! MPL 28.11.08 |
224 |
|
|
|
225 |
|
|
! ------------------------------------------------------------------ |
226 |
|
|
|
227 |
|
|
!* 3. SETTING CONSTANTS FOR CONVECTION SCHEME |
228 |
|
|
! --------------------------------------- |
229 |
|
|
|
230 |
|
|
!CALL SUCUMF(ISMAX) ! MPL 28.11.08 |
231 |
|
|
|
232 |
|
|
! ------------------------------------------------------------------ |
233 |
|
|
|
234 |
|
|
!* 3. SETTING CONSTANTS FOR NEW LINEARIZED CONVECTION SCHEME |
235 |
|
|
! ------------------------------------------------------ |
236 |
|
|
|
237 |
|
|
!CALL SUCUMF2(ISMAX) ! MPL 28.11.08 |
238 |
|
|
|
239 |
|
|
! ------------------------------------------------------------------ |
240 |
|
|
!* 4. SETTING CONSTANTS FOR GRAVITY WAVE DRAG SCHEME |
241 |
|
|
! ---------------------------------------------- |
242 |
|
|
|
243 |
|
|
!CALL SUGWD (KULOUT, NFLEVG, VAH, VBH ) ! MPL 28.11.08 |
244 |
|
|
|
245 |
|
|
! ------------------------------------------------------------------ |
246 |
|
|
|
247 |
|
|
!* 5. SETTING CONSTANTS FOR VERTICAL DIFFUSION |
248 |
|
|
! ---------------------------------------- |
249 |
|
|
|
250 |
|
|
!CALL SUVDFS ! MPL 28.11.08 |
251 |
|
|
|
252 |
|
|
!CALL SUVDF ! MPL 28.11.08 |
253 |
|
|
|
254 |
|
|
!cccc CALL SUVDFD ( NABLPFR, ABLPLL ) cccccccccccccccccccccccccccccccccc |
255 |
|
|
|
256 |
|
|
! ------------------------------------------------------------------ |
257 |
|
|
|
258 |
|
|
!* 6. SETTING CONSTANTS FOR RADIATION SCHEME |
259 |
|
|
! -------------------------------------- |
260 |
|
|
|
261 |
✗✓ |
1 |
IF (LRAYFM15) THEN |
262 |
|
|
CALL SUECRAD15 (KULOUT, NFLEVG, ZETAH ) |
263 |
|
|
ELSE |
264 |
|
1 |
CALL SUECRAD (KULOUT, NFLEVG, ZETAH ) |
265 |
|
|
ENDIF |
266 |
|
|
|
267 |
|
|
! ------------------------------------------------------------------ |
268 |
|
|
!* 7. SETTING CONSTANTS FOR SURFACE SCHEME |
269 |
|
|
! ------------------------------------ |
270 |
|
|
|
271 |
|
|
!IF (LRAYFM15) THEN |
272 |
|
|
! CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,& |
273 |
|
|
! & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,& |
274 |
|
|
! & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,& |
275 |
|
|
! & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,& |
276 |
|
|
! & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,& |
277 |
|
|
! & PRSUN=RSUN15) |
278 |
|
|
!ELSE |
279 |
|
|
! CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,& |
280 |
|
|
! & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,& |
281 |
|
|
! & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,& |
282 |
|
|
! & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,& |
283 |
|
|
! & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,& |
284 |
|
|
! & PRSUN=RSUN) |
285 |
|
|
!ENDIF |
286 |
|
|
|
287 |
|
|
|
288 |
|
|
!CALL SURF_INQ(KNVTYPES=NVTYPES) |
289 |
|
|
|
290 |
|
|
|
291 |
|
|
! 7.1 Allocate working arrays |
292 |
|
|
!ALLOCATE(RUSTRTI(NPROMA,NTILES,NGPBLKS)) |
293 |
|
|
!ALLOCATE(RVSTRTI(NPROMA,NTILES,NGPBLKS)) |
294 |
|
|
!ALLOCATE(RAHFSTI(NPROMA,NTILES,NGPBLKS)) |
295 |
|
|
!ALLOCATE(REVAPTI(NPROMA,NTILES,NGPBLKS)) |
296 |
|
|
!ALLOCATE(RTSKTI (NPROMA,NTILES,NGPBLKS)) |
297 |
|
|
!RUSTRTI(:,:,:) = 0.0_JPRB |
298 |
|
|
!RVSTRTI(:,:,:) = 0.0_JPRB |
299 |
|
|
!RAHFSTI(:,:,:) = 0.0_JPRB |
300 |
|
|
!REVAPTI(:,:,:) = 0.0_JPRB |
301 |
|
|
!RTSKTI (:,:,:) = 0.0_JPRB |
302 |
|
|
!CALL GSTATS(1811,1) |
303 |
|
|
|
304 |
|
|
! ------------------------------------------------------------------ |
305 |
|
|
|
306 |
|
|
!* 8. SETTING CONSTANTS FOR CLOUD OPTICAL PROPERTIES |
307 |
|
|
! ---------------------------------------------- |
308 |
|
|
|
309 |
✗✓ |
1 |
IF (LRAYFM15) THEN |
310 |
|
|
CALL SUCLOP15 |
311 |
|
|
ELSE |
312 |
|
1 |
CALL SUCLOP |
313 |
|
|
ENDIF |
314 |
|
|
|
315 |
|
|
! ------------------------------------------------------------------ |
316 |
|
|
|
317 |
|
|
!* 9. SETTING CONSTANTS FOR PROGNOSTIC CLOUD SCHEME |
318 |
|
|
! ---------------------------------------------- |
319 |
|
|
|
320 |
|
|
!CALL SUCLDP |
321 |
|
|
|
322 |
|
|
! ------------------------------------------------------------------ |
323 |
|
|
|
324 |
|
|
!* 10. SETTING CONSTANTS FOR WAVE COUPLING |
325 |
|
|
! ----------------------------------- |
326 |
|
|
|
327 |
|
|
!CALL SUWCOU |
328 |
|
|
|
329 |
|
|
! ------------------------------------------------------------------ |
330 |
|
|
!* 11. SETTING CONSTANTS FOR LINEARIZED PHYSICS |
331 |
|
|
! ---------------------------------------- |
332 |
|
|
|
333 |
|
|
!CALL SUPHLI |
334 |
|
|
|
335 |
|
|
! ------------------------------------------------------------------ |
336 |
|
|
!* 12. SETTING CONSTANTS FOR METHANE OXIDATION |
337 |
|
|
! --------------------------------------- |
338 |
|
|
|
339 |
|
|
!CALL SUMETHOX |
340 |
|
|
|
341 |
|
|
! ------------------------------------------------------------------ |
342 |
|
|
|
343 |
|
1 |
WRITE(UNIT=KULOUT,FMT='('' SUPHEC IS OVER '')') |
344 |
|
|
|
345 |
|
|
! ------------------------------------------------------------------ |
346 |
|
|
|
347 |
✓✗ |
1 |
IF (LHOOK) CALL DR_HOOK('SUPHEC',1,ZHOOK_HANDLE) |
348 |
|
1 |
END SUBROUTINE SUPHEC |