rrtm_taumol16.F90

Go to the documentation of this file.

!----------------------------------------------------------------------------
SUBROUTINE rrtm_taumol16 (KLEV,TAU,&
  &tauaerl,fac00,fac01,fac10,fac11,jp,jt,jt1,oneminus,&
  &colh2o,colch4,laytrop,selffac,selffrac,indself,pfrac)

!     BAND 16:  2600-3000 cm-1 (low - H2O,CH4; high - nothing)

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


#include "tsmbkind.h"

USE parrrtm  , ONLY : jplay  ,jpband ,jpgpt   ,jpxsec ,ngs15
USE yoerrtwn , ONLY : ng     ,nspa   ,nspb
USE yoerrta16, ONLY : ng16   ,absa   ,fracrefa,ka     ,selfref,strrat


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 PRECISE             
real_b :: oneminus

!- from PROFDATA             
real_b :: colh2o(jplay)
real_b :: colch4(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, js, lay

!     LOCAL REAL SCALARS
real_b :: fac000, fac001, fac010, fac011, fac100, fac101,&
          &fac110, fac111, fs, speccomb, specmult, specparm


!  Input
!#include "yoeratm.h"

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

!     Compute the optical depth by interpolating in ln(pressure), 
!     temperature, and appropriate species.  Below LAYTROP, the water
!     vapor self-continuum is interpolated (in temperature) separately. 
 
DO lay = 1, laytrop
  speccomb = colh2o(lay) + strrat*colch4(lay)
  specparm = colh2o(lay)/speccomb
  specparm = min(specparm,oneminus)
  specmult = 8._jprb*(specparm)
  js = 1 + int(specmult)
  fs = mod(specmult,_one_)
!----jjm         
  fac000 = (_one_ - fs) * fac00(lay)
  fac010 = (_one_ - fs) * fac10(lay)
  fac100 = fs * fac00(lay)
  fac110 = fs * fac10(lay)
  fac001 = (_one_ - fs) * fac01(lay)
  fac011 = (_one_ - fs) * fac11(lay)
  fac101 = fs * fac01(lay)
  fac111 = fs * fac11(lay)
!-----         
  ind0 = ((jp(lay)-1)*5+(jt(lay)-1))*nspa(16) + js
  ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(16) + js
  inds = indself(lay)
!         DO IG = 1, NG16
!-- DS_990714
  ig=1
  tau(ngs15+ig,lay) = speccomb *&
!     &((1. - FS)*(FAC00(LAY) * ABSA(IND0   ,IG) +
!     &            FAC10(LAY) * ABSA(IND0+ 9,IG) +
!     &            FAC01(LAY) * ABSA(IND1   ,IG) + 
!     &            FAC11(LAY) * ABSA(IND1+ 9,IG))+
!     &    FS * (  FAC01(LAY) * ABSA(IND1+ 1,IG) +
!     &            FAC10(LAY) * ABSA(IND0+10,IG) +
!     &            FAC00(LAY) * ABSA(IND0+ 1,IG) +
!     &            FAC11(LAY) * ABSA(IND1+10,IG))) +
   &(fac000 * absa(ind0   ,ig) +&
   & fac100 * absa(ind0+ 1,ig) +&
   & fac010 * absa(ind0+ 9,ig) +&
   & fac110 * absa(ind0+10,ig) +&
   & fac001 * absa(ind1   ,ig) +&
   & fac101 * absa(ind1+ 1,ig) +&
   & fac011 * absa(ind1+ 9,ig) +&
   & fac111 * absa(ind1+10,ig))+&
   &colh2o(lay) * &
   &selffac(lay) * (selfref(inds,ig) + &
   &selffrac(lay) *&
   &(selfref(inds+1,ig) - selfref(inds,ig)))&
   &+ tauaerl(lay,16)
  pfrac(ngs15+ig,lay) = fracrefa(ig,js) + fs *&
   &(fracrefa(ig,js+1) - fracrefa(ig,js))
  ig=2
  tau(ngs15+ig,lay) = speccomb *&
!     &((1. - FS)*(FAC00(LAY) * ABSA(IND0   ,IG) +
!     &            FAC10(LAY) * ABSA(IND0+ 9,IG) +
!     &            FAC01(LAY) * ABSA(IND1   ,IG) +
!     &            FAC11(LAY) * ABSA(IND1+ 9,IG))+
!     &    FS * (  FAC01(LAY) * ABSA(IND1+ 1,IG) +
!     &            FAC10(LAY) * ABSA(IND0+10,IG) +
!     &            FAC00(LAY) * ABSA(IND0+ 1,IG) +
!     &            FAC11(LAY) * ABSA(IND1+10,IG))) +
   &(fac000 * absa(ind0   ,ig) +&
   & fac100 * absa(ind0+ 1,ig) +&
   & fac010 * absa(ind0+ 9,ig) +&
   & fac110 * absa(ind0+10,ig) +&
   & fac001 * absa(ind1   ,ig) +&
   & fac101 * absa(ind1+ 1,ig) +&
   & fac011 * absa(ind1+ 9,ig) +&
   & fac111 * absa(ind1+10,ig))+&
   &colh2o(lay) *&
   &selffac(lay) * (selfref(inds,ig) +&
   &selffrac(lay) *&
   &(selfref(inds+1,ig) - selfref(inds,ig)))&
   &+ tauaerl(lay,16)
  pfrac(ngs15+ig,lay) = fracrefa(ig,js) + fs *&
   &(fracrefa(ig,js+1) - fracrefa(ig,js))

!         END DO
!-- DS_990714
ENDDO

DO lay = laytrop+1, klev
!         DO IG = 1, NG16
!-- DS_990714
  ig=1
  tau(ngs15+ig,lay) = tauaerl(lay,16)
  pfrac(ngs15+ig,lay) = _zero_
  ig=2
  tau(ngs15+ig,lay) = tauaerl(lay,16)
  pfrac(ngs15+ig,lay) = _zero_
!-- DS_990714
!         END DO
ENDDO

RETURN
END SUBROUTINE rrtm_taumol16