*** empty log message ***

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
   

src/serial/aux/imsrx.f90

@@ -31,13 +31,13 @@
 ! File:  imsrx.f90 
  ! Subroutine: 
  ! Parameters:
-subroutine imsrx(n,x,indx)
+subroutine imsrx(n,x,indx,flag)
-  integer :: n
+  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
+  if (flag == 0) then 
-    indx(k) = k
+    do k=1,n
-  enddo
+      indx(k) = k
-
+    enddo
+  end if
   call mrgsrt(n,x,iaux,iret)
-  
+
   if (iret /= 1) then 
     lp = iaux(0)
     k  = 1

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