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

Author: jacobwilliams

src/Makefile

@@ -1,53 +1,53 @@
 SRCF = \
-	zfftb.f\
-	cfftb1.f\
-	zfftf.f\
-	cfftf1.f\
-	zffti.f\
-	cffti1.f\
-	dcosqb.f\
-	cosqb1.f\
-	dcosqf.f\
-	cosqf1.f\
-	dcosqi.f\
-	dcost.f\
-	dcosti.f\
-	ezfft1.f\
-	dzfftb.f\
-	dzfftf.f\
-	dzffti.f\
-	passb.f\
-	passb2.f\
-	passb3.f\
-	passb4.f\
-	passb5.f\
-	passf.f\
-	passf2.f\
-	passf3.f\
-	passf4.f\
-	passf5.f\
-	radb2.f\
-	radb3.f\
-	radb4.f\
-	radb5.f\
-	radbg.f\
-	radf2.f\
-	radf3.f\
-	radf4.f\
-	radf5.f\
-	radfg.f\
-	dfftb.f\
-	rfftb1.f\
-	dfftf.f\
-	rfftf1.f\
-	dffti.f\
-	rffti1.f\
-	dsinqb.f\
-	dsinqf.f\
-	dsinqi.f\
-	dsint.f\
-	sint1.f\
-	dsinti.f
+	zfftb.f90\
+	cfftb1.f90\
+	zfftf.f90\
+	cfftf1.f90\
+	zffti.f90\
+	cffti1.f90\
+	dcosqb.f90\
+	cosqb1.f90\
+	dcosqf.f90\
+	cosqf1.f90\
+	dcosqi.f90\
+	dcost.f90\
+	dcosti.f90\
+	ezfft1.f90\
+	dzfftb.f90\
+	dzfftf.f90\
+	dzffti.f90\
+	passb.f90\
+	passb2.f90\
+	passb3.f90\
+	passb4.f90\
+	passb5.f90\
+	passf.f90\
+	passf2.f90\
+	passf3.f90\
+	passf4.f90\
+	passf5.f90\
+	radb2.f90\
+	radb3.f90\
+	radb4.f90\
+	radb5.f90\
+	radbg.f90\
+	radf2.f90\
+	radf3.f90\
+	radf4.f90\
+	radf5.f90\
+	radfg.f90\
+	dfftb.f90\
+	rfftb1.f90\
+	dfftf.f90\
+	rfftf1.f90\
+	dffti.f90\
+	rffti1.f90\
+	dsinqb.f90\
+	dsinqf.f90\
+	dsinqi.f90\
+	dsint.f90\
+	sint1.f90\
+	dsinti.f90
 
 SRCF90 = \
 	fftpack.f90\

src/cfftb1.f

@@ -0,0 +1,68 @@
+      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

src/cfftb1.f90

@@ -0,0 +1,68 @@
+      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