suaersn.F90

Go to the documentation of this file.

SUBROUTINE suaersn (KTSW, KSW)

!**** *SUAERS*   - INITIALIZE COMMON YOEAER

!     PURPOSE.
!     --------
!           INITIALIZE YOEAER, THE COMMON THAT CONTAINS THE
!           RADIATIVE CHARACTERISTICS OF THE AEROSOLS

!**   INTERFACE.
!     ----------
!              -----        -----

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

!        IMPLICIT ARGUMENTS :
!        --------------------
!        COMMON YOEAER

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

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

!     REFERENCE.
!     ----------
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "IFS MODEL"

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

!     MODIFICATIONS.
!     --------------
!        ORIGINAL : 88-02-15
!        96-01-27  JJ Morcrette  Various spectral resolutions
!        99-05-25  JJMorcrette   Revised aerosol optical properties
!        00-10-25  JJMorcrette   6 spectral intervals
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE yoesw    , ONLY : rtaua     ,rpiza    ,rcga

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KTSW 
INTEGER(KIND=JPIM),INTENT(IN)    :: KSW 
REAL(KIND=JPRB) :: ZTAUA2(2,6)  ,ZPIZA2(2,6)  ,ZCGA2(2,6)
REAL(KIND=JPRB) :: ZTAUA4(4,6)  ,ZPIZA4(4,6)  ,ZCGA4(4,6)
REAL(KIND=JPRB) :: ZTAUA6(6,6)  ,ZPIZA6(6,6)  ,ZCGA6(6,6)

INTEGER(KIND=JPIM) :: JAER, JNU
REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

!*       1.    SHORTWAVE COEFFICIENTS
!              ----------------------
!=======================================================================
!-- The (old) five aerosol types were respectively:

!  1/ continental average (+desert)       2/ maritime
!  3/ urban                               4/ volcanic active
!  5/ stratospheric background

!-- old values were not spectrally defined:
! ZTAU2  = .730719, .912819, .725059, .745405, .682188
! ZPIZA2 = .872212, .982545, .623143, .944887, .997975
! ZCGA2  = .647596, .739002, .580845, .662657, .624246
!=======================================================================

!-- The six aerosol types are respectively:

!  1/ continental average                 2/ maritime
!  3/ desert                              4/ urban
!  5/ volcanic active                     6/ stratospheric background

! The quantities given are:
! TAU : ratio of average optical thickness in interval to that at 0.55 
!       micron
! PIZA: average single scattering albedo
! CGA : average asymmetry factor

! computed from Hess and Koepke (con, mar, des, urb)
!          from Bonnel et al.   (vol, str)

!        1.1   TWO SPECTRAL INTERVALS (0.25-0.69-4.00microns)

IF (lhook) CALL dr_hook('SUAERSN',0,zhook_handle)
ztaua2(1, :)= (/&
 & 1.69446_jprb , 1.11855_jprb , 1.09212_jprb , 1.72145_jprb , 1.03858_jprb , 1.12044_jprb /)  
ztaua2(2, :)= (/&
 & 0.40174_jprb , 0.89383_jprb , 0.89546_jprb , 0.40741_jprb , 0.51143_jprb , 0.32646_jprb /)  
 
zpiza2(1, :)= (/&
 & .9148907_jprb, .9956173_jprb, .7504584_jprb, .8131335_jprb, .9401905_jprb, .9999999_jprb/)  
zpiza2(2, :)= (/&
 & .8814597_jprb, .9920407_jprb, .9239428_jprb, .7546879_jprb, .9515548_jprb, .9938563_jprb/)  
 
zcga2(1, :)= (/&
 & 0.729019_jprb, 0.803129_jprb, 0.784592_jprb, 0.712208_jprb, .7008249_jprb, .7270548_jprb/)  
zcga2(2, :)= (/&
 & 0.663224_jprb, 0.793746_jprb, 0.696315_jprb, 0.652612_jprb, .6608509_jprb, .6318786_jprb/)  

!        1.2   FOUR SPECTRAL INTERVALS (0.25-0.69-1.19-2.38-4.00microns)

ztaua4(1, :)= (/&
 & 1.69446_jprb , 1.11855_jprb , 1.09212_jprb , 1.72145_jprb , 1.03858_jprb , 1.12044_jprb /)  
ztaua4(2, :)= (/&
 & 0.52838_jprb , 0.93285_jprb , 0.93449_jprb , 0.53078_jprb , 0.67148_jprb , 0.46608_jprb /)  
ztaua4(3, :)= (/&
 & 0.20543_jprb , 0.84642_jprb , 0.84958_jprb , 0.21673_jprb , 0.28270_jprb , 0.10915_jprb /)  
ztaua4(4, :)= (/&
 & 0.10849_jprb , 0.66699_jprb , 0.65255_jprb , 0.11600_jprb , 0.06529_jprb , 0.04468_jprb /)  
 
zpiza4(1, :)= (/&
 & .9148907_jprb, .9956173_jprb, .7504584_jprb, .8131335_jprb, .9401905_jprb, .9999999_jprb/)  
zpiza4(2, :)= (/&
 & .8970131_jprb, .9984940_jprb, .9245594_jprb, .7768385_jprb, .9532763_jprb, .9999999_jprb/)  
zpiza4(3, :)= (/&
 & .8287144_jprb, .9949396_jprb, .9279543_jprb, .6765051_jprb, .9467578_jprb, .9955938_jprb/)  
zpiza4(4, :)= (/&
 & .5230504_jprb, .7868518_jprb, .8531531_jprb, .4048149_jprb, .8748231_jprb, .2355667_jprb/)  
 
zcga4(1, :)= (/&
 & 0.729019_jprb, 0.803129_jprb, 0.784592_jprb, 0.712208_jprb, .7008249_jprb, .7270548_jprb/)  
zcga4(2, :)= (/&
 & 0.668431_jprb, 0.788530_jprb, 0.698682_jprb, 0.657422_jprb, .6735182_jprb, .6519706_jprb/)  
zcga4(3, :)= (/&
 & 0.636342_jprb, 0.802467_jprb, 0.691305_jprb, 0.627497_jprb, .6105750_jprb, .4760794_jprb/)  
zcga4(4, :)= (/&
 & 0.700610_jprb, 0.818871_jprb, 0.702399_jprb, 0.689886_jprb, .4629866_jprb, .1907639_jprb/)  

!        1.3   SIX SPECTRAL INTERVALS (0.185-0.25-0.44-0.69-1.19-2.38-4.00microns)

ztaua6(1, :)= (/&
 & 1.69446_jprb , 1.11855_jprb , 1.09212_jprb , 1.72145_jprb , 1.03858_jprb , 1.12044_jprb /)  
ztaua6(2, :)= (/&
 & 1.69446_jprb , 1.11855_jprb , 1.09212_jprb , 1.72145_jprb , 1.03858_jprb , 1.12044_jprb /)  
ztaua6(3, :)= (/&
 & 1.69446_jprb , 1.11855_jprb , 1.09212_jprb , 1.72145_jprb , 1.03858_jprb , 1.12044_jprb /)  
ztaua6(4, :)= (/&
 & 0.52838_jprb , 0.93285_jprb , 0.93449_jprb , 0.53078_jprb , 0.67148_jprb , 0.46608_jprb /)  
ztaua6(5, :)= (/&
 & 0.20543_jprb , 0.84642_jprb , 0.84958_jprb , 0.21673_jprb , 0.28270_jprb , 0.10915_jprb /)  
ztaua6(6, :)= (/&
 & 0.10849_jprb , 0.66699_jprb , 0.65255_jprb , 0.11600_jprb , 0.06529_jprb , 0.04468_jprb /)  
 
zpiza6(1, :)= (/&
 & .9148907_jprb, .9956173_jprb, .7504584_jprb, .8131335_jprb, .9401905_jprb, .9999999_jprb/)  
zpiza6(2, :)= (/&
 & .9148907_jprb, .9956173_jprb, .7504584_jprb, .8131335_jprb, .9401905_jprb, .9999999_jprb/)  
zpiza6(3, :)= (/&
 & .9148907_jprb, .9956173_jprb, .7504584_jprb, .8131335_jprb, .9401905_jprb, .9999999_jprb/)  
zpiza6(4, :)= (/&
 & .8970131_jprb, .9984940_jprb, .9245594_jprb, .7768385_jprb, .9532763_jprb, .9999999_jprb/)  
zpiza6(5, :)= (/&
 & .8287144_jprb, .9949396_jprb, .9279543_jprb, .6765051_jprb, .9467578_jprb, .9955938_jprb/)  
zpiza6(6, :)= (/&
 & .5230504_jprb, .7868518_jprb, .8531531_jprb, .4048149_jprb, .8748231_jprb, .2355667_jprb/)  
 
zcga6(1, :)= (/&
 & 0.729019_jprb, 0.803129_jprb, 0.784592_jprb, 0.712208_jprb, .7008249_jprb, .7270548_jprb/)  
zcga6(2, :)= (/&
 & 0.729019_jprb, 0.803129_jprb, 0.784592_jprb, 0.712208_jprb, .7008249_jprb, .7270548_jprb/)  
zcga6(3, :)= (/&
 & 0.729019_jprb, 0.803129_jprb, 0.784592_jprb, 0.712208_jprb, .7008249_jprb, .7270548_jprb/)  
zcga6(4, :)= (/&
 & 0.668431_jprb, 0.788530_jprb, 0.698682_jprb, 0.657422_jprb, .6735182_jprb, .6519706_jprb/)  
zcga6(5, :)= (/&
 & 0.636342_jprb, 0.802467_jprb, 0.691305_jprb, 0.627497_jprb, .6105750_jprb, .4760794_jprb/)  
zcga6(6, :)= (/&
 & 0.700610_jprb, 0.818871_jprb, 0.702399_jprb, 0.689886_jprb, .4629866_jprb, .1907639_jprb/)  

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

IF (ksw == 2) THEN
  DO jnu=1,ksw
    DO jaer=1,6
      rtaua(jnu,jaer)=ztaua2(jnu,jaer)
      rpiza(jnu,jaer)=zpiza2(jnu,jaer)
      rcga(jnu,jaer) =zcga2(jnu,jaer)
    ENDDO
  ENDDO
ELSEIF (ksw == 4) THEN
  DO jnu=1,ksw
    DO jaer=1,6
      rtaua(jnu,jaer)=ztaua4(jnu,jaer)
      rpiza(jnu,jaer)=zpiza4(jnu,jaer)
      rcga(jnu,jaer) =zcga4(jnu,jaer)
    ENDDO
  ENDDO
ELSEIF (ksw == 6) THEN
  DO jnu=1,ksw
    DO jaer=1,6
      rtaua(jnu,jaer)=ztaua6(jnu,jaer)
      rpiza(jnu,jaer)=zpiza6(jnu,jaer)
      rcga(jnu,jaer) =zcga6(jnu,jaer)
    ENDDO
  ENDDO
ELSEIF (ksw == 14 .AND. ktsw == 14) THEN
  print *,'SUAERSN: 14-SPECTRAL INTERVALS --> RRTM_SW'
ELSE
  stop 'SUAERSN: WRONG NUMBER OF SPECTRAL INTERVALS'
ENDIF

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

IF (lhook) CALL dr_hook('SUAERSN',1,zhook_handle)
END SUBROUTINE suaersn