Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2024 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 : MODULE fftsg_lib
8 : USE fft_kinds, ONLY: dp
9 : USE mltfftsg_tools, ONLY: mltfftsg
10 :
11 : IMPLICIT NONE
12 :
13 : PRIVATE
14 :
15 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'fftsg_lib'
16 :
17 : PUBLIC :: fftsg_do_init, fftsg_do_cleanup, fftsg_get_lengths, fftsg3d, fftsg1dm
18 :
19 : CONTAINS
20 :
21 : ! **************************************************************************************************
22 : !> \brief ...
23 : ! **************************************************************************************************
24 12 : SUBROUTINE fftsg_do_init()
25 :
26 : ! no init needed
27 :
28 12 : END SUBROUTINE
29 :
30 : ! **************************************************************************************************
31 : !> \brief ...
32 : ! **************************************************************************************************
33 12 : SUBROUTINE fftsg_do_cleanup()
34 :
35 : ! no cleanup needed
36 :
37 12 : END SUBROUTINE
38 :
39 : ! **************************************************************************************************
40 : !> \brief ...
41 : !> \param DATA ...
42 : !> \param max_length ...
43 : !> \par History
44 : !> Adapted to new interface structure
45 : !> \author JGH
46 : ! **************************************************************************************************
47 112388 : SUBROUTINE fftsg_get_lengths(DATA, max_length)
48 :
49 : INTEGER, DIMENSION(*) :: DATA
50 : INTEGER, INTENT(INOUT) :: max_length
51 :
52 : INTEGER, PARAMETER :: rlen = 81
53 : INTEGER, DIMENSION(rlen), PARAMETER :: radix = (/2, 4, 6, 8, 9, 12, 15, 16, 18, 20, 24, 25, &
54 : 27, 30, 32, 36, 40, 45, 48, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125, 128, &
55 : 135, 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 256, 270, 288, 300, 320, 324, &
56 : 360, 375, 384, 400, 405, 432, 450, 480, 486, 500, 512, 540, 576, 600, 625, 640, 648, 675, &
57 : 720, 729, 750, 768, 800, 810, 864, 900, 960, 972, 1000, 1024/)
58 :
59 : INTEGER :: ndata
60 :
61 : !------------------------------------------------------------------------------
62 :
63 112388 : ndata = MIN(max_length, rlen)
64 9215816 : DATA(1:ndata) = RADIX(1:ndata)
65 112388 : max_length = ndata
66 :
67 112388 : END SUBROUTINE fftsg_get_lengths
68 :
69 : ! **************************************************************************************************
70 : !> \brief ...
71 : !> \param fft_in_place ...
72 : !> \param fsign ...
73 : !> \param scale ...
74 : !> \param n ...
75 : !> \param zin ...
76 : !> \param zout ...
77 : ! **************************************************************************************************
78 2884 : SUBROUTINE fftsg3d(fft_in_place, fsign, scale, n, zin, zout)
79 :
80 : LOGICAL, INTENT(IN) :: fft_in_place
81 : INTEGER, INTENT(INOUT) :: fsign
82 : REAL(KIND=dp), INTENT(IN) :: scale
83 : INTEGER, DIMENSION(*), INTENT(IN) :: n
84 : COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zin, zout
85 :
86 2884 : COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: xf, yf
87 : INTEGER :: nx, ny, nz
88 :
89 : !------------------------------------------------------------------------------
90 :
91 2884 : nx = n(1)
92 2884 : ny = n(2)
93 2884 : nz = n(3)
94 :
95 2884 : IF (fft_in_place) THEN
96 :
97 11520 : ALLOCATE (xf(nx*ny*nz), yf(nx*ny*nz))
98 :
99 : CALL mltfftsg('N', 'T', zin, nx, ny*nz, xf, ny*nz, nx, nx, &
100 2880 : ny*nz, fsign, 1.0_dp)
101 : CALL mltfftsg('N', 'T', xf, ny, nx*nz, yf, nx*nz, ny, ny, &
102 2880 : nx*nz, fsign, 1.0_dp)
103 : CALL mltfftsg('N', 'T', yf, nz, ny*nx, zin, ny*nx, nz, nz, &
104 2880 : ny*nx, fsign, scale)
105 :
106 2880 : DEALLOCATE (xf, yf)
107 :
108 : ELSE
109 :
110 12 : ALLOCATE (xf(nx*ny*nz))
111 :
112 : CALL mltfftsg('N', 'T', zin, nx, ny*nz, zout, ny*nz, nx, nx, &
113 4 : ny*nz, fsign, 1.0_dp)
114 : CALL mltfftsg('N', 'T', zout, ny, nx*nz, xf, nx*nz, ny, ny, &
115 4 : nx*nz, fsign, 1.0_dp)
116 : CALL mltfftsg('N', 'T', xf, nz, ny*nx, zout, ny*nx, nz, nz, &
117 4 : ny*nx, fsign, scale)
118 :
119 4 : DEALLOCATE (xf)
120 :
121 : END IF
122 :
123 2884 : END SUBROUTINE fftsg3d
124 :
125 : ! **************************************************************************************************
126 : !> \brief ...
127 : !> \param fsign ...
128 : !> \param trans ...
129 : !> \param n ...
130 : !> \param m ...
131 : !> \param zin ...
132 : !> \param zout ...
133 : !> \param scale ...
134 : ! **************************************************************************************************
135 16338 : SUBROUTINE fftsg1dm(fsign, trans, n, m, zin, zout, scale)
136 :
137 : INTEGER, INTENT(INOUT) :: fsign
138 : LOGICAL, INTENT(IN) :: trans
139 : INTEGER, INTENT(IN) :: n, m
140 : COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zin
141 : COMPLEX(KIND=dp), DIMENSION(*), INTENT(OUT) :: zout
142 : REAL(KIND=dp), INTENT(IN) :: scale
143 :
144 : !------------------------------------------------------------------------------
145 :
146 16338 : IF (trans) THEN
147 16338 : IF (fsign > 0) THEN
148 8022 : CALL mltfftsg("T", "N", zin, m, n, zout, n, m, n, m, fsign, scale)
149 : ELSE
150 8316 : CALL mltfftsg("N", "T", zin, n, m, zout, m, n, n, m, fsign, scale)
151 : END IF
152 : ELSE
153 0 : CALL mltfftsg("N", "N", zin, n, m, zout, n, m, n, m, fsign, scale)
154 : END IF
155 :
156 16338 : END SUBROUTINE fftsg1dm
157 :
158 : END MODULE
159 :
|
