GCC Code Coverage Report


Directory: ./
File: rad/srtm_taumol23.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 22 0.0%
Branches: 0 18 0.0%

Line Branch Exec Source
1 SUBROUTINE SRTM_TAUMOL23 &
2 & ( KLEV,&
3 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
4 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
5 & P_COLH2O , P_COLMOL,&
6 & K_LAYTROP , P_SELFFAC, P_SELFFRAC, K_INDSELF , P_FORFAC, P_FORFRAC, K_INDFOR,&
7 & P_SFLUXZEN, P_TAUG , P_TAUR &
8 & )
9
10 ! Written by Eli J. Mlawer, Atmospheric & Environmental Research.
11
12 ! BAND 23: 8050-12850 cm-1 (low - H2O; high - nothing)
13
14 ! Modifications
15 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
16
17 ! JJMorcrette 2003-02-24 adapted to ECMWF environment
18
19 ! PARAMETER (MG=16, MXLAY=203, NBANDS=14)
20
21 USE PARKIND1 ,ONLY : JPIM ,JPRB
22 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
23
24 USE PARSRTM , ONLY : JPLAY, JPG, NG23
25 USE YOESRTA23, ONLY : ABSA, FORREFC, SELFREFC &
26 & , SFLUXREFC, RAYLC &
27 & , LAYREFFR, GIVFAC
28 USE YOESRTWN , ONLY : NSPA
29
30 IMPLICIT NONE
31
32 !-- Output
33 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
34 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
35 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
36 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
37 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
38 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
39 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
40 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
41 REAL(KIND=JPRB) :: P_ONEMINUS ! Argument NOT used
42 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
43 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
44 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
45 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
46 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
47 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
48 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
49 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
50 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
51
52 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
53 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
54 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
55 !- from INTFAC
56 !- from INTIND
57 !- from PRECISE
58 !- from PROFDATA
59 !- from SELF
60 INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, I_LAY, I_LAYSOLFR, I_NLAYERS
61
62 REAL(KIND=JPRB) :: &
63 & Z_TAURAY
64 REAL(KIND=JPRB) :: ZHOOK_HANDLE
65
66 IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL23',0,ZHOOK_HANDLE)
67 I_NLAYERS = KLEV
68
69 ! Compute the optical depth by interpolating in ln(pressure),
70 ! temperature, and appropriate species. Below LAYTROP, the water
71 ! vapor self-continuum is interpolated (in temperature) separately.
72
73 I_LAYSOLFR = K_LAYTROP
74
75 DO I_LAY = 1, K_LAYTROP
76 IF (K_JP(I_LAY) < LAYREFFR .AND. K_JP(I_LAY+1) >= LAYREFFR) &
77 & I_LAYSOLFR = MIN(I_LAY+1,K_LAYTROP)
78 IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(23) + 1
79 IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(23) + 1
80 INDS = K_INDSELF(I_LAY)
81 INDF = K_INDFOR(I_LAY)
82
83 ! DO IG = 1, NG(23)
84 DO IG = 1 , NG23
85 Z_TAURAY = P_COLMOL(I_LAY) * RAYLC(IG)
86 P_TAUG(I_LAY,IG) = P_COLH2O(I_LAY) * &
87 & (GIVFAC * (P_FAC00(I_LAY) * ABSA(IND0,IG) + &
88 & P_FAC10(I_LAY) * ABSA(IND0+1,IG) + &
89 & P_FAC01(I_LAY) * ABSA(IND1,IG) + &
90 & P_FAC11(I_LAY) * ABSA(IND1+1,IG)) + &
91 & P_SELFFAC(I_LAY) * (SELFREFC(INDS,IG) + &
92 & P_SELFFRAC(I_LAY) * &
93 & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
94 & P_FORFAC(I_LAY) * (FORREFC(INDF,IG) + &
95 & P_FORFRAC(I_LAY) * &
96 & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))
97 ! & + TAURAY
98 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
99 IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IG) = SFLUXREFC(IG)
100 P_TAUR(I_LAY,IG) = Z_TAURAY
101 ENDDO
102 ENDDO
103
104 DO I_LAY = K_LAYTROP+1, I_NLAYERS
105 ! DO IG = 1, NG(23)
106 DO IG = 1 , NG23
107 ! TAUG(LAY,IG) = COLMOL(LAY) * RAYLC(IG)
108 ! SSA(LAY,IG) = 1.0
109 P_TAUG(I_LAY,IG) = 0.0_JPRB
110 P_TAUR(I_LAY,IG) = P_COLMOL(I_LAY) * RAYLC(IG)
111 ENDDO
112 ENDDO
113
114 !-----------------------------------------------------------------------
115 IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL23',1,ZHOOK_HANDLE)
116 END SUBROUTINE SRTM_TAUMOL23
117
118