rrtm_taumol10.F90

Go to the documentation of this file.

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

!     BAND 10:  1390-1480 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  , ngs9
USE yoerrtwn , ONLY : ng     ,nspa   ,nspb
USE yoerrta10, ONLY : ng10   ,absa   ,absb   ,fracrefa, fracrefb, ka , kb

!  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 SP             
real_b :: pfrac(jpgpt,jplay)

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

!     LOCAL INTEGER SCALARS
integer_m :: ig, lay

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

!     Compute the optical depth by interpolating in ln(pressure) and 
!     temperature.  

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

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

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

!-- JJM_000517
DO ig = 1, ng10
  DO lay = laytrop+1, klev
!-- JJM_000517
    tau(ngs9+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,10)
    pfrac(ngs9+ig,lay) = fracrefb(ig)
  ENDDO
ENDDO

RETURN
END SUBROUTINE rrtm_taumol10