fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-16 19:02:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
Alfredo Buttari
2005-12-09 15:48:05 +00:00
parent 8c82169764
commit 59dbb18a52
1 changed files with 27 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/modules/psb_realloc_mod.f90
+27 -20
View File
@@ -34,25 +34,33 @@ Contains
if(psb_get_errstatus().ne.0) return
info=0
if (associated(rrax)) then
dim=size(rrax)
If (dim /= len) Then
Allocate(tmp(len),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
goto 9999
end if
!!$ write(0,*) 'IA: copying ',len,dim
if (.true.) then
do i=1, min(len,dim)
tmp(i)=rrax(i)
end do
else
tmp(1:min(len,dim))=rrax(1:min(len,dim))
end if
!!$ write(0,*) 'IA: copying done'
Deallocate(rrax,stat=info)
if (info /= 0) then
<<<<<<< psb_realloc_mod.f90
dim=size(rrax)
If (dim /= len) Then
Allocate(tmp(len),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
goto 9999
end if
if (.true.) then
do i=1, min(len,dim)
tmp(i)=rrax(i)
end do
else
tmp(1:min(len,dim))=rrax(1:min(len,dim))
end if
Deallocate(rrax,stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
goto 9999
end if
rrax=>tmp
End If
else
allocate(rrax(len),stat=info)
if (info /= 0) then
err=4000
call psb_errpush(err,name)
goto 9999
@@ -69,7 +77,6 @@ Contains
end if
endif
if (present(pad)) then
!!$ write(0,*) 'IA: padding'
rrax(dim+1:len) = pad
endif