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

Last change on this file since 2236 was 2152, checked in by fhourdin, 10 years ago

Corrections cosmétiques pour RRTM
Bug fixing for RRTM

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