suecrad15.F90

Go to the documentation of this file.

!OPTIONS XOPT(NOEVAL)
SUBROUTINE suecrad15 (KULOUT, KLEV, PETAH )

!**** *SUECRAD15*   - INITIALIZE COMMONS YOMRxx15 CONTROLLING RADIATION
!****                 FROZEN VERSION (CYCLE 15) OF SUECRAD

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

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

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

!        IMPLICIT ARGUMENTS :
!        --------------------
!        COMMONS YOMRAD15, YOMRDU15

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

!     EXTERNALS.
!     ----------
!        SUAER, SUAERH, SUAERV, SULW, SUSW, SUCLD, SUOCST, SUSAT

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

!     AUTHOR.
!     -------
!        96-11: Ph. Dandin. Meteo-France
!        ORIGINAL : 88-12-15 BY JEAN-JACQUES MORCRETTE  *ECMWF*

!     MODIFICATIONS.
!     --------------
!        R. El Khatib 01-02-02 proper initialization of NFRRC moved in SUCFU
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        F. Bouyssel 27-09-04 initialisation of NSW
!        A. Alias    29-09-05 Sulfate aerosols (Hu Rong Ming)
!     ------------------------------------------------------------------

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

USE yomct0   , ONLY : nprintlev
USE yomdim   , ONLY : ndlon    ,nsmax   ,ngpblks  ,nflevg   ,nproma
USE yomdyn   , ONLY : tstep
! Ce qui concerne NULNAM commente par MPL le 15.04.09
!USE YOMLUN   , ONLY : NULNAM
USE yomcst   , ONLY : rday     ,rg       ,rcpd
USE yomphy   , ONLY : lrayfm15
USE yoephy   , ONLY : lephys   ,leradi
USE yomrad15 , ONLY : naer15   ,nflux15  ,nmode15  ,nrad15   ,&
 & nradfr15 ,nradpfr15,nradpla15,nrint15  ,nradnfr15,&
 & nradsfr15,novlp15  ,nrproma15,nradf2c15,nradc2f15,&
 & lerad6h15,leradhs15,lradaer15,lnewaer15
USE yoerad   , ONLY : naer     ,ntsw
!USE YOERAD   , ONLY : NAER     ,NSW      ,NTSW
! NSW mis dans .def MPL 20140211
USE yomrdu15 , ONLY : nuaer15  ,ntraer15 ,rcday15  ,r10e15   ,&
 & reelog15 ,repsc15  ,repsco15 ,repscq15 ,repsct15 ,&
 & repscw15 ,diff15  
USE yomaerd15, ONLY : cvdaes15 ,cvdael15 ,cvdaeu15 ,cvdaed15 ,&
 & cvdaef15 ,&
 & rcaeops15,rcaeopl15,rcaeopu15,rcaeopd15,rctrbga15,&
 & rcaeopf15,&
 & rcvobga15,rcstbga15,rctrpt15 ,rcaeadm15,rcaeros15,&
 & rcaeadk15  
USE yomprad  , ONLY : lodbgradi,lodbgradl
USE yomradf  , ONLY : emtd     ,emtu      ,trsw    ,rmoon

IMPLICIT NONE

include "clesphys.h"

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV
INTEGER(KIND=JPIM),INTENT(IN)    :: KULOUT 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PETAH(klev+1)
LOGICAL :: LLP

#include "namrad15.h"
!      ----------------------------------------------------------------

LOGICAL :: LLMESS

INTEGER(KIND=JPIM) :: IRADFR, IST1HR, IST6HR


REAL(KIND=JPRB) :: ZSTPHR, ZTSTEP
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "posnam.intfb.h"
#include "suaer15.intfb.h"
#include "suaerv15.intfb.h"
#include "suecradi15.intfb.h"
#include "suecradl.intfb.h"
#include "sulw15.intfb.h"
#include "surdi15.intfb.h"
#include "susat.intfb.h"
#include "susw15.intfb.h"

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

!*         1.       SET DEFAULT VALUES.
!                   -------------------

!*         1.1      PRESET INDICES IN *YOMRAD15*
!                   --------------------------

IF (lhook) CALL dr_hook('SUECRAD15',0,zhook_handle)
llmess=.false.
lerad6h15=.true.
leradhs15=.true.
lradaer15=.true.
lnewaer15=.false.
naer15   =1
naer=0
nflux15  =6
nmode15  =0
nrad15   =1
nradfr15 =-3
nradpfr15=36
nradpla15=15
nrint15  =4
nradf2c15=1
nradc2f15=1
nuaer15  = 24
ntraer15 = 15
novlp15 = 1
nsw=2
ntsw=2
IF(nsmax >= 106) THEN
  nrproma15 = 80
ELSEIF(nsmax == 63) THEN
  nrproma15=48
ELSE
  nrproma15=20
ENDIF

!*         1.3      SET SECURITY PARAMETERS
!                   -----------------------

repsc15  = 1.e-12_jprb
repsco15 = 1.e-12_jprb
repscq15 = 1.e-12_jprb
repsct15 = 1.e-12_jprb
repscw15 = 1.e-12_jprb
reelog15 = 1.e-12_jprb

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

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

! Ce qui concerne NAMRAD15 commente par MPL le 15.04.09
!CALL POSNAM(NULNAM,'NAMRAD15')
!READ (NULNAM,NAMRAD15)

!     INITIALISE DATA STRUCTURES REQUIRED FOR RADIATION INTERPOLATION

lodbgradi=.false.
CALL suecradi15

IF( llmess )THEN

!     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')
ENDIF

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

!*       3.    INITIALIZE RADIATION COEFFICIENTS.
!              ----------------------------------

rcday15  = rday * rg / rcpd
diff15   = 1.66_jprb
r10e15   = 0.4342945_jprb

CALL surdi15

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

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

CALL sulw15
CALL susw15

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

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

!     INITIALIZATION DONE IN BLOCK DATA SUAERHBD

!- optical properties
CALL suaer15

!     CALL SUAERH

CALL suaerv15 ( klev  , petah,&
 & cvdaes15, cvdael15, cvdaeu15, cvdaed15, cvdaef15,&
 & rctrbga15, rcvobga15, rcstbga15, rcaeops15, rcaeopl15, rcaeopu15,&
 & rcaeopf15,&
 & rcaeopd15, rctrpt15 , rcaeadk15, rcaeadm15, rcaeros15        )  

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

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

IF (lephys) THEN
  IF (nmode15 > 1) THEN
    CALL susat
  ENDIF
ENDIF

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

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

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

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

ztstep=max(tstep,1.0_jprb)
zstphr=3600._jprb/ztstep
iradfr=nradfr15
IF(nradfr15 < 0) THEN
  nradfr15=-nradfr15*zstphr+0.5_jprb
ENDIF
nradpfr15=nradpfr15*nradfr15
IF (mod(nradpla15,2) == 0.AND. nradpla15 /= 0) THEN
  nradpla15=nradpla15+1
ENDIF

ist1hr=zstphr+0.05_jprb
ist6hr=6._jprb*zstphr+0.05_jprb
IF (mod(3600._jprb,ztstep) > 0.1_jprb) THEN
  ist1hr=ist1hr+1
  DO WHILE (mod(ist6hr,ist1hr) /= 0)
    ist1hr=ist1hr+1
  ENDDO
ENDIF
nradsfr15=ist1hr
nradnfr15=nradfr15

IF(lrayfm15) THEN
  nrproma15=ndlon+6+(1-mod(ndlon,2))
ENDIF



!*       9.    ALLOCATE WORK ARRAYS
!               --------------------

llp = nprintlev >= 1

  ALLOCATE(emtd(nproma,nflevg+1,ngpblks))
  IF(llp)WRITE(unit=kulout,fmt=9) 'EMTD     ',SIZE(emtd     ),shape(emtd     )
  ALLOCATE(trsw(nproma,nflevg+1,ngpblks))
  IF(llp)WRITE(unit=kulout,fmt=9) 'TRSW     ',SIZE(trsw     ),shape(trsw     )
  ALLOCATE(emtu(nproma,nflevg+1,ngpblks))
  IF(llp)WRITE(unit=kulout,fmt=9) 'EMTU     ',SIZE(emtu     ),shape(emtu     )
  ALLOCATE(rmoon(nproma,ngpblks))
  IF(llp)WRITE(unit=kulout,fmt=9) 'RMOON    ',SIZE(rmoon    ),shape(rmoon    )

9 FORMAT(1x,'ARRAY ',a10,' ALLOCATED ',8i8)

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

!*       9.    PRINT FINAL VALUES.
!              -------------------




IF (llp) THEN
  WRITE(unit=kulout,fmt='('' COMMON YOMRAD15 '')')
  WRITE(unit=kulout,fmt='('' LERADI  = '',L5 &
   & ,'' LERAD6H15 = '',L5)')&
   & leradi,lerad6h15  
  WRITE(unit=kulout,fmt='('' NRADFR15  = '',I2 &
   & ,'' NRADPFR15 = '',I3 &
   & ,'' NRADPLA15 = '',I2 &
   & ,'' NRINT15   = '',I1 &
   & ,'' NRPROMA15 = '',I5 &
   & ,'' NRADF2C15 = '',I1 &
   & ,'' NRADC2F15 = '',I1 &
   & )')&
   & nradfr15,nradpfr15,nradpla15,nrint15,&
   & nrproma15,nradf2c15,nradc2f15  
   
  WRITE(unit=kulout,fmt='('' LERADHS15= '',L5,'' LRADAER15= '',L5 &
   & ,'' LNEWAER15= '',L5 &
   & ,'' NMODE15 = '',I1 &
   & ,'' NAER15  = '',I1 &
   & ,'' NFLUX15 = '',I2 &
   & ,'' NRAD15  = '',I2 &
   & )')&
   & leradhs15,lradaer15,lnewaer15,nmode15,naer15,nflux15,nrad15  
  WRITE(kulout,fmt='('' WARNING! CLOUD OVERLAP ASSUMPTION IS''&
   & ,'' NOVLP15   = '',I2 &
   & )')&
   & novlp15  

  WRITE(unit=kulout,fmt='('' MODULE YOERAD '')')
  WRITE(unit=kulout,fmt='('' NSW = '',I2, '' NTSW = '',I2)') nsw,ntsw
ENDIF

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

IF (lhook) CALL dr_hook('SUECRAD15',1,zhook_handle)
END SUBROUTINE suecrad15