fdurastante/psblas3
1
0
Fork 0
mirror of https://github.com/sfilippone/psblas3.git synced 2026-10-20 04:42:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Merged changes at r2702 from branch psblas-ovtrans.

Browse Source
This commit is contained in:
Salvatore Filippone
2008-01-14 15:31:12 +00:00
parent 7f758de51c
commit c8c211c0e9
119 changed files with 2944 additions and 2490 deletions
Download Patch File Download Diff File Expand all files Collapse all files
base/modules/psb_comm_mod.f90
+205 -189
View File
@@ -31,204 +31,220 @@
module psb_comm_mod
interface psb_ovrl
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,jx,ik,mode
end subroutine psb_dovrlm
subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,mode
end subroutine psb_dovrlv
subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,jx,ik,mode
end subroutine psb_zovrlm
subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,mode
end subroutine psb_zovrlv
subroutine psb_dovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,jx,ik,mode
end subroutine psb_dovrlm
subroutine psb_dovrlv(x,desc_a,info,work,update,mode)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,mode
end subroutine psb_dovrlv
subroutine psb_iovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_descriptor_type
integer, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,jx,ik,mode
end subroutine psb_iovrlm
subroutine psb_iovrlv(x,desc_a,info,work,update,mode)
use psb_descriptor_type
integer, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,mode
end subroutine psb_iovrlv
subroutine psb_zovrlm(x,desc_a,info,jx,ik,work,update,mode)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,jx,ik,mode
end subroutine psb_zovrlm
subroutine psb_zovrlv(x,desc_a,info,work,update,mode)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(inout), optional :: work(:)
integer, intent(in), optional :: update,mode
end subroutine psb_zovrlv
end interface
interface psb_halo
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
end subroutine psb_dhalom
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_dhalov
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type
integer, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
integer, intent(inout), optional :: work(:)
integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
end subroutine psb_ihalom
subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
integer, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
integer, intent(inout), optional :: work(:)
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_ihalov
subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(in), optional :: alpha
complex(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
end subroutine psb_zhalom
subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(in), optional :: alpha
complex(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_zhalov
subroutine psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
end subroutine psb_dhalom
subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
real(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
real(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_dhalov
subroutine psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type
integer, intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
integer, intent(inout), optional :: work(:)
integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
end subroutine psb_ihalom
subroutine psb_ihalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
integer, intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
real(kind(1.d0)), intent(in), optional :: alpha
integer, intent(inout), optional :: work(:)
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_ihalov
subroutine psb_zhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode,data)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(in), optional :: alpha
complex(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,jx,ik,data
character, intent(in), optional :: tran
end subroutine psb_zhalom
subroutine psb_zhalov(x,desc_a,info,alpha,work,tran,mode,data)
use psb_descriptor_type
complex(kind(1.d0)), intent(inout) :: x(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
complex(kind(1.d0)), intent(in), optional :: alpha
complex(kind(1.d0)), target, optional :: work(:)
integer, intent(in), optional :: mode,data
character, intent(in), optional :: tran
end subroutine psb_zhalov
end interface
interface psb_dscatter
subroutine psb_dscatterm(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(out) :: locx(:,:)
real(kind(1.d0)), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dscatterm
subroutine psb_dscatterv(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(out) :: locx(:)
real(kind(1.d0)), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dscatterv
subroutine psb_zscatterm(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(out) :: locx(:,:)
complex(kind(1.d0)), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zscatterm
subroutine psb_zscatterv(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(out) :: locx(:)
complex(kind(1.d0)), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zscatterv
subroutine psb_iscatterm(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(out) :: locx(:,:)
integer, intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_iscatterm
subroutine psb_iscatterv(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(out) :: locx(:)
integer, intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_iscatterv
subroutine psb_dscatterm(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(out) :: locx(:,:)
real(kind(1.d0)), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dscatterm
subroutine psb_dscatterv(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(out) :: locx(:)
real(kind(1.d0)), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dscatterv
subroutine psb_zscatterm(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(out) :: locx(:,:)
complex(kind(1.d0)), intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zscatterm
subroutine psb_zscatterv(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(out) :: locx(:)
complex(kind(1.d0)), intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zscatterv
subroutine psb_iscatterm(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(out) :: locx(:,:)
integer, intent(in) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_iscatterm
subroutine psb_iscatterv(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(out) :: locx(:)
integer, intent(in) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_iscatterv
end interface
interface psb_gather
subroutine psb_igatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(in) :: locx(:,:)
integer, intent(out) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_igatherm
subroutine psb_igatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(in) :: locx(:)
integer, intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_igatherv
subroutine psb_dgatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(in) :: locx(:,:)
real(kind(1.d0)), intent(out) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dgatherm
subroutine psb_dgatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(in) :: locx(:)
real(kind(1.d0)), intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dgatherv
subroutine psb_zgatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(in) :: locx(:,:)
complex(kind(1.d0)), intent(out) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zgatherm
subroutine psb_zgatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(in) :: locx(:)
complex(kind(1.d0)), intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zgatherv
subroutine psb_igatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(in) :: locx(:,:)
integer, intent(out) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_igatherm
subroutine psb_igatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type
integer, intent(in) :: locx(:)
integer, intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_igatherv
subroutine psb_dgatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(in) :: locx(:,:)
real(kind(1.d0)), intent(out) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dgatherm
subroutine psb_dgatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type
real(kind(1.d0)), intent(in) :: locx(:)
real(kind(1.d0)), intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_dgatherv
subroutine psb_zgatherm(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(in) :: locx(:,:)
complex(kind(1.d0)), intent(out) :: globx(:,:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zgatherm
subroutine psb_zgatherv(globx, locx, desc_a, info, root)
use psb_descriptor_type
complex(kind(1.d0)), intent(in) :: locx(:)
complex(kind(1.d0)), intent(out) :: globx(:)
type(psb_desc_type), intent(in) :: desc_a
integer, intent(out) :: info
integer, intent(in), optional :: root
end subroutine psb_zgatherv
end interface
end module psb_comm_mod
base/modules/psb_desc_type.f90
+1 -1
View File
@@ -266,7 +266,7 @@ module psb_descriptor_type
integer, allocatable :: halo_index(:), ext_index(:)
integer, allocatable :: bnd_elem(:)
integer, allocatable :: ovrlap_index(:)
integer, allocatable :: ovrlap_elem(:)
integer, allocatable :: ovrlap_elem(:,:)
integer, allocatable :: loc_to_glob(:)
integer, allocatable :: glob_to_loc (:)
integer, allocatable :: hashv(:), glb_lc(:,:), ptree(:)
base/modules/psb_error_mod.F90
+11 -11
View File
@@ -222,7 +222,7 @@ contains
new_node%next => error_stack%top
error_stack%top => new_node
error_stack%n_elems = error_stack%n_elems+1
if(error_status.eq.0) error_status=1
if(error_status == 0) error_status=1
nullify(new_node)
end subroutine psb_errpush
@@ -246,7 +246,7 @@ contains
old_node => error_stack%top
error_stack%top => old_node%next
error_stack%n_elems = error_stack%n_elems - 1
if(error_stack%n_elems.eq.0) error_status=0
if(error_stack%n_elems == 0) error_status=0
deallocate(old_node)
@@ -266,10 +266,10 @@ contains
integer, parameter :: ione=1, izero=0
if(error_status.gt.0) then
if(verbosity_level.gt.1) then
if(error_status > 0) then
if(verbosity_level > 1) then
do while (error_stack%n_elems.gt.izero)
do while (error_stack%n_elems > izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
@@ -284,7 +284,7 @@ contains
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d,me)
do while (error_stack%n_elems.gt.0)
do while (error_stack%n_elems > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
#if defined(SERIAL_MPI)
@@ -295,7 +295,7 @@ contains
end if
end if
if(error_status.gt.izero) then
if(error_status > izero) then
#if defined(SERIAL_MPI)
stop
#else
@@ -316,10 +316,10 @@ contains
integer :: i_e_d(5)
integer, parameter :: ione=1, izero=0
if(error_status.gt.0) then
if(verbosity_level.gt.1) then
if(error_status > 0) then
if(verbosity_level > 1) then
do while (error_stack%n_elems.gt.izero)
do while (error_stack%n_elems > izero)
write(0,'(50("="))')
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
@@ -330,7 +330,7 @@ contains
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
call psb_errmsg(err_c, r_name, i_e_d, a_e_d)
do while (error_stack%n_elems.gt.0)
do while (error_stack%n_elems > 0)
call psb_errpop(err_c, r_name, i_e_d, a_e_d)
end do
end if
base/modules/psb_gps_mod.f90
+63 -63
View File
@@ -62,11 +62,11 @@ CONTAINS
! INDICES OF THE NONZERO ELEMENTS OF THE MATRIX, A. THE ALGO-
! RITHM IS DESCRIBED IN TERMS OF THE ADJACENCY GRAPH WHICH
! HAS THE CHARACTERISTIC THAT THERE IS AN EDGE (CONNECTION)
! BETWEEN NODES I AND J IF A(I,J) .NE. 0 AND I .NE. J.
! BETWEEN NODES I AND J IF A(I,J) /= 0 AND I /= J.
! DIMENSIONING INFORMATION--THE FOLLOWING INTEGER ARRAYS MUST BE
! DIMENSIONED IN THE CALLING ROUTINE.
! NDSTK(NR,D1) D1 IS .GE. MAXIMUM DEGREE OF ALL NODES.
! IOLD(D2) D2 AND NR ARE .GE. THE TOTAL NUMBER OF
! NDSTK(NR,D1) D1 IS >= MAXIMUM DEGREE OF ALL NODES.
! IOLD(D2) D2 AND NR ARE >= THE TOTAL NUMBER OF
! RENUM(D2+1) NODES IN THE GRAPH.
! NDEG(D2) STORAGE REQUIREMENTS CAN BE SIGNIFICANTLY
! LVL(D2) DECREASED FOR IBM 360 AND 370 COMPUTERS
@@ -146,7 +146,7 @@ CONTAINS
STNUM = N
! NUMBER THE NODES OF DEGREE ZERO
DO I=1,N
IF (NDEG(I).GT.0) CYCLE
IF (NDEG(I) > 0) CYCLE
RENUM(I) = STNUM
STNUM = STNUM - 1
END DO
@@ -156,8 +156,8 @@ CONTAINS
NFLG = 1
ISDIR = 1
DO I=1,N
IF (NDEG(I).GE.LOWDG) CYCLE
IF (RENUM(I).GT.0) CYCLE
IF (NDEG(I) >= LOWDG) CYCLE
IF (RENUM(I) > 0) CYCLE
LOWDG = NDEG(I)
STNODE = I
END DO
@@ -165,7 +165,7 @@ CONTAINS
! STNODE AND RVNODE ARE THE ENDS OF THE DIAM AND LVLS1 AND LVLS2
! ARE THE RESPECTIVE LEVEL STRUCTURES.
CALL FNDIAM(STNODE, RVNODE, NDSTK, NR, NDEG, LVL, LVLS1,LVLS2, CCSTOR, IDFLT)
IF (.not.(ndeg(stnode).le.ndeg(rvnode))) then
IF (.not.(ndeg(stnode) <= ndeg(rvnode))) then
! NFLG INDICATES THE END TO BEGIN NUMBERING ON
NFLG = -1
STNODE = RVNODE
@@ -176,7 +176,7 @@ CONTAINS
LROOT = 1
LVLN = 1
DO I=1,N
IF (LVL(I).NE.0) CYCLE
IF (LVL(I) /= 0) CYCLE
XCC = XCC + 1
STPT(XCC) = LROOT
CALL TREE(I, NDSTK, NR, LVL, CCSTOR, NDEG, LVLWTH, LVLBOT,LVLN, MAXLW, N)
@@ -192,13 +192,13 @@ CONTAINS
! DIRECTION. NUM IS SET TO THE PROPER VALUE FOR THIS DIRECTION.
ISDIR = ISDIR*NFLG
NUM = SBNUM
IF (ISDIR.LT.0) NUM = STNUM
IF (ISDIR < 0) NUM = STNUM
CALL NUMBER(STNODE, NUM, NDSTK, LVLS2, NDEG, RENUM, LVLS1,LVL,&
& NR, NFLG, IBW2, IPF2, CCSTOR, ISDIR)
! UPDATE STNUM OR SBNUM AFTER NUMBERING
IF (ISDIR.LT.0) STNUM = NUM
IF (ISDIR.GT.0) SBNUM = NUM
IF (.not.(sbnum.le.stnum)) exit
IF (ISDIR < 0) STNUM = NUM
IF (ISDIR > 0) SBNUM = NUM
IF (.not.(sbnum <= stnum)) exit
end do
IF (IBW2 > IBW1) then
! IF ORIGINAL NUMBERING IS BETTER THAN NEW ONE, SET UP TO RETURN IT
@@ -233,10 +233,10 @@ CONTAINS
IF(ITST <= 0) EXIT
NDEG(I) = NDEG(I) + 1
IDIF = IOLD(I) - IOLD(ITST)
IF (IRW.LT.IDIF) IRW = IDIF
IF (IRW < IDIF) IRW = IDIF
END DO
IPF1 = IPF1 + IRW
IF (IRW.GT.IBW1) IBW1 = IRW
IF (IRW > IBW1) IBW1 = IRW
END DO
RETURN
END SUBROUTINE DGREE
@@ -251,7 +251,7 @@ CONTAINS
! LVLS1- ARRAY CONTAINING LEVEL STRUCTURE WITH SND1 AS ROOT
! LVLS2- ARRAY CONTAINING LEVEL STRUCTURE WITH SND2 AS ROOT
! IDFLT- FLAG USED IN PICKING FINAL LEVEL STRUCTURE, SET
! =1 IF WIDTH OF LVLS1 .LE. WIDTH OF LVLS2, OTHERWISE =2
! =1 IF WIDTH OF LVLS1 <= WIDTH OF LVLS2, OTHERWISE =2
! LVL,IWK- WORKING STORAGE
! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370.
INTEGER NDSTK
@@ -274,7 +274,7 @@ CONTAINS
LVLN = 1
! DROP A TREE FROM SND
CALL TREE(SND, NDSTK, NR, LVL, IWK, NDEG, LVLWTH, LVLBOT,LVLN, MAXLW, MTW2)
IF (FLAG.GE.1) GO TO 50
IF (FLAG >= 1) GO TO 50
FLAG = 1
30 IDPTH = LVLN - 1
MTW1 = MAXLW
@@ -289,24 +289,24 @@ CONTAINS
CALL SORTDG(NDLST, IWK(LVLBOT), NDXL, LVLWTH, NDEG)
SND = NDLST(1)
GO TO 10
50 IF (IDPTH.GE.LVLN-1) GO TO 60
50 IF (IDPTH >= LVLN-1) GO TO 60
! START AGAIN WITH NEW STARTING NODE
SND1 = SND
GO TO 30
60 IF (MAXLW.GE.MTW2) GO TO 80
60 IF (MAXLW >= MTW2) GO TO 80
MTW2 = MAXLW
SND2 = SND
! STORE NARROWEST REVERSE LEVEL STRUCTURE IN LVLS2
DO 70 I=1,N
LVLS2(I) = LVL(I)
70 END DO
80 IF (NDXN.EQ.NDXL) GO TO 90
80 IF (NDXN == NDXL) GO TO 90
! TRY NEXT NODE IN NDLST
NDXN = NDXN + 1
SND = NDLST(NDXN)
GO TO 10
90 IDFLT = 1
IF (MTW2.LE.MTW1) IDFLT = 2
IF (MTW2 <= MTW1) IDFLT = 2
NULLIFY(NDLST)
RETURN
END SUBROUTINE FNDIAM
@@ -328,7 +328,7 @@ CONTAINS
! CONNECTED COMPONENTS, LVLN IS NEXT AVAILABLE LOCATION.
! ON OUTPUT THE TOTAL NUMBER OF LEVELS + 1
! IBORT- INPUT PARAM WHICH TRIGGERS EARLY RETURN IF
! MAXLW BECOMES .GE. IBORT
! MAXLW BECOMES >= IBORT
! USE INTEGER*2 NDSTK WITH AN IBM 360 OR 370.
INTEGER NDSTK
DIMENSION NDSTK(NR,IDEG), LVL(N), IWK(N), NDEG(N)
@@ -345,17 +345,17 @@ CONTAINS
NDROW = NDEG(IWKNOW)
DO 30 J=1,NDROW
ITEST = NDSTK(IWKNOW,J)
IF (LVL(ITEST).NE.0) CYCLE
IF (LVL(ITEST) /= 0) CYCLE
LVL(ITEST) = LVLN
ITOP = ITOP + 1
IWK(ITOP) = ITEST
30 END DO
INOW = INOW + 1
IF (INOW.LT.LVLTOP) GO TO 20
IF (INOW < LVLTOP) GO TO 20
LVLWTH = LVLTOP - LVLBOT
IF (MAXLW.LT.LVLWTH) MAXLW = LVLWTH
IF (MAXLW.GE.IBORT) RETURN
IF (ITOP.LT.LVLTOP) RETURN
IF (MAXLW < LVLWTH) MAXLW = LVLWTH
IF (MAXLW >= IBORT) RETURN
IF (ITOP < LVLTOP) RETURN
LVLBOT = INOW
LVLTOP = ITOP + 1
GO TO 10
@@ -371,18 +371,18 @@ CONTAINS
IND = X2
10 ITEST = 0
IND = IND - 1
IF (IND.LT.1) GO TO 30
IF (IND < 1) GO TO 30
DO 20 I=1,IND
J = I + 1
ISTK2 = STK2(I)
JSTK2 = STK2(J)
IF (NDEG(ISTK2).LE.NDEG(JSTK2)) CYCLE
IF (NDEG(ISTK2) <= NDEG(JSTK2)) CYCLE
ITEST = 1
TEMP = STK2(I)
STK2(I) = STK2(J)
STK2(J) = TEMP
20 END DO
IF (ITEST.EQ.1) GO TO 10
IF (ITEST == 1) GO TO 10
30 DO 40 I=1,X2
X1 = X1 + 1
STK1(X1) = STK2(I)
@@ -403,7 +403,7 @@ CONTAINS
INTEGER :: SZ
!-----------------------------------------------------
SZ=SIZE(NACUM)
IF(SZ .LT. IDPTH) THEN
IF(SZ < IDPTH) THEN
WRITE(*,*) 'GPS_SETUP: on fly reallocation of NACUM'
CALL REALLOC(NACUM,SZ,IDPTH)
END IF
@@ -415,8 +415,8 @@ CONTAINS
LVL(I) = 1
LVLS2(I) = IDPTH + 1 - LVLS2(I)
ITEMP = LVLS2(I)
IF (ITEMP.GT.IDPTH) CYCLE
IF (ITEMP.NE.LVLS1(I)) GO TO 20
IF (ITEMP > IDPTH) CYCLE
IF (ITEMP /= LVLS1(I)) GO TO 20
NACUM(ITEMP) = NACUM(ITEMP) + 1
CYCLE
20 LVL(I) = 0
@@ -432,15 +432,15 @@ CONTAINS
!COMMON /CC/ XCC, SIZEG(50), STPT(50)
SORT2 = 0
IF (XCC.EQ.0) RETURN
IF (XCC == 0) RETURN
SORT2 = 1
IND = XCC
10 ITEST = 0
IND = IND - 1
IF (IND.LT.1) RETURN
IF (IND < 1) RETURN
DO 20 I=1,IND
J = I + 1
IF (SIZEG(I).GE.SIZEG(J)) CYCLE
IF (SIZEG(I) >= SIZEG(J)) CYCLE
ITEST = 1
TEMP = SIZEG(I)
SIZEG(I) = SIZEG(J)
@@ -449,7 +449,7 @@ CONTAINS
STPT(I) = STPT(J)
STPT(J) = TEMP
20 END DO
IF (ITEST.EQ.1) GO TO 10
IF (ITEST == 1) GO TO 10
RETURN
END FUNCTION SORT2
!
@@ -459,7 +459,7 @@ CONTAINS
! LVLS2- ON INPUT CONTAINS REVERSE LEVELING INFO
! ON OUTPUT THE FINAL LEVEL STRUCTURE CHOSEN
! CCSTOR- ON INPUT CONTAINS CONNECTED COMPONENT INFO
! IDFLT- ON INPUT =1 IF WDTH LVLS1.LE.WDTH LVLS2, =2 OTHERWISE
! IDFLT- ON INPUT =1 IF WDTH LVLS1 <= WDTH LVLS2, =2 OTHERWISE
! NHIGH KEEPS TRACK OF LEVEL WIDTHS FOR HIGH NUMBERING
! NLOW- KEEPS TRACK OF LEVEL WIDTHS FOR LOW NUMBERING
! NACUM- KEEPS TRACK OF LEVEL WIDTHS FOR CHOSEN LEVEL STRUCTURE
@@ -483,12 +483,12 @@ CONTAINS
! SET NHIGH AND NLOW EQUAL TO NACUM
!-----------------------------------------------------
SZ=SIZE(NHIGH)
IF(SZ .LT. IDPTH) THEN
IF(SZ < IDPTH) THEN
WRITE(*,*) 'GPS_PIKLVL: on fly reallocation of NHIGH'
CALL REALLOC(NHIGH,SZ,IDPTH)
END IF
SZ=SIZE(NLOW)
IF(SZ .LT. IDPTH) THEN
IF(SZ < IDPTH) THEN
WRITE(*,*) 'GPS_PIKLVL: on fly reallocation of NLOW'
CALL REALLOC(NLOW,SZ,IDPTH)
END IF
@@ -510,16 +510,16 @@ CONTAINS
! SET MAX1=LARGEST NEW NUMBER IN NHIGH
! SET MAX2=LARGEST NEW NUMBER IN NLOW
DO 30 K=1,IDPTH
IF (2*NACUM(K).EQ.NLOW(K)+NHIGH(K)) CYCLE
IF (NHIGH(K).GT.MAX1) MAX1 = NHIGH(K)
IF (NLOW(K).GT.MAX2) MAX2 = NLOW(K)
IF (2*NACUM(K) == NLOW(K)+NHIGH(K)) CYCLE
IF (NHIGH(K) > MAX1) MAX1 = NHIGH(K)
IF (NLOW(K) > MAX2) MAX2 = NLOW(K)
30 END DO
! SET IT= NUMBER OF LEVEL STRUCTURE TO BE USED
IT = 1
IF (MAX1.GT.MAX2) IT = 2
IF (MAX1.EQ.MAX2) IT = IDFLT
IF (IT.EQ.2) GO TO 60
IF (I.EQ.1) ISDIR = -1
IF (MAX1 > MAX2) IT = 2
IF (MAX1 == MAX2) IT = IDFLT
IF (IT == 2) GO TO 60
IF (I == 1) ISDIR = -1
! COPY LVLS1 INTO LVLS2 FOR EACH NODE IN CONNECTED COMPONENT
DO 40 K=J,ENDC
INODE = CCSTOR(K)
@@ -580,7 +580,7 @@ CONTAINS
DO 30 I=1,IDPTH
LSTPT(I) = NSTPT
DO 20 J=1,N
IF (LVLS2(J).NE.I) CYCLE
IF (LVLS2(J) /= I) CYCLE
LVLST(NSTPT) = J
NSTPT = NSTPT + 1
20 END DO
@@ -592,7 +592,7 @@ CONTAINS
! LVLN KEEPS TRACK OF THE LEVEL WE ARE WORKING AT.
! INITIALLY STKC CONTAINS ONLY THE INITIAL NODE, SND.
LVLN = 0
IF (NFLG.LT.0) LVLN = IDPTH + 1
IF (NFLG < 0) LVLN = IDPTH + 1
XC = 1
STKC(XC) = SND
40 CX = 1
@@ -612,16 +612,16 @@ CONTAINS
TEST = NDSTK(IPRO,I)
INX = RENUM(TEST)
! ONLY NODES NOT NUMBERED OR ALREADY ON A STACK ARE ADDED
IF (INX.EQ.0) GO TO 60
IF (INX.LT.0) CYCLE
IF (INX == 0) GO TO 60
IF (INX < 0) CYCLE
! DO PRELIMINARY BANDWIDTH AND PROFILE CALCULATIONS
NBW = (RENUM(IPRO)-INX)*ISDIR
IF (ISDIR.GT.0) INX = RENUM(IPRO)
IF (IPFA(INX).LT.NBW) IPFA(INX) = NBW
IF (ISDIR > 0) INX = RENUM(IPRO)
IF (IPFA(INX) < NBW) IPFA(INX) = NBW
CYCLE
60 RENUM(TEST) = -1
! PUT NODES ON SAME LEVEL ON STKA, ALL OTHERS ON STKB
IF (LVLS2(TEST).EQ.LVLS2(IPRO)) GO TO 70
IF (LVLS2(TEST) == LVLS2(IPRO)) GO TO 70
XB = XB + 1
STKB(XB) = TEST
CYCLE
@@ -630,8 +630,8 @@ CONTAINS
80 END DO
! SORT STKA AND STKB INTO INCREASING DEGREE AND ADD STKA TO STKC
! AND STKB TO STKD
IF (XA.EQ.0) GO TO 100
IF (XA.EQ.1) GO TO 90
IF (XA == 0) GO TO 100
IF (XA == 1) GO TO 90
!-----------------------------------------------------------------
SZ1=SIZE(STKC)
SZ2=XC+XA
@@ -655,8 +655,8 @@ CONTAINS
END IF
!-----------------------------------------------------------------
STKC(XC) = STKA(XA)
100 IF (XB.EQ.0) GO TO 120
IF (XB.EQ.1) GO TO 110
100 IF (XB == 0) GO TO 120
IF (XB == 1) GO TO 110
!-----------------------------------------------------------------
SZ1=SIZE(STKD)
SZ2=XD+XB
@@ -682,21 +682,21 @@ CONTAINS
STKD(XD) = STKB(XB)
! BE SURE TO PROCESS ALL NODES IN STKC
120 CX = CX + 1
IF (XC.GE.CX) GO TO 50
IF (XC >= CX) GO TO 50
! WHEN STKC IS EXHAUSTED LOOK FOR MIN DEGREE NODE IN SAME LEVEL
! WHICH HAS NOT BEEN PROCESSED
MAX = IDEG + 1
SND = N + 1
DO 130 I=LST,LND
TEST = LVLST(I)
IF (RENUM(TEST).NE.0) CYCLE
IF (NDEG(TEST).GE.MAX) CYCLE
IF (RENUM(TEST) /= 0) CYCLE
IF (NDEG(TEST) >= MAX) CYCLE
RENUM(SND) = 0
RENUM(TEST) = -1
MAX = NDEG(TEST)
SND = TEST
130 END DO
IF (SND.EQ.N+1) GO TO 140
IF (SND == N+1) GO TO 140
XC = XC + 1
!-----------------------------------------------------------------
SZ1=SIZE(STKC)
@@ -712,7 +712,7 @@ CONTAINS
GO TO 50
! IF STKD IS EMPTY WE ARE DONE, OTHERWISE COPY STKD ONTO STKC
! AND BEGIN PROCESSING NEW STKC
140 IF (XD.EQ.0) GO TO 160
140 IF (XD == 0) GO TO 160
!-----------------------------------------------------------------
SZ1=SIZE(STKC)
SZ2=XD
@@ -730,7 +730,7 @@ CONTAINS
GO TO 40
! DO FINAL BANDWIDTH AND PROFILE CALCULATIONS
160 DO 170 I=1,N
IF (IPFA(I).GT.IBW2) IBW2 = IPFA(I)
IF (IPFA(I) > IBW2) IBW2 = IPFA(I)
IPF2 = IPF2 + IPFA(I)
170 END DO
!
base/modules/psb_realloc_mod.F90
+29 -29
View File
@@ -96,7 +96,7 @@ Contains
name='psb_cpy1d'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info = 0
if (allocated(vin)) then
isz = size(vin)
@@ -118,7 +118,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -143,7 +143,7 @@ Contains
name='psb_cpy1d'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info = 0
if (allocated(vin)) then
isz1 = size(vin,1)
@@ -167,7 +167,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -192,7 +192,7 @@ Contains
name='psb_cpy1d'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info = 0
if (allocated(vin)) then
isz = size(vin)
@@ -214,7 +214,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -239,7 +239,7 @@ Contains
name='psb_cpy1d'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info = 0
if (allocated(vin)) then
isz1 = size(vin,1)
@@ -263,7 +263,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -288,7 +288,7 @@ Contains
name='psb_cpy1d'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info = 0
if (allocated(vin)) then
isz = size(vin)
@@ -310,7 +310,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -335,7 +335,7 @@ Contains
name='psb_cpy1d'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info = 0
if (allocated(vin)) then
isz1 = size(vin,1)
@@ -359,7 +359,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -473,7 +473,7 @@ Contains
name='psb_ensure_size'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
If (len > psb_size(v)) Then
@@ -501,7 +501,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -529,7 +529,7 @@ Contains
name='psb_ensure_size'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
If (len > psb_size(v)) Then
@@ -557,7 +557,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -585,7 +585,7 @@ Contains
name='psb_ensure_size'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
If (len > psb_size(v)) Then
@@ -612,7 +612,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -642,7 +642,7 @@ Contains
call psb_erractionsave(err_act)
if (debug) write(0,*) 'reallocate I',len
if (psb_get_errstatus().ne.0) return
if (psb_get_errstatus() /= 0) return
info=0
if (present(lb)) then
lb_ = lb
@@ -689,7 +689,7 @@ Contains
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -765,7 +765,7 @@ Contains
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -839,7 +839,7 @@ Contains
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -932,7 +932,7 @@ Contains
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -1026,7 +1026,7 @@ Contains
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -1117,7 +1117,7 @@ Contains
info = err
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -1140,7 +1140,7 @@ Contains
name='psb_dreallocate2i'
call psb_erractionsave(err_act)
if(psb_get_errstatus().ne.0) return
if(psb_get_errstatus() /= 0) return
info=0
call psb_dreallocate1i(len,rrax,info,pad=pad)
if (info /= 0) then
@@ -1160,7 +1160,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -1211,7 +1211,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
@@ -1260,7 +1260,7 @@ Contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_ret_) then
if (err_act == psb_act_ret_) then
return
else
call psb_error()
base/modules/psb_sort_mod.f90
+10 -10
View File
@@ -171,7 +171,7 @@ contains
end if
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -231,7 +231,7 @@ contains
end if
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -290,7 +290,7 @@ contains
end if
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -330,7 +330,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -406,7 +406,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -482,7 +482,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -571,7 +571,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -681,7 +681,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -789,7 +789,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -897,7 +897,7 @@ contains
9999 continue
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
base/modules/psb_spmat_type.f90
+14 -14
View File
@@ -365,7 +365,7 @@ contains
if (clear_) a%aspk(:) = dzero
if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then
if(a%fida(1:3).eq.'JAD') then
if(a%fida(1:3) == 'JAD') then
a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0
else
a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0
@@ -397,7 +397,7 @@ contains
logical, parameter :: debug=.false.
info = 0
if (nnz.lt.0) then
if (nnz < 0) then
info=45
return
Endif
@@ -463,7 +463,7 @@ contains
logical, parameter :: debug=.false.
info = 0
if (nnz.lt.0) then
if (nnz < 0) then
info=45
return
endif
@@ -534,7 +534,7 @@ contains
logical, parameter :: debug=.false.
info = 0
if (nnz.lt.0) then
if (nnz < 0) then
info=45
return
endif
@@ -910,7 +910,7 @@ contains
if (clear_) a%aspk(:) = zzero
if (psb_sp_getifld(psb_upd_,a,info)==psb_upd_perm_) then
if(a%fida(1:3).eq.'JAD') then
if(a%fida(1:3) == 'JAD') then
a%ia1(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0
else
a%ia2(a%infoa(psb_upd_pnt_)+psb_nnz_) = 0
@@ -942,7 +942,7 @@ contains
logical, parameter :: debug=.false.
info = 0
if (nnz.lt.0) then
if (nnz < 0) then
info=45
return
Endif
@@ -1008,7 +1008,7 @@ contains
logical, parameter :: debug=.false.
info = 0
if (nnz.lt.0) then
if (nnz < 0) then
info=45
return
endif
@@ -1101,7 +1101,7 @@ contains
integer :: ifc_
info = 0
if (nnz.lt.0) then
if (nnz < 0) then
info=45
return
endif
@@ -1450,14 +1450,14 @@ contains
nz=0
blkfnd: do
j=j+1
if(ia1(j).eq.idx) then
if(ia1(j) == idx) then
nz=nz+ia3(j)-ia2(j)
ipx = ia1(j) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
else if(ia1(j).gt.idx) then
else if(ia1(j) > idx) then
nz=nz+ia3(j-1)-ia2(j-1)
ipx = ia1(j-1) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
@@ -1500,7 +1500,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
@@ -1605,14 +1605,14 @@ contains
nz=0
blkfnd: do
j=j+1
if(ia1(j).eq.idx) then
if(ia1(j) == idx) then
nz=nz+ia3(j)-ia2(j)
ipx = ia1(j) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
row = ia3(j)+rb
nz = nz+ja(row+1)-ja(row)
exit blkfnd
else if(ia1(j).gt.idx) then
else if(ia1(j) > idx) then
nz=nz+ia3(j-1)-ia2(j-1)
ipx = ia1(j-1) ! the first row index of the block
rb = idx-ipx ! the row offset within the block
@@ -1655,7 +1655,7 @@ contains
9999 continue
call psb_erractionrestore(err_act)
if (err_act.eq.psb_act_abort_) then
if (err_act == psb_act_abort_) then
call psb_error()
return
end if
base/modules/psb_tools_mod.f90
+9 -8
View File
@@ -674,14 +674,15 @@ contains
subroutine psb_cdasb(desc_a,info)
use psb_descriptor_type
interface
subroutine psb_icdasb(desc_a,info,ext_hv)
use psb_descriptor_type
Type(psb_desc_type), intent(inout) :: desc_a
integer, intent(out) :: info
logical, intent(in),optional :: ext_hv
end subroutine psb_icdasb
end interface
interface
subroutine psb_icdasb(desc_a,info,ext_hv)
use psb_descriptor_type
Type(psb_desc_type), intent(inout) :: desc_a
integer, intent(out) :: info
logical, intent(in),optional :: ext_hv
end subroutine psb_icdasb
end interface
Type(psb_desc_type), intent(inout) :: desc_a
integer, intent(out) :: info
base/modules/psi_mod.f90
+971 -231
View File
File diff suppressed because it is too large Load Diff