source: LMDZ6/branches/IPSLCM6.0.13/libf/phylmd/rrtm/srtm_init.F90 @ 3040

SUBROUTINE SRTM_INIT

!-- read in the basic coefficients to configure RRTM_SW
!- creates module YOESRTWN with BG, NSPA, NSPB, WAVENUM1, WAVENUM2,
!  DELWAVE, PREF, PREFLOG, TREF

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

USE PARSRTM  , ONLY : JPG, JPSW
USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM

IMPLICIT NONE

! Local variables
INTEGER(KIND=JPIM) :: IGC, IGCSM, IBND, IG, IND, IPR, IPRSM
REAL(KIND=JPRB)    :: ZWTSUM

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "susrtm.intfb.h"
#include "srtm_kgb16.intfb.h"
#include "srtm_kgb17.intfb.h"
#include "srtm_kgb18.intfb.h"
#include "srtm_kgb19.intfb.h"
#include "srtm_kgb20.intfb.h"
#include "srtm_kgb21.intfb.h"
#include "srtm_kgb22.intfb.h"
#include "srtm_kgb23.intfb.h"
#include "srtm_kgb24.intfb.h"
#include "srtm_kgb25.intfb.h"
#include "srtm_kgb26.intfb.h"
#include "srtm_kgb27.intfb.h"
#include "srtm_kgb28.intfb.h"
#include "srtm_kgb29.intfb.h"
!#include "susrtop.intfb.h"

#include "srtm_cmbgb16.intfb.h"
#include "srtm_cmbgb17.intfb.h"
#include "srtm_cmbgb18.intfb.h"
#include "srtm_cmbgb19.intfb.h"
#include "srtm_cmbgb20.intfb.h"
#include "srtm_cmbgb21.intfb.h"
#include "srtm_cmbgb22.intfb.h"
#include "srtm_cmbgb23.intfb.h"
#include "srtm_cmbgb24.intfb.h"
#include "srtm_cmbgb25.intfb.h"
#include "srtm_cmbgb26.intfb.h"
#include "srtm_cmbgb27.intfb.h"
#include "srtm_cmbgb28.intfb.h"
#include "srtm_cmbgb29.intfb.h"

IF (LHOOK) CALL DR_HOOK('SRTM_INIT',0,ZHOOK_HANDLE)

CALL SUSRTM

!-- read in the molecular absorption coefficients

CALL SRTM_KGB16
CALL SRTM_KGB17
CALL SRTM_KGB18
CALL SRTM_KGB19
CALL SRTM_KGB20
CALL SRTM_KGB21
CALL SRTM_KGB22
CALL SRTM_KGB23
CALL SRTM_KGB24
CALL SRTM_KGB25
CALL SRTM_KGB26
CALL SRTM_KGB27
CALL SRTM_KGB28
CALL SRTM_KGB29

!-- read in the cloud optical properties
!- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1, 
!  EXTICE3, SSAICE3, ASYICE3, FDLICE3  

!-- RRTM_SW cloud optical properties are not used
!   SRTM_CLDPROP is not called
!   no need to call SUSRTOP

!CALL SUSRTOP ( -1 )


!Mike Iacono 20050804
!-- Perform g-point reduction from 16 per band (224 total points) to
!-- a band dependent number (112 total points) for all absorption
!-- coefficient input data and Planck fraction input data.
!-- Compute relative weighting for new g-point combinations.

IGCSM = 0
DO IBND = 1,JPSW
  IPRSM = 0
  IF (NGC(IBND) < JPG) THEN
    DO IGC = 1,NGC(IBND)
      IGCSM = IGCSM + 1
      ZWTSUM = 0.
      DO IPR = 1, NGN(IGCSM)
        IPRSM = IPRSM + 1
        ZWTSUM = ZWTSUM + WT(IPRSM)
      ENDDO
      WTSM(IGC) = ZWTSUM
    ENDDO

    DO IG = 1,NG(IBND+15)
      IND = (IBND-1)*JPG + IG
      RWGT(IND) = WT(IG)/WTSM(NGM(IND))
    ENDDO
  ELSE
    DO IG = 1,NG(IBND+15)
      IGCSM = IGCSM + 1
      IND = (IBND-1)*JPG + IG
      RWGT(IND) = 1.0
    ENDDO
  ENDIF
ENDDO

CALL SRTM_CMBGB16
CALL SRTM_CMBGB17
CALL SRTM_CMBGB18
CALL SRTM_CMBGB19
CALL SRTM_CMBGB20
CALL SRTM_CMBGB21
CALL SRTM_CMBGB22
CALL SRTM_CMBGB23
CALL SRTM_CMBGB24
CALL SRTM_CMBGB25
CALL SRTM_CMBGB26
CALL SRTM_CMBGB27
CALL SRTM_CMBGB28
CALL SRTM_CMBGB29

!-----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE)
END SUBROUTINE SRTM_INIT