GCC Code Coverage Report

Directory: ./
File: rad/swu.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 77 88 87.5%
Branches: 31 44 70.5%
Line Branch Exec Source
1 !OPTIONS XOPT(HSFUN)
2 240 SUBROUTINE SWU &
3 & ( KIDIA, KFDIA , KLON , KLEV,&
4 120 & PSCT , PCARDI, PCLDSW, PPMB , PPSOL, PRMU0, PTAVE, PWV,&
5 120 & PAKI , PCLD , PCLEAR, PDSIG, PFACT, PRMU , PSEC , PUD &
6 & )
7
8 !**** *SWU* - SHORTWAVE RADIATION, ABSORBER AMOUNTS
9
10 ! PURPOSE.
11 ! --------
12 ! COMPUTES THE ABSORBER AMOUNTS USED IN SHORTWAVE RADIATION
13 ! CALCULATIONS
14
15 !** INTERFACE.
16 ! ----------
17 ! *SWU* IS CALLED BY *SW*
18
19 ! IMPLICIT ARGUMENTS :
20 ! --------------------
21
22 ! ==== INPUTS ===
23 ! ==== OUTPUTS ===
24
25 ! METHOD.
26 ! -------
27
28 ! 1. COMPUTES ABSORBER AMOUNTS WITH TEMPERATURE AND PRESSURE
29 ! SCALING.
30
31 ! EXTERNALS.
32 ! ----------
33
34 ! *SWTT*
35
36 ! REFERENCE.
37 ! ----------
38
39 ! SEE RADIATION'S PART OF THE ECMWF RESEARCH DEPARTMENT
40 ! DOCUMENTATION, AND FOUQUART AND BONNEL (1980)
41
42 ! AUTHOR.
43 ! -------
44 ! JEAN-JACQUES MORCRETTE *ECMWF*
45
46 ! MODIFICATIONS.
47 ! --------------
48 ! ORIGINAL : 89-07-14
49 ! 03-03-18 JJMorcrette security on normalized cloud cover
50 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
51 ! Y.Seity 06-09-09 : add modset from O.Thouron (MesoNH) under NOVLP tests
52
53 ! ------------------------------------------------------------------
54
55 USE PARKIND1 ,ONLY : JPIM ,JPRB
56 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
57
58 USE YOECLD , ONLY : REPSEC
59 !USE YOERAD , ONLY : NOVLP ,NSW
60 ! NSW mis dans .def MPL 20140211
61 USE YOERAD , ONLY : NOVLP
62 USE YOERDU , ONLY : REPSCQ
63 USE YOESW , ONLY : RPDH1 ,RPDU1 ,RPNH ,RPNU ,&
64 & RTDH2O ,RTDUMG ,RTH2O ,RTUMG
65 USE YOEOVLP , ONLY : RA1OVLP
66
67 IMPLICIT NONE
68
69 include "clesphys.h"
70 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
71 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
72 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
73 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
74 REAL(KIND=JPRB) ,INTENT(IN) :: PSCT
75 REAL(KIND=JPRB) ,INTENT(IN) :: PCARDI
76 REAL(KIND=JPRB) ,INTENT(IN) :: PCLDSW(KLON,KLEV)
77 REAL(KIND=JPRB) ,INTENT(IN) :: PPMB(KLON,KLEV+1)
78 REAL(KIND=JPRB) ,INTENT(IN) :: PPSOL(KLON)
79 REAL(KIND=JPRB) ,INTENT(IN) :: PRMU0(KLON)
80 REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV)
81 REAL(KIND=JPRB) ,INTENT(IN) :: PWV(KLON,KLEV)
82 REAL(KIND=JPRB) ,INTENT(OUT) :: PAKI(KLON,2,NSW)
83 REAL(KIND=JPRB) ,INTENT(INOUT) :: PCLD(KLON,KLEV)
84 REAL(KIND=JPRB) ,INTENT(OUT) :: PCLEAR(KLON)
85 REAL(KIND=JPRB) ,INTENT(OUT) :: PDSIG(KLON,KLEV)
86 REAL(KIND=JPRB) ,INTENT(OUT) :: PFACT(KLON)
87 REAL(KIND=JPRB) ,INTENT(OUT) :: PRMU(KLON)
88 REAL(KIND=JPRB) ,INTENT(OUT) :: PSEC(KLON)
89 REAL(KIND=JPRB) ,INTENT(OUT) :: PUD(KLON,5,KLEV+1)
90 ! ------------------------------------------------------------------
91
92 !* 0.1 ARGUMENTS
93 ! ---------
94
95 INTEGER(KIND=JPIM) :: INUIR
96
97 ! ------------------------------------------------------------------
98
99 ! ------------
100
101 INTEGER(KIND=JPIM) :: IIND(2)
102 240 REAL(KIND=JPRB) :: ZC1J(KLON,KLEV+1),ZCLEAR(KLON),ZCLOUD(KLON)&
103 240 & , ZN175(KLON), ZN190(KLON), ZO175(KLON)&
104 240 & , ZO190(KLON), ZSIGN(KLON)&
105 240 & , ZR(KLON,2) , ZSIGO(KLON), ZUD(KLON,2)
106
107 INTEGER(KIND=JPIM) :: JA, JK, JKL, JKLP1, JKP1, JL, JNU
108
109 REAL(KIND=JPRB) :: ZDSCO2, ZDSH2O, ZFPPW, ZRTH, ZRTU, ZWH2O, ZALPHA1
110 REAL(KIND=JPRB) :: ZHOOK_HANDLE
111
112 INTERFACE
113 SUBROUTINE SWTT1 ( KIDIA,KFDIA,KLON,KNU,KABS,KIND, PU, PTR )
114 USE PARKIND1 ,ONLY : JPIM ,JPRB
115 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
116 INTEGER(KIND=JPIM),INTENT(IN) :: KABS
117 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
118 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
119 INTEGER(KIND=JPIM),INTENT(IN) :: KNU
120 INTEGER(KIND=JPIM),INTENT(IN) :: KIND(KABS)
121 REAL(KIND=JPRB) ,INTENT(IN) :: PU(KLON,KABS)
122 REAL(KIND=JPRB) ,INTENT(OUT) :: PTR(KLON,KABS)
123 END SUBROUTINE SWTT1
124 END INTERFACE
125
126 ! ------------------------------------------------------------------
127
128 !* 1. COMPUTES AMOUNTS OF ABSORBERS
129 ! -----------------------------
130
131 120 REPSEC=1.E-12_JPRB !!!!! A REVOIR (MPL)
132
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('SWU',0,ZHOOK_HANDLE)
133 120 IIND(1)=1
134 120 IIND(2)=2
135
136 !* 1.1 INITIALIZES QUANTITIES
137 ! ----------------------
138
139
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL = KIDIA,KFDIA
140 119280 PUD(JL,1,KLEV+1)=0.0_JPRB
141 119280 PUD(JL,2,KLEV+1)=0.0_JPRB
142 119280 PUD(JL,3,KLEV+1)=0.0_JPRB
143 119280 PUD(JL,4,KLEV+1)=0.0_JPRB
144 119280 PUD(JL,5,KLEV+1)=0.0_JPRB
145 119280 PFACT(JL)= PRMU0(JL) * PSCT
146 !- already accounted for in RADINT
147 ! PRMU(JL)=SQRT(1224.* PRMU0(JL) * PRMU0(JL) + 1.) / 35.
148 119280 PRMU(JL)=PRMU0(JL)
149 119280 PSEC(JL)=1.0_JPRB/PRMU(JL)
150 119400 ZC1J(JL,KLEV+1)=0.0_JPRB
151 ENDDO
152
153 !* 1.3 AMOUNTS OF ABSORBERS
154 ! --------------------
155
156
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL= KIDIA,KFDIA
157 119280 ZUD(JL,1) = 0.0_JPRB
158 119280 ZUD(JL,2) = 0.0_JPRB
159 119280 ZO175(JL) = PPSOL(JL)** RPDU1
160 119280 ZO190(JL) = PPSOL(JL)** RPDH1
161 119280 ZSIGO(JL) = PPSOL(JL)
162 119280 ZCLEAR(JL)=1.0_JPRB
163 119400 ZCLOUD(JL)=0.0_JPRB
164 ENDDO
165
166
2/2
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
 4800 DO JK = 1 , KLEV
167 4680 JKP1 = JK + 1
168 4680 JKL = KLEV+1 - JK
169 JKLP1 = JKL+1
170 4680 ZALPHA1=RA1OVLP(KLEV+1-JK)
171
172
2/2
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 4651920 times.
 4656720 DO JL = KIDIA,KFDIA
173 4651920 ZRTH=(RTH2O/PTAVE(JL,JK))**RTDH2O
174 4651920 ZRTU=(RTUMG/PTAVE(JL,JK))**RTDUMG
175 4651920 ZWH2O = MAX (PWV(JL,JKL) , REPSCQ )
176
177 4651920 ZSIGN(JL) = 100._JPRB * PPMB(JL,JKP1)
178 4651920 PDSIG(JL,JK) = (ZSIGO(JL) - ZSIGN(JL))/PPSOL(JL)
179 4651920 ZN175(JL) = ZSIGN(JL) ** RPDU1
180 4651920 ZN190(JL) = ZSIGN(JL) ** RPDH1
181 4651920 ZDSCO2 = ZO175(JL) - ZN175(JL)
182 4651920 ZDSH2O = ZO190(JL) - ZN190(JL)
183 4651920 PUD(JL,1,JK) = RPNH * ZDSH2O * ZWH2O * ZRTH
184 4651920 PUD(JL,2,JK) = RPNU * ZDSCO2 * PCARDI * ZRTU
185
186 4651920 ZFPPW=1.6078_JPRB*ZWH2O/(1.0_JPRB+0.608_JPRB*ZWH2O)
187 4651920 PUD(JL,4,JK)=PUD(JL,1,JK)*ZFPPW
188 4651920 PUD(JL,5,JK)=PUD(JL,1,JK)*(1.0_JPRB-ZFPPW)
189 4651920 ZUD(JL,1) = ZUD(JL,1) + PUD(JL,1,JK)
190 4651920 ZUD(JL,2) = ZUD(JL,2) + PUD(JL,2,JK)
191 4651920 ZSIGO(JL) = ZSIGN(JL)
192 4651920 ZO175(JL) = ZN175(JL)
193 4651920 ZO190(JL) = ZN190(JL)
194 !print *,'SWU: RTH2O RTDH2O RTUMG RTDUMG',RTH2O,RTDH2O,RTUMG,RTDUMG
195 !print *,'SWU: RPNH ZDSH2O ZWH2O ZRTH',RPNH,ZDSH2O,ZWH2O,ZRTH
196 !print *,'SWU: RPNU ZDSCO2 PCARDI ZRTU',RPNU,ZDSCO2,PCARDI,ZRTU
197
198 !++MODIFCODE
199
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 4651920 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
 4656600 IF ((NOVLP == 1).OR.(NOVLP==6).OR.(NOVLP==8)) THEN
200 ZCLEAR(JL)=ZCLEAR(JL)&
201 & *(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL)))&
202 4651920 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC))
203 4651920 ZC1J(JL,JKL)= 1.0_JPRB - ZCLEAR(JL)
204 4651920 ZCLOUD(JL) = PCLDSW(JL,JKL)
205 ✗ ELSEIF ((NOVLP == 2).OR.(NOVLP==7)) THEN
206 ✗ ZCLOUD(JL) = MAX(PCLDSW(JL,JKL),ZCLOUD(JL))
207 ✗ ZC1J(JL,JKL) = ZCLOUD(JL)
208 ✗ ELSEIF ((NOVLP == 3).OR.(NOVLP==5)) THEN
209 ✗ ZCLEAR(JL) = ZCLEAR(JL)*(1.0_JPRB-PCLDSW(JL,JKL))
210 ✗ ZCLOUD(JL) = 1.0_JPRB - ZCLEAR(JL)
211 ✗ ZC1J(JL,JKL) = ZCLOUD(JL)
212 ✗ ELSEIF (NOVLP == 4) THEN
213 !** Hogan & Illingworth (2001)
214 ZCLEAR(JL)=ZCLEAR(JL)*( &
215 & ZALPHA1*(1.0_JPRB-MAX(PCLDSW(JL,JKL),ZCLOUD(JL))) &
216 & /(1.0_JPRB-MIN(ZCLOUD(JL),1.0_JPRB-REPSEC)) &
217 ✗ & +(1.0_JPRB-ZALPHA1)*(1.0_JPRB-PCLDSW(JL,JKL)) )
218 ✗ ZC1J(JL,JKL) = 1.0_JPRB - ZCLEAR(JL)
219 ✗ ZCLOUD(JL) = PCLDSW(JL,JKL)
220 ENDIF
221 !--MODIFCODE
222 ENDDO
223 ENDDO
224
225
2/2
✓ Branch 0 taken 119280 times.
✓ Branch 1 taken 120 times.
 119400 DO JL=KIDIA,KFDIA
226 119400 PCLEAR(JL)=1.0_JPRB-ZC1J(JL,1)
227 ENDDO
228
2/2
✓ Branch 0 taken 4680 times.
✓ Branch 1 taken 120 times.
 4800 DO JK=1,KLEV
229
2/2
✓ Branch 0 taken 4651920 times.
✓ Branch 1 taken 4680 times.
 4656720 DO JL=KIDIA,KFDIA
230
2/2
✓ Branch 0 taken 4539600 times.
✓ Branch 1 taken 112320 times.
 4651920 IF (PCLEAR(JL) < 1.0_JPRB) THEN
231 4539600 PCLD(JL,JK)=PCLDSW(JL,JK)/(1.0_JPRB-PCLEAR(JL))
232 ELSE
233 112320 PCLD(JL,JK)=0.0_JPRB
234 ENDIF
235 4656600 PCLD(JL,JK)=MAX(0.0_JPRB,MIN(1.0_JPRB,PCLD(JL,JK)))
236 ENDDO
237 ENDDO
238
239 !* 1.4 COMPUTES CLEAR-SKY GREY ABSORPTION COEFFICIENTS
240 ! -----------------------------------------------
241
242
2/2
✓ Branch 0 taken 240 times.
✓ Branch 1 taken 120 times.
 360 DO JA = 1,2
243
2/2
✓ Branch 0 taken 238560 times.
✓ Branch 1 taken 240 times.
 238920 DO JL = KIDIA,KFDIA
244 238800 ZUD(JL,JA) = ZUD(JL,JA) * PSEC(JL)
245 ENDDO
246 ENDDO
247
248
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (NSW <= 4) THEN
249 INUIR=2
250
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 ELSEIF (NSW == 6) THEN
251 INUIR=4
252 ENDIF
253
254
2/2
✓ Branch 0 taken 360 times.
✓ Branch 1 taken 120 times.
 480 DO JNU= INUIR,NSW
255
256 CALL SWTT1 ( KIDIA,KFDIA,KLON, JNU, 2, IIND,&
257 & ZUD,&
258 360 & ZR )
259
260
2/2
✓ Branch 0 taken 720 times.
✓ Branch 1 taken 360 times.
 1200 DO JA = 1,2
261
2/2
✓ Branch 0 taken 715680 times.
✓ Branch 1 taken 720 times.
 716760 DO JL = KIDIA,KFDIA
262 716400 PAKI(JL,JA,JNU) = -LOG( ZR(JL,JA) ) / ZUD(JL,JA)
263 ENDDO
264 ENDDO
265 ENDDO
266
267 ! ------------------------------------------------------------------
268
269
1/2
✓ Branch 0 taken 120 times.
✗ Branch 1 not taken.
 120 IF (LHOOK) CALL DR_HOOK('SWU',1,ZHOOK_HANDLE)
270 120 END SUBROUTINE SWU
271
272