From 9a09cf4904b71dda320a7034b3deff9b46491041 Mon Sep 17 00:00:00 2001 From: Salvatore Filippone Date: Tue, 7 Mar 2006 16:18:00 +0000 Subject: [PATCH] Second step of preconditioning revision. --- src/modules/psb_prec_type.f90 | 4 +- src/prec/Makefile | 6 +- src/prec/psb_dcslu.f90 | 376 ------------------ .../{psb_dilu_bld.f90 => psb_dilu_fct.f90} | 16 +- src/prec/psb_dmlprc_bld.f90 | 18 +- src/prec/psb_dprec.f90 | 12 +- src/prec/psb_dprecbld.f90 | 14 +- src/prec/psb_dslu_bld.f90 | 6 +- src/prec/psb_dumf_bld.f90 | 10 +- src/prec/{fort_slu_impl.c => psb_slu_impl.c} | 24 +- src/prec/{fort_umf_impl.c => psb_umf_impl.c} | 24 +- 11 files changed, 67 insertions(+), 443 deletions(-) delete mode 100644 src/prec/psb_dcslu.f90 rename src/prec/{psb_dilu_bld.f90 => psb_dilu_fct.f90} (97%) rename src/prec/{fort_slu_impl.c => psb_slu_impl.c} (96%) rename src/prec/{fort_umf_impl.c => psb_umf_impl.c} (92%) diff --git a/src/modules/psb_prec_type.f90 b/src/modules/psb_prec_type.f90 index 329ef7ce..bf80ad96 100644 --- a/src/modules/psb_prec_type.f90 +++ b/src/modules/psb_prec_type.f90 @@ -481,10 +481,10 @@ contains if (associated(p%iprcparm)) then if (p%iprcparm(f_type_)==f_slu_) then - call fort_slu_free(p%iprcparm(slu_ptr_),info) + call psb_slu_free(p%iprcparm(slu_ptr_),info) end if if (p%iprcparm(f_type_)==f_umf_) then - call fort_umf_free(p%iprcparm(umf_symptr_),& + call psb_umf_free(p%iprcparm(umf_symptr_),& & p%iprcparm(umf_numptr_),info) end if deallocate(p%iprcparm,stat=info) diff --git a/src/prec/Makefile b/src/prec/Makefile index 704f0cb8..24e79fd8 100644 --- a/src/prec/Makefile +++ b/src/prec/Makefile @@ -3,13 +3,13 @@ include ../../Make.inc LIBDIR=../../lib/ -MPFOBJS=psb_dcslu.o psb_dbldaggrmat.o -F90OBJS=psb_dasmatbld.o psb_dslu_bld.o psb_dumf_bld.o psb_dilu_bld.o\ +MPFOBJS=psb_dilu_bld.o psb_dbldaggrmat.o +F90OBJS=psb_dasmatbld.o psb_dslu_bld.o psb_dumf_bld.o psb_dilu_fct.o\ psb_dmlprc_bld.o psb_dsp_renum.o\ psb_dprec.o psb_dprecbld.o gps.o psb_dprecfree.o psb_dprecset.o \ psb_dgenaggrmap.o $(MPFOBJS) -COBJS=fort_slu_impl.o fort_umf_impl.o +COBJS=psb_slu_impl.o psb_umf_impl.o INCDIRS=-I. -I.. -I$(LIBDIR) OBJS=$(F90OBJS) $(COBJS) diff --git a/src/prec/psb_dcslu.f90 b/src/prec/psb_dcslu.f90 deleted file mode 100644 index 7e85d23a..00000000 --- a/src/prec/psb_dcslu.f90 +++ /dev/null @@ -1,376 +0,0 @@ -!!$ -!!$ -!!$ MPcube: Multilevel Parallel Preconditioners Package -!!$ for -!!$ Parallel Sparse BLAS v2.0 -!!$ (C) Copyright 2006 Salvatore Filippone University of Rome Tor Vergata -!!$ Alfredo Buttari University of Rome Tor Vergata -!!$ Daniela Di Serafino II University of Naples -!!$ Pasqua D'Ambra ICAR-CNR -!!$ -!!$ 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 MPCUBE 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 MPCUBE 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. -!!$ -!!$ -!***************************************************************************** -!* * -!* This is where the action takes place. * -!* ASMATBLD does the setup: building the prec descriptor plus retrieving * -!* matrix rows if needed * -!* * -!* * -!* * -!* * -!* some open code does the renumbering * -!* * -!* * -!* * -!* * -!***************************************************************************** -subroutine psb_dcslu(a,desc_a,p,upd,info) - use psb_serial_mod - use psb_const_mod - use psb_prec_type - use psb_descriptor_type - use psb_spmat_type - use psb_tools_mod - use psb_psblas_mod - use psb_error_mod - implicit none - ! - ! .. Scalar Arguments .. - integer, intent(out) :: info - ! .. array Arguments .. - type(psb_dspmat_type), intent(in), target :: a - type(psb_dbase_prec), 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,mpi_wtime, t7, t8 - integer, pointer :: itmp(:), itmp2(:) - real(kind(1.d0)), pointer :: rtmp(:) - external mpi_wtime - logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false. - integer istpb, istpe, ifctb, ifcte, err_act, irank, icomm, nztota, nztotb,& - & nztmp, nzl, nnr, ir, mglob, mtype, n_row, nrow_a,n_col, nhalo,lovr, & - & ind, iind, pi,nr,ns - integer ::icontxt,nprow,npcol,me,mycol - character(len=20) :: name, ch_err - - interface psb_ilu_bld - subroutine psb_dilu_bld(a,l,u,d,info,blck) - use psb_spmat_type - integer, intent(out) :: info - type(psb_dspmat_type),intent(in) :: a - type(psb_dspmat_type),intent(inout) :: l,u - type(psb_dspmat_type),intent(in), optional, target :: blck - real(kind(1.d0)), intent(inout) :: d(:) - end subroutine psb_dilu_bld - end interface - - interface psb_asmatbld - Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt) - use psb_serial_mod - Use psb_descriptor_type - Use psb_prec_type - integer, intent(in) :: ptype,novr - Type(psb_dspmat_type), Intent(in) :: a - Type(psb_dspmat_type), Intent(inout) :: blk - Type(psb_desc_type), Intent(inout) :: desc_p - Type(psb_desc_type), Intent(in) :: desc_data - Character, Intent(in) :: upd - integer, intent(out) :: info - character(len=5), optional :: outfmt - end Subroutine psb_dasmatbld - end interface - - interface psb_sp_renum - subroutine psb_dsp_renum(a,desc_a,blck,p,atmp,info) - use psb_prec_type - use psb_descriptor_type - use psb_spmat_type - implicit none - - ! .. array Arguments .. - type(psb_dspmat_type), intent(in) :: a,blck - type(psb_dspmat_type), intent(inout) :: atmp - type(psb_dbase_prec), intent(inout) :: p - type(psb_desc_type), intent(in) :: desc_a - integer, intent(out) :: info - end subroutine psb_dsp_renum - end interface - - if(psb_get_errstatus().ne.0) return - info=0 - name='psb_dcslu' - call psb_erractionsave(err_act) - - icontxt=desc_a%matrix_data(psb_ctxt_) - call blacs_gridinfo(icontxt,nprow,npcol,me,mycol) - - 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' - if (p%iprcparm(n_ovr_) < 0) then - info = 11 - int_err(1) = 1 - int_err(2) = p%iprcparm(n_ovr_) - call psb_errpush(info,name,i_err=int_err) - goto 9999 - endif - - ! call blacs_gridinfo(icontxt,nprow,npcol,me,mycol) - - - icontxt=desc_a%matrix_data(psb_ctxt_) - call psb_nullify_sp(blck) - t1= mpi_wtime() - - if(debug) write(0,*)me,': calling psb_asmatbld',p%iprcparm(p_type_),p%iprcparm(n_ovr_) - call psb_asmatbld(p%iprcparm(p_type_),p%iprcparm(n_ovr_),a,& - & blck,desc_a,upd,p%desc_data,info) - if(info/=0) then - info=4010 - ch_err='psb_asmatbld' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - t2= mpi_wtime() - if(debug) write(0,*)me,': out of psb_asmatbld' - - if (associated(p%av)) then - if (size(p%av) < bp_ilu_avsz) then - do k=1,size(p%av) - call psb_spfree(p%av(k),info) - end do - deallocate(p%av) - p%av => null() - endif - endif - - if (.not.associated(p%av)) then - allocate(p%av(bp_ilu_avsz),stat=info) - if (info /= 0) then - call psb_errpush(4010,name,a_err='Allocate') - goto 9999 - end if - endif - do k=1,size(p%av) - call psb_nullify_sp(p%av(k)) - end do - nrow_a = desc_a%matrix_data(psb_n_row_) - call psb_spinfo(psb_nztotreq_,a,nztota,info) - if(info/=0) then - info=4010 - ch_err='psb_spinfo' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - n_col = desc_a%matrix_data(psb_n_col_) - nhalo = n_col-nrow_a - n_row = p%desc_data%matrix_data(psb_n_row_) - lovr = ((nztota+nrow_a-1)/nrow_a)*nhalo*p%iprcparm(n_ovr_) - 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_spall(n_row,n_row,p%av(l_pr_),nztota+lovr,info) - call psb_spall(n_row,n_row,p%av(u_pr_),nztota+lovr,info) - if(info/=0) then - info=4010 - ch_err='psb_spall' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if (associated(p%d)) then - if (size(p%d) < n_row) then - deallocate(p%d) - endif - endif - if (.not.associated(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 - - - if (debug) then - write(0,*) me,'Done psb_asmatbld' - call blacs_barrier(icontxt,'All') - endif - - - if (p%iprcparm(iren_) > 0) then - - ! - ! Here we allocate a full copy to hold local A and received BLK - ! - - call psb_spinfo(psb_nztotreq_,a,nztota,info) - call psb_spinfo(psb_nztotreq_,blck,nztotb,info) - call psb_spall(atmp,nztota+nztotb,info) - if(info/=0) then - info=4011 - call psb_errpush(info,name) - goto 9999 - end if - - - ! write(0,*) 'DCSLU ',nztota,nztotb,a%m - - call psb_sp_renum(a,desc_a,blck,p,atmp,info) - - if(info/=0) then - info=4010 - ch_err='psb_sp_renum' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - t3 = mpi_wtime() - if (debugprt) then - call blacs_barrier(icontxt,'All') - open(40+me) - call psb_csprt(40+me,atmp,head='% Local matrix') - close(40+me) - endif - if (debug) write(0,*) me,' Factoring rows ',& - &atmp%m,a%m,blck%m,atmp%ia2(atmp%m+1)-1 - - ! - ! Ok, factor the matrix. - ! - t5 = mpi_wtime() - blck%m=0 - call psb_ilu_bld(atmp,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck) - if(info/=0) then - info=4010 - ch_err='psb_ilu_bld' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - call psb_spfree(atmp,info) - if(info/=0) then - info=4010 - ch_err='psb_spfree' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - - else if (p%iprcparm(iren_) == 0) then - t3 = mpi_wtime() - ! This is where we have mo renumbering, thus no need - ! for ATMP - - if (debugprt) then - open(40+me) - call blacs_barrier(icontxt,'All') - call psb_csprt(40+me,a,iv=p%desc_data%loc_to_glob,& - & head='% Local matrix') - if (p%iprcparm(p_type_)==asm_) then - call psb_csprt(40+me,blck,iv=p%desc_data%loc_to_glob,& - & irs=a%m,head='% Received rows') - endif - close(40+me) - endif - - t5= mpi_wtime() - if (debug) write(0,*) me,' Going for dilu_bld' - call psb_ilu_bld(a,p%av(l_pr_),p%av(u_pr_),p%d,info,blck=blck) - if(info/=0) then - info=4010 - ch_err='psb_ilu_bld' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - if (debug) write(0,*) me,' Done dilu_bld' - endif - - - 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 = mpi_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 - - call psb_spfree(blck,info) - if(info/=0) then - info=4010 - ch_err='psb_spfree' - call psb_errpush(info,name,a_err=ch_err) - goto 9999 - end if - - if (debug) write(0,*) me,'End of cslu' - - call psb_erractionrestore(err_act) - return - -9999 continue - call psb_erractionrestore(err_act) - if (err_act.eq.act_abort) then - call psb_error() - return - end if - return - - -end subroutine psb_dcslu - - diff --git a/src/prec/psb_dilu_bld.f90 b/src/prec/psb_dilu_fct.f90 similarity index 97% rename from src/prec/psb_dilu_bld.f90 rename to src/prec/psb_dilu_fct.f90 index c1ac28e7..2718b25e 100644 --- a/src/prec/psb_dilu_bld.f90 +++ b/src/prec/psb_dilu_fct.f90 @@ -33,7 +33,7 @@ !!$ POSSIBILITY OF SUCH DAMAGE. !!$ !!$ -subroutine psb_dilu_bld(a,l,u,d,info,blck) +subroutine psb_dilu_fct(a,l,u,d,info,blck) ! ! This routine copies and factors "on the fly" from A and BLCK @@ -86,11 +86,11 @@ subroutine psb_dilu_bld(a,l,u,d,info,blck) blck_%m=0 endif - call psb_dilu_bldint(m,a%m,a,blck_%m,blck_,& + call psb_dilu_fctint(m,a%m,a,blck_%m,blck_,& & d,l%aspk,l%ia1,l%ia2,u%aspk,u%ia1,u%ia2,l1,l2,info) if(info.ne.0) then info=4010 - ch_err='psb_dilu_bldint' + ch_err='psb_dilu_fctint' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -130,7 +130,7 @@ subroutine psb_dilu_bld(a,l,u,d,info,blck) return contains - subroutine psb_dilu_bldint(m,ma,a,mb,b,& + subroutine psb_dilu_fctint(m,ma,a,mb,b,& & d,laspk,lia1,lia2,uaspk,uia1,uia2,l1,l2,info) implicit none @@ -148,7 +148,7 @@ contains integer :: int_err(5) character(len=20) :: name, ch_err - name='psb_dilu_bldint' + name='psb_dilu_fctint' if(psb_get_errstatus().ne.0) return info=0 call psb_erractionsave(err_act) @@ -461,7 +461,7 @@ contains call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - if(debug) write(0,*)'Leaving dcsrlu' + if(debug) write(0,*)'Leaving ilu_fct' call psb_erractionrestore(err_act) return @@ -473,5 +473,5 @@ contains return end if return - end subroutine psb_dilu_bldint -end subroutine psb_dilu_bld + end subroutine psb_dilu_fctint +end subroutine psb_dilu_fct diff --git a/src/prec/psb_dmlprc_bld.f90 b/src/prec/psb_dmlprc_bld.f90 index 1c646508..25586af9 100644 --- a/src/prec/psb_dmlprc_bld.f90 +++ b/src/prec/psb_dmlprc_bld.f90 @@ -51,15 +51,15 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info) integer :: i, nrg, nzg, err_act,k character(len=20) :: name, ch_err - interface psb_ilu_bld - subroutine psb_dilu_bld(a,l,u,d,info,blck) + interface psb_ilu_fct + subroutine psb_dilu_fct(a,l,u,d,info,blck) use psb_spmat_type integer, intent(out) :: info type(psb_dspmat_type),intent(in) :: a type(psb_dspmat_type),intent(inout) :: l,u type(psb_dspmat_type),intent(in), optional, target :: blck real(kind(1.d0)), intent(inout) :: d(:) - end subroutine psb_dilu_bld + end subroutine psb_dilu_fct end interface interface psb_genaggrmap @@ -152,10 +152,10 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info) case(f_ilu_n_,f_ilu_e_) call psb_spreall(p%av(l_pr_),nzg,info) call psb_spreall(p%av(u_pr_),nzg,info) - call psb_ilu_bld(p%av(ac_),p%av(l_pr_),p%av(u_pr_),p%d,info) + call psb_ilu_fct(p%av(ac_),p%av(l_pr_),p%av(u_pr_),p%d,info) if(info /= 0) then info=4011 - ch_err='psb_ilu_bld' + ch_err='psb_ilu_fct' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -182,11 +182,11 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info) p%av(ac_)%infoa(psb_nnz_) = k call psb_ipcoo2csr(p%av(ac_),info) call psb_spinfo(psb_nztotreq_,p%av(ac_),nzg,info) - call fort_slu_factor(nrg,nzg,& + call psb_slu_factor(nrg,nzg,& & p%av(ac_)%aspk,p%av(ac_)%ia2,p%av(ac_)%ia1,p%iprcparm(slu_ptr_),info) if(info /= 0) then info=4011 - ch_err='psb_fort_slu_factor' + ch_err='psb_slu_factor' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if @@ -213,12 +213,12 @@ subroutine psb_dmlprc_bld(a,desc_a,p,info) p%av(ac_)%infoa(psb_nnz_) = k call psb_ipcoo2csc(p%av(ac_),info) call psb_spinfo(psb_nztotreq_,p%av(ac_),nzg,info) - call fort_umf_factor(nrg,nzg,& + call psb_umf_factor(nrg,nzg,& & p%av(ac_)%aspk,p%av(ac_)%ia1,p%av(ac_)%ia2,& & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) if(info /= 0) then info=4011 - ch_err='psb_fort_umf_factor' + ch_err='psb_umf_factor' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/prec/psb_dprec.f90 b/src/prec/psb_dprec.f90 index 4d78bf02..e5863e23 100644 --- a/src/prec/psb_dprec.f90 +++ b/src/prec/psb_dprec.f90 @@ -591,9 +591,9 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info) select case(trans) case('N','n') - call fort_slu_solve(0,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) + call psb_slu_solve(0,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) case('T','t','C','c') - call fort_slu_solve(1,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) + call psb_slu_solve(1,n_row,1,ww,n_row,prec%iprcparm(slu_ptr_),info) end select if(info /=0) goto 9999 @@ -612,9 +612,9 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info) select case(trans) case('N','n') - call fort_umf_solve(0,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) + call psb_umf_solve(0,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) case('T','t','C','c') - call fort_umf_solve(1,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) + call psb_umf_solve(1,n_row,ww,x,n_row,prec%iprcparm(umf_numptr_),info) end select if(info /=0) goto 9999 @@ -678,7 +678,7 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info) & prec%desc_data,info,work=aux) if(info /=0) goto 9999 - call fort_slu_solve(0,n_row,1,ty,n_row,prec%iprcparm(slu_ptr_),info) + call psb_slu_solve(0,n_row,1,ty,n_row,prec%iprcparm(slu_ptr_),info) if(info /=0) goto 9999 tx(1:n_row) = ty(1:n_row) end do @@ -690,7 +690,7 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info) & prec%desc_data,info,work=aux) if(info /=0) goto 9999 - call fort_umf_solve(0,n_row,ww,ty,n_row,& + call psb_umf_solve(0,n_row,ww,ty,n_row,& & prec%iprcparm(umf_numptr_),info) if(info /=0) goto 9999 tx(1:n_row) = ww(1:n_row) diff --git a/src/prec/psb_dprecbld.f90 b/src/prec/psb_dprecbld.f90 index 2a5828dc..393829f5 100644 --- a/src/prec/psb_dprecbld.f90 +++ b/src/prec/psb_dprecbld.f90 @@ -52,8 +52,8 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) type(psb_desc_type), intent(in) :: desc_a character, intent(in), optional :: upd - interface psb_cslu - subroutine psb_dcslu(a,desc_data,p,upd,info) + interface psb_ilu_bld + subroutine psb_dilu_bld(a,desc_data,p,upd,info) use psb_serial_mod use psb_descriptor_type use psb_prec_type @@ -62,7 +62,7 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) type(psb_desc_type),intent(in) :: desc_data type(psb_dbase_prec), intent(inout) :: p character, intent(in) :: upd - end subroutine psb_dcslu + end subroutine psb_dilu_bld end interface interface psb_slu_bld @@ -261,17 +261,17 @@ subroutine psb_dprecbld(a,p,desc_a,info,upd) call psb_check_def(p%baseprecv(1)%iprcparm(iren_),'renumbering',& & renum_none_,is_legal_renum) - if (debug) write(0,*)me, ': Calling PSB_DCSLU' + if (debug) write(0,*)me, ': Calling PSB_ILU_BLD' select case(p%baseprecv(1)%iprcparm(f_type_)) case(f_ilu_n_,f_ilu_e_) - call psb_cslu(a,desc_a,p%baseprecv(1),iupd,info) - if(debug) write(0,*)me,': out of psb_dcslu' + call psb_ilu_bld(a,desc_a,p%baseprecv(1),iupd,info) + if(debug) write(0,*)me,': out of psb_ilu_bld' if(info /= 0) then info=4010 - ch_err='psb_dcslu' + ch_err='psb_ilu_bld' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/prec/psb_dslu_bld.f90 b/src/prec/psb_dslu_bld.f90 index df97215e..5f649d02 100644 --- a/src/prec/psb_dslu_bld.f90 +++ b/src/prec/psb_dslu_bld.f90 @@ -170,16 +170,16 @@ subroutine psb_dslu_bld(a,desc_a,p,info) goto 9999 end if if (Debug) then - write(0,*) me,'Calling fort_slu_factor ',nzt,atmp%m,& + write(0,*) me,'Calling psb_slu_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) call blacs_barrier(icontxt,'All') endif - call fort_slu_factor(atmp%m,nzt,& + call psb_slu_factor(atmp%m,nzt,& & atmp%aspk,atmp%ia2,atmp%ia1,p%iprcparm(slu_ptr_),info) if(info /= 0) then info=4010 - ch_err='fort_slu_fact' + ch_err='psb_slu_fact' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/prec/psb_dumf_bld.f90 b/src/prec/psb_dumf_bld.f90 index dd1e3f2f..5b80586f 100644 --- a/src/prec/psb_dumf_bld.f90 +++ b/src/prec/psb_dumf_bld.f90 @@ -95,7 +95,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - nza = atmp%infoa(psb_nnz_) + call psb_spinfo(psb_nztotreq_,atmp,nza,info) if (Debug) then write(0,*) me, 'UMFBLD: Done csdp',info,nza,atmp%m,atmp%k call blacs_barrier(icontxt,'All') @@ -109,7 +109,7 @@ subroutine psb_dumf_bld(a,desc_a,p,info) goto 9999 end if - nzb = blck%infoa(psb_nnz_) + call psb_spinfo(psb_nztotreq_,blck,nzb,info) if (Debug) then write(0,*) me, 'UMFBLD: Done asmatbld',info,nzb,blck%fida call blacs_barrier(icontxt,'All') @@ -170,17 +170,17 @@ subroutine psb_dumf_bld(a,desc_a,p,info) goto 9999 end if if (Debug) then - write(0,*) me,'Calling fort_slu_factor ',nzt,atmp%m,& + write(0,*) me,'Calling psb_umf_factor ',nzt,atmp%m,& & atmp%k,p%desc_data%matrix_data(psb_n_row_) call blacs_barrier(icontxt,'All') endif - call fort_umf_factor(atmp%m,nzt,& + call psb_umf_factor(atmp%m,nzt,& & atmp%aspk,atmp%ia1,atmp%ia2,& & p%iprcparm(umf_symptr_),p%iprcparm(umf_numptr_),info) if(info /= 0) then info=4010 - ch_err='fort_umf_fact' + ch_err='psb_umf_fact' call psb_errpush(info,name,a_err=ch_err) goto 9999 end if diff --git a/src/prec/fort_slu_impl.c b/src/prec/psb_slu_impl.c similarity index 96% rename from src/prec/fort_slu_impl.c rename to src/prec/psb_slu_impl.c index c298a4c0..03ba857f 100644 --- a/src/prec/fort_slu_impl.c +++ b/src/prec/psb_slu_impl.c @@ -111,26 +111,26 @@ typedef struct { #ifdef Add_ -#define fort_slu_factor_ fort_slu_factor_ -#define fort_slu_solve_ fort_slu_solve_ -#define fort_slu_free_ fort_slu_free_ +#define psb_slu_factor_ psb_slu_factor_ +#define psb_slu_solve_ psb_slu_solve_ +#define psb_slu_free_ psb_slu_free_ #endif #ifdef AddDouble_ -#define fort_slu_factor_ fort_slu_factor__ -#define fort_slu_solve_ fort_slu_solve__ -#define fort_slu_free_ fort_slu_free__ +#define psb_slu_factor_ psb_slu_factor__ +#define psb_slu_solve_ psb_slu_solve__ +#define psb_slu_free_ psb_slu_free__ #endif #ifdef NoChange -#define fort_slu_factor_ fort_slu_factor -#define fort_slu_solve_ fort_slu_solve -#define fort_slu_free_ fort_slu_free +#define psb_slu_factor_ psb_slu_factor +#define psb_slu_solve_ psb_slu_solve +#define psb_slu_free_ psb_slu_free #endif void -fort_slu_factor_(int *n, int *nnz, +psb_slu_factor_(int *n, int *nnz, double *values, int *rowind, int *colptr, #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address @@ -254,7 +254,7 @@ fort_slu_factor_(int *n, int *nnz, void -fort_slu_solve_(int *itrans, int *n, int *nrhs, +psb_slu_solve_(int *itrans, int *n, int *nrhs, double *b, int *ldb, #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address @@ -320,7 +320,7 @@ fort_slu_solve_(int *itrans, int *n, int *nrhs, void -fort_slu_free_( +psb_slu_free_( #ifdef Have_SLU_ fptr *f_factors, /* a handle containing the address pointing to the factored matrices */ diff --git a/src/prec/fort_umf_impl.c b/src/prec/psb_umf_impl.c similarity index 92% rename from src/prec/fort_umf_impl.c rename to src/prec/psb_umf_impl.c index 8433415c..246cc343 100644 --- a/src/prec/fort_umf_impl.c +++ b/src/prec/psb_umf_impl.c @@ -71,19 +71,19 @@ Availability: #ifdef Add_ -#define fort_umf_factor_ fort_umf_factor_ -#define fort_umf_solve_ fort_umf_solve_ -#define fort_umf_free_ fort_umf_free_ +#define psb_umf_factor_ psb_umf_factor_ +#define psb_umf_solve_ psb_umf_solve_ +#define psb_umf_free_ psb_umf_free_ #endif #ifdef AddDouble_ -#define fort_umf_factor_ fort_umf_factor__ -#define fort_umf_solve_ fort_umf_solve__ -#define fort_umf_free_ fort_umf_free__ +#define psb_umf_factor_ psb_umf_factor__ +#define psb_umf_solve_ psb_umf_solve__ +#define psb_umf_free_ psb_umf_free__ #endif #ifdef NoChange -#define fort_umf_factor_ fort_umf_factor -#define fort_umf_solve_ fort_umf_solve -#define fort_umf_free_ fort_umf_free +#define psb_umf_factor_ psb_umf_factor +#define psb_umf_solve_ psb_umf_solve +#define psb_umf_free_ psb_umf_free #endif @@ -99,7 +99,7 @@ typedef int fptr; /* 32-bit by default */ #endif void -fort_umf_factor_(int *n, int *nnz, +psb_umf_factor_(int *n, int *nnz, double *values, int *rowind, int *colptr, #ifdef Have_UMF_ fptr *symptr, @@ -156,7 +156,7 @@ fort_umf_factor_(int *n, int *nnz, void -fort_umf_solve_(int *itrans, int *n, +psb_umf_solve_(int *itrans, int *n, double *x, double *b, int *ldb, #ifdef Have_UMF_ fptr *numptr, @@ -197,7 +197,7 @@ fort_umf_solve_(int *itrans, int *n, void -fort_umf_free_( +psb_umf_free_( #ifdef Have_UMF_ fptr *symptr, fptr *numptr,