rrtm_cmbgb8.F90

Go to the documentation of this file.

!***************************************************************************
SUBROUTINE rrtm_cmbgb8
!***************************************************************************

!     BAND 8:  1080-1180 cm-1 (low (i.e.>~300mb) - H2O; high - O3)
!***************************************************************************

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

USE yoerrto8 , ONLY : kao     ,kbo     ,selfrefo   ,fracrefao  ,&
 & fracrefbo, absco2ao,absco2bo,absn2oao   ,absn2obo   ,&
 & cfc12o   , cfc22adjo  
USE yoerrta8 , ONLY : ka      ,kb      ,selfref    ,fracrefa   ,&
 & fracrefb , absco2a ,absco2b ,absn2oa    ,absn2ob    ,&
 & cfc12    , cfc22adj  
USE yoerrtrwt, ONLY : frefa    ,frefb    ,rwgt
USE yoerrtftr, ONLY : ngc      ,ngs      ,ngn      

IMPLICIT NONE

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

REAL(KIND=JPRB) :: Z_SUMF1, Z_SUMF2, Z_SUMK, Z_SUMK1, Z_SUMK2, Z_SUMK3, Z_SUMK4, Z_SUMK5, Z_SUMK6
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('RRTM_CMBGB8',0,zhook_handle)
DO jt = 1,5
  DO jp = 1,7
    iprsm = 0
    DO igc = 1,ngc(8)
      z_sumk = 0.0_jprb
      DO ipr = 1, ngn(ngs(7)+igc)
        iprsm = iprsm + 1
        z_sumk = z_sumk + kao(jt,jp,iprsm)*rwgt(iprsm+112)
      ENDDO
      ka(jt,jp,igc) = z_sumk
    ENDDO
  ENDDO
ENDDO
DO jt = 1,5
  DO jp = 7,59
    iprsm = 0
    DO igc = 1,ngc(8)
      z_sumk = 0.0_jprb
      DO ipr = 1, ngn(ngs(7)+igc)
        iprsm = iprsm + 1
        z_sumk = z_sumk + kbo(jt,jp,iprsm)*rwgt(iprsm+112)
      ENDDO
      kb(jt,jp,igc) = z_sumk
    ENDDO
  ENDDO
ENDDO

DO jt = 1,10
  iprsm = 0
  DO igc = 1,ngc(8)
    z_sumk = 0.0_jprb
    DO ipr = 1, ngn(ngs(7)+igc)
      iprsm = iprsm + 1
      z_sumk = z_sumk + selfrefo(jt,iprsm)*rwgt(iprsm+112)
    ENDDO
    selfref(jt,igc) = z_sumk
  ENDDO
ENDDO

iprsm = 0
DO igc = 1,ngc(8)
  z_sumf1= 0.0_jprb
  z_sumf2= 0.0_jprb
  z_sumk1= 0.0_jprb
  z_sumk2= 0.0_jprb
  z_sumk3= 0.0_jprb
  z_sumk4= 0.0_jprb
  z_sumk5= 0.0_jprb
  z_sumk6= 0.0_jprb
  DO ipr = 1, ngn(ngs(7)+igc)
    iprsm = iprsm + 1
    z_sumf1= z_sumf1+ fracrefao(iprsm)
    z_sumf2= z_sumf2+ fracrefbo(iprsm)
    z_sumk1= z_sumk1+ absco2ao(iprsm)*rwgt(iprsm+112)
    z_sumk2= z_sumk2+ absco2bo(iprsm)*rwgt(iprsm+112)
    z_sumk3= z_sumk3+ absn2oao(iprsm)*rwgt(iprsm+112)
    z_sumk4= z_sumk4+ absn2obo(iprsm)*rwgt(iprsm+112)
    z_sumk5= z_sumk5+ cfc12o(iprsm)*rwgt(iprsm+112)
    z_sumk6= z_sumk6+ cfc22adjo(iprsm)*rwgt(iprsm+112)
  ENDDO
  fracrefa(igc) = z_sumf1
  fracrefb(igc) = z_sumf2
  absco2a(igc) = z_sumk1
  absco2b(igc) = z_sumk2
  absn2oa(igc) = z_sumk3
  absn2ob(igc) = z_sumk4
  cfc12(igc) = z_sumk5
  cfc22adj(igc) = z_sumk6
ENDDO

DO igc = 1,ngc(8)
  frefa(ngs(7)+igc,1) = fracrefa(igc)
  frefb(ngs(7)+igc,1) = fracrefb(igc)
ENDDO

IF (lhook) CALL dr_hook('RRTM_CMBGB8',1,zhook_handle)
END SUBROUTINE rrtm_cmbgb8