GCC Code Coverage Report

Directory: ./
File: rad/srtm_init.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 48 0.0%
Branches: 0 16 0.0%
Line Branch Exec Source
1 ✗ SUBROUTINE SRTM_INIT
2
3 !-- read in the basic coefficients to configure RRTM_SW
4 !- creates module YOESRTWN with BG, NSPA, NSPB, WAVENUM1, WAVENUM2,
5 ! DELWAVE, PREF, PREFLOG, TREF
6
7 USE PARKIND1 ,ONLY : JPIM , JPRB
8 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
9
10 USE PARSRTM , ONLY : JPG, JPSW
11 USE YOESRTWN , ONLY : NG, NGM, WT, NGC, NGN, RWGT, WTSM
12
13 IMPLICIT NONE
14
15 ! Local variables
16 INTEGER(KIND=JPIM) :: IGC, IGCSM, IBND, IG, IND, IPR, IPRSM
17 REAL(KIND=JPRB) :: ZWTSUM
18
19 REAL(KIND=JPRB) :: ZHOOK_HANDLE
20
21 INTERFACE
22 SUBROUTINE SUSRTM
23 END SUBROUTINE SUSRTM
24 END INTERFACE
25 INTERFACE
26 SUBROUTINE SRTM_KGB16
27 END SUBROUTINE SRTM_KGB16
28 END INTERFACE
29 INTERFACE
30 SUBROUTINE SRTM_KGB17
31 END SUBROUTINE SRTM_KGB17
32 END INTERFACE
33 INTERFACE
34 SUBROUTINE SRTM_KGB18
35 END SUBROUTINE SRTM_KGB18
36 END INTERFACE
37 INTERFACE
38 SUBROUTINE SRTM_KGB19
39 END SUBROUTINE SRTM_KGB19
40 END INTERFACE
41 INTERFACE
42 SUBROUTINE SRTM_KGB20
43 END SUBROUTINE SRTM_KGB20
44 END INTERFACE
45 INTERFACE
46 SUBROUTINE SRTM_KGB21
47 END SUBROUTINE SRTM_KGB21
48 END INTERFACE
49 INTERFACE
50 SUBROUTINE SRTM_KGB22
51 END SUBROUTINE SRTM_KGB22
52 END INTERFACE
53 INTERFACE
54 SUBROUTINE SRTM_KGB23
55 END SUBROUTINE SRTM_KGB23
56 END INTERFACE
57 INTERFACE
58 SUBROUTINE SRTM_KGB24
59 END SUBROUTINE SRTM_KGB24
60 END INTERFACE
61 INTERFACE
62 SUBROUTINE SRTM_KGB25
63 END SUBROUTINE SRTM_KGB25
64 END INTERFACE
65 INTERFACE
66 SUBROUTINE SRTM_KGB26
67 END SUBROUTINE SRTM_KGB26
68 END INTERFACE
69 INTERFACE
70 SUBROUTINE SRTM_KGB27
71 END SUBROUTINE SRTM_KGB27
72 END INTERFACE
73 INTERFACE
74 SUBROUTINE SRTM_KGB28
75 END SUBROUTINE SRTM_KGB28
76 END INTERFACE
77 INTERFACE
78 SUBROUTINE SRTM_KGB29
79 END SUBROUTINE SRTM_KGB29
80 END INTERFACE
81 !#include "susrtop.intfb.h"
82
83 INTERFACE
84 SUBROUTINE SRTM_CMBGB16
85 END SUBROUTINE SRTM_CMBGB16
86 END INTERFACE
87 INTERFACE
88 SUBROUTINE SRTM_CMBGB17
89 END SUBROUTINE SRTM_CMBGB17
90 END INTERFACE
91 INTERFACE
92 SUBROUTINE SRTM_CMBGB18
93 END SUBROUTINE SRTM_CMBGB18
94 END INTERFACE
95 INTERFACE
96 SUBROUTINE SRTM_CMBGB19
97 END SUBROUTINE SRTM_CMBGB19
98 END INTERFACE
99 INTERFACE
100 SUBROUTINE SRTM_CMBGB20
101 END SUBROUTINE SRTM_CMBGB20
102 END INTERFACE
103 INTERFACE
104 SUBROUTINE SRTM_CMBGB21
105 END SUBROUTINE SRTM_CMBGB21
106 END INTERFACE
107 INTERFACE
108 SUBROUTINE SRTM_CMBGB22
109 END SUBROUTINE SRTM_CMBGB22
110 END INTERFACE
111 INTERFACE
112 SUBROUTINE SRTM_CMBGB23
113 END SUBROUTINE SRTM_CMBGB23
114 END INTERFACE
115 INTERFACE
116 SUBROUTINE SRTM_CMBGB24
117 END SUBROUTINE SRTM_CMBGB24
118 END INTERFACE
119 INTERFACE
120 SUBROUTINE SRTM_CMBGB25
121 END SUBROUTINE SRTM_CMBGB25
122 END INTERFACE
123 INTERFACE
124 SUBROUTINE SRTM_CMBGB26
125 END SUBROUTINE SRTM_CMBGB26
126 END INTERFACE
127 INTERFACE
128 SUBROUTINE SRTM_CMBGB27
129 END SUBROUTINE SRTM_CMBGB27
130 END INTERFACE
131 INTERFACE
132 SUBROUTINE SRTM_CMBGB28
133 END SUBROUTINE SRTM_CMBGB28
134 END INTERFACE
135 INTERFACE
136 SUBROUTINE SRTM_CMBGB29
137 END SUBROUTINE SRTM_CMBGB29
138 END INTERFACE
139
140 ✗ IF (LHOOK) CALL DR_HOOK('SRTM_INIT',0,ZHOOK_HANDLE)
141
142 ✗ CALL SUSRTM
143
144 !-- read in the molecular absorption coefficients
145
146 ✗ CALL SRTM_KGB16
147 ✗ CALL SRTM_KGB17
148 ✗ CALL SRTM_KGB18
149 ✗ CALL SRTM_KGB19
150 ✗ CALL SRTM_KGB20
151 ✗ CALL SRTM_KGB21
152 ✗ CALL SRTM_KGB22
153 ✗ CALL SRTM_KGB23
154 ✗ CALL SRTM_KGB24
155 ✗ CALL SRTM_KGB25
156 ✗ CALL SRTM_KGB26
157 ✗ CALL SRTM_KGB27
158 ✗ CALL SRTM_KGB28
159 ✗ CALL SRTM_KGB29
160
161 !-- read in the cloud optical properties
162 !- creates module YOESRTOP with EXTLIQ1, SSALIQ1, ASYLIQ1,
163 ! EXTICE3, SSAICE3, ASYICE3, FDLICE3
164
165 !-- RRTM_SW cloud optical properties are not used
166 ! SRTM_CLDPROP is not called
167 ! no need to call SUSRTOP
168
169 !CALL SUSRTOP ( -1 )
170
171
172 !Mike Iacono 20050804
173 !-- Perform g-point reduction from 16 per band (224 total points) to
174 !-- a band dependent number (112 total points) for all absorption
175 !-- coefficient input data and Planck fraction input data.
176 !-- Compute relative weighting for new g-point combinations.
177
178 IGCSM = 0
179 ✗ DO IBND = 1,JPSW
180 IPRSM = 0
181 ✗ IF (NGC(IBND) < JPG) THEN
182 ✗ DO IGC = 1,NGC(IBND)
183 ✗ IGCSM = IGCSM + 1
184 ZWTSUM = 0.
185 ✗ DO IPR = 1, NGN(IGCSM)
186 ✗ IPRSM = IPRSM + 1
187 ✗ ZWTSUM = ZWTSUM + WT(IPRSM)
188 ENDDO
189 ✗ WTSM(IGC) = ZWTSUM
190 ENDDO
191
192 ✗ DO IG = 1,NG(IBND+15)
193 ✗ IND = (IBND-1)*JPG + IG
194 ✗ RWGT(IND) = WT(IG)/WTSM(NGM(IND))
195 ENDDO
196 ELSE
197 ✗ DO IG = 1,NG(IBND+15)
198 ✗ IGCSM = IGCSM + 1
199 ✗ IND = (IBND-1)*JPG + IG
200 ✗ RWGT(IND) = 1.0
201 ENDDO
202 ENDIF
203 ENDDO
204
205 ✗ CALL SRTM_CMBGB16
206 ✗ CALL SRTM_CMBGB17
207 ✗ CALL SRTM_CMBGB18
208 ✗ CALL SRTM_CMBGB19
209 ✗ CALL SRTM_CMBGB20
210 ✗ CALL SRTM_CMBGB21
211 ✗ CALL SRTM_CMBGB22
212 ✗ CALL SRTM_CMBGB23
213 ✗ CALL SRTM_CMBGB24
214 ✗ CALL SRTM_CMBGB25
215 ✗ CALL SRTM_CMBGB26
216 ✗ CALL SRTM_CMBGB27
217 ✗ CALL SRTM_CMBGB28
218 ✗ CALL SRTM_CMBGB29
219
220 !-----------------------------------------------------------------------
221 ✗ IF (LHOOK) CALL DR_HOOK('SRTM_INIT',1,ZHOOK_HANDLE)
222 ✗ END SUBROUTINE SRTM_INIT
223
224