diff --git a/base/serial/aux/ibsrch.f b/base/serial/aux/ibsrch.f index eb676b7b..5fa3e57a 100644 --- a/base/serial/aux/ibsrch.f +++ b/base/serial/aux/ibsrch.f @@ -29,6 +29,7 @@ C POSSIBILITY OF SUCH DAMAGE. C C subroutine ibsrch(ipos,key,n,v) + implicit none integer ipos, key, n integer v(n) diff --git a/base/serial/aux/imsr.f90 b/base/serial/aux/imsr.f90 index a7d54e20..b5dfff9f 100644 --- a/base/serial/aux/imsr.f90 +++ b/base/serial/aux/imsr.f90 @@ -33,6 +33,8 @@ ! Parameters: subroutine imsr(n,x,idir) use psb_serial_mod + implicit none + integer :: n, idir integer :: x(n) diff --git a/base/serial/aux/imsru.f90 b/base/serial/aux/imsru.f90 index 136cc330..5fe9d4f1 100644 --- a/base/serial/aux/imsru.f90 +++ b/base/serial/aux/imsru.f90 @@ -33,6 +33,7 @@ ! Parameters: subroutine imsru(n,x,idir,nout) use psb_serial_mod + implicit none integer :: n, idir,nout integer :: x(n) diff --git a/base/serial/aux/imsrx.f90 b/base/serial/aux/imsrx.f90 index 53eda348..11a35950 100644 --- a/base/serial/aux/imsrx.f90 +++ b/base/serial/aux/imsrx.f90 @@ -33,6 +33,7 @@ ! Parameters: subroutine imsrx(n,x,indx,idir,flag) use psb_serial_mod + implicit none integer :: n,idir,flag integer :: x(n) integer :: indx(n) diff --git a/base/serial/aux/isaperm.f b/base/serial/aux/isaperm.f index f5224cbe..d303493b 100644 --- a/base/serial/aux/isaperm.f +++ b/base/serial/aux/isaperm.f @@ -45,6 +45,8 @@ C * * *********************************************************************** LOGICAL FUNCTION ISAPERM(N,IP) + implicit none + C .. Scalar Arguments .. INTEGER N C .. diff --git a/base/serial/aux/isr.f90 b/base/serial/aux/isr.f90 index 7b421eb2..a6491ee0 100644 --- a/base/serial/aux/isr.f90 +++ b/base/serial/aux/isr.f90 @@ -31,6 +31,7 @@ subroutine isr(n,x,dir) use psb_serial_mod + implicit none ! ! Quicksort. ! Adapted from a number of sources, including Don Knuth's TAOCP. @@ -40,8 +41,9 @@ subroutine isr(n,x,dir) integer :: x(n) ! .. ! .. Local Scalars .. - integer i, j, xx, ilx, iux, istp, piv, lpiv - integer it1, n1, n2 + integer :: xx, xk, piv, xt + integer i, j, ilx, iux, istp, lpiv + integer n1, n2 integer, parameter :: maxstack=64,nparms=3,ithrs=16 integer :: istack(nparms,maxstack) @@ -77,29 +79,29 @@ subroutine isr(n,x,dir) lpiv = (i+j)/2 piv = x(lpiv) if (piv < x(i)) then - it1 = x(i) + xt = x(i) x(i) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt piv = x(lpiv) endif if (piv > x(j)) then - it1 = x(j) + xt = x(j) x(j) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt piv = x(lpiv) endif if (piv < x(i)) then - it1 = x(i) + xt = x(i) x(i) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt piv = x(lpiv) endif ! ! now piv is correct; place it into first location - it1 = x(i) + xt = x(i) x(i) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt i = ilx - 1 j = iux + 1 @@ -113,19 +115,19 @@ subroutine isr(n,x,dir) ! ! Ensure finite termination for next loop ! - it1 = xk + xt = xk x(i) = piv in_up2:do j = j - 1 xk = x(j) if (xk <= piv) exit in_up2 end do in_up2 - x(i) = it1 + x(i) = xt if (j > i) then - it1 = x(i) + xt = x(i) x(i) = x(j) - x(j) = it1 + x(j) = xt else exit outer_up end if @@ -202,29 +204,29 @@ subroutine isr(n,x,dir) lpiv = (i+j)/2 piv = x(lpiv) if (piv > x(i)) then - it1 = x(i) + xt = x(i) x(i) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt piv = x(lpiv) endif if (piv < x(j)) then - it1 = x(j) + xt = x(j) x(j) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt piv = x(lpiv) endif if (piv > x(i)) then - it1 = x(i) + xt = x(i) x(i) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt piv = x(lpiv) endif ! ! now piv is correct; place it into first location - it1 = x(i) + xt = x(i) x(i) = x(lpiv) - x(lpiv) = it1 + x(lpiv) = xt i = ilx - 1 j = iux + 1 @@ -238,19 +240,19 @@ subroutine isr(n,x,dir) ! ! Ensure finite termination for next loop ! - it1 = xk + xt = xk x(i) = piv in_dw2:do j = j - 1 xk = x(j) if (xk >= piv) exit in_dw2 end do in_dw2 - x(i) = it1 + x(i) = xt if (j > i) then - it1 = x(i) + xt = x(i) x(i) = x(j) - x(j) = it1 + x(j) = xt else exit outer_dw end if @@ -311,6 +313,8 @@ subroutine isr(n,x,dir) contains subroutine iisr_up(n,x) + implicit none + integer :: n integer :: x(n) integer :: i,j @@ -332,6 +336,7 @@ contains end subroutine iisr_up subroutine iisr_dw(n,x) + implicit none integer :: n integer :: x(n) integer :: i,j diff --git a/base/serial/aux/isrx.f90 b/base/serial/aux/isrx.f90 index df48e338..4642155f 100644 --- a/base/serial/aux/isrx.f90 +++ b/base/serial/aux/isrx.f90 @@ -30,6 +30,7 @@ !!$ subroutine isrx(n,x,indx,dir,flag) use psb_serial_mod + implicit none ! ! Quicksort with indices into original positions. ! Adapted from a number of sources, including Don Knuth's TAOCP. @@ -39,8 +40,9 @@ subroutine isrx(n,x,indx,dir,flag) integer :: x(n), indx(n) ! .. ! .. Local Scalars .. - integer i, j, ii, xx, ilx, iux, istp, piv, lpiv - integer it1, it2, n1, n2 + integer :: xx, piv, xk, xt + integer i, j, ii, ilx, iux, istp, lpiv + integer ixt, n1, n2 integer, parameter :: maxstack=64,nparms=3,ithrs=16 integer :: istack(nparms,maxstack) @@ -88,40 +90,40 @@ subroutine isrx(n,x,indx,dir,flag) lpiv = (i+j)/2 piv = x(lpiv) if (piv < x(i)) then - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(lpiv) indx(i) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) endif if (piv > x(j)) then - it1 = x(j) - it2 = indx(j) + xt = x(j) + ixt = indx(j) x(j) = x(lpiv) indx(j) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) endif if (piv < x(i)) then - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(lpiv) indx(i) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(lpiv) indx(i) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -136,22 +138,22 @@ subroutine isrx(n,x,indx,dir,flag) ! ! Ensure finite termination for next loop ! - it1 = xk + xt = xk x(i) = piv in_up2:do j = j - 1 xk = x(j) if (xk <= piv) exit in_up2 end do in_up2 - x(i) = it1 + x(i) = xt if (j > i) then - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(j) indx(i) = indx(j) - x(j) = it1 - indx(j) = it2 + x(j) = xt + indx(j) = ixt else exit outer_up end if @@ -229,40 +231,40 @@ subroutine isrx(n,x,indx,dir,flag) lpiv = (i+j)/2 piv = x(lpiv) if (piv > x(i)) then - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(lpiv) indx(i) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) endif if (piv < x(j)) then - it1 = x(j) - it2 = indx(j) + xt = x(j) + ixt = indx(j) x(j) = x(lpiv) indx(j) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) endif if (piv > x(i)) then - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(lpiv) indx(i) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) endif ! ! now piv is correct; place it into first location - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(lpiv) indx(i) = indx(lpiv) - x(lpiv) = it1 - indx(lpiv) = it2 + x(lpiv) = xt + indx(lpiv) = ixt piv = x(lpiv) i = ilx - 1 @@ -277,22 +279,22 @@ subroutine isrx(n,x,indx,dir,flag) ! ! Ensure finite termination for next loop ! - it1 = xk + xt = xk x(i) = piv in_dw2:do j = j - 1 xk = x(j) if (xk >= piv) exit in_dw2 end do in_dw2 - x(i) = it1 + x(i) = xt if (j > i) then - it1 = x(i) - it2 = indx(i) + xt = x(i) + ixt = indx(i) x(i) = x(j) indx(i) = indx(j) - x(j) = it1 - indx(j) = it2 + x(j) = xt + indx(j) = ixt else exit outer_dw end if @@ -353,6 +355,7 @@ subroutine isrx(n,x,indx,dir,flag) contains subroutine iisrx_up(n,x,indx) + implicit none integer :: n integer :: x(n) integer :: indx(n) @@ -378,6 +381,7 @@ contains end subroutine iisrx_up subroutine iisrx_dw(n,x,indx) + implicit none integer :: n integer :: x(n) integer :: indx(n) diff --git a/base/serial/aux/issrch.f b/base/serial/aux/issrch.f index c5119c15..2f2c0566 100644 --- a/base/serial/aux/issrch.f +++ b/base/serial/aux/issrch.f @@ -29,6 +29,7 @@ C POSSIBILITY OF SUCH DAMAGE. C C subroutine issrch(ipos,key,n,v) + implicit none integer ipos, key, n integer v(n) diff --git a/base/serial/aux/msort_dw.f90 b/base/serial/aux/msort_dw.f90 index 527952ff..bce133d2 100644 --- a/base/serial/aux/msort_dw.f90 +++ b/base/serial/aux/msort_dw.f90 @@ -68,6 +68,7 @@ ! ! subroutine msort_dw(n,k,l,iret) + implicit none integer n, iret integer k(n),l(0:n+1) ! diff --git a/base/serial/aux/msort_up.f90 b/base/serial/aux/msort_up.f90 index 4c10b11c..3eee931f 100644 --- a/base/serial/aux/msort_up.f90 +++ b/base/serial/aux/msort_up.f90 @@ -68,6 +68,7 @@ ! ! subroutine msort_up(n,k,l,iret) + implicit none integer n, iret integer k(n),l(0:n+1) !