GCC Code Coverage Report

Directory: ./
File: rad/srtm_taumol24.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_TAUMOL24 &
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 , P_COLO2 , P_COLO3,&
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 24: 12850-16000 cm-1 (low - H2O,O2; high - O2)
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, NG24
25 USE YOESRTA24, ONLY : ABSA, ABSB, FORREFC, SELFREFC &
26 & , SFLUXREFC, ABSO3AC, ABSO3BC, RAYLAC, RAYLBC &
27 & , LAYREFFR, STRRAT
28 USE YOESRTWN , ONLY : NSPA, NSPB
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) ,INTENT(IN) :: P_ONEMINUS
42 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLH2O(JPLAY)
43 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLMOL(JPLAY)
44 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO2(JPLAY)
45 REAL(KIND=JPRB) ,INTENT(IN) :: P_COLO3(JPLAY)
46 INTEGER(KIND=JPIM),INTENT(IN) :: K_LAYTROP
47 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFAC(JPLAY)
48 REAL(KIND=JPRB) ,INTENT(IN) :: P_SELFFRAC(JPLAY)
49 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDSELF(JPLAY)
50 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFAC(JPLAY)
51 REAL(KIND=JPRB) ,INTENT(IN) :: P_FORFRAC(JPLAY)
52 INTEGER(KIND=JPIM),INTENT(IN) :: K_INDFOR(JPLAY)
53
54 REAL(KIND=JPRB) ,INTENT(OUT) :: P_SFLUXZEN(JPG)
55 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUG(JPLAY,JPG)
56 REAL(KIND=JPRB) ,INTENT(OUT) :: P_TAUR(JPLAY,JPG)
57 !- from INTFAC
58 !- from INTIND
59 !- from PRECISE
60 !- from PROFDATA
61 !- from SELF
62 INTEGER(KIND=JPIM) :: IG, IND0, IND1, INDS, INDF, JS, I_LAY, I_LAYSOLFR, I_NLAYERS
63
64 REAL(KIND=JPRB) :: Z_FAC000, Z_FAC001, Z_FAC010, Z_FAC011, Z_FAC100, Z_FAC101,&
65 & Z_FAC110, Z_FAC111, Z_FS, Z_SPECCOMB, Z_SPECMULT, Z_SPECPARM, &
66 & Z_TAURAY
67 REAL(KIND=JPRB) :: ZHOOK_HANDLE
68
69 ✗ IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL24',0,ZHOOK_HANDLE)
70 ✗ I_NLAYERS = KLEV
71
72 ! Compute the optical depth by interpolating in ln(pressure),
73 ! temperature, and appropriate species. Below LAYTROP, the water
74 ! vapor self-continuum is interpolated (in temperature) separately.
75
76 ✗ I_LAYSOLFR = K_LAYTROP
77
78 ✗ DO I_LAY = 1, K_LAYTROP
79 ✗ IF (K_JP(I_LAY) < LAYREFFR .AND. K_JP(I_LAY+1) >= LAYREFFR) &
80 ✗ & I_LAYSOLFR = MIN(I_LAY+1,K_LAYTROP)
81 ✗ Z_SPECCOMB = P_COLH2O(I_LAY) + STRRAT*P_COLO2(I_LAY)
82 ✗ Z_SPECPARM = P_COLH2O(I_LAY)/Z_SPECCOMB
83 ✗ IF (Z_SPECPARM >= P_ONEMINUS) Z_SPECPARM = P_ONEMINUS
84 ✗ Z_SPECMULT = 8.*(Z_SPECPARM)
85 ✗ JS = 1 + INT(Z_SPECMULT)
86 ✗ Z_FS = MOD(Z_SPECMULT, 1.0_JPRB )
87 ! Z_FAC000 = (1. - Z_FS) * P_FAC00(I_LAY)
88 ! Z_FAC010 = (1. - Z_FS) * P_FAC10(I_LAY)
89 ! Z_FAC100 = Z_FS * P_FAC00(I_LAY)
90 ! Z_FAC110 = Z_FS * P_FAC10(I_LAY)
91 ! Z_FAC001 = (1. - Z_FS) * P_FAC01(I_LAY)
92 ! Z_FAC011 = (1. - Z_FS) * P_FAC11(I_LAY)
93 ! Z_FAC101 = Z_FS * P_FAC01(I_LAY)
94 ! Z_FAC111 = Z_FS * P_FAC11(I_LAY)
95 ✗ IND0 = ((K_JP(I_LAY)-1)*5+(K_JT(I_LAY)-1))*NSPA(24) + JS
96 ✗ IND1 = (K_JP(I_LAY)*5+(K_JT1(I_LAY)-1))*NSPA(24) + JS
97 ✗ INDS = K_INDSELF(I_LAY)
98 ✗ INDF = K_INDFOR(I_LAY)
99
100 ! DO IG = 1, NG(24)
101 ✗ DO IG = 1 , NG24
102 Z_TAURAY = P_COLMOL(I_LAY) * (RAYLAC(IG,JS) + &
103 ✗ & Z_FS * (RAYLAC(IG,JS+1) - RAYLAC(IG,JS)))
104 P_TAUG(I_LAY,IG) = Z_SPECCOMB * &
105 ! & (Z_FAC000 * ABSA(IND0,IG) + &
106 ! & Z_FAC100 * ABSA(IND0+1,IG) + &
107 ! & Z_FAC010 * ABSA(IND0+9,IG) + &
108 ! & Z_FAC110 * ABSA(IND0+10,IG) + &
109 ! & Z_FAC001 * ABSA(IND1,IG) + &
110 ! & Z_FAC101 * ABSA(IND1+1,IG) + &
111 ! & Z_FAC011 * ABSA(IND1+9,IG) + &
112 ! & Z_FAC111 * ABSA(IND1+10,IG)) + &
113 & (&
114 & (1. - Z_FS) * ( ABSA(IND0,IG) * P_FAC00(I_LAY) + &
115 & ABSA(IND0+9,IG) * P_FAC10(I_LAY) + &
116 & ABSA(IND1,IG) * P_FAC01(I_LAY) + &
117 & ABSA(IND1+9,IG) * P_FAC11(I_LAY) ) + &
118 & Z_FS * ( ABSA(IND0+1,IG) * P_FAC00(I_LAY) + &
119 & ABSA(IND0+10,IG) * P_FAC10(I_LAY) + &
120 & ABSA(IND1+1,IG) * P_FAC01(I_LAY) + &
121 & ABSA(IND1+10,IG) * P_FAC11(I_LAY) ) &
122 & ) + &
123 & P_COLO3(I_LAY) * ABSO3AC(IG) + &
124 & P_COLH2O(I_LAY) * &
125 & (P_SELFFAC(I_LAY) * (SELFREFC(INDS,IG) + &
126 & P_SELFFRAC(I_LAY) * &
127 & (SELFREFC(INDS+1,IG) - SELFREFC(INDS,IG))) + &
128 & P_FORFAC(I_LAY) * (FORREFC(INDF,IG) + &
129 & P_FORFRAC(I_LAY) * &
130 ✗ & (FORREFC(INDF+1,IG) - FORREFC(INDF,IG))))
131 ! & + TAURAY
132 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
133 ✗ IF (I_LAY == I_LAYSOLFR) P_SFLUXZEN(IG) = SFLUXREFC(IG,JS) &
134 ✗ & + Z_FS * (SFLUXREFC(IG,JS+1) - SFLUXREFC(IG,JS))
135 ✗ P_TAUR(I_LAY,IG) = Z_TAURAY
136 ENDDO
137 ENDDO
138
139 ✗ DO I_LAY = K_LAYTROP+1, I_NLAYERS
140 ✗ IND0 = ((K_JP(I_LAY)-13)*5+(K_JT(I_LAY)-1))*NSPB(24) + 1
141 ✗ IND1 = ((K_JP(I_LAY)-12)*5+(K_JT1(I_LAY)-1))*NSPB(24) + 1
142
143 ! DO IG = 1, NG(24)
144 ✗ DO IG = 1 , NG24
145 ✗ Z_TAURAY = P_COLMOL(I_LAY) * RAYLBC(IG)
146 P_TAUG(I_LAY,IG) = P_COLO2(I_LAY) * &
147 & (P_FAC00(I_LAY) * ABSB(IND0,IG) + &
148 & P_FAC10(I_LAY) * ABSB(IND0+1,IG) + &
149 & P_FAC01(I_LAY) * ABSB(IND1,IG) + &
150 & P_FAC11(I_LAY) * ABSB(IND1+1,IG)) + &
151 ✗ & P_COLO3(I_LAY) * ABSO3BC(IG)
152 ! & + TAURAY
153 ! SSA(LAY,IG) = TAURAY/TAUG(LAY,IG)
154 ✗ P_TAUR(I_LAY,IG) = Z_TAURAY
155 ENDDO
156 ENDDO
157
158 !-----------------------------------------------------------------------
159 ✗ IF (LHOOK) CALL DR_HOOK('SRTM_TAUMOL24',1,ZHOOK_HANDLE)
160 ✗ END SUBROUTINE SRTM_TAUMOL24
161
162