GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/suecrad15.F90 Lines: 0 84 0.0 %
Date: 2023-06-30 12:56:34 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
#include "namrad15.h"
91
!      ----------------------------------------------------------------
92
93
LOGICAL :: LLMESS
94
95
INTEGER(KIND=JPIM) :: IRADFR, IST1HR, IST6HR
96
97
98
REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP
99
REAL(KIND=JPRB) :: ZHOOK_HANDLE
100
101
#include "posnam.intfb.h"
102
#include "suaer15.intfb.h"
103
#include "suaerv15.intfb.h"
104
#include "suecradi15.intfb.h"
105
#include "suecradl.intfb.h"
106
#include "sulw15.intfb.h"
107
#include "surdi15.intfb.h"
108
#include "susat.intfb.h"
109
#include "susw15.intfb.h"
110
111
!      ----------------------------------------------------------------
112
113
!*         1.       SET DEFAULT VALUES.
114
!                   -------------------
115
116
!*         1.1      PRESET INDICES IN *YOMRAD15*
117
!                   --------------------------
118
119
IF (LHOOK) CALL DR_HOOK('SUECRAD15',0,ZHOOK_HANDLE)
120
LLMESS=.FALSE.
121
LERAD6H15=.TRUE.
122
LERADHS15=.TRUE.
123
LRADAER15=.TRUE.
124
LNEWAER15=.FALSE.
125
NAER15   =1
126
NAER=0
127
NFLUX15  =6
128
NMODE15  =0
129
NRAD15   =1
130
NRADFR15 =-3
131
NRADPFR15=36
132
NRADPLA15=15
133
NRINT15  =4
134
NRADF2C15=1
135
NRADC2F15=1
136
NUAER15  = 24
137
NTRAER15 = 15
138
NOVLP15 = 1
139
NSW=2
140
NTSW=2
141
IF(NSMAX >= 106) THEN
142
  NRPROMA15 = 80
143
ELSEIF(NSMAX == 63) THEN
144
  NRPROMA15=48
145
ELSE
146
  NRPROMA15=20
147
ENDIF
148
149
!*         1.3      SET SECURITY PARAMETERS
150
!                   -----------------------
151
152
REPSC15  = 1.E-12_JPRB
153
REPSCO15 = 1.E-12_JPRB
154
REPSCQ15 = 1.E-12_JPRB
155
REPSCT15 = 1.E-12_JPRB
156
REPSCW15 = 1.E-12_JPRB
157
REELOG15 = 1.E-12_JPRB
158
159
!     ------------------------------------------------------------------
160
161
!*         2.       READ VALUES OF RADIATION CONFIGURATION
162
!                   --------------------------------------
163
164
! Ce qui concerne NAMRAD15 commente par MPL le 15.04.09
165
!CALL POSNAM(NULNAM,'NAMRAD15')
166
!READ (NULNAM,NAMRAD15)
167
168
!     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
169
170
LODBGRADI=.FALSE.
171
CALL SUECRADI15
172
173
IF( LLMESS )THEN
174
175
!     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
176
!     LOAD BALANCING
177
178
  LODBGRADL=.FALSE.
179
! CALL SUECRADL   ! MPL 1.12.08
180
  CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
181
ENDIF
182
183
!      ----------------------------------------------------------------
184
185
!*       3.    INITIALIZE RADIATION COEFFICIENTS.
186
!              ----------------------------------
187
188
RCDAY15  = RDAY * RG / RCPD
189
DIFF15   = 1.66_JPRB
190
R10E15   = 0.4342945_JPRB
191
192
CALL SURDI15
193
194
!      ----------------------------------------------------------------
195
196
!*       4.    INITIALIZE RADIATION ABSORPTION COEFFICIENTS
197
!              --------------------------------------------
198
199
CALL SULW15
200
CALL SUSW15
201
202
!      ----------------------------------------------------------------
203
204
!*       5.    INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
205
!              ------------------------------------------------------
206
207
!     INITIALIZATION DONE IN BLOCK DATA SUAERHBD
208
209
!- optical properties
210
CALL SUAER15
211
212
!     CALL SUAERH
213
214
CALL SUAERV15 ( KLEV  , PETAH,&
215
 & CVDAES15, CVDAEL15, CVDAEU15, CVDAED15, CVDAEF15,&
216
 & RCTRBGA15, RCVOBGA15, RCSTBGA15, RCAEOPS15, RCAEOPL15, RCAEOPU15,&
217
 & RCAEOPF15,&
218
 & RCAEOPD15, RCTRPT15 , RCAEADK15, RCAEADM15, RCAEROS15        )
219
220
!      ----------------------------------------------------------------
221
222
!*       6.    INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
223
!              -------------------------------------------------------
224
225
IF (LEPHYS) THEN
226
  IF (NMODE15 > 1) THEN
227
    CALL SUSAT
228
  ENDIF
229
ENDIF
230
231
!      ----------------------------------------------------------------
232
233
!*       7.    INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
234
!              --------------------------------------------
235
!                  (not done here!!!  called from APLPAR as it depends
236
!                     on model pressure levels!)
237
238
!      ----------------------------------------------------------------
239
240
!*       8.    SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
241
!              -------------------------------------------------------
242
243
ZTSTEP=MAX(TSTEP,1.0_JPRB)
244
ZSTPHR=3600._JPRB/ZTSTEP
245
IRADFR=NRADFR15
246
IF(NRADFR15 < 0) THEN
247
  NRADFR15=-NRADFR15*ZSTPHR+0.5_JPRB
248
ENDIF
249
NRADPFR15=NRADPFR15*NRADFR15
250
IF (MOD(NRADPLA15,2) == 0.AND. NRADPLA15 /= 0) THEN
251
  NRADPLA15=NRADPLA15+1
252
ENDIF
253
254
IST1HR=ZSTPHR+0.05_JPRB
255
IST6HR=6._JPRB*ZSTPHR+0.05_JPRB
256
IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
257
  IST1HR=IST1HR+1
258
  DO WHILE (MOD(IST6HR,IST1HR) /= 0)
259
    IST1HR=IST1HR+1
260
  ENDDO
261
ENDIF
262
NRADSFR15=IST1HR
263
NRADNFR15=NRADFR15
264
265
IF(LRAYFM15) THEN
266
  NRPROMA15=NDLON+6+(1-MOD(NDLON,2))
267
ENDIF
268
269
270
271
!*       9.    ALLOCATE WORK ARRAYS
272
!               --------------------
273
274
LLP = NPRINTLEV >= 1
275
276
  ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
277
  IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
278
  ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
279
  IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
280
  ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS))
281
  IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'EMTU     ',SIZE(EMTU     ),SHAPE(EMTU     )
282
  ALLOCATE(RMOON(NPROMA,NGPBLKS))
283
  IF(LLP)WRITE(UNIT=KULOUT,FMT=9) 'RMOON    ',SIZE(RMOON    ),SHAPE(RMOON    )
284
285
9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
286
287
!      ----------------------------------------------------------------
288
289
!*       9.    PRINT FINAL VALUES.
290
!              -------------------
291
292
293
294
295
IF (LLP) THEN
296
  WRITE(UNIT=KULOUT,FMT='('' COMMON YOMRAD15 '')')
297
  WRITE(UNIT=KULOUT,FMT='('' LERADI  = '',L5 &
298
   & ,'' LERAD6H15 = '',L5)')&
299
   & LERADI,LERAD6H15
300
  WRITE(UNIT=KULOUT,FMT='('' NRADFR15  = '',I2 &
301
   & ,'' NRADPFR15 = '',I3 &
302
   & ,'' NRADPLA15 = '',I2 &
303
   & ,'' NRINT15   = '',I1 &
304
   & ,'' NRPROMA15 = '',I5 &
305
   & ,'' NRADF2C15 = '',I1 &
306
   & ,'' NRADC2F15 = '',I1 &
307
   & )')&
308
   & NRADFR15,NRADPFR15,NRADPLA15,NRINT15,&
309
   & NRPROMA15,NRADF2C15,NRADC2F15
310
311
  WRITE(UNIT=KULOUT,FMT='('' LERADHS15= '',L5,'' LRADAER15= '',L5 &
312
   & ,'' LNEWAER15= '',L5 &
313
   & ,'' NMODE15 = '',I1 &
314
   & ,'' NAER15  = '',I1 &
315
   & ,'' NFLUX15 = '',I2 &
316
   & ,'' NRAD15  = '',I2 &
317
   & )')&
318
   & LERADHS15,LRADAER15,LNEWAER15,NMODE15,NAER15,NFLUX15,NRAD15
319
  WRITE(KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPTION IS''&
320
   & ,'' NOVLP15   = '',I2 &
321
   & )')&
322
   & NOVLP15
323
324
  WRITE(UNIT=KULOUT,FMT='('' MODULE YOERAD '')')
325
  WRITE(UNIT=KULOUT,FMT='('' NSW = '',I2, '' NTSW = '',I2)') NSW,NTSW
326
ENDIF
327
328
!     ------------------------------------------------------------------
329
330
IF (LHOOK) CALL DR_HOOK('SUECRAD15',1,ZHOOK_HANDLE)
331
END SUBROUTINE SUECRAD15