GCC Code Coverage Report

Directory: ./
File: rad/lwvd.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 68 0.0%
Branches: 0 42 0.0%
Line Branch Exec Source
1 ✗ SUBROUTINE LWVD &
2 & ( KIDIA, KFDIA, KLON , KLEV , KTRAER,&
3 ✗ & PABCU, PDBDT,&
4 ✗ & PGA , PGB,&
5 ✗ & PCNTRB, PDISD, PDISU, PDWFSU &
6 & )
7
8 !**** *LWVD* - L.W., VERTICAL INTEGRATION, DISTANT LAYERS
9
10 ! PURPOSE.
11 ! --------
12 ! CARRIES OUT THE VERTICAL INTEGRATION ON THE DISTANT LAYERS
13
14 !** INTERFACE.
15 ! ----------
16
17 ! EXPLICIT ARGUMENTS :
18 ! --------------------
19 ! ==== INPUTS ===
20 ! PABCU : (KLON,NUA,3*KLEV+1) ; ABSORBER AMOUNTS
21 ! PDBDT : (KLON,KLEV) ; LAYER PLANCK FUNCTION GRADIENT
22 ! PGA, PGB ; PADE APPROXIMANTS
23 ! ==== OUTPUTS ===
24 ! PCNTRB : (KLON,KLEV+1,KLEV+1); ENERGY EXCHANGE MATRIX
25 ! PDIS.. : (KLON,KLEV+1) ; CONTRIBUTION BY DISTANT LAYERS
26 ! PDWFSU : (KLON,NSIL) ; SPECTRAL DOWNWARD FLUX AT SURFACE
27
28 ! IMPLICIT ARGUMENTS : NONE
29 ! --------------------
30
31 ! METHOD.
32 ! -------
33
34 ! 1. PERFORMS THE VERTICAL INTEGRATION CORRESPONDING TO THE
35 ! CONTRIBUTIONS OF THE DISTANT LAYERS USING TRAPEZOIDAL RULE
36
37 ! EXTERNALS.
38 ! ----------
39
40 ! *LWTT*
41
42 ! REFERENCE.
43 ! ----------
44
45 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
46 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
47
48 ! AUTHOR.
49 ! -------
50 ! JEAN-JACQUES MORCRETTE *ECMWF*
51
52 ! MODIFICATIONS.
53 ! --------------
54 ! ORIGINAL : 89-07-14
55 ! JJ Morcrette 97-04-18 Revised continuum + Surf. Emissiv.
56 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
57 !-----------------------------------------------------------------------
58
59 USE PARKIND1 ,ONLY : JPIM ,JPRB
60 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
61
62 USE YOELW , ONLY : NSIL ,NIPD ,NTRA ,NUA ,NG1P1
63
64 IMPLICIT NONE
65
66 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
67 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
68 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
69 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
70 INTEGER(KIND=JPIM),INTENT(IN) :: KTRAER
71 REAL(KIND=JPRB) ,INTENT(IN) :: PABCU(KLON,NUA,3*KLEV+1)
72 REAL(KIND=JPRB) ,INTENT(IN) :: PDBDT(KLON,NSIL,KLEV)
73 REAL(KIND=JPRB) ,INTENT(IN) :: PGA(KLON,NIPD,2,KLEV)
74 REAL(KIND=JPRB) ,INTENT(IN) :: PGB(KLON,NIPD,2,KLEV)
75 REAL(KIND=JPRB) ,INTENT(OUT) :: PCNTRB(KLON,KLEV+1,KLEV+1)
76 REAL(KIND=JPRB) ,INTENT(OUT) :: PDISD(KLON,KLEV+1)
77 REAL(KIND=JPRB) ,INTENT(OUT) :: PDISU(KLON,KLEV+1)
78 REAL(KIND=JPRB) ,INTENT(INOUT) :: PDWFSU(KLON,NSIL)
79 !-----------------------------------------------------------------------
80
81 !* 0.1 ARGUMENTS
82 ! ---------
83
84 !-----------------------------------------------------------------------
85
86 ! ------------
87
88 ✗ REAL(KIND=JPRB) :: ZTT(KLON,NTRA), ZTT1(KLON,NTRA), ZTT2(KLON,NTRA)
89
90 INTEGER(KIND=JPIM) :: IJKL, IKD1, IKD2, IKJ, IKJP1, IKM1, IKN,&
91 & IKP1, IKU1, IKU2, ITT, JA, JK, JKJ, JL, JLK
92
93 REAL(KIND=JPRB) :: ZWW, ZWW1, ZWW2, ZWW3, ZWW4, ZWW5, ZWW6
94 REAL(KIND=JPRB) :: ZHOOK_HANDLE
95
96 INTERFACE
97 SUBROUTINE LWTTM ( KIDIA, KFDIA, KLON, PGA , PGB, PUU1 , PUU2 , PTT )
98 USE PARKIND1 ,ONLY : JPIM ,JPRB
99 USE YOELW , ONLY : NTRA ,NUA ,RPTYPE ,RETYPE ,&
100 & RO1H ,RO2H ,RPIALF0
101 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
102 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
103 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
104 REAL(KIND=JPRB) ,INTENT(IN) :: PGA(KLON,8,2)
105 REAL(KIND=JPRB) ,INTENT(IN) :: PGB(KLON,8,2)
106 REAL(KIND=JPRB) ,INTENT(IN) :: PUU1(KLON,NUA)
107 REAL(KIND=JPRB) ,INTENT(IN) :: PUU2(KLON,NUA)
108 REAL(KIND=JPRB) ,INTENT(OUT) :: PTT(KLON,NTRA)
109 END SUBROUTINE LWTTM
110 END INTERFACE
111
112 !-----------------------------------------------------------------------
113
114 !* 1. INITIALIZATION
115 ! --------------
116
117 !* 1.1 INITIALIZE LAYER CONTRIBUTIONS
118 ! ------------------------------
119
120 ✗ IF (LHOOK) CALL DR_HOOK('LWVD',0,ZHOOK_HANDLE)
121 ✗ DO JK = 1, KLEV+1
122 ✗ DO JL = KIDIA,KFDIA
123 ✗ PDISD(JL,JK) = 0.0_JPRB
124 ✗ PDISU(JL,JK) = 0.0_JPRB
125 ENDDO
126 ENDDO
127
128 !* 1.2 INITIALIZE TRANSMISSION FUNCTIONS
129 ! ---------------------------------
130
131 ✗ DO JA = 1, NTRA
132 ✗ DO JL = KIDIA,KFDIA
133 ✗ ZTT (JL,JA) = 1.0_JPRB
134 ✗ ZTT1(JL,JA) = 1.0_JPRB
135 ✗ ZTT2(JL,JA) = 1.0_JPRB
136 ENDDO
137 ENDDO
138
139 ! ------------------------------------------------------------------
140
141 !* 2. VERTICAL INTEGRATION
142 ! --------------------
143
144 !* 2.2 CONTRIBUTION FROM DISTANT LAYERS
145 ! ---------------------------------
146
147 !* 2.2.1 DISTANT AND ABOVE LAYERS
148 ! ------------------------
149
150 !* 2.2.2 FIRST UPPER LEVEL
151 ! -----------------
152
153 ✗ DO JK = 1 , KLEV-1
154 ✗ IKP1=JK+1
155 ✗ IKN=(JK-1)*NG1P1+1
156 ✗ IKD1= JK *NG1P1+1
157
158 CALL LWTTM &
159 & ( KIDIA , KFDIA , KLON,&
160 & PGA(1,1,1,JK) , PGB(1,1,1,JK),&
161 & PABCU(1,1,IKN), PABCU(1,1,IKD1), ZTT1 &
162 ✗ & )
163
164 !* 2.2.3 HIGHER UP
165 ! ---------
166
167 ITT=1
168 ✗ DO JKJ=IKP1,KLEV
169 ✗ IF(ITT == 1) THEN
170 ITT=2
171 ELSE
172 ITT=1
173 ENDIF
174 ✗ IKJP1=JKJ+1
175 ✗ IKD2= JKJ *NG1P1+1
176
177 ✗ IF(ITT == 1) THEN
178 CALL LWTTM &
179 & ( KIDIA , KFDIA , KLON,&
180 & PGA(1,1,1,JKJ), PGB(1,1,1,JKJ),&
181 & PABCU(1,1,IKN), PABCU(1,1,IKD2), ZTT1 &
182 ✗ & )
183
184 ELSE
185 CALL LWTTM &
186 & ( KIDIA , KFDIA , KLON,&
187 & PGA(1,1,1,JKJ), PGB(1,1,1,JKJ),&
188 & PABCU(1,1,IKN), PABCU(1,1,IKD2), ZTT2 &
189 ✗ & )
190
191 ENDIF
192
193 ✗ DO JA = 1, KTRAER
194 ✗ DO JL = KIDIA,KFDIA
195 ✗ ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5_JPRB
196 ENDDO
197 ENDDO
198
199 ✗ DO JL = KIDIA,KFDIA
200 ✗ ZWW1=PDBDT(JL,1,JKJ)*ZTT(JL,1) *ZTT(JL,10)
201 ✗ ZWW2=PDBDT(JL,2,JKJ)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)
202 ✗ ZWW3=PDBDT(JL,3,JKJ)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)
203 ✗ ZWW4=PDBDT(JL,4,JKJ)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)
204 ✗ ZWW5=PDBDT(JL,5,JKJ)*ZTT(JL,3) *ZTT(JL,14)
205 ✗ ZWW6=PDBDT(JL,6,JKJ)*ZTT(JL,6) *ZTT(JL,15)
206 ✗ ZWW=ZWW1+ZWW2+ZWW3+ZWW4+ZWW5+ZWW6
207 ✗ PDISD(JL,JK)=PDISD(JL,JK)+ZWW
208 ✗ PCNTRB(JL,JK,IKJP1)=ZWW
209 ✗ IF (JK == 1) THEN
210 ✗ PDWFSU(JL,1)=PDWFSU(JL,1)+ZWW1
211 ✗ PDWFSU(JL,2)=PDWFSU(JL,2)+ZWW2
212 ✗ PDWFSU(JL,3)=PDWFSU(JL,3)+ZWW3
213 ✗ PDWFSU(JL,4)=PDWFSU(JL,4)+ZWW4
214 ✗ PDWFSU(JL,5)=PDWFSU(JL,5)+ZWW5
215 ✗ PDWFSU(JL,6)=PDWFSU(JL,6)+ZWW6
216 ENDIF
217 ENDDO
218
219 ENDDO
220 ENDDO
221
222 !* 2.2.4 DISTANT AND BELOW LAYERS
223 ! ------------------------
224
225 !* 2.2.5 FIRST LOWER LEVEL
226 ! -----------------
227
228 ✗ DO JK=3,KLEV+1
229 ✗ IKN=(JK-1)*NG1P1+1
230 IKM1=JK-1
231 ✗ IKJ=JK-2
232 ✗ IKU1= IKJ *NG1P1+1
233
234 CALL LWTTM &
235 & ( KIDIA , KFDIA , KLON,&
236 & PGA(1,1,1,IKJ) , PGB(1,1,1,IKJ),&
237 & PABCU(1,1,IKU1), PABCU(1,1,IKN), ZTT1 &
238 ✗ & )
239
240 !* 2.2.6 DOWN BELOW
241 ! ----------
242
243 ITT=1
244 ✗ DO JLK=1,IKJ
245 ✗ IF(ITT == 1) THEN
246 ITT=2
247 ELSE
248 ITT=1
249 ENDIF
250 ✗ IJKL=IKM1-JLK
251 ✗ IKU2=(IJKL-1)*NG1P1+1
252
253 ✗ IF(ITT == 1) THEN
254 CALL LWTTM &
255 & ( KIDIA , KFDIA , KLON,&
256 & PGA(1,1,1,IJKL), PGB(1,1,1,IJKL),&
257 & PABCU(1,1,IKU2), PABCU(1,1,IKN) , ZTT1 &
258 ✗ & )
259
260 ELSE
261 CALL LWTTM &
262 & ( KIDIA , KFDIA , KLON,&
263 & PGA(1,1,1,IJKL), PGB(1,1,1,IJKL),&
264 & PABCU(1,1,IKU2), PABCU(1,1,IKN) , ZTT2 &
265 ✗ & )
266
267 ENDIF
268
269 ✗ DO JA = 1, KTRAER
270 ✗ DO JL = KIDIA,KFDIA
271 ✗ ZTT(JL,JA) = (ZTT1(JL,JA)+ZTT2(JL,JA))*0.5_JPRB
272 ENDDO
273 ENDDO
274
275 ✗ DO JL = KIDIA,KFDIA
276 ZWW=PDBDT(JL,1,IJKL)*ZTT(JL,1) *ZTT(JL,10)&
277 & +PDBDT(JL,2,IJKL)*ZTT(JL,2)*ZTT(JL,7)*ZTT(JL,11)&
278 & +PDBDT(JL,3,IJKL)*ZTT(JL,4)*ZTT(JL,8)*ZTT(JL,12)&
279 & +PDBDT(JL,4,IJKL)*ZTT(JL,5)*ZTT(JL,9)*ZTT(JL,13)&
280 & +PDBDT(JL,5,IJKL)*ZTT(JL,3) *ZTT(JL,14)&
281 ✗ & +PDBDT(JL,6,IJKL)*ZTT(JL,6) *ZTT(JL,15)
282 ✗ PDISU(JL,JK)=PDISU(JL,JK)+ZWW
283 ✗ PCNTRB(JL,JK,IJKL)=ZWW
284 ENDDO
285
286 ENDDO
287 ENDDO
288
289 ! ------------------------------------------------------------------
290
291 ✗ IF (LHOOK) CALL DR_HOOK('LWVD',1,ZHOOK_HANDLE)
292 ✗ END SUBROUTINE LWVD
293