*** empty log message ***

psblas3-type-indexed
Salvatore Filippone 18 years ago
parent 2b48a169bf
commit b220064d37

@ -41,7 +41,7 @@ subroutine imsr(n,x)
integer :: lswap integer :: lswap
if (n<0) then if (n<0) then
write(0,*) 'Error: IMSR: N<0' !!$ write(0,*) 'Error: IMSR: N<0'
return return
endif endif

@ -31,8 +31,8 @@
! File: imsrx.f90 ! File: imsrx.f90
! Subroutine: ! Subroutine:
! Parameters: ! Parameters:
subroutine imsrx(n,x,indx) subroutine imsrx(n,x,indx,flag)
integer :: n integer :: n, flag
integer :: x(n) integer :: x(n)
integer :: indx(n) integer :: indx(n)
@ -48,7 +48,9 @@ subroutine imsrx(n,x,indx)
if (n==0) return if (n==0) return
if (n==1) then if (n==1) then
indx(1) = 1 if (flag == 0) then
indx(1) = 1
endif
return return
endif endif
@ -58,10 +60,11 @@ subroutine imsrx(n,x,indx)
return return
endif 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) call mrgsrt(n,x,iaux,iret)
if (iret /= 1) then if (iret /= 1) then

@ -60,6 +60,36 @@ C ... Swap of vectors IA2, IA1, AR ...
LP = LSWAP LP = LSWAP
KK = KK+1 KK = KK+1
GOTO 500 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 800 CONTINUE
return return
end end

Loading…
Cancel
Save