Skip to content

Commit 41fae14

Browse files
jacobwilliamsjacobwilliams
committed
initial refactor to free-form source
convert to lower case added subroutine names to END fixed issues where x(1) was being used instead of x(*) for dummy arguments declare all variables and add implicit none replaced float with real replaced double precision literals in data statements with parameters computed for rk kind restructuring and elimination of most gotos and line numbers replaced old style logical operators with modern updated makefile
1 parent 1c23efa commit 41fae14

Some content is hidden

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

101 files changed

+2389
-2226
lines changed

‎src/Makefile

Lines changed: 49 additions & 49 deletions
Original file line numberDiff line numberDiff line change
@@ -1,53 +1,53 @@
11
SRCF = \
2-
zfftb.f\
3-
cfftb1.f\
4-
zfftf.f\
5-
cfftf1.f\
6-
zffti.f\
7-
cffti1.f\
8-
dcosqb.f\
9-
cosqb1.f\
10-
dcosqf.f\
11-
cosqf1.f\
12-
dcosqi.f\
13-
dcost.f\
14-
dcosti.f\
15-
ezfft1.f\
16-
dzfftb.f\
17-
dzfftf.f\
18-
dzffti.f\
19-
passb.f\
20-
passb2.f\
21-
passb3.f\
22-
passb4.f\
23-
passb5.f\
24-
passf.f\
25-
passf2.f\
26-
passf3.f\
27-
passf4.f\
28-
passf5.f\
29-
radb2.f\
30-
radb3.f\
31-
radb4.f\
32-
radb5.f\
33-
radbg.f\
34-
radf2.f\
35-
radf3.f\
36-
radf4.f\
37-
radf5.f\
38-
radfg.f\
39-
dfftb.f\
40-
rfftb1.f\
41-
dfftf.f\
42-
rfftf1.f\
43-
dffti.f\
44-
rffti1.f\
45-
dsinqb.f\
46-
dsinqf.f\
47-
dsinqi.f\
48-
dsint.f\
49-
sint1.f\
50-
dsinti.f
2+
zfftb.f90\
3+
cfftb1.f90\
4+
zfftf.f90\
5+
cfftf1.f90\
6+
zffti.f90\
7+
cffti1.f90\
8+
dcosqb.f90\
9+
cosqb1.f90\
10+
dcosqf.f90\
11+
cosqf1.f90\
12+
dcosqi.f90\
13+
dcost.f90\
14+
dcosti.f90\
15+
ezfft1.f90\
16+
dzfftb.f90\
17+
dzfftf.f90\
18+
dzffti.f90\
19+
passb.f90\
20+
passb2.f90\
21+
passb3.f90\
22+
passb4.f90\
23+
passb5.f90\
24+
passf.f90\
25+
passf2.f90\
26+
passf3.f90\
27+
passf4.f90\
28+
passf5.f90\
29+
radb2.f90\
30+
radb3.f90\
31+
radb4.f90\
32+
radb5.f90\
33+
radbg.f90\
34+
radf2.f90\
35+
radf3.f90\
36+
radf4.f90\
37+
radf5.f90\
38+
radfg.f90\
39+
dfftb.f90\
40+
rfftb1.f90\
41+
dfftf.f90\
42+
rfftf1.f90\
43+
dffti.f90\
44+
rffti1.f90\
45+
dsinqb.f90\
46+
dsinqf.f90\
47+
dsinqi.f90\
48+
dsint.f90\
49+
sint1.f90\
50+
dsinti.f90
5151

5252
SRCF90 = \
5353
fftpack.f90\

‎src/cfftb1.f

Lines changed: 0 additions & 63 deletions
This file was deleted.

‎src/cfftb1.f90

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
subroutine cfftb1(n,c,Ch,Wa,Ifac)
2+
use fftpack_kind
3+
implicit none
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
7+
dimension Ch(*) , c(*) , Wa(*) , Ifac(*)
8+
nf = Ifac(2)
9+
na = 0
10+
l1 = 1
11+
iw = 1
12+
do k1 = 1 , nf
13+
ip = Ifac(k1+2)
14+
l2 = ip*l1
15+
ido = n/l2
16+
idot = ido + ido
17+
idl1 = idot*l1
18+
if ( ip==4 ) then
19+
ix2 = iw + idot
20+
ix3 = ix2 + idot
21+
if ( na/=0 ) then
22+
call passb4(idot,l1,Ch,c,Wa(iw),Wa(ix2),Wa(ix3))
23+
else
24+
call passb4(idot,l1,c,Ch,Wa(iw),Wa(ix2),Wa(ix3))
25+
endif
26+
na = 1 - na
27+
elseif ( ip==2 ) then
28+
if ( na/=0 ) then
29+
call passb2(idot,l1,Ch,c,Wa(iw))
30+
else
31+
call passb2(idot,l1,c,Ch,Wa(iw))
32+
endif
33+
na = 1 - na
34+
elseif ( ip==3 ) then
35+
ix2 = iw + idot
36+
if ( na/=0 ) then
37+
call passb3(idot,l1,Ch,c,Wa(iw),Wa(ix2))
38+
else
39+
call passb3(idot,l1,c,Ch,Wa(iw),Wa(ix2))
40+
endif
41+
na = 1 - na
42+
elseif ( ip/=5 ) then
43+
if ( na/=0 ) then
44+
call passb(nac,idot,ip,l1,idl1,Ch,Ch,Ch,c,c,Wa(iw))
45+
else
46+
call passb(nac,idot,ip,l1,idl1,c,c,c,Ch,Ch,Wa(iw))
47+
endif
48+
if ( nac/=0 ) na = 1 - na
49+
else
50+
ix2 = iw + idot
51+
ix3 = ix2 + idot
52+
ix4 = ix3 + idot
53+
if ( na/=0 ) then
54+
call passb5(idot,l1,Ch,c,Wa(iw),Wa(ix2),Wa(ix3),Wa(ix4))
55+
else
56+
call passb5(idot,l1,c,Ch,Wa(iw),Wa(ix2),Wa(ix3),Wa(ix4))
57+
endif
58+
na = 1 - na
59+
endif
60+
l1 = l2
61+
iw = iw + (ip-1)*idot
62+
enddo
63+
if ( na==0 ) return
64+
n2 = n + n
65+
do i = 1 , n2
66+
c(i) = Ch(i)
67+
enddo
68+
end subroutine cfftb1

‎src/cfftf1.f

Lines changed: 0 additions & 63 deletions
This file was deleted.

‎src/cfftf1.f90

Lines changed: 68 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
subroutine cfftf1(n,c,Ch,Wa,Ifac)
2+
use fftpack_kind
3+
implicit none
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
7+
dimension Ch(*) , c(*) , Wa(*) , Ifac(*)
8+
nf = Ifac(2)
9+
na = 0
10+
l1 = 1
11+
iw = 1
12+
do k1 = 1 , nf
13+
ip = Ifac(k1+2)
14+
l2 = ip*l1
15+
ido = n/l2
16+
idot = ido + ido
17+
idl1 = idot*l1
18+
if ( ip==4 ) then
19+
ix2 = iw + idot
20+
ix3 = ix2 + idot
21+
if ( na/=0 ) then
22+
call passf4(idot,l1,Ch,c,Wa(iw),Wa(ix2),Wa(ix3))
23+
else
24+
call passf4(idot,l1,c,Ch,Wa(iw),Wa(ix2),Wa(ix3))
25+
endif
26+
na = 1 - na
27+
elseif ( ip==2 ) then
28+
if ( na/=0 ) then
29+
call passf2(idot,l1,Ch,c,Wa(iw))
30+
else
31+
call passf2(idot,l1,c,Ch,Wa(iw))
32+
endif
33+
na = 1 - na
34+
elseif ( ip==3 ) then
35+
ix2 = iw + idot
36+
if ( na/=0 ) then
37+
call passf3(idot,l1,Ch,c,Wa(iw),Wa(ix2))
38+
else
39+
call passf3(idot,l1,c,Ch,Wa(iw),Wa(ix2))
40+
endif
41+
na = 1 - na
42+
elseif ( ip/=5 ) then
43+
if ( na/=0 ) then
44+
call passf(nac,idot,ip,l1,idl1,Ch,Ch,Ch,c,c,Wa(iw))
45+
else
46+
call passf(nac,idot,ip,l1,idl1,c,c,c,Ch,Ch,Wa(iw))
47+
endif
48+
if ( nac/=0 ) na = 1 - na
49+
else
50+
ix2 = iw + idot
51+
ix3 = ix2 + idot
52+
ix4 = ix3 + idot
53+
if ( na/=0 ) then
54+
call passf5(idot,l1,Ch,c,Wa(iw),Wa(ix2),Wa(ix3),Wa(ix4))
55+
else
56+
call passf5(idot,l1,c,Ch,Wa(iw),Wa(ix2),Wa(ix3),Wa(ix4))
57+
endif
58+
na = 1 - na
59+
endif
60+
l1 = l2
61+
iw = iw + (ip-1)*idot
62+
enddo
63+
if ( na==0 ) return
64+
n2 = n + n
65+
do i = 1 , n2
66+
c(i) = Ch(i)
67+
enddo
68+
end subroutine cfftf1

0 commit comments

Comments
 (0)