susw15.F90

Go to the documentation of this file.

!OPTIONS XOPT(NOEVAL)
SUBROUTINE susw15

!**** *SUSW15*   - INITIALIZE COMMON YOMSW15
!****              FROZEN VERSION (CYCLE 15) OF SUSW

!     PURPOSE.
!     --------
!           INITIALIZE YOMSW15, THE COMMON THAT CONTAINS COEFFICIENTS
!           NEEDED TO RUN THE SHORTWAVE RADIATION SUBROUTINES

!**   INTERFACE.
!     ----------
!        *CALL* *SUSW15

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

!        IMPLICIT ARGUMENTS :
!        --------------------
!        COMMON YOMSW15

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

!     EXTERNALS.
!     ----------

!     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.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE yomcst   , ONLY : rg
USE yomsw15  , ONLY : apad15   ,bpad15   ,rray15   ,rsun15   ,&
 & rpdh115  ,rpdu115  ,rpnh15   ,rpnu15   ,rswce15  ,&
 & rswcp15  ,rtdh2o15 ,rtdumg15 ,rth2o15  ,rtumg15  ,d15  

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

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

IMPLICIT NONE
REAL(KIND=JPRB)   :: ZPDH2O=0.8_jprb
REAL(KIND=JPRB)   :: ZPDUMG=0.75_jprb
REAL(KIND=JPRB)   :: ZPRH2O=30000._jprb
REAL(KIND=JPRB)   :: ZPRUMG=30000._jprb

!$OMP THREADPRIVATE(zpdh2o,zpdumg,zprh2o,zprumg)

REAL(KIND=JPRB) :: ZH2O, ZUMG
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('SUSW15',0,zhook_handle)
rpdh115=zpdh2o+1.0_jprb
rpdu115=zpdumg+1.0_jprb
zh2o=1.0_jprb/( 10._jprb* rg * rpdh115 )
zumg=1.0_jprb/( 10._jprb* rg * rpdu115 )
rpnu15 = zumg/(zprumg**zpdumg)
rpnh15 = zh2o/(zprh2o**zpdh2o)

rswcp15=0.002_jprb*rswce15

rtdh2o15 = 0.40_jprb
rtdumg15 = 0.375_jprb
rth2o15 = 240._jprb
rtumg15 = 240._jprb
rswce15 = 0._jprb
rswcp15 = 0._jprb

rsun15(1) = 0.441676_jprb
d15(1,:) = (/ 0.00_jprb, 0.00_jprb, 0.00_jprb /)
!* DERIVED FROM HITRAN APRIL 1991
!       H2O:  Pref=300 hPa, Tref=240K, Pdep=0.8
!       O3 :  unchanged

apad15(1,1:3,1:7) = reshape((/&
 & 0.912418292e+05_jprb, 0.000000000e-00_jprb, 0.925887084e-04_jprb,&
 & 0.723613782e+05_jprb, 0.000000000e-00_jprb, 0.129353723e-01_jprb,&
 & 0.596037057e+04_jprb, 0.000000000e-00_jprb, 0.800821928e+00_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.242715973e+02_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.878331486e+02_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.191559725e+02_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.000000000e+00_jprb /)&
 & ,(/3,7/))  

bpad15(1,1:3,1:7) = reshape((/&
 & 0.912418292e+05_jprb, 0.000000000e-00_jprb, 0.925887084e-04_jprb,&
 & 0.724555318e+05_jprb, 0.000000000e-00_jprb, 0.131812683e-01_jprb,&
 & 0.602593328e+04_jprb, 0.000000000e-00_jprb, 0.812706117e+00_jprb,&
 & 0.100000000e+01_jprb, 0.000000000e-00_jprb, 0.249863591e+02_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.931071925e+02_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.252233437e+02_jprb,&
 & 0.000000000e-00_jprb, 0.000000000e-00_jprb, 0.100000000e+01_jprb /)&
 & ,(/3,7/))  

rray15(1,1:6) = (/&
 & .428937e-01_jprb, .890743e+00_jprb,-.288555e+01_jprb,&
 & .522744e+01_jprb,-.469173e+01_jprb, .161645e+01_jprb/)  

rsun15(2) = 0.558324_jprb

d15(2,1:3) = (/ 0.000000000_jprb, 0.000000000_jprb, 0.800000000_jprb /)

!* INTERVAL 2:  0.68 - 4.00 MICRONS
!* DERIVED FROM HITRAN APRIL 1991
!       H2O:  Pref=300 hPa, Tref=240K, Pdep=0.80
!       UMG:  Pref=300 hPa, Tref=240K, Pdep=0.75 (CO2+O2+CH4+N2O+CO)
!       O3 :  unchanged

apad15(2,1:3,1:7) = reshape((/&
 & 0.376655383e-08_jprb, 0.739646016e-08_jprb, 0.410177786e+03_jprb,&
 & 0.978576773e-04_jprb, 0.131849595e-03_jprb, 0.672595424e+02_jprb,&
 & 0.387714006e+00_jprb, 0.437772681e+00_jprb, 0.000000000e-00_jprb,&
 & 0.118461660e+03_jprb, 0.151345118e+03_jprb, 0.000000000e-00_jprb,&
 & 0.119079797e+04_jprb, 0.233628890e+04_jprb, 0.000000000e-00_jprb,&
 & 0.293353397e+03_jprb, 0.797219934e+03_jprb, 0.000000000e-00_jprb,&
 & 0.000000000e+00_jprb, 0.000000000e+00_jprb, 0.000000000e+00_jprb /)&
 & ,(/3,7/))  

bpad15(2,1:3,1:7) = reshape((/&
 & 0.376655383e-08_jprb, 0.739646016e-08_jprb, 0.410177786e+03_jprb,&
 & 0.979023421e-04_jprb, 0.131861712e-03_jprb, 0.731185438e+02_jprb,&
 & 0.388611139e+00_jprb, 0.437949001e+00_jprb, 0.100000000e+01_jprb,&
 & 0.120291383e+03_jprb, 0.151692730e+03_jprb, 0.000000000e+00_jprb,&
 & 0.130531005e+04_jprb, 0.237071130e+04_jprb, 0.000000000e+00_jprb,&
 & 0.415049409e+03_jprb, 0.867914360e+03_jprb, 0.000000000e+00_jprb,&
 & 0.100000000e+01_jprb, 0.100000000e+01_jprb, 0.000000000e+00_jprb /)&
 & ,(/3,7/))  

rray15(2,1:6) = (/&
 & .697200e-02_jprb, .173297e-01_jprb,-.850903e-01_jprb,&
 & .248261e+00_jprb,-.302031e+00_jprb, .129662e+00_jprb/)  
IF (lhook) CALL dr_hook('SUSW15',1,zhook_handle)
END SUBROUTINE susw15