! Library:phys $Id: suhlrad.F90 5513 2007-11-08 13:48:59Z xiaohua $

!options xopt(noeval)
subroutine suhlrad

!     Purpose:
!     --------
!     Initialize YHLRAD which contains a group of
!     constants applied in the radiation scheme of
!     Hannu Savijaervi. 
!     SUHLRAD replaces HIRLAM's INIRAD

!     Interface:
!     ----------
!     call suhlrad

!     Implicit arguments :
!     --------------------
!     YHLRAD

!     Author:
!     --------
!     Nov-1992 Bent H.Sass    The Danish Meteorological Institute

!     Modifications:
!     --------------
!     Feb-1994 Modified by Laura Rontu and Bent H.Sass
!     Aug-1998 Modified by Carl Fortelius and Laura Rontu
!     Dec-1998 Modified by Laura Rontu and Klaus Wyser
!     Oct-2000 Modified by Laura Rontu and Petri Raisanen
!     Jun-2002 Modified by Colin Jones and Laura Rontu

!     02-Jun-2005 S.Niemela     Original version for ARPEGE/IFS/ALADIN.      
!                            a) minc,secc not used --> removed
!                               csur2  not used --> removed.
!                               cetyp  not used --> removed.
!                               chybcr not used --> removed.
!                               remx   not used --> removed. 
!                               emc(nlev) not used --> removed.

!     28-Sep-2005 S.Niemela    Initialization of cadd, fabso3 and csusa 
!                              are moved to HLRADIA. 

!     03-Oct-2005 S.Niemela a) Initialization of "sa", "cosd" and 
!                              "sind" removed. In HIRLAM, use HLSOLAR.
!                              In Aladin, take from YOMRIP,YOMPHYS3. 
!                              monthc, dayc and ceqt removed.
!                           b) Some parameters not used by HLRADIA.
!                              List of removed:
!                              c10e,cem1,cem2,cem3,cem4,ctrmin
!     End modifications
!     ------------------------------------------------------

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

USE YHLCONST  ,ONLY : GRAVIT
USE YHLRAD    ,ONLY : NTABM, CQPMIN, CPAT, CKILGR,     &
 &             CSUR1, CSUR3, COSMIN, CDEGR, CPATSH,    &
 &             CAADRY, CAAHUM, CBBDRY, CBBHUM, CSAC,   &
 &             CFRAC1, CFRAC2, CAAK, CASK, CPF, CPC,   &
 &             CPSREF, CDPSUR, CREFRAD, SHTAB, CQCO2,  &
 &             CEML1, CEML2, CEML3, CEML4, CPATE,      &
 &             CEME1A, CEME2A, CEME1B, CEME2B, CEME3B, &
 &             CEME4B, CEME5B, CPATC, CEMC1A, CEMC2A,  &
 &             CEMC3A, CEMC1B, CEMC2B, CEMC3B, CEMC4B, &
 &             CA1, CA2, CA3, CA4, CA5, CB1, CB2, CB3, &
 &             CB4, CB5, CEMADD, CMMY, REMN, CRELAND,  &
 &             CRESEA, B10A, B10B, B11, B12, B13A,     &
 &             B13B, B14, A1, A2, A3

IMPLICIT NONE

REAL(KIND=JPRB) :: ZHOOK_HANDLE


!     Declaration of working variables


REAL(KIND=JPRB) :: zgravi,zpref,zincr,zx,zco2

INTEGER(KIND=JPIM), PARAMETER :: jptabm = 5000
INTEGER(KIND=JPIM) :: j


      if (lhook) call dr_hook('suhlrad',0,zhook_handle)

!     Constants used in longwave radiation.
!     =====================================

!     -------------------------------------------------------
!     Minimum water path length "cqpmin"
!     -------------------------------------------------------
      cqpmin=2.E-5_JPRB

!     -------------------------------------------------------
!     Scaling factor "cpat" involved in calculating water
!     path in cm of precipitable water.
!     -------------------------------------------------------
      zgravi=gravit
      zpref=101325._JPRB
      cpat=1._JPRB/( zgravi*zpref*10._JPRB )

!     -------------------------------------------------------
!     emissivity constants
!     -------------------------------------------------------
      cfrac1=1.0_JPRB
      cfrac2=2.0E4_JPRB

!     -------------------------------------------------------
!     Emission constants "csur1,csur2,csur3" for surface flux
!     calculations. Values of 'csur1' and 'csur2' have been
!     tuned by B.H.Sass 30/3 1993 to produce improved downward
!     radiative flux in the atmosphere.
!     "csur2" not use anymore.
!     -------------------------------------------------------

      csur1 = 15._JPRB

      csur3=1.00_JPRB

!     -------------------------------------------------------
!     conversion factor "ckilgr" from kilo to gram.
!     -------------------------------------------------------
      ckilgr=1000._JPRB

!     =======================================================
!     Constants and arrays used in shortwave radiation.
!     =======================================================

      csac=1.E-9_JPRB

      cosmin=0.00001_JPRB
      cpatsh=0.05_JPRB

      cdegr=0.0174533_JPRB

      caadry=0.05_JPRB
      caahum=0.03_JPRB
      cbbdry=0.63_JPRB
      cbbhum=0.81_JPRB


!     ---------------------------------------------------------
!     Table "shtab(j)" applied in humid clear air absorbtion
!     ---------------------------------------------------------

      ntabm=jptabm
      zincr=0.01_JPRB

      IF (.NOT. ALLOCATED(shtab)) ALLOCATE(shtab(ntabm))

      DO j=1,ntabm
        shtab(j)=( REAL(j)*0.5_JPRB*zincr )**(-cbbhum)
      ENDDO

      caak=1.20_JPRB
      cask=1.25_JPRB
      cpf=2500._JPRB

!     correct coefficient associated with cooling
!     rate below clouds, to get better agreement
!     with reference comparisons for thick cirrus clouds.

      cpc=7.0E4_JPRB
      cpsref=100000._JPRB
      cdpsur=2500._JPRB
      crefrad=1.66_JPRB

!     ---------------------------------------------------------
!     Constants and coefficients for the modified
!     computation of longwave clear-sky emissivities

!     -------------------------------------------
!     Carbon dioxide volume and mass mixing ratio
!     -------------------------------------------
!      zco2 = 882.5e-6_JPRB   ! CO2 Hadley fakt=2.5
!      zco2 = 706.e-6_JPRB ! CO2 ECHAM, ERA  fakt=2.0
      zco2 = 353.e-6_JPRB ! cntr Hadley, ECHAM, ERA

      cqco2 = zco2 *44._JPRB/28.9644_JPRB

!     ----------------------------------------------------------
!     Water vapor line (&p-type continuum) emissivity parameters
!     ----------------------------------------------------------
      ceml1 = 6.54860_JPRB
      ceml2 = -11.9669_JPRB
      ceml3 = 7.82396_JPRB
      ceml4 = -1.79180_JPRB

!     ----------------------------------------------------------
!     Water vapor e-type continuum emissivity parameters
!     ----------------------------------------------------------

      cpate  = 10._JPRB**(-2.5_JPRB)
      ceme1a = 31.811_JPRB
      ceme2a = -1463.1_JPRB
      ceme1b = -8.2253e-2_JPRB
      ceme2b = 3.1258_JPRB
      ceme3b = -2.1966_JPRB
      ceme4b = -3.6719_JPRB
      ceme5b = 4.0475_JPRB

!     ----------------------------------------------------------
!     Carbon dioxide emissivity parameters
!     ----------------------------------------------------------

      cpatc  = 0.001_JPRB
      cemc1a = 4.5297_JPRB
      cemc2a = -109.83_JPRB
      cemc3a = 1264.4_JPRB
      cemc1b = 0.21332_JPRB
      cemc2b = 2.8000e-2_JPRB
      cemc3b = 2.2341e-3_JPRB
      cemc4b = 1.6113e-4_JPRB

!     -----------------------------------------------------------
!     Coefficients for water vapour line and continuum absorption
!     overlap factor
!     -----------------------------------------------------------

      ca1 = 1.8062_JPRB
      ca2 = -8.0828_JPRB
      ca3 = 10.029_JPRB
      ca4 = -4.948_JPRB
      ca5 = 0.88512_JPRB

!     ---------------------------------------------------------------
!     Coefficients for water vapour and carbon dioxide overlap factor
!     ---------------------------------------------------------------
      zx = 2.1449_JPRB*((zco2/500.e-6_JPRB)**(1._JPRB/3._JPRB)-1._JPRB)
      cb1 = 0.11293_JPRB
      cb2 = 4.4780_JPRB +1.4774e-2_JPRB*zx
      cb3 = -9.777_JPRB -8.5438e-2_JPRB*zx
      cb4 = 6.313_JPRB +0.19318_JPRB*zx
      cb5 = -1.317_JPRB -8.1497e-2_JPRB*zx

!     ---------------------------------------------------------------
!     Typical contribution of other factors than H2O line absorption
!     to single-layer clear-sky emissivity:
!     ---------------------------------------------------------------
      cemadd = 0.12_JPRB

!     ---------------------------------------------------------
!     Definitions needed for effective radius parameterization
!     ---------------------------------------------------------
      cmmy=1.0E+06_JPRB
      remn=4._JPRB
      creland=9.528e-5_JPRB
      cresea= 1.434e-4_JPRB
      b10a = 1.55e-4_JPRB
      b10b = 8.18e-3_JPRB
      b11 = 1.29_JPRB
      b12 = 0.545_JPRB
      b13a = 7.00_JPRB
      b13b = -4.75_JPRB
      b14 = 8.30e-2_JPRB
      a1=0.522_JPRB
      a2=-4.551_JPRB
      a3=4.115_JPRB

      if (lhook) call dr_hook('suhlrad',1,zhook_handle)
end subroutine suhlrad
