rrtm_taumol14.F90

Go to the documentation of this file.

!******************************************************************************
SUBROUTINE rrtm_taumol14 (KLEV,TAU,&
  &tauaerl,fac00,fac01,fac10,fac11,jp,jt,jt1,&
  &colco2,laytrop,selffac,selffrac,indself,pfrac)

!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)

! Modifications
!
!     D Salmond 1999-07-14 speed-up


#include "tsmbkind.h"

USE parrrtm  , ONLY : jplay  ,jpband ,jpgpt  ,jpxsec  , ngs13
USE yoerrtwn , ONLY : ng     ,nspa   ,nspb
USE yoerrta14, ONLY : ng14   ,absa   ,absb   ,fracrefa, fracrefb,&
              &ka    , kb    ,selfref

IMPLICIT NONE

!  Output
real_b :: tau(jpgpt,jplay)

!     DUMMY INTEGER SCALARS
integer_m :: klev

!- from AER
real_b :: tauaerl(jplay,jpband)

!- from INTFAC      
real_b :: fac00(jplay)
real_b :: fac01(jplay)
real_b :: fac10(jplay)
real_b :: fac11(jplay)

!- from INTIND
integer_m :: jp(jplay)
integer_m :: jt(jplay)
integer_m :: jt1(jplay)

!- from PROFDATA             
real_b :: colco2(jplay)
integer_m :: laytrop

!- from SELF             
real_b :: selffac(jplay)
real_b :: selffrac(jplay)
integer_m :: indself(jplay)

!- from SP             
real_b :: pfrac(jpgpt,jplay)


!     LOCAL INTEGER SCALARS
integer_m :: ig, ind0, ind1, inds, lay


!  Input
!#include "yoeratm.h"

!      REAL TAUAER(JPLAY)
!      EQUIVALENCE (TAUAERL(1,14),TAUAER)

!     Compute the optical depth by interpolating in ln(pressure) and 
!     temperature.  Below LAYTROP, the water vapor self-continuum 
!     is interpolated (in temperature) separately.  

DO lay = 1, laytrop
  ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(14) + 1
  ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(14) + 1
  inds = indself(lay)
!-- DS_990714  
!         DO IG = 1, NG14
  ig=1
  tau(ngs13+ig,lay) = colco2(lay) *&
   &(fac00(lay) * absa(ind0  ,ig) +&
   & fac10(lay) * absa(ind0+1,ig) +&
   & fac01(lay) * absa(ind1  ,ig) +&
   & fac11(lay) * absa(ind1+1,ig) +&
   &selffac(lay) * (selfref(inds,ig) + &
   &selffrac(lay) *&
   &(selfref(inds+1,ig) - selfref(inds,ig))))&
   &+ tauaerl(lay,14)
  pfrac(ngs13+ig,lay) = fracrefa(ig)
  ig=2
  tau(ngs13+ig,lay) = colco2(lay) *&
   &(fac00(lay) * absa(ind0  ,ig) +&
   & fac10(lay) * absa(ind0+1,ig) +&
   & fac01(lay) * absa(ind1  ,ig) +&
   & fac11(lay) * absa(ind1+1,ig) +&
   &selffac(lay) * (selfref(inds,ig) +&
   &selffrac(lay) *&
   &(selfref(inds+1,ig) - selfref(inds,ig))))&
   &+ tauaerl(lay,14)
  pfrac(ngs13+ig,lay) = fracrefa(ig)
!         END DO
!-- DS_990714  
ENDDO

DO lay = laytrop+1, klev
  ind0 = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(14) + 1
  ind1 = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(14) + 1
!-- DS_990714  
!         DO IG = 1, NG14
  ig=1
  tau(ngs13+ig,lay) = colco2(lay) *&
   &(fac00(lay) * absb(ind0  ,ig) +&
   & fac10(lay) * absb(ind0+1,ig) +&
   & fac01(lay) * absb(ind1  ,ig) +&
   & fac11(lay) * absb(ind1+1,ig)) &
   &+ tauaerl(lay,14)
  pfrac(ngs13+ig,lay) = fracrefb(ig)
  ig=2
  tau(ngs13+ig,lay) = colco2(lay) *&
   &(fac00(lay) * absb(ind0  ,ig) +&
   & fac10(lay) * absb(ind0+1,ig) +&
   & fac01(lay) * absb(ind1  ,ig) +&
   & fac11(lay) * absb(ind1+1,ig)) &
   &+ tauaerl(lay,14)
  pfrac(ngs13+ig,lay) = fracrefb(ig)
!         END DO
!-- DS_990714  
ENDDO

RETURN
END SUBROUTINE rrtm_taumol14