From 2ce82bba1cdc03a0176219ff639b4cc04b361eaf Mon Sep 17 00:00:00 2001 From: rouson Date: Mon, 18 Mar 2024 05:55:46 +0000 Subject: [PATCH] =?UTF-8?q?Deploying=20to=20gh-pages=20from=20=20@=200f73f?= =?UTF-8?q?4e3ff6b8eb535ac702118c89dc6243999ce=20=F0=9F=9A=80?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- index.html | 9 +- interface/dcosqb.html | 2 +- interface/dcosqf.html | 2 +- interface/dcosqi.html | 2 +- interface/dcost.html | 2 +- interface/dcosti.html | 2 +- interface/dct.html | 2 +- interface/dct_t1.html | 2 +- interface/dct_t1i.html | 2 +- interface/dct_t2.html | 2 +- interface/dct_t23i.html | 2 +- interface/dct_t3.html | 2 +- interface/dfftb.html | 2 +- interface/dfftf.html | 2 +- interface/dffti.html | 2 +- interface/dzfftb.html | 2 +- interface/dzfftf.html | 2 +- interface/dzffti.html | 2 +- interface/fft.html | 2 +- interface/fftfreq.html | 2 +- interface/fftshift.html | 2 +- interface/idct.html | 2 +- interface/ifft.html | 2 +- interface/ifftshift.html | 2 +- interface/irfft.html | 2 +- interface/rfft.html | 2 +- interface/rfftfreq.html | 2 +- interface/zfftb.html | 2 +- interface/zfftf.html | 2 +- interface/zffti.html | 2 +- lists/files.html | 2 +- lists/modules.html | 2 +- lists/procedures.html | 2 +- module/fftpack.html | 2 +- module/fftpack_dct.html | 2 +- module/fftpack_fft.html | 2 +- module/fftpack_fftshift.html | 2 +- module/fftpack_ifft.html | 2 +- module/fftpack_ifftshift.html | 2 +- module/fftpack_irfft.html | 2 +- module/fftpack_kind.html | 2 +- module/fftpack_rfft.html | 2 +- module/fftpack_utils.html | 2 +- page/Makefile | 96 --- page/README | 31 - page/doc | 868 -------------------------- page/doc.double | 25 - page/index.html | 2 +- page/origMakefile | 63 -- page/specs/fftpack.html | 2 +- page/specs/fftpack_kind.html | 2 +- page/specs/index.html | 2 +- proc/cfftb1.html | 2 +- proc/cfftf1.html | 2 +- proc/cffti1.html | 2 +- proc/cosqb1.html | 2 +- proc/cosqf1.html | 2 +- proc/dcosqb.html | 2 +- proc/dcosqf.html | 2 +- proc/dcosqi.html | 2 +- proc/dcost.html | 2 +- proc/dcosti.html | 2 +- proc/dfftb.html | 2 +- proc/dfftf.html | 2 +- proc/dffti.html | 2 +- proc/dsinqb.html | 2 +- proc/dsinqf.html | 2 +- proc/dsinqi.html | 2 +- proc/dsint.html | 2 +- proc/dsinti.html | 2 +- proc/dzfftb.html | 2 +- proc/dzfftf.html | 2 +- proc/dzffti.html | 2 +- proc/ezfft1.html | 2 +- proc/passb.html | 2 +- proc/passb2.html | 2 +- proc/passb3.html | 2 +- proc/passb4.html | 2 +- proc/passb5.html | 2 +- proc/passf.html | 2 +- proc/passf2.html | 2 +- proc/passf3.html | 2 +- proc/passf4.html | 2 +- proc/passf5.html | 2 +- proc/radb2.html | 2 +- proc/radb3.html | 2 +- proc/radb4.html | 2 +- proc/radb5.html | 2 +- proc/radbg.html | 2 +- proc/radf2.html | 2 +- proc/radf3.html | 2 +- proc/radf4.html | 2 +- proc/radf5.html | 2 +- proc/radfg.html | 2 +- proc/rfftb1.html | 2 +- proc/rfftf1.html | 2 +- proc/rffti1.html | 2 +- proc/sint1.html | 2 +- proc/zfftb.html | 2 +- proc/zfftf.html | 2 +- proc/zffti.html | 2 +- search.html | 2 +- sourcefile/cfftb1.f90.html | 2 +- sourcefile/cfftf1.f90.html | 2 +- sourcefile/cffti1.f90.html | 2 +- sourcefile/cosqb1.f90.html | 2 +- sourcefile/cosqf1.f90.html | 2 +- sourcefile/dcosqb.f90.html | 2 +- sourcefile/dcosqf.f90.html | 2 +- sourcefile/dcosqi.f90.html | 2 +- sourcefile/dcost.f90.html | 2 +- sourcefile/dcosti.f90.html | 2 +- sourcefile/dfftb.f90.html | 2 +- sourcefile/dfftf.f90.html | 2 +- sourcefile/dffti.f90.html | 2 +- sourcefile/dsinqb.f90.html | 2 +- sourcefile/dsinqf.f90.html | 2 +- sourcefile/dsinqi.f90.html | 2 +- sourcefile/dsint.f90.html | 2 +- sourcefile/dsinti.f90.html | 2 +- sourcefile/dzfftb.f90.html | 2 +- sourcefile/dzfftf.f90.html | 2 +- sourcefile/dzffti.f90.html | 2 +- sourcefile/ezfft1.f90.html | 2 +- sourcefile/fftpack.f90.html | 2 +- sourcefile/fftpack_dct.f90.html | 2 +- sourcefile/fftpack_fft.f90.html | 2 +- sourcefile/fftpack_fftshift.f90.html | 2 +- sourcefile/fftpack_ifft.f90.html | 2 +- sourcefile/fftpack_ifftshift.f90.html | 2 +- sourcefile/fftpack_irfft.f90.html | 2 +- sourcefile/fftpack_rfft.f90.html | 2 +- sourcefile/fftpack_utils.f90.html | 2 +- sourcefile/passb.f90.html | 2 +- sourcefile/passb2.f90.html | 2 +- sourcefile/passb3.f90.html | 2 +- sourcefile/passb4.f90.html | 2 +- sourcefile/passb5.f90.html | 2 +- sourcefile/passf.f90.html | 2 +- sourcefile/passf2.f90.html | 2 +- sourcefile/passf3.f90.html | 2 +- sourcefile/passf4.f90.html | 2 +- sourcefile/passf5.f90.html | 2 +- sourcefile/radb2.f90.html | 2 +- sourcefile/radb3.f90.html | 2 +- sourcefile/radb4.f90.html | 2 +- sourcefile/radb5.f90.html | 2 +- sourcefile/radbg.f90.html | 2 +- sourcefile/radf2.f90.html | 2 +- sourcefile/radf3.f90.html | 2 +- sourcefile/radf4.f90.html | 2 +- sourcefile/radf5.f90.html | 2 +- sourcefile/radfg.f90.html | 2 +- sourcefile/rfftb1.f90.html | 2 +- sourcefile/rfftf1.f90.html | 2 +- sourcefile/rffti1.f90.html | 2 +- sourcefile/rk.f90.html | 2 +- sourcefile/sint1.f90.html | 2 +- sourcefile/zfftb.f90.html | 2 +- sourcefile/zfftf.f90.html | 2 +- sourcefile/zffti.f90.html | 2 +- tipuesearch/tipuesearch_content.js | 2 +- 162 files changed, 161 insertions(+), 1243 deletions(-) delete mode 100644 page/Makefile delete mode 100644 page/README delete mode 100644 page/doc delete mode 100644 page/doc.double delete mode 100644 page/origMakefile diff --git a/index.html b/index.html index d6b679f..0c81077 100644 --- a/index.html +++ b/index.html @@ -166,9 +166,9 @@

Documentation

See the our GitHub Pages site for documentation generated by FORD from the fortran-lang/fftpack project file.

References

Although fortran-lang is not interface-compatible with any of the following libraries, each contains documentation that might be useful for different reasons: -- Recommended reference: The scipy.fftpack documentation contains succinct description of the storage sequences for function results that match those in fortran-lang/fftpack, e.g., the location of the real and imaginary parts of the rfft function result. -- Theory reference: The documentation for the GNU/gsl FFT routines, which are also based on netlib/fftpack, provides some useful definitions of FFT terminology and represenations of the analytical forms of the Discrete Fourier Transform nicely formatted by LaTeX. -- Historical reference: The netlib/fftpack library on which fortran-lang/fftpack is useful for understanding several fortran-lang/fftpack design choices, e.g., the procedure dependencies.

+* Recommended reference: The scipy.fftpack documentation contains succinct description of the storage sequences for function results that match those in fortran-lang/fftpack, e.g., the location of the real and imaginary parts of the rfft function result. +* Theory reference: The documentation for the GNU/gsl FFT routines, which are also based on netlib/fftpack, provides some useful definitions of FFT terminology and represenations of the analytical forms of the Discrete Fourier Transform nicely formatted by LaTeX. +* Historical reference: The netlib/fftpack library on which fortran-lang/fftpack is useful for understanding several fortran-lang/fftpack design choices, e.g., the procedure dependencies.

@@ -178,6 +178,7 @@

Paul N. Swarztrauber & Developer picture
+ @@ -234,7 +235,7 @@

Procedures

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dcosqb.html b/interface/dcosqb.html index 21ad52c..4a9cac7 100644 --- a/interface/dcosqb.html +++ b/interface/dcosqb.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dcosqf.html b/interface/dcosqf.html index 5b1ae8b..5615b29 100644 --- a/interface/dcosqf.html +++ b/interface/dcosqf.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dcosqi.html b/interface/dcosqi.html index c3a64f1..ad9b2c4 100644 --- a/interface/dcosqi.html +++ b/interface/dcosqi.html @@ -216,7 +216,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dcost.html b/interface/dcost.html index 449da25..b51a578 100644 --- a/interface/dcost.html +++ b/interface/dcost.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dcosti.html b/interface/dcosti.html index 4c2d053..13459d2 100644 --- a/interface/dcosti.html +++ b/interface/dcosti.html @@ -216,7 +216,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dct.html b/interface/dct.html index 92a05f7..5d39a82 100644 --- a/interface/dct.html +++ b/interface/dct.html @@ -292,7 +292,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dct_t1.html b/interface/dct_t1.html index cdf1275..58b97d9 100644 --- a/interface/dct_t1.html +++ b/interface/dct_t1.html @@ -231,7 +231,7 @@

Arguments

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dct_t1i.html b/interface/dct_t1i.html index 382d349..301c8ea 100644 --- a/interface/dct_t1i.html +++ b/interface/dct_t1i.html @@ -231,7 +231,7 @@

Arguments

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dct_t2.html b/interface/dct_t2.html index 932f3aa..5c52cc7 100644 --- a/interface/dct_t2.html +++ b/interface/dct_t2.html @@ -231,7 +231,7 @@

Arguments

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dct_t23i.html b/interface/dct_t23i.html index ea9c7ec..6081ed7 100644 --- a/interface/dct_t23i.html +++ b/interface/dct_t23i.html @@ -231,7 +231,7 @@

Arguments

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dct_t3.html b/interface/dct_t3.html index 5d935c1..11ff4bc 100644 --- a/interface/dct_t3.html +++ b/interface/dct_t3.html @@ -231,7 +231,7 @@

Arguments

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dfftb.html b/interface/dfftb.html index 65a64b8..9917294 100644 --- a/interface/dfftb.html +++ b/interface/dfftb.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dfftf.html b/interface/dfftf.html index 074da87..337971a 100644 --- a/interface/dfftf.html +++ b/interface/dfftf.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dffti.html b/interface/dffti.html index 0f71c85..73eb377 100644 --- a/interface/dffti.html +++ b/interface/dffti.html @@ -216,7 +216,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dzfftb.html b/interface/dzfftb.html index 8ae87b6..288f3f7 100644 --- a/interface/dzfftb.html +++ b/interface/dzfftb.html @@ -276,7 +276,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dzfftf.html b/interface/dzfftf.html index 95da6c4..a723233 100644 --- a/interface/dzfftf.html +++ b/interface/dzfftf.html @@ -276,7 +276,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/dzffti.html b/interface/dzffti.html index e5f8526..9d67ea0 100644 --- a/interface/dzffti.html +++ b/interface/dzffti.html @@ -216,7 +216,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/fft.html b/interface/fft.html index 8386033..a796cf2 100644 --- a/interface/fft.html +++ b/interface/fft.html @@ -277,7 +277,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/fftfreq.html b/interface/fftfreq.html index 5afcfce..bc5b03b 100644 --- a/interface/fftfreq.html +++ b/interface/fftfreq.html @@ -203,7 +203,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/fftshift.html b/interface/fftshift.html index ac9771d..08740f2 100644 --- a/interface/fftshift.html +++ b/interface/fftshift.html @@ -308,7 +308,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/idct.html b/interface/idct.html index 1f89d58..d4de709 100644 --- a/interface/idct.html +++ b/interface/idct.html @@ -292,7 +292,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/ifft.html b/interface/ifft.html index e258034..8cd82ca 100644 --- a/interface/ifft.html +++ b/interface/ifft.html @@ -277,7 +277,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/ifftshift.html b/interface/ifftshift.html index 5e573ed..7a67c57 100644 --- a/interface/ifftshift.html +++ b/interface/ifftshift.html @@ -308,7 +308,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/irfft.html b/interface/irfft.html index ec92dea..2e6e93e 100644 --- a/interface/irfft.html +++ b/interface/irfft.html @@ -277,7 +277,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/rfft.html b/interface/rfft.html index 47d388f..32cd5e8 100644 --- a/interface/rfft.html +++ b/interface/rfft.html @@ -277,7 +277,7 @@

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/rfftfreq.html b/interface/rfftfreq.html index 0051daa..8795fc4 100644 --- a/interface/rfftfreq.html +++ b/interface/rfftfreq.html @@ -203,7 +203,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/zfftb.html b/interface/zfftb.html index c59ab96..2d7b859 100644 --- a/interface/zfftb.html +++ b/interface/zfftb.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/zfftf.html b/interface/zfftf.html index 952bf0e..739cc0b 100644 --- a/interface/zfftf.html +++ b/interface/zfftf.html @@ -231,7 +231,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/interface/zffti.html b/interface/zffti.html index 4034dff..4a513ed 100644 --- a/interface/zffti.html +++ b/interface/zffti.html @@ -216,7 +216,7 @@

Description

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/lists/files.html b/lists/files.html index a48fdec..181063b 100644 --- a/lists/files.html +++ b/lists/files.html @@ -158,7 +158,7 @@

Source Files

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/lists/modules.html b/lists/modules.html index 0f1f14f..61a2334 100644 --- a/lists/modules.html +++ b/lists/modules.html @@ -110,7 +110,7 @@

Modules

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/lists/procedures.html b/lists/procedures.html index f2e618d..f53d1d3 100644 --- a/lists/procedures.html +++ b/lists/procedures.html @@ -190,7 +190,7 @@

Procedures

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack.html b/module/fftpack.html index cfff540..ae3f64b 100644 --- a/module/fftpack.html +++ b/module/fftpack.html @@ -2336,7 +2336,7 @@

Arguments

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_dct.html b/module/fftpack_dct.html index 3fdc1ea..590d25b 100644 --- a/module/fftpack_dct.html +++ b/module/fftpack_dct.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_fft.html b/module/fftpack_fft.html index 1b6820e..fa17cea 100644 --- a/module/fftpack_fft.html +++ b/module/fftpack_fft.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_fftshift.html b/module/fftpack_fftshift.html index ff0507c..8a603b2 100644 --- a/module/fftpack_fftshift.html +++ b/module/fftpack_fftshift.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_ifft.html b/module/fftpack_ifft.html index 7ff4a50..48788a7 100644 --- a/module/fftpack_ifft.html +++ b/module/fftpack_ifft.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_ifftshift.html b/module/fftpack_ifftshift.html index 430ca6a..6d81432 100644 --- a/module/fftpack_ifftshift.html +++ b/module/fftpack_ifftshift.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_irfft.html b/module/fftpack_irfft.html index d585f35..9f9c21a 100644 --- a/module/fftpack_irfft.html +++ b/module/fftpack_irfft.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_kind.html b/module/fftpack_kind.html index 116cf11..34d36b9 100644 --- a/module/fftpack_kind.html +++ b/module/fftpack_kind.html @@ -257,7 +257,7 @@

Variables

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_rfft.html b/module/fftpack_rfft.html index a772f18..e4067ce 100644 --- a/module/fftpack_rfft.html +++ b/module/fftpack_rfft.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/module/fftpack_utils.html b/module/fftpack_utils.html index b236336..46c1f0e 100644 --- a/module/fftpack_utils.html +++ b/module/fftpack_utils.html @@ -214,7 +214,7 @@

Contents

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/page/Makefile b/page/Makefile deleted file mode 100644 index 952e704..0000000 --- a/page/Makefile +++ /dev/null @@ -1,96 +0,0 @@ -# Several changes made by HCP so this would build without trouble -# on a Linux/g77 system. -# (1) changed step to build library to use ar instead of update -# (update must mean something different on someone elses Unix.) -# (2) Added make clean step -# (3) In test step, changed a.out to ./a.out for cautious folk who don't -# have "." in their PATH. -# (4) Change FFLAGS from -O to -O2 -funroll-loops -# (5) Specify FC=gcc in case /usr/bin/f77 is not a link to g77 -# (as it won't be if you have f77reorder installed) -# (6) Added targets shared and installshared to make and install a shared -# version of the library. You need /usr/local/lib in /etc/ld.so.conf -# for this to work -# (7) Modified names for dble prec version -LIB=dfftpack - -# Use these lines for Linux/g77 -FC=g77 -FFLAGS=-O2 -funroll-loops -fexpensive-optimizations - -# Use these lines for Solaris -#FC=f77 -#FFLAGS=-fast -O5 - -OBJ=\ -zfftb.o\ -cfftb1.o\ -zfftf.o\ -cfftf1.o\ -zffti.o\ -cffti1.o\ -dcosqb.o\ -cosqb1.o\ -dcosqf.o\ -cosqf1.o\ -dcosqi.o\ -dcost.o\ -dcosti.o\ -ezfft1.o\ -dzfftb.o\ -dzfftf.o\ -dzffti.o\ -passb.o\ -passb2.o\ -passb3.o\ -passb4.o\ -passb5.o\ -passf.o\ -passf2.o\ -passf3.o\ -passf4.o\ -passf5.o\ -radb2.o\ -radb3.o\ -radb4.o\ -radb5.o\ -radbg.o\ -radf2.o\ -radf3.o\ -radf4.o\ -radf5.o\ -radfg.o\ -dfftb.o\ -rfftb1.o\ -dfftf.o\ -rfftf1.o\ -dffti.o\ -rffti1.o\ -dsinqb.o\ -dsinqf.o\ -dsinqi.o\ -dsint.o\ -sint1.o\ -dsinti.o - -lib$(LIB).a: $(OBJ) - ar -rcs lib$(LIB).a $(OBJ) - -shared:$(OBJ) - $(FC) -shared -o lib$(LIB).so $(OBJ) - -install: lib$(LIB).a - mv lib$(LIB).a /usr/local/lib - rm *.o - -installshared:lib$(LIB).so - mv lib$(LIB).so /usr/local/lib - rm *.o - ldconfig - -test: test.o - $(FC) test.o -L./ -l$(LIB) - time ./a.out - -clean: - rm -f -r *.o *.a *.so diff --git a/page/README b/page/README deleted file mode 100644 index 4780f1a..0000000 --- a/page/README +++ /dev/null @@ -1,31 +0,0 @@ - DFFTPACK V1.0 -***************************************************************** - A Double precision clone by Hugh C. Pumphrey of: - FFTPACK - version 4 april 1985 - -The gzipped tar file dp.tgz contains a complete copy of the FORTRAN -sources of fftpack, with everything converted to double precision. If -you do - -gunzip dp.tgz -tar xvf dfftpack.tar - -You will get a directory called dfftpack with all the source code in -it. There is also: - -(*) a Makefile which I have tweaked to work on modern Linux and Solaris -systems. The comments in this file document the changes made. - -(*) a file doc which was supplied with fftpack and which has been -altered to reflect the changes made in the change to double precision. - -(*) A file doc.double which details the changes I made to the source code - -Please send any comments or bug reports to hcp@met.ed.ac.uk . Please -also report if you get dfftpack to build successfully on any system -other than Linux or Solaris. - -The original FFTPACK was public domain, so dfftpack is public domain -too. It is released in the hope it will be useful to someone. There is -no warranty of any sort covering this software. diff --git a/page/doc b/page/doc deleted file mode 100644 index 9457147..0000000 --- a/page/doc +++ /dev/null @@ -1,868 +0,0 @@ - DFFTPACK V1.0 -***************************************************************** - - A Double precision clone by Hugh C. Pumphrey of: - - FFTPACK - version 4 april 1985 - - a package of fortran subprograms for the fast fourier - transform of periodic and other symmetric sequences - - by - - paul n swarztrauber - - national center for atmospheric research boulder,colorado 80307 - - which is sponsored by the national science foundation - -* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * - - -this package consists of programs which perform fast fourier -transforms for both double complex and (double precision) real -periodic sequences and certain other symmetric sequences that are -listed below. - -1. dffti initialize dfftf and dfftb -2. dfftf forward transform of a real periodic sequence -3. dfftb backward transform of a real coefficient array - -4. dzffti initialize dzfftf and dzfftb -5. dzfftf a simplified real periodic forward transform -6. dzfftb a simplified real periodic backward transform - -7. dsinti initialize dsint -8. dsint sine transform of a real odd sequence - -9. dcosti initialize dcost -10. dcost cosine transform of a real even sequence - -11. dsinqi initialize dsinqf and dsinqb -12. dsinqf forward sine transform with odd wave numbers -13. dsinqb unnormalized inverse of dsinqf - -14. dcosqi initialize dcosqf and dcosqb -15. dcosqf forward cosine transform with odd wave numbers -16. dcosqb unnormalized inverse of dcosqf - -17. zffti initialize zfftf and zfftb -18. zfftf forward transform of a double complex periodic sequence -19. zfftb unnormalized inverse of zfftf - - -****************************************************************** - -subroutine dffti(n,wsave) - - **************************************************************** - -subroutine dffti initializes the array wsave which is used in -both dfftf and dfftb. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the sequence to be transformed. - -output parameter - -wsave a work array which must be dimensioned at least 2*n+15. - the same work array can be used for both dfftf and dfftb - as long as n remains unchanged. different wsave arrays - are required for different values of n. the contents of - wsave must not be changed between calls of dfftf or dfftb. - -****************************************************************** - -subroutine dfftf(n,r,wsave) - -****************************************************************** - -subroutine dfftf computes the fourier coefficients of a real -perodic sequence (fourier analysis). the transform is defined -below at output parameter r. - -input parameters - -n the length of the array r to be transformed. the method - is most efficient when n is a product of small primes. - n may change so long as different work arrays are provided - -r a real array of length n which contains the sequence - to be transformed - -wsave a work array which must be dimensioned at least 2*n+15. - in the program that calls dfftf. the wsave array must be - initialized by calling subroutine dffti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - the same wsave array can be used by dfftf and dfftb. - - -output parameters - -r r(1) = the sum from i=1 to i=n of r(i) - - if n is even set l =n/2 , if n is odd set l = (n+1)/2 - - then for k = 2,...,l - - r(2*k-2) = the sum from i = 1 to i = n of - - r(i)*cos((k-1)*(i-1)*2*pi/n) - - r(2*k-1) = the sum from i = 1 to i = n of - - -r(i)*sin((k-1)*(i-1)*2*pi/n) - - if n is even - - r(n) = the sum from i = 1 to i = n of - - (-1)**(i-1)*r(i) - - ***** note - this transform is unnormalized since a call of dfftf - followed by a call of dfftb will multiply the input - sequence by n. - -wsave contains results which must not be destroyed between - calls of dfftf or dfftb. - - -****************************************************************** - -subroutine dfftb(n,r,wsave) - -****************************************************************** - -subroutine dfftb computes the real perodic sequence from its -fourier coefficients (fourier synthesis). the transform is defined -below at output parameter r. - -input parameters - -n the length of the array r to be transformed. the method - is most efficient when n is a product of small primes. - n may change so long as different work arrays are provided - -r a real array of length n which contains the sequence - to be transformed - -wsave a work array which must be dimensioned at least 2*n+15. - in the program that calls dfftb. the wsave array must be - initialized by calling subroutine dffti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - the same wsave array can be used by dfftf and dfftb. - - -output parameters - -r for n even and for i = 1,...,n - - r(i) = r(1)+(-1)**(i-1)*r(n) - - plus the sum from k=2 to k=n/2 of - - 2.*r(2*k-2)*cos((k-1)*(i-1)*2*pi/n) - - -2.*r(2*k-1)*sin((k-1)*(i-1)*2*pi/n) - - for n odd and for i = 1,...,n - - r(i) = r(1) plus the sum from k=2 to k=(n+1)/2 of - - 2.*r(2*k-2)*cos((k-1)*(i-1)*2*pi/n) - - -2.*r(2*k-1)*sin((k-1)*(i-1)*2*pi/n) - - ***** note - this transform is unnormalized since a call of dfftf - followed by a call of dfftb will multiply the input - sequence by n. - -wsave contains results which must not be destroyed between - calls of dfftb or dfftf. - - -****************************************************************** - -subroutine dzffti(n,wsave) - -****************************************************************** - -subroutine dzffti initializes the array wsave which is used in -both dzfftf and dzfftb. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the sequence to be transformed. - -output parameter - -wsave a work array which must be dimensioned at least 3*n+15. - the same work array can be used for both dzfftf and dzfftb - as long as n remains unchanged. different wsave arrays - are required for different values of n. - - -****************************************************************** - -subroutine dzfftf(n,r,azero,a,b,wsave) - -****************************************************************** - -subroutine dzfftf computes the fourier coefficients of a real -perodic sequence (fourier analysis). the transform is defined -below at output parameters azero,a and b. dzfftf is a simplified -but slower version of dfftf. - -input parameters - -n the length of the array r to be transformed. the method - is most efficient when n is the product of small primes. - -r a real array of length n which contains the sequence - to be transformed. r is not destroyed. - - -wsave a work array which must be dimensioned at least 3*n+15. - in the program that calls dzfftf. the wsave array must be - initialized by calling subroutine dzffti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - the same wsave array can be used by dzfftf and dzfftb. - -output parameters - -azero the sum from i=1 to i=n of r(i)/n - -a,b for n even b(n/2)=0. and a(n/2) is the sum from i=1 to - i=n of (-1)**(i-1)*r(i)/n - - for n even define kmax=n/2-1 - for n odd define kmax=(n-1)/2 - - then for k=1,...,kmax - - a(k) equals the sum from i=1 to i=n of - - 2./n*r(i)*cos(k*(i-1)*2*pi/n) - - b(k) equals the sum from i=1 to i=n of - - 2./n*r(i)*sin(k*(i-1)*2*pi/n) - - -****************************************************************** - -subroutine dzfftb(n,r,azero,a,b,wsave) - -****************************************************************** - -subroutine dzfftb computes a real perodic sequence from its -fourier coefficients (fourier synthesis). the transform is -defined below at output parameter r. dzfftb is a simplified -but slower version of dfftb. - -input parameters - -n the length of the output array r. the method is most - efficient when n is the product of small primes. - -azero the constant fourier coefficient - -a,b arrays which contain the remaining fourier coefficients - these arrays are not destroyed. - - the length of these arrays depends on whether n is even or - odd. - - if n is even n/2 locations are required - if n is odd (n-1)/2 locations are required - -wsave a work array which must be dimensioned at least 3*n+15. - in the program that calls dzfftb. the wsave array must be - initialized by calling subroutine dzffti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - the same wsave array can be used by dzfftf and dzfftb. - - -output parameters - -r if n is even define kmax=n/2 - if n is odd define kmax=(n-1)/2 - - then for i=1,...,n - - r(i)=azero plus the sum from k=1 to k=kmax of - - a(k)*cos(k*(i-1)*2*pi/n)+b(k)*sin(k*(i-1)*2*pi/n) - -********************* complex notation ************************** - - for j=1,...,n - - r(j) equals the sum from k=-kmax to k=kmax of - - c(k)*exp(i*k*(j-1)*2*pi/n) - - where - - c(k) = .5*cmplx(a(k),-b(k)) for k=1,...,kmax - - c(-k) = conjg(c(k)) - - c(0) = azero - - and i=sqrt(-1) - -*************** amplitude - phase notation *********************** - - for i=1,...,n - - r(i) equals azero plus the sum from k=1 to k=kmax of - - alpha(k)*cos(k*(i-1)*2*pi/n+beta(k)) - - where - - alpha(k) = sqrt(a(k)*a(k)+b(k)*b(k)) - - cos(beta(k))=a(k)/alpha(k) - - sin(beta(k))=-b(k)/alpha(k) - -****************************************************************** - -subroutine dsinti(n,wsave) - -****************************************************************** - -subroutine dsinti initializes the array wsave which is used in -subroutine dsint. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the sequence to be transformed. the method - is most efficient when n+1 is a product of small primes. - -output parameter - -wsave a work array with at least int(2.5*n+15) locations. - different wsave arrays are required for different values - of n. the contents of wsave must not be changed between - calls of dsint. - -****************************************************************** - -subroutine dsint(n,x,wsave) - -****************************************************************** - -subroutine dsint computes the discrete fourier sine transform -of an odd sequence x(i). the transform is defined below at -output parameter x. - -dsint is the unnormalized inverse of itself since a call of dsint -followed by another call of dsint will multiply the input sequence -x by 2*(n+1). - -the array wsave which is used by subroutine dsint must be -initialized by calling subroutine dsinti(n,wsave). - -input parameters - -n the length of the sequence to be transformed. the method - is most efficient when n+1 is the product of small primes. - -x an array which contains the sequence to be transformed - - -wsave a work array with dimension at least int(2.5*n+15) - in the program that calls dsint. the wsave array must be - initialized by calling subroutine dsinti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - -output parameters - -x for i=1,...,n - - x(i)= the sum from k=1 to k=n - - 2*x(k)*sin(k*i*pi/(n+1)) - - a call of dsint followed by another call of - dsint will multiply the sequence x by 2*(n+1). - hence dsint is the unnormalized inverse - of itself. - -wsave contains initialization calculations which must not be - destroyed between calls of dsint. - -****************************************************************** - -subroutine dcosti(n,wsave) - -****************************************************************** - -subroutine dcosti initializes the array wsave which is used in -subroutine dcost. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the sequence to be transformed. the method - is most efficient when n-1 is a product of small primes. - -output parameter - -wsave a work array which must be dimensioned at least 3*n+15. - different wsave arrays are required for different values - of n. the contents of wsave must not be changed between - calls of dcost. - -****************************************************************** - -subroutine dcost(n,x,wsave) - -****************************************************************** - -subroutine dcost computes the discrete fourier cosine transform -of an even sequence x(i). the transform is defined below at output -parameter x. - -dcost is the unnormalized inverse of itself since a call of dcost -followed by another call of dcost will multiply the input sequence -x by 2*(n-1). the transform is defined below at output parameter x - -the array wsave which is used by subroutine dcost must be -initialized by calling subroutine dcosti(n,wsave). - -input parameters - -n the length of the sequence x. n must be greater than 1. - the method is most efficient when n-1 is a product of - small primes. - -x an array which contains the sequence to be transformed - -wsave a work array which must be dimensioned at least 3*n+15 - in the program that calls dcost. the wsave array must be - initialized by calling subroutine dcosti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - -output parameters - -x for i=1,...,n - - x(i) = x(1)+(-1)**(i-1)*x(n) - - + the sum from k=2 to k=n-1 - - 2*x(k)*cos((k-1)*(i-1)*pi/(n-1)) - - a call of dcost followed by another call of - dcost will multiply the sequence x by 2*(n-1) - hence dcost is the unnormalized inverse - of itself. - -wsave contains initialization calculations which must not be - destroyed between calls of dcost. - -****************************************************************** - -subroutine dsinqi(n,wsave) - -****************************************************************** - -subroutine dsinqi initializes the array wsave which is used in -both dsinqf and dsinqb. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the sequence to be transformed. the method - is most efficient when n is a product of small primes. - -output parameter - -wsave a work array which must be dimensioned at least 3*n+15. - the same work array can be used for both dsinqf and dsinqb - as long as n remains unchanged. different wsave arrays - are required for different values of n. the contents of - wsave must not be changed between calls of dsinqf or dsinqb. - -****************************************************************** - -subroutine dsinqf(n,x,wsave) - -****************************************************************** - -subroutine dsinqf computes the fast fourier transform of quarter -wave data. that is , dsinqf computes the coefficients in a sine -series representation with only odd wave numbers. the transform -is defined below at output parameter x. - -dsinqb is the unnormalized inverse of dsinqf since a call of dsinqf -followed by a call of dsinqb will multiply the input sequence x -by 4*n. - -the array wsave which is used by subroutine dsinqf must be -initialized by calling subroutine dsinqi(n,wsave). - - -input parameters - -n the length of the array x to be transformed. the method - is most efficient when n is a product of small primes. - -x an array which contains the sequence to be transformed - -wsave a work array which must be dimensioned at least 3*n+15. - in the program that calls dsinqf. the wsave array must be - initialized by calling subroutine dsinqi(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - -output parameters - -x for i=1,...,n - - x(i) = (-1)**(i-1)*x(n) - - + the sum from k=1 to k=n-1 of - - 2*x(k)*sin((2*i-1)*k*pi/(2*n)) - - a call of dsinqf followed by a call of - dsinqb will multiply the sequence x by 4*n. - therefore dsinqb is the unnormalized inverse - of dsinqf. - -wsave contains initialization calculations which must not - be destroyed between calls of dsinqf or dsinqb. - -****************************************************************** - -subroutine dsinqb(n,x,wsave) - -****************************************************************** - -subroutine dsinqb computes the fast fourier transform of quarter -wave data. that is , dsinqb computes a sequence from its -representation in terms of a sine series with odd wave numbers. -the transform is defined below at output parameter x. - -dsinqf is the unnormalized inverse of dsinqb since a call of dsinqb -followed by a call of dsinqf will multiply the input sequence x -by 4*n. - -the array wsave which is used by subroutine dsinqb must be -initialized by calling subroutine dsinqi(n,wsave). - - -input parameters - -n the length of the array x to be transformed. the method - is most efficient when n is a product of small primes. - -x an array which contains the sequence to be transformed - -wsave a work array which must be dimensioned at least 3*n+15. - in the program that calls dsinqb. the wsave array must be - initialized by calling subroutine dsinqi(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - -output parameters - -x for i=1,...,n - - x(i)= the sum from k=1 to k=n of - - 4*x(k)*sin((2k-1)*i*pi/(2*n)) - - a call of dsinqb followed by a call of - dsinqf will multiply the sequence x by 4*n. - therefore dsinqf is the unnormalized inverse - of dsinqb. - -wsave contains initialization calculations which must not - be destroyed between calls of dsinqb or dsinqf. - -****************************************************************** - -subroutine dcosqi(n,wsave) - -****************************************************************** - -subroutine dcosqi initializes the array wsave which is used in -both dcosqf and dcosqb. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the array to be transformed. the method - is most efficient when n is a product of small primes. - -output parameter - -wsave a work array which must be dimensioned at least 3*n+15. - the same work array can be used for both dcosqf and dcosqb - as long as n remains unchanged. different wsave arrays - are required for different values of n. the contents of - wsave must not be changed between calls of dcosqf or dcosqb. - -****************************************************************** - -subroutine dcosqf(n,x,wsave) - -****************************************************************** - -subroutine dcosqf computes the fast fourier transform of quarter -wave data. that is , dcosqf computes the coefficients in a cosine -series representation with only odd wave numbers. the transform -is defined below at output parameter x - -dcosqf is the unnormalized inverse of dcosqb since a call of dcosqf -followed by a call of dcosqb will multiply the input sequence x -by 4*n. - -the array wsave which is used by subroutine dcosqf must be -initialized by calling subroutine dcosqi(n,wsave). - - -input parameters - -n the length of the array x to be transformed. the method - is most efficient when n is a product of small primes. - -x an array which contains the sequence to be transformed - -wsave a work array which must be dimensioned at least 3*n+15 - in the program that calls dcosqf. the wsave array must be - initialized by calling subroutine dcosqi(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - -output parameters - -x for i=1,...,n - - x(i) = x(1) plus the sum from k=2 to k=n of - - 2*x(k)*cos((2*i-1)*(k-1)*pi/(2*n)) - - a call of dcosqf followed by a call of - cosqb will multiply the sequence x by 4*n. - therefore dcosqb is the unnormalized inverse - of dcosqf. - -wsave contains initialization calculations which must not - be destroyed between calls of dcosqf or dcosqb. - -****************************************************************** - -subroutine dcosqb(n,x,wsave) - -****************************************************************** - -subroutine dcosqb computes the fast fourier transform of quarter -wave data. that is , dcosqb computes a sequence from its -representation in terms of a cosine series with odd wave numbers. -the transform is defined below at output parameter x. - -dcosqb is the unnormalized inverse of dcosqf since a call of dcosqb -followed by a call of dcosqf will multiply the input sequence x -by 4*n. - -the array wsave which is used by subroutine dcosqb must be -initialized by calling subroutine dcosqi(n,wsave). - - -input parameters - -n the length of the array x to be transformed. the method - is most efficient when n is a product of small primes. - -x an array which contains the sequence to be transformed - -wsave a work array that must be dimensioned at least 3*n+15 - in the program that calls dcosqb. the wsave array must be - initialized by calling subroutine dcosqi(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - -output parameters - -x for i=1,...,n - - x(i)= the sum from k=1 to k=n of - - 4*x(k)*cos((2*k-1)*(i-1)*pi/(2*n)) - - a call of dcosqb followed by a call of - dcosqf will multiply the sequence x by 4*n. - therefore dcosqf is the unnormalized inverse - of dcosqb. - -wsave contains initialization calculations which must not - be destroyed between calls of dcosqb or dcosqf. - -****************************************************************** - -subroutine zffti(n,wsave) - -****************************************************************** - -subroutine zffti initializes the array wsave which is used in -both zfftf and zfftb. the prime factorization of n together with -a tabulation of the trigonometric functions are computed and -stored in wsave. - -input parameter - -n the length of the sequence to be transformed - -output parameter - -wsave a work array which must be dimensioned at least 4*n+15 - the same work array can be used for both zfftf and zfftb - as long as n remains unchanged. different wsave arrays - are required for different values of n. the contents of - wsave must not be changed between calls of zfftf or zfftb. - -****************************************************************** - -subroutine zfftf(n,c,wsave) - -****************************************************************** - -subroutine zfftf computes the forward complex discrete fourier -transform (the fourier analysis). equivalently , zfftf computes -the fourier coefficients of a complex periodic sequence. -the transform is defined below at output parameter c. - -the transform is not normalized. to obtain a normalized transform -the output must be divided by n. otherwise a call of zfftf -followed by a call of zfftb will multiply the sequence by n. - -the array wsave which is used by subroutine zfftf must be -initialized by calling subroutine zffti(n,wsave). - -input parameters - - -n the length of the complex sequence c. the method is - more efficient when n is the product of small primes. n - -c a complex array of length n which contains the sequence - -wsave a real work array which must be dimensioned at least 4n+15 - in the program that calls zfftf. the wsave array must be - initialized by calling subroutine zffti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - the same wsave array can be used by zfftf and zfftb. - -output parameters - -c for j=1,...,n - - c(j)=the sum from k=1,...,n of - - c(k)*exp(-i*(j-1)*(k-1)*2*pi/n) - - where i=sqrt(-1) - -wsave contains initialization calculations which must not be - destroyed between calls of subroutine zfftf or zfftb - -****************************************************************** - -subroutine zfftb(n,c,wsave) - -****************************************************************** - -subroutine zfftb computes the backward complex discrete fourier -transform (the fourier synthesis). equivalently , zfftb computes -a complex periodic sequence from its fourier coefficients. -the transform is defined below at output parameter c. - -a call of zfftf followed by a call of zfftb will multiply the -sequence by n. - -the array wsave which is used by subroutine zfftb must be -initialized by calling subroutine zffti(n,wsave). - -input parameters - - -n the length of the complex sequence c. the method is - more efficient when n is the product of small primes. - -c a complex array of length n which contains the sequence - -wsave a real work array which must be dimensioned at least 4n+15 - in the program that calls zfftb. the wsave array must be - initialized by calling subroutine zffti(n,wsave) and a - different wsave array must be used for each different - value of n. this initialization does not have to be - repeated so long as n remains unchanged thus subsequent - transforms can be obtained faster than the first. - the same wsave array can be used by zfftf and zfftb. - -output parameters - -c for j=1,...,n - - c(j)=the sum from k=1,...,n of - - c(k)*exp(i*(j-1)*(k-1)*2*pi/n) - - where i=sqrt(-1) - -wsave contains initialization calculations which must not be - destroyed between calls of subroutine zfftf or zfftb - - - -["send index for vfftpk" describes a vectorized version of fftpack] - diff --git a/page/doc.double b/page/doc.double deleted file mode 100644 index e93e722..0000000 --- a/page/doc.double +++ /dev/null @@ -1,25 +0,0 @@ -This documents the changes done by HCP to make fftpack into dfftpack - -(1) Renamed all files corresponding to subroutines in the API - i.e. ones documented as callable by the luser. Names chosen to match - the ones in libsunperf. - -(2) Inserted IMPLICIT DOUBLE PRECISION (A-H,O-Z) after every - subroutine statement. This makes everything that used to be a real - into a double. - -(3) Replaced floating constants with Double Prec. constants. All - 0. become 0.D0 etc and PI, SQRT(2) etc. expanded to dble prec. - -(4) Replaced DIMENSION FOO(1) with DIMENSION FOO(*) where foo - is an array argument of a subroutine. I only did this in the places - where g77 notices it, so the compile looks cleaner. - -(5) Replaced COMPLEX with DOUBLE COMPLEX. Now, this is not standard - fortran 77, so the whole thing may fall apart if you have a VERY - vanilla Fortran 77 compiler. On the other hand, the only place a - complex is _declared_ as such is in the test program. If you don't have - DOUBLE COMPLEX my guess is that the library will work, except for - the routines ZFFTI, ZFFTB and ZFFTF. - -(6) Updated the file doc \ No newline at end of file diff --git a/page/index.html b/page/index.html index 4f40353..f785112 100644 --- a/page/index.html +++ b/page/index.html @@ -135,7 +135,7 @@

Contributing and specs

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/page/origMakefile b/page/origMakefile deleted file mode 100644 index f155b5a..0000000 --- a/page/origMakefile +++ /dev/null @@ -1,63 +0,0 @@ -LIB=fftpack -FFLAGS=-O -OBJ=\ -cfftb.o\ -cfftb1.o\ -cfftf.o\ -cfftf1.o\ -cffti.o\ -cffti1.o\ -cosqb.o\ -cosqb1.o\ -cosqf.o\ -cosqf1.o\ -cosqi.o\ -cost.o\ -costi.o\ -ezfft1.o\ -ezfftb.o\ -ezfftf.o\ -ezffti.o\ -passb.o\ -passb2.o\ -passb3.o\ -passb4.o\ -passb5.o\ -passf.o\ -passf2.o\ -passf3.o\ -passf4.o\ -passf5.o\ -radb2.o\ -radb3.o\ -radb4.o\ -radb5.o\ -radbg.o\ -radf2.o\ -radf3.o\ -radf4.o\ -radf5.o\ -radfg.o\ -rfftb.o\ -rfftb1.o\ -rfftf.o\ -rfftf1.o\ -rffti.o\ -rffti1.o\ -sinqb.o\ -sinqf.o\ -sinqi.o\ -sint.o\ -sint1.o\ -sinti.o - -lib$(LIB).a: $(OBJ) - update lib$(LIB).a $? - -install: lib$(LIB).a - mv lib$(LIB).a /usr/local/lib - rm *.o - -test: test.o - f77 test.o -l$(LIB) - time a.out diff --git a/page/specs/fftpack.html b/page/specs/fftpack.html index e10f55e..9219706 100644 --- a/page/specs/fftpack.html +++ b/page/specs/fftpack.html @@ -1402,7 +1402,7 @@

Example

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/page/specs/fftpack_kind.html b/page/specs/fftpack_kind.html index 2f46cb4..7e71788 100644 --- a/page/specs/fftpack_kind.html +++ b/page/specs/fftpack_kind.html @@ -148,7 +148,7 @@

Constants provided by fftpack_

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/page/specs/index.html b/page/specs/index.html index 5797434..829322d 100644 --- a/page/specs/index.html +++ b/page/specs/index.html @@ -155,7 +155,7 @@

Released/Stable Features & Modules<

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/cfftb1.html b/proc/cfftb1.html index cb4ddba..a58b855 100644 --- a/proc/cfftb1.html +++ b/proc/cfftb1.html @@ -731,7 +731,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/cfftf1.html b/proc/cfftf1.html index 5bbd604..ae751e5 100644 --- a/proc/cfftf1.html +++ b/proc/cfftf1.html @@ -731,7 +731,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/cffti1.html b/proc/cffti1.html index c3d23b9..2396cc5 100644 --- a/proc/cffti1.html +++ b/proc/cffti1.html @@ -853,7 +853,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/cosqb1.html b/proc/cosqb1.html index 4f109bc..6fbb3fa 100644 --- a/proc/cosqb1.html +++ b/proc/cosqb1.html @@ -507,7 +507,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/cosqf1.html b/proc/cosqf1.html index 379d3af..7bf7658 100644 --- a/proc/cosqf1.html +++ b/proc/cosqf1.html @@ -505,7 +505,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dcosqb.html b/proc/dcosqb.html index 68b1947..50a5091 100644 --- a/proc/dcosqb.html +++ b/proc/dcosqb.html @@ -386,7 +386,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dcosqf.html b/proc/dcosqf.html index 1a1339a..7601163 100644 --- a/proc/dcosqf.html +++ b/proc/dcosqf.html @@ -384,7 +384,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dcosqi.html b/proc/dcosqi.html index 0b8f437..c90b82b 100644 --- a/proc/dcosqi.html +++ b/proc/dcosqi.html @@ -405,7 +405,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dcost.html b/proc/dcost.html index 206b70c..f80d2d5 100644 --- a/proc/dcost.html +++ b/proc/dcost.html @@ -662,7 +662,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dcosti.html b/proc/dcosti.html index 9e9fdc4..28ffa1a 100644 --- a/proc/dcosti.html +++ b/proc/dcosti.html @@ -487,7 +487,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dfftb.html b/proc/dfftb.html index b422ee0..53aeccf 100644 --- a/proc/dfftb.html +++ b/proc/dfftb.html @@ -299,7 +299,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dfftf.html b/proc/dfftf.html index 088264a..d85ab72 100644 --- a/proc/dfftf.html +++ b/proc/dfftf.html @@ -299,7 +299,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dffti.html b/proc/dffti.html index ac19d94..076d603 100644 --- a/proc/dffti.html +++ b/proc/dffti.html @@ -284,7 +284,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dsinqb.html b/proc/dsinqb.html index 77d6cf8..54b354b 100644 --- a/proc/dsinqb.html +++ b/proc/dsinqb.html @@ -428,7 +428,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dsinqf.html b/proc/dsinqf.html index cd69f87..50734ef 100644 --- a/proc/dsinqf.html +++ b/proc/dsinqf.html @@ -424,7 +424,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dsinqi.html b/proc/dsinqi.html index a9f85fd..c1f8feb 100644 --- a/proc/dsinqi.html +++ b/proc/dsinqi.html @@ -283,7 +283,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dsint.html b/proc/dsint.html index d80c279..7edd156 100644 --- a/proc/dsint.html +++ b/proc/dsint.html @@ -417,7 +417,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dsinti.html b/proc/dsinti.html index d93bcbc..a18e039 100644 --- a/proc/dsinti.html +++ b/proc/dsinti.html @@ -425,7 +425,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dzfftb.html b/proc/dzfftb.html index 88288b1..b14216a 100644 --- a/proc/dzfftb.html +++ b/proc/dzfftb.html @@ -436,7 +436,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dzfftf.html b/proc/dzfftf.html index c97d5a5..1f6b5f9 100644 --- a/proc/dzfftf.html +++ b/proc/dzfftf.html @@ -504,7 +504,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/dzffti.html b/proc/dzffti.html index bda8ded..b1f81bc 100644 --- a/proc/dzffti.html +++ b/proc/dzffti.html @@ -284,7 +284,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/ezfft1.html b/proc/ezfft1.html index 7a1580e..8042934 100644 --- a/proc/ezfft1.html +++ b/proc/ezfft1.html @@ -894,7 +894,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passb.html b/proc/passb.html index cff86b1..3a1b7de 100644 --- a/proc/passb.html +++ b/proc/passb.html @@ -935,7 +935,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passb2.html b/proc/passb2.html index 65319e3..75e264c 100644 --- a/proc/passb2.html +++ b/proc/passb2.html @@ -461,7 +461,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passb3.html b/proc/passb3.html index 6ade93a..c49fe5e 100644 --- a/proc/passb3.html +++ b/proc/passb3.html @@ -687,7 +687,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passb4.html b/proc/passb4.html index e9bd3b3..31aa4d3 100644 --- a/proc/passb4.html +++ b/proc/passb4.html @@ -749,7 +749,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passb5.html b/proc/passb5.html index 61ca10d..4d12fae 100644 --- a/proc/passb5.html +++ b/proc/passb5.html @@ -1079,7 +1079,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passf.html b/proc/passf.html index 1763343..adc60b9 100644 --- a/proc/passf.html +++ b/proc/passf.html @@ -934,7 +934,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passf2.html b/proc/passf2.html index 1478897..dc09a3d 100644 --- a/proc/passf2.html +++ b/proc/passf2.html @@ -461,7 +461,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passf3.html b/proc/passf3.html index 8d41504..aa0d333 100644 --- a/proc/passf3.html +++ b/proc/passf3.html @@ -687,7 +687,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passf4.html b/proc/passf4.html index bd5e524..44b633c 100644 --- a/proc/passf4.html +++ b/proc/passf4.html @@ -749,7 +749,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/passf5.html b/proc/passf5.html index 528b516..75e874c 100644 --- a/proc/passf5.html +++ b/proc/passf5.html @@ -1079,7 +1079,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radb2.html b/proc/radb2.html index 14cce4b..7e9a611 100644 --- a/proc/radb2.html +++ b/proc/radb2.html @@ -504,7 +504,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radb3.html b/proc/radb3.html index 9ee7c5a..d37247c 100644 --- a/proc/radb3.html +++ b/proc/radb3.html @@ -719,7 +719,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radb4.html b/proc/radb4.html index 7aae425..aebbc56 100644 --- a/proc/radb4.html +++ b/proc/radb4.html @@ -812,7 +812,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radb5.html b/proc/radb5.html index 8df34d4..20aeff4 100644 --- a/proc/radb5.html +++ b/proc/radb5.html @@ -1104,7 +1104,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radbg.html b/proc/radbg.html index 02666f9..8370a12 100644 --- a/proc/radbg.html +++ b/proc/radbg.html @@ -1121,7 +1121,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radf2.html b/proc/radf2.html index 06e3dc6..483a53e 100644 --- a/proc/radf2.html +++ b/proc/radf2.html @@ -504,7 +504,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radf3.html b/proc/radf3.html index 0377144..4469ba2 100644 --- a/proc/radf3.html +++ b/proc/radf3.html @@ -718,7 +718,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radf4.html b/proc/radf4.html index 5078f62..eab95de 100644 --- a/proc/radf4.html +++ b/proc/radf4.html @@ -808,7 +808,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radf5.html b/proc/radf5.html index 2a5d1a2..e086167 100644 --- a/proc/radf5.html +++ b/proc/radf5.html @@ -1100,7 +1100,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/radfg.html b/proc/radfg.html index 6696f0c..0d27afe 100644 --- a/proc/radfg.html +++ b/proc/radfg.html @@ -1127,7 +1127,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/rfftb1.html b/proc/rfftb1.html index a2c52f7..c305656 100644 --- a/proc/rfftb1.html +++ b/proc/rfftb1.html @@ -672,7 +672,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/rfftf1.html b/proc/rfftf1.html index 57b5e6e..6866fb0 100644 --- a/proc/rfftf1.html +++ b/proc/rfftf1.html @@ -691,7 +691,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/rffti1.html b/proc/rffti1.html index 55b0d6d..c2527ad 100644 --- a/proc/rffti1.html +++ b/proc/rffti1.html @@ -849,7 +849,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/sint1.html b/proc/sint1.html index bc442bc..80a7841 100644 --- a/proc/sint1.html +++ b/proc/sint1.html @@ -607,7 +607,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/zfftb.html b/proc/zfftb.html index 209ca0e..a1d6466 100644 --- a/proc/zfftb.html +++ b/proc/zfftb.html @@ -378,7 +378,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/zfftf.html b/proc/zfftf.html index c2fb0e6..48a8607 100644 --- a/proc/zfftf.html +++ b/proc/zfftf.html @@ -378,7 +378,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/proc/zffti.html b/proc/zffti.html index 5a0b07d..a6a01f2 100644 --- a/proc/zffti.html +++ b/proc/zffti.html @@ -363,7 +363,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/search.html b/search.html index e13931c..fc0c13a 100644 --- a/search.html +++ b/search.html @@ -112,7 +112,7 @@

Search Results

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/cfftb1.f90.html b/sourcefile/cfftb1.f90.html index 69e75cf..dc56077 100644 --- a/sourcefile/cfftb1.f90.html +++ b/sourcefile/cfftb1.f90.html @@ -293,7 +293,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/cfftf1.f90.html b/sourcefile/cfftf1.f90.html index ca2caad..e49c744 100644 --- a/sourcefile/cfftf1.f90.html +++ b/sourcefile/cfftf1.f90.html @@ -293,7 +293,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/cffti1.f90.html b/sourcefile/cffti1.f90.html index 3103762..014f900 100644 --- a/sourcefile/cffti1.f90.html +++ b/sourcefile/cffti1.f90.html @@ -293,7 +293,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/cosqb1.f90.html b/sourcefile/cosqb1.f90.html index dc434ea..86d550e 100644 --- a/sourcefile/cosqb1.f90.html +++ b/sourcefile/cosqb1.f90.html @@ -255,7 +255,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/cosqf1.f90.html b/sourcefile/cosqf1.f90.html index fb43b55..4a98e12 100644 --- a/sourcefile/cosqf1.f90.html +++ b/sourcefile/cosqf1.f90.html @@ -253,7 +253,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dcosqb.f90.html b/sourcefile/dcosqb.f90.html index 03e7054..00a3102 100644 --- a/sourcefile/dcosqb.f90.html +++ b/sourcefile/dcosqb.f90.html @@ -244,7 +244,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dcosqf.f90.html b/sourcefile/dcosqf.f90.html index 1ebc581..be104dd 100644 --- a/sourcefile/dcosqf.f90.html +++ b/sourcefile/dcosqf.f90.html @@ -242,7 +242,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dcosqi.f90.html b/sourcefile/dcosqi.f90.html index 8080616..8edef42 100644 --- a/sourcefile/dcosqi.f90.html +++ b/sourcefile/dcosqi.f90.html @@ -240,7 +240,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dcost.f90.html b/sourcefile/dcost.f90.html index 714aae0..8480528 100644 --- a/sourcefile/dcost.f90.html +++ b/sourcefile/dcost.f90.html @@ -273,7 +273,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dcosti.f90.html b/sourcefile/dcosti.f90.html index bb08db4..3bd3d95 100644 --- a/sourcefile/dcosti.f90.html +++ b/sourcefile/dcosti.f90.html @@ -246,7 +246,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dfftb.f90.html b/sourcefile/dfftb.f90.html index da638fb..42f5144 100644 --- a/sourcefile/dfftb.f90.html +++ b/sourcefile/dfftb.f90.html @@ -234,7 +234,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dfftf.f90.html b/sourcefile/dfftf.f90.html index 24c266b..a4a2468 100644 --- a/sourcefile/dfftf.f90.html +++ b/sourcefile/dfftf.f90.html @@ -234,7 +234,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dffti.f90.html b/sourcefile/dffti.f90.html index 9768171..96e548b 100644 --- a/sourcefile/dffti.f90.html +++ b/sourcefile/dffti.f90.html @@ -234,7 +234,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dsinqb.f90.html b/sourcefile/dsinqb.f90.html index 4095f96..951efa6 100644 --- a/sourcefile/dsinqb.f90.html +++ b/sourcefile/dsinqb.f90.html @@ -248,7 +248,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dsinqf.f90.html b/sourcefile/dsinqf.f90.html index 6ea1770..995a3ec 100644 --- a/sourcefile/dsinqf.f90.html +++ b/sourcefile/dsinqf.f90.html @@ -244,7 +244,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dsinqi.f90.html b/sourcefile/dsinqi.f90.html index 7a64aa7..2b6c99e 100644 --- a/sourcefile/dsinqi.f90.html +++ b/sourcefile/dsinqi.f90.html @@ -233,7 +233,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dsint.f90.html b/sourcefile/dsint.f90.html index e6b4ec8..61c922f 100644 --- a/sourcefile/dsint.f90.html +++ b/sourcefile/dsint.f90.html @@ -237,7 +237,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dsinti.f90.html b/sourcefile/dsinti.f90.html index ed72715..8b2ec05 100644 --- a/sourcefile/dsinti.f90.html +++ b/sourcefile/dsinti.f90.html @@ -241,7 +241,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dzfftb.f90.html b/sourcefile/dzfftb.f90.html index e6f070b..2ebedee 100644 --- a/sourcefile/dzfftb.f90.html +++ b/sourcefile/dzfftb.f90.html @@ -249,7 +249,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dzfftf.f90.html b/sourcefile/dzfftf.f90.html index 7c1594f..24b316e 100644 --- a/sourcefile/dzfftf.f90.html +++ b/sourcefile/dzfftf.f90.html @@ -260,7 +260,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/dzffti.f90.html b/sourcefile/dzffti.f90.html index 3c32cb4..cf5432f 100644 --- a/sourcefile/dzffti.f90.html +++ b/sourcefile/dzffti.f90.html @@ -234,7 +234,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/ezfft1.f90.html b/sourcefile/ezfft1.f90.html index 6a3d683..4f10e03 100644 --- a/sourcefile/ezfft1.f90.html +++ b/sourcefile/ezfft1.f90.html @@ -296,7 +296,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack.f90.html b/sourcefile/fftpack.f90.html index 4940c84..022ccb0 100644 --- a/sourcefile/fftpack.f90.html +++ b/sourcefile/fftpack.f90.html @@ -569,7 +569,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_dct.f90.html b/sourcefile/fftpack_dct.f90.html index 8cf1f25..805b268 100644 --- a/sourcefile/fftpack_dct.f90.html +++ b/sourcefile/fftpack_dct.f90.html @@ -328,7 +328,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_fft.f90.html b/sourcefile/fftpack_fft.f90.html index 5f8e0e8..8e1f321 100644 --- a/sourcefile/fftpack_fft.f90.html +++ b/sourcefile/fftpack_fft.f90.html @@ -261,7 +261,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_fftshift.f90.html b/sourcefile/fftpack_fftshift.f90.html index bdb63ad..c590983 100644 --- a/sourcefile/fftpack_fftshift.f90.html +++ b/sourcefile/fftpack_fftshift.f90.html @@ -248,7 +248,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_ifft.f90.html b/sourcefile/fftpack_ifft.f90.html index 6535f00..831726f 100644 --- a/sourcefile/fftpack_ifft.f90.html +++ b/sourcefile/fftpack_ifft.f90.html @@ -261,7 +261,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_ifftshift.f90.html b/sourcefile/fftpack_ifftshift.f90.html index 0d912f3..18670b2 100644 --- a/sourcefile/fftpack_ifftshift.f90.html +++ b/sourcefile/fftpack_ifftshift.f90.html @@ -248,7 +248,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_irfft.f90.html b/sourcefile/fftpack_irfft.f90.html index cac054a..f71e83c 100644 --- a/sourcefile/fftpack_irfft.f90.html +++ b/sourcefile/fftpack_irfft.f90.html @@ -261,7 +261,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_rfft.f90.html b/sourcefile/fftpack_rfft.f90.html index 73bcd06..5c0fe6a 100644 --- a/sourcefile/fftpack_rfft.f90.html +++ b/sourcefile/fftpack_rfft.f90.html @@ -261,7 +261,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/fftpack_utils.f90.html b/sourcefile/fftpack_utils.f90.html index 925ff1d..762333f 100644 --- a/sourcefile/fftpack_utils.f90.html +++ b/sourcefile/fftpack_utils.f90.html @@ -285,7 +285,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passb.f90.html b/sourcefile/passb.f90.html index 94b59f1..1b93df8 100644 --- a/sourcefile/passb.f90.html +++ b/sourcefile/passb.f90.html @@ -350,7 +350,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passb2.f90.html b/sourcefile/passb2.f90.html index d260424..7e5caf9 100644 --- a/sourcefile/passb2.f90.html +++ b/sourcefile/passb2.f90.html @@ -251,7 +251,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passb3.f90.html b/sourcefile/passb3.f90.html index b21b81b..0ae70ad 100644 --- a/sourcefile/passb3.f90.html +++ b/sourcefile/passb3.f90.html @@ -272,7 +272,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passb4.f90.html b/sourcefile/passb4.f90.html index 4eeb329..b8bbba4 100644 --- a/sourcefile/passb4.f90.html +++ b/sourcefile/passb4.f90.html @@ -281,7 +281,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passb5.f90.html b/sourcefile/passb5.f90.html index 76170d6..33ce5f2 100644 --- a/sourcefile/passb5.f90.html +++ b/sourcefile/passb5.f90.html @@ -311,7 +311,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passf.f90.html b/sourcefile/passf.f90.html index 25c8d49..5eaeb49 100644 --- a/sourcefile/passf.f90.html +++ b/sourcefile/passf.f90.html @@ -349,7 +349,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passf2.f90.html b/sourcefile/passf2.f90.html index f7a04f5..746d0db 100644 --- a/sourcefile/passf2.f90.html +++ b/sourcefile/passf2.f90.html @@ -251,7 +251,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passf3.f90.html b/sourcefile/passf3.f90.html index 43c18f5..0fe5c4b 100644 --- a/sourcefile/passf3.f90.html +++ b/sourcefile/passf3.f90.html @@ -272,7 +272,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passf4.f90.html b/sourcefile/passf4.f90.html index fe98e11..23d1f2b 100644 --- a/sourcefile/passf4.f90.html +++ b/sourcefile/passf4.f90.html @@ -281,7 +281,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/passf5.f90.html b/sourcefile/passf5.f90.html index 349bd94..4db7c10 100644 --- a/sourcefile/passf5.f90.html +++ b/sourcefile/passf5.f90.html @@ -311,7 +311,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radb2.f90.html b/sourcefile/radb2.f90.html index a7e30df..8ee586e 100644 --- a/sourcefile/radb2.f90.html +++ b/sourcefile/radb2.f90.html @@ -256,7 +256,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radb3.f90.html b/sourcefile/radb3.f90.html index 19ebbbb..0c84a4f 100644 --- a/sourcefile/radb3.f90.html +++ b/sourcefile/radb3.f90.html @@ -266,7 +266,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radb4.f90.html b/sourcefile/radb4.f90.html index 215eb8c..7db89b1 100644 --- a/sourcefile/radb4.f90.html +++ b/sourcefile/radb4.f90.html @@ -287,7 +287,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radb5.f90.html b/sourcefile/radb5.f90.html index a321b59..8b5c752 100644 --- a/sourcefile/radb5.f90.html +++ b/sourcefile/radb5.f90.html @@ -298,7 +298,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radbg.f90.html b/sourcefile/radbg.f90.html index c977976..77e3cc5 100644 --- a/sourcefile/radbg.f90.html +++ b/sourcefile/radbg.f90.html @@ -399,7 +399,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radf2.f90.html b/sourcefile/radf2.f90.html index 10ca535..41d7546 100644 --- a/sourcefile/radf2.f90.html +++ b/sourcefile/radf2.f90.html @@ -256,7 +256,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radf3.f90.html b/sourcefile/radf3.f90.html index 32040ef..63e082e 100644 --- a/sourcefile/radf3.f90.html +++ b/sourcefile/radf3.f90.html @@ -265,7 +265,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radf4.f90.html b/sourcefile/radf4.f90.html index 2712705..1c7a7eb 100644 --- a/sourcefile/radf4.f90.html +++ b/sourcefile/radf4.f90.html @@ -283,7 +283,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radf5.f90.html b/sourcefile/radf5.f90.html index 4425639..97844ac 100644 --- a/sourcefile/radf5.f90.html +++ b/sourcefile/radf5.f90.html @@ -294,7 +294,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/radfg.f90.html b/sourcefile/radfg.f90.html index bda42c1..4adca28 100644 --- a/sourcefile/radfg.f90.html +++ b/sourcefile/radfg.f90.html @@ -405,7 +405,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/rfftb1.f90.html b/sourcefile/rfftb1.f90.html index 397e80f..623a33d 100644 --- a/sourcefile/rfftb1.f90.html +++ b/sourcefile/rfftb1.f90.html @@ -291,7 +291,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/rfftf1.f90.html b/sourcefile/rfftf1.f90.html index 4638a23..dfcc6fc 100644 --- a/sourcefile/rfftf1.f90.html +++ b/sourcefile/rfftf1.f90.html @@ -291,7 +291,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/rffti1.f90.html b/sourcefile/rffti1.f90.html index d841fc4..457a628 100644 --- a/sourcefile/rffti1.f90.html +++ b/sourcefile/rffti1.f90.html @@ -289,7 +289,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/rk.f90.html b/sourcefile/rk.f90.html index 334172e..a7e68a1 100644 --- a/sourcefile/rk.f90.html +++ b/sourcefile/rk.f90.html @@ -229,7 +229,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/sint1.f90.html b/sourcefile/sint1.f90.html index 7d6d59e..8584b9e 100644 --- a/sourcefile/sint1.f90.html +++ b/sourcefile/sint1.f90.html @@ -268,7 +268,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/zfftb.f90.html b/sourcefile/zfftb.f90.html index ec53627..4854271 100644 --- a/sourcefile/zfftb.f90.html +++ b/sourcefile/zfftb.f90.html @@ -236,7 +236,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/zfftf.f90.html b/sourcefile/zfftf.f90.html index 1160141..9f88bb8 100644 --- a/sourcefile/zfftf.f90.html +++ b/sourcefile/zfftf.f90.html @@ -236,7 +236,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/sourcefile/zffti.f90.html b/sourcefile/zffti.f90.html index 79d5174..5c072aa 100644 --- a/sourcefile/zffti.f90.html +++ b/sourcefile/zffti.f90.html @@ -236,7 +236,7 @@

Source Code

Documentation generated by FORD - on 2024-03-17 21:42

+ on 2024-03-18 05:55


diff --git a/tipuesearch/tipuesearch_content.js b/tipuesearch/tipuesearch_content.js index 0b0c650..010b2bd 100644 --- a/tipuesearch/tipuesearch_content.js +++ b/tipuesearch/tipuesearch_content.js @@ -1 +1 @@ -var tipuesearch = {"pages":[{"title":" Fortran-lang/fftpack ","text":"Fortran-lang/fftpack Fortran FFTPACK API Documentation FFTPACK Getting started Get the code Build with fortran-lang/fpm Build with Make Build with CMake Build with Meson Documentation References Warning This API documentation for the Fortran-lang/fftpack is a work in progress. Fortran FFTPACK API Documentation This is the main API documentation landing page generated by FORD .\nThe documentation for comment markup in source code, running FORD and the FORD project file are all maintained on the FORD wiki . FFTPACK A package of Fortran subprograms for the fast Fourier transform of periodic and other symmetric sequences. Getting started Get the code git clone https://github.com/fortran-lang/fftpack.git cd fftpack Build with fortran-lang/fpm Fortran Package Manager (fpm) is a package manager and build system for Fortran. You can build using provided fpm.toml : fpm build\nfpm test --list\nfpm test To use fftpack within your fpm project, add the following to your fpm.toml file: [dependencies] fftpack = { git = \"https://github.com/fortran-lang/fftpack.git\" } Build with Make Alternatively, you can build using provided Makefile : make Build with CMake This library can also be built using CMake. For instructions see Running CMake . CMake version 3.24 or higher is required. Build with Meson This library can also be built using Meson. The following dependencies are required:\n- a Fortran compiler\n- meson version 0.57 or newer\n- a build-system backend, i.e. ninja version 1.7 or newer Setup a build with meson setup build You can select the Fortran compiler by the FC environment variable.\nTo compile and run the projects testsuite use meson test -C build --print-errorlogs If the testsuite passes you can install with meson configure build --prefix = /path/to/install\nmeson install -C build Documentation See the our GitHub Pages site for documentation generated by FORD from the fortran-lang/fftpack project file . References Although fortran-lang is not interface-compatible with any of the following libraries, each contains documentation that might be useful for different reasons:\n- Recommended reference: The scipy.fftpack documentation contains succinct description of the storage sequences for function results that match those in fortran-lang/fftpack, e.g., the location of the real and imaginary parts of the rfft function result.\n- Theory reference: The documentation for the GNU/gsl FFT routines , which are also based on netlib/fftpack, provides some useful definitions of FFT terminology and represenations of the analytical forms of the Discrete Fourier Transform nicely formatted by LaTeX .\n- Historical reference: The netlib/fftpack library on which fortran-lang/fftpack is useful for understanding several fortran-lang/fftpack design choices, e.g., the procedure dependencies. Developer Info Paul N. Swarztrauber &\nfortran-lang/fftpack contributors","tags":"home","loc":"index.html"},{"title":"radb5 – Fortran-lang/fftpack","text":"subroutine radb5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i ic idp2 k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code radb5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine radb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 ti5 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 5 , k ) + Cc ( 1 , 5 , k ) tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr3 = Cc ( Ido , 4 , k ) + Cc ( Ido , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci5 = ti11 * ti5 + ti12 * ti4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 1 , k , 5 ) = cr2 + ci5 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti5 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ti4 = Cc ( i , 5 , k ) + Cc ( ic , 4 , k ) ti3 = Cc ( i , 5 , k ) - Cc ( ic , 4 , k ) tr5 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) tr4 = Cc ( i - 1 , 5 , k ) - Cc ( ic - 1 , 4 , k ) tr3 = Cc ( i - 1 , 5 , k ) + Cc ( ic - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * dr4 - Wa3 ( i - 1 ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * di4 + Wa3 ( i - 1 ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 2 ) * dr5 - Wa4 ( i - 1 ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 2 ) * di5 + Wa4 ( i - 1 ) * dr5 enddo enddo end subroutine radb5","tags":"","loc":"proc/radb5.html"},{"title":"radf5 – Fortran-lang/fftpack","text":"subroutine radf5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i ic idp2 k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code radf5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine radf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 5 ) , Ch ( Ido , 5 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 cr2 = Cc ( 1 , k , 5 ) + Cc ( 1 , k , 2 ) ci5 = Cc ( 1 , k , 5 ) - Cc ( 1 , k , 2 ) cr3 = Cc ( 1 , k , 4 ) + Cc ( 1 , k , 3 ) ci4 = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 + cr3 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 Ch ( 1 , 3 , k ) = ti11 * ci5 + ti12 * ci4 Ch ( Ido , 4 , k ) = Cc ( 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 Ch ( 1 , 5 , k ) = ti12 * ci5 - ti11 * ci4 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) dr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) di4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) dr5 = Wa4 ( i - 2 ) * Cc ( i - 1 , k , 5 ) + Wa4 ( i - 1 ) * Cc ( i , k , 5 ) di5 = Wa4 ( i - 2 ) * Cc ( i , k , 5 ) - Wa4 ( i - 1 ) * Cc ( i - 1 , k , 5 ) cr2 = dr2 + dr5 ci5 = dr5 - dr2 cr5 = di2 - di5 ci2 = di2 + di5 cr3 = dr3 + dr4 ci4 = dr4 - dr3 cr4 = di3 - di4 ci3 = di3 + di4 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 + cr3 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 + ci3 tr2 = Cc ( i - 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 ti2 = Cc ( i , k , 1 ) + tr11 * ci2 + tr12 * ci3 tr3 = Cc ( i - 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 ti3 = Cc ( i , k , 1 ) + tr12 * ci2 + tr11 * ci3 tr5 = ti11 * cr5 + ti12 * cr4 ti5 = ti11 * ci5 + ti12 * ci4 tr4 = ti12 * cr5 - ti11 * cr4 ti4 = ti12 * ci5 - ti11 * ci4 Ch ( i - 1 , 3 , k ) = tr2 + tr5 Ch ( ic - 1 , 2 , k ) = tr2 - tr5 Ch ( i , 3 , k ) = ti2 + ti5 Ch ( ic , 2 , k ) = ti5 - ti2 Ch ( i - 1 , 5 , k ) = tr3 + tr4 Ch ( ic - 1 , 4 , k ) = tr3 - tr4 Ch ( i , 5 , k ) = ti3 + ti4 Ch ( ic , 4 , k ) = ti4 - ti3 enddo enddo end subroutine radf5","tags":"","loc":"proc/radf5.html"},{"title":"radb3 – Fortran-lang/fftpack","text":"subroutine radb3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 ci3 cr2 cr3 di2 di3 dr2 dr3 i ic idp2 k taui taur ti2 tr2 Source Code radb3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: taui = sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine radb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ci3 = taui * ( Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k )) ci3 = taui * ( Cc ( i , 3 , k ) + Cc ( ic , 2 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 enddo enddo end subroutine radb3","tags":"","loc":"proc/radb3.html"},{"title":"zfftb – Fortran-lang/fftpack","text":"subroutine zfftb(n, c, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Wsave Contents Variables iw1 iw2 Source Code zfftb Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 Source Code subroutine zfftb ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftb1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftb","tags":"","loc":"proc/zfftb.html"},{"title":"dffti – Fortran-lang/fftpack","text":"subroutine dffti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Source Code dffti Source Code subroutine dffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call rffti1 ( n , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dffti","tags":"","loc":"proc/dffti.html"},{"title":"passb5 – Fortran-lang/fftpack","text":"subroutine passb5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code passb5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine passb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 - Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 + Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 - Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 + Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passb5","tags":"","loc":"proc/passb5.html"},{"title":"passb2 – Fortran-lang/fftpack","text":"subroutine passb2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i k ti2 tr2 Source Code passb2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 + Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 - Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passb2","tags":"","loc":"proc/passb2.html"},{"title":"passf2 – Fortran-lang/fftpack","text":"subroutine passf2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i k ti2 tr2 Source Code passf2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 - Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 + Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passf2","tags":"","loc":"proc/passf2.html"},{"title":"dcosqf – Fortran-lang/fftpack","text":"subroutine dcosqf(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables sqrt2 tsqx Source Code dcosqf Variables Type Visibility Attributes Name Initial real(kind=rk), public, parameter :: sqrt2 = sqrt(2.0_rk) real(kind=rk), public :: tsqx Source Code subroutine dcosqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: tsqx , Wsave , x dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) if ( n < 2 ) then return elseif ( n == 2 ) then tsqx = sqrt2 * x ( 2 ) x ( 2 ) = x ( 1 ) - tsqx x ( 1 ) = x ( 1 ) + tsqx else call cosqf1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqf","tags":"","loc":"proc/dcosqf.html"},{"title":"radbg – Fortran-lang/fftpack","text":"subroutine radbg(Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables ai1 ai2 ar1 ar1h ar2 ar2h arg dc2 dcp ds2 dsp i ic idij idp2 ik ipp2 ipph is j j2 jc k l lc nbd tpi Source Code radbg Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ai1 real(kind=rk), public :: ai2 real(kind=rk), public :: ar1 real(kind=rk), public :: ar1h real(kind=rk), public :: ar2 real(kind=rk), public :: ar2h real(kind=rk), public :: arg real(kind=rk), public :: dc2 real(kind=rk), public :: dcp real(kind=rk), public :: ds2 real(kind=rk), public :: dsp integer, public :: i integer, public :: ic integer, public :: idij integer, public :: idp2 integer, public :: ik integer, public :: ipp2 integer, public :: ipph integer, public :: is integer, public :: j integer, public :: j2 integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nbd real(kind=rk), public, parameter :: tpi = 2*acos(-1.0_rk) Source Code subroutine radbg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2 * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Ch ( 1 , k , j ) = Cc ( Ido , j2 - 2 , k ) + Cc ( Ido , j2 - 2 , k ) Ch ( 1 , k , jc ) = Cc ( 1 , j2 - 1 , k ) + Cc ( 1 , j2 - 1 , k ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo endif endif ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + ar1 * Ch2 ( ik , 2 ) c2 ( ik , lc ) = ai1 * Ch2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + ar2 * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + ai2 * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) - c1 ( 1 , k , jc ) Ch ( 1 , k , jc ) = c1 ( 1 , k , j ) + c1 ( 1 , k , jc ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo endif endif if ( Ido == 1 ) return do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo endif end subroutine radbg","tags":"","loc":"proc/radbg.html"},{"title":"cfftb1 – Fortran-lang/fftpack","text":"subroutine cfftb1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido idot ip iw ix2 ix3 ix4 k1 l1 l2 n2 na nac nf Source Code cfftb1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: idot integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: n2 integer, public :: na integer, public :: nac integer, public :: nf Source Code subroutine cfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passb4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passb4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passb2 ( idot , l1 , Ch , c , Wa ( iw )) else call passb2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passb3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passb3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passb ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passb ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passb5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passb5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftb1","tags":"","loc":"proc/cfftb1.html"},{"title":"passf5 – Fortran-lang/fftpack","text":"subroutine passf5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code passf5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = -sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = -sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine passf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = - sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = - sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 + Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 - Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 + Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 - Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passf5","tags":"","loc":"proc/passf5.html"},{"title":"dcost – Fortran-lang/fftpack","text":"subroutine dcost(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables c1 i k kc modn nm1 np1 ns2 t1 t2 tx2 x1h x1p3 xi xim2 Source Code dcost Variables Type Visibility Attributes Name Initial real(kind=rk), public :: c1 integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: nm1 integer, public :: np1 integer, public :: ns2 real(kind=rk), public :: t1 real(kind=rk), public :: t2 real(kind=rk), public :: tx2 real(kind=rk), public :: x1h real(kind=rk), public :: x1p3 real(kind=rk), public :: xi real(kind=rk), public :: xim2 Source Code subroutine dcost ( n , x , Wsave ) use fftpack_kind implicit none real ( rk ) :: c1 , t1 , t2 , tx2 , Wsave , x , x1h , x1p3 , & xi , xim2 integer :: i , k , kc , modn , n , nm1 , np1 , ns2 dimension x ( * ) , Wsave ( * ) nm1 = n - 1 np1 = n + 1 ns2 = n / 2 if ( n < 2 ) return if ( n == 2 ) then x1h = x ( 1 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 2 ) x ( 1 ) = x1h return elseif ( n > 3 ) then c1 = x ( 1 ) - x ( n ) x ( 1 ) = x ( 1 ) + x ( n ) do k = 2 , ns2 kc = np1 - k t1 = x ( k ) + x ( kc ) t2 = x ( k ) - x ( kc ) c1 = c1 + Wsave ( kc ) * t2 t2 = Wsave ( k ) * t2 x ( k ) = t1 - t2 x ( kc ) = t1 + t2 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) call dfftf ( nm1 , x , Wsave ( n + 1 )) xim2 = x ( 2 ) x ( 2 ) = c1 do i = 4 , n , 2 xi = x ( i ) x ( i ) = x ( i - 2 ) - x ( i - 1 ) x ( i - 1 ) = xim2 xim2 = xi enddo if ( modn /= 0 ) x ( n ) = xim2 return endif x1p3 = x ( 1 ) + x ( 3 ) tx2 = x ( 2 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 3 ) x ( 1 ) = x1p3 + tx2 x ( 3 ) = x1p3 - tx2 end subroutine dcost","tags":"","loc":"proc/dcost.html"},{"title":"radf4 – Fortran-lang/fftpack","text":"subroutine radf4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 hsqt2 i ic idp2 k ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code radf4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public, parameter :: hsqt2 = sqrt(2.0_rk)/2.0_rk integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine radf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 4 ) , Ch ( Ido , 4 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: hsqt2 = sqrt ( 2.0_rk ) / 2.0_rk do k = 1 , l1 tr1 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 4 ) tr2 = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = tr1 + tr2 Ch ( Ido , 4 , k ) = tr2 - tr1 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 3 , k ) = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i cr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ci2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) cr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) ci3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) ci4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) tr1 = cr2 + cr4 tr4 = cr4 - cr2 ti1 = ci2 + ci4 ti4 = ci2 - ci4 ti2 = Cc ( i , k , 1 ) + ci3 ti3 = Cc ( i , k , 1 ) - ci3 tr2 = Cc ( i - 1 , k , 1 ) + cr3 tr3 = Cc ( i - 1 , k , 1 ) - cr3 Ch ( i - 1 , 1 , k ) = tr1 + tr2 Ch ( ic - 1 , 4 , k ) = tr2 - tr1 Ch ( i , 1 , k ) = ti1 + ti2 Ch ( ic , 4 , k ) = ti1 - ti2 Ch ( i - 1 , 3 , k ) = ti4 + tr3 Ch ( ic - 1 , 2 , k ) = tr3 - ti4 Ch ( i , 3 , k ) = tr4 + ti3 Ch ( ic , 2 , k ) = tr4 - ti3 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = - hsqt2 * ( Cc ( Ido , k , 2 ) + Cc ( Ido , k , 4 )) tr1 = hsqt2 * ( Cc ( Ido , k , 2 ) - Cc ( Ido , k , 4 )) Ch ( Ido , 1 , k ) = tr1 + Cc ( Ido , k , 1 ) Ch ( Ido , 3 , k ) = Cc ( Ido , k , 1 ) - tr1 Ch ( 1 , 2 , k ) = ti1 - Cc ( Ido , k , 3 ) Ch ( 1 , 4 , k ) = ti1 + Cc ( Ido , k , 3 ) enddo end subroutine radf4","tags":"","loc":"proc/radf4.html"},{"title":"zfftf – Fortran-lang/fftpack","text":"subroutine zfftf(n, c, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Wsave Contents Variables iw1 iw2 Source Code zfftf Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 Source Code subroutine zfftf ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftf1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftf","tags":"","loc":"proc/zfftf.html"},{"title":"radb2 – Fortran-lang/fftpack","text":"subroutine radb2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i ic idp2 k ti2 tr2 Source Code radb2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine radb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( Ido , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( Ido , 2 , k ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) - Cc ( ic , 2 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( ic , 2 , k ) Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * tr2 - Wa1 ( i - 1 ) * ti2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ti2 + Wa1 ( i - 1 ) * tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( Ido , k , 1 ) = Cc ( Ido , 1 , k ) + Cc ( Ido , 1 , k ) Ch ( Ido , k , 2 ) = - ( Cc ( 1 , 2 , k ) + Cc ( 1 , 2 , k )) enddo end subroutine radb2","tags":"","loc":"proc/radb2.html"},{"title":"rfftf1 – Fortran-lang/fftpack","text":"subroutine rfftf1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido ip iw ix2 ix3 ix4 k1 kh l1 l2 na nf Source Code rfftf1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: kh integer, public :: l1 integer, public :: l2 integer, public :: na integer, public :: nf Source Code subroutine rfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & kh , l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 1 l2 = n iw = n do k1 = 1 , nf kh = nf - k1 ip = Ifac ( kh + 3 ) l1 = l2 / ip ido = n / l2 idl1 = ido * l1 iw = iw - ( ip - 1 ) * ido na = 1 - na if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radf4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radf4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif elseif ( ip /= 2 ) then if ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radf3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radf3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif elseif ( ip /= 5 ) then if ( ido == 1 ) na = 1 - na if ( na /= 0 ) then call radfg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) na = 0 else call radfg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) na = 1 endif else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radf5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radf5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif endif elseif ( na /= 0 ) then call radf2 ( ido , l1 , Ch , c , Wa ( iw )) else call radf2 ( ido , l1 , c , Ch , Wa ( iw )) endif l2 = l1 enddo if ( na == 1 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftf1","tags":"","loc":"proc/rfftf1.html"},{"title":"radf3 – Fortran-lang/fftpack","text":"subroutine radf3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 cr2 di2 di3 dr2 dr3 i ic idp2 k taui taur ti2 ti3 tr2 tr3 Source Code radf3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: cr2 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: taui = sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 Source Code subroutine radf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , cr2 , di2 , di3 , dr2 , dr3 , & ti2 , ti3 , tr2 , tr3 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 3 , l1 ) , Cc ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk ! note: original comment said this was -SQRT(3)/2 but value was 0.86602540378443864676d0 real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 cr2 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 Ch ( 1 , 3 , k ) = taui * ( Cc ( 1 , k , 3 ) - Cc ( 1 , k , 2 )) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + taur * cr2 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr2 = dr2 + dr3 ci2 = di2 + di3 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 tr2 = Cc ( i - 1 , k , 1 ) + taur * cr2 ti2 = Cc ( i , k , 1 ) + taur * ci2 tr3 = taui * ( di2 - di3 ) ti3 = taui * ( dr3 - dr2 ) Ch ( i - 1 , 3 , k ) = tr2 + tr3 Ch ( ic - 1 , 2 , k ) = tr2 - tr3 Ch ( i , 3 , k ) = ti2 + ti3 Ch ( ic , 2 , k ) = ti3 - ti2 enddo enddo end subroutine radf3","tags":"","loc":"proc/radf3.html"},{"title":"passb3 – Fortran-lang/fftpack","text":"subroutine passb3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 ci3 cr2 cr3 di2 di3 dr2 dr3 i k taui taur ti2 tr2 Source Code passb3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: taui = sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passb3","tags":"","loc":"proc/passb3.html"},{"title":"dzfftb – Fortran-lang/fftpack","text":"subroutine dzfftb(n, r, Azero, a, b, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Azero real(kind=rk) :: a real(kind=rk) :: b real(kind=rk) :: Wsave Contents Variables i ns2 Source Code dzfftb Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: ns2 Source Code subroutine dzfftb ( n , r , Azero , a , b , Wsave ) use fftpack_kind implicit none real ( rk ) :: a , Azero , b , r , Wsave integer :: i , n , ns2 dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then r ( 1 ) = Azero return elseif ( n == 2 ) then r ( 1 ) = Azero + a ( 1 ) r ( 2 ) = Azero - a ( 1 ) return else ns2 = ( n - 1 ) / 2 do i = 1 , ns2 r ( 2 * i ) = 0.5_rk * a ( i ) r ( 2 * i + 1 ) = - 0.5_rk * b ( i ) enddo r ( 1 ) = Azero if ( mod ( n , 2 ) == 0 ) r ( n ) = a ( ns2 + 1 ) call dfftb ( n , r , Wsave ( n + 1 )) endif end subroutine dzfftb","tags":"","loc":"proc/dzfftb.html"},{"title":"passf4 – Fortran-lang/fftpack","text":"subroutine passf4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 i k ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code passf4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 integer, public :: i integer, public :: k real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine passf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 2 , k ) - Cc ( i , 4 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 4 , k ) - Cc ( i - 1 , 2 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 + Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 - Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 + Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 - Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 + Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 - Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 2 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passf4","tags":"","loc":"proc/passf4.html"},{"title":"zffti – Fortran-lang/fftpack","text":"subroutine zffti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables iw1 iw2 Source Code zffti Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 Source Code subroutine zffti ( n , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cffti1 ( n , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zffti","tags":"","loc":"proc/zffti.html"},{"title":"passb – Fortran-lang/fftpack","text":"subroutine passb(Nac, Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Nac integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables i idij idj idl idlj idot idp ik inc ipp2 ipph j jc k l lc nt wai war Source Code passb Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idij integer, public :: idj integer, public :: idl integer, public :: idlj integer, public :: idot integer, public :: idp integer, public :: ik integer, public :: inc integer, public :: ipp2 integer, public :: ipph integer, public :: j integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nt real(kind=rk), public :: wai real(kind=rk), public :: war Source Code subroutine passb ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo return endif idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo return end subroutine passb","tags":"","loc":"proc/passb.html"},{"title":"dsint – Fortran-lang/fftpack","text":"subroutine dsint(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables iw1 iw2 iw3 np1 Source Code dsint Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 integer, public :: iw3 integer, public :: np1 Source Code subroutine dsint ( n , x , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , iw3 , n , np1 real ( rk ) :: Wsave , x dimension x ( * ) , Wsave ( * ) np1 = n + 1 iw1 = n / 2 + 1 iw2 = iw1 + np1 iw3 = iw2 + np1 call sint1 ( n , x , Wsave , Wsave ( iw1 ), Wsave ( iw2 ), Wsave ( iw3 )) end subroutine dsint","tags":"","loc":"proc/dsint.html"},{"title":"rfftb1 – Fortran-lang/fftpack","text":"subroutine rfftb1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido ip iw ix2 ix3 ix4 k1 l1 l2 na nf Source Code rfftb1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: na integer, public :: nf Source Code subroutine rfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idl1 = ido * l1 if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radb4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radb4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call radb2 ( ido , l1 , Ch , c , Wa ( iw )) else call radb2 ( ido , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radb3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radb3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call radbg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call radbg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( ido == 1 ) na = 1 - na else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radb5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radb5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * ido enddo if ( na == 0 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftb1","tags":"","loc":"proc/rfftb1.html"},{"title":"radf2 – Fortran-lang/fftpack","text":"subroutine radf2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i ic idp2 k ti2 tr2 Source Code radf2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine radf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 2 , l1 ) , Cc ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 2 ) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ti2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ti2 Ch ( ic , 2 , k ) = ti2 - Cc ( i , k , 1 ) Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + tr2 Ch ( ic - 1 , 2 , k ) = Cc ( i - 1 , k , 1 ) - tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( 1 , 2 , k ) = - Cc ( Ido , k , 2 ) Ch ( Ido , 1 , k ) = Cc ( Ido , k , 1 ) enddo end subroutine radf2","tags":"","loc":"proc/radf2.html"},{"title":"radfg – Fortran-lang/fftpack","text":"subroutine radfg(Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables ai1 ai2 ar1 ar1h ar2 ar2h arg dc2 dcp ds2 dsp i ic idij idp2 ik ipp2 ipph is j j2 jc k l lc nbd tpi Source Code radfg Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ai1 real(kind=rk), public :: ai2 real(kind=rk), public :: ar1 real(kind=rk), public :: ar1h real(kind=rk), public :: ar2 real(kind=rk), public :: ar2h real(kind=rk), public :: arg real(kind=rk), public :: dc2 real(kind=rk), public :: dcp real(kind=rk), public :: ds2 real(kind=rk), public :: dsp integer, public :: i integer, public :: ic integer, public :: idij integer, public :: idp2 integer, public :: ik integer, public :: ipp2 integer, public :: ipph integer, public :: is integer, public :: j integer, public :: j2 integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nbd real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine radfg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) ipph = ( Ip + 1 ) / 2 ipp2 = Ip + 2 idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 if ( Ido == 1 ) then do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo else do ik = 1 , Idl1 Ch2 ( ik , 1 ) = c2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo endif if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo endif endif do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) + Ch ( 1 , k , jc ) c1 ( 1 , k , jc ) = Ch ( 1 , k , jc ) - Ch ( 1 , k , j ) enddo enddo ! ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 Ch2 ( ik , l ) = c2 ( ik , 1 ) + ar1 * c2 ( ik , 2 ) Ch2 ( ik , lc ) = ai1 * c2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 Ch2 ( ik , l ) = Ch2 ( ik , l ) + ar2 * c2 ( ik , j ) Ch2 ( ik , lc ) = Ch2 ( ik , lc ) + ai2 * c2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + c2 ( ik , j ) enddo enddo ! if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Cc ( Ido , j2 - 2 , k ) = Ch ( 1 , k , j ) Cc ( 1 , j2 - 1 , k ) = Ch ( 1 , k , jc ) enddo enddo if ( Ido == 1 ) return if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j j2 = j + j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo end if end subroutine radfg","tags":"","loc":"proc/radfg.html"},{"title":"dsinti – Fortran-lang/fftpack","text":"subroutine dsinti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables dt k np1 ns2 pi Source Code dsinti Variables Type Visibility Attributes Name Initial real(kind=rk), public :: dt integer, public :: k integer, public :: np1 integer, public :: ns2 real(kind=rk), public, parameter :: pi = acos(-1.0_rk) Source Code subroutine dsinti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , Wsave integer :: k , n , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 1 ) return ns2 = n / 2 np1 = n + 1 dt = pi / real ( np1 , rk ) do k = 1 , ns2 Wsave ( k ) = 2.0_rk * sin ( k * dt ) enddo call dffti ( np1 , Wsave ( ns2 + 1 )) end subroutine dsinti","tags":"","loc":"proc/dsinti.html"},{"title":"dzffti – Fortran-lang/fftpack","text":"subroutine dzffti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Source Code dzffti Source Code subroutine dzffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call ezfft1 ( n , Wsave ( 2 * n + 1 ), Wsave ( 3 * n + 1 )) end subroutine dzffti","tags":"","loc":"proc/dzffti.html"},{"title":"passf – Fortran-lang/fftpack","text":"subroutine passf(Nac, Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Nac integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables i idij idj idl idlj idot idp ik inc ipp2 ipph j jc k l lc nt wai war Source Code passf Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idij integer, public :: idj integer, public :: idl integer, public :: idlj integer, public :: idot integer, public :: idp integer, public :: ik integer, public :: inc integer, public :: ipp2 integer, public :: ipph integer, public :: j integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nt real(kind=rk), public :: wai real(kind=rk), public :: war Source Code subroutine passf ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = - Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) - wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo end if end subroutine passf","tags":"","loc":"proc/passf.html"},{"title":"sint1 – Fortran-lang/fftpack","text":"subroutine sint1(n, War, Was, Xh, x, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: War real(kind=rk) :: Was real(kind=rk) :: Xh real(kind=rk) :: x integer :: Ifac Contents Variables i k kc modn np1 ns2 sqrt3 t1 t2 xhold Source Code sint1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: np1 integer, public :: ns2 real(kind=rk), public, parameter :: sqrt3 = sqrt(3.0_rk) real(kind=rk), public :: t1 real(kind=rk), public :: t2 real(kind=rk), public :: xhold Source Code subroutine sint1 ( n , War , Was , Xh , x , Ifac ) use fftpack_kind implicit none integer :: i , Ifac , k , kc , modn , n , np1 , ns2 real ( rk ) :: t1 , t2 , War , Was , x , Xh , xhold dimension War ( * ) , Was ( * ) , x ( * ) , Xh ( * ) , Ifac ( * ) real ( rk ), parameter :: sqrt3 = sqrt ( 3.0_rk ) do i = 1 , n Xh ( i ) = War ( i ) War ( i ) = x ( i ) enddo if ( n < 2 ) then Xh ( 1 ) = Xh ( 1 ) + Xh ( 1 ) elseif ( n == 2 ) then xhold = sqrt3 * ( Xh ( 1 ) + Xh ( 2 )) Xh ( 2 ) = sqrt3 * ( Xh ( 1 ) - Xh ( 2 )) Xh ( 1 ) = xhold else np1 = n + 1 ns2 = n / 2 x ( 1 ) = 0.0_rk do k = 1 , ns2 kc = np1 - k t1 = Xh ( k ) - Xh ( kc ) t2 = Was ( k ) * ( Xh ( k ) + Xh ( kc )) x ( k + 1 ) = t1 + t2 x ( kc + 1 ) = t2 - t1 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 2 ) = 4.0_rk * Xh ( ns2 + 1 ) call rfftf1 ( np1 , x , Xh , War , Ifac ) Xh ( 1 ) = 0.5_rk * x ( 1 ) do i = 3 , n , 2 Xh ( i - 1 ) = - x ( i ) Xh ( i ) = Xh ( i - 2 ) + x ( i - 1 ) enddo if ( modn == 0 ) Xh ( n ) = - x ( n + 1 ) endif do i = 1 , n x ( i ) = War ( i ) War ( i ) = Xh ( i ) enddo end subroutine sint1","tags":"","loc":"proc/sint1.html"},{"title":"dsinqf – Fortran-lang/fftpack","text":"subroutine dsinqf(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables k kc ns2 xhold Source Code dsinqf Variables Type Visibility Attributes Name Initial integer, public :: k integer, public :: kc integer, public :: ns2 real(kind=rk), public :: xhold Source Code subroutine dsinqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n == 1 ) return ns2 = n / 2 do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo call dcosqf ( n , x , Wsave ) do k = 2 , n , 2 x ( k ) = - x ( k ) enddo end subroutine dsinqf","tags":"","loc":"proc/dsinqf.html"},{"title":"dsinqi – Fortran-lang/fftpack","text":"subroutine dsinqi(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Source Code dsinqi Source Code subroutine dsinqi ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) call dcosqi ( n , Wsave ) end subroutine dsinqi","tags":"","loc":"proc/dsinqi.html"},{"title":"passb4 – Fortran-lang/fftpack","text":"subroutine passb4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 i k ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code passb4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 integer, public :: i integer, public :: k real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine passb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 4 , k ) - Cc ( i , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 - Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 + Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 - Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 + Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 - Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 + Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 4 , k ) - Cc ( 2 , 2 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 2 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passb4","tags":"","loc":"proc/passb4.html"},{"title":"dcosqi – Fortran-lang/fftpack","text":"subroutine dcosqi(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables dt fk k pih Source Code dcosqi Variables Type Visibility Attributes Name Initial real(kind=rk), public :: dt real(kind=rk), public :: fk integer, public :: k real(kind=rk), public, parameter :: pih = acos(-1.0_rk)/2.0_rk Source Code subroutine dcosqi ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , n dimension Wsave ( * ) real ( rk ), parameter :: pih = acos ( - 1.0_rk ) / 2.0_rk ! pi / 2 dt = pih / real ( n , rk ) fk = 0.0_rk do k = 1 , n fk = fk + 1.0_rk Wsave ( k ) = cos ( fk * dt ) enddo call dffti ( n , Wsave ( n + 1 )) end subroutine dcosqi","tags":"","loc":"proc/dcosqi.html"},{"title":"cfftf1 – Fortran-lang/fftpack","text":"subroutine cfftf1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido idot ip iw ix2 ix3 ix4 k1 l1 l2 n2 na nac nf Source Code cfftf1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: idot integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: n2 integer, public :: na integer, public :: nac integer, public :: nf Source Code subroutine cfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passf4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passf4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passf2 ( idot , l1 , Ch , c , Wa ( iw )) else call passf2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passf3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passf3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passf ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passf ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passf5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passf5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftf1","tags":"","loc":"proc/cfftf1.html"},{"title":"dcosqb – Fortran-lang/fftpack","text":"subroutine dcosqb(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables tsqrt2 x1 Source Code dcosqb Variables Type Visibility Attributes Name Initial real(kind=rk), public, parameter :: tsqrt2 = 2.0_rk*sqrt(2.0_rk) real(kind=rk), public :: x1 Source Code subroutine dcosqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave , x , x1 dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: tsqrt2 = 2.0_rk * sqrt ( 2.0_rk ) if ( n < 2 ) then x ( 1 ) = 4.0_rk * x ( 1 ) return elseif ( n == 2 ) then x1 = 4.0_rk * ( x ( 1 ) + x ( 2 )) x ( 2 ) = tsqrt2 * ( x ( 1 ) - x ( 2 )) x ( 1 ) = x1 return else call cosqb1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqb","tags":"","loc":"proc/dcosqb.html"},{"title":"ezfft1 – Fortran-lang/fftpack","text":"subroutine ezfft1(n, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wa integer :: Ifac Contents Variables arg1 argh ch1 ch1h dch1 dsh1 i ib ido ii ip ipm is j k1 l1 l2 nf nfm1 nl nq nr ntry ntryh sh1 tpi Source Code ezfft1 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: arg1 real(kind=rk), public :: argh real(kind=rk), public :: ch1 real(kind=rk), public :: ch1h real(kind=rk), public :: dch1 real(kind=rk), public :: dsh1 integer, public :: i integer, public :: ib integer, public :: ido integer, public :: ii integer, public :: ip integer, public :: ipm integer, public :: is integer, public :: j integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: nf integer, public :: nfm1 integer, public :: nl integer, public :: nq integer, public :: nr integer, public :: ntry integer, public, parameter, dimension(4) :: ntryh = [4, 2, 3, 5] real(kind=rk), public :: sh1 real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine ezfft1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg1 , argh , ch1 , ch1h , dch1 , dsh1 , sh1 , & Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) l2 = l1 * ip ido = n / l2 ipm = ip - 1 arg1 = real ( l1 , rk ) * argh ch1 = 1.0_rk sh1 = 0.0_rk dch1 = cos ( arg1 ) dsh1 = sin ( arg1 ) do j = 1 , ipm ch1h = dch1 * ch1 - dsh1 * sh1 sh1 = dch1 * sh1 + dsh1 * ch1 ch1 = ch1h i = is + 2 Wa ( i - 1 ) = ch1 Wa ( i ) = sh1 if ( ido >= 5 ) then do ii = 5 , ido , 2 i = i + 2 Wa ( i - 1 ) = ch1 * Wa ( i - 3 ) - sh1 * Wa ( i - 2 ) Wa ( i ) = ch1 * Wa ( i - 2 ) + sh1 * Wa ( i - 3 ) enddo endif is = is + ido enddo l1 = l2 enddo end subroutine ezfft1","tags":"","loc":"proc/ezfft1.html"},{"title":"dsinqb – Fortran-lang/fftpack","text":"subroutine dsinqb(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables k kc ns2 xhold Source Code dsinqb Variables Type Visibility Attributes Name Initial integer, public :: k integer, public :: kc integer, public :: ns2 real(kind=rk), public :: xhold Source Code subroutine dsinqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n > 1 ) then ns2 = n / 2 do k = 2 , n , 2 x ( k ) = - x ( k ) enddo call dcosqb ( n , x , Wsave ) do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo return endif x ( 1 ) = 4.0_rk * x ( 1 ) return end subroutine dsinqb","tags":"","loc":"proc/dsinqb.html"},{"title":"passf3 – Fortran-lang/fftpack","text":"subroutine passf3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 ci3 cr2 cr3 di2 di3 dr2 dr3 i k taui taur ti2 tr2 Source Code passf3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: taui = -sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = - sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passf3","tags":"","loc":"proc/passf3.html"},{"title":"dfftf – Fortran-lang/fftpack","text":"subroutine dfftf(n, r, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Wsave Contents Source Code dfftf Source Code subroutine dfftf ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftf1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftf","tags":"","loc":"proc/dfftf.html"},{"title":"dcosti – Fortran-lang/fftpack","text":"subroutine dcosti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables dt fk k kc nm1 np1 ns2 pi Source Code dcosti Variables Type Visibility Attributes Name Initial real(kind=rk), public :: dt real(kind=rk), public :: fk integer, public :: k integer, public :: kc integer, public :: nm1 integer, public :: np1 integer, public :: ns2 real(kind=rk), public, parameter :: pi = acos(-1.0_rk) Source Code subroutine dcosti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , kc , n , nm1 , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 3 ) return nm1 = n - 1 np1 = n + 1 ns2 = n / 2 dt = pi / real ( nm1 , rk ) fk = 0.0_rk do k = 2 , ns2 kc = np1 - k fk = fk + 1.0_rk Wsave ( k ) = 2.0_rk * sin ( fk * dt ) Wsave ( kc ) = 2.0_rk * cos ( fk * dt ) enddo call dffti ( nm1 , Wsave ( n + 1 )) end subroutine dcosti","tags":"","loc":"proc/dcosti.html"},{"title":"dfftb – Fortran-lang/fftpack","text":"subroutine dfftb(n, r, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Wsave Contents Source Code dfftb Source Code subroutine dfftb ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftb1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftb","tags":"","loc":"proc/dfftb.html"},{"title":"cosqb1 – Fortran-lang/fftpack","text":"subroutine cosqb1(n, x, w, Xh) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: w real(kind=rk) :: Xh Contents Variables i k kc modn np2 ns2 xim1 Source Code cosqb1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: np2 integer, public :: ns2 real(kind=rk), public :: xim1 Source Code subroutine cosqb1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do i = 3 , n , 2 xim1 = x ( i - 1 ) + x ( i ) x ( i ) = x ( i ) - x ( i - 1 ) x ( i - 1 ) = xim1 enddo x ( 1 ) = x ( 1 ) + x ( 1 ) modn = mod ( n , 2 ) if ( modn == 0 ) x ( n ) = x ( n ) + x ( n ) call dfftb ( n , x , Xh ) do k = 2 , ns2 kc = np2 - k Xh ( k ) = w ( k - 1 ) * x ( kc ) + w ( kc - 1 ) * x ( k ) Xh ( kc ) = w ( k - 1 ) * x ( k ) - w ( kc - 1 ) * x ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * ( x ( ns2 + 1 ) + x ( ns2 + 1 )) do k = 2 , ns2 kc = np2 - k x ( k ) = Xh ( k ) + Xh ( kc ) x ( kc ) = Xh ( k ) - Xh ( kc ) enddo x ( 1 ) = x ( 1 ) + x ( 1 ) end subroutine cosqb1","tags":"","loc":"proc/cosqb1.html"},{"title":"rffti1 – Fortran-lang/fftpack","text":"subroutine rffti1(n, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wa integer :: Ifac Contents Variables arg argh argld fi i ib ido ii ip ipm is j k1 l1 l2 ld nf nfm1 nl nq nr ntry ntryh tpi Source Code rffti1 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: arg real(kind=rk), public :: argh real(kind=rk), public :: argld real(kind=rk), public :: fi integer, public :: i integer, public :: ib integer, public :: ido integer, public :: ii integer, public :: ip integer, public :: ipm integer, public :: is integer, public :: j integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: ld integer, public :: nf integer, public :: nfm1 integer, public :: nl integer, public :: nq integer, public :: nr integer, public :: ntry integer, public, parameter, dimension(4) :: ntryh = [4, 2, 3, 5] real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine rffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , ld , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 ipm = ip - 1 do j = 1 , ipm ld = ld + l1 i = is argld = real ( ld , rk ) * argh fi = 0.0_rk do ii = 3 , ido , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo is = is + ido enddo l1 = l2 enddo end subroutine rffti1","tags":"","loc":"proc/rffti1.html"},{"title":"dzfftf – Fortran-lang/fftpack","text":"subroutine dzfftf(n, r, Azero, a, b, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Azero real(kind=rk) :: a real(kind=rk) :: b real(kind=rk) :: Wsave Contents Variables cf cfm i ns2 ns2m Source Code dzfftf Variables Type Visibility Attributes Name Initial real(kind=rk), public :: cf real(kind=rk), public :: cfm integer, public :: i integer, public :: ns2 integer, public :: ns2m Source Code subroutine dzfftf ( n , r , Azero , a , b , Wsave ) ! ! VERSION 3 JUNE 1979 ! use fftpack_kind implicit none real ( rk ) :: a , Azero , b , cf , cfm , r , Wsave integer :: i , n , ns2 , ns2m dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then Azero = r ( 1 ) return elseif ( n == 2 ) then Azero = 0.5_rk * ( r ( 1 ) + r ( 2 )) a ( 1 ) = 0.5_rk * ( r ( 1 ) - r ( 2 )) return else do i = 1 , n Wsave ( i ) = r ( i ) enddo call dfftf ( n , Wsave , Wsave ( n + 1 )) cf = 2.0_rk / real ( n , rk ) cfm = - cf Azero = 0.5_rk * cf * Wsave ( 1 ) ns2 = ( n + 1 ) / 2 ns2m = ns2 - 1 do i = 1 , ns2m a ( i ) = cf * Wsave ( 2 * i ) b ( i ) = cfm * Wsave ( 2 * i + 1 ) enddo if ( mod ( n , 2 ) == 1 ) return a ( ns2 ) = 0.5_rk * cf * Wsave ( n ) b ( ns2 ) = 0.0_rk endif end subroutine dzfftf","tags":"","loc":"proc/dzfftf.html"},{"title":"cffti1 – Fortran-lang/fftpack","text":"subroutine cffti1(n, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wa integer :: Ifac Contents Variables arg argh argld fi i i1 ib ido idot ii ip ipm j k1 l1 l2 ld nf nl nq nr ntry ntryh tpi Source Code cffti1 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: arg real(kind=rk), public :: argh real(kind=rk), public :: argld real(kind=rk), public :: fi integer, public :: i integer, public :: i1 integer, public :: ib integer, public :: ido integer, public :: idot integer, public :: ii integer, public :: ip integer, public :: ipm integer, public :: j integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: ld integer, public :: nf integer, public :: nl integer, public :: nq integer, public :: nr integer, public :: ntry integer, public, parameter, dimension(4) :: ntryh = [3, 4, 2, 5] real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine cffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , i1 , ib , ido , idot , Ifac , ii , ip , ipm , j , k1 , & l1 , l2 , ld , n , nf , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 3 , 4 , 2 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) i = 2 l1 = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 idot = ido + ido + 2 ipm = ip - 1 do j = 1 , ipm i1 = i Wa ( i - 1 ) = 1.0_rk Wa ( i ) = 0.0_rk ld = ld + l1 fi = 0.0_rk argld = real ( ld , rk ) * argh do ii = 4 , idot , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo if ( ip > 5 ) then Wa ( i1 - 1 ) = Wa ( i - 1 ) Wa ( i1 ) = Wa ( i ) endif enddo l1 = l2 enddo end subroutine cffti1","tags":"","loc":"proc/cffti1.html"},{"title":"radb4 – Fortran-lang/fftpack","text":"subroutine radb4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 i ic idp2 k sqrt2 ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code radb4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: sqrt2 = sqrt(2.0_rk) real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine radb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) do k = 1 , l1 tr1 = Cc ( 1 , 1 , k ) - Cc ( Ido , 4 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( Ido , 4 , k ) tr3 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr4 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 2 ) = tr1 - tr4 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 1 , k , 4 ) = tr1 + tr4 enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti1 = Cc ( i , 1 , k ) + Cc ( ic , 4 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( ic , 4 , k ) ti3 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) tr4 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 4 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 4 , k ) ti4 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 - tr4 cr4 = tr1 + tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * cr2 - Wa1 ( i - 1 ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ci2 + Wa1 ( i - 1 ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * cr3 - Wa2 ( i - 1 ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * ci3 + Wa2 ( i - 1 ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * cr4 - Wa3 ( i - 1 ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * ci4 + Wa3 ( i - 1 ) * cr4 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) ti2 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr1 = Cc ( Ido , 1 , k ) - Cc ( Ido , 3 , k ) tr2 = Cc ( Ido , 1 , k ) + Cc ( Ido , 3 , k ) Ch ( Ido , k , 1 ) = tr2 + tr2 Ch ( Ido , k , 2 ) = sqrt2 * ( tr1 - ti1 ) Ch ( Ido , k , 3 ) = ti2 + ti2 Ch ( Ido , k , 4 ) = - sqrt2 * ( tr1 + ti1 ) enddo end subroutine radb4","tags":"","loc":"proc/radb4.html"},{"title":"cosqf1 – Fortran-lang/fftpack","text":"subroutine cosqf1(n, x, w, Xh) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: w real(kind=rk) :: Xh Contents Variables i k kc modn np2 ns2 xim1 Source Code cosqf1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: np2 integer, public :: ns2 real(kind=rk), public :: xim1 Source Code subroutine cosqf1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do k = 2 , ns2 kc = np2 - k Xh ( k ) = x ( k ) + x ( kc ) Xh ( kc ) = x ( k ) - x ( kc ) enddo modn = mod ( n , 2 ) if ( modn == 0 ) Xh ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) do k = 2 , ns2 kc = np2 - k x ( k ) = w ( k - 1 ) * Xh ( kc ) + w ( kc - 1 ) * Xh ( k ) x ( kc ) = w ( k - 1 ) * Xh ( k ) - w ( kc - 1 ) * Xh ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * Xh ( ns2 + 1 ) call dfftf ( n , x , Xh ) do i = 3 , n , 2 xim1 = x ( i - 1 ) - x ( i ) x ( i ) = x ( i - 1 ) + x ( i ) x ( i - 1 ) = xim1 enddo end subroutine cosqf1","tags":"","loc":"proc/cosqf1.html"},{"title":"dcosqb – Fortran-lang/fftpack","text":"interface public pure subroutine dcosqb(n, x, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of dcosqf .\n( Specification )","tags":"","loc":"interface/dcosqb.html"},{"title":"dcosqf – Fortran-lang/fftpack","text":"interface public pure subroutine dcosqf(n, x, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) Description Forward transform of quarter wave data.\n( Specification )","tags":"","loc":"interface/dcosqf.html"},{"title":"dcosqi – Fortran-lang/fftpack","text":"interface public pure subroutine dcosqi(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dcosqf and dcosqb .\n( Specification )","tags":"","loc":"interface/dcosqi.html"},{"title":"dcost – Fortran-lang/fftpack","text":"interface public pure subroutine dcost(n, x, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) Description Discrete fourier cosine transform of an even sequence.\n( Specification )","tags":"","loc":"interface/dcost.html"},{"title":"dcosti – Fortran-lang/fftpack","text":"interface public pure subroutine dcosti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dcost .\n( Specification )","tags":"","loc":"interface/dcosti.html"},{"title":"dct – Fortran-lang/fftpack","text":"public interface dct Dsicrete cosine transforms.\n( Specification ) Contents Functions dct_rk Functions private pure module function dct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/dct.html"},{"title":"dct_t1 – Fortran-lang/fftpack","text":"public interface dct_t1 Perform DCT type-1\n( Specification ) Contents Module Procedures dcost Module Procedures public interface dcost () Arguments None","tags":"","loc":"interface/dct_t1.html"},{"title":"dct_t1i – Fortran-lang/fftpack","text":"public interface dct_t1i Initialize DCT type-1\n( Specification ) Contents Module Procedures dcosti Module Procedures public interface dcosti () Arguments None","tags":"","loc":"interface/dct_t1i.html"},{"title":"dct_t2 – Fortran-lang/fftpack","text":"public interface dct_t2 Perform DCT type-2\n( Specification ) Contents Module Procedures dcosqb Module Procedures public interface dcosqb () Arguments None","tags":"","loc":"interface/dct_t2.html"},{"title":"dct_t23i – Fortran-lang/fftpack","text":"public interface dct_t23i Initialize DCT types 2, 3\n( Specification ) Contents Module Procedures dcosqi Module Procedures public interface dcosqi () Arguments None","tags":"","loc":"interface/dct_t23i.html"},{"title":"dct_t3 – Fortran-lang/fftpack","text":"public interface dct_t3 Perform DCT type-3\n( Specification ) Contents Module Procedures dcosqf Module Procedures public interface dcosqf () Arguments None","tags":"","loc":"interface/dct_t3.html"},{"title":"dfftb – Fortran-lang/fftpack","text":"interface public pure subroutine dfftb(n, r, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of dfftf .\n( Specification )","tags":"","loc":"interface/dfftb.html"},{"title":"dfftf – Fortran-lang/fftpack","text":"interface public pure subroutine dfftf(n, r, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) Description Forward transform of a real periodic sequence.\n( Specification )","tags":"","loc":"interface/dfftf.html"},{"title":"dffti – Fortran-lang/fftpack","text":"interface public pure subroutine dffti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dfftf and dfftb .\n( Specification )","tags":"","loc":"interface/dffti.html"},{"title":"dzfftb – Fortran-lang/fftpack","text":"interface public pure subroutine dzfftb(n, r, azero, a, b, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: r (*) real(kind=rk), intent(in) :: azero real(kind=rk), intent(in) :: a (*) real(kind=rk), intent(in) :: b (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of dzfftf .\n( Specification )","tags":"","loc":"interface/dzfftb.html"},{"title":"dzfftf – Fortran-lang/fftpack","text":"interface public pure subroutine dzfftf(n, r, azero, a, b, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(in) :: r (*) real(kind=rk), intent(out) :: azero real(kind=rk), intent(out) :: a (*) real(kind=rk), intent(out) :: b (*) real(kind=rk), intent(in) :: wsave (*) Description Simplified forward transform of a real periodic sequence.\n( Specification )","tags":"","loc":"interface/dzfftf.html"},{"title":"dzffti – Fortran-lang/fftpack","text":"interface public pure subroutine dzffti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dzfftf and dzfftb .\n( Specification )","tags":"","loc":"interface/dzffti.html"},{"title":"fft – Fortran-lang/fftpack","text":"public interface fft Forward transform of a complex periodic sequence.\n( Specifiction ) Contents Functions fft_rk Functions private pure module function fft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:)","tags":"","loc":"interface/fft.html"},{"title":"fftfreq – Fortran-lang/fftpack","text":"interface public pure module function fftfreq(n) result(out) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer,dimension(n) Description Integer frequency values involved in complex FFT.\n( Specifiction )","tags":"","loc":"interface/fftfreq.html"},{"title":"fftshift – Fortran-lang/fftpack","text":"public interface fftshift Shifts zero-frequency component to center of spectrum.\n( Specifiction ) Contents Functions fftshift_crk fftshift_rrk Functions private pure module function fftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function fftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x))","tags":"","loc":"interface/fftshift.html"},{"title":"idct – Fortran-lang/fftpack","text":"public interface idct Inverse discrete cosine transforms.\n( Specification ) Contents Functions idct_rk Functions private pure module function idct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/idct.html"},{"title":"ifft – Fortran-lang/fftpack","text":"public interface ifft Backward transform of a complex periodic sequence.\n( Specifiction ) Contents Functions ifft_rk Functions private pure module function ifft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:)","tags":"","loc":"interface/ifft.html"},{"title":"ifftshift – Fortran-lang/fftpack","text":"public interface ifftshift Shifts zero-frequency component to beginning of spectrum.\n( Specifiction ) Contents Functions ifftshift_crk ifftshift_rrk Functions private pure module function ifftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function ifftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x))","tags":"","loc":"interface/ifftshift.html"},{"title":"irfft – Fortran-lang/fftpack","text":"public interface irfft Backward transform of a real periodic sequence.\n( Specifiction ) Contents Functions irfft_rk Functions private pure module function irfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/irfft.html"},{"title":"rfft – Fortran-lang/fftpack","text":"public interface rfft Forward transform of a real periodic sequence.\n( Specifiction ) Contents Functions rfft_rk Functions private pure module function rfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/rfft.html"},{"title":"rfftfreq – Fortran-lang/fftpack","text":"interface public pure module function rfftfreq(n) result(out) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer,dimension(n) Description Integer frequency values involved in real FFT.\n( Specifiction )","tags":"","loc":"interface/rfftfreq.html"},{"title":"zfftb – Fortran-lang/fftpack","text":"interface public pure subroutine zfftb(n, c, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of zfftf .\n( Specification )","tags":"","loc":"interface/zfftb.html"},{"title":"zfftf – Fortran-lang/fftpack","text":"interface public pure subroutine zfftf(n, c, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) Description Forward transform of a complex periodic sequence.\n( Specification )","tags":"","loc":"interface/zfftf.html"},{"title":"zffti – Fortran-lang/fftpack","text":"interface public pure subroutine zffti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize zfftf and zfftb .\n( Specification )","tags":"","loc":"interface/zffti.html"},{"title":"fftpack – Fortran-lang/fftpack","text":"Uses fftpack_kind Used by Descendants: fftpack_dct fftpack_fft fftpack_fftshift fftpack_ifft fftpack_ifftshift fftpack_irfft fftpack_rfft fftpack_utils Contents Interfaces dcosqb dcosqf dcosqi dcost dcosti dct dct_t1 dct_t1i dct_t2 dct_t23i dct_t3 dfftb dfftf dffti dzfftb dzfftf dzffti fft fftfreq fftshift idct ifft ifftshift irfft rfft rfftfreq zfftb zfftf zffti Interfaces interface public pure subroutine dcosqb(n, x, wsave) Unnormalized inverse of dcosqf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dcosqf(n, x, wsave) Forward transform of quarter wave data.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dcosqi(n, wsave) Initialize dcosqf and dcosqb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) interface public pure subroutine dcost(n, x, wsave) Discrete fourier cosine transform of an even sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dcosti(n, wsave) Initialize dcost .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) public interface dct Dsicrete cosine transforms.\n( Specification ) private pure module function dct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:) public interface dct_t1 Perform DCT type-1\n( Specification ) public interface dcost () Arguments None public interface dct_t1i Initialize DCT type-1\n( Specification ) public interface dcosti () Arguments None public interface dct_t2 Perform DCT type-2\n( Specification ) public interface dcosqb () Arguments None public interface dct_t23i Initialize DCT types 2, 3\n( Specification ) public interface dcosqi () Arguments None public interface dct_t3 Perform DCT type-3\n( Specification ) public interface dcosqf () Arguments None interface public pure subroutine dfftb(n, r, wsave) Unnormalized inverse of dfftf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dfftf(n, r, wsave) Forward transform of a real periodic sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dffti(n, wsave) Initialize dfftf and dfftb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) interface public pure subroutine dzfftb(n, r, azero, a, b, wsave) Unnormalized inverse of dzfftf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: r (*) real(kind=rk), intent(in) :: azero real(kind=rk), intent(in) :: a (*) real(kind=rk), intent(in) :: b (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dzfftf(n, r, azero, a, b, wsave) Simplified forward transform of a real periodic sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(in) :: r (*) real(kind=rk), intent(out) :: azero real(kind=rk), intent(out) :: a (*) real(kind=rk), intent(out) :: b (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dzffti(n, wsave) Initialize dzfftf and dzfftb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) public interface fft Forward transform of a complex periodic sequence.\n( Specifiction ) private pure module function fft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:) interface public pure module function fftfreq(n) result(out) Integer frequency values involved in complex FFT.\n( Specifiction ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer, dimension(n) public interface fftshift Shifts zero-frequency component to center of spectrum.\n( Specifiction ) private pure module function fftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function fftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x)) public interface idct Inverse discrete cosine transforms.\n( Specification ) private pure module function idct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:) public interface ifft Backward transform of a complex periodic sequence.\n( Specifiction ) private pure module function ifft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:) public interface ifftshift Shifts zero-frequency component to beginning of spectrum.\n( Specifiction ) private pure module function ifftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function ifftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x)) public interface irfft Backward transform of a real periodic sequence.\n( Specifiction ) private pure module function irfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:) public interface rfft Forward transform of a real periodic sequence.\n( Specifiction ) private pure module function rfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:) interface public pure module function rfftfreq(n) result(out) Integer frequency values involved in real FFT.\n( Specifiction ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer, dimension(n) interface public pure subroutine zfftb(n, c, wsave) Unnormalized inverse of zfftf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine zfftf(n, c, wsave) Forward transform of a complex periodic sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine zffti(n, wsave) Initialize zfftf and zfftb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*)","tags":"","loc":"module/fftpack.html"},{"title":"fftpack_kind – Fortran-lang/fftpack","text":"Contents Variables rk Variables Type Visibility Attributes Name Initial integer, public, parameter :: rk = kind(1.0d0)","tags":"","loc":"module/fftpack_kind.html"},{"title":"fftpack_fftshift – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_fftshift.html"},{"title":"fftpack_dct – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_dct.html"},{"title":"fftpack_fft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_fft.html"},{"title":"fftpack_irfft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_irfft.html"},{"title":"fftpack_ifft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_ifft.html"},{"title":"fftpack_utils – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_utils.html"},{"title":"fftpack_ifftshift – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_ifftshift.html"},{"title":"fftpack_rfft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_rfft.html"},{"title":"fftpack.f90 – Fortran-lang/fftpack","text":"Contents Modules fftpack Source Code fftpack.f90 Source Code module fftpack use fftpack_kind implicit none private public :: zffti , zfftf , zfftb public :: fft , ifft public :: fftshift , ifftshift public :: fftfreq , rfftfreq public :: dffti , dfftf , dfftb public :: rfft , irfft public :: dzffti , dzfftf , dzfftb public :: dcosqi , dcosqf , dcosqb public :: dcosti , dcost public :: dct , idct public :: dct_t1i , dct_t1 public :: dct_t23i , dct_t2 , dct_t3 public :: rk interface !> Version: experimental !> !> Initialize `zfftf` and `zfftb`. !> ([Specification](../page/specs/fftpack.html#zffti)) pure subroutine zffti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine zffti !> Version: experimental !> !> Forward transform of a complex periodic sequence. !> ([Specification](../page/specs/fftpack.html#zfftf)) pure subroutine zfftf ( n , c , wsave ) import rk integer , intent ( in ) :: n complex ( kind = rk ), intent ( inout ) :: c ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine zfftf !> Version: experimental !> !> Unnormalized inverse of `zfftf`. !> ([Specification](../page/specs/fftpack.html#zfftb)) pure subroutine zfftb ( n , c , wsave ) import rk integer , intent ( in ) :: n complex ( kind = rk ), intent ( inout ) :: c ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine zfftb !> Version: experimental !> !> Initialize `dfftf` and `dfftb`. !> ([Specification](../page/specs/fftpack.html#dffti)) pure subroutine dffti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dffti !> Version: experimental !> !> Forward transform of a real periodic sequence. !> ([Specification](../page/specs/fftpack.html#dfftf)) pure subroutine dfftf ( n , r , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: r ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dfftf !> Version: experimental !> !> Unnormalized inverse of `dfftf`. !> ([Specification](../page/specs/fftpack.html#dfftb)) pure subroutine dfftb ( n , r , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: r ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dfftb !> Version: experimental !> !> Initialize `dzfftf` and `dzfftb`. !> ([Specification](../page/specs/fftpack.html#dzffti)) pure subroutine dzffti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dzffti !> Version: experimental !> !> Simplified forward transform of a real periodic sequence. !> ([Specification](../page/specs/fftpack.html#dzfftf)) pure subroutine dzfftf ( n , r , azero , a , b , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( in ) :: r ( * ) real ( kind = rk ), intent ( out ) :: azero real ( kind = rk ), intent ( out ) :: a ( * ), b ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dzfftf !> Version: experimental !> !> Unnormalized inverse of `dzfftf`. !> ([Specification](../page/specs/fftpack.html#dzfftb)) pure subroutine dzfftb ( n , r , azero , a , b , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: r ( * ) real ( kind = rk ), intent ( in ) :: azero real ( kind = rk ), intent ( in ) :: a ( * ), b ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dzfftb !> Version: experimental !> !> Initialize `dcosqf` and `dcosqb`. !> ([Specification](../page/specs/fftpack.html#initialize-dct-2-3-dcosqi-or-dct_t23i)) pure subroutine dcosqi ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dcosqi !> Version: experimental !> !> Forward transform of quarter wave data. !> ([Specification](../page/specs/fftpack.html#compute-dct-3-dcosqf-or-dct_t3)) pure subroutine dcosqf ( n , x , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: x ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dcosqf !> Version: experimental !> !> Unnormalized inverse of `dcosqf`. !> ([Specification](../page/specs/fftpack.html#compute-dct-2-dcosqb-or-dct_t2)) pure subroutine dcosqb ( n , x , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: x ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dcosqb !> Version: experimental !> !> Initialize `dcost`. !> ([Specification](../page/specs/fftpack.html#initialize-dct-1-dcosti-or-dct_t1i)) pure subroutine dcosti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dcosti !> Version: experimental !> !> Discrete fourier cosine transform of an even sequence. !> ([Specification](../page/specs/fftpack.html#compute-dct-1-dcost-or-dct_t1)) pure subroutine dcost ( n , x , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: x ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dcost !> Version: experimental !> !> Integer frequency values involved in complex FFT. !> ([Specifiction](../page/specs/fftpack.html#fftfreq)) pure module function fftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out end function fftfreq !> Version: experimental !> !> Integer frequency values involved in real FFT. !> ([Specifiction](../page/specs/fftpack.html#rfftfreq)) pure module function rfftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out end function rfftfreq end interface !> Version: experimental !> !> Forward transform of a complex periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#fft)) interface fft pure module function fft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) end function fft_rk end interface fft !> Version: experimental !> !> Backward transform of a complex periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#ifft)) interface ifft pure module function ifft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) end function ifft_rk end interface ifft !> Version: experimental !> !> Forward transform of a real periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#rfft)) interface rfft pure module function rfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) end function rfft_rk end interface rfft !> Version: experimental !> !> Backward transform of a real periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#irfft)) interface irfft pure module function irfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) end function irfft_rk end interface irfft !> Version: experimental !> !> Dsicrete cosine transforms. !> ([Specification](../page/specs/fftpack.html#simplified-dct-of-types-1-2-3-dct)) interface dct pure module function dct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) end function dct_rk end interface dct !> Version: experimental !> !> Inverse discrete cosine transforms. !> ([Specification](../page/specs/fftpack.html#simplified-inverse-dct-of-types-1-2-3-idct)) interface idct pure module function idct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) end function idct_rk end interface idct !> Version: experimental !> !> Initialize DCT type-1 !> ([Specification](../page/specs/fftpack.html#initialize-dct-1-dcosti-or-dct_t1i)) interface dct_t1i procedure :: dcosti end interface dct_t1i !> Version: experimental !> !> Perform DCT type-1 !> ([Specification](../page/specs/fftpack.html#compute-dct-1-dcost-or-dct_t1)) interface dct_t1 procedure :: dcost end interface dct_t1 !> Version: experimental !> !> Initialize DCT types 2, 3 !> ([Specification](../page/specs/fftpack.html#initialize-dct-2-3-dcosqi-or-dct_t23i)) interface dct_t23i procedure :: dcosqi end interface dct_t23i !> Version: experimental !> !> Perform DCT type-2 !> ([Specification](../page/specs/fftpack.html#compute-dct-2-dcosqb-or-dct_t2)) interface dct_t2 procedure :: dcosqb end interface dct_t2 !> Version: experimental !> !> Perform DCT type-3 !> ([Specification](../page/specs/fftpack.html#compute-dct-3-dcosqf-or-dct_t3)) interface dct_t3 procedure :: dcosqf end interface dct_t3 !> Version: experimental !> !> Shifts zero-frequency component to center of spectrum. !> ([Specifiction](../page/specs/fftpack.html#fftshift)) interface fftshift pure module function fftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result end function fftshift_crk pure module function fftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result end function fftshift_rrk end interface fftshift !> Version: experimental !> !> Shifts zero-frequency component to beginning of spectrum. !> ([Specifiction](../page/specs/fftpack.html#ifftshift)) interface ifftshift pure module function ifftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result end function ifftshift_crk pure module function ifftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result end function ifftshift_rrk end interface ifftshift end module fftpack","tags":"","loc":"sourcefile/fftpack.f90.html"},{"title":"radb5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb5 Source Code radb5.f90 Source Code subroutine radb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 ti5 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 5 , k ) + Cc ( 1 , 5 , k ) tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr3 = Cc ( Ido , 4 , k ) + Cc ( Ido , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci5 = ti11 * ti5 + ti12 * ti4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 1 , k , 5 ) = cr2 + ci5 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti5 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ti4 = Cc ( i , 5 , k ) + Cc ( ic , 4 , k ) ti3 = Cc ( i , 5 , k ) - Cc ( ic , 4 , k ) tr5 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) tr4 = Cc ( i - 1 , 5 , k ) - Cc ( ic - 1 , 4 , k ) tr3 = Cc ( i - 1 , 5 , k ) + Cc ( ic - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * dr4 - Wa3 ( i - 1 ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * di4 + Wa3 ( i - 1 ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 2 ) * dr5 - Wa4 ( i - 1 ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 2 ) * di5 + Wa4 ( i - 1 ) * dr5 enddo enddo end subroutine radb5","tags":"","loc":"sourcefile/radb5.f90.html"},{"title":"radf5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf5 Source Code radf5.f90 Source Code subroutine radf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 5 ) , Ch ( Ido , 5 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 cr2 = Cc ( 1 , k , 5 ) + Cc ( 1 , k , 2 ) ci5 = Cc ( 1 , k , 5 ) - Cc ( 1 , k , 2 ) cr3 = Cc ( 1 , k , 4 ) + Cc ( 1 , k , 3 ) ci4 = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 + cr3 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 Ch ( 1 , 3 , k ) = ti11 * ci5 + ti12 * ci4 Ch ( Ido , 4 , k ) = Cc ( 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 Ch ( 1 , 5 , k ) = ti12 * ci5 - ti11 * ci4 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) dr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) di4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) dr5 = Wa4 ( i - 2 ) * Cc ( i - 1 , k , 5 ) + Wa4 ( i - 1 ) * Cc ( i , k , 5 ) di5 = Wa4 ( i - 2 ) * Cc ( i , k , 5 ) - Wa4 ( i - 1 ) * Cc ( i - 1 , k , 5 ) cr2 = dr2 + dr5 ci5 = dr5 - dr2 cr5 = di2 - di5 ci2 = di2 + di5 cr3 = dr3 + dr4 ci4 = dr4 - dr3 cr4 = di3 - di4 ci3 = di3 + di4 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 + cr3 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 + ci3 tr2 = Cc ( i - 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 ti2 = Cc ( i , k , 1 ) + tr11 * ci2 + tr12 * ci3 tr3 = Cc ( i - 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 ti3 = Cc ( i , k , 1 ) + tr12 * ci2 + tr11 * ci3 tr5 = ti11 * cr5 + ti12 * cr4 ti5 = ti11 * ci5 + ti12 * ci4 tr4 = ti12 * cr5 - ti11 * cr4 ti4 = ti12 * ci5 - ti11 * ci4 Ch ( i - 1 , 3 , k ) = tr2 + tr5 Ch ( ic - 1 , 2 , k ) = tr2 - tr5 Ch ( i , 3 , k ) = ti2 + ti5 Ch ( ic , 2 , k ) = ti5 - ti2 Ch ( i - 1 , 5 , k ) = tr3 + tr4 Ch ( ic - 1 , 4 , k ) = tr3 - tr4 Ch ( i , 5 , k ) = ti3 + ti4 Ch ( ic , 4 , k ) = ti4 - ti3 enddo enddo end subroutine radf5","tags":"","loc":"sourcefile/radf5.f90.html"},{"title":"radb3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb3 Source Code radb3.f90 Source Code subroutine radb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ci3 = taui * ( Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k )) ci3 = taui * ( Cc ( i , 3 , k ) + Cc ( ic , 2 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 enddo enddo end subroutine radb3","tags":"","loc":"sourcefile/radb3.f90.html"},{"title":"zfftb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines zfftb Source Code zfftb.f90 Source Code subroutine zfftb ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftb1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftb","tags":"","loc":"sourcefile/zfftb.f90.html"},{"title":"dffti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dffti Source Code dffti.f90 Source Code subroutine dffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call rffti1 ( n , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dffti","tags":"","loc":"sourcefile/dffti.f90.html"},{"title":"passb5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb5 Source Code passb5.f90 Source Code subroutine passb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 - Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 + Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 - Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 + Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passb5","tags":"","loc":"sourcefile/passb5.f90.html"},{"title":"passb2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb2 Source Code passb2.f90 Source Code subroutine passb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 + Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 - Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passb2","tags":"","loc":"sourcefile/passb2.f90.html"},{"title":"passf2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf2 Source Code passf2.f90 Source Code subroutine passf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 - Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 + Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passf2","tags":"","loc":"sourcefile/passf2.f90.html"},{"title":"dcosqf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosqf Source Code dcosqf.f90 Source Code subroutine dcosqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: tsqx , Wsave , x dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) if ( n < 2 ) then return elseif ( n == 2 ) then tsqx = sqrt2 * x ( 2 ) x ( 2 ) = x ( 1 ) - tsqx x ( 1 ) = x ( 1 ) + tsqx else call cosqf1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqf","tags":"","loc":"sourcefile/dcosqf.f90.html"},{"title":"fftpack_fftshift.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_fftshift Source Code fftpack_fftshift.f90 Source Code submodule ( fftpack ) fftpack_fftshift contains !> Shifts zero-frequency component to center of spectrum for `complex` type. pure module function fftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- floor ( 0.5_rk * size ( x ))) end function fftshift_crk !> Shifts zero-frequency component to center of spectrum for `real` type. pure module function fftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- floor ( 0.5_rk * size ( x ))) end function fftshift_rrk end submodule fftpack_fftshift","tags":"","loc":"sourcefile/fftpack_fftshift.f90.html"},{"title":"radbg.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radbg Source Code radbg.f90 Source Code subroutine radbg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2 * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Ch ( 1 , k , j ) = Cc ( Ido , j2 - 2 , k ) + Cc ( Ido , j2 - 2 , k ) Ch ( 1 , k , jc ) = Cc ( 1 , j2 - 1 , k ) + Cc ( 1 , j2 - 1 , k ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo endif endif ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + ar1 * Ch2 ( ik , 2 ) c2 ( ik , lc ) = ai1 * Ch2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + ar2 * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + ai2 * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) - c1 ( 1 , k , jc ) Ch ( 1 , k , jc ) = c1 ( 1 , k , j ) + c1 ( 1 , k , jc ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo endif endif if ( Ido == 1 ) return do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo endif end subroutine radbg","tags":"","loc":"sourcefile/radbg.f90.html"},{"title":"cfftb1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cfftb1 Source Code cfftb1.f90 Source Code subroutine cfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passb4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passb4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passb2 ( idot , l1 , Ch , c , Wa ( iw )) else call passb2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passb3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passb3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passb ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passb ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passb5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passb5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftb1","tags":"","loc":"sourcefile/cfftb1.f90.html"},{"title":"passf5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf5 Source Code passf5.f90 Source Code subroutine passf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = - sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = - sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 + Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 - Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 + Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 - Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passf5","tags":"","loc":"sourcefile/passf5.f90.html"},{"title":"fftpack_dct.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_dct Source Code fftpack_dct.f90 Source Code submodule ( fftpack ) fftpack_dct contains !> Discrete cosine transforms of types 1, 2, 3. pure module function dct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if ! Default to DCT-2 if (. not . present ( type )) then lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqb ( lenseq , result , wsave ) return end if if ( type == 1 ) then ! DCT-1 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosti ( lenseq , wsave ) call dcost ( lenseq , result , wsave ) else if ( type == 2 ) then ! DCT-2 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqb ( lenseq , result , wsave ) else if ( type == 3 ) then ! DCT-3 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqf ( lenseq , result , wsave ) end if end function dct_rk !> Inverse discrete cosine transforms of types 1, 2, 3. pure module function idct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if ! Default to t=2; inverse DCT-2 is DCT-3 if (. not . present ( type )) then lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqf ( lenseq , result , wsave ) return end if if ( type == 1 ) then ! inverse DCT-1 is DCT-1 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosti ( lenseq , wsave ) call dcost ( lenseq , result , wsave ) else if ( type == 2 ) then ! inverse DCT-2 is DCT-3 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqf ( lenseq , result , wsave ) else if ( type == 3 ) then ! inverse DCT-3 is DCT-2 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqb ( lenseq , result , wsave ) end if end function idct_rk end submodule fftpack_dct","tags":"","loc":"sourcefile/fftpack_dct.f90.html"},{"title":"fftpack_fft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_fft Source Code fftpack_fft.f90 Source Code submodule ( fftpack ) fftpack_fft contains !> Forward transform of a complex periodic sequence. pure module function fft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , (( 0.0_rk , 0.0_rk ), i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 4 * lenseq + 15 allocate ( wsave ( lensav )) call zffti ( lenseq , wsave ) !> Forward transformation call zfftf ( lenseq , result , wsave ) end function fft_rk end submodule fftpack_fft","tags":"","loc":"sourcefile/fftpack_fft.f90.html"},{"title":"dcost.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcost Source Code dcost.f90 Source Code subroutine dcost ( n , x , Wsave ) use fftpack_kind implicit none real ( rk ) :: c1 , t1 , t2 , tx2 , Wsave , x , x1h , x1p3 , & xi , xim2 integer :: i , k , kc , modn , n , nm1 , np1 , ns2 dimension x ( * ) , Wsave ( * ) nm1 = n - 1 np1 = n + 1 ns2 = n / 2 if ( n < 2 ) return if ( n == 2 ) then x1h = x ( 1 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 2 ) x ( 1 ) = x1h return elseif ( n > 3 ) then c1 = x ( 1 ) - x ( n ) x ( 1 ) = x ( 1 ) + x ( n ) do k = 2 , ns2 kc = np1 - k t1 = x ( k ) + x ( kc ) t2 = x ( k ) - x ( kc ) c1 = c1 + Wsave ( kc ) * t2 t2 = Wsave ( k ) * t2 x ( k ) = t1 - t2 x ( kc ) = t1 + t2 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) call dfftf ( nm1 , x , Wsave ( n + 1 )) xim2 = x ( 2 ) x ( 2 ) = c1 do i = 4 , n , 2 xi = x ( i ) x ( i ) = x ( i - 2 ) - x ( i - 1 ) x ( i - 1 ) = xim2 xim2 = xi enddo if ( modn /= 0 ) x ( n ) = xim2 return endif x1p3 = x ( 1 ) + x ( 3 ) tx2 = x ( 2 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 3 ) x ( 1 ) = x1p3 + tx2 x ( 3 ) = x1p3 - tx2 end subroutine dcost","tags":"","loc":"sourcefile/dcost.f90.html"},{"title":"radf4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf4 Source Code radf4.f90 Source Code subroutine radf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 4 ) , Ch ( Ido , 4 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: hsqt2 = sqrt ( 2.0_rk ) / 2.0_rk do k = 1 , l1 tr1 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 4 ) tr2 = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = tr1 + tr2 Ch ( Ido , 4 , k ) = tr2 - tr1 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 3 , k ) = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i cr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ci2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) cr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) ci3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) ci4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) tr1 = cr2 + cr4 tr4 = cr4 - cr2 ti1 = ci2 + ci4 ti4 = ci2 - ci4 ti2 = Cc ( i , k , 1 ) + ci3 ti3 = Cc ( i , k , 1 ) - ci3 tr2 = Cc ( i - 1 , k , 1 ) + cr3 tr3 = Cc ( i - 1 , k , 1 ) - cr3 Ch ( i - 1 , 1 , k ) = tr1 + tr2 Ch ( ic - 1 , 4 , k ) = tr2 - tr1 Ch ( i , 1 , k ) = ti1 + ti2 Ch ( ic , 4 , k ) = ti1 - ti2 Ch ( i - 1 , 3 , k ) = ti4 + tr3 Ch ( ic - 1 , 2 , k ) = tr3 - ti4 Ch ( i , 3 , k ) = tr4 + ti3 Ch ( ic , 2 , k ) = tr4 - ti3 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = - hsqt2 * ( Cc ( Ido , k , 2 ) + Cc ( Ido , k , 4 )) tr1 = hsqt2 * ( Cc ( Ido , k , 2 ) - Cc ( Ido , k , 4 )) Ch ( Ido , 1 , k ) = tr1 + Cc ( Ido , k , 1 ) Ch ( Ido , 3 , k ) = Cc ( Ido , k , 1 ) - tr1 Ch ( 1 , 2 , k ) = ti1 - Cc ( Ido , k , 3 ) Ch ( 1 , 4 , k ) = ti1 + Cc ( Ido , k , 3 ) enddo end subroutine radf4","tags":"","loc":"sourcefile/radf4.f90.html"},{"title":"zfftf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines zfftf Source Code zfftf.f90 Source Code subroutine zfftf ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftf1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftf","tags":"","loc":"sourcefile/zfftf.f90.html"},{"title":"radb2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb2 Source Code radb2.f90 Source Code subroutine radb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( Ido , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( Ido , 2 , k ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) - Cc ( ic , 2 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( ic , 2 , k ) Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * tr2 - Wa1 ( i - 1 ) * ti2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ti2 + Wa1 ( i - 1 ) * tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( Ido , k , 1 ) = Cc ( Ido , 1 , k ) + Cc ( Ido , 1 , k ) Ch ( Ido , k , 2 ) = - ( Cc ( 1 , 2 , k ) + Cc ( 1 , 2 , k )) enddo end subroutine radb2","tags":"","loc":"sourcefile/radb2.f90.html"},{"title":"rfftf1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines rfftf1 Source Code rfftf1.f90 Source Code subroutine rfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & kh , l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 1 l2 = n iw = n do k1 = 1 , nf kh = nf - k1 ip = Ifac ( kh + 3 ) l1 = l2 / ip ido = n / l2 idl1 = ido * l1 iw = iw - ( ip - 1 ) * ido na = 1 - na if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radf4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radf4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif elseif ( ip /= 2 ) then if ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radf3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radf3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif elseif ( ip /= 5 ) then if ( ido == 1 ) na = 1 - na if ( na /= 0 ) then call radfg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) na = 0 else call radfg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) na = 1 endif else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radf5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radf5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif endif elseif ( na /= 0 ) then call radf2 ( ido , l1 , Ch , c , Wa ( iw )) else call radf2 ( ido , l1 , c , Ch , Wa ( iw )) endif l2 = l1 enddo if ( na == 1 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftf1","tags":"","loc":"sourcefile/rfftf1.f90.html"},{"title":"radf3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf3 Source Code radf3.f90 Source Code subroutine radf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , cr2 , di2 , di3 , dr2 , dr3 , & ti2 , ti3 , tr2 , tr3 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 3 , l1 ) , Cc ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk ! note: original comment said this was -SQRT(3)/2 but value was 0.86602540378443864676d0 real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 cr2 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 Ch ( 1 , 3 , k ) = taui * ( Cc ( 1 , k , 3 ) - Cc ( 1 , k , 2 )) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + taur * cr2 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr2 = dr2 + dr3 ci2 = di2 + di3 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 tr2 = Cc ( i - 1 , k , 1 ) + taur * cr2 ti2 = Cc ( i , k , 1 ) + taur * ci2 tr3 = taui * ( di2 - di3 ) ti3 = taui * ( dr3 - dr2 ) Ch ( i - 1 , 3 , k ) = tr2 + tr3 Ch ( ic - 1 , 2 , k ) = tr2 - tr3 Ch ( i , 3 , k ) = ti2 + ti3 Ch ( ic , 2 , k ) = ti3 - ti2 enddo enddo end subroutine radf3","tags":"","loc":"sourcefile/radf3.f90.html"},{"title":"passb3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb3 Source Code passb3.f90 Source Code subroutine passb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passb3","tags":"","loc":"sourcefile/passb3.f90.html"},{"title":"dzfftb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dzfftb Source Code dzfftb.f90 Source Code subroutine dzfftb ( n , r , Azero , a , b , Wsave ) use fftpack_kind implicit none real ( rk ) :: a , Azero , b , r , Wsave integer :: i , n , ns2 dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then r ( 1 ) = Azero return elseif ( n == 2 ) then r ( 1 ) = Azero + a ( 1 ) r ( 2 ) = Azero - a ( 1 ) return else ns2 = ( n - 1 ) / 2 do i = 1 , ns2 r ( 2 * i ) = 0.5_rk * a ( i ) r ( 2 * i + 1 ) = - 0.5_rk * b ( i ) enddo r ( 1 ) = Azero if ( mod ( n , 2 ) == 0 ) r ( n ) = a ( ns2 + 1 ) call dfftb ( n , r , Wsave ( n + 1 )) endif end subroutine dzfftb","tags":"","loc":"sourcefile/dzfftb.f90.html"},{"title":"passf4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf4 Source Code passf4.f90 Source Code subroutine passf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 2 , k ) - Cc ( i , 4 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 4 , k ) - Cc ( i - 1 , 2 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 + Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 - Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 + Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 - Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 + Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 - Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 2 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passf4","tags":"","loc":"sourcefile/passf4.f90.html"},{"title":"fftpack_irfft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_irfft Source Code fftpack_irfft.f90 Source Code submodule ( fftpack ) fftpack_irfft contains !> Backward transform of a real periodic sequence. pure module function irfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 2 * lenseq + 15 allocate ( wsave ( lensav )) call dffti ( lenseq , wsave ) !> Backward transformation call dfftb ( lenseq , result , wsave ) end function irfft_rk end submodule fftpack_irfft","tags":"","loc":"sourcefile/fftpack_irfft.f90.html"},{"title":"zffti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines zffti Source Code zffti.f90 Source Code subroutine zffti ( n , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cffti1 ( n , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zffti","tags":"","loc":"sourcefile/zffti.f90.html"},{"title":"passb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb Source Code passb.f90 Source Code subroutine passb ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo return endif idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo return end subroutine passb","tags":"","loc":"sourcefile/passb.f90.html"},{"title":"dsint.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsint Source Code dsint.f90 Source Code subroutine dsint ( n , x , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , iw3 , n , np1 real ( rk ) :: Wsave , x dimension x ( * ) , Wsave ( * ) np1 = n + 1 iw1 = n / 2 + 1 iw2 = iw1 + np1 iw3 = iw2 + np1 call sint1 ( n , x , Wsave , Wsave ( iw1 ), Wsave ( iw2 ), Wsave ( iw3 )) end subroutine dsint","tags":"","loc":"sourcefile/dsint.f90.html"},{"title":"rfftb1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines rfftb1 Source Code rfftb1.f90 Source Code subroutine rfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idl1 = ido * l1 if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radb4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radb4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call radb2 ( ido , l1 , Ch , c , Wa ( iw )) else call radb2 ( ido , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radb3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radb3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call radbg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call radbg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( ido == 1 ) na = 1 - na else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radb5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radb5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * ido enddo if ( na == 0 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftb1","tags":"","loc":"sourcefile/rfftb1.f90.html"},{"title":"radf2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf2 Source Code radf2.f90 Source Code subroutine radf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 2 , l1 ) , Cc ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 2 ) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ti2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ti2 Ch ( ic , 2 , k ) = ti2 - Cc ( i , k , 1 ) Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + tr2 Ch ( ic - 1 , 2 , k ) = Cc ( i - 1 , k , 1 ) - tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( 1 , 2 , k ) = - Cc ( Ido , k , 2 ) Ch ( Ido , 1 , k ) = Cc ( Ido , k , 1 ) enddo end subroutine radf2","tags":"","loc":"sourcefile/radf2.f90.html"},{"title":"radfg.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radfg Source Code radfg.f90 Source Code subroutine radfg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) ipph = ( Ip + 1 ) / 2 ipp2 = Ip + 2 idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 if ( Ido == 1 ) then do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo else do ik = 1 , Idl1 Ch2 ( ik , 1 ) = c2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo endif if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo endif endif do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) + Ch ( 1 , k , jc ) c1 ( 1 , k , jc ) = Ch ( 1 , k , jc ) - Ch ( 1 , k , j ) enddo enddo ! ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 Ch2 ( ik , l ) = c2 ( ik , 1 ) + ar1 * c2 ( ik , 2 ) Ch2 ( ik , lc ) = ai1 * c2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 Ch2 ( ik , l ) = Ch2 ( ik , l ) + ar2 * c2 ( ik , j ) Ch2 ( ik , lc ) = Ch2 ( ik , lc ) + ai2 * c2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + c2 ( ik , j ) enddo enddo ! if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Cc ( Ido , j2 - 2 , k ) = Ch ( 1 , k , j ) Cc ( 1 , j2 - 1 , k ) = Ch ( 1 , k , jc ) enddo enddo if ( Ido == 1 ) return if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j j2 = j + j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo end if end subroutine radfg","tags":"","loc":"sourcefile/radfg.f90.html"},{"title":"dsinti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinti Source Code dsinti.f90 Source Code subroutine dsinti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , Wsave integer :: k , n , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 1 ) return ns2 = n / 2 np1 = n + 1 dt = pi / real ( np1 , rk ) do k = 1 , ns2 Wsave ( k ) = 2.0_rk * sin ( k * dt ) enddo call dffti ( np1 , Wsave ( ns2 + 1 )) end subroutine dsinti","tags":"","loc":"sourcefile/dsinti.f90.html"},{"title":"dzffti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dzffti Source Code dzffti.f90 Source Code subroutine dzffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call ezfft1 ( n , Wsave ( 2 * n + 1 ), Wsave ( 3 * n + 1 )) end subroutine dzffti","tags":"","loc":"sourcefile/dzffti.f90.html"},{"title":"passf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf Source Code passf.f90 Source Code subroutine passf ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = - Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) - wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo end if end subroutine passf","tags":"","loc":"sourcefile/passf.f90.html"},{"title":"sint1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines sint1 Source Code sint1.f90 Source Code subroutine sint1 ( n , War , Was , Xh , x , Ifac ) use fftpack_kind implicit none integer :: i , Ifac , k , kc , modn , n , np1 , ns2 real ( rk ) :: t1 , t2 , War , Was , x , Xh , xhold dimension War ( * ) , Was ( * ) , x ( * ) , Xh ( * ) , Ifac ( * ) real ( rk ), parameter :: sqrt3 = sqrt ( 3.0_rk ) do i = 1 , n Xh ( i ) = War ( i ) War ( i ) = x ( i ) enddo if ( n < 2 ) then Xh ( 1 ) = Xh ( 1 ) + Xh ( 1 ) elseif ( n == 2 ) then xhold = sqrt3 * ( Xh ( 1 ) + Xh ( 2 )) Xh ( 2 ) = sqrt3 * ( Xh ( 1 ) - Xh ( 2 )) Xh ( 1 ) = xhold else np1 = n + 1 ns2 = n / 2 x ( 1 ) = 0.0_rk do k = 1 , ns2 kc = np1 - k t1 = Xh ( k ) - Xh ( kc ) t2 = Was ( k ) * ( Xh ( k ) + Xh ( kc )) x ( k + 1 ) = t1 + t2 x ( kc + 1 ) = t2 - t1 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 2 ) = 4.0_rk * Xh ( ns2 + 1 ) call rfftf1 ( np1 , x , Xh , War , Ifac ) Xh ( 1 ) = 0.5_rk * x ( 1 ) do i = 3 , n , 2 Xh ( i - 1 ) = - x ( i ) Xh ( i ) = Xh ( i - 2 ) + x ( i - 1 ) enddo if ( modn == 0 ) Xh ( n ) = - x ( n + 1 ) endif do i = 1 , n x ( i ) = War ( i ) War ( i ) = Xh ( i ) enddo end subroutine sint1","tags":"","loc":"sourcefile/sint1.f90.html"},{"title":"dsinqf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinqf Source Code dsinqf.f90 Source Code subroutine dsinqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n == 1 ) return ns2 = n / 2 do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo call dcosqf ( n , x , Wsave ) do k = 2 , n , 2 x ( k ) = - x ( k ) enddo end subroutine dsinqf","tags":"","loc":"sourcefile/dsinqf.f90.html"},{"title":"dsinqi.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinqi Source Code dsinqi.f90 Source Code subroutine dsinqi ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) call dcosqi ( n , Wsave ) end subroutine dsinqi","tags":"","loc":"sourcefile/dsinqi.f90.html"},{"title":"rk.f90 – Fortran-lang/fftpack","text":"Contents Modules fftpack_kind Source Code rk.f90 Source Code module fftpack_kind implicit none integer , parameter :: rk = kind ( 1.0d0 ) end module fftpack_kind","tags":"","loc":"sourcefile/rk.f90.html"},{"title":"passb4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb4 Source Code passb4.f90 Source Code subroutine passb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 4 , k ) - Cc ( i , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 - Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 + Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 - Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 + Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 - Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 + Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 4 , k ) - Cc ( 2 , 2 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 2 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passb4","tags":"","loc":"sourcefile/passb4.f90.html"},{"title":"dcosqi.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosqi Source Code dcosqi.f90 Source Code subroutine dcosqi ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , n dimension Wsave ( * ) real ( rk ), parameter :: pih = acos ( - 1.0_rk ) / 2.0_rk ! pi / 2 dt = pih / real ( n , rk ) fk = 0.0_rk do k = 1 , n fk = fk + 1.0_rk Wsave ( k ) = cos ( fk * dt ) enddo call dffti ( n , Wsave ( n + 1 )) end subroutine dcosqi","tags":"","loc":"sourcefile/dcosqi.f90.html"},{"title":"fftpack_ifft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_ifft Source Code fftpack_ifft.f90 Source Code submodule ( fftpack ) fftpack_ifft contains !> Backward transform of a complex periodic sequence. pure module function ifft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , (( 0.0_rk , 0.0_rk ), i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 4 * lenseq + 15 allocate ( wsave ( lensav )) call zffti ( lenseq , wsave ) !> Backward transformation call zfftb ( lenseq , result , wsave ) end function ifft_rk end submodule fftpack_ifft","tags":"","loc":"sourcefile/fftpack_ifft.f90.html"},{"title":"cfftf1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cfftf1 Source Code cfftf1.f90 Source Code subroutine cfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passf4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passf4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passf2 ( idot , l1 , Ch , c , Wa ( iw )) else call passf2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passf3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passf3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passf ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passf ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passf5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passf5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftf1","tags":"","loc":"sourcefile/cfftf1.f90.html"},{"title":"fftpack_utils.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_utils Source Code fftpack_utils.f90 Source Code submodule ( fftpack ) fftpack_utils contains !> Returns an integer array with the frequency values involved in the !> performed FFT, ordered in the standard way (zero first, then positive !> frequencies, then the negative ones). pure module function fftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out integer :: i out ( 1 ) = 0 if ( n == 1 ) return if ( mod ( n , 2 ) == 0 ) then ! n even, smallest n = 2 do i = 2 , n / 2 out ( i ) = i - 1 end do out ( n / 2 + 1 ) = - n / 2 do i = n / 2 + 2 , n ! only enters if n/2+2 <= n out ( i ) = out ( i - 1 ) + 1 end do else ! n odd, smallest n = 3 do i = 2 , n / 2 + 1 out ( i ) = i - 1 end do out ( n / 2 + 2 ) = - out ( n / 2 + 1 ) do i = n / 2 + 3 , n ! only enters if n/2+3 <= n out ( i ) = out ( i - 1 ) + 1 end do end if end function fftfreq !> Returns an integer array with the frequency values involved in the !> performed real FFT, ordered in the standard way (zero first, then !> positive frequencies, then, if applicable, the negative one). pure module function rfftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out integer :: i out ( 1 ) = 0 if ( n == 1 ) return if ( mod ( n , 2 ) == 0 ) then ! n even, smallest n = 2 do i = 2 , n - 2 , 2 out ( i ) = out ( i - 1 ) + 1 out ( i + 1 ) = out ( i ) end do out ( n ) = - n / 2 else ! n odd, smallest n = 3 do i = 2 , n - 1 , 2 out ( i ) = out ( i - 1 ) + 1 out ( i + 1 ) = out ( i ) end do end if end function rfftfreq end submodule fftpack_utils","tags":"","loc":"sourcefile/fftpack_utils.f90.html"},{"title":"dcosqb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosqb Source Code dcosqb.f90 Source Code subroutine dcosqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave , x , x1 dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: tsqrt2 = 2.0_rk * sqrt ( 2.0_rk ) if ( n < 2 ) then x ( 1 ) = 4.0_rk * x ( 1 ) return elseif ( n == 2 ) then x1 = 4.0_rk * ( x ( 1 ) + x ( 2 )) x ( 2 ) = tsqrt2 * ( x ( 1 ) - x ( 2 )) x ( 1 ) = x1 return else call cosqb1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqb","tags":"","loc":"sourcefile/dcosqb.f90.html"},{"title":"fftpack_ifftshift.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_ifftshift Source Code fftpack_ifftshift.f90 Source Code submodule ( fftpack ) fftpack_ifftshift contains !> Shifts zero-frequency component to beginning of spectrum for `complex` type. pure module function ifftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- ceiling ( 0.5_rk * size ( x ))) end function ifftshift_crk !> Shifts zero-frequency component to beginning of spectrum for `real` type. pure module function ifftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- ceiling ( 0.5_rk * size ( x ))) end function ifftshift_rrk end submodule fftpack_ifftshift","tags":"","loc":"sourcefile/fftpack_ifftshift.f90.html"},{"title":"ezfft1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines ezfft1 Source Code ezfft1.f90 Source Code subroutine ezfft1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg1 , argh , ch1 , ch1h , dch1 , dsh1 , sh1 , & Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) l2 = l1 * ip ido = n / l2 ipm = ip - 1 arg1 = real ( l1 , rk ) * argh ch1 = 1.0_rk sh1 = 0.0_rk dch1 = cos ( arg1 ) dsh1 = sin ( arg1 ) do j = 1 , ipm ch1h = dch1 * ch1 - dsh1 * sh1 sh1 = dch1 * sh1 + dsh1 * ch1 ch1 = ch1h i = is + 2 Wa ( i - 1 ) = ch1 Wa ( i ) = sh1 if ( ido >= 5 ) then do ii = 5 , ido , 2 i = i + 2 Wa ( i - 1 ) = ch1 * Wa ( i - 3 ) - sh1 * Wa ( i - 2 ) Wa ( i ) = ch1 * Wa ( i - 2 ) + sh1 * Wa ( i - 3 ) enddo endif is = is + ido enddo l1 = l2 enddo end subroutine ezfft1","tags":"","loc":"sourcefile/ezfft1.f90.html"},{"title":"dsinqb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinqb Source Code dsinqb.f90 Source Code subroutine dsinqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n > 1 ) then ns2 = n / 2 do k = 2 , n , 2 x ( k ) = - x ( k ) enddo call dcosqb ( n , x , Wsave ) do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo return endif x ( 1 ) = 4.0_rk * x ( 1 ) return end subroutine dsinqb","tags":"","loc":"sourcefile/dsinqb.f90.html"},{"title":"passf3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf3 Source Code passf3.f90 Source Code subroutine passf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = - sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passf3","tags":"","loc":"sourcefile/passf3.f90.html"},{"title":"dfftf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dfftf Source Code dfftf.f90 Source Code subroutine dfftf ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftf1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftf","tags":"","loc":"sourcefile/dfftf.f90.html"},{"title":"dcosti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosti Source Code dcosti.f90 Source Code subroutine dcosti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , kc , n , nm1 , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 3 ) return nm1 = n - 1 np1 = n + 1 ns2 = n / 2 dt = pi / real ( nm1 , rk ) fk = 0.0_rk do k = 2 , ns2 kc = np1 - k fk = fk + 1.0_rk Wsave ( k ) = 2.0_rk * sin ( fk * dt ) Wsave ( kc ) = 2.0_rk * cos ( fk * dt ) enddo call dffti ( nm1 , Wsave ( n + 1 )) end subroutine dcosti","tags":"","loc":"sourcefile/dcosti.f90.html"},{"title":"dfftb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dfftb Source Code dfftb.f90 Source Code subroutine dfftb ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftb1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftb","tags":"","loc":"sourcefile/dfftb.f90.html"},{"title":"cosqb1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cosqb1 Source Code cosqb1.f90 Source Code subroutine cosqb1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do i = 3 , n , 2 xim1 = x ( i - 1 ) + x ( i ) x ( i ) = x ( i ) - x ( i - 1 ) x ( i - 1 ) = xim1 enddo x ( 1 ) = x ( 1 ) + x ( 1 ) modn = mod ( n , 2 ) if ( modn == 0 ) x ( n ) = x ( n ) + x ( n ) call dfftb ( n , x , Xh ) do k = 2 , ns2 kc = np2 - k Xh ( k ) = w ( k - 1 ) * x ( kc ) + w ( kc - 1 ) * x ( k ) Xh ( kc ) = w ( k - 1 ) * x ( k ) - w ( kc - 1 ) * x ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * ( x ( ns2 + 1 ) + x ( ns2 + 1 )) do k = 2 , ns2 kc = np2 - k x ( k ) = Xh ( k ) + Xh ( kc ) x ( kc ) = Xh ( k ) - Xh ( kc ) enddo x ( 1 ) = x ( 1 ) + x ( 1 ) end subroutine cosqb1","tags":"","loc":"sourcefile/cosqb1.f90.html"},{"title":"rffti1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines rffti1 Source Code rffti1.f90 Source Code subroutine rffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , ld , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 ipm = ip - 1 do j = 1 , ipm ld = ld + l1 i = is argld = real ( ld , rk ) * argh fi = 0.0_rk do ii = 3 , ido , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo is = is + ido enddo l1 = l2 enddo end subroutine rffti1","tags":"","loc":"sourcefile/rffti1.f90.html"},{"title":"dzfftf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dzfftf Source Code dzfftf.f90 Source Code subroutine dzfftf ( n , r , Azero , a , b , Wsave ) ! ! VERSION 3 JUNE 1979 ! use fftpack_kind implicit none real ( rk ) :: a , Azero , b , cf , cfm , r , Wsave integer :: i , n , ns2 , ns2m dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then Azero = r ( 1 ) return elseif ( n == 2 ) then Azero = 0.5_rk * ( r ( 1 ) + r ( 2 )) a ( 1 ) = 0.5_rk * ( r ( 1 ) - r ( 2 )) return else do i = 1 , n Wsave ( i ) = r ( i ) enddo call dfftf ( n , Wsave , Wsave ( n + 1 )) cf = 2.0_rk / real ( n , rk ) cfm = - cf Azero = 0.5_rk * cf * Wsave ( 1 ) ns2 = ( n + 1 ) / 2 ns2m = ns2 - 1 do i = 1 , ns2m a ( i ) = cf * Wsave ( 2 * i ) b ( i ) = cfm * Wsave ( 2 * i + 1 ) enddo if ( mod ( n , 2 ) == 1 ) return a ( ns2 ) = 0.5_rk * cf * Wsave ( n ) b ( ns2 ) = 0.0_rk endif end subroutine dzfftf","tags":"","loc":"sourcefile/dzfftf.f90.html"},{"title":"fftpack_rfft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_rfft Source Code fftpack_rfft.f90 Source Code submodule ( fftpack ) fftpack_rfft contains !> Forward transform of a real periodic sequence. pure module function rfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 2 * lenseq + 15 allocate ( wsave ( lensav )) call dffti ( lenseq , wsave ) !> Forward transformation call dfftf ( lenseq , result , wsave ) end function rfft_rk end submodule fftpack_rfft","tags":"","loc":"sourcefile/fftpack_rfft.f90.html"},{"title":"cffti1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cffti1 Source Code cffti1.f90 Source Code subroutine cffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , i1 , ib , ido , idot , Ifac , ii , ip , ipm , j , k1 , & l1 , l2 , ld , n , nf , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 3 , 4 , 2 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) i = 2 l1 = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 idot = ido + ido + 2 ipm = ip - 1 do j = 1 , ipm i1 = i Wa ( i - 1 ) = 1.0_rk Wa ( i ) = 0.0_rk ld = ld + l1 fi = 0.0_rk argld = real ( ld , rk ) * argh do ii = 4 , idot , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo if ( ip > 5 ) then Wa ( i1 - 1 ) = Wa ( i - 1 ) Wa ( i1 ) = Wa ( i ) endif enddo l1 = l2 enddo end subroutine cffti1","tags":"","loc":"sourcefile/cffti1.f90.html"},{"title":"radb4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb4 Source Code radb4.f90 Source Code subroutine radb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) do k = 1 , l1 tr1 = Cc ( 1 , 1 , k ) - Cc ( Ido , 4 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( Ido , 4 , k ) tr3 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr4 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 2 ) = tr1 - tr4 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 1 , k , 4 ) = tr1 + tr4 enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti1 = Cc ( i , 1 , k ) + Cc ( ic , 4 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( ic , 4 , k ) ti3 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) tr4 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 4 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 4 , k ) ti4 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 - tr4 cr4 = tr1 + tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * cr2 - Wa1 ( i - 1 ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ci2 + Wa1 ( i - 1 ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * cr3 - Wa2 ( i - 1 ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * ci3 + Wa2 ( i - 1 ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * cr4 - Wa3 ( i - 1 ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * ci4 + Wa3 ( i - 1 ) * cr4 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) ti2 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr1 = Cc ( Ido , 1 , k ) - Cc ( Ido , 3 , k ) tr2 = Cc ( Ido , 1 , k ) + Cc ( Ido , 3 , k ) Ch ( Ido , k , 1 ) = tr2 + tr2 Ch ( Ido , k , 2 ) = sqrt2 * ( tr1 - ti1 ) Ch ( Ido , k , 3 ) = ti2 + ti2 Ch ( Ido , k , 4 ) = - sqrt2 * ( tr1 + ti1 ) enddo end subroutine radb4","tags":"","loc":"sourcefile/radb4.f90.html"},{"title":"cosqf1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cosqf1 Source Code cosqf1.f90 Source Code subroutine cosqf1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do k = 2 , ns2 kc = np2 - k Xh ( k ) = x ( k ) + x ( kc ) Xh ( kc ) = x ( k ) - x ( kc ) enddo modn = mod ( n , 2 ) if ( modn == 0 ) Xh ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) do k = 2 , ns2 kc = np2 - k x ( k ) = w ( k - 1 ) * Xh ( kc ) + w ( kc - 1 ) * Xh ( k ) x ( kc ) = w ( k - 1 ) * Xh ( k ) - w ( kc - 1 ) * Xh ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * Xh ( ns2 + 1 ) call dfftf ( n , x , Xh ) do i = 3 , n , 2 xim1 = x ( i - 1 ) - x ( i ) x ( i ) = x ( i - 1 ) + x ( i ) x ( i - 1 ) = xim1 enddo end subroutine cosqf1","tags":"","loc":"sourcefile/cosqf1.f90.html"},{"title":"Contributing and specs – Fortran-lang/fftpack","text":"Warning This page is currently under construction!","tags":"","loc":"page/index.html"},{"title":"Specifications (specs) – Fortran-lang/fftpack","text":"Fortran fftpack Specifications (specs) Fortran fftpack Specifications (specs) Experimental Features & Modules Released/Stable Features & Modules Experimental Features & Modules fftpack - fftpack module. fftpack_kind - fftpack_kind module. Released/Stable Features & Modules (None yet)","tags":"","loc":"page/specs/index.html"},{"title":"FFTPACK – Fortran-lang/fftpack","text":"Discrete Fourier transform (DFT) of complex data zffti Description Status Class Syntax Argument Warning Example zfftf Description Status Class Syntax Argument Warning Example zfftb Description Status Class Syntax Argument Warning Example fft Description Status Class Syntax Argument Return value Notes Example ifft Description Status Class Syntax Argument Return value Example Discrete Fourier transform (DFT) of real data dffti Description Status Class Syntax Argument Warning Example dfftf Description Status Class Syntax Argument Warning Example dfftb Description Status Class Syntax Argument Warning Example rfft Description Status Class Syntax Argument Return value Notes Example irfft Description Status Class Syntax Argument Return value Example Simplified discrete Fourier transform (DFT) of real data dzffti Description Status Class Syntax Arguments Warning Example dzfftf Description Status Class Syntax Arguments Example dzfftb Description Status Class Syntax Arguments Example Discrete cosine transforms (DCT) DCT type-1 (DCT-1) Initialize DCT-1: dcosti or dct_t1i Description Status Class Syntax Arguments Example Compute DCT-1: dcost or dct_t1 Description Status Class Syntax Arguments Example DCT of types 2, 3 (DCT-2, 3), a.k.a \"Quarter\" cosine transforms Initialize DCT-2, 3: dcosqi or dct_t23i Description Status Class Syntax Arguments Example Compute DCT-3: dcosqf or dct_t3 Description Status Class Syntax Arguments Example Compute DCT-2: dcosqb or dct_t2 Description Status Class Syntax Arguments Example Simplified DCT of types 1, 2, 3: dct Description Status Class Syntax Argument Return value Notes Example Simplified inverse DCT of types 1, 2, 3: idct Description Status Class Syntax Argument Return value Notes Example References Utility functions fftshift Description Status Class Syntax Argument Return value Example ifftshift Description Status Class Syntax Argument Return value Example fftfreq Description Status Class Syntax Argument Return value Example rfftfreq Description Status Class Syntax Argument Return value Example Discrete Fourier transform (DFT) of complex data zffti Description Initializes the array wsave which is used in both zfftf and zfftb . The prime factorization of n together with a tabulation of the trigonometric functions are computed and\nstored in wsave . Status Experimental. Class Pure subroutine. Syntax call zffti (n, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. wsave : Shall be a real array.\nThis argument is intent(out) . A work array which must be dimensioned at least 4*n+15 .\nThe same work array can be used for both zfftf and zfftb as long as n remains unchanged. Different wsave arrays\nare required for different values of n . Warning The contents of wsave must not be changed between calls of zfftf or zfftb . Example program demo_zffti use fftpack , only : zffti complex ( kind = 8 ) :: x ( 4 ) = [ 1.0 , 2.0 , 3.0 , 4.0 ] real ( kind = 8 ) :: w ( 31 ) call zffti ( 4 , w ) end program demo_zffti zfftf Description Computes the forward complex discrete fourier transform (the fourier analysis). Equivalently, zfftf computes the fourier coefficients of a complex periodic sequence.\nThe transform is defined below at output parameter c . The transform is not normalized. To obtain a normalized transform the output must be divided by n . Otherwise a call of zfftf followed by a call of zfftb will multiply the sequence by n . The array wsave which is used by subroutine zfftf must be initialized by calling subroutine zffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call zfftf (n, c, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the complex sequence c . The method is more efficient when n is the product of small primes. c : Shall be a complex and rank-1 array.\nThis argument is intent(inout) . A complex array of length n which contains the sequence. for j = 1 ,..., n c ( j ) = the sum from k = 1 ,..., n of c ( k ) * exp ( - i * ( j - 1 ) * ( k - 1 ) * 2 * pi / n ) where i = sqrt ( - 1 ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 4n+15 in the program that calls zfftf .\nThe wsave array must be initialized by calling subroutine zffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by zfftf and zfftb . Contains initialization calculations which must not be destroyed between calls of subroutine zfftf or zfftb . Warning The contents of wsave must not be changed between calls of zfftf or zfftb . Example program demo_zfftf use fftpack , only : zffti , zfftf complex ( kind = 8 ) :: x ( 4 ) real ( kind = 8 ) :: w ( 31 ) x = [ real ( kind = 8 ) :: 1.0 , 2.0 , 3.0 , 4.0 ] call zffti ( 4 , w ) call zfftf ( 4 , x , w ) !! `x` returns [(10.0,0.0), (-2.0,2.0), (-2.0,0.0), (-2.0,-2.0)]. end program demo_zfftf zfftb Description Unnormalized inverse of zfftf . Computes the backward complex discrete fourier transform (the fourier synthesis).\nEquivalently, zfftb computes a complex periodic sequence from its fourier coefficients.\nThe transform is defined below at output parameter c . The transform is not normalized. to obtain a normalized transform the output must be divided by n . Otherwise a call of zfftf followed by a call of zfftb will multiply the sequence by n . The array wsave which is used by subroutine zfftf must be initialized by calling subroutine zffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call zfftb (n, c, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the complex sequence c . The method is more efficient when n is the product of small primes. c : Shall be a complex array.\nThis argument is intent(inout) . A complex array of length n which contains the sequence. for j = 1 ,..., n c ( j ) = the sum from k = 1 ,..., n of c ( k ) * exp ( - i * ( j - 1 ) * ( k - 1 ) * 2 * pi / n ) where i = sqrt ( - 1 ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 4n+15 in the program that calls zfftf . The wsave array must be initialized by calling subroutine zffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. The same wsave array can be used by zfftf and zfftb . Contains initialization calculations which must not be destroyed between calls of subroutine zfftf or zfftb . Warning The contents of wsave must not be changed between calls of zfftf or zfftb . Example program demo_zfftb use fftpack , only : zffti , zfftf , zfftb complex ( kind = 8 ) :: x ( 4 ) real ( kind = 8 ) :: w ( 31 ) x = [ real ( kind = 8 ) :: 1.0 , 2.0 , 3.0 , 4.0 ] call zffti ( 4 , w ) call zfftf ( 4 , x , w ) !! `x` returns [(10.0,0.0), (-2.0,2.0), (-2.0,0.0), (-2.0,-2.0)]. call zfftb ( 4 , x , w ) !! `x` returns [(4.0,0.0), (8.0,0.0), (12.0,0.0), (16.0,0.0)]. end program demo_zfftb fft Description Computes the forward complex discrete fourier transform (the fourier analysis). Status Experimental. Class Pure function. Syntax result = fft (x [, n]) Argument x : Shall be a complex and rank-1 array.\nThis argument is intent(in) . n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a complex and rank-1 array, the Discrete Fourier Transform (DFT) of x . Notes Within numerical accuracy, x == ifft(fft(x))/size(x) . Example program demo_fft use fftpack , only : fft complex ( kind = 8 ) :: x ( 4 ) x = [ real ( kind = 8 ) :: 1.0 , 2.0 , 3.0 , 4.0 ] print * , fft ( x ) !! [(10.0,0.0), (-2.0,2.0), (-2.0,0.0), (-2.0,-2.0)]. print * , fft ( x , 3 ) !! [(6.0,0.0), (-1.5,0.86), (-1.5,0.86)]. print * , fft ( x , 5 ) !! [(10.0,0.0), (-4.0,1.3), (1.5,-2.1), (1.5,2.1), (-4.0,1.3)]. end program demo_fft ifft Description Unnormalized inverse of fft . Status Experimental. Class Pure function. Syntax result = ifft (x [, n]) Argument x : Shall be a complex and rank-1 array.\nThis argument is intent(in) . n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a complex and rank-1 array, the unnormalized inverse Discrete Fourier Transform (DFT) of x . Example program demo_ifft use fftpack , only : fft , ifft complex ( kind = 8 ) :: x ( 4 ) = [ 1.0 , 2.0 , 3.0 , 4.0 ] print * , ifft ( fft ( x )) / 4.0 !! [(1.0,0.0), (2.0,0.0), (3.0,0.0), (4.0,0.0)] print * , ifft ( fft ( x ), 3 ) !! [(6.0,2.0), (10.3,-1.0), (13.73,-1.0)] end program demo_ifft Discrete Fourier transform (DFT) of real data dffti Description Initializes the array wsave which is used in both dfftf and dfftb . The prime factorization of n together with a tabulation of the trigonometric functions are computed and\nstored in wsave . Status Experimental. Class Pure subroutine. Syntax call dffti (n, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. wsave : Shall be a real array.\nThis argument is intent(out) . A work array which must be dimensioned at least 2*n+15 .\nThe same work array can be used for both dfftf and dfftb as long as n remains unchanged.\nDifferent wsave arrays are required for different values of n . Warning The contents of wsave must not be changed between calls of dfftf or dfftb . Example program demo_dffti use fftpack , only : dffti real ( kind = 8 ) :: x ( 4 ) = [ 1.0 , 2.0 , 3.0 , 4.0 ] real ( kind = 8 ) :: w ( 23 ) call dffti ( 4 , w ) end program demo_dffti dfftf Description Computes the fourier coefficients of a real perodic sequence (fourier analysis).\nThe transform is defined below at output parameter r . The transform is not normalized. To obtain a normalized transform the output must be divided by n . Otherwise a call of dfftf followed by a call of dfftb will multiply the sequence by n . The array wsave which is used by subroutine dfftf must be initialized by calling subroutine dffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call dfftf (n, r, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the real sequence r . The method is more efficient when n is the product of small primes. n may change so long as different work arrays are provided. r : Shall be a real array.\nThis argument is intent(inout) . A real array of length n which contains the sequence. r ( 1 ) = the sum from i = 1 to i = n of r ( i ) if n is even set l = n / 2 , if n is odd set l = ( n + 1 ) / 2 then for k = 2 ,..., l r ( 2 * k - 2 ) = the sum from i = 1 to i = n of r ( i ) * cos (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) r ( 2 * k - 1 ) = the sum from i = 1 to i = n of - r ( i ) * sin (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) if n is even r ( n ) = the sum from i = 1 to i = n of ( - 1 ) ** ( i - 1 ) * r ( i ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 4n+15 in the program that calls dfftf .\nThe wsave array must be initialized by calling subroutine dffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by dfftf and dfftb . Contains initialization calculations which must not be destroyed between calls of subroutine dfftf or dfftb . Warning The contents of wsave must not be changed between calls of dfftf or dfftb . Example program demo_dfftf use fftpack , only : dffti , dfftf real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 23 ) call dffti ( 4 , w ) call dfftf ( 4 , x , w ) !! `x` returns [10.0, -2.0, 2.0, -2.0]. end program demo_dfftf dfftb Description Unnormalized inverse of dfftf . Computes the backward real discrete fourier transform (the fourier synthesis).\nEquivalently, dfftb computes a real periodic sequence from its fourier coefficients.\nThe transform is defined below at output parameter c . The transform is not normalized. To obtain a normalized transform the output must be divided by n . Otherwise a call of dfftf followed by a call of dfftb will multiply the sequence by n . The array wsave which is used by subroutine dfftf must be initialized by calling subroutine dffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call dfftb (n, r, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the real sequence r . The method is more efficient when n is the product of small primes. r : Shall be a real array.\nThis argument is intent(inout) . A real array of length n which contains the sequence. for n even and for i = 1 ,..., n r ( i ) = r ( 1 ) + ( - 1 ) ** ( i - 1 ) * r ( n ) plus the sum from k = 2 to k = n / 2 of 2 . * r ( 2 * k - 2 ) * cos (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) - 2 . * r ( 2 * k - 1 ) * sin (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) for n odd and for i = 1 ,..., n r ( i ) = r ( 1 ) plus the sum from k = 2 to k = ( n + 1 ) / 2 of 2 . * r ( 2 * k - 2 ) * cos (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) - 2 . * r ( 2 * k - 1 ) * sin (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 2n+15 in the program that calls dfftf . The wsave array must be initialized by calling subroutine dffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. The same wsave array can be used by dfftf and dfftb . Contains initialization calculations which must not be destroyed between calls of subroutine dfftf or dfftb . Warning The contents of wsave must not be changed between calls of dfftf or dfftb . Example program demo_dfftb use fftpack , only : dffti , dfftf , dfftb real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 31 ) call dffti ( 4 , w ) call dfftf ( 4 , x , w ) !! `x` returns [10.0, -2.0, 2.0, -2.0]. call dfftb ( 4 , x , w ) !! `x` returns [4.0, 8.0, 12.0, 16.0], which is not normalized. end program demo_dfftb rfft Description Discrete Fourier transform of a real sequence. Status Experimental. Class Pure function. Syntax result = rfft (x [, n]) Argument x : Shall be a real and rank-1 array.\nThis argument is intent(in) . The data to transform. n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a real and rank-1 array, the Discrete Fourier Transform (DFT) of x . Notes Within numerical accuracy, y == rfft(irfft(y))/size(y) . Example program demo_rfft use fftpack , only : rfft real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , rfft ( x , 3 ) !! [6.0, -1.5, 0.87]. print * , rfft ( x ) !! [10.0, -2.0, 2.0, -2.0]. print * , rfft ( x , 5 ) !! [10.0, -4.0, -1.3, 1.5, -2.1]. end program demo_rfft irfft Description Unnormalized inverse of rfft . Status Experimental. Class Pure function. Syntax result = irfft (x [, n]) Argument x : Shall be a real array.\nThis argument is intent(in) .\nTransformed data to invert. n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a real and rank-1 array, the unnormalized inverse discrete Fourier transform. Example program demo_irfft use fftpack , only : rfft , irfft real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , irfft ( rfft ( x )) / 4.0 !! [1.0, 2.0, 3.0, 4.0] print * , irfft ( rfft ( x ), 3 ) !! [6.0, 8.53, 15.46] end program demo_irfft Simplified discrete Fourier transform (DFT) of real data dzffti Description Initializes the array wsave which is used in both dzfftf and dzfftb .\nThe prime factorization of n together with a tabulation of the trigonometric functions are computed and stored in wsave . Status Experimental Class Prue function. Syntax call dzffti (n, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. wsave : Shall be a real and rank-1 array.\nThis argument is intent(out) . A work array which must be dimensioned at least 3*n+15 .\nThe same work array can be used for both dzfftf and dzfftb as long as n remains unchanged.\nDifferent wsave arrays are required for different values of n . Warning The contents of wsave must not be changed between calls of dzfftf or dzfftb . Example program demo_dzffti use fftpack , only : dzffti real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dzffti ( 4 , w ) !! Initializes the array `w` which is used in both `dzfftf` and `dzfftb`. end program demo_dzffti dzfftf Description Computes the fourier coefficients of a real perodic sequence (fourier analysis).\nThe transform is defined below at output parameters azero , a and b . dzfftf is a simplified but slower version of dfftf . Status Experimental Class Pure subroutine. Syntax call dzfftf (n, r, azero, a, b, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array r to be transformed. The method is most efficient when n is the product of small primes. r : Shall be a real and rank-1 array.\nThis argument is intent(in) . A real array of length n which contains the sequence to be transformed. r is not destroyed. azero : Shall be a real scalar.\nThis argument is intent(out) . The sum from i=1 to i=n of r(i)/n . a , b : Shall be a real and rank-1 array.\nThis argument is intent(out) . for n even b ( n / 2 ) = 0 . and a ( n / 2 ) is the sum from i = 1 to i = n of ( - 1 ) ** ( i - 1 ) * r ( i ) / n for n even define kmax = n / 2 - 1 for n odd define kmax = ( n - 1 ) / 2 then for k = 1 ,..., kmax a ( k ) equals the sum from i = 1 to i = n of 2 . / n * r ( i ) * cos ( k * ( i - 1 ) * 2 * pi / n ) b ( k ) equals the sum from i = 1 to i = n of 2 . / n * r ( i ) * sin ( k * ( i - 1 ) * 2 * pi / n ) wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) .\nA work array which must be dimensioned at least 3*n+15 .\nIn the program that calls dzfftf . The wsave array must be initialized by calling subroutine dzffti(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by dzfftf and dzfftb . Example program demo_dzfftf use fftpack , only : dzffti , dzfftf real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: azero , a ( 4 / 2 ), b ( 4 / 2 ) call dzffti ( 4 , w ) call dzfftf ( 4 , x , azero , a , b , w ) !! `azero`: 2.5; `a`: [-1.0, -0.5]; `b`: [-1.0, -0.0] end program demo_dzfftf dzfftb Description Computes a real perodic sequence from its fourier coefficients (fourier synthesis).\nThe transform is defined below at output parameter r . dzfftb is a simplified but slower version of dfftb . Status Experimental Class Pure subroutine. Syntax call dzfftb (n, r, azero, a, b, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the output array r . The method is most efficient when n is the product of small primes. r : Shall be a real and rank-1 array.\nThis argument is intent(out) . if n is even define kmax = n / 2 if n is odd define kmax = ( n - 1 ) / 2 then for i = 1 ,..., n r ( i ) = azero plus the sum from k = 1 to k = kmax of a ( k ) * cos ( k * ( i - 1 ) * 2 * pi / n ) + b ( k ) * sin ( k * ( i - 1 ) * 2 * pi / n ) Complex notation: for j = 1 ,..., n r ( j ) equals the sum from k =- kmax to k = kmax of c ( k ) * exp ( i * k * ( j - 1 ) * 2 * pi / n ) where c ( k ) = . 5 * cmplx ( a ( k ) , - b ( k )) for k = 1 ,..., kmax c ( - k ) = conjg ( c ( k )) c ( 0 ) = azero and i = sqrt ( - 1 ) Amplitude - phase notation: for i = 1 ,..., n r ( i ) equals azero plus the sum from k = 1 to k = kmax of alpha ( k ) * cos ( k * ( i - 1 ) * 2 * pi / n + beta ( k )) where alpha ( k ) = sqrt ( a ( k ) * a ( k ) + b ( k ) * b ( k )) cos ( beta ( k )) = a ( k ) / alpha ( k ) sin ( beta ( k )) =- b ( k ) / alpha ( k ) azero : Shall be a real scalar.\nThis argument is intent(in) . The constant fourier coefficient. a , b : Shall be a real and rank-1 array.\nThis argument is intent(in) . Arrays which contain the remaining fourier coefficients these arrays are not destroyed.\nThe length of these arrays depends on whether n is even or odd. if n is even n / 2 locations are required if n is odd ( n - 1 ) / 2 locations are required wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) .\nA work array which must be dimensioned at least 3*n+15 .\nIn the program that calls dzfftf . The wsave array must be initialized by calling subroutine dzffti(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by dzfftf and dzfftb . Example program demo_dzfftb use fftpack , only : dzffti , dzfftf , dzfftb real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: azero , a ( 4 / 2 ), b ( 4 / 2 ) call dzffti ( 4 , w ) call dzfftf ( 4 , x , azero , a , b , w ) !! `azero`: 2.5; `a`: [-1.0, -0.5]; `b`: [-1.0, -0.0] x = 0.0 call dzfftb ( 4 , x , azero , a , b , w ) !! `x`: [1.0, 2.0, 3.0, 4.0] end program demo_dzfftb Discrete cosine transforms (DCT) DCT type-1 (DCT-1) Initialize DCT-1: dcosti or dct_t1i Description Initializes the array wsave which is used in subroutine dcost .\nThe prime factorization of n together with a tabulation of the trigonometric functions are computed and stored in wsave . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. Status Experimental Class Pure subroutine. Syntax call dcosti (n , wsave) Arguments n : Shall be a integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. The method is most efficient when n-1 is a product of small primes. wsave : Shall be a real and rank-1 array.\nThis argument is intent(out) . A work array which must be dimensioned at least 3*n+15 .\nDifferent wsave arrays are required for different values of n .\nThe contents of wsave must not be changed between calls of dcost . Example program demo_dcosti use fftpack , only : dcosti real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dcosti ( 4 , w ) !! Initializes the array `w` which is used in subroutine `dcost`. end program demo_dcosti Compute DCT-1: dcost or dct_t1 Description Computes the DCT-1 of the input real data.\nThe transform is defined below at output parameter x . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. For real input data x of length n , the DCT-1 of x is equivalent, up to a\nscaling factor, to the DFT of the even extension of x with length 2*(n-1) ,\nwhere the first and last entries of the original data are not repeated in the\nextension. For example, the DCT-1 of input data abcde (size ) is\nequivalent to the DFT of data abcdedcb (size ). Also, dcost is the unnormalized inverse of itself. This means that a call of dcost followed by another call of dcost will multiply the input sequence x by 2*(n-1) . The array wsave which is used by subroutine dcost must be initialized by calling subroutine dcosti(n,wsave) . Status Experimental Class Pure subroutine. Syntax call dcost (n, x, wsave) Arguments n : Shall be a integer scalar.\nThis argument is intent(in) . The length of the sequence x . n must be greater than 1 .\nThe method is most efficient when n-1 is a product of small primes. x : Shall be a real and rank-1 array.\nThis argument is intent(inout) .\nAn array which contains the sequence to be transformed, and is overwritten\nby the result. for i = 1 ,..., n x ( i ) = x ( 1 ) + ( - 1 ) ** ( i - 1 ) * x ( n ) + the sum from k = 2 to k = n - 1 2 * x ( k ) * cos (( k - 1 ) * ( i - 1 ) * pi / ( n - 1 )) a call of dcost followed by another call of dcost will multiply the sequence x by 2 * ( n - 1 ) hence dcost is the unnormalized inverse of itself . wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) . A work array which must be of length at least 3*n+15 in the program that calls dcost .\nThe wsave array must be initialized by calling subroutine dcosti(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent\ntransforms can be obtained faster than the first.\nContains initialization calculations which must not be destroyed between calls of dcost . Example program demo_dcost use fftpack , only : dcosti , dcost real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dcosti ( 4 , w ) call dcost ( 4 , x , w ) !! `x`: [15.0, -4.0, 0.0, -1.0] call dcost ( 4 , x , w ) !! `x`: [6.0, 12.0, 18.0, 24.0] end program demo_dcost DCT of types 2, 3 (DCT-2, 3), a.k.a \"Quarter\" cosine transforms Initialize DCT-2, 3: dcosqi or dct_t23i Description Initializes the array wsave which is used in both dcosqf and dcosqb .\nThe prime factorization of n together with\na tabulation of the trigonometric functions are computed and\nstored in wsave . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. Status Experimental Class Pure subroutine. Syntax call dcosqi (n, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array to be transformed.\nThe method is most efficient when n is a product of small primes. wsave : Shall be a real and rank-1 array.\nThis argument is intent(out) . A work array which must be dimensioned at least 3*n+15 .\nThe same work array can be used for both dcosqf and dcosqb as long as n remains unchanged.\nDifferent wsave arrays are required for different values of n .\nThe contents of wsave must not be changed between calls of dcosqf or dcosqb . Example program demo_dcosqi use fftpack , only : dcosqi real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dcosqi ( 4 , w ) !! Initializes the array `w` which is used in both `dcosqf` and `dcosqb`. end program demo_dcosqi Compute DCT-3: dcosqf or dct_t3 Description Computes the DCT-3 of the input real data.\nThe transform is defined below at output parameter x . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. Also, dcosqf (DCT-3) is the unnormalized inverse of dcosqb (DCT-2), since a\ncall of dcosqf followed by a call of dcosqb will multiply the input sequence x by 4*n . The array wsave which is used by subroutine dcosqf must be initialized by calling subroutine dcosqi(n,wsave) . Status Experimental Class Pure subroutine. Syntax call dcosqf (n, x, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array x to be transformed.\nThe method is most efficient when n is a product of small primes. x : Shall be a real and rank-1 array.\nThis argument is intent(inout) . An array which contains the sequence to be transformed, and is overwritten by\nthe result. for i = 1 ,..., n x ( i ) = x ( 1 ) plus the sum from k = 2 to k = n of 2 * x ( k ) * cos (( 2 * i - 1 ) * ( k - 1 ) * pi / ( 2 * n )) a call of dcosqf followed by a call of cosqb will multiply the sequence x by 4 * n . therefore dcosqb is the unnormalized inverse of dcosqf . wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) . A work array which must be dimensioned at least 3*n+15 in the program that calls dcosqf .\nThe wsave array must be initialized by calling subroutine dcosqi(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. Warning : wsave contains initialization calculations which must not be\ndestroyed between calls of dcosqf or dcosqb of the same n . Example program demo_dcosqf use fftpack , only : dcosqi , dcosqf real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] call dcosqi ( 4 , w ) call dcosqf ( 4 , x , w ) !! `x`: [12.0, -9.10, 2.62, -1.51] end program demo_dcosqf Compute DCT-2: dcosqb or dct_t2 Description Computes the DCT-2 of the input real data.\nThe transform is defined below at output parameter x . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. For real input data x of length n , the DCT-2 of x is equivalent, up to a\nscaling factor, to the DFT of the even extension of x with length 4*n ,\nwhere all the even-frequency entries are zero. Also, dcosqb (DCT-2) is the unnormalized inverse of dcosqf (DCT-3), since a\ncall of dcosqb followed by a call of dcosqf will multiply the input sequence x by 4*n . The array wsave which is used by subroutine dcosqb must be initialized by calling subroutine dcosqi(n,wsave) . Status Experimental Class Pure subroutine. Syntax call dcosqb (n, x, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array x to be transformed.\nThe method is most efficient when n is a product of small primes. x : Shall be a real and rank-1 array.\nThis argument is intent(inout) . An array which contains the sequence to be transformed, and is overwritten by\nthe result. for i = 1 ,..., n x ( i ) = the sum from k = 1 to k = n of 4 * x ( k ) * cos (( 2 * k - 1 ) * ( i - 1 ) * pi / ( 2 * n )) a call of dcosqb followed by a call of dcosqf will multiply the sequence x by 4 * n . therefore dcosqf is the unnormalized inverse of dcosqb . wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) . A work array which must be dimensioned at least 3*n+15 in the program that calls dcosqb .\nThe wsave array must be initialized by calling subroutine dcosqi(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. Warning : wsave contains initialization calculations which must not be\ndestroyed between calls of dcosqf or dcosqb of the same n . Example program demo_dcosqb use fftpack , only : dcosqi , dcosqf , dcosqb real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: x ( 4 ) = [ 4 , 3 , 5 , 10 ] call dcosqi ( 4 , w ) call dcosqf ( 4 , x , w ) call dcosqb ( 4 , x , w ) !! [64.0, 48.0, 80.0, 160.0] end program demo_dcosqb Simplified DCT of types 1, 2, 3: dct Description Discrete cosine transforms (DCT) of types 1, 2, 3.\nThis is a more flexible interface for the DCT of types 1, 2 and 3, albeit\nslightly slower than the in-place DCT procedures. Status Experimental. Class Pure function. Syntax result = dct (x [, n, type]) Argument x : Shall be a real and rank-1 array.\nThis argument is intent(in) .\nThe data to transform. n : Shall be an integer scalar.\nThis argument is intent(in) and optional .\nDefines the length of the DCT. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. type : Shall be an integer scalar, equal to 1 , 2 or 3 .\nThis argument is intent(in) and optional .\nDefines the type of DCT to be performed. The default type is 2 . Return value Returns a real and rank-1 array, the DCT type- t of the input data x . Notes Within numerical accuracy,\n- x == idct(dct(x, type=1), type=1) / (2*(size(x) - 1)) - x == idct(dct(x, type=2), type=2) / (4*size(x)) - x == idct(dct(x, type=3), type=3) / (4*size(x)) Example program demo_dct use fftpack , only : dct real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , dct ( x , 3 , 1 ) !! [8.0, -2.0, 0.0]. print * , dct ( x , type = 1 ) !! [15.0, -4.0, 0.0, -1.0]. print * , dct ( x , 5 , 2 ) !! [14.36, -6.11, -5.0, 4.40, -2.65]. print * , dct ( dct ( x , type = 1 ), type = 1 ) / ( 2 * ( 4 - 1 )) !! (normalized): [1.0, 2.0, 3.0, 4.0] end program demo_dct Simplified inverse DCT of types 1, 2, 3: idct Description Unnormalized inverse discrete cosine transform (IDCT) of types 1, 2 and 3.\nThis is a more flexible interface for the IDCT of types 1, 2 and 3,\nalbeit slightly slower than the in-place DCT procedures. Status Experimental. Class Pure function. Syntax result = idct (x [, n, type]) Argument x : Shall be a real array.\nThis argument is intent(in) .\nTransformed data to invert. n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. type : Shall be an integer scalar, equal to 1 or 2 .\nThis argument is intent(in) and optional .\nDefines the type of the IDCT to be performed. The default type is 2 . Return value Returns a real and rank-1 array, the IDCT type- t of the input data x . Notes Within numerical accuracy,\n- x == idct(dct(x, type=1), type=1) / (2*(size(x) - 1)) - x == idct(dct(x, type=2), type=2) / (4*size(x)) - x == idct(dct(x, type=3), type=3) / (4*size(x)) Example program demo_idct use fftpack , only : dct , idct real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , idct ( dct ( x , type = 1 ), type = 1 ) / ( 2 * ( 4 - 1 )) !! (normalized): [1.0, 2.0, 3.0, 4.0] print * , idct ( dct ( x , type = 2 ), type = 2 ) / ( 4 * 4 ) !! (normalized): [1.0, 2.0, 3.0, 4.0] print * , idct ( dct ( x ), n = 3 ) !! (unnormalized): [22.06, 32.5, 65.65] end program demo_idct References [1] Wikipedia, \"Discrete cosine transform\", https://en.wikipedia.org/wiki/Discrete_cosine_transform Utility functions fftshift Description Rearranges the Fourier transform by moving the zero-frequency component to the center of the array. Status Experimental. Class Pure function. Syntax result = fftshift (x) Argument x : Shall be a complex/real and rank-1 array.\nThis argument is intent(in) . Return value Returns the complex/real and rank-1 Fourier transform by moving the zero-frequency component to the center of the array. Example program demo_fftshift use fftpack , only : fftshift complex ( kind = 8 ) :: c ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] real ( kind = 8 ) :: x ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] print * , fftshift ( c ( 1 : 4 )) !! [(3.0,0.0), (4.0,0.0), (1.0,0.0), (2.0,0.0)] print * , fftshift ( c ) !! [(4.0,0.0), (5.0,0.0), (1.0,0.0), (2.0,0.0), (3.0,0.0)] print * , fftshift ( x ( 1 : 4 )) !! [3.0, 4.0, 1.0, 2.0] print * , fftshift ( x ) !! [4.0, 5.0, 1.0, 2.0, 3.0] end program demo_fftshift ifftshift Description Rearranges the Fourier transform with zero frequency shifting back to the original transform output. In other words, ifftshift is the result of undoing fftshift . Status Experimental. Class Pure function. Syntax result = ifftshift (x) Argument x : Shall be a complex/real and rank-1 array.\nThis argument is intent(in) . Return value Returns the complex/real and rank-1 Fourier transform with zero frequency shifting back to the original transform output. Example program demo_ifftshift use fftpack , only : fftshift , ifftshift complex ( kind = 8 ) :: c ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] real ( kind = 8 ) :: x ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] print * , ifftshift ( fftshift ( c ( 1 : 4 ))) !! [(1.0,0.0), (2.0,0.0), (3.0,0.0), (4.0,0.0)] print * , ifftshift ( fftshift ( c ) ) !! [(1.0,0.0), (2.0,0.0), (3.0,0.0), (4.0,0.0), (5.0,0.0)] print * , ifftshift ( fftshift ( x ( 1 : 4 ))) !! [1.0, 2.0, 3.0, 4.0] print * , ifftshift ( fftshift ( x )) !! [1.0, 2.0, 3.0, 4.0, 5.0] end program demo_ifftshift fftfreq Description Returns the integer frequency (or wavenumber) values that correspond to the coefficients calculated by the complex discrete Fourier transform, in the standard order (zero frequency first). Status Experimental. Class Pure function. Syntax result = fftfreq (n) Argument n : Shall be an integer , equal to the length of the corresponding complex discrete Fourier transform.\nThis argument is intent(in) . Return value Returns the integer and rank-1 array of the transform's frequency values in the standard order (zero frequency first). Example program demo_fftfreq use fftpack , only : fftfreq print * , fftfreq ( 4 ) ! [0, 1, -2, -1] print * , fftfreq ( 5 ) ! [0, 1, 2, -2, -1] end program demo_fftfreq rfftfreq Description Returns the integer frequency (or wavenumber) values that correspond to the coefficients calculated by the real discrete Fourier transform, in the standard order (zero frequency first). Status Experimental. Class Pure function. Syntax result = rfftfreq (n) Argument n : Shall be an integer , equal to the length of the corresponding real discrete Fourier transform.\nThis argument is intent(in) . Return value Returns the integer and rank-1 array of the transform's frequency values in the standard order (zero frequency first). Example program demo_rfftfreq use fftpack , only : rfftfreq print * , rfftfreq ( 4 ) ! [0, 1, 1, -2] print * , rfftfreq ( 5 ) ! [0, 1, 1, 2, 2] end program demo_rfftfreq","tags":"","loc":"page/specs/fftpack.html"},{"title":"FFTPACK Kind – Fortran-lang/fftpack","text":"The fftpack_kind Module The fftpack_kind Module Introduction Constants provided by fftpack_kind Introduction The fftpack_kind module provides kind parameters for FFTs. Constants provided by fftpack_kind rk : Double precision real kind parameter . Provides real kind parameter for floating point numbers with a minimal precision of 15 significant digits.","tags":"","loc":"page/specs/fftpack_kind.html"}]} \ No newline at end of file +var tipuesearch = {"pages":[{"title":" Fortran-lang/fftpack ","text":"Fortran-lang/fftpack Fortran FFTPACK API Documentation FFTPACK Getting started Get the code Build with fortran-lang/fpm Build with Make Build with CMake Build with Meson Documentation References Warning This API documentation for the Fortran-lang/fftpack is a work in progress. Fortran FFTPACK API Documentation This is the main API documentation landing page generated by FORD .\nThe documentation for comment markup in source code, running FORD and the FORD project file are all maintained on the FORD wiki . FFTPACK A package of Fortran subprograms for the fast Fourier transform of periodic and other symmetric sequences. Getting started Get the code git clone https://github.com/fortran-lang/fftpack.git cd fftpack Build with fortran-lang/fpm Fortran Package Manager (fpm) is a package manager and build system for Fortran. You can build using provided fpm.toml : fpm build\nfpm test --list\nfpm test To use fftpack within your fpm project, add the following to your fpm.toml file: [dependencies] fftpack = { git = \"https://github.com/fortran-lang/fftpack.git\" } Build with Make Alternatively, you can build using provided Makefile : make Build with CMake This library can also be built using CMake. For instructions see Running CMake . CMake version 3.24 or higher is required. Build with Meson This library can also be built using Meson. The following dependencies are required:\n- a Fortran compiler\n- meson version 0.57 or newer\n- a build-system backend, i.e. ninja version 1.7 or newer Setup a build with meson setup build You can select the Fortran compiler by the FC environment variable.\nTo compile and run the projects testsuite use meson test -C build --print-errorlogs If the testsuite passes you can install with meson configure build --prefix = /path/to/install\nmeson install -C build Documentation See the our GitHub Pages site for documentation generated by FORD from the fortran-lang/fftpack project file . References Although fortran-lang is not interface-compatible with any of the following libraries, each contains documentation that might be useful for different reasons:\n* Recommended reference: The scipy.fftpack documentation contains succinct description of the storage sequences for function results that match those in fortran-lang/fftpack, e.g., the location of the real and imaginary parts of the rfft function result.\n* Theory reference: The documentation for the GNU/gsl FFT routines , which are also based on netlib/fftpack, provides some useful definitions of FFT terminology and represenations of the analytical forms of the Discrete Fourier Transform nicely formatted by LaTeX .\n* Historical reference: The netlib/fftpack library on which fortran-lang/fftpack is useful for understanding several fortran-lang/fftpack design choices, e.g., the procedure dependencies. Developer Info Paul N. Swarztrauber &\nfortran-lang/fftpack contributors","tags":"home","loc":"index.html"},{"title":"radb5 – Fortran-lang/fftpack","text":"subroutine radb5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i ic idp2 k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code radb5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine radb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 ti5 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 5 , k ) + Cc ( 1 , 5 , k ) tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr3 = Cc ( Ido , 4 , k ) + Cc ( Ido , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci5 = ti11 * ti5 + ti12 * ti4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 1 , k , 5 ) = cr2 + ci5 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti5 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ti4 = Cc ( i , 5 , k ) + Cc ( ic , 4 , k ) ti3 = Cc ( i , 5 , k ) - Cc ( ic , 4 , k ) tr5 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) tr4 = Cc ( i - 1 , 5 , k ) - Cc ( ic - 1 , 4 , k ) tr3 = Cc ( i - 1 , 5 , k ) + Cc ( ic - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * dr4 - Wa3 ( i - 1 ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * di4 + Wa3 ( i - 1 ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 2 ) * dr5 - Wa4 ( i - 1 ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 2 ) * di5 + Wa4 ( i - 1 ) * dr5 enddo enddo end subroutine radb5","tags":"","loc":"proc/radb5.html"},{"title":"radf5 – Fortran-lang/fftpack","text":"subroutine radf5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i ic idp2 k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code radf5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine radf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 5 ) , Ch ( Ido , 5 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 cr2 = Cc ( 1 , k , 5 ) + Cc ( 1 , k , 2 ) ci5 = Cc ( 1 , k , 5 ) - Cc ( 1 , k , 2 ) cr3 = Cc ( 1 , k , 4 ) + Cc ( 1 , k , 3 ) ci4 = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 + cr3 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 Ch ( 1 , 3 , k ) = ti11 * ci5 + ti12 * ci4 Ch ( Ido , 4 , k ) = Cc ( 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 Ch ( 1 , 5 , k ) = ti12 * ci5 - ti11 * ci4 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) dr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) di4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) dr5 = Wa4 ( i - 2 ) * Cc ( i - 1 , k , 5 ) + Wa4 ( i - 1 ) * Cc ( i , k , 5 ) di5 = Wa4 ( i - 2 ) * Cc ( i , k , 5 ) - Wa4 ( i - 1 ) * Cc ( i - 1 , k , 5 ) cr2 = dr2 + dr5 ci5 = dr5 - dr2 cr5 = di2 - di5 ci2 = di2 + di5 cr3 = dr3 + dr4 ci4 = dr4 - dr3 cr4 = di3 - di4 ci3 = di3 + di4 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 + cr3 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 + ci3 tr2 = Cc ( i - 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 ti2 = Cc ( i , k , 1 ) + tr11 * ci2 + tr12 * ci3 tr3 = Cc ( i - 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 ti3 = Cc ( i , k , 1 ) + tr12 * ci2 + tr11 * ci3 tr5 = ti11 * cr5 + ti12 * cr4 ti5 = ti11 * ci5 + ti12 * ci4 tr4 = ti12 * cr5 - ti11 * cr4 ti4 = ti12 * ci5 - ti11 * ci4 Ch ( i - 1 , 3 , k ) = tr2 + tr5 Ch ( ic - 1 , 2 , k ) = tr2 - tr5 Ch ( i , 3 , k ) = ti2 + ti5 Ch ( ic , 2 , k ) = ti5 - ti2 Ch ( i - 1 , 5 , k ) = tr3 + tr4 Ch ( ic - 1 , 4 , k ) = tr3 - tr4 Ch ( i , 5 , k ) = ti3 + ti4 Ch ( ic , 4 , k ) = ti4 - ti3 enddo enddo end subroutine radf5","tags":"","loc":"proc/radf5.html"},{"title":"radb3 – Fortran-lang/fftpack","text":"subroutine radb3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 ci3 cr2 cr3 di2 di3 dr2 dr3 i ic idp2 k taui taur ti2 tr2 Source Code radb3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: taui = sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine radb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ci3 = taui * ( Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k )) ci3 = taui * ( Cc ( i , 3 , k ) + Cc ( ic , 2 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 enddo enddo end subroutine radb3","tags":"","loc":"proc/radb3.html"},{"title":"zfftb – Fortran-lang/fftpack","text":"subroutine zfftb(n, c, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Wsave Contents Variables iw1 iw2 Source Code zfftb Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 Source Code subroutine zfftb ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftb1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftb","tags":"","loc":"proc/zfftb.html"},{"title":"dffti – Fortran-lang/fftpack","text":"subroutine dffti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Source Code dffti Source Code subroutine dffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call rffti1 ( n , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dffti","tags":"","loc":"proc/dffti.html"},{"title":"passb5 – Fortran-lang/fftpack","text":"subroutine passb5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code passb5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine passb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 - Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 + Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 - Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 + Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passb5","tags":"","loc":"proc/passb5.html"},{"title":"passb2 – Fortran-lang/fftpack","text":"subroutine passb2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i k ti2 tr2 Source Code passb2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 + Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 - Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passb2","tags":"","loc":"proc/passb2.html"},{"title":"passf2 – Fortran-lang/fftpack","text":"subroutine passf2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i k ti2 tr2 Source Code passf2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 - Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 + Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passf2","tags":"","loc":"proc/passf2.html"},{"title":"dcosqf – Fortran-lang/fftpack","text":"subroutine dcosqf(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables sqrt2 tsqx Source Code dcosqf Variables Type Visibility Attributes Name Initial real(kind=rk), public, parameter :: sqrt2 = sqrt(2.0_rk) real(kind=rk), public :: tsqx Source Code subroutine dcosqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: tsqx , Wsave , x dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) if ( n < 2 ) then return elseif ( n == 2 ) then tsqx = sqrt2 * x ( 2 ) x ( 2 ) = x ( 1 ) - tsqx x ( 1 ) = x ( 1 ) + tsqx else call cosqf1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqf","tags":"","loc":"proc/dcosqf.html"},{"title":"radbg – Fortran-lang/fftpack","text":"subroutine radbg(Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables ai1 ai2 ar1 ar1h ar2 ar2h arg dc2 dcp ds2 dsp i ic idij idp2 ik ipp2 ipph is j j2 jc k l lc nbd tpi Source Code radbg Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ai1 real(kind=rk), public :: ai2 real(kind=rk), public :: ar1 real(kind=rk), public :: ar1h real(kind=rk), public :: ar2 real(kind=rk), public :: ar2h real(kind=rk), public :: arg real(kind=rk), public :: dc2 real(kind=rk), public :: dcp real(kind=rk), public :: ds2 real(kind=rk), public :: dsp integer, public :: i integer, public :: ic integer, public :: idij integer, public :: idp2 integer, public :: ik integer, public :: ipp2 integer, public :: ipph integer, public :: is integer, public :: j integer, public :: j2 integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nbd real(kind=rk), public, parameter :: tpi = 2*acos(-1.0_rk) Source Code subroutine radbg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2 * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Ch ( 1 , k , j ) = Cc ( Ido , j2 - 2 , k ) + Cc ( Ido , j2 - 2 , k ) Ch ( 1 , k , jc ) = Cc ( 1 , j2 - 1 , k ) + Cc ( 1 , j2 - 1 , k ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo endif endif ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + ar1 * Ch2 ( ik , 2 ) c2 ( ik , lc ) = ai1 * Ch2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + ar2 * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + ai2 * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) - c1 ( 1 , k , jc ) Ch ( 1 , k , jc ) = c1 ( 1 , k , j ) + c1 ( 1 , k , jc ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo endif endif if ( Ido == 1 ) return do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo endif end subroutine radbg","tags":"","loc":"proc/radbg.html"},{"title":"cfftb1 – Fortran-lang/fftpack","text":"subroutine cfftb1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido idot ip iw ix2 ix3 ix4 k1 l1 l2 n2 na nac nf Source Code cfftb1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: idot integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: n2 integer, public :: na integer, public :: nac integer, public :: nf Source Code subroutine cfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passb4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passb4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passb2 ( idot , l1 , Ch , c , Wa ( iw )) else call passb2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passb3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passb3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passb ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passb ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passb5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passb5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftb1","tags":"","loc":"proc/cfftb1.html"},{"title":"passf5 – Fortran-lang/fftpack","text":"subroutine passf5(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3, Wa4) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 real(kind=rk) :: Wa4 Contents Variables ci2 ci3 ci4 ci5 cr2 cr3 cr4 cr5 di2 di3 di4 di5 dr2 dr3 dr4 dr5 i k pi ti11 ti12 ti2 ti3 ti4 ti5 tr11 tr12 tr2 tr3 tr4 tr5 Source Code passf5 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: ci5 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public :: cr5 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: di4 real(kind=rk), public :: di5 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 real(kind=rk), public :: dr4 real(kind=rk), public :: dr5 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: pi = acos(-1.0_rk) real(kind=rk), public, parameter :: ti11 = -sin(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: ti12 = -sin(4.0_rk*pi/5.0_rk) real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: ti5 real(kind=rk), public, parameter :: tr11 = cos(2.0_rk*pi/5.0_rk) real(kind=rk), public, parameter :: tr12 = cos(4.0_rk*pi/5.0_rk) real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 real(kind=rk), public :: tr5 Source Code subroutine passf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = - sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = - sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 + Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 - Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 + Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 - Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passf5","tags":"","loc":"proc/passf5.html"},{"title":"dcost – Fortran-lang/fftpack","text":"subroutine dcost(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables c1 i k kc modn nm1 np1 ns2 t1 t2 tx2 x1h x1p3 xi xim2 Source Code dcost Variables Type Visibility Attributes Name Initial real(kind=rk), public :: c1 integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: nm1 integer, public :: np1 integer, public :: ns2 real(kind=rk), public :: t1 real(kind=rk), public :: t2 real(kind=rk), public :: tx2 real(kind=rk), public :: x1h real(kind=rk), public :: x1p3 real(kind=rk), public :: xi real(kind=rk), public :: xim2 Source Code subroutine dcost ( n , x , Wsave ) use fftpack_kind implicit none real ( rk ) :: c1 , t1 , t2 , tx2 , Wsave , x , x1h , x1p3 , & xi , xim2 integer :: i , k , kc , modn , n , nm1 , np1 , ns2 dimension x ( * ) , Wsave ( * ) nm1 = n - 1 np1 = n + 1 ns2 = n / 2 if ( n < 2 ) return if ( n == 2 ) then x1h = x ( 1 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 2 ) x ( 1 ) = x1h return elseif ( n > 3 ) then c1 = x ( 1 ) - x ( n ) x ( 1 ) = x ( 1 ) + x ( n ) do k = 2 , ns2 kc = np1 - k t1 = x ( k ) + x ( kc ) t2 = x ( k ) - x ( kc ) c1 = c1 + Wsave ( kc ) * t2 t2 = Wsave ( k ) * t2 x ( k ) = t1 - t2 x ( kc ) = t1 + t2 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) call dfftf ( nm1 , x , Wsave ( n + 1 )) xim2 = x ( 2 ) x ( 2 ) = c1 do i = 4 , n , 2 xi = x ( i ) x ( i ) = x ( i - 2 ) - x ( i - 1 ) x ( i - 1 ) = xim2 xim2 = xi enddo if ( modn /= 0 ) x ( n ) = xim2 return endif x1p3 = x ( 1 ) + x ( 3 ) tx2 = x ( 2 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 3 ) x ( 1 ) = x1p3 + tx2 x ( 3 ) = x1p3 - tx2 end subroutine dcost","tags":"","loc":"proc/dcost.html"},{"title":"radf4 – Fortran-lang/fftpack","text":"subroutine radf4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 hsqt2 i ic idp2 k ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code radf4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 real(kind=rk), public, parameter :: hsqt2 = sqrt(2.0_rk)/2.0_rk integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine radf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 4 ) , Ch ( Ido , 4 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: hsqt2 = sqrt ( 2.0_rk ) / 2.0_rk do k = 1 , l1 tr1 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 4 ) tr2 = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = tr1 + tr2 Ch ( Ido , 4 , k ) = tr2 - tr1 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 3 , k ) = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i cr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ci2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) cr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) ci3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) ci4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) tr1 = cr2 + cr4 tr4 = cr4 - cr2 ti1 = ci2 + ci4 ti4 = ci2 - ci4 ti2 = Cc ( i , k , 1 ) + ci3 ti3 = Cc ( i , k , 1 ) - ci3 tr2 = Cc ( i - 1 , k , 1 ) + cr3 tr3 = Cc ( i - 1 , k , 1 ) - cr3 Ch ( i - 1 , 1 , k ) = tr1 + tr2 Ch ( ic - 1 , 4 , k ) = tr2 - tr1 Ch ( i , 1 , k ) = ti1 + ti2 Ch ( ic , 4 , k ) = ti1 - ti2 Ch ( i - 1 , 3 , k ) = ti4 + tr3 Ch ( ic - 1 , 2 , k ) = tr3 - ti4 Ch ( i , 3 , k ) = tr4 + ti3 Ch ( ic , 2 , k ) = tr4 - ti3 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = - hsqt2 * ( Cc ( Ido , k , 2 ) + Cc ( Ido , k , 4 )) tr1 = hsqt2 * ( Cc ( Ido , k , 2 ) - Cc ( Ido , k , 4 )) Ch ( Ido , 1 , k ) = tr1 + Cc ( Ido , k , 1 ) Ch ( Ido , 3 , k ) = Cc ( Ido , k , 1 ) - tr1 Ch ( 1 , 2 , k ) = ti1 - Cc ( Ido , k , 3 ) Ch ( 1 , 4 , k ) = ti1 + Cc ( Ido , k , 3 ) enddo end subroutine radf4","tags":"","loc":"proc/radf4.html"},{"title":"zfftf – Fortran-lang/fftpack","text":"subroutine zfftf(n, c, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Wsave Contents Variables iw1 iw2 Source Code zfftf Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 Source Code subroutine zfftf ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftf1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftf","tags":"","loc":"proc/zfftf.html"},{"title":"radb2 – Fortran-lang/fftpack","text":"subroutine radb2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i ic idp2 k ti2 tr2 Source Code radb2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine radb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( Ido , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( Ido , 2 , k ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) - Cc ( ic , 2 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( ic , 2 , k ) Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * tr2 - Wa1 ( i - 1 ) * ti2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ti2 + Wa1 ( i - 1 ) * tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( Ido , k , 1 ) = Cc ( Ido , 1 , k ) + Cc ( Ido , 1 , k ) Ch ( Ido , k , 2 ) = - ( Cc ( 1 , 2 , k ) + Cc ( 1 , 2 , k )) enddo end subroutine radb2","tags":"","loc":"proc/radb2.html"},{"title":"rfftf1 – Fortran-lang/fftpack","text":"subroutine rfftf1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido ip iw ix2 ix3 ix4 k1 kh l1 l2 na nf Source Code rfftf1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: kh integer, public :: l1 integer, public :: l2 integer, public :: na integer, public :: nf Source Code subroutine rfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & kh , l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 1 l2 = n iw = n do k1 = 1 , nf kh = nf - k1 ip = Ifac ( kh + 3 ) l1 = l2 / ip ido = n / l2 idl1 = ido * l1 iw = iw - ( ip - 1 ) * ido na = 1 - na if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radf4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radf4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif elseif ( ip /= 2 ) then if ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radf3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radf3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif elseif ( ip /= 5 ) then if ( ido == 1 ) na = 1 - na if ( na /= 0 ) then call radfg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) na = 0 else call radfg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) na = 1 endif else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radf5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radf5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif endif elseif ( na /= 0 ) then call radf2 ( ido , l1 , Ch , c , Wa ( iw )) else call radf2 ( ido , l1 , c , Ch , Wa ( iw )) endif l2 = l1 enddo if ( na == 1 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftf1","tags":"","loc":"proc/rfftf1.html"},{"title":"radf3 – Fortran-lang/fftpack","text":"subroutine radf3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 cr2 di2 di3 dr2 dr3 i ic idp2 k taui taur ti2 ti3 tr2 tr3 Source Code radf3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: cr2 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: taui = sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 Source Code subroutine radf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , cr2 , di2 , di3 , dr2 , dr3 , & ti2 , ti3 , tr2 , tr3 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 3 , l1 ) , Cc ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk ! note: original comment said this was -SQRT(3)/2 but value was 0.86602540378443864676d0 real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 cr2 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 Ch ( 1 , 3 , k ) = taui * ( Cc ( 1 , k , 3 ) - Cc ( 1 , k , 2 )) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + taur * cr2 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr2 = dr2 + dr3 ci2 = di2 + di3 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 tr2 = Cc ( i - 1 , k , 1 ) + taur * cr2 ti2 = Cc ( i , k , 1 ) + taur * ci2 tr3 = taui * ( di2 - di3 ) ti3 = taui * ( dr3 - dr2 ) Ch ( i - 1 , 3 , k ) = tr2 + tr3 Ch ( ic - 1 , 2 , k ) = tr2 - tr3 Ch ( i , 3 , k ) = ti2 + ti3 Ch ( ic , 2 , k ) = ti3 - ti2 enddo enddo end subroutine radf3","tags":"","loc":"proc/radf3.html"},{"title":"passb3 – Fortran-lang/fftpack","text":"subroutine passb3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 ci3 cr2 cr3 di2 di3 dr2 dr3 i k taui taur ti2 tr2 Source Code passb3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: taui = sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passb3","tags":"","loc":"proc/passb3.html"},{"title":"dzfftb – Fortran-lang/fftpack","text":"subroutine dzfftb(n, r, Azero, a, b, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Azero real(kind=rk) :: a real(kind=rk) :: b real(kind=rk) :: Wsave Contents Variables i ns2 Source Code dzfftb Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: ns2 Source Code subroutine dzfftb ( n , r , Azero , a , b , Wsave ) use fftpack_kind implicit none real ( rk ) :: a , Azero , b , r , Wsave integer :: i , n , ns2 dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then r ( 1 ) = Azero return elseif ( n == 2 ) then r ( 1 ) = Azero + a ( 1 ) r ( 2 ) = Azero - a ( 1 ) return else ns2 = ( n - 1 ) / 2 do i = 1 , ns2 r ( 2 * i ) = 0.5_rk * a ( i ) r ( 2 * i + 1 ) = - 0.5_rk * b ( i ) enddo r ( 1 ) = Azero if ( mod ( n , 2 ) == 0 ) r ( n ) = a ( ns2 + 1 ) call dfftb ( n , r , Wsave ( n + 1 )) endif end subroutine dzfftb","tags":"","loc":"proc/dzfftb.html"},{"title":"passf4 – Fortran-lang/fftpack","text":"subroutine passf4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 i k ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code passf4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 integer, public :: i integer, public :: k real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine passf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 2 , k ) - Cc ( i , 4 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 4 , k ) - Cc ( i - 1 , 2 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 + Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 - Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 + Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 - Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 + Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 - Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 2 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passf4","tags":"","loc":"proc/passf4.html"},{"title":"zffti – Fortran-lang/fftpack","text":"subroutine zffti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables iw1 iw2 Source Code zffti Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 Source Code subroutine zffti ( n , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cffti1 ( n , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zffti","tags":"","loc":"proc/zffti.html"},{"title":"passb – Fortran-lang/fftpack","text":"subroutine passb(Nac, Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Nac integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables i idij idj idl idlj idot idp ik inc ipp2 ipph j jc k l lc nt wai war Source Code passb Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idij integer, public :: idj integer, public :: idl integer, public :: idlj integer, public :: idot integer, public :: idp integer, public :: ik integer, public :: inc integer, public :: ipp2 integer, public :: ipph integer, public :: j integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nt real(kind=rk), public :: wai real(kind=rk), public :: war Source Code subroutine passb ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo return endif idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo return end subroutine passb","tags":"","loc":"proc/passb.html"},{"title":"dsint – Fortran-lang/fftpack","text":"subroutine dsint(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables iw1 iw2 iw3 np1 Source Code dsint Variables Type Visibility Attributes Name Initial integer, public :: iw1 integer, public :: iw2 integer, public :: iw3 integer, public :: np1 Source Code subroutine dsint ( n , x , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , iw3 , n , np1 real ( rk ) :: Wsave , x dimension x ( * ) , Wsave ( * ) np1 = n + 1 iw1 = n / 2 + 1 iw2 = iw1 + np1 iw3 = iw2 + np1 call sint1 ( n , x , Wsave , Wsave ( iw1 ), Wsave ( iw2 ), Wsave ( iw3 )) end subroutine dsint","tags":"","loc":"proc/dsint.html"},{"title":"rfftb1 – Fortran-lang/fftpack","text":"subroutine rfftb1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido ip iw ix2 ix3 ix4 k1 l1 l2 na nf Source Code rfftb1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: na integer, public :: nf Source Code subroutine rfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idl1 = ido * l1 if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radb4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radb4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call radb2 ( ido , l1 , Ch , c , Wa ( iw )) else call radb2 ( ido , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radb3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radb3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call radbg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call radbg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( ido == 1 ) na = 1 - na else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radb5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radb5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * ido enddo if ( na == 0 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftb1","tags":"","loc":"proc/rfftb1.html"},{"title":"radf2 – Fortran-lang/fftpack","text":"subroutine radf2(Ido, l1, Cc, Ch, Wa1) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 Contents Variables i ic idp2 k ti2 tr2 Source Code radf2 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine radf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 2 , l1 ) , Cc ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 2 ) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ti2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ti2 Ch ( ic , 2 , k ) = ti2 - Cc ( i , k , 1 ) Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + tr2 Ch ( ic - 1 , 2 , k ) = Cc ( i - 1 , k , 1 ) - tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( 1 , 2 , k ) = - Cc ( Ido , k , 2 ) Ch ( Ido , 1 , k ) = Cc ( Ido , k , 1 ) enddo end subroutine radf2","tags":"","loc":"proc/radf2.html"},{"title":"radfg – Fortran-lang/fftpack","text":"subroutine radfg(Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables ai1 ai2 ar1 ar1h ar2 ar2h arg dc2 dcp ds2 dsp i ic idij idp2 ik ipp2 ipph is j j2 jc k l lc nbd tpi Source Code radfg Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ai1 real(kind=rk), public :: ai2 real(kind=rk), public :: ar1 real(kind=rk), public :: ar1h real(kind=rk), public :: ar2 real(kind=rk), public :: ar2h real(kind=rk), public :: arg real(kind=rk), public :: dc2 real(kind=rk), public :: dcp real(kind=rk), public :: ds2 real(kind=rk), public :: dsp integer, public :: i integer, public :: ic integer, public :: idij integer, public :: idp2 integer, public :: ik integer, public :: ipp2 integer, public :: ipph integer, public :: is integer, public :: j integer, public :: j2 integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nbd real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine radfg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) ipph = ( Ip + 1 ) / 2 ipp2 = Ip + 2 idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 if ( Ido == 1 ) then do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo else do ik = 1 , Idl1 Ch2 ( ik , 1 ) = c2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo endif if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo endif endif do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) + Ch ( 1 , k , jc ) c1 ( 1 , k , jc ) = Ch ( 1 , k , jc ) - Ch ( 1 , k , j ) enddo enddo ! ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 Ch2 ( ik , l ) = c2 ( ik , 1 ) + ar1 * c2 ( ik , 2 ) Ch2 ( ik , lc ) = ai1 * c2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 Ch2 ( ik , l ) = Ch2 ( ik , l ) + ar2 * c2 ( ik , j ) Ch2 ( ik , lc ) = Ch2 ( ik , lc ) + ai2 * c2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + c2 ( ik , j ) enddo enddo ! if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Cc ( Ido , j2 - 2 , k ) = Ch ( 1 , k , j ) Cc ( 1 , j2 - 1 , k ) = Ch ( 1 , k , jc ) enddo enddo if ( Ido == 1 ) return if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j j2 = j + j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo end if end subroutine radfg","tags":"","loc":"proc/radfg.html"},{"title":"dsinti – Fortran-lang/fftpack","text":"subroutine dsinti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables dt k np1 ns2 pi Source Code dsinti Variables Type Visibility Attributes Name Initial real(kind=rk), public :: dt integer, public :: k integer, public :: np1 integer, public :: ns2 real(kind=rk), public, parameter :: pi = acos(-1.0_rk) Source Code subroutine dsinti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , Wsave integer :: k , n , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 1 ) return ns2 = n / 2 np1 = n + 1 dt = pi / real ( np1 , rk ) do k = 1 , ns2 Wsave ( k ) = 2.0_rk * sin ( k * dt ) enddo call dffti ( np1 , Wsave ( ns2 + 1 )) end subroutine dsinti","tags":"","loc":"proc/dsinti.html"},{"title":"dzffti – Fortran-lang/fftpack","text":"subroutine dzffti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Source Code dzffti Source Code subroutine dzffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call ezfft1 ( n , Wsave ( 2 * n + 1 ), Wsave ( 3 * n + 1 )) end subroutine dzffti","tags":"","loc":"proc/dzffti.html"},{"title":"passf – Fortran-lang/fftpack","text":"subroutine passf(Nac, Ido, Ip, l1, Idl1, Cc, c1, c2, Ch, Ch2, Wa) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Nac integer :: Ido integer :: Ip integer :: l1 integer :: Idl1 real(kind=rk) :: Cc real(kind=rk) :: c1 real(kind=rk) :: c2 real(kind=rk) :: Ch real(kind=rk) :: Ch2 real(kind=rk) :: Wa Contents Variables i idij idj idl idlj idot idp ik inc ipp2 ipph j jc k l lc nt wai war Source Code passf Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idij integer, public :: idj integer, public :: idl integer, public :: idlj integer, public :: idot integer, public :: idp integer, public :: ik integer, public :: inc integer, public :: ipp2 integer, public :: ipph integer, public :: j integer, public :: jc integer, public :: k integer, public :: l integer, public :: lc integer, public :: nt real(kind=rk), public :: wai real(kind=rk), public :: war Source Code subroutine passf ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = - Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) - wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo end if end subroutine passf","tags":"","loc":"proc/passf.html"},{"title":"sint1 – Fortran-lang/fftpack","text":"subroutine sint1(n, War, Was, Xh, x, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: War real(kind=rk) :: Was real(kind=rk) :: Xh real(kind=rk) :: x integer :: Ifac Contents Variables i k kc modn np1 ns2 sqrt3 t1 t2 xhold Source Code sint1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: np1 integer, public :: ns2 real(kind=rk), public, parameter :: sqrt3 = sqrt(3.0_rk) real(kind=rk), public :: t1 real(kind=rk), public :: t2 real(kind=rk), public :: xhold Source Code subroutine sint1 ( n , War , Was , Xh , x , Ifac ) use fftpack_kind implicit none integer :: i , Ifac , k , kc , modn , n , np1 , ns2 real ( rk ) :: t1 , t2 , War , Was , x , Xh , xhold dimension War ( * ) , Was ( * ) , x ( * ) , Xh ( * ) , Ifac ( * ) real ( rk ), parameter :: sqrt3 = sqrt ( 3.0_rk ) do i = 1 , n Xh ( i ) = War ( i ) War ( i ) = x ( i ) enddo if ( n < 2 ) then Xh ( 1 ) = Xh ( 1 ) + Xh ( 1 ) elseif ( n == 2 ) then xhold = sqrt3 * ( Xh ( 1 ) + Xh ( 2 )) Xh ( 2 ) = sqrt3 * ( Xh ( 1 ) - Xh ( 2 )) Xh ( 1 ) = xhold else np1 = n + 1 ns2 = n / 2 x ( 1 ) = 0.0_rk do k = 1 , ns2 kc = np1 - k t1 = Xh ( k ) - Xh ( kc ) t2 = Was ( k ) * ( Xh ( k ) + Xh ( kc )) x ( k + 1 ) = t1 + t2 x ( kc + 1 ) = t2 - t1 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 2 ) = 4.0_rk * Xh ( ns2 + 1 ) call rfftf1 ( np1 , x , Xh , War , Ifac ) Xh ( 1 ) = 0.5_rk * x ( 1 ) do i = 3 , n , 2 Xh ( i - 1 ) = - x ( i ) Xh ( i ) = Xh ( i - 2 ) + x ( i - 1 ) enddo if ( modn == 0 ) Xh ( n ) = - x ( n + 1 ) endif do i = 1 , n x ( i ) = War ( i ) War ( i ) = Xh ( i ) enddo end subroutine sint1","tags":"","loc":"proc/sint1.html"},{"title":"dsinqf – Fortran-lang/fftpack","text":"subroutine dsinqf(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables k kc ns2 xhold Source Code dsinqf Variables Type Visibility Attributes Name Initial integer, public :: k integer, public :: kc integer, public :: ns2 real(kind=rk), public :: xhold Source Code subroutine dsinqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n == 1 ) return ns2 = n / 2 do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo call dcosqf ( n , x , Wsave ) do k = 2 , n , 2 x ( k ) = - x ( k ) enddo end subroutine dsinqf","tags":"","loc":"proc/dsinqf.html"},{"title":"dsinqi – Fortran-lang/fftpack","text":"subroutine dsinqi(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Source Code dsinqi Source Code subroutine dsinqi ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) call dcosqi ( n , Wsave ) end subroutine dsinqi","tags":"","loc":"proc/dsinqi.html"},{"title":"passb4 – Fortran-lang/fftpack","text":"subroutine passb4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 i k ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code passb4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 integer, public :: i integer, public :: k real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine passb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 4 , k ) - Cc ( i , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 - Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 + Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 - Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 + Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 - Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 + Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 4 , k ) - Cc ( 2 , 2 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 2 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passb4","tags":"","loc":"proc/passb4.html"},{"title":"dcosqi – Fortran-lang/fftpack","text":"subroutine dcosqi(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables dt fk k pih Source Code dcosqi Variables Type Visibility Attributes Name Initial real(kind=rk), public :: dt real(kind=rk), public :: fk integer, public :: k real(kind=rk), public, parameter :: pih = acos(-1.0_rk)/2.0_rk Source Code subroutine dcosqi ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , n dimension Wsave ( * ) real ( rk ), parameter :: pih = acos ( - 1.0_rk ) / 2.0_rk ! pi / 2 dt = pih / real ( n , rk ) fk = 0.0_rk do k = 1 , n fk = fk + 1.0_rk Wsave ( k ) = cos ( fk * dt ) enddo call dffti ( n , Wsave ( n + 1 )) end subroutine dcosqi","tags":"","loc":"proc/dcosqi.html"},{"title":"cfftf1 – Fortran-lang/fftpack","text":"subroutine cfftf1(n, c, Ch, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: c real(kind=rk) :: Ch real(kind=rk) :: Wa integer :: Ifac Contents Variables i idl1 ido idot ip iw ix2 ix3 ix4 k1 l1 l2 n2 na nac nf Source Code cfftf1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: idl1 integer, public :: ido integer, public :: idot integer, public :: ip integer, public :: iw integer, public :: ix2 integer, public :: ix3 integer, public :: ix4 integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: n2 integer, public :: na integer, public :: nac integer, public :: nf Source Code subroutine cfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passf4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passf4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passf2 ( idot , l1 , Ch , c , Wa ( iw )) else call passf2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passf3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passf3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passf ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passf ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passf5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passf5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftf1","tags":"","loc":"proc/cfftf1.html"},{"title":"dcosqb – Fortran-lang/fftpack","text":"subroutine dcosqb(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables tsqrt2 x1 Source Code dcosqb Variables Type Visibility Attributes Name Initial real(kind=rk), public, parameter :: tsqrt2 = 2.0_rk*sqrt(2.0_rk) real(kind=rk), public :: x1 Source Code subroutine dcosqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave , x , x1 dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: tsqrt2 = 2.0_rk * sqrt ( 2.0_rk ) if ( n < 2 ) then x ( 1 ) = 4.0_rk * x ( 1 ) return elseif ( n == 2 ) then x1 = 4.0_rk * ( x ( 1 ) + x ( 2 )) x ( 2 ) = tsqrt2 * ( x ( 1 ) - x ( 2 )) x ( 1 ) = x1 return else call cosqb1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqb","tags":"","loc":"proc/dcosqb.html"},{"title":"ezfft1 – Fortran-lang/fftpack","text":"subroutine ezfft1(n, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wa integer :: Ifac Contents Variables arg1 argh ch1 ch1h dch1 dsh1 i ib ido ii ip ipm is j k1 l1 l2 nf nfm1 nl nq nr ntry ntryh sh1 tpi Source Code ezfft1 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: arg1 real(kind=rk), public :: argh real(kind=rk), public :: ch1 real(kind=rk), public :: ch1h real(kind=rk), public :: dch1 real(kind=rk), public :: dsh1 integer, public :: i integer, public :: ib integer, public :: ido integer, public :: ii integer, public :: ip integer, public :: ipm integer, public :: is integer, public :: j integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: nf integer, public :: nfm1 integer, public :: nl integer, public :: nq integer, public :: nr integer, public :: ntry integer, public, parameter, dimension(4) :: ntryh = [4, 2, 3, 5] real(kind=rk), public :: sh1 real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine ezfft1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg1 , argh , ch1 , ch1h , dch1 , dsh1 , sh1 , & Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) l2 = l1 * ip ido = n / l2 ipm = ip - 1 arg1 = real ( l1 , rk ) * argh ch1 = 1.0_rk sh1 = 0.0_rk dch1 = cos ( arg1 ) dsh1 = sin ( arg1 ) do j = 1 , ipm ch1h = dch1 * ch1 - dsh1 * sh1 sh1 = dch1 * sh1 + dsh1 * ch1 ch1 = ch1h i = is + 2 Wa ( i - 1 ) = ch1 Wa ( i ) = sh1 if ( ido >= 5 ) then do ii = 5 , ido , 2 i = i + 2 Wa ( i - 1 ) = ch1 * Wa ( i - 3 ) - sh1 * Wa ( i - 2 ) Wa ( i ) = ch1 * Wa ( i - 2 ) + sh1 * Wa ( i - 3 ) enddo endif is = is + ido enddo l1 = l2 enddo end subroutine ezfft1","tags":"","loc":"proc/ezfft1.html"},{"title":"dsinqb – Fortran-lang/fftpack","text":"subroutine dsinqb(n, x, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: Wsave Contents Variables k kc ns2 xhold Source Code dsinqb Variables Type Visibility Attributes Name Initial integer, public :: k integer, public :: kc integer, public :: ns2 real(kind=rk), public :: xhold Source Code subroutine dsinqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n > 1 ) then ns2 = n / 2 do k = 2 , n , 2 x ( k ) = - x ( k ) enddo call dcosqb ( n , x , Wsave ) do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo return endif x ( 1 ) = 4.0_rk * x ( 1 ) return end subroutine dsinqb","tags":"","loc":"proc/dsinqb.html"},{"title":"passf3 – Fortran-lang/fftpack","text":"subroutine passf3(Ido, l1, Cc, Ch, Wa1, Wa2) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 Contents Variables ci2 ci3 cr2 cr3 di2 di3 dr2 dr3 i k taui taur ti2 tr2 Source Code passf3 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: di2 real(kind=rk), public :: di3 real(kind=rk), public :: dr2 real(kind=rk), public :: dr3 integer, public :: i integer, public :: k real(kind=rk), public, parameter :: taui = -sqrt(3.0_rk)/2.0_rk real(kind=rk), public, parameter :: taur = -0.5_rk real(kind=rk), public :: ti2 real(kind=rk), public :: tr2 Source Code subroutine passf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = - sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passf3","tags":"","loc":"proc/passf3.html"},{"title":"dfftf – Fortran-lang/fftpack","text":"subroutine dfftf(n, r, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Wsave Contents Source Code dfftf Source Code subroutine dfftf ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftf1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftf","tags":"","loc":"proc/dfftf.html"},{"title":"dcosti – Fortran-lang/fftpack","text":"subroutine dcosti(n, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wsave Contents Variables dt fk k kc nm1 np1 ns2 pi Source Code dcosti Variables Type Visibility Attributes Name Initial real(kind=rk), public :: dt real(kind=rk), public :: fk integer, public :: k integer, public :: kc integer, public :: nm1 integer, public :: np1 integer, public :: ns2 real(kind=rk), public, parameter :: pi = acos(-1.0_rk) Source Code subroutine dcosti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , kc , n , nm1 , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 3 ) return nm1 = n - 1 np1 = n + 1 ns2 = n / 2 dt = pi / real ( nm1 , rk ) fk = 0.0_rk do k = 2 , ns2 kc = np1 - k fk = fk + 1.0_rk Wsave ( k ) = 2.0_rk * sin ( fk * dt ) Wsave ( kc ) = 2.0_rk * cos ( fk * dt ) enddo call dffti ( nm1 , Wsave ( n + 1 )) end subroutine dcosti","tags":"","loc":"proc/dcosti.html"},{"title":"dfftb – Fortran-lang/fftpack","text":"subroutine dfftb(n, r, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Wsave Contents Source Code dfftb Source Code subroutine dfftb ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftb1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftb","tags":"","loc":"proc/dfftb.html"},{"title":"cosqb1 – Fortran-lang/fftpack","text":"subroutine cosqb1(n, x, w, Xh) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: w real(kind=rk) :: Xh Contents Variables i k kc modn np2 ns2 xim1 Source Code cosqb1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: np2 integer, public :: ns2 real(kind=rk), public :: xim1 Source Code subroutine cosqb1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do i = 3 , n , 2 xim1 = x ( i - 1 ) + x ( i ) x ( i ) = x ( i ) - x ( i - 1 ) x ( i - 1 ) = xim1 enddo x ( 1 ) = x ( 1 ) + x ( 1 ) modn = mod ( n , 2 ) if ( modn == 0 ) x ( n ) = x ( n ) + x ( n ) call dfftb ( n , x , Xh ) do k = 2 , ns2 kc = np2 - k Xh ( k ) = w ( k - 1 ) * x ( kc ) + w ( kc - 1 ) * x ( k ) Xh ( kc ) = w ( k - 1 ) * x ( k ) - w ( kc - 1 ) * x ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * ( x ( ns2 + 1 ) + x ( ns2 + 1 )) do k = 2 , ns2 kc = np2 - k x ( k ) = Xh ( k ) + Xh ( kc ) x ( kc ) = Xh ( k ) - Xh ( kc ) enddo x ( 1 ) = x ( 1 ) + x ( 1 ) end subroutine cosqb1","tags":"","loc":"proc/cosqb1.html"},{"title":"rffti1 – Fortran-lang/fftpack","text":"subroutine rffti1(n, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wa integer :: Ifac Contents Variables arg argh argld fi i ib ido ii ip ipm is j k1 l1 l2 ld nf nfm1 nl nq nr ntry ntryh tpi Source Code rffti1 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: arg real(kind=rk), public :: argh real(kind=rk), public :: argld real(kind=rk), public :: fi integer, public :: i integer, public :: ib integer, public :: ido integer, public :: ii integer, public :: ip integer, public :: ipm integer, public :: is integer, public :: j integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: ld integer, public :: nf integer, public :: nfm1 integer, public :: nl integer, public :: nq integer, public :: nr integer, public :: ntry integer, public, parameter, dimension(4) :: ntryh = [4, 2, 3, 5] real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine rffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , ld , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 ipm = ip - 1 do j = 1 , ipm ld = ld + l1 i = is argld = real ( ld , rk ) * argh fi = 0.0_rk do ii = 3 , ido , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo is = is + ido enddo l1 = l2 enddo end subroutine rffti1","tags":"","loc":"proc/rffti1.html"},{"title":"dzfftf – Fortran-lang/fftpack","text":"subroutine dzfftf(n, r, Azero, a, b, Wsave) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: r real(kind=rk) :: Azero real(kind=rk) :: a real(kind=rk) :: b real(kind=rk) :: Wsave Contents Variables cf cfm i ns2 ns2m Source Code dzfftf Variables Type Visibility Attributes Name Initial real(kind=rk), public :: cf real(kind=rk), public :: cfm integer, public :: i integer, public :: ns2 integer, public :: ns2m Source Code subroutine dzfftf ( n , r , Azero , a , b , Wsave ) ! ! VERSION 3 JUNE 1979 ! use fftpack_kind implicit none real ( rk ) :: a , Azero , b , cf , cfm , r , Wsave integer :: i , n , ns2 , ns2m dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then Azero = r ( 1 ) return elseif ( n == 2 ) then Azero = 0.5_rk * ( r ( 1 ) + r ( 2 )) a ( 1 ) = 0.5_rk * ( r ( 1 ) - r ( 2 )) return else do i = 1 , n Wsave ( i ) = r ( i ) enddo call dfftf ( n , Wsave , Wsave ( n + 1 )) cf = 2.0_rk / real ( n , rk ) cfm = - cf Azero = 0.5_rk * cf * Wsave ( 1 ) ns2 = ( n + 1 ) / 2 ns2m = ns2 - 1 do i = 1 , ns2m a ( i ) = cf * Wsave ( 2 * i ) b ( i ) = cfm * Wsave ( 2 * i + 1 ) enddo if ( mod ( n , 2 ) == 1 ) return a ( ns2 ) = 0.5_rk * cf * Wsave ( n ) b ( ns2 ) = 0.0_rk endif end subroutine dzfftf","tags":"","loc":"proc/dzfftf.html"},{"title":"cffti1 – Fortran-lang/fftpack","text":"subroutine cffti1(n, Wa, Ifac) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: Wa integer :: Ifac Contents Variables arg argh argld fi i i1 ib ido idot ii ip ipm j k1 l1 l2 ld nf nl nq nr ntry ntryh tpi Source Code cffti1 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: arg real(kind=rk), public :: argh real(kind=rk), public :: argld real(kind=rk), public :: fi integer, public :: i integer, public :: i1 integer, public :: ib integer, public :: ido integer, public :: idot integer, public :: ii integer, public :: ip integer, public :: ipm integer, public :: j integer, public :: k1 integer, public :: l1 integer, public :: l2 integer, public :: ld integer, public :: nf integer, public :: nl integer, public :: nq integer, public :: nr integer, public :: ntry integer, public, parameter, dimension(4) :: ntryh = [3, 4, 2, 5] real(kind=rk), public, parameter :: tpi = 2.0_rk*acos(-1.0_rk) Source Code subroutine cffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , i1 , ib , ido , idot , Ifac , ii , ip , ipm , j , k1 , & l1 , l2 , ld , n , nf , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 3 , 4 , 2 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) i = 2 l1 = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 idot = ido + ido + 2 ipm = ip - 1 do j = 1 , ipm i1 = i Wa ( i - 1 ) = 1.0_rk Wa ( i ) = 0.0_rk ld = ld + l1 fi = 0.0_rk argld = real ( ld , rk ) * argh do ii = 4 , idot , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo if ( ip > 5 ) then Wa ( i1 - 1 ) = Wa ( i - 1 ) Wa ( i1 ) = Wa ( i ) endif enddo l1 = l2 enddo end subroutine cffti1","tags":"","loc":"proc/cffti1.html"},{"title":"radb4 – Fortran-lang/fftpack","text":"subroutine radb4(Ido, l1, Cc, Ch, Wa1, Wa2, Wa3) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: Ido integer :: l1 real(kind=rk) :: Cc real(kind=rk) :: Ch real(kind=rk) :: Wa1 real(kind=rk) :: Wa2 real(kind=rk) :: Wa3 Contents Variables ci2 ci3 ci4 cr2 cr3 cr4 i ic idp2 k sqrt2 ti1 ti2 ti3 ti4 tr1 tr2 tr3 tr4 Source Code radb4 Variables Type Visibility Attributes Name Initial real(kind=rk), public :: ci2 real(kind=rk), public :: ci3 real(kind=rk), public :: ci4 real(kind=rk), public :: cr2 real(kind=rk), public :: cr3 real(kind=rk), public :: cr4 integer, public :: i integer, public :: ic integer, public :: idp2 integer, public :: k real(kind=rk), public, parameter :: sqrt2 = sqrt(2.0_rk) real(kind=rk), public :: ti1 real(kind=rk), public :: ti2 real(kind=rk), public :: ti3 real(kind=rk), public :: ti4 real(kind=rk), public :: tr1 real(kind=rk), public :: tr2 real(kind=rk), public :: tr3 real(kind=rk), public :: tr4 Source Code subroutine radb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) do k = 1 , l1 tr1 = Cc ( 1 , 1 , k ) - Cc ( Ido , 4 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( Ido , 4 , k ) tr3 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr4 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 2 ) = tr1 - tr4 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 1 , k , 4 ) = tr1 + tr4 enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti1 = Cc ( i , 1 , k ) + Cc ( ic , 4 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( ic , 4 , k ) ti3 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) tr4 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 4 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 4 , k ) ti4 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 - tr4 cr4 = tr1 + tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * cr2 - Wa1 ( i - 1 ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ci2 + Wa1 ( i - 1 ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * cr3 - Wa2 ( i - 1 ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * ci3 + Wa2 ( i - 1 ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * cr4 - Wa3 ( i - 1 ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * ci4 + Wa3 ( i - 1 ) * cr4 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) ti2 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr1 = Cc ( Ido , 1 , k ) - Cc ( Ido , 3 , k ) tr2 = Cc ( Ido , 1 , k ) + Cc ( Ido , 3 , k ) Ch ( Ido , k , 1 ) = tr2 + tr2 Ch ( Ido , k , 2 ) = sqrt2 * ( tr1 - ti1 ) Ch ( Ido , k , 3 ) = ti2 + ti2 Ch ( Ido , k , 4 ) = - sqrt2 * ( tr1 + ti1 ) enddo end subroutine radb4","tags":"","loc":"proc/radb4.html"},{"title":"cosqf1 – Fortran-lang/fftpack","text":"subroutine cosqf1(n, x, w, Xh) Uses fftpack_kind Arguments Type Intent Optional Attributes Name integer :: n real(kind=rk) :: x real(kind=rk) :: w real(kind=rk) :: Xh Contents Variables i k kc modn np2 ns2 xim1 Source Code cosqf1 Variables Type Visibility Attributes Name Initial integer, public :: i integer, public :: k integer, public :: kc integer, public :: modn integer, public :: np2 integer, public :: ns2 real(kind=rk), public :: xim1 Source Code subroutine cosqf1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do k = 2 , ns2 kc = np2 - k Xh ( k ) = x ( k ) + x ( kc ) Xh ( kc ) = x ( k ) - x ( kc ) enddo modn = mod ( n , 2 ) if ( modn == 0 ) Xh ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) do k = 2 , ns2 kc = np2 - k x ( k ) = w ( k - 1 ) * Xh ( kc ) + w ( kc - 1 ) * Xh ( k ) x ( kc ) = w ( k - 1 ) * Xh ( k ) - w ( kc - 1 ) * Xh ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * Xh ( ns2 + 1 ) call dfftf ( n , x , Xh ) do i = 3 , n , 2 xim1 = x ( i - 1 ) - x ( i ) x ( i ) = x ( i - 1 ) + x ( i ) x ( i - 1 ) = xim1 enddo end subroutine cosqf1","tags":"","loc":"proc/cosqf1.html"},{"title":"dcosqb – Fortran-lang/fftpack","text":"interface public pure subroutine dcosqb(n, x, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of dcosqf .\n( Specification )","tags":"","loc":"interface/dcosqb.html"},{"title":"dcosqf – Fortran-lang/fftpack","text":"interface public pure subroutine dcosqf(n, x, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) Description Forward transform of quarter wave data.\n( Specification )","tags":"","loc":"interface/dcosqf.html"},{"title":"dcosqi – Fortran-lang/fftpack","text":"interface public pure subroutine dcosqi(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dcosqf and dcosqb .\n( Specification )","tags":"","loc":"interface/dcosqi.html"},{"title":"dcost – Fortran-lang/fftpack","text":"interface public pure subroutine dcost(n, x, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) Description Discrete fourier cosine transform of an even sequence.\n( Specification )","tags":"","loc":"interface/dcost.html"},{"title":"dcosti – Fortran-lang/fftpack","text":"interface public pure subroutine dcosti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dcost .\n( Specification )","tags":"","loc":"interface/dcosti.html"},{"title":"dct – Fortran-lang/fftpack","text":"public interface dct Dsicrete cosine transforms.\n( Specification ) Contents Functions dct_rk Functions private pure module function dct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/dct.html"},{"title":"dct_t1 – Fortran-lang/fftpack","text":"public interface dct_t1 Perform DCT type-1\n( Specification ) Contents Module Procedures dcost Module Procedures public interface dcost () Arguments None","tags":"","loc":"interface/dct_t1.html"},{"title":"dct_t1i – Fortran-lang/fftpack","text":"public interface dct_t1i Initialize DCT type-1\n( Specification ) Contents Module Procedures dcosti Module Procedures public interface dcosti () Arguments None","tags":"","loc":"interface/dct_t1i.html"},{"title":"dct_t2 – Fortran-lang/fftpack","text":"public interface dct_t2 Perform DCT type-2\n( Specification ) Contents Module Procedures dcosqb Module Procedures public interface dcosqb () Arguments None","tags":"","loc":"interface/dct_t2.html"},{"title":"dct_t23i – Fortran-lang/fftpack","text":"public interface dct_t23i Initialize DCT types 2, 3\n( Specification ) Contents Module Procedures dcosqi Module Procedures public interface dcosqi () Arguments None","tags":"","loc":"interface/dct_t23i.html"},{"title":"dct_t3 – Fortran-lang/fftpack","text":"public interface dct_t3 Perform DCT type-3\n( Specification ) Contents Module Procedures dcosqf Module Procedures public interface dcosqf () Arguments None","tags":"","loc":"interface/dct_t3.html"},{"title":"dfftb – Fortran-lang/fftpack","text":"interface public pure subroutine dfftb(n, r, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of dfftf .\n( Specification )","tags":"","loc":"interface/dfftb.html"},{"title":"dfftf – Fortran-lang/fftpack","text":"interface public pure subroutine dfftf(n, r, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) Description Forward transform of a real periodic sequence.\n( Specification )","tags":"","loc":"interface/dfftf.html"},{"title":"dffti – Fortran-lang/fftpack","text":"interface public pure subroutine dffti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dfftf and dfftb .\n( Specification )","tags":"","loc":"interface/dffti.html"},{"title":"dzfftb – Fortran-lang/fftpack","text":"interface public pure subroutine dzfftb(n, r, azero, a, b, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: r (*) real(kind=rk), intent(in) :: azero real(kind=rk), intent(in) :: a (*) real(kind=rk), intent(in) :: b (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of dzfftf .\n( Specification )","tags":"","loc":"interface/dzfftb.html"},{"title":"dzfftf – Fortran-lang/fftpack","text":"interface public pure subroutine dzfftf(n, r, azero, a, b, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(in) :: r (*) real(kind=rk), intent(out) :: azero real(kind=rk), intent(out) :: a (*) real(kind=rk), intent(out) :: b (*) real(kind=rk), intent(in) :: wsave (*) Description Simplified forward transform of a real periodic sequence.\n( Specification )","tags":"","loc":"interface/dzfftf.html"},{"title":"dzffti – Fortran-lang/fftpack","text":"interface public pure subroutine dzffti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize dzfftf and dzfftb .\n( Specification )","tags":"","loc":"interface/dzffti.html"},{"title":"fft – Fortran-lang/fftpack","text":"public interface fft Forward transform of a complex periodic sequence.\n( Specifiction ) Contents Functions fft_rk Functions private pure module function fft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:)","tags":"","loc":"interface/fft.html"},{"title":"fftfreq – Fortran-lang/fftpack","text":"interface public pure module function fftfreq(n) result(out) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer,dimension(n) Description Integer frequency values involved in complex FFT.\n( Specifiction )","tags":"","loc":"interface/fftfreq.html"},{"title":"fftshift – Fortran-lang/fftpack","text":"public interface fftshift Shifts zero-frequency component to center of spectrum.\n( Specifiction ) Contents Functions fftshift_crk fftshift_rrk Functions private pure module function fftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function fftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x))","tags":"","loc":"interface/fftshift.html"},{"title":"idct – Fortran-lang/fftpack","text":"public interface idct Inverse discrete cosine transforms.\n( Specification ) Contents Functions idct_rk Functions private pure module function idct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/idct.html"},{"title":"ifft – Fortran-lang/fftpack","text":"public interface ifft Backward transform of a complex periodic sequence.\n( Specifiction ) Contents Functions ifft_rk Functions private pure module function ifft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:)","tags":"","loc":"interface/ifft.html"},{"title":"ifftshift – Fortran-lang/fftpack","text":"public interface ifftshift Shifts zero-frequency component to beginning of spectrum.\n( Specifiction ) Contents Functions ifftshift_crk ifftshift_rrk Functions private pure module function ifftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function ifftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x))","tags":"","loc":"interface/ifftshift.html"},{"title":"irfft – Fortran-lang/fftpack","text":"public interface irfft Backward transform of a real periodic sequence.\n( Specifiction ) Contents Functions irfft_rk Functions private pure module function irfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/irfft.html"},{"title":"rfft – Fortran-lang/fftpack","text":"public interface rfft Forward transform of a real periodic sequence.\n( Specifiction ) Contents Functions rfft_rk Functions private pure module function rfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:)","tags":"","loc":"interface/rfft.html"},{"title":"rfftfreq – Fortran-lang/fftpack","text":"interface public pure module function rfftfreq(n) result(out) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer,dimension(n) Description Integer frequency values involved in real FFT.\n( Specifiction )","tags":"","loc":"interface/rfftfreq.html"},{"title":"zfftb – Fortran-lang/fftpack","text":"interface public pure subroutine zfftb(n, c, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) Description Unnormalized inverse of zfftf .\n( Specification )","tags":"","loc":"interface/zfftb.html"},{"title":"zfftf – Fortran-lang/fftpack","text":"interface public pure subroutine zfftf(n, c, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) Description Forward transform of a complex periodic sequence.\n( Specification )","tags":"","loc":"interface/zfftf.html"},{"title":"zffti – Fortran-lang/fftpack","text":"interface public pure subroutine zffti(n, wsave) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) Description Initialize zfftf and zfftb .\n( Specification )","tags":"","loc":"interface/zffti.html"},{"title":"fftpack – Fortran-lang/fftpack","text":"Uses fftpack_kind Used by Descendants: fftpack_dct fftpack_fft fftpack_fftshift fftpack_ifft fftpack_ifftshift fftpack_irfft fftpack_rfft fftpack_utils Contents Interfaces dcosqb dcosqf dcosqi dcost dcosti dct dct_t1 dct_t1i dct_t2 dct_t23i dct_t3 dfftb dfftf dffti dzfftb dzfftf dzffti fft fftfreq fftshift idct ifft ifftshift irfft rfft rfftfreq zfftb zfftf zffti Interfaces interface public pure subroutine dcosqb(n, x, wsave) Unnormalized inverse of dcosqf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dcosqf(n, x, wsave) Forward transform of quarter wave data.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dcosqi(n, wsave) Initialize dcosqf and dcosqb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) interface public pure subroutine dcost(n, x, wsave) Discrete fourier cosine transform of an even sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: x (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dcosti(n, wsave) Initialize dcost .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) public interface dct Dsicrete cosine transforms.\n( Specification ) private pure module function dct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:) public interface dct_t1 Perform DCT type-1\n( Specification ) public interface dcost () Arguments None public interface dct_t1i Initialize DCT type-1\n( Specification ) public interface dcosti () Arguments None public interface dct_t2 Perform DCT type-2\n( Specification ) public interface dcosqb () Arguments None public interface dct_t23i Initialize DCT types 2, 3\n( Specification ) public interface dcosqi () Arguments None public interface dct_t3 Perform DCT type-3\n( Specification ) public interface dcosqf () Arguments None interface public pure subroutine dfftb(n, r, wsave) Unnormalized inverse of dfftf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dfftf(n, r, wsave) Forward transform of a real periodic sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(inout) :: r (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dffti(n, wsave) Initialize dfftf and dfftb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) interface public pure subroutine dzfftb(n, r, azero, a, b, wsave) Unnormalized inverse of dzfftf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: r (*) real(kind=rk), intent(in) :: azero real(kind=rk), intent(in) :: a (*) real(kind=rk), intent(in) :: b (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dzfftf(n, r, azero, a, b, wsave) Simplified forward transform of a real periodic sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(in) :: r (*) real(kind=rk), intent(out) :: azero real(kind=rk), intent(out) :: a (*) real(kind=rk), intent(out) :: b (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine dzffti(n, wsave) Initialize dzfftf and dzfftb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*) public interface fft Forward transform of a complex periodic sequence.\n( Specifiction ) private pure module function fft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:) interface public pure module function fftfreq(n) result(out) Integer frequency values involved in complex FFT.\n( Specifiction ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer, dimension(n) public interface fftshift Shifts zero-frequency component to center of spectrum.\n( Specifiction ) private pure module function fftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function fftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x)) public interface idct Inverse discrete cosine transforms.\n( Specification ) private pure module function idct_rk(x, n, type) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n integer, intent(in), optional :: type Return Value real(kind=rk), allocatable, (:) public interface ifft Backward transform of a complex periodic sequence.\n( Specifiction ) private pure module function ifft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value complex(kind=rk), allocatable, (:) public interface ifftshift Shifts zero-frequency component to beginning of spectrum.\n( Specifiction ) private pure module function ifftshift_crk(x) result(result) Arguments Type Intent Optional Attributes Name complex(kind=rk), intent(in) :: x (:) Return Value complex(kind=rk), dimension(size(x)) private pure module function ifftshift_rrk(x) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) Return Value real(kind=rk), dimension(size(x)) public interface irfft Backward transform of a real periodic sequence.\n( Specifiction ) private pure module function irfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:) public interface rfft Forward transform of a real periodic sequence.\n( Specifiction ) private pure module function rfft_rk(x, n) result(result) Arguments Type Intent Optional Attributes Name real(kind=rk), intent(in) :: x (:) integer, intent(in), optional :: n Return Value real(kind=rk), allocatable, (:) interface public pure module function rfftfreq(n) result(out) Integer frequency values involved in real FFT.\n( Specifiction ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n Return Value integer, dimension(n) interface public pure subroutine zfftb(n, c, wsave) Unnormalized inverse of zfftf .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine zfftf(n, c, wsave) Forward transform of a complex periodic sequence.\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n complex(kind=rk), intent(inout) :: c (*) real(kind=rk), intent(in) :: wsave (*) interface public pure subroutine zffti(n, wsave) Initialize zfftf and zfftb .\n( Specification ) Arguments Type Intent Optional Attributes Name integer, intent(in) :: n real(kind=rk), intent(out) :: wsave (*)","tags":"","loc":"module/fftpack.html"},{"title":"fftpack_kind – Fortran-lang/fftpack","text":"Contents Variables rk Variables Type Visibility Attributes Name Initial integer, public, parameter :: rk = kind(1.0d0)","tags":"","loc":"module/fftpack_kind.html"},{"title":"fftpack_fftshift – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_fftshift.html"},{"title":"fftpack_dct – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_dct.html"},{"title":"fftpack_fft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_fft.html"},{"title":"fftpack_irfft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_irfft.html"},{"title":"fftpack_ifft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_ifft.html"},{"title":"fftpack_utils – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_utils.html"},{"title":"fftpack_ifftshift – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_ifftshift.html"},{"title":"fftpack_rfft – Fortran-lang/fftpack","text":"Uses Ancestors: fftpack Contents None","tags":"","loc":"module/fftpack_rfft.html"},{"title":"fftpack.f90 – Fortran-lang/fftpack","text":"Contents Modules fftpack Source Code fftpack.f90 Source Code module fftpack use fftpack_kind implicit none private public :: zffti , zfftf , zfftb public :: fft , ifft public :: fftshift , ifftshift public :: fftfreq , rfftfreq public :: dffti , dfftf , dfftb public :: rfft , irfft public :: dzffti , dzfftf , dzfftb public :: dcosqi , dcosqf , dcosqb public :: dcosti , dcost public :: dct , idct public :: dct_t1i , dct_t1 public :: dct_t23i , dct_t2 , dct_t3 public :: rk interface !> Version: experimental !> !> Initialize `zfftf` and `zfftb`. !> ([Specification](../page/specs/fftpack.html#zffti)) pure subroutine zffti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine zffti !> Version: experimental !> !> Forward transform of a complex periodic sequence. !> ([Specification](../page/specs/fftpack.html#zfftf)) pure subroutine zfftf ( n , c , wsave ) import rk integer , intent ( in ) :: n complex ( kind = rk ), intent ( inout ) :: c ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine zfftf !> Version: experimental !> !> Unnormalized inverse of `zfftf`. !> ([Specification](../page/specs/fftpack.html#zfftb)) pure subroutine zfftb ( n , c , wsave ) import rk integer , intent ( in ) :: n complex ( kind = rk ), intent ( inout ) :: c ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine zfftb !> Version: experimental !> !> Initialize `dfftf` and `dfftb`. !> ([Specification](../page/specs/fftpack.html#dffti)) pure subroutine dffti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dffti !> Version: experimental !> !> Forward transform of a real periodic sequence. !> ([Specification](../page/specs/fftpack.html#dfftf)) pure subroutine dfftf ( n , r , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: r ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dfftf !> Version: experimental !> !> Unnormalized inverse of `dfftf`. !> ([Specification](../page/specs/fftpack.html#dfftb)) pure subroutine dfftb ( n , r , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: r ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dfftb !> Version: experimental !> !> Initialize `dzfftf` and `dzfftb`. !> ([Specification](../page/specs/fftpack.html#dzffti)) pure subroutine dzffti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dzffti !> Version: experimental !> !> Simplified forward transform of a real periodic sequence. !> ([Specification](../page/specs/fftpack.html#dzfftf)) pure subroutine dzfftf ( n , r , azero , a , b , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( in ) :: r ( * ) real ( kind = rk ), intent ( out ) :: azero real ( kind = rk ), intent ( out ) :: a ( * ), b ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dzfftf !> Version: experimental !> !> Unnormalized inverse of `dzfftf`. !> ([Specification](../page/specs/fftpack.html#dzfftb)) pure subroutine dzfftb ( n , r , azero , a , b , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: r ( * ) real ( kind = rk ), intent ( in ) :: azero real ( kind = rk ), intent ( in ) :: a ( * ), b ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dzfftb !> Version: experimental !> !> Initialize `dcosqf` and `dcosqb`. !> ([Specification](../page/specs/fftpack.html#initialize-dct-2-3-dcosqi-or-dct_t23i)) pure subroutine dcosqi ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dcosqi !> Version: experimental !> !> Forward transform of quarter wave data. !> ([Specification](../page/specs/fftpack.html#compute-dct-3-dcosqf-or-dct_t3)) pure subroutine dcosqf ( n , x , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: x ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dcosqf !> Version: experimental !> !> Unnormalized inverse of `dcosqf`. !> ([Specification](../page/specs/fftpack.html#compute-dct-2-dcosqb-or-dct_t2)) pure subroutine dcosqb ( n , x , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: x ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dcosqb !> Version: experimental !> !> Initialize `dcost`. !> ([Specification](../page/specs/fftpack.html#initialize-dct-1-dcosti-or-dct_t1i)) pure subroutine dcosti ( n , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( out ) :: wsave ( * ) end subroutine dcosti !> Version: experimental !> !> Discrete fourier cosine transform of an even sequence. !> ([Specification](../page/specs/fftpack.html#compute-dct-1-dcost-or-dct_t1)) pure subroutine dcost ( n , x , wsave ) import rk integer , intent ( in ) :: n real ( kind = rk ), intent ( inout ) :: x ( * ) real ( kind = rk ), intent ( in ) :: wsave ( * ) end subroutine dcost !> Version: experimental !> !> Integer frequency values involved in complex FFT. !> ([Specifiction](../page/specs/fftpack.html#fftfreq)) pure module function fftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out end function fftfreq !> Version: experimental !> !> Integer frequency values involved in real FFT. !> ([Specifiction](../page/specs/fftpack.html#rfftfreq)) pure module function rfftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out end function rfftfreq end interface !> Version: experimental !> !> Forward transform of a complex periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#fft)) interface fft pure module function fft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) end function fft_rk end interface fft !> Version: experimental !> !> Backward transform of a complex periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#ifft)) interface ifft pure module function ifft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) end function ifft_rk end interface ifft !> Version: experimental !> !> Forward transform of a real periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#rfft)) interface rfft pure module function rfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) end function rfft_rk end interface rfft !> Version: experimental !> !> Backward transform of a real periodic sequence. !> ([Specifiction](../page/specs/fftpack.html#irfft)) interface irfft pure module function irfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) end function irfft_rk end interface irfft !> Version: experimental !> !> Dsicrete cosine transforms. !> ([Specification](../page/specs/fftpack.html#simplified-dct-of-types-1-2-3-dct)) interface dct pure module function dct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) end function dct_rk end interface dct !> Version: experimental !> !> Inverse discrete cosine transforms. !> ([Specification](../page/specs/fftpack.html#simplified-inverse-dct-of-types-1-2-3-idct)) interface idct pure module function idct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) end function idct_rk end interface idct !> Version: experimental !> !> Initialize DCT type-1 !> ([Specification](../page/specs/fftpack.html#initialize-dct-1-dcosti-or-dct_t1i)) interface dct_t1i procedure :: dcosti end interface dct_t1i !> Version: experimental !> !> Perform DCT type-1 !> ([Specification](../page/specs/fftpack.html#compute-dct-1-dcost-or-dct_t1)) interface dct_t1 procedure :: dcost end interface dct_t1 !> Version: experimental !> !> Initialize DCT types 2, 3 !> ([Specification](../page/specs/fftpack.html#initialize-dct-2-3-dcosqi-or-dct_t23i)) interface dct_t23i procedure :: dcosqi end interface dct_t23i !> Version: experimental !> !> Perform DCT type-2 !> ([Specification](../page/specs/fftpack.html#compute-dct-2-dcosqb-or-dct_t2)) interface dct_t2 procedure :: dcosqb end interface dct_t2 !> Version: experimental !> !> Perform DCT type-3 !> ([Specification](../page/specs/fftpack.html#compute-dct-3-dcosqf-or-dct_t3)) interface dct_t3 procedure :: dcosqf end interface dct_t3 !> Version: experimental !> !> Shifts zero-frequency component to center of spectrum. !> ([Specifiction](../page/specs/fftpack.html#fftshift)) interface fftshift pure module function fftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result end function fftshift_crk pure module function fftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result end function fftshift_rrk end interface fftshift !> Version: experimental !> !> Shifts zero-frequency component to beginning of spectrum. !> ([Specifiction](../page/specs/fftpack.html#ifftshift)) interface ifftshift pure module function ifftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result end function ifftshift_crk pure module function ifftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result end function ifftshift_rrk end interface ifftshift end module fftpack","tags":"","loc":"sourcefile/fftpack.f90.html"},{"title":"radb5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb5 Source Code radb5.f90 Source Code subroutine radb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 ti5 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 5 , k ) + Cc ( 1 , 5 , k ) tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr3 = Cc ( Ido , 4 , k ) + Cc ( Ido , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci5 = ti11 * ti5 + ti12 * ti4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 1 , k , 5 ) = cr2 + ci5 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti5 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ti4 = Cc ( i , 5 , k ) + Cc ( ic , 4 , k ) ti3 = Cc ( i , 5 , k ) - Cc ( ic , 4 , k ) tr5 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) tr4 = Cc ( i - 1 , 5 , k ) - Cc ( ic - 1 , 4 , k ) tr3 = Cc ( i - 1 , 5 , k ) + Cc ( ic - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * dr4 - Wa3 ( i - 1 ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * di4 + Wa3 ( i - 1 ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 2 ) * dr5 - Wa4 ( i - 1 ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 2 ) * di5 + Wa4 ( i - 1 ) * dr5 enddo enddo end subroutine radb5","tags":"","loc":"sourcefile/radb5.f90.html"},{"title":"radf5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf5 Source Code radf5.f90 Source Code subroutine radf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 5 ) , Ch ( Ido , 5 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) do k = 1 , l1 cr2 = Cc ( 1 , k , 5 ) + Cc ( 1 , k , 2 ) ci5 = Cc ( 1 , k , 5 ) - Cc ( 1 , k , 2 ) cr3 = Cc ( 1 , k , 4 ) + Cc ( 1 , k , 3 ) ci4 = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 + cr3 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 Ch ( 1 , 3 , k ) = ti11 * ci5 + ti12 * ci4 Ch ( Ido , 4 , k ) = Cc ( 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 Ch ( 1 , 5 , k ) = ti12 * ci5 - ti11 * ci4 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) dr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) di4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) dr5 = Wa4 ( i - 2 ) * Cc ( i - 1 , k , 5 ) + Wa4 ( i - 1 ) * Cc ( i , k , 5 ) di5 = Wa4 ( i - 2 ) * Cc ( i , k , 5 ) - Wa4 ( i - 1 ) * Cc ( i - 1 , k , 5 ) cr2 = dr2 + dr5 ci5 = dr5 - dr2 cr5 = di2 - di5 ci2 = di2 + di5 cr3 = dr3 + dr4 ci4 = dr4 - dr3 cr4 = di3 - di4 ci3 = di3 + di4 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 + cr3 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 + ci3 tr2 = Cc ( i - 1 , k , 1 ) + tr11 * cr2 + tr12 * cr3 ti2 = Cc ( i , k , 1 ) + tr11 * ci2 + tr12 * ci3 tr3 = Cc ( i - 1 , k , 1 ) + tr12 * cr2 + tr11 * cr3 ti3 = Cc ( i , k , 1 ) + tr12 * ci2 + tr11 * ci3 tr5 = ti11 * cr5 + ti12 * cr4 ti5 = ti11 * ci5 + ti12 * ci4 tr4 = ti12 * cr5 - ti11 * cr4 ti4 = ti12 * ci5 - ti11 * ci4 Ch ( i - 1 , 3 , k ) = tr2 + tr5 Ch ( ic - 1 , 2 , k ) = tr2 - tr5 Ch ( i , 3 , k ) = ti2 + ti5 Ch ( ic , 2 , k ) = ti5 - ti2 Ch ( i - 1 , 5 , k ) = tr3 + tr4 Ch ( ic - 1 , 4 , k ) = tr3 - tr4 Ch ( i , 5 , k ) = ti3 + ti4 Ch ( ic , 4 , k ) = ti4 - ti3 enddo enddo end subroutine radf5","tags":"","loc":"sourcefile/radf5.f90.html"},{"title":"radb3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb3 Source Code radb3.f90 Source Code subroutine radb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 tr2 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ci3 = taui * ( Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k )) ci3 = taui * ( Cc ( i , 3 , k ) + Cc ( ic , 2 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * dr2 - Wa1 ( i - 1 ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * di2 + Wa1 ( i - 1 ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * dr3 - Wa2 ( i - 1 ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * di3 + Wa2 ( i - 1 ) * dr3 enddo enddo end subroutine radb3","tags":"","loc":"sourcefile/radb3.f90.html"},{"title":"zfftb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines zfftb Source Code zfftb.f90 Source Code subroutine zfftb ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftb1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftb","tags":"","loc":"sourcefile/zfftb.f90.html"},{"title":"dffti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dffti Source Code dffti.f90 Source Code subroutine dffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call rffti1 ( n , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dffti","tags":"","loc":"sourcefile/dffti.f90.html"},{"title":"passb5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb5 Source Code passb5.f90 Source Code subroutine passb5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 - Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 + Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 - Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 + Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passb5","tags":"","loc":"sourcefile/passb5.f90.html"},{"title":"passb2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb2 Source Code passb2.f90 Source Code subroutine passb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 + Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 - Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passb2","tags":"","loc":"sourcefile/passb2.f90.html"},{"title":"passf2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf2 Source Code passf2.f90 Source Code subroutine passf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , Ido , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) if ( Ido > 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + Cc ( i , 2 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( i , 2 , k ) Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ti2 - Wa1 ( i ) * tr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * tr2 + Wa1 ( i ) * ti2 enddo enddo else do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( 1 , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( 1 , 2 , k ) Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + Cc ( 2 , 2 , k ) Ch ( 2 , k , 2 ) = Cc ( 2 , 1 , k ) - Cc ( 2 , 2 , k ) enddo end if end subroutine passf2","tags":"","loc":"sourcefile/passf2.f90.html"},{"title":"dcosqf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosqf Source Code dcosqf.f90 Source Code subroutine dcosqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: tsqx , Wsave , x dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) if ( n < 2 ) then return elseif ( n == 2 ) then tsqx = sqrt2 * x ( 2 ) x ( 2 ) = x ( 1 ) - tsqx x ( 1 ) = x ( 1 ) + tsqx else call cosqf1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqf","tags":"","loc":"sourcefile/dcosqf.f90.html"},{"title":"fftpack_fftshift.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_fftshift Source Code fftpack_fftshift.f90 Source Code submodule ( fftpack ) fftpack_fftshift contains !> Shifts zero-frequency component to center of spectrum for `complex` type. pure module function fftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- floor ( 0.5_rk * size ( x ))) end function fftshift_crk !> Shifts zero-frequency component to center of spectrum for `real` type. pure module function fftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- floor ( 0.5_rk * size ( x ))) end function fftshift_rrk end submodule fftpack_fftshift","tags":"","loc":"sourcefile/fftpack_fftshift.f90.html"},{"title":"radbg.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radbg Source Code radbg.f90 Source Code subroutine radbg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2 * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Ch ( 1 , k , j ) = Cc ( Ido , j2 - 2 , k ) + Cc ( Ido , j2 - 2 , k ) Ch ( 1 , k , jc ) = Cc ( 1 , j2 - 1 , k ) + Cc ( 1 , j2 - 1 , k ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , j ) = Cc ( i - 1 , 2 * j - 1 , k ) + Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i - 1 , k , jc ) = Cc ( i - 1 , 2 * j - 1 , k ) - Cc ( ic - 1 , 2 * j - 2 , k ) Ch ( i , k , j ) = Cc ( i , 2 * j - 1 , k ) - Cc ( ic , 2 * j - 2 , k ) Ch ( i , k , jc ) = Cc ( i , 2 * j - 1 , k ) + Cc ( ic , 2 * j - 2 , k ) enddo enddo enddo endif endif ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + ar1 * Ch2 ( ik , 2 ) c2 ( ik , lc ) = ai1 * Ch2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + ar2 * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + ai2 * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) - c1 ( 1 , k , jc ) Ch ( 1 , k , jc ) = c1 ( 1 , k , j ) + c1 ( 1 , k , jc ) enddo enddo if ( Ido /= 1 ) then if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 Ch ( i - 1 , k , j ) = c1 ( i - 1 , k , j ) - c1 ( i , k , jc ) Ch ( i - 1 , k , jc ) = c1 ( i - 1 , k , j ) + c1 ( i , k , jc ) Ch ( i , k , j ) = c1 ( i , k , j ) + c1 ( i - 1 , k , jc ) Ch ( i , k , jc ) = c1 ( i , k , j ) - c1 ( i - 1 , k , jc ) enddo enddo enddo endif endif if ( Ido == 1 ) return do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo endif end subroutine radbg","tags":"","loc":"sourcefile/radbg.f90.html"},{"title":"cfftb1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cfftb1 Source Code cfftb1.f90 Source Code subroutine cfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passb4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passb4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passb2 ( idot , l1 , Ch , c , Wa ( iw )) else call passb2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passb3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passb3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passb ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passb ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passb5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passb5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftb1","tags":"","loc":"sourcefile/cfftb1.f90.html"},{"title":"passf5.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf5 Source Code passf5.f90 Source Code subroutine passf5 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 , Wa4 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , ci5 , cr2 , cr3 , & cr4 , cr5 , di2 , di3 , di4 , di5 , dr2 , dr3 , & dr4 , dr5 real ( rk ) :: ti2 , ti3 , ti4 , ti5 , tr2 , tr3 , & tr4 , tr5 , Wa1 , Wa2 , Wa3 , Wa4 integer :: i , Ido , k , l1 dimension Cc ( Ido , 5 , l1 ) , Ch ( Ido , l1 , 5 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ), & Wa4 ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) real ( rk ), parameter :: tr11 = cos ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti11 = - sin ( 2.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: tr12 = cos ( 4.0_rk * pi / 5.0_rk ) real ( rk ), parameter :: ti12 = - sin ( 4.0_rk * pi / 5.0_rk ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti5 = Cc ( i , 2 , k ) - Cc ( i , 5 , k ) ti2 = Cc ( i , 2 , k ) + Cc ( i , 5 , k ) ti4 = Cc ( i , 3 , k ) - Cc ( i , 4 , k ) ti3 = Cc ( i , 3 , k ) + Cc ( i , 4 , k ) tr5 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 5 , k ) tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 5 , k ) tr4 = Cc ( i - 1 , 3 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 + tr3 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 + ti3 cr2 = Cc ( i - 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( i , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( i - 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( i , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 dr3 = cr3 - ci4 dr4 = cr3 + ci4 di3 = ci3 + cr4 di4 = ci3 - cr4 dr5 = cr2 + ci5 dr2 = cr2 - ci5 di5 = ci2 - cr5 di2 = ci2 + cr5 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * dr4 + Wa3 ( i ) * di4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * di4 - Wa3 ( i ) * dr4 Ch ( i - 1 , k , 5 ) = Wa4 ( i - 1 ) * dr5 + Wa4 ( i ) * di5 Ch ( i , k , 5 ) = Wa4 ( i - 1 ) * di5 - Wa4 ( i ) * dr5 enddo enddo else do k = 1 , l1 ti5 = Cc ( 2 , 2 , k ) - Cc ( 2 , 5 , k ) ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 5 , k ) ti4 = Cc ( 2 , 3 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 3 , k ) + Cc ( 2 , 4 , k ) tr5 = Cc ( 1 , 2 , k ) - Cc ( 1 , 5 , k ) tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 5 , k ) tr4 = Cc ( 1 , 3 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 3 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 + tr3 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 + ti3 cr2 = Cc ( 1 , 1 , k ) + tr11 * tr2 + tr12 * tr3 ci2 = Cc ( 2 , 1 , k ) + tr11 * ti2 + tr12 * ti3 cr3 = Cc ( 1 , 1 , k ) + tr12 * tr2 + tr11 * tr3 ci3 = Cc ( 2 , 1 , k ) + tr12 * ti2 + tr11 * ti3 cr5 = ti11 * tr5 + ti12 * tr4 ci5 = ti11 * ti5 + ti12 * ti4 cr4 = ti12 * tr5 - ti11 * tr4 ci4 = ti12 * ti5 - ti11 * ti4 Ch ( 1 , k , 2 ) = cr2 - ci5 Ch ( 1 , k , 5 ) = cr2 + ci5 Ch ( 2 , k , 2 ) = ci2 + cr5 Ch ( 2 , k , 3 ) = ci3 + cr4 Ch ( 1 , k , 3 ) = cr3 - ci4 Ch ( 1 , k , 4 ) = cr3 + ci4 Ch ( 2 , k , 4 ) = ci3 - cr4 Ch ( 2 , k , 5 ) = ci2 - cr5 enddo end if end subroutine passf5","tags":"","loc":"sourcefile/passf5.f90.html"},{"title":"fftpack_dct.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_dct Source Code fftpack_dct.f90 Source Code submodule ( fftpack ) fftpack_dct contains !> Discrete cosine transforms of types 1, 2, 3. pure module function dct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if ! Default to DCT-2 if (. not . present ( type )) then lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqb ( lenseq , result , wsave ) return end if if ( type == 1 ) then ! DCT-1 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosti ( lenseq , wsave ) call dcost ( lenseq , result , wsave ) else if ( type == 2 ) then ! DCT-2 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqb ( lenseq , result , wsave ) else if ( type == 3 ) then ! DCT-3 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqf ( lenseq , result , wsave ) end if end function dct_rk !> Inverse discrete cosine transforms of types 1, 2, 3. pure module function idct_rk ( x , n , type ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n integer , intent ( in ), optional :: type real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if ! Default to t=2; inverse DCT-2 is DCT-3 if (. not . present ( type )) then lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqf ( lenseq , result , wsave ) return end if if ( type == 1 ) then ! inverse DCT-1 is DCT-1 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosti ( lenseq , wsave ) call dcost ( lenseq , result , wsave ) else if ( type == 2 ) then ! inverse DCT-2 is DCT-3 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqf ( lenseq , result , wsave ) else if ( type == 3 ) then ! inverse DCT-3 is DCT-2 lensav = 3 * lenseq + 15 allocate ( wsave ( lensav )) call dcosqi ( lenseq , wsave ) call dcosqb ( lenseq , result , wsave ) end if end function idct_rk end submodule fftpack_dct","tags":"","loc":"sourcefile/fftpack_dct.f90.html"},{"title":"fftpack_fft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_fft Source Code fftpack_fft.f90 Source Code submodule ( fftpack ) fftpack_fft contains !> Forward transform of a complex periodic sequence. pure module function fft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , (( 0.0_rk , 0.0_rk ), i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 4 * lenseq + 15 allocate ( wsave ( lensav )) call zffti ( lenseq , wsave ) !> Forward transformation call zfftf ( lenseq , result , wsave ) end function fft_rk end submodule fftpack_fft","tags":"","loc":"sourcefile/fftpack_fft.f90.html"},{"title":"dcost.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcost Source Code dcost.f90 Source Code subroutine dcost ( n , x , Wsave ) use fftpack_kind implicit none real ( rk ) :: c1 , t1 , t2 , tx2 , Wsave , x , x1h , x1p3 , & xi , xim2 integer :: i , k , kc , modn , n , nm1 , np1 , ns2 dimension x ( * ) , Wsave ( * ) nm1 = n - 1 np1 = n + 1 ns2 = n / 2 if ( n < 2 ) return if ( n == 2 ) then x1h = x ( 1 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 2 ) x ( 1 ) = x1h return elseif ( n > 3 ) then c1 = x ( 1 ) - x ( n ) x ( 1 ) = x ( 1 ) + x ( n ) do k = 2 , ns2 kc = np1 - k t1 = x ( k ) + x ( kc ) t2 = x ( k ) - x ( kc ) c1 = c1 + Wsave ( kc ) * t2 t2 = Wsave ( k ) * t2 x ( k ) = t1 - t2 x ( kc ) = t1 + t2 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) call dfftf ( nm1 , x , Wsave ( n + 1 )) xim2 = x ( 2 ) x ( 2 ) = c1 do i = 4 , n , 2 xi = x ( i ) x ( i ) = x ( i - 2 ) - x ( i - 1 ) x ( i - 1 ) = xim2 xim2 = xi enddo if ( modn /= 0 ) x ( n ) = xim2 return endif x1p3 = x ( 1 ) + x ( 3 ) tx2 = x ( 2 ) + x ( 2 ) x ( 2 ) = x ( 1 ) - x ( 3 ) x ( 1 ) = x1p3 + tx2 x ( 3 ) = x1p3 - tx2 end subroutine dcost","tags":"","loc":"sourcefile/dcost.f90.html"},{"title":"radf4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf4 Source Code radf4.f90 Source Code subroutine radf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , l1 , 4 ) , Ch ( Ido , 4 , l1 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: hsqt2 = sqrt ( 2.0_rk ) / 2.0_rk do k = 1 , l1 tr1 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 4 ) tr2 = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = tr1 + tr2 Ch ( Ido , 4 , k ) = tr2 - tr1 Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 3 ) Ch ( 1 , 3 , k ) = Cc ( 1 , k , 4 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i cr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ci2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) cr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) ci3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr4 = Wa3 ( i - 2 ) * Cc ( i - 1 , k , 4 ) + Wa3 ( i - 1 ) * Cc ( i , k , 4 ) ci4 = Wa3 ( i - 2 ) * Cc ( i , k , 4 ) - Wa3 ( i - 1 ) * Cc ( i - 1 , k , 4 ) tr1 = cr2 + cr4 tr4 = cr4 - cr2 ti1 = ci2 + ci4 ti4 = ci2 - ci4 ti2 = Cc ( i , k , 1 ) + ci3 ti3 = Cc ( i , k , 1 ) - ci3 tr2 = Cc ( i - 1 , k , 1 ) + cr3 tr3 = Cc ( i - 1 , k , 1 ) - cr3 Ch ( i - 1 , 1 , k ) = tr1 + tr2 Ch ( ic - 1 , 4 , k ) = tr2 - tr1 Ch ( i , 1 , k ) = ti1 + ti2 Ch ( ic , 4 , k ) = ti1 - ti2 Ch ( i - 1 , 3 , k ) = ti4 + tr3 Ch ( ic - 1 , 2 , k ) = tr3 - ti4 Ch ( i , 3 , k ) = tr4 + ti3 Ch ( ic , 2 , k ) = tr4 - ti3 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = - hsqt2 * ( Cc ( Ido , k , 2 ) + Cc ( Ido , k , 4 )) tr1 = hsqt2 * ( Cc ( Ido , k , 2 ) - Cc ( Ido , k , 4 )) Ch ( Ido , 1 , k ) = tr1 + Cc ( Ido , k , 1 ) Ch ( Ido , 3 , k ) = Cc ( Ido , k , 1 ) - tr1 Ch ( 1 , 2 , k ) = ti1 - Cc ( Ido , k , 3 ) Ch ( 1 , 4 , k ) = ti1 + Cc ( Ido , k , 3 ) enddo end subroutine radf4","tags":"","loc":"sourcefile/radf4.f90.html"},{"title":"zfftf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines zfftf Source Code zfftf.f90 Source Code subroutine zfftf ( n , c , Wsave ) use fftpack_kind implicit none real ( rk ) :: c , Wsave integer :: iw1 , iw2 , n dimension c ( * ) , Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cfftf1 ( n , c , Wsave , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zfftf","tags":"","loc":"sourcefile/zfftf.f90.html"},{"title":"radb2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb2 Source Code radb2.f90 Source Code subroutine radb2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 2 , l1 ) , Ch ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + Cc ( Ido , 2 , k ) Ch ( 1 , k , 2 ) = Cc ( 1 , 1 , k ) - Cc ( Ido , 2 , k ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 2 , k ) tr2 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 2 , k ) Ch ( i , k , 1 ) = Cc ( i , 1 , k ) - Cc ( ic , 2 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( ic , 2 , k ) Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * tr2 - Wa1 ( i - 1 ) * ti2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ti2 + Wa1 ( i - 1 ) * tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( Ido , k , 1 ) = Cc ( Ido , 1 , k ) + Cc ( Ido , 1 , k ) Ch ( Ido , k , 2 ) = - ( Cc ( 1 , 2 , k ) + Cc ( 1 , 2 , k )) enddo end subroutine radb2","tags":"","loc":"sourcefile/radb2.f90.html"},{"title":"rfftf1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines rfftf1 Source Code rfftf1.f90 Source Code subroutine rfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & kh , l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 1 l2 = n iw = n do k1 = 1 , nf kh = nf - k1 ip = Ifac ( kh + 3 ) l1 = l2 / ip ido = n / l2 idl1 = ido * l1 iw = iw - ( ip - 1 ) * ido na = 1 - na if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radf4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radf4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif elseif ( ip /= 2 ) then if ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radf3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radf3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif elseif ( ip /= 5 ) then if ( ido == 1 ) na = 1 - na if ( na /= 0 ) then call radfg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) na = 0 else call radfg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) na = 1 endif else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radf5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radf5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif endif elseif ( na /= 0 ) then call radf2 ( ido , l1 , Ch , c , Wa ( iw )) else call radf2 ( ido , l1 , c , Ch , Wa ( iw )) endif l2 = l1 enddo if ( na == 1 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftf1","tags":"","loc":"sourcefile/rfftf1.f90.html"},{"title":"radf3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf3 Source Code radf3.f90 Source Code subroutine radf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , cr2 , di2 , di3 , dr2 , dr3 , & ti2 , ti3 , tr2 , tr3 , Wa1 , Wa2 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 3 , l1 ) , Cc ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk ! note: original comment said this was -SQRT(3)/2 but value was 0.86602540378443864676d0 real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk do k = 1 , l1 cr2 = Cc ( 1 , k , 2 ) + Cc ( 1 , k , 3 ) Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + cr2 Ch ( 1 , 3 , k ) = taui * ( Cc ( 1 , k , 3 ) - Cc ( 1 , k , 2 )) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) + taur * cr2 enddo if ( Ido == 1 ) return idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i dr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) di2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) dr3 = Wa2 ( i - 2 ) * Cc ( i - 1 , k , 3 ) + Wa2 ( i - 1 ) * Cc ( i , k , 3 ) di3 = Wa2 ( i - 2 ) * Cc ( i , k , 3 ) - Wa2 ( i - 1 ) * Cc ( i - 1 , k , 3 ) cr2 = dr2 + dr3 ci2 = di2 + di3 Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + cr2 Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ci2 tr2 = Cc ( i - 1 , k , 1 ) + taur * cr2 ti2 = Cc ( i , k , 1 ) + taur * ci2 tr3 = taui * ( di2 - di3 ) ti3 = taui * ( dr3 - dr2 ) Ch ( i - 1 , 3 , k ) = tr2 + tr3 Ch ( ic - 1 , 2 , k ) = tr2 - tr3 Ch ( i , 3 , k ) = ti2 + ti3 Ch ( ic , 2 , k ) = ti3 - ti2 enddo enddo end subroutine radf3","tags":"","loc":"sourcefile/radf3.f90.html"},{"title":"passb3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb3 Source Code passb3.f90 Source Code subroutine passb3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 + Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 - Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 + Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 - Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passb3","tags":"","loc":"sourcefile/passb3.f90.html"},{"title":"dzfftb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dzfftb Source Code dzfftb.f90 Source Code subroutine dzfftb ( n , r , Azero , a , b , Wsave ) use fftpack_kind implicit none real ( rk ) :: a , Azero , b , r , Wsave integer :: i , n , ns2 dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then r ( 1 ) = Azero return elseif ( n == 2 ) then r ( 1 ) = Azero + a ( 1 ) r ( 2 ) = Azero - a ( 1 ) return else ns2 = ( n - 1 ) / 2 do i = 1 , ns2 r ( 2 * i ) = 0.5_rk * a ( i ) r ( 2 * i + 1 ) = - 0.5_rk * b ( i ) enddo r ( 1 ) = Azero if ( mod ( n , 2 ) == 0 ) r ( n ) = a ( ns2 + 1 ) call dfftb ( n , r , Wsave ( n + 1 )) endif end subroutine dzfftb","tags":"","loc":"sourcefile/dzfftb.f90.html"},{"title":"passf4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf4 Source Code passf4.f90 Source Code subroutine passf4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 2 , k ) - Cc ( i , 4 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 4 , k ) - Cc ( i - 1 , 2 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 + Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 - Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 + Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 - Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 + Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 - Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 2 , k ) - Cc ( 2 , 4 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passf4","tags":"","loc":"sourcefile/passf4.f90.html"},{"title":"fftpack_irfft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_irfft Source Code fftpack_irfft.f90 Source Code submodule ( fftpack ) fftpack_irfft contains !> Backward transform of a real periodic sequence. pure module function irfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 2 * lenseq + 15 allocate ( wsave ( lensav )) call dffti ( lenseq , wsave ) !> Backward transformation call dfftb ( lenseq , result , wsave ) end function irfft_rk end submodule fftpack_irfft","tags":"","loc":"sourcefile/fftpack_irfft.f90.html"},{"title":"zffti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines zffti Source Code zffti.f90 Source Code subroutine zffti ( n , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return iw1 = n + n + 1 iw2 = iw1 + n + n call cffti1 ( n , Wsave ( iw1 ), Wsave ( iw2 )) end subroutine zffti","tags":"","loc":"sourcefile/zffti.f90.html"},{"title":"passb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb Source Code passb.f90 Source Code subroutine passb ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) + wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo return endif idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) - Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) + Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo return end subroutine passb","tags":"","loc":"sourcefile/passb.f90.html"},{"title":"dsint.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsint Source Code dsint.f90 Source Code subroutine dsint ( n , x , Wsave ) use fftpack_kind implicit none integer :: iw1 , iw2 , iw3 , n , np1 real ( rk ) :: Wsave , x dimension x ( * ) , Wsave ( * ) np1 = n + 1 iw1 = n / 2 + 1 iw2 = iw1 + np1 iw3 = iw2 + np1 call sint1 ( n , x , Wsave , Wsave ( iw1 ), Wsave ( iw2 ), Wsave ( iw3 )) end subroutine dsint","tags":"","loc":"sourcefile/dsint.f90.html"},{"title":"rfftb1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines rfftb1 Source Code rfftb1.f90 Source Code subroutine rfftb1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , Ifac , ip , iw , ix2 , ix3 , ix4 , k1 , & l1 , l2 , n , na , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idl1 = ido * l1 if ( ip == 4 ) then ix2 = iw + ido ix3 = ix2 + ido if ( na /= 0 ) then call radb4 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call radb4 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call radb2 ( ido , l1 , Ch , c , Wa ( iw )) else call radb2 ( ido , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + ido if ( na /= 0 ) then call radb3 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call radb3 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call radbg ( ido , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call radbg ( ido , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( ido == 1 ) na = 1 - na else ix2 = iw + ido ix3 = ix2 + ido ix4 = ix3 + ido if ( na /= 0 ) then call radb5 ( ido , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call radb5 ( ido , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * ido enddo if ( na == 0 ) return do i = 1 , n c ( i ) = Ch ( i ) enddo end subroutine rfftb1","tags":"","loc":"sourcefile/rfftb1.f90.html"},{"title":"radf2.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radf2 Source Code radf2.f90 Source Code subroutine radf2 ( Ido , l1 , Cc , Ch , Wa1 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ti2 , tr2 , Wa1 integer :: i , ic , Ido , idp2 , k , l1 dimension Ch ( Ido , 2 , l1 ) , Cc ( Ido , l1 , 2 ) , Wa1 ( * ) do k = 1 , l1 Ch ( 1 , 1 , k ) = Cc ( 1 , k , 1 ) + Cc ( 1 , k , 2 ) Ch ( Ido , 2 , k ) = Cc ( 1 , k , 1 ) - Cc ( 1 , k , 2 ) enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i tr2 = Wa1 ( i - 2 ) * Cc ( i - 1 , k , 2 ) + Wa1 ( i - 1 ) * Cc ( i , k , 2 ) ti2 = Wa1 ( i - 2 ) * Cc ( i , k , 2 ) - Wa1 ( i - 1 ) * Cc ( i - 1 , k , 2 ) Ch ( i , 1 , k ) = Cc ( i , k , 1 ) + ti2 Ch ( ic , 2 , k ) = ti2 - Cc ( i , k , 1 ) Ch ( i - 1 , 1 , k ) = Cc ( i - 1 , k , 1 ) + tr2 Ch ( ic - 1 , 2 , k ) = Cc ( i - 1 , k , 1 ) - tr2 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 Ch ( 1 , 2 , k ) = - Cc ( Ido , k , 2 ) Ch ( Ido , 1 , k ) = Cc ( Ido , k , 1 ) enddo end subroutine radf2","tags":"","loc":"sourcefile/radf2.f90.html"},{"title":"radfg.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radfg Source Code radfg.f90 Source Code subroutine radfg ( Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: ai1 , ai2 , ar1 , ar1h , ar2 , ar2h , arg , c1 , & c2 , Cc , Ch , Ch2 , dc2 , dcp , ds2 , dsp , & Wa integer :: i , ic , idij , Idl1 , Ido , idp2 , ik , Ip , ipp2 , & ipph , is , j , j2 , jc , k , l , l1 , lc , nbd dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) , Wa ( * ) real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi arg = tpi / real ( Ip , rk ) dcp = cos ( arg ) dsp = sin ( arg ) ipph = ( Ip + 1 ) / 2 ipp2 = Ip + 2 idp2 = Ido + 2 nbd = ( Ido - 1 ) / 2 if ( Ido == 1 ) then do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo else do ik = 1 , Idl1 Ch2 ( ik , 1 ) = c2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 Ch ( 1 , k , j ) = c1 ( 1 , k , j ) enddo enddo if ( nbd > l1 ) then is = - Ido do j = 2 , Ip is = is + Ido do k = 1 , l1 idij = is do i = 3 , Ido , 2 idij = idij + 2 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo else is = - Ido do j = 2 , Ip is = is + Ido idij = is do i = 3 , Ido , 2 idij = idij + 2 do k = 1 , l1 Ch ( i - 1 , k , j ) = Wa ( idij - 1 ) * c1 ( i - 1 , k , j ) + Wa ( idij ) & * c1 ( i , k , j ) Ch ( i , k , j ) = Wa ( idij - 1 ) * c1 ( i , k , j ) - Wa ( idij ) & * c1 ( i - 1 , k , j ) enddo enddo enddo endif if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 3 , Ido , 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 3 , Ido , 2 c1 ( i - 1 , k , j ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) c1 ( i - 1 , k , jc ) = Ch ( i , k , j ) - Ch ( i , k , jc ) c1 ( i , k , j ) = Ch ( i , k , j ) + Ch ( i , k , jc ) c1 ( i , k , jc ) = Ch ( i - 1 , k , jc ) - Ch ( i - 1 , k , j ) enddo enddo enddo endif endif do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) + Ch ( 1 , k , jc ) c1 ( 1 , k , jc ) = Ch ( 1 , k , jc ) - Ch ( 1 , k , j ) enddo enddo ! ar1 = 1.0_rk ai1 = 0.0_rk do l = 2 , ipph lc = ipp2 - l ar1h = dcp * ar1 - dsp * ai1 ai1 = dcp * ai1 + dsp * ar1 ar1 = ar1h do ik = 1 , Idl1 Ch2 ( ik , l ) = c2 ( ik , 1 ) + ar1 * c2 ( ik , 2 ) Ch2 ( ik , lc ) = ai1 * c2 ( ik , Ip ) enddo dc2 = ar1 ds2 = ai1 ar2 = ar1 ai2 = ai1 do j = 3 , ipph jc = ipp2 - j ar2h = dc2 * ar2 - ds2 * ai2 ai2 = dc2 * ai2 + ds2 * ar2 ar2 = ar2h do ik = 1 , Idl1 Ch2 ( ik , l ) = Ch2 ( ik , l ) + ar2 * c2 ( ik , j ) Ch2 ( ik , lc ) = Ch2 ( ik , lc ) + ai2 * c2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + c2 ( ik , j ) enddo enddo ! if ( Ido < l1 ) then do i = 1 , Ido do k = 1 , l1 Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo else do k = 1 , l1 do i = 1 , Ido Cc ( i , 1 , k ) = Ch ( i , k , 1 ) enddo enddo endif do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 Cc ( Ido , j2 - 2 , k ) = Ch ( 1 , k , j ) Cc ( 1 , j2 - 1 , k ) = Ch ( 1 , k , jc ) enddo enddo if ( Ido == 1 ) return if ( nbd < l1 ) then do j = 2 , ipph jc = ipp2 - j j2 = j + j do i = 3 , Ido , 2 ic = idp2 - i do k = 1 , l1 Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo else do j = 2 , ipph jc = ipp2 - j j2 = j + j do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i Cc ( i - 1 , j2 - 1 , k ) = Ch ( i - 1 , k , j ) + Ch ( i - 1 , k , jc ) Cc ( ic - 1 , j2 - 2 , k ) = Ch ( i - 1 , k , j ) - Ch ( i - 1 , k , jc ) Cc ( i , j2 - 1 , k ) = Ch ( i , k , j ) + Ch ( i , k , jc ) Cc ( ic , j2 - 2 , k ) = Ch ( i , k , jc ) - Ch ( i , k , j ) enddo enddo enddo end if end subroutine radfg","tags":"","loc":"sourcefile/radfg.f90.html"},{"title":"dsinti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinti Source Code dsinti.f90 Source Code subroutine dsinti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , Wsave integer :: k , n , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 1 ) return ns2 = n / 2 np1 = n + 1 dt = pi / real ( np1 , rk ) do k = 1 , ns2 Wsave ( k ) = 2.0_rk * sin ( k * dt ) enddo call dffti ( np1 , Wsave ( ns2 + 1 )) end subroutine dsinti","tags":"","loc":"sourcefile/dsinti.f90.html"},{"title":"dzffti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dzffti Source Code dzffti.f90 Source Code subroutine dzffti ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) if ( n == 1 ) return call ezfft1 ( n , Wsave ( 2 * n + 1 ), Wsave ( 3 * n + 1 )) end subroutine dzffti","tags":"","loc":"sourcefile/dzffti.f90.html"},{"title":"passf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf Source Code passf.f90 Source Code subroutine passf ( Nac , Ido , Ip , l1 , Idl1 , Cc , c1 , c2 , Ch , Ch2 , Wa ) use fftpack_kind implicit none real ( rk ) :: c1 , c2 , Cc , Ch , Ch2 , Wa , wai , war integer :: i , idij , idj , idl , Idl1 , idlj , Ido , idot , idp , & ik , inc , Ip , ipp2 , ipph , j , jc , k , l , l1 , lc integer :: Nac , nt dimension Ch ( Ido , l1 , Ip ) , Cc ( Ido , Ip , l1 ) , c1 ( Ido , l1 , Ip ) , Wa ( * ) , & & c2 ( Idl1 , Ip ) , Ch2 ( Idl1 , Ip ) idot = Ido / 2 nt = Ip * Idl1 ipp2 = Ip + 2 ipph = ( Ip + 1 ) / 2 idp = Ip * Ido ! if ( Ido < l1 ) then do j = 2 , ipph jc = ipp2 - j do i = 1 , Ido do k = 1 , l1 Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do i = 1 , Ido do k = 1 , l1 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo else do j = 2 , ipph jc = ipp2 - j do k = 1 , l1 do i = 1 , Ido Ch ( i , k , j ) = Cc ( i , j , k ) + Cc ( i , jc , k ) Ch ( i , k , jc ) = Cc ( i , j , k ) - Cc ( i , jc , k ) enddo enddo enddo do k = 1 , l1 do i = 1 , Ido Ch ( i , k , 1 ) = Cc ( i , 1 , k ) enddo enddo endif idl = 2 - Ido inc = 0 do l = 2 , ipph lc = ipp2 - l idl = idl + Ido do ik = 1 , Idl1 c2 ( ik , l ) = Ch2 ( ik , 1 ) + Wa ( idl - 1 ) * Ch2 ( ik , 2 ) c2 ( ik , lc ) = - Wa ( idl ) * Ch2 ( ik , Ip ) enddo idlj = idl inc = inc + Ido do j = 3 , ipph jc = ipp2 - j idlj = idlj + inc if ( idlj > idp ) idlj = idlj - idp war = Wa ( idlj - 1 ) wai = Wa ( idlj ) do ik = 1 , Idl1 c2 ( ik , l ) = c2 ( ik , l ) + war * Ch2 ( ik , j ) c2 ( ik , lc ) = c2 ( ik , lc ) - wai * Ch2 ( ik , jc ) enddo enddo enddo do j = 2 , ipph do ik = 1 , Idl1 Ch2 ( ik , 1 ) = Ch2 ( ik , 1 ) + Ch2 ( ik , j ) enddo enddo do j = 2 , ipph jc = ipp2 - j do ik = 2 , Idl1 , 2 Ch2 ( ik - 1 , j ) = c2 ( ik - 1 , j ) - c2 ( ik , jc ) Ch2 ( ik - 1 , jc ) = c2 ( ik - 1 , j ) + c2 ( ik , jc ) Ch2 ( ik , j ) = c2 ( ik , j ) + c2 ( ik - 1 , jc ) Ch2 ( ik , jc ) = c2 ( ik , j ) - c2 ( ik - 1 , jc ) enddo enddo Nac = 1 if ( Ido == 2 ) return Nac = 0 do ik = 1 , Idl1 c2 ( ik , 1 ) = Ch2 ( ik , 1 ) enddo do j = 2 , Ip do k = 1 , l1 c1 ( 1 , k , j ) = Ch ( 1 , k , j ) c1 ( 2 , k , j ) = Ch ( 2 , k , j ) enddo enddo if ( idot > l1 ) then idj = 2 - Ido do j = 2 , Ip idj = idj + Ido do k = 1 , l1 idij = idj do i = 4 , Ido , 2 idij = idij + 2 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) & * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) & * Ch ( i - 1 , k , j ) enddo enddo enddo else idij = 0 do j = 2 , Ip idij = idij + 2 do i = 4 , Ido , 2 idij = idij + 2 do k = 1 , l1 c1 ( i - 1 , k , j ) = Wa ( idij - 1 ) * Ch ( i - 1 , k , j ) + Wa ( idij ) * Ch ( i , k , j ) c1 ( i , k , j ) = Wa ( idij - 1 ) * Ch ( i , k , j ) - Wa ( idij ) * Ch ( i - 1 , k , j ) enddo enddo enddo end if end subroutine passf","tags":"","loc":"sourcefile/passf.f90.html"},{"title":"sint1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines sint1 Source Code sint1.f90 Source Code subroutine sint1 ( n , War , Was , Xh , x , Ifac ) use fftpack_kind implicit none integer :: i , Ifac , k , kc , modn , n , np1 , ns2 real ( rk ) :: t1 , t2 , War , Was , x , Xh , xhold dimension War ( * ) , Was ( * ) , x ( * ) , Xh ( * ) , Ifac ( * ) real ( rk ), parameter :: sqrt3 = sqrt ( 3.0_rk ) do i = 1 , n Xh ( i ) = War ( i ) War ( i ) = x ( i ) enddo if ( n < 2 ) then Xh ( 1 ) = Xh ( 1 ) + Xh ( 1 ) elseif ( n == 2 ) then xhold = sqrt3 * ( Xh ( 1 ) + Xh ( 2 )) Xh ( 2 ) = sqrt3 * ( Xh ( 1 ) - Xh ( 2 )) Xh ( 1 ) = xhold else np1 = n + 1 ns2 = n / 2 x ( 1 ) = 0.0_rk do k = 1 , ns2 kc = np1 - k t1 = Xh ( k ) - Xh ( kc ) t2 = Was ( k ) * ( Xh ( k ) + Xh ( kc )) x ( k + 1 ) = t1 + t2 x ( kc + 1 ) = t2 - t1 enddo modn = mod ( n , 2 ) if ( modn /= 0 ) x ( ns2 + 2 ) = 4.0_rk * Xh ( ns2 + 1 ) call rfftf1 ( np1 , x , Xh , War , Ifac ) Xh ( 1 ) = 0.5_rk * x ( 1 ) do i = 3 , n , 2 Xh ( i - 1 ) = - x ( i ) Xh ( i ) = Xh ( i - 2 ) + x ( i - 1 ) enddo if ( modn == 0 ) Xh ( n ) = - x ( n + 1 ) endif do i = 1 , n x ( i ) = War ( i ) War ( i ) = Xh ( i ) enddo end subroutine sint1","tags":"","loc":"sourcefile/sint1.f90.html"},{"title":"dsinqf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinqf Source Code dsinqf.f90 Source Code subroutine dsinqf ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n == 1 ) return ns2 = n / 2 do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo call dcosqf ( n , x , Wsave ) do k = 2 , n , 2 x ( k ) = - x ( k ) enddo end subroutine dsinqf","tags":"","loc":"sourcefile/dsinqf.f90.html"},{"title":"dsinqi.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinqi Source Code dsinqi.f90 Source Code subroutine dsinqi ( n , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave dimension Wsave ( * ) call dcosqi ( n , Wsave ) end subroutine dsinqi","tags":"","loc":"sourcefile/dsinqi.f90.html"},{"title":"rk.f90 – Fortran-lang/fftpack","text":"Contents Modules fftpack_kind Source Code rk.f90 Source Code module fftpack_kind implicit none integer , parameter :: rk = kind ( 1.0d0 ) end module fftpack_kind","tags":"","loc":"sourcefile/rk.f90.html"},{"title":"passb4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passb4 Source Code passb4.f90 Source Code subroutine passb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , tr4 , & & Wa1 , Wa2 , Wa3 integer :: i , Ido , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 ti1 = Cc ( i , 1 , k ) - Cc ( i , 3 , k ) ti2 = Cc ( i , 1 , k ) + Cc ( i , 3 , k ) ti3 = Cc ( i , 2 , k ) + Cc ( i , 4 , k ) tr4 = Cc ( i , 4 , k ) - Cc ( i , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( i - 1 , 3 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( i - 1 , 3 , k ) ti4 = Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 4 , k ) tr3 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 4 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 + tr4 cr4 = tr1 - tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * cr2 - Wa1 ( i ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * ci2 + Wa1 ( i ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * cr3 - Wa2 ( i ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * ci3 + Wa2 ( i ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 1 ) * cr4 - Wa3 ( i ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 1 ) * ci4 + Wa3 ( i ) * cr4 enddo enddo else do k = 1 , l1 ti1 = Cc ( 2 , 1 , k ) - Cc ( 2 , 3 , k ) ti2 = Cc ( 2 , 1 , k ) + Cc ( 2 , 3 , k ) tr4 = Cc ( 2 , 4 , k ) - Cc ( 2 , 2 , k ) ti3 = Cc ( 2 , 2 , k ) + Cc ( 2 , 4 , k ) tr1 = Cc ( 1 , 1 , k ) - Cc ( 1 , 3 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( 1 , 3 , k ) ti4 = Cc ( 1 , 2 , k ) - Cc ( 1 , 4 , k ) tr3 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 2 , k , 1 ) = ti2 + ti3 Ch ( 2 , k , 3 ) = ti2 - ti3 Ch ( 1 , k , 2 ) = tr1 + tr4 Ch ( 1 , k , 4 ) = tr1 - tr4 Ch ( 2 , k , 2 ) = ti1 + ti4 Ch ( 2 , k , 4 ) = ti1 - ti4 enddo end if end subroutine passb4","tags":"","loc":"sourcefile/passb4.f90.html"},{"title":"dcosqi.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosqi Source Code dcosqi.f90 Source Code subroutine dcosqi ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , n dimension Wsave ( * ) real ( rk ), parameter :: pih = acos ( - 1.0_rk ) / 2.0_rk ! pi / 2 dt = pih / real ( n , rk ) fk = 0.0_rk do k = 1 , n fk = fk + 1.0_rk Wsave ( k ) = cos ( fk * dt ) enddo call dffti ( n , Wsave ( n + 1 )) end subroutine dcosqi","tags":"","loc":"sourcefile/dcosqi.f90.html"},{"title":"fftpack_ifft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_ifft Source Code fftpack_ifft.f90 Source Code submodule ( fftpack ) fftpack_ifft contains !> Backward transform of a complex periodic sequence. pure module function ifft_rk ( x , n ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n complex ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , (( 0.0_rk , 0.0_rk ), i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 4 * lenseq + 15 allocate ( wsave ( lensav )) call zffti ( lenseq , wsave ) !> Backward transformation call zfftb ( lenseq , result , wsave ) end function ifft_rk end submodule fftpack_ifft","tags":"","loc":"sourcefile/fftpack_ifft.f90.html"},{"title":"cfftf1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cfftf1 Source Code cfftf1.f90 Source Code subroutine cfftf1 ( n , c , Ch , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: c , Ch , Wa integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 , & k1 , l1 , l2 , n , n2 , na , nac , nf dimension Ch ( * ) , c ( * ) , Wa ( * ) , Ifac ( * ) nf = Ifac ( 2 ) na = 0 l1 = 1 iw = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) l2 = ip * l1 ido = n / l2 idot = ido + ido idl1 = idot * l1 if ( ip == 4 ) then ix2 = iw + idot ix3 = ix2 + idot if ( na /= 0 ) then call passf4 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) else call passf4 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 )) endif na = 1 - na elseif ( ip == 2 ) then if ( na /= 0 ) then call passf2 ( idot , l1 , Ch , c , Wa ( iw )) else call passf2 ( idot , l1 , c , Ch , Wa ( iw )) endif na = 1 - na elseif ( ip == 3 ) then ix2 = iw + idot if ( na /= 0 ) then call passf3 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 )) else call passf3 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 )) endif na = 1 - na elseif ( ip /= 5 ) then if ( na /= 0 ) then call passf ( nac , idot , ip , l1 , idl1 , Ch , Ch , Ch , c , c , Wa ( iw )) else call passf ( nac , idot , ip , l1 , idl1 , c , c , c , Ch , Ch , Wa ( iw )) endif if ( nac /= 0 ) na = 1 - na else ix2 = iw + idot ix3 = ix2 + idot ix4 = ix3 + idot if ( na /= 0 ) then call passf5 ( idot , l1 , Ch , c , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) else call passf5 ( idot , l1 , c , Ch , Wa ( iw ), Wa ( ix2 ), Wa ( ix3 ), Wa ( ix4 )) endif na = 1 - na endif l1 = l2 iw = iw + ( ip - 1 ) * idot enddo if ( na == 0 ) return n2 = n + n do i = 1 , n2 c ( i ) = Ch ( i ) enddo end subroutine cfftf1","tags":"","loc":"sourcefile/cfftf1.f90.html"},{"title":"fftpack_utils.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_utils Source Code fftpack_utils.f90 Source Code submodule ( fftpack ) fftpack_utils contains !> Returns an integer array with the frequency values involved in the !> performed FFT, ordered in the standard way (zero first, then positive !> frequencies, then the negative ones). pure module function fftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out integer :: i out ( 1 ) = 0 if ( n == 1 ) return if ( mod ( n , 2 ) == 0 ) then ! n even, smallest n = 2 do i = 2 , n / 2 out ( i ) = i - 1 end do out ( n / 2 + 1 ) = - n / 2 do i = n / 2 + 2 , n ! only enters if n/2+2 <= n out ( i ) = out ( i - 1 ) + 1 end do else ! n odd, smallest n = 3 do i = 2 , n / 2 + 1 out ( i ) = i - 1 end do out ( n / 2 + 2 ) = - out ( n / 2 + 1 ) do i = n / 2 + 3 , n ! only enters if n/2+3 <= n out ( i ) = out ( i - 1 ) + 1 end do end if end function fftfreq !> Returns an integer array with the frequency values involved in the !> performed real FFT, ordered in the standard way (zero first, then !> positive frequencies, then, if applicable, the negative one). pure module function rfftfreq ( n ) result ( out ) integer , intent ( in ) :: n integer , dimension ( n ) :: out integer :: i out ( 1 ) = 0 if ( n == 1 ) return if ( mod ( n , 2 ) == 0 ) then ! n even, smallest n = 2 do i = 2 , n - 2 , 2 out ( i ) = out ( i - 1 ) + 1 out ( i + 1 ) = out ( i ) end do out ( n ) = - n / 2 else ! n odd, smallest n = 3 do i = 2 , n - 1 , 2 out ( i ) = out ( i - 1 ) + 1 out ( i + 1 ) = out ( i ) end do end if end function rfftfreq end submodule fftpack_utils","tags":"","loc":"sourcefile/fftpack_utils.f90.html"},{"title":"dcosqb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosqb Source Code dcosqb.f90 Source Code subroutine dcosqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: Wsave , x , x1 dimension x ( * ) , Wsave ( * ) real ( rk ), parameter :: tsqrt2 = 2.0_rk * sqrt ( 2.0_rk ) if ( n < 2 ) then x ( 1 ) = 4.0_rk * x ( 1 ) return elseif ( n == 2 ) then x1 = 4.0_rk * ( x ( 1 ) + x ( 2 )) x ( 2 ) = tsqrt2 * ( x ( 1 ) - x ( 2 )) x ( 1 ) = x1 return else call cosqb1 ( n , x , Wsave , Wsave ( n + 1 )) endif end subroutine dcosqb","tags":"","loc":"sourcefile/dcosqb.f90.html"},{"title":"fftpack_ifftshift.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_ifftshift Source Code fftpack_ifftshift.f90 Source Code submodule ( fftpack ) fftpack_ifftshift contains !> Shifts zero-frequency component to beginning of spectrum for `complex` type. pure module function ifftshift_crk ( x ) result ( result ) complex ( kind = rk ), intent ( in ) :: x (:) complex ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- ceiling ( 0.5_rk * size ( x ))) end function ifftshift_crk !> Shifts zero-frequency component to beginning of spectrum for `real` type. pure module function ifftshift_rrk ( x ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) real ( kind = rk ), dimension ( size ( x )) :: result result = cshift ( x , shift =- ceiling ( 0.5_rk * size ( x ))) end function ifftshift_rrk end submodule fftpack_ifftshift","tags":"","loc":"sourcefile/fftpack_ifftshift.f90.html"},{"title":"ezfft1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines ezfft1 Source Code ezfft1.f90 Source Code subroutine ezfft1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg1 , argh , ch1 , ch1h , dch1 , dsh1 , sh1 , & Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) l2 = l1 * ip ido = n / l2 ipm = ip - 1 arg1 = real ( l1 , rk ) * argh ch1 = 1.0_rk sh1 = 0.0_rk dch1 = cos ( arg1 ) dsh1 = sin ( arg1 ) do j = 1 , ipm ch1h = dch1 * ch1 - dsh1 * sh1 sh1 = dch1 * sh1 + dsh1 * ch1 ch1 = ch1h i = is + 2 Wa ( i - 1 ) = ch1 Wa ( i ) = sh1 if ( ido >= 5 ) then do ii = 5 , ido , 2 i = i + 2 Wa ( i - 1 ) = ch1 * Wa ( i - 3 ) - sh1 * Wa ( i - 2 ) Wa ( i ) = ch1 * Wa ( i - 2 ) + sh1 * Wa ( i - 3 ) enddo endif is = is + ido enddo l1 = l2 enddo end subroutine ezfft1","tags":"","loc":"sourcefile/ezfft1.f90.html"},{"title":"dsinqb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dsinqb Source Code dsinqb.f90 Source Code subroutine dsinqb ( n , x , Wsave ) use fftpack_kind implicit none integer :: k , kc , n , ns2 real ( rk ) :: Wsave , x , xhold dimension x ( * ) , Wsave ( * ) if ( n > 1 ) then ns2 = n / 2 do k = 2 , n , 2 x ( k ) = - x ( k ) enddo call dcosqb ( n , x , Wsave ) do k = 1 , ns2 kc = n - k xhold = x ( k ) x ( k ) = x ( kc + 1 ) x ( kc + 1 ) = xhold enddo return endif x ( 1 ) = 4.0_rk * x ( 1 ) return end subroutine dsinqb","tags":"","loc":"sourcefile/dsinqb.f90.html"},{"title":"passf3.f90 – Fortran-lang/fftpack","text":"Contents Subroutines passf3 Source Code passf3.f90 Source Code subroutine passf3 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , cr2 , cr3 , di2 , di3 , & & dr2 , dr3 , ti2 , tr2 , Wa1 , Wa2 integer :: i , Ido , k , l1 dimension Cc ( Ido , 3 , l1 ) , Ch ( Ido , l1 , 3 ) , Wa1 ( * ) , Wa2 ( * ) real ( rk ), parameter :: taur = - 0.5_rk real ( rk ), parameter :: taui = - sqrt ( 3.0_rk ) / 2.0_rk if ( Ido /= 2 ) then do k = 1 , l1 do i = 2 , Ido , 2 tr2 = Cc ( i - 1 , 2 , k ) + Cc ( i - 1 , 3 , k ) cr2 = Cc ( i - 1 , 1 , k ) + taur * tr2 Ch ( i - 1 , k , 1 ) = Cc ( i - 1 , 1 , k ) + tr2 ti2 = Cc ( i , 2 , k ) + Cc ( i , 3 , k ) ci2 = Cc ( i , 1 , k ) + taur * ti2 Ch ( i , k , 1 ) = Cc ( i , 1 , k ) + ti2 cr3 = taui * ( Cc ( i - 1 , 2 , k ) - Cc ( i - 1 , 3 , k )) ci3 = taui * ( Cc ( i , 2 , k ) - Cc ( i , 3 , k )) dr2 = cr2 - ci3 dr3 = cr2 + ci3 di2 = ci2 + cr3 di3 = ci2 - cr3 Ch ( i , k , 2 ) = Wa1 ( i - 1 ) * di2 - Wa1 ( i ) * dr2 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 1 ) * dr2 + Wa1 ( i ) * di2 Ch ( i , k , 3 ) = Wa2 ( i - 1 ) * di3 - Wa2 ( i ) * dr3 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 1 ) * dr3 + Wa2 ( i ) * di3 enddo enddo else do k = 1 , l1 tr2 = Cc ( 1 , 2 , k ) + Cc ( 1 , 3 , k ) cr2 = Cc ( 1 , 1 , k ) + taur * tr2 Ch ( 1 , k , 1 ) = Cc ( 1 , 1 , k ) + tr2 ti2 = Cc ( 2 , 2 , k ) + Cc ( 2 , 3 , k ) ci2 = Cc ( 2 , 1 , k ) + taur * ti2 Ch ( 2 , k , 1 ) = Cc ( 2 , 1 , k ) + ti2 cr3 = taui * ( Cc ( 1 , 2 , k ) - Cc ( 1 , 3 , k )) ci3 = taui * ( Cc ( 2 , 2 , k ) - Cc ( 2 , 3 , k )) Ch ( 1 , k , 2 ) = cr2 - ci3 Ch ( 1 , k , 3 ) = cr2 + ci3 Ch ( 2 , k , 2 ) = ci2 + cr3 Ch ( 2 , k , 3 ) = ci2 - cr3 enddo end if end subroutine passf3","tags":"","loc":"sourcefile/passf3.f90.html"},{"title":"dfftf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dfftf Source Code dfftf.f90 Source Code subroutine dfftf ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftf1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftf","tags":"","loc":"sourcefile/dfftf.f90.html"},{"title":"dcosti.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dcosti Source Code dcosti.f90 Source Code subroutine dcosti ( n , Wsave ) use fftpack_kind implicit none real ( rk ) :: dt , fk , Wsave integer :: k , kc , n , nm1 , np1 , ns2 dimension Wsave ( * ) real ( rk ), parameter :: pi = acos ( - 1.0_rk ) if ( n <= 3 ) return nm1 = n - 1 np1 = n + 1 ns2 = n / 2 dt = pi / real ( nm1 , rk ) fk = 0.0_rk do k = 2 , ns2 kc = np1 - k fk = fk + 1.0_rk Wsave ( k ) = 2.0_rk * sin ( fk * dt ) Wsave ( kc ) = 2.0_rk * cos ( fk * dt ) enddo call dffti ( nm1 , Wsave ( n + 1 )) end subroutine dcosti","tags":"","loc":"sourcefile/dcosti.f90.html"},{"title":"dfftb.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dfftb Source Code dfftb.f90 Source Code subroutine dfftb ( n , r , Wsave ) use fftpack_kind implicit none integer :: n real ( rk ) :: r , Wsave dimension r ( * ) , Wsave ( * ) if ( n == 1 ) return call rfftb1 ( n , r , Wsave , Wsave ( n + 1 ), Wsave ( 2 * n + 1 )) end subroutine dfftb","tags":"","loc":"sourcefile/dfftb.f90.html"},{"title":"cosqb1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cosqb1 Source Code cosqb1.f90 Source Code subroutine cosqb1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do i = 3 , n , 2 xim1 = x ( i - 1 ) + x ( i ) x ( i ) = x ( i ) - x ( i - 1 ) x ( i - 1 ) = xim1 enddo x ( 1 ) = x ( 1 ) + x ( 1 ) modn = mod ( n , 2 ) if ( modn == 0 ) x ( n ) = x ( n ) + x ( n ) call dfftb ( n , x , Xh ) do k = 2 , ns2 kc = np2 - k Xh ( k ) = w ( k - 1 ) * x ( kc ) + w ( kc - 1 ) * x ( k ) Xh ( kc ) = w ( k - 1 ) * x ( k ) - w ( kc - 1 ) * x ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * ( x ( ns2 + 1 ) + x ( ns2 + 1 )) do k = 2 , ns2 kc = np2 - k x ( k ) = Xh ( k ) + Xh ( kc ) x ( kc ) = Xh ( k ) - Xh ( kc ) enddo x ( 1 ) = x ( 1 ) + x ( 1 ) end subroutine cosqb1","tags":"","loc":"sourcefile/cosqb1.f90.html"},{"title":"rffti1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines rffti1 Source Code rffti1.f90 Source Code subroutine rffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , ib , ido , Ifac , ii , ip , ipm , is , j , k1 , l1 , & l2 , ld , n , nf , nfm1 , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 4 , 2 , 3 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) is = 0 nfm1 = nf - 1 l1 = 1 if ( nfm1 == 0 ) return do k1 = 1 , nfm1 ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 ipm = ip - 1 do j = 1 , ipm ld = ld + l1 i = is argld = real ( ld , rk ) * argh fi = 0.0_rk do ii = 3 , ido , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo is = is + ido enddo l1 = l2 enddo end subroutine rffti1","tags":"","loc":"sourcefile/rffti1.f90.html"},{"title":"dzfftf.f90 – Fortran-lang/fftpack","text":"Contents Subroutines dzfftf Source Code dzfftf.f90 Source Code subroutine dzfftf ( n , r , Azero , a , b , Wsave ) ! ! VERSION 3 JUNE 1979 ! use fftpack_kind implicit none real ( rk ) :: a , Azero , b , cf , cfm , r , Wsave integer :: i , n , ns2 , ns2m dimension r ( * ) , a ( * ) , b ( * ) , Wsave ( * ) if ( n < 2 ) then Azero = r ( 1 ) return elseif ( n == 2 ) then Azero = 0.5_rk * ( r ( 1 ) + r ( 2 )) a ( 1 ) = 0.5_rk * ( r ( 1 ) - r ( 2 )) return else do i = 1 , n Wsave ( i ) = r ( i ) enddo call dfftf ( n , Wsave , Wsave ( n + 1 )) cf = 2.0_rk / real ( n , rk ) cfm = - cf Azero = 0.5_rk * cf * Wsave ( 1 ) ns2 = ( n + 1 ) / 2 ns2m = ns2 - 1 do i = 1 , ns2m a ( i ) = cf * Wsave ( 2 * i ) b ( i ) = cfm * Wsave ( 2 * i + 1 ) enddo if ( mod ( n , 2 ) == 1 ) return a ( ns2 ) = 0.5_rk * cf * Wsave ( n ) b ( ns2 ) = 0.0_rk endif end subroutine dzfftf","tags":"","loc":"sourcefile/dzfftf.f90.html"},{"title":"fftpack_rfft.f90 – Fortran-lang/fftpack","text":"Contents Submodules fftpack_rfft Source Code fftpack_rfft.f90 Source Code submodule ( fftpack ) fftpack_rfft contains !> Forward transform of a real periodic sequence. pure module function rfft_rk ( x , n ) result ( result ) real ( kind = rk ), intent ( in ) :: x (:) integer , intent ( in ), optional :: n real ( kind = rk ), allocatable :: result (:) integer :: lenseq , lensav , i real ( kind = rk ), allocatable :: wsave (:) if ( present ( n )) then lenseq = n if ( lenseq <= size ( x )) then result = x (: lenseq ) else if ( lenseq > size ( x )) then result = [ x , ( 0.0_rk , i = 1 , lenseq - size ( x ))] end if else lenseq = size ( x ) result = x end if !> Initialize FFT lensav = 2 * lenseq + 15 allocate ( wsave ( lensav )) call dffti ( lenseq , wsave ) !> Forward transformation call dfftf ( lenseq , result , wsave ) end function rfft_rk end submodule fftpack_rfft","tags":"","loc":"sourcefile/fftpack_rfft.f90.html"},{"title":"cffti1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cffti1 Source Code cffti1.f90 Source Code subroutine cffti1 ( n , Wa , Ifac ) use fftpack_kind implicit none real ( rk ) :: arg , argh , argld , fi , Wa integer :: i , i1 , ib , ido , idot , Ifac , ii , ip , ipm , j , k1 , & l1 , l2 , ld , n , nf , nl , nq , nr , ntry dimension Wa ( * ) , Ifac ( * ) integer , dimension ( 4 ), parameter :: ntryh = [ 3 , 4 , 2 , 5 ] real ( rk ), parameter :: tpi = 2.0_rk * acos ( - 1.0_rk ) ! 2 * pi nl = n nf = 0 j = 0 100 j = j + 1 if ( j <= 4 ) then ntry = ntryh ( j ) else ntry = ntry + 2 endif 200 nq = nl / ntry nr = nl - ntry * nq if ( nr /= 0 ) goto 100 nf = nf + 1 Ifac ( nf + 2 ) = ntry nl = nq if ( ntry == 2 ) then if ( nf /= 1 ) then do i = 2 , nf ib = nf - i + 2 Ifac ( ib + 2 ) = Ifac ( ib + 1 ) enddo Ifac ( 3 ) = 2 endif endif if ( nl /= 1 ) goto 200 Ifac ( 1 ) = n Ifac ( 2 ) = nf argh = tpi / real ( n , rk ) i = 2 l1 = 1 do k1 = 1 , nf ip = Ifac ( k1 + 2 ) ld = 0 l2 = l1 * ip ido = n / l2 idot = ido + ido + 2 ipm = ip - 1 do j = 1 , ipm i1 = i Wa ( i - 1 ) = 1.0_rk Wa ( i ) = 0.0_rk ld = ld + l1 fi = 0.0_rk argld = real ( ld , rk ) * argh do ii = 4 , idot , 2 i = i + 2 fi = fi + 1.0_rk arg = fi * argld Wa ( i - 1 ) = cos ( arg ) Wa ( i ) = sin ( arg ) enddo if ( ip > 5 ) then Wa ( i1 - 1 ) = Wa ( i - 1 ) Wa ( i1 ) = Wa ( i ) endif enddo l1 = l2 enddo end subroutine cffti1","tags":"","loc":"sourcefile/cffti1.f90.html"},{"title":"radb4.f90 – Fortran-lang/fftpack","text":"Contents Subroutines radb4 Source Code radb4.f90 Source Code subroutine radb4 ( Ido , l1 , Cc , Ch , Wa1 , Wa2 , Wa3 ) use fftpack_kind implicit none real ( rk ) :: Cc , Ch , ci2 , ci3 , ci4 , cr2 , cr3 , cr4 , & ti1 , ti2 , ti3 , ti4 , tr1 , tr2 , tr3 , & tr4 , Wa1 , Wa2 , Wa3 integer :: i , ic , Ido , idp2 , k , l1 dimension Cc ( Ido , 4 , l1 ) , Ch ( Ido , l1 , 4 ) , Wa1 ( * ) , Wa2 ( * ) , Wa3 ( * ) real ( rk ), parameter :: sqrt2 = sqrt ( 2.0_rk ) do k = 1 , l1 tr1 = Cc ( 1 , 1 , k ) - Cc ( Ido , 4 , k ) tr2 = Cc ( 1 , 1 , k ) + Cc ( Ido , 4 , k ) tr3 = Cc ( Ido , 2 , k ) + Cc ( Ido , 2 , k ) tr4 = Cc ( 1 , 3 , k ) + Cc ( 1 , 3 , k ) Ch ( 1 , k , 1 ) = tr2 + tr3 Ch ( 1 , k , 2 ) = tr1 - tr4 Ch ( 1 , k , 3 ) = tr2 - tr3 Ch ( 1 , k , 4 ) = tr1 + tr4 enddo if ( Ido < 2 ) return if ( Ido /= 2 ) then idp2 = Ido + 2 do k = 1 , l1 do i = 3 , Ido , 2 ic = idp2 - i ti1 = Cc ( i , 1 , k ) + Cc ( ic , 4 , k ) ti2 = Cc ( i , 1 , k ) - Cc ( ic , 4 , k ) ti3 = Cc ( i , 3 , k ) - Cc ( ic , 2 , k ) tr4 = Cc ( i , 3 , k ) + Cc ( ic , 2 , k ) tr1 = Cc ( i - 1 , 1 , k ) - Cc ( ic - 1 , 4 , k ) tr2 = Cc ( i - 1 , 1 , k ) + Cc ( ic - 1 , 4 , k ) ti4 = Cc ( i - 1 , 3 , k ) - Cc ( ic - 1 , 2 , k ) tr3 = Cc ( i - 1 , 3 , k ) + Cc ( ic - 1 , 2 , k ) Ch ( i - 1 , k , 1 ) = tr2 + tr3 cr3 = tr2 - tr3 Ch ( i , k , 1 ) = ti2 + ti3 ci3 = ti2 - ti3 cr2 = tr1 - tr4 cr4 = tr1 + tr4 ci2 = ti1 + ti4 ci4 = ti1 - ti4 Ch ( i - 1 , k , 2 ) = Wa1 ( i - 2 ) * cr2 - Wa1 ( i - 1 ) * ci2 Ch ( i , k , 2 ) = Wa1 ( i - 2 ) * ci2 + Wa1 ( i - 1 ) * cr2 Ch ( i - 1 , k , 3 ) = Wa2 ( i - 2 ) * cr3 - Wa2 ( i - 1 ) * ci3 Ch ( i , k , 3 ) = Wa2 ( i - 2 ) * ci3 + Wa2 ( i - 1 ) * cr3 Ch ( i - 1 , k , 4 ) = Wa3 ( i - 2 ) * cr4 - Wa3 ( i - 1 ) * ci4 Ch ( i , k , 4 ) = Wa3 ( i - 2 ) * ci4 + Wa3 ( i - 1 ) * cr4 enddo enddo if ( mod ( Ido , 2 ) == 1 ) return endif do k = 1 , l1 ti1 = Cc ( 1 , 2 , k ) + Cc ( 1 , 4 , k ) ti2 = Cc ( 1 , 4 , k ) - Cc ( 1 , 2 , k ) tr1 = Cc ( Ido , 1 , k ) - Cc ( Ido , 3 , k ) tr2 = Cc ( Ido , 1 , k ) + Cc ( Ido , 3 , k ) Ch ( Ido , k , 1 ) = tr2 + tr2 Ch ( Ido , k , 2 ) = sqrt2 * ( tr1 - ti1 ) Ch ( Ido , k , 3 ) = ti2 + ti2 Ch ( Ido , k , 4 ) = - sqrt2 * ( tr1 + ti1 ) enddo end subroutine radb4","tags":"","loc":"sourcefile/radb4.f90.html"},{"title":"cosqf1.f90 – Fortran-lang/fftpack","text":"Contents Subroutines cosqf1 Source Code cosqf1.f90 Source Code subroutine cosqf1 ( n , x , w , Xh ) use fftpack_kind implicit none integer :: i , k , kc , modn , n , np2 , ns2 real ( rk ) :: w , x , Xh , xim1 dimension x ( * ) , w ( * ) , Xh ( * ) ns2 = ( n + 1 ) / 2 np2 = n + 2 do k = 2 , ns2 kc = np2 - k Xh ( k ) = x ( k ) + x ( kc ) Xh ( kc ) = x ( k ) - x ( kc ) enddo modn = mod ( n , 2 ) if ( modn == 0 ) Xh ( ns2 + 1 ) = x ( ns2 + 1 ) + x ( ns2 + 1 ) do k = 2 , ns2 kc = np2 - k x ( k ) = w ( k - 1 ) * Xh ( kc ) + w ( kc - 1 ) * Xh ( k ) x ( kc ) = w ( k - 1 ) * Xh ( k ) - w ( kc - 1 ) * Xh ( kc ) enddo if ( modn == 0 ) x ( ns2 + 1 ) = w ( ns2 ) * Xh ( ns2 + 1 ) call dfftf ( n , x , Xh ) do i = 3 , n , 2 xim1 = x ( i - 1 ) - x ( i ) x ( i ) = x ( i - 1 ) + x ( i ) x ( i - 1 ) = xim1 enddo end subroutine cosqf1","tags":"","loc":"sourcefile/cosqf1.f90.html"},{"title":"Contributing and specs – Fortran-lang/fftpack","text":"Warning This page is currently under construction!","tags":"","loc":"page/index.html"},{"title":"Specifications (specs) – Fortran-lang/fftpack","text":"Fortran fftpack Specifications (specs) Fortran fftpack Specifications (specs) Experimental Features & Modules Released/Stable Features & Modules Experimental Features & Modules fftpack - fftpack module. fftpack_kind - fftpack_kind module. Released/Stable Features & Modules (None yet)","tags":"","loc":"page/specs/index.html"},{"title":"FFTPACK – Fortran-lang/fftpack","text":"Discrete Fourier transform (DFT) of complex data zffti Description Status Class Syntax Argument Warning Example zfftf Description Status Class Syntax Argument Warning Example zfftb Description Status Class Syntax Argument Warning Example fft Description Status Class Syntax Argument Return value Notes Example ifft Description Status Class Syntax Argument Return value Example Discrete Fourier transform (DFT) of real data dffti Description Status Class Syntax Argument Warning Example dfftf Description Status Class Syntax Argument Warning Example dfftb Description Status Class Syntax Argument Warning Example rfft Description Status Class Syntax Argument Return value Notes Example irfft Description Status Class Syntax Argument Return value Example Simplified discrete Fourier transform (DFT) of real data dzffti Description Status Class Syntax Arguments Warning Example dzfftf Description Status Class Syntax Arguments Example dzfftb Description Status Class Syntax Arguments Example Discrete cosine transforms (DCT) DCT type-1 (DCT-1) Initialize DCT-1: dcosti or dct_t1i Description Status Class Syntax Arguments Example Compute DCT-1: dcost or dct_t1 Description Status Class Syntax Arguments Example DCT of types 2, 3 (DCT-2, 3), a.k.a \"Quarter\" cosine transforms Initialize DCT-2, 3: dcosqi or dct_t23i Description Status Class Syntax Arguments Example Compute DCT-3: dcosqf or dct_t3 Description Status Class Syntax Arguments Example Compute DCT-2: dcosqb or dct_t2 Description Status Class Syntax Arguments Example Simplified DCT of types 1, 2, 3: dct Description Status Class Syntax Argument Return value Notes Example Simplified inverse DCT of types 1, 2, 3: idct Description Status Class Syntax Argument Return value Notes Example References Utility functions fftshift Description Status Class Syntax Argument Return value Example ifftshift Description Status Class Syntax Argument Return value Example fftfreq Description Status Class Syntax Argument Return value Example rfftfreq Description Status Class Syntax Argument Return value Example Discrete Fourier transform (DFT) of complex data zffti Description Initializes the array wsave which is used in both zfftf and zfftb . The prime factorization of n together with a tabulation of the trigonometric functions are computed and\nstored in wsave . Status Experimental. Class Pure subroutine. Syntax call zffti (n, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. wsave : Shall be a real array.\nThis argument is intent(out) . A work array which must be dimensioned at least 4*n+15 .\nThe same work array can be used for both zfftf and zfftb as long as n remains unchanged. Different wsave arrays\nare required for different values of n . Warning The contents of wsave must not be changed between calls of zfftf or zfftb . Example program demo_zffti use fftpack , only : zffti complex ( kind = 8 ) :: x ( 4 ) = [ 1.0 , 2.0 , 3.0 , 4.0 ] real ( kind = 8 ) :: w ( 31 ) call zffti ( 4 , w ) end program demo_zffti zfftf Description Computes the forward complex discrete fourier transform (the fourier analysis). Equivalently, zfftf computes the fourier coefficients of a complex periodic sequence.\nThe transform is defined below at output parameter c . The transform is not normalized. To obtain a normalized transform the output must be divided by n . Otherwise a call of zfftf followed by a call of zfftb will multiply the sequence by n . The array wsave which is used by subroutine zfftf must be initialized by calling subroutine zffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call zfftf (n, c, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the complex sequence c . The method is more efficient when n is the product of small primes. c : Shall be a complex and rank-1 array.\nThis argument is intent(inout) . A complex array of length n which contains the sequence. for j = 1 ,..., n c ( j ) = the sum from k = 1 ,..., n of c ( k ) * exp ( - i * ( j - 1 ) * ( k - 1 ) * 2 * pi / n ) where i = sqrt ( - 1 ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 4n+15 in the program that calls zfftf .\nThe wsave array must be initialized by calling subroutine zffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by zfftf and zfftb . Contains initialization calculations which must not be destroyed between calls of subroutine zfftf or zfftb . Warning The contents of wsave must not be changed between calls of zfftf or zfftb . Example program demo_zfftf use fftpack , only : zffti , zfftf complex ( kind = 8 ) :: x ( 4 ) real ( kind = 8 ) :: w ( 31 ) x = [ real ( kind = 8 ) :: 1.0 , 2.0 , 3.0 , 4.0 ] call zffti ( 4 , w ) call zfftf ( 4 , x , w ) !! `x` returns [(10.0,0.0), (-2.0,2.0), (-2.0,0.0), (-2.0,-2.0)]. end program demo_zfftf zfftb Description Unnormalized inverse of zfftf . Computes the backward complex discrete fourier transform (the fourier synthesis).\nEquivalently, zfftb computes a complex periodic sequence from its fourier coefficients.\nThe transform is defined below at output parameter c . The transform is not normalized. to obtain a normalized transform the output must be divided by n . Otherwise a call of zfftf followed by a call of zfftb will multiply the sequence by n . The array wsave which is used by subroutine zfftf must be initialized by calling subroutine zffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call zfftb (n, c, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the complex sequence c . The method is more efficient when n is the product of small primes. c : Shall be a complex array.\nThis argument is intent(inout) . A complex array of length n which contains the sequence. for j = 1 ,..., n c ( j ) = the sum from k = 1 ,..., n of c ( k ) * exp ( - i * ( j - 1 ) * ( k - 1 ) * 2 * pi / n ) where i = sqrt ( - 1 ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 4n+15 in the program that calls zfftf . The wsave array must be initialized by calling subroutine zffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. The same wsave array can be used by zfftf and zfftb . Contains initialization calculations which must not be destroyed between calls of subroutine zfftf or zfftb . Warning The contents of wsave must not be changed between calls of zfftf or zfftb . Example program demo_zfftb use fftpack , only : zffti , zfftf , zfftb complex ( kind = 8 ) :: x ( 4 ) real ( kind = 8 ) :: w ( 31 ) x = [ real ( kind = 8 ) :: 1.0 , 2.0 , 3.0 , 4.0 ] call zffti ( 4 , w ) call zfftf ( 4 , x , w ) !! `x` returns [(10.0,0.0), (-2.0,2.0), (-2.0,0.0), (-2.0,-2.0)]. call zfftb ( 4 , x , w ) !! `x` returns [(4.0,0.0), (8.0,0.0), (12.0,0.0), (16.0,0.0)]. end program demo_zfftb fft Description Computes the forward complex discrete fourier transform (the fourier analysis). Status Experimental. Class Pure function. Syntax result = fft (x [, n]) Argument x : Shall be a complex and rank-1 array.\nThis argument is intent(in) . n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a complex and rank-1 array, the Discrete Fourier Transform (DFT) of x . Notes Within numerical accuracy, x == ifft(fft(x))/size(x) . Example program demo_fft use fftpack , only : fft complex ( kind = 8 ) :: x ( 4 ) x = [ real ( kind = 8 ) :: 1.0 , 2.0 , 3.0 , 4.0 ] print * , fft ( x ) !! [(10.0,0.0), (-2.0,2.0), (-2.0,0.0), (-2.0,-2.0)]. print * , fft ( x , 3 ) !! [(6.0,0.0), (-1.5,0.86), (-1.5,0.86)]. print * , fft ( x , 5 ) !! [(10.0,0.0), (-4.0,1.3), (1.5,-2.1), (1.5,2.1), (-4.0,1.3)]. end program demo_fft ifft Description Unnormalized inverse of fft . Status Experimental. Class Pure function. Syntax result = ifft (x [, n]) Argument x : Shall be a complex and rank-1 array.\nThis argument is intent(in) . n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a complex and rank-1 array, the unnormalized inverse Discrete Fourier Transform (DFT) of x . Example program demo_ifft use fftpack , only : fft , ifft complex ( kind = 8 ) :: x ( 4 ) = [ 1.0 , 2.0 , 3.0 , 4.0 ] print * , ifft ( fft ( x )) / 4.0 !! [(1.0,0.0), (2.0,0.0), (3.0,0.0), (4.0,0.0)] print * , ifft ( fft ( x ), 3 ) !! [(6.0,2.0), (10.3,-1.0), (13.73,-1.0)] end program demo_ifft Discrete Fourier transform (DFT) of real data dffti Description Initializes the array wsave which is used in both dfftf and dfftb . The prime factorization of n together with a tabulation of the trigonometric functions are computed and\nstored in wsave . Status Experimental. Class Pure subroutine. Syntax call dffti (n, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. wsave : Shall be a real array.\nThis argument is intent(out) . A work array which must be dimensioned at least 2*n+15 .\nThe same work array can be used for both dfftf and dfftb as long as n remains unchanged.\nDifferent wsave arrays are required for different values of n . Warning The contents of wsave must not be changed between calls of dfftf or dfftb . Example program demo_dffti use fftpack , only : dffti real ( kind = 8 ) :: x ( 4 ) = [ 1.0 , 2.0 , 3.0 , 4.0 ] real ( kind = 8 ) :: w ( 23 ) call dffti ( 4 , w ) end program demo_dffti dfftf Description Computes the fourier coefficients of a real perodic sequence (fourier analysis).\nThe transform is defined below at output parameter r . The transform is not normalized. To obtain a normalized transform the output must be divided by n . Otherwise a call of dfftf followed by a call of dfftb will multiply the sequence by n . The array wsave which is used by subroutine dfftf must be initialized by calling subroutine dffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call dfftf (n, r, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the real sequence r . The method is more efficient when n is the product of small primes. n may change so long as different work arrays are provided. r : Shall be a real array.\nThis argument is intent(inout) . A real array of length n which contains the sequence. r ( 1 ) = the sum from i = 1 to i = n of r ( i ) if n is even set l = n / 2 , if n is odd set l = ( n + 1 ) / 2 then for k = 2 ,..., l r ( 2 * k - 2 ) = the sum from i = 1 to i = n of r ( i ) * cos (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) r ( 2 * k - 1 ) = the sum from i = 1 to i = n of - r ( i ) * sin (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) if n is even r ( n ) = the sum from i = 1 to i = n of ( - 1 ) ** ( i - 1 ) * r ( i ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 4n+15 in the program that calls dfftf .\nThe wsave array must be initialized by calling subroutine dffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by dfftf and dfftb . Contains initialization calculations which must not be destroyed between calls of subroutine dfftf or dfftb . Warning The contents of wsave must not be changed between calls of dfftf or dfftb . Example program demo_dfftf use fftpack , only : dffti , dfftf real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 23 ) call dffti ( 4 , w ) call dfftf ( 4 , x , w ) !! `x` returns [10.0, -2.0, 2.0, -2.0]. end program demo_dfftf dfftb Description Unnormalized inverse of dfftf . Computes the backward real discrete fourier transform (the fourier synthesis).\nEquivalently, dfftb computes a real periodic sequence from its fourier coefficients.\nThe transform is defined below at output parameter c . The transform is not normalized. To obtain a normalized transform the output must be divided by n . Otherwise a call of dfftf followed by a call of dfftb will multiply the sequence by n . The array wsave which is used by subroutine dfftf must be initialized by calling subroutine dffti(n,wsave) . Status Experimental. Class Pure subroutine. Syntax call dfftb (n, r, wsave) Argument n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the real sequence r . The method is more efficient when n is the product of small primes. r : Shall be a real array.\nThis argument is intent(inout) . A real array of length n which contains the sequence. for n even and for i = 1 ,..., n r ( i ) = r ( 1 ) + ( - 1 ) ** ( i - 1 ) * r ( n ) plus the sum from k = 2 to k = n / 2 of 2 . * r ( 2 * k - 2 ) * cos (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) - 2 . * r ( 2 * k - 1 ) * sin (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) for n odd and for i = 1 ,..., n r ( i ) = r ( 1 ) plus the sum from k = 2 to k = ( n + 1 ) / 2 of 2 . * r ( 2 * k - 2 ) * cos (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) - 2 . * r ( 2 * k - 1 ) * sin (( k - 1 ) * ( i - 1 ) * 2 * pi / n ) wsave : Shall be a real array.\nThis argument is intent(in) . A real work array which must be dimensioned at least 2n+15 in the program that calls dfftf . The wsave array must be initialized by calling subroutine dffti(n,wsave) and a different wsave array must be used for each different value of n . This initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. The same wsave array can be used by dfftf and dfftb . Contains initialization calculations which must not be destroyed between calls of subroutine dfftf or dfftb . Warning The contents of wsave must not be changed between calls of dfftf or dfftb . Example program demo_dfftb use fftpack , only : dffti , dfftf , dfftb real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 31 ) call dffti ( 4 , w ) call dfftf ( 4 , x , w ) !! `x` returns [10.0, -2.0, 2.0, -2.0]. call dfftb ( 4 , x , w ) !! `x` returns [4.0, 8.0, 12.0, 16.0], which is not normalized. end program demo_dfftb rfft Description Discrete Fourier transform of a real sequence. Status Experimental. Class Pure function. Syntax result = rfft (x [, n]) Argument x : Shall be a real and rank-1 array.\nThis argument is intent(in) . The data to transform. n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a real and rank-1 array, the Discrete Fourier Transform (DFT) of x . Notes Within numerical accuracy, y == rfft(irfft(y))/size(y) . Example program demo_rfft use fftpack , only : rfft real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , rfft ( x , 3 ) !! [6.0, -1.5, 0.87]. print * , rfft ( x ) !! [10.0, -2.0, 2.0, -2.0]. print * , rfft ( x , 5 ) !! [10.0, -4.0, -1.3, 1.5, -2.1]. end program demo_rfft irfft Description Unnormalized inverse of rfft . Status Experimental. Class Pure function. Syntax result = irfft (x [, n]) Argument x : Shall be a real array.\nThis argument is intent(in) .\nTransformed data to invert. n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. Return value Returns a real and rank-1 array, the unnormalized inverse discrete Fourier transform. Example program demo_irfft use fftpack , only : rfft , irfft real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , irfft ( rfft ( x )) / 4.0 !! [1.0, 2.0, 3.0, 4.0] print * , irfft ( rfft ( x ), 3 ) !! [6.0, 8.53, 15.46] end program demo_irfft Simplified discrete Fourier transform (DFT) of real data dzffti Description Initializes the array wsave which is used in both dzfftf and dzfftb .\nThe prime factorization of n together with a tabulation of the trigonometric functions are computed and stored in wsave . Status Experimental Class Prue function. Syntax call dzffti (n, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. wsave : Shall be a real and rank-1 array.\nThis argument is intent(out) . A work array which must be dimensioned at least 3*n+15 .\nThe same work array can be used for both dzfftf and dzfftb as long as n remains unchanged.\nDifferent wsave arrays are required for different values of n . Warning The contents of wsave must not be changed between calls of dzfftf or dzfftb . Example program demo_dzffti use fftpack , only : dzffti real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dzffti ( 4 , w ) !! Initializes the array `w` which is used in both `dzfftf` and `dzfftb`. end program demo_dzffti dzfftf Description Computes the fourier coefficients of a real perodic sequence (fourier analysis).\nThe transform is defined below at output parameters azero , a and b . dzfftf is a simplified but slower version of dfftf . Status Experimental Class Pure subroutine. Syntax call dzfftf (n, r, azero, a, b, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array r to be transformed. The method is most efficient when n is the product of small primes. r : Shall be a real and rank-1 array.\nThis argument is intent(in) . A real array of length n which contains the sequence to be transformed. r is not destroyed. azero : Shall be a real scalar.\nThis argument is intent(out) . The sum from i=1 to i=n of r(i)/n . a , b : Shall be a real and rank-1 array.\nThis argument is intent(out) . for n even b ( n / 2 ) = 0 . and a ( n / 2 ) is the sum from i = 1 to i = n of ( - 1 ) ** ( i - 1 ) * r ( i ) / n for n even define kmax = n / 2 - 1 for n odd define kmax = ( n - 1 ) / 2 then for k = 1 ,..., kmax a ( k ) equals the sum from i = 1 to i = n of 2 . / n * r ( i ) * cos ( k * ( i - 1 ) * 2 * pi / n ) b ( k ) equals the sum from i = 1 to i = n of 2 . / n * r ( i ) * sin ( k * ( i - 1 ) * 2 * pi / n ) wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) .\nA work array which must be dimensioned at least 3*n+15 .\nIn the program that calls dzfftf . The wsave array must be initialized by calling subroutine dzffti(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by dzfftf and dzfftb . Example program demo_dzfftf use fftpack , only : dzffti , dzfftf real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: azero , a ( 4 / 2 ), b ( 4 / 2 ) call dzffti ( 4 , w ) call dzfftf ( 4 , x , azero , a , b , w ) !! `azero`: 2.5; `a`: [-1.0, -0.5]; `b`: [-1.0, -0.0] end program demo_dzfftf dzfftb Description Computes a real perodic sequence from its fourier coefficients (fourier synthesis).\nThe transform is defined below at output parameter r . dzfftb is a simplified but slower version of dfftb . Status Experimental Class Pure subroutine. Syntax call dzfftb (n, r, azero, a, b, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the output array r . The method is most efficient when n is the product of small primes. r : Shall be a real and rank-1 array.\nThis argument is intent(out) . if n is even define kmax = n / 2 if n is odd define kmax = ( n - 1 ) / 2 then for i = 1 ,..., n r ( i ) = azero plus the sum from k = 1 to k = kmax of a ( k ) * cos ( k * ( i - 1 ) * 2 * pi / n ) + b ( k ) * sin ( k * ( i - 1 ) * 2 * pi / n ) Complex notation: for j = 1 ,..., n r ( j ) equals the sum from k =- kmax to k = kmax of c ( k ) * exp ( i * k * ( j - 1 ) * 2 * pi / n ) where c ( k ) = . 5 * cmplx ( a ( k ) , - b ( k )) for k = 1 ,..., kmax c ( - k ) = conjg ( c ( k )) c ( 0 ) = azero and i = sqrt ( - 1 ) Amplitude - phase notation: for i = 1 ,..., n r ( i ) equals azero plus the sum from k = 1 to k = kmax of alpha ( k ) * cos ( k * ( i - 1 ) * 2 * pi / n + beta ( k )) where alpha ( k ) = sqrt ( a ( k ) * a ( k ) + b ( k ) * b ( k )) cos ( beta ( k )) = a ( k ) / alpha ( k ) sin ( beta ( k )) =- b ( k ) / alpha ( k ) azero : Shall be a real scalar.\nThis argument is intent(in) . The constant fourier coefficient. a , b : Shall be a real and rank-1 array.\nThis argument is intent(in) . Arrays which contain the remaining fourier coefficients these arrays are not destroyed.\nThe length of these arrays depends on whether n is even or odd. if n is even n / 2 locations are required if n is odd ( n - 1 ) / 2 locations are required wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) .\nA work array which must be dimensioned at least 3*n+15 .\nIn the program that calls dzfftf . The wsave array must be initialized by calling subroutine dzffti(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first.\nThe same wsave array can be used by dzfftf and dzfftb . Example program demo_dzfftb use fftpack , only : dzffti , dzfftf , dzfftb real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: azero , a ( 4 / 2 ), b ( 4 / 2 ) call dzffti ( 4 , w ) call dzfftf ( 4 , x , azero , a , b , w ) !! `azero`: 2.5; `a`: [-1.0, -0.5]; `b`: [-1.0, -0.0] x = 0.0 call dzfftb ( 4 , x , azero , a , b , w ) !! `x`: [1.0, 2.0, 3.0, 4.0] end program demo_dzfftb Discrete cosine transforms (DCT) DCT type-1 (DCT-1) Initialize DCT-1: dcosti or dct_t1i Description Initializes the array wsave which is used in subroutine dcost .\nThe prime factorization of n together with a tabulation of the trigonometric functions are computed and stored in wsave . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. Status Experimental Class Pure subroutine. Syntax call dcosti (n , wsave) Arguments n : Shall be a integer scalar.\nThis argument is intent(in) . The length of the sequence to be transformed. The method is most efficient when n-1 is a product of small primes. wsave : Shall be a real and rank-1 array.\nThis argument is intent(out) . A work array which must be dimensioned at least 3*n+15 .\nDifferent wsave arrays are required for different values of n .\nThe contents of wsave must not be changed between calls of dcost . Example program demo_dcosti use fftpack , only : dcosti real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dcosti ( 4 , w ) !! Initializes the array `w` which is used in subroutine `dcost`. end program demo_dcosti Compute DCT-1: dcost or dct_t1 Description Computes the DCT-1 of the input real data.\nThe transform is defined below at output parameter x . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. For real input data x of length n , the DCT-1 of x is equivalent, up to a\nscaling factor, to the DFT of the even extension of x with length 2*(n-1) ,\nwhere the first and last entries of the original data are not repeated in the\nextension. For example, the DCT-1 of input data abcde (size ) is\nequivalent to the DFT of data abcdedcb (size ). Also, dcost is the unnormalized inverse of itself. This means that a call of dcost followed by another call of dcost will multiply the input sequence x by 2*(n-1) . The array wsave which is used by subroutine dcost must be initialized by calling subroutine dcosti(n,wsave) . Status Experimental Class Pure subroutine. Syntax call dcost (n, x, wsave) Arguments n : Shall be a integer scalar.\nThis argument is intent(in) . The length of the sequence x . n must be greater than 1 .\nThe method is most efficient when n-1 is a product of small primes. x : Shall be a real and rank-1 array.\nThis argument is intent(inout) .\nAn array which contains the sequence to be transformed, and is overwritten\nby the result. for i = 1 ,..., n x ( i ) = x ( 1 ) + ( - 1 ) ** ( i - 1 ) * x ( n ) + the sum from k = 2 to k = n - 1 2 * x ( k ) * cos (( k - 1 ) * ( i - 1 ) * pi / ( n - 1 )) a call of dcost followed by another call of dcost will multiply the sequence x by 2 * ( n - 1 ) hence dcost is the unnormalized inverse of itself . wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) . A work array which must be of length at least 3*n+15 in the program that calls dcost .\nThe wsave array must be initialized by calling subroutine dcosti(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent\ntransforms can be obtained faster than the first.\nContains initialization calculations which must not be destroyed between calls of dcost . Example program demo_dcost use fftpack , only : dcosti , dcost real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dcosti ( 4 , w ) call dcost ( 4 , x , w ) !! `x`: [15.0, -4.0, 0.0, -1.0] call dcost ( 4 , x , w ) !! `x`: [6.0, 12.0, 18.0, 24.0] end program demo_dcost DCT of types 2, 3 (DCT-2, 3), a.k.a \"Quarter\" cosine transforms Initialize DCT-2, 3: dcosqi or dct_t23i Description Initializes the array wsave which is used in both dcosqf and dcosqb .\nThe prime factorization of n together with\na tabulation of the trigonometric functions are computed and\nstored in wsave . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. Status Experimental Class Pure subroutine. Syntax call dcosqi (n, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array to be transformed.\nThe method is most efficient when n is a product of small primes. wsave : Shall be a real and rank-1 array.\nThis argument is intent(out) . A work array which must be dimensioned at least 3*n+15 .\nThe same work array can be used for both dcosqf and dcosqb as long as n remains unchanged.\nDifferent wsave arrays are required for different values of n .\nThe contents of wsave must not be changed between calls of dcosqf or dcosqb . Example program demo_dcosqi use fftpack , only : dcosqi real ( kind = 8 ) :: w ( 3 * 4 + 15 ) call dcosqi ( 4 , w ) !! Initializes the array `w` which is used in both `dcosqf` and `dcosqb`. end program demo_dcosqi Compute DCT-3: dcosqf or dct_t3 Description Computes the DCT-3 of the input real data.\nThe transform is defined below at output parameter x . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. Also, dcosqf (DCT-3) is the unnormalized inverse of dcosqb (DCT-2), since a\ncall of dcosqf followed by a call of dcosqb will multiply the input sequence x by 4*n . The array wsave which is used by subroutine dcosqf must be initialized by calling subroutine dcosqi(n,wsave) . Status Experimental Class Pure subroutine. Syntax call dcosqf (n, x, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array x to be transformed.\nThe method is most efficient when n is a product of small primes. x : Shall be a real and rank-1 array.\nThis argument is intent(inout) . An array which contains the sequence to be transformed, and is overwritten by\nthe result. for i = 1 ,..., n x ( i ) = x ( 1 ) plus the sum from k = 2 to k = n of 2 * x ( k ) * cos (( 2 * i - 1 ) * ( k - 1 ) * pi / ( 2 * n )) a call of dcosqf followed by a call of cosqb will multiply the sequence x by 4 * n . therefore dcosqb is the unnormalized inverse of dcosqf . wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) . A work array which must be dimensioned at least 3*n+15 in the program that calls dcosqf .\nThe wsave array must be initialized by calling subroutine dcosqi(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. Warning : wsave contains initialization calculations which must not be\ndestroyed between calls of dcosqf or dcosqb of the same n . Example program demo_dcosqf use fftpack , only : dcosqi , dcosqf real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] call dcosqi ( 4 , w ) call dcosqf ( 4 , x , w ) !! `x`: [12.0, -9.10, 2.62, -1.51] end program demo_dcosqf Compute DCT-2: dcosqb or dct_t2 Description Computes the DCT-2 of the input real data.\nThe transform is defined below at output parameter x . The two procedures are completely equivalent and expect the same arguments.\nIt is a matter of personal preference which one you choose to use. For real input data x of length n , the DCT-2 of x is equivalent, up to a\nscaling factor, to the DFT of the even extension of x with length 4*n ,\nwhere all the even-frequency entries are zero. Also, dcosqb (DCT-2) is the unnormalized inverse of dcosqf (DCT-3), since a\ncall of dcosqb followed by a call of dcosqf will multiply the input sequence x by 4*n . The array wsave which is used by subroutine dcosqb must be initialized by calling subroutine dcosqi(n,wsave) . Status Experimental Class Pure subroutine. Syntax call dcosqb (n, x, wsave) Arguments n : Shall be an integer scalar.\nThis argument is intent(in) . The length of the array x to be transformed.\nThe method is most efficient when n is a product of small primes. x : Shall be a real and rank-1 array.\nThis argument is intent(inout) . An array which contains the sequence to be transformed, and is overwritten by\nthe result. for i = 1 ,..., n x ( i ) = the sum from k = 1 to k = n of 4 * x ( k ) * cos (( 2 * k - 1 ) * ( i - 1 ) * pi / ( 2 * n )) a call of dcosqb followed by a call of dcosqf will multiply the sequence x by 4 * n . therefore dcosqf is the unnormalized inverse of dcosqb . wsave : Shall be a real and rank-1 array.\nThis argument is intent(in) . A work array which must be dimensioned at least 3*n+15 in the program that calls dcosqb .\nThe wsave array must be initialized by calling subroutine dcosqi(n,wsave) and a different wsave array must be used for each different value of n .\nThis initialization does not have to be repeated so long as n remains unchanged thus subsequent transforms can be obtained faster than the first. Warning : wsave contains initialization calculations which must not be\ndestroyed between calls of dcosqf or dcosqb of the same n . Example program demo_dcosqb use fftpack , only : dcosqi , dcosqf , dcosqb real ( kind = 8 ) :: w ( 3 * 4 + 15 ) real ( kind = 8 ) :: x ( 4 ) = [ 4 , 3 , 5 , 10 ] call dcosqi ( 4 , w ) call dcosqf ( 4 , x , w ) call dcosqb ( 4 , x , w ) !! [64.0, 48.0, 80.0, 160.0] end program demo_dcosqb Simplified DCT of types 1, 2, 3: dct Description Discrete cosine transforms (DCT) of types 1, 2, 3.\nThis is a more flexible interface for the DCT of types 1, 2 and 3, albeit\nslightly slower than the in-place DCT procedures. Status Experimental. Class Pure function. Syntax result = dct (x [, n, type]) Argument x : Shall be a real and rank-1 array.\nThis argument is intent(in) .\nThe data to transform. n : Shall be an integer scalar.\nThis argument is intent(in) and optional .\nDefines the length of the DCT. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. type : Shall be an integer scalar, equal to 1 , 2 or 3 .\nThis argument is intent(in) and optional .\nDefines the type of DCT to be performed. The default type is 2 . Return value Returns a real and rank-1 array, the DCT type- t of the input data x . Notes Within numerical accuracy,\n- x == idct(dct(x, type=1), type=1) / (2*(size(x) - 1)) - x == idct(dct(x, type=2), type=2) / (4*size(x)) - x == idct(dct(x, type=3), type=3) / (4*size(x)) Example program demo_dct use fftpack , only : dct real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , dct ( x , 3 , 1 ) !! [8.0, -2.0, 0.0]. print * , dct ( x , type = 1 ) !! [15.0, -4.0, 0.0, -1.0]. print * , dct ( x , 5 , 2 ) !! [14.36, -6.11, -5.0, 4.40, -2.65]. print * , dct ( dct ( x , type = 1 ), type = 1 ) / ( 2 * ( 4 - 1 )) !! (normalized): [1.0, 2.0, 3.0, 4.0] end program demo_dct Simplified inverse DCT of types 1, 2, 3: idct Description Unnormalized inverse discrete cosine transform (IDCT) of types 1, 2 and 3.\nThis is a more flexible interface for the IDCT of types 1, 2 and 3,\nalbeit slightly slower than the in-place DCT procedures. Status Experimental. Class Pure function. Syntax result = idct (x [, n, type]) Argument x : Shall be a real array.\nThis argument is intent(in) .\nTransformed data to invert. n : Shall be an integer scalar.\nThis argument is intent(in) and optional . Defines the length of the Fourier transform. If n is not specified (the default) then n = size(x) . If n <= size(x) , x is truncated, if n > size(x) , x is zero-padded. type : Shall be an integer scalar, equal to 1 or 2 .\nThis argument is intent(in) and optional .\nDefines the type of the IDCT to be performed. The default type is 2 . Return value Returns a real and rank-1 array, the IDCT type- t of the input data x . Notes Within numerical accuracy,\n- x == idct(dct(x, type=1), type=1) / (2*(size(x) - 1)) - x == idct(dct(x, type=2), type=2) / (4*size(x)) - x == idct(dct(x, type=3), type=3) / (4*size(x)) Example program demo_idct use fftpack , only : dct , idct real ( kind = 8 ) :: x ( 4 ) = [ 1 , 2 , 3 , 4 ] print * , idct ( dct ( x , type = 1 ), type = 1 ) / ( 2 * ( 4 - 1 )) !! (normalized): [1.0, 2.0, 3.0, 4.0] print * , idct ( dct ( x , type = 2 ), type = 2 ) / ( 4 * 4 ) !! (normalized): [1.0, 2.0, 3.0, 4.0] print * , idct ( dct ( x ), n = 3 ) !! (unnormalized): [22.06, 32.5, 65.65] end program demo_idct References [1] Wikipedia, \"Discrete cosine transform\", https://en.wikipedia.org/wiki/Discrete_cosine_transform Utility functions fftshift Description Rearranges the Fourier transform by moving the zero-frequency component to the center of the array. Status Experimental. Class Pure function. Syntax result = fftshift (x) Argument x : Shall be a complex/real and rank-1 array.\nThis argument is intent(in) . Return value Returns the complex/real and rank-1 Fourier transform by moving the zero-frequency component to the center of the array. Example program demo_fftshift use fftpack , only : fftshift complex ( kind = 8 ) :: c ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] real ( kind = 8 ) :: x ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] print * , fftshift ( c ( 1 : 4 )) !! [(3.0,0.0), (4.0,0.0), (1.0,0.0), (2.0,0.0)] print * , fftshift ( c ) !! [(4.0,0.0), (5.0,0.0), (1.0,0.0), (2.0,0.0), (3.0,0.0)] print * , fftshift ( x ( 1 : 4 )) !! [3.0, 4.0, 1.0, 2.0] print * , fftshift ( x ) !! [4.0, 5.0, 1.0, 2.0, 3.0] end program demo_fftshift ifftshift Description Rearranges the Fourier transform with zero frequency shifting back to the original transform output. In other words, ifftshift is the result of undoing fftshift . Status Experimental. Class Pure function. Syntax result = ifftshift (x) Argument x : Shall be a complex/real and rank-1 array.\nThis argument is intent(in) . Return value Returns the complex/real and rank-1 Fourier transform with zero frequency shifting back to the original transform output. Example program demo_ifftshift use fftpack , only : fftshift , ifftshift complex ( kind = 8 ) :: c ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] real ( kind = 8 ) :: x ( 5 ) = [ 1 , 2 , 3 , 4 , 5 ] print * , ifftshift ( fftshift ( c ( 1 : 4 ))) !! [(1.0,0.0), (2.0,0.0), (3.0,0.0), (4.0,0.0)] print * , ifftshift ( fftshift ( c ) ) !! [(1.0,0.0), (2.0,0.0), (3.0,0.0), (4.0,0.0), (5.0,0.0)] print * , ifftshift ( fftshift ( x ( 1 : 4 ))) !! [1.0, 2.0, 3.0, 4.0] print * , ifftshift ( fftshift ( x )) !! [1.0, 2.0, 3.0, 4.0, 5.0] end program demo_ifftshift fftfreq Description Returns the integer frequency (or wavenumber) values that correspond to the coefficients calculated by the complex discrete Fourier transform, in the standard order (zero frequency first). Status Experimental. Class Pure function. Syntax result = fftfreq (n) Argument n : Shall be an integer , equal to the length of the corresponding complex discrete Fourier transform.\nThis argument is intent(in) . Return value Returns the integer and rank-1 array of the transform's frequency values in the standard order (zero frequency first). Example program demo_fftfreq use fftpack , only : fftfreq print * , fftfreq ( 4 ) ! [0, 1, -2, -1] print * , fftfreq ( 5 ) ! [0, 1, 2, -2, -1] end program demo_fftfreq rfftfreq Description Returns the integer frequency (or wavenumber) values that correspond to the coefficients calculated by the real discrete Fourier transform, in the standard order (zero frequency first). Status Experimental. Class Pure function. Syntax result = rfftfreq (n) Argument n : Shall be an integer , equal to the length of the corresponding real discrete Fourier transform.\nThis argument is intent(in) . Return value Returns the integer and rank-1 array of the transform's frequency values in the standard order (zero frequency first). Example program demo_rfftfreq use fftpack , only : rfftfreq print * , rfftfreq ( 4 ) ! [0, 1, 1, -2] print * , rfftfreq ( 5 ) ! [0, 1, 1, 2, 2] end program demo_rfftfreq","tags":"","loc":"page/specs/fftpack.html"},{"title":"FFTPACK Kind – Fortran-lang/fftpack","text":"The fftpack_kind Module The fftpack_kind Module Introduction Constants provided by fftpack_kind Introduction The fftpack_kind module provides kind parameters for FFTs. Constants provided by fftpack_kind rk : Double precision real kind parameter . Provides real kind parameter for floating point numbers with a minimal precision of 15 significant digits.","tags":"","loc":"page/specs/fftpack_kind.html"}]} \ No newline at end of file