GCC Code Coverage Report

Directory: ./
File: filtrez/filtreg.f
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 60 74 81.1%
Branches: 156 200 78.0%
Line Branch Exec Source
1 !
2 ! $Header$
3 !
4 127392 SUBROUTINE filtreg ( champ, nlat, nbniv, ifiltre,iaire,
5 & griscal ,iter)
6
7 USE filtreg_mod
8
9 IMPLICIT NONE
10 c=======================================================================
11 c
12 c Auteur: P. Le Van 07/10/97
13 c ------
14 c
15 c Objet: filtre matriciel longitudinal ,avec les matrices precalculees
16 c pour l'operateur Filtre .
17 c ------
18 c
19 c Arguments:
20 c ----------
21 c
22 c nblat nombre de latitudes a filtrer
23 c nbniv nombre de niveaux verticaux a filtrer
24 c champ(iip1,nblat,nbniv) en entree : champ a filtrer
25 c en sortie : champ filtre
26 c ifiltre +1 Transformee directe
27 c -1 Transformee inverse
28 c +2 Filtre directe
29 c -2 Filtre inverse
30 c
31 c iaire 1 si champ intensif
32 c 2 si champ extensif (pondere par les aires)
33 c
34 c iter 1 filtre simple
35 c
36 c=======================================================================
37 c
38 c
39 c Variable Intensive
40 c ifiltre = 1 filtre directe
41 c ifiltre =-1 filtre inverse
42 c
43 c Variable Extensive
44 c ifiltre = 2 filtre directe
45 c ifiltre =-2 filtre inverse
46 c
47 c
48 !-----------------------------------------------------------------------
49 ! INCLUDE 'dimensions.h'
50 !
51 ! dimensions.h contient les dimensions du modele
52 ! ndm est tel que iim=2**ndm
53 !-----------------------------------------------------------------------
54
55 INTEGER iim,jjm,llm,ndm
56
57 PARAMETER (iim= 32,jjm=32,llm=39,ndm=1)
58
59 !-----------------------------------------------------------------------
60 !
61 ! $Header$
62 !
63 !
64 ! ATTENTION!!!!: ce fichier include est compatible format fixe/format libre
65 ! veillez n'utiliser que des ! pour les commentaires
66 ! et bien positionner les & des lignes de continuation
67 ! (les placer en colonne 6 et en colonne 73)
68 !
69 !
70 !-----------------------------------------------------------------------
71 ! INCLUDE 'paramet.h'
72
73 INTEGER iip1,iip2,iip3,jjp1,llmp1,llmp2,llmm1
74 INTEGER kftd,ip1jm,ip1jmp1,ip1jmi1,ijp1llm
75 INTEGER ijmllm,mvar
76 INTEGER jcfil,jcfllm
77
78 PARAMETER( iip1= iim+1,iip2=iim+2,iip3=iim+3 &
79 & ,jjp1=jjm+1-1/jjm)
80 PARAMETER( llmp1 = llm+1, llmp2 = llm+2, llmm1 = llm-1 )
81 PARAMETER( kftd = iim/2 -ndm )
82 PARAMETER( ip1jm = iip1*jjm, ip1jmp1= iip1*jjp1 )
83 PARAMETER( ip1jmi1= ip1jm - iip1 )
84 PARAMETER( ijp1llm= ip1jmp1 * llm, ijmllm= ip1jm * llm )
85 PARAMETER( mvar= ip1jmp1*( 2*llm+1) + ijmllm )
86 PARAMETER( jcfil=jjm/2+5, jcfllm=jcfil*llm )
87
88 !-----------------------------------------------------------------------
89 !
90 ! $Id $
91 !
92 COMMON/coefils/jfiltnu,jfiltsu,jfiltnv,jfiltsv,sddu(iim),sddv(iim)&
93 & ,unsddu(iim),unsddv(iim),coefilu(iim,jjm),coefilv(iim,jjm), &
94 & modfrstu(jjm),modfrstv(jjm),eignfnu(iim,iim),eignfnv(iim,iim) &
95 & ,coefilu2(iim,jjm),coefilv2(iim,jjm)
96 !c
97 INTEGER jfiltnu ! index of the last lat line filtered in NH (U grid)
98 INTEGER jfiltsu ! index of the first lat line filtered in SH (U grid)
99 INTEGER jfiltnv ! index of the last lat line filtered in NH (V grid)
100 INTEGER jfiltsv ! index of the first lat line filtered in SH (V grid)
101 INTEGER modfrstu ! number of retained (ie: unfiltered) modes on U grid
102 INTEGER modfrstv ! number of retained (ie: unfiltered) modes on V grid
103 REAL sddu,sddv,unsddu,unsddv,coefilu,coefilv,eignfnu,eignfnv
104 REAL coefilu2,coefilv2
105
106 INTEGER nlat,nbniv,ifiltre,iter
107 INTEGER i,j,l,k
108 INTEGER iim2,immjm
109 INTEGER jdfil1,jdfil2,jffil1,jffil2,jdfil,jffil
110
111 REAL champ( iip1,nlat,nbniv)
112
113 42464 REAL eignq(iim,nlat,nbniv), sdd1(iim),sdd2(iim)
114 LOGICAL griscal
115 INTEGER hemisph, iaire
116
117 LOGICAL,SAVE :: first=.TRUE.
118
119 REAL, SAVE :: sdd12(iim,4)
120
121 INTEGER, PARAMETER :: type_sddu=1
122 INTEGER, PARAMETER :: type_sddv=2
123 INTEGER, PARAMETER :: type_unsddu=3
124 INTEGER, PARAMETER :: type_unsddv=4
125
126 INTEGER :: sdd1_type, sdd2_type
127
128
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 21231 times.
 21232 IF (first) THEN
129
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 32 times.
 33 sdd12(1:iim,type_sddu) = sddu(1:iim)
130
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 32 times.
 33 sdd12(1:iim,type_sddv) = sddv(1:iim)
131
2/2
✓ Branch 0 taken 1 times.
✓ Branch 1 taken 32 times.
 33 sdd12(1:iim,type_unsddu) = unsddu(1:iim)
132
2/2
✓ Branch 0 taken 32 times.
✓ Branch 1 taken 1 times.
 33 sdd12(1:iim,type_unsddv) = unsddv(1:iim)
133
134 1 first=.FALSE.
135 ENDIF
136
137
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21232 times.
 21232 IF(ifiltre.EQ.1.or.ifiltre.EQ.-1)
138 ✗ & STOP'Pas de transformee simple dans cette version'
139
140
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21232 times.
 21232 IF( iter.EQ. 2 ) THEN
141 ✗ PRINT *,' Pas d iteration du filtre dans cette version !'
142 ✗ & , ' Utiliser old_filtreg et repasser !'
143 ✗ STOP
144 ENDIF
145
146
3/4
✓ Branch 0 taken 561 times.
✓ Branch 1 taken 20671 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 561 times.
 21232 IF( ifiltre.EQ. -2 .AND..NOT.griscal ) THEN
147 ✗ PRINT *,' Cette routine ne calcule le filtre inverse que '
148 ✗ & , ' sur la grille des scalaires !'
149 ✗ STOP
150 ENDIF
151
152
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 21232 times.
 21232 IF( ifiltre.NE.2 .AND.ifiltre.NE. - 2 ) THEN
153 ✗ PRINT *,' Probleme dans filtreg car ifiltre NE 2 et NE -2'
154 ✗ & , ' corriger et repasser !'
155 ✗ STOP
156 ENDIF
157
158 iim2 = iim * iim
159 immjm = iim * jjm
160
161
2/2
✓ Branch 0 taken 16229 times.
✓ Branch 1 taken 5003 times.
 21232 IF( griscal ) THEN
162
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 16229 times.
 16229 IF( nlat. NE. jjp1 ) THEN
163 ✗ PRINT 1111
164 ✗ STOP
165 ELSE
166
167
2/2
✓ Branch 0 taken 7913 times.
✓ Branch 1 taken 8316 times.
 16229 IF( iaire.EQ.1 ) THEN
168 sdd1_type = type_sddv
169 sdd2_type = type_unsddv
170 ELSE
171 sdd1_type = type_unsddv
172 sdd2_type = type_sddv
173 ENDIF
174
175 c IF( iaire.EQ.1 ) THEN
176 c CALL SCOPY( iim, sddv, 1, sdd1, 1 )
177 c CALL SCOPY( iim, unsddv, 1, sdd2, 1 )
178 c ELSE
179 c CALL SCOPY( iim, unsddv, 1, sdd1, 1 )
180 c CALL SCOPY( iim, sddv, 1, sdd2, 1 )
181 c END IF
182
183 jdfil1 = 2
184 16229 jffil1 = jfiltnu
185 16229 jdfil2 = jfiltsu
186 jffil2 = jjm
187 END IF
188 ELSE
189
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 5003 times.
 5003 IF( nlat.NE.jjm ) THEN
190 ✗ PRINT 2222
191 ✗ STOP
192 ELSE
193
194
2/2
✓ Branch 0 taken 1060 times.
✓ Branch 1 taken 3943 times.
 5003 IF( iaire.EQ.1 ) THEN
195 sdd1_type = type_sddu
196 sdd2_type = type_unsddu
197 ELSE
198 sdd1_type = type_unsddu
199 sdd2_type = type_sddu
200 ENDIF
201
202 c IF( iaire.EQ.1 ) THEN
203 c CALL SCOPY( iim, sddu, 1, sdd1, 1 )
204 c CALL SCOPY( iim, unsddu, 1, sdd2, 1 )
205 c ELSE
206 c CALL SCOPY( iim, unsddu, 1, sdd1, 1 )
207 c CALL SCOPY( iim, sddu, 1, sdd2, 1 )
208 c END IF
209
210 jdfil1 = 1
211 5003 jffil1 = jfiltnv
212 5003 jdfil2 = jfiltsv
213 jffil2 = jjm
214 END IF
215 END IF
216
217
2/2
✓ Branch 0 taken 42464 times.
✓ Branch 1 taken 21232 times.
 63696 DO hemisph = 1, 2
218
219
2/2
✓ Branch 0 taken 21232 times.
✓ Branch 1 taken 21232 times.
 42464 IF ( hemisph.EQ.1 ) THEN
220 jdfil = jdfil1
221 jffil = jffil1
222 ELSE
223 jdfil = jdfil2
224 jffil = jffil2
225 END IF
226
227
2/2
✓ Branch 0 taken 1617716 times.
✓ Branch 1 taken 42464 times.
 1660180 DO l = 1, nbniv
228
2/2
✓ Branch 0 taken 8088580 times.
✓ Branch 1 taken 1617716 times.
 9748760 DO j = jdfil,jffil
229
2/2
✓ Branch 0 taken 258834560 times.
✓ Branch 1 taken 8088580 times.
 268540856 DO i = 1, iim
230 266923140 champ(i,j,l) = champ(i,j,l) * sdd12(i,sdd1_type) ! sdd1(i)
231 END DO
232 END DO
233 END DO
234
235
2/2
✓ Branch 0 taken 21232 times.
✓ Branch 1 taken 21232 times.
 42464 IF( hemisph. EQ. 1 ) THEN
236
237
2/2
✓ Branch 0 taken 561 times.
✓ Branch 1 taken 20671 times.
 21232 IF( ifiltre. EQ. -2 ) THEN
238
239
2/2
✓ Branch 0 taken 2805 times.
✓ Branch 1 taken 561 times.
 3366 DO j = jdfil,jffil
240 eignq(:,j-jdfil+1,:)
241
5/20
✗ Branch 0 not taken.
✓ Branch 1 taken 2805 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
✓ Branch 17 taken 109395 times.
✓ Branch 18 taken 2805 times.
✓ Branch 19 taken 109395 times.
✓ Branch 20 taken 3500640 times.
 3613401 $ = matmul(matrinvn(:,:,j), champ(:iim,j,:))
242 END DO
243
244
2/2
✓ Branch 0 taken 5003 times.
✓ Branch 1 taken 15668 times.
 20671 ELSE IF ( griscal ) THEN
245
246
2/2
✓ Branch 0 taken 15668 times.
✓ Branch 1 taken 78340 times.
 94008 DO j = jdfil,jffil
247 eignq(:,j-jdfil+1,:)
248
18/20
✓ Branch 0 taken 1515 times.
✓ Branch 1 taken 76825 times.
✓ Branch 2 taken 1515 times.
✓ Branch 3 taken 1515 times.
✓ Branch 4 taken 48480 times.
✓ Branch 5 taken 1515 times.
✓ Branch 6 taken 1515 times.
✓ Branch 7 taken 1515 times.
✓ Branch 8 taken 48480 times.
✓ Branch 9 taken 1515 times.
✓ Branch 10 taken 1551360 times.
✓ Branch 11 taken 48480 times.
✓ Branch 12 taken 1551360 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1551360 times.
✗ Branch 15 not taken.
✓ Branch 17 taken 2996175 times.
✓ Branch 18 taken 76825 times.
✓ Branch 19 taken 2996175 times.
✓ Branch 20 taken 95877600 times.
 102172008 $ = matmul(matriceun(:,:,j), champ(:iim,j,:))
249 END DO
250
251 ELSE
252
253
2/2
✓ Branch 0 taken 5003 times.
✓ Branch 1 taken 25015 times.
 30018 DO j = jdfil,jffil
254 eignq(:,j-jdfil+1,:)
255
18/20
✓ Branch 0 taken 1010 times.
✓ Branch 1 taken 24005 times.
✓ Branch 2 taken 1010 times.
✓ Branch 3 taken 1010 times.
✓ Branch 4 taken 32320 times.
✓ Branch 5 taken 1010 times.
✓ Branch 6 taken 1010 times.
✓ Branch 7 taken 1010 times.
✓ Branch 8 taken 32320 times.
✓ Branch 9 taken 1010 times.
✓ Branch 10 taken 1034240 times.
✓ Branch 11 taken 32320 times.
✓ Branch 12 taken 1034240 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1034240 times.
✗ Branch 15 not taken.
✓ Branch 17 taken 936195 times.
✓ Branch 18 taken 24005 times.
✓ Branch 19 taken 936195 times.
✓ Branch 20 taken 29958240 times.
 33059593 $ = matmul(matricevn(:,:,j), champ(:iim,j,:))
256 END DO
257
258 ENDIF
259
260 ELSE
261
262
2/2
✓ Branch 0 taken 561 times.
✓ Branch 1 taken 20671 times.
 21232 IF( ifiltre. EQ. -2 ) THEN
263
264
2/2
✓ Branch 0 taken 561 times.
✓ Branch 1 taken 2805 times.
 3366 DO j = jdfil,jffil
265 eignq(:,j-jdfil+1,:)
266 2805 $ = matmul(matrinvs(:,:,j-jfiltsu+1),
267
5/20
✗ Branch 0 not taken.
✓ Branch 1 taken 2805 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
✗ Branch 6 not taken.
✗ Branch 7 not taken.
✗ Branch 8 not taken.
✗ Branch 9 not taken.
✗ Branch 10 not taken.
✗ Branch 11 not taken.
✗ Branch 12 not taken.
✗ Branch 13 not taken.
✗ Branch 14 not taken.
✗ Branch 15 not taken.
✓ Branch 17 taken 109395 times.
✓ Branch 18 taken 2805 times.
✓ Branch 19 taken 109395 times.
✓ Branch 20 taken 3500640 times.
 3613401 $ champ(:iim,j,:))
268 END DO
269
270
271
2/2
✓ Branch 0 taken 5003 times.
✓ Branch 1 taken 15668 times.
 20671 ELSE IF ( griscal ) THEN
272
273
2/2
✓ Branch 0 taken 15668 times.
✓ Branch 1 taken 78340 times.
 94008 DO j = jdfil,jffil
274 eignq(:,j-jdfil+1,:)
275 78340 $ = matmul(matriceus(:,:,j-jfiltsu+1),
276
18/20
✓ Branch 0 taken 1515 times.
✓ Branch 1 taken 76825 times.
✓ Branch 2 taken 1515 times.
✓ Branch 3 taken 1515 times.
✓ Branch 4 taken 48480 times.
✓ Branch 5 taken 1515 times.
✓ Branch 6 taken 1515 times.
✓ Branch 7 taken 1515 times.
✓ Branch 8 taken 48480 times.
✓ Branch 9 taken 1515 times.
✓ Branch 10 taken 1551360 times.
✓ Branch 11 taken 48480 times.
✓ Branch 12 taken 1551360 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1551360 times.
✗ Branch 15 not taken.
✓ Branch 17 taken 2996175 times.
✓ Branch 18 taken 76825 times.
✓ Branch 19 taken 2996175 times.
✓ Branch 20 taken 95877600 times.
 102172008 $ champ(:iim,j,:))
277 END DO
278
279 ELSE
280
281
2/2
✓ Branch 0 taken 5003 times.
✓ Branch 1 taken 25015 times.
 30018 DO j = jdfil,jffil
282 eignq(:,j-jdfil+1,:)
283 25015 $ = matmul(matricevs(:,:,j-jfiltsv+1),
284
18/20
✓ Branch 0 taken 1010 times.
✓ Branch 1 taken 24005 times.
✓ Branch 2 taken 1010 times.
✓ Branch 3 taken 1010 times.
✓ Branch 4 taken 32320 times.
✓ Branch 5 taken 1010 times.
✓ Branch 6 taken 1010 times.
✓ Branch 7 taken 1010 times.
✓ Branch 8 taken 32320 times.
✓ Branch 9 taken 1010 times.
✓ Branch 10 taken 1034240 times.
✓ Branch 11 taken 32320 times.
✓ Branch 12 taken 1034240 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1034240 times.
✗ Branch 15 not taken.
✓ Branch 17 taken 936195 times.
✓ Branch 18 taken 24005 times.
✓ Branch 19 taken 936195 times.
✓ Branch 20 taken 29958240 times.
 33060603 $ champ(:iim,j,:))
285 END DO
286
287 ENDIF
288
289 ENDIF
290
291
2/2
✓ Branch 0 taken 41342 times.
✓ Branch 1 taken 1122 times.
 42464 IF( ifiltre.EQ. 2 ) THEN
292
293
2/2
✓ Branch 0 taken 1573958 times.
✓ Branch 1 taken 41342 times.
 1615300 DO l = 1, nbniv
294
2/2
✓ Branch 0 taken 7869790 times.
✓ Branch 1 taken 1573958 times.
 9485090 DO j = jdfil,jffil
295
2/2
✓ Branch 0 taken 251833280 times.
✓ Branch 1 taken 7869790 times.
 261277028 DO i = 1, iim
296 champ( i,j,l ) =
297 & (champ(i,j,l) + eignq(i,j-jdfil+1,l))
298 259703070 & * sdd12(i,sdd2_type) ! sdd2(i)
299 END DO
300 END DO
301 END DO
302
303 ELSE
304
305
2/2
✓ Branch 0 taken 1122 times.
✓ Branch 1 taken 43758 times.
 44880 DO l = 1, nbniv
306
2/2
✓ Branch 0 taken 218790 times.
✓ Branch 1 taken 43758 times.
 263670 DO j = jdfil,jffil
307
2/2
✓ Branch 0 taken 7001280 times.
✓ Branch 1 taken 218790 times.
 7263828 DO i = 1, iim
308 champ( i,j,l ) =
309 & (champ(i,j,l) - eignq(i,j-jdfil+1,l))
310 7220070 & * sdd12(i,sdd2_type) ! sdd2(i)
311 END DO
312 END DO
313 END DO
314
315 ENDIF
316
317
2/2
✓ Branch 0 taken 1617716 times.
✓ Branch 1 taken 42464 times.
 1681412 DO l = 1, nbniv
318
2/2
✓ Branch 0 taken 8088580 times.
✓ Branch 1 taken 1617716 times.
 9748760 DO j = jdfil,jffil
319 9706296 champ( iip1,j,l ) = champ( 1,j,l )
320 END DO
321 END DO
322
323
324 ENDDO
325
326 1111 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a
327 & filtrer, sur la grille des scalaires'/)
328 2222 FORMAT(//20x,'ERREUR dans le dimensionnement du tableau CHAMP a fi
329 & ltrer, sur la grille de V ou de Z'/)
330 21232 RETURN
331 END
332