rrtm_taumol11.F90

Go to the documentation of this file.

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

!     BAND 11:  1480-1800 cm-1 (low - H2O; high - H2O)

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


#include "tsmbkind.h"

USE parrrtm  , ONLY : jplay  ,jpband ,jpgpt  ,jpxsec  , ngs10
USE yoerrtwn , ONLY : ng     ,nspa   ,nspb
USE yoerrta11, ONLY : ng11   ,absa   ,absb   ,fracrefa, fracrefb,&
            &ka      , kb     ,selfref

!  Input
!#include "yoeratm.h"

!      REAL TAUAER(JPLAY)

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 :: colh2o(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,11),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(lay) = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(11) + 1
  ind1(lay) = (jp(lay)*5+(jt1(lay)-1))*nspa(11) + 1
  inds(lay) = indself(lay)
ENDDO

!-- DS_000515  
DO ig = 1, ng11
  DO lay = 1, laytrop
!-- DS_000515  
    tau(ngs10+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))))&
     &+ tauaerl(lay,11)
    pfrac(ngs10+ig,lay) = fracrefa(ig)
  ENDDO
ENDDO

DO lay = laytrop+1, klev
  ind0(lay) = ((jp(lay)-13)*5+(jt(lay)-1))*nspb(11) + 1
  ind1(lay) = ((jp(lay)-12)*5+(jt1(lay)-1))*nspb(11) + 1
ENDDO

!-- JJM_000517
DO ig = 1, ng11
  DO lay = laytrop+1, klev
!-- JJM_000517
    tau(ngs10+ig,lay) = colh2o(lay) *&
     &(fac00(lay) * absb(ind0(lay)  ,ig) +&
     & fac10(lay) * absb(ind0(lay)+1,ig) +&
     & fac01(lay) * absb(ind1(lay)  ,ig) +&
     & fac11(lay) * absb(ind1(lay)+1,ig)) &
     &+ tauaerl(lay,11)
    pfrac(ngs10+ig,lay) = fracrefb(ig)
  ENDDO
ENDDO

RETURN
END SUBROUTINE rrtm_taumol11