GCC Code Coverage Report

Directory: ./
File: rad/suecrad.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 176 678 26.0%
Branches: 48 1017 4.7%
Line Branch Exec Source
1 !
2 ! $Id: suecrad.F90 3115 2017-12-07 14:45:01Z emillour $
3 !
4 5 SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH )
5
6 !**** *SUECRAD* - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION
7
8 ! PURPOSE.
9 ! --------
10 ! INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE
11 ! RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES
12 ! ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS
13
14 !** INTERFACE.
15 ! ----------
16 ! CALL *SUECRAD* FROM *SUPHEC*
17 ! ------- ------
18
19 ! EXPLICIT ARGUMENTS :
20 ! --------------------
21 ! NONE
22
23 ! IMPLICIT ARGUMENTS :
24 ! --------------------
25 ! COMMONS YOERAD, YOERDU
26
27 ! METHOD.
28 ! -------
29 ! SEE DOCUMENTATION
30
31 ! EXTERNALS.
32 ! ----------
33 ! SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT
34 ! SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP
35
36 ! REFERENCE.
37 ! ----------
38 ! ECMWF Research Department documentation of the IFS
39
40 ! AUTHOR.
41 ! -------
42 ! JEAN-JACQUES MORCRETTE *ECMWF*
43
44 ! MODIFICATIONS.
45 ! --------------
46 ! ORIGINAL : 88-12-15
47 ! P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED
48 ! Modified 93-11-15 by Ph. Dandin : FMR scheme with MF
49 ! Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR
50 ! 980317 JJMorcrette clean-up (NRAD, NFLUX)
51 ! 000118 JJMorcrette variable concentr. uniformly mixed gases
52 ! 990525 JJMorcrette GISS volcanic and new tropospheric aerosols
53 ! 990831 JJMorcrette RRTM
54 ! R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
55 ! 010129 JJMorcrette clean-up LERAD1H, NLNGR1H
56 ! 011105 GMozdzynski support new radiation grid
57 ! 011005 JJMorcrette CCN --> Re Water clouds
58 ! R. El Khatib 01-02-02 LRRTM=lecmwf by default
59 ! 020909 GMozdzynski support NRADRES to specify radiation grid
60 ! 021001 GMozdzynski support on-demand radiation communications
61 ! 030422 GMozdzynski automatic min-halo
62 ! 030501 JJMorcrette new radiation grid on, new aerosols on (default)
63 ! 030513 JJMorcrette progn. O3 / radiation interactions off (default)
64 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
65 ! 050315 JJMorcrette prog.aerosols v1
66 ! 041214 JJMorcrette SRTM
67 ! 050111 JJMorcrette new cloud optical properties
68 ! 050415 GMozdzynski Reduced halo support for radiation interpolation
69 ! 051004 JJMorcrette UV surface radiation processor
70 ! 051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca)
71 ! 060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
72 ! 060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
73 ! JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
74 ! 060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
75 ! 060726 JJMorcrette McICA default operational configuration
76 ! ------------------------------------------------------------------
77
78 USE PARKIND1 ,ONLY : JPIM ,JPRB
79 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
80
81 USE PARDIM , ONLY : JPMXGL
82 USE PARRRTM , ONLY : JPLAY
83 USE PARSRTM , ONLY : JPGPT
84 USE YOMCT0 , ONLY : LOUTPUT ,NPRINTLEV,LALLOPR,&
85 & NPROC ,N_REGIONS_NS ,N_REGIONS_EW
86 USE YOMDIM , ONLY : NDLON ,NSMAX ,NDGENL ,&
87 & NDGSAL ,NDGLG ,NDGSAG ,NDGENG ,NDSUR1 ,&
88 & NDLSUR ,NDGSUR ,NGPBLKS ,NFLEVG ,NPROMA
89 USE YOMCT0B , ONLY : LECMWF
90 USE YOMDYN , ONLY : TSTEP
91 ! Ce qui concerne NULRAD commente par MPL le 15.04.09
92 !USE YOMLUN , ONLY : NULNAM ,NULRAD ,NULOUT
93 USE YOMLUN , ONLY : NULRAD ,NULOUT
94 USE YOMCST , ONLY : RDAY ,RG ,RCPD ,RPI ,RI0
95 USE YOMPHY , ONLY : LMPHYS, LRAYFM ,LRAYFM15
96 USE YOEPHY , ONLY : LEPHYS ,LERADI, LE4ALB
97 USE YOERDI , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC
98 USE YOERAD , ONLY : NAER , NOZOCL ,&
99 & NRADFR ,NRADPFR ,NRADPLA ,NRINT ,&
100 & NRADNFR ,NRADSFR ,NOVLP ,NRPROMA ,&
101 !& NLW ,NSW ,NTSW ,NCSRADF ,&
102 ! NSW mis dans .def MPL 20140211
103 & NLW ,NTSW ,NCSRADF ,&
104 & NMODE ,NLNGR1H ,NSWNL ,NSWTL ,NUV ,&
105 & LERAD1H ,LERADHS ,LEPO3RA ,LRADLB ,LONEWSW ,&
106 & LCCNL ,LCCNO ,&
107 & LECSRAD ,LHVOLCA ,LNEWAER ,LRRTM ,LSRTM ,LDIFFC ,&
108 & NRADINT ,NRADRES ,CRTABLEDIR,CRTABLEFIL ,&
109 & NICEOPT ,NLIQOPT ,NRADIP ,NRADLP ,NINHOM ,NLAYINH ,&
110 & LRAYL ,LOPTRPROMA,&
111 & RCCNLND ,RCCNSEA ,RLWINHF ,RSWINHF ,RRe2De ,&
112 & RPERTOZ ,NPERTOZ ,NMCICA ,&
113 & LNOTROAER,NPERTAER ,LECO2VAR ,LHGHG ,NHINCSOL,NSCEN ,&
114 & LEDBUG
115 USE YOERDU , ONLY : NUAER ,NTRAER ,RCDAY ,R10E ,&
116 & REPLOG ,REPSC ,REPSCO ,REPSCQ ,REPSCT ,&
117 & REPSCW ,DIFF
118 USE YOEAERD , ONLY : CVDAES ,CVDAEL ,CVDAEU ,CVDAED ,&
119 & RCAEOPS ,RCAEOPL ,RCAEOPU ,RCAEOPD ,RCTRBGA ,&
120 & RCVOBGA ,RCSTBGA ,RCTRPT ,RCAEADM ,RCAEROS , &
121 & RCAEADK
122 USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV
123
124 USE YOMMP , ONLY : MYPROC ,NPRCIDS ,LSPLIT ,NAPSETS ,&
125 & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
126 & NSTA,NONL,NPTRFRSTLAT,NFRSTLAT,NLSTLAT ,&
127 & MY_REGION_NS ,MY_REGION_EW ,NGLOBALINDEX ,&
128 & NRISTA ,NRIONL ,NRIOFF ,NRIEXT ,NRICORE ,&
129 & NRISENDPOS ,NRIRECVPOS ,NRISENDPTR ,NRIRECVPTR ,&
130 & NARIB1 ,NRIPROCS ,NRIMPBUFSZ,NRISPT ,NRIRPT ,&
131 & NRICOMM ,&
132 & NROSTA ,NROONL ,NROOFF ,NROEXT ,NROCORE ,&
133 & NROSENDPOS ,NRORECVPOS ,NROSENDPTR ,NRORECVPTR ,&
134 & NAROB1 ,NROPROCS ,NROMPBUFSZ,NROSPT ,NRORPT ,&
135 & NROCOMM
136 USE YOMGC , ONLY : GELAT ,GELAM
137 USE YOMLEG , ONLY : RMU ,RSQM2
138 USE YOMSC2 , ONLY : &
139 & NRIWIDEN ,NRIWIDES ,NRIWIDEW ,NRIWIDEE,&
140 & NROWIDEN ,NROWIDES ,NROWIDEW ,NROWIDEE
141 USE YOMGEM , ONLY : NGPTOT ,NGPTOTG ,NGPTOTMX ,NLOENG
142 USE YOMTAG , ONLY : MTAGRAD
143 USE YOMPRAD , ONLY : LODBGRADI,LODBGRADL ,RADGRID ,&
144 & LRADONDEM
145 USE YOMRADF , ONLY : EMTD ,TRSW ,EMTC ,TRSC ,&
146 & SRSWD ,SRLWD ,SRSWDCS ,SRLWDCS ,SRSWDV ,&
147 & SRSWDUV ,EDRO ,SRSWPAR ,SRSWUVB ,SRSWPARC, SRSWTINC,&
148 & EMTU, RMOON
149 ! Commente par MPL 26.11.08
150 !USE YOPHNC , ONLY : LERADN2
151 ! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE
152 !USE MPL_MODULE , ONLY : MPL_BROADCAST, MPL_SEND, MPL_RECV
153 USE YOM_YGFL , ONLY : YO3
154 !!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90
155 USE YOMDYN , ONLY : NDLNPR
156
157 IMPLICIT NONE
158
159 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
160 INTEGER(KIND=JPIM),INTENT(IN) :: KULOUT
161 REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1)
162 ! LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
163 INTEGER(KIND=JPIM) :: NRGRI(JPMXGL)
164
165 INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL
166 INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN
167 INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON
168 INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN
169 INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU
170 INTEGER(KIND=JPIM) :: J,JROC,IGPTOT
171 INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE
172 INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE
173 INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX
174 INTEGER(KIND=JPIM) :: IWIDE(10)
175 INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C
176 INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5
177 INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV
178
179 LOGICAL :: LLINEAR_GRID
180 LOGICAL :: LLDEBUG,LLP
181
182 REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
183 REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON
184 REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON
185 REAL(KIND=JPRB) :: ZLAT
186 !REAL(KIND=JPRB) :: RLATVOL, RLONVOL
187
188 CHARACTER (LEN = 300) :: CLFN
189 INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1
190
191 INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:)
192 INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:)
193 INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:)
194 INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:)
195 INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:)
196 INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:)
197 INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:)
198 INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:)
199 INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:)
200 INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:)
201 INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:)
202 INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:)
203 INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:)
204
205 REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:)
206 REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:)
207 REAL(KIND=JPRB) :: ZHOOK_HANDLE
208
209 INTERFACE
210 SUBROUTINE SETUP_TRANS(KSMAX,KDGL,KLOEN,LDLINEAR_GRID,LDSPLIT,&
211 &KAPSETS,KTMAX,KRESOL)
212
213 !**** *SETUP_TRANS* - Setup transform package for specific resolution
214
215 ! Purpose.
216 ! --------
217 ! To setup for making spectral transforms. Each call to this routine
218 ! creates a new resolution up to a maximum of NMAX_RESOL set up in
219 ! SETUP_TRANS0. You need to call SETUP_TRANS0 before this routine can
220 ! be called.
221
222 !** Interface.
223 ! ----------
224 ! CALL SETUP_TRANS(...)
225
226 ! Explicit arguments : KLOEN,LDLINEAR_GRID,LDSPLIT,KAPSETS are optional arguments
227 ! --------------------
228 ! KSMAX - spectral truncation required
229 ! KDGL - number of Gaussian latitudes
230 ! KLOEN(:) - number of points on each Gaussian latitude [2*KDGL]
231 ! LDSPLIT - true if split latitudes in grid-point space [false]
232 ! LDLINEAR_GRID - true if linear grid
233 ! KAPSETS - Number of apple sets in the distribution [0]
234 ! KTMAX - truncation order for tendencies?
235 ! KRESOL - the resolution identifier
236
237 ! KSMAX,KDGL,KTMAX and KLOEN are GLOBAL variables desribing the resolution
238 ! in spectral and grid-point space
239
240 ! LDSPLIT and KAPSETS describe the distribution among processors of
241 ! grid-point data and has no relevance if you are using a single processor
242
243 ! Method.
244 ! -------
245
246 ! Externals. SET_RESOL - set resolution
247 ! ---------- SETUP_DIMS - setup distribution independent dimensions
248 ! SUMP_TRANS_PRELEG - first part of setup of distr. environment
249 ! SULEG - Compute Legandre polonomial and Gaussian
250 ! Latitudes and Weights
251 ! SETUP_GEOM - Compute arrays related to grid-point geometry
252 ! SUMP_TRANS - Second part of setup of distributed environment
253 ! SUFFT - setup for FFT
254
255 ! Author.
256 ! -------
257 ! Mats Hamrud *ECMWF*
258
259 ! Modifications.
260 ! --------------
261 ! Original : 00-03-03
262
263 ! ------------------------------------------------------------------
264
265 USE PARKIND1 ,ONLY : JPIM ,JPRB
266
267 IMPLICIT NONE
268
269 ! Dummy arguments
270
271 INTEGER(KIND=JPIM) ,INTENT(IN) :: KSMAX,KDGL
272 INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KLOEN(:)
273 LOGICAL ,OPTIONAL,INTENT(IN) :: LDLINEAR_GRID
274 LOGICAL ,OPTIONAL,INTENT(IN) :: LDSPLIT
275 INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KAPSETS
276 INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(IN) :: KTMAX
277 INTEGER(KIND=JPIM) ,OPTIONAL,INTENT(OUT):: KRESOL
278
279
280 END SUBROUTINE SETUP_TRANS
281
282
283 SUBROUTINE TRANS_INQ(KRESOL,KSPEC,KSPEC2,KSPEC2G,KSPEC2MX,KNUMP,&
284 &KGPTOT,KGPTOTG,KGPTOTMX,KGPTOTL,&
285 &KMYMS,KASM0,KUMPP,KPOSSP,KPTRMS,KALLMS,KDIM0G,&
286 &KFRSTLAT,KLSTLAT,KFRSTLOFF,KPTRLAT,&
287 &KPTRFRSTLAT,KPTRLSTLAT,KPTRFLOFF,KSTA,KONL,&
288 &KULTPP,KPTRLS,&
289 &LDSPLITLAT,&
290 &PMU,PGW,PRPNM,KLEI3,KSPOLEGL,KPMS)
291
292 !**** *TRANS_INQ* - Extract information from the transform package
293
294 ! Purpose.
295 ! --------
296 ! Interface routine for extracting information from the T.P.
297
298 !** Interface.
299 ! ----------
300 ! CALL TRANS_INQ(...)
301 ! Explicit arguments : All arguments are optional.
302 ! --------------------
303 ! KRESOL - resolution tag for which info is required ,default is the
304 ! first defined resulution (input)
305
306 ! SPECTRAL SPACE
307 ! KSPEC - number of complex spectral coefficients on this PE
308 ! KSPEC2 - 2*KSPEC
309 ! KSPEC2G - global KSPEC2
310 ! KSPEC2MX - maximun KSPEC2 among all PEs
311 ! KNUMP - Number of spectral waves handled by this PE
312 ! KGPTOT - Total number of grid columns on this PE
313 ! KGPTOTG - Total number of grid columns on the Globe
314 ! KGPTOTMX - Maximum number of grid columns on any of the PEs
315 ! KGPTOTL - Number of grid columns one each PE (dimension NPRGPNS:NPRGPEW)
316 ! KMYMS - This PEs spectral zonal wavenumbers
317 ! KASM0 - Address in a spectral array of (m, n=m)
318 ! KUMPP - No. of wave numbers each wave set is responsible for
319 ! KPOSSP - Defines partitioning of global spectral fields among PEs
320 ! KPTRMS - Pointer to the first wave number of a given a-set
321 ! KALLMS - Wave numbers for all wave-set concatenated together
322 ! to give all wave numbers in wave-set order
323 ! KDIM0G - Defines partitioning of global spectral fields among PEs
324
325 ! GRIDPOINT SPACE
326 ! KFRSTLAT - First latitude of each a-set in grid-point space
327 ! KLSTTLAT - Last latitude of each a-set in grid-point space
328 ! KFRSTLOFF - Offset for first lat of own a-set in grid-point space
329 ! KPTRLAT - Pointer to the start of each latitude
330 ! KPTRFRSTLAT - Pointer to the first latitude of each a-set in
331 ! NSTA and NONL arrays
332 ! KPTRLSTLAT - Pointer to the last latitude of each a-set in
333 ! NSTA and NONL arrays
334 ! KPTRFLOFF - Offset for pointer to the first latitude of own a-set
335 ! NSTA and NONL arrays, i.e. nptrfrstlat(myseta)-1
336 ! KSTA - Position of first grid column for the latitudes on a
337 ! processor. The information is available for all processors.
338 ! The b-sets are distinguished by the last dimension of
339 ! nsta().The latitude band for each a-set is addressed by
340 ! nptrfrstlat(jaset),nptrlstlat(jaset), and
341 ! nptrfloff=nptrfrstlat(myseta) on this processors a-set.
342 ! Each split latitude has two entries in nsta(,:) which
343 ! necessitates the rather complex addressing of nsta(,:)
344 ! and the overdimensioning of nsta by nprgpns.
345 ! KONL - Number of grid columns for the latitudes on a processor.
346 ! Similar to nsta() in data structure.
347 ! LDSPLITLAT - TRUE if latitude is split in grid point space over
348 ! two a-sets
349
350 ! FOURIER SPACE
351 ! KULTPP - number of latitudes for which each a-set is calculating
352 ! the FFT's.
353 ! KPTRLS - pointer to first global latitude of each a-set for which
354 ! it performs the Fourier calculations
355
356 ! LEGENDRE
357 ! PMU - sin(Gaussian latitudes)
358 ! PGW - Gaussian weights
359 ! PRPNM - Legendre polynomials
360 ! KLEI3 - First dimension of Legendre polynomials
361 ! KSPOLEGL - Second dimension of Legendre polynomials
362 ! KPMS - Adress for legendre polynomial for given M (NSMAX)
363
364 ! Method.
365 ! -------
366
367 ! Externals. SET_RESOL - set resolution
368 ! ----------
369
370 ! Author.
371 ! -------
372 ! Mats Hamrud *ECMWF*
373
374 ! Modifications.
375 ! --------------
376 ! Original : 00-03-03
377 ! M. Hortal : 2001-03-05 Dimensions of the Legendre polynomials
378
379 ! ------------------------------------------------------------------
380
381 USE PARKIND1 ,ONLY : JPIM ,JPRB
382
383
384 IMPLICIT NONE
385
386 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(IN) :: KRESOL
387
388 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC
389 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2
390 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2G
391 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPEC2MX
392 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KNUMP
393 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOT
394 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTG
395 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTMX
396 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KGPTOTL(:,:)
397 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLOFF
398 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFLOFF
399
400 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KMYMS(:)
401 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KASM0(0:)
402 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KUMPP(:)
403 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPOSSP(:)
404 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRMS(:)
405 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KALLMS(:)
406 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KDIM0G(0:)
407 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KFRSTLAT(:)
408 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLSTLAT(:)
409 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLAT(:)
410 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRFRSTLAT(:)
411 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLSTLAT(:)
412 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSTA(:,:)
413 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KONL(:,:)
414 LOGICAL ,OPTIONAL, INTENT(OUT) :: LDSPLITLAT(:)
415
416 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KULTPP(:)
417 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPTRLS(:)
418
419 REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PMU(:)
420 REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PGW(:)
421 REAL(KIND=JPRB) ,OPTIONAL, INTENT(OUT) :: PRPNM(:,:)
422 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KLEI3
423 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KSPOLEGL
424 INTEGER(KIND=JPIM) ,OPTIONAL, INTENT(OUT) :: KPMS(0:)
425
426
427 END SUBROUTINE TRANS_INQ
428
429
430
431
432
433
434 END INTERFACE
435
436 INTERFACE
437 SUBROUTINE ABOR1(CDTEXT)
438 CHARACTER(LEN=*) :: CDTEXT
439 END SUBROUTINE ABOR1
440 END INTERFACE
441 INTERFACE
442 SUBROUTINE POSNAM(KULNAM,CDNAML)
443 USE PARKIND1 ,ONLY : JPIM ,JPRB
444 INTEGER(KIND=JPIM),INTENT(IN) :: KULNAM
445 CHARACTER(LEN=*) ,INTENT(IN) :: CDNAML
446 END SUBROUTINE POSNAM
447 END INTERFACE
448 INTERFACE
449 SUBROUTINE RRTM_INIT_140GP
450 END SUBROUTINE RRTM_INIT_140GP
451 END INTERFACE
452
453 INTERFACE
454 SUBROUTINE RDCSET(CDSL,KSLWIDEN,KSLWIDES,KSLWIDEW,KSLWIDEE,&
455 & KSLRPTSUR,KSLSPTSUR,&
456 & KDGLG,KDLON,KDGSAG,KDGENG,KDGUXL,KDGUXG,KDGSAL,KDGENL,&
457 & KDSUR1,KDLSUR,KDGSUR,KGPTOT,KGPTOT_CAP,&
458 & KPTRFLOFF,KFRSTLOFF,KYFRSTACTLAT,KYLSTACTLAT,&
459 & KSTA,KONL,KLOENG,KPTRFRSTLAT,KFRSTLAT,KLSTLAT,&
460 & PMU,PSQM2,&
461 & KSLSTA,KSLONL,KSLOFF,KSLEXT,KSLCORE,KASLB1,&
462 & KSLPROCS,KSLMPBUFSZ,KSLRPT,KSLSPT,&
463 & KSLSENDPOS,KSLRECVPOS,KSENDPTR,KRECVPTR,KSLCOMM,KMAP,KMAPLEN)
464 USE PARKIND1 ,ONLY : JPIM ,JPRB
465 USE YOMCT0 , ONLY : NPROC ,NPRINTLEV,LOUTPUT ,LMPDIAG ,LALLOPR ,&
466 & LELAM ,N_REGIONS_NS ,N_REGIONS_EW
467 INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDEN
468 INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDES
469 INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDEW
470 INTEGER(KIND=JPIM),INTENT(IN) :: KSLWIDEE
471 INTEGER(KIND=JPIM),INTENT(IN) :: KSLRPTSUR
472 INTEGER(KIND=JPIM),INTENT(IN) :: KSLSPTSUR
473 INTEGER(KIND=JPIM),INTENT(IN) :: KDGLG
474 INTEGER(KIND=JPIM),INTENT(IN) :: KDLON
475 INTEGER(KIND=JPIM),INTENT(IN) :: KDGSAG
476 INTEGER(KIND=JPIM),INTENT(IN) :: KDGENG
477 INTEGER(KIND=JPIM),INTENT(IN) :: KDGSAL
478 INTEGER(KIND=JPIM),INTENT(IN) :: KDGENL
479 INTEGER(KIND=JPIM),INTENT(IN) :: KGPTOT
480 CHARACTER(LEN=2) ,INTENT(IN) :: CDSL
481 INTEGER(KIND=JPIM),INTENT(IN) :: KDGUXL
482 INTEGER(KIND=JPIM),INTENT(IN) :: KDGUXG
483 INTEGER(KIND=JPIM),INTENT(IN) :: KDSUR1
484 INTEGER(KIND=JPIM),INTENT(IN) :: KDLSUR
485 INTEGER(KIND=JPIM),INTENT(IN) :: KDGSUR
486 INTEGER(KIND=JPIM),INTENT(IN) :: KGPTOT_CAP
487 INTEGER(KIND=JPIM),INTENT(IN) :: KPTRFLOFF
488 INTEGER(KIND=JPIM),INTENT(IN) :: KFRSTLOFF
489 INTEGER(KIND=JPIM),INTENT(IN) :: KYFRSTACTLAT
490 INTEGER(KIND=JPIM),INTENT(IN) :: KYLSTACTLAT
491 INTEGER(KIND=JPIM),INTENT(IN) :: KSTA(KDGSAG:KDGENG+N_REGIONS_NS-1,N_REGIONS_EW)
492 INTEGER(KIND=JPIM),INTENT(IN) :: KONL(KDGSAG:KDGENG+N_REGIONS_NS-1,N_REGIONS_EW)
493 INTEGER(KIND=JPIM),INTENT(IN) :: KLOENG(KDGSAG:KDGENG)
494 INTEGER(KIND=JPIM),INTENT(IN) :: KPTRFRSTLAT(N_REGIONS_NS)
495 INTEGER(KIND=JPIM),INTENT(IN) :: KFRSTLAT(N_REGIONS_NS)
496 INTEGER(KIND=JPIM),INTENT(IN) :: KLSTLAT(N_REGIONS_NS)
497 REAL(KIND=JPRB) ,INTENT(IN) :: PMU(KDGSAG:KDGENG)
498 REAL(KIND=JPRB) ,INTENT(IN) :: PSQM2(KDGSAG:KDGENG)
499 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLSTA(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES)
500 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLONL(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES)
501 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLOFF(KDGSAL-KSLWIDEN:KDGENL+KSLWIDES)
502 INTEGER(KIND=JPIM),INTENT(OUT) :: KSLEXT(1-KDLON:KDLON+KDLON,1-KSLWIDEN:KDGENL+KSLWIDES)
503 INTEGER(KIND=JPIM),INTENT(OUT) :: KSLCORE(KGPTOT)
504 INTEGER(KIND=JPIM),INTENT(INOUT) :: KASLB1
505 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLPROCS
506 INTEGER(KIND=JPIM),INTENT(OUT) :: KSLMPBUFSZ
507 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLRPT
508 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLSPT
509 INTEGER(KIND=JPIM),INTENT(OUT) :: KSLSENDPOS(KSLSPTSUR)
510 INTEGER(KIND=JPIM),INTENT(OUT) :: KSLRECVPOS(KSLRPTSUR)
511 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSENDPTR(NPROC+1)
512 INTEGER(KIND=JPIM),INTENT(INOUT) :: KRECVPTR(NPROC+1)
513 INTEGER(KIND=JPIM),INTENT(INOUT) :: KSLCOMM(NPROC)
514 INTEGER(KIND=JPIM),INTENT(OUT) :: KMAP(4,KDGLG)
515 INTEGER(KIND=JPIM),INTENT(OUT) :: KMAPLEN
516 END SUBROUTINE RDCSET
517 END INTERFACE
518 INTERFACE
519 SUBROUTINE SUAERH
520 END SUBROUTINE SUAERH
521 END INTERFACE
522 INTERFACE
523 SUBROUTINE SUAERL
524 END SUBROUTINE SUAERL
525 END INTERFACE
526 INTERFACE
527 SUBROUTINE SUAERSN (KTSW, KSW)
528 USE PARKIND1 ,ONLY : JPIM ,JPRB
529 INTEGER(KIND=JPIM),INTENT(IN) :: KTSW
530 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
531 END SUBROUTINE SUAERSN
532 END INTERFACE
533 INTERFACE
534 SUBROUTINE SUAERV&
535 & ( KLEV , PETAH,&
536 & PVDAES, PVDAEL, PVDAEU, PVDAED,&
537 & PTRBGA, PVOBGA, PSTBGA, PAEOPS, PAEOPL, PAEOPU,&
538 & PAEOPD, PTRPT , PAEADK, PAEADM, PAEROS&
539 & )
540 USE PARKIND1 ,ONLY : JPIM ,JPRB
541 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
542 REAL(KIND=JPRB) ,INTENT(IN) :: PETAH(KLEV+1)
543 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAES(KLEV+1)
544 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEL(KLEV+1)
545 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAEU(KLEV+1)
546 REAL(KIND=JPRB) ,INTENT(OUT) :: PVDAED(KLEV+1)
547 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRBGA
548 REAL(KIND=JPRB) ,INTENT(OUT) :: PVOBGA
549 REAL(KIND=JPRB) ,INTENT(OUT) :: PSTBGA
550 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPS
551 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPL
552 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPU
553 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEOPD
554 REAL(KIND=JPRB) ,INTENT(OUT) :: PTRPT
555 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEADK(3)
556 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEADM
557 REAL(KIND=JPRB) ,INTENT(OUT) :: PAEROS
558 END SUBROUTINE SUAERV
559 END INTERFACE
560 INTERFACE
561 SUBROUTINE SUCLOPN (KTSW, KSW, KLEV)
562 USE PARKIND1 ,ONLY : JPIM ,JPRB
563 INTEGER(KIND=JPIM),INTENT(IN) :: KTSW
564 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
565 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
566 END SUBROUTINE SUCLOPN
567 END INTERFACE
568 INTERFACE
569 SUBROUTINE SUECRADI
570 END SUBROUTINE SUECRADI
571 END INTERFACE
572 INTERFACE
573 SUBROUTINE SUECRADL
574 !USE MPL_MODULE
575 END SUBROUTINE SUECRADL
576 END INTERFACE
577 INTERFACE
578 SUBROUTINE SULWN
579 END SUBROUTINE SULWN
580 END INTERFACE
581 INTERFACE
582 SUBROUTINE SULWNEUR(KLEV)
583 USE PARKIND1 ,ONLY : JPIM ,JPRB
584 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
585 END SUBROUTINE SULWNEUR
586 END INTERFACE
587 INTERFACE
588 SUBROUTINE SUOVLP ( KLEV )
589 USE PARKIND1 ,ONLY : JPIM ,JPRB
590 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
591 END SUBROUTINE SUOVLP
592 END INTERFACE
593 INTERFACE
594 SUBROUTINE SURDI
595 END SUBROUTINE SURDI
596 END INTERFACE
597 INTERFACE
598 SUBROUTINE SURRTAB
599 END SUBROUTINE SURRTAB
600 END INTERFACE
601 INTERFACE
602 SUBROUTINE SURRTFTR
603 END SUBROUTINE SURRTFTR
604 END INTERFACE
605 INTERFACE
606 SUBROUTINE SURRTPK
607 END SUBROUTINE SURRTPK
608 END INTERFACE
609 INTERFACE
610 SUBROUTINE SURRTRF
611 END SUBROUTINE SURRTRF
612 END INTERFACE
613 INTERFACE
614 SUBROUTINE SUSAT
615 END SUBROUTINE SUSAT
616 END INTERFACE
617 INTERFACE
618 SUBROUTINE SUSWN (KTSW, KSW)
619 USE PARKIND1 ,ONLY : JPIM ,JPRB
620 INTEGER(KIND=JPIM),INTENT(IN) :: KTSW
621 INTEGER(KIND=JPIM),INTENT(IN) :: KSW
622 END SUBROUTINE SUSWN
623 END INTERFACE
624 INTERFACE
625 SUBROUTINE SUSRTAER
626 END SUBROUTINE SUSRTAER
627 END INTERFACE
628 INTERFACE
629 SUBROUTINE SRTM_INIT
630 END SUBROUTINE SRTM_INIT
631 END INTERFACE
632 INTERFACE
633 SUBROUTINE SUSRTCOP
634 END SUBROUTINE SUSRTCOP
635 END INTERFACE
636 INTERFACE
637 SUBROUTINE SU_AERW
638 END SUBROUTINE SU_AERW
639 END INTERFACE
640 INTERFACE
641 SUBROUTINE SU_UVRAD ( KUV )
642 USE PARKIND1 ,ONLY : JPIM ,JPRB
643 INTEGER(KIND=JPIM),INTENT(IN) :: KUV
644 END SUBROUTINE SU_UVRAD
645 END INTERFACE
646 INTERFACE
647 SUBROUTINE SU_MCICA
648 END SUBROUTINE SU_MCICA
649 END INTERFACE
650
651 ! ----------------------------------------------------------------
652
653 ! -----------------------------------------------------------------
654 NAMELIST/NAERAD/&
655 & LERAD1H, LERADHS, LEPO3RA, LRADLB , LONEWSW &
656 &, LCCNL , LCCNO , LECSRAD, LRAYL , LRRTM , LSRTM &
657 &, LHVOLCA, LNEWAER, LDIFFC , LNOTROAER &
658 &, LRADONDEM &
659 &, NICEOPT, NLIQOPT, NMCICA , NRADIP , NRADLP &
660 &, NAER , NMODE , NOZOCL , NINHOM , NLAYINH &
661 &, NOVLP , NLW , NSW , NRADFR , NLNGR1H &
662 &, NRADPFR, NRADPLA, NRINT , NRPROMA, NCSRADF &
663 &, NRADINT, NRADRES, CRTABLEDIR, CRTABLEFIL &
664 &, RCCNSEA, RCCNLND, NPERTAER, NPERTOZ &
665 &, RPERTOZ, RLWINHF, RSWINHF, RRe2De &
666 &, RCCO2 , RCCH4 , RCN2O , RCCFC11, RCCFC12 &
667 &, NHINCSOL,LECO2VAR,LHGHG , NSCEN &
668 &, LEDBUG &
669 &, LUVPROC, LUVTDEP, LUVDBG , NUV , NUVTIM , NRADUV , RUVLAM, RMUZUV
670 ! -----------------------------------------------------------------
671
672
673
674 !-----------------------------------------------------------------------------
675
676 NAMELIST/NAMRGRI/NRGRI
677
678 !-----------------------------------------------------------------------------
679
680 !MPL/IM 20160915 on prend GES de phylmd
681 ! $Id: clesphys.h 3435 2019-01-22 15:21:59Z fairhead $
682 !
683 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
684 ! veillez \`a n'utiliser que des ! pour les commentaires
685 ! et \`a bien positionner les & des lignes de continuation
686 ! (les placer en colonne 6 et en colonne 73)
687 !
688 !..include cles_phys.h
689 !
690 INTEGER iflag_cycle_diurne
691 LOGICAL soil_model,new_oliq,ok_orodr,ok_orolf
692 LOGICAL ok_limitvrai
693 LOGICAL ok_all_xml
694 LOGICAL ok_lwoff
695 INTEGER nbapp_rad, iflag_con, nbapp_cv, nbapp_wk, iflag_ener_conserv
696 REAL co2_ppm, co2_ppm0, solaire
697 !FC
698 REAL Cd_frein
699 LOGICAL ok_suntime_rrtm
700 REAL(kind=8) RCO2, RCH4, RN2O, RCFC11, RCFC12
701 REAL(kind=8) RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act
702 REAL(kind=8) CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt
703 !IM ajout CFMIP2/CMIP5
704 REAL(kind=8) RCO2_per,RCH4_per,RN2O_per,RCFC11_per,RCFC12_per
705 REAL(kind=8) CH4_ppb_per,N2O_ppb_per,CFC11_ppt_per,CFC12_ppt_per
706
707 !OM ---> correction du bilan d'eau global
708 !OM Correction sur precip KE
709 REAL cvl_corr
710 !OM Fonte calotte dans bilan eau
711 LOGICAL ok_lic_melt
712 !OB Depot de vapeur d eau sur la calotte pour le bilan eau
713 LOGICAL ok_lic_cond
714
715 !IM simulateur ISCCP
716 INTEGER top_height, overlap
717 !IM seuils cdrm, cdrh
718 REAL cdmmax, cdhmax
719 !IM param. stabilite s/ terres et en dehors
720 REAL ksta, ksta_ter, f_ri_cd_min
721 !IM ok_kzmin : clef calcul Kzmin dans la CL de surface cf FH
722 LOGICAL ok_kzmin
723 !IM, MAFo fmagic, pmagic : parametres - additionnel et multiplicatif -
724 ! pour regler l albedo sur ocean
725 REAL pbl_lmixmin_alpha
726 REAL fmagic, pmagic
727 ! Hauteur (imposee) du contenu en eau du sol
728 REAL qsol0,albsno0,evap0
729 ! Frottement au sol (Cdrag)
730 Real f_cdrag_ter,f_cdrag_oce
731 REAL min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce
732 REAL z0m_seaice,z0h_seaice
733 INTEGER iflag_gusts,iflag_z0_oce
734
735 ! Rugoro
736 Real f_rugoro,z0min
737
738 ! tau_gl : constante de rappel de la temperature a la surface de la glace
739 REAL tau_gl
740
741 !IM lev_histhf : niveau sorties 6h
742 !IM lev_histday : niveau sorties journalieres
743 !IM lev_histmth : niveau sorties mensuelles
744 !IM lev_histdayNMC : on peut sortir soit sur 8 (comme AR5) ou bien
745 ! sur 17 niveaux de pression
746 INTEGER lev_histhf, lev_histday, lev_histmth
747 INTEGER lev_histdayNMC
748 Integer lev_histins, lev_histLES
749 !IM ok_histNMC : sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
750 !IM freq_outNMC : frequences de sortie fichiers niveaux de pression (histmthNMC, histdayNMC, histhfNMC)
751 !IM freq_calNMC : frequences de calcul fis. hist*NMC.nc
752 LOGICAL ok_histNMC(3)
753 INTEGER levout_histNMC(3)
754 REAL freq_outNMC(3) , freq_calNMC(3)
755 CHARACTER(len=4) type_run
756 ! aer_type: pour utiliser un fichier constant dans readaerosol
757 CHARACTER(len=8) :: aer_type
758 LOGICAL ok_regdyn
759 REAL lonmin_ins, lonmax_ins, latmin_ins, latmax_ins
760 REAL ecrit_ins, ecrit_hf, ecrit_day
761 REAL ecrit_mth, ecrit_tra, ecrit_reg
762 REAL ecrit_LES
763 REAL freq_ISCCP, ecrit_ISCCP
764 REAL freq_COSP, freq_AIRS
765 LOGICAL :: ok_cosp,ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP
766 LOGICAL :: ok_airs
767 INTEGER :: ip_ebil_phy, iflag_rrtm, iflag_ice_thermo, NSW, iflag_albedo
768 LOGICAL :: ok_chlorophyll
769 LOGICAL :: ok_strato
770 LOGICAL :: ok_hines, ok_gwd_rando
771 LOGICAL :: ok_qch4
772 LOGICAL :: ok_conserv_q
773 LOGICAL :: adjust_tropopause
774 LOGICAL :: ok_daily_climoz
775 ! flag to bypass or not the phytrac module
776 INTEGER :: iflag_phytrac
777
778 COMMON/clesphys/ &
779 ! REAL FIRST
780 & co2_ppm, solaire &
781 & , RCO2, RCH4, RN2O, RCFC11, RCFC12 &
782 & , RCO2_act, RCH4_act, RN2O_act, RCFC11_act, RCFC12_act &
783 & , RCO2_per, RCH4_per, RN2O_per, RCFC11_per, RCFC12_per &
784 & , CH4_ppb, N2O_ppb, CFC11_ppt, CFC12_ppt &
785 & , CH4_ppb_per, N2O_ppb_per, CFC11_ppt_per, CFC12_ppt_per &
786 & , cdmmax,cdhmax,ksta,ksta_ter,f_ri_cd_min,pbl_lmixmin_alpha &
787 & , fmagic, pmagic &
788 & , f_cdrag_ter,f_cdrag_oce,f_rugoro,z0min,tau_gl &
789 & , min_wind_speed,f_gust_wk,f_gust_bl,f_qsat_oce,f_z0qh_oce &
790 & , z0m_seaice,z0h_seaice &
791 & , freq_outNMC, freq_calNMC &
792 & , lonmin_ins, lonmax_ins, latmin_ins, latmax_ins &
793 & , freq_ISCCP, ecrit_ISCCP, freq_COSP, freq_AIRS &
794 & , cvl_corr &
795 & , qsol0,albsno0,evap0 &
796 & , co2_ppm0 &
797 !FC
798 & , Cd_frein &
799 & , ecrit_LES &
800 & , ecrit_ins, ecrit_hf, ecrit_day &
801 & , ecrit_mth, ecrit_tra, ecrit_reg &
802 ! THEN INTEGER AND LOGICALS
803 & , top_height &
804 & , iflag_cycle_diurne, soil_model, new_oliq &
805 & , ok_orodr, ok_orolf, ok_limitvrai, nbapp_rad &
806 & , iflag_con, nbapp_cv, nbapp_wk &
807 & , iflag_ener_conserv &
808 & , ok_suntime_rrtm &
809 & , overlap &
810 & , ok_kzmin &
811 & , lev_histhf, lev_histday, lev_histmth &
812 & , lev_histins, lev_histLES, lev_histdayNMC, levout_histNMC &
813 & , ok_histNMC &
814 & , type_run, ok_regdyn, ok_cosp, ok_airs &
815 & , ok_mensuelCOSP,ok_journeCOSP,ok_hfCOSP &
816 & , ip_ebil_phy &
817 & , iflag_gusts ,iflag_z0_oce &
818 & , ok_lic_melt, ok_lic_cond, aer_type &
819 & , iflag_rrtm, ok_strato,ok_hines, ok_qch4 &
820 & , iflag_ice_thermo, ok_gwd_rando, NSW, iflag_albedo &
821 & , ok_chlorophyll,ok_conserv_q, adjust_tropopause &
822 & , ok_daily_climoz, ok_all_xml, ok_lwoff &
823 & , iflag_phytrac
824
825 save /clesphys/
826 !$OMP THREADPRIVATE(/clesphys/)
827
828 !* 1. INITIALIZE NEUROFLUX LONGWAVE RADIATION
829 ! ---------------------------------------
830
831
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LHOOK) CALL DR_HOOK('SUECRAD',0,ZHOOK_HANDLE)
832 !CALL GSTATS(1818,0) MPL 2.12.08
833 !IF (LERADN2) THEN
834 ! CALL SULWNEUR(KLEV)
835 !ENDIF
836
837 !* 2. SET DEFAULT VALUES.
838 ! -------------------
839
840 !* 2.1 PRESET INDICES IN *YOERAD*
841 ! --------------------------
842
843 1 LERAD1H=.FALSE.
844 1 NLNGR1H=6
845
846 1 LERADHS=.TRUE.
847 1 LONEWSW=.TRUE.
848 1 LECSRAD=.FALSE.
849
850 !LE4ALB=.FALSE.
851 !This is read from SU0PHY in NAEPHY and put in YOEPHY
852
853 !- default setting of cloud optical properties
854 ! liquid water cloud 0: Fouquart (SW), Smith-Shi (LW)
855 ! 1: Slingo (SW), Savijarvi (LW)
856 ! 2: Slingo (SW), Lindner-Li (LW)
857 ! ice water cloud 0: Ebert-Curry (SW), Smith-Shi (LW)
858 ! 1: Ebert-Curry (SW), Ebert-Curry (LW)
859 ! 2: Fu-Liou'93 (SW), Fu-Liou'93 (LW)
860 ! 3: Fu'96 (SW), Fu et al'98 (LW)
861 1 NLIQOPT=2 ! before 3?R1 default=0 2
862 1 NICEOPT=3 ! before 3?R1 default=1 3
863
864 !- default setting of cloud effective radius/diameter
865 ! liquid water cloud 0: f(P) 10 to 45
866 ! 1: 13: ocean; 10: land
867 ! 2: Martin et al. CCN 50 over ocean, 900 over land
868 ! ice water cloud 0: 40 microns
869 ! 1: f(T) 40 to 130 microns
870 ! 2: f(T) 30 to 60
871 ! 3: f(T,IWC) Sun'01: 22.5 to 175 microns
872 ! conversion factor between effective radius and particle size for ice
873 1 NRADIP=3 ! before 3?R1 default=2 3
874 1 NRADLP=2 ! before 3?R1 default=2 2
875 1 print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP
876 1 RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB
877
878 !- RRTM as LW scheme
879 1 LRRTM = .FALSE.
880 1 LECMWF = .FALSE.
881
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (iflag_rrtm.EQ.1) THEN
882 1 LRRTM = .TRUE.
883 1 LECMWF = .TRUE.
884 ! LRRTM = .FALSE. ! Utiliser pour faire tourner le "vieux" rayonnement
885 ! LECMWF = .FALSE.
886 ENDIF
887
888 !LRRTM = .FALSE.
889
890 !- SRTM as SW scheme
891 !!!!! A REVOIR (MPL) verifier signification de LSRTM
892 1 LSRTM = .FALSE. ! before 3?R1 default was .FALSE. true
893
894 ! -- McICA treatment of cloud-radiation interactions
895 ! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA)
896 1 NMcICA = 2 ! 2 for generalized overlap
897
898 !- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns)
899 1 NINHOM = 0 ! before 3?R1 default=1
900 1 NLAYINH= 0
901 1 RLWINHF = 1.0_JPRB ! before 3?R1 default=0.7
902 1 RSWINHF = 1.0_JPRB ! before 3?R1 default=0.7
903 !- Diffusivity correction a la Savijarvi
904 1 LDIFFC = .FALSE. ! before 31R1 default=.FALSE.
905
906 !- history of volcanic aerosols
907 1 LHVOLCA=.FALSE.
908 !- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
909 1 LNEWAER=.TRUE.
910 !!! cpl LNOTROAER=.FALSE.
911 1 LNOTROAER=.TRUE.
912 1 NPERTAER=0
913
914 !- New Rayleigh formulation
915 1 LRAYL=.TRUE.
916
917 !- Number concentration of aerosols if specified
918 1 LCCNL=.TRUE. ! before 3?R1 default=.FALSE. true
919 1 LCCNO=.TRUE. ! before 3?R1 default=.FALSE. true
920 1 RCCNLND=900._JPRB ! before 3?R1 default=900. now irrelevant
921 1 RCCNSEA=50._JPRB ! before 3?R1 default=50. now irrelevant
922
923 !- interaction radiation / prognostic O3 off by default
924 1 LEPO3RA=.FALSE.
925 1 print *,'SUECRAD-0'
926
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (.NOT.YO3%LGP) THEN
927 1 LEPO3RA=.FALSE.
928 ENDIF
929 1 RPERTOZ=0._JPRB
930 1 NPERTOZ=0
931
932 !NAER: CONFIGURATION INDEX FOR AEROSOLS
933 !!!!! A REVOIR (MPL) a mettre dans un fichier .def
934 1 NAER =1
935 1 NMODE =0
936 1 NOZOCL =1
937 1 NRADFR =-3
938
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (NSMAX >= 511) NRADFR =-1
939 1 NRADPFR=0
940 1 NRADPLA=15
941
942 ! -- UV diagnostic of surface fluxes over the 280-400 nm interval
943 ! with up-to 24 values (5 nm wide spectral intervals)
944 1 LUVPROC=.FALSE.
945 1 LUVTDEP=.TRUE.
946 1 LUVDBG =.FALSE.
947 1 NRADUV =-3
948 1 NUVTIM = 0
949 1 NUV = 24
950 1 RMUZUV = 1.E-01_JPRB
951
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 1 times.
 25 DO JUV=1,NUV
952 25 RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB
953 ENDDO
954
955 !- radiation interpolation (George M's grid on by default)
956 LLDEBUG=.TRUE.
957 1 LEDBUG=.FALSE.
958 1 NRADINT=3
959 1 NRADRES=0
960
961 1 NRINT =4
962
963 1 LRADLB=.TRUE.
964 1 CRTABLEDIR='./'
965 1 CRTABLEFIL='not set'
966 1 LRADONDEM=.TRUE.
967 !GM Temporary as per trans/external/setup_trans.F90
968 1 LLINEAR_GRID=NSMAX > (NDLON+3)/3
969 IF( LLDEBUG )THEN
970 1 WRITE(NULOUT,'("SUECRAD: NSMAX=",I6)')NSMAX
971 1 WRITE(NULOUT,'("SUECRAD: NDLON=",I6)')NDLON
972 1 WRITE(NULOUT,'("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID
973 ENDIF
974
975 1 NUAER = 24
976 1 NTRAER = 15
977 ! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH)
978 ! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415)
979 ✗ SELECT CASE (overlap)
980 CASE (:1)
981 ✗ NOVLP = 2
982 CASE (2)
983 ✗ NOVLP = 3
984 CASE (3:)
985
1/3
✗ Branch 0 not taken.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
 1 NOVLP = 1
986 END SELECT
987 1 print *,'SUECRAD: NOVLP=',NOVLP
988 1 NLW = 16
989 1 NTSW = 14
990 !NSW = 6 !!!!! Maintenant dans config.def (MPL 20140213)
991 1 NSWNL = 6
992 1 NSWTL = 2
993 1 NCSRADF= 1
994
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF(NSMAX >= 106) THEN
995 ✗ NRPROMA = 80
996
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 ELSEIF(NSMAX == 63) THEN
997 ✗ NRPROMA=48
998 ELSE
999 1 NRPROMA=64
1000 ENDIF
1001
1002 !* 2.3 SET SECURITY PARAMETERS
1003 ! -----------------------
1004
1005 1 REPSC = 1.E-04_JPRB
1006 1 REPSCO = 1.E-12_JPRB
1007 1 REPSCQ = 1.E-12_JPRB
1008 1 REPSCT = 1.E-12_JPRB
1009 1 REPSCW = 1.E-12_JPRB
1010 1 REPLOG = 1.E-12_JPRB
1011
1012
1013 !* 2.4 BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
1014 ! -----------------------------------------------
1015
1016 1 LECO2VAR=.FALSE.
1017 1 LHGHG =.FALSE.
1018 1 NHINCSOL= 0
1019 1 NSCEN = 1
1020 1 RSOLINC = RI0
1021
1022 ! Valeurs d origine MPL 18052010
1023 !RCCO2 = 353.E-06_JPRB
1024 !RCCH4 = 1.72E-06_JPRB
1025 !RCN2O = 310.E-09_JPRB
1026 !RCCFC11 = 280.E-12_JPRB
1027 !RCCFC12 = 484.E-12_JPRB
1028
1029 ! Valeurs LMDZ (physiq.def) MPL 18052010
1030 !RCCO2 = 348.E-06_JPRB
1031 !RCCH4 = 1.65E-06_JPRB
1032 !RCN2O = 306.E-09_JPRB
1033 !RCCFC11 = 280.E-12_JPRB
1034 !RCCFC12 = 484.E-12_JPRB
1035
1036 !MPL/IM 20160915 on prend GES de phylmd
1037 1 RCCO2 = CO2_ppm * 1.0e-06
1038 1 RCCH4 = CH4_ppb * 1.0e-09
1039 1 RCN2O = N2O_ppb * 1.0e-09
1040 1 RCCFC11 = CFC11_ppt * 1.0e-12
1041 1 RCCFC12 = CFC12_ppt * 1.0e-12
1042 !print *,'LMDZSUECRAD-1 RCCO2=',RCCO2
1043 !print *,'LMDZSUECRAD-1 RCCH4=',RCCH4
1044 !print *,'LMDZSUECRAD-1 RCN2O=',RCN2O
1045 !print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11
1046 !print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12
1047 ! ------------------------------------------------------------------
1048
1049 !* 3. READ VALUES OF RADIATION CONFIGURATION
1050 ! --------------------------------------
1051
1052 !CALL POSNAM(NULNAM,'NAERAD')
1053 !READ (NULNAM,NAERAD)
1054 1 print *,'SUECRAD-2'
1055
1056 !CALL POSNAM(NULNAM,'NAEAER')
1057 !READ (NULNAM,NAEAER)
1058
1059 !IF (NTYPAER(9) /= 0) THEN
1060 ! RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB
1061 ! RGELAV=RLONVOL*RPI/180._JPRB
1062 ! RCLONV=COS(RGELAV)
1063 ! RSLONV=SIN(RGELAV)
1064 ! DO J=1,NGPTOT-1
1065 ! IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. &
1066 ! & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN
1067 ! RDGMUV=ABS( RMU(J+1) - RMU(J))
1068 ! RDGLAV=ABS( GELAM(J+1)-GELAM(J) )
1069 ! RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) )
1070 ! RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) )
1071 ! END IF
1072 ! END DO
1073 !END IF
1074
1075 !- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration)
1076
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (.NOT.LSRTM) THEN
1077 1 NMcICA = 0
1078 1 LCCNL = .FALSE.
1079 1 LCCNO = .FALSE.
1080 1 LDIFFC = .FALSE.
1081 1 NICEOPT= 1
1082 1 NLIQOPT= 0
1083 1 NRADIP = 4
1084 1 NRADLP = 3
1085 1 RRe2De = 0.5_JPRB
1086 1 NINHOM = 1
1087 1 RLWINHF= 0.7_JPRB
1088 1 RSWINHF= 0.7_JPRB
1089 ENDIF
1090 1 print *,'SUECRAD-3'
1091
1092 !- for McICA computations, make sure these parameters are as follows ...
1093
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (NMCICA /= 0) THEN
1094 ✗ NINHOM = 0
1095 ✗ RLWINHF= 1.0_JPRB
1096 ✗ RSWINHF= 1.0_JPRB
1097 !-- read the XCW values for Raisanen-Cole-Barker cloud generator
1098 ✗ CALL SU_McICA
1099 ENDIF
1100 1 print *,'SUECRAD-4'
1101
1102
1103
1104 IF( LLDEBUG )THEN
1105 1 WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT
1106 1 WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES
1107 ENDIF
1108
1109 ! DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA
1110
1111 1 LOPTRPROMA=NRPROMA > 0
1112 1 NRPROMA=ABS(NRPROMA)
1113
1114
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
 1 IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
1115 1 WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
1116 1 NRADINT=0
1117 ENDIF
1118
1119
1/8
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
 1 IF( NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA )THEN
1120 ! This combination is not supported as aerosol data would be
1121 ! required to be interpolated (see radintg)
1122 WRITE(NULOUT,'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",&
1123 ✗ & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")')
1124 ✗ NRADRES=NSMAX
1125 ENDIF
1126 !CALL GSTATS(1818,1) MPL 2.12.08
1127
1128 100 CONTINUE
1129
1130
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF( LERADI )THEN ! START OF LERADI BLOCK
1131
1132 ✗ IF( NRADINT == -1 )THEN
1133
1134 ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
1135
1136 ✗ LODBGRADI=.FALSE.
1137 ✗ CALL SUECRADI
1138
1139 ! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
1140 ! LOAD BALANCING
1141
1142 ✗ LODBGRADL=.FALSE.
1143 ! CALL SUECRADL ! MPL 1.12.08
1144 ✗ CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
1145
1146 ✗ ELSEIF( NRADINT == 0 )THEN
1147
1148 ✗ IF( NRADRES /= NSMAX )THEN
1149 ✗ WRITE(NULOUT,'("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")')
1150 ✗ NRADRES=NSMAX
1151 ENDIF
1152 ✗ RADGRID%NGPTOT=NGPTOT
1153
1154 ✗ NARIB1=0
1155 ✗ NAROB1=0
1156
1157 ✗ ELSEIF( NRADINT >=1 .AND. NRADINT <= 3 )THEN
1158
1159 ✗ NARIB1=0
1160 ✗ NAROB1=0
1161
1162 ! set the default radiation grid resolution for the current model resolution
1163 ! if not already specified
1164 ✗ IF( NRADRES == 0 )THEN
1165 ✗ IF( LLINEAR_GRID )THEN ! RATIO OF GRID-POINTS (MODEL/RAD)
1166 ✗ IF( NSMAX == 63 )THEN
1167 ✗ NRADRES=21 ! 3.62
1168 ✗ LLINEAR_GRID=.FALSE.
1169 ENDIF
1170 ✗ IF( NSMAX == 95 ) NRADRES= 95 ! 1.00
1171 ✗ IF( NSMAX == 159 ) NRADRES= 63 ! 5.84
1172 ✗ IF( NSMAX == 255 ) NRADRES= 95 ! 6.69
1173 ✗ IF( NSMAX == 319 ) NRADRES= 159 ! 3.87
1174 ✗ IF( NSMAX == 399 ) NRADRES= 159 ! 5.99
1175 ✗ IF( NSMAX == 511 ) NRADRES= 255 ! 3.92
1176 ✗ IF( NSMAX == 639 ) NRADRES= 319 ! 3.92
1177 ✗ IF( NSMAX == 799 ) NRADRES= 399 ! 3.94
1178 ✗ IF( NSMAX == 1023 ) NRADRES= 511 ! 3.94
1179 ✗ IF( NSMAX == 1279 ) NRADRES= 639 !
1180 ✗ IF( NSMAX == 2047 ) NRADRES= 1023 !
1181 ELSE ! NOT LINEAR GRID
1182 ✗ IF( NSMAX == 21 ) NRADRES= 21 ! 1.00
1183 ✗ IF( NSMAX == 42 ) NRADRES= 21 ! 3.62
1184 ✗ IF( NSMAX == 63 ) NRADRES= 42 ! 2.17
1185 ✗ IF( NSMAX == 106 ) NRADRES= 63 ! 2.69
1186 ✗ IF( NSMAX == 170 ) NRADRES= 63 ! 6.69
1187 ✗ IF( NSMAX == 213 ) NRADRES= 106 ! 3.87
1188 ✗ IF( NSMAX == 266 ) NRADRES= 106 ! 5.99
1189 ✗ IF( NSMAX == 341 ) NRADRES= 170 ! 3.92
1190 ✗ IF( NSMAX == 426 ) NRADRES= 213 ! 3.92
1191 ✗ IF( NSMAX == 533 ) NRADRES= 266 ! 3.94
1192 ✗ IF( NSMAX == 682 ) NRADRES= 341 ! 3.94
1193 ENDIF
1194 ENDIF
1195 ✗ print *,'SUECRAD-5'
1196
1197 ! test if radiation grid resolution has been set
1198 ✗ IF( NRADRES == 0 )THEN
1199 ✗ WRITE(NULOUT,'("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX
1200 ✗ CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND')
1201 ENDIF
1202
1203 ! test if no interpolation is required
1204 ✗ IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
1205 ✗ WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
1206 ✗ NRADINT=0
1207 ✗ GOTO 100
1208 ENDIF
1209
1210 ! CALL GSTATS(1818,0) MPL 2.12.08
1211 ✗ IF( CRTABLEFIL == 'not set' )THEN
1212 ✗ IF( LLINEAR_GRID )THEN
1213 ✗ IF( NRADRES < 1000 )THEN
1214 ✗ WRITE(CRTABLEFIL,'("rtablel_2",I3.3)')NRADRES
1215 ELSE
1216 ✗ WRITE(CRTABLEFIL,'("rtablel_2",I4.4)')NRADRES
1217 ENDIF
1218 ELSE
1219 ✗ IF( NRADRES < 1000 )THEN
1220 ✗ WRITE(CRTABLEFIL,'("rtable_2" ,I3.3)')NRADRES
1221 ELSE
1222 ✗ WRITE(CRTABLEFIL,'("rtable_2" ,I4.4)')NRADRES
1223 ENDIF
1224 ENDIF
1225 ENDIF
1226 ! CALL GSTATS(1818,1) MPL 2.12.08
1227
1228 ✗ RADGRID%NSMAX=NRADRES
1229
1230 ✗ IF( MYPROC == JPIOMASTER )THEN
1231 ✗ IDIR=LEN_TRIM(CRTABLEDIR)
1232 ✗ IFIL=LEN_TRIM(CRTABLEFIL)
1233 ✗ CLFN=CRTABLEDIR(1:IDIR)//CRTABLEFIL(1:IFIL)
1234 ! Ce qui concerne NULRAD commente par MPL le 15.04.09
1235 ! OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999)
1236 ! GOTO 1000
1237 ! 999 CONTINUE
1238 ! WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN
1239 ! CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE')
1240 ! 1000 CONTINUE
1241 ✗ NRGRI(:)=0
1242 ! Ce qui concerne NAMRGRI commente par MPL le 15.04.09
1243 ! CALL POSNAM(NULRAD,'NAMRGRI')
1244 ! READ (NULRAD,NAMRGRI)
1245 IDGL=1
1246 DO WHILE( NRGRI(IDGL)>0 )
1247 IF( LLDEBUG )THEN
1248 WRITE(NULOUT,'("SUECRAD: NRGRI(",I4,")=",I4)')IDGL,NRGRI(IDGL)
1249 ENDIF
1250 IDGL=IDGL+1
1251 ENDDO
1252 ✗ IDGL=IDGL-1
1253 ✗ RADGRID%NDGLG=IDGL
1254 IF( LLDEBUG )THEN
1255 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG
1256 ENDIF
1257 ! CLOSE(NULRAD)
1258 ENDIF
1259 ! CALL GSTATS(667,0) MPL 2.12.08
1260 ✗ IF( NPROC > 1 )THEN
1261 ✗ stop 'Pas pret pour proc > 1'
1262 ! CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
1263 ENDIF
1264 ✗ ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG))
1265 ✗ IF( MYPROC == JPIOMASTER )THEN
1266 ✗ RADGRID%NRGRI(1:RADGRID%NDGLG)=NRGRI(1:RADGRID%NDGLG)
1267 ENDIF
1268 ✗ IF( NPROC > 1 )THEN
1269 ✗ stop 'Pas pret pour proc > 1'
1270 ! CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
1271 ENDIF
1272 ! CALL GSTATS(667,1) MPL 2.12.08
1273
1274 ! CALL GSTATS(1818,0) MPL 2.12.08
1275 ✗ IF ( NRADINT == 1 )THEN
1276 ✗ WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")')
1277 ✗ RADGRID%NDGSUR=0
1278 ✗ NRIWIDEN=0
1279 ✗ NRIWIDES=0
1280 ✗ NRIWIDEW=0
1281 ✗ NRIWIDEE=0
1282 ✗ NROWIDEN=0
1283 ✗ NROWIDES=0
1284 ✗ NROWIDEW=0
1285 ✗ NROWIDEE=0
1286 ✗ ELSEIF( NRADINT == 2 )THEN
1287 ✗ WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 4 POINT")')
1288 ✗ RADGRID%NDGSUR=2
1289 ✗ ELSEIF( NRADINT == 3 )THEN
1290 ✗ WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 12 POINT")')
1291 ✗ RADGRID%NDGSUR=2
1292 ENDIF
1293 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSUR =",I8)')RADGRID%NDGSUR
1294
1295 ✗ RADGRID%NDGSAG=1-RADGRID%NDGSUR
1296 ✗ RADGRID%NDGENG=RADGRID%NDGLG+RADGRID%NDGSUR
1297 ✗ RADGRID%NDLON=RADGRID%NRGRI(RADGRID%NDGLG/2)
1298 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAG =",I8)')RADGRID%NDGSAG
1299 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENG =",I8)')RADGRID%NDGENG
1300 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG =",I8)')RADGRID%NDGLG
1301 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDLON =",I8)')RADGRID%NDLON
1302 ✗ CALL FLUSH(NULOUT)
1303
1304 ✗ ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG))
1305 ✗ RADGRID%NLOENG(1:RADGRID%NDGLG)=RADGRID%NRGRI(1:RADGRID%NDGLG)
1306 ✗ IF(RADGRID%NDGSUR >= 1)THEN
1307 ✗ DO JGLSUR=1,RADGRID%NDGSUR
1308 ✗ RADGRID%NLOENG(1-JGLSUR)=RADGRID%NLOENG(JGLSUR)
1309 ENDDO
1310 ✗ DO JGLSUR=1,RADGRID%NDGSUR
1311 ✗ RADGRID%NLOENG(RADGRID%NDGLG+JGLSUR)=RADGRID%NLOENG(RADGRID%NDGLG+1-JGLSUR)
1312 ENDDO
1313 ENDIF
1314 ! CALL GSTATS(1818,1) MPL 2.12.08
1315
1316 ! Setup the transform package for the radiation grid
1317 CALL SETUP_TRANS (KSMAX=RADGRID%NSMAX, &
1318 & KDGL=RADGRID%NDGLG, &
1319 & KLOEN=RADGRID%NLOENG(1:RADGRID%NDGLG), &
1320 & LDLINEAR_GRID=LLINEAR_GRID, &
1321 & LDSPLIT=LSPLIT, &
1322 & KAPSETS=NAPSETS, &
1323 ✗ & KRESOL=RADGRID%NRESOL_ID)
1324
1325 ✗ ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
1326 ✗ ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
1327 ✗ ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS))
1328 ✗ ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS))
1329 ✗ ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS))
1330 ✗ ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG))
1331 ✗ ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG))
1332 ✗ ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG))
1333
1334 ! Interrogate the transform package for the radiation grid
1335 ! CALL GSTATS(1818,0) MPL 2.12.08
1336 CALL TRANS_INQ (KRESOL =RADGRID%NRESOL_ID, &
1337 & KSPEC2 =RADGRID%NSPEC2, &
1338 & KNUMP =RADGRID%NUMP, &
1339 & KGPTOT =RADGRID%NGPTOT, &
1340 & KGPTOTG =RADGRID%NGPTOTG, &
1341 & KGPTOTMX =RADGRID%NGPTOTMX, &
1342 & KPTRFRSTLAT=RADGRID%NPTRFRSTLAT, &
1343 & KFRSTLAT =RADGRID%NFRSTLAT, &
1344 & KLSTLAT =RADGRID%NLSTLAT, &
1345 & KFRSTLOFF =RADGRID%NFRSTLOFF, &
1346 & KSTA =RADGRID%NSTA(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
1347 & KONL =RADGRID%NONL(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
1348 & KPTRFLOFF =RADGRID%NPTRFLOFF, &
1349 ✗ & PMU =RADGRID%RMU(1:) )
1350
1351 ✗ IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
1352 ✗ DO JGL=1,RADGRID%NDGLG
1353 ✗ RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL)*RADGRID%RMU(JGL))
1354 ✗ RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL))
1355 ! WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')&
1356 ! & JGL,RADGRID%RLATIG(JGL)
1357 ENDDO
1358 ✗ IF(RADGRID%NDGSUR >= 1)THEN
1359 ✗ DO JGLSUR=1,RADGRID%NDGSUR
1360 ✗ RADGRID%RMU(1-JGLSUR)=RADGRID%RMU(JGLSUR)
1361 ✗ RADGRID%RSQM2(1-JGLSUR)=RADGRID%RSQM2(JGLSUR)
1362 ✗ RADGRID%RLATIG(1-JGLSUR)=RPI-RADGRID%RLATIG(JGLSUR)
1363 ENDDO
1364 ✗ DO JGLSUR=1,RADGRID%NDGSUR
1365 ✗ RADGRID%RMU(RADGRID%NDGLG+JGLSUR)=RADGRID%RMU(RADGRID%NDGLG+1-JGLSUR)
1366 ✗ RADGRID%RSQM2(RADGRID%NDGLG+JGLSUR)=RADGRID%RSQM2(RADGRID%NDGLG+1-JGLSUR)
1367 ✗ RADGRID%RLATIG(RADGRID%NDGLG+JGLSUR)=-RPI-RADGRID%RLATIG(RADGRID%NDGLG+1-JGLSUR)
1368 ENDDO
1369 ENDIF
1370 ENDIF
1371
1372 ✗ RADGRID%NDGSAL=1
1373 ✗ RADGRID%NDGENL=RADGRID%NLSTLAT(MY_REGION_NS)-RADGRID%NFRSTLOFF
1374 ✗ RADGRID%NDSUR1=3-MOD(RADGRID%NDLON,2)
1375 ✗ IDLSUR=MAX(RADGRID%NDLON,2*RADGRID%NSMAX+1)
1376 ✗ RADGRID%NDLSUR=IDLSUR+RADGRID%NDSUR1
1377 ✗ RADGRID%MYFRSTACTLAT=RADGRID%NFRSTLAT(MY_REGION_NS)
1378 ✗ RADGRID%MYLSTACTLAT=RADGRID%NLSTLAT(MY_REGION_NS)
1379
1380 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NRESOL_ID =",I8)')RADGRID%NRESOL_ID
1381 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NSMAX =",I8)')RADGRID%NSMAX
1382 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NSPEC2 =",I8)')RADGRID%NSPEC2
1383 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOT =",I8)')RADGRID%NGPTOT
1384 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOTG =",I8)')RADGRID%NGPTOTG
1385 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAL =",I8)')RADGRID%NDGSAL
1386 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENL =",I8)')RADGRID%NDGENL
1387 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDSUR1 =",I8)')RADGRID%NDSUR1
1388 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDLSUR =",I8)')RADGRID%NDLSUR
1389 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT
1390 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%MYLSTACTLAT =",I8)')RADGRID%MYLSTACTLAT
1391 ✗ CALL FLUSH(NULOUT)
1392
1393 ✗ ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2))
1394 ✗ ALLOCATE(RADGRID%MYMS(RADGRID%NUMP))
1395 CALL TRANS_INQ (KRESOL =RADGRID%NRESOL_ID, &
1396 & KASM0 =RADGRID%NASM0, &
1397 ✗ & KMYMS =RADGRID%MYMS )
1398
1399 ✗ ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT))
1400 ✗ ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT))
1401 ✗ ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT))
1402 ✗ ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT))
1403 ✗ ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT))
1404
1405 IOFF=0
1406 ✗ ILAT=RADGRID%NPTRFLOFF
1407 ✗ DO JGLAT=RADGRID%NFRSTLAT(MY_REGION_NS), &
1408 ✗ & RADGRID%NLSTLAT(MY_REGION_NS)
1409 ✗ ZGEMU=RADGRID%RMU(JGLAT)
1410 ✗ ILAT=ILAT+1
1411 ✗ ISTLON = RADGRID%NSTA(ILAT,MY_REGION_EW)
1412 ✗ IENDLON = ISTLON-1 + RADGRID%NONL(ILAT,MY_REGION_EW)
1413
1414 ✗ DO JLON=ISTLON,IENDLON
1415 ZLON= REAL(JLON-1,JPRB)*2.0_JPRB*RPI &
1416 ✗ & /REAL(RADGRID%NLOENG(JGLAT),JPRB)
1417 ✗ IOFF=IOFF+1
1418 ✗ RADGRID%GELAM(IOFF) = ZLON
1419 ✗ RADGRID%GELAT(IOFF) = ASIN(ZGEMU)
1420 ✗ RADGRID%GESLO(IOFF) = SIN(ZLON)
1421 ✗ RADGRID%GECLO(IOFF) = COS(ZLON)
1422 ✗ RADGRID%GEMU (IOFF) = ZGEMU
1423 ENDDO
1424 ENDDO
1425
1426 ✗ IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
1427
1428 ! For grid point interpolations we need to calculate the halo size
1429 ! required by each processor
1430
1431 ✗ ALLOCATE(ZLATX(RADGRID%NGPTOTMX))
1432 ✗ ALLOCATE(ZLONX(RADGRID%NGPTOTMX))
1433 ✗ DO J=1,RADGRID%NGPTOT
1434 ✗ ZLATX(J)=RADGRID%GELAT(J)/RPI*2.0_JPRB*90.0
1435 ✗ ZLONX(J)=(RADGRID%GELAM(J)-RPI)/RPI*180.0
1436 ENDDO
1437 ✗ ZMINRADLAT=MINVAL(ZLATX(1:RADGRID%NGPTOT))
1438 ✗ ZMAXRADLAT=MAXVAL(ZLATX(1:RADGRID%NGPTOT))
1439 ✗ ZMINRADLON=MINVAL(ZLONX(1:RADGRID%NGPTOT))
1440 ✗ ZMAXRADLON=MAXVAL(ZLONX(1:RADGRID%NGPTOT))
1441 IF( LLDEBUG )THEN
1442 ✗ WRITE(NULOUT,'("RADGRID,BEGIN")')
1443 ✗ IF( MYPROC /= 1 )THEN
1444 ✗ stop 'Pas pret pour proc > 1'
1445 ! CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R')
1446 ! CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R')
1447 ! CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R')
1448 ENDIF
1449 IF( MYPROC == 1 )THEN
1450 ✗ DO JROC=1,NPROC
1451 ✗ IF( JROC == MYPROC )THEN
1452 ✗ DO J=1,RADGRID%NGPTOT
1453 ✗ WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),MYPROC
1454 ENDDO
1455 ELSE
1456 ✗ stop 'Pas pret pour proc > 1'
1457 ! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M')
1458 ! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M')
1459 ! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M')
1460 DO J=1,IGPTOT
1461 WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),JROC
1462 ENDDO
1463 ENDIF
1464 ENDDO
1465 ENDIF
1466 ✗ WRITE(NULOUT,'("RADGRID,END")')
1467 ENDIF
1468 ✗ DEALLOCATE(ZLATX)
1469 ✗ DEALLOCATE(ZLONX)
1470
1471 ✗ ALLOCATE(ZLATX(NGPTOTMX))
1472 ✗ ALLOCATE(ZLONX(NGPTOTMX))
1473 ✗ DO J=1,NGPTOT
1474 ✗ ZLATX(J)=GELAT(J)/RPI*2.0_JPRB*90.0
1475 ✗ ZLONX(J)=(GELAM(J)-RPI)/RPI*180.0
1476 ENDDO
1477 ✗ ZMINMDLLAT=MINVAL(ZLATX(1:NGPTOT))
1478 ✗ ZMAXMDLLAT=MAXVAL(ZLATX(1:NGPTOT))
1479 ✗ ZMINMDLLON=MINVAL(ZLONX(1:NGPTOT))
1480 ✗ ZMAXMDLLON=MAXVAL(ZLONX(1:NGPTOT))
1481 IF( LLDEBUG )THEN
1482 ✗ WRITE(NULOUT,'("MODELGRID,BEGIN")')
1483 ✗ IF( MYPROC /= 1 )THEN
1484 ✗ stop 'Pas pret pour proc > 1'
1485 ! CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD')
1486 ! CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD')
1487 ! CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD')
1488 ! CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD')
1489 ENDIF
1490 IF( MYPROC == 1 )THEN
1491 ✗ DO JROC=1,NPROC
1492 ✗ IF( JROC == MYPROC )THEN
1493 ✗ DO J=1,NGPTOT
1494 ✗ WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),MYPROC,NGLOBALINDEX(J)
1495 ENDDO
1496 ELSE
1497 ✗ stop 'Pas pret pour proc > 1'
1498 ! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD')
1499 ! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD')
1500 ! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD')
1501 ALLOCATE(IGLOBALINDEX(1:IGPTOT))
1502 ! CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD')
1503 DO J=1,IGPTOT
1504 WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),JROC,IGLOBALINDEX(J)
1505 ENDDO
1506 DEALLOCATE(IGLOBALINDEX)
1507 ENDIF
1508 ENDDO
1509 ENDIF
1510 ✗ WRITE(NULOUT,'("MODELGRID,END")')
1511 ENDIF
1512 ✗ DEALLOCATE(ZLATX)
1513 ✗ DEALLOCATE(ZLONX)
1514
1515 IF( LLDEBUG )THEN
1516 ✗ WRITE(NULOUT,'("ZMINRADLAT=",F10.2)')ZMINRADLAT
1517 ✗ WRITE(NULOUT,'("ZMINMDLLAT=",F10.2)')ZMINMDLLAT
1518 ✗ WRITE(NULOUT,'("ZMAXRADLAT=",F10.2)')ZMAXRADLAT
1519 ✗ WRITE(NULOUT,'("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT
1520 ✗ WRITE(NULOUT,'("ZMINRADLON=",F10.2)')ZMINRADLON
1521 ✗ WRITE(NULOUT,'("ZMINMDLLON=",F10.2)')ZMINMDLLON
1522 ✗ WRITE(NULOUT,'("ZMAXRADLON=",F10.2)')ZMAXRADLON
1523 ✗ WRITE(NULOUT,'("ZMAXMDLLON=",F10.2)')ZMAXMDLLON
1524 ENDIF
1525
1526 ✗ ZLAT=NDGLG/180.
1527 ✗ ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
1528 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
1529 ✗ IF( ZMINRADLAT < ZMINMDLLAT )THEN
1530 ✗ NRIWIDES=JP_MIN_HALO+ILATS_DIFF_C
1531 ELSE
1532 ✗ NRIWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1533 ENDIF
1534 ✗ ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
1535 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
1536 ✗ IF( ZMAXRADLAT < ZMAXMDLLAT )THEN
1537 ✗ NRIWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1538 ELSE
1539 ✗ NRIWIDEN=JP_MIN_HALO+ILATS_DIFF_C
1540 ENDIF
1541 ✗ ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
1542 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
1543 ✗ IF( ZMINRADLON < ZMINMDLLON )THEN
1544 ✗ NRIWIDEW=JP_MIN_HALO+ILATS_DIFF_C
1545 ELSE
1546 ✗ NRIWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1547 ENDIF
1548 ✗ ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
1549 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
1550 ✗ IF( ZMAXRADLON < ZMAXMDLLON )THEN
1551 ✗ NRIWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1552 ELSE
1553 ✗ NRIWIDEE=JP_MIN_HALO+ILATS_DIFF_C
1554 ENDIF
1555
1556 ✗ ZLAT=RADGRID%NDGLG/180.
1557 ✗ ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
1558 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
1559 ✗ IF( ZMINMDLLAT < ZMINRADLAT )THEN
1560 ✗ NROWIDES=JP_MIN_HALO+ILATS_DIFF_C
1561 ELSE
1562 ✗ NROWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1563 ENDIF
1564 ✗ ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
1565 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
1566 ✗ IF( ZMAXMDLLAT < ZMAXRADLAT )THEN
1567 ✗ NROWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1568 ELSE
1569 ✗ NROWIDEN=JP_MIN_HALO+ILATS_DIFF_C
1570 ENDIF
1571 ✗ ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
1572 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
1573 ✗ IF( ZMINMDLLON < ZMINRADLON )THEN
1574 ✗ NROWIDEW=JP_MIN_HALO+ILATS_DIFF_C
1575 ELSE
1576 ✗ NROWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1577 ENDIF
1578 ✗ ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
1579 ✗ ILATS_DIFF_F=FLOOR (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
1580 ✗ IF( ZMAXMDLLON < ZMAXRADLON )THEN
1581 ✗ NROWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
1582 ELSE
1583 ✗ NROWIDEE=JP_MIN_HALO+ILATS_DIFF_C
1584 ENDIF
1585
1586 ENDIF
1587
1588 RADGRID%NDGSAH=MAX(RADGRID%NDGSAG,&
1589 ✗ & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF
1590 RADGRID%NDGENH=MIN(RADGRID%NDGENG,&
1591 ✗ & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF
1592 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAH =",I8)')RADGRID%NDGSAH
1593 ✗ WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENH =",I8)')RADGRID%NDGENH
1594
1595 ✗ IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
1596
1597 ILBRLATI = MAX(RADGRID%NDGSAG,&
1598 ✗ & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF
1599 IUBRLATI = MIN(RADGRID%NDGENG,&
1600 ✗ & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF
1601 ✗ ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI))
1602 ✗ ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI))
1603 ✗ ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI))
1604 ✗ ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI))
1605
1606 ✗ DO JGL= ILBRLATI,IUBRLATI
1607 ✗ IGLGLO=JGL+RADGRID%NFRSTLOFF
1608 ✗ IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN
1609 ✗ ZD1=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO)
1610 ✗ ZD2=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+1)
1611 ✗ ZD3=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+2)
1612 ✗ ZD4=RADGRID%RLATIG(IGLGLO )-RADGRID%RLATIG(IGLGLO+1)
1613 ✗ ZD5=RADGRID%RLATIG(IGLGLO )-RADGRID%RLATIG(IGLGLO+2)
1614 ✗ ZD6=RADGRID%RLATIG(IGLGLO+1)-RADGRID%RLATIG(IGLGLO+2)
1615 ✗ RADGRID%RIPI0(JGL)=-1.0_JPRB/(ZD1*ZD4*ZD5)
1616 ✗ RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6)
1617 ✗ RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6)
1618 ENDIF
1619 ✗ RADGRID%RLATI(JGL)=RADGRID%RLATIG(IGLGLO)
1620 ENDDO
1621
1622 ✗ IF( NPROC > 1 )THEN
1623 ✗ IRIRPTSUR=NGPTOTG
1624 ✗ IRISPTSUR=2*NGPTOTG
1625 ELSE
1626 IRIRPTSUR=0
1627 IRISPTSUR=0
1628 ENDIF
1629
1630 ✗ ALLOCATE(NRISTA(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
1631 ✗ ALLOCATE(NRIONL(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
1632 ✗ ALLOCATE(NRIOFF(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
1633 ✗ ALLOCATE(NRIEXT(1-NDLON:NDLON+NDLON,1-NRIWIDEN:NDGENL+NRIWIDES))
1634 ✗ ALLOCATE(NRICORE(NGPTOT))
1635 ✗ ALLOCATE(IRISENDPOS(IRISPTSUR))
1636 ✗ ALLOCATE(IRIRECVPOS(IRIRPTSUR))
1637 ✗ ALLOCATE(IRISENDPTR(NPROC+1))
1638 ✗ ALLOCATE(IRIRECVPTR(NPROC+1))
1639 ✗ ALLOCATE(IRICOMM(NPROC))
1640 ✗ ALLOCATE(IRIMAP(4,NDGLG))
1641 ! MPL 1.12.08
1642 ! CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,&
1643 ! & IRIRPTSUR,IRISPTSUR,&
1644 ! & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,&
1645 ! & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,&
1646 ! & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
1647 ! & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,&
1648 ! & RMU,RSQM2,&
1649 ! & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,&
1650 ! & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,&
1651 ! & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN)
1652 ✗ CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
1653 ✗ WRITE(NULOUT,'("SUECRAD: NARIB1=",I12)')NARIB1
1654 ✗ ALLOCATE(NRISENDPOS(NRISPT))
1655 ✗ ALLOCATE(NRIRECVPOS(NRIRPT))
1656 ✗ ALLOCATE(NRISENDPTR(NRIPROCS+1))
1657 ✗ ALLOCATE(NRIRECVPTR(NRIPROCS+1))
1658 ✗ ALLOCATE(NRICOMM(NRIPROCS))
1659 ✗ NRISENDPOS(1:NRISPT)=IRISENDPOS(1:NRISPT)
1660 ✗ NRIRECVPOS(1:NRIRPT)=IRIRECVPOS(1:NRIRPT)
1661 ✗ NRISENDPTR(1:NRIPROCS+1)=IRISENDPTR(1:NRIPROCS+1)
1662 ✗ NRIRECVPTR(1:NRIPROCS+1)=IRIRECVPTR(1:NRIPROCS+1)
1663 ✗ NRICOMM(1:NRIPROCS)=IRICOMM(1:NRIPROCS)
1664 ✗ DEALLOCATE(IRISENDPOS)
1665 ✗ DEALLOCATE(IRIRECVPOS)
1666 ✗ DEALLOCATE(IRISENDPTR)
1667 ✗ DEALLOCATE(IRIRECVPTR)
1668 ✗ DEALLOCATE(IRICOMM)
1669 ✗ DEALLOCATE(IRIMAP)
1670
1671 ✗ IF( NPROC > 1 )THEN
1672 ✗ IRORPTSUR=RADGRID%NGPTOTG
1673 ✗ IROSPTSUR=2*RADGRID%NGPTOTG
1674 ELSE
1675 IRORPTSUR=0
1676 IROSPTSUR=0
1677 ENDIF
1678
1679 ✗ ALLOCATE(NROSTA(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
1680 ✗ ALLOCATE(NROONL(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
1681 ✗ ALLOCATE(NROOFF(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
1682 ✗ ALLOCATE(NROEXT(1-RADGRID%NDLON:RADGRID%NDLON+RADGRID%NDLON,&
1683 ✗ & 1-NROWIDEN:RADGRID%NDGENL+NROWIDES))
1684 ✗ ALLOCATE(NROCORE(RADGRID%NGPTOT))
1685 ✗ ALLOCATE(IROSENDPOS(IROSPTSUR))
1686 ✗ ALLOCATE(IRORECVPOS(IRORPTSUR))
1687 ✗ ALLOCATE(IROSENDPTR(NPROC+1))
1688 ✗ ALLOCATE(IRORECVPTR(NPROC+1))
1689 ✗ ALLOCATE(IROCOMM(NPROC))
1690 ✗ ALLOCATE(IROMAP(4,RADGRID%NDGLG))
1691 ! MPL 1.12.08
1692 ! CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,&
1693 ! & IRORPTSUR,IROSPTSUR,&
1694 ! & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,&
1695 ! & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,&
1696 ! & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,&
1697 ! & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,&
1698 ! & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,&
1699 ! & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,&
1700 ! & RADGRID%RMU,RADGRID%RSQM2,&
1701 ! & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,&
1702 ! & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,&
1703 ! & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN)
1704 ✗ CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
1705 ✗ WRITE(NULOUT,'("SUECRAD: NAROB1=",I12)')NAROB1
1706 ✗ ALLOCATE(NROSENDPOS(NROSPT))
1707 ✗ ALLOCATE(NRORECVPOS(NRORPT))
1708 ✗ ALLOCATE(NROSENDPTR(NROPROCS+1))
1709 ✗ ALLOCATE(NRORECVPTR(NROPROCS+1))
1710 ✗ ALLOCATE(NROCOMM(NROPROCS))
1711 ✗ NROSENDPOS(1:NROSPT)=IROSENDPOS(1:NROSPT)
1712 ✗ NRORECVPOS(1:NRORPT)=IRORECVPOS(1:NRORPT)
1713 ✗ NROSENDPTR(1:NROPROCS+1)=IROSENDPTR(1:NROPROCS+1)
1714 ✗ NRORECVPTR(1:NROPROCS+1)=IRORECVPTR(1:NROPROCS+1)
1715 ✗ NROCOMM(1:NROPROCS)=IROCOMM(1:NROPROCS)
1716 ✗ DEALLOCATE(IROSENDPOS)
1717 ✗ DEALLOCATE(IRORECVPOS)
1718 ✗ DEALLOCATE(IROSENDPTR)
1719 ✗ DEALLOCATE(IRORECVPTR)
1720 ✗ DEALLOCATE(IROCOMM)
1721 ✗ DEALLOCATE(IROMAP)
1722
1723 IF( LLDEBUG )THEN
1724 ✗ WRITE(NULOUT,'("")')
1725 ✗ IRIWIDEMAXN=0
1726 ✗ IRIWIDEMAXS=0
1727 ✗ IRIWIDEMAXW=0
1728 ✗ IRIWIDEMAXE=0
1729 ✗ IROWIDEMAXN=0
1730 ✗ IROWIDEMAXS=0
1731 ✗ IROWIDEMAXW=0
1732 ✗ IROWIDEMAXE=0
1733 ✗ IARIB1MAX=0
1734 ✗ IAROB1MAX=0
1735 ✗ IWIDE(1)=NRIWIDEN
1736 ✗ IWIDE(2)=NRIWIDES
1737 ✗ IWIDE(3)=NRIWIDEW
1738 ✗ IWIDE(4)=NRIWIDEE
1739 ✗ IWIDE(5)=NROWIDEN
1740 ✗ IWIDE(6)=NROWIDES
1741 ✗ IWIDE(7)=NROWIDEW
1742 ✗ IWIDE(8)=NROWIDEE
1743 ✗ IWIDE(9)=NARIB1
1744 ✗ IWIDE(10)=NAROB1
1745 ✗ IF( MYPROC /= 1 )THEN
1746 ✗ stop 'Pas pret pour proc > 1'
1747 ! CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W')
1748 ENDIF
1749 IF( MYPROC == 1 )THEN
1750 ✗ DO JROC=1,NPROC
1751 ✗ IF( JROC /= MYPROC )THEN
1752 ✗ stop 'Pas pret pour proc > 1'
1753 ! CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W')
1754 ENDIF
1755 WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')&
1756 ✗ & JROC,IWIDE(1),IWIDE(5)
1757 WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')&
1758 ✗ & JROC,IWIDE(2),IWIDE(6)
1759 WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')&
1760 ✗ & JROC,IWIDE(3),IWIDE(7)
1761 WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')&
1762 ✗ & JROC,IWIDE(4),IWIDE(8)
1763 WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')&
1764 ✗ & JROC,IWIDE(9),IWIDE(10)
1765 ✗ WRITE(NULOUT,'("")')
1766 ✗ IF( IWIDE(1) > IRIWIDEMAXN ) IRIWIDEMAXN=IWIDE(1)
1767 ✗ IF( IWIDE(2) > IRIWIDEMAXS ) IRIWIDEMAXS=IWIDE(2)
1768 ✗ IF( IWIDE(3) > IRIWIDEMAXW ) IRIWIDEMAXW=IWIDE(3)
1769 ✗ IF( IWIDE(4) > IRIWIDEMAXE ) IRIWIDEMAXE=IWIDE(4)
1770 ✗ IF( IWIDE(5) > IROWIDEMAXN ) IROWIDEMAXN=IWIDE(5)
1771 ✗ IF( IWIDE(6) > IROWIDEMAXS ) IROWIDEMAXS=IWIDE(6)
1772 ✗ IF( IWIDE(7) > IROWIDEMAXW ) IROWIDEMAXW=IWIDE(7)
1773 ✗ IF( IWIDE(8) > IROWIDEMAXE ) IROWIDEMAXE=IWIDE(8)
1774 ✗ IF( IWIDE(9) > IARIB1MAX ) IARIB1MAX =IWIDE(9)
1775 ✗ IF( IWIDE(10) > IAROB1MAX ) IAROB1MAX =IWIDE(10)
1776 ENDDO
1777 ✗ WRITE(NULOUT,'("")')
1778 ✗ WRITE(NULOUT,'("SUECRAD: NRIWIDEN(MAX) =",I8)')IRIWIDEMAXN
1779 ✗ WRITE(NULOUT,'("SUECRAD: NRIWIDES(MAX) =",I8)')IRIWIDEMAXS
1780 ✗ WRITE(NULOUT,'("SUECRAD: NRIWIDEW(MAX) =",I8)')IRIWIDEMAXW
1781 ✗ WRITE(NULOUT,'("SUECRAD: NRIWIDEE(MAX) =",I8)')IRIWIDEMAXE
1782 ✗ WRITE(NULOUT,'("SUECRAD: NROWIDEN(MAX) =",I8)')IROWIDEMAXN
1783 ✗ WRITE(NULOUT,'("SUECRAD: NROWIDES(MAX) =",I8)')IROWIDEMAXS
1784 ✗ WRITE(NULOUT,'("SUECRAD: NROWIDEW(MAX) =",I8)')IROWIDEMAXW
1785 ✗ WRITE(NULOUT,'("SUECRAD: NROWIDEE(MAX) =",I8)')IROWIDEMAXE
1786 ✗ WRITE(NULOUT,'("SUECRAD: NARIB1(MAX) =",I10)')IARIB1MAX
1787 ✗ WRITE(NULOUT,'("SUECRAD: NAROB1(MAX) =",I10)')IAROB1MAX
1788 ✗ WRITE(NULOUT,'("")')
1789 ENDIF
1790 ✗ CALL FLUSH(NULOUT)
1791 ENDIF
1792
1793 ENDIF
1794 ! CALL GSTATS(1818,1) MPL 2.12.08
1795
1796 ELSE
1797
1798 ✗ WRITE(NULOUT,'("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT
1799 ✗ CALL ABOR1('SUECRAD: NRADINT INVALID')
1800
1801 ENDIF
1802
1803 ENDIF ! END OF LERADI BLOCK
1804
1805 ! ----------------------------------------------------------------
1806
1807 !* 4. INITIALIZE RADIATION COEFFICIENTS.
1808 ! ----------------------------------
1809
1810 1 RCDAY = RDAY * RG / RCPD
1811 1 DIFF = 1.66_JPRB
1812 1 R10E = 0.4342945_JPRB
1813
1814 ! CALL GSTATS(1818,0) MPL 2.12.08
1815 1 CALL SURDI
1816
1817
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (NINHOM == 0) THEN
1818 ✗ RLWINHF=1._JPRB
1819 ✗ RSWINHF=1._JPRB
1820 ENDIF
1821
1822 ! ----------------------------------------------------------------
1823
1824 !* 5. INITIALIZE RADIATION ABSORPTION COEFFICIENTS
1825 ! --------------------------------------------
1826
1827 !* 5.1. Initialization routine for RRTM
1828 ! -------------------------------
1829
1830 1 CALL SURRTAB
1831 1 CALL SURRTPK
1832 1 CALL SURRTRF
1833 1 CALL SURRTFTR
1834
1835
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LRRTM) THEN
1836
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (KLEV > JPLAY) THEN
1837 WRITE(UNIT=KULOUT,&
1838 & FMT='('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',&
1839 ✗ & '' CALL ABORT'')')
1840 ✗ CALL ABOR1(' ABOR1 CALLED SUECRAD')
1841 ENDIF
1842
1843 ! Read the absorption coefficient data and reduce from 256 to 140 g-points
1844
1845 1 CALL RRTM_INIT_140GP
1846
1847 1 INBLW=16
1848
1849 ELSE
1850 ✗ INBLW=6
1851
1852 ENDIF
1853
1854 1 CALL SULWN
1855 1 CALL SUSWN (NTSW, NSW)
1856 1 CALL SUCLOPN (NTSW, NSW, KLEV)
1857
1858 !-- routines specific to SRTM
1859
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (LSRTM) THEN
1860 ✗ NTSW=14
1861 ✗ ISW =14
1862 ✗ CALL SRTM_INIT
1863 ✗ CALL SUSRTAER
1864 ✗ CALL SUSRTCOP
1865 ✗ WRITE(UNIT=KULOUT,FMT='(''SRTM Configuration'',L8,3I4)')LSRTM,NTSW,ISW,JPGPT
1866
1867 ELSE
1868
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
 1 IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6)) ) THEN
1869 ✗ WRITE(UNIT=KULOUT,FMT='(''Wrong SW Configuration'',L8,I3)')LONEWSW,NSW
1870 ENDIF
1871
1872 1 CALL SUSWN (NTSW,NSW)
1873 1 CALL SUAERSN (NTSW,NSW)
1874 ENDIF
1875 1 WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW
1876
1877
1878 !-- routine specific to the UV processor
1879
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (LUVPROC) THEN
1880 ✗ NUVTIM = NUVTIM * 86400
1881 ✗ CALL SU_UVRAD ( NUV )
1882 ENDIF
1883
1884 ! ----------------------------------------------------------------
1885
1886 !* 6. INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
1887 ! ------------------------------------------------------
1888
1889 !- LW optical properties
1890 1 CALL SUAERL
1891 !- SW optical properties moved above
1892 !CALL SUAERSN (NTSW,NSW)
1893
1894 !- horizontal distribution
1895 1 CALL SUAERH
1896
1897 !- vertical distribution
1898 CALL SUAERV ( KLEV , PETAH,&
1899 & CVDAES , CVDAEL , CVDAEU , CVDAED,&
1900 & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU,&
1901 & RCAEOPD, RCTRPT , RCAEADK, RCAEADM, RCAEROS &
1902 1 & )
1903
1904 !-- Overlap function (only used if NOVLP=4)
1905 ! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise
1906 ! sinon il faudrait calculer le geopotentiel STZ
1907 !CALL SUOVLP ( KLEV )
1908
1909 !-- parameters for prognostic aerosols
1910 1 CALL SU_AERW
1911
1912 ! ----------------------------------------------------------------
1913
1914 !* 7. INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
1915 ! -------------------------------------------------------
1916
1917
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 1 IF (LEPHYS .AND. NMODE > 1) THEN
1918 ✗ CALL SUSAT
1919 ENDIF
1920 !CALL GSTATS(1818,1) MPL 2.12.08
1921
1922 ! ----------------------------------------------------------------
1923
1924 !* 8. INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
1925 ! --------------------------------------------
1926 ! (not done here!!! called from APLPAR as it depends
1927 ! on model pressure levels!)
1928
1929 ! ----------------------------------------------------------------
1930
1931 !* 9. SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
1932 ! -------------------------------------------------------
1933
1934 1 ZTSTEP=MAX(TSTEP,1.0_JPRB)
1935 1 ZSTPHR=3600._JPRB/ZTSTEP
1936 1 IRADFR=NRADFR
1937
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF(NRADFR < 0) THEN
1938 1 NRADFR=-NRADFR*ZSTPHR+0.5_JPRB
1939 ENDIF
1940 1 NRADPFR=NRADPFR*NRADFR
1941
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 1 IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN
1942 ✗ NRADPLA=NRADPLA+1
1943 ENDIF
1944
1945
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF(NRADUV < 0) THEN
1946 1 NRADUV=-NRADUV*ZSTPHR+0.5_JPRB
1947 ENDIF
1948
1949 1 IST1HR=ZSTPHR+0.05_JPRB
1950 1 ISTNHR= NLNGR1H *ZSTPHR+0.05_JPRB
1951
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
1952 801 CONTINUE
1953 ✗ IST1HR=IST1HR+1
1954 ✗ IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801
1955 ENDIF
1956
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (NRADFR == 1) THEN
1957 ✗ NRADSFR=NRADFR
1958 ELSE
1959 1 NRADSFR=IST1HR
1960 ENDIF
1961 1 NRADNFR=NRADFR
1962
1963
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF(LRAYFM) THEN
1964 ✗ NRPROMA=NDLON+6+(1-MOD(NDLON,2))
1965 ENDIF
1966
1967 ! ----------------------------------------------------------------
1968
1969 !* 10. ALLOCATE WORK ARRAYS
1970 ! --------------------
1971
1972 1 IU = NULOUT
1973
2/4
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1 times.
✗ Branch 3 not taken.
 1 LLP = NPRINTLEV >= 1.OR. LALLOPR
1974
1975
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (LEPHYS) THEN
1976 ✗ ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
1977 ✗ IF(LLP)WRITE(IU,9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD )
1978 ✗ ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
1979 ✗ IF(LLP)WRITE(IU,9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW )
1980 ✗ ALLOCATE(EMTC(NPROMA,NFLEVG+1,NGPBLKS))
1981 ✗ IF(LLP)WRITE(IU,9) 'EMTC ',SIZE(EMTC ),SHAPE(EMTC )
1982 ✗ ALLOCATE(TRSC(NPROMA,NFLEVG+1,NGPBLKS))
1983 ✗ IF(LLP)WRITE(IU,9) 'TRSC ',SIZE(TRSC ),SHAPE(TRSC )
1984 ✗ ALLOCATE(SRSWD(NPROMA,NGPBLKS))
1985 ✗ IF(LLP)WRITE(IU,9) 'SRSWD ',SIZE(SRSWD ),SHAPE(SRSWD )
1986 ✗ ALLOCATE(SRLWD(NPROMA,NGPBLKS))
1987 ✗ IF(LLP)WRITE(IU,9) 'SRLWD ',SIZE(SRLWD ),SHAPE(SRLWD )
1988 ✗ ALLOCATE(SRSWDCS(NPROMA,NGPBLKS))
1989 ✗ IF(LLP)WRITE(IU,9) 'SRSWDCS ',SIZE(SRSWDCS ),SHAPE(SRSWDCS )
1990 ✗ ALLOCATE(SRLWDCS(NPROMA,NGPBLKS))
1991 ✗ IF(LLP)WRITE(IU,9) 'SRLWDCS ',SIZE(SRLWDCS ),SHAPE(SRLWDCS )
1992 ✗ ALLOCATE(SRSWDV(NPROMA,NGPBLKS))
1993 ✗ IF(LLP)WRITE(IU,9) 'SRSWDV ',SIZE(SRSWDV ),SHAPE(SRSWDV )
1994 ✗ ALLOCATE(SRSWDUV(NPROMA,NGPBLKS))
1995 ✗ IF(LLP)WRITE(IU,9) 'SRSWDUV ',SIZE(SRSWDUV ),SHAPE(SRSWDUV )
1996 ✗ ALLOCATE(EDRO(NPROMA,NGPBLKS))
1997 ✗ IF(LLP)WRITE(IU,9) 'EDRO ',SIZE(EDRO ),SHAPE(EDRO )
1998 ✗ ALLOCATE(SRSWPAR(NPROMA,NGPBLKS))
1999 ✗ IF(LLP)WRITE(IU,9) 'SRSWPAR ',SIZE(SRSWPAR ),SHAPE(SRSWPAR )
2000 ✗ ALLOCATE(SRSWUVB(NPROMA,NGPBLKS))
2001 ✗ IF(LLP)WRITE(IU,9) 'SRSWUVB ',SIZE(SRSWUVB ),SHAPE(SRSWUVB )
2002
2003
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
 1 ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN
2004 ✗ ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
2005 ✗ IF(LLP)WRITE(IU,9) 'EMTD ',SIZE(EMTD ),SHAPE(EMTD )
2006 ✗ ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
2007 ✗ IF(LLP)WRITE(IU,9) 'TRSW ',SIZE(TRSW ),SHAPE(TRSW )
2008 ✗ ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS))
2009 ✗ IF(LLP)WRITE(IU,9) 'EMTC ',SIZE(EMTU ),SHAPE(EMTU )
2010 ✗ ALLOCATE(RMOON(NPROMA,NGPBLKS))
2011 ✗ IF(LLP)WRITE(IU,9) 'RMOON ',SIZE(RMOON ),SHAPE(RMOON )
2012 ENDIF
2013
5/10
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
 2 ALLOCATE(SRSWPARC(NPROMA,NGPBLKS))
2014
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
 1 IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC )
2015
5/10
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 4 not taken.
✓ Branch 5 taken 1 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 1 times.
 2 ALLOCATE(SRSWTINC(NPROMA,NGPBLKS))
2016
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
 1 IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC )
2017
2018 9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
2019
2020 ! ----------------------------------------------------------------
2021
2022 !* 10. PRINT FINAL VALUES.
2023 ! -------------------
2024
2025
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
 1 IF (LOUTPUT) THEN
2026 ✗ WRITE(UNIT=KULOUT,FMT='('' COMMON YOERAD '')')
2027 WRITE(UNIT=KULOUT,FMT='('' LERADI = '',L5 &
2028 & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 &
2029 & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')&
2030 ✗ & LERADI,LERAD1H,LECO2VAR,LHGHG,NLNGR1H,NRADSFR
2031 ✗ WRITE(UNIT=KULOUT,FMT='('' LEPO3RA = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA,YO3%LGP
2032 WRITE(UNIT=KULOUT,FMT='('' NRADFR = '',I2 &
2033 & ,'' NRADPFR = '',I3 &
2034 & ,'' NRADPLA = '',I2 &
2035 & ,'' NRINT = '',I1 &
2036 & ,'' NRPROMA = '',I5 &
2037 & )')&
2038 ✗ & NRADFR,NRADPFR,NRADPLA,NRINT, NRPROMA
2039 WRITE(UNIT=KULOUT,FMT='('' LERADHS= '',L5 &
2040 & ,'' LRRTM = '',L5 &
2041 & ,'' LSRTM = '',L5 &
2042 & ,'' NMODE = '',I1 &
2043 & ,'' NOZOCL= '',I1 &
2044 & ,'' NAER = '',I1 &
2045 & ,'' NHINCSOL='',I2 &
2046 & )')&
2047 ✗ & LERADHS,LRRTM,LSRTM,NMODE,NOZOCL,NAER,NHINCSOL
2048 ✗ IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT=KULOUT,FMT='('' RCCO2= '',E10.3 &
2049 &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 &
2050 &)')&
2051 ✗ & RCCO2,RCCH4,RCN2O,RCCFC11,RCCFC12
2052 WRITE(UNIT=KULOUT,FMT='('' NINHOM = '',I1 &
2053 & ,'' NLAYINH='',I1 &
2054 & ,'' RLWINHF='',F4.2 &
2055 & ,'' RSWINHF='',F4.2 &
2056 & )')&
2057 ✗ & NINHOM,NLAYINH,RLWINHF,RSWINHF
2058 ✗ IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN
2059 WRITE(UNIT=KULOUT,FMT='('' NPERTAER= '',I2 &
2060 & ,'' LNOTROAER='',L5 &
2061 & ,'' NPERTOZ = '',I1 &
2062 & ,'' RPERTOZ = '',F5.0 &
2063 & )')&
2064 ✗ & NPERTAER,LNOTROAER,NPERTOZ,RPERTOZ
2065 ENDIF
2066 ✗ WRITE(UNIT=KULOUT,FMT='('' NRADINT = '',I2)')NRADINT
2067 ✗ WRITE(UNIT=KULOUT,FMT='('' NRADRES = '',I4)')NRADRES
2068 ✗ WRITE(UNIT=KULOUT,FMT='('' LRADONDEM = '',L5)')LRADONDEM
2069 ✗ IF( NRADINT > 0 )THEN
2070 ✗ IDIR=LEN_TRIM(CRTABLEDIR)
2071 ✗ IFIL=LEN_TRIM(CRTABLEFIL)
2072 WRITE(UNIT=KULOUT,FMT='('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')&
2073 ✗ & CRTABLEDIR(1:IDIR),CRTABLEFIL(1:IFIL)
2074 ENDIF
2075 WRITE(UNIT=KULOUT,FMT='('' LCCNL = '',L5 &
2076 & ,'' LCCNO = '',L5 &
2077 & ,'' RCCNLND= '',F5.0 &
2078 & ,'' RCCNSEA= '',F5.0 &
2079 & ,'' LE4ALB = '',L5 &
2080 &)')&
2081 ✗ & LCCNL,LCCNO,RCCNLND,RCCNSEA,LE4ALB
2082 ✗ IF (LHVOLCA) THEN
2083 ✗ WRITE(UNIT=KULOUT,FMT='('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA
2084 ENDIF
2085 WRITE(UNIT=KULOUT,FMT='('' LONEWSW= '',L5 &
2086 & ,'' NRADIP = '',I1 &
2087 & ,'' NRADLP = '',I1 &
2088 & ,'' NICEOPT= '',I1 &
2089 & ,'' NLIQOPT= '',I1 &
2090 & ,'' LDIFFC = '',L5 &
2091 & )')&
2092 ✗ & LONEWSW,NRADIP,NRADLP,NICEOPT,NLIQOPT,LDIFFC
2093 WRITE(UNIT=KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPT. IS''&
2094 & ,'' NOVLP = '',I2 &
2095 & )')&
2096 ✗ & NOVLP
2097 ✗ IF (LUVPROC) THEN
2098 ✗ IDAYUV=NUVTIM/86400
2099 WRITE(UNIT=KULOUT,FMT='('' LUVPROC = '',L5 &
2100 & ,'' LUVTDEP= '',L5 &
2101 & ,'' NRADUV = '',I2 &
2102 & ,'' NUV = '',I2 &
2103 & ,'' NDAYUV = '',I5 &
2104 & ,'' RMUZUV = '',E9.3 &
2105 & )')&
2106 ✗ & LUVPROC,LUVTDEP,NRADUV,NUV,IDAYUV,RMUZUV
2107 ✗ WRITE(UNIT=KULOUT,FMT='('' RUVLAM = '',24F6.1)') (RUVLAM(JUV),JUV=1,NUV)
2108 ✗ WRITE(UNIT=KULOUT,FMT='('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV),JUV=1,NUV)
2109 ENDIF
2110 WRITE(UNIT=KULOUT,FMT='('' NMCICA= '',I2 &
2111 & )')&
2112 ✗ & NMCICA
2113 ENDIF
2114
2115 ! ------------------------------------------------------------------
2116
2117
2118
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
 1 IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE)
2119 1 END SUBROUTINE SUECRAD
2120