Context Navigation

suecrad.F90 @ 5371

Last change on this file since 5371 was 2152, checked in by fhourdin, 10 years ago
Corrections cosmétiques pour RRTM Bug fixing for RRTM
Property copyright set to Name of program: LMDZ Creation date: 1984 Version: LMDZ5 License: CeCILL version 2 Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539 See the license file in the root directory Property svn:keywords set to `Author Date Id Revi`
File size: 51.8 KB

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

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

Download in other formats:

Original Format