source: LMDZ6/branches/IPSLCM6.0.15/libf/phymar/rrtm_taumol15.F90 @ 3607

!----------------------------------------------------------------------------
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