GCC Code Coverage Report


Directory: ./
File: rad/lwv.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 23 0.0%
Branches: 0 12 0.0%

Line Branch Exec Source
1 SUBROUTINE LWV &
2 & ( KIDIA, KFDIA, KLON , KLEV , KUAER , KTRAER,&
3 & PABCU, PB , PBINT, PBSUR, PBTOP , PDBSL,&
4 & PEMIS, PEMIW,&
5 & PGA , PGB , PGASUR,PGBSUR,PGATOP, PGBTOP,&
6 & PCNTRB,PFLUC &
7 & )
8
9 !**** *LWV* - LONGWAVE RADIATION, VERTICAL INTEGRATION
10
11 ! PURPOSE.
12 ! --------
13 ! CARRIES OUT THE VERTICAL INTEGRATION TO GIVE LONGWAVE
14 ! FLUXES OR RADIANCES
15
16 !** INTERFACE.
17 ! ----------
18
19 ! EXPLICIT ARGUMENTS :
20 ! --------------------
21 ! ==== INPUTS ===
22 ! PABCU : (KLON,NUA,3*KLEV+1); ABSORBER AMOUNTS
23 ! PB : (KLON,NSIL,KLEV+1); SPECTRAL HALF-LEVEL PLANCK FUNCTIONS
24 ! PBINT : (KLON,KLEV+1) ; HALF-LEVEL PLANCK FUNCTIONS
25 ! PBSUR : (KLON,NSIL) ; SURFACE SPECTRAL PLANCK FUNCTION
26 ! PBTOP : (KLON,NSIL) ; T.O.A. SPECTRAL PLANCK FUNCTION
27 ! PDBSL : (KLON,KLEV*2) ; SUB-LAYER PLANCK FUNCTION GRADIENT
28 ! PEMIS : (KLON) ; SURFACE LW EMISSIVITY
29 ! PEMIW : (KLON) ; SURFACE LW WINDOW EMISSIVITY
30 ! PGA, PGB ; PADE APPROXIMANTS
31 ! PGASUR, PGBSUR ; SURFACE PADE APPROXIMANTS
32 ! PGATOP, PGBTOP ; T.O.A. PADE APPROXIMANTS
33 ! ==== OUTPUTS ===
34 ! PCNTRB : (KLON,KLEV+1,KLEV+1); CLEAR-SKY ENERGY EXCHANGE MATRIX
35 ! PFLUC(KLON,2,KLEV) ; RADIATIVE FLUXES CLEAR-SKY
36
37 ! IMPLICIT ARGUMENTS : NONE
38 ! --------------------
39
40 ! METHOD.
41 ! -------
42
43 ! 1. PERFORMS THE VERTICAL INTEGRATION DISTINGUISHING BETWEEN
44 ! CONTRIBUTIONS BY - THE NEARBY LAYERS
45 ! - THE DISTANT LAYERS
46 ! - THE BOUNDARY TERMS
47 ! 2. COMPUTES THE CLEAR-SKY DOWNWARD AND UPWARD EMISSIVITIES.
48
49 ! EXTERNALS.
50 ! ----------
51
52 ! *LWVN*, *LWVD*, *LWVB*
53
54 ! REFERENCE.
55 ! ----------
56
57 ! SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
58 ! ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE IFS
59
60 ! AUTHOR.
61 ! -------
62 ! JEAN-JACQUES MORCRETTE *ECMWF*
63
64 ! MODIFICATIONS.
65 ! --------------
66 ! ORIGINAL : 89-07-14
67 ! JJ Morcrette 96-06-07 Surface LW window emissivity
68 ! M.Hamrud 01-Oct-2003 CY28 Cleaning
69 !-----------------------------------------------------------------------
70
71 USE PARKIND1 ,ONLY : JPIM ,JPRB
72 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
73
74 USE YOELW , ONLY : NSIL ,NIPD ,NUA
75
76 IMPLICIT NONE
77
78 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
79 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
80 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
81 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
82 INTEGER(KIND=JPIM),INTENT(IN) :: KUAER
83 INTEGER(KIND=JPIM),INTENT(IN) :: KTRAER
84 REAL(KIND=JPRB) ,INTENT(IN) :: PABCU(KLON,NUA,3*KLEV+1)
85 REAL(KIND=JPRB) ,INTENT(IN) :: PB(KLON,NSIL,KLEV+1)
86 REAL(KIND=JPRB) ,INTENT(IN) :: PBINT(KLON,KLEV+1)
87 REAL(KIND=JPRB) ,INTENT(IN) :: PBSUR(KLON,NSIL)
88 REAL(KIND=JPRB) ,INTENT(IN) :: PBTOP(KLON,NSIL)
89 REAL(KIND=JPRB) ,INTENT(IN) :: PDBSL(KLON,NSIL,KLEV*2)
90 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON)
91 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON)
92 REAL(KIND=JPRB) ,INTENT(IN) :: PGA(KLON,NIPD,2,KLEV)
93 REAL(KIND=JPRB) ,INTENT(IN) :: PGB(KLON,NIPD,2,KLEV)
94 REAL(KIND=JPRB) ,INTENT(IN) :: PGASUR(KLON,NIPD,2)
95 REAL(KIND=JPRB) ,INTENT(IN) :: PGBSUR(KLON,NIPD,2)
96 REAL(KIND=JPRB) ,INTENT(IN) :: PGATOP(KLON,NIPD,2)
97 REAL(KIND=JPRB) ,INTENT(IN) :: PGBTOP(KLON,NIPD,2)
98 REAL(KIND=JPRB) ,INTENT(OUT) :: PCNTRB(KLON,KLEV+1,KLEV+1)
99 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1)
100 !-----------------------------------------------------------------------
101
102 !* 0.1 ARGUMENTS
103 ! ---------
104
105 !-----------------------------------------------------------------------
106
107 ! ------------
108
109 REAL(KIND=JPRB) :: ZADJD(KLON,KLEV+1) , ZADJU(KLON,KLEV+1)&
110 & , ZDBDT(KLON,NSIL,KLEV)&
111 & , ZDISD(KLON,KLEV+1) , ZDISU(KLON,KLEV+1)&
112 & , ZDWFSU(KLON,NSIL)
113
114 INTEGER(KIND=JPIM) :: JA, JK, JL
115 REAL(KIND=JPRB) :: ZHOOK_HANDLE
116
117 INTERFACE
118 SUBROUTINE LWVB&
119 & ( KIDIA , KFDIA , KLON , KLEV , KUAER,&
120 & PABCU , PADJD , PADJU,&
121 & PB , PBINT , PBSUR , PBTOP,&
122 & PDISD , PDISU , PEMIS , PEMIW,&
123 & PGASUR, PGBSUR, PGATOP, PGBTOP,&
124 & PDWFSU,PFLUC&
125 & )
126 USE PARKIND1 ,ONLY : JPIM ,JPRB
127 USE YOELW , ONLY : NSIL ,NIPD ,NTRA ,NUA ,NG1P1
128 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
129 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
130 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
131 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
132 INTEGER(KIND=JPIM),INTENT(IN) :: KUAER
133 REAL(KIND=JPRB) ,INTENT(IN) :: PABCU(KLON,NUA,3*KLEV+1)
134 REAL(KIND=JPRB) ,INTENT(IN) :: PADJD(KLON,KLEV+1)
135 REAL(KIND=JPRB) ,INTENT(IN) :: PADJU(KLON,KLEV+1)
136 REAL(KIND=JPRB) ,INTENT(IN) :: PB(KLON,NSIL,KLEV+1)
137 REAL(KIND=JPRB) ,INTENT(IN) :: PBINT(KLON,KLEV+1)
138 REAL(KIND=JPRB) ,INTENT(IN) :: PBSUR(KLON,NSIL)
139 REAL(KIND=JPRB) ,INTENT(IN) :: PBTOP(KLON,NSIL)
140 REAL(KIND=JPRB) ,INTENT(IN) :: PDISD(KLON,KLEV+1)
141 REAL(KIND=JPRB) ,INTENT(IN) :: PDISU(KLON,KLEV+1)
142 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIS(KLON)
143 REAL(KIND=JPRB) ,INTENT(IN) :: PEMIW(KLON)
144 REAL(KIND=JPRB) ,INTENT(IN) :: PGASUR(KLON,NIPD,2)
145 REAL(KIND=JPRB) ,INTENT(IN) :: PGBSUR(KLON,NIPD,2)
146 REAL(KIND=JPRB) ,INTENT(IN) :: PGATOP(KLON,NIPD,2)
147 REAL(KIND=JPRB) ,INTENT(IN) :: PGBTOP(KLON,NIPD,2)
148 REAL(KIND=JPRB) ,INTENT(INOUT) :: PDWFSU(KLON,NSIL)
149 REAL(KIND=JPRB) ,INTENT(OUT) :: PFLUC(KLON,2,KLEV+1)
150 END SUBROUTINE LWVB
151 END INTERFACE
152 INTERFACE
153 SUBROUTINE LWVD&
154 & ( KIDIA, KFDIA, KLON , KLEV , KTRAER,&
155 & PABCU, PDBDT,&
156 & PGA , PGB,&
157 & PCNTRB, PDISD, PDISU, PDWFSU&
158 & )
159 USE PARKIND1 ,ONLY : JPIM ,JPRB
160 USE YOELW , ONLY : NSIL ,NIPD ,NTRA ,NUA ,NG1P1
161 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
162 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
163 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
164 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
165 INTEGER(KIND=JPIM),INTENT(IN) :: KTRAER
166 REAL(KIND=JPRB) ,INTENT(IN) :: PABCU(KLON,NUA,3*KLEV+1)
167 REAL(KIND=JPRB) ,INTENT(IN) :: PDBDT(KLON,NSIL,KLEV)
168 REAL(KIND=JPRB) ,INTENT(IN) :: PGA(KLON,NIPD,2,KLEV)
169 REAL(KIND=JPRB) ,INTENT(IN) :: PGB(KLON,NIPD,2,KLEV)
170 REAL(KIND=JPRB) ,INTENT(OUT) :: PCNTRB(KLON,KLEV+1,KLEV+1)
171 REAL(KIND=JPRB) ,INTENT(OUT) :: PDISD(KLON,KLEV+1)
172 REAL(KIND=JPRB) ,INTENT(OUT) :: PDISU(KLON,KLEV+1)
173 REAL(KIND=JPRB) ,INTENT(INOUT) :: PDWFSU(KLON,NSIL)
174 END SUBROUTINE LWVD
175 END INTERFACE
176 INTERFACE
177 SUBROUTINE LWVN&
178 & ( KIDIA, KFDIA, KLON , KLEV , KUAER,&
179 & PABCU, PDBSL, PGA , PGB,&
180 & PADJD, PADJU, PCNTRB, PDBDT, PDWFSU&
181 & )
182 USE PARKIND1 ,ONLY : JPIM ,JPRB
183 USE YOELW , ONLY : NSIL ,NIPD ,NTRA ,NUA ,&
184 & NG1 ,NG1P1 ,WG1
185 INTEGER(KIND=JPIM),INTENT(IN) :: KLON
186 INTEGER(KIND=JPIM),INTENT(IN) :: KLEV
187 INTEGER(KIND=JPIM),INTENT(IN) :: KIDIA
188 INTEGER(KIND=JPIM),INTENT(IN) :: KFDIA
189 INTEGER(KIND=JPIM),INTENT(IN) :: KUAER
190 REAL(KIND=JPRB) ,INTENT(IN) :: PABCU(KLON,NUA,3*KLEV+1)
191 REAL(KIND=JPRB) ,INTENT(IN) :: PDBSL(KLON,NSIL,KLEV*2)
192 REAL(KIND=JPRB) ,INTENT(IN) :: PGA(KLON,NIPD,2,KLEV)
193 REAL(KIND=JPRB) ,INTENT(IN) :: PGB(KLON,NIPD,2,KLEV)
194 REAL(KIND=JPRB) ,INTENT(OUT) :: PADJD(KLON,KLEV+1)
195 REAL(KIND=JPRB) ,INTENT(OUT) :: PADJU(KLON,KLEV+1)
196 REAL(KIND=JPRB) ,INTENT(OUT) :: PCNTRB(KLON,KLEV+1,KLEV+1)
197 REAL(KIND=JPRB) ,INTENT(OUT) :: PDBDT(KLON,NSIL,KLEV)
198 REAL(KIND=JPRB) ,INTENT(INOUT) :: PDWFSU(KLON,NSIL)
199 END SUBROUTINE LWVN
200 END INTERFACE
201
202 !-----------------------------------------------------------------------
203
204 !* 1. INITIALIZATION
205 ! --------------
206
207 !* 1.1 INITIALIZE LAYER CONTRIBUTIONS
208 ! ------------------------------
209
210 IF (LHOOK) CALL DR_HOOK('LWV',0,ZHOOK_HANDLE)
211 DO JK=1,KLEV+1
212 DO JL=KIDIA,KFDIA
213 ZADJD(JL,JK)=0.0_JPRB
214 ZADJU(JL,JK)=0.0_JPRB
215 ZDISD(JL,JK)=0.0_JPRB
216 ZDISU(JL,JK)=0.0_JPRB
217 ENDDO
218 ENDDO
219 DO JA=1,NSIL
220 DO JL=KIDIA,KFDIA
221 ZDWFSU(JL,JA)=0.0_JPRB
222 ENDDO
223 ENDDO
224
225 ! ------------------------------------------------------------------
226
227 !* 2. VERTICAL INTEGRATION
228 ! --------------------
229
230 ! ------------------------------------------------------------------
231
232 !* 2.1 CONTRIBUTION FROM ADJACENT LAYERS
233 ! ---------------------------------
234
235 CALL LWVN &
236 & ( KIDIA, KFDIA, KLON , KLEV , KUAER,&
237 & PABCU, PDBSL, PGA , PGB,&
238 & ZADJD, ZADJU, PCNTRB, ZDBDT, ZDWFSU &
239 & )
240
241 ! ------------------------------------------------------------------
242
243 !* 2.2 CONTRIBUTION FROM DISTANT LAYERS
244 ! ---------------------------------
245
246 CALL LWVD &
247 & ( KIDIA , KFDIA, KLON , KLEV , KTRAER,&
248 & PABCU , ZDBDT, PGA , PGB,&
249 & PCNTRB, ZDISD, ZDISU, ZDWFSU &
250 & )
251
252 ! ------------------------------------------------------------------
253
254 !* 2.3 EXCHANGE WITH THE BOUNDARIES
255 ! ----------------------------
256
257 CALL LWVB &
258 & ( KIDIA , KFDIA , KLON , KLEV , KUAER,&
259 & PABCU , ZADJD , ZADJU,&
260 & PB , PBINT , PBSUR , PBTOP,&
261 & ZDISD , ZDISU , PEMIS , PEMIW,&
262 & PGASUR, PGBSUR, PGATOP, PGBTOP,&
263 & ZDWFSU,PFLUC &
264 & )
265
266 !-----------------------------------------------------------------------
267
268 IF (LHOOK) CALL DR_HOOK('LWV',1,ZHOOK_HANDLE)
269 END SUBROUTINE LWV
270