SUBROUTINE RRTM_GASABS1A_140GP (KLEV,P_ATR1,P_OD,P_TF1,P_COLDRY,P_WX,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCO2,P_COLO3,P_COLN2O,P_COLCH4,P_COLO2,P_CO2MULT,&
 & K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  

!     Reformatted for F90 by JJMorcrette, ECMWF, 980714

USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

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

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_ATR1(JPGPT,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_OD(JPGPT,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: P_TF1(JPGPT,JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLDRY(JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_WX(JPXSEC,JPLAY) ! Amount of trace gases
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) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_FORFAC(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_ONEMINUS 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLH2O(JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCO2(JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLO3(JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLN2O(JPLAY) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_COLCH4(JPLAY) 
REAL(KIND=JPRB)                  :: P_COLO2(JPLAY) ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: P_CO2MULT(JPLAY) 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYTROP 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYSWTCH 
INTEGER(KIND=JPIM),INTENT(IN)    :: K_LAYLOW 
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 PRECISE             
!- from PROFDATA             
!- from SELF             
!- from SP             
REAL(KIND=JPRB) :: Z_TAU   (JPGPT,JPLAY)

INTEGER(KIND=JPIM) :: IPR, ITR, I_LAY

REAL(KIND=JPRB) :: Z_ODEPTH, Z_SECANG, Z_TF
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "rrtm_taumol1.intfb.h"
#include "rrtm_taumol10.intfb.h"
#include "rrtm_taumol11.intfb.h"
#include "rrtm_taumol12.intfb.h"
#include "rrtm_taumol13.intfb.h"
#include "rrtm_taumol14.intfb.h"
#include "rrtm_taumol15.intfb.h"
#include "rrtm_taumol16.intfb.h"
#include "rrtm_taumol2.intfb.h"
#include "rrtm_taumol3.intfb.h"
#include "rrtm_taumol4.intfb.h"
#include "rrtm_taumol5.intfb.h"
#include "rrtm_taumol6.intfb.h"
#include "rrtm_taumol7.intfb.h"
#include "rrtm_taumol8.intfb.h"
#include "rrtm_taumol9.intfb.h"

!- SECANG is equal to the secant of the diffusivity angle.
IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',0,ZHOOK_HANDLE)
Z_SECANG = 1.66_JPRB

CALL RRTM_TAUMOL1  (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,&
 & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL2  (KLEV,Z_TAU,P_COLDRY,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,&
 & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL3  (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL4  (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL5  (KLEV,Z_TAU,P_WX,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,P_FORFAC,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCO2,P_COLO3,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL6  (KLEV,Z_TAU,P_WX,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
 & P_COLH2O,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL7  (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLO3,P_CO2MULT,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL8  (KLEV,Z_TAU,P_WX,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
 & P_COLH2O,P_COLO3,P_COLN2O,P_CO2MULT,K_LAYSWTCH,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL9  (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLN2O,P_COLCH4,K_LAYTROP,K_LAYSWTCH,K_LAYLOW,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL10 (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
 & P_COLH2O,K_LAYTROP,PFRAC)  
CALL RRTM_TAUMOL11 (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,&
 & P_COLH2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL12 (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCO2,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL13 (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL14 (KLEV,Z_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)  
CALL RRTM_TAUMOL15 (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCO2,P_COLN2O,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  
CALL RRTM_TAUMOL16 (KLEV,Z_TAU,&
 & P_TAUAERL,P_FAC00,P_FAC01,P_FAC10,P_FAC11,K_JP,K_JT,K_JT1,P_ONEMINUS,&
 & P_COLH2O,P_COLCH4,K_LAYTROP,P_SELFFAC,P_SELFFRAC,K_INDSELF,PFRAC)  

!- Loop over g-channels.
DO I_LAY = 1, KLEV
  DO IPR = 1, JPGPT
    Z_ODEPTH = Z_SECANG * Z_TAU(IPR,I_LAY)
    P_OD(IPR,I_LAY) = Z_ODEPTH
    Z_ODEPTH=0.5D0*(ABS(Z_ODEPTH)+Z_ODEPTH)

!-- revised code to get the pre-computed transmission
!          IF (ODEPTH.LE.0.) PRINT*, 'ODEPTH = ',ODEPTH
!!  IF (ODEPTH <= _ZERO_)THEN
!!    ATR1(IPR,LAY) = _ONE_ - TRANS(0)
!!    TF1(IPR,LAY) = _ZERO_
!!  ELSE

    Z_TF = Z_ODEPTH/(BPADE+Z_ODEPTH)
    ITR=INT(5.E+03_JPRB*Z_TF+0.5_JPRB)
    IF (ITR.LT.0) ITR=0     ! MPL 12.12.08
    P_ATR1(IPR,I_LAY) = 1.0_JPRB - TRANS(ITR)
    P_TF1(IPR,I_LAY) = Z_TF

!!  ENDIF
  ENDDO
ENDDO

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

IF (LHOOK) CALL DR_HOOK('RRTM_GASABS1A_140GP',1,ZHOOK_HANDLE)
END SUBROUTINE RRTM_GASABS1A_140GP