Context Navigation

suecrad.F90 @ 5306

Last change on this file since 5306 was 4482, checked in by lguez, 19 months ago
Sync latest trunk changes to branch LMDZ_ECRad
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: 52.2 KB

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

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

Download in other formats:

Original Format