Context Navigation

suecrad.F90 @ 2010

Last change on this file since 2010 was 2010, checked in by Laurent Fairhead, 10 years ago

Modifications pour OpenMP

OpenMP modifications

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

File size: 51.8 KB

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

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

Download in other formats:

Original Format