GCC Code Coverage Report

Directory: ./
File: rad/srtm_taumol18.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 32 0.0%
Branches: 0 20 0.0%
Line Branch Exec Source
1 ✗ SUBROUTINE SRTM_TAUMOL18 &
2 & ( KLEV,&
3 & P_FAC00 , P_FAC01 , P_FAC10 , P_FAC11,&
4 & K_JP , K_JT , K_JT1 , P_ONEMINUS,&
5 & P_COLH2O , P_COLCH4 , 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 18: 4000-4650 cm-1 (low - H2O,CH4; high - CH4)
13
14 USE PARKIND1 ,ONLY : JPIM ,JPRB
15 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
16
17 USE PARSRTM , ONLY : JPLAY, JPG, NG18
18 USE YOESRTA18, ONLY : ABSA, ABSB, FORREFC, SELFREFC &
19 & , SFLUXREFC, RAYL &
20 & , LAYREFFR, STRRAT
21 USE YOESRTWN , ONLY : NSPA, NSPB
22
23 IMPLICIT NONE
24
25 !-- Output
26 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
27 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC00(JPLAY)
28 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC01(JPLAY)
29 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC10(JPLAY)
30 REAL(KIND=JPRB) ,INTENT(IN) :: P_FAC11(JPLAY)
31 INTEGER(KIND=JPIM),INTENT(IN) :: K_JP(JPLAY)
32 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT(JPLAY)
33 INTEGER(KIND=JPIM),INTENT(IN) :: K_JT1(JPLAY)
34 REAL(KIND=JPRB) ,INTENT(IN) :: P_ONEMINUS
35 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
36 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLCH4(JPLAY)
37 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
38 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
39 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
40 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
41 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
42 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
43 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
44 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
45
46 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
47 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
48 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
49 !- from INTFAC
50 !- from INTIND
51 !- from PRECISE
52 !- from PROFDATA
53 !- from SELF
54 INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR, I_NLAYERS
55
56 REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
57 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
58 & Z_TAURAY
59 REAL(KIND=JPRB) :: ZHOOK_HANDLE
60
61 ✗ IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL18',0,ZHOOK_HANDLE)
62 ✗ I_NLAYERS = KLEV
63
64 ! Compute the optical depth by interpolating in ln(pressure),
65 ! temperature, and appropriate species. Below LAYTROP, the water
66 ! vapor self-continuum is interpolated (in temperature) separately.
67
68 ✗ I_LAYSOLFR = K_LAYTROP
69
70 ✗ DO I_LAY = 1, K_LAYTROP
71 ✗ IF (K_JP(I_LAY) < LAYREFFR .AND. K_JP(I_LAY+1) >= LAYREFFR) &
72 ✗ & I_LAYSOLFR = MIN(I_LAY+1,K_LAYTROP)
73 ✗ Z_SPECCOMB = P_COLH2O(I_LAY) + STRRAT*P_COLCH4(I_LAY)
74 ✗ Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB
75 ✗ IF (Z_SPECPARM >= P_ONEMINUS) Z_SPECPARM = P_ONEMINUS
76 ✗ Z_SPECMULT = 8.*(Z_SPECPARM)
77 ✗ JS = 1 + INT(Z_SPECMULT)
78 ✗ Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
79 ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
80 ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
81 ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
82 ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
83 ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
84 ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
85 ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
86 ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
87 ✗ IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(18) + JS
88 ✗ IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(18) + JS
89 ✗ INDS = K_INDSELF(I_LAY)
90 ✗ INDF = K_INDFOR(I_LAY)
91 ✗ Z_TAURAY = P_COLMOL(I_LAY) * RAYL
92
93 ! DO IG = 1, NG(18)
94 ✗ DO IG = 1, NG18
95 P_TAUG(I_LAY,IG) = Z_SPECCOMB * &
96 ! & (Z_FAC000 * ABSA(IND0,IG) + &
97 ! & Z_FAC100 * ABSA(IND0+1,IG) + &
98 ! & Z_FAC010 * ABSA(IND0+9,IG) + &
99 ! & Z_FAC110 * ABSA(IND0+10,IG) + &
100 ! & Z_FAC001 * ABSA(IND1,IG) + &
101 ! & Z_FAC101 * ABSA(IND1+1,IG) + &
102 ! & Z_FAC011 * ABSA(IND1+9,IG) + &
103 ! & Z_FAC111 * ABSA(IND1+10,IG)) + &
104 & (&
105 & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(I_LAY) + &
106 & ABSA(IND0+9,IG) * P_FAC10(I_LAY) + &
107 & ABSA(IND1,IG) * P_FAC01(I_LAY) + &
108 & ABSA(IND1+9,IG) * P_FAC11(I_LAY) ) + &
109 & Z_FS * ( ABSA(IND0+1,IG) * P_FAC00(I_LAY) + &
110 & ABSA(IND0+10,IG) * P_FAC10(I_LAY) + &
111 & ABSA(IND1+1,IG) * P_FAC01(I_LAY) + &
112 & ABSA(IND1+10,IG) * P_FAC11(I_LAY) ) &
113 & ) + &
114 & P_COLH2O(I_LAY) * &
115 & (P_SELFFAC(I_LAY) * (SELFREFC(INDS,IG) + &
116 & P_SELFFRAC(I_LAY) * &
117 & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
118 & P_FORFAC(I_LAY) * (FORREFC(INDF,IG) + &
119 & P_FORFRAC(I_LAY) * &
120 ✗ & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))
121 ! & + TAURAY
122 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
123 ✗ IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IG) = SFLUXREFC(IG,JS) &
124 ✗ & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))
125 ✗ P_TAUR(I_LAY,IG) = Z_TAURAY
126 ENDDO
127 ENDDO
128
129 ✗ DO I_LAY = K_LAYTROP+1, I_NLAYERS
130 ✗ IND0 = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(18) + 1
131 ✗ IND1 = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(18) + 1
132 ✗ Z_TAURAY = P_COLMOL(I_LAY) * RAYL
133
134 ! DO IG = 1, NG(18)
135 ✗ DO IG = 1, NG18
136 P_TAUG(I_LAY,IG) = P_COLCH4(I_LAY) * &
137 & (P_FAC00(I_LAY) * ABSB(IND0,IG) + &
138 & P_FAC10(I_LAY) * ABSB(IND0+1,IG) + &
139 & P_FAC01(I_LAY) * ABSB(IND1,IG) + &
140 ✗ & P_FAC11(I_LAY) * ABSB(IND1+1,IG))
141 ! & + TAURAY
142 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
143 ✗ P_TAUR(I_LAY,IG) = Z_TAURAY
144 ENDDO
145 ENDDO
146
147 !-----------------------------------------------------------------------
148 ✗ IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL18',1,ZHOOK_HANDLE)
149 ✗ END SUBROUTINE SRTM_TAUMOL18
150
151