GCC Code Coverage Report


Directory: ./
File: rad/suecrad15.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 84 0.0%
Branches: 0 100 0.0%

Line Branch Exec Source
1 !OPTIONS XOPT(NOEVAL)
2 SUBROUTINE SUECRAD15 (KULOUT, KLEV, PETAH )
3
4 !**** *SUECRAD15* - INITIALIZE COMMONS YOMRxx15 CONTROLLING RADIATION
5 !**** FROZEN VERSION (CYCLE 15) OF SUECRAD
6
7 ! PURPOSE.
8 ! --------
9 ! INITIALIZE YOMRAD15, THE COMMON THAT CONTROLS THE
10 ! RADIATION OF THE MODEL, AND YOMRDU15 THAT INCLUDES
11 ! ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS
12
13 !** INTERFACE.
14 ! ----------
15 ! CALL *SUECRAD15* FROM *SUPHEC*
16 ! --------- ------
17
18 ! EXPLICIT ARGUMENTS :
19 ! --------------------
20 ! NONE
21
22 ! IMPLICIT ARGUMENTS :
23 ! --------------------
24 ! COMMONS YOMRAD15, YOMRDU15
25
26 ! METHOD.
27 ! -------
28 ! SEE DOCUMENTATION
29
30 ! EXTERNALS.
31 ! ----------
32 ! SUAER, SUAERH, SUAERV, SULW, SUSW, SUCLD, SUOCST, SUSAT
33
34 ! REFERENCE.
35 ! ----------
36 ! ECMWF Research Department documentation of the IFS
37
38 ! AUTHOR.
39 ! -------
40 ! 96-11: Ph. Dandin. Meteo-France
41 ! ORIGINAL : 88-12-15 BY JEAN-JACQUES MORCRETTE *ECMWF*
42
43 ! MODIFICATIONS.
44 ! --------------
45 ! R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
46 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
47 ! F. Bouyssel 27-09-04 initialisation of NSW
48 ! A. Alias 29-09-05 Sulfate aerosols (Hu Rong Ming)
49 ! ------------------------------------------------------------------
50
51 USE PARKIND1 ,ONLY : JPIM ,JPRB
52 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
53
54 USE YOMCT0 , ONLY : NPRINTLEV
55 USE YOMDIM , ONLY : NDLON ,NSMAX ,NGPBLKS ,NFLEVG ,NPROMA
56 USE YOMDYN , ONLY : TSTEP
57 ! Ce qui concerne NULNAM commente par MPL le 15.04.09
58 !USE YOMLUN , ONLY : NULNAM
59 USE YOMCST , ONLY : RDAY ,RG ,RCPD
60 USE YOMPHY , ONLY : LRAYFM15
61 USE YOEPHY , ONLY : LEPHYS ,LERADI
62 USE YOMRAD15 , ONLY : NAER15 ,NFLUX15 ,NMODE15 ,NRAD15 ,&
63 & NRADFR15 ,NRADPFR15,NRADPLA15,NRINT15 ,NRADNFR15,&
64 & NRADSFR15,NOVLP15 ,NRPROMA15,NRADF2C15,NRADC2F15,&
65 & LERAD6H15,LERADHS15,LRADAER15,LNEWAER15
66 USE YOERAD , ONLY : NAER ,NTSW
67 !USE YOERAD , ONLY : NAER ,NSW ,NTSW
68 ! NSW mis dans .def MPL 20140211
69 USE YOMRDU15 , ONLY : NUAER15 ,NTRAER15 ,RCDAY15 ,R10E15 ,&
70 & REELOG15 ,REPSC15 ,REPSCO15 ,REPSCQ15 ,REPSCT15 ,&
71 & REPSCW15 ,DIFF15
72 USE YOMAERD15, ONLY : CVDAES15 ,CVDAEL15 ,CVDAEU15 ,CVDAED15 ,&
73 & CVDAEF15 ,&
74 & RCAEOPS15,RCAEOPL15,RCAEOPU15,RCAEOPD15,RCTRBGA15,&
75 & RCAEOPF15,&
76 & RCVOBGA15,RCSTBGA15,RCTRPT15 ,RCAEADM15,RCAEROS15,&
77 & RCAEADK15
78 USE YOMPRAD , ONLY : LODBGRADI,LODBGRADL
79 USE YOMRADF , ONLY : EMTD ,EMTU ,TRSW ,RMOON
80
81 IMPLICIT NONE
82
83 include "clesphys.h"
84
85 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
86 INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
87 REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1)
88 LOGICAL :: LLP
89
90 ! -----------------------------------------------------------------
91 NAMELIST/NAMRAD15/&
92 &LERAD6H15, LERADHS15, LRADAER15, LNEWAER15 &
93 &, NAER15 , NFLUX15 , NMODE15 &
94 &, NOVLP15 , NRAD15 , NRADFR15 &
95 &, NRADPFR15, NRADPLA15, NRINT15 , NRPROMA15 &
96 &, NRADF2C15, NRADC2F15
97 ! -----------------------------------------------------------------
98
99 ! ----------------------------------------------------------------
100
101 LOGICAL :: LLMESS
102
103 INTEGER(KIND=JPIM) :: IRADFR, IST1HR, IST6HR
104
105
106 REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP
107 REAL(KIND=JPRB) :: ZHOOK_HANDLE
108
109 INTERFACE
110 SUBROUTINE POSNAM(KULNAM,CDNAML)
111 USE PARKIND1 ,ONLY : JPIM ,JPRB
112 INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM
113 CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML
114 END SUBROUTINE POSNAM
115 END INTERFACE
116 INTERFACE
117 SUBROUTINE SUAER15
118 END SUBROUTINE SUAER15
119 END INTERFACE
120 INTERFACE
121 SUBROUTINE SUAERV15 ( KLEV , PETAH,&
122 & PVDAES,PVDAEL,PVDAEU,PVDAED,PVDAEF,&
123 & PTRBGA,PVOBGA,PSTBGA,PAEOPS,PAEOPL,PAEOPU,&
124 & PAEOPF,&
125 & PAEOPD,PTRPT,PAEADK,PAEADM, PAEROS )
126 USE PARKIND1 ,ONLY : JPIM ,JPRB
127 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
128 REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1)
129 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAES(KLEV+1)
130 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEL(KLEV+1)
131 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEU(KLEV+1)
132 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAED(KLEV+1)
133 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEF(KLEV+1)
134 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRBGA
135 REAL(KIND=JPRB) ,INTENT(OUT) :: PVOBGA
136 REAL(KIND=JPRB) ,INTENT(OUT) :: PSTBGA
137 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPS
138 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPL
139 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPU
140 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPF
141 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPD
142 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRPT
143 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEADK(3)
144 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEADM
145 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEROS
146 END SUBROUTINE SUAERV15
147 END INTERFACE
148 INTERFACE
149 SUBROUTINE SUECRADI15
150 END SUBROUTINE SUECRADI15
151 END INTERFACE
152 INTERFACE
153 SUBROUTINE SUECRADL
154 !USE MPL_MODULE
155 END SUBROUTINE SUECRADL
156 END INTERFACE
157 INTERFACE
158 SUBROUTINE SULW15
159 END SUBROUTINE SULW15
160 END INTERFACE
161 INTERFACE
162 SUBROUTINE SURDI15
163 END SUBROUTINE SURDI15
164 END INTERFACE
165 INTERFACE
166 SUBROUTINE SUSAT
167 END SUBROUTINE SUSAT
168 END INTERFACE
169 INTERFACE
170 SUBROUTINE SUSW15
171 END SUBROUTINE SUSW15
172 END INTERFACE
173
174 ! ----------------------------------------------------------------
175
176 !* 1. SET DEFAULT VALUES.
177 ! -------------------
178
179 !* 1.1 PRESET INDICES IN *YOMRAD15*
180 ! --------------------------
181
182 IF (LHOOK) CALL DR_HOOK('SUECRAD15',0,ZHOOK_HANDLE)
183 LLMESS=.FALSE.
184 LERAD6H15=.TRUE.
185 LERADHS15=.TRUE.
186 LRADAER15=.TRUE.
187 LNEWAER15=.FALSE.
188 NAER15 =1
189 NAER=0
190 NFLUX15 =6
191 NMODE15 =0
192 NRAD15 =1
193 NRADFR15 =-3
194 NRADPFR15=36
195 NRADPLA15=15
196 NRINT15 =4
197 NRADF2C15=1
198 NRADC2F15=1
199 NUAER15 = 24
200 NTRAER15 = 15
201 NOVLP15 = 1
202 NSW=2
203 NTSW=2
204 IF(NSMAX >= 106) THEN
205 NRPROMA15 = 80
206 ELSEIF(NSMAX == 63) THEN
207 NRPROMA15=48
208 ELSE
209 NRPROMA15=20
210 ENDIF
211
212 !* 1.3 SET SECURITY PARAMETERS
213 ! -----------------------
214
215 REPSC15 = 1.E-12_JPRB
216 REPSCO15 = 1.E-12_JPRB
217 REPSCQ15 = 1.E-12_JPRB
218 REPSCT15 = 1.E-12_JPRB
219 REPSCW15 = 1.E-12_JPRB
220 REELOG15 = 1.E-12_JPRB
221
222 ! ------------------------------------------------------------------
223
224 !* 2. READ VALUES OF RADIATION CONFIGURATION
225 ! --------------------------------------
226
227 ! Ce qui concerne NAMRAD15 commente par MPL le 15.04.09
228 !CALL POSNAM(NULNAM,'NAMRAD15')
229 !READ (NULNAM,NAMRAD15)
230
231 ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
232
233 LODBGRADI=.FALSE.
234 CALL SUECRADI15
235
236 IF( LLMESS )THEN
237
238 ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
239 ! LOAD BALANCING
240
241 LODBGRADL=.FALSE.
242 ! CALL SUECRADL ! MPL 1.12.08
243 CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
244 ENDIF
245
246 ! ----------------------------------------------------------------
247
248 !* 3. INITIALIZE RADIATION COEFFICIENTS.
249 ! ----------------------------------
250
251 RCDAY15 = RDAY * RG / RCPD
252 DIFF15 = 1.66_JPRB
253 R10E15 = 0.4342945_JPRB
254
255 CALL SURDI15
256
257 ! ----------------------------------------------------------------
258
259 !* 4. INITIALIZE RADIATION ABSORPTION COEFFICIENTS
260 ! --------------------------------------------
261
262 CALL SULW15
263 CALL SUSW15
264
265 ! ----------------------------------------------------------------
266
267 !* 5. INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
268 ! ------------------------------------------------------
269
270 ! INITIALIZATION DONE IN BLOCK DATA SUAERHBD
271
272 !- optical properties
273 CALL SUAER15
274
275 ! CALL SUAERH
276
277 CALL SUAERV15 ( KLEV , PETAH,&
278 & CVDAES15, CVDAEL15, CVDAEU15, CVDAED15, CVDAEF15,&
279 & RCTRBGA15, RCVOBGA15, RCSTBGA15, RCAEOPS15, RCAEOPL15, RCAEOPU15,&
280 & RCAEOPF15,&
281 & RCAEOPD15, RCTRPT15 , RCAEADK15, RCAEADM15, RCAEROS15 )
282
283 ! ----------------------------------------------------------------
284
285 !* 6. INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
286 ! -------------------------------------------------------
287
288 IF (LEPHYS) THEN
289 IF (NMODE15 > 1) THEN
290 CALL SUSAT
291 ENDIF
292 ENDIF
293
294 ! ----------------------------------------------------------------
295
296 !* 7. INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
297 ! --------------------------------------------
298 ! (not done here!!! called from APLPAR as it depends
299 ! on model pressure levels!)
300
301 ! ----------------------------------------------------------------
302
303 !* 8. SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
304 ! -------------------------------------------------------
305
306 ZTSTEP=MAX(TSTEP,1.0_JPRB)
307 ZSTPHR=3600._JPRB/ZTSTEP
308 IRADFR=NRADFR15
309 IF(NRADFR15 < 0) THEN
310 NRADFR15=-NRADFR15*ZSTPHR+0.5_JPRB
311 ENDIF
312 NRADPFR15=NRADPFR15*NRADFR15
313 IF (MOD(NRADPLA15,2) == 0.AND. NRADPLA15 /= 0) THEN
314 NRADPLA15=NRADPLA15+1
315 ENDIF
316
317 IST1HR=ZSTPHR+0.05_JPRB
318 IST6HR=6._JPRB*ZSTPHR+0.05_JPRB
319 IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
320 IST1HR=IST1HR+1
321 DO WHILE (MOD(IST6HR,IST1HR) /= 0)
322 IST1HR=IST1HR+1
323 ENDDO
324 ENDIF
325 NRADSFR15=IST1HR
326 NRADNFR15=NRADFR15
327
328 IF(LRAYFM15) THEN
329 NRPROMA15=NDLON+6+(1-MOD(NDLON,2))
330 ENDIF
331
332
333
334 !* 9. ALLOCATE WORK ARRAYS
335 ! --------------------
336
337 LLP = NPRINTLEV >= 1
338
339 ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
340 IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD )
341 ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
342 IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW )
343 ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS))
344 IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'EMTU ',SIZE(EMTU ),SHAPE(EMTU )
345 ALLOCATE(RMOON(NPROMA,NGPBLKS))
346 IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'RMOON ',SIZE(RMOON ),SHAPE(RMOON )
347
348 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
349
350 ! ----------------------------------------------------------------
351
352 !* 9. PRINT FINAL VALUES.
353 ! -------------------
354
355
356
357
358 IF (LLP) THEN
359 WRITE(UNIT=KULOUT,FMT='('' COMMON YOMRAD15 '')')
360 WRITE(UNIT=KULOUT,FMT='('' LERADI = '',L5 &
361 & ,'' LERAD6H15 = '',L5)')&
362 & LERADI,LERAD6H15
363 WRITE(UNIT=KULOUT,FMT='('' NRADFR15 = '',I2 &
364 & ,'' NRADPFR15 = '',I3 &
365 & ,'' NRADPLA15 = '',I2 &
366 & ,'' NRINT15 = '',I1 &
367 & ,'' NRPROMA15 = '',I5 &
368 & ,'' NRADF2C15 = '',I1 &
369 & ,'' NRADC2F15 = '',I1 &
370 & )')&
371 & NRADFR15,NRADPFR15,NRADPLA15,NRINT15,&
372 & NRPROMA15,NRADF2C15,NRADC2F15
373
374 WRITE(UNIT=KULOUT,FMT='('' LERADHS15= '',L5,'' LRADAER15= '',L5 &
375 & ,'' LNEWAER15= '',L5 &
376 & ,'' NMODE15 = '',I1 &
377 & ,'' NAER15 = '',I1 &
378 & ,'' NFLUX15 = '',I2 &
379 & ,'' NRAD15 = '',I2 &
380 & )')&
381 & LERADHS15,LRADAER15,LNEWAER15,NMODE15,NAER15,NFLUX15,NRAD15
382 WRITE(KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPTION IS''&
383 & ,'' NOVLP15 = '',I2 &
384 & )')&
385 & NOVLP15
386
387 WRITE(UNIT=KULOUT,FMT='('' MODULE YOERAD '')')
388 WRITE(UNIT=KULOUT,FMT='('' NSW = '',I2, '' NTSW = '',I2)') NSW,NTSW
389 ENDIF
390
391 ! ------------------------------------------------------------------
392
393 IF (LHOOK) CALL DR_HOOK('SUECRAD15',1,ZHOOK_HANDLE)
394 END SUBROUTINE SUECRAD15
395