From b220064d37c2154f2e8b620ecbc22325e486e972 Mon Sep 17 00:00:00 2001
From: Salvatore Filippone <salvatore.filippone@cranfield.ac.uk>
Date: Tue, 28 Nov 2006 14:02:59 +0000
Subject: [PATCH] *** empty log message ***

---
 src/serial/aux/imsr.f90  |  2 +-
 src/serial/aux/imsrx.f90 | 25 ++++++++++++++-----------
 src/serial/dp/reordvn.f  | 30 ++++++++++++++++++++++++++++++
 3 files changed, 45 insertions(+), 12 deletions(-)

diff --git a/src/serial/aux/imsr.f90 b/src/serial/aux/imsr.f90
index 121c53e7..c183ece9 100644
--- a/src/serial/aux/imsr.f90
+++ b/src/serial/aux/imsr.f90
@@ -41,7 +41,7 @@ subroutine imsr(n,x)
   integer :: lswap
 
   if (n<0) then 
-    write(0,*) 'Error: IMSR: N<0'
+!!$    write(0,*) 'Error: IMSR: N<0'
     return
   endif
   
diff --git a/src/serial/aux/imsrx.f90 b/src/serial/aux/imsrx.f90
index ee50b03d..8bc7d15a 100644
--- a/src/serial/aux/imsrx.f90
+++ b/src/serial/aux/imsrx.f90
@@ -31,13 +31,13 @@
 ! File:  imsrx.f90 
  ! Subroutine: 
  ! Parameters:
-subroutine imsrx(n,x,indx)
-  integer :: n
+subroutine imsrx(n,x,indx,flag)
+  integer :: n, flag
   integer :: x(n)
   integer :: indx(n)
-  
+
   integer, allocatable :: iaux(:)
-  
+
   integer :: iswap, iret, info, lp, k
   integer :: lswap, ixswap
 
@@ -45,10 +45,12 @@ subroutine imsrx(n,x,indx)
     write(0,*) 'Error: IMSRX: N<0'
     return
   endif
-  
+
   if (n==0) return
   if (n==1) then 
-    indx(1) = 1
+    if (flag == 0) then 
+      indx(1) = 1
+    endif
     return
   endif
 
@@ -58,12 +60,13 @@ subroutine imsrx(n,x,indx)
     return
   endif
 
-  do k=1,n
-    indx(k) = k
-  enddo
-
+  if (flag == 0) then 
+    do k=1,n
+      indx(k) = k
+    enddo
+  end if
   call mrgsrt(n,x,iaux,iret)
-  
+
   if (iret /= 1) then 
     lp = iaux(0)
     k  = 1
diff --git a/src/serial/dp/reordvn.f b/src/serial/dp/reordvn.f
index 8d6c7344..fc00c5c1 100644
--- a/src/serial/dp/reordvn.f
+++ b/src/serial/dp/reordvn.f
@@ -60,6 +60,36 @@ C        ... Swap of vectors IA2, IA1, AR ...
       LP      = LSWAP
       KK      = KK+1
       GOTO 500
+ 800  CONTINUE
+      return
+      end
+      subroutine ireordv2(nnz,ia1,ia2,idx)
+      integer nnz
+      integer ia1(*),ia2(*),idx(0:*)
+      integer lp, kk, swapia1, swapia2, lswap
+
+      LP = IDX(0)
+      KK = 1
+ 500  CONTINUE
+      IF ((LP.EQ.0).OR.(KK.GT.NNZ)) GOTO 800
+ 600  CONTINUE
+      IF (LP.GE.KK) GOTO 700
+      LP = IDX(LP)
+      GOTO 600
+ 700  CONTINUE
+C        ... Swap of vectors IA2, IA1 ..
+      SWAPIA2 = IA2(KK)
+      SWAPIA1 = IA1(KK)
+      IA2(KK) = IA2(LP)
+      IA1(KK) = IA1(LP)
+      IA2(LP) = SWAPIA2
+      IA1(LP) = SWAPIA1
+      LSWAP   = IDX(LP)
+      IDX(LP) = IDX(KK)
+      IDX(KK) = LP
+      LP      = LSWAP
+      KK      = KK+1
+      GOTO 500
  800  CONTINUE
       return
       end