Directory: | ./ |
---|---|
File: | rad/suphec.f90 |
Date: | 2022-01-11 19:19:34 |
Exec | Total | Coverage | |
---|---|---|---|
Lines: | 29 | 54 | 53.7% |
Branches: | 23 | 38 | 60.5% |
Line | Branch | Exec | Source |
---|---|---|---|
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 | SUBROUTINE SUSURF(KSW,KCSS,KSIL,KTILES,KTSW,& | ||
98 | & LD_LLCCNL,LD_LLCCNO,LD_LEOCWA,LD_LEOCCO,LD_LEOCSA,LD_LLE4ALB,& | ||
99 | & LD_LSCMEC,LD_LROUGH,PEXTZ0M,PEXTZ0H,& | ||
100 | & PTHRFRTI,PTSTAND,PXP,PRCCNSEA,PRCCNLND,& | ||
101 | & PRSUN) | ||
102 | |||
103 | !** *SUSURF* IS THE SET-UP ROUTINE FOR surface modules containing constants | ||
104 | |||
105 | ! PURPOSE | ||
106 | ! ------- | ||
107 | ! THIS ROUTINE INITIALIZES THE CONSTANTS IN COMMON BLOCK | ||
108 | ! *YOESOIL* | ||
109 | |||
110 | ! INTERFACE. | ||
111 | ! ---------- | ||
112 | ! CALL *SUSURF* FROM *SUPHEC* | ||
113 | |||
114 | ! METHOD. | ||
115 | ! ------- | ||
116 | |||
117 | ! EXTERNALS. | ||
118 | ! ---------- | ||
119 | |||
120 | ! REFERENCE. | ||
121 | ! ---------- | ||
122 | |||
123 | ! Original A.C.M. BELJAARS E.C.M.W.F. 89/11/02 | ||
124 | ! MODIFICATIONS | ||
125 | ! ------------- | ||
126 | ! J.-J. MORCRETTE E.C.M.W.F. 91/07/14 | ||
127 | ! P. VITERBO E.C.M.W.F. 8/10/93 | ||
128 | ! P. Viterbo 99-03-26 Tiling of the land surface | ||
129 | ! C. Fischer 00-12-20 Meteo-France recode initialization of rdat to avoid | ||
130 | ! memory overflow on SUN workstation | ||
131 | ! J.F. Estrade *ECMWF* 03-10-01 move in surf vob | ||
132 | ! M.Hamrud 01-Oct-2003 CY28 Cleaning | ||
133 | ! P. Viterbo ECMWF 03-12-2004 Include user-defined RTHRFRTI | ||
134 | ! P. Viterbo ECMWF May 2005 Externalise surf | ||
135 | ! JJMorcrette 20060511 MODIS albedo | ||
136 | |||
137 | ! INTERFACE: | ||
138 | |||
139 | ! Integers (In): | ||
140 | |||
141 | ! KSW : NUMBER OF SHORTWAVE SPECTRAL INTERVALS | ||
142 | ! KCSS : Number of soil levels | ||
143 | ! KSIL : NUMBER OF (infrared) SPECTRAL INTERVALS | ||
144 | ! KTILES : Number of surface tiles | ||
145 | ! KTSW : Maximum possible number of sw spectral intervals | ||
146 | |||
147 | ! Logicals (In): | ||
148 | |||
149 | ! LD_LLCCNL : .T. IF CCN CONCENTRATION OVER LAND IS DIAGNOSED | ||
150 | ! LD_LLCCNO : .T. IF CCN CONCENTRATION OVER OCEAN IS DIAGNOSED | ||
151 | ! LD_LLE4ALB: .T. IF MODIS ALBEDO IS USED | ||
152 | |||
153 | ! Reals (In): | ||
154 | |||
155 | ! PTHRFRTI : ! MINIMUM THRESHOLD FOR TILE FRACTION | ||
156 | ! PTSTAND : ! REFERENCE TEMPERATURE FOR TEMPERATURE DEPENDENCE | ||
157 | ! PXP : ! POLYNOMIAL COEFFICIENTS OF PLANCK FUNCTION | ||
158 | ! PRCCNSEA : ! NUMBER CONCENTRATION (CM-3) OF CCNs OVER SEA | ||
159 | ! PRCCNLND : ! NUMBER CONCENTRATION (CM-3) OF CCNs OVER LAND | ||
160 | ! PRSUN : ! SOLAR FRACTION IN SPECTRAL INTERVALS | ||
161 | |||
162 | ! ------------------------------------------------------------------ | ||
163 | |||
164 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
165 | |||
166 | IMPLICIT NONE | ||
167 | |||
168 | ! Declaration of arguments | ||
169 | |||
170 | INTEGER(KIND=JPIM),INTENT(IN) :: KSW | ||
171 | REAL(KIND=JPRB) ,INTENT(IN) :: PTHRFRTI | ||
172 | INTEGER(KIND=JPIM),INTENT(IN) :: KCSS | ||
173 | INTEGER(KIND=JPIM),INTENT(IN) :: KSIL | ||
174 | INTEGER(KIND=JPIM),INTENT(IN) :: KTILES | ||
175 | INTEGER(KIND=JPIM),INTENT(IN) :: KTSW | ||
176 | LOGICAL ,INTENT(IN) :: LD_LLCCNL | ||
177 | LOGICAL ,INTENT(IN) :: LD_LLCCNO | ||
178 | LOGICAL ,INTENT(IN) :: LD_LEOCWA | ||
179 | LOGICAL ,INTENT(IN) :: LD_LEOCCO | ||
180 | LOGICAL ,INTENT(IN) :: LD_LEOCSA | ||
181 | LOGICAL ,INTENT(IN) :: LD_LLE4ALB | ||
182 | LOGICAL ,INTENT(IN) :: LD_LSCMEC | ||
183 | LOGICAL ,INTENT(IN) :: LD_LROUGH | ||
184 | REAL(KIND=JPRB) ,INTENT(IN) :: PEXTZ0M | ||
185 | REAL(KIND=JPRB) ,INTENT(IN) :: PEXTZ0H | ||
186 | REAL(KIND=JPRB) ,INTENT(IN) :: PTSTAND | ||
187 | REAL(KIND=JPRB) ,INTENT(IN) :: PXP(6,6) | ||
188 | REAL(KIND=JPRB) ,INTENT(IN) :: PRCCNSEA | ||
189 | REAL(KIND=JPRB) ,INTENT(IN) :: PRCCNLND | ||
190 | REAL(KIND=JPRB) ,INTENT(IN) :: PRSUN(:) | ||
191 | |||
192 | ! ------------------------------------------------------------------ | ||
193 | |||
194 | END SUBROUTINE SUSURF | ||
195 | SUBROUTINE SURF_INQ(KNVTYPES,PRRCSOIL,PRWSAT,PRWCAP,PRWPWP,PRQWEVAP,PRQWSBCR,& | ||
196 | & PRQSNCR,PRWLMAX,PRTF1,PRTF2,PRTF3,PRTF4,& | ||
197 | & PRTFREEZSICE,PRTMELTSICE,PRCIMIN,PRALFMINSN,& | ||
198 | & PRALFMAXSN,PRHOMINSN,PRHOMAXSN,PRDAT,& | ||
199 | & PRDAW,PRRCSICE,PRALBSEAD,PREPALB,PRVCOV,PRVLAI,& | ||
200 | & PRVROOTSA,PRVLAMSK,PRVLAMSKS,PRVTRSR,PRCHAR,PREPUST) | ||
201 | |||
202 | !** *SURF_INQ* Extract information from the surface package | ||
203 | |||
204 | ! Purpose. | ||
205 | ! -------- | ||
206 | ! Interface routine for extracting information from the surf pack. | ||
207 | |||
208 | !** Interface. | ||
209 | ! ---------- | ||
210 | ! CALL SURFINQ(...) | ||
211 | ! Explicit arguments : All arguments are optional. | ||
212 | ! -------------------- | ||
213 | |||
214 | ! Method. | ||
215 | ! ------- | ||
216 | |||
217 | ! Externals: none | ||
218 | |||
219 | ! Author. | ||
220 | ! ------- | ||
221 | ! JF Estrade *ECMWF* | ||
222 | |||
223 | ! Modifications. | ||
224 | ! -------------- | ||
225 | ! Original : 03-10-01 | ||
226 | ! ------------------------------------------------------------------ | ||
227 | |||
228 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
229 | |||
230 | |||
231 | IMPLICIT NONE | ||
232 | |||
233 | ! Declaration of arguments | ||
234 | |||
235 | INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNVTYPES | ||
236 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRRCSOIL | ||
237 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRWSAT | ||
238 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRQWSBCR | ||
239 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRWCAP | ||
240 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRWPWP | ||
241 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRQWEVAP | ||
242 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRQSNCR | ||
243 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRWLMAX | ||
244 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRTFREEZSICE | ||
245 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRTMELTSICE | ||
246 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRCIMIN | ||
247 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRALFMINSN | ||
248 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRALFMAXSN | ||
249 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRHOMINSN | ||
250 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRHOMAXSN | ||
251 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRDAT(:) | ||
252 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRDAW(:) | ||
253 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRALBSEAD | ||
254 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PREPALB | ||
255 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRVCOV(:) | ||
256 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRVLAI(:) | ||
257 | REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PRCHAR | ||
258 | REAL(KIND=JPRB) ,OPTIONAL,INTENT(OUT) :: PREPUST | ||
259 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRTF1 | ||
260 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRTF2 | ||
261 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRTF3 | ||
262 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRTF4 | ||
263 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRRCSICE | ||
264 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRVROOTSA(:,:) | ||
265 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRVLAMSK(:) | ||
266 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRVLAMSKS(:) | ||
267 | REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRVTRSR(:) | ||
268 | |||
269 | |||
270 | ! ------------------------------------------------------------------ | ||
271 | |||
272 | END SUBROUTINE SURF_INQ | ||
273 | END INTERFACE | ||
274 | |||
275 | INTERFACE | ||
276 | SUBROUTINE GPPRE(KPROMA,KSTART,KPROF,KFLEV,PVAH,PVBH,PRESH,PRESF) | ||
277 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
278 | INTEGER(KIND=JPIM),INTENT(IN) :: KPROMA | ||
279 | INTEGER(KIND=JPIM),INTENT(IN) :: KFLEV | ||
280 | INTEGER(KIND=JPIM),INTENT(IN) :: KSTART | ||
281 | INTEGER(KIND=JPIM),INTENT(IN) :: KPROF | ||
282 | REAL(KIND=JPRB) ,INTENT(IN) :: PVAH(0:KFLEV) | ||
283 | REAL(KIND=JPRB) ,INTENT(IN) :: PVBH(0:KFLEV) | ||
284 | REAL(KIND=JPRB) ,INTENT(INOUT) :: PRESH(KPROMA,0:KFLEV) | ||
285 | REAL(KIND=JPRB) ,INTENT(OUT) :: PRESF(KPROMA,KFLEV) | ||
286 | END SUBROUTINE GPPRE | ||
287 | END INTERFACE | ||
288 | INTERFACE | ||
289 | SUBROUTINE SUCLD ( KLEV , PETA ) | ||
290 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
291 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
292 | REAL(KIND=JPRB) ,INTENT(IN) :: PETA(KLEV) | ||
293 | END SUBROUTINE SUCLD | ||
294 | END INTERFACE | ||
295 | INTERFACE | ||
296 | SUBROUTINE SUCLDP | ||
297 | END SUBROUTINE SUCLDP | ||
298 | END INTERFACE | ||
299 | INTERFACE | ||
300 | SUBROUTINE SUCLOP | ||
301 | END SUBROUTINE SUCLOP | ||
302 | END INTERFACE | ||
303 | INTERFACE | ||
304 | SUBROUTINE SUCLOP15 | ||
305 | END SUBROUTINE SUCLOP15 | ||
306 | END INTERFACE | ||
307 | INTERFACE | ||
308 | SUBROUTINE SUCOND ( KULOUT , KLEV , PETA ) | ||
309 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
310 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
311 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
312 | REAL(KIND=JPRB) ,INTENT(IN) :: PETA(KLEV) | ||
313 | END SUBROUTINE SUCOND | ||
314 | END INTERFACE | ||
315 | INTERFACE | ||
316 | SUBROUTINE SUCUMF(KSMAX) | ||
317 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
318 | INTEGER(KIND=JPIM),INTENT(IN) :: KSMAX | ||
319 | END SUBROUTINE SUCUMF | ||
320 | END INTERFACE | ||
321 | INTERFACE | ||
322 | SUBROUTINE SUCUMF2(KSMAX) | ||
323 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
324 | INTEGER(KIND=JPIM),INTENT(IN) :: KSMAX | ||
325 | END SUBROUTINE SUCUMF2 | ||
326 | END INTERFACE | ||
327 | INTERFACE | ||
328 | SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH ) | ||
329 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
330 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
331 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
332 | REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1) | ||
333 | INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5 | ||
334 | INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1 | ||
335 | END SUBROUTINE SUECRAD | ||
336 | END INTERFACE | ||
337 | INTERFACE | ||
338 | SUBROUTINE SUECRAD15 (KULOUT, KLEV, PETAH ) | ||
339 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
340 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
341 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
342 | REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1) | ||
343 | END SUBROUTINE SUECRAD15 | ||
344 | END INTERFACE | ||
345 | INTERFACE | ||
346 | SUBROUTINE SUGWD(KULOUT,KLEV,PVAH,PVBH) | ||
347 | USE PARKIND1 ,ONLY : JPIM ,JPRB | ||
348 | INTEGER(KIND=JPIM),INTENT(IN) :: KLEV | ||
349 | INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT | ||
350 | REAL(KIND=JPRB) ,INTENT(IN) :: PVAH(KLEV+1) | ||
351 | REAL(KIND=JPRB) ,INTENT(IN) :: PVBH(KLEV+1) | ||
352 | END SUBROUTINE SUGWD | ||
353 | END INTERFACE | ||
354 | INTERFACE | ||
355 | SUBROUTINE SUMETHOX | ||
356 | END SUBROUTINE SUMETHOX | ||
357 | END INTERFACE | ||
358 | INTERFACE | ||
359 | SUBROUTINE SUPHLI | ||
360 | END SUBROUTINE SUPHLI | ||
361 | END INTERFACE | ||
362 | INTERFACE | ||
363 | SUBROUTINE SUVDF | ||
364 | END SUBROUTINE SUVDF | ||
365 | END INTERFACE | ||
366 | INTERFACE | ||
367 | SUBROUTINE SUVDFS | ||
368 | END SUBROUTINE SUVDFS | ||
369 | END INTERFACE | ||
370 | INTERFACE | ||
371 | SUBROUTINE SUWCOU | ||
372 | END SUBROUTINE SUWCOU | ||
373 | END INTERFACE | ||
374 | |||
375 | ! ------------------------------------------------------------------ | ||
376 | |||
377 | 2 | REAL(KIND=JPRB) :: ZPRES(0:NFLEVG),ZPRESF(NFLEVG), ZETA(NFLEVG),ZETAH(0:NFLEVG) | |
378 | |||
379 | INTEGER(KIND=JPIM) :: JK,ISMAX,JLEV | ||
380 | REAL(KIND=JPRB) :: ZHOOK_HANDLE | ||
381 | |||
382 | ! ------------------------------------------------------------------ | ||
383 | |||
384 | !* 0.2 DEFINING DERIVED CONSTANTS FROM UNIVERSAL CONSTANTS | ||
385 | ! --------------------------------------------------- | ||
386 | |||
387 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUPHEC',0,ZHOOK_HANDLE) |
388 | ! | ||
389 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (OK_BAD_ECMWF_THERMO) THEN |
390 | ! | ||
391 | ! Modify constants defined in suphel.F90 and set RVTMP2 to 0. | ||
392 | ! CALL GSTATS(1811,0) ! MPL 28.11.08 | ||
393 | ! RVTMP2=RCPV/RCPD-1.0_JPRB !use cp,moist | ||
394 | ✗ | RVTMP2=0.0_JPRB !neglect cp,moist | |
395 | ✗ | RHOH2O=RATM/100._JPRB | |
396 | ✗ | R2ES=611.21_JPRB*RD/RV | |
397 | ✗ | R3LES=17.502_JPRB | |
398 | ✗ | R3IES=22.587_JPRB | |
399 | ✗ | R4LES=32.19_JPRB | |
400 | ✗ | R4IES=-0.7_JPRB | |
401 | ✗ | R5LES=R3LES*(RTT-R4LES) | |
402 | ✗ | R5IES=R3IES*(RTT-R4IES) | |
403 | ✗ | R5ALVCP=R5LES*RLVTT/RCPD | |
404 | ✗ | R5ALSCP=R5IES*RLSTT/RCPD | |
405 | ✗ | RALVDCP=RLVTT/RCPD | |
406 | ✗ | RALSDCP=RLSTT/RCPD | |
407 | ✗ | RALFDCP=RLMLT/RCPD | |
408 | ✗ | RTWAT=RTT | |
409 | ✗ | RTBER=RTT-5._JPRB | |
410 | ✗ | RTBERCU=RTT-5.0_JPRB | |
411 | ✗ | RTICE=RTT-23._JPRB | |
412 | ✗ | RTICECU=RTT-23._JPRB | |
413 | |||
414 | ✗ | RTWAT_RTICE_R=1.0_JPRB/(RTWAT-RTICE) | |
415 | ✗ | RTWAT_RTICECU_R=1.0_JPRB/(RTWAT-RTICECU) | |
416 | IF(NPHYINT == 0) THEN | ||
417 | ISMAX=NSMAX | ||
418 | ELSE | ||
419 | ISMAX=PHYS_GRID%NSMAX | ||
420 | ENDIF | ||
421 | |||
422 | ✗ | RKOOP1=2.583_JPRB | |
423 | ✗ | RKOOP2=0.48116E-2_JPRB | |
424 | |||
425 | ELSE | ||
426 | ! Keep constants defined in suphel.F90 | ||
427 | 1 | RTICE=RTT-23._JPRB | |
428 | ! | ||
429 | ENDIF ! (OK_BAD_ECMWF_THERMO) | ||
430 | |||
431 | ! ------------------------------------------------------------------ | ||
432 | !* 0.5 DEFINE STANDARD ATMOSPHERE VERTICAL CONFIGURATION | ||
433 | ! ------------------------------------------------- | ||
434 | !ALLOCATE(VBH (0:MAX(JPMXLE,NFLEVG))) from suallo.F90 | ||
435 | !! | ||
436 |
3/6✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
|
1 | ALLOCATE(VAH (0:NFLEVG)) ! Ajout ALLOCATE MPL 200509 |
437 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(VBH (0:NFLEVG)) |
438 |
3/6✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
|
1 | ALLOCATE(VAF (NFLEVG)) |
439 |
2/4✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1 times.
|
1 | ALLOCATE(VBF (NFLEVG)) |
440 | ! Commente par MPL 28.11.08, puis decommente le 19.05.09 | ||
441 | 1 | VP00=101325. !!!!! A REVOIR (MPL) | |
442 | 1 | ZPRES(NFLEVG)=VP00 | |
443 | ! on recupere ap et bp de dyn3d (vertical_layers_mod) MPL 19.05.09 | ||
444 | ! Attention, VAH et VBH sont inverses, comme les niveaux | ||
445 | ! plev(l)=PAPRS(klon,nlayer+1-l) de 1 a nlayer (apllmd.F) | ||
446 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 40 times.
|
41 | DO JLEV = 0, NFLEVG |
447 | ! VAH(JLEV)=ap(JLEV+1)ap(JLEV+1) | ||
448 | ! VBH(JLEV)=bp(JLEV+1) | ||
449 | ! print *,'SUPHEC: jlev ap bp',JLEV,ap(JLEV+1),bp(JLEV+1) | ||
450 | 40 | VAH(JLEV)=ap(NFLEVG+1-JLEV) | |
451 | 41 | VBH(JLEV)=bp(NFLEVG+1-JLEV) | |
452 | ENDDO | ||
453 | ! Calcul de VAF et VBF, analogues de VAH et VBH mais aux niveaux pleins | ||
454 |
2/2✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
|
40 | DO JLEV = 1, NFLEVG |
455 | 39 | VAF(JLEV)=(VAH(JLEV)+VAH(JLEV-1))/2. | |
456 | 40 | VBF(JLEV)=(VBH(JLEV)+VBH(JLEV-1))/2. | |
457 | ENDDO | ||
458 | |||
459 | ! Appel a GPPRE commente par MPL 28.11.08, puis decommente le 19.05.09 | ||
460 | 1 | CALL GPPRE ( 1 ,1, 1, NFLEVG, VAH, VBH, ZPRES, ZPRESF ) | |
461 | |||
462 |
2/2✓ Branch 0 taken 1 times.
✓ Branch 1 taken 40 times.
|
41 | DO JK=0,NFLEVG |
463 | 41 | ZETAH(JK)= ZPRES(JK)/ZPRES(NFLEVG) | |
464 | ENDDO | ||
465 |
2/2✓ Branch 0 taken 39 times.
✓ Branch 1 taken 1 times.
|
40 | DO JK=1,NFLEVG |
466 | 40 | ZETA(JK)= ZPRESF(JK)/ZPRES(NFLEVG) | |
467 | ENDDO | ||
468 | |||
469 | ! ------------------------------------------------------------------ | ||
470 | !* 1. SETTING CONSTANTS FOR DIAGNOSTIC CLOUD SCHEME | ||
471 | ! --------------------------------------------- | ||
472 | |||
473 | !CALL SUCLD ( NFLEVG , ZETA ) ! MPL 28.11.08 | ||
474 | |||
475 | ! ------------------------------------------------------------------ | ||
476 | |||
477 | !* 2. SETTING CONSTANTS FOR LARGE-SCALE CONDENSATION SCHEME | ||
478 | ! ----------------------------------------------------- | ||
479 | |||
480 | !CALL SUCOND ( KULOUT , NFLEVG , ZETA ) ! MPL 28.11.08 | ||
481 | |||
482 | ! ------------------------------------------------------------------ | ||
483 | |||
484 | !* 3. SETTING CONSTANTS FOR CONVECTION SCHEME | ||
485 | ! --------------------------------------- | ||
486 | |||
487 | !CALL SUCUMF(ISMAX) ! MPL 28.11.08 | ||
488 | |||
489 | ! ------------------------------------------------------------------ | ||
490 | |||
491 | !* 3. SETTING CONSTANTS FOR NEW LINEARIZED CONVECTION SCHEME | ||
492 | ! ------------------------------------------------------ | ||
493 | |||
494 | !CALL SUCUMF2(ISMAX) ! MPL 28.11.08 | ||
495 | |||
496 | ! ------------------------------------------------------------------ | ||
497 | !* 4. SETTING CONSTANTS FOR GRAVITY WAVE DRAG SCHEME | ||
498 | ! ---------------------------------------------- | ||
499 | |||
500 | !CALL SUGWD (KULOUT, NFLEVG, VAH, VBH ) ! MPL 28.11.08 | ||
501 | |||
502 | ! ------------------------------------------------------------------ | ||
503 | |||
504 | !* 5. SETTING CONSTANTS FOR VERTICAL DIFFUSION | ||
505 | ! ---------------------------------------- | ||
506 | |||
507 | !CALL SUVDFS ! MPL 28.11.08 | ||
508 | |||
509 | !CALL SUVDF ! MPL 28.11.08 | ||
510 | |||
511 | !cccc CALL SUVDFD ( NABLPFR, ABLPLL ) cccccccccccccccccccccccccccccccccc | ||
512 | |||
513 | ! ------------------------------------------------------------------ | ||
514 | |||
515 | !* 6. SETTING CONSTANTS FOR RADIATION SCHEME | ||
516 | ! -------------------------------------- | ||
517 | |||
518 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (LRAYFM15) THEN |
519 | ✗ | CALL SUECRAD15 (KULOUT, NFLEVG, ZETAH ) | |
520 | ELSE | ||
521 | 1 | CALL SUECRAD (KULOUT, NFLEVG, ZETAH ) | |
522 | ENDIF | ||
523 | |||
524 | ! ------------------------------------------------------------------ | ||
525 | !* 7. SETTING CONSTANTS FOR SURFACE SCHEME | ||
526 | ! ------------------------------------ | ||
527 | |||
528 | !IF (LRAYFM15) THEN | ||
529 | ! CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,& | ||
530 | ! & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,& | ||
531 | ! & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,& | ||
532 | ! & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,& | ||
533 | ! & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,& | ||
534 | ! & PRSUN=RSUN15) | ||
535 | !ELSE | ||
536 | ! CALL SUSURF(KSW=NSW,KCSS=YSP_SBD%NLEVS,KSIL=NSIL,KTILES=NTILES,KTSW=NTSW,& | ||
537 | ! & LD_LLCCNL=LCCNL,LD_LLCCNO=LCCNO,& | ||
538 | ! & LD_LEOCWA=LEOCWA,LD_LEOCCO=LEOCCO,LD_LEOCSA=LEOCSA,LD_LLE4ALB=LE4ALB,& | ||
539 | ! & LD_LSCMEC=LSCMEC,LD_LROUGH=LROUGH,PEXTZ0M=REXTZ0M,PEXTZ0H=REXTZ0H,& | ||
540 | ! & PTHRFRTI=RTHRFRTI,PTSTAND=TSTAND,PXP=XP,PRCCNSEA=RCCNSEA,PRCCNLND=RCCNLND,& | ||
541 | ! & PRSUN=RSUN) | ||
542 | !ENDIF | ||
543 | |||
544 | |||
545 | !CALL SURF_INQ(KNVTYPES=NVTYPES) | ||
546 | |||
547 | |||
548 | ! 7.1 Allocate working arrays | ||
549 | !ALLOCATE(RUSTRTI(NPROMA,NTILES,NGPBLKS)) | ||
550 | !ALLOCATE(RVSTRTI(NPROMA,NTILES,NGPBLKS)) | ||
551 | !ALLOCATE(RAHFSTI(NPROMA,NTILES,NGPBLKS)) | ||
552 | !ALLOCATE(REVAPTI(NPROMA,NTILES,NGPBLKS)) | ||
553 | !ALLOCATE(RTSKTI (NPROMA,NTILES,NGPBLKS)) | ||
554 | !RUSTRTI(:,:,:) = 0.0_JPRB | ||
555 | !RVSTRTI(:,:,:) = 0.0_JPRB | ||
556 | !RAHFSTI(:,:,:) = 0.0_JPRB | ||
557 | !REVAPTI(:,:,:) = 0.0_JPRB | ||
558 | !RTSKTI (:,:,:) = 0.0_JPRB | ||
559 | !CALL GSTATS(1811,1) | ||
560 | |||
561 | ! ------------------------------------------------------------------ | ||
562 | |||
563 | !* 8. SETTING CONSTANTS FOR CLOUD OPTICAL PROPERTIES | ||
564 | ! ---------------------------------------------- | ||
565 | |||
566 |
1/2✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
|
1 | IF (LRAYFM15) THEN |
567 | ✗ | CALL SUCLOP15 | |
568 | ELSE | ||
569 | 1 | CALL SUCLOP | |
570 | ENDIF | ||
571 | |||
572 | ! ------------------------------------------------------------------ | ||
573 | |||
574 | !* 9. SETTING CONSTANTS FOR PROGNOSTIC CLOUD SCHEME | ||
575 | ! ---------------------------------------------- | ||
576 | |||
577 | !CALL SUCLDP | ||
578 | |||
579 | ! ------------------------------------------------------------------ | ||
580 | |||
581 | !* 10. SETTING CONSTANTS FOR WAVE COUPLING | ||
582 | ! ----------------------------------- | ||
583 | |||
584 | !CALL SUWCOU | ||
585 | |||
586 | ! ------------------------------------------------------------------ | ||
587 | !* 11. SETTING CONSTANTS FOR LINEARIZED PHYSICS | ||
588 | ! ---------------------------------------- | ||
589 | |||
590 | !CALL SUPHLI | ||
591 | |||
592 | ! ------------------------------------------------------------------ | ||
593 | !* 12. SETTING CONSTANTS FOR METHANE OXIDATION | ||
594 | ! --------------------------------------- | ||
595 | |||
596 | !CALL SUMETHOX | ||
597 | |||
598 | ! ------------------------------------------------------------------ | ||
599 | |||
600 | 1 | WRITE(UNIT=KULOUT,FMT='('' SUPHEC IS OVER '')') | |
601 | |||
602 | ! ------------------------------------------------------------------ | ||
603 | |||
604 |
1/2✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
|
1 | IF (LHOOK) CALL DR_HOOK('SUPHEC',1,ZHOOK_HANDLE) |
605 | 1 | END SUBROUTINE SUPHEC | |
606 |