Context Navigation

suecrad.F90 @ 5441

Last change on this file since 5441 was 5160, checked in by abarral, 5 months ago
Put .h into modules
File size: 56.8 KB

Line
1
2	! $Id: suecrad.F90 4251 2022-09-20 00:22:43Z fhourdin $
3
4	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	USE lmdz_clesphys
157
158	IMPLICIT NONE
159
160	INTEGER(KIND = JPIM), INTENT(IN) :: KLEV
161	INTEGER(KIND = JPIM), INTENT(IN) :: KULOUT
162	REAL(KIND = JPRB), INTENT(IN) :: PETAH(KLEV + 1)
163	! LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
164	INTEGER(KIND = JPIM) :: NRGRI(JPMXGL)
165
166	INTEGER(KIND = JPIM) :: IDGL, INBLW, IRADFR, IST1HR, ISTNHR, IDIR, IFIL
167	INTEGER(KIND = JPIM) :: IRIRPTSUR, IRISPTSUR, IRIMAPLEN
168	INTEGER(KIND = JPIM) :: JLON, JGLAT, JGL, JGLSUR, IDLSUR, IOFF, ILAT, ISTLON, IENDLON
169	INTEGER(KIND = JPIM) :: IRORPTSUR, IROSPTSUR, IROMAPLEN
170	INTEGER(KIND = JPIM) :: ILBRLATI, IUBRLATI, IGLGLO, IDUM, IU
171	INTEGER(KIND = JPIM) :: J, JROC, IGPTOT
172	INTEGER(KIND = JPIM) :: IROWIDEMAXN, IROWIDEMAXS, IROWIDEMAXW, IROWIDEMAXE
173	INTEGER(KIND = JPIM) :: IRIWIDEMAXN, IRIWIDEMAXS, IRIWIDEMAXW, IRIWIDEMAXE
174	INTEGER(KIND = JPIM) :: IARIB1MAX, IAROB1MAX
175	INTEGER(KIND = JPIM) :: IWIDE(10)
176	INTEGER(KIND = JPIM) :: ILATS_DIFF_F, ILATS_DIFF_C
177	INTEGER(KIND = JPIM), PARAMETER :: JP_MIN_HALO = 5
178	INTEGER(KIND = JPIM) :: ISW, JUV, IDAYUV
179
180	LOGICAL :: LLINEAR_GRID
181	LOGICAL :: LLDEBUG, LLP
182
183	REAL(KIND = JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
184	REAL(KIND = JPRB) :: ZMINRADLAT, ZMAXRADLAT, ZMINRADLON, ZMAXRADLON
185	REAL(KIND = JPRB) :: ZMINMDLLAT, ZMAXMDLLAT, ZMINMDLLON, ZMAXMDLLON
186	REAL(KIND = JPRB) :: ZLAT
187	!REAL(KIND=JPRB) :: RLATVOL, RLONVOL
188
189	CHARACTER (LEN = 300) :: CLFN
190	INTEGER(KIND = JPIM), PARAMETER :: JPIOMASTER = 1
191
192	INTEGER(KIND = JPIM), ALLOCATABLE :: IRISENDPOS(:)
193	INTEGER(KIND = JPIM), ALLOCATABLE :: IRIRECVPOS(:)
194	INTEGER(KIND = JPIM), ALLOCATABLE :: IRISENDPTR(:)
195	INTEGER(KIND = JPIM), ALLOCATABLE :: IRIRECVPTR(:)
196	INTEGER(KIND = JPIM), ALLOCATABLE :: IRICOMM(:)
197	INTEGER(KIND = JPIM), ALLOCATABLE :: IRIMAP(:, :)
198	INTEGER(KIND = JPIM), ALLOCATABLE :: IROSENDPOS(:)
199	INTEGER(KIND = JPIM), ALLOCATABLE :: IRORECVPOS(:)
200	INTEGER(KIND = JPIM), ALLOCATABLE :: IROSENDPTR(:)
201	INTEGER(KIND = JPIM), ALLOCATABLE :: IRORECVPTR(:)
202	INTEGER(KIND = JPIM), ALLOCATABLE :: IROCOMM(:)
203	INTEGER(KIND = JPIM), ALLOCATABLE :: IROMAP(:, :)
204	INTEGER(KIND = JPIM), ALLOCATABLE :: IGLOBALINDEX(:)
205
206	REAL(KIND = JPRB), ALLOCATABLE :: ZLATX(:)
207	REAL(KIND = JPRB), ALLOCATABLE :: ZLONX(:)
208	REAL(KIND = JPRB) :: ZHOOK_HANDLE
209
210	INTERFACE
211	#include "setup_trans.h"
212	#include "trans_inq.h"
213	END INTERFACE
214
215	#include "abor1.intfb.h"
216	#include "posnam.intfb.h"
217	#include "rrtm_init_140gp.intfb.h"
218
219	#include "rdcset.intfb.h"
220	#include "suaerh.intfb.h"
221	#include "suaerl.intfb.h"
222	#include "suaersn.intfb.h"
223	#include "suaerv.intfb.h"
224	#include "suclopn.intfb.h"
225	#include "suecradi.intfb.h"
226	#include "suecradl.intfb.h"
227	#include "sulwn.intfb.h"
228	#include "sulwneur.intfb.h"
229	#include "suovlp.intfb.h"
230	#include "surdi.intfb.h"
231	#include "surrtab.intfb.h"
232	#include "surrtftr.intfb.h"
233	#include "surrtpk.intfb.h"
234	#include "surrtrf.intfb.h"
235	#include "susat.intfb.h"
236	#include "suswn.intfb.h"
237	#include "susrtaer.intfb.h"
238	#include "srtm_init.intfb.h"
239	#include "susrtcop.intfb.h"
240	#include "su_aerw.intfb.h"
241	#include "su_uvrad.intfb.h"
242	#include "su_mcica.intfb.h"
243
244	! ----------------------------------------------------------------
245
246	#include "naerad.h"
247	#include "namrgri.h"
248	!MPL/IM 20160915 on prend GES de phylmd
249
250	!* 1. INITIALIZE NEUROFLUX LONGWAVE RADIATION
251	! ---------------------------------------
252
253	IF (LHOOK) CALL DR_HOOK('SUECRAD', 0, ZHOOK_HANDLE)
254	!CALL GSTATS(1818,0) MPL 2.12.08
255	!IF (LERADN2) THEN
256	! CALL SULWNEUR(KLEV)
257	!ENDIF
258
259	!* 2. SET DEFAULT VALUES.
260	! -------------------
261
262	!* 2.1 PRESET INDICES IN YOERAD
263	! --------------------------
264
265	LERAD1H = .FALSE.
266	NLNGR1H = 6
267
268	LERADHS = .TRUE.
269	LONEWSW = .TRUE.
270	LECSRAD = .FALSE.
271
272	!LE4ALB=.FALSE.
273	!This is read from SU0PHY in NAEPHY and put in YOEPHY
274
275	!- default setting of cloud optical properties
276	! liquid water cloud 0: Fouquart (SW), Smith-Shi (LW)
277	! 1: Slingo (SW), Savijarvi (LW)
278	! 2: Slingo (SW), Lindner-Li (LW)
279	! ice water cloud 0: Ebert-Curry (SW), Smith-Shi (LW)
280	! 1: Ebert-Curry (SW), Ebert-Curry (LW)
281	! 2: Fu-Liou'93 (SW), Fu-Liou'93 (LW)
282	! 3: Fu'96 (SW), Fu et al'98 (LW)
283	NLIQOPT = 2 ! before 3?R1 default=0 2
284	NICEOPT = 3 ! before 3?R1 default=1 3
285
286	!- default setting of cloud effective radius/diameter
287	! liquid water cloud 0: f(P) 10 to 45
288	! 1: 13: ocean; 10: land
289	! 2: Martin et al. CCN 50 over ocean, 900 over land
290	! ice water cloud 0: 40 microns
291	! 1: f(T) 40 to 130 microns
292	! 2: f(T) 30 to 60
293	! 3: f(T,IWC) Sun'01: 22.5 to 175 microns
294	! conversion factor between effective radius and particle size for ice
295	NRADIP = 3 ! before 3?R1 default=2 3
296	NRADLP = 2 ! before 3?R1 default=2 2
297	PRINT *, 'SUECRAD: NRADLP, NRADIP=', NRADLP, NRADIP
298	RRe2De = 0.64952_JPRB ! before 3?R1 default=0.5_JPRB
299
300	!- RRTM as LW scheme
301	LRRTM = .FALSE.
302	LECMWF = .FALSE.
303	IF (iflag_rrtm.EQ.1) THEN
304	LRRTM = .TRUE.
305	LECMWF = .TRUE.
306	! LRRTM = .FALSE. ! Utiliser pour faire tourner le "vieux" rayonnement
307	! LECMWF = .FALSE.
308	ENDIF
309
310	!LRRTM = .FALSE.
311
312	!- SRTM as SW scheme
313	!!!!! A REVOIR (MPL) verifier signification de LSRTM
314	LSRTM = .FALSE. ! before 3?R1 default was .FALSE. true
315
316	! -- McICA treatment of cloud-radiation interactions
317	! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA)
318	NMcICA = 2 ! 2 for generalized overlap
319
320	!- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns)
321	NINHOM = 0 ! before 3?R1 default=1
322	NLAYINH = 0
323	RLWINHF = 1.0_JPRB ! before 3?R1 default=0.7
324	RSWINHF = 1.0_JPRB ! before 3?R1 default=0.7
325	!- Diffusivity correction a la Savijarvi
326	LDIFFC = .FALSE. ! before 31R1 default=.FALSE.
327
328	!- history of volcanic aerosols
329	LHVOLCA = .FALSE.
330	!- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
331	LNEWAER = .TRUE.
332	!!! cpl LNOTROAER=.FALSE.
333	LNOTROAER = .TRUE.
334	NPERTAER = 0
335
336	!- New Rayleigh formulation
337	LRAYL = .TRUE.
338
339	!- Number concentration of aerosols if specified
340	LCCNL = .TRUE. ! before 3?R1 default=.FALSE. true
341	LCCNO = .TRUE. ! before 3?R1 default=.FALSE. true
342	RCCNLND = 900._JPRB ! before 3?R1 default=900. now irrelevant
343	RCCNSEA = 50._JPRB ! before 3?R1 default=50. now irrelevant
344
345	!- interaction radiation / prognostic O3 off by default
346	LEPO3RA = .FALSE.
347	PRINT *, 'SUECRAD-0'
348	IF (.NOT.YO3%LGP) THEN
349	LEPO3RA = .FALSE.
350	ENDIF
351	RPERTOZ = 0._JPRB
352	NPERTOZ = 0
353
354	!NAER: CONFIGURATION INDEX FOR AEROSOLS
355	!!!!! A REVOIR (MPL) a mettre dans un fichier .def
356	NAER = 1
357	NMODE = 0
358	NOZOCL = 1
359	NRADFR = -3
360	IF (NSMAX >= 511) NRADFR = -1
361	NRADPFR = 0
362	NRADPLA = 15
363
364	! -- UV diagnostic of surface fluxes over the 280-400 nm interval
365	! with up-to 24 values (5 nm wide spectral intervals)
366	LUVPROC = .FALSE.
367	LUVTDEP = .TRUE.
368	LUVDBG = .FALSE.
369	NRADUV = -3
370	NUVTIM = 0
371	NUV = 24
372	RMUZUV = 1.E-01_JPRB
373	DO JUV = 1, NUV
374	RUVLAM(JUV) = 280._JPRB + (JUV - 1) * 5._JPRB
375	ENDDO
376
377	!- radiation interpolation (George M's grid on by default)
378	LLDEBUG = .TRUE.
379	LEDBUG = .FALSE.
380	NRADINT = 3
381	NRADRES = 0
382
383	NRINT = 4
384
385	LRADLB = .TRUE.
386	CRTABLEDIR = './'
387	CRTABLEFIL = 'not set'
388	LRADONDEM = .TRUE.
389	!GM Temporary as per trans/external/setup_trans.F90
390	LLINEAR_GRID = NSMAX > (NDLON + 3) / 3
391	IF(LLDEBUG)THEN
392	WRITE(NULOUT, '("SUECRAD: NSMAX=",I6)')NSMAX
393	WRITE(NULOUT, '("SUECRAD: NDLON=",I6)')NDLON
394	WRITE(NULOUT, '("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID
395	ENDIF
396
397	NUAER = 24
398	NTRAER = 15
399	! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH)
400	! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415)
401	SELECT CASE (overlap)
402	CASE (:1)
403	NOVLP = 2
404	CASE (2)
405	NOVLP = 3
406	CASE (3:)
407	NOVLP = 1
408	END SELECT
409	PRINT *, 'SUECRAD: NOVLP=', NOVLP
410	NLW = 16
411	NTSW = 14
412	!NSW = 6 !!!!! Maintenant dans config.def (MPL 20140213)
413	NSWNL = 6
414	NSWTL = 2
415	NCSRADF = 1
416	IF(NSMAX >= 106) THEN
417	NRPROMA = 80
418	ELSEIF(NSMAX == 63) THEN
419	NRPROMA = 48
420	ELSE
421	NRPROMA = 64
422	ENDIF
423
424	!* 2.3 SET SECURITY PARAMETERS
425	! -----------------------
426
427	REPSC = 1.E-04_JPRB
428	REPSCO = 1.E-12_JPRB
429	REPSCQ = 1.E-12_JPRB
430	REPSCT = 1.E-12_JPRB
431	REPSCW = 1.E-12_JPRB
432	REPLOG = 1.E-12_JPRB
433
434
435	!* 2.4 BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
436	! -----------------------------------------------
437
438	LECO2VAR = .FALSE.
439	LHGHG = .FALSE.
440	NHINCSOL = 0
441	NSCEN = 1
442	RSOLINC = RI0
443
444	! Valeurs d origine MPL 18052010
445	!RCCO2 = 353.E-06_JPRB
446	!RCCH4 = 1.72E-06_JPRB
447	!RCN2O = 310.E-09_JPRB
448	!RCCFC11 = 280.E-12_JPRB
449	!RCCFC12 = 484.E-12_JPRB
450
451	! Valeurs LMDZ (physiq.def) MPL 18052010
452	!RCCO2 = 348.E-06_JPRB
453	!RCCH4 = 1.65E-06_JPRB
454	!RCN2O = 306.E-09_JPRB
455	!RCCFC11 = 280.E-12_JPRB
456	!RCCFC12 = 484.E-12_JPRB
457
458	!MPL/IM 20160915 on prend GES de phylmd
459	RCCO2 = CO2_ppm * 1.0e-06
460	RCCH4 = CH4_ppb * 1.0e-09
461	RCN2O = N2O_ppb * 1.0e-09
462	RCCFC11 = CFC11_ppt * 1.0e-12
463	RCCFC12 = CFC12_ppt * 1.0e-12
464	!PRINT *,'LMDZSUECRAD-1 RCCO2=',RCCO2
465	!PRINT *,'LMDZSUECRAD-1 RCCH4=',RCCH4
466	!PRINT *,'LMDZSUECRAD-1 RCN2O=',RCN2O
467	!PRINT *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11
468	!PRINT *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12
469	! ------------------------------------------------------------------
470
471	!* 3. READ VALUES OF RADIATION CONFIGURATION
472	! --------------------------------------
473
474	!CALL POSNAM(NULNAM,'NAERAD')
475	!READ (NULNAM,NAERAD)
476	PRINT *, 'SUECRAD-2'
477
478	!CALL POSNAM(NULNAM,'NAEAER')
479	!READ (NULNAM,NAEAER)
480
481	!IF (NTYPAER(9) /= 0) THEN
482	! RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB
483	! RGELAV=RLONVOL*RPI/180._JPRB
484	! RCLONV=COS(RGELAV)
485	! RSLONV=SIN(RGELAV)
486	! DO J=1,NGPTOT-1
487	! IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. &
488	! & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN
489	! RDGMUV=ABS( RMU(J+1) - RMU(J))
490	! RDGLAV=ABS( GELAM(J+1)-GELAM(J) )
491	! RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) )
492	! RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) )
493	! END IF
494	! END DO
495	!END IF
496
497	!- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration)
498	IF (.NOT.LSRTM) THEN
499	NMcICA = 0
500	LCCNL = .FALSE.
501	LCCNO = .FALSE.
502	LDIFFC = .FALSE.
503	NICEOPT = 1
504	NLIQOPT = 0
505	NRADIP = 4
506	NRADLP = 3
507	RRe2De = 0.5_JPRB
508	NINHOM = 1
509	RLWINHF = 0.7_JPRB
510	RSWINHF = 0.7_JPRB
511	ENDIF
512	PRINT *, 'SUECRAD-3'
513
514	!- for McICA computations, make sure these parameters are as follows ...
515	IF (NMCICA /= 0) THEN
516	NINHOM = 0
517	RLWINHF = 1.0_JPRB
518	RSWINHF = 1.0_JPRB
519	!-- read the XCW values for Raisanen-Cole-Barker cloud generator
520	CALL SU_McICA
521	ENDIF
522	PRINT *, 'SUECRAD-4'
523
524	IF(LLDEBUG)THEN
525	WRITE(NULOUT, '("SUECRAD: NRADINT=",I2)')NRADINT
526	WRITE(NULOUT, '("SUECRAD: NRADRES=",I4)')NRADRES
527	ENDIF
528
529	! DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA
530
531	LOPTRPROMA = NRPROMA > 0
532	NRPROMA = ABS(NRPROMA)
533
534	IF(NRADINT > 0 .AND. NRADRES == NSMAX)THEN
535	WRITE(NULOUT, '("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
536	NRADINT = 0
537	ENDIF
538
539	IF(NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA)THEN
540	! This combination is not supported as aerosol data would be
541	! required to be interpolated (see radintg)
542	WRITE(NULOUT, '("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",&
543	& " NRADRES RESET TO NSMAX (NO INTERPOLATION)")')
544	NRADRES = NSMAX
545	ENDIF
546	!CALL GSTATS(1818,1) MPL 2.12.08
547
548	100 CONTINUE
549
550	IF(LERADI)THEN ! START OF LERADI BLOCK
551
552	IF(NRADINT == -1)THEN
553
554	! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION
555
556	LODBGRADI = .FALSE.
557	CALL SUECRADI
558
559	! INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
560	! LOAD BALANCING
561
562	LODBGRADL = .FALSE.
563	! CALL SUECRADL ! MPL 1.12.08
564	CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')
565
566	ELSEIF(NRADINT == 0)THEN
567
568	IF(NRADRES /= NSMAX)THEN
569	WRITE(NULOUT, '("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")')
570	NRADRES = NSMAX
571	ENDIF
572	RADGRID%NGPTOT = NGPTOT
573
574	NARIB1 = 0
575	NAROB1 = 0
576
577	ELSEIF(NRADINT >=1 .AND. NRADINT <= 3)THEN
578
579	NARIB1 = 0
580	NAROB1 = 0
581
582	! set the default radiation grid resolution for the current model resolution
583	! if not already specified
584	IF(NRADRES == 0)THEN
585	IF(LLINEAR_GRID)THEN ! RATIO OF GRID-POINTS (MODEL/RAD)
586	IF(NSMAX == 63)THEN
587	NRADRES = 21 ! 3.62
588	LLINEAR_GRID = .FALSE.
589	ENDIF
590	IF(NSMAX == 95) NRADRES = 95 ! 1.00
591	IF(NSMAX == 159) NRADRES = 63 ! 5.84
592	IF(NSMAX == 255) NRADRES = 95 ! 6.69
593	IF(NSMAX == 319) NRADRES = 159 ! 3.87
594	IF(NSMAX == 399) NRADRES = 159 ! 5.99
595	IF(NSMAX == 511) NRADRES = 255 ! 3.92
596	IF(NSMAX == 639) NRADRES = 319 ! 3.92
597	IF(NSMAX == 799) NRADRES = 399 ! 3.94
598	IF(NSMAX == 1023) NRADRES = 511 ! 3.94
599	IF(NSMAX == 1279) NRADRES = 639 !
600	IF(NSMAX == 2047) NRADRES = 1023 !
601	ELSE ! NOT LINEAR GRID
602	IF(NSMAX == 21) NRADRES = 21 ! 1.00
603	IF(NSMAX == 42) NRADRES = 21 ! 3.62
604	IF(NSMAX == 63) NRADRES = 42 ! 2.17
605	IF(NSMAX == 106) NRADRES = 63 ! 2.69
606	IF(NSMAX == 170) NRADRES = 63 ! 6.69
607	IF(NSMAX == 213) NRADRES = 106 ! 3.87
608	IF(NSMAX == 266) NRADRES = 106 ! 5.99
609	IF(NSMAX == 341) NRADRES = 170 ! 3.92
610	IF(NSMAX == 426) NRADRES = 213 ! 3.92
611	IF(NSMAX == 533) NRADRES = 266 ! 3.94
612	IF(NSMAX == 682) NRADRES = 341 ! 3.94
613	ENDIF
614	ENDIF
615	PRINT *, 'SUECRAD-5'
616
617	! test if radiation grid resolution has been set
618	IF(NRADRES == 0)THEN
619	WRITE(NULOUT, '("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX
620	CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND')
621	ENDIF
622
623	! test if no interpolation is required
624	IF(NRADINT > 0 .AND. NRADRES == NSMAX)THEN
625	WRITE(NULOUT, '("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
626	NRADINT = 0
627	GOTO 100
628	ENDIF
629
630	! CALL GSTATS(1818,0) MPL 2.12.08
631	IF(CRTABLEFIL == 'not set')THEN
632	IF(LLINEAR_GRID)THEN
633	IF(NRADRES < 1000)THEN
634	WRITE(CRTABLEFIL, '("rtablel_2",I3.3)')NRADRES
635	ELSE
636	WRITE(CRTABLEFIL, '("rtablel_2",I4.4)')NRADRES
637	ENDIF
638	ELSE
639	IF(NRADRES < 1000)THEN
640	WRITE(CRTABLEFIL, '("rtable_2" ,I3.3)')NRADRES
641	ELSE
642	WRITE(CRTABLEFIL, '("rtable_2" ,I4.4)')NRADRES
643	ENDIF
644	ENDIF
645	ENDIF
646	! CALL GSTATS(1818,1) MPL 2.12.08
647
648	RADGRID%NSMAX = NRADRES
649
650	IF(MYPROC == JPIOMASTER)THEN
651	IDIR = LEN_TRIM(CRTABLEDIR)
652	IFIL = LEN_TRIM(CRTABLEFIL)
653	CLFN = CRTABLEDIR(1:IDIR) // CRTABLEFIL(1:IFIL)
654	! Ce qui concerne NULRAD commente par MPL le 15.04.09
655	! OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999)
656	! GOTO 1000
657	! 999 CONTINUE
658	! WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN
659	! CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE')
660	! 1000 CONTINUE
661	NRGRI(:) = 0
662	! Ce qui concerne NAMRGRI commente par MPL le 15.04.09
663	! CALL POSNAM(NULRAD,'NAMRGRI')
664	! READ (NULRAD,NAMRGRI)
665	IDGL = 1
666	DO WHILE(NRGRI(IDGL)>0)
667	IF(LLDEBUG)THEN
668	WRITE(NULOUT, '("SUECRAD: NRGRI(",I4,")=",I4)')IDGL, NRGRI(IDGL)
669	ENDIF
670	IDGL = IDGL + 1
671	ENDDO
672	IDGL = IDGL - 1
673	RADGRID%NDGLG = IDGL
674	IF(LLDEBUG)THEN
675	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG
676	ENDIF
677	! CLOSE(NULRAD)
678	ENDIF
679	! CALL GSTATS(667,0) MPL 2.12.08
680	IF(NPROC > 1)THEN
681	stop 'Pas pret pour proc > 1'
682	! CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
683	ENDIF
684	ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG))
685	IF(MYPROC == JPIOMASTER)THEN
686	RADGRID%NRGRI(1:RADGRID%NDGLG) = NRGRI(1:RADGRID%NDGLG)
687	ENDIF
688	IF(NPROC > 1)THEN
689	stop 'Pas pret pour proc > 1'
690	! CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
691	ENDIF
692	! CALL GSTATS(667,1) MPL 2.12.08
693
694	! CALL GSTATS(1818,0) MPL 2.12.08
695	IF (NRADINT == 1)THEN
696	WRITE(NULOUT, '("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")')
697	RADGRID%NDGSUR = 0
698	NRIWIDEN = 0
699	NRIWIDES = 0
700	NRIWIDEW = 0
701	NRIWIDEE = 0
702	NROWIDEN = 0
703	NROWIDES = 0
704	NROWIDEW = 0
705	NROWIDEE = 0
706	ELSEIF(NRADINT == 2)THEN
707	WRITE(NULOUT, '("SUECRAD: INTERPOLATION METHOD - 4 POINT")')
708	RADGRID%NDGSUR = 2
709	ELSEIF(NRADINT == 3)THEN
710	WRITE(NULOUT, '("SUECRAD: INTERPOLATION METHOD - 12 POINT")')
711	RADGRID%NDGSUR = 2
712	ENDIF
713	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSUR =",I8)')RADGRID%NDGSUR
714
715	RADGRID%NDGSAG = 1 - RADGRID%NDGSUR
716	RADGRID%NDGENG = RADGRID%NDGLG + RADGRID%NDGSUR
717	RADGRID%NDLON = RADGRID%NRGRI(RADGRID%NDGLG / 2)
718	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSAG =",I8)')RADGRID%NDGSAG
719	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGENG =",I8)')RADGRID%NDGENG
720	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGLG =",I8)')RADGRID%NDGLG
721	WRITE(NULOUT, '("SUECRAD: RADGRID%NDLON =",I8)')RADGRID%NDLON
722	CALL FLUSH(NULOUT)
723
724	ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG))
725	RADGRID%NLOENG(1:RADGRID%NDGLG) = RADGRID%NRGRI(1:RADGRID%NDGLG)
726	IF(RADGRID%NDGSUR >= 1)THEN
727	DO JGLSUR = 1, RADGRID%NDGSUR
728	RADGRID%NLOENG(1 - JGLSUR) = RADGRID%NLOENG(JGLSUR)
729	ENDDO
730	DO JGLSUR = 1, RADGRID%NDGSUR
731	RADGRID%NLOENG(RADGRID%NDGLG + JGLSUR) = RADGRID%NLOENG(RADGRID%NDGLG + 1 - JGLSUR)
732	ENDDO
733	ENDIF
734	! CALL GSTATS(1818,1) MPL 2.12.08
735
736	! Setup the transform package for the radiation grid
737	CALL SETUP_TRANS (KSMAX = RADGRID%NSMAX, &
738	& KDGL = RADGRID%NDGLG, &
739	& KLOEN = RADGRID%NLOENG(1:RADGRID%NDGLG), &
740	& LDLINEAR_GRID = LLINEAR_GRID, &
741	& LDSPLIT = LSPLIT, &
742	& KAPSETS = NAPSETS, &
743	& KRESOL = RADGRID%NRESOL_ID)
744
745	ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG + N_REGIONS_NS - 1, N_REGIONS_EW))
746	ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG + N_REGIONS_NS - 1, N_REGIONS_EW))
747	ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS))
748	ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS))
749	ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS))
750	ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG))
751	ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG))
752	ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG))
753
754	! Interrogate the transform package for the radiation grid
755	! CALL GSTATS(1818,0) MPL 2.12.08
756	CALL TRANS_INQ (KRESOL = RADGRID%NRESOL_ID, &
757	& KSPEC2 = RADGRID%NSPEC2, &
758	& KNUMP = RADGRID%NUMP, &
759	& KGPTOT = RADGRID%NGPTOT, &
760	& KGPTOTG = RADGRID%NGPTOTG, &
761	& KGPTOTMX = RADGRID%NGPTOTMX, &
762	& KPTRFRSTLAT = RADGRID%NPTRFRSTLAT, &
763	& KFRSTLAT = RADGRID%NFRSTLAT, &
764	& KLSTLAT = RADGRID%NLSTLAT, &
765	& KFRSTLOFF = RADGRID%NFRSTLOFF, &
766	& KSTA = RADGRID%NSTA(1:RADGRID%NDGLG + N_REGIONS_NS - 1, :), &
767	& KONL = RADGRID%NONL(1:RADGRID%NDGLG + N_REGIONS_NS - 1, :), &
768	& KPTRFLOFF = RADGRID%NPTRFLOFF, &
769	& PMU = RADGRID%RMU(1:))
770
771	IF(NRADINT == 2 .OR. NRADINT == 3)THEN
772	DO JGL = 1, RADGRID%NDGLG
773	RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL) * RADGRID%RMU(JGL))
774	RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL))
775	! WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')&
776	! & JGL,RADGRID%RLATIG(JGL)
777	ENDDO
778	IF(RADGRID%NDGSUR >= 1)THEN
779	DO JGLSUR = 1, RADGRID%NDGSUR
780	RADGRID%RMU(1 - JGLSUR) = RADGRID%RMU(JGLSUR)
781	RADGRID%RSQM2(1 - JGLSUR) = RADGRID%RSQM2(JGLSUR)
782	RADGRID%RLATIG(1 - JGLSUR) = RPI - RADGRID%RLATIG(JGLSUR)
783	ENDDO
784	DO JGLSUR = 1, RADGRID%NDGSUR
785	RADGRID%RMU(RADGRID%NDGLG + JGLSUR) = RADGRID%RMU(RADGRID%NDGLG + 1 - JGLSUR)
786	RADGRID%RSQM2(RADGRID%NDGLG + JGLSUR) = RADGRID%RSQM2(RADGRID%NDGLG + 1 - JGLSUR)
787	RADGRID%RLATIG(RADGRID%NDGLG + JGLSUR) = -RPI - RADGRID%RLATIG(RADGRID%NDGLG + 1 - JGLSUR)
788	ENDDO
789	ENDIF
790	ENDIF
791
792	RADGRID%NDGSAL = 1
793	RADGRID%NDGENL = RADGRID%NLSTLAT(MY_REGION_NS) - RADGRID%NFRSTLOFF
794	RADGRID%NDSUR1 = 3 - MOD(RADGRID%NDLON, 2)
795	IDLSUR = MAX(RADGRID%NDLON, 2 * RADGRID%NSMAX + 1)
796	RADGRID%NDLSUR = IDLSUR + RADGRID%NDSUR1
797	RADGRID%MYFRSTACTLAT = RADGRID%NFRSTLAT(MY_REGION_NS)
798	RADGRID%MYLSTACTLAT = RADGRID%NLSTLAT(MY_REGION_NS)
799
800	WRITE(NULOUT, '("SUECRAD: RADGRID%NRESOL_ID =",I8)')RADGRID%NRESOL_ID
801	WRITE(NULOUT, '("SUECRAD: RADGRID%NSMAX =",I8)')RADGRID%NSMAX
802	WRITE(NULOUT, '("SUECRAD: RADGRID%NSPEC2 =",I8)')RADGRID%NSPEC2
803	WRITE(NULOUT, '("SUECRAD: RADGRID%NGPTOT =",I8)')RADGRID%NGPTOT
804	WRITE(NULOUT, '("SUECRAD: RADGRID%NGPTOTG =",I8)')RADGRID%NGPTOTG
805	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSAL =",I8)')RADGRID%NDGSAL
806	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGENL =",I8)')RADGRID%NDGENL
807	WRITE(NULOUT, '("SUECRAD: RADGRID%NDSUR1 =",I8)')RADGRID%NDSUR1
808	WRITE(NULOUT, '("SUECRAD: RADGRID%NDLSUR =",I8)')RADGRID%NDLSUR
809	WRITE(NULOUT, '("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT
810	WRITE(NULOUT, '("SUECRAD: RADGRID%MYLSTACTLAT =",I8)')RADGRID%MYLSTACTLAT
811	CALL FLUSH(NULOUT)
812
813	ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2))
814	ALLOCATE(RADGRID%MYMS(RADGRID%NUMP))
815	CALL TRANS_INQ (KRESOL = RADGRID%NRESOL_ID, &
816	& KASM0 = RADGRID%NASM0, &
817	& KMYMS = RADGRID%MYMS)
818
819	ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT))
820	ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT))
821	ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT))
822	ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT))
823	ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT))
824
825	IOFF = 0
826	ILAT = RADGRID%NPTRFLOFF
827	DO JGLAT = RADGRID%NFRSTLAT(MY_REGION_NS), &
828	& RADGRID%NLSTLAT(MY_REGION_NS)
829	ZGEMU = RADGRID%RMU(JGLAT)
830	ILAT = ILAT + 1
831	ISTLON = RADGRID%NSTA(ILAT, MY_REGION_EW)
832	IENDLON = ISTLON - 1 + RADGRID%NONL(ILAT, MY_REGION_EW)
833
834	DO JLON = ISTLON, IENDLON
835	ZLON = REAL(JLON - 1, JPRB) * 2.0_JPRB * RPI &
836	& / REAL(RADGRID%NLOENG(JGLAT), JPRB)
837	IOFF = IOFF + 1
838	RADGRID%GELAM(IOFF) = ZLON
839	RADGRID%GELAT(IOFF) = ASIN(ZGEMU)
840	RADGRID%GESLO(IOFF) = SIN(ZLON)
841	RADGRID%GECLO(IOFF) = COS(ZLON)
842	RADGRID%GEMU (IOFF) = ZGEMU
843	ENDDO
844	ENDDO
845
846	IF(NRADINT == 2 .OR. NRADINT == 3)THEN
847
848	! For grid point interpolations we need to calculate the halo size
849	! required by each processor
850
851	ALLOCATE(ZLATX(RADGRID%NGPTOTMX))
852	ALLOCATE(ZLONX(RADGRID%NGPTOTMX))
853	DO J = 1, RADGRID%NGPTOT
854	ZLATX(J) = RADGRID%GELAT(J) / RPI * 2.0_JPRB * 90.0
855	ZLONX(J) = (RADGRID%GELAM(J) - RPI) / RPI * 180.0
856	ENDDO
857	ZMINRADLAT = MINVAL(ZLATX(1:RADGRID%NGPTOT))
858	ZMAXRADLAT = MAXVAL(ZLATX(1:RADGRID%NGPTOT))
859	ZMINRADLON = MINVAL(ZLONX(1:RADGRID%NGPTOT))
860	ZMAXRADLON = MAXVAL(ZLONX(1:RADGRID%NGPTOT))
861	IF(LLDEBUG)THEN
862	WRITE(NULOUT, '("RADGRID,BEGIN")')
863	IF(MYPROC /= 1)THEN
864	stop 'Pas pret pour proc > 1'
865	! CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R')
866	! CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R')
867	! CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R')
868	ENDIF
869	IF(MYPROC == 1)THEN
870	DO JROC = 1, NPROC
871	IF(JROC == MYPROC)THEN
872	DO J = 1, RADGRID%NGPTOT
873	WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6)')ZLATX(J), ZLONX(J), MYPROC
874	ENDDO
875	ELSE
876	stop 'Pas pret pour proc > 1'
877	! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M')
878	! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M')
879	! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M')
880	DO J = 1, IGPTOT
881	WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6)')ZLATX(J), ZLONX(J), JROC
882	ENDDO
883	ENDIF
884	ENDDO
885	ENDIF
886	WRITE(NULOUT, '("RADGRID,END")')
887	ENDIF
888	DEALLOCATE(ZLATX)
889	DEALLOCATE(ZLONX)
890
891	ALLOCATE(ZLATX(NGPTOTMX))
892	ALLOCATE(ZLONX(NGPTOTMX))
893	DO J = 1, NGPTOT
894	ZLATX(J) = GELAT(J) / RPI * 2.0_JPRB * 90.0
895	ZLONX(J) = (GELAM(J) - RPI) / RPI * 180.0
896	ENDDO
897	ZMINMDLLAT = MINVAL(ZLATX(1:NGPTOT))
898	ZMAXMDLLAT = MAXVAL(ZLATX(1:NGPTOT))
899	ZMINMDLLON = MINVAL(ZLONX(1:NGPTOT))
900	ZMAXMDLLON = MAXVAL(ZLONX(1:NGPTOT))
901	IF(LLDEBUG)THEN
902	WRITE(NULOUT, '("MODELGRID,BEGIN")')
903	IF(MYPROC /= 1)THEN
904	stop 'Pas pret pour proc > 1'
905	! CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD')
906	! CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD')
907	! CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD')
908	! CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD')
909	ENDIF
910	IF(MYPROC == 1)THEN
911	DO JROC = 1, NPROC
912	IF(JROC == MYPROC)THEN
913	DO J = 1, NGPTOT
914	WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J), ZLONX(J), MYPROC, NGLOBALINDEX(J)
915	ENDDO
916	ELSE
917	stop 'Pas pret pour proc > 1'
918	! CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD')
919	! CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD')
920	! CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD')
921	ALLOCATE(IGLOBALINDEX(1:IGPTOT))
922	! CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD')
923	DO J = 1, IGPTOT
924	WRITE(NULOUT, '(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J), ZLONX(J), JROC, IGLOBALINDEX(J)
925	ENDDO
926	DEALLOCATE(IGLOBALINDEX)
927	ENDIF
928	ENDDO
929	ENDIF
930	WRITE(NULOUT, '("MODELGRID,END")')
931	ENDIF
932	DEALLOCATE(ZLATX)
933	DEALLOCATE(ZLONX)
934
935	IF(LLDEBUG)THEN
936	WRITE(NULOUT, '("ZMINRADLAT=",F10.2)')ZMINRADLAT
937	WRITE(NULOUT, '("ZMINMDLLAT=",F10.2)')ZMINMDLLAT
938	WRITE(NULOUT, '("ZMAXRADLAT=",F10.2)')ZMAXRADLAT
939	WRITE(NULOUT, '("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT
940	WRITE(NULOUT, '("ZMINRADLON=",F10.2)')ZMINRADLON
941	WRITE(NULOUT, '("ZMINMDLLON=",F10.2)')ZMINMDLLON
942	WRITE(NULOUT, '("ZMAXRADLON=",F10.2)')ZMAXRADLON
943	WRITE(NULOUT, '("ZMAXMDLLON=",F10.2)')ZMAXMDLLON
944	ENDIF
945
946	ZLAT = NDGLG / 180.
947	ILATS_DIFF_C = CEILING(ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
948	ILATS_DIFF_F = FLOOR (ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
949	IF(ZMINRADLAT < ZMINMDLLAT)THEN
950	NRIWIDES = JP_MIN_HALO + ILATS_DIFF_C
951	ELSE
952	NRIWIDES = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
953	ENDIF
954	ILATS_DIFF_C = CEILING(ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
955	ILATS_DIFF_F = FLOOR (ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
956	IF(ZMAXRADLAT < ZMAXMDLLAT)THEN
957	NRIWIDEN = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
958	ELSE
959	NRIWIDEN = JP_MIN_HALO + ILATS_DIFF_C
960	ENDIF
961	ILATS_DIFF_C = CEILING(ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
962	ILATS_DIFF_F = FLOOR (ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
963	IF(ZMINRADLON < ZMINMDLLON)THEN
964	NRIWIDEW = JP_MIN_HALO + ILATS_DIFF_C
965	ELSE
966	NRIWIDEW = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
967	ENDIF
968	ILATS_DIFF_C = CEILING(ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
969	ILATS_DIFF_F = FLOOR (ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
970	IF(ZMAXRADLON < ZMAXMDLLON)THEN
971	NRIWIDEE = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
972	ELSE
973	NRIWIDEE = JP_MIN_HALO + ILATS_DIFF_C
974	ENDIF
975
976	ZLAT = RADGRID%NDGLG / 180.
977	ILATS_DIFF_C = CEILING(ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
978	ILATS_DIFF_F = FLOOR (ABS(ZMINRADLAT - ZMINMDLLAT) * ZLAT)
979	IF(ZMINMDLLAT < ZMINRADLAT)THEN
980	NROWIDES = JP_MIN_HALO + ILATS_DIFF_C
981	ELSE
982	NROWIDES = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
983	ENDIF
984	ILATS_DIFF_C = CEILING(ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
985	ILATS_DIFF_F = FLOOR (ABS(ZMAXRADLAT - ZMAXMDLLAT) * ZLAT)
986	IF(ZMAXMDLLAT < ZMAXRADLAT)THEN
987	NROWIDEN = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
988	ELSE
989	NROWIDEN = JP_MIN_HALO + ILATS_DIFF_C
990	ENDIF
991	ILATS_DIFF_C = CEILING(ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
992	ILATS_DIFF_F = FLOOR (ABS(ZMINRADLON - ZMINMDLLON) * ZLAT)
993	IF(ZMINMDLLON < ZMINRADLON)THEN
994	NROWIDEW = JP_MIN_HALO + ILATS_DIFF_C
995	ELSE
996	NROWIDEW = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
997	ENDIF
998	ILATS_DIFF_C = CEILING(ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
999	ILATS_DIFF_F = FLOOR (ABS(ZMAXRADLON - ZMAXMDLLON) * ZLAT)
1000	IF(ZMAXMDLLON < ZMAXRADLON)THEN
1001	NROWIDEE = MAX(0, JP_MIN_HALO - ILATS_DIFF_F)
1002	ELSE
1003	NROWIDEE = JP_MIN_HALO + ILATS_DIFF_C
1004	ENDIF
1005
1006	ENDIF
1007
1008	RADGRID%NDGSAH = MAX(RADGRID%NDGSAG, &
1009	& RADGRID%NDGSAL + RADGRID%NFRSTLOFF - NROWIDEN) - RADGRID%NFRSTLOFF
1010	RADGRID%NDGENH = MIN(RADGRID%NDGENG, &
1011	& RADGRID%NDGENL + RADGRID%NFRSTLOFF + NROWIDES) - RADGRID%NFRSTLOFF
1012	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGSAH =",I8)')RADGRID%NDGSAH
1013	WRITE(NULOUT, '("SUECRAD: RADGRID%NDGENH =",I8)')RADGRID%NDGENH
1014
1015	IF(NRADINT == 2 .OR. NRADINT == 3)THEN
1016
1017	ILBRLATI = MAX(RADGRID%NDGSAG, &
1018	& RADGRID%NDGSAL + RADGRID%NFRSTLOFF - NROWIDEN) - RADGRID%NFRSTLOFF
1019	IUBRLATI = MIN(RADGRID%NDGENG, &
1020	& RADGRID%NDGENL + RADGRID%NFRSTLOFF + NROWIDES) - RADGRID%NFRSTLOFF
1021	ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI))
1022	ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI))
1023	ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI))
1024	ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI))
1025
1026	DO JGL = ILBRLATI, IUBRLATI
1027	IGLGLO = JGL + RADGRID%NFRSTLOFF
1028	IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN
1029	ZD1 = RADGRID%RLATIG(IGLGLO - 1) - RADGRID%RLATIG(IGLGLO)
1030	ZD2 = RADGRID%RLATIG(IGLGLO - 1) - RADGRID%RLATIG(IGLGLO + 1)
1031	ZD3 = RADGRID%RLATIG(IGLGLO - 1) - RADGRID%RLATIG(IGLGLO + 2)
1032	ZD4 = RADGRID%RLATIG(IGLGLO) - RADGRID%RLATIG(IGLGLO + 1)
1033	ZD5 = RADGRID%RLATIG(IGLGLO) - RADGRID%RLATIG(IGLGLO + 2)
1034	ZD6 = RADGRID%RLATIG(IGLGLO + 1) - RADGRID%RLATIG(IGLGLO + 2)
1035	RADGRID%RIPI0(JGL) = -1.0_JPRB / (ZD1 * ZD4 * ZD5)
1036	RADGRID%RIPI1(JGL) = 1.0_JPRB / (ZD2 * ZD4 * ZD6)
1037	RADGRID%RIPI2(JGL) = -1.0_JPRB / (ZD3 * ZD5 * ZD6)
1038	ENDIF
1039	RADGRID%RLATI(JGL) = RADGRID%RLATIG(IGLGLO)
1040	ENDDO
1041
1042	IF(NPROC > 1)THEN
1043	IRIRPTSUR = NGPTOTG
1044	IRISPTSUR = 2 * NGPTOTG
1045	ELSE
1046	IRIRPTSUR = 0
1047	IRISPTSUR = 0
1048	ENDIF
1049
1050	ALLOCATE(NRISTA(NDGSAL - NRIWIDEN:NDGENL + NRIWIDES))
1051	ALLOCATE(NRIONL(NDGSAL - NRIWIDEN:NDGENL + NRIWIDES))
1052	ALLOCATE(NRIOFF(NDGSAL - NRIWIDEN:NDGENL + NRIWIDES))
1053	ALLOCATE(NRIEXT(1 - NDLON:NDLON + NDLON, 1 - NRIWIDEN:NDGENL + NRIWIDES))
1054	ALLOCATE(NRICORE(NGPTOT))
1055	ALLOCATE(IRISENDPOS(IRISPTSUR))
1056	ALLOCATE(IRIRECVPOS(IRIRPTSUR))
1057	ALLOCATE(IRISENDPTR(NPROC + 1))
1058	ALLOCATE(IRIRECVPTR(NPROC + 1))
1059	ALLOCATE(IRICOMM(NPROC))
1060	ALLOCATE(IRIMAP(4, NDGLG))
1061	! MPL 1.12.08
1062	! CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,&
1063	! & IRIRPTSUR,IRISPTSUR,&
1064	! & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,&
1065	! & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,&
1066	! & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
1067	! & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,&
1068	! & RMU,RSQM2,&
1069	! & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,&
1070	! & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,&
1071	! & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN)
1072	CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
1073	WRITE(NULOUT, '("SUECRAD: NARIB1=",I12)')NARIB1
1074	ALLOCATE(NRISENDPOS(NRISPT))
1075	ALLOCATE(NRIRECVPOS(NRIRPT))
1076	ALLOCATE(NRISENDPTR(NRIPROCS + 1))
1077	ALLOCATE(NRIRECVPTR(NRIPROCS + 1))
1078	ALLOCATE(NRICOMM(NRIPROCS))
1079	NRISENDPOS(1:NRISPT) = IRISENDPOS(1:NRISPT)
1080	NRIRECVPOS(1:NRIRPT) = IRIRECVPOS(1:NRIRPT)
1081	NRISENDPTR(1:NRIPROCS + 1) = IRISENDPTR(1:NRIPROCS + 1)
1082	NRIRECVPTR(1:NRIPROCS + 1) = IRIRECVPTR(1:NRIPROCS + 1)
1083	NRICOMM(1:NRIPROCS) = IRICOMM(1:NRIPROCS)
1084	DEALLOCATE(IRISENDPOS)
1085	DEALLOCATE(IRIRECVPOS)
1086	DEALLOCATE(IRISENDPTR)
1087	DEALLOCATE(IRIRECVPTR)
1088	DEALLOCATE(IRICOMM)
1089	DEALLOCATE(IRIMAP)
1090
1091	IF(NPROC > 1)THEN
1092	IRORPTSUR = RADGRID%NGPTOTG
1093	IROSPTSUR = 2 * RADGRID%NGPTOTG
1094	ELSE
1095	IRORPTSUR = 0
1096	IROSPTSUR = 0
1097	ENDIF
1098
1099	ALLOCATE(NROSTA(RADGRID%NDGSAL - NROWIDEN:RADGRID%NDGENL + NROWIDES))
1100	ALLOCATE(NROONL(RADGRID%NDGSAL - NROWIDEN:RADGRID%NDGENL + NROWIDES))
1101	ALLOCATE(NROOFF(RADGRID%NDGSAL - NROWIDEN:RADGRID%NDGENL + NROWIDES))
1102	ALLOCATE(NROEXT(1 - RADGRID%NDLON:RADGRID%NDLON + RADGRID%NDLON, &
1103	& 1 - NROWIDEN:RADGRID%NDGENL + NROWIDES))
1104	ALLOCATE(NROCORE(RADGRID%NGPTOT))
1105	ALLOCATE(IROSENDPOS(IROSPTSUR))
1106	ALLOCATE(IRORECVPOS(IRORPTSUR))
1107	ALLOCATE(IROSENDPTR(NPROC + 1))
1108	ALLOCATE(IRORECVPTR(NPROC + 1))
1109	ALLOCATE(IROCOMM(NPROC))
1110	ALLOCATE(IROMAP(4, RADGRID%NDGLG))
1111	! MPL 1.12.08
1112	! CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,&
1113	! & IRORPTSUR,IROSPTSUR,&
1114	! & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,&
1115	! & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,&
1116	! & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,&
1117	! & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,&
1118	! & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,&
1119	! & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,&
1120	! & RADGRID%RMU,RADGRID%RSQM2,&
1121	! & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,&
1122	! & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,&
1123	! & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN)
1124	CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
1125	WRITE(NULOUT, '("SUECRAD: NAROB1=",I12)')NAROB1
1126	ALLOCATE(NROSENDPOS(NROSPT))
1127	ALLOCATE(NRORECVPOS(NRORPT))
1128	ALLOCATE(NROSENDPTR(NROPROCS + 1))
1129	ALLOCATE(NRORECVPTR(NROPROCS + 1))
1130	ALLOCATE(NROCOMM(NROPROCS))
1131	NROSENDPOS(1:NROSPT) = IROSENDPOS(1:NROSPT)
1132	NRORECVPOS(1:NRORPT) = IRORECVPOS(1:NRORPT)
1133	NROSENDPTR(1:NROPROCS + 1) = IROSENDPTR(1:NROPROCS + 1)
1134	NRORECVPTR(1:NROPROCS + 1) = IRORECVPTR(1:NROPROCS + 1)
1135	NROCOMM(1:NROPROCS) = IROCOMM(1:NROPROCS)
1136	DEALLOCATE(IROSENDPOS)
1137	DEALLOCATE(IRORECVPOS)
1138	DEALLOCATE(IROSENDPTR)
1139	DEALLOCATE(IRORECVPTR)
1140	DEALLOCATE(IROCOMM)
1141	DEALLOCATE(IROMAP)
1142
1143	IF(LLDEBUG)THEN
1144	WRITE(NULOUT, '("")')
1145	IRIWIDEMAXN = 0
1146	IRIWIDEMAXS = 0
1147	IRIWIDEMAXW = 0
1148	IRIWIDEMAXE = 0
1149	IROWIDEMAXN = 0
1150	IROWIDEMAXS = 0
1151	IROWIDEMAXW = 0
1152	IROWIDEMAXE = 0
1153	IARIB1MAX = 0
1154	IAROB1MAX = 0
1155	IWIDE(1) = NRIWIDEN
1156	IWIDE(2) = NRIWIDES
1157	IWIDE(3) = NRIWIDEW
1158	IWIDE(4) = NRIWIDEE
1159	IWIDE(5) = NROWIDEN
1160	IWIDE(6) = NROWIDES
1161	IWIDE(7) = NROWIDEW
1162	IWIDE(8) = NROWIDEE
1163	IWIDE(9) = NARIB1
1164	IWIDE(10) = NAROB1
1165	IF(MYPROC /= 1)THEN
1166	stop 'Pas pret pour proc > 1'
1167	! CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W')
1168	ENDIF
1169	IF(MYPROC == 1)THEN
1170	DO JROC = 1, NPROC
1171	IF(JROC /= MYPROC)THEN
1172	stop 'Pas pret pour proc > 1'
1173	! CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W')
1174	ENDIF
1175	WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')&
1176	& JROC, IWIDE(1), IWIDE(5)
1177	WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')&
1178	& JROC, IWIDE(2), IWIDE(6)
1179	WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')&
1180	& JROC, IWIDE(3), IWIDE(7)
1181	WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')&
1182	& JROC, IWIDE(4), IWIDE(8)
1183	WRITE(NULOUT, '("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')&
1184	& JROC, IWIDE(9), IWIDE(10)
1185	WRITE(NULOUT, '("")')
1186	IF(IWIDE(1) > IRIWIDEMAXN) IRIWIDEMAXN = IWIDE(1)
1187	IF(IWIDE(2) > IRIWIDEMAXS) IRIWIDEMAXS = IWIDE(2)
1188	IF(IWIDE(3) > IRIWIDEMAXW) IRIWIDEMAXW = IWIDE(3)
1189	IF(IWIDE(4) > IRIWIDEMAXE) IRIWIDEMAXE = IWIDE(4)
1190	IF(IWIDE(5) > IROWIDEMAXN) IROWIDEMAXN = IWIDE(5)
1191	IF(IWIDE(6) > IROWIDEMAXS) IROWIDEMAXS = IWIDE(6)
1192	IF(IWIDE(7) > IROWIDEMAXW) IROWIDEMAXW = IWIDE(7)
1193	IF(IWIDE(8) > IROWIDEMAXE) IROWIDEMAXE = IWIDE(8)
1194	IF(IWIDE(9) > IARIB1MAX) IARIB1MAX = IWIDE(9)
1195	IF(IWIDE(10) > IAROB1MAX) IAROB1MAX = IWIDE(10)
1196	ENDDO
1197	WRITE(NULOUT, '("")')
1198	WRITE(NULOUT, '("SUECRAD: NRIWIDEN(MAX) =",I8)')IRIWIDEMAXN
1199	WRITE(NULOUT, '("SUECRAD: NRIWIDES(MAX) =",I8)')IRIWIDEMAXS
1200	WRITE(NULOUT, '("SUECRAD: NRIWIDEW(MAX) =",I8)')IRIWIDEMAXW
1201	WRITE(NULOUT, '("SUECRAD: NRIWIDEE(MAX) =",I8)')IRIWIDEMAXE
1202	WRITE(NULOUT, '("SUECRAD: NROWIDEN(MAX) =",I8)')IROWIDEMAXN
1203	WRITE(NULOUT, '("SUECRAD: NROWIDES(MAX) =",I8)')IROWIDEMAXS
1204	WRITE(NULOUT, '("SUECRAD: NROWIDEW(MAX) =",I8)')IROWIDEMAXW
1205	WRITE(NULOUT, '("SUECRAD: NROWIDEE(MAX) =",I8)')IROWIDEMAXE
1206	WRITE(NULOUT, '("SUECRAD: NARIB1(MAX) =",I10)')IARIB1MAX
1207	WRITE(NULOUT, '("SUECRAD: NAROB1(MAX) =",I10)')IAROB1MAX
1208	WRITE(NULOUT, '("")')
1209	ENDIF
1210	CALL FLUSH(NULOUT)
1211	ENDIF
1212
1213	ENDIF
1214	! CALL GSTATS(1818,1) MPL 2.12.08
1215
1216	ELSE
1217
1218	WRITE(NULOUT, '("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT
1219	CALL ABOR1('SUECRAD: NRADINT INVALID')
1220
1221	ENDIF
1222
1223	ENDIF ! END OF LERADI BLOCK
1224
1225	! ----------------------------------------------------------------
1226
1227	!* 4. INITIALIZE RADIATION COEFFICIENTS.
1228	! ----------------------------------
1229
1230	RCDAY = RDAY * RG / RCPD
1231	DIFF = 1.66_JPRB
1232	R10E = 0.4342945_JPRB
1233
1234	! CALL GSTATS(1818,0) MPL 2.12.08
1235	CALL SURDI
1236
1237	IF (NINHOM == 0) THEN
1238	RLWINHF = 1._JPRB
1239	RSWINHF = 1._JPRB
1240	ENDIF
1241
1242	! ----------------------------------------------------------------
1243
1244	!* 5. INITIALIZE RADIATION ABSORPTION COEFFICIENTS
1245	! --------------------------------------------
1246
1247	!* 5.1. Initialization routine for RRTM
1248	! -------------------------------
1249
1250	CALL SURRTAB
1251	CALL SURRTPK
1252	CALL SURRTRF
1253	CALL SURRTFTR
1254
1255	IF (LRRTM) THEN
1256	IF (KLEV > JPLAY) THEN
1257	WRITE(UNIT = KULOUT, &
1258	& FMT = '('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',&
1259	& '' CALL ABORT'')')
1260	CALL ABOR1(' ABOR1 CALLED SUECRAD')
1261	ENDIF
1262
1263	! Read the absorption coefficient data and reduce from 256 to 140 g-points
1264
1265	CALL RRTM_INIT_140GP
1266
1267	INBLW = 16
1268
1269	ELSE
1270	INBLW = 6
1271
1272	ENDIF
1273
1274	CALL SULWN
1275	CALL SUSWN (NTSW, NSW)
1276	CALL SUCLOPN (NTSW, NSW, KLEV)
1277
1278	!-- routines specific to SRTM
1279	IF (LSRTM) THEN
1280	NTSW = 14
1281	ISW = 14
1282	CALL SRTM_INIT
1283	CALL SUSRTAER
1284	CALL SUSRTCOP
1285	WRITE(UNIT = KULOUT, FMT = '(''SRTM Configuration'',L8,3I4)')LSRTM, NTSW, ISW, JPGPT
1286
1287	ELSE
1288	IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6))) THEN
1289	WRITE(UNIT = KULOUT, FMT = '(''Wrong SW Configuration'',L8,I3)')LONEWSW, NSW
1290	ENDIF
1291
1292	CALL SUSWN (NTSW, NSW)
1293	CALL SUAERSN (NTSW, NSW)
1294	ENDIF
1295	WRITE(UNIT = KULOUT, FMT = '('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW, NTSW, NSW
1296
1297
1298	!-- routine specific to the UV processor
1299	IF (LUVPROC) THEN
1300	NUVTIM = NUVTIM * 86400
1301	CALL SU_UVRAD (NUV)
1302	ENDIF
1303
1304	! ----------------------------------------------------------------
1305
1306	!* 6. INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
1307	! ------------------------------------------------------
1308
1309	!- LW optical properties
1310	CALL SUAERL
1311	!- SW optical properties moved above
1312	!CALL SUAERSN (NTSW,NSW)
1313
1314	!- horizontal distribution
1315	CALL SUAERH
1316
1317	!- vertical distribution
1318	CALL SUAERV (KLEV, PETAH, &
1319	& CVDAES, CVDAEL, CVDAEU, CVDAED, &
1320	& RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU, &
1321	& RCAEOPD, RCTRPT, RCAEADK, RCAEADM, RCAEROS &
1322	&)
1323
1324	!-- Overlap function (only used if NOVLP=4)
1325	! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise
1326	! sinon il faudrait calculer le geopotentiel STZ
1327	!CALL SUOVLP ( KLEV )
1328
1329	!-- parameters for prognostic aerosols
1330	CALL SU_AERW
1331
1332	! ----------------------------------------------------------------
1333
1334	!* 7. INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
1335	! -------------------------------------------------------
1336
1337	IF (LEPHYS .AND. NMODE > 1) THEN
1338	CALL SUSAT
1339	ENDIF
1340	!CALL GSTATS(1818,1) MPL 2.12.08
1341
1342	! ----------------------------------------------------------------
1343
1344	!* 8. INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
1345	! --------------------------------------------
1346	! (not done here!!! called from APLPAR as it depends
1347	! on model pressure levels!)
1348
1349	! ----------------------------------------------------------------
1350
1351	!* 9. SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
1352	! -------------------------------------------------------
1353
1354	ZTSTEP = MAX(TSTEP, 1.0_JPRB)
1355	ZSTPHR = 3600._JPRB / ZTSTEP
1356	IRADFR = NRADFR
1357	IF(NRADFR < 0) THEN
1358	NRADFR = -NRADFR * ZSTPHR + 0.5_JPRB
1359	ENDIF
1360	NRADPFR = NRADPFR * NRADFR
1361	IF (MOD(NRADPLA, 2) == 0.AND. NRADPLA /= 0) THEN
1362	NRADPLA = NRADPLA + 1
1363	ENDIF
1364
1365	IF(NRADUV < 0) THEN
1366	NRADUV = -NRADUV * ZSTPHR + 0.5_JPRB
1367	ENDIF
1368
1369	IST1HR = ZSTPHR + 0.05_JPRB
1370	ISTNHR = NLNGR1H * ZSTPHR + 0.05_JPRB
1371	IF (MOD(3600._JPRB, ZTSTEP) > 0.1_JPRB) THEN
1372	801 CONTINUE
1373	IST1HR = IST1HR + 1
1374	IF (MOD(ISTNHR, IST1HR) /= 0) GO TO 801
1375	ENDIF
1376	IF (NRADFR == 1) THEN
1377	NRADSFR = NRADFR
1378	ELSE
1379	NRADSFR = IST1HR
1380	ENDIF
1381	NRADNFR = NRADFR
1382
1383	IF(LRAYFM) THEN
1384	NRPROMA = NDLON + 6 + (1 - MOD(NDLON, 2))
1385	ENDIF
1386
1387	! ----------------------------------------------------------------
1388
1389	!* 10. ALLOCATE WORK ARRAYS
1390	! --------------------
1391
1392	IU = NULOUT
1393	LLP = NPRINTLEV >= 1.OR. LALLOPR
1394
1395	IF (LEPHYS) THEN
1396	ALLOCATE(EMTD(NPROMA, NFLEVG + 1, NGPBLKS))
1397	IF(LLP)WRITE(IU, 9) 'EMTD ', SIZE(EMTD), SHAPE(EMTD)
1398	ALLOCATE(TRSW(NPROMA, NFLEVG + 1, NGPBLKS))
1399	IF(LLP)WRITE(IU, 9) 'TRSW ', SIZE(TRSW), SHAPE(TRSW)
1400	ALLOCATE(EMTC(NPROMA, NFLEVG + 1, NGPBLKS))
1401	IF(LLP)WRITE(IU, 9) 'EMTC ', SIZE(EMTC), SHAPE(EMTC)
1402	ALLOCATE(TRSC(NPROMA, NFLEVG + 1, NGPBLKS))
1403	IF(LLP)WRITE(IU, 9) 'TRSC ', SIZE(TRSC), SHAPE(TRSC)
1404	ALLOCATE(SRSWD(NPROMA, NGPBLKS))
1405	IF(LLP)WRITE(IU, 9) 'SRSWD ', SIZE(SRSWD), SHAPE(SRSWD)
1406	ALLOCATE(SRLWD(NPROMA, NGPBLKS))
1407	IF(LLP)WRITE(IU, 9) 'SRLWD ', SIZE(SRLWD), SHAPE(SRLWD)
1408	ALLOCATE(SRSWDCS(NPROMA, NGPBLKS))
1409	IF(LLP)WRITE(IU, 9) 'SRSWDCS ', SIZE(SRSWDCS), SHAPE(SRSWDCS)
1410	ALLOCATE(SRLWDCS(NPROMA, NGPBLKS))
1411	IF(LLP)WRITE(IU, 9) 'SRLWDCS ', SIZE(SRLWDCS), SHAPE(SRLWDCS)
1412	ALLOCATE(SRSWDV(NPROMA, NGPBLKS))
1413	IF(LLP)WRITE(IU, 9) 'SRSWDV ', SIZE(SRSWDV), SHAPE(SRSWDV)
1414	ALLOCATE(SRSWDUV(NPROMA, NGPBLKS))
1415	IF(LLP)WRITE(IU, 9) 'SRSWDUV ', SIZE(SRSWDUV), SHAPE(SRSWDUV)
1416	ALLOCATE(EDRO(NPROMA, NGPBLKS))
1417	IF(LLP)WRITE(IU, 9) 'EDRO ', SIZE(EDRO), SHAPE(EDRO)
1418	ALLOCATE(SRSWPAR(NPROMA, NGPBLKS))
1419	IF(LLP)WRITE(IU, 9) 'SRSWPAR ', SIZE(SRSWPAR), SHAPE(SRSWPAR)
1420	ALLOCATE(SRSWUVB(NPROMA, NGPBLKS))
1421	IF(LLP)WRITE(IU, 9) 'SRSWUVB ', SIZE(SRSWUVB), SHAPE(SRSWUVB)
1422
1423	ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN
1424	ALLOCATE(EMTD(NPROMA, NFLEVG + 1, NGPBLKS))
1425	IF(LLP)WRITE(IU, 9) 'EMTD ', SIZE(EMTD), SHAPE(EMTD)
1426	ALLOCATE(TRSW(NPROMA, NFLEVG + 1, NGPBLKS))
1427	IF(LLP)WRITE(IU, 9) 'TRSW ', SIZE(TRSW), SHAPE(TRSW)
1428	ALLOCATE(EMTU(NPROMA, NFLEVG + 1, NGPBLKS))
1429	IF(LLP)WRITE(IU, 9) 'EMTC ', SIZE(EMTU), SHAPE(EMTU)
1430	ALLOCATE(RMOON(NPROMA, NGPBLKS))
1431	IF(LLP)WRITE(IU, 9) 'RMOON ', SIZE(RMOON), SHAPE(RMOON)
1432	ENDIF
1433	ALLOCATE(SRSWPARC(NPROMA, NGPBLKS))
1434	IF(LLP)WRITE(IU, 9) 'SRSWPARC ', SIZE(SRSWPARC), SHAPE(SRSWPARC)
1435	ALLOCATE(SRSWTINC(NPROMA, NGPBLKS))
1436	IF(LLP)WRITE(IU, 9) 'SRSWTINC ', SIZE(SRSWTINC), SHAPE(SRSWTINC)
1437
1438	9 FORMAT(1X, 'ARRAY ', A10, ' ALLOCATED ', 8I8)
1439
1440	! ----------------------------------------------------------------
1441
1442	!* 10. PRINT FINAL VALUES.
1443	! -------------------
1444
1445	IF (LOUTPUT) THEN
1446	WRITE(UNIT = KULOUT, FMT = '('' COMMON YOERAD '')')
1447	WRITE(UNIT = KULOUT, FMT = '('' LERADI = '',L5 &
1448	& ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 &
1449	& ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')&
1450	& LERADI, LERAD1H, LECO2VAR, LHGHG, NLNGR1H, NRADSFR
1451	WRITE(UNIT = KULOUT, FMT = '('' LEPO3RA = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA, YO3%LGP
1452	WRITE(UNIT = KULOUT, FMT = '('' NRADFR = '',I2 &
1453	& ,'' NRADPFR = '',I3 &
1454	& ,'' NRADPLA = '',I2 &
1455	& ,'' NRINT = '',I1 &
1456	& ,'' NRPROMA = '',I5 &
1457	& )')&
1458	& NRADFR, NRADPFR, NRADPLA, NRINT, NRPROMA
1459	WRITE(UNIT = KULOUT, FMT = '('' LERADHS= '',L5 &
1460	& ,'' LRRTM = '',L5 &
1461	& ,'' LSRTM = '',L5 &
1462	& ,'' NMODE = '',I1 &
1463	& ,'' NOZOCL= '',I1 &
1464	& ,'' NAER = '',I1 &
1465	& ,'' NHINCSOL='',I2 &
1466	& )')&
1467	& LERADHS, LRRTM, LSRTM, NMODE, NOZOCL, NAER, NHINCSOL
1468	IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT = KULOUT, FMT = '('' RCCO2= '',E10.3 &
1469	&,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 &
1470	&)')&
1471	& RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12
1472	WRITE(UNIT = KULOUT, FMT = '('' NINHOM = '',I1 &
1473	& ,'' NLAYINH='',I1 &
1474	& ,'' RLWINHF='',F4.2 &
1475	& ,'' RSWINHF='',F4.2 &
1476	& )')&
1477	& NINHOM, NLAYINH, RLWINHF, RSWINHF
1478	IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN
1479	WRITE(UNIT = KULOUT, FMT = '('' NPERTAER= '',I2 &
1480	& ,'' LNOTROAER='',L5 &
1481	& ,'' NPERTOZ = '',I1 &
1482	& ,'' RPERTOZ = '',F5.0 &
1483	& )')&
1484	& NPERTAER, LNOTROAER, NPERTOZ, RPERTOZ
1485	ENDIF
1486	WRITE(UNIT = KULOUT, FMT = '('' NRADINT = '',I2)')NRADINT
1487	WRITE(UNIT = KULOUT, FMT = '('' NRADRES = '',I4)')NRADRES
1488	WRITE(UNIT = KULOUT, FMT = '('' LRADONDEM = '',L5)')LRADONDEM
1489	IF(NRADINT > 0)THEN
1490	IDIR = LEN_TRIM(CRTABLEDIR)
1491	IFIL = LEN_TRIM(CRTABLEFIL)
1492	WRITE(UNIT = KULOUT, FMT = '('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')&
1493	& CRTABLEDIR(1:IDIR), CRTABLEFIL(1:IFIL)
1494	ENDIF
1495	WRITE(UNIT = KULOUT, FMT = '('' LCCNL = '',L5 &
1496	& ,'' LCCNO = '',L5 &
1497	& ,'' RCCNLND= '',F5.0 &
1498	& ,'' RCCNSEA= '',F5.0 &
1499	& ,'' LE4ALB = '',L5 &
1500	&)')&
1501	& LCCNL, LCCNO, RCCNLND, RCCNSEA, LE4ALB
1502	IF (LHVOLCA) THEN
1503	WRITE(UNIT = KULOUT, FMT = '('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA
1504	ENDIF
1505	WRITE(UNIT = KULOUT, FMT = '('' LONEWSW= '',L5 &
1506	& ,'' NRADIP = '',I1 &
1507	& ,'' NRADLP = '',I1 &
1508	& ,'' NICEOPT= '',I1 &
1509	& ,'' NLIQOPT= '',I1 &
1510	& ,'' LDIFFC = '',L5 &
1511	& )')&
1512	& LONEWSW, NRADIP, NRADLP, NICEOPT, NLIQOPT, LDIFFC
1513	WRITE(UNIT = KULOUT, FMT = '('' WARNING! CLOUD OVERLAP ASSUMPT. IS''&
1514	& ,'' NOVLP = '',I2 &
1515	& )')&
1516	& NOVLP
1517	IF (LUVPROC) THEN
1518	IDAYUV = NUVTIM / 86400
1519	WRITE(UNIT = KULOUT, FMT = '('' LUVPROC = '',L5 &
1520	& ,'' LUVTDEP= '',L5 &
1521	& ,'' NRADUV = '',I2 &
1522	& ,'' NUV = '',I2 &
1523	& ,'' NDAYUV = '',I5 &
1524	& ,'' RMUZUV = '',E9.3 &
1525	& )')&
1526	& LUVPROC, LUVTDEP, NRADUV, NUV, IDAYUV, RMUZUV
1527	WRITE(UNIT = KULOUT, FMT = '('' RUVLAM = '',24F6.1)') (RUVLAM(JUV), JUV = 1, NUV)
1528	WRITE(UNIT = KULOUT, FMT = '('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV), JUV = 1, NUV)
1529	ENDIF
1530	WRITE(UNIT = KULOUT, FMT = '('' NMCICA= '',I2 &
1531	& )')&
1532	& NMCICA
1533	ENDIF
1534
1535	! ------------------------------------------------------------------
1536
1537	IF (LHOOK) CALL DR_HOOK('SUECRAD', 1, ZHOOK_HANDLE)
1538	END SUBROUTINE SUECRAD

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format