Skip to content
Projects
Groups
Snippets
Help
Loading...
Help
Support
Submit feedback
Contribute to GitLab
Sign in
Toggle navigation
fleur
Project
Project
Details
Activity
Releases
Cycle Analytics
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Charts
Issues
57
Issues
57
List
Boards
Labels
Milestones
Packages
Packages
Container Registry
Wiki
Wiki
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Charts
Create a new issue
Commits
Issue Boards
Open sidebar
fleur
fleur
Commits
70243c70
Commit
70243c70
authored
Mar 01, 2019
by
Matthias Redies
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
format fft3d
parent
4b72360e
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
48 additions
and
48 deletions
+48
-48
math/fft3d.f90
math/fft3d.f90
+48
-48
No files found.
math/fft3d.f90
View file @
70243c70
MODULE
m_fft3d
CONTAINS
SUBROUTINE
fft3d
(&
&
afft
,
bfft
,
fg3
,&
&
stars
,
isn
,
scaled
)
MODULE
m_fft3d
CONTAINS
SUBROUTINE
fft3d
(&
&
afft
,
bfft
,
fg3
,&
&
stars
,
isn
,
scaled
)
!************************************************************
!* *
...
...
@@ -19,74 +19,74 @@
USE
m_types
USE
m_fft_interface
IMPLICIT
NONE
INTEGER
,
INTENT
(
IN
)
::
isn
TYPE
(
t_stars
),
INTENT
(
IN
)::
stars
REAL
,
INTENT
(
INOUT
)
::
afft
(
0
:
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
-
1
)
REAL
,
INTENT
(
INOUT
)
::
bfft
(
0
:
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
-
1
)
INTEGER
,
INTENT
(
IN
)
::
isn
TYPE
(
t_stars
),
INTENT
(
IN
)::
stars
REAL
,
INTENT
(
INOUT
)
::
afft
(
0
:
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
-
1
)
REAL
,
INTENT
(
INOUT
)
::
bfft
(
0
:
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
-
1
)
COMPLEX
::
fg3
(
stars
%
ng3
)
LOGICAL
,
INTENT
(
IN
),
OPTIONAL
::
scaled
!< determines if coefficients are scaled by stars%nstr
LOGICAL
,
INTENT
(
IN
),
OPTIONAL
::
scaled
!< determines if coefficients are scaled by stars%nstr
INTEGER
i
,
ifftd
INTEGER
i
,
ifftd
REAL
scale
COMPLEX
ctmp
LOGICAL
forw
INTEGER
length_zfft
(
3
)
complex
::
zfft
(
0
:
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
-1
)
complex
::
zfft
(
0
:
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
-
1
)
ifftd
=
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
ifftd
=
27
*
stars
%
mx1
*
stars
%
mx2
*
stars
%
mx3
IF
(
isn
.GT.
0
)
THEN
IF
(
isn
>
0
)
THEN
!
! ---> put stars onto the fft-grid
! ---> put stars onto the fft-grid
!
afft
=
0.0
bfft
=
0.0
DO
i
=
0
,
stars
%
kimax
ctmp
=
fg3
(
stars
%
igfft
(
i
,
1
))
*
stars
%
pgfft
(
i
)
afft
(
stars
%
igfft
(
i
,
2
))
=
real
(
ctmp
)
bfft
(
stars
%
igfft
(
i
,
2
))
=
aimag
(
ctmp
)
ENDDO
afft
=
0.0
bfft
=
0.0
DO
i
=
0
,
stars
%
kimax
ctmp
=
fg3
(
stars
%
igfft
(
i
,
1
))
*
stars
%
pgfft
(
i
)
afft
(
stars
%
igfft
(
i
,
2
))
=
real
(
ctmp
)
bfft
(
stars
%
igfft
(
i
,
2
))
=
aimag
(
ctmp
)
ENDDO
ENDIF
!---> now do the fft (isn=+1 : G -> r ; isn=-1 : r -> G)
zfft
=
cmplx
(
afft
,
bfft
)
zfft
=
cmplx
(
afft
,
bfft
)
if
(
isn
==
-1
)
then
forw
=
.true.
forw
=
.true.
else
forw
=
.false.
forw
=
.false.
end
if
length_zfft
(
1
)
=
3
*
stars
%
mx1
length_zfft
(
2
)
=
3
*
stars
%
mx2
length_zfft
(
3
)
=
3
*
stars
%
mx3
call
fft_interface
(
3
,
length_zfft
,
zfft
,
forw
)
call
fft_interface
(
3
,
length_zfft
,
zfft
,
forw
)
afft
=
real
(
zfft
)
bfft
=
aimag
(
zfft
)
IF
(
isn
.LT.
0
)
THEN
IF
(
isn
<
0
)
THEN
!
! ---> collect stars from the fft-grid
!
DO
i
=
1
,
stars
%
ng3
fg3
(
i
)
=
cmplx
(
0.0
,
0.0
)
ENDDO
DO
i
=
0
,
stars
%
kimax
fg3
(
stars
%
igfft
(
i
,
1
))
=
fg3
(
stars
%
igfft
(
i
,
1
))
+
CONJG
(
stars
%
pgfft
(
i
)
)
*
&
&
zfft
(
stars
%
igfft
(
i
,
2
))
ENDDO
scale
=
1.0
/
ifftd
IF
(
PRESENT
(
scaled
))
THEN
IF
(
scaled
)
THEN
fg3
=
scale
*
fg3
/
stars
%
nstr
ELSE
fg3
=
scale
*
fg3
ENDIF
ELSE
fg3
=
scale
*
fg3
/
stars
%
nstr
ENDIF
DO
i
=
1
,
stars
%
ng3
fg3
(
i
)
=
cmplx
(
0.0
,
0.0
)
ENDDO
DO
i
=
0
,
stars
%
kimax
fg3
(
stars
%
igfft
(
i
,
1
))
=
fg3
(
stars
%
igfft
(
i
,
1
))
+
CONJG
(
stars
%
pgfft
(
i
))
*
&
&
zfft
(
stars
%
igfft
(
i
,
2
))
ENDDO
scale
=
1.0
/
ifftd
IF
(
PRESENT
(
scaled
))
THEN
IF
(
scaled
)
THEN
fg3
=
scale
*
fg3
/
stars
%
nstr
ELSE
fg3
=
scale
*
fg3
ENDIF
ELSE
fg3
=
scale
*
fg3
/
stars
%
nstr
ENDIF
ENDIF
END
SUBROUTINE
fft3d
END
MODULE
m_fft3d
END
SUBROUTINE
fft3d
END
MODULE
m_fft3d
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment