GCC Code Coverage Report


Directory: ./
File: rad/lwb.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 90 0.0%
Branches: 0 58 0.0%

Line Branch Exec Source
1 SUBROUTINE LWB &
2 & ( KIDIA, KFDIA, KLON , KLEV , KMODE,&
3 & PDT0 , PTAVE, PTL,&
4 & PB , PBINT, PBSUR , PBTOP , PDBSL,&
5 & PGA , PGB , PGASUR, PGBSUR, PGATOP, PGBTOP &
6 & )
7
8 !**** *LWB* - COMPUTES BLACK-BODY FUNCTIONS FOR LONGWAVE CALCULATIONS
9
10 ! PURPOSE.
11 ! --------
12 ! COMPUTES PLANCK FUNCTIONS
13
14 !** INTERFACE.
15 ! ----------
16
17 ! EXPLICIT ARGUMENTS :
18 ! --------------------
19 ! ==== INPUTS ===
20 ! PDT0 : (KLON) ; SURFACE TEMPERATURE DISCONTINUITY
21 ! PTAVE : (KLON,KLEV) ; TEMPERATURE
22 ! PTL : (KLON,KLEV+1) ; HALF LEVEL TEMPERATURE
23 ! ==== OUTPUTS ===
24 ! PB : (KLON,NSIL,KLEV+1); SPECTRAL HALF LEVEL PLANCK FUNCTION
25 ! PBINT : (KLON,KLEV+1) ; HALF LEVEL PLANCK FUNCTION
26 ! PBSUR : (KLON,NSIL) ; SURFACE SPECTRAL PLANCK FUNCTION
27 ! PBTOP : (KLON,NSIL) ; TOP SPECTRAL PLANCK FUNCTION
28 ! PDBSL : (KLON,NSIL,KLEV*2); SUB-LAYER PLANCK FUNCTION GRADIENT
29 ! PGA : (KLON,8,2,KLEV) ; dB/dT-weighted LAYER PADE APPROXIMANTS
30 ! PGB : (KLON,8,2,KLEV) ; dB/dT-weighted LAYER PADE APPROXIMANTS
31 ! PGASUR, PGBSUR (KLON,8,2) ; SURFACE PADE APPROXIMANTS
32 ! PGATOP, PGBTOP (KLON,8,2) ; T.O.A. PADE APPROXIMANTS
33
34 ! IMPLICIT ARGUMENTS : NONE
35 ! --------------------
36
37 ! METHOD.
38 ! -------
39
40 ! 1. COMPUTES THE PLANCK FUNCTION ON ALL LEVELS AND HALF LEVELS
41 ! FROM A POLYNOMIAL DEVELOPMENT OF PLANCK FUNCTION
42
43 ! EXTERNALS.
44 ! ----------
45
46 ! NONE
47
48 ! REFERENCE.
49 ! ----------
50
51 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
52 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS "
53
54 ! AUTHOR.
55 ! -------
56 ! JEAN-JACQUES MORCRETTE *ECMWF*
57
58 ! MODIFICATIONS.
59 ! --------------
60 ! ORIGINAL : 89-07-14
61 ! MODIFIED : 99-06-14 D.SALMOND Optimisation
62 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
63
64 !-----------------------------------------------------------------------
65
66 USE PARKIND1 ,ONLY : JPIM ,JPRB
67 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
68
69 USE YOELW , ONLY : MXIXT ,NSIL ,NIPD ,PDGA ,&
70 & PDGB ,TINTP ,TSTAND ,TSTP ,XP
71
72 IMPLICIT NONE
73
74 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
75 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
76 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
77 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
78 INTEGER(KIND=JPIM),INTENT(IN) :: KMODE
79 REAL(KIND=JPRB) ,INTENT(IN) :: PDT0(KLON)
80 REAL(KIND=JPRB) ,INTENT(IN) :: PTAVE(KLON,KLEV)
81 REAL(KIND=JPRB) ,INTENT(IN) :: PTL(KLON,KLEV+1)
82 REAL(KIND=JPRB) ,INTENT(OUT) :: PB(KLON,NSIL,KLEV+1)
83 REAL(KIND=JPRB) ,INTENT(OUT) :: PBINT(KLON,KLEV+1)
84 REAL(KIND=JPRB) ,INTENT(OUT) :: PBSUR(KLON,NSIL)
85 REAL(KIND=JPRB) ,INTENT(OUT) :: PBTOP(KLON,NSIL)
86 REAL(KIND=JPRB) ,INTENT(OUT) :: PDBSL(KLON,NSIL,KLEV*2)
87 REAL(KIND=JPRB) ,INTENT(OUT) :: PGA(KLON,NIPD,2,KLEV)
88 REAL(KIND=JPRB) ,INTENT(OUT) :: PGB(KLON,NIPD,2,KLEV)
89 REAL(KIND=JPRB) ,INTENT(OUT) :: PGASUR(KLON,NIPD,2)
90 REAL(KIND=JPRB) ,INTENT(OUT) :: PGBSUR(KLON,NIPD,2)
91 REAL(KIND=JPRB) ,INTENT(OUT) :: PGATOP(KLON,NIPD,2)
92 REAL(KIND=JPRB) ,INTENT(OUT) :: PGBTOP(KLON,NIPD,2)
93 !-----------------------------------------------------------------------
94
95 !* 0.1 ARGUMENTS
96 ! ---------
97
98 !-------------------------------------------------------------------------
99
100 ! ------------
101 INTEGER(KIND=JPIM) :: INDB(KLON) , INDS(KLON)
102 REAL(KIND=JPRB) :: ZBLAY(KLON,KLEV), ZBLEV(KLON,KLEV+1)&
103 & , ZRES(KLON) , ZRES2(KLON)&
104 & , ZTI(KLON) , ZTI2(KLON)
105
106 INTEGER(KIND=JPIM) :: ILEV2, INDSU, INDT, INDTO, INDTP, INUE, INUS,&
107 & IXTOX, IXTX, JF, JG, JK, JK1, JK2, JL, JNU
108
109 REAL(KIND=JPRB) :: ZDST1, ZDSTO1, ZDSTOX, ZDSTX
110 REAL(KIND=JPRB) :: ZHOOK_HANDLE
111
112 ! ------------------------------------------------------------------
113
114 !* 1.0 PLANCK FUNCTIONS AND GRADIENTS
115 ! ------------------------------
116
117 print *,'dans LWB'
118 IF (LHOOK) CALL DR_HOOK('LWB',0,ZHOOK_HANDLE)
119 ILEV2=2*KLEV
120 INUS=1
121 INUE=NSIL
122 IF (KMODE == 2) THEN
123 INUS=3
124 INUE=4
125 ENDIF
126
127 DO JK = 1 , KLEV+1
128 DO JL = KIDIA,KFDIA
129 PBINT(JL,JK) = 0.0_JPRB
130 ENDDO
131 ENDDO
132
133 DO JNU=1,NSIL
134 DO JL=KIDIA,KFDIA
135 PBSUR(JL,JNU)=0.0_JPRB
136 PBTOP(JL,JNU)=0.0_JPRB
137 ENDDO
138 DO JK=1,KLEV
139 DO JL=KIDIA,KFDIA
140 PB(JL,JNU,JK)=0.0_JPRB
141 ENDDO
142 ENDDO
143 DO JK=1,ILEV2
144 DO JL=KIDIA,KFDIA
145 PDBSL(JL,JNU,JK)=0.0_JPRB
146 ENDDO
147 ENDDO
148 ENDDO
149
150 DO JNU=INUS,INUE
151
152 !* 1.1 LEVELS FROM SURFACE TO KLEV
153 ! ----------------------------
154
155 DO JK = 1 , KLEV
156 DO JL = KIDIA,KFDIA
157 ZTI(JL)=(PTL(JL,JK)-TSTAND)/TSTAND
158 ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU)&
159 & +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU)&
160 & )))))
161 PBINT(JL,JK)=PBINT(JL,JK)+ZRES(JL)
162 PB(JL,JNU,JK)= ZRES(JL)
163 ZBLEV(JL,JK) = ZRES(JL)
164
165 ZTI2(JL)=(PTAVE(JL,JK)-TSTAND)/TSTAND
166 ZRES2(JL)=XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU)&
167 & +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,&
168 & JNU)&
169 & )))))
170 ZBLAY(JL,JK) = ZRES2(JL)
171 ENDDO
172 ENDDO
173
174 !* 1.2 TOP OF THE ATMOSPHERE AND SURFACE
175 ! ---------------------------------
176
177 DO JL = KIDIA,KFDIA
178 ZTI(JL)=(PTL(JL,KLEV+1)-TSTAND)/TSTAND
179 ZTI2(JL) = (PTL(JL,1) + PDT0(JL) - TSTAND) / TSTAND
180 ZRES(JL) = XP(1,JNU)+ZTI(JL)*(XP(2,JNU)+ZTI(JL)*(XP(3,JNU)&
181 & +ZTI(JL)*(XP(4,JNU)+ZTI(JL)*(XP(5,JNU)+ZTI(JL)*(XP(6,JNU)&
182 & )))))
183 ZRES2(JL) = XP(1,JNU)+ZTI2(JL)*(XP(2,JNU)+ZTI2(JL)*(XP(3,JNU)&
184 & +ZTI2(JL)*(XP(4,JNU)+ZTI2(JL)*(XP(5,JNU)+ZTI2(JL)*(XP(6,JNU)&
185 & )))))
186 PBINT(JL,KLEV+1) = PBINT(JL,KLEV+1)+ZRES(JL)
187 PB(JL,JNU,KLEV+1)= ZRES(JL)
188 ZBLEV(JL,KLEV+1) = ZRES(JL)
189 PBTOP(JL,JNU) = ZRES(JL)
190 PBSUR(JL,JNU) = ZRES2(JL)
191 ENDDO
192
193 !* 1.3 GRADIENTS IN SUB-LAYERS
194 ! -----------------------
195
196 DO JK = 1 , KLEV
197 JK2 = 2 * JK
198 JK1 = JK2 - 1
199 DO JL = KIDIA,KFDIA
200 PDBSL(JL,JNU,JK1) = ZBLAY(JL,JK ) - ZBLEV(JL,JK)
201 PDBSL(JL,JNU,JK2) = ZBLEV(JL,JK+1) - ZBLAY(JL,JK)
202 ENDDO
203 ENDDO
204
205 ENDDO
206
207 !* 2.0 CHOOSE THE RELEVANT SETS OF PADE APPROXIMANTS
208 ! ---------------------------------------------
209
210 DO JL=KIDIA,KFDIA
211 ZDSTO1 = (PTL(JL,KLEV+1)-TINTP(1)) / TSTP
212 IXTOX = MAX( 1, MIN( MXIXT, INT( ZDSTO1 + 1.0_JPRB ) ) )
213 ZDSTOX = (PTL(JL,KLEV+1)-TINTP(IXTOX))/TSTP
214 IF (ZDSTOX < 0.5_JPRB) THEN
215 INDTO=IXTOX
216 ELSE
217 INDTO=IXTOX+1
218 ENDIF
219 INDB(JL)=INDTO
220 ZDST1 = (PTL(JL,1)-TINTP(1)) / TSTP
221 IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1.0_JPRB ) ) )
222 ZDSTX = (PTL(JL,1)-TINTP(IXTX))/TSTP
223 IF (ZDSTX < 0.5_JPRB) THEN
224 INDT=IXTX
225 ELSE
226 INDT=IXTX+1
227 ENDIF
228 INDS(JL)=INDT
229 ENDDO
230
231 DO JF=1,2
232 DO JG=1,NIPD
233 DO JL=KIDIA,KFDIA
234 INDSU=INDS(JL)
235 PGASUR(JL,JG,JF)=PDGA(INDSU,2*JG-1,JF)
236 PGBSUR(JL,JG,JF)=PDGB(INDSU,2*JG-1,JF)
237 INDTP=INDB(JL)
238 PGATOP(JL,JG,JF)=PDGA(INDTP,2*JG-1,JF)
239 PGBTOP(JL,JG,JF)=PDGB(INDTP,2*JG-1,JF)
240 ENDDO
241 ENDDO
242 ENDDO
243
244 DO JK=1,KLEV
245 DO JL=KIDIA,KFDIA
246 ZDST1 = (PTAVE(JL,JK)-TINTP(1)) / TSTP
247 IXTX = MAX( 1, MIN( MXIXT, INT( ZDST1 + 1.0_JPRB ) ) )
248 ZDSTX = (PTAVE(JL,JK)-TINTP(IXTX))/TSTP
249 IF (ZDSTX < 0.5_JPRB) THEN
250 INDT=IXTX
251 ELSE
252 INDT=IXTX+1
253 ENDIF
254 INDB(JL)=INDT
255 ENDDO
256
257 DO JF=1,2
258 DO JL=KIDIA,KFDIA
259 INDT=INDB(JL)
260 DO JG=1,NIPD
261 PGA(JL,JG,JF,JK)=PDGA(INDT,2*JG,JF)
262 PGB(JL,JG,JF,JK)=PDGB(INDT,2*JG,JF)
263 ENDDO
264 ENDDO
265 ENDDO
266
267 ENDDO
268
269 ! ------------------------------------------------------------------
270
271 IF (LHOOK) CALL DR_HOOK('LWB',1,ZHOOK_HANDLE)
272 END SUBROUTINE LWB
273