GCC Code Coverage Report


Directory: ./
File: filtrez/mod_filtre_fft.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 0 104 0.0%
Branches: 0 106 0.0%

Line Branch Exec Source
1 !
2 ! $Id: mod_filtre_fft.F90 1907 2013-11-26 13:10:46Z lguez $
3 !
4
5 MODULE mod_filtre_fft
6
7 LOGICAL,SAVE :: use_filtre_fft
8 REAL,SAVE,ALLOCATABLE :: Filtre_u(:,:)
9 REAL,SAVE,ALLOCATABLE :: Filtre_v(:,:)
10 REAL,SAVE,ALLOCATABLE :: Filtre_inv(:,:)
11
12 CONTAINS
13
14 SUBROUTINE Init_filtre_fft(coeffu,modfrstu,jfiltnu,jfiltsu,coeffv,modfrstv,jfiltnv,jfiltsv)
15 USE mod_fft
16 IMPLICIT NONE
17 include 'dimensions.h'
18 REAL, INTENT(IN) :: coeffu(iim,jjm)
19 INTEGER,INTENT(IN) :: modfrstu(jjm)
20 INTEGER,INTENT(IN) :: jfiltnu
21 INTEGER,INTENT(IN) :: jfiltsu
22 REAL, INTENT(IN) :: coeffv(iim,jjm)
23 INTEGER,INTENT(IN) :: modfrstv(jjm)
24 INTEGER,INTENT(IN) :: jfiltnv
25 INTEGER,INTENT(IN) :: jfiltsv
26
27 INTEGER :: index_vp(iim)
28 INTEGER :: i,j
29 INTEGER :: l,ll_nb
30
31 index_vp(1)=1
32 DO i=1,iim/2
33 index_vp(i+1)=i*2
34 ENDDO
35
36 DO i=1,iim/2-1
37 index_vp(iim/2+i+1)=iim-2*i+1
38 ENDDO
39
40 ALLOCATE(Filtre_u(iim,jjm))
41 ALLOCATE(Filtre_v(iim,jjm))
42 ALLOCATE(Filtre_inv(iim,jjm))
43
44
45 DO j=2,jfiltnu
46 DO i=1,iim
47 IF (index_vp(i) < modfrstu(j)) THEN
48 Filtre_u(i,j)=0
49 ELSE
50 Filtre_u(i,j)=coeffu(index_vp(i),j)
51 ENDIF
52 ENDDO
53 ENDDO
54
55 DO j=jfiltsu,jjm
56 DO i=1,iim
57 IF (index_vp(i) < modfrstu(j)) THEN
58 Filtre_u(i,j)=0
59 ELSE
60 Filtre_u(i,j)=coeffu(index_vp(i),j)
61 ENDIF
62 ENDDO
63 ENDDO
64
65 DO j=1,jfiltnv
66 DO i=1,iim
67 IF (index_vp(i) < modfrstv(j)) THEN
68 Filtre_v(i,j)=0
69 ELSE
70 Filtre_v(i,j)=coeffv(index_vp(i),j)
71 ENDIF
72 ENDDO
73 ENDDO
74
75 DO j=jfiltsv,jjm
76 DO i=1,iim
77 IF (index_vp(i) < modfrstv(j)) THEN
78 Filtre_v(i,j)=0
79 ELSE
80 Filtre_v(i,j)=coeffv(index_vp(i),j)
81 ENDIF
82 ENDDO
83 ENDDO
84
85 DO j=2,jfiltnu
86 DO i=1,iim
87 IF (index_vp(i) < modfrstu(j)) THEN
88 Filtre_inv(i,j)=0
89 ELSE
90 Filtre_inv(i,j)=coeffu(index_vp(i),j)/(1.+coeffu(index_vp(i),j))
91 ENDIF
92 ENDDO
93 ENDDO
94
95 DO j=jfiltsu,jjm
96 DO i=1,iim
97 IF (index_vp(i) < modfrstu(j)) THEN
98 Filtre_inv(i,j)=0
99 ELSE
100 Filtre_inv(i,j)=coeffu(index_vp(i),j)/(1.+coeffu(index_vp(i),j))
101 ENDIF
102 ENDDO
103 ENDDO
104
105 CALL Init_FFT(iim,(jjm+1)*(llm+1))
106
107 END SUBROUTINE Init_filtre_fft
108
109 SUBROUTINE Filtre_u_fft(vect_inout,nlat,jj_begin,jj_end,nbniv)
110 USE mod_fft
111 IMPLICIT NONE
112 include 'dimensions.h'
113 INTEGER,INTENT(IN) :: nlat
114 INTEGER,INTENT(IN) :: jj_begin
115 INTEGER,INTENT(IN) :: jj_end
116 INTEGER,INTENT(IN) :: nbniv
117 REAL,INTENT(INOUT) :: vect_inout(iim+1,nlat,nbniv)
118
119 REAL :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
120 COMPLEX :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
121 INTEGER :: nb_vect
122 INTEGER :: i,j,l
123 INTEGER :: ll_nb
124
125 ll_nb=0
126 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
127 DO l=1,nbniv
128 ll_nb=ll_nb+1
129 DO j=1,jj_end-jj_begin+1
130 DO i=1,iim+1
131 vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
132 ENDDO
133 ENDDO
134 ENDDO
135 !$OMP END DO NOWAIT
136
137 nb_vect=(jj_end-jj_begin+1)*ll_nb
138
139 CALL FFT_forward(vect,TF_vect,nb_vect)
140
141 DO l=1,ll_nb
142 DO j=1,jj_end-jj_begin+1
143 DO i=1,iim/2+1
144 TF_vect(i,j,l)=TF_vect(i,j,l)*Filtre_u(i,jj_begin+j-1)
145 ENDDO
146 ENDDO
147 ENDDO
148
149 CALL FFT_backward(TF_vect,vect,nb_vect)
150
151
152 ll_nb=0
153 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
154 DO l=1,nbniv
155 ll_nb=ll_nb+1
156 DO j=1,jj_end-jj_begin+1
157 DO i=1,iim+1
158 vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
159 ENDDO
160 ENDDO
161 ENDDO
162 !$OMP END DO NOWAIT
163
164 END SUBROUTINE Filtre_u_fft
165
166
167 SUBROUTINE Filtre_v_fft(vect_inout,nlat,jj_begin,jj_end,nbniv)
168 USE mod_fft
169 IMPLICIT NONE
170 INCLUDE 'dimensions.h'
171 INTEGER,INTENT(IN) :: nlat
172 INTEGER,INTENT(IN) :: jj_begin
173 INTEGER,INTENT(IN) :: jj_end
174 INTEGER,INTENT(IN) :: nbniv
175 REAL,INTENT(INOUT) :: vect_inout(iim+1,nlat,nbniv)
176
177 REAL :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
178 COMPLEX :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
179 INTEGER :: nb_vect
180 INTEGER :: i,j,l
181 INTEGER :: ll_nb
182
183 ll_nb=0
184 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
185 DO l=1,nbniv
186 ll_nb=ll_nb+1
187 DO j=1,jj_end-jj_begin+1
188 DO i=1,iim+1
189 vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
190 ENDDO
191 ENDDO
192 ENDDO
193 !$OMP END DO NOWAIT
194
195
196 nb_vect=(jj_end-jj_begin+1)*ll_nb
197
198 CALL FFT_forward(vect,TF_vect,nb_vect)
199
200 DO l=1,ll_nb
201 DO j=1,jj_end-jj_begin+1
202 DO i=1,iim/2+1
203 TF_vect(i,j,l)=TF_vect(i,j,l)*Filtre_v(i,jj_begin+j-1)
204 ENDDO
205 ENDDO
206 ENDDO
207
208 CALL FFT_backward(TF_vect,vect,nb_vect)
209
210
211 ll_nb=0
212 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
213 DO l=1,nbniv
214 ll_nb=ll_nb+1
215 DO j=1,jj_end-jj_begin+1
216 DO i=1,iim+1
217 vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
218 ENDDO
219 ENDDO
220 ENDDO
221 !$OMP END DO NOWAIT
222
223 END SUBROUTINE Filtre_v_fft
224
225
226 SUBROUTINE Filtre_inv_fft(vect_inout,nlat,jj_begin,jj_end,nbniv)
227 USE mod_fft
228 IMPLICIT NONE
229 INCLUDE 'dimensions.h'
230 INTEGER,INTENT(IN) :: nlat
231 INTEGER,INTENT(IN) :: jj_begin
232 INTEGER,INTENT(IN) :: jj_end
233 INTEGER,INTENT(IN) :: nbniv
234 REAL,INTENT(INOUT) :: vect_inout(iim+1,nlat,nbniv)
235
236 REAL :: vect(iim+inc,jj_end-jj_begin+1,nbniv)
237 COMPLEX :: TF_vect(iim/2+1,jj_end-jj_begin+1,nbniv)
238 INTEGER :: nb_vect
239 INTEGER :: i,j,l
240 INTEGER :: ll_nb
241
242 ll_nb=0
243 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
244 DO l=1,nbniv
245 ll_nb=ll_nb+1
246 DO j=1,jj_end-jj_begin+1
247 DO i=1,iim+1
248 vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
249 ENDDO
250 ENDDO
251 ENDDO
252 !$OMP END DO NOWAIT
253
254 nb_vect=(jj_end-jj_begin+1)*ll_nb
255
256 CALL FFT_forward(vect,TF_vect,nb_vect)
257
258 DO l=1,ll_nb
259 DO j=1,jj_end-jj_begin+1
260 DO i=1,iim/2+1
261 TF_vect(i,j,l)=TF_vect(i,j,l)*Filtre_inv(i,jj_begin+j-1)
262 ENDDO
263 ENDDO
264 ENDDO
265
266 CALL FFT_backward(TF_vect,vect,nb_vect)
267
268 ll_nb=0
269 !$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
270 DO l=1,nbniv
271 ll_nb=ll_nb+1
272 DO j=1,jj_end-jj_begin+1
273 DO i=1,iim+1
274 vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
275 ENDDO
276 ENDDO
277 ENDDO
278 !$OMP END DO NOWAIT
279
280 END SUBROUTINE Filtre_inv_fft
281
282 END MODULE mod_filtre_fft
283
284