source: LMDZ6/trunk/libf/phylmd/rrtm/suecrad.F90 @ 5428

Last change on this file since 5428 was 5294, checked in by Laurent Fairhead, 2 months ago

Keeping clesphys.h was not the right solution
LF

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