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