Skip to content

Commit ab13c44

Browse files
jacobwilliamsjacobwilliams
committed
manual cleanups.
added back rk module
1 parent 60b793a commit ab13c44

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

50 files changed

+505
-712
lines changed

‎src/cfftb1.f90‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,9 @@
1-
!*==CFFTB1.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine cfftb1(n,c,Ch,Wa,Ifac)
32
use fftpack_kind
43
implicit none
5-
!*--CFFTB15
6-
!*** Start of declarations inserted by SPAG
7-
real c , Ch , fftpack_kind , rk , Wa
8-
integer i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 ,&
9-
& k1 , l1 , l2 , n , n2 , na , nac , nf
10-
!*** End of declarations inserted by SPAG
4+
real(rk) :: c , Ch , Wa
5+
integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4, &
6+
k1 , l1 , l2 , n , n2 , na , nac , nf
117
dimension Ch(*) , c(*) , Wa(*) , Ifac(*)
128
nf = Ifac(2)
139
na = 0

‎src/cfftf1.f90‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,9 @@
1-
!*==CFFTF1.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine cfftf1(n,c,Ch,Wa,Ifac)
32
use fftpack_kind
43
implicit none
5-
!*--CFFTF177
6-
!*** Start of declarations inserted by SPAG
7-
real c , Ch , fftpack_kind , rk , Wa
8-
integer i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4 ,&
9-
& k1 , l1 , l2 , n , n2 , na , nac , nf
10-
!*** End of declarations inserted by SPAG
4+
real(rk) :: c , Ch , Wa
5+
integer :: i , idl1 , ido , idot , Ifac , ip , iw , ix2 , ix3 , ix4, &
6+
k1 , l1 , l2 , n , n2 , na , nac , nf
117
dimension Ch(*) , c(*) , Wa(*) , Ifac(*)
128
nf = Ifac(2)
139
na = 0

‎src/cffti1.f90‎

Lines changed: 12 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,12 @@
1-
!*==CFFTI1.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine cffti1(n,Wa,Ifac)
32
use fftpack_kind
43
implicit none
5-
!*--CFFTI1149
6-
!*** Start of declarations inserted by SPAG
7-
real arg , argh , argld , fftpack_kind , fi , rk , tpi , Wa
8-
integer i , i1 , ib , ido , idot , Ifac , ii , ip , ipm , j , k1 ,&
9-
& l1 , l2 , ld , n , nf , nl , nq , nr , ntry
10-
integer ntryh
11-
!*** End of declarations inserted by SPAG
12-
dimension Wa(*) , Ifac(*) , ntryh(4)
13-
data ntryh(1) , ntryh(2) , ntryh(3) , ntryh(4)/3 , 4 , 2 , 5/
4+
real(rk) :: arg , argh , argld , fi , Wa
5+
integer :: i , i1 , ib , ido , idot , Ifac , ii , ip , ipm , j , k1, &
6+
l1 , l2 , ld , n , nf , nl , nq , nr , ntry
7+
dimension Wa(*) , Ifac(*)
8+
integer,dimension(4),parameter :: ntryh = [3 , 4 , 2 , 5]
9+
real(rk),parameter :: tpi = 2.0_rk * acos(-1.0_rk) ! 2 * pi
1410
nl = n
1511
nf = 0
1612
j = 0
@@ -38,8 +34,7 @@ subroutine cffti1(n,Wa,Ifac)
3834
if ( nl/=1 ) goto 200
3935
Ifac(1) = n
4036
Ifac(2) = nf
41-
tpi = 6.28318530717958647692d0
42-
argh = tpi/real(n,rk)
37+
argh = tpi/real(n, rk)
4338
i = 2
4439
l1 = 1
4540
do k1 = 1 , nf
@@ -51,14 +46,14 @@ subroutine cffti1(n,Wa,Ifac)
5146
ipm = ip - 1
5247
do j = 1 , ipm
5348
i1 = i
54-
Wa(i-1) = 1.0d0
55-
Wa(i) = 0.0d0
49+
Wa(i-1) = 1.0_rk
50+
Wa(i) = 0.0_rk
5651
ld = ld + l1
57-
fi = 0.0d0
58-
argld = real(ld,rk)*argh
52+
fi = 0.0_rk
53+
argld = real(ld, rk)*argh
5954
do ii = 4 , idot , 2
6055
i = i + 2
61-
fi = fi + 1.d0
56+
fi = fi + 1.0_rk
6257
arg = fi*argld
6358
Wa(i-1) = cos(arg)
6459
Wa(i) = sin(arg)

‎src/cosqb1.f90‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,9 @@
1-
!*==COSQB1.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine cosqb1(n,x,w,Xh)
32
use fftpack_kind
43
implicit none
5-
!*--COSQB1222
6-
!*** Start of declarations inserted by SPAG
7-
real fftpack_kind , rk , w , x , Xh , xim1
8-
integer i , k , kc , modn , n , np2 , ns2
9-
!*** End of declarations inserted by SPAG
10-
dimension x(1) , w(1) , Xh(1)
4+
integer :: i , k , kc , modn , n , np2 , ns2
5+
real(rk) :: w , x , Xh , xim1
6+
dimension x(*) , w(*) , Xh(*)
117
ns2 = (n+1)/2
128
np2 = n + 2
139
do i = 3 , n , 2

‎src/cosqf1.f90‎

Lines changed: 3 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,9 @@
1-
!*==COSQF1.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine cosqf1(n,x,w,Xh)
32
use fftpack_kind
43
implicit none
5-
!*--COSQF1256
6-
!*** Start of declarations inserted by SPAG
7-
real fftpack_kind , rk , w , x , Xh , xim1
8-
integer i , k , kc , modn , n , np2 , ns2
9-
!*** End of declarations inserted by SPAG
10-
dimension x(1) , w(1) , Xh(1)
4+
integer :: i , k , kc , modn , n , np2 , ns2
5+
real(rk) :: w , x , Xh , xim1
6+
dimension x(*) , w(*) , Xh(*)
117
ns2 = (n+1)/2
128
np2 = n + 2
139
do k = 2 , ns2

‎src/dcosqb.f90‎

Lines changed: 5 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,15 @@
1-
!*==DCOSQB.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine dcosqb(n,x,Wsave)
32
use fftpack_kind
43
implicit none
5-
!*--DCOSQB288
6-
!*** Start of declarations inserted by SPAG
7-
real fftpack_kind , rk , tsqrt2 , Wsave , x , x1
8-
integer n
9-
!*** End of declarations inserted by SPAG
4+
integer :: n
5+
real(rk) :: Wsave , x , x1
106
dimension x(*) , Wsave(*)
11-
data tsqrt2/2.82842712474619009760d0/
7+
real(rk),parameter :: tsqrt2 = 2.0_rk * sqrt(2.0_rk)
128
if ( n<2 ) then
13-
x(1) = 4.0d0*x(1)
9+
x(1) = 4.0_rk*x(1)
1410
return
1511
elseif ( n==2 ) then
16-
x1 = 4.0d0*(x(1)+x(2))
12+
x1 = 4.0_rk*(x(1)+x(2))
1713
x(2) = tsqrt2*(x(1)-x(2))
1814
x(1) = x1
1915
return

‎src/dcosqf.f90‎

Lines changed: 5 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,17 @@
1-
!*==DCOSQF.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine dcosqf(n,x,Wsave)
32
use fftpack_kind
43
implicit none
5-
!*--DCOSQF311
6-
!*** Start of declarations inserted by SPAG
7-
real fftpack_kind , rk , sqrt2 , tsqx , Wsave , x
8-
integer n
9-
!*** End of declarations inserted by SPAG
4+
integer :: n
5+
real(rk) :: tsqx , Wsave , x
106
dimension x(*) , Wsave(*)
11-
data sqrt2/1.41421356237309504880d0/
7+
real(rk),parameter :: sqrt2 = sqrt(2.0_rk)
128
if ( n<2 ) then
9+
return
1310
elseif ( n==2 ) then
1411
tsqx = sqrt2*x(2)
1512
x(2) = x(1) - tsqx
1613
x(1) = x(1) + tsqx
1714
else
1815
call cosqf1(n,x,Wsave,Wsave(n+1))
19-
goto 99999
2016
endif
21-
return
22-
99999 end subroutine dcosqf
17+
end subroutine dcosqf

‎src/dcosqi.f90‎

Lines changed: 7 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,14 @@
1-
!*==DCOSQI.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine dcosqi(n,Wsave)
32
use fftpack_kind
43
implicit none
5-
!*--DCOSQI333
6-
!*** Start of declarations inserted by SPAG
7-
real dt , fftpack_kind , fk , pih , rk , Wsave
8-
integer k , n
9-
!*** End of declarations inserted by SPAG
10-
dimension Wsave(1)
11-
data pih/1.57079632679489661923d0/
12-
dt = pih/real(n,rk)
13-
fk = 0.0d0
4+
real(rk) :: dt , fk , Wsave
5+
integer :: k , n
6+
dimension Wsave(*)
7+
real(rk),parameter :: pih = acos(-1.0_rk) / 2.0_rk ! pi / 2
8+
dt = pih/real(n, rk)
9+
fk = 0.0_rk
1410
do k = 1 , n
15-
fk = fk + 1.0d0
11+
fk = fk + 1.0_rk
1612
Wsave(k) = cos(fk*dt)
1713
enddo
1814
call dffti(n,Wsave(n+1))

‎src/dcost.f90‎

Lines changed: 6 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,18 +1,14 @@
1-
!*==DCOST.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine dcost(n,x,Wsave)
32
use fftpack_kind
43
implicit none
5-
!*--DCOST352
6-
!*** Start of declarations inserted by SPAG
7-
real c1 , fftpack_kind , rk , t1 , t2 , tx2 , Wsave , x , x1h , &
8-
& x1p3 , xi , xim2
9-
integer i , k , kc , modn , n , nm1 , np1 , ns2
10-
!*** End of declarations inserted by SPAG
4+
real(rk) :: c1 , t1 , t2 , tx2 , Wsave , x , x1h , x1p3 , &
5+
xi , xim2
6+
integer :: i , k , kc , modn , n , nm1 , np1 , ns2
117
dimension x(*) , Wsave(*)
128
nm1 = n - 1
139
np1 = n + 1
1410
ns2 = n/2
15-
if ( n<2 ) goto 99999
11+
if ( n<2 ) return
1612
if ( n==2 ) then
1713
x1h = x(1) + x(2)
1814
x(2) = x(1) - x(2)
@@ -42,12 +38,11 @@ subroutine dcost(n,x,Wsave)
4238
xim2 = xi
4339
enddo
4440
if ( modn/=0 ) x(n) = xim2
45-
goto 99999
41+
return
4642
endif
4743
x1p3 = x(1) + x(3)
4844
tx2 = x(2) + x(2)
4945
x(2) = x(1) - x(3)
5046
x(1) = x1p3 + tx2
5147
x(3) = x1p3 - tx2
52-
return
53-
99999 end subroutine dcost
48+
end subroutine dcost

‎src/dcosti.f90‎

Lines changed: 9 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -1,25 +1,21 @@
1-
!*==DCOSTI.spg processed by SPAG 6.72Dc at 19:17 on 14 Sep 2021
21
subroutine dcosti(n,Wsave)
32
use fftpack_kind
43
implicit none
5-
!*--DCOSTI405
6-
!*** Start of declarations inserted by SPAG
7-
real dt , fftpack_kind , fk , pi , rk , Wsave
8-
integer k , kc , n , nm1 , np1 , ns2
9-
!*** End of declarations inserted by SPAG
10-
dimension Wsave(1)
11-
data pi/3.14159265358979323846d0/
4+
real(rk) :: dt , fk , Wsave
5+
integer :: k , kc , n , nm1 , np1 , ns2
6+
dimension Wsave(*)
7+
real(rk),parameter :: pi = acos(-1.0_rk)
128
if ( n<=3 ) return
139
nm1 = n - 1
1410
np1 = n + 1
1511
ns2 = n/2
16-
dt = pi/real(nm1,rk)
17-
fk = 0.0d0
12+
dt = pi/real(nm1, rk)
13+
fk = 0.0_rk
1814
do k = 2 , ns2
1915
kc = np1 - k
20-
fk = fk + 1.0d0
21-
Wsave(k) = 2.0d0*sin(fk*dt)
22-
Wsave(kc) = 2.0d0*cos(fk*dt)
16+
fk = fk + 1.0_rk
17+
Wsave(k) = 2.0_rk*sin(fk*dt)
18+
Wsave(kc) = 2.0_rk*cos(fk*dt)
2319
enddo
2420
call dffti(nm1,Wsave(n+1))
2521
end subroutine dcosti

0 commit comments

Comments
 (0)