14 SUBROUTINE init_filtre_fft(coeffu,modfrstu,jfiltnu,jfiltsu,coeffv,modfrstv,jfiltnv,jfiltsv)
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
27 INTEGER :: index_vp(
iim)
37 index_vp(
iim/2+i+1)=
iim-2*i+1
47 IF (index_vp(i) < modfrstu(j))
THEN
57 IF (index_vp(i) < modfrstu(j))
THEN
67 IF (index_vp(i) < modfrstv(j))
THEN
77 IF (index_vp(i) < modfrstv(j))
THEN
87 IF (index_vp(i) < modfrstu(j))
THEN
90 filtre_inv(i,j)=coeffu(index_vp(i),j)/(1.+coeffu(index_vp(i),j))
97 IF (index_vp(i) < modfrstu(j))
THEN
100 filtre_inv(i,j)=coeffu(index_vp(i),j)/(1.+coeffu(index_vp(i),j))
107 WRITE (*,*)
"COTH jfiltnu,jfiltsu,jfiltnv,jjm-jfiltsv"
108 WRITE (*,*)jfiltnu,jfiltsu,jfiltnv,jjm-jfiltsv
109 WRITE (*,*)max(jfiltnu-2,jjm-jfiltsu,jfiltnv-2,jjm-jfiltsv)+1
110 CALL init_fft(
iim,(
llm+1)*(max(jfiltnu-2,jjm-jfiltsu,jfiltnv-2,jjm-jfiltsv)+1))
112 CALL init_fft(
iim,(jjm+1)*(
llm+1))
117 SUBROUTINE filtre_u_fft(vect_inout,nlat,jj_begin,jj_end,nbniv)
123 include
'dimensions.h'
124 INTEGER,
INTENT(IN) :: nlat
125 INTEGER,
INTENT(IN) :: jj_begin
126 INTEGER,
INTENT(IN) :: jj_end
127 INTEGER,
INTENT(IN) :: nbniv
128 REAL,
INTENT(INOUT) :: vect_inout(
iim+1,nlat,nbniv)
130 REAL :: vect(
iim+inc,jj_end-jj_begin+1,nbniv)
131 COMPLEX :: TF_vect(
iim/2+1,jj_end-jj_begin+1,nbniv)
140 DO j=1,jj_end-jj_begin+1
142 vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
148 nb_vect=(jj_end-jj_begin+1)*ll_nb
150 CALL fft_forward(vect,tf_vect,nb_vect)
153 DO j=1,jj_end-jj_begin+1
155 tf_vect(i,j,l)=tf_vect(i,j,l)*
filtre_u(i,jj_begin+j-1)
160 CALL fft_backward(tf_vect,vect,nb_vect)
167 DO j=1,jj_end-jj_begin+1
169 vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
178 SUBROUTINE filtre_v_fft(vect_inout,nlat,jj_begin,jj_end,nbniv)
184 include
'dimensions.h'
185 INTEGER,
INTENT(IN) :: nlat
186 INTEGER,
INTENT(IN) :: jj_begin
187 INTEGER,
INTENT(IN) :: jj_end
188 INTEGER,
INTENT(IN) :: nbniv
189 REAL,
INTENT(INOUT) :: vect_inout(
iim+1,nlat,nbniv)
191 REAL :: vect(
iim+inc,jj_end-jj_begin+1,nbniv)
192 COMPLEX :: TF_vect(
iim/2+1,jj_end-jj_begin+1,nbniv)
201 DO j=1,jj_end-jj_begin+1
203 vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
210 nb_vect=(jj_end-jj_begin+1)*ll_nb
212 CALL fft_forward(vect,tf_vect,nb_vect)
215 DO j=1,jj_end-jj_begin+1
217 tf_vect(i,j,l)=tf_vect(i,j,l)*
filtre_v(i,jj_begin+j-1)
222 CALL fft_backward(tf_vect,vect,nb_vect)
229 DO j=1,jj_end-jj_begin+1
231 vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
246 include
'dimensions.h'
247 INTEGER,
INTENT(IN) :: nlat
248 INTEGER,
INTENT(IN) :: jj_begin
249 INTEGER,
INTENT(IN) :: jj_end
250 INTEGER,
INTENT(IN) :: nbniv
251 REAL,
INTENT(INOUT) :: vect_inout(
iim+1,nlat,nbniv)
253 REAL :: vect(
iim+inc,jj_end-jj_begin+1,nbniv)
254 COMPLEX :: TF_vect(
iim/2+1,jj_end-jj_begin+1,nbniv)
263 DO j=1,jj_end-jj_begin+1
265 vect(i,j,ll_nb)=vect_inout(i,j+jj_begin-1,l)
271 nb_vect=(jj_end-jj_begin+1)*ll_nb
273 CALL fft_forward(vect,tf_vect,nb_vect)
276 DO j=1,jj_end-jj_begin+1
278 tf_vect(i,j,l)=tf_vect(i,j,l)*
filtre_inv(i,jj_begin+j-1)
283 CALL fft_backward(tf_vect,vect,nb_vect)
289 DO j=1,jj_end-jj_begin+1
291 vect_inout(i,j+jj_begin-1,l)=vect(i,j,ll_nb)
subroutine init_filtre_fft(coeffu, modfrstu, jfiltnu, jfiltsu, coeffv, modfrstv, jfiltnv, jfiltsv)
real, dimension(:,:), allocatable, save filtre_v
subroutine filtre_u_fft(vect_inout, nlat, jj_begin, jj_end, nbniv)
logical, save use_filtre_fft
subroutine filtre_v_fft(vect_inout, nlat, jj_begin, jj_end, nbniv)
!$Id Turb_fcg_gcssold get_uvd hqturb_gcssold endif!large scale llm day day1 day day1 *dt_toga endif!time annee_ref dt_toga u_toga vq_toga w_prof vq_prof llm day day1 day day1 *dt_dice endif!time annee_ref dt_dice swup_dice vg_dice omega_dice tg_prof vg_profd w_profd omega_profd!do llm!print llm l llm
real, dimension(:,:), allocatable, save filtre_u
real, dimension(:,:), allocatable, save filtre_inv
c c zjulian c cym CALL iim cym klev iim
subroutine filtre_inv_fft(vect_inout, nlat, jj_begin, jj_end, nbniv)