source: LMDZ5/branches/IPSLCM5A2.1_ISO/libf/phymar/rrtm_gasabs1a_140gp.F90 @ 4622

SUBROUTINE RRTM_GASABS1A_140GP (KLEV,ATR1,OD,TF1,COLDRY,WX,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCO2,COLO3,COLN2O,COLCH4,COLO2,CO2MULT,&
  &LAYTROP,LAYSWTCH,LAYLOW,SELFFAC,SELFFRAC,INDSELF,PFRAC)

!     Reformatted for F90 by JJMorcrette, ECMWF, 980714

#include "tsmbkind.h"

USE PARRRTM  , ONLY : JPLAY    ,JPBAND   ,JPGPT   ,JPXSEC
USE YOERRTAB , ONLY : TRANS    ,BPADE

IMPLICIT NONE

REAL_B :: ATR1  (JPGPT,JPLAY)
REAL_B :: OD    (JPGPT,JPLAY)
REAL_B :: TF1   (JPGPT,JPLAY)
REAL_B :: COLDRY(JPLAY)
REAL_B :: WX(JPXSEC,JPLAY)           ! Amount of trace gases

!     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)
REAL_B :: FORFAC(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 :: COLO3 (JPLAY)
REAL_B :: COLN2O(JPLAY)
REAL_B :: COLCH4(JPLAY)
REAL_B :: COLO2 (JPLAY)
REAL_B :: CO2MULT(JPLAY)
INTEGER_M :: LAYTROP
INTEGER_M :: LAYSWTCH
INTEGER_M :: LAYLOW

!- from SELF             
REAL_B :: SELFFAC(JPLAY)
REAL_B :: SELFFRAC(JPLAY)
INTEGER_M :: INDSELF(JPLAY)

!- from SP             
REAL_B :: PFRAC(JPGPT,JPLAY)


REAL_B :: TAU   (JPGPT,JPLAY)

!     LOCAL INTEGER SCALARS
INTEGER_M :: IPR, ITR, LAY

!     LOCAL REAL SCALARS
REAL_B :: ODEPTH, SECANG, TF


!- SECANG is equal to the secant of the diffusivity angle.
SECANG = 1.66_JPRB

CALL RRTM_TAUMOL1  (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,&
  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL2  (KLEV,TAU,COLDRY,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,&
  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL3  (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCO2,COLN2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL4  (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCO2,COLO3,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL5  (KLEV,TAU,WX,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,FORFAC,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCO2,COLO3,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL6  (KLEV,TAU,WX,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
  &COLH2O,CO2MULT,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL7  (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLO3,CO2MULT,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL8  (KLEV,TAU,WX,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
  &COLH2O,COLO3,COLN2O,CO2MULT,LAYSWTCH,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL9  (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLN2O,COLCH4,LAYTROP,LAYSWTCH,LAYLOW,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL10 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
  &COLH2O,LAYTROP,PFRAC)
CALL RRTM_TAUMOL11 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
  &COLH2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL12 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCO2,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL13 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLN2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL14 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,&
  &COLCO2,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL15 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCO2,COLN2O,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)
CALL RRTM_TAUMOL16 (KLEV,TAU,&
  &TAUAERL,FAC00,FAC01,FAC10,FAC11,JP,JT,JT1,ONEMINUS,&
  &COLH2O,COLCH4,LAYTROP,SELFFAC,SELFFRAC,INDSELF,PFRAC)

!- Loop over g-channels.
DO LAY = 1, KLEV
  DO IPR = 1, JPGPT
    ODEPTH = SECANG * TAU(IPR,LAY)
    OD(IPR,LAY) = ODEPTH
!-- revised code to get the pre-computed transmission            
    TF = ODEPTH/(BPADE+ODEPTH)
!          IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH
    IF (ODEPTH <= _ZERO_) TF = _ZERO_
    ITR=INT(5.E+03_JPRB*TF+_HALF_)
    ATR1(IPR,LAY) = _ONE_ - TRANS(ITR)
    TF1(IPR,LAY) = TF
  ENDDO
ENDDO

!     -----------------------------------------------------------------

RETURN
END SUBROUTINE RRTM_GASABS1A_140GP