GCC Code Coverage Report

Directory: ./
File: filtrez/mod_filtre_fft_loc.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 103 0.0%
Branches: 0 106 0.0%
Line Branch Exec Source
1 MODULE mod_filtre_fft_loc
2
3 LOGICAL,SAVE :: use_filtre_fft
4 REAL,SAVE,ALLOCATABLE :: Filtre_u(:,:)
5 REAL,SAVE,ALLOCATABLE :: Filtre_v(:,:)
6 REAL,SAVE,ALLOCATABLE :: Filtre_inv(:,:)
7
8 CONTAINS
9
10 ✗ SUBROUTINE Init_filtre_fft(coeffu,modfrstu,jfiltnu,jfiltsu,coeffv,modfrstv,jfiltnv,jfiltsv)
11 USE mod_fft
12 IMPLICIT NONE
13 include 'dimensions.h'
14 REAL, INTENT(IN) :: coeffu(iim,jjm)
15 INTEGER,INTENT(IN) :: modfrstu(jjm)
16 INTEGER,INTENT(IN) :: jfiltnu
17 INTEGER,INTENT(IN) :: jfiltsu
18 REAL, INTENT(IN) :: coeffv(iim,jjm)
19 INTEGER,INTENT(IN) :: modfrstv(jjm)
20 INTEGER,INTENT(IN) :: jfiltnv
21 INTEGER,INTENT(IN) :: jfiltsv
22
23 INTEGER :: index_vp(iim)
24 INTEGER :: i,j
25
26 ✗ index_vp(1)=1
27 ✗ DO i=1,iim/2
28 ✗ index_vp(i+1)=i*2
29 ENDDO
30
31 ✗ DO i=1,iim/2-1
32 ✗ index_vp(iim/2+i+1)=iim-2*i+1
33 ENDDO
34
35 ✗ ALLOCATE(Filtre_u(iim,jjm))
36 ✗ ALLOCATE(Filtre_v(iim,jjm))
37 ✗ ALLOCATE(Filtre_inv(iim,jjm))
38
39
40 ✗ DO j=2,jfiltnu
41 ✗ DO i=1,iim
42 ✗ IF (index_vp(i) < modfrstu(j)) THEN
43 ✗ Filtre_u(i,j)=0
44 ELSE
45 ✗ Filtre_u(i,j)=coeffu(index_vp(i),j)
46 ENDIF
47 ENDDO
48 ENDDO
49
50 ✗ DO j=jfiltsu,jjm
51 ✗ DO i=1,iim
52 ✗ IF (index_vp(i) < modfrstu(j)) THEN
53 ✗ Filtre_u(i,j)=0
54 ELSE
55 ✗ Filtre_u(i,j)=coeffu(index_vp(i),j)
56 ENDIF
57 ENDDO
58 ENDDO
59
60 ✗ DO j=1,jfiltnv
61 ✗ DO i=1,iim
62 ✗ IF (index_vp(i) < modfrstv(j)) THEN
63 ✗ Filtre_v(i,j)=0
64 ELSE
65 ✗ Filtre_v(i,j)=coeffv(index_vp(i),j)
66 ENDIF
67 ENDDO
68 ENDDO
69
70 ✗ DO j=jfiltsv,jjm
71 ✗ DO i=1,iim
72 ✗ IF (index_vp(i) < modfrstv(j)) THEN
73 ✗ Filtre_v(i,j)=0
74 ELSE
75 ✗ Filtre_v(i,j)=coeffv(index_vp(i),j)
76 ENDIF
77 ENDDO
78 ENDDO
79
80 ✗ DO j=2,jfiltnu
81 ✗ DO i=1,iim
82 ✗ IF (index_vp(i) < modfrstu(j)) THEN
83 ✗ Filtre_inv(i,j)=0
84 ELSE
85 ✗ Filtre_inv(i,j)=coeffu(index_vp(i),j)/(1.+coeffu(index_vp(i),j))
86 ENDIF
87 ENDDO
88 ENDDO
89
90 ✗ DO j=jfiltsu,jjm
91 ✗ DO i=1,iim
92 ✗ IF (index_vp(i) < modfrstu(j)) THEN
93 ✗ Filtre_inv(i,j)=0
94 ELSE
95 ✗ Filtre_inv(i,j)=coeffu(index_vp(i),j)/(1.+coeffu(index_vp(i),j))
96 ENDIF
97 ENDDO
98 ENDDO
99
100
101 ! CALL Init_FFT(iim,(jjm+1)*(llm+1))
102
103
104 ✗ END SUBROUTINE Init_filtre_fft
105
106 ✗ SUBROUTINE Filtre_u_fft(vect_inout,jjb,jje,jj_begin,jj_end,nbniv)
107 USE mod_fft
108 IMPLICIT NONE
109 include 'dimensions.h'
110 INTEGER,INTENT(IN) :: jjb
111 INTEGER,INTENT(IN) :: jje
112 INTEGER,INTENT(IN) :: jj_begin
113 INTEGER,INTENT(IN) :: jj_end
114 INTEGER,INTENT(IN) :: nbniv
115 REAL,INTENT(INOUT) :: vect_inout(iim+1,jjb:jje,nbniv)
116
117 ✗ REAL :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
118 ✗ COMPLEX :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
119 INTEGER :: nb_vect
120 INTEGER :: i,j,l
121 INTEGER :: ll_nb
122 ! REAL :: vect_tmp(iim+inc,jj_end-jj_begin+1,nbniv)
123
124 ll_nb=0
125 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
126 ✗ DO l=1,nbniv
127 ✗ ll_nb=ll_nb+1
128 ✗ DO j=1,jj_end-jj_begin+1
129 ✗ DO i=1,iim+1
130 ✗ vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
131 ENDDO
132 ENDDO
133 ENDDO
134 !$OMP END DO NOWAIT
135
136 ✗ nb_vect=(jj_end-jj_begin+1)*ll_nb
137
138 ! vect_tmp=vect
139
140 ✗ CALL FFT_forward(vect,TF_vect,nb_vect)
141
142 ! CALL FFT_forward(vect,TF_vect_test,nb_vect)
143 ! PRINT *,"XXXXXXXXXXXXX Filtre_u_FFT xxxxxxxxxxxx"
144 ! DO j=1,jj_end-jj_begin+1
145 ! DO i=1,iim/2+1
146 ! PRINT *,"====",i,j,"----->",TF_vect_test(i,j,1)
147 ! ENDDO
148 ! ENDDO
149
150 ✗ DO l=1,ll_nb
151 ✗ DO j=1,jj_end-jj_begin+1
152 ✗ DO i=1,iim/2+1
153 ✗ TF_vect(i,j,l)=TF_vect(i,j,l)*Filtre_u(i,jj_begin+j-1)
154 ENDDO
155 ENDDO
156 ENDDO
157
158 ✗ CALL FFT_backward(TF_vect,vect,nb_vect)
159 ! CALL FFT_backward(TF_vect_test,vect_test,nb_vect)
160
161 ! PRINT *,"XXXXXXXXXXXXX Filtre_u_FFT xxxxxxxxxxxx"
162 ! DO j=1,jj_end-jj_begin+1
163 ! DO i=1,iim
164 ! PRINT *,"====",i,j,"----->",vect_test(i,j,1)
165 ! ENDDO
166 ! ENDDO
167
168 ll_nb=0
169 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
170 ✗ DO l=1,nbniv
171 ✗ ll_nb=ll_nb+1
172 ✗ DO j=1,jj_end-jj_begin+1
173 ✗ DO i=1,iim+1
174 ✗ vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
175 ENDDO
176 ENDDO
177 ENDDO
178 !$OMP END DO NOWAIT
179
180 ✗ END SUBROUTINE Filtre_u_fft
181
182
183 ✗ SUBROUTINE Filtre_v_fft(vect_inout,jjb,jje,jj_begin,jj_end,nbniv)
184 USE mod_fft
185 IMPLICIT NONE
186 INCLUDE 'dimensions.h'
187 INTEGER,INTENT(IN) :: jjb
188 INTEGER,INTENT(IN) :: jje
189 INTEGER,INTENT(IN) :: jj_begin
190 INTEGER,INTENT(IN) :: jj_end
191 INTEGER,INTENT(IN) :: nbniv
192 REAL,INTENT(INOUT) :: vect_inout(iim+1,jjb:jje,nbniv)
193
194 ✗ REAL :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
195 ✗ COMPLEX :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
196 INTEGER :: nb_vect
197 INTEGER :: i,j,l
198 INTEGER :: ll_nb
199
200 ll_nb=0
201 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
202 ✗ DO l=1,nbniv
203 ✗ ll_nb=ll_nb+1
204 ✗ DO j=1,jj_end-jj_begin+1
205 ✗ DO i=1,iim+1
206 ✗ vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
207 ENDDO
208 ENDDO
209 ENDDO
210 !$OMP END DO NOWAIT
211
212
213 ✗ nb_vect=(jj_end-jj_begin+1)*ll_nb
214
215 ✗ CALL FFT_forward(vect,TF_vect,nb_vect)
216
217 ✗ DO l=1,ll_nb
218 ✗ DO j=1,jj_end-jj_begin+1
219 ✗ DO i=1,iim/2+1
220 ✗ TF_vect(i,j,l)=TF_vect(i,j,l)*Filtre_v(i,jj_begin+j-1)
221 ENDDO
222 ENDDO
223 ENDDO
224
225 ✗ CALL FFT_backward(TF_vect,vect,nb_vect)
226
227
228 ll_nb=0
229 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
230 ✗ DO l=1,nbniv
231 ✗ ll_nb=ll_nb+1
232 ✗ DO j=1,jj_end-jj_begin+1
233 ✗ DO i=1,iim+1
234 ✗ vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
235 ENDDO
236 ENDDO
237 ENDDO
238 !$OMP END DO NOWAIT
239
240 ✗ END SUBROUTINE Filtre_v_fft
241
242
243 ✗ SUBROUTINE Filtre_inv_fft(vect_inout,jjb,jje,jj_begin,jj_end,nbniv)
244 USE mod_fft
245 IMPLICIT NONE
246 INCLUDE 'dimensions.h'
247 INTEGER,INTENT(IN) :: jjb
248 INTEGER,INTENT(IN) :: jje
249 INTEGER,INTENT(IN) :: jj_begin
250 INTEGER,INTENT(IN) :: jj_end
251 INTEGER,INTENT(IN) :: nbniv
252 REAL,INTENT(INOUT) :: vect_inout(iim+1,jjb:jje,nbniv)
253
254 ✗ REAL :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
255 ✗ COMPLEX :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
256 INTEGER :: nb_vect
257 INTEGER :: i,j,l
258 INTEGER :: ll_nb
259
260 ll_nb=0
261 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
262 ✗ DO l=1,nbniv
263 ✗ ll_nb=ll_nb+1
264 ✗ DO j=1,jj_end-jj_begin+1
265 ✗ DO i=1,iim+1
266 ✗ vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
267 ENDDO
268 ENDDO
269 ENDDO
270 !$OMP END DO NOWAIT
271
272 ✗ nb_vect=(jj_end-jj_begin+1)*ll_nb
273
274 ✗ CALL FFT_forward(vect,TF_vect,nb_vect)
275
276 ✗ DO l=1,ll_nb
277 ✗ DO j=1,jj_end-jj_begin+1
278 ✗ DO i=1,iim/2+1
279 ✗ TF_vect(i,j,l)=TF_vect(i,j,l)*Filtre_inv(i,jj_begin+j-1)
280 ENDDO
281 ENDDO
282 ENDDO
283
284 ✗ CALL FFT_backward(TF_vect,vect,nb_vect)
285
286 ll_nb=0
287 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
288 ✗ DO l=1,nbniv
289 ✗ ll_nb=ll_nb+1
290 ✗ DO j=1,jj_end-jj_begin+1
291 ✗ DO i=1,iim+1
292 ✗ vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
293 ENDDO
294 ENDDO
295 ENDDO
296 !$OMP END DO NOWAIT
297
298 ✗ END SUBROUTINE Filtre_inv_fft
299
300
301 ! SUBROUTINE get_ll_index(nbniv,ll_index,ll_nb)
302 ! IMPLICIT NONE
303 ! INTEGER,INTENT(IN) :: nbniv
304 ! INTEGER,INTENT(OUT) :: ll_index(nbniv)
305 ! INTEGER,INTENT(OUT) :: ll_nb
306 !
307 ! INTEGER :: l,ll_begin, ll_end
308 ! INTEGER :: omp_rank,omp_size
309 ! INTEGER :: OMP_GET_NUM_THREADS
310 ! INTEGER :: omp_chunk
311 ! EXTERNAL OMP_GET_NUM_THREADS
312 ! INTEGER :: OMP_GET_THREAD_NUM
313 ! EXTERNAL OMP_GET_THREAD_NUM
314 !
315 !
316 ! omp_size=OMP_GET_NUM_THREADS()
317 ! omp_rank=OMP_GET_THREAD_NUM()
318 ! omp_chunk=nbniv/omp_size+min(1,MOD(nbniv,omp_size))
319 !
320 ! ll_begin=omp_rank*OMP_CHUNK+1
321 ! ll_nb=0
322 ! DO WHILE (ll_begin<=nbniv)
323 ! ll_end=min(ll_begin+OMP_CHUNK-1,nbniv)
324 ! DO l=ll_begin,ll_end
325 ! ll_nb=ll_nb+1
326 ! ll_index(ll_nb)=l
327 ! ENDDO
328 ! ll_begin=ll_begin+omp_size*OMP_CHUNK
329 ! ENDDO
330 !
331 ! END SUBROUTINE get_ll_index
332
333 END MODULE mod_filtre_fft_loc
334
335