rrtm_taumol6.F90

Go to the documentation of this file.

!----------------------------------------------------------------------------
SUBROUTINE rrtm_taumol6 (KLEV,TAU,WX,&
  &tauaerl,fac00,fac01,fac10,fac11,jp,jt,jt1,&
  &colh2o,co2mult,laytrop,selffac,selffrac,indself,pfrac)

!     BAND 6:  820-980 cm-1 (low - H2O; high - nothing)

! Modifications
!
!     D Salmond   2000-05-15 speed-up
!     JJMorcrette 2000-05-17 speed-up


#include "tsmbkind.h"

USE parrrtm  , ONLY : jplay  ,jpband ,jpgpt  ,jpxsec   , ngs5
USE yoerrtwn , ONLY : ng     ,nspa   ,nspb
USE yoerrta6 , ONLY : ng6    ,absa   ,absco2 ,cfc11adj , cfc12 ,&
            &fracrefa, ka     ,selfref

!  Input
!#include "yoeratm.h"

!      REAL TAUAER(JPLAY)

IMPLICIT NONE

real_b :: wx(jpxsec,jplay)              ! Amount of trace gases
!  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 :: colh2o(jplay)
real_b :: co2mult(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)

integer_m :: ind0(jplay),ind1(jplay),inds(jplay)

!     LOCAL INTEGER SCALARS
integer_m :: ig, lay

!      EQUIVALENCE (TAUAERL(1,6),TAUAER)

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

DO lay = 1, laytrop
  ind0(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(6) + 1
  ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(6) + 1
  inds(lay) = indself(lay)
ENDDO

!-- DS_000515  
DO ig = 1, ng6
  DO lay = 1, laytrop
!-- DS_000515  
    tau(ngs5+ig,lay) = colh2o(lay) *&
     &(fac00(lay) * absa(ind0(lay)  ,ig) +&
     & fac10(lay) * absa(ind0(lay)+1,ig) +&
     & fac01(lay) * absa(ind1(lay)  ,ig) +&
     & fac11(lay) * absa(ind1(lay)+1,ig) +&
     &selffac(lay) * (selfref(inds(lay),ig) + &
     &selffrac(lay)*&
     &(selfref(inds(lay)+1,ig)-selfref(inds(lay),ig))))&
     &+ wx(2,lay) * cfc11adj(ig)&
     &+ wx(3,lay) * cfc12(ig)&
     &+ co2mult(lay) * absco2(ig)&
     &+ tauaerl(lay,6)
    pfrac(ngs5+ig,lay) = fracrefa(ig)
  ENDDO
ENDDO

!     Nothing important goes on above LAYTROP in this band.
!-- JJM_000517
DO ig = 1, ng6
  DO lay = laytrop+1, klev
!-- JJM_000517
    tau(ngs5+ig,lay) = _zero_ &
     &+ wx(2,lay) * cfc11adj(ig)&
     &+ wx(3,lay) * cfc12(ig)&
     &+ tauaerl(lay,6)
    pfrac(ngs5+ig,lay) = fracrefa(ig)
  ENDDO
ENDDO

RETURN
END SUBROUTINE rrtm_taumol6