Head

GCC Code Coverage Report
Directory:	./		Exec	Total	Coverage
File:	phylmd/rrtm/suecrad.F90	Lines:	176	678	26.0 %
Date:	2023-06-30 12:51:15	Branches:	48	1017	4.7 %

!
! $Id: suecrad.F90 4251 2022-09-20 00:22:43Z fhourdin $
!
SUBROUTINE SUECRAD (KULOUT, KLEV, PETAH )

!**** *SUECRAD*   - INITIALIZE COMMONS YOERxx CONTROLLING RADIATION

!     PURPOSE.
!     --------
!           INITIALIZE YOERAD, THE COMMON THAT CONTROLS THE
!           RADIATION OF THE MODEL, AND YOERDU THAT INCLUDES
!           ADJUSTABLE PARAMETERS FOR RADIATION COMPUTATIONS

!**   INTERFACE.
!     ----------
!        CALL *SUECRAD* FROM *SUPHEC*
!              -------        ------

!        EXPLICIT ARGUMENTS :
!        --------------------
!        NONE

!        IMPLICIT ARGUMENTS :
!        --------------------
!        COMMONS YOERAD, YOERDU

!     METHOD.
!     -------
!        SEE DOCUMENTATION

!     EXTERNALS.
!     ----------
!        SUAER, SUAERH, SUAERV, SULW, SUSW, SUOCST, SUSAT
!        SUAERL, SUAERSN, SUSRTAER, SRTM_INIT, SUSRTCOP

!     REFERENCE.
!     ----------
!        ECMWF Research Department documentation of the IFS

!     AUTHOR.
!     -------
!        JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 88-12-15
!        P.COURTIER AND M.HAMRUD NAME SURAD ALREADY USED
!        Modified 93-11-15 by Ph. Dandin : FMR scheme with MF
!        Modified 95-12 by PhD : Cloud overlapping hypothesis for FMR
!        980317 JJMorcrette clean-up (NRAD, NFLUX)
!        000118 JJMorcrette variable concentr. uniformly mixed gases
!        990525 JJMorcrette GISS volcanic and new tropospheric aerosols
!        990831 JJMorcrette RRTM
!        R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
!        010129 JJMorcrette clean-up LERAD1H, NLNGR1H
!        011105 GMozdzynski support new radiation grid
!        011005 JJMorcrette CCN --> Re Water clouds
!        R. El Khatib 01-02-02 LRRTM=lecmwf by default
!        020909 GMozdzynski support NRADRES to specify radiation grid
!        021001 GMozdzynski support on-demand radiation communications
!        030422 GMozdzynski automatic min-halo
!        030501 JJMorcrette new radiation grid on, new aerosols on (default)
!        030513 JJMorcrette progn. O3 / radiation interactions off (default)
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        050315 JJMorcrette prog.aerosols v1
!        041214 JJMorcrette SRTM
!        050111 JJMorcrette new cloud optical properties
!        050415 GMozdzynski Reduced halo support for radiation interpolation
!        051004 JJMorcrette UV surface radiation processor
!        051220 JJMorcrette SRTM112g+LWSCAT+UVprocessor+(bgfx:swclr, radaca)
!        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
!        060510 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
!        JJMorcrette 20060721 PP of clear-sky PAR and TOA incident solar radiation
!        060625 JJMorcrette MODIS albedo (UVis, NIR)x(parallel+diffuse)
!        060726 JJMorcrette McICA default operational configuration
!     ------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE PARDIM   , ONLY : JPMXGL
USE PARRRTM  , ONLY : JPLAY
USE PARSRTM  , ONLY : JPGPT
USE YOMCT0   , ONLY : LOUTPUT  ,NPRINTLEV,LALLOPR,&
 & NPROC    ,N_REGIONS_NS  ,N_REGIONS_EW
USE YOMDIM   , ONLY : NDLON    ,NSMAX    ,NDGENL    ,&
 & NDGSAL   ,NDGLG    ,NDGSAG   ,NDGENG   ,NDSUR1    ,&
 & NDLSUR   ,NDGSUR   ,NGPBLKS  ,NFLEVG   ,NPROMA
USE YOMCT0B  , ONLY : LECMWF
USE YOMDYN   , ONLY : TSTEP
! Ce qui concerne NULRAD commente par MPL le 15.04.09
!USE YOMLUN   , ONLY : NULNAM   ,NULRAD   ,NULOUT
USE YOMLUN   , ONLY : NULRAD   ,NULOUT
USE YOMCST   , ONLY : RDAY     ,RG       ,RCPD     ,RPI     ,RI0
USE YOMPHY   , ONLY : LMPHYS, LRAYFM   ,LRAYFM15
USE YOEPHY   , ONLY : LEPHYS   ,LERADI, LE4ALB
USE YOERDI   , ONLY : RCCO2, RCCH4, RCN2O, RCCFC11, RCCFC12, RSOLINC
USE YOERAD   , ONLY : NAER     , NOZOCL   ,&
 & NRADFR   ,NRADPFR  ,NRADPLA  ,NRINT    ,&
 & NRADNFR  ,NRADSFR  ,NOVLP    ,NRPROMA  ,&
!& NLW      ,NSW      ,NTSW     ,NCSRADF  ,&
! NSW mis dans .def MPL 20140211
 & NLW      ,NTSW     ,NCSRADF  ,&
 & NMODE    ,NLNGR1H  ,NSWNL    ,NSWTL    ,NUV     ,&
 & LERAD1H  ,LERADHS  ,LEPO3RA  ,LRADLB   ,LONEWSW ,&
 & LCCNL    ,LCCNO    ,&
 & LECSRAD  ,LHVOLCA  ,LNEWAER  ,LRRTM    ,LSRTM   ,LDIFFC  ,&
 & NRADINT  ,NRADRES  ,CRTABLEDIR,CRTABLEFIL       ,&
 & NICEOPT  ,NLIQOPT  ,NRADIP   ,NRADLP   ,NINHOM  ,NLAYINH ,&
 & LRAYL    ,LOPTRPROMA,&
 & RCCNLND  ,RCCNSEA  ,RLWINHF  ,RSWINHF  ,RRe2De  ,&
 & RPERTOZ  ,NPERTOZ  ,NMCICA   ,&
 & LNOTROAER,NPERTAER ,LECO2VAR ,LHGHG    ,NHINCSOL,NSCEN ,&
 & LEDBUG
USE YOERDU   , ONLY : NUAER    ,NTRAER   ,RCDAY    ,R10E     ,&
 & REPLOG   ,REPSC    ,REPSCO   ,REPSCQ   ,REPSCT   ,&
 & REPSCW   ,DIFF
USE YOEAERD  , ONLY : CVDAES   ,CVDAEL   ,CVDAEU   ,CVDAED   ,&
 & RCAEOPS  ,RCAEOPL  ,RCAEOPU  ,RCAEOPD  ,RCTRBGA  ,&
 & RCVOBGA  ,RCSTBGA  ,RCTRPT   ,RCAEADM  ,RCAEROS  ,            &
 & RCAEADK
USE YOE_UVRAD, ONLY : JUVLAM, LUVPROC, LUVTDEP, LUVDBG, NRADUV, NUVTIM, RUVLAM, RMUZUV

USE YOMMP    , ONLY : MYPROC   ,NPRCIDS  ,LSPLIT   ,NAPSETS  ,&
 & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
 & NSTA,NONL,NPTRFRSTLAT,NFRSTLAT,NLSTLAT ,&
 & MY_REGION_NS  ,MY_REGION_EW   ,NGLOBALINDEX ,&
 & NRISTA  ,NRIONL   ,NRIOFF    ,NRIEXT   ,NRICORE ,&
 & NRISENDPOS ,NRIRECVPOS ,NRISENDPTR ,NRIRECVPTR ,&
 & NARIB1  ,NRIPROCS ,NRIMPBUFSZ,NRISPT   ,NRIRPT ,&
 & NRICOMM ,&
 & NROSTA  ,NROONL   ,NROOFF    ,NROEXT   ,NROCORE ,&
 & NROSENDPOS ,NRORECVPOS ,NROSENDPTR ,NRORECVPTR ,&
 & NAROB1  ,NROPROCS ,NROMPBUFSZ,NROSPT   ,NRORPT ,&
 & NROCOMM
USE YOMGC    , ONLY : GELAT    ,GELAM
USE YOMLEG   , ONLY : RMU      ,RSQM2
USE YOMSC2   , ONLY : &
 & NRIWIDEN  ,NRIWIDES  ,NRIWIDEW  ,NRIWIDEE,&
 & NROWIDEN  ,NROWIDES  ,NROWIDEW  ,NROWIDEE
USE YOMGEM   , ONLY : NGPTOT   ,NGPTOTG   ,NGPTOTMX ,NLOENG
USE YOMTAG   , ONLY : MTAGRAD
USE YOMPRAD  , ONLY : LODBGRADI,LODBGRADL ,RADGRID  ,&
 & LRADONDEM
USE YOMRADF  , ONLY : EMTD     ,TRSW     ,EMTC      ,TRSC    ,&
 & SRSWD    ,SRLWD    ,SRSWDCS  ,SRLWDCS   ,SRSWDV  ,&
 & SRSWDUV  ,EDRO     ,SRSWPAR  ,SRSWUVB   ,SRSWPARC,  SRSWTINC,&
 & EMTU, RMOON
! Commente par MPL 26.11.08
!USE YOPHNC   , ONLY :  LERADN2
! MPLefebvre 6-11-08 commente tout ce qui concerne MPL_MODULE
!USE MPL_MODULE  , ONLY :  MPL_BROADCAST, MPL_SEND, MPL_RECV
USE YOM_YGFL , ONLY : YO3
!!!!! A REVOIR (MPL) NDLNPR devrait etre initialise dans sudyn.F90
USE YOMDYN   , ONLY : NDLNPR

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT
REAL(KIND=JPRB)   ,INTENT(IN)    :: PETAH(KLEV+1)
!     LOCAL ARRAYS FOR THE PURPOSE OF READING NAMRGRI (RADIATION GRID)
INTEGER(KIND=JPIM) :: NRGRI(JPMXGL)

INTEGER(KIND=JPIM) :: IDGL,INBLW,IRADFR,IST1HR,ISTNHR,IDIR,IFIL
INTEGER(KIND=JPIM) :: IRIRPTSUR,IRISPTSUR,IRIMAPLEN
INTEGER(KIND=JPIM) :: JLON,JGLAT,JGL,JGLSUR,IDLSUR,IOFF,ILAT,ISTLON,IENDLON
INTEGER(KIND=JPIM) :: IRORPTSUR,IROSPTSUR,IROMAPLEN
INTEGER(KIND=JPIM) :: ILBRLATI,IUBRLATI,IGLGLO,IDUM,IU
INTEGER(KIND=JPIM) :: J,JROC,IGPTOT
INTEGER(KIND=JPIM) :: IROWIDEMAXN,IROWIDEMAXS,IROWIDEMAXW,IROWIDEMAXE
INTEGER(KIND=JPIM) :: IRIWIDEMAXN,IRIWIDEMAXS,IRIWIDEMAXW,IRIWIDEMAXE
INTEGER(KIND=JPIM) :: IARIB1MAX,IAROB1MAX
INTEGER(KIND=JPIM) :: IWIDE(10)
INTEGER(KIND=JPIM) :: ILATS_DIFF_F,ILATS_DIFF_C
INTEGER(KIND=JPIM), PARAMETER :: JP_MIN_HALO=5
INTEGER(KIND=JPIM) :: ISW,JUV,IDAYUV

LOGICAL :: LLINEAR_GRID
LOGICAL :: LLDEBUG,LLP

REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP, ZGEMU, ZLON, ZD1, ZD2, ZD3, ZD4, ZD5, ZD6
REAL(KIND=JPRB) :: ZMINRADLAT,ZMAXRADLAT,ZMINRADLON,ZMAXRADLON
REAL(KIND=JPRB) :: ZMINMDLLAT,ZMAXMDLLAT,ZMINMDLLON,ZMAXMDLLON
REAL(KIND=JPRB) :: ZLAT
!REAL(KIND=JPRB) :: RLATVOL, RLONVOL

CHARACTER (LEN = 300) ::  CLFN
INTEGER(KIND=JPIM), PARAMETER :: JPIOMASTER=1

INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPOS(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPOS(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRISENDPTR(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRIRECVPTR(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRICOMM(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRIMAP(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPOS(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPOS(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IROSENDPTR(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IRORECVPTR(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IROCOMM(:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IROMAP(:,:)
INTEGER(KIND=JPIM), ALLOCATABLE :: IGLOBALINDEX(:)

REAL(KIND=JPRB),ALLOCATABLE :: ZLATX(:)
REAL(KIND=JPRB),ALLOCATABLE :: ZLONX(:)
REAL(KIND=JPRB) :: ZHOOK_HANDLE

INTERFACE
#include "setup_trans.h"
#include "trans_inq.h"
END INTERFACE

#include "abor1.intfb.h"
#include "posnam.intfb.h"
#include "rrtm_init_140gp.intfb.h"

#include "rdcset.intfb.h"
#include "suaerh.intfb.h"
#include "suaerl.intfb.h"
#include "suaersn.intfb.h"
#include "suaerv.intfb.h"
#include "suclopn.intfb.h"
#include "suecradi.intfb.h"
#include "suecradl.intfb.h"
#include "sulwn.intfb.h"
#include "sulwneur.intfb.h"
#include "suovlp.intfb.h"
#include "surdi.intfb.h"
#include "surrtab.intfb.h"
#include "surrtftr.intfb.h"
#include "surrtpk.intfb.h"
#include "surrtrf.intfb.h"
#include "susat.intfb.h"
#include "suswn.intfb.h"
#include "susrtaer.intfb.h"
#include "srtm_init.intfb.h"
#include "susrtcop.intfb.h"
#include "su_aerw.intfb.h"
#include "su_uvrad.intfb.h"
#include "su_mcica.intfb.h"

!      ----------------------------------------------------------------

#include "clesphys.h"
#include "naerad.h"
#include "namrgri.h"
!MPL/IM 20160915 on prend GES de phylmd

!*         1.       INITIALIZE NEUROFLUX LONGWAVE RADIATION
!                   ---------------------------------------

IF (LHOOK) CALL DR_HOOK('SUECRAD',0,ZHOOK_HANDLE)
!CALL GSTATS(1818,0)     MPL 2.12.08
!IF (LERADN2) THEN
!  CALL SULWNEUR(KLEV)
!ENDIF

!*         2.       SET DEFAULT VALUES.
!                   -------------------

!*         2.1      PRESET INDICES IN *YOERAD*
!                   --------------------------

LERAD1H=.FALSE.
NLNGR1H=6

LERADHS=.TRUE.
LONEWSW=.TRUE.
LECSRAD=.FALSE.

!LE4ALB=.FALSE.
!This is read from SU0PHY in NAEPHY and put in YOEPHY

!- default setting of cloud optical properties
!  liquid water cloud 0: Fouquart    (SW), Smith-Shi   (LW)
!                     1: Slingo      (SW), Savijarvi   (LW)
!                     2: Slingo      (SW), Lindner-Li  (LW)
!  ice water cloud    0: Ebert-Curry (SW), Smith-Shi   (LW)
!                     1: Ebert-Curry (SW), Ebert-Curry (LW)
!                     2: Fu-Liou'93  (SW), Fu-Liou'93  (LW)
!                     3: Fu'96       (SW), Fu et al'98 (LW)
NLIQOPT=2           ! before 3?R1 default=0    2
NICEOPT=3           ! before 3?R1 default=1    3

!- default setting of cloud effective radius/diameter
!  liquid water cloud 0: f(P) 10 to 45
!                     1: 13: ocean; 10: land
!                     2: Martin et al. CCN 50 over ocean, 900 over land
!  ice water cloud    0: 40 microns
!                     1: f(T) 40 to 130 microns
!                     2: f(T) 30 to 60
!                     3: f(T,IWC) Sun'01: 22.5 to 175 microns
!  conversion factor between effective radius and particle size for ice
NRADIP=3            ! before 3?R1 default=2 	3
NRADLP=2            ! before 3?R1 default=2	2
print *,'SUECRAD: NRADLP, NRADIP=',NRADLP,NRADIP
RRe2De=0.64952_JPRB ! before 3?R1 default=0.5_JPRB

!- RRTM as LW scheme
LRRTM  = .FALSE.
LECMWF = .FALSE.
IF (iflag_rrtm.EQ.1) THEN
        LRRTM  = .TRUE.
        LECMWF = .TRUE.
!       LRRTM  = .FALSE.  ! Utiliser pour faire tourner le "vieux" rayonnement
!       LECMWF = .FALSE.
ENDIF

!LRRTM  = .FALSE.

!- SRTM as SW scheme
!!!!! A REVOIR (MPL) verifier signification de LSRTM
LSRTM = .FALSE.     ! before 3?R1 default was .FALSE.    true

! -- McICA treatment of cloud-radiation interactions
! - 1 is maximum-random, 2 is generalized cloud overlap (before 31R1 default=0 no McICA)
NMcICA = 2          !  2 for generalized overlap

!- Inhomogeneity factors in LW and SW (0=F, 1=0.7 in both, 2=Barker's, 3=Cairns)
NINHOM = 0          ! before 3?R1 default=1
NLAYINH= 0
RLWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
RSWINHF = 1.0_JPRB  ! before 3?R1 default=0.7
!- Diffusivity correction a la Savijarvi
LDIFFC = .FALSE.    ! before 31R1 default=.FALSE.

!- history of volcanic aerosols
LHVOLCA=.FALSE.
!- monthly climatol. of tropospheric aerosols from Tegen et al. (1997)
LNEWAER=.TRUE.
!!! cpl LNOTROAER=.FALSE.
LNOTROAER=.TRUE.
NPERTAER=0

!- New Rayleigh formulation
LRAYL=.TRUE.

!- Number concentration of aerosols if specified
LCCNL=.TRUE.        ! before 3?R1 default=.FALSE.     true
LCCNO=.TRUE.        ! before 3?R1 default=.FALSE.     true
RCCNLND=900._JPRB   ! before 3?R1 default=900. now irrelevant
RCCNSEA=50._JPRB    ! before 3?R1 default=50.  now irrelevant

!- interaction radiation / prognostic O3 off by default
LEPO3RA=.FALSE.
print *,'SUECRAD-0'
IF (.NOT.YO3%LGP) THEN
  LEPO3RA=.FALSE.
ENDIF
RPERTOZ=0._JPRB
NPERTOZ=0

!NAER: CONFIGURATION INDEX FOR AEROSOLS
!!!!! A REVOIR (MPL) a mettre dans un fichier .def
NAER   =1
NMODE  =0
NOZOCL =1
NRADFR =-3
IF (NSMAX >= 511) NRADFR =-1
NRADPFR=0
NRADPLA=15

! -- UV diagnostic of surface fluxes over the 280-400 nm interval
!    with up-to 24 values (5 nm wide spectral intervals)
LUVPROC=.FALSE.
LUVTDEP=.TRUE.
LUVDBG =.FALSE.
NRADUV =-3
NUVTIM = 0
NUV    = 24
RMUZUV = 1.E-01_JPRB
DO JUV=1,NUV
  RUVLAM(JUV)=280._JPRB+(JUV-1)*5._JPRB
ENDDO

!- radiation interpolation (George M's grid on by default)
LLDEBUG=.TRUE.
LEDBUG=.FALSE.
NRADINT=3
NRADRES=0

NRINT  =4

LRADLB=.TRUE.
CRTABLEDIR='./'
CRTABLEFIL='not set'
LRADONDEM=.TRUE.
!GM Temporary as per trans/external/setup_trans.F90
LLINEAR_GRID=NSMAX > (NDLON+3)/3
IF( LLDEBUG )THEN
  WRITE(NULOUT,'("SUECRAD: NSMAX=",I6)')NSMAX
  WRITE(NULOUT,'("SUECRAD: NDLON=",I6)')NDLON
  WRITE(NULOUT,'("SUECRAD: LLINEAR_GRID=",L5)')LLINEAR_GRID
ENDIF

NUAER  = 24
NTRAER = 15
! 1: max-random, 2: max, 3: random (5,6,7,8 pour meso-NH)
! le CASE qui suit car les conventions sont differentes dans ARP et LMDZ (MPL 20100415)
SELECT CASE (overlap)
  CASE (:1)
   NOVLP = 2
  CASE (2)
   NOVLP = 3
  CASE (3:)
   NOVLP = 1
  END SELECT
print *,'SUECRAD: NOVLP=',NOVLP
NLW    = 16
NTSW   = 14
!NSW    = 6    !!!!! Maintenant dans config.def (MPL 20140213)
NSWNL  = 6
NSWTL  = 2
NCSRADF= 1
IF(NSMAX >= 106) THEN
  NRPROMA = 80
ELSEIF(NSMAX == 63) THEN
  NRPROMA=48
ELSE
  NRPROMA=64
ENDIF

!*         2.3      SET SECURITY PARAMETERS
!                   -----------------------

REPSC  = 1.E-04_JPRB
REPSCO = 1.E-12_JPRB
REPSCQ = 1.E-12_JPRB
REPSCT = 1.E-12_JPRB
REPSCW = 1.E-12_JPRB
REPLOG = 1.E-12_JPRB


!*          2.4     BACKGROUND GAS CONCENTRATIONS (IPCC/SACC, 1990)
!                   -----------------------------------------------

LECO2VAR=.FALSE.
LHGHG   =.FALSE.
NHINCSOL= 0
NSCEN   = 1
RSOLINC = RI0

! Valeurs d origine MPL 18052010
!RCCO2   = 353.E-06_JPRB
!RCCH4   = 1.72E-06_JPRB
!RCN2O   = 310.E-09_JPRB
!RCCFC11 = 280.E-12_JPRB
!RCCFC12 = 484.E-12_JPRB

! Valeurs LMDZ (physiq.def) MPL 18052010
!RCCO2   = 348.E-06_JPRB
!RCCH4   = 1.65E-06_JPRB
!RCN2O   = 306.E-09_JPRB
!RCCFC11 = 280.E-12_JPRB
!RCCFC12 = 484.E-12_JPRB

!MPL/IM 20160915 on prend GES de phylmd
RCCO2   = CO2_ppm * 1.0e-06
RCCH4   = CH4_ppb * 1.0e-09
RCN2O   = N2O_ppb * 1.0e-09
RCCFC11 = CFC11_ppt * 1.0e-12
RCCFC12 = CFC12_ppt * 1.0e-12
!print *,'LMDZSUECRAD-1 RCCO2=',RCCO2
!print *,'LMDZSUECRAD-1 RCCH4=',RCCH4
!print *,'LMDZSUECRAD-1 RCN2O=',RCN2O
!print *,'LMDZSUECRAD-1 RCCFC11=',RCCFC11
!print *,'LMDZSUECRAD-1 RCCFC12=',RCCFC12
!     ------------------------------------------------------------------

!*         3.       READ VALUES OF RADIATION CONFIGURATION
!                   --------------------------------------

!CALL POSNAM(NULNAM,'NAERAD')
!READ (NULNAM,NAERAD)
print *,'SUECRAD-2'

!CALL POSNAM(NULNAM,'NAEAER')
!READ (NULNAM,NAEAER)

!IF (NTYPAER(9) /= 0) THEN
!  RGEMUV=(RLATVOL+90._JPRB)*RPI/180._JPRB
!  RGELAV=RLONVOL*RPI/180._JPRB
!  RCLONV=COS(RGELAV)
!  RSLONV=SIN(RGELAV)
!  DO J=1,NGPTOT-1
!    IF (RGELAV > GELAM(J) .AND. RGELAV <= GELAM(J+1) .AND. &
!      & RGEMUV < RMU(JL) .AND. RGEMUV >= RMU(JL+1) ) THEN
!      RDGMUV=ABS( RMU(J+1) - RMU(J))
!      RDGLAV=ABS( GELAM(J+1)-GELAM(J) )
!      RDSLONV=ABS( SIN(GELAM(JL+1))-SIN(GELAM(JL)) )
!      RDCLONV=ABS( COS(GELAM(JL+1))-COS(GELAM(JL)) )
!    END IF
!  END DO
!END IF

!- reset some parameters if SW6 is used (revert to pre-CY3?R1 operational configuration)
IF (.NOT.LSRTM) THEN
  NMcICA = 0
  LCCNL  = .FALSE.
  LCCNO  = .FALSE.
  LDIFFC = .FALSE.
  NICEOPT= 1
  NLIQOPT= 0
  NRADIP = 4
  NRADLP = 3
  RRe2De = 0.5_JPRB
  NINHOM = 1
  RLWINHF= 0.7_JPRB
  RSWINHF= 0.7_JPRB
ENDIF
print *,'SUECRAD-3'

!- for McICA computations, make sure these parameters are as follows ...
IF (NMCICA /= 0) THEN
  NINHOM = 0
  RLWINHF= 1.0_JPRB
  RSWINHF= 1.0_JPRB
!-- read the XCW values for Raisanen-Cole-Barker cloud generator
  CALL SU_McICA
ENDIF
print *,'SUECRAD-4'



IF( LLDEBUG )THEN
  WRITE(NULOUT,'("SUECRAD: NRADINT=",I2)')NRADINT
  WRITE(NULOUT,'("SUECRAD: NRADRES=",I4)')NRADRES
ENDIF

!     DETERMINE WHETHER NRPROMA IS NEGATIVE AND SET LOPTRPROMA

LOPTRPROMA=NRPROMA > 0
NRPROMA=ABS(NRPROMA)

IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
  WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
  NRADINT=0
ENDIF

IF( NRADINT > 0 .AND. LRAYFM .AND. NAER /= 0 .AND. .NOT.LHVOLCA )THEN
!   This combination is not supported as aerosol data would be
!   required to be interpolated (see radintg)
  WRITE(NULOUT,'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0 .AND. LHVOLCA=F,",&
   & " NRADRES RESET TO NSMAX (NO INTERPOLATION)")')
  NRADRES=NSMAX
ENDIF
!CALL GSTATS(1818,1)      MPL 2.12.08

100 CONTINUE

IF( LERADI )THEN   ! START OF LERADI BLOCK

  IF( NRADINT == -1 )THEN

  !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION

    LODBGRADI=.FALSE.
    CALL SUECRADI

  !     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION COURSE GRID
  !     LOAD BALANCING

    LODBGRADL=.FALSE.
!   CALL SUECRADL    ! MPL 1.12.08
    CALL ABOR1('JUSTE APRES CALL SUECRADL COMMENTE')

  ELSEIF( NRADINT == 0 )THEN

    IF( NRADRES /= NSMAX )THEN
      WRITE(NULOUT,'("SUECRAD: NRADINT=0 REQUESTED, NRADRES RESET TO NSMAX")')
      NRADRES=NSMAX
    ENDIF
    RADGRID%NGPTOT=NGPTOT

    NARIB1=0
    NAROB1=0

  ELSEIF( NRADINT >=1 .AND. NRADINT <= 3 )THEN

    NARIB1=0
    NAROB1=0

! set the default radiation grid resolution for the current model resolution
! if not already specified
    IF( NRADRES == 0 )THEN
      IF( LLINEAR_GRID )THEN                ! RATIO OF GRID-POINTS (MODEL/RAD)
        IF( NSMAX == 63 )THEN
          NRADRES=21                        ! 3.62
          LLINEAR_GRID=.FALSE.
        ENDIF
        IF( NSMAX ==   95 ) NRADRES=   95   ! 1.00
        IF( NSMAX ==  159 ) NRADRES=   63   ! 5.84
        IF( NSMAX ==  255 ) NRADRES=   95   ! 6.69
        IF( NSMAX ==  319 ) NRADRES=  159   ! 3.87
        IF( NSMAX ==  399 ) NRADRES=  159   ! 5.99
        IF( NSMAX ==  511 ) NRADRES=  255   ! 3.92
        IF( NSMAX ==  639 ) NRADRES=  319   ! 3.92
        IF( NSMAX ==  799 ) NRADRES=  399   ! 3.94
        IF( NSMAX == 1023 ) NRADRES=  511   ! 3.94
        IF( NSMAX == 1279 ) NRADRES=  639       !
        IF( NSMAX == 2047 ) NRADRES= 1023       !
      ELSE ! NOT LINEAR GRID
        IF( NSMAX ==   21 ) NRADRES=   21   ! 1.00
        IF( NSMAX ==   42 ) NRADRES=   21   ! 3.62
        IF( NSMAX ==   63 ) NRADRES=   42   ! 2.17
        IF( NSMAX ==  106 ) NRADRES=   63   ! 2.69
        IF( NSMAX ==  170 ) NRADRES=   63   ! 6.69
        IF( NSMAX ==  213 ) NRADRES=  106   ! 3.87
        IF( NSMAX ==  266 ) NRADRES=  106   ! 5.99
        IF( NSMAX ==  341 ) NRADRES=  170   ! 3.92
        IF( NSMAX ==  426 ) NRADRES=  213   ! 3.92
        IF( NSMAX ==  533 ) NRADRES=  266   ! 3.94
        IF( NSMAX ==  682 ) NRADRES=  341   ! 3.94
      ENDIF
    ENDIF
print *,'SUECRAD-5'

! test if radiation grid resolution has been set
    IF( NRADRES == 0 )THEN
      WRITE(NULOUT,'("SUECRAD: NRADRES NOT SET OR DEFAULT FOUND,NSMAX=",I4)')NSMAX
      CALL ABOR1('SUECRAD: NRADRES NOT SET OR DEFAULT FOUND')
    ENDIF

! test if no interpolation is required
    IF( NRADINT > 0 .AND. NRADRES == NSMAX )THEN
      WRITE(NULOUT,'("SUECRAD: NRADINT > 0 .AND. NRADRES = NSMAX, NRADINT RESET TO 0")')
      NRADINT=0
      GOTO 100
    ENDIF

!    CALL GSTATS(1818,0)       MPL 2.12.08
    IF( CRTABLEFIL == 'not set' )THEN
      IF( LLINEAR_GRID )THEN
        IF( NRADRES < 1000 )THEN
          WRITE(CRTABLEFIL,'("rtablel_2",I3.3)')NRADRES
        ELSE
          WRITE(CRTABLEFIL,'("rtablel_2",I4.4)')NRADRES
        ENDIF
      ELSE
        IF( NRADRES < 1000 )THEN
          WRITE(CRTABLEFIL,'("rtable_2" ,I3.3)')NRADRES
        ELSE
          WRITE(CRTABLEFIL,'("rtable_2" ,I4.4)')NRADRES
        ENDIF
      ENDIF
    ENDIF
!    CALL GSTATS(1818,1)       MPL 2.12.08

    RADGRID%NSMAX=NRADRES

    IF( MYPROC == JPIOMASTER )THEN
      IDIR=LEN_TRIM(CRTABLEDIR)
      IFIL=LEN_TRIM(CRTABLEFIL)
      CLFN=CRTABLEDIR(1:IDIR)//CRTABLEFIL(1:IFIL)
! Ce qui concerne NULRAD commente par MPL le 15.04.09
!     OPEN(NULRAD,FILE=CLFN,ACTION="READ",ERR=999)
!     GOTO 1000
!     999 CONTINUE
!     WRITE(NULOUT,'("SUECRAD: UNABLE TO OPEN FILE ",A)')CLFN
!     CALL ABOR1('SUECRAD: UNABLE TO OPEN RADIATION GRID RTABLE FILE')
!     1000 CONTINUE
      NRGRI(:)=0
! Ce qui concerne NAMRGRI commente par MPL le 15.04.09
!     CALL POSNAM(NULRAD,'NAMRGRI')
!     READ (NULRAD,NAMRGRI)
      IDGL=1
      DO WHILE( NRGRI(IDGL)>0 )
        IF( LLDEBUG )THEN
          WRITE(NULOUT,'("SUECRAD: NRGRI(",I4,")=",I4)')IDGL,NRGRI(IDGL)
        ENDIF
        IDGL=IDGL+1
      ENDDO
      IDGL=IDGL-1
      RADGRID%NDGLG=IDGL
      IF( LLDEBUG )THEN
        WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG=",I4)')RADGRID%NDGLG
      ENDIF
!     CLOSE(NULRAD)
    ENDIF
!    CALL GSTATS(667,0)     MPL 2.12.08
    IF( NPROC > 1 )THEN
      stop 'Pas pret pour proc > 1'
!     CALL MPL_BROADCAST (RADGRID%NDGLG,MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
    ENDIF
    ALLOCATE(RADGRID%NRGRI(RADGRID%NDGLG))
    IF( MYPROC == JPIOMASTER )THEN
      RADGRID%NRGRI(1:RADGRID%NDGLG)=NRGRI(1:RADGRID%NDGLG)
    ENDIF
    IF( NPROC > 1 )THEN
      stop 'Pas pret pour proc > 1'
!     CALL MPL_BROADCAST (RADGRID%NRGRI(1:RADGRID%NDGLG),MTAGRAD,JPIOMASTER,CDSTRING='SUECRAD:')
    ENDIF
!    CALL GSTATS(667,1)      MPL 2.12.08

!    CALL GSTATS(1818,0)     MPL 2.12.08
    IF    ( NRADINT == 1 )THEN
      WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - SPECTRAL TRANSFORM")')
      RADGRID%NDGSUR=0
      NRIWIDEN=0
      NRIWIDES=0
      NRIWIDEW=0
      NRIWIDEE=0
      NROWIDEN=0
      NROWIDES=0
      NROWIDEW=0
      NROWIDEE=0
    ELSEIF( NRADINT == 2 )THEN
      WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 4 POINT")')
      RADGRID%NDGSUR=2
    ELSEIF( NRADINT == 3 )THEN
      WRITE(NULOUT,'("SUECRAD: INTERPOLATION METHOD - 12 POINT")')
      RADGRID%NDGSUR=2
    ENDIF
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSUR       =",I8)')RADGRID%NDGSUR

    RADGRID%NDGSAG=1-RADGRID%NDGSUR
    RADGRID%NDGENG=RADGRID%NDGLG+RADGRID%NDGSUR
    RADGRID%NDLON=RADGRID%NRGRI(RADGRID%NDGLG/2)
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAG       =",I8)')RADGRID%NDGSAG
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENG       =",I8)')RADGRID%NDGENG
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGLG        =",I8)')RADGRID%NDGLG
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDLON        =",I8)')RADGRID%NDLON
    CALL FLUSH(NULOUT)

    ALLOCATE(RADGRID%NLOENG(RADGRID%NDGSAG:RADGRID%NDGENG))
    RADGRID%NLOENG(1:RADGRID%NDGLG)=RADGRID%NRGRI(1:RADGRID%NDGLG)
    IF(RADGRID%NDGSUR >= 1)THEN
      DO JGLSUR=1,RADGRID%NDGSUR
        RADGRID%NLOENG(1-JGLSUR)=RADGRID%NLOENG(JGLSUR)
      ENDDO
      DO JGLSUR=1,RADGRID%NDGSUR
        RADGRID%NLOENG(RADGRID%NDGLG+JGLSUR)=RADGRID%NLOENG(RADGRID%NDGLG+1-JGLSUR)
      ENDDO
    ENDIF
!     CALL GSTATS(1818,1)     MPL 2.12.08

! Setup the transform package for the radiation grid
    CALL SETUP_TRANS (KSMAX=RADGRID%NSMAX, &
     & KDGL=RADGRID%NDGLG, &
     & KLOEN=RADGRID%NLOENG(1:RADGRID%NDGLG), &
     & LDLINEAR_GRID=LLINEAR_GRID, &
     & LDSPLIT=LSPLIT, &
     & KAPSETS=NAPSETS, &
     & KRESOL=RADGRID%NRESOL_ID)

    ALLOCATE(RADGRID%NSTA(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
    ALLOCATE(RADGRID%NONL(RADGRID%NDGSAG:RADGRID%NDGENG+N_REGIONS_NS-1,N_REGIONS_EW))
    ALLOCATE(RADGRID%NPTRFRSTLAT(N_REGIONS_NS))
    ALLOCATE(RADGRID%NFRSTLAT(N_REGIONS_NS))
    ALLOCATE(RADGRID%NLSTLAT(N_REGIONS_NS))
    ALLOCATE(RADGRID%RMU(RADGRID%NDGSAG:RADGRID%NDGENG))
    ALLOCATE(RADGRID%RSQM2(RADGRID%NDGSAG:RADGRID%NDGENG))
    ALLOCATE(RADGRID%RLATIG(RADGRID%NDGSAG:RADGRID%NDGENG))

! Interrogate the transform package for the radiation grid
!    CALL GSTATS(1818,0)    MPL 2.12.08
    CALL TRANS_INQ (KRESOL     =RADGRID%NRESOL_ID, &
     & KSPEC2     =RADGRID%NSPEC2, &
     & KNUMP      =RADGRID%NUMP, &
     & KGPTOT     =RADGRID%NGPTOT, &
     & KGPTOTG    =RADGRID%NGPTOTG, &
     & KGPTOTMX   =RADGRID%NGPTOTMX, &
     & KPTRFRSTLAT=RADGRID%NPTRFRSTLAT, &
     & KFRSTLAT   =RADGRID%NFRSTLAT, &
     & KLSTLAT    =RADGRID%NLSTLAT, &
     & KFRSTLOFF  =RADGRID%NFRSTLOFF, &
     & KSTA       =RADGRID%NSTA(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
     & KONL       =RADGRID%NONL(1:RADGRID%NDGLG+N_REGIONS_NS-1,:), &
     & KPTRFLOFF  =RADGRID%NPTRFLOFF, &
     & PMU        =RADGRID%RMU(1:) )

    IF( NRADINT == 2 .OR. NRADINT == 3 )THEN
      DO JGL=1,RADGRID%NDGLG
        RADGRID%RSQM2(JGL) = SQRT(1.0_JPRB - RADGRID%RMU(JGL)*RADGRID%RMU(JGL))
        RADGRID%RLATIG(JGL) = ASIN(RADGRID%RMU(JGL))
!       WRITE(NULOUT,'("SUECRAD: JGL=",I6," RADGRID%RLATIG=",F10.3)')&
!        & JGL,RADGRID%RLATIG(JGL)
      ENDDO
      IF(RADGRID%NDGSUR >= 1)THEN
        DO JGLSUR=1,RADGRID%NDGSUR
          RADGRID%RMU(1-JGLSUR)=RADGRID%RMU(JGLSUR)
          RADGRID%RSQM2(1-JGLSUR)=RADGRID%RSQM2(JGLSUR)
          RADGRID%RLATIG(1-JGLSUR)=RPI-RADGRID%RLATIG(JGLSUR)
        ENDDO
        DO JGLSUR=1,RADGRID%NDGSUR
          RADGRID%RMU(RADGRID%NDGLG+JGLSUR)=RADGRID%RMU(RADGRID%NDGLG+1-JGLSUR)
          RADGRID%RSQM2(RADGRID%NDGLG+JGLSUR)=RADGRID%RSQM2(RADGRID%NDGLG+1-JGLSUR)
          RADGRID%RLATIG(RADGRID%NDGLG+JGLSUR)=-RPI-RADGRID%RLATIG(RADGRID%NDGLG+1-JGLSUR)
        ENDDO
      ENDIF
    ENDIF

    RADGRID%NDGSAL=1
    RADGRID%NDGENL=RADGRID%NLSTLAT(MY_REGION_NS)-RADGRID%NFRSTLOFF
    RADGRID%NDSUR1=3-MOD(RADGRID%NDLON,2)
    IDLSUR=MAX(RADGRID%NDLON,2*RADGRID%NSMAX+1)
    RADGRID%NDLSUR=IDLSUR+RADGRID%NDSUR1
    RADGRID%MYFRSTACTLAT=RADGRID%NFRSTLAT(MY_REGION_NS)
    RADGRID%MYLSTACTLAT=RADGRID%NLSTLAT(MY_REGION_NS)

    WRITE(NULOUT,'("SUECRAD: RADGRID%NRESOL_ID    =",I8)')RADGRID%NRESOL_ID
    WRITE(NULOUT,'("SUECRAD: RADGRID%NSMAX        =",I8)')RADGRID%NSMAX
    WRITE(NULOUT,'("SUECRAD: RADGRID%NSPEC2       =",I8)')RADGRID%NSPEC2
    WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOT       =",I8)')RADGRID%NGPTOT
    WRITE(NULOUT,'("SUECRAD: RADGRID%NGPTOTG      =",I8)')RADGRID%NGPTOTG
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAL       =",I8)')RADGRID%NDGSAL
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENL       =",I8)')RADGRID%NDGENL
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDSUR1       =",I8)')RADGRID%NDSUR1
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDLSUR       =",I8)')RADGRID%NDLSUR
    WRITE(NULOUT,'("SUECRAD: RADGRID%MYFRSTACTLAT =",I8)')RADGRID%MYFRSTACTLAT
    WRITE(NULOUT,'("SUECRAD: RADGRID%MYLSTACTLAT  =",I8)')RADGRID%MYLSTACTLAT
    CALL FLUSH(NULOUT)

    ALLOCATE(RADGRID%NASM0(0:RADGRID%NSPEC2))
    ALLOCATE(RADGRID%MYMS(RADGRID%NUMP))
    CALL TRANS_INQ (KRESOL     =RADGRID%NRESOL_ID, &
     & KASM0      =RADGRID%NASM0, &
     & KMYMS      =RADGRID%MYMS )

    ALLOCATE(RADGRID%GELAM(RADGRID%NGPTOT))
    ALLOCATE(RADGRID%GELAT(RADGRID%NGPTOT))
    ALLOCATE(RADGRID%GESLO(RADGRID%NGPTOT))
    ALLOCATE(RADGRID%GECLO(RADGRID%NGPTOT))
    ALLOCATE(RADGRID%GEMU (RADGRID%NGPTOT))

    IOFF=0
    ILAT=RADGRID%NPTRFLOFF
    DO JGLAT=RADGRID%NFRSTLAT(MY_REGION_NS), &
       & RADGRID%NLSTLAT(MY_REGION_NS)
      ZGEMU=RADGRID%RMU(JGLAT)
      ILAT=ILAT+1
      ISTLON  = RADGRID%NSTA(ILAT,MY_REGION_EW)
      IENDLON = ISTLON-1 + RADGRID%NONL(ILAT,MY_REGION_EW)

      DO JLON=ISTLON,IENDLON
        ZLON=  REAL(JLON-1,JPRB)*2.0_JPRB*RPI &
         & /REAL(RADGRID%NLOENG(JGLAT),JPRB)
        IOFF=IOFF+1
        RADGRID%GELAM(IOFF) = ZLON
        RADGRID%GELAT(IOFF) = ASIN(ZGEMU)
        RADGRID%GESLO(IOFF) = SIN(ZLON)
        RADGRID%GECLO(IOFF) = COS(ZLON)
        RADGRID%GEMU (IOFF) = ZGEMU
      ENDDO
    ENDDO

    IF( NRADINT == 2 .OR. NRADINT == 3 )THEN

!   For grid point interpolations we need to calculate the halo size
!   required by each processor

      ALLOCATE(ZLATX(RADGRID%NGPTOTMX))
      ALLOCATE(ZLONX(RADGRID%NGPTOTMX))
      DO J=1,RADGRID%NGPTOT
        ZLATX(J)=RADGRID%GELAT(J)/RPI*2.0_JPRB*90.0
        ZLONX(J)=(RADGRID%GELAM(J)-RPI)/RPI*180.0
      ENDDO
      ZMINRADLAT=MINVAL(ZLATX(1:RADGRID%NGPTOT))
      ZMAXRADLAT=MAXVAL(ZLATX(1:RADGRID%NGPTOT))
      ZMINRADLON=MINVAL(ZLONX(1:RADGRID%NGPTOT))
      ZMAXRADLON=MAXVAL(ZLONX(1:RADGRID%NGPTOT))
      IF( LLDEBUG )THEN
        WRITE(NULOUT,'("RADGRID,BEGIN")')
        IF( MYPROC /= 1 )THEN
          stop 'Pas pret pour proc > 1'
!         CALL MPL_SEND(RADGRID%NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.R')
!         CALL MPL_SEND(ZLATX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD.R')
!         CALL MPL_SEND(ZLONX(1:RADGRID%NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD.R')
        ENDIF
        IF( MYPROC == 1 )THEN
          DO JROC=1,NPROC
            IF( JROC == MYPROC )THEN
              DO J=1,RADGRID%NGPTOT
                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),MYPROC
              ENDDO
            ELSE
              stop 'Pas pret pour proc > 1'
!             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.M')
!             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD.M')
!             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD.M')
              DO J=1,IGPTOT
                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6)')ZLATX(J),ZLONX(J),JROC
              ENDDO
            ENDIF
          ENDDO
        ENDIF
        WRITE(NULOUT,'("RADGRID,END")')
      ENDIF
      DEALLOCATE(ZLATX)
      DEALLOCATE(ZLONX)

      ALLOCATE(ZLATX(NGPTOTMX))
      ALLOCATE(ZLONX(NGPTOTMX))
      DO J=1,NGPTOT
        ZLATX(J)=GELAT(J)/RPI*2.0_JPRB*90.0
        ZLONX(J)=(GELAM(J)-RPI)/RPI*180.0
      ENDDO
      ZMINMDLLAT=MINVAL(ZLATX(1:NGPTOT))
      ZMAXMDLLAT=MAXVAL(ZLATX(1:NGPTOT))
      ZMINMDLLON=MINVAL(ZLONX(1:NGPTOT))
      ZMAXMDLLON=MAXVAL(ZLONX(1:NGPTOT))
      IF( LLDEBUG )THEN
        WRITE(NULOUT,'("MODELGRID,BEGIN")')
        IF( MYPROC /= 1 )THEN
          stop 'Pas pret pour proc > 1'
!         CALL MPL_SEND(NGPTOT,KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD')
!         CALL MPL_SEND(ZLATX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=2,CDSTRING='SUECRAD')
!         CALL MPL_SEND(ZLONX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=3,CDSTRING='SUECRAD')
!         CALL MPL_SEND(NGLOBALINDEX(1:NGPTOT),KDEST=NPRCIDS(1),KTAG=4,CDSTRING='SUECRAD')
        ENDIF
        IF( MYPROC == 1 )THEN
          DO JROC=1,NPROC
            IF( JROC == MYPROC )THEN
              DO J=1,NGPTOT
                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),MYPROC,NGLOBALINDEX(J)
              ENDDO
            ELSE
              stop 'Pas pret pour proc > 1'
!             CALL MPL_RECV(IGPTOT,KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD')
!             CALL MPL_RECV(ZLATX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=2,CDSTRING='SUECRAD')
!             CALL MPL_RECV(ZLONX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=3,CDSTRING='SUECRAD')
              ALLOCATE(IGLOBALINDEX(1:IGPTOT))
!             CALL MPL_RECV(IGLOBALINDEX(1:IGPTOT),KSOURCE=NPRCIDS(JROC),KTAG=4,CDSTRING='SUECRAD')
              DO J=1,IGPTOT
                WRITE(NULOUT,'(F7.2,2X,F7.2,2X,I6,2X,I12)')ZLATX(J),ZLONX(J),JROC,IGLOBALINDEX(J)
              ENDDO
              DEALLOCATE(IGLOBALINDEX)
            ENDIF
          ENDDO
        ENDIF
        WRITE(NULOUT,'("MODELGRID,END")')
      ENDIF
      DEALLOCATE(ZLATX)
      DEALLOCATE(ZLONX)

      IF( LLDEBUG )THEN
        WRITE(NULOUT,'("ZMINRADLAT=",F10.2)')ZMINRADLAT
        WRITE(NULOUT,'("ZMINMDLLAT=",F10.2)')ZMINMDLLAT
        WRITE(NULOUT,'("ZMAXRADLAT=",F10.2)')ZMAXRADLAT
        WRITE(NULOUT,'("ZMAXMDLLAT=",F10.2)')ZMAXMDLLAT
        WRITE(NULOUT,'("ZMINRADLON=",F10.2)')ZMINRADLON
        WRITE(NULOUT,'("ZMINMDLLON=",F10.2)')ZMINMDLLON
        WRITE(NULOUT,'("ZMAXRADLON=",F10.2)')ZMAXRADLON
        WRITE(NULOUT,'("ZMAXMDLLON=",F10.2)')ZMAXMDLLON
      ENDIF

      ZLAT=NDGLG/180.
      ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
      IF( ZMINRADLAT < ZMINMDLLAT )THEN
        NRIWIDES=JP_MIN_HALO+ILATS_DIFF_C
      ELSE
        NRIWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ENDIF
      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
      IF( ZMAXRADLAT < ZMAXMDLLAT )THEN
        NRIWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ELSE
        NRIWIDEN=JP_MIN_HALO+ILATS_DIFF_C
      ENDIF
      ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
      IF( ZMINRADLON < ZMINMDLLON )THEN
        NRIWIDEW=JP_MIN_HALO+ILATS_DIFF_C
      ELSE
        NRIWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ENDIF
      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
      IF( ZMAXRADLON < ZMAXMDLLON )THEN
        NRIWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ELSE
        NRIWIDEE=JP_MIN_HALO+ILATS_DIFF_C
      ENDIF

      ZLAT=RADGRID%NDGLG/180.
      ILATS_DIFF_C=CEILING(ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLAT-ZMINMDLLAT)*ZLAT)
      IF( ZMINMDLLAT < ZMINRADLAT )THEN
        NROWIDES=JP_MIN_HALO+ILATS_DIFF_C
      ELSE
        NROWIDES=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ENDIF
      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLAT-ZMAXMDLLAT)*ZLAT)
      IF( ZMAXMDLLAT < ZMAXRADLAT )THEN
        NROWIDEN=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ELSE
        NROWIDEN=JP_MIN_HALO+ILATS_DIFF_C
      ENDIF
      ILATS_DIFF_C=CEILING(ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMINRADLON-ZMINMDLLON)*ZLAT)
      IF( ZMINMDLLON < ZMINRADLON )THEN
        NROWIDEW=JP_MIN_HALO+ILATS_DIFF_C
      ELSE
        NROWIDEW=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ENDIF
      ILATS_DIFF_C=CEILING(ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
      ILATS_DIFF_F=FLOOR  (ABS(ZMAXRADLON-ZMAXMDLLON)*ZLAT)
      IF( ZMAXMDLLON < ZMAXRADLON )THEN
        NROWIDEE=MAX(0,JP_MIN_HALO-ILATS_DIFF_F)
      ELSE
        NROWIDEE=JP_MIN_HALO+ILATS_DIFF_C
      ENDIF

    ENDIF

    RADGRID%NDGSAH=MAX(RADGRID%NDGSAG,&
     & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF
    RADGRID%NDGENH=MIN(RADGRID%NDGENG,&
     & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGSAH       =",I8)')RADGRID%NDGSAH
    WRITE(NULOUT,'("SUECRAD: RADGRID%NDGENH       =",I8)')RADGRID%NDGENH

    IF( NRADINT == 2 .OR. NRADINT == 3 )THEN

      ILBRLATI = MAX(RADGRID%NDGSAG,&
       & RADGRID%NDGSAL+RADGRID%NFRSTLOFF-NROWIDEN)-RADGRID%NFRSTLOFF
      IUBRLATI = MIN(RADGRID%NDGENG,&
       & RADGRID%NDGENL+RADGRID%NFRSTLOFF+NROWIDES)-RADGRID%NFRSTLOFF
      ALLOCATE(RADGRID%RLATI(ILBRLATI:IUBRLATI))
      ALLOCATE(RADGRID%RIPI0(ILBRLATI:IUBRLATI))
      ALLOCATE(RADGRID%RIPI1(ILBRLATI:IUBRLATI))
      ALLOCATE(RADGRID%RIPI2(ILBRLATI:IUBRLATI))

      DO JGL= ILBRLATI,IUBRLATI
        IGLGLO=JGL+RADGRID%NFRSTLOFF
        IF(IGLGLO >= 0.AND.IGLGLO <= RADGRID%NDGLG) THEN
          ZD1=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO)
          ZD2=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+1)
          ZD3=RADGRID%RLATIG(IGLGLO-1)-RADGRID%RLATIG(IGLGLO+2)
          ZD4=RADGRID%RLATIG(IGLGLO  )-RADGRID%RLATIG(IGLGLO+1)
          ZD5=RADGRID%RLATIG(IGLGLO  )-RADGRID%RLATIG(IGLGLO+2)
          ZD6=RADGRID%RLATIG(IGLGLO+1)-RADGRID%RLATIG(IGLGLO+2)
          RADGRID%RIPI0(JGL)=-1.0_JPRB/(ZD1*ZD4*ZD5)
          RADGRID%RIPI1(JGL)= 1.0_JPRB/(ZD2*ZD4*ZD6)
          RADGRID%RIPI2(JGL)=-1.0_JPRB/(ZD3*ZD5*ZD6)
        ENDIF
        RADGRID%RLATI(JGL)=RADGRID%RLATIG(IGLGLO)
      ENDDO

      IF( NPROC > 1 )THEN
        IRIRPTSUR=NGPTOTG
        IRISPTSUR=2*NGPTOTG
      ELSE
        IRIRPTSUR=0
        IRISPTSUR=0
      ENDIF

      ALLOCATE(NRISTA(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
      ALLOCATE(NRIONL(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
      ALLOCATE(NRIOFF(NDGSAL-NRIWIDEN:NDGENL+NRIWIDES))
      ALLOCATE(NRIEXT(1-NDLON:NDLON+NDLON,1-NRIWIDEN:NDGENL+NRIWIDES))
      ALLOCATE(NRICORE(NGPTOT))
      ALLOCATE(IRISENDPOS(IRISPTSUR))
      ALLOCATE(IRIRECVPOS(IRIRPTSUR))
      ALLOCATE(IRISENDPTR(NPROC+1))
      ALLOCATE(IRIRECVPTR(NPROC+1))
      ALLOCATE(IRICOMM(NPROC))
      ALLOCATE(IRIMAP(4,NDGLG))
! MPL 1.12.08
!     CALL RDCSET('RI',NRIWIDEN,NRIWIDES,NRIWIDEW,NRIWIDEE,&
!      & IRIRPTSUR,IRISPTSUR,&
!      & NDGLG,NDLON,NDGSAG,NDGENG,IDUM,IDUM,NDGSAL,NDGENL,&
!      & NDSUR1,NDLSUR,NDGSUR,NGPTOT,IDUM,&
!      & NPTRFLOFF,NFRSTLOFF,MYFRSTACTLAT,MYLSTACTLAT,&
!      & NSTA,NONL,NLOENG,NPTRFRSTLAT,NFRSTLAT,NLSTLAT,&
!      & RMU,RSQM2,&
!      & NRISTA,NRIONL,NRIOFF,NRIEXT,NRICORE,NARIB1,&
!      & NRIPROCS,NRIMPBUFSZ,NRIRPT,NRISPT,&
!      & IRISENDPOS,IRIRECVPOS,IRISENDPTR,IRIRECVPTR,IRICOMM,IRIMAP,IRIMAPLEN)
      CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
      WRITE(NULOUT,'("SUECRAD: NARIB1=",I12)')NARIB1
      ALLOCATE(NRISENDPOS(NRISPT))
      ALLOCATE(NRIRECVPOS(NRIRPT))
      ALLOCATE(NRISENDPTR(NRIPROCS+1))
      ALLOCATE(NRIRECVPTR(NRIPROCS+1))
      ALLOCATE(NRICOMM(NRIPROCS))
      NRISENDPOS(1:NRISPT)=IRISENDPOS(1:NRISPT)
      NRIRECVPOS(1:NRIRPT)=IRIRECVPOS(1:NRIRPT)
      NRISENDPTR(1:NRIPROCS+1)=IRISENDPTR(1:NRIPROCS+1)
      NRIRECVPTR(1:NRIPROCS+1)=IRIRECVPTR(1:NRIPROCS+1)
      NRICOMM(1:NRIPROCS)=IRICOMM(1:NRIPROCS)
      DEALLOCATE(IRISENDPOS)
      DEALLOCATE(IRIRECVPOS)
      DEALLOCATE(IRISENDPTR)
      DEALLOCATE(IRIRECVPTR)
      DEALLOCATE(IRICOMM)
      DEALLOCATE(IRIMAP)

      IF( NPROC > 1 )THEN
        IRORPTSUR=RADGRID%NGPTOTG
        IROSPTSUR=2*RADGRID%NGPTOTG
      ELSE
        IRORPTSUR=0
        IROSPTSUR=0
      ENDIF

      ALLOCATE(NROSTA(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
      ALLOCATE(NROONL(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
      ALLOCATE(NROOFF(RADGRID%NDGSAL-NROWIDEN:RADGRID%NDGENL+NROWIDES))
      ALLOCATE(NROEXT(1-RADGRID%NDLON:RADGRID%NDLON+RADGRID%NDLON,&
       & 1-NROWIDEN:RADGRID%NDGENL+NROWIDES))
      ALLOCATE(NROCORE(RADGRID%NGPTOT))
      ALLOCATE(IROSENDPOS(IROSPTSUR))
      ALLOCATE(IRORECVPOS(IRORPTSUR))
      ALLOCATE(IROSENDPTR(NPROC+1))
      ALLOCATE(IRORECVPTR(NPROC+1))
      ALLOCATE(IROCOMM(NPROC))
      ALLOCATE(IROMAP(4,RADGRID%NDGLG))
! MPL 1.12.08
!     CALL RDCSET('RO',NROWIDEN,NROWIDES,NROWIDEW,NROWIDEE,&
!      & IRORPTSUR,IROSPTSUR,&
!      & RADGRID%NDGLG,RADGRID%NDLON,RADGRID%NDGSAG,&
!      & RADGRID%NDGENG,IDUM,IDUM,RADGRID%NDGSAL,RADGRID%NDGENL,&
!      & RADGRID%NDSUR1,RADGRID%NDLSUR,RADGRID%NDGSUR,RADGRID%NGPTOT,IDUM,&
!      & RADGRID%NPTRFLOFF,RADGRID%NFRSTLOFF,RADGRID%MYFRSTACTLAT,RADGRID%MYLSTACTLAT,&
!      & RADGRID%NSTA,RADGRID%NONL,RADGRID%NLOENG,RADGRID%NPTRFRSTLAT,&
!      & RADGRID%NFRSTLAT,RADGRID%NLSTLAT,&
!      & RADGRID%RMU,RADGRID%RSQM2,&
!      & NROSTA,NROONL,NROOFF,NROEXT,NROCORE,NAROB1,&
!      & NROPROCS,NROMPBUFSZ,NRORPT,NROSPT,&
!      & IROSENDPOS,IRORECVPOS,IROSENDPTR,IRORECVPTR,IROCOMM,IROMAP,IROMAPLEN)
      CALL ABOR1('JUSTE APRES CALL RDCSET COMMENTE')
      WRITE(NULOUT,'("SUECRAD: NAROB1=",I12)')NAROB1
      ALLOCATE(NROSENDPOS(NROSPT))
      ALLOCATE(NRORECVPOS(NRORPT))
      ALLOCATE(NROSENDPTR(NROPROCS+1))
      ALLOCATE(NRORECVPTR(NROPROCS+1))
      ALLOCATE(NROCOMM(NROPROCS))
      NROSENDPOS(1:NROSPT)=IROSENDPOS(1:NROSPT)
      NRORECVPOS(1:NRORPT)=IRORECVPOS(1:NRORPT)
      NROSENDPTR(1:NROPROCS+1)=IROSENDPTR(1:NROPROCS+1)
      NRORECVPTR(1:NROPROCS+1)=IRORECVPTR(1:NROPROCS+1)
      NROCOMM(1:NROPROCS)=IROCOMM(1:NROPROCS)
      DEALLOCATE(IROSENDPOS)
      DEALLOCATE(IRORECVPOS)
      DEALLOCATE(IROSENDPTR)
      DEALLOCATE(IRORECVPTR)
      DEALLOCATE(IROCOMM)
      DEALLOCATE(IROMAP)

      IF( LLDEBUG )THEN
        WRITE(NULOUT,'("")')
        IRIWIDEMAXN=0
        IRIWIDEMAXS=0
        IRIWIDEMAXW=0
        IRIWIDEMAXE=0
        IROWIDEMAXN=0
        IROWIDEMAXS=0
        IROWIDEMAXW=0
        IROWIDEMAXE=0
        IARIB1MAX=0
        IAROB1MAX=0
        IWIDE(1)=NRIWIDEN
        IWIDE(2)=NRIWIDES
        IWIDE(3)=NRIWIDEW
        IWIDE(4)=NRIWIDEE
        IWIDE(5)=NROWIDEN
        IWIDE(6)=NROWIDES
        IWIDE(7)=NROWIDEW
        IWIDE(8)=NROWIDEE
        IWIDE(9)=NARIB1
        IWIDE(10)=NAROB1
        IF( MYPROC /= 1 )THEN
          stop 'Pas pret pour proc > 1'
!         CALL MPL_SEND(IWIDE(1:10),KDEST=NPRCIDS(1),KTAG=1,CDSTRING='SUECRAD.W')
        ENDIF
        IF( MYPROC == 1 )THEN
          DO JROC=1,NPROC
            IF( JROC /= MYPROC )THEN
              stop 'Pas pret pour proc > 1'
!             CALL MPL_RECV(IWIDE(1:10),KSOURCE=NPRCIDS(JROC),KTAG=1,CDSTRING='SUECRAD.W')
            ENDIF
            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEN=",I3,2X,"NROWIDEN=",I3 )')&
             & JROC,IWIDE(1),IWIDE(5)
            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDES=",I3,2X,"NROWIDES=",I3 )')&
             & JROC,IWIDE(2),IWIDE(6)
            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEW=",I3,2X,"NROWIDEW=",I3 )')&
             & JROC,IWIDE(3),IWIDE(7)
            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NRIWIDEE=",I3,2X,"NROWIDEE=",I3 )')&
             & JROC,IWIDE(4),IWIDE(8)
            WRITE(NULOUT,'("SUECRAD: PROC=",I5,2X,"NARIB1=",I10,2X,"NAROB1=",I10 )')&
             & JROC,IWIDE(9),IWIDE(10)
            WRITE(NULOUT,'("")')
            IF( IWIDE(1) > IRIWIDEMAXN ) IRIWIDEMAXN=IWIDE(1)
            IF( IWIDE(2) > IRIWIDEMAXS ) IRIWIDEMAXS=IWIDE(2)
            IF( IWIDE(3) > IRIWIDEMAXW ) IRIWIDEMAXW=IWIDE(3)
            IF( IWIDE(4) > IRIWIDEMAXE ) IRIWIDEMAXE=IWIDE(4)
            IF( IWIDE(5) > IROWIDEMAXN ) IROWIDEMAXN=IWIDE(5)
            IF( IWIDE(6) > IROWIDEMAXS ) IROWIDEMAXS=IWIDE(6)
            IF( IWIDE(7) > IROWIDEMAXW ) IROWIDEMAXW=IWIDE(7)
            IF( IWIDE(8) > IROWIDEMAXE ) IROWIDEMAXE=IWIDE(8)
            IF( IWIDE(9)  > IARIB1MAX  ) IARIB1MAX  =IWIDE(9)
            IF( IWIDE(10) > IAROB1MAX  ) IAROB1MAX  =IWIDE(10)
          ENDDO
          WRITE(NULOUT,'("")')
          WRITE(NULOUT,'("SUECRAD: NRIWIDEN(MAX)  =",I8)')IRIWIDEMAXN
          WRITE(NULOUT,'("SUECRAD: NRIWIDES(MAX)  =",I8)')IRIWIDEMAXS
          WRITE(NULOUT,'("SUECRAD: NRIWIDEW(MAX)  =",I8)')IRIWIDEMAXW
          WRITE(NULOUT,'("SUECRAD: NRIWIDEE(MAX)  =",I8)')IRIWIDEMAXE
          WRITE(NULOUT,'("SUECRAD: NROWIDEN(MAX)  =",I8)')IROWIDEMAXN
          WRITE(NULOUT,'("SUECRAD: NROWIDES(MAX)  =",I8)')IROWIDEMAXS
          WRITE(NULOUT,'("SUECRAD: NROWIDEW(MAX)  =",I8)')IROWIDEMAXW
          WRITE(NULOUT,'("SUECRAD: NROWIDEE(MAX)  =",I8)')IROWIDEMAXE
          WRITE(NULOUT,'("SUECRAD: NARIB1(MAX)    =",I10)')IARIB1MAX
          WRITE(NULOUT,'("SUECRAD: NAROB1(MAX)    =",I10)')IAROB1MAX
          WRITE(NULOUT,'("")')
        ENDIF
        CALL FLUSH(NULOUT)
      ENDIF

    ENDIF
!    CALL GSTATS(1818,1)      MPL 2.12.08

  ELSE

    WRITE(NULOUT,'("SUECRAD: INVALID VALUE FOR NRADINT=",I6)')NRADINT
    CALL ABOR1('SUECRAD: NRADINT INVALID')

  ENDIF

ENDIF              ! END OF LERADI BLOCK

!      ----------------------------------------------------------------

!*       4.    INITIALIZE RADIATION COEFFICIENTS.
!              ----------------------------------

RCDAY   = RDAY * RG / RCPD
DIFF   = 1.66_JPRB
R10E   = 0.4342945_JPRB

! CALL GSTATS(1818,0)    MPL 2.12.08
CALL SURDI

IF (NINHOM == 0) THEN
  RLWINHF=1._JPRB
  RSWINHF=1._JPRB
ENDIF

!      ----------------------------------------------------------------

!*       5.    INITIALIZE RADIATION ABSORPTION COEFFICIENTS
!              --------------------------------------------

!*       5.1.  Initialization routine for RRTM
!              -------------------------------

CALL SURRTAB
CALL SURRTPK
CALL SURRTRF
CALL SURRTFTR

IF (LRRTM) THEN
  IF (KLEV > JPLAY) THEN
    WRITE(UNIT=KULOUT,&
     & FMT='('' RRTM MAXIMUM NUMBER OF LAYERS IS REACHED'',&
     & '' CALL ABORT'')')
    CALL ABOR1(' ABOR1 CALLED SUECRAD')
  ENDIF

! Read the absorption coefficient data and reduce from 256 to 140 g-points

  CALL RRTM_INIT_140GP

  INBLW=16

ELSE
  INBLW=6

ENDIF

CALL SULWN
CALL SUSWN   (NTSW, NSW)
CALL SUCLOPN (NTSW, NSW, KLEV)

!-- routines specific to SRTM
IF (LSRTM) THEN
  NTSW=14
  ISW =14
  CALL SRTM_INIT
  CALL SUSRTAER
  CALL SUSRTCOP
  WRITE(UNIT=KULOUT,FMT='(''SRTM Configuration'',L8,3I4)')LSRTM,NTSW,ISW,JPGPT

ELSE
  IF (.NOT.LONEWSW .OR. ((NSW /= 2).AND.(NSW /= 4).AND.(NSW /= 6)) ) THEN
    WRITE(UNIT=KULOUT,FMT='(''Wrong SW Configuration'',L8,I3)')LONEWSW,NSW
  ENDIF

  CALL SUSWN   (NTSW,NSW)
  CALL SUAERSN (NTSW,NSW)
ENDIF
WRITE(UNIT=KULOUT,FMT='('' NLW,NTSW,NSW SET EQUAL TO:'',3I3)') INBLW,NTSW,NSW


!-- routine specific to the UV processor
IF (LUVPROC) THEN
  NUVTIM = NUVTIM * 86400
  CALL SU_UVRAD ( NUV )
ENDIF

!      ----------------------------------------------------------------

!*       6.    INITIALIZE AEROSOL OPTICAL PARAMETERS AND DISTRIBUTION
!              ------------------------------------------------------

!- LW optical properties
CALL SUAERL
!- SW optical properties moved above
!CALL SUAERSN (NTSW,NSW)

!- horizontal distribution
CALL SUAERH

!- vertical distribution
CALL SUAERV ( KLEV  , PETAH,&
 & CVDAES , CVDAEL , CVDAEU , CVDAED,&
 & RCTRBGA, RCVOBGA, RCSTBGA, RCAEOPS, RCAEOPL, RCAEOPU,&
 & RCAEOPD, RCTRPT , RCAEADK, RCAEADM, RCAEROS &
 & )

!-- Overlap function (only used if NOVLP=4)
! Appel supprime par MPL (30042010) car NOVLP=4 pas utilise
! sinon il faudrait calculer le geopotentiel STZ
!CALL SUOVLP ( KLEV )

!-- parameters for prognostic aerosols
CALL SU_AERW

!      ----------------------------------------------------------------

!*       7.    INITIALIZE SATELLITE GEOMETRICAL/RADIOMETRIC PARAMETERS
!              -------------------------------------------------------

IF (LEPHYS .AND. NMODE > 1) THEN
  CALL SUSAT
ENDIF
!CALL GSTATS(1818,1)   MPL 2.12.08

!      ----------------------------------------------------------------

!*       8.    INITIALIZE CLIMATOLOGICAL OZONE DISTRIBUTION
!              --------------------------------------------
!                  (not done here!!!  called from APLPAR as it depends
!                     on model pressure levels!)

!      ----------------------------------------------------------------

!*       9.    SET UP MODEL CONFIGURATION FOR TIME-SPACE INTERPOLATION
!              -------------------------------------------------------

ZTSTEP=MAX(TSTEP,1.0_JPRB)
ZSTPHR=3600._JPRB/ZTSTEP
IRADFR=NRADFR
IF(NRADFR < 0) THEN
  NRADFR=-NRADFR*ZSTPHR+0.5_JPRB
ENDIF
NRADPFR=NRADPFR*NRADFR
IF (MOD(NRADPLA,2) == 0.AND. NRADPLA /= 0) THEN
  NRADPLA=NRADPLA+1
ENDIF

IF(NRADUV < 0) THEN
  NRADUV=-NRADUV*ZSTPHR+0.5_JPRB
ENDIF

IST1HR=ZSTPHR+0.05_JPRB
ISTNHR=  NLNGR1H *ZSTPHR+0.05_JPRB
IF (MOD(3600._JPRB,ZTSTEP) > 0.1_JPRB) THEN
  801 CONTINUE
  IST1HR=IST1HR+1
  IF (MOD(ISTNHR,IST1HR) /= 0) GO TO 801
ENDIF
IF (NRADFR == 1) THEN
  NRADSFR=NRADFR
ELSE
  NRADSFR=IST1HR
ENDIF
NRADNFR=NRADFR

IF(LRAYFM) THEN
  NRPROMA=NDLON+6+(1-MOD(NDLON,2))
ENDIF

!      ----------------------------------------------------------------

!*       10.    ALLOCATE WORK ARRAYS
!               --------------------

IU = NULOUT
LLP = NPRINTLEV >= 1.OR. LALLOPR

IF (LEPHYS) THEN
  ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
  ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
  ALLOCATE(EMTC(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'EMTC     ',SIZE(EMTC     ),SHAPE(EMTC     )
  ALLOCATE(TRSC(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'TRSC     ',SIZE(TRSC     ),SHAPE(TRSC     )
  ALLOCATE(SRSWD(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRSWD    ',SIZE(SRSWD    ),SHAPE(SRSWD    )
  ALLOCATE(SRLWD(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRLWD    ',SIZE(SRLWD    ),SHAPE(SRLWD    )
  ALLOCATE(SRSWDCS(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRSWDCS  ',SIZE(SRSWDCS  ),SHAPE(SRSWDCS  )
  ALLOCATE(SRLWDCS(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRLWDCS  ',SIZE(SRLWDCS  ),SHAPE(SRLWDCS  )
  ALLOCATE(SRSWDV(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRSWDV   ',SIZE(SRSWDV   ),SHAPE(SRSWDV   )
  ALLOCATE(SRSWDUV(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRSWDUV  ',SIZE(SRSWDUV  ),SHAPE(SRSWDUV  )
  ALLOCATE(EDRO(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'EDRO     ',SIZE(EDRO     ),SHAPE(EDRO     )
  ALLOCATE(SRSWPAR(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRSWPAR  ',SIZE(SRSWPAR  ),SHAPE(SRSWPAR  )
  ALLOCATE(SRSWUVB(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'SRSWUVB  ',SIZE(SRSWUVB  ),SHAPE(SRSWUVB  )

ELSEIF(LMPHYS .AND. (LRAYFM.OR.LRAYFM15)) THEN
  ALLOCATE(EMTD(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'EMTD     ',SIZE(EMTD     ),SHAPE(EMTD     )
  ALLOCATE(TRSW(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'TRSW     ',SIZE(TRSW     ),SHAPE(TRSW     )
  ALLOCATE(EMTU(NPROMA,NFLEVG+1,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'EMTC     ',SIZE(EMTU     ),SHAPE(EMTU     )
  ALLOCATE(RMOON(NPROMA,NGPBLKS))
  IF(LLP)WRITE(IU,9) 'RMOON    ',SIZE(RMOON    ),SHAPE(RMOON    )
ENDIF
ALLOCATE(SRSWPARC(NPROMA,NGPBLKS))
IF(LLP)WRITE(IU,9) 'SRSWPARC ',SIZE(SRSWPARC ),SHAPE(SRSWPARC )
ALLOCATE(SRSWTINC(NPROMA,NGPBLKS))
IF(LLP)WRITE(IU,9) 'SRSWTINC ',SIZE(SRSWTINC ),SHAPE(SRSWTINC )

9 FORMAT(1X,'ARRAY ',A10,' ALLOCATED ',8I8)

!      ----------------------------------------------------------------

!*       10.    PRINT FINAL VALUES.
!               -------------------

IF (LOUTPUT) THEN
  WRITE(UNIT=KULOUT,FMT='('' COMMON YOERAD '')')
  WRITE(UNIT=KULOUT,FMT='('' LERADI  = '',L5 &
   & ,'' LERAD1H = '',L5,'' LECO2VAR= '',L5,'' LHGHG = '',L5 &
   & ,'' NLNGR1H = '',I2,'' NRADSFR = '',I2)')&
   & LERADI,LERAD1H,LECO2VAR,LHGHG,NLNGR1H,NRADSFR
  WRITE(UNIT=KULOUT,FMT='('' LEPO3RA  = '',L5,'' YO3%LGP = '',L5 )') LEPO3RA,YO3%LGP
  WRITE(UNIT=KULOUT,FMT='('' NRADFR  = '',I2 &
   & ,'' NRADPFR = '',I3 &
   & ,'' NRADPLA = '',I2 &
   & ,'' NRINT   = '',I1 &
   & ,'' NRPROMA = '',I5 &
   & )')&
   & NRADFR,NRADPFR,NRADPLA,NRINT, NRPROMA
  WRITE(UNIT=KULOUT,FMT='('' LERADHS= '',L5 &
   & ,'' LRRTM = '',L5 &
   & ,'' LSRTM = '',L5 &
   & ,'' NMODE = '',I1 &
   & ,'' NOZOCL= '',I1 &
   & ,'' NAER  = '',I1 &
   & ,'' NHINCSOL='',I2 &
   & )')&
   & LERADHS,LRRTM,LSRTM,NMODE,NOZOCL,NAER,NHINCSOL
  IF (.NOT.LHGHG .AND. .NOT.LECO2VAR) WRITE(UNIT=KULOUT,FMT='('' RCCO2= '',E10.3 &
    &,'' RCCH4= '',E10.3,'' RCN2O= '',E10.3,'' RCCFC11= '',E10.3,'' RCFC12= '',E10.3 &
    &)')&
    & RCCO2,RCCH4,RCN2O,RCCFC11,RCCFC12
  WRITE(UNIT=KULOUT,FMT='('' NINHOM = '',I1 &
   & ,'' NLAYINH='',I1   &
   & ,'' RLWINHF='',F4.2 &
   & ,'' RSWINHF='',F4.2 &
   & )')&
   & NINHOM,NLAYINH,RLWINHF,RSWINHF
  IF (NPERTAER /= 0 .OR. NPERTOZ /= 0) THEN
    WRITE(UNIT=KULOUT,FMT='('' NPERTAER= '',I2 &
   & ,'' LNOTROAER='',L5 &
   & ,'' NPERTOZ = '',I1 &
   & ,'' RPERTOZ = '',F5.0 &
   & )')&
   & NPERTAER,LNOTROAER,NPERTOZ,RPERTOZ
  ENDIF
  WRITE(UNIT=KULOUT,FMT='('' NRADINT = '',I2)')NRADINT
  WRITE(UNIT=KULOUT,FMT='('' NRADRES = '',I4)')NRADRES
  WRITE(UNIT=KULOUT,FMT='('' LRADONDEM = '',L5)')LRADONDEM
  IF( NRADINT > 0 )THEN
    IDIR=LEN_TRIM(CRTABLEDIR)
    IFIL=LEN_TRIM(CRTABLEFIL)
    WRITE(UNIT=KULOUT,FMT='('' CRTABLEDIR = '',A,'' CRTABLEFIL = '',A)')&
     & CRTABLEDIR(1:IDIR),CRTABLEFIL(1:IFIL)
  ENDIF
  WRITE(UNIT=KULOUT,FMT='('' LCCNL = '',L5 &
   & ,'' LCCNO = '',L5 &
   & ,'' RCCNLND= '',F5.0 &
   & ,'' RCCNSEA= '',F5.0 &
   & ,'' LE4ALB = '',L5 &
   &)')&
   & LCCNL,LCCNO,RCCNLND,RCCNSEA,LE4ALB
  IF (LHVOLCA) THEN
    WRITE(UNIT=KULOUT,FMT='('' HISTORY OF VOLCANIC AEROSOLS= '',L5)')LHVOLCA
  ENDIF
  WRITE(UNIT=KULOUT,FMT='('' LONEWSW= '',L5 &
   & ,'' NRADIP = '',I1 &
   & ,'' NRADLP = '',I1 &
   & ,'' NICEOPT= '',I1 &
   & ,'' NLIQOPT= '',I1 &
   & ,'' LDIFFC = '',L5 &
   & )')&
   & LONEWSW,NRADIP,NRADLP,NICEOPT,NLIQOPT,LDIFFC
  WRITE(UNIT=KULOUT,FMT='('' WARNING! CLOUD OVERLAP ASSUMPT. IS''&
   & ,'' NOVLP   = '',I2 &
   & )')&
   & NOVLP
  IF (LUVPROC) THEN
    IDAYUV=NUVTIM/86400
    WRITE(UNIT=KULOUT,FMT='('' LUVPROC = '',L5 &
   & ,'' LUVTDEP= '',L5 &
   & ,'' NRADUV = '',I2 &
   & ,'' NUV = '',I2 &
   & ,'' NDAYUV = '',I5 &
   & ,'' RMUZUV = '',E9.3 &
   & )')&
   & LUVPROC,LUVTDEP,NRADUV,NUV,IDAYUV,RMUZUV
    WRITE(UNIT=KULOUT,FMT='('' RUVLAM = '',24F6.1)') (RUVLAM(JUV),JUV=1,NUV)
    WRITE(UNIT=KULOUT,FMT='('' JUVLAM = '',24(3X,I1,2X))') (JUVLAM(JUV),JUV=1,NUV)
  ENDIF
  WRITE(UNIT=KULOUT,FMT='('' NMCICA= '',I2 &
   & )')&
   & NMCICA
ENDIF

!     ------------------------------------------------------------------


IF (LHOOK) CALL DR_HOOK('SUECRAD',1,ZHOOK_HANDLE)
END SUBROUTINE SUECRAD

Generated by: GCOVR (Version 4.2)