GCC Code Coverage Report

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