SCALE-RM
Functions/Subroutines
scale_dft Module Reference

Functions/Subroutines

subroutine, public dft_setup (KA, KS, KE, IA, IS, IE, JA, JS, JE, LM, MM)
 
subroutine, public dft_finalize
 
subroutine dft_g2s (KA, KS, KE, IA, IS, IE, JA, JS, JE, LM, MM, f, s)
 
subroutine dft_s2g (KA, KS, KE, IA, IS, IE, JA, JS, JE, LM, MM, s, f)
 
subroutine, public dft_g2g (KA, KS, KE, IA, IS, IE, JA, JS, JE, LM, MM, f)
 
subroutine, public dft_g2g_divfree (KA, KS, KE, IA, IS, IE, JA, JS, JE, LM, MM, u, v)
 

Function/Subroutine Documentation

◆ dft_setup()

subroutine, public scale_dft::dft_setup ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  LM,
integer, intent(in)  MM 
)

Definition at line 37 of file scale_dft.F90.

37  implicit none
38  integer,intent(in) :: KA, IA, JA
39  integer,intent(in) :: KS, KE, IS, IE, JS, JE
40  integer,intent(in) :: LM, MM
41  real(RP) :: x, y
42  integer :: i, j, k, l, m
43 
44  imax = (ie-is+1)*prc_num_x
45  jmax = (je-js+1)*prc_num_y
46 
47  igs = (ie-is+1)*prc_2drank(prc_myrank,1)+1
48  jgs = (je-js+1)*prc_2drank(prc_myrank,2)+1
49 
50  lmm = lm
51  mmm = mm
52 
53  allocate( table_x(is:ie,0:2*lm), table_y(js:je,0:2*mm) )
54  allocate( table_l(0:2*lm), table_m(0:2*mm) )
55  allocate( work(ka,0:2*lm,ja) )
56 
57  do i = is, ie
58  x = 2*pi/imax*(i-is+igs)
59  table_x(i,0) = 1
60  enddo
61 
62  do l = 1, lm
63  do i = is, ie
64  x = 2*pi/imax*(i-is+igs)
65  table_x(i,2*l-1) = cos(l*x)
66  table_x(i,2*l) = -sin(l*x)
67  enddo
68  enddo
69 
70  do j = js, je
71  y = 2*pi/jmax*(j-js+jgs)
72  table_y(j,0) = 1
73  enddo
74 
75  do m = 1, mm
76  do j = js, je
77  y = 2*pi/jmax*(j-js+jgs)
78  table_y(j,2*m-1) = cos(m*y)
79  table_y(j,2*m) = -sin(m*y)
80  enddo
81  enddo
82 
83  table_l(0) = 1
84  do l = 1, lm
85  table_l(2*l-1) = cos(pi*l/imax)
86  table_l(2*l) = sin(pi*l/imax)
87  enddo
88 
89  table_m(0) = 1
90  do m = 1, mm
91  table_m(2*m-1) = cos(pi*m/jmax)
92  table_m(2*m) = sin(pi*m/jmax)
93  enddo
94 
95  !$acc enter data copyin(table_x, table_y)
96  !$acc enter data copyin(table_l, table_m)
97  !$acc enter data create(work)
98 

References scale_prc_cartesc::prc_2drank, scale_prc::prc_myrank, scale_prc_cartesc::prc_num_x, and scale_prc_cartesc::prc_num_y.

Referenced by scale_spnudge::spnudge_setup().

Here is the caller graph for this function:

◆ dft_finalize()

subroutine, public scale_dft::dft_finalize

Definition at line 102 of file scale_dft.F90.

102 
103  !$acc exit data delete(table_x, table_y)
104  !$acc exit data delete(table_l, table_m)
105  !$acc exit data delete(work)
106  deallocate( table_x, table_y )
107  deallocate( table_l, table_m )
108  deallocate( work )
109 
110  return

Referenced by scale_spnudge::spnudge_finalize().

Here is the caller graph for this function:

◆ dft_g2s()

subroutine scale_dft::dft_g2s ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  LM,
integer, intent(in)  MM,
real(rp), dimension(ka, ia, ja), intent(in)  f,
real(rp), dimension(ka,0:2*lm,0:2*mm), intent(out)  s 
)

Definition at line 114 of file scale_dft.F90.

114  ! Grid to spectral transformation
115  integer,intent(in) :: KA, IA, JA
116  integer,intent(in) :: KS, KE, IS, IE, JS, JE
117  integer,intent(in) :: LM, MM
118  real(RP), intent(in) :: f(KA, IA, JA) ! x: full level, y: full level
119  real(RP), intent(out) :: s(KA,0:2*LM,0:2*MM)
120  real(RP) :: work_s(KA,0:2*LM,0:2*MM)
121  real(RP) :: c, tb
122  integer :: i, j, k, l, m
123  integer :: ierr
124 
125  !$acc data copyin(f) copyout(s) create(work_s)
126 
127  c = 1.0_rp/imax
128  !$acc kernels
129  do j = js, je
130  do l = 0, 2*lm
131  do k = ks, ke
132  work(k,l,j) = 0
133  enddo
134  !$acc loop seq
135  do i = is, ie
136  tb = table_x(i,l)*c
137  do k = ks, ke
138  work(k,l,j) = work(k,l,j) + f(k,i,j)*tb
139  enddo
140  enddo
141  enddo
142  enddo
143  !$acc end kernels
144 
145  !$acc kernels
146  do m = 0, 2*mm
147  do l = 0, 2*lm
148  do k = ks, ke
149  work_s(k,l,m) = 0
150  enddo
151  enddo
152  enddo
153  !$acc end kernels
154 
155  c = 1.0_rp/jmax
156  !$acc kernels
157  do m = 0, 2*mm
158  do j = js, je
159  tb = table_y(j,m)*c
160  do l = 0, 2*lm
161  do k = ks, ke
162  !$acc atomic
163  work_s(k,l,m) = work_s(k,l,m) + work(k,l,j)*tb
164  enddo
165  enddo
166  enddo
167  enddo
168  !$acc end kernels
169 
170  call mpi_allreduce(work_s, s, ka*(2*lm+1)*(2*mm+1), comm_datatype, mpi_sum, prc_local_comm_world, ierr)
171 
172  !$acc end data
173 

References scale_comm_cartesc::comm_datatype, and scale_prc::prc_local_comm_world.

Referenced by dft_g2g(), and dft_g2g_divfree().

Here is the caller graph for this function:

◆ dft_s2g()

subroutine scale_dft::dft_s2g ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  LM,
integer, intent(in)  MM,
real(rp), dimension(ka,0:2*lm,0:2*mm), intent(in)  s,
real(rp), dimension(ka, ia, ja), intent(out)  f 
)

Definition at line 177 of file scale_dft.F90.

177  ! Grid to spectral transformation
178  integer,intent(in) :: KA, IA, JA
179  integer,intent(in) :: KS, KE, IS, IE, JS, JE
180  integer,intent(in) :: LM, MM
181  real(RP), intent(in) :: s(KA,0:2*LM,0:2*MM)
182  real(RP), intent(out) :: f(KA, IA, JA) ! x: full level, y: full level
183  real(RP) :: c, tb
184  integer :: i, j, k, l, m
185 
186  !$acc data copyin(s) copyout(f)
187 
188  !$acc kernels
189  do j = js, je
190  do i = is, ie
191  do k = ks, ke
192  f(k,i,j) = 0
193  enddo
194  enddo
195  enddo
196  !$acc end kernels
197 
198  !$acc kernels
199  do j = js, je
200  do l = 0, 2*lm
201  do k = ks, ke
202  work(k,l,j) = 0
203  enddo
204  enddo
205  enddo
206  !$acc end kernels
207 
208  !$acc kernels
209  do m = 0, 2*mm
210  if( m == 0 ) then
211  c = 1
212  else
213  c = 2
214  endif
215  do j = js, je
216  tb = table_y(j,m)*c
217  do l = 0, 2*lm
218  do k = ks, ke
219  !$acc atomic
220  work(k,l,j) = work(k,l,j) + s(k,l,m)*tb
221  enddo
222  enddo
223  enddo
224  enddo
225  !$acc end kernels
226 
227  !$acc kernels
228  do j = js, je
229  do i = is, ie
230  do k = ks, ke
231  f(k,i,j) = 0
232  enddo
233  enddo
234  do l = 0, 2*lm
235  if( l == 0 ) then
236  c = 1
237  else
238  c = 2
239  endif
240  do i = is, ie
241  tb = table_x(i,l)*c
242  do k = ks, ke
243  !$acc atomic
244  f(k,i,j) = f(k,i,j) + work(k,l,j)*tb
245  enddo
246  enddo
247  enddo
248  enddo
249  !$acc end kernels
250 
251  !$acc end data
252 

Referenced by dft_g2g(), and dft_g2g_divfree().

Here is the caller graph for this function:

◆ dft_g2g()

subroutine, public scale_dft::dft_g2g ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  LM,
integer, intent(in)  MM,
real(rp), dimension(ka, ia, ja), intent(inout)  f 
)

Definition at line 257 of file scale_dft.F90.

257  integer,intent(in) :: KA, IA, JA
258  integer,intent(in) :: KS, KE, IS, IE, JS, JE
259  integer,intent(in) :: LM, MM
260  real(RP), intent(inout) :: f(KA, IA, JA) ! x,y: full or half level
261  real(RP) :: s(KA,0:2*LM,0:2*MM)
262 
263  call dft_g2s(ka,ks,ke,ia,is,ie,ja,js,je,lm,mm,f,s)
264  call dft_s2g(ka,ks,ke,ia,is,ie,ja,js,je,lm,mm,s,f)
265 

References dft_g2s(), and dft_s2g().

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ dft_g2g_divfree()

subroutine, public scale_dft::dft_g2g_divfree ( integer, intent(in)  KA,
integer, intent(in)  KS,
integer, intent(in)  KE,
integer, intent(in)  IA,
integer, intent(in)  IS,
integer, intent(in)  IE,
integer, intent(in)  JA,
integer, intent(in)  JS,
integer, intent(in)  JE,
integer, intent(in)  LM,
integer, intent(in)  MM,
real(rp), dimension(ka, ia, ja), intent(inout)  u,
real(rp), dimension(ka, ia, ja), intent(inout)  v 
)

Definition at line 270 of file scale_dft.F90.

270  integer,intent(in) :: KA, IA, JA
271  integer,intent(in) :: KS, KE, IS, IE, JS, JE
272  integer,intent(in) :: LM, MM
273  real(RP), intent(inout) :: u(KA, IA, JA) ! x: half level, y: full level
274  real(RP), intent(inout) :: v(KA, IA, JA) ! x: full level, y: half level
275  integer :: k, l, m
276  real(RP) :: s1(KA,0:2*LM,0:2*MM)
277  real(RP) :: s2(KA,0:2*LM,0:2*MM)
278  real(RP) :: s3(KA,0:2*LM,0:2*MM)
279  real(RP) :: a, b, fac
280 
281  !$acc data copy(u,v) create(s1,s2,s3)
282 
283  call dft_g2s(ka,ks,ke,ia,is,ie,ja,js,je,lm,mm,u,s1)
284 
285  ! phase shift
286  !$acc kernels
287  do m = 0, 2*mm
288  do l = 1, lm
289  do k = ks, ke
290  a = s1(k,2*l-1,m)
291  b = s1(k,2*l,m)
292  s1(k,2*l-1,m) = a*table_l(2*l-1) + b*table_l(2*l)
293  s1(k,2*l,m) = b*table_l(2*l-1) - a*table_l(2*l)
294  enddo
295  enddo
296  enddo
297  !$acc end kernels
298 
299  call dft_g2s(ka,ks,ke,ia,is,ie,ja,js,je,lm,mm,v,s2)
300 
301  ! phase shift
302  !$acc kernels
303  do m = 1, mm
304  do l = 0, 2*lm
305  do k = ks, ke
306  a = s2(k,l,2*m-1)
307  b = s2(k,l,2*m)
308  s2(k,l,2*m-1) = a*table_m(2*m-1) + b*table_m(2*m)
309  s2(k,l,2*m) = b*table_m(2*m-1) - a*table_m(2*m)
310  enddo
311  enddo
312  enddo
313  !$acc end kernels
314 
315  ! rotation
316  !$acc kernels
317  do m = 0, 2*mm
318  do l = 0, 2*lm
319  do k = ks, ke
320  s3(k,l,m) = 0
321  enddo
322  enddo
323  enddo
324  !$acc end kernels
325 
326  ! dv/dx
327  !$acc kernels
328  do m = 0, 2*mm
329  do l = 1, lm
330  do k = ks, ke
331  s3(k,2*l-1,m) = -l*s2(k,2*l,m)
332  s3(k,2*l,m) = l*s2(k,2*l-1,m)
333  enddo
334  enddo
335  enddo
336  !$acc end kernels
337 
338  ! + (- du/dy)
339  !$acc kernels
340  do m = 1, mm
341  do l = 0, 2*lm
342  do k = ks, ke
343  s3(k,l,2*m-1) = s3(k,l,2*m-1) + m*s1(k,l,2*m)
344  s3(k,l,2*m) = s3(k,l,2*m) - m*s1(k,l,2*m-1)
345  enddo
346  enddo
347  enddo
348  !$acc end kernels
349 
350  ! minus inverse laplacian ( stream function on model plane )
351  !$acc kernels
352  do k = ks, ke
353  s3(k,0,0) = 0
354  enddo
355  !$acc end kernels
356 
357  !$acc kernels
358  do l = 1, lm
359  fac = 1.0_rp/ (l*l)
360  do k = ks, ke
361  s3(k,2*l-1,0) = s3(k,2*l-1,0)*fac
362  s3(k,2*l,0) = s3(k,2*l,0)*fac
363  enddo
364  enddo
365  !$acc end kernels
366 
367  !$acc kernels
368  do m = 1, mm
369  fac = 1.0_rp/ (m*m)
370  do k = ks, ke
371  s3(k,0,2*m-1) = s3(k,0,2*m-1)*fac
372  s3(k,0,2*m) = s3(k,0,2*m)*fac
373  enddo
374  enddo
375  !$acc end kernels
376 
377  !$acc kernels
378  do m = 1, mm
379  do l = 1, lm
380  fac = 1.0_rp/ (l*l+m*m)
381  do k = ks, ke
382  s3(k,2*l-1,2*m-1) = s3(k,2*l-1,2*m-1)*fac
383  s3(k,2*l-1,2*m) = s3(k,2*l-1,2*m)*fac
384  s3(k,2*l,2*m-1) = s3(k,2*l,2*m-1)*fac
385  s3(k,2*l,2*m) = s3(k,2*l,2*m)*fac
386  enddo
387  enddo
388  enddo
389  !$acc end kernels
390 
391  ! divergence free 2D vector
392 
393  ! dphi/dy
394  !$acc kernels
395  do l = 1, 2*lm
396  do k = ks, ke
397  s1(k,l,0) = 0
398  enddo
399  enddo
400  !$acc end kernels
401  !$acc kernels
402  do m = 1, mm
403  do l = 0, 2*lm
404  do k = ks, ke
405  s1(k,l,2*m-1) = -m*s3(k,l,2*m)
406  s1(k,l,2*m) = m*s3(k,l,2*m-1)
407  enddo
408  enddo
409  enddo
410  !$acc end kernels
411 
412  ! -dphi/dx
413  !$acc kernels
414  do m = 1, 2*mm
415  do k = ks, ke
416  s2(k,0,m) = 0
417  enddo
418  enddo
419  !$acc end kernels
420  !$acc kernels
421  do m = 0, 2*mm
422  do l = 1, lm
423  do k = ks, ke
424  s2(k,2*l-1,m) = l*s3(k,2*l,m)
425  s2(k,2*l,m) = -l*s3(k,2*l-1,m)
426  enddo
427  enddo
428  enddo
429  !$acc end kernels
430 
431  ! phase shift
432  !$acc kernels
433  do m = 0, 2*mm
434  do l = 1, lm
435  do k = ks, ke
436  a = s1(k,2*l-1,m)
437  b = s1(k,2*l,m)
438  s1(k,2*l-1,m) = a*table_l(2*l-1) - b*table_l(2*l)
439  s1(k,2*l,m) = b*table_l(2*l-1) + a*table_l(2*l)
440  enddo
441  enddo
442  enddo
443  !$acc end kernels
444 
445  call dft_s2g(ka,ks,ke,ia,is,ie,ja,js,je,lm,mm,s1,u)
446 
447  ! phase shift
448  !$acc kernels
449  do m = 1, mm
450  do l = 0, 2*lm
451  do k = ks, ke
452  a = s2(k,l,2*m-1)
453  b = s2(k,l,2*m)
454  s2(k,l,2*m-1) = a*table_m(2*m-1) - b*table_m(2*m)
455  s2(k,l,2*m) = b*table_m(2*m-1) + a*table_m(2*m)
456  enddo
457  enddo
458  enddo
459  !$acc end kernels
460 
461  call dft_s2g(ka,ks,ke,ia,is,ie,ja,js,je,lm,mm,s2,v)
462 
463  !$acc end data
464 

References dft_g2s(), and dft_s2g().

Referenced by scale_atmos_dyn_tstep_large_fvm_heve::atmos_dyn_tstep_large_fvm_heve().

Here is the call graph for this function:
Here is the caller graph for this function:
scale_comm_cartesc::comm_datatype
integer, public comm_datatype
datatype of variable
Definition: scale_comm_cartesC.F90:105
scale_atmos_grid_cartesc_index::ke
integer, public ke
end point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:52
scale_atmos_grid_cartesc_index::ka
integer, public ka
Definition: scale_atmos_grid_cartesC_index.F90:47
scale_prc::prc_myrank
integer, public prc_myrank
process num in local communicator
Definition: scale_prc.F90:91
scale_atmos_grid_cartesc_index::imax
integer, public imax
Definition: scale_atmos_grid_cartesC_index.F90:37
scale_atmos_grid_cartesc_index::ie
integer, public ie
end point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:54
scale_atmos_grid_cartesc_index::ia
integer, public ia
Definition: scale_atmos_grid_cartesC_index.F90:48
scale_atmos_grid_cartesc_index::is
integer, public is
start point of inner domain: x, local
Definition: scale_atmos_grid_cartesC_index.F90:53
scale_atmos_grid_cartesc_index::ja
integer, public ja
Definition: scale_atmos_grid_cartesC_index.F90:49
scale_atmos_grid_cartesc_index::ks
integer, public ks
start point of inner domain: z, local
Definition: scale_atmos_grid_cartesC_index.F90:51
scale_atmos_grid_cartesc_index::jmax
integer, public jmax
Definition: scale_atmos_grid_cartesC_index.F90:38
scale_atmos_grid_cartesc_index::js
integer, public js
start point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:55
scale_atmos_grid_cartesc_index::je
integer, public je
end point of inner domain: y, local
Definition: scale_atmos_grid_cartesC_index.F90:56
Generated by   doxygen 1.8.17