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

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

#include "tsmbkind.h"

USE yoerrtab , ONLY : trans, bpade

IMPLICIT NONE

!     LOCAL INTEGER SCALARS
integer_m :: itr

!     LOCAL REAL SCALARS
real_b :: ztau, ztfn


bpade=_one_/0.278_jprb
trans(0)   =_one_
trans(5000)=_zero_
DO itr=1,4970
  ztfn=REAL(itr)/5000._JPRB
  ztau=bpade*ztfn/(_one_-ztfn)
  trans(itr)=exp(-ztau)
! write(6,*) ITR,TRANS(ITR)
ENDDO
DO itr=4971,4999
  trans(itr)=_zero_
! write(6,*) ITR,TRANS(ITR)
ENDDO

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

RETURN
END SUBROUTINE surrtab