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

Fixed last remnants of gebs2d.

Browse Source
psblas3-type-indexed
Salvatore Filippone 19 years ago
parent f2c532f812
commit 2d9a8b50d9
2 changed files with 48 additions and 51 deletions
Show Stats Download Patch File Download Diff File

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

@ -97,7 +97,7 @@ program df_sample
integer, pointer :: ivg(:), ipv(:), neigh(:) integer, pointer :: ivg(:), ipv(:), neigh(:)
external mpi_wtime external mpi_wtime
call psb_init(ictxt) call psb_init(ictxt)
call psb_info(ictxt,iam,np) call psb_info(ictxt,iam,np)
@ -131,11 +131,11 @@ program df_sample
call readmat(mtrx_file, aux_a, ictxt) call readmat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m m_problem = aux_a%m
call gebs2d(ictxt,'a',m_problem) call psb_bcast(ictxt,m_problem)
if(rhs_file /= 'NONE') then if(rhs_file /= 'NONE') then
! reading an rhs ! reading an rhs
call read_rhs(rhs_file,aux_b,ictxt) call read_rhs(rhs_file,aux_b,ictxt)
end if end if
if (associated(aux_b).and.size(aux_b,1)==m_problem) then if (associated(aux_b).and.size(aux_b,1)==m_problem) then
@ -147,56 +147,53 @@ program df_sample
write(*,'(" ")') write(*,'(" ")')
allocate(aux_b(m_problem,1), stat=ircode) allocate(aux_b(m_problem,1), stat=ircode)
if (ircode /= 0) then if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
endif endif
b_col_glob => aux_b(:,1) b_col_glob => aux_b(:,1)
do i=1, m_problem do i=1, m_problem
b_col_glob(i) = 1.d0 b_col_glob(i) = 1.d0
enddo enddo
call random_seed()
call random_number(b_col_glob(1:m_problem))
b_col_glob(1:m_problem) = 2.0d0 * b_col_glob(1:m_problem) - 1.0d0
endif endif
call gebs2d(ictxt,'a',b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call gebr2d(ictxt,'a',m_problem) call psb_bcast(ictxt,m_problem)
allocate(aux_b(m_problem,1), stat=ircode) allocate(aux_b(m_problem,1), stat=ircode)
if (ircode /= 0) then if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
endif endif
b_col_glob =>aux_b(:,1) b_col_glob =>aux_b(:,1)
call gebr2d(ictxt,'a',b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if end if
! switch over different partition types ! switch over different partition types
if (ipart.eq.0) then if (ipart.eq.0) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (amroot) write(*,'("Partition type: block")') if (amroot) write(*,'("Partition type: block")')
allocate(ivg(m_problem),ipv(np)) allocate(ivg(m_problem),ipv(np))
do i=1,m_problem do i=1,m_problem
call part_block(i,m_problem,np,ipv,nv) call part_block(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
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)
else if (ipart.eq.1) then else if (ipart.eq.1) then
call psb_barrier(ictxt) call psb_barrier(ictxt)
if (amroot) write(*,'("Partition type: blk2")') if (amroot) write(*,'("Partition type: blk2")')
allocate(ivg(m_problem),ipv(np)) allocate(ivg(m_problem),ipv(np))
do i=1,m_problem do i=1,m_problem
call part_blk2(i,m_problem,np,ipv,nv) call part_blk2(i,m_problem,np,ipv,nv)
ivg(i) = ipv(1) ivg(i) = ipv(1)
enddo enddo
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)
else if (ipart.eq.2) then else if (ipart.eq.2) then
if (amroot) then if (amroot) then
write(*,'("Partition type: graph")') write(*,'("Partition type: graph")')
write(*,'(" ")') write(*,'(" ")')
! write(0,'("Build type: graph")') ! write(0,'("Build type: graph")')
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)
@ -209,7 +206,7 @@ program df_sample
call matdist(aux_a, a, part_block, ictxt, & call matdist(aux_a, a, part_block, ictxt, &
& desc_a,b_col_glob,b_col,info,fmt=afmt) & desc_a,b_col_glob,b_col,info,fmt=afmt)
end if end if
call psb_geall(x_col,desc_a,info) call psb_geall(x_col,desc_a,info)
x_col(:) =0.0 x_col(:) =0.0
call psb_geasb(x_col,desc_a,info) call psb_geasb(x_col,desc_a,info)
@ -217,14 +214,14 @@ program df_sample
r_col(:) =0.0 r_col(:) =0.0
call psb_geasb(r_col,desc_a,info) call psb_geasb(r_col,desc_a,info)
t2 = mpi_wtime() - t1 t2 = mpi_wtime() - t1
call psb_amx(ictxt, t2) call psb_amx(ictxt, t2)
if (amroot) then if (amroot) then
write(*,'(" ")') write(*,'(" ")')
write(*,'("Time to read and partition matrix : ",es10.4)')t2 write(*,'("Time to read and partition matrix : ",es10.4)')t2
write(*,'(" ")') write(*,'(" ")')
end if end if
! !
@ -260,16 +257,16 @@ program df_sample
call psb_precbld(a,desc_a,pre,info) call psb_precbld(a,desc_a,pre,info)
tprec = mpi_wtime()-t1 tprec = mpi_wtime()-t1
if (info /= 0) then if (info /= 0) then
call psb_errpush(4010,name,a_err='psb_precbld') call psb_errpush(4010,name,a_err='psb_precbld')
goto 9999 goto 9999
end if end if
call psb_amx(ictxt, tprec) call psb_amx(ictxt, tprec)
if(amroot) then if(amroot) then
write(*,'("Preconditioner time: ",es10.4)')tprec write(*,'("Preconditioner time: ",es10.4)')tprec
write(*,'(" ")') write(*,'(" ")')
end if end if
iparm = 0 iparm = 0
@ -322,7 +319,7 @@ program df_sample
998 format(i8,4(2x,g20.14)) 998 format(i8,4(2x,g20.14))
993 format(i6,4(1x,e12.6)) 993 format(i6,4(1x,e12.6))
call psb_gefree(b_col, desc_a,info) call psb_gefree(b_col, desc_a,info)
call psb_gefree(x_col, desc_a,info) call psb_gefree(x_col, desc_a,info)
call psb_spfree(a, desc_a,info) call psb_spfree(a, desc_a,info)
@ -331,11 +328,11 @@ program df_sample
9999 continue 9999 continue
if(info /= 0) then if(info /= 0) then
call psb_error(ictxt) call psb_error(ictxt)
end if end if
call psb_exit(ictxt) call psb_exit(ictxt)
stop stop
end program df_sample end program df_sample

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

@ -131,7 +131,7 @@ program zf_sample
call readmat(mtrx_file, aux_a, ictxt) call readmat(mtrx_file, aux_a, ictxt)
m_problem = aux_a%m m_problem = aux_a%m
call gebs2d(ictxt,'a',m_problem) call psb_bcast(ictxt,m_problem)
if(rhs_file /= 'NONE') then if(rhs_file /= 'NONE') then
! reading an rhs ! reading an rhs
@ -156,16 +156,16 @@ program zf_sample
b_col_glob(i) = (1.d0,1.d0) b_col_glob(i) = (1.d0,1.d0)
enddo enddo
endif endif
call gebs2d(ictxt,'a',b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
else else
call gebr2d(ictxt,'a',m_problem) call psb_bcast(ictxt,m_problem)
allocate(aux_b(m_problem,1), stat=ircode) allocate(aux_b(m_problem,1), stat=ircode)
if (ircode /= 0) then if (ircode /= 0) then
call psb_errpush(4000,name) call psb_errpush(4000,name)
goto 9999 goto 9999
endif endif
b_col_glob =>aux_b(:,1) b_col_glob =>aux_b(:,1)
call gebr2d(ictxt,'a',b_col_glob(1:m_problem)) call psb_bcast(ictxt,b_col_glob(1:m_problem))
end if end if
! switch over different partition types ! switch over different partition types

Write Preview
Loading…
Cancel
Save