source: LMDZ5/trunk/libf/phylmd/rrtm/suecrad.F90 @ 3862

Last change on this file since 3862 was 2627, checked in by musat, 8 years ago

Missed this for rrtm GES' bug fix

  • 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 2627 2016-09-16 08:24:03Z fhourdin $
3!
4SUBROUTINE 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
78USE PARKIND1  ,ONLY : JPIM     ,JPRB
79USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
80
81USE PARDIM   , ONLY : JPMXGL
82USE PARRRTM  , ONLY : JPLAY
83USE PARSRTM  , ONLY : JPGPT
84USE YOMCT0   , ONLY : LOUTPUT  ,NPRINTLEV,LALLOPR,&
85 & NPROC    ,N_REGIONS_NS  ,N_REGIONS_EW
86USE YOMDIM   , ONLY : NDLON    ,NSMAX    ,NDGENL    ,&
87 & NDGSAL   ,NDGLG    ,NDGSAG   ,NDGENG   ,NDSUR1    ,&
88 & NDLSUR   ,NDGSUR   ,NGPBLKS  ,NFLEVG   ,NPROMA 
89USE YOMCT0B  , ONLY : LECMWF
90USE YOMDYN   , ONLY : TSTEP
91! Ce qui concerne NULRAD commente par MPL le 15.04.09
92!USE YOMLUN   , ONLY : NULNAM   ,NULRAD   ,NULOUT
93USE YOMLUN   , ONLY : NULRAD   ,NULOUT
94USE YOMCST   , ONLY : RDAY     ,RG       ,RCPD     ,RPI     ,RI0
95USE YOMPHY   , ONLY : LMPHYS, LRAYFM   ,LRAYFM15
96USE YOEPHY   , ONLY : LEPHYS   ,LERADI, LE4ALB
97USE YOERDI   , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC
98USE 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
115USE YOERDU   , ONLY : NUAER    ,NTRAER   ,RCDAY    ,R10E     ,&
116 & REPLOG   ,REPSC    ,REPSCO   ,REPSCQ   ,REPSCT   ,&
117 & REPSCW   ,DIFF 
118USE YOEAERD  , ONLY : CVDAES   ,CVDAEL   ,CVDAEU   ,CVDAED   ,&
119 & RCAEOPS  ,RCAEOPL  ,RCAEOPU  ,RCAEOPD  ,RCTRBGA  ,&
120 & RCVOBGA  ,RCSTBGA  ,RCTRPT   ,RCAEADM  ,RCAEROS  ,            &
121 & RCAEADK 
122USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV
123
124USE 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
136USE YOMGC    , ONLY : GELAT    ,GELAM
137USE YOMLEG   , ONLY : RMU      ,RSQM2
138USE YOMSC2   , ONLY : &
139 & NRIWIDEN  ,NRIWIDES  ,NRIWIDEW  ,NRIWIDEE,&
140 & NROWIDEN  ,NROWIDES  ,NROWIDEW  ,NROWIDEE
141USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG   ,NGPTOTMX ,NLOENG
142USE YOMTAG   , ONLY : MTAGRAD
143USE YOMPRAD  , ONLY : LODBGRADI,LODBGRADL ,RADGRID  ,&
144 & LRADONDEM 
145USE 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
153USE YOM_YGFL , ONLY : YO3
154!!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90
155USE YOMDYN   , ONLY : NDLNPR
156
157IMPLICIT NONE
158
159INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
160INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT
161REAL(KIND=JPRB)   ,INTENT(IN)    :: PETAH(KLEV+1)
162!     LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
163INTEGER(KIND=JPIM) :: NRGRI(JPMXGL)
164
165INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL
166INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN
167INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON
168INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN
169INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU
170INTEGER(KIND=JPIM) :: J,JROC,IGPTOT
171INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE
172INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE
173INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX
174INTEGER(KIND=JPIM) :: IWIDE(10)
175INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C
176INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5
177INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV
178
179LOGICAL :: LLINEAR_GRID
180LOGICAL :: LLDEBUG,LLP
181
182REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
183REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON
184REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON
185REAL(KIND=JPRB) :: ZLAT
186!REAL(KIND=JPRB) :: RLATVOL, RLONVOL
187
188CHARACTER (LEN = 300) ::  CLFN
189INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1
190
191INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:)
192INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:)
193INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:)
194INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:)
195INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:)
196INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:)
197INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:)
198INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:)
199INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:)
200INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:)
201INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:)
202INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:)
203INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:)
204
205REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:)
206REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:)
207REAL(KIND=JPRB) :: ZHOOK_HANDLE
208
209INTERFACE
210#include "setup_trans.h"
211#include "trans_inq.h"
212END INTERFACE
213
214#include "abor1.intfb.h"
215#include "posnam.intfb.h"
216#include "rrtm_init_140gp.intfb.h"
217
218#include "rdcset.intfb.h"
219#include "suaerh.intfb.h"
220#include "suaerl.intfb.h"
221#include "suaersn.intfb.h"
222#include "suaerv.intfb.h"
223#include "suclopn.intfb.h"
224#include "suecradi.intfb.h"
225#include "suecradl.intfb.h"
226#include "sulwn.intfb.h"
227#include "sulwneur.intfb.h"
228#include "suovlp.intfb.h"
229#include "surdi.intfb.h"
230#include "surrtab.intfb.h"
231#include "surrtftr.intfb.h"
232#include "surrtpk.intfb.h"
233#include "surrtrf.intfb.h"
234#include "susat.intfb.h"
235#include "suswn.intfb.h"
236#include "susrtaer.intfb.h"
237#include "srtm_init.intfb.h"
238#include "susrtcop.intfb.h"
239#include "su_aerw.intfb.h"
240#include "su_uvrad.intfb.h"
241#include "su_mcica.intfb.h"
242
243!      ----------------------------------------------------------------
244
245#include "naerad.h"
246#include "namrgri.h"
247!MPL/IM 20160915 on prend GES de phylmd
248#include "clesphys.h"
249
250!*         1.       INITIALIZE NEUROFLUX LONGWAVE RADIATION
251!                   ---------------------------------------
252
253IF (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
265LERAD1H=.FALSE.
266NLNGR1H=6
267
268LERADHS=.TRUE.
269LONEWSW=.TRUE.
270LECSRAD=.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)
283NLIQOPT=2           ! before 3?R1 default=0    2
284NICEOPT=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
295NRADIP=3            ! before 3?R1 default=2     3
296NRADLP=2            ! before 3?R1 default=2     2
297print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP
298RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB
299
300!- RRTM as LW scheme
301LRRTM  = .FALSE.
302LECMWF = .FALSE.
303IF (iflag_rrtm.EQ.1) THEN
304        LRRTM  = .TRUE.
305        LECMWF = .TRUE.
306!       LRRTM  = .FALSE.  ! Utiliser pour faire tourner le "vieux" rayonnement
307!       LECMWF = .FALSE.
308ENDIF
309
310!LRRTM  = .FALSE.
311
312!- SRTM as SW scheme
313!!!!! A REVOIR (MPL) verifier signification de LSRTM
314LSRTM = .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)
318NMcICA = 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)
321NINHOM = 0          ! before 3?R1 default=1
322NLAYINH= 0
323RLWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
324RSWINHF = 1.0_JPRB  ! before 3?R1 default=0.7 
325!- Diffusivity correction a la Savijarvi
326LDIFFC = .FALSE.    ! before 31R1 default=.FALSE.
327
328!- history of volcanic aerosols
329LHVOLCA=.FALSE.
330!- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
331LNEWAER=.TRUE.
332!!! cpl LNOTROAER=.FALSE.
333LNOTROAER=.TRUE.
334NPERTAER=0
335
336!- New Rayleigh formulation
337LRAYL=.TRUE.
338
339!- Number concentration of aerosols if specified
340LCCNL=.TRUE.        ! before 3?R1 default=.FALSE.     true
341LCCNO=.TRUE.        ! before 3?R1 default=.FALSE.     true
342RCCNLND=900._JPRB   ! before 3?R1 default=900. now irrelevant
343RCCNSEA=50._JPRB    ! before 3?R1 default=50.  now irrelevant
344
345!- interaction radiation / prognostic O3 off by default
346LEPO3RA=.FALSE.
347print *,'SUECRAD-0'
348IF (.NOT.YO3%LGP) THEN
349  LEPO3RA=.FALSE.
350ENDIF
351RPERTOZ=0._JPRB
352NPERTOZ=0
353
354!NAER: CONFIGURATION INDEX FOR AEROSOLS
355!!!!! A REVOIR (MPL) a mettre dans un fichier .def
356NAER   =1
357NMODE  =0
358NOZOCL =1
359NRADFR =-3
360IF (NSMAX >= 511) NRADFR =-1
361NRADPFR=0
362NRADPLA=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)
366LUVPROC=.FALSE.
367LUVTDEP=.TRUE.
368LUVDBG =.FALSE.
369NRADUV =-3
370NUVTIM = 0
371NUV    = 24
372RMUZUV = 1.E-01_JPRB
373DO JUV=1,NUV
374  RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB
375ENDDO
376
377!- radiation interpolation (George M's grid on by default)
378LLDEBUG=.TRUE.
379LEDBUG=.FALSE.
380NRADINT=3
381NRADRES=0
382
383NRINT  =4
384
385LRADLB=.TRUE.
386CRTABLEDIR='./'
387CRTABLEFIL='not set'
388LRADONDEM=.TRUE.
389!GM Temporary as per trans/external/setup_trans.F90
390LLINEAR_GRID=NSMAX > (NDLON+3)/3
391IF( 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
395ENDIF
396
397NUAER  = 24
398NTRAER = 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)
401SELECT CASE (overlap)
402  CASE (:1)
403   NOVLP = 2   
404  CASE (2)
405   NOVLP = 3   
406  CASE (3:)
407   NOVLP = 1   
408  END SELECT
409print *,'SUECRAD: NOVLP=',NOVLP
410NLW    = 16
411NTSW   = 14
412!NSW    = 6    !!!!! Maintenant dans config.def (MPL 20140213)
413NSWNL  = 6
414NSWTL  = 2
415NCSRADF= 1
416IF(NSMAX >= 106) THEN
417  NRPROMA = 80
418ELSEIF(NSMAX == 63) THEN
419  NRPROMA=48
420ELSE
421  NRPROMA=64
422ENDIF
423
424!*         2.3      SET SECURITY PARAMETERS
425!                   -----------------------
426
427REPSC  = 1.E-04_JPRB
428REPSCO = 1.E-12_JPRB
429REPSCQ = 1.E-12_JPRB
430REPSCT = 1.E-12_JPRB
431REPSCW = 1.E-12_JPRB
432REPLOG = 1.E-12_JPRB
433
434
435!*          2.4     BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
436!                   -----------------------------------------------
437
438LECO2VAR=.FALSE.
439LHGHG   =.FALSE.
440NHINCSOL= 0
441NSCEN   = 1
442RSOLINC = 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
459RCCO2   = CO2_ppm * 1.0e-06
460RCCH4   = CH4_ppb * 1.0e-09
461RCN2O   = N2O_ppb * 1.0e-09
462RCCFC11 = CFC11_ppt * 1.0e-12
463RCCFC12 = 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)
476print *,'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)
498IF (.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
511ENDIF
512print *,'SUECRAD-3'
513
514!- for McICA computations, make sure these parameters are as follows ...
515IF (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
521ENDIF
522print *,'SUECRAD-4'
523
524
525
526IF( LLDEBUG )THEN
527  WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT
528  WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES
529ENDIF
530
531!     DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA
532
533LOPTRPROMA=NRPROMA > 0
534NRPROMA=ABS(NRPROMA)
535
536IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
537  WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
538  NRADINT=0
539ENDIF
540
541IF( 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
547ENDIF
548!CALL GSTATS(1818,1)      MPL 2.12.08
549
550100 CONTINUE
551
552IF( 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
617print *,'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_JPRB*RPI &
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)/RPI*2.0_JPRB*90.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)/RPI*2.0_JPRB*90.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/(ZD1*ZD4*ZD5)
1038          RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6)
1039          RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6)
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
1225ENDIF              ! END OF LERADI BLOCK
1226
1227!      ----------------------------------------------------------------
1228
1229!*       4.    INITIALIZE RADIATION COEFFICIENTS.
1230!              ----------------------------------
1231
1232RCDAY   = RDAY * RG / RCPD
1233DIFF   = 1.66_JPRB
1234R10E   = 0.4342945_JPRB
1235
1236! CALL GSTATS(1818,0)    MPL 2.12.08
1237CALL SURDI
1238
1239IF (NINHOM == 0) THEN
1240  RLWINHF=1._JPRB
1241  RSWINHF=1._JPRB
1242ENDIF
1243
1244!      ----------------------------------------------------------------
1245
1246!*       5.    INITIALIZE RADIATION ABSORPTION COEFFICIENTS
1247!              --------------------------------------------
1248
1249!*       5.1.  Initialization routine for RRTM
1250!              -------------------------------
1251
1252CALL SURRTAB
1253CALL SURRTPK
1254CALL SURRTRF
1255CALL SURRTFTR
1256
1257IF (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
1271ELSE
1272  INBLW=6
1273
1274ENDIF
1275
1276CALL SULWN
1277CALL SUSWN   (NTSW, NSW)
1278CALL SUCLOPN (NTSW, NSW, KLEV)
1279
1280!-- routines specific to SRTM
1281IF (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
1289ELSE
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)
1296ENDIF
1297WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW
1298
1299
1300!-- routine specific to the UV processor
1301IF (LUVPROC) THEN
1302  NUVTIM = NUVTIM * 86400
1303  CALL SU_UVRAD ( NUV )
1304ENDIF
1305
1306!      ----------------------------------------------------------------
1307
1308!*       6.    INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
1309!              ------------------------------------------------------
1310
1311!- LW optical properties
1312CALL SUAERL
1313!- SW optical properties moved above
1314!CALL SUAERSN (NTSW,NSW)
1315
1316!- horizontal distribution     
1317CALL SUAERH
1318
1319!- vertical distribution
1320CALL 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
1332CALL SU_AERW
1333
1334!      ----------------------------------------------------------------
1335
1336!*       7.    INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
1337!              -------------------------------------------------------
1338
1339IF (LEPHYS .AND. NMODE > 1) THEN
1340  CALL SUSAT
1341ENDIF
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
1356ZTSTEP=MAX(TSTEP,1.0_JPRB)
1357ZSTPHR=3600._JPRB/ZTSTEP
1358IRADFR=NRADFR
1359IF(NRADFR < 0) THEN
1360  NRADFR=-NRADFR*ZSTPHR+0.5_JPRB
1361ENDIF
1362NRADPFR=NRADPFR*NRADFR
1363IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN
1364  NRADPLA=NRADPLA+1
1365ENDIF
1366
1367IF(NRADUV < 0) THEN
1368  NRADUV=-NRADUV*ZSTPHR+0.5_JPRB
1369ENDIF
1370
1371IST1HR=ZSTPHR+0.05_JPRB
1372ISTNHR=  NLNGR1H *ZSTPHR+0.05_JPRB
1373IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
1374  801 CONTINUE
1375  IST1HR=IST1HR+1
1376  IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801
1377ENDIF
1378IF (NRADFR == 1) THEN
1379  NRADSFR=NRADFR
1380ELSE
1381  NRADSFR=IST1HR
1382ENDIF
1383NRADNFR=NRADFR
1384
1385IF(LRAYFM) THEN
1386  NRPROMA=NDLON+6+(1-MOD(NDLON,2))
1387ENDIF
1388
1389!      ----------------------------------------------------------------
1390
1391!*       10.    ALLOCATE WORK ARRAYS
1392!               --------------------
1393
1394IU = NULOUT
1395LLP = NPRINTLEV >= 1.OR. LALLOPR
1396
1397IF (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
1425ELSEIF(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    )
1434ENDIF
1435ALLOCATE(SRSWPARC(NPROMA,NGPBLKS))
1436IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC )
1437ALLOCATE(SRSWTINC(NPROMA,NGPBLKS))
1438IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC )
1439
14409 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)
1441
1442!      ----------------------------------------------------------------
1443
1444!*       10.    PRINT FINAL VALUES.
1445!               -------------------
1446
1447IF (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
1535ENDIF
1536
1537!     ------------------------------------------------------------------
1538
1539
1540IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE)
1541END SUBROUTINE SUECRAD
Note: See TracBrowser for help on using the repository browser.