GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/rrtm/surrtab.F90 Lines: 11 11 100.0 %
Date: 2023-06-30 12:56:34 Branches: 4 6 66.7 %

Line Branch Exec Source
1
1
SUBROUTINE SURRTAB
2
3
!     -----------------------------------------------------------------
4
!        * E.C.M.W.F. PHYSICS PACKAGE ** AER'S RRTM LW RADIATION **
5
6
!     J.-J. MORCRETTE       E.C.M.W.F.      98/07/14
7
8
!     -----------------------------------------------------------------
9
10
USE PARKIND1  ,ONLY : JPIM     ,JPRB
11
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
12
13
USE YOERRTAB , ONLY : TRANS, BPADE
14
15
IMPLICIT NONE
16
17
INTEGER(KIND=JPIM) :: ITR
18
19
REAL(KIND=JPRB) :: ZTAU, ZTFN
20
REAL(KIND=JPRB) :: ZHOOK_HANDLE
21
22
1
IF (LHOOK) CALL DR_HOOK('SURRTAB',0,ZHOOK_HANDLE)
23
1
BPADE=1.0_JPRB/0.278_JPRB
24
1
TRANS(0)   =1.0_JPRB
25
1
TRANS(5000)=0.0_JPRB
26
5000
DO ITR=1,4999
27
4999
  ZTFN=REAL(ITR)/5000._JPRB
28
4999
  ZTAU=BPADE*ZTFN/(1.0_JPRB-ZTFN)
29
5000
  TRANS(ITR)=EXP(-ZTAU)
30
ENDDO
31
32
!     -----------------------------------------------------------------
33
34
1
IF (LHOOK) CALL DR_HOOK('SURRTAB',1,ZHOOK_HANDLE)
35
1
END SUBROUTINE SURRTAB