rrtm_cmbgb1.F90

Go to the documentation of this file.

!***************************************************************************
SUBROUTINE rrtm_cmbgb1
!***************************************************************************

!  The subroutines CMBGB1->CMBGB16 input the absorption coefficient
!  data for each band, which are defined for 16 g-points and 16 spectral
!  bands. The data are combined with appropriate weighting following the
!  g-point mapping arrays specified in RRTMINIT.  Plank fraction data
!  in arrays FRACREFA and FRACREFB are combined without weighting.  All
!  g-point reduced data are put into new arrays for use in RRTM.

!  BAND 1:  10-250 cm-1 (low - H2O; high - H2O)
!***************************************************************************

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

USE yoerrto1 , ONLY : kao, kbo, selfrefo, forrefo, fracrefao,fracrefbo
USE yoerrta1 , ONLY : ka , kb , selfref , forref , fracrefa ,fracrefb
USE yoerrtrwt, ONLY : frefa    ,frefb    ,rwgt
USE yoerrtftr, ONLY : ngc      ,ngn      

IMPLICIT NONE

INTEGER(KIND=JPIM) :: IGC, IPR, IPRSM, JP, JT

REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('RRTM_CMBGB1',0,zhook_handle)
DO jt = 1,5
  DO jp = 1,13
    iprsm = 0
    DO igc = 1,ngc(1)
      z_sumk = 0.0_jprb
      DO ipr = 1, ngn(igc)
        iprsm = iprsm + 1

        z_sumk = z_sumk + kao(jt,jp,iprsm)*rwgt(iprsm)
      ENDDO

      ka(jt,jp,igc) = z_sumk
    ENDDO
  ENDDO
  DO jp = 13,59
    iprsm = 0
    DO igc = 1,ngc(1)
      z_sumk = 0.0_jprb
      DO ipr = 1, ngn(igc)
        iprsm = iprsm + 1

        z_sumk = z_sumk + kbo(jt,jp,iprsm)*rwgt(iprsm)
      ENDDO

      kb(jt,jp,igc) = z_sumk
    ENDDO
  ENDDO
ENDDO

DO jt = 1,10
  iprsm = 0
  DO igc = 1,ngc(1)
    z_sumk = 0.0_jprb
    DO ipr = 1, ngn(igc)
      iprsm = iprsm + 1

      z_sumk = z_sumk + selfrefo(jt,iprsm)*rwgt(iprsm)
    ENDDO

    selfref(jt,igc) = z_sumk
  ENDDO
ENDDO

iprsm = 0
DO igc = 1,ngc(1)
  z_sumk = 0.0_jprb
  z_sumf1 = 0.0_jprb
  z_sumf2 = 0.0_jprb
  DO ipr = 1, ngn(igc)
    iprsm = iprsm + 1

    z_sumk = z_sumk + forrefo(iprsm)*rwgt(iprsm)
    z_sumf1= z_sumf1+ fracrefao(iprsm)
    z_sumf2= z_sumf2+ fracrefbo(iprsm)
  ENDDO

  forref(igc) = z_sumk
  fracrefa(igc) = z_sumf1
  fracrefb(igc) = z_sumf2
ENDDO

DO igc = 1,ngc(1)

  frefa(igc,1) = fracrefa(igc)
  frefb(igc,1) = fracrefb(igc)
ENDDO

IF (lhook) CALL dr_hook('RRTM_CMBGB1',1,zhook_handle)
END SUBROUTINE rrtm_cmbgb1