Ignore:
Timestamp:
Mar 20, 2014 8:40:49 AM (8 years ago)
Author:
raasch
Message:

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/singleton.f90

    r484 r1320  
    44! Current revisions:
    55! -----------------
    6 !
     6! kind-parameters added to all INTEGER and REAL declaration statements,
     7! kinds are defined in new module kinds,
     8! revision history before 2012 removed,
    79!
    810! Former revisions:
    911! -----------------
    10 ! $Id$
    11 ! RCS Log replace by Id keyword, revision history cleaned up
    12 !
    13 ! Revision 1.2  2004/04/30 12:52:09  raasch
    14 ! Shape of arrays is explicitly stored in ishape and handled to the
    15 ! fft-routines instead of the shape-function (due to a compiler error on
    16 ! decalpha)
    17 !
    1812! Revision 1.1  2002/05/02 18:56:59  raasch
    1913! Initial revision
     
    158152!-----------------------------------------------------------------------------
    159153
     154    USE kinds
     155
    160156    IMPLICIT NONE
    161157
    162158    PRIVATE
    163     PUBLIC:: fft, fftn, fftkind
    164 
    165     INTEGER, PARAMETER:: fftkind = KIND(0.0) ! adjust here for other precisions
    166 
    167     REAL(fftkind), PARAMETER:: sin60 = 0.86602540378443865_fftkind
    168     REAL(fftkind), PARAMETER:: cos72 = 0.30901699437494742_fftkind
    169     REAL(fftkind), PARAMETER:: sin72 = 0.95105651629515357_fftkind
    170     REAL(fftkind), PARAMETER:: pi    = 3.14159265358979323_fftkind
     159    PUBLIC:: fft, fftn
     160
     161    REAL(wp), PARAMETER:: sin60 = 0.86602540378443865_wp
     162    REAL(wp), PARAMETER:: cos72 = 0.30901699437494742_wp
     163    REAL(wp), PARAMETER:: sin72 = 0.95105651629515357_wp
     164    REAL(wp), PARAMETER:: pi    = 3.14159265358979323_wp
    171165
    172166    INTERFACE fft
     
    187181!
    188182!-- Formal parameters
    189     COMPLEX(fftkind), DIMENSION(:), INTENT(IN)           :: array
    190     INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
    191     LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
    192     INTEGER,                        INTENT(OUT), OPTIONAL:: stat
     183    COMPLEX(wp), DIMENSION(:), INTENT(IN)           :: array
     184    INTEGER(iwp), DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
     185    INTEGER(iwp),               INTENT(OUT), OPTIONAL:: stat
     186    LOGICAL,                    INTENT(IN),  OPTIONAL:: inv
    193187!
    194188!-- Function result
    195     COMPLEX(fftkind), DIMENSION(SIZE(array, 1)):: ft
    196 
    197     INTEGER ::  ishape(1)
     189    COMPLEX(wp), DIMENSION(SIZE(array, 1)):: ft
     190
     191    INTEGER(iwp)::  ishape(1)
    198192
    199193!
     
    211205!
    212206!-- Formal parameters
    213     COMPLEX(fftkind), DIMENSION(:,:), INTENT(IN)           :: array
    214     INTEGER,          DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
    215     LOGICAL,                          INTENT(IN),  OPTIONAL:: inv
    216     INTEGER,                          INTENT(OUT), OPTIONAL:: stat
     207    COMPLEX(wp), DIMENSION(:,:), INTENT(IN)           :: array
     208    INTEGER(iwp), DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
     209    INTEGER(iwp),                 INTENT(OUT), OPTIONAL:: stat
     210    LOGICAL,                      INTENT(IN),  OPTIONAL:: inv
    217211!
    218212!-- Function result
    219     COMPLEX(fftkind), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft
    220 
    221     INTEGER ::  ishape(2)
     213    COMPLEX(wp), DIMENSION(SIZE(array, 1), SIZE(array, 2)):: ft
     214
     215    INTEGER(iwp) ::  ishape(2)
    222216!
    223217!-- Intrinsics used
     
    234228!
    235229!-- Formal parameters
    236     COMPLEX(fftkind), DIMENSION(:,:,:), INTENT(IN)           :: array
    237     INTEGER,          DIMENSION(:),     INTENT(IN),  OPTIONAL:: dim
    238     LOGICAL,                            INTENT(IN),  OPTIONAL:: inv
    239     INTEGER,                            INTENT(OUT), OPTIONAL:: stat
     230    COMPLEX(wp), DIMENSION(:,:,:), INTENT(IN)           :: array
     231    INTEGER(iwp), DIMENSION(:),     INTENT(IN),  OPTIONAL:: dim
     232    INTEGER(iwp),                   INTENT(OUT), OPTIONAL:: stat
     233    LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
    240234!
    241235!-- Function result
    242     COMPLEX(fftkind), &
     236    COMPLEX(wp), &
    243237         DIMENSION(SIZE(array, 1), SIZE(array, 2), SIZE(array, 3)):: ft
    244238
    245     INTEGER ::  ishape(3)
     239    INTEGER(iwp) ::  ishape(3)
    246240
    247241!
     
    259253!
    260254!-- Formal parameters
    261     COMPLEX(fftkind), DIMENSION(:,:,:,:), INTENT(IN)           :: array
    262     INTEGER,          DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
    263     LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
    264     INTEGER,                              INTENT(OUT), OPTIONAL:: stat
     255    COMPLEX(wp), DIMENSION(:,:,:,:), INTENT(IN)           :: array
     256    INTEGER(iwp), DIMENSION(:),       INTENT(IN),  OPTIONAL:: dim
     257    INTEGER(iwp),                     INTENT(OUT), OPTIONAL:: stat
     258    LOGICAL,                          INTENT(IN),  OPTIONAL:: inv
    265259!
    266260!-- Function result
    267     COMPLEX(fftkind), DIMENSION( &
     261    COMPLEX(wp), DIMENSION( &
    268262         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4)):: ft
    269263
    270     INTEGER ::  ishape(4)
     264    INTEGER(iwp) ::  ishape(4)
    271265!
    272266!-- Intrinsics used
     
    283277!
    284278!-- Formal parameters
    285     COMPLEX(fftkind), DIMENSION(:,:,:,:,:), INTENT(IN)           :: array
    286     INTEGER,          DIMENSION(:),         INTENT(IN),  OPTIONAL:: dim
    287     LOGICAL,                                INTENT(IN),  OPTIONAL:: inv
    288     INTEGER,                                INTENT(OUT), OPTIONAL:: stat
     279    COMPLEX(wp), DIMENSION(:,:,:,:,:), INTENT(IN)           :: array
     280    INTEGER(iwp), DIMENSION(:),         INTENT(IN),  OPTIONAL:: dim
     281    INTEGER(iwp),                       INTENT(OUT), OPTIONAL:: stat
     282    LOGICAL,                            INTENT(IN),  OPTIONAL:: inv
    289283!
    290284!-- Function result
    291     COMPLEX(fftkind), DIMENSION( &
     285    COMPLEX(wp), DIMENSION( &
    292286         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
    293287         SIZE(array, 5)):: ft
    294288
    295     INTEGER ::  ishape(5)
     289    INTEGER(iwp) ::  ishape(5)
    296290
    297291!
     
    309303!
    310304!-- Formal parameters
    311     COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:), INTENT(IN)           :: array
    312     INTEGER,          DIMENSION(:),           INTENT(IN),  OPTIONAL:: dim
    313     LOGICAL,                                  INTENT(IN),  OPTIONAL:: inv
    314     INTEGER,                                  INTENT(OUT), OPTIONAL:: stat
     305    COMPLEX(wp), DIMENSION(:,:,:,:,:,:), INTENT(IN)           :: array
     306    INTEGER(iwp), DIMENSION(:),           INTENT(IN),  OPTIONAL:: dim
     307    INTEGER(iwp),                         INTENT(OUT), OPTIONAL:: stat
     308    LOGICAL,                              INTENT(IN),  OPTIONAL:: inv
    315309!
    316310!-- Function result
    317     COMPLEX(fftkind), DIMENSION( &
     311    COMPLEX(wp), DIMENSION( &
    318312         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
    319313         SIZE(array, 5), SIZE(array, 6)):: ft
    320314
    321     INTEGER ::  ishape(6)
     315    INTEGER(iwp) ::  ishape(6)
    322316
    323317!
     
    335329!
    336330!-- Formal parameters
    337     COMPLEX(fftkind), DIMENSION(:,:,:,:,:,:,:), INTENT(IN)           :: array
    338     INTEGER,          DIMENSION(:),             INTENT(IN),  OPTIONAL:: dim
    339     LOGICAL,                                    INTENT(IN),  OPTIONAL:: inv
    340     INTEGER,                                    INTENT(OUT), OPTIONAL:: stat
     331    COMPLEX(wp), DIMENSION(:,:,:,:,:,:,:), INTENT(IN)           :: array
     332    INTEGER(iwp),          DIMENSION(:),   INTENT(IN),  OPTIONAL:: dim
     333    INTEGER(iwp),                          INTENT(OUT), OPTIONAL:: stat
     334    LOGICAL,                               INTENT(IN),  OPTIONAL:: inv
    341335!
    342336!-- Function result
    343     COMPLEX(fftkind), DIMENSION( &
     337    COMPLEX(wp), DIMENSION( &
    344338         SIZE(array, 1), SIZE(array, 2), SIZE(array, 3), SIZE(array, 4), &
    345339         SIZE(array, 5), SIZE(array, 6), SIZE(array, 7)):: ft
    346340
    347     INTEGER ::  ishape(7)
     341    INTEGER(iwp) ::  ishape(7)
    348342
    349343!
     
    361355!
    362356!-- Formal parameters
    363     COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
    364     INTEGER,          DIMENSION(:), INTENT(IN)           :: shape
    365     INTEGER,          DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
    366     LOGICAL,                        INTENT(IN),  OPTIONAL:: inv
    367     INTEGER,                        INTENT(OUT), OPTIONAL:: stat
     357    COMPLEX(wp), DIMENSION(*), INTENT(INOUT)        :: array
     358    INTEGER(iwp), DIMENSION(:), INTENT(IN)           :: shape
     359    INTEGER(iwp), DIMENSION(:), INTENT(IN),  OPTIONAL:: dim
     360    INTEGER(iwp),               INTENT(OUT), OPTIONAL:: stat
     361    LOGICAL,                    INTENT(IN),  OPTIONAL:: inv
    368362!
    369363!-- Local arrays
    370     INTEGER, DIMENSION(SIZE(shape)):: d
     364    INTEGER(iwp), DIMENSION(SIZE(shape)):: d
    371365!
    372366!-- Local scalars
    373367    LOGICAL      :: inverse
    374     INTEGER      :: i, ndim, ntotal
    375     REAL(fftkind):: scale
     368    INTEGER(iwp) :: i, ndim, ntotal
     369    REAL(wp):: scale
    376370!
    377371!-- Intrinsics used
     
    394388
    395389    ntotal = PRODUCT(shape)
    396     scale = SQRT(1.0_fftkind / PRODUCT(shape(d(1:ndim))))
     390    scale = SQRT(1.0_wp / PRODUCT(shape(d(1:ndim))))
    397391    DO i = 1, ntotal
    398392       array(i) = CMPLX(REAL(array(i)) * scale, AIMAG(array(i)) * scale, &
    399             KIND=fftkind)
     393            KIND=wp)
    400394    END DO
    401395
     
    414408!
    415409!-- Formal parameters
    416     COMPLEX(fftkind), DIMENSION(*), INTENT(INOUT)        :: array
    417     INTEGER,                        INTENT(IN)           :: ntotal, npass, nspan
    418     LOGICAL,                        INTENT(IN)           :: inv
    419     INTEGER,                        INTENT(OUT), OPTIONAL:: stat
     410    COMPLEX(wp), DIMENSION(*), INTENT(INOUT)        :: array
     411    INTEGER(iwp),               INTENT(IN)           :: ntotal, npass, nspan
     412    INTEGER(iwp),               INTENT(OUT), OPTIONAL:: stat
     413    LOGICAL,                    INTENT(IN)           :: inv
    420414!
    421415!-- Local arrays
    422     INTEGER,          DIMENSION(BIT_SIZE(0))     :: factor
    423     COMPLEX(fftkind), DIMENSION(:), ALLOCATABLE  :: ctmp
    424     REAL(fftkind),    DIMENSION(:), ALLOCATABLE  :: sine, cosine
    425     INTEGER,          DIMENSION(:), ALLOCATABLE  :: perm
     416    COMPLEX(wp),  DIMENSION(:), ALLOCATABLE  :: ctmp
     417    INTEGER(iwp), DIMENSION(BIT_SIZE(0))     :: factor
     418    INTEGER(iwp), DIMENSION(:), ALLOCATABLE  :: perm
     419    REAL(wp),     DIMENSION(:), ALLOCATABLE  :: sine, cosine
    426420!
    427421!-- Local scalars
    428     INTEGER         :: maxfactor, nfactor, nsquare, nperm
     422    INTEGER(iwp)         :: maxfactor, nfactor, nsquare, nperm
    429423!
    430424!-- Intrinsics used
     
    476470!
    477471!--   Formal parameters
    478       INTEGER,               INTENT(IN) :: npass
    479       INTEGER, DIMENSION(*), INTENT(OUT):: factor
    480       INTEGER,               INTENT(OUT):: nfactor, nsquare
     472      INTEGER(iwp),               INTENT(IN) :: npass
     473      INTEGER(iwp), DIMENSION(*), INTENT(OUT):: factor
     474      INTEGER(iwp),               INTENT(OUT):: nfactor, nsquare
    481475!
    482476!--   Local scalars
    483       INTEGER:: j, jj, k
     477      INTEGER(iwp):: j, jj, k
    484478
    485479      nfactor = 0
     
    541535!
    542536!--   Formal parameters
    543       COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
    544       INTEGER,                        INTENT(IN)    :: ntotal, npass, nspan
    545       INTEGER,          DIMENSION(*), INTENT(IN)    :: factor
    546       INTEGER,                        INTENT(IN)    :: nfactor
    547       COMPLEX(fftkind), DIMENSION(*), INTENT(OUT)   :: ctmp
    548       REAL(fftkind),    DIMENSION(*), INTENT(OUT)   :: sine, cosine
    549       LOGICAL,                        INTENT(IN)    :: inv
     537      COMPLEX(wp), DIMENSION(*), INTENT(IN OUT):: array
     538      COMPLEX(wp),  DIMENSION(*), INTENT(OUT)   :: ctmp
     539      INTEGER(iwp),               INTENT(IN)    :: ntotal, npass, nspan
     540      INTEGER(iwp), DIMENSION(*), INTENT(IN)    :: factor
     541      INTEGER(iwp),               INTENT(IN)    :: nfactor
     542      LOGICAL,                    INTENT(IN)    :: inv
     543      REAL(wp),     DIMENSION(*), INTENT(OUT)   :: sine, cosine
    550544!
    551545!--   Local scalars
    552       INTEGER         :: ii, ispan
    553       INTEGER         :: j, jc, jf, jj
    554       INTEGER         :: k, kk, kspan, k1, k2, k3, k4
    555       INTEGER         :: nn, nt
    556       REAL(fftkind)   :: s60, c72, s72, pi2, radf
    557       REAL(fftkind)   :: c1, s1, c2, s2, c3, s3, cd, sd, ak
    558       COMPLEX(fftkind):: cc, cj, ck, cjp, cjm, ckp, ckm
     546      INTEGER(iwp):: ii, ispan
     547      INTEGER(iwp):: j, jc, jf, jj
     548      INTEGER(iwp):: k, kk, kspan, k1, k2, k3, k4
     549      INTEGER(iwp):: nn, nt
     550      REAL(wp)    :: s60, c72, s72, pi2, radf
     551      REAL(wp)    :: c1, s1, c2, s2, c3, s3, cd, sd, ak
     552      COMPLEX(wp) :: cc, cj, ck, cjp, cjm, ckp, ckm
    559553
    560554      c72 = cos72
     
    574568      jc = nspan / npass
    575569      radf = pi2 * jc
    576       pi2 = pi2 * 2.0_fftkind !-- use 2 PI from here on
     570      pi2 = pi2 * 2.0_wp !-- use 2 PI from here on
    577571
    578572      ii = 0
     
    581575         sd = radf / kspan
    582576         cd = SIN(sd)
    583          cd = 2.0_fftkind * cd * cd
     577         cd = 2.0_wp * cd * cd
    584578         sd = SIN(sd + sd)
    585579         kk = 1
     
    606600            IF (kk > kspan) RETURN
    607601            DO
    608                c1 = 1.0_fftkind - cd
     602               c1 = 1.0_wp - cd
    609603               s1 = sd
    610604               DO
     
    614608                        ck = array(kk) - array(k2)
    615609                        array(kk) = array(kk) + array(k2)
    616                         array(k2) = ck * CMPLX(c1, s1, KIND=fftkind)
     610                        array(k2) = ck * CMPLX(c1, s1, KIND=wp)
    617611                        kk = k2 + kspan
    618612                        IF (kk >= nt) EXIT
     
    625619                  ak = c1 - (cd * c1 + sd * s1)
    626620                  s1 = sd * c1 - cd * s1 + s1
    627                   c1 = 2.0_fftkind - (ak * ak + s1 * s1)
     621                  c1 = 2.0_wp - (ak * ak + s1 * s1)
    628622                  s1 = s1 * c1
    629623                  c1 = c1 * ak
     
    641635
    642636            DO
    643                c1 = 1.0_fftkind
    644                s1 = 0.0_fftkind
     637               c1 = 1.0_wp
     638               s1 = 0.0_wp
    645639               DO
    646640                  DO
     
    655649                     cjp = ckp - cjp
    656650                     IF (inv) THEN
    657                         ckp = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
    658                         ckm = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
     651                        ckp = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=wp)
     652                        ckm = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=wp)
    659653                     ELSE
    660                         ckp = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=fftkind)
    661                         ckm = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=fftkind)
     654                        ckp = ckm + CMPLX(AIMAG(cjm), -REAL(cjm), KIND=wp)
     655                        ckm = ckm + CMPLX(-AIMAG(cjm), REAL(cjm), KIND=wp)
    662656                     END IF
    663657!
    664658!--                  Avoid useless multiplies
    665                      IF (s1 == 0.0_fftkind) THEN
     659                     IF (s1 == 0.0_wp) THEN
    666660                        array(k1) = ckp
    667661                        array(k2) = cjp
    668662                        array(k3) = ckm
    669663                     ELSE
    670                         array(k1) = ckp * CMPLX(c1, s1, KIND=fftkind)
    671                         array(k2) = cjp * CMPLX(c2, s2, KIND=fftkind)
    672                         array(k3) = ckm * CMPLX(c3, s3, KIND=fftkind)
     664                        array(k1) = ckp * CMPLX(c1, s1, KIND=wp)
     665                        array(k2) = cjp * CMPLX(c2, s2, KIND=wp)
     666                        array(k3) = ckm * CMPLX(c3, s3, KIND=wp)
    673667                     END IF
    674668                     kk = k3 + kspan
     
    678672                  c2 = c1 - (cd * c1 + sd * s1)
    679673                  s1 = sd * c1 - cd * s1 + s1
    680                   c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
     674                  c1 = 2.0_wp - (c2 * c2 + s1 * s1)
    681675                  s1 = s1 * c1
    682676                  c1 = c1 * c2
     
    684678!--               Values of c2, c3, s2, s3 that will get used next time
    685679                  c2 = c1 * c1 - s1 * s1
    686                   s2 = 2.0_fftkind * c1 * s1
     680                  s2 = 2.0_wp * c1 * s1
    687681                  c3 = c2 * c1 - s2 * s1
    688682                  s3 = c2 * s1 + s2 * c1
     
    712706                     array(kk) = ck + cj
    713707                     ck = ck - CMPLX( &
    714                           0.5_fftkind * REAL (cj), &
    715                           0.5_fftkind * AIMAG(cj), &
    716                           KIND=fftkind)
     708                          0.5_wp * REAL (cj), &
     709                          0.5_wp * AIMAG(cj), &
     710                          KIND=wp)
    717711                     cj = CMPLX( &
    718712                          (REAL (array(k1)) - REAL (array(k2))) * s60, &
    719713                          (AIMAG(array(k1)) - AIMAG(array(k2))) * s60, &
    720                           KIND=fftkind)
    721                      array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
    722                      array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
     714                          KIND=wp)
     715                     array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=wp)
     716                     array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=wp)
    723717                     kk = k2 + kspan
    724718                     IF (kk >= nn) EXIT
     
    730724            CASE (5) !-- transform for factor of 5 (optional code)
    731725               c2 = c72 * c72 - s72 * s72
    732                s2 = 2.0_fftkind * c72 * s72
     726               s2 = 2.0_wp * c72 * s72
    733727               DO
    734728                  DO
     
    744738                     array(kk) = cc + ckp + cjp
    745739                     ck = CMPLX(REAL(ckp) * c72, AIMAG(ckp) * c72, &
    746                           KIND=fftkind) + &
     740                          KIND=wp) + &
    747741                          CMPLX(REAL(cjp) * c2,  AIMAG(cjp) * c2,  &
    748                           KIND=fftkind) + cc
     742                          KIND=wp) + cc
    749743                     cj = CMPLX(REAL(ckm) * s72, AIMAG(ckm) * s72, &
    750                           KIND=fftkind) + &
     744                          KIND=wp) + &
    751745                          CMPLX(REAL(cjm) * s2,  AIMAG(cjm) * s2,  &
    752                           KIND=fftkind)
    753                      array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
    754                      array(k4) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
     746                          KIND=wp)
     747                     array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=wp)
     748                     array(k4) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=wp)
    755749                     ck = CMPLX(REAL(ckp) * c2,  AIMAG(ckp) * c2,  &
    756                           KIND=fftkind) + &
     750                          KIND=wp) + &
    757751                          CMPLX(REAL(cjp) * c72, AIMAG(cjp) * c72, &
    758                           KIND=fftkind) + cc
     752                          KIND=wp) + cc
    759753                     cj = CMPLX(REAL(ckm) * s2,  AIMAG(ckm) * s2,  &
    760                           KIND=fftkind) - &
     754                          KIND=wp) - &
    761755                          CMPLX(REAL(cjm) * s72, AIMAG(cjm) * s72, &
    762                           KIND=fftkind)
    763                      array(k2) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=fftkind)
    764                      array(k3) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=fftkind)
     756                          KIND=wp)
     757                     array(k2) = ck + CMPLX(-AIMAG(cj), REAL(cj), KIND=wp)
     758                     array(k3) = ck + CMPLX(AIMAG(cj), -REAL(cj), KIND=wp)
    765759                     kk = k4 + kspan
    766760                     IF (kk >= nn) EXIT
     
    776770                  c1 = COS(s1)
    777771                  s1 = SIN(s1)
    778                   cosine (jf) = 1.0_fftkind
    779                   sine (jf) = 0.0_fftkind
     772                  cosine (jf) = 1.0_wp
     773                  sine (jf) = 0.0_wp
    780774                  j = 1
    781775                  DO
     
    816810                        jj = j
    817811                        ck = cc
    818                         cj = (0.0_fftkind, 0.0_fftkind)
     812                        cj = (0.0_wp, 0.0_wp)
    819813                        k = 1
    820814                        DO
     
    822816                           ck = ck + CMPLX( &
    823817                                REAL (ctmp(k)) * cosine(jj), &
    824                                 AIMAG(ctmp(k)) * cosine(jj), KIND=fftkind)
     818                                AIMAG(ctmp(k)) * cosine(jj), KIND=wp)
    825819                           k = k + 1
    826820                           cj = cj + CMPLX( &
    827821                                REAL (ctmp(k)) * sine(jj), &
    828                                 AIMAG(ctmp(k)) * sine(jj), KIND=fftkind)
     822                                AIMAG(ctmp(k)) * sine(jj), KIND=wp)
    829823                           jj = jj + j
    830824                           IF (jj > jf) jj = jj - jf
     
    833827                        k = jf - j
    834828                        array(k1) = ck + CMPLX(-AIMAG(cj), REAL(cj), &
    835                              KIND=fftkind)
     829                             KIND=wp)
    836830                        array(k2) = ck + CMPLX(AIMAG(cj), -REAL(cj), &
    837                              KIND=fftkind)
     831                             KIND=wp)
    838832                        j = j + 1
    839833                        IF (j >= k) EXIT
     
    852846            kk = jc + 1
    853847            DO
    854                c2 = 1.0_fftkind - cd
     848               c2 = 1.0_wp - cd
    855849               s1 = sd
    856850               DO
     
    860854                  DO
    861855                     DO
    862                         array(kk) = CMPLX(c2, s2, KIND=fftkind) * array(kk)
     856                        array(kk) = CMPLX(c2, s2, KIND=wp) * array(kk)
    863857                        kk = kk + ispan
    864858                        IF (kk > nt) EXIT
     
    872866                  c2 = c1 - (cd * c1 + sd * s1)
    873867                  s1 = s1 + sd * c1 - cd * s1
    874                   c1 = 2.0_fftkind - (c2 * c2 + s1 * s1)
     868                  c1 = 2.0_wp - (c2 * c2 + s1 * s1)
    875869                  s1 = s1 * c1
    876870                  c2 = c2 * c1
     
    892886!
    893887!--   Formal parameters
    894       COMPLEX(fftkind), DIMENSION(*), INTENT(IN OUT):: array
    895       INTEGER,                        INTENT(IN)    :: ntotal, npass, nspan
    896       INTEGER,          DIMENSION(*), INTENT(IN OUT):: factor
    897       INTEGER,                        INTENT(IN)    :: nfactor, nsquare
    898       INTEGER,                        INTENT(IN)    :: maxfactor
    899       COMPLEX(fftkind), DIMENSION(*), INTENT(OUT)   :: ctmp
    900       INTEGER,          DIMENSION(*), INTENT(OUT)   :: perm
     888      COMPLEX(wp), DIMENSION(*), INTENT(IN OUT):: array
     889      COMPLEX(wp),  DIMENSION(*), INTENT(OUT)   :: ctmp
     890      INTEGER(iwp),               INTENT(IN)    :: ntotal, npass, nspan
     891      INTEGER(iwp), DIMENSION(*), INTENT(IN OUT):: factor
     892      INTEGER(iwp),               INTENT(IN)    :: nfactor, nsquare
     893      INTEGER(iwp),               INTENT(IN)    :: maxfactor
     894      INTEGER(iwp), DIMENSION(*), INTENT(OUT)   :: perm
    901895!
    902896!--   Local scalars
    903       INTEGER         :: ii, ispan
    904       INTEGER         :: j, jc, jj
    905       INTEGER         :: k, kk, kspan, kt, k1, k2, k3
    906       INTEGER         :: nn, nt
    907       COMPLEX(fftkind):: ck
    908 
     897      COMPLEX(wp) :: ck
     898      INTEGER(iwp):: ii, ispan
     899      INTEGER(iwp):: j, jc, jj
     900      INTEGER(iwp):: k, kk, kspan, kt, k1, k2, k3
     901      INTEGER(iwp):: nn, nt
    909902!
    910903!--   Permute the results to normal order---done in two stages
Note: See TracChangeset for help on using the changeset viewer.