rrtm_taumol14.F90

Go to the documentation of this file.

!******************************************************************************
SUBROUTINE rrtm_taumol14 (KLEV,P_TAU,&
 & p_tauaerl,p_fac00,p_fac01,p_fac10,p_fac11,k_jp,k_jt,k_jt1,&
 & p_colco2,k_laytrop,p_selffac,p_selffrac,k_indself,pfrac)  

!     BAND 14:  2250-2380 cm-1 (low - CO2; high - CO2)

! Modifications
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!     D Salmond 1999-07-14 speed-up

USE parkind1  ,ONLY : jpim     ,jprb
USE yomhook   ,ONLY : lhook,   dr_hook

USE parrrtm  , ONLY : jplay  ,jpband ,jpgpt  ,ngs13
USE yoerrtwn , ONLY :      nspa   ,nspb
USE yoerrta14, ONLY : absa   ,absb   ,fracrefa, fracrefb,selfref

IMPLICIT NONE

!  Output
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TAU(jpgpt,jplay) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_TAUAERL(jplay,jpband) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC00(jplay) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC01(jplay) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC10(jplay) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FAC11(jplay) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_JP(jplay) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT(jplay) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_JT1(jplay) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(jplay) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFAC(jplay) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_SELFFRAC(jplay) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_INDSELF(jplay) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFRAC(jpgpt,jplay) 
!- from AER
!- from INTFAC      
!- from INTIND
!- from PROFDATA             
!- from SELF             
!- from SP             
INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, I_LAY
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!  Input
!#include "yoeratm.h"

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

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

IF (lhook) CALL dr_hook('RRTM_TAUMOL14',0,zhook_handle)
DO i_lay = 1, k_laytrop
  ind0 = ((k_jp(i_lay)-1)*5+(k_jt(i_lay)-1))*nspa(14) + 1
  ind1 = (k_jp(i_lay)*5+(k_jt1(i_lay)-1))*nspa(14) + 1
  inds = k_indself(i_lay)
!-- DS_990714  
!         DO IG = 1, NG14
  ig=1
  p_tau(ngs13+ig,i_lay) = p_colco2(i_lay) *&
   & (p_fac00(i_lay) * absa(ind0  ,ig) +&
   & p_fac10(i_lay) * absa(ind0+1,ig) +&
   & p_fac01(i_lay) * absa(ind1  ,ig) +&
   & p_fac11(i_lay) * absa(ind1+1,ig) +&
   & p_selffac(i_lay) * (selfref(inds,ig) + &
   & p_selffrac(i_lay) *&
   & (selfref(inds+1,ig) - selfref(inds,ig))))&
   & + p_tauaerl(i_lay,14)  
  pfrac(ngs13+ig,i_lay) = fracrefa(ig)
  ig=2
  p_tau(ngs13+ig,i_lay) = p_colco2(i_lay) *&
   & (p_fac00(i_lay) * absa(ind0  ,ig) +&
   & p_fac10(i_lay) * absa(ind0+1,ig) +&
   & p_fac01(i_lay) * absa(ind1  ,ig) +&
   & p_fac11(i_lay) * absa(ind1+1,ig) +&
   & p_selffac(i_lay) * (selfref(inds,ig) +&
   & p_selffrac(i_lay) *&
   & (selfref(inds+1,ig) - selfref(inds,ig))))&
   & + p_tauaerl(i_lay,14)  
  pfrac(ngs13+ig,i_lay) = fracrefa(ig)
!         END DO
!-- DS_990714  
ENDDO

DO i_lay = k_laytrop+1, klev
  ind0 = ((k_jp(i_lay)-13)*5+(k_jt(i_lay)-1))*nspb(14) + 1
  ind1 = ((k_jp(i_lay)-12)*5+(k_jt1(i_lay)-1))*nspb(14) + 1
!-- DS_990714  
!         DO IG = 1, NG14
  ig=1
  p_tau(ngs13+ig,i_lay) = p_colco2(i_lay) *&
   & (p_fac00(i_lay) * absb(ind0  ,ig) +&
   & p_fac10(i_lay) * absb(ind0+1,ig) +&
   & p_fac01(i_lay) * absb(ind1  ,ig) +&
   & p_fac11(i_lay) * absb(ind1+1,ig)) &
   & + p_tauaerl(i_lay,14)  
  pfrac(ngs13+ig,i_lay) = fracrefb(ig)
  ig=2
  p_tau(ngs13+ig,i_lay) = p_colco2(i_lay) *&
   & (p_fac00(i_lay) * absb(ind0  ,ig) +&
   & p_fac10(i_lay) * absb(ind0+1,ig) +&
   & p_fac01(i_lay) * absb(ind1  ,ig) +&
   & p_fac11(i_lay) * absb(ind1+1,ig)) &
   & + p_tauaerl(i_lay,14)  
  pfrac(ngs13+ig,i_lay) = fracrefb(ig)
!         END DO
!-- DS_990714  
ENDDO

IF (lhook) CALL dr_hook('RRTM_TAUMOL14',1,zhook_handle)
END SUBROUTINE rrtm_taumol14