rrtm_taumol15.F90

Go to the documentation of this file.

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

!     BAND 15:  2380-2600 cm-1 (low - N2O,CO2; high - nothing)

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


#include "tsmbkind.h"

USE parrrtm  , ONLY : jplay  ,jpband ,jpgpt   ,jpxsec ,ngs14
USE yoerrtwn , ONLY : ng     ,nspa   ,nspb
USE yoerrta15, ONLY : ng15   ,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 :: colco2(jplay)
real_b :: coln2o(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,15),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 = coln2o(lay) + strrat*colco2(lay)
  specparm = coln2o(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(15) + js
  ind1 = (jp(lay)*5+(jt1(lay)-1))*nspa(15) + js
  inds = indself(lay)
!-- DS_990714  
!         DO IG = 1, NG15
  ig=1
  tau(ngs14+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,15)
  pfrac(ngs14+ig,lay) = fracrefa(ig,js) + fs *&
   &(fracrefa(ig,js+1) - fracrefa(ig,js))
  ig=2
  tau(ngs14+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,15)
  pfrac(ngs14+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, NG15
!-- DS_990714  
  ig=1
  tau(ngs14+ig,lay) = tauaerl(lay,15)
  pfrac(ngs14+ig,lay) = _zero_
  ig=2
  tau(ngs14+ig,lay) = tauaerl(lay,15)
  pfrac(ngs14+ig,lay) = _zero_
!-- DS_990714  
!         END DO
ENDDO

RETURN
END SUBROUTINE rrtm_taumol15