surrtab.F90

Go to the documentation of this file.

SUBROUTINE surrtab

!     -----------------------------------------------------------------
!        * E.C.M.W.F. PHYSICS PACKAGE ** AER'S RRTM LW RADIATION **

!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14

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

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

USE yoerrtab , ONLY : trans, bpade

IMPLICIT NONE

INTEGER(KIND=JPIM) :: ITR

REAL(KIND=JPRB) :: ZTAU, ZTFN
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('SURRTAB',0,zhook_handle)
bpade=1.0_jprb/0.278_jprb
trans(0)   =1.0_jprb
trans(5000)=0.0_jprb
DO itr=1,4999
  ztfn=REAL(itr)/5000._JPRB
  ztau=bpade*ztfn/(1.0_jprb-ztfn)
  trans(itr)=exp(-ztau)
ENDDO

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

IF (lhook) CALL dr_hook('SURRTAB',1,zhook_handle)
END SUBROUTINE surrtab