diff --git a/base/internals/Makefile b/base/internals/Makefile index 7dff70db..e354bac8 100644 --- a/base/internals/Makefile +++ b/base/internals/Makefile @@ -2,9 +2,8 @@ include ../../Make.inc FOBJS = psi_compute_size.o psi_crea_bnd_elem.o psi_crea_index.o \ psi_crea_ovr_elem.o psi_dl_check.o \ - psi_gthsct.o \ psi_sort_dl.o \ - psi_gthsct.o psi_ldsc_pre_halo.o\ + psi_ldsc_pre_halo.o\ psi_sort_dl.o psi_idx_cnv.o psi_idx_ins_cnv.o psi_fnd_owner.o FOBJS2 = psi_exist_ovr_elem.o psi_list_search.o srtlist.o COBJS = avltree.o srcht.o @@ -22,7 +21,7 @@ lib: mpfobjs $(FOBJS) $(FOBJS2) $(COBJS) $(MPFOBJS2) $(RANLIB) $(LIBDIR)/$(LIBNAME) -mpfobjs: psi_gthsct.o +mpfobjs: (make $(MPFOBJS) F90="$(MPF90)" FC="$(MPF90)" FCOPT="$(F90COPT)") (make $(FOBJS2) F90="$(MPF77)" FC="$(MPF77)" FCOPT="$(FCOPT)") clean: diff --git a/base/internals/psi_compute_size.f90 b/base/internals/psi_compute_size.f90 index ee43cf46..f9c6dbb6 100644 --- a/base/internals/psi_compute_size.f90 +++ b/base/internals/psi_compute_size.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_compute_size(desc_data, index_in, dl_lda, info) + use psi_mod, psb_protect_name => psi_compute_size use psb_const_mod use psb_descriptor_type use psb_error_mod diff --git a/base/internals/psi_crea_bnd_elem.f90 b/base/internals/psi_crea_bnd_elem.f90 index cb5355ef..b7b6e41d 100644 --- a/base/internals/psi_crea_bnd_elem.f90 +++ b/base/internals/psi_crea_bnd_elem.f90 @@ -29,6 +29,7 @@ !!$ !!$ subroutine psi_crea_bnd_elem(bndel,desc_a,info) + use psi_mod, psb_protect_name => psi_crea_bnd_elem use psb_realloc_mod use psb_descriptor_type use psb_error_mod diff --git a/base/internals/psi_crea_index.f90 b/base/internals/psi_crea_index.f90 index dc08c337..ea88d856 100644 --- a/base/internals/psi_crea_index.f90 +++ b/base/internals/psi_crea_index.f90 @@ -34,6 +34,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info use psb_descriptor_type use psb_error_mod use psb_penv_mod + use psi_mod, psb_protect_name => psi_crea_index implicit none type(psb_desc_type), intent(in) :: desc_a @@ -50,33 +51,6 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,nxch,nsnd,nrcv,info logical,parameter :: debug=.false. character(len=20) :: name - - interface - subroutine psi_sort_dl(dep_list,l_dep_list,np,info) - integer :: np,dep_list(:,:), l_dep_list(:), info - end subroutine psi_sort_dl - end interface - - interface - subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) - integer :: np,dl_lda,length_dl(0:np) - integer :: dep_list(dl_lda,0:np) - end subroutine psi_dl_check - end interface - - interface - subroutine psi_desc_index(desc,index_in,dep_list,& - & length_dl,nsnd,nrcv,desc_index,& - & isglob_in,info) - use psb_descriptor_type - type(psb_desc_type) :: desc - integer :: index_in(:),dep_list(:) - integer, allocatable :: desc_index(:) - integer :: length_dl,nsnd,nrcv,info - logical :: isglob_in - end subroutine psi_desc_index - end interface - info = 0 name='psi_crea_index' call psb_erractionsave(err_act) diff --git a/base/internals/psi_crea_ovr_elem.f90 b/base/internals/psi_crea_ovr_elem.f90 index 003b4f50..17a685d9 100644 --- a/base/internals/psi_crea_ovr_elem.f90 +++ b/base/internals/psi_crea_ovr_elem.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_crea_ovr_elem(desc_overlap,ovr_elem,info) + use psi_mod, psb_protect_name => psi_crea_ovr_elem use psb_realloc_mod use psb_error_mod use psb_penv_mod diff --git a/base/internals/psi_desc_index.f90 b/base/internals/psi_desc_index.f90 index d26d937a..048e8d9e 100644 --- a/base/internals/psi_desc_index.f90 +++ b/base/internals/psi_desc_index.f90 @@ -36,7 +36,7 @@ subroutine psi_desc_index(desc,index_in,dep_list,& use psb_const_mod use mpi use psb_penv_mod - use psi_mod, only : psi_idx_cnv + use psi_mod, psb_protect_name => psi_desc_index implicit none ! ...array parameters..... diff --git a/base/internals/psi_dl_check.f90 b/base/internals/psi_dl_check.f90 index 9c374970..95c6ac87 100644 --- a/base/internals/psi_dl_check.f90 +++ b/base/internals/psi_dl_check.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) + use psi_mod, psb_protect_name => psi_dl_check use psb_const_mod use psb_descriptor_type implicit none diff --git a/base/internals/psi_dswapdata.f90 b/base/internals/psi_dswapdata.f90 index fd0ade4d..9af8113e 100644 --- a/base/internals/psi_dswapdata.f90 +++ b/base/internals/psi_dswapdata.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_dswapdatam use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -49,7 +50,6 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info,data) & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & snd_pt, rcv_pt, pnti, data_ - integer :: krecvid, ksendid integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) @@ -442,6 +442,7 @@ end subroutine psi_dswapdatam !!$ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_dswapdatav use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -465,7 +466,6 @@ subroutine psi_dswapdatav(flag,beta,y,desc_a,work,info,data) integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) - integer :: krecvid, ksendid integer :: int_err(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv diff --git a/base/internals/psi_dswaptran.f90 b/base/internals/psi_dswaptran.f90 index ceeaf4e9..a665075c 100644 --- a/base/internals/psi_dswaptran.f90 +++ b/base/internals/psi_dswaptran.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_dswaptranm use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -49,7 +50,6 @@ subroutine psi_dswaptranm(flag,n,beta,y,desc_a,work,info,data) & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & snd_pt, rcv_pt, pnti - integer :: krecvid, ksendid integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) @@ -427,6 +427,7 @@ end subroutine psi_dswaptranm !!$ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_dswaptranv use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -450,7 +451,6 @@ subroutine psi_dswaptranv(flag,beta,y,desc_a,work,info,data) integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) - integer :: krecvid, ksendid integer :: int_err(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv diff --git a/base/internals/psi_extrct_dl.f90 b/base/internals/psi_extrct_dl.f90 index f5fb633a..78d31bf8 100644 --- a/base/internals/psi_extrct_dl.f90 +++ b/base/internals/psi_extrct_dl.f90 @@ -117,6 +117,7 @@ subroutine psi_extract_dep_list(desc_data,desc_str,dep_list,& ! desc_str list. ! length_dl integer array(0:np) ! length_dl(i) is the length of dep_list(*,i) list + use psi_mod, psb_protect_name => psi_extract_dep_list use mpi use psb_penv_mod use psb_const_mod @@ -128,7 +129,7 @@ subroutine psi_extract_dep_list(desc_data,desc_str,dep_list,& ! ....array parameters.... integer :: desc_str(*),desc_data(*),dep_list(dl_lda,0:np),length_dl(0:np) - integer, pointer :: itmp(:) + integer, allocatable :: itmp(:) ! .....local arrays.... integer int_err(5) double precision real_err(5) diff --git a/base/internals/psi_fnd_owner.f90 b/base/internals/psi_fnd_owner.f90 index cc556fcd..5633a5b8 100644 --- a/base/internals/psi_fnd_owner.f90 +++ b/base/internals/psi_fnd_owner.f90 @@ -35,7 +35,8 @@ subroutine psi_fnd_owner(nv,idx,iprc,desc,info) use psb_error_mod use psb_penv_mod use psb_realloc_mod - use psi_mod, only : psi_idx_cnv + use psi_mod, psb_protect_name => psi_fnd_owner + implicit none integer, intent(in) :: nv integer, intent(in) :: idx(:) diff --git a/base/internals/psi_idx_cnv.f90 b/base/internals/psi_idx_cnv.f90 index 1dd6f0f4..4106d4f8 100644 --- a/base/internals/psi_idx_cnv.f90 +++ b/base/internals/psi_idx_cnv.f90 @@ -34,6 +34,7 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) use psb_const_mod use psb_error_mod use psb_penv_mod + use psi_mod, psb_protect_name => psi_idx_cnv1 implicit none integer, intent(in) :: nv integer, intent(inout) :: idxin(:) @@ -41,17 +42,6 @@ subroutine psi_idx_cnv1(nv,idxin,desc,info,mask,owned) integer, intent(out) :: info logical, intent(in), optional, target :: mask(:) logical, intent(in), optional :: owned - interface - subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) - use psb_descriptor_type - integer, intent(in) :: nv, idxin(:) - integer, intent(out) :: idxout(:) - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - logical, intent(in), optional, target :: mask(:) - logical, intent(in), optional :: owned - end subroutine psi_idx_cnv2 - end interface integer :: i,ictxt,row,k,mglob, nglob,err integer :: np, me, isize integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt @@ -184,7 +174,7 @@ subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) use psb_const_mod use psb_error_mod use psb_penv_mod - use psi_mod, only : psi_inner_cnv + use psi_mod, psb_protect_name => psi_idx_cnv2 implicit none integer, intent(in) :: nv, idxin(:) integer, intent(out) :: idxout(:) @@ -366,6 +356,8 @@ end subroutine psi_idx_cnv2 !!$ !!$ subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) + + use psi_mod, psb_protect_name => psi_idx_cnvs use psb_descriptor_type integer, intent(in) :: idxin integer, intent(out) :: idxout @@ -373,17 +365,6 @@ subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) integer, intent(out) :: info logical, intent(in), optional, target :: mask logical, intent(in), optional :: owned - interface - subroutine psi_idx_cnv2(nv,idxin,idxout,desc,info,mask,owned) - use psb_descriptor_type - integer, intent(in) :: nv, idxin(:) - integer, intent(out) :: idxout(:) - type(psb_desc_type), intent(in) :: desc - integer, intent(out) :: info - logical, intent(in), optional, target :: mask(:) - logical, intent(in), optional :: owned - end subroutine psi_idx_cnv2 - end interface integer :: iout(1) logical :: mask_, owned_ @@ -397,7 +378,7 @@ subroutine psi_idx_cnvs(idxin,idxout,desc,info,mask,owned) else owned_ = .true. endif - call psi_idx_cnv2(1,(/idxin/),iout,desc,info,(/mask_/),owned_) + call psi_idx_cnv(1,(/idxin/),iout,desc,info,(/mask_/),owned_) idxout=iout(1) return diff --git a/base/internals/psi_idx_ins_cnv.f90 b/base/internals/psi_idx_ins_cnv.f90 index 05c2bf52..d774b114 100644 --- a/base/internals/psi_idx_ins_cnv.f90 +++ b/base/internals/psi_idx_ins_cnv.f90 @@ -29,6 +29,7 @@ !!$ !!$ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask) + use psi_mod, psb_protect_name => psi_idx_ins_cnv1 use psb_descriptor_type use psb_serial_mod use psb_const_mod @@ -40,16 +41,6 @@ subroutine psi_idx_ins_cnv1(nv,idxin,desc,info,mask) type(psb_desc_type), intent(inout) :: desc integer, intent(out) :: info logical, intent(in), optional, target :: mask(:) - interface - subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) - use psb_descriptor_type - integer, intent(in) :: nv, idxin(:) - integer, intent(out) :: idxout(:) - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in), optional, target :: mask(:) - end subroutine psi_idx_ins_cnv2 - end interface integer :: i,ictxt,row,k,mglob, nglob,err integer :: np, me, isize integer :: pnt_halo,nrow,ncol, nh, ip, err_act,lip,nxt @@ -170,6 +161,7 @@ end subroutine psi_idx_ins_cnv1 !!$ subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) + use psi_mod, psb_protect_name => psi_idx_ins_cnv2 use psb_descriptor_type use psb_serial_mod use psb_const_mod @@ -408,22 +400,13 @@ end subroutine psi_idx_ins_cnv2 !!$ !!$ subroutine psi_idx_ins_cnvs(idxin,idxout,desc,info,mask) + use psi_mod, psb_protect_name => psi_idx_cnvs use psb_descriptor_type integer, intent(in) :: idxin integer, intent(out) :: idxout type(psb_desc_type), intent(inout) :: desc integer, intent(out) :: info logical, intent(in), optional, target :: mask - interface - subroutine psi_idx_ins_cnv2(nv,idxin,idxout,desc,info,mask) - use psb_descriptor_type - integer, intent(in) :: nv, idxin(:) - integer, intent(out) :: idxout(:) - type(psb_desc_type), intent(inout) :: desc - integer, intent(out) :: info - logical, intent(in), optional, target :: mask(:) - end subroutine psi_idx_ins_cnv2 - end interface integer :: iout(1) logical :: mask_ @@ -432,7 +415,7 @@ subroutine psi_idx_ins_cnvs(idxin,idxout,desc,info,mask) else mask_ = .true. endif - call psi_idx_ins_cnv2(1,(/idxin/),iout,desc,info,(/mask_/)) + call psi_idx_ins_cnv(1,(/idxin/),iout,desc,info,(/mask_/)) idxout=iout(1) return diff --git a/base/internals/psi_iswapdata.f90 b/base/internals/psi_iswapdata.f90 index 285c7b77..34a9e69e 100644 --- a/base/internals/psi_iswapdata.f90 +++ b/base/internals/psi_iswapdata.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_iswapdatam use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -49,7 +50,6 @@ subroutine psi_iswapdatam(flag,n,beta,y,desc_a,work,info,data) & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & snd_pt, rcv_pt, pnti, data_ - integer :: krecvid, ksendid integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) @@ -442,6 +442,7 @@ end subroutine psi_iswapdatam !!$ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_iswapdatav use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -465,7 +466,6 @@ subroutine psi_iswapdatav(flag,beta,y,desc_a,work,info,data) integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) - integer :: krecvid, ksendid integer :: int_err(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv diff --git a/base/internals/psi_iswaptran.f90 b/base/internals/psi_iswaptran.f90 index afa039ed..43a80f1f 100644 --- a/base/internals/psi_iswaptran.f90 +++ b/base/internals/psi_iswaptran.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_iswaptranm use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -49,7 +50,6 @@ subroutine psi_iswaptranm(flag,n,beta,y,desc_a,work,info,data) & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & snd_pt, rcv_pt, pnti - integer :: krecvid, ksendid integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) @@ -428,6 +428,7 @@ end subroutine psi_iswaptranm !!$ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_iswaptranv use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -451,7 +452,6 @@ subroutine psi_iswaptranv(flag,beta,y,desc_a,work,info,data) integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) - integer :: krecvid, ksendid integer :: int_err(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv diff --git a/base/internals/psi_ldsc_pre_halo.f90 b/base/internals/psi_ldsc_pre_halo.f90 index 57b98275..57281118 100644 --- a/base/internals/psi_ldsc_pre_halo.f90 +++ b/base/internals/psi_ldsc_pre_halo.f90 @@ -35,7 +35,7 @@ subroutine psi_ldsc_pre_halo(desc,ext_hv,info) use psb_error_mod use psb_penv_mod use psb_realloc_mod - use psi_mod, only : psi_fnd_owner + use psi_mod, psb_protect_name => psi_ldsc_pre_halo implicit none type(psb_desc_type), intent(inout) :: desc logical, intent(in) :: ext_hv diff --git a/base/internals/psi_sort_dl.f90 b/base/internals/psi_sort_dl.f90 index 9116ff86..7f787cdf 100644 --- a/base/internals/psi_sort_dl.f90 +++ b/base/internals/psi_sort_dl.f90 @@ -33,6 +33,7 @@ subroutine psi_sort_dl(dep_list,l_dep_list,np,info) ! interface between former sort_dep_list subroutine ! and new srtlist ! + use psi_mod, psb_protect_name => psi_sort_dl use psb_const_mod use psb_error_mod implicit none diff --git a/base/internals/psi_zswapdata.f90 b/base/internals/psi_zswapdata.f90 index 267fbf34..01fe5d79 100644 --- a/base/internals/psi_zswapdata.f90 +++ b/base/internals/psi_zswapdata.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_zswapdatam use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -49,7 +50,6 @@ subroutine psi_zswapdatam(flag,n,beta,y,desc_a,work,info,data) & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & snd_pt, rcv_pt, pnti, data_ - integer :: krecvid, ksendid integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) @@ -442,6 +442,7 @@ end subroutine psi_zswapdatam !!$ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_zswapdatav use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -465,7 +466,6 @@ subroutine psi_zswapdatav(flag,beta,y,desc_a,work,info,data) integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) - integer :: krecvid, ksendid integer :: int_err(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv diff --git a/base/internals/psi_zswaptran.f90 b/base/internals/psi_zswaptran.f90 index 3a3d9c03..2d93de38 100644 --- a/base/internals/psi_zswaptran.f90 +++ b/base/internals/psi_zswaptran.f90 @@ -30,6 +30,7 @@ !!$ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) + use psi_mod, psb_protect_name => psi_zswaptranm use psb_error_mod use psb_descriptor_type use psb_penv_mod @@ -49,7 +50,6 @@ subroutine psi_zswaptranm(flag,n,beta,y,desc_a,work,info,data) & proc_to_comm, p2ptag, icomm, p2pstat(mpi_status_size),& & idxs, idxr, iret, err_act, totxch, ixrec, i, idx_pt,& & snd_pt, rcv_pt, pnti - integer :: krecvid, ksendid integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) @@ -445,7 +445,6 @@ subroutine psi_zswaptranv(flag,beta,y,desc_a,work,info,data) integer, allocatable, dimension(:) :: bsdidx, brvidx,& & sdsz, rvsz, prcid, rvhd, sdhd integer, pointer :: d_idx(:) - integer :: krecvid, ksendid integer :: int_err(5) logical :: swap_mpi, swap_sync, swap_send, swap_recv,& & albf,do_send,do_recv diff --git a/base/modules/Makefile b/base/modules/Makefile index e39fd6cb..86ab1a14 100644 --- a/base/modules/Makefile +++ b/base/modules/Makefile @@ -3,6 +3,7 @@ include ../../Make.inc MODULES = psb_realloc_mod.o psb_string_mod.o psb_spmat_type.o \ psb_desc_type.o psb_spsb_mod.o \ psb_serial_mod.o psb_tools_mod.o \ + psi_gthsct_mod.o \ psb_error_mod.o \ psb_const_mod.o \ psb_comm_mod.o psb_psblas_mod.o psi_mod.o \ @@ -21,7 +22,7 @@ psb_realloc_mod.o : psb_error_mod.o psb_spmat_type.o : psb_realloc_mod.o psb_error_mod.o psb_const_mod.o psb_string_mod.o psb_error_mod.o: psb_const_mod.o psb_penv_mod.o: psb_const_mod.o psb_error_mod.o psb_realloc_mod.o -psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o +psi_mod.o: psb_penv_mod.o psb_error_mod.o psb_desc_type.o psi_gthsct_mod.o psb_desc_type.o: psb_const_mod.o psb_error_mod.o psb_penv_mod.o psb_check_mod.o: psb_desc_type.o psb_methd_mod.o: psb_serial_mod.o psb_desc_type.o psb_prec_type.o diff --git a/base/modules/psb_gthsct_mod.f90 b/base/modules/psb_gthsct_mod.f90 deleted file mode 100644 index d52cce9a..00000000 --- a/base/modules/psb_gthsct_mod.f90 +++ /dev/null @@ -1,349 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -module psi_gthsct_mod - - interface psi_gth - module procedure psi_igthm, psi_igthv,& - & psi_dgthm, psi_dgthv,& - & psi_zgthm, psi_zgthv - end interface - - interface psi_sct - module procedure psi_isctm, psi_isctv,& - & psi_dsctm, psi_dsctv,& - & psi_zsctm, psi_zsctv - end interface - -contains - - subroutine psi_dgthm(n,k,idx,x,y) - - implicit none - - integer :: n, k, idx(:) - real(kind(1.d0)) :: x(:,:), y(:) - - ! Locals - integer :: i, j, pt - - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(pt)=x(idx(i),j) - end do - end do - - end subroutine psi_dgthm - - subroutine psi_dgthv(n,idx,x,y) - - implicit none - - integer :: n, idx(:) - real(kind(1.d0)) :: x(:), y(:) - - ! Locals - integer :: i, j - - do i=1,n - y(i)=x(idx(i)) - end do - - end subroutine psi_dgthv - - - subroutine psi_dsctm(n,k,idx,x,beta,y) - - implicit none - - integer :: n, k, idx(:) - real(kind(1.d0)) :: beta, x(:), y(:,:) - - ! Locals - integer :: i, j, pt - - if (beta.eq.0.d0) then - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = x(pt) - end do - end do - else if (beta.eq.1.d0) then - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = y(idx(i),j)+x(pt) - end do - end do - else - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = beta*y(idx(i),j)+x(pt) - end do - end do - end if - end subroutine psi_dsctm - - subroutine psi_dsctv(n,idx,x,beta,y) - - implicit none - - integer :: n, k, idx(:) - real(kind(1.d0)) :: beta, x(:), y(:) - - ! Locals - integer :: i, j, pt - - if (beta.eq.0.d0) then - do i=1,n - y(idx(i)) = x(i) - end do - else if (beta.eq.1.d0) then - do i=1,n - y(idx(i)) = y(idx(i))+x(i) - end do - else - do i=1,n - y(idx(i)) = beta*y(idx(i))+x(i) - end do - end if - end subroutine psi_dsctv - - - subroutine psi_igthm(n,k,idx,x,y) - - implicit none - - integer :: n, k, idx(:) - integer :: x(:,:), y(:) - - ! Locals - integer :: i, j, pt - - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(pt)=x(idx(i),j) - end do - end do - - end subroutine psi_igthm - - - subroutine psi_igthv(n,idx,x,y) - - implicit none - - integer :: n, idx(:) - integer :: x(:), y(:) - - ! Locals - integer :: i, j - - do i=1,n - y(i)=x(idx(i)) - end do - - end subroutine psi_igthv - - - - subroutine psi_isctm(n,k,idx,x,beta,y) - - implicit none - - integer :: n, k, idx(:) - integer :: beta, x(:), y(:,:) - - ! Locals - integer :: i, j, pt - - if (beta.eq.0.d0) then - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = x(pt) - end do - end do - else if (beta.eq.1.d0) then - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = y(idx(i),j)+x(pt) - end do - end do - else - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = beta*y(idx(i),j)+x(pt) - end do - end do - end if - end subroutine psi_isctm - - subroutine psi_isctv(n,idx,x,beta,y) - - implicit none - - integer :: n, k, idx(:) - integer :: beta, x(:), y(:) - - ! Locals - integer :: i, j, pt - - if (beta.eq.0.d0) then - do i=1,n - y(idx(i)) = x(i) - end do - else if (beta.eq.1.d0) then - do i=1,n - y(idx(i)) = y(idx(i))+x(i) - end do - else - do i=1,n - y(idx(i)) = beta*y(idx(i))+x(i) - end do - end if - end subroutine psi_isctv - - - subroutine psi_zgthm(n,k,idx,x,y) - - implicit none - - integer :: n, k, idx(:) - complex(kind(1.d0)) :: x(:,:), y(:) - - ! Locals - integer :: i, j, pt - - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(pt)=x(idx(i),j) - end do - end do - - end subroutine psi_zgthm - - - subroutine psi_zgthv(n,idx,x,y) - - implicit none - - integer :: n, idx(:) - complex(kind(1.d0)) :: x(:), y(:) - - ! Locals - integer :: i, j - - do i=1,n - y(i)=x(idx(i)) - end do - - end subroutine psi_zgthv - - subroutine psi_zsctm(n,k,idx,x,beta,y) - - implicit none - - integer :: n, k, idx(:) - complex(kind(1.d0)) :: beta, x(:), y(:,:) - - ! Locals - integer :: i, j, pt - - if (beta.eq.0.d0) then - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = x(pt) - end do - end do - else if (beta.eq.1.d0) then - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = y(idx(i),j)+x(pt) - end do - end do - else - pt=0 - do j=1,k - do i=1,n - pt=pt+1 - y(idx(i),j) = beta*y(idx(i),j)+x(pt) - end do - end do - end if - end subroutine psi_zsctm - - - subroutine psi_zsctv(n,idx,x,beta,y) - - implicit none - - integer :: n, k, idx(:) - complex(kind(1.d0)) :: beta, x(:), y(:) - - ! Locals - integer :: i, j, pt - - if (beta.eq.0.d0) then - do i=1,n - y(idx(i)) = x(i) - end do - else if (beta.eq.1.d0) then - do i=1,n - y(idx(i)) = y(idx(i))+x(i) - end do - else - do i=1,n - y(idx(i)) = beta*y(idx(i))+x(i) - end do - end if - end subroutine psi_zsctv - -end module psi_gthsct_mod diff --git a/base/modules/psb_penv_mod.F90 b/base/modules/psb_penv_mod.F90 index abd9f05f..a012b2a0 100644 --- a/base/modules/psb_penv_mod.F90 +++ b/base/modules/psb_penv_mod.F90 @@ -168,6 +168,20 @@ module psb_penv_mod #if defined(SERIAL_MPI) integer, private, save :: nctxt=0 #endif + + +#if defined(NETLIB_BLACS) + interface + integer function krecvid(contxt,proc_to_comm,myrow) + integer contxt,proc_to_comm,myrow + end function krecvid + end interface + interface + integer function ksendid(contxt,proc_to_comm,myrow) + integer contxt,proc_to_comm,myrow + end function ksendid + end interface +#endif contains diff --git a/base/modules/psb_serial_mod.f90 b/base/modules/psb_serial_mod.f90 index bfd8de51..489e4afb 100644 --- a/base/modules/psb_serial_mod.f90 +++ b/base/modules/psb_serial_mod.f90 @@ -309,19 +309,21 @@ module psb_serial_mod end interface interface psb_rwextd - subroutine psb_drwextd(nr,a,info,b) + subroutine psb_drwextd(nr,a,info,b,rowscale) use psb_spmat_type integer, intent(in) :: nr type(psb_dspmat_type), intent(inout) :: a integer, intent(out) :: info type(psb_dspmat_type), intent(in), optional :: b + logical, intent(in), optional :: rowscale end subroutine psb_drwextd - subroutine psb_zrwextd(nr,a,info,b) + subroutine psb_zrwextd(nr,a,info,b,rowscale) use psb_spmat_type integer, intent(in) :: nr type(psb_zspmat_type), intent(inout) :: a integer, intent(out) :: info type(psb_zspmat_type), intent(in), optional :: b + logical, intent(in), optional :: rowscale end subroutine psb_zrwextd end interface diff --git a/base/modules/psb_spmat_type.f90 b/base/modules/psb_spmat_type.f90 index f525067e..7c8f6d3a 100644 --- a/base/modules/psb_spmat_type.f90 +++ b/base/modules/psb_spmat_type.f90 @@ -508,7 +508,7 @@ contains if (info /= 0) return call psb_realloc(max(nnz,a%m+1,a%k+1),a%ia2,info) if (info /= 0) return - call psb_realloc(ifc*nnz+200,a%ia1,info) + call psb_realloc(max(ifc*nnz+200,a%m+1,a%k+1),a%ia1,info) if (info /= 0) return end if if (info /= 0) return diff --git a/base/modules/psb_tools_mod.f90 b/base/modules/psb_tools_mod.f90 index a3c13fab..002d4f55 100644 --- a/base/modules/psb_tools_mod.f90 +++ b/base/modules/psb_tools_mod.f90 @@ -726,7 +726,7 @@ contains subroutine psb_cdasb(desc_a,info) use psb_descriptor_type - interface psb_icdasb + interface subroutine psb_icdasb(desc_a,info,ext_hv) use psb_descriptor_type Type(psb_desc_type), intent(inout) :: desc_a @@ -735,7 +735,6 @@ contains end subroutine psb_icdasb end interface - Type(psb_desc_type), intent(inout) :: desc_a integer, intent(out) :: info diff --git a/base/internals/psi_gthsct.f90 b/base/modules/psi_gthsct_mod.f90 similarity index 100% rename from base/internals/psi_gthsct.f90 rename to base/modules/psi_gthsct_mod.f90 diff --git a/base/modules/psi_mod.f90 b/base/modules/psi_mod.f90 index abbda7ff..46d28ef4 100644 --- a/base/modules/psi_mod.f90 +++ b/base/modules/psi_mod.f90 @@ -30,16 +30,8 @@ !!$ module psi_mod + use psi_gthsct_mod -!!$ use psb_descriptor_type - -!!$ interface -!!$ subroutine psi_inner_cnv(n,x,hashsize,hashmask,hashv,glb_lc) -!!$ integer, intent(in) :: n, hashsize,hashmask,hashv(0:),glb_lc(:,:) -!!$ integer, intent(inout) :: x(:) -!!$ end subroutine psi_inner_cnv -!!$ end interface - interface subroutine psi_compute_size(desc_data,& & index_in, dl_lda, info) @@ -77,17 +69,24 @@ module psi_mod end interface interface - subroutine psi_desc_index(desc_data,index_in,dep_list,& - & length_dl,nsnd,nrcv,loc_to_glob,glob_to_loc,desc_index,& - & isglob_in,info) - integer :: desc_data(:),index_in(:),dep_list(:) - integer :: loc_to_glob(:),glob_to_loc(:) - integer,allocatable, intent(inout) :: desc_index(:) - integer :: length_dl,nsnd,nrcv,info - logical :: isglob_in - end subroutine psi_desc_index + subroutine psi_desc_index(desc,index_in,dep_list,& + & length_dl,nsnd,nrcv,desc_index,isglob_in,info) + use psb_descriptor_type + type(psb_desc_type) :: desc + integer :: index_in(:),dep_list(:) + integer,allocatable, intent(inout) :: desc_index(:) + integer :: length_dl,nsnd,nrcv,info + logical :: isglob_in + end subroutine psi_desc_index end interface + interface + subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) + integer :: np,dl_lda,length_dl(0:np) + integer :: dep_list(dl_lda,0:np) + end subroutine psi_dl_check + end interface + interface subroutine psi_sort_dl(dep_list,l_dep_list,np,info) integer :: np,dep_list(:,:), l_dep_list(:), info @@ -203,61 +202,6 @@ module psi_mod end subroutine psi_zswaptranv end interface - - interface psi_gth - subroutine psi_dgthm(n,k,idx,x,y) - integer :: n, k, idx(:) - real(kind(1.d0)) :: x(:,:), y(:) - end subroutine psi_dgthm - subroutine psi_dgthv(n,idx,x,y) - integer :: n, idx(:) - real(kind(1.d0)) :: x(:), y(:) - end subroutine psi_dgthv - subroutine psi_igthm(n,k,idx,x,y) - integer :: n, k, idx(:) - integer :: x(:,:), y(:) - end subroutine psi_igthm - subroutine psi_igthv(n,idx,x,y) - integer :: n, idx(:) - integer :: x(:), y(:) - end subroutine psi_igthv - subroutine psi_zgthm(n,k,idx,x,y) - integer :: n, k, idx(:) - complex(kind(1.d0)) :: x(:,:), y(:) - end subroutine psi_zgthm - subroutine psi_zgthv(n,idx,x,y) - integer :: n, idx(:) - complex(kind(1.d0)) :: x(:), y(:) - end subroutine psi_zgthv - end interface - - interface psi_sct - subroutine psi_dsctm(n,k,idx,x,beta,y) - integer :: n, k, idx(:) - real(kind(1.d0)) :: beta, x(:), y(:,:) - end subroutine psi_dsctm - subroutine psi_dsctv(n,idx,x,beta,y) - integer :: n, idx(:) - real(kind(1.d0)) :: beta, x(:), y(:) - end subroutine psi_dsctv - subroutine psi_isctm(n,k,idx,x,beta,y) - integer :: n, k, idx(:) - integer :: beta, x(:), y(:,:) - end subroutine psi_isctm - subroutine psi_isctv(n,idx,x,beta,y) - integer :: n, idx(:) - integer :: beta, x(:), y(:) - end subroutine psi_isctv - subroutine psi_zsctm(n,k,idx,x,beta,y) - integer :: n, k, idx(:) - complex(kind(1.d0)) :: beta, x(:), y(:,:) - end subroutine psi_zsctm - subroutine psi_zsctv(n,idx,x,beta,y) - integer :: n, idx(:) - complex(kind(1.d0)) :: beta, x(:), y(:) - end subroutine psi_zsctv - end interface - interface psi_cnv_dsc module procedure psi_cnv_dsc end interface @@ -266,6 +210,13 @@ module psi_mod module procedure psi_inner_cnv1, psi_inner_cnv2 end interface + interface + subroutine psi_extract_dep_list(desc_data,desc_str,dep_list,& + & length_dl,np,dl_lda,mode,info) + integer :: np,dl_lda,mode, info + integer :: desc_str(*),desc_data(*),dep_list(dl_lda,0:np),length_dl(0:np) + end subroutine psi_extract_dep_list + end interface interface psi_fnd_owner subroutine psi_fnd_owner(nv,idx,iprc,desc,info) use psb_descriptor_type diff --git a/base/serial/psb_drwextd.f90 b/base/serial/psb_drwextd.f90 index ce420245..77587b73 100644 --- a/base/serial/psb_drwextd.f90 +++ b/base/serial/psb_drwextd.f90 @@ -31,8 +31,13 @@ ! File: psb_drwextd.f90 ! Subroutine: ! Parameters: - -subroutine psb_drwextd(nr,a,info,b) +! +! We have a problem here: 1. How to handle well all the formats? +! 2. What should we do with rowscale? Does it only +! apply when a%fida='COO' ?????? +! +! +subroutine psb_drwextd(nr,a,info,b,rowscale) use psb_spmat_type use psb_error_mod implicit none @@ -42,39 +47,49 @@ subroutine psb_drwextd(nr,a,info,b) type(psb_dspmat_type), intent(inout) :: a integer,intent(out) :: info type(psb_dspmat_type), intent(in), optional :: b - integer :: i,j,ja,jb,err_act + logical,intent(in), optional :: rowscale + + integer :: i,j,ja,jb,err_act,nza,nzb character(len=20) :: name, ch_err + logical rowscale_ name='psb_drwextd' info = 0 call psb_erractionsave(err_act) - if (nr > a%m) then + if (present(rowscale)) then + rowscale_ = rowscale + else + rowscale_ = .true. + end if + if (nr > a%m) then if (a%fida == 'CSR') then call psb_realloc(nr+1,a%ia2,info) if (present(b)) then - jb = b%ia2(b%m+1)-1 - call psb_realloc(size(a%ia1)+jb,a%ia1,info) - call psb_realloc(size(a%aspk)+jb,a%aspk,info) - do i=1, min(nr-a%m,b%m) - ! Should use spgtblk. - ! Don't care for the time being. - a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i) - ja = a%ia2(a%m+i) - jb = b%ia2(i) - do - if (jb >= b%ia2(i+1)) exit - a%aspk(ja) = b%aspk(jb) - a%ia1(ja) = b%ia1(jb) - ja = ja + 1 - jb = jb + 1 - end do - end do - do j=i,nr-a%m - a%ia2(a%m+i+1) = a%ia2(a%m+i) - end do + nzb = psb_sp_get_nnzeros(b) + call psb_realloc(size(a%ia1)+nzb,a%ia1,info) + call psb_realloc(size(a%aspk)+nzb,a%aspk,info) + if (b%fida=='CSR') then + do i=1, min(nr-a%m,b%m) + a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i) + ja = a%ia2(a%m+i) + jb = b%ia2(i) + do + if (jb >= b%ia2(i+1)) exit + a%aspk(ja) = b%aspk(jb) + a%ia1(ja) = b%ia1(jb) + ja = ja + 1 + jb = jb + 1 + end do + end do + do j=i,nr-a%m + a%ia2(a%m+i+1) = a%ia2(a%m+i) + end do + else + write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' + endif else do i=a%m+2,nr+1 a%ia2(i) = a%ia2(i-1) @@ -83,7 +98,44 @@ subroutine psb_drwextd(nr,a,info,b) a%m = nr else if (a%fida == 'COO') then if (present(b)) then - else + nza = psb_sp_get_nnzeros(a) + nzb = psb_sp_get_nnzeros(b) + call psb_sp_reall(a,nza+nzb,info) + if (b%fida=='COO') then + if (rowscale_) then + do j=1,nzb + if ((a%m + b%ia1(j)) <= nr) then + a%ia1(nza+j) = a%m + b%ia1(j) + a%ia2(nza+j) = b%ia2(j) + a%aspk(nza+j) = b%aspk(j) + end if + enddo + else + do j=1,nzb + if ((b%ia1(j)) <= nr) then + a%ia1(nza+j) = b%ia1(j) + a%ia2(nza+j) = b%ia2(j) + a%aspk(nza+j) = b%aspk(j) + endif + enddo + endif + a%infoa(psb_nnz_) = nza+nzb + else if(b%fida=='CSR') then + do i=1, min(nr-a%m,b%m) + do + jb = b%ia2(i) + if (jb >= b%ia2(i+1)) exit + nza = nza + 1 + a%aspk(nza) = b%aspk(jb) + a%ia1(nza) = a%m + i + a%ia2(nza) = b%ia1(jb) + jb = jb + 1 + end do + end do + a%infoa(psb_nnz_) = nza + else + write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' + endif endif a%m = nr else if (a%fida == 'JAD') then diff --git a/base/serial/psb_zrwextd.f90 b/base/serial/psb_zrwextd.f90 index e0c61c56..b583a56c 100644 --- a/base/serial/psb_zrwextd.f90 +++ b/base/serial/psb_zrwextd.f90 @@ -31,8 +31,13 @@ ! File: psb_zrwextd.f90 ! Subroutine: ! Parameters: - -subroutine psb_zrwextd(nr,a,info,b) +! +! We have a problem here: 1. How to handle well all the formats? +! 2. What should we do with rowscale? Does it only +! apply when a%fida='COO' ?????? +! +! +subroutine psb_zrwextd(nr,a,info,b,rowscale) use psb_spmat_type use psb_error_mod implicit none @@ -42,39 +47,49 @@ subroutine psb_zrwextd(nr,a,info,b) type(psb_zspmat_type), intent(inout) :: a integer,intent(out) :: info type(psb_zspmat_type), intent(in), optional :: b - integer :: i,j,ja,jb,err_act + logical,intent(in), optional :: rowscale + + integer :: i,j,ja,jb,err_act,nza,nzb character(len=20) :: name, ch_err + logical rowscale_ name='psb_zrwextd' info = 0 call psb_erractionsave(err_act) - if (nr > a%m) then + if (present(rowscale)) then + rowscale_ = rowscale + else + rowscale_ = .true. + end if + if (nr > a%m) then if (a%fida == 'CSR') then call psb_realloc(nr+1,a%ia2,info) if (present(b)) then - jb = b%ia2(b%m+1)-1 - call psb_realloc(size(a%ia1)+jb,a%ia1,info) - call psb_realloc(size(a%aspk)+jb,a%aspk,info) - do i=1, min(nr-a%m,b%m) - ! Should use spgtblk. - ! Don't care for the time being. - a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i) - ja = a%ia2(a%m+i) - jb = b%ia2(i) - do - if (jb >= b%ia2(i+1)) exit - a%aspk(ja) = b%aspk(jb) - a%ia1(ja) = b%ia1(jb) - ja = ja + 1 - jb = jb + 1 - end do - end do - do j=i,nr-a%m - a%ia2(a%m+i+1) = a%ia2(a%m+i) - end do + nzb = psb_sp_get_nnzeros(b) + call psb_realloc(size(a%ia1)+nzb,a%ia1,info) + call psb_realloc(size(a%aspk)+nzb,a%aspk,info) + if (b%fida=='CSR') then + do i=1, min(nr-a%m,b%m) + a%ia2(a%m+i+1) = a%ia2(a%m+i) + b%ia2(i+1) - b%ia2(i) + ja = a%ia2(a%m+i) + jb = b%ia2(i) + do + if (jb >= b%ia2(i+1)) exit + a%aspk(ja) = b%aspk(jb) + a%ia1(ja) = b%ia1(jb) + ja = ja + 1 + jb = jb + 1 + end do + end do + do j=i,nr-a%m + a%ia2(a%m+i+1) = a%ia2(a%m+i) + end do + else + write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' + endif else do i=a%m+2,nr+1 a%ia2(i) = a%ia2(i-1) @@ -83,7 +98,44 @@ subroutine psb_zrwextd(nr,a,info,b) a%m = nr else if (a%fida == 'COO') then if (present(b)) then - else + nza = psb_sp_get_nnzeros(a) + nzb = psb_sp_get_nnzeros(b) + call psb_sp_reall(a,nza+nzb,info) + if (b%fida=='COO') then + if (rowscale_) then + do j=1,nzb + if ((a%m + b%ia1(j)) <= nr) then + a%ia1(nza+j) = a%m + b%ia1(j) + a%ia2(nza+j) = b%ia2(j) + a%aspk(nza+j) = b%aspk(j) + end if + enddo + else + do j=1,nzb + if ((b%ia1(j)) <= nr) then + a%ia1(nza+j) = b%ia1(j) + a%ia2(nza+j) = b%ia2(j) + a%aspk(nza+j) = b%aspk(j) + endif + enddo + endif + a%infoa(psb_nnz_) = nza+nzb + else if(b%fida=='CSR') then + do i=1, min(nr-a%m,b%m) + do + jb = b%ia2(i) + if (jb >= b%ia2(i+1)) exit + nza = nza + 1 + a%aspk(nza) = b%aspk(jb) + a%ia1(nza) = a%m + i + a%ia2(nza) = b%ia1(jb) + jb = jb + 1 + end do + end do + a%infoa(psb_nnz_) = nza + else + write(0,*) 'Implement SPGETBLK in RWEXTD!!!!!!!' + endif endif a%m = nr else if (a%fida == 'JAD') then diff --git a/base/tools/psb_dcdovr.f90 b/base/tools/psb_dcdovr.f90 index e124a26d..335d18df 100644 --- a/base/tools/psb_dcdovr.f90 +++ b/base/tools/psb_dcdovr.f90 @@ -46,14 +46,16 @@ ! Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype) + use psb_tools_mod, psb_protect_name => psb_dcdovr + use psb_serial_mod use psb_descriptor_type use psb_error_mod use psb_penv_mod - use psb_tools_mod, only : psb_cdcpy use psb_realloc_mod use psi_mod use mpi + Implicit None ! .. Array Arguments .. @@ -64,7 +66,7 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype) integer, intent(out) :: info integer, intent(in),optional :: extype - interface psb_icdasb + interface subroutine psb_icdasb(desc_a,info,ext_hv) use psb_descriptor_type Type(psb_desc_type), intent(inout) :: desc_a @@ -72,8 +74,6 @@ Subroutine psb_dcdovr(a,desc_a,novr,desc_ov,info, extype) logical, intent(in),optional :: ext_hv end subroutine psb_icdasb end interface - - integer icomm, err_act ! .. Local Scalars .. diff --git a/base/tools/psb_dspins.f90 b/base/tools/psb_dspins.f90 index 991eab0d..517d2ea8 100644 --- a/base/tools/psb_dspins.f90 +++ b/base/tools/psb_dspins.f90 @@ -46,6 +46,7 @@ ! subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) + use psb_tools_mod, psb_protect_name => psb_dspins use psb_descriptor_type use psb_spmat_type use psb_serial_mod @@ -69,28 +70,6 @@ subroutine psb_dspins(nz,ia,ja,val,a,desc_a,info,rebuild) integer, parameter :: relocsz=200 logical :: rebuild_ integer, allocatable :: ila(:),jla(:) - - interface psb_cdins - subroutine psb_cdins(nz,ia,ja,desc_a,info,ila,jla) - use psb_descriptor_type - implicit none - type(psb_desc_type), intent(inout) :: desc_a - integer, intent(in) :: nz,ia(:),ja(:) - integer, intent(out) :: info - integer, optional, intent(out) :: ila(:), jla(:) - end subroutine psb_cdins - end interface - - interface psb_glob_to_loc - subroutine psb_glob_to_loc(x,desc_a,info,iact) - use psb_descriptor_type - implicit none - type(psb_desc_type), intent(in) :: desc_a - integer, intent(inout) :: x(:) - integer, intent(out) :: info - character, intent(in), optional :: iact - end subroutine psb_glob_to_loc - end interface character(len=20) :: name, ch_err info = 0 diff --git a/base/tools/psb_zcdovr.f90 b/base/tools/psb_zcdovr.f90 index 44915b5e..9b11860b 100644 --- a/base/tools/psb_zcdovr.f90 +++ b/base/tools/psb_zcdovr.f90 @@ -45,11 +45,11 @@ ! Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype) + use psb_tools_mod, psb_protect_name => psb_zcdovr use psb_serial_mod use psb_descriptor_type use psb_error_mod use psb_penv_mod - use psb_tools_mod, only : psb_cdcpy use psb_realloc_mod use psi_mod use mpi @@ -63,7 +63,7 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype) integer, intent(out) :: info integer, intent(in),optional :: extype - interface psb_icdasb + interface subroutine psb_icdasb(desc_a,info,ext_hv) use psb_descriptor_type Type(psb_desc_type), intent(inout) :: desc_a @@ -71,8 +71,6 @@ Subroutine psb_zcdovr(a,desc_a,novr,desc_ov,info, extype) logical, intent(in),optional :: ext_hv end subroutine psb_icdasb end interface - - integer icomm, err_act ! .. Local Scalars .. diff --git a/base/tools/psb_zspins.f90 b/base/tools/psb_zspins.f90 index cf4600b0..74569b95 100644 --- a/base/tools/psb_zspins.f90 +++ b/base/tools/psb_zspins.f90 @@ -46,13 +46,13 @@ ! subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) + use psb_tools_mod, psb_protect_name => psb_zspins use psb_descriptor_type use psb_spmat_type use psb_serial_mod use psb_const_mod use psb_error_mod use psb_penv_mod - use psb_tools_mod implicit none !....parameters... @@ -71,27 +71,6 @@ subroutine psb_zspins(nz,ia,ja,val,a,desc_a,info,rebuild) logical :: rebuild_ integer, allocatable :: ila(:),jla(:) -!!$ interface psb_cdins -!!$ subroutine psb_cdins(nz,ia,ja,desc_a,info,ila,jla) -!!$ use psb_descriptor_type -!!$ implicit none -!!$ type(psb_desc_type), intent(inout) :: desc_a -!!$ integer, intent(in) :: nz,ia(:),ja(:) -!!$ integer, intent(out) :: info -!!$ integer, optional, intent(out) :: ila(:), jla(:) -!!$ end subroutine psb_cdins -!!$ end interface -!!$ -!!$ interface psb_glob_to_loc -!!$ subroutine psb_glob_to_loc(x,desc_a,info,iact) -!!$ use psb_descriptor_type -!!$ implicit none -!!$ type(psb_desc_type), intent(in) :: desc_a -!!$ integer, intent(inout) :: x(:) -!!$ integer, intent(out) :: info -!!$ character, intent(in), optional :: iact -!!$ end subroutine psb_glob_to_loc -!!$ end interface character(len=20) :: name, ch_err info = 0 diff --git a/prec/Makefile b/prec/Makefile index 6530ea59..2af84258 100644 --- a/prec/Makefile +++ b/prec/Makefile @@ -3,12 +3,12 @@ include ../Make.inc LIBDIR=../lib HERE=. MODOBJS= psb_prec_type.o psb_prec_mod.o -F90OBJS= psb_dilu_bld.o psb_dilu_fct.o\ +F90OBJS= psb_dbjac_bld.o psb_dilu_fct.o\ psb_dprecbld.o psb_dprecset.o \ psb_ddiagsc_bld.o \ psb_dprc_aply.o \ psb_dgprec_aply.o psb_dbjac_aply.o\ - psb_zilu_bld.o psb_zilu_fct.o\ + psb_zbjac_bld.o psb_zilu_fct.o\ psb_zprecbld.o psb_zprecset.o \ psb_zdiagsc_bld.o \ psb_zprc_aply.o psb_zgprec_aply.o psb_zbjac_aply.o diff --git a/prec/psb_dbjac_bld.f90 b/prec/psb_dbjac_bld.f90 new file mode 100644 index 00000000..ad30149c --- /dev/null +++ b/prec/psb_dbjac_bld.f90 @@ -0,0 +1,236 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_dbjac_bld(a,desc_a,p,upd,info) + use psb_base_mod + use psb_prec_mod, psb_protect_name => psb_dbjac_bld + implicit none + ! + ! .. Scalar Arguments .. + integer, intent(out) :: info + ! .. array Arguments .. + type(psb_dspmat_type), intent(in), target :: a + type(psb_dprec_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + character, intent(in) :: upd + + ! .. Local Scalars .. + integer :: i, j, jj, k, kk, m + integer :: int_err(5) + character :: trans, unitd + type(psb_dspmat_type) :: blck, atmp + real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6, t7, t8 + logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. + integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& + & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia + integer :: ictxt,np,me + character(len=20) :: name, ch_err + + + if(psb_get_errstatus().ne.0) return + info=0 + name='psb_dbjac_bld' + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_a) + call psb_info(ictxt, me, np) + + m = a%m + if (m < 0) then + info = 10 + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + trans = 'N' + unitd = 'U' + call psb_nullify_sp(atmp) + + call psb_cdcpy(desc_a,p%desc_data,info) + if(info /= 0) then + info=4010 + ch_err='psb_cdcpy' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + select case(p%iprcparm(f_type_)) + + case(f_ilu_n_,f_ilu_e_) + + if (allocated(p%av)) then + if (size(p%av) < bp_ilu_avsz) then + do i=1,size(p%av) + call psb_sp_free(p%av(i),info) + if (info /= 0) then + ! Actually, we don't care here about this. + ! Just let it go. + ! return + end if + enddo + deallocate(p%av,stat=info) + endif + end if + if (.not.allocated(p%av)) then + allocate(p%av(max_avsz),stat=info) + if (info /= 0) then + call psb_errpush(4000,name) + goto 9999 + end if + endif +!!$ call psb_csprt(50+me,a,head='% (A)') + + nrow_a = psb_cd_get_local_rows(desc_a) + nztota = psb_sp_get_nnzeros(a) + if (debug) write(0,*)me,': out get_nnzeros',nztota + if (debug) call psb_barrier(ictxt) + + n_col = psb_cd_get_local_cols(desc_a) + nhalo = n_col-nrow_a + n_row = p%desc_data%matrix_data(psb_n_row_) + p%av(l_pr_)%m = n_row + p%av(l_pr_)%k = n_row + p%av(u_pr_)%m = n_row + p%av(u_pr_)%k = n_row + call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) + if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) + if(info/=0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (allocated(p%d)) then + if (size(p%d) < n_row) then + deallocate(p%d) + endif + endif + if (.not.allocated(p%d)) then + allocate(p%d(n_row),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + endif + t3 = psb_wtime() + ! This is where we have mo renumbering, thus no need + ! for ATMP + + if (debugprt) then + open(40+me) + call psb_barrier(ictxt) + call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& + & head='% Local matrix') + close(40+me) + endif + + t5= psb_wtime() + if (debug) write(0,*) me,' Going for ilu_fct' + if (debug) call psb_barrier(ictxt) + call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) + if(info/=0) then + info=4010 + ch_err='psb_ilu_fct' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (debug) write(0,*) me,' Done dilu_fct' + + + if (debugprt) then + ! + ! Print out the factors on file. + ! + open(80+me) + + call psb_csprt(80+me,p%av(l_pr_),head='% Local L factor') + write(80+me,*) '% Diagonal: ',p%av(l_pr_)%m + do i=1,p%av(l_pr_)%m + write(80+me,*) i,i,p%d(i) + enddo + call psb_csprt(80+me,p%av(u_pr_),head='% Local U factor') + + close(80+me) + end if + + ! ierr = MPE_Log_event( ifcte, 0, "st SIMPLE" ) + t6 = psb_wtime() + ! + ! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5 + ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 + + if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) + endif + + if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) + endif + + + case(f_none_) + write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' + info=4010 + ch_err='Inconsistent prec f_none_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + + case default + write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& + &p%iprcparm(f_type_) + info=4010 + ch_err='Unknown f_type_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select + + + if (debug) write(0,*) me,'End of ilu_bld' + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.psb_act_abort_) then + call psb_error() + return + end if + return + + +end subroutine psb_dbjac_bld + + diff --git a/prec/psb_dilu_bld.f90 b/prec/psb_dilu_bld.f90 deleted file mode 100644 index e10becef..00000000 --- a/prec/psb_dilu_bld.f90 +++ /dev/null @@ -1,195 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -subroutine psb_dilu_bld(a,desc_a,p,upd,info) - use psb_base_mod - use psb_prec_mod, psb_protect_name => psb_dilu_bld - implicit none - ! - ! .. Scalar Arguments .. - integer, intent(out) :: info - ! .. array Arguments .. - type(psb_dspmat_type), intent(in), target :: a - type(psb_dprec_type), intent(inout) :: p - type(psb_desc_type), intent(in) :: desc_a - character, intent(in) :: upd - - ! .. Local Scalars .. - integer :: i, j, jj, k, kk, m - integer :: int_err(5) - character :: trans, unitd - type(psb_dspmat_type) :: blck, atmp - real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6, t7, t8 - logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. - integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& - & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia - integer :: ictxt,np,me - character(len=20) :: name, ch_err - - - if(psb_get_errstatus().ne.0) return - info=0 - name='psb_dilu_bld' - call psb_erractionsave(err_act) - - ictxt=psb_cd_get_context(desc_a) - call psb_info(ictxt, me, np) - - m = a%m - if (m < 0) then - info = 10 - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,i_err=int_err) - goto 9999 - endif - trans = 'N' - unitd = 'U' - call psb_nullify_sp(atmp) - - if (allocated(p%av)) then - if (size(p%av) < bp_ilu_avsz) then - call psb_errpush(4010,name,a_err='Insufficient av size') - goto 9999 - endif - else - call psb_errpush(4010,name,a_err='AV not associated') - goto 9999 - endif -!!$ call psb_csprt(50+me,a,head='% (A)') - - nrow_a = psb_cd_get_local_rows(desc_a) - nztota = psb_sp_get_nnzeros(a) - if (debug) write(0,*)me,': out get_nnzeros',nztota - if (debug) call psb_barrier(ictxt) - - n_col = psb_cd_get_local_cols(desc_a) - nhalo = n_col-nrow_a - n_row = p%desc_data%matrix_data(psb_n_row_) - p%av(l_pr_)%m = n_row - p%av(l_pr_)%k = n_row - p%av(u_pr_)%m = n_row - p%av(u_pr_)%k = n_row - call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) - if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) - if(info/=0) then - info=4010 - ch_err='psb_sp_all' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if (allocated(p%d)) then - if (size(p%d) < n_row) then - deallocate(p%d) - endif - endif - if (.not.allocated(p%d)) then - allocate(p%d(n_row),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 - end if - - endif - t3 = psb_wtime() - ! This is where we have mo renumbering, thus no need - ! for ATMP - - if (debugprt) then - open(40+me) - call psb_barrier(ictxt) - call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& - & head='% Local matrix') - close(40+me) - endif - - t5= psb_wtime() - if (debug) write(0,*) me,' Going for ilu_fct' - if (debug) call psb_barrier(ictxt) - call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) - if(info/=0) then - info=4010 - ch_err='psb_ilu_fct' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (debug) write(0,*) me,' Done dilu_fct' - - - if (debugprt) then - ! - ! Print out the factors on file. - ! - open(80+me) - - call psb_csprt(80+me,p%av(l_pr_),head='% Local L factor') - write(80+me,*) '% Diagonal: ',p%av(l_pr_)%m - do i=1,p%av(l_pr_)%m - write(80+me,*) i,i,p%d(i) - enddo - call psb_csprt(80+me,p%av(u_pr_),head='% Local U factor') - - close(80+me) - end if - - ! ierr = MPE_Log_event( ifcte, 0, "st SIMPLE" ) - t6 = psb_wtime() - ! - ! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5 - ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 - - if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then - call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) - if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) - endif - - if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then - call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) - if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) - endif - - - if (debug) write(0,*) me,'End of ilu_bld' - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.psb_act_abort_) then - call psb_error() - return - end if - return - - -end subroutine psb_dilu_bld - - diff --git a/prec/psb_dprecbld.f90 b/prec/psb_dprecbld.f90 index 6f841886..2a86331b 100644 --- a/prec/psb_dprecbld.f90 +++ b/prec/psb_dprecbld.f90 @@ -117,50 +117,15 @@ subroutine psb_dprecbld(a,desc_a,p,info,upd) call psb_check_def(p%iprcparm(f_type_),'fact',& & f_ilu_n_,is_legal_ml_fact) - if (debug) write(0,*)me, ': Calling PSB_ILU_BLD' + if (debug) write(0,*)me, ': Calling PSB_BJAC_BLD' if (debug) call psb_barrier(ictxt) - call psb_cdcpy(desc_a,p%desc_data,info) - if(info /= 0) then - info=4010 - ch_err='psb_cdcpy' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - allocate(p%av(max_avsz),stat=info) + call psb_bjac_bld(a,desc_a,p,iupd,info) + if(info /= 0) then - info=4000 - call psb_errpush(info,name) + call psb_errpush(4010,name,a_err='psb_bjac_bld') goto 9999 end if - - select case(p%iprcparm(f_type_)) - - case(f_ilu_n_,f_ilu_e_) - call psb_ilu_bld(a,desc_a,p,iupd,info) - if(debug) write(0,*)me,': out of psb_ilu_bld',info - if (debug) call psb_barrier(ictxt) - if(info /= 0) then - info=4010 - ch_err='psb_ilu_bld' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - case(f_none_) - write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' - info=4010 - ch_err='Inconsistent prec f_none_' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - case default - write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& - &p%iprcparm(f_type_) - info=4010 - ch_err='Unknown f_type_' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end select case default info=4010 ch_err='Unknown p_type_' diff --git a/prec/psb_prec_mod.f90 b/prec/psb_prec_mod.f90 index 1aa7e108..30b461a2 100644 --- a/prec/psb_prec_mod.f90 +++ b/prec/psb_prec_mod.f90 @@ -167,8 +167,8 @@ module psb_prec_mod end subroutine psb_zilu_fct end interface - interface psb_ilu_bld - subroutine psb_dilu_bld(a,desc_a,p,upd,info) + interface psb_bjac_bld + subroutine psb_dbjac_bld(a,desc_a,p,upd,info) use psb_base_mod use psb_prec_type integer, intent(out) :: info @@ -176,8 +176,8 @@ module psb_prec_mod type(psb_dprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd - end subroutine psb_dilu_bld - subroutine psb_zilu_bld(a,desc_a,p,upd,info) + end subroutine psb_dbjac_bld + subroutine psb_zbjac_bld(a,desc_a,p,upd,info) use psb_base_mod use psb_prec_type integer, intent(out) :: info @@ -185,7 +185,7 @@ module psb_prec_mod type(psb_zprec_type), intent(inout) :: p type(psb_desc_type), intent(in) :: desc_a character, intent(in) :: upd - end subroutine psb_zilu_bld + end subroutine psb_zbjac_bld end interface interface psb_diagsc_bld diff --git a/prec/psb_zbjac_bld.f90 b/prec/psb_zbjac_bld.f90 new file mode 100644 index 00000000..dad3ca86 --- /dev/null +++ b/prec/psb_zbjac_bld.f90 @@ -0,0 +1,236 @@ +!!$ +!!$ Parallel Sparse BLAS v2.0 +!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata +!!$ Alfredo Buttari University of Rome Tor Vergata +!!$ +!!$ Redistribution and use in source and binary forms, with or without +!!$ modification, are permitted provided that the following conditions +!!$ are met: +!!$ 1. Redistributions of source code must retain the above copyright +!!$ notice, this list of conditions and the following disclaimer. +!!$ 2. Redistributions in binary form must reproduce the above copyright +!!$ notice, this list of conditions, and the following disclaimer in the +!!$ documentation and/or other materials provided with the distribution. +!!$ 3. The name of the PSBLAS group or the names of its contributors may +!!$ not be used to endorse or promote products derived from this +!!$ software without specific written permission. +!!$ +!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS +!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF +!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE +!!$ POSSIBILITY OF SUCH DAMAGE. +!!$ +!!$ +subroutine psb_zbjac_bld(a,desc_a,p,upd,info) + use psb_base_mod + use psb_prec_mod, psb_protect_name => psb_zbjac_bld + implicit none + ! + ! .. Scalar Arguments .. + integer, intent(out) :: info + ! .. array Arguments .. + type(psb_zspmat_type), intent(in), target :: a + type(psb_zprec_type), intent(inout) :: p + type(psb_desc_type), intent(in) :: desc_a + character, intent(in) :: upd + + ! .. Local Scalars .. + integer :: i, j, jj, k, kk, m + integer :: int_err(5) + character :: trans, unitd + type(psb_zspmat_type) :: blck, atmp + real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6, t7, t8 + logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. + integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& + & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia + integer :: ictxt,np,me + character(len=20) :: name, ch_err + + + if(psb_get_errstatus().ne.0) return + info=0 + name='psb_zbjac_bld' + call psb_erractionsave(err_act) + + ictxt=psb_cd_get_context(desc_a) + call psb_info(ictxt, me, np) + + m = a%m + if (m < 0) then + info = 10 + int_err(1) = 1 + int_err(2) = m + call psb_errpush(info,name,i_err=int_err) + goto 9999 + endif + trans = 'N' + unitd = 'U' + call psb_nullify_sp(atmp) + + call psb_cdcpy(desc_a,p%desc_data,info) + if(info /= 0) then + info=4010 + ch_err='psb_cdcpy' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + + select case(p%iprcparm(f_type_)) + + case(f_ilu_n_,f_ilu_e_) + + if (allocated(p%av)) then + if (size(p%av) < bp_ilu_avsz) then + do i=1,size(p%av) + call psb_sp_free(p%av(i),info) + if (info /= 0) then + ! Actually, we don't care here about this. + ! Just let it go. + ! return + end if + enddo + deallocate(p%av,stat=info) + endif + end if + if (.not.allocated(p%av)) then + allocate(p%av(max_avsz),stat=info) + if (info /= 0) then + call psb_errpush(4000,name) + goto 9999 + end if + endif +!!$ call psb_csprt(50+me,a,head='% (A)') + + nrow_a = psb_cd_get_local_rows(desc_a) + nztota = psb_sp_get_nnzeros(a) + if (debug) write(0,*)me,': out get_nnzeros',nztota + if (debug) call psb_barrier(ictxt) + + n_col = psb_cd_get_local_cols(desc_a) + nhalo = n_col-nrow_a + n_row = p%desc_data%matrix_data(psb_n_row_) + p%av(l_pr_)%m = n_row + p%av(l_pr_)%k = n_row + p%av(u_pr_)%m = n_row + p%av(u_pr_)%k = n_row + call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) + if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) + if(info/=0) then + info=4010 + ch_err='psb_sp_all' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + + if (allocated(p%d)) then + if (size(p%d) < n_row) then + deallocate(p%d) + endif + endif + if (.not.allocated(p%d)) then + allocate(p%d(n_row),stat=info) + if (info /= 0) then + call psb_errpush(4010,name,a_err='Allocate') + goto 9999 + end if + + endif + t3 = psb_wtime() + ! This is where we have mo renumbering, thus no need + ! for ATMP + + if (debugprt) then + open(40+me) + call psb_barrier(ictxt) + call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& + & head='% Local matrix') + close(40+me) + endif + + t5= psb_wtime() + if (debug) write(0,*) me,' Going for ilu_fct' + if (debug) call psb_barrier(ictxt) + call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) + if(info/=0) then + info=4010 + ch_err='psb_ilu_fct' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end if + if (debug) write(0,*) me,' Done dilu_fct' + + + if (debugprt) then + ! + ! Print out the factors on file. + ! + open(80+me) + + call psb_csprt(80+me,p%av(l_pr_),head='% Local L factor') + write(80+me,*) '% Diagonal: ',p%av(l_pr_)%m + do i=1,p%av(l_pr_)%m + write(80+me,*) i,i,p%d(i) + enddo + call psb_csprt(80+me,p%av(u_pr_),head='% Local U factor') + + close(80+me) + end if + + ! ierr = MPE_Log_event( ifcte, 0, "st SIMPLE" ) + t6 = psb_wtime() + ! + ! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5 + ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 + + if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) + endif + + if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then + call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) + if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) + endif + + + case(f_none_) + write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' + info=4010 + ch_err='Inconsistent prec f_none_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + + case default + write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& + &p%iprcparm(f_type_) + info=4010 + ch_err='Unknown f_type_' + call psb_errpush(info,name,a_err=ch_err) + goto 9999 + end select + + + if (debug) write(0,*) me,'End of ilu_bld' + call psb_erractionrestore(err_act) + return + +9999 continue + call psb_erractionrestore(err_act) + if (err_act.eq.psb_act_abort_) then + call psb_error() + return + end if + return + + +end subroutine psb_zbjac_bld + + diff --git a/prec/psb_zilu_bld.f90 b/prec/psb_zilu_bld.f90 deleted file mode 100644 index 152b70bd..00000000 --- a/prec/psb_zilu_bld.f90 +++ /dev/null @@ -1,197 +0,0 @@ -!!$ -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ -!!$ Redistribution and use in source and binary forms, with or without -!!$ modification, are permitted provided that the following conditions -!!$ are met: -!!$ 1. Redistributions of source code must retain the above copyright -!!$ notice, this list of conditions and the following disclaimer. -!!$ 2. Redistributions in binary form must reproduce the above copyright -!!$ notice, this list of conditions, and the following disclaimer in the -!!$ documentation and/or other materials provided with the distribution. -!!$ 3. The name of the PSBLAS group or the names of its contributors may -!!$ not be used to endorse or promote products derived from this -!!$ software without specific written permission. -!!$ -!!$ THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -!!$ ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED -!!$ TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR -!!$ PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS -!!$ BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR -!!$ CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF -!!$ SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -!!$ INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -!!$ CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) -!!$ ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE -!!$ POSSIBILITY OF SUCH DAMAGE. -!!$ -!!$ -subroutine psb_zilu_bld(a,desc_a,p,upd,info) - use psb_base_mod - use psb_prec_mod, psb_protect_name => psb_zilu_bld - implicit none - ! - ! .. Scalar Arguments .. - integer, intent(out) :: info - ! .. array Arguments .. - type(psb_zspmat_type), intent(in), target :: a - type(psb_zprec_type), intent(inout) :: p - type(psb_desc_type), intent(in) :: desc_a - character, intent(in) :: upd - - ! .. Local Scalars .. - integer :: i, j, jj, k, kk, m - integer :: int_err(5) - character :: trans, unitd - type(psb_zspmat_type) :: blck, atmp - real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6, t7, t8 - logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. - integer nztota, nztotb, nztmp, nzl, nnr, ir, err_act,& - & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia - integer :: ictxt,np,me - character(len=20) :: name, ch_err - - - if(psb_get_errstatus().ne.0) return - info=0 - name='psb_zilu_bld' - call psb_erractionsave(err_act) - - ictxt=psb_cd_get_context(desc_a) - call psb_info(ictxt, me, np) - - m = a%m - if (m < 0) then - info = 10 - int_err(1) = 1 - int_err(2) = m - call psb_errpush(info,name,i_err=int_err) - goto 9999 - endif - trans = 'N' - unitd = 'U' - call psb_nullify_sp(atmp) - - if (allocated(p%av)) then - if (size(p%av) < bp_ilu_avsz) then - call psb_errpush(4010,name,a_err='Insufficient av size') - goto 9999 - endif - else - call psb_errpush(4010,name,a_err='AV not associated') - goto 9999 - endif -!!$ call psb_csprt(50+me,a,head='% (A)') - - nrow_a = psb_cd_get_local_rows(desc_a) - nztota = psb_sp_get_nnzeros(a) - if (debug) write(0,*)me,': out get_nnzeros',nztota - if (debug) call psb_barrier(ictxt) - - n_col = psb_cd_get_local_cols(desc_a) - nhalo = n_col-nrow_a - n_row = p%desc_data%matrix_data(psb_n_row_) - p%av(l_pr_)%m = n_row - p%av(l_pr_)%k = n_row - p%av(u_pr_)%m = n_row - p%av(u_pr_)%k = n_row - call psb_sp_all(n_row,n_row,p%av(l_pr_),nztota,info) - if (info == 0) call psb_sp_all(n_row,n_row,p%av(u_pr_),nztota,info) - if(info/=0) then - info=4010 - ch_err='psb_sp_all' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if (allocated(p%d)) then - if (size(p%d) < n_row) then - deallocate(p%d) - endif - endif - if (.not.allocated(p%d)) then - allocate(p%d(n_row),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 - end if - - endif - - t3 = psb_wtime() - ! This is where we have mo renumbering, thus no need - ! for ATMP - - if (debugprt) then - open(40+me) - call psb_barrier(ictxt) - call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& - & head='% Local matrix') - close(40+me) - endif - - t5= psb_wtime() - if (debug) write(0,*) me,' Going for ilu_fct' - if (debug) call psb_barrier(ictxt) - call psb_ilu_fct(a,p%av(l_pr_),p%av(u_pr_),p%d,info) - if(info/=0) then - info=4010 - ch_err='psb_ilu_fct' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (debug) write(0,*) me,' Done dilu_fct' - - if (debugprt) then - ! - ! Print out the factors on file. - ! - open(80+me) - - call psb_csprt(80+me,p%av(l_pr_),head='% Local L factor') - write(80+me,*) '% Diagonal: ',p%av(l_pr_)%m - do i=1,p%av(l_pr_)%m - write(80+me,*) i,i,p%d(i) - enddo - call psb_csprt(80+me,p%av(u_pr_),head='% Local U factor') - - close(80+me) - endif - - - ! ierr = MPE_Log_event( ifcte, 0, "st SIMPLE" ) - t6 = psb_wtime() - ! - ! write(0,'(i3,1x,a,3(1x,g18.9))') me,'renum/factor time',t3-t2,t6-t5 - ! if (me==0) write(0,'(a,3(1x,g18.9))') 'renum/factor time',t3-t2,t6-t5 - - if (psb_sp_getifld(psb_upd_,p%av(u_pr_),info) /= psb_upd_perm_) then - call psb_sp_trimsize(p%av(u_pr_),i1,i2,ia,info) - if (info == 0) call psb_sp_reall(p%av(u_pr_),i1,i2,ia,info) - endif - - if (psb_sp_getifld(psb_upd_,p%av(l_pr_),info) /= psb_upd_perm_) then - call psb_sp_trimsize(p%av(l_pr_),i1,i2,ia,info) - if (info == 0) call psb_sp_reall(p%av(l_pr_),i1,i2,ia,info) - endif - - - if (debug) write(0,*) me,'End of ilu_bld' - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.psb_act_abort_) then - call psb_error() - return - end if - return - - -end subroutine psb_zilu_bld - - diff --git a/prec/psb_zprecbld.f90 b/prec/psb_zprecbld.f90 index ae26a596..de58e101 100644 --- a/prec/psb_zprecbld.f90 +++ b/prec/psb_zprecbld.f90 @@ -50,8 +50,7 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd) integer :: int_err(5) character :: iupd - - logical, parameter :: debug=.false. + logical, parameter :: debug=.false. integer,parameter :: iroot=0,iout=60,ilout=40 character(len=20) :: name, ch_err @@ -120,50 +119,15 @@ subroutine psb_zprecbld(a,desc_a,p,info,upd) call psb_check_def(p%iprcparm(f_type_),'fact',& & f_ilu_n_,is_legal_ml_fact) - if (debug) write(0,*)me, ': Calling PSB_ILU_BLD' + if (debug) write(0,*)me, ': Calling PSB_BJAC_BLD' if (debug) call psb_barrier(ictxt) - call psb_cdcpy(desc_a,p%desc_data,info) - if(info /= 0) then - info=4010 - ch_err='psb_cdcpy' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - allocate(p%av(max_avsz),stat=info) + call psb_bjac_bld(a,desc_a,p,iupd,info) + if(info /= 0) then - info=4000 - call psb_errpush(info,name) + call psb_errpush(4010,name,a_err='psb_bjac_bld') goto 9999 end if - - select case(p%iprcparm(f_type_)) - - case(f_ilu_n_,f_ilu_e_) - call psb_ilu_bld(a,desc_a,p,iupd,info) - if(debug) write(0,*)me,': out of psb_ilu_bld' - if (debug) call psb_barrier(ictxt) - if(info /= 0) then - info=4010 - ch_err='psb_ilu_bld' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - case(f_none_) - write(0,*) 'Fact=None in BASEPRC_BLD Bja/ASM??' - info=4010 - ch_err='Inconsistent prec f_none_' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - case default - write(0,*) 'Unknown factor type in baseprc_bld bja/asm: ',& - &p%iprcparm(f_type_) - info=4010 - ch_err='Unknown f_type_' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end select case default info=4010 ch_err='Unknown p_type_'