Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2026 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 14 : SUBROUTINE fftsg_do_init()
25 :
26 : ! no init needed
27 :
28 14 : END SUBROUTINE fftsg_do_init
29 :
30 : ! **************************************************************************************************
31 : !> \brief ...
32 : ! **************************************************************************************************
33 14 : SUBROUTINE fftsg_do_cleanup()
34 :
35 : ! no cleanup needed
36 :
37 14 : END SUBROUTINE fftsg_do_cleanup
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 0 : 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, 27&
54 : , 30, 32, 36, 40, 45, 48, 54, 60, 64, 72, 75, 80, 81, 90, 96, 100, 108, 120, 125, 128, 135&
55 : , 144, 150, 160, 162, 180, 192, 200, 216, 225, 240, 243, 256, 270, 288, 300, 320, 324, 360&
56 : , 375, 384, 400, 405, 432, 450, 480, 486, 500, 512, 540, 576, 600, 625, 640, 648, 675, 720&
57 : , 729, 750, 768, 800, 810, 864, 900, 960, 972, 1000, 1024]
58 :
59 : INTEGER :: ndata
60 :
61 : !------------------------------------------------------------------------------
62 :
63 0 : ndata = MIN(max_length, rlen)
64 0 : DATA(1:ndata) = RADIX(1:ndata)
65 0 : max_length = ndata
66 :
67 0 : 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 2964 : 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 2964 : COMPLEX(KIND=dp), ALLOCATABLE, DIMENSION(:) :: xf, yf
87 : INTEGER :: nx, ny, nz
88 :
89 : !------------------------------------------------------------------------------
90 :
91 2964 : nx = n(1)
92 2964 : ny = n(2)
93 2964 : nz = n(3)
94 :
95 2964 : IF (fft_in_place) THEN
96 :
97 11520 : ALLOCATE (xf(nx*ny*nz), yf(nx*ny*nz))
98 :
99 : CALL mltfftsg(.FALSE., .TRUE., zin, nx, ny*nz, xf, ny*nz, nx, nx, &
100 2880 : ny*nz, fsign, 1.0_dp)
101 : CALL mltfftsg(.FALSE., .TRUE., xf, ny, nx*nz, yf, nx*nz, ny, ny, &
102 2880 : nx*nz, fsign, 1.0_dp)
103 : CALL mltfftsg(.FALSE., .TRUE., 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 252 : ALLOCATE (xf(nx*ny*nz))
111 :
112 : CALL mltfftsg(.FALSE., .TRUE., zin, nx, ny*nz, zout, ny*nz, nx, nx, &
113 84 : ny*nz, fsign, 1.0_dp)
114 : CALL mltfftsg(.FALSE., .TRUE., zout, ny, nx*nz, xf, nx*nz, ny, ny, &
115 84 : nx*nz, fsign, 1.0_dp)
116 : CALL mltfftsg(.FALSE., .TRUE., xf, nz, ny*nx, zout, ny*nx, nz, nz, &
117 84 : ny*nx, fsign, scale)
118 :
119 84 : DEALLOCATE (xf)
120 :
121 : END IF
122 :
123 2964 : END SUBROUTINE fftsg3d
124 :
125 : ! **************************************************************************************************
126 : !> \brief ...
127 : !> \param fsign ...
128 : !> \param trans_in ...
129 : !> \param trans_out ...
130 : !> \param n ...
131 : !> \param m ...
132 : !> \param ldx_in ...
133 : !> \param ldy_in ...
134 : !> \param ldx_out ...
135 : !> \param ldy_out ...
136 : !> \param zin ...
137 : !> \param zout ...
138 : !> \param scale ...
139 : ! **************************************************************************************************
140 30238 : SUBROUTINE fftsg1dm(fsign, trans_in, trans_out, n, m, ldx_in, ldy_in, ldx_out, ldy_out, zin, zout, scale)
141 :
142 : INTEGER, INTENT(INOUT) :: fsign
143 : LOGICAL, INTENT(IN) :: trans_in, trans_out
144 : INTEGER, INTENT(IN) :: n, m, ldx_in, ldy_in, ldx_out, ldy_out
145 : COMPLEX(KIND=dp), DIMENSION(*), INTENT(INOUT) :: zin
146 : COMPLEX(KIND=dp), DIMENSION(*), INTENT(OUT) :: zout
147 : REAL(KIND=dp), INTENT(IN) :: scale
148 :
149 30238 : CALL mltfftsg(trans_in, trans_out, zin, ldx_in, ldy_in, zout, ldx_out, ldy_out, n, m, fsign, scale)
150 :
151 30238 : END SUBROUTINE fftsg1dm
152 :
153 : END MODULE fftsg_lib
154 :
|
