rrtm_cmbgb3.F90

Go to the documentation of this file.

!***************************************************************************
SUBROUTINE rrtm_cmbgb3
!***************************************************************************

!     BAND 3:  500-630 cm-1 (low - H2O,CO2; high - H2O,CO2)
!***************************************************************************

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

USE yoerrto3 , ONLY : kao     ,kbo     ,selfrefo   ,fracrefao  ,&
 & fracrefbo  ,forrefo    ,absn2oao   ,absn2obo  
USE yoerrta3 , ONLY : ka      ,kb      ,selfref    ,fracrefa   ,&
 & fracrefb   ,forref    ,absn2oa   ,absn2ob  
USE yoerrtrwt, ONLY : frefa    ,frefb    ,frefadf  ,frefbdf   ,rwgt
USE yoerrtftr, ONLY : ngc      ,ngs      ,ngn      

IMPLICIT NONE

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

REAL(KIND=JPRB) :: Z_SUMF, Z_SUMK, Z_SUMK1, Z_SUMK2, Z_SUMK3
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('RRTM_CMBGB3',0,zhook_handle)
DO jn = 1,10
  DO jt = 1,5
    DO jp = 1,13
      iprsm = 0
      DO igc = 1,ngc(3)
        z_sumk = 0.0_jprb
        DO ipr = 1, ngn(ngs(2)+igc)
          iprsm = iprsm + 1

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

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

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

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

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

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

    selfref(jt,igc) = z_sumk
    fracrefa(igc,jt) = z_sumf
  ENDDO
ENDDO

DO jp = 1,5
  iprsm = 0
  DO igc = 1,ngc(3)
    z_sumf = 0.0_jprb
    DO ipr = 1, ngn(ngs(2)+igc)
      iprsm = iprsm + 1

      z_sumf = z_sumf + fracrefbo(iprsm,jp)
    ENDDO

    fracrefb(igc,jp) = z_sumf
  ENDDO
ENDDO

iprsm = 0
DO igc = 1,ngc(3)
  z_sumk1= 0.0_jprb
  z_sumk2= 0.0_jprb
  z_sumk3= 0.0_jprb
  DO ipr = 1, ngn(ngs(2)+igc)
    iprsm = iprsm + 1

    z_sumk1= z_sumk1+ forrefo(iprsm)*rwgt(iprsm+32)
    z_sumk2= z_sumk2+ absn2oao(iprsm)*rwgt(iprsm+32)
    z_sumk3= z_sumk3+ absn2obo(iprsm)*rwgt(iprsm+32)
  ENDDO

  forref(igc) = z_sumk1
  absn2oa(igc) = z_sumk2
  absn2ob(igc) = z_sumk3
ENDDO

DO jp = 1,10
  DO igc = 1,ngc(3)

    frefa(ngs(2)+igc,jp) = fracrefa(igc,jp)
  ENDDO
ENDDO
DO jp = 1,9
  DO igc = 1,ngc(3)

    frefadf(ngs(2)+igc,jp) = fracrefa(igc,jp+1) -fracrefa(igc,jp)
  ENDDO
ENDDO
DO jp = 1,5
  DO igc = 1,ngc(3)

    frefb(ngs(2)+igc,jp) = fracrefb(igc,jp)
  ENDDO
ENDDO
DO jp = 1,4
  DO igc = 1,ngc(3)

    frefbdf(ngs(2)+igc,jp) = fracrefb(igc,jp+1) -fracrefb(igc,jp)
  ENDDO
ENDDO

IF (lhook) CALL dr_hook('RRTM_CMBGB3',1,zhook_handle)
END SUBROUTINE rrtm_cmbgb3