fdurastante
/
psblas3
mirror of https://github.com/sfilippone/psblas3.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Fixed interface to mat_dist to use new envinronment.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent 0aa6ea63f7
commit ccf9f79bfa
3 changed files with 108 additions and 112 deletions
Show Stats Download Patch File Download Diff File

5
test/Fileread/df_sample.f90
Unescape Escape View File

@ -77,6 +77,7 @@ program df_sample
integer :: ictxt, iam, np integer :: ictxt, iam, np
logical :: amroot logical :: amroot
integer, parameter :: root=0
! solver paramters ! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,& integer :: iter, itmax, ierr, itrace, ircode, ipart,&
@ -106,7 +107,7 @@ program df_sample
call psb_exit(ictxt) call psb_exit(ictxt)
stop stop
endif endif
amroot = (iam==0) amroot = (iam==root)
name='df_sample' name='df_sample'
@ -196,7 +197,7 @@ program df_sample
call build_grppart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np) call build_grppart(aux_a%m,aux_a%fida,aux_a%ia1,aux_a%ia2,np)
endif endif
call psb_barrier(ictxt) call psb_barrier(ictxt)
call distr_grppart(0,0,ictxt) call distr_grppart(root,ictxt)
call getv_grppart(ivg) call getv_grppart(ivg)
call matdist(aux_a, a, ivg, ictxt, & call matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)

186
test/Fileread/partgraph.f90
Unescape Escape View File

@ -55,73 +55,72 @@ MODULE PARTGRAPH
public part_graph, build_grppart, distr_grppart,& public part_graph, build_grppart, distr_grppart,&
& getv_grppart, build_usrpart, free_part & getv_grppart, build_usrpart, free_part
private private
INTEGER, POINTER, SAVE :: GRAPH_VECT(:) integer, pointer, save :: graph_vect(:)
CONTAINS CONTAINS
SUBROUTINE PART_GRAPH(GLOBAL_INDX,N,NP,PV,NV) subroutine part_graph(global_indx,n,np,pv,nv)
INTEGER, INTENT(IN) :: GLOBAL_INDX, N, NP integer, intent(in) :: global_indx, n, np
INTEGER, INTENT(OUT) :: NV integer, intent(out) :: nv
INTEGER, INTENT(OUT) :: PV(*) integer, intent(out) :: pv(*)
IF (.NOT.ASSOCIATED(GRAPH_VECT)) THEN IF (.not.associated(graph_vect)) then
WRITE(0,*) 'Fatal error in PART_GRAPH: vector GRAPH_VECT ',& write(0,*) 'Fatal error in PART_GRAPH: vector GRAPH_VECT ',&
& 'not initialized' & 'not initialized'
RETURN return
ENDIF endif
IF ((GLOBAL_INDX<1).OR.(GLOBAL_INDX > SIZE(GRAPH_VECT))) THEN if ((global_indx<1).or.(global_indx > size(graph_vect))) then
WRITE(0,*) 'Fatal error in PART_GRAPH: index GLOBAL_INDX ',& write(0,*) 'Fatal error in PART_GRAPH: index GLOBAL_INDX ',&
& 'outside GRAPH_VECT bounds',global_indx,size(graph_vect) & 'outside GRAPH_VECT bounds',global_indx,size(graph_vect)
RETURN return
ENDIF endif
NV = 1 nv = 1
PV(NV) = GRAPH_VECT(GLOBAL_INDX) pv(nv) = graph_vect(global_indx)
RETURN return
END SUBROUTINE PART_GRAPH end subroutine part_graph
SUBROUTINE DISTR_GRPPART(RROOT, CROOT, ICTXT) subroutine distr_grppart(root, ictxt)
INTEGER :: RROOT, CROOT, ICTXT use psb_sparse_mod
INTEGER :: N, MER, MEC, NPR, NPC integer :: root, ictxt
integer :: n, me, np
CALL BLACS_GRIDINFO(ICTXT,NPR,NPC,MER,MEC) call psb_info(ictxt,me,np)
IF (.NOT.((RROOT>=0).AND.(RROOT<NPR).AND.& if (.not.((root>=0).and.(root<np))) then
& (CROOT>=0).AND.(CROOT<NPC))) THEN write(0,*) 'Fatal error in DISTR_GRPPART: invalid ROOT ',&
WRITE(0,*) 'Fatal error in DISTR_GRPPART: invalid ROOT ',&
& 'coordinates ' & 'coordinates '
CALL BLACS_ABORT(ICTXT,-1) call psb_abort(ictxt)
RETURN return
ENDIF endif
IF ((MER == RROOT) .AND.(MEC == CROOT)) THEN if (me == root) then
IF (.NOT.ASSOCIATED(GRAPH_VECT)) THEN if (.not.associated(graph_vect)) then
WRITE(0,*) 'Fatal error in DISTR_GRPPART: vector GRAPH_VECT ',& write(0,*) 'Fatal error in DISTR_GRPPART: vector GRAPH_VECT ',&
& 'not initialized' & 'not initialized'
CALL BLACS_ABORT(ICTXT,-1) call psb_abort(ictxt)
RETURN return
ENDIF endif
N = SIZE(GRAPH_VECT) n = size(graph_vect)
CALL IGEBS2D(ICTXT,'All',' ',1,1,N,1) call psb_bcast(ictxt,n,root=root)
CALL IGEBS2D(ICTXT,'All',' ',N,1,GRAPH_VECT,N) else
ELSE call psb_bcast(ictxt,n,root=root)
CALL IGEBR2D(ICTXT,'All',' ',1,1,N,1,RROOT,CROOT) !!$ if (associated(graph_vect)) then
!!$ IF (ASSOCIATED(GRAPH_VECT)) THEN !!$ deallocate(graph_vect)
!!$ DEALLOCATE(GRAPH_VECT) !!$ endif
!!$ ENDIF allocate(graph_vect(n),stat=info)
ALLOCATE(GRAPH_VECT(N),STAT=INFO) if (info /= 0) then
IF (INFO /= 0) THEN write(0,*) 'Fatal error in DISTR_GRPPART: memory allocation ',&
WRITE(0,*) 'Fatal error in DISTR_GRPPART: memory allocation ',&
& ' failure.' & ' failure.'
RETURN return
ENDIF endif
CALL IGEBR2D(ICTXT,'All',' ',N,1,GRAPH_VECT,N,RROOT,CROOT) endif
ENDIF call psb_bcast(ictxt,graph_vect(1:n),root=root)
RETURN return
END SUBROUTINE DISTR_GRPPART end subroutine distr_grppart
subroutine getv_grppart(ivg) subroutine getv_grppart(ivg)
integer, pointer :: ivg(:) integer, pointer :: ivg(:)
@ -134,14 +133,15 @@ CONTAINS
end subroutine getv_grppart end subroutine getv_grppart
SUBROUTINE BUILD_GRPPART(N,FIDA,IA1,IA2,NPARTS) subroutine build_grppart(n,fida,ia1,ia2,nparts)
INTEGER :: NPARTS use psb_sparse_mod
INTEGER :: IA1(:), IA2(:) integer :: nparts
INTEGER :: N, I, IB, II,numflag,nedc,wgflag integer :: ia1(:), ia2(:)
CHARACTER(LEN=5) :: FIDA integer :: n, i, ib, ii,numflag,nedc,wgflag
INTEGER, PARAMETER :: NB=512 character(len=5) :: fida
REAL(KIND(1.D0)), PARAMETER :: SEED=12345.D0 integer, parameter :: nb=512
REAL(KIND(1.D0)) :: XV(NB) real(kind(1.d0)), parameter :: seed=12345.d0
real(kind(1.d0)) :: XV(NB)
integer :: iopt(10),idummy(2),jdummy(2) integer :: iopt(10),idummy(2),jdummy(2)
interface interface
subroutine METIS_PartGraphRecursive(n,ixadj,iadj,ivwg,iajw,& subroutine METIS_PartGraphRecursive(n,ixadj,iadj,ivwg,iajw,&
@ -156,15 +156,15 @@ CONTAINS
!!$ DEALLOCATE(GRAPH_VECT) !!$ DEALLOCATE(GRAPH_VECT)
!!$ ENDIF !!$ ENDIF
ALLOCATE(GRAPH_VECT(N),STAT=INFO) allocate(graph_vect(n),stat=info)
IF (INFO /= 0) THEN if (info /= 0) then
WRITE(0,*) 'Fatal error in BUILD_GRPPART: memory allocation ',& write(0,*) 'Fatal error in BUILD_GRPPART: memory allocation ',&
& ' failure.' & ' failure.'
RETURN return
ENDIF endif
IF (NPARTS.GT.1) THEN if (nparts.gt.1) then
IF (FIDA.EQ.'CSR') THEN if (toupper(fida).eq.'CSR') then
iopt(1) = 0 iopt(1) = 0
numflag = 1 numflag = 1
wgflag = 0 wgflag = 0
@ -174,47 +174,41 @@ CONTAINS
call METIS_PartGraphRecursive(n,ia2,ia1,idummy,jdummy,& call METIS_PartGraphRecursive(n,ia2,ia1,idummy,jdummy,&
& wgflag,numflag,nparts,iopt,nedc,graph_vect) & wgflag,numflag,nparts,iopt,nedc,graph_vect)
!!$ write(0,*)'Edge cut from Metis ',nedc !!$ write(0,*)'Edge cut from Metis ',nedc
DO I=1, N do i=1, n
GRAPH_VECT(I) = GRAPH_VECT(I) - 1 graph_vect(i) = graph_vect(i) - 1
ENDDO enddo
ELSE else
WRITE(0,*) 'Fatal error in BUILD_GRPPART: matrix format ',& write(0,*) 'Fatal error in BUILD_GRPPART: matrix format ',&
& ' failure. ', FIDA & ' failure. ', FIDA
RETURN return
ENDIF endif
ELSE else
DO I=1, N do i=1, n
GRAPH_VECT(I) = 0 graph_vect(i) = 0
ENDDO enddo
ENDIF endif
RETURN return
END SUBROUTINE BUILD_GRPPART end subroutine build_grppart
SUBROUTINE BUILD_USRPART(N,V,NPARTS) subroutine build_usrpart(n,v,nparts)
INTEGER :: NPARTS integer :: nparts
INTEGER :: V(:) integer :: v(:)
INTEGER :: N, I, IB, II,numflag,nedc,wgflag integer :: n, i, ib, ii,numflag,nedc,wgflag
CHARACTER(LEN=5) :: FIDA
if ((n<=0) .or. (nparts<1)) then if ((n<=0) .or. (nparts<1)) then
write(0,*) 'Invalid input to BUILD_USRPART ',n,nparts write(0,*) 'Invalid input to BUILD_USRPART ',n,nparts
return return
endif endif
allocate(graph_vect(n),stat=info)
!!$ IF (ASSOCIATED(GRAPH_VECT)) THEN if (info /= 0) then
!!$ DEALLOCATE(GRAPH_VECT) write(0,*) 'Fatal error in BUILD_USRPART: memory allocation ',&
!!$ ENDIF
ALLOCATE(GRAPH_VECT(N),STAT=INFO)
IF (INFO /= 0) THEN
WRITE(0,*) 'Fatal error in BUILD_USRPART: memory allocation ',&
& ' failure.' & ' failure.'
RETURN return
ENDIF endif
do i=1, n do i=1, n
if ((0<=v(i)).and.(v(i)<nparts)) then if ((0<=v(i)).and.(v(i)<nparts)) then
@ -224,9 +218,9 @@ CONTAINS
endif endif
end do end do
RETURN return
END SUBROUTINE BUILD_USRPART end subroutine build_usrpart
subroutine free_part(info) subroutine free_part(info)
integer :: info integer :: info

5
test/Fileread/zf_sample.f90
Unescape Escape View File

@ -77,6 +77,7 @@ program zf_sample
integer :: ictxt, iam, np integer :: ictxt, iam, np
logical :: amroot logical :: amroot
integer, parameter :: root=0
! solver paramters ! solver paramters
integer :: iter, itmax, ierr, itrace, ircode, ipart,& integer :: iter, itmax, ierr, itrace, ircode, ipart,&
@ -106,7 +107,7 @@ program zf_sample
call psb_exit(ictxt) call psb_exit(ictxt)
stop stop
endif endif
amroot = (iam==0) amroot = (iam==root)
name='zf_sample' name='zf_sample'
@ -197,7 +198,7 @@ program zf_sample
endif endif
write(0,'("Done graph build")') write(0,'("Done graph build")')
call psb_barrier(ictxt) call psb_barrier(ictxt)
call distr_grppart(0,0,ictxt) call distr_grppart(root,ictxt)
call getv_grppart(ivg) call getv_grppart(ivg)
call matdist(aux_a, a, ivg, ictxt, & call matdist(aux_a, a, ivg, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)

Write Preview
Loading…
Cancel
Save