suecrad.F90

Go to the documentation of this file.

!
! $Id: suecrad.F90 2152 2014-11-19 16:52:35Z 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 "naerad.h"
#include "namrgri.h"
#include "clesphys.h"

!*         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
print *,'SUECRAD-1'

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

!*         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,.AND.'("SUECRAD: NRADINT > 0  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,.AND.'("SUECRAD: NRADINT>0, LRAYFM=T NAER /= 0  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,.AND.'("SUECRAD: NRADINT > 0  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