mirror of
https://github.com/sfilippone/psblas3.git
synced 2026-10-24 14:51:49 +00:00
psblas3:
base/Makefile base/comm/psb_cgather.f90 base/comm/psb_chalo.f90 base/comm/psb_covrl.f90 base/comm/psb_dgather.f90 base/comm/psb_dhalo.f90 base/comm/psb_dovrl.f90 base/comm/psb_sgather.f90 base/comm/psb_shalo.f90 base/comm/psb_sovrl.f90 base/comm/psb_zgather.f90 base/comm/psb_zhalo.f90 base/comm/psb_zovrl.f90 base/internals/psi_cswapdata.F90 base/internals/psi_cswaptran.F90 base/internals/psi_dswapdata.F90 base/internals/psi_dswaptran.F90 base/internals/psi_idx_ins_cnv.f90 base/internals/psi_ovrl_restr.f90 base/internals/psi_ovrl_save.f90 base/internals/psi_ovrl_upd.f90 base/internals/psi_sswapdata.F90 base/internals/psi_sswaptran.F90 base/internals/psi_zswapdata.F90 base/internals/psi_zswaptran.F90 base/modules/Makefile base/modules/psb_base_mat_mod.f90 base/modules/psb_base_mod.f90 base/modules/psb_c_base_mat_mod.f90 base/modules/psb_c_base_vect_mod.f90 base/modules/psb_c_comm_mod.f90 base/modules/psb_c_csc_mat_mod.f90 base/modules/psb_c_csr_mat_mod.f90 base/modules/psb_c_linmap_mod.f90 base/modules/psb_c_mat_mod.f90 base/modules/psb_c_psblas_mod.f90 base/modules/psb_c_tools_mod.f90 base/modules/psb_c_vect_mod.f90 base/modules/psb_check_mod.f90 base/modules/psb_comm_mod.f90 base/modules/psb_const_mod.F90 base/modules/psb_d_base_mat_mod.f90 base/modules/psb_d_base_vect_mod.f90 base/modules/psb_d_comm_mod.f90 base/modules/psb_d_csc_mat_mod.f90 base/modules/psb_d_csr_mat_mod.f90 base/modules/psb_d_linmap_mod.f90 base/modules/psb_d_mat_mod.f90 base/modules/psb_d_psblas_mod.f90 base/modules/psb_d_tools_mod.f90 base/modules/psb_d_vect_mod.f90 base/modules/psb_error_impl.F90 base/modules/psb_error_mod.F90 base/modules/psb_i_comm_mod.f90 base/modules/psb_ip_reord_mod.f90 base/modules/psb_linmap_mod.f90 base/modules/psb_linmap_type_mod.f90 base/modules/psb_s_base_mat_mod.f90 base/modules/psb_s_base_vect_mod.f90 base/modules/psb_s_comm_mod.f90 base/modules/psb_s_csc_mat_mod.f90 base/modules/psb_s_csr_mat_mod.f90 base/modules/psb_s_linmap_mod.f90 base/modules/psb_s_mat_mod.f90 base/modules/psb_s_psblas_mod.f90 base/modules/psb_s_tools_mod.f90 base/modules/psb_s_vect_mod.f90 base/modules/psb_serial_mod.f90 base/modules/psb_vect_mod.f90 base/modules/psb_z_base_mat_mod.f90 base/modules/psb_z_base_vect_mod.f90 base/modules/psb_z_comm_mod.f90 base/modules/psb_z_csc_mat_mod.f90 base/modules/psb_z_csr_mat_mod.f90 base/modules/psb_z_linmap_mod.f90 base/modules/psb_z_mat_mod.f90 base/modules/psb_z_psblas_mod.f90 base/modules/psb_z_tools_mod.f90 base/modules/psb_z_vect_mod.f90 base/modules/psi_c_mod.f90 base/modules/psi_d_mod.f90 base/modules/psi_i_mod.f90 base/modules/psi_mod.f90 base/modules/psi_penv_mod.F90 base/modules/psi_s_mod.f90 base/modules/psi_z_mod.f90 base/psblas/psb_camax.f90 base/psblas/psb_casum.f90 base/psblas/psb_caxpby.f90 base/psblas/psb_cdot.f90 base/psblas/psb_cnrm2.f90 base/psblas/psb_cspmm.f90 base/psblas/psb_cspsm.f90 base/psblas/psb_damax.f90 base/psblas/psb_dasum.f90 base/psblas/psb_daxpby.f90 base/psblas/psb_ddot.f90 base/psblas/psb_dnrm2.f90 base/psblas/psb_dnrmi.f90 base/psblas/psb_dspmm.f90 base/psblas/psb_dspnrm1.f90 base/psblas/psb_dspsm.f90 base/psblas/psb_samax.f90 base/psblas/psb_sasum.f90 base/psblas/psb_saxpby.f90 base/psblas/psb_sdot.f90 base/psblas/psb_snrm2.f90 base/psblas/psb_sspmm.f90 base/psblas/psb_sspsm.f90 base/psblas/psb_zamax.f90 base/psblas/psb_zasum.f90 base/psblas/psb_zaxpby.f90 base/psblas/psb_zdot.f90 base/psblas/psb_znrm2.f90 base/psblas/psb_zspmm.f90 base/psblas/psb_zspsm.f90 base/serial/Makefile base/serial/impl/psb_c_base_mat_impl.f90 base/serial/impl/psb_c_coo_impl.f90 base/serial/impl/psb_c_csc_impl.f90 base/serial/impl/psb_c_csr_impl.f90 base/serial/impl/psb_c_mat_impl.F90 base/serial/impl/psb_d_base_mat_impl.f90 base/serial/impl/psb_d_coo_impl.f90 base/serial/impl/psb_d_csc_impl.f90 base/serial/impl/psb_d_csr_impl.f90 base/serial/impl/psb_d_mat_impl.F90 base/serial/impl/psb_s_base_mat_impl.f90 base/serial/impl/psb_s_coo_impl.f90 base/serial/impl/psb_s_csc_impl.f90 base/serial/impl/psb_s_csr_impl.f90 base/serial/impl/psb_s_mat_impl.F90 base/serial/impl/psb_z_base_mat_impl.f90 base/serial/impl/psb_z_coo_impl.f90 base/serial/impl/psb_z_csc_impl.f90 base/serial/impl/psb_z_csr_impl.f90 base/serial/impl/psb_z_mat_impl.F90 base/serial/psb_cgelp.f90 base/serial/psb_dgelp.f90 base/serial/psb_sgelp.f90 base/serial/psb_spdot_srtd.f90 base/serial/psb_zgelp.f90 base/tools/Makefile base/tools/psb_c_map.f90 base/tools/psb_callc.f90 base/tools/psb_casb.f90 base/tools/psb_cdins.f90 base/tools/psb_cfree.f90 base/tools/psb_cins.f90 base/tools/psb_d_map.f90 base/tools/psb_dallc.f90 base/tools/psb_dasb.f90 base/tools/psb_dcdbldext.F90 base/tools/psb_dfree.f90 base/tools/psb_dins.f90 base/tools/psb_dspalloc.f90 base/tools/psb_dspasb.f90 base/tools/psb_dspfree.f90 base/tools/psb_dsphalo.F90 base/tools/psb_dspins.f90 base/tools/psb_dsprn.f90 base/tools/psb_linmap.f90 base/tools/psb_map.f90 base/tools/psb_s_map.f90 base/tools/psb_sallc.f90 base/tools/psb_sasb.f90 base/tools/psb_sfree.f90 base/tools/psb_sins.f90 base/tools/psb_z_map.f90 base/tools/psb_zallc.f90 base/tools/psb_zasb.f90 base/tools/psb_zfree.f90 base/tools/psb_zins.f90 config/pac.m4 configure.ac configure docs/html/footnode.html docs/html/img1.png docs/html/img10.png docs/html/img100.png docs/html/img101.png docs/html/img102.png docs/html/img103.png docs/html/img104.png docs/html/img105.png docs/html/img106.png docs/html/img107.png docs/html/img108.png docs/html/img109.png docs/html/img11.png docs/html/img110.png docs/html/img111.png docs/html/img112.png docs/html/img113.png docs/html/img114.png docs/html/img115.png docs/html/img116.png docs/html/img117.png docs/html/img118.png docs/html/img119.png docs/html/img12.png docs/html/img120.png docs/html/img121.png docs/html/img122.png docs/html/img123.png docs/html/img124.png docs/html/img125.png docs/html/img126.png docs/html/img127.png docs/html/img128.png docs/html/img129.png docs/html/img13.png docs/html/img130.png docs/html/img131.png docs/html/img132.png docs/html/img133.png docs/html/img134.png docs/html/img135.png docs/html/img136.png docs/html/img137.png docs/html/img138.png docs/html/img14.png docs/html/img140.png docs/html/img141.png docs/html/img142.png docs/html/img143.png docs/html/img144.png docs/html/img145.png docs/html/img146.png docs/html/img147.png docs/html/img148.png docs/html/img149.png docs/html/img15.png docs/html/img16.png docs/html/img17.png docs/html/img18.png docs/html/img2.png docs/html/img20.png docs/html/img22.png docs/html/img23.png docs/html/img24.png docs/html/img26.png docs/html/img27.png docs/html/img28.png docs/html/img29.png docs/html/img3.png docs/html/img30.png docs/html/img31.png docs/html/img32.png docs/html/img33.png docs/html/img34.png docs/html/img35.png docs/html/img36.png docs/html/img37.png docs/html/img38.png docs/html/img39.png docs/html/img4.png docs/html/img40.png docs/html/img41.png docs/html/img42.png docs/html/img43.png docs/html/img44.png docs/html/img45.png docs/html/img46.png docs/html/img47.png docs/html/img48.png docs/html/img49.png docs/html/img5.png docs/html/img50.png docs/html/img51.png docs/html/img52.png docs/html/img53.png docs/html/img54.png docs/html/img55.png docs/html/img56.png docs/html/img57.png docs/html/img58.png docs/html/img59.png docs/html/img6.png docs/html/img60.png docs/html/img61.png docs/html/img62.png docs/html/img63.png docs/html/img64.png docs/html/img65.png docs/html/img66.png docs/html/img67.png docs/html/img68.png docs/html/img69.png docs/html/img7.png docs/html/img70.png docs/html/img71.png docs/html/img72.png docs/html/img73.png docs/html/img74.png docs/html/img75.png docs/html/img76.png docs/html/img77.png docs/html/img78.png docs/html/img79.png docs/html/img8.png docs/html/img80.png docs/html/img81.png docs/html/img82.png docs/html/img83.png docs/html/img84.png docs/html/img85.png docs/html/img86.png docs/html/img87.png docs/html/img88.png docs/html/img89.png docs/html/img9.png docs/html/img90.png docs/html/img91.png docs/html/img92.png docs/html/img93.png docs/html/img94.png docs/html/img95.png docs/html/img96.png docs/html/img97.png docs/html/img98.png docs/html/img99.png docs/html/index.html docs/html/node1.html docs/html/node10.html docs/html/node100.html docs/html/node101.html docs/html/node102.html docs/html/node103.html docs/html/node104.html docs/html/node105.html docs/html/node106.html docs/html/node107.html docs/html/node108.html docs/html/node109.html docs/html/node11.html docs/html/node12.html docs/html/node13.html docs/html/node14.html docs/html/node15.html docs/html/node16.html docs/html/node17.html docs/html/node18.html docs/html/node19.html docs/html/node2.html docs/html/node20.html docs/html/node21.html docs/html/node22.html docs/html/node23.html docs/html/node24.html docs/html/node25.html docs/html/node26.html docs/html/node27.html docs/html/node28.html docs/html/node29.html docs/html/node3.html docs/html/node30.html docs/html/node31.html docs/html/node32.html docs/html/node33.html docs/html/node34.html docs/html/node35.html docs/html/node36.html docs/html/node37.html docs/html/node38.html docs/html/node39.html docs/html/node4.html docs/html/node40.html docs/html/node41.html docs/html/node42.html docs/html/node43.html docs/html/node44.html docs/html/node45.html docs/html/node46.html docs/html/node47.html docs/html/node48.html docs/html/node49.html docs/html/node5.html docs/html/node50.html docs/html/node51.html docs/html/node52.html docs/html/node53.html docs/html/node54.html docs/html/node55.html docs/html/node56.html docs/html/node57.html docs/html/node58.html docs/html/node59.html docs/html/node6.html docs/html/node60.html docs/html/node61.html docs/html/node62.html docs/html/node63.html docs/html/node64.html docs/html/node65.html docs/html/node66.html docs/html/node67.html docs/html/node68.html docs/html/node69.html docs/html/node7.html docs/html/node70.html docs/html/node71.html docs/html/node72.html docs/html/node73.html docs/html/node74.html docs/html/node75.html docs/html/node76.html docs/html/node77.html docs/html/node78.html docs/html/node79.html docs/html/node8.html docs/html/node80.html docs/html/node81.html docs/html/node82.html docs/html/node83.html docs/html/node84.html docs/html/node85.html docs/html/node86.html docs/html/node87.html docs/html/node88.html docs/html/node89.html docs/html/node9.html docs/html/node90.html docs/html/node91.html docs/html/node92.html docs/html/node93.html docs/html/node94.html docs/html/node95.html docs/html/node96.html docs/html/node97.html docs/html/node98.html docs/html/node99.html docs/html/userhtml.html docs/psblas-3.0.pdf docs/src/datastruct.tex krylov/Makefile krylov/psb_base_inner_krylov_mod.f90 krylov/psb_c_inner_krylov_mod.f90 krylov/psb_cbicg.f90 krylov/psb_ccg.f90 krylov/psb_ccgs.f90 krylov/psb_ccgstab.f90 krylov/psb_ccgstabl.f90 krylov/psb_ckrylov.f90 krylov/psb_crgmres.f90 krylov/psb_d_inner_krylov_mod.f90 krylov/psb_dbicg.f90 krylov/psb_dcg.F90 krylov/psb_dcgs.f90 krylov/psb_dcgstab.F90 krylov/psb_dcgstabl.f90 krylov/psb_dkrylov.f90 krylov/psb_drgmres.f90 krylov/psb_krylov_mod.f90 krylov/psb_s_inner_krylov_mod.f90 krylov/psb_sbicg.f90 krylov/psb_scg.F90 krylov/psb_scgs.f90 krylov/psb_scgstab.F90 krylov/psb_scgstabl.f90 krylov/psb_skrylov.f90 krylov/psb_srgmres.f90 krylov/psb_z_inner_krylov_mod.f90 krylov/psb_zbicg.f90 krylov/psb_zcg.F90 krylov/psb_zcgs.f90 krylov/psb_zcgstab.f90 krylov/psb_zcgstabl.f90 krylov/psb_zkrylov.f90 krylov/psb_zrgmres.f90 opt/Makefile opt/psb_c_rsb_mat_mod.F90 opt/psb_d_rsb_mat_mod.F90 opt/psb_s_rsb_mat_mod.F90 opt/psb_z_rsb_mat_mod.F90 opt/rsb_c_mod.f90 opt/rsb_d_mod.f90 opt/rsb_s_mod.f90 opt/rsb_z_mod.f90 prec/Makefile prec/psb_c_base_prec_mod.f90 prec/psb_c_bjacprec.f90 prec/psb_c_diagprec.f90 prec/psb_c_nullprec.f90 prec/psb_c_prec_type.f90 prec/psb_cprecbld.f90 prec/psb_d_base_prec_mod.f90 prec/psb_d_bjacprec.f90 prec/psb_d_diagprec.f90 prec/psb_d_nullprec.f90 prec/psb_d_prec_type.f90 prec/psb_dprecbld.f90 prec/psb_s_base_prec_mod.f90 prec/psb_s_bjacprec.f90 prec/psb_s_diagprec.f90 prec/psb_s_nullprec.f90 prec/psb_s_prec_type.f90 prec/psb_sprecbld.f90 prec/psb_z_base_prec_mod.f90 prec/psb_z_bjacprec.f90 prec/psb_z_diagprec.f90 prec/psb_z_nullprec.f90 prec/psb_z_prec_type.f90 prec/psb_zprecbld.f90 test/fileread/cf_sample.f90 test/fileread/df_sample.f90 test/fileread/runs/dfs.inp test/fileread/runs/sfs.inp test/fileread/sf_sample.f90 test/fileread/zf_sample.f90 test/kernel/d_file_spmv.f90 test/kernel/s_file_spmv.f90 test/newfmt/ppde.F90 test/newfmt/spde.f90 test/pargen/ppde.f90 test/pargen/runs/ppde.inp test/pargen/spde.f90 test/serial/Makefile test/serial/d_matgen.F90 test/serial/psb_d_czz_mat_mod.f90 util/Makefile util/psb_c_hbio_impl.f90 util/psb_c_mat_dist_impl.f90 util/psb_c_mmio_impl.f90 util/psb_c_renum_impl.F90 util/psb_d_hbio_impl.f90 util/psb_d_mat_dist_impl.f90 util/psb_d_mmio_impl.f90 util/psb_d_renum_impl.F90 util/psb_hbio_impl.f90 util/psb_mat_dist_mod.f90 util/psb_mmio_impl.f90 util/psb_renum_impl.F90 util/psb_renum_mod.f90 util/psb_s_hbio_impl.f90 util/psb_s_mat_dist_impl.f90 util/psb_s_mmio_impl.f90 util/psb_s_renum_impl.F90 util/psb_z_hbio_impl.f90 util/psb_z_mat_dist_impl.f90 util/psb_z_mmio_impl.f90 util/psb_z_renum_impl.F90 Merged vect-state branch. Now need to: 1. Update MLD 2. Fix documentation 3. Take out older Krylov interfaces.
This commit is contained in:
Salvatore Filippone
@@ -48,9 +48,9 @@ program cf_sample
|
||||
|
||||
! dense matrices
|
||||
complex(psb_spk_), allocatable, target :: aux_b(:,:), d(:)
|
||||
complex(psb_spk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||
& x_col_glob(:), r_col_glob(:)
|
||||
complex(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
|
||||
complex(psb_spk_), pointer :: b_col_glob(:)
|
||||
type(psb_c_vect_type) :: b_col, x_col, r_col
|
||||
|
||||
! communications data structure
|
||||
type(psb_desc_type):: desc_a
|
||||
@@ -75,7 +75,8 @@ program cf_sample
|
||||
real(psb_dpk_) :: t1, t2, tprec
|
||||
real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp
|
||||
integer :: nrhs, nrow, n_row, dim, nv, ne
|
||||
integer, allocatable :: ivg(:), ipv(:)
|
||||
integer, allocatable :: ivg(:), ipv(:), perm(:)
|
||||
character(len=40) :: fname, fnout
|
||||
|
||||
|
||||
call psb_init(ictxt)
|
||||
@@ -138,12 +139,15 @@ program cf_sample
|
||||
|
||||
m_problem = aux_a%get_nrows()
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
|
||||
!!$ call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm)
|
||||
|
||||
! At this point aux_b may still be unallocated
|
||||
if (psb_size(aux_b,dim=1) == m_problem) then
|
||||
! if any rhs were present, broadcast the first one
|
||||
write(psb_err_unit,'("Ok, got an rhs ")')
|
||||
b_col_glob =>aux_b(:,1)
|
||||
!!$ call psb_gelp('N',perm(1:m_problem),&
|
||||
!!$ & b_col_glob(1:m_problem),info)
|
||||
else
|
||||
write(psb_out_unit,'("Generating an rhs...")')
|
||||
write(psb_out_unit,'(" ")')
|
||||
@@ -159,7 +163,9 @@ program cf_sample
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_col_glob(1:m_problem))
|
||||
|
||||
else
|
||||
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
call psb_realloc(m_problem,1,aux_b,ircode)
|
||||
if (ircode /= 0) then
|
||||
@@ -181,6 +187,7 @@ program cf_sample
|
||||
enddo
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else if (ipart == 2) then
|
||||
if (iam == psb_root_) then
|
||||
write(psb_out_unit,'("Partition type: graph")')
|
||||
@@ -194,17 +201,18 @@ program cf_sample
|
||||
call getv_mtpart(ivg)
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else
|
||||
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,parts=part_block)
|
||||
end if
|
||||
|
||||
|
||||
call psb_geall(x_col,desc_a,info)
|
||||
x_col(:) =0.0
|
||||
call x_col%set(czero)
|
||||
call psb_geasb(x_col,desc_a,info)
|
||||
call psb_geall(r_col,desc_a,info)
|
||||
r_col(:) =0.0
|
||||
call r_col%set(czero)
|
||||
call psb_geasb(r_col,desc_a,info)
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
|
||||
+12
-10
@@ -48,9 +48,10 @@ program df_sample
|
||||
|
||||
! dense matrices
|
||||
real(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
|
||||
real(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||
& x_col_glob(:), r_col_glob(:)
|
||||
real(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
|
||||
real(psb_dpk_), pointer :: b_col_glob(:)
|
||||
type(psb_d_vect_type) :: b_col, x_col, r_col
|
||||
|
||||
|
||||
! communications data structure
|
||||
type(psb_desc_type):: desc_a
|
||||
@@ -75,7 +76,7 @@ program df_sample
|
||||
real(psb_dpk_) :: t1, t2, tprec, r_amax, b_amax,&
|
||||
&scale,resmx,resmxp
|
||||
integer :: nrhs, nrow, n_row, dim, nv, ne
|
||||
integer, allocatable :: ivg(:), ipv(:)
|
||||
integer, allocatable :: ivg(:), ipv(:), perm(:)
|
||||
character(len=40) :: fname, fnout
|
||||
|
||||
|
||||
@@ -139,12 +140,15 @@ program df_sample
|
||||
|
||||
m_problem = aux_a%get_nrows()
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
|
||||
call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm)
|
||||
|
||||
! At this point aux_b may still be unallocated
|
||||
if (psb_size(aux_b,dim=1) == m_problem) then
|
||||
! if any rhs were present, broadcast the first one
|
||||
write(psb_err_unit,'("Ok, got an rhs ")')
|
||||
b_col_glob =>aux_b(:,1)
|
||||
call psb_gelp('N',perm(1:m_problem),&
|
||||
& b_col_glob(1:m_problem),info)
|
||||
else
|
||||
write(psb_out_unit,'("Generating an rhs...")')
|
||||
write(psb_out_unit,'(" ")')
|
||||
@@ -174,8 +178,6 @@ program df_sample
|
||||
|
||||
end if
|
||||
|
||||
call psb_mat_renum(psb_mat_renum_gps_,aux_a,info)
|
||||
|
||||
! switch over different partition types
|
||||
if (ipart == 0) then
|
||||
call psb_barrier(ictxt)
|
||||
@@ -209,10 +211,10 @@ program df_sample
|
||||
end if
|
||||
|
||||
call psb_geall(x_col,desc_a,info)
|
||||
x_col(:) =0.0
|
||||
call x_col%set(dzero)
|
||||
call psb_geasb(x_col,desc_a,info)
|
||||
call psb_geall(r_col,desc_a,info)
|
||||
r_col(:) =0.0
|
||||
call r_col%set(dzero)
|
||||
call psb_geasb(r_col,desc_a,info)
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -258,8 +260,8 @@ program df_sample
|
||||
call psb_amx(ictxt,t2)
|
||||
call psb_geaxpby(done,b_col,dzero,r_col,desc_a,info)
|
||||
call psb_spmm(-done,a,x_col,done,r_col,desc_a,info)
|
||||
call psb_genrm2s(resmx,r_col,desc_a,info)
|
||||
call psb_geamaxs(resmxp,r_col,desc_a,info)
|
||||
resmx = psb_genrm2(r_col,desc_a,info)
|
||||
resmxp = psb_geamax(r_col,desc_a,info)
|
||||
|
||||
amatsize = psb_sizeof(a)
|
||||
descsize = psb_sizeof(desc_a)
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
11 Number of inputs
|
||||
A_1M_gps.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
|
||||
NONE sherman3_rhs1.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
|
||||
sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
|
||||
sherman3_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
|
||||
MM File format: MM: Matrix Market HB: Harwell-Boeing.
|
||||
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
|
||||
BJAC Preconditioner NONE DIAG BJAC
|
||||
|
||||
@@ -1,6 +1,6 @@
|
||||
11 Number of inputs
|
||||
sherman3.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
|
||||
NONE http://www.cise.ufl.edu/research/sparse/matrices/index.html
|
||||
sherman1.mtx This (and others) from: http://math.nist.gov/MatrixMarket/ or
|
||||
sherman1_b.mtx http://www.cise.ufl.edu/research/sparse/matrices/index.html
|
||||
MM File format: MM: Matrix Market HB: Harwell-Boeing.
|
||||
BICGSTAB Iterative method: BiCGSTAB CGS RGMRES BiCGSTABL BICG CG
|
||||
BJAC Preconditioner NONE DIAG BJAC
|
||||
|
||||
+22
-12
@@ -48,9 +48,10 @@ program sf_sample
|
||||
|
||||
! dense matrices
|
||||
real(psb_spk_), allocatable, target :: aux_b(:,:), d(:)
|
||||
real(psb_spk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||
& x_col_glob(:), r_col_glob(:)
|
||||
real(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
|
||||
real(psb_spk_), pointer :: b_col_glob(:)
|
||||
type(psb_s_vect_type) :: b_col, x_col, r_col
|
||||
|
||||
|
||||
! communications data structure
|
||||
type(psb_desc_type):: desc_a
|
||||
@@ -72,10 +73,11 @@ program sf_sample
|
||||
! other variables
|
||||
integer :: i,info,j,m_problem
|
||||
integer :: internal, m,ii,nnzero
|
||||
real(psb_spk_) :: t1, t2, tprec, r_amax, b_amax,&
|
||||
&scale,resmx,resmxp
|
||||
real(psb_dpk_) :: t1, t2, tprec
|
||||
real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp
|
||||
integer :: nrhs, nrow, n_row, dim, nv, ne
|
||||
integer, allocatable :: ivg(:), ipv(:)
|
||||
integer, allocatable :: ivg(:), ipv(:), perm(:)
|
||||
character(len=40) :: fname, fnout
|
||||
|
||||
|
||||
call psb_init(ictxt)
|
||||
@@ -88,7 +90,7 @@ program sf_sample
|
||||
endif
|
||||
|
||||
|
||||
name='df_sample'
|
||||
name='sf_sample'
|
||||
if(psb_get_errstatus() /= 0) goto 9999
|
||||
info=psb_success_
|
||||
call psb_set_errverbosity(2)
|
||||
@@ -138,12 +140,15 @@ program sf_sample
|
||||
|
||||
m_problem = aux_a%get_nrows()
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
|
||||
!!$ call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm)
|
||||
|
||||
! At this point aux_b may still be unallocated
|
||||
if (psb_size(aux_b,dim=1) == m_problem) then
|
||||
! if any rhs were present, broadcast the first one
|
||||
write(psb_err_unit,'("Ok, got an rhs ")')
|
||||
b_col_glob =>aux_b(:,1)
|
||||
!!$ call psb_gelp('N',perm(1:m_problem),&
|
||||
!!$ & b_col_glob(1:m_problem),info)
|
||||
else
|
||||
write(psb_out_unit,'("Generating an rhs...")')
|
||||
write(psb_out_unit,'(" ")')
|
||||
@@ -159,7 +164,9 @@ program sf_sample
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_col_glob(1:m_problem))
|
||||
|
||||
else
|
||||
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
call psb_realloc(m_problem,1,aux_b,ircode)
|
||||
if (ircode /= 0) then
|
||||
@@ -181,6 +188,7 @@ program sf_sample
|
||||
enddo
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else if (ipart == 2) then
|
||||
if (iam == psb_root_) then
|
||||
write(psb_out_unit,'("Partition type: graph")')
|
||||
@@ -194,6 +202,7 @@ program sf_sample
|
||||
call getv_mtpart(ivg)
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else
|
||||
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
@@ -201,10 +210,10 @@ program sf_sample
|
||||
end if
|
||||
|
||||
call psb_geall(x_col,desc_a,info)
|
||||
x_col(:) =0.0
|
||||
call x_col%set(szero)
|
||||
call psb_geasb(x_col,desc_a,info)
|
||||
call psb_geall(r_col,desc_a,info)
|
||||
r_col(:) =0.0
|
||||
call r_col%set(szero)
|
||||
call psb_geasb(r_col,desc_a,info)
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -237,7 +246,7 @@ program sf_sample
|
||||
write(psb_out_unit,'("Preconditioner time: ",es12.5)')tprec
|
||||
write(psb_out_unit,'(" ")')
|
||||
end if
|
||||
cond = -sone
|
||||
cond = szero
|
||||
iparm = 0
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
@@ -250,8 +259,8 @@ program sf_sample
|
||||
call psb_amx(ictxt,t2)
|
||||
call psb_geaxpby(sone,b_col,szero,r_col,desc_a,info)
|
||||
call psb_spmm(-sone,a,x_col,sone,r_col,desc_a,info)
|
||||
call psb_genrm2s(resmx,r_col,desc_a,info)
|
||||
call psb_geamaxs(resmxp,r_col,desc_a,info)
|
||||
resmx = psb_genrm2(r_col,desc_a,info)
|
||||
resmxp = psb_geamax(r_col,desc_a,info)
|
||||
|
||||
amatsize = psb_sizeof(a)
|
||||
descsize = psb_sizeof(desc_a)
|
||||
@@ -278,6 +287,7 @@ program sf_sample
|
||||
write(psb_out_unit,'("Storage type for DESC_A : ",a)')&
|
||||
& desc_a%indxmap%get_fmt()
|
||||
end if
|
||||
!!$ call psb_precdump(prec,info,prefix=trim(mtrx_file)//'_')
|
||||
|
||||
allocate(x_col_glob(m_problem),r_col_glob(m_problem),stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
|
||||
+18
-10
@@ -48,9 +48,9 @@ program zf_sample
|
||||
|
||||
! dense matrices
|
||||
complex(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
|
||||
complex(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||
& x_col_glob(:), r_col_glob(:)
|
||||
complex(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
|
||||
complex(psb_dpk_), pointer :: b_col_glob(:)
|
||||
type(psb_z_vect_type) :: b_col, x_col, r_col
|
||||
|
||||
! communications data structure
|
||||
type(psb_desc_type):: desc_a
|
||||
@@ -72,10 +72,11 @@ program zf_sample
|
||||
! other variables
|
||||
integer :: i,info,j,m_problem
|
||||
integer :: internal, m,ii,nnzero
|
||||
real(psb_dpk_) :: t1, t2, tprec, r_amax, b_amax,&
|
||||
&scale,resmx,resmxp
|
||||
real(psb_dpk_) :: t1, t2, tprec
|
||||
real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp
|
||||
integer :: nrhs, nrow, n_row, dim, nv, ne
|
||||
integer, allocatable :: ivg(:), ipv(:)
|
||||
integer, allocatable :: ivg(:), ipv(:), perm(:)
|
||||
character(len=40) :: fname, fnout
|
||||
|
||||
|
||||
call psb_init(ictxt)
|
||||
@@ -138,12 +139,15 @@ program zf_sample
|
||||
|
||||
m_problem = aux_a%get_nrows()
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
|
||||
!!$ call psb_mat_renum(psb_mat_renum_gps_,aux_a,info,perm)
|
||||
|
||||
! At this point aux_b may still be unallocated
|
||||
if (psb_size(aux_b,dim=1) == m_problem) then
|
||||
! if any rhs were present, broadcast the first one
|
||||
write(psb_err_unit,'("Ok, got an rhs ")')
|
||||
b_col_glob =>aux_b(:,1)
|
||||
!!$ call psb_gelp('N',perm(1:m_problem),&
|
||||
!!$ & b_col_glob(1:m_problem),info)
|
||||
else
|
||||
write(psb_out_unit,'("Generating an rhs...")')
|
||||
write(psb_out_unit,'(" ")')
|
||||
@@ -159,7 +163,9 @@ program zf_sample
|
||||
enddo
|
||||
endif
|
||||
call psb_bcast(ictxt,b_col_glob(1:m_problem))
|
||||
|
||||
else
|
||||
|
||||
call psb_bcast(ictxt,m_problem)
|
||||
call psb_realloc(m_problem,1,aux_b,ircode)
|
||||
if (ircode /= 0) then
|
||||
@@ -181,6 +187,7 @@ program zf_sample
|
||||
enddo
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else if (ipart == 2) then
|
||||
if (iam == psb_root_) then
|
||||
write(psb_out_unit,'("Partition type: graph")')
|
||||
@@ -194,6 +201,7 @@ program zf_sample
|
||||
call getv_mtpart(ivg)
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else
|
||||
if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
@@ -201,10 +209,10 @@ program zf_sample
|
||||
end if
|
||||
|
||||
call psb_geall(x_col,desc_a,info)
|
||||
x_col(:) =0.0
|
||||
call x_col%set(zzero)
|
||||
call psb_geasb(x_col,desc_a,info)
|
||||
call psb_geall(r_col,desc_a,info)
|
||||
r_col(:) =0.0
|
||||
call r_col%set(zzero)
|
||||
call psb_geasb(r_col,desc_a,info)
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -248,8 +256,8 @@ program zf_sample
|
||||
call psb_amx(ictxt,t2)
|
||||
call psb_geaxpby(zone,b_col,zzero,r_col,desc_a,info)
|
||||
call psb_spmm(-zone,a,x_col,zone,r_col,desc_a,info)
|
||||
call psb_genrm2s(resmx,r_col,desc_a,info)
|
||||
call psb_geamaxs(resmxp,r_col,desc_a,info)
|
||||
resmx = psb_genrm2(r_col,desc_a,info)
|
||||
resmxp = psb_geamax(r_col,desc_a,info)
|
||||
|
||||
amatsize = psb_sizeof(a)
|
||||
descsize = psb_sizeof(desc_a)
|
||||
|
||||
@@ -42,9 +42,10 @@ program d_file_spmv
|
||||
|
||||
! dense matrices
|
||||
real(psb_dpk_), allocatable, target :: aux_b(:,:), d(:)
|
||||
real(psb_dpk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||
& x_col_glob(:), r_col_glob(:)
|
||||
real(psb_dpk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
|
||||
real(psb_dpk_), pointer :: b_col_glob(:)
|
||||
type(psb_d_vect_type) :: b_col, x_col, r_col
|
||||
|
||||
|
||||
! communications data structure
|
||||
type(psb_desc_type):: desc_a
|
||||
@@ -114,7 +115,7 @@ program d_file_spmv
|
||||
! For Matrix Market we have an input file for the matrix
|
||||
! and an (optional) second file for the RHS.
|
||||
call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
|
||||
if (info == 0) then
|
||||
if (info == psb_success_) then
|
||||
if (rhs_file /= 'NONE') then
|
||||
call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file)
|
||||
end if
|
||||
@@ -129,7 +130,7 @@ program d_file_spmv
|
||||
info = -1
|
||||
write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
|
||||
end select
|
||||
if (info /= 0) then
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) 'Error while reading input matrix '
|
||||
call psb_abort(ictxt)
|
||||
end if
|
||||
@@ -147,7 +148,7 @@ program d_file_spmv
|
||||
write(psb_out_unit,'(" ")')
|
||||
call psb_realloc(m_problem,1,aux_b,ircode)
|
||||
if (ircode /= 0) then
|
||||
call psb_errpush(4000,name)
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
@@ -182,18 +183,21 @@ program d_file_spmv
|
||||
enddo
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else if (ipart == 2) then
|
||||
if (iam==psb_root_) then
|
||||
write(psb_out_unit,'("Partition type: graph")')
|
||||
write(psb_out_unit,'(" ")')
|
||||
! write(psb_err_unit,'("Build type: graph")')
|
||||
call build_mtpart(aux_a,np)
|
||||
|
||||
endif
|
||||
call psb_barrier(ictxt)
|
||||
call distr_mtpart(psb_root_,ictxt)
|
||||
call getv_mtpart(ivg)
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else
|
||||
if (iam==psb_root_) write(psb_out_unit,'("Partition type: default block")')
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
@@ -201,7 +205,7 @@ program d_file_spmv
|
||||
end if
|
||||
|
||||
call psb_geall(x_col,desc_a,info)
|
||||
x_col(:) =1.0
|
||||
call x_col%set(done)
|
||||
call psb_geasb(x_col,desc_a,info)
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -264,7 +268,8 @@ program d_file_spmv
|
||||
!
|
||||
! This computation is valid for CSR
|
||||
!
|
||||
nbytes = nr*(2*psb_sizeof_dp + psb_sizeof_int)+ annz*(psb_sizeof_dp + psb_sizeof_int)
|
||||
nbytes = nr*(2*psb_sizeof_dp + psb_sizeof_int)+&
|
||||
& annz*(psb_sizeof_dp + psb_sizeof_int)
|
||||
bdwdth = times*nbytes/(t2*1.d6)
|
||||
write(psb_out_unit,*)
|
||||
write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth
|
||||
|
||||
@@ -42,9 +42,10 @@ program s_file_spmv
|
||||
|
||||
! dense matrices
|
||||
real(psb_spk_), allocatable, target :: aux_b(:,:), d(:)
|
||||
real(psb_spk_), allocatable , save :: b_col(:), x_col(:), r_col(:), &
|
||||
& x_col_glob(:), r_col_glob(:)
|
||||
real(psb_spk_), allocatable , save :: x_col_glob(:), r_col_glob(:)
|
||||
real(psb_spk_), pointer :: b_col_glob(:)
|
||||
type(psb_s_vect_type) :: b_col, x_col, r_col
|
||||
|
||||
|
||||
! communications data structure
|
||||
type(psb_desc_type):: desc_a
|
||||
@@ -114,7 +115,7 @@ program s_file_spmv
|
||||
! For Matrix Market we have an input file for the matrix
|
||||
! and an (optional) second file for the RHS.
|
||||
call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
|
||||
if (info == 0) then
|
||||
if (info == psb_success_) then
|
||||
if (rhs_file /= 'NONE') then
|
||||
call mm_vet_read(aux_b,info,iunit=iunit,filename=rhs_file)
|
||||
end if
|
||||
@@ -129,7 +130,7 @@ program s_file_spmv
|
||||
info = -1
|
||||
write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
|
||||
end select
|
||||
if (info /= 0) then
|
||||
if (info /= psb_success_) then
|
||||
write(psb_err_unit,*) 'Error while reading input matrix '
|
||||
call psb_abort(ictxt)
|
||||
end if
|
||||
@@ -147,7 +148,7 @@ program s_file_spmv
|
||||
write(psb_out_unit,'(" ")')
|
||||
call psb_realloc(m_problem,1,aux_b,ircode)
|
||||
if (ircode /= 0) then
|
||||
call psb_errpush(4000,name)
|
||||
call psb_errpush(psb_err_alloc_dealloc_,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
@@ -182,18 +183,21 @@ program s_file_spmv
|
||||
enddo
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else if (ipart == 2) then
|
||||
if (iam==psb_root_) then
|
||||
write(psb_out_unit,'("Partition type: graph")')
|
||||
write(psb_out_unit,'(" ")')
|
||||
! write(psb_err_unit,'("Build type: graph")')
|
||||
call build_mtpart(aux_a,np)
|
||||
|
||||
endif
|
||||
call psb_barrier(ictxt)
|
||||
call distr_mtpart(psb_root_,ictxt)
|
||||
call getv_mtpart(ivg)
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
& desc_a,b_col_glob,b_col,info,fmt=afmt,v=ivg)
|
||||
|
||||
else
|
||||
if (iam==psb_root_) write(psb_out_unit,'("Partition type: block")')
|
||||
call psb_matdist(aux_a, a, ictxt, &
|
||||
@@ -201,7 +205,7 @@ program s_file_spmv
|
||||
end if
|
||||
|
||||
call psb_geall(x_col,desc_a,info)
|
||||
x_col(:) =1.0
|
||||
call x_col%set(sone)
|
||||
call psb_geasb(x_col,desc_a,info)
|
||||
t2 = psb_wtime() - t1
|
||||
|
||||
@@ -264,7 +268,8 @@ program s_file_spmv
|
||||
!
|
||||
! This computation is valid for CSR
|
||||
!
|
||||
nbytes = nr*(2*psb_sizeof_sp + psb_sizeof_int)+ annz*(psb_sizeof_sp + psb_sizeof_int)
|
||||
nbytes = nr*(2*psb_sizeof_sp + psb_sizeof_int)+ &
|
||||
& annz*(psb_sizeof_sp + psb_sizeof_int)
|
||||
bdwdth = times*nbytes/(t2*1.d6)
|
||||
write(psb_out_unit,*)
|
||||
write(psb_out_unit,'("MBYTES/S : ",F20.3)') bdwdth
|
||||
|
||||
@@ -425,7 +425,7 @@ contains
|
||||
! define rhs from boundary conditions; also build initial guess
|
||||
if (info == psb_success_) call psb_geall(b,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(xv,desc_a,info)
|
||||
nlr = psb_cd_get_local_rows(desc_a)
|
||||
nlr = desc_a%get_local_rows()
|
||||
call psb_barrier(ictxt)
|
||||
talc = psb_wtime()-t0
|
||||
|
||||
|
||||
@@ -401,7 +401,7 @@ contains
|
||||
! define rhs from boundary conditions; also build initial guess
|
||||
if (info == psb_success_) call psb_geall(b,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(xv,desc_a,info)
|
||||
nlr = psb_cd_get_local_rows(desc_a)
|
||||
nlr = desc_a%get_local_rows()
|
||||
call psb_barrier(ictxt)
|
||||
talc = psb_wtime()-t0
|
||||
|
||||
|
||||
+54
-56
@@ -83,7 +83,8 @@ program ppde
|
||||
! descriptor
|
||||
type(psb_desc_type) :: desc_a, desc_b
|
||||
! dense matrices
|
||||
real(psb_dpk_), allocatable :: b(:), x(:)
|
||||
type(psb_d_vect_type) :: xxv,bv, vtst
|
||||
real(psb_dpk_), allocatable :: tst(:)
|
||||
! blacs parameters
|
||||
integer :: ictxt, iam, np
|
||||
|
||||
@@ -128,7 +129,7 @@ program ppde
|
||||
!
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info)
|
||||
call create_matrix(idim,a,bv,xxv,desc_a,ictxt,afmt,info)
|
||||
call psb_barrier(ictxt)
|
||||
t2 = psb_wtime() - t1
|
||||
if(info /= psb_success_) then
|
||||
@@ -139,8 +140,8 @@ program ppde
|
||||
end if
|
||||
if (iam == psb_root_) write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2
|
||||
if (iam == psb_root_) write(psb_out_unit,'(" ")')
|
||||
write(fname,'(a,i0,a)') 'pde-',idim,'.hb'
|
||||
call hb_write(a,info,filename=fname,rhs=b,key='PDEGEN',mtitle='MLD2P4 pdegen Test matrix ')
|
||||
!!$ write(fname,'(a,i0,a)') 'pde-',idim,'.hb'
|
||||
!!$ call hb_write(a,info,filename=fname,rhs=b,key='PDEGEN',mtitle='MLD2P4 pdegen Test matrix ')
|
||||
!!$ write(fname,'(a,i2.2,a,i2.2,a)') 'amat-',iam,'-',np,'.mtx'
|
||||
!!$ call a%print(fname)
|
||||
!!$ call psb_cdprt(20+iam,desc_a,short=.false.)
|
||||
@@ -181,7 +182,7 @@ program ppde
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
eps = 1.d-9
|
||||
call psb_krylov(kmethd,a,prec,b,x,eps,desc_a,info,&
|
||||
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
|
||||
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
|
||||
|
||||
if(info /= psb_success_) then
|
||||
@@ -194,7 +195,6 @@ program ppde
|
||||
call psb_barrier(ictxt)
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
amatsize = psb_sizeof(a)
|
||||
descsize = psb_sizeof(desc_a)
|
||||
precsize = psb_sizeof(prec)
|
||||
@@ -215,12 +215,26 @@ program ppde
|
||||
write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
|
||||
write(psb_out_unit,'("Storage type for DESC_B: ",a)') desc_b%indxmap%get_fmt()
|
||||
end if
|
||||
|
||||
!
|
||||
if (.false.) then
|
||||
call psb_geall(tst,desc_b, info)
|
||||
call psb_geall(vtst,desc_b, info)
|
||||
vtst%v%v = iam+1
|
||||
call psb_geasb(vtst,desc_b,info)
|
||||
tst = vtst
|
||||
call psb_geasb(tst,desc_b,info)
|
||||
call psb_ovrl(vtst,desc_b,info,update=psb_avg_)
|
||||
call psb_ovrl(tst,desc_b,info,update=psb_avg_)
|
||||
write(0,*) iam,' After ovrl:',vtst%v%v
|
||||
write(0,*) iam,' After ovrl:',tst
|
||||
end if
|
||||
|
||||
!
|
||||
! cleanup storage and exit
|
||||
!
|
||||
call psb_gefree(b,desc_a,info)
|
||||
call psb_gefree(x,desc_a,info)
|
||||
call psb_gefree(bv,desc_a,info)
|
||||
call psb_gefree(xxv,desc_a,info)
|
||||
call psb_spfree(a,desc_a,info)
|
||||
call psb_precfree(prec,info)
|
||||
call psb_cdfree(desc_a,info)
|
||||
@@ -346,7 +360,7 @@ contains
|
||||
! subroutine to allocate and fill in the coefficient matrix and
|
||||
! the rhs.
|
||||
!
|
||||
subroutine create_matrix(idim,a,b,xv,desc_a,ictxt,afmt,info)
|
||||
subroutine create_matrix(idim,a,bv,xxv,desc_a,ictxt,afmt,info)
|
||||
!
|
||||
! discretize the partial diferential equation
|
||||
!
|
||||
@@ -366,16 +380,16 @@ contains
|
||||
use psb_base_mod
|
||||
use psb_mat_mod
|
||||
implicit none
|
||||
integer :: idim
|
||||
integer, parameter :: nb=20
|
||||
real(psb_dpk_), allocatable :: b(:),xv(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
integer :: ictxt, info
|
||||
character :: afmt*5
|
||||
integer :: idim
|
||||
integer, parameter :: nb=20
|
||||
type(psb_d_vect_type) :: xxv,bv
|
||||
type(psb_desc_type) :: desc_a
|
||||
integer :: ictxt, info
|
||||
character :: afmt*5
|
||||
type(psb_dspmat_type) :: a
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
type(psb_d_coo_sparse_mat) :: acoo
|
||||
type(psb_d_csr_sparse_mat) :: acsr
|
||||
type(psb_d_csc_sparse_mat) :: acsc
|
||||
type(psb_d_coo_sparse_mat) :: acoo
|
||||
type(psb_d_csr_sparse_mat) :: acsr
|
||||
real(psb_dpk_) :: zt(nb),x,y,z
|
||||
integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k
|
||||
integer :: ix,iy,iz,ia,indx_owner
|
||||
@@ -384,9 +398,8 @@ contains
|
||||
integer, allocatable :: irow(:),icol(:),myidx(:)
|
||||
real(psb_dpk_), allocatable :: val(:)
|
||||
! deltah dimension of each grid cell
|
||||
|
||||
! deltat discretization time
|
||||
real(psb_dpk_) :: deltah
|
||||
real(psb_dpk_) :: deltah, deltah2
|
||||
real(psb_dpk_),parameter :: rhs=0.d0,one=1.d0,zero=0.d0
|
||||
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen
|
||||
real(psb_dpk_) :: a1, a2, a3, a4, b1, b2, b3
|
||||
@@ -401,7 +414,8 @@ contains
|
||||
|
||||
call psb_info(ictxt, iam, np)
|
||||
|
||||
deltah = 1.d0/(idim-1)
|
||||
deltah = 1.d0/(idim-1)
|
||||
deltah2 = deltah*deltah
|
||||
|
||||
! initialize array descriptor and sparse matrix storage. provide an
|
||||
! estimate of the number of non zeroes
|
||||
@@ -425,8 +439,8 @@ contains
|
||||
call psb_cdall(ictxt,desc_a,info,nl=nr)
|
||||
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz)
|
||||
! define rhs from boundary conditions; also build initial guess
|
||||
if (info == psb_success_) call psb_geall(b,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(xv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(xxv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(bv,desc_a,info)
|
||||
nlr = desc_a%get_local_rows()
|
||||
call psb_barrier(ictxt)
|
||||
talc = psb_wtime()-t0
|
||||
@@ -493,79 +507,63 @@ contains
|
||||
! term depending on (x-1,y,z)
|
||||
!
|
||||
if (ix == 1) then
|
||||
val(element)=-b1(x,y,z)-a1(x,y,z)
|
||||
val(element) = val(element)/(deltah*&
|
||||
& deltah)
|
||||
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
|
||||
zt(k) = exp(-x**2-y**2-z**2)*(-val(element))
|
||||
else
|
||||
val(element)=-b1(x,y,z)-a1(x,y,z)
|
||||
val(element) = val(element)/(deltah*&
|
||||
& deltah)
|
||||
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
|
||||
icol(element) = (ix-2)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y-1,z)
|
||||
if (iy == 1) then
|
||||
val(element)=-b2(x,y,z)-a2(x,y,z)
|
||||
val(element) = val(element)/(deltah*&
|
||||
& deltah)
|
||||
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b2(x,y,z)-a2(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
|
||||
icol(element) = (ix-1)*idim*idim+(iy-2)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y,z-1)
|
||||
if (iz == 1) then
|
||||
val(element)=-b3(x,y,z)-a3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b3(x,y,z)-a3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
|
||||
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz-1)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y,z)
|
||||
val(element)=2*b1(x,y,z) + 2*b2(x,y,z)&
|
||||
& + 2*b3(x,y,z) + a1(x,y,z)&
|
||||
& + a2(x,y,z) + a3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/deltah2&
|
||||
& + (a1(x,y,z) + a2(x,y,z) + a3(x,y,z)+ a4(x,y,z))/deltah
|
||||
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
! term depending on (x,y,z+1)
|
||||
if (iz == idim) then
|
||||
val(element)=-b1(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b1(x,y,z)/deltah2
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b1(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b1(x,y,z)/deltah2
|
||||
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz+1)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y+1,z)
|
||||
if (iy == idim) then
|
||||
val(element)=-b2(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b2(x,y,z)/deltah2
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b2(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b2(x,y,z)/deltah2
|
||||
icol(element) = (ix-1)*idim*idim+(iy)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x+1,y,z)
|
||||
if (ix<idim) then
|
||||
val(element)=-b3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b3(x,y,z)/deltah2
|
||||
icol(element) = (ix)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
@@ -574,10 +572,10 @@ contains
|
||||
end do
|
||||
call psb_spins(element-1,irow,icol,val,a,desc_a,info)
|
||||
if(info /= psb_success_) exit
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),b,desc_a,info)
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
|
||||
if(info /= psb_success_) exit
|
||||
zt(:)=0.d0
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xxv,desc_a,info)
|
||||
if(info /= psb_success_) exit
|
||||
end do
|
||||
|
||||
@@ -603,8 +601,8 @@ contains
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_geasb(b,desc_a,info)
|
||||
call psb_geasb(xv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geasb(xxv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geasb(bv,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='asb rout.'
|
||||
|
||||
@@ -1,11 +1,11 @@
|
||||
7 Number of entries below this
|
||||
BICGSTAB Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
|
||||
BICGSTABL Iterative method BICGSTAB CGS BICG BICGSTABL RGMRES
|
||||
BJAC Preconditioner NONE DIAG BJAC
|
||||
CSR Storage format for matrix A: CSR COO JAD
|
||||
005 Domain size (acutal system is this**3)
|
||||
040 Domain size (acutal system is this**3)
|
||||
2 Stopping criterion
|
||||
0200 MAXIT
|
||||
-1 ITRACE
|
||||
20 IRST restart for RGMRES and BiCGSTABL
|
||||
0200 MAXIT
|
||||
02 ITRACE
|
||||
02 IRST restart for RGMRES and BiCGSTABL
|
||||
|
||||
|
||||
|
||||
+62
-59
@@ -65,6 +65,7 @@ program ppde
|
||||
use psb_base_mod
|
||||
use psb_prec_mod
|
||||
use psb_krylov_mod
|
||||
use psb_util_mod
|
||||
implicit none
|
||||
|
||||
! input parameters
|
||||
@@ -82,13 +83,14 @@ program ppde
|
||||
! descriptor
|
||||
type(psb_desc_type) :: desc_a, desc_b
|
||||
! dense matrices
|
||||
real(psb_spk_), allocatable :: b(:), x(:)
|
||||
type(psb_s_vect_type) :: xxv,bv, vtst
|
||||
real(psb_spk_), allocatable :: tst(:)
|
||||
! blacs parameters
|
||||
integer :: ictxt, iam, np
|
||||
|
||||
! solver parameters
|
||||
integer :: iter, itmax,itrace, istopc, irst
|
||||
integer(psb_long_int_k_) :: amatsize, precsize, descsize
|
||||
integer(psb_long_int_k_) :: amatsize, precsize, descsize, d2size
|
||||
real(psb_spk_) :: err, eps
|
||||
|
||||
! other variables
|
||||
@@ -127,7 +129,7 @@ program ppde
|
||||
!
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info)
|
||||
call create_matrix(idim,a,bv,xxv,desc_a,ictxt,afmt,info)
|
||||
call psb_barrier(ictxt)
|
||||
t2 = psb_wtime() - t1
|
||||
if(info /= psb_success_) then
|
||||
@@ -138,6 +140,8 @@ program ppde
|
||||
end if
|
||||
if (iam == psb_root_) write(psb_out_unit,'("Overall matrix creation time : ",es12.5)')t2
|
||||
if (iam == psb_root_) write(psb_out_unit,'(" ")')
|
||||
!!$ write(fname,'(a,i0,a)') 'pde-',idim,'.hb'
|
||||
!!$ call hb_write(a,info,filename=fname,rhs=b,key='PDEGEN',mtitle='MLD2P4 pdegen Test matrix ')
|
||||
!!$ write(fname,'(a,i2.2,a,i2.2,a)') 'amat-',iam,'-',np,'.mtx'
|
||||
!!$ call a%print(fname)
|
||||
!!$ call psb_cdprt(20+iam,desc_a,short=.false.)
|
||||
@@ -178,7 +182,7 @@ program ppde
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
eps = 1.d-9
|
||||
call psb_krylov(kmethd,a,prec,b,x,eps,desc_a,info,&
|
||||
call psb_krylov(kmethd,a,prec,bv,xxv,eps,desc_a,info,&
|
||||
& itmax=itmax,iter=iter,err=err,itrace=itrace,istop=istopc,irst=irst)
|
||||
|
||||
if(info /= psb_success_) then
|
||||
@@ -191,7 +195,6 @@ program ppde
|
||||
call psb_barrier(ictxt)
|
||||
t2 = psb_wtime() - t1
|
||||
call psb_amx(ictxt,t2)
|
||||
|
||||
amatsize = psb_sizeof(a)
|
||||
descsize = psb_sizeof(desc_a)
|
||||
precsize = psb_sizeof(prec)
|
||||
@@ -212,12 +215,26 @@ program ppde
|
||||
write(psb_out_unit,'("Storage type for DESC_A: ",a)') desc_a%indxmap%get_fmt()
|
||||
write(psb_out_unit,'("Storage type for DESC_B: ",a)') desc_b%indxmap%get_fmt()
|
||||
end if
|
||||
|
||||
!
|
||||
if (.false.) then
|
||||
call psb_geall(tst,desc_b, info)
|
||||
call psb_geall(vtst,desc_b, info)
|
||||
vtst%v%v = iam+1
|
||||
call psb_geasb(vtst,desc_b,info)
|
||||
tst = vtst
|
||||
call psb_geasb(tst,desc_b,info)
|
||||
call psb_ovrl(vtst,desc_b,info,update=psb_avg_)
|
||||
call psb_ovrl(tst,desc_b,info,update=psb_avg_)
|
||||
write(0,*) iam,' After ovrl:',vtst%v%v
|
||||
write(0,*) iam,' After ovrl:',tst
|
||||
end if
|
||||
|
||||
!
|
||||
! cleanup storage and exit
|
||||
!
|
||||
call psb_gefree(b,desc_a,info)
|
||||
call psb_gefree(x,desc_a,info)
|
||||
call psb_gefree(bv,desc_a,info)
|
||||
call psb_gefree(xxv,desc_a,info)
|
||||
call psb_spfree(a,desc_a,info)
|
||||
call psb_precfree(prec,info)
|
||||
call psb_cdfree(desc_a,info)
|
||||
@@ -343,7 +360,7 @@ contains
|
||||
! subroutine to allocate and fill in the coefficient matrix and
|
||||
! the rhs.
|
||||
!
|
||||
subroutine create_matrix(idim,a,b,xv,desc_a,ictxt,afmt,info)
|
||||
subroutine create_matrix(idim,a,bv,xxv,desc_a,ictxt,afmt,info)
|
||||
!
|
||||
! discretize the partial diferential equation
|
||||
!
|
||||
@@ -363,15 +380,16 @@ contains
|
||||
use psb_base_mod
|
||||
use psb_mat_mod
|
||||
implicit none
|
||||
integer :: idim
|
||||
integer, parameter :: nb=20
|
||||
real(psb_spk_), allocatable :: b(:),xv(:)
|
||||
type(psb_desc_type) :: desc_a
|
||||
integer :: ictxt, info
|
||||
character :: afmt*5
|
||||
type(psb_sspmat_type) :: a
|
||||
type(psb_s_coo_sparse_mat) :: acoo
|
||||
type(psb_s_csr_sparse_mat) :: acsr
|
||||
integer :: idim
|
||||
integer, parameter :: nb=20
|
||||
type(psb_s_vect_type) :: xxv,bv
|
||||
type(psb_desc_type) :: desc_a
|
||||
integer :: ictxt, info
|
||||
character :: afmt*5
|
||||
type(psb_sspmat_type) :: a
|
||||
type(psb_s_csc_sparse_mat) :: acsc
|
||||
type(psb_s_coo_sparse_mat) :: acoo
|
||||
type(psb_s_csr_sparse_mat) :: acsr
|
||||
real(psb_spk_) :: zt(nb),x,y,z
|
||||
integer :: m,n,nnz,glob_row,nlr,i,ii,ib,k
|
||||
integer :: ix,iy,iz,ia,indx_owner
|
||||
@@ -381,7 +399,7 @@ contains
|
||||
real(psb_spk_), allocatable :: val(:)
|
||||
! deltah dimension of each grid cell
|
||||
! deltat discretization time
|
||||
real(psb_spk_) :: deltah
|
||||
real(psb_spk_) :: deltah, deltah2
|
||||
real(psb_spk_),parameter :: rhs=0.0,one=1.0,zero=0.0
|
||||
real(psb_dpk_) :: t0, t1, t2, t3, tasb, talc, ttot, tgen
|
||||
real(psb_spk_) :: a1, a2, a3, a4, b1, b2, b3
|
||||
@@ -396,7 +414,8 @@ contains
|
||||
|
||||
call psb_info(ictxt, iam, np)
|
||||
|
||||
deltah = 1.d0/(idim-1)
|
||||
deltah = 1.d0/(idim-1)
|
||||
deltah2 = deltah*deltah
|
||||
|
||||
! initialize array descriptor and sparse matrix storage. provide an
|
||||
! estimate of the number of non zeroes
|
||||
@@ -420,8 +439,8 @@ contains
|
||||
call psb_cdall(ictxt,desc_a,info,nl=nr)
|
||||
if (info == psb_success_) call psb_spall(a,desc_a,info,nnz=nnz)
|
||||
! define rhs from boundary conditions; also build initial guess
|
||||
if (info == psb_success_) call psb_geall(b,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(xv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(xxv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geall(bv,desc_a,info)
|
||||
nlr = desc_a%get_local_rows()
|
||||
call psb_barrier(ictxt)
|
||||
talc = psb_wtime()-t0
|
||||
@@ -488,79 +507,63 @@ contains
|
||||
! term depending on (x-1,y,z)
|
||||
!
|
||||
if (ix == 1) then
|
||||
val(element)=-b1(x,y,z)-a1(x,y,z)
|
||||
val(element) = val(element)/(deltah*&
|
||||
& deltah)
|
||||
zt(k) = exp(-y**2-z**2)*(-val(element))
|
||||
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
|
||||
zt(k) = exp(-x**2-y**2-z**2)*(-val(element))
|
||||
else
|
||||
val(element)=-b1(x,y,z)-a1(x,y,z)
|
||||
val(element) = val(element)/(deltah*&
|
||||
& deltah)
|
||||
val(element) = -b1(x,y,z)/deltah2-a1(x,y,z)/deltah
|
||||
icol(element) = (ix-2)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y-1,z)
|
||||
if (iy == 1) then
|
||||
val(element)=-b2(x,y,z)-a2(x,y,z)
|
||||
val(element) = val(element)/(deltah*&
|
||||
& deltah)
|
||||
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
|
||||
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b2(x,y,z)-a2(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element) = -b2(x,y,z)/deltah2-a2(x,y,z)/deltah
|
||||
icol(element) = (ix-1)*idim*idim+(iy-2)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y,z-1)
|
||||
if (iz == 1) then
|
||||
val(element)=-b3(x,y,z)-a3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
|
||||
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b3(x,y,z)-a3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b3(x,y,z)/deltah2-a3(x,y,z)/deltah
|
||||
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz-1)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y,z)
|
||||
val(element)=2*b1(x,y,z) + 2*b2(x,y,z)&
|
||||
& + 2*b3(x,y,z) + a1(x,y,z)&
|
||||
& + a2(x,y,z) + a3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=(2*b1(x,y,z) + 2*b2(x,y,z) + 2*b3(x,y,z))/deltah2&
|
||||
& + (a1(x,y,z) + a2(x,y,z) + a3(x,y,z)+ a4(x,y,z))/deltah
|
||||
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
! term depending on (x,y,z+1)
|
||||
if (iz == idim) then
|
||||
val(element)=-b1(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
|
||||
val(element)=-b1(x,y,z)/deltah2
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b1(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b1(x,y,z)/deltah2
|
||||
icol(element) = (ix-1)*idim*idim+(iy-1)*idim+(iz+1)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x,y+1,z)
|
||||
if (iy == idim) then
|
||||
val(element)=-b2(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
zt(k) = exp(-y**2-z**2)*exp(-x)*(-val(element))
|
||||
val(element)=-b2(x,y,z)/deltah2
|
||||
zt(k) = exp(-x**2-y**2-z**2)*exp(-x)*(-val(element))
|
||||
else
|
||||
val(element)=-b2(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b2(x,y,z)/deltah2
|
||||
icol(element) = (ix-1)*idim*idim+(iy)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
endif
|
||||
! term depending on (x+1,y,z)
|
||||
if (ix<idim) then
|
||||
val(element)=-b3(x,y,z)
|
||||
val(element) = val(element)/(deltah*deltah)
|
||||
val(element)=-b3(x,y,z)/deltah2
|
||||
icol(element) = (ix)*idim*idim+(iy-1)*idim+(iz)
|
||||
irow(element) = glob_row
|
||||
element = element+1
|
||||
@@ -569,10 +572,10 @@ contains
|
||||
end do
|
||||
call psb_spins(element-1,irow,icol,val,a,desc_a,info)
|
||||
if(info /= psb_success_) exit
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),b,desc_a,info)
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),bv,desc_a,info)
|
||||
if(info /= psb_success_) exit
|
||||
zt(:)=0.d0
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xv,desc_a,info)
|
||||
call psb_geins(ib,myidx(ii:ii+ib-1),zt(1:ib),xxv,desc_a,info)
|
||||
if(info /= psb_success_) exit
|
||||
end do
|
||||
|
||||
@@ -598,8 +601,8 @@ contains
|
||||
call psb_errpush(info,name,a_err=ch_err)
|
||||
goto 9999
|
||||
end if
|
||||
call psb_geasb(b,desc_a,info)
|
||||
call psb_geasb(xv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geasb(xxv,desc_a,info)
|
||||
if (info == psb_success_) call psb_geasb(bv,desc_a,info)
|
||||
if(info /= psb_success_) then
|
||||
info=psb_err_from_subroutine_
|
||||
ch_err='asb rout.'
|
||||
|
||||
@@ -28,9 +28,9 @@ d_coo_matgen: d_coo_matgen.o
|
||||
psb_d_cxx_impl.o d_matgen.o: psb_d_cxx_mat_mod.o
|
||||
psb_d_cyy_impl.o d_matgen.o: psb_d_cyy_mat_mod.o
|
||||
d_matgen.o: psb_d_czz_mat_mod.o
|
||||
d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o psb_d_czz_mat_mod.o
|
||||
d_matgen: d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o psb_d_cyy_impl.o
|
||||
$(F90LINK) $(LINKOPT) d_matgen.o psb_d_cxx_mat_mod.o psb_d_cxx_impl.o psb_d_cyy_mat_mod.o\
|
||||
psb_d_cyy_impl.o psb_d_czz_mat_mod.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) $(RSB_EXTRA)
|
||||
psb_d_cyy_impl.o -o d_matgen $(PSBLAS_LIB) $(LDLIBS) $(RSB_EXTRA)
|
||||
/bin/cp -p $(CPUPDFLAG) d_matgen $(EXEDIR)
|
||||
# /bin/mv d_matgen $(EXEDIR)
|
||||
|
||||
@@ -39,7 +39,6 @@ check: all
|
||||
|
||||
clean:
|
||||
/bin/rm -f d_coo_matgen.o d_matgen.o \
|
||||
psb_d_czz_mat_mod.o \
|
||||
psb_d_cyy_mat_mod.o psb_d_cyy_impl.o \
|
||||
psb_d_cxx_mat_mod.o psb_d_cxx_impl.o *$(.mod)
|
||||
verycleanlib:
|
||||
|
||||
@@ -6,7 +6,6 @@ program d_matgen
|
||||
use psb_d_mat_mod
|
||||
use psb_d_cxx_mat_mod
|
||||
use psb_d_cyy_mat_mod
|
||||
use psb_d_czz_mat_mod
|
||||
#ifdef HAVE_LIBRSB
|
||||
use psb_d_rsb_mat_mod
|
||||
#endif
|
||||
@@ -40,7 +39,6 @@ program d_matgen
|
||||
#endif
|
||||
type(psb_d_cyy_sparse_mat) :: acyy
|
||||
type(psb_d_csr_sparse_mat) :: acsr
|
||||
type(psb_d_czz_sparse_mat) :: aczz
|
||||
type(psb_d_cxx_sparse_mat) :: acxx
|
||||
|
||||
! other variables
|
||||
@@ -78,7 +76,6 @@ program d_matgen
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
!call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acyy)
|
||||
!call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,aczz)
|
||||
!call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,acxx)
|
||||
#ifdef HAVE_LIBRSB
|
||||
call create_matrix(idim,a,b,x,desc_a,ictxt,afmt,info,arsb)
|
||||
|
||||
@@ -1,13 +0,0 @@
|
||||
module psb_d_czz_mat_mod
|
||||
|
||||
use psb_d_base_mat_mod
|
||||
|
||||
type, extends(psb_d_base_sparse_mat) :: psb_d_czz_sparse_mat
|
||||
|
||||
integer, allocatable :: irp(:), ja(:)
|
||||
real(psb_dpk_), allocatable :: val(:)
|
||||
|
||||
contains
|
||||
end type psb_d_czz_sparse_mat
|
||||
contains
|
||||
end module psb_d_czz_mat_mod
|
||||
Reference in New Issue
Block a user