Skip to content

Commit 8476c39

Browse files
loiseaujcloiseaujc
authored
Merge pull request #58 from loiseaujc/intent_specs
Intent specifications for all subroutines
2 parents c1205d0 + afcfff6 commit 8476c39

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

+2376
-2303
lines changed

‎src/cfftb1.f90‎

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

‎src/cfftf1.f90‎

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

0 commit comments

Comments
 (0)