|
|
|
|
@ -60,7 +60,7 @@
|
|
|
|
|
type(psb_c_coo_sparse_mat), target :: acoo
|
|
|
|
|
integer(psb_ipk_) :: n_row,n_col, nrow_a, nztota, nglob, nglobrec, nzt, npr, npc
|
|
|
|
|
integer(psb_ipk_) :: ifrst, ibcheck
|
|
|
|
|
integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, me, i, err_act, debug_unit, debug_level
|
|
|
|
|
integer(psb_ipk_) :: ictxt, ictxt1, icomm, np, iam, me, i, err_act, debug_unit, debug_level
|
|
|
|
|
character(len=20) :: name='c_mumps_solver_bld', ch_err
|
|
|
|
|
|
|
|
|
|
#if defined(HAVE_MUMPS_)
|
|
|
|
|
@ -71,20 +71,26 @@
|
|
|
|
|
debug_unit = psb_get_debug_unit()
|
|
|
|
|
debug_level = psb_get_debug_level()
|
|
|
|
|
ictxt = desc_a%get_context()
|
|
|
|
|
if (sv%ipar(1) < 0 ) then
|
|
|
|
|
call psb_info(ictxt, me, np)
|
|
|
|
|
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/me/))
|
|
|
|
|
if (sv%ipar(1) == mld_local_solver_ ) then
|
|
|
|
|
call psb_info(ictxt, iam, np)
|
|
|
|
|
call psb_init(ictxt1,np=1,basectxt=ictxt,ids=(/iam/))
|
|
|
|
|
call psb_get_mpicomm(ictxt1, icomm)
|
|
|
|
|
allocate(sv%local_ictxt,stat=info)
|
|
|
|
|
sv%local_ictxt = ictxt1
|
|
|
|
|
write(*,*)'mumps_bld: +++++>',icomm,ictxt1
|
|
|
|
|
write(*,*)'mumps_bld: +++++>',icomm,sv%local_ictxt
|
|
|
|
|
call psb_info(ictxt1, me, np)
|
|
|
|
|
npr = np
|
|
|
|
|
else
|
|
|
|
|
else if (sv%ipar(1) == mld_global_solver_ ) then
|
|
|
|
|
call psb_get_mpicomm(ictxt,icomm)
|
|
|
|
|
write(*,*)'mumps_bld: +++++>',icomm,ictxt
|
|
|
|
|
call psb_info(ictxt, me, np)
|
|
|
|
|
call psb_info(ictxt, iam, np)
|
|
|
|
|
me = iam
|
|
|
|
|
npr = np
|
|
|
|
|
else
|
|
|
|
|
info = psb_err_internal_error_
|
|
|
|
|
call psb_errpush(info,name,&
|
|
|
|
|
& a_err='Invalid local/global solver in MUMPS')
|
|
|
|
|
goto 9999
|
|
|
|
|
end if
|
|
|
|
|
npc = 1
|
|
|
|
|
if (debug_level >= psb_debug_outer_) &
|
|
|
|
|
@ -98,7 +104,7 @@
|
|
|
|
|
allocate(sv%id,stat=info)
|
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
|
info=psb_err_alloc_dealloc_
|
|
|
|
|
call psb_errpush(info,name,a_err='mld_cmumps_default')
|
|
|
|
|
call psb_errpush(info,name,a_err='mld_dmumps_default')
|
|
|
|
|
goto 9999
|
|
|
|
|
end if
|
|
|
|
|
end if
|
|
|
|
|
@ -108,10 +114,13 @@
|
|
|
|
|
sv%id%job = -1
|
|
|
|
|
sv%id%par = 1
|
|
|
|
|
call cmumps(sv%id)
|
|
|
|
|
!WARNING: CALLING cMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
|
|
|
|
|
!WARNING: CALLING dMUMPS WITH JOB=-1 DESTROY THE SETTING OF DEFAULT:TO FIX
|
|
|
|
|
if (allocated(sv%icntl)) then
|
|
|
|
|
do i=1,mld_mumps_icntl_size
|
|
|
|
|
if (allocated(sv%icntl(i)%item)) sv%id%icntl(i) = sv%icntl(i)%item
|
|
|
|
|
if (allocated(sv%icntl(i)%item)) then
|
|
|
|
|
!write(0,*) 'MUMPS_BLD: setting entry ',i,' to ', sv%icntl(i)%item
|
|
|
|
|
sv%id%icntl(i) = sv%icntl(i)%item
|
|
|
|
|
end if
|
|
|
|
|
end do
|
|
|
|
|
end if
|
|
|
|
|
if (allocated(sv%rcntl)) then
|
|
|
|
|
@ -122,13 +131,14 @@
|
|
|
|
|
sv%id%icntl(3)=sv%ipar(2)
|
|
|
|
|
|
|
|
|
|
nglob = desc_a%get_global_rows()
|
|
|
|
|
if (sv%ipar(1) < 0) then
|
|
|
|
|
if (sv%ipar(1) == mld_local_solver_ ) then
|
|
|
|
|
nglobrec=desc_a%get_local_rows()
|
|
|
|
|
call a%csclip(c,info,jmax=a%get_nrows())
|
|
|
|
|
call c%cp_to(acoo)
|
|
|
|
|
nglob = c%get_nrows()
|
|
|
|
|
if (nglobrec /= nglob) then
|
|
|
|
|
write(*,*)'WARNING: MUMPS solver does not allow overlap in AS yet. A zero-overlap is used instead'
|
|
|
|
|
write(*,*)'WARNING: MUMPS solver does not allow overlap in AS yet. '
|
|
|
|
|
write(*,*)'A zero-overlap is used instead'
|
|
|
|
|
end if
|
|
|
|
|
else
|
|
|
|
|
call a%cp_to(acoo)
|
|
|
|
|
@ -136,7 +146,7 @@
|
|
|
|
|
nztota = acoo%get_nzeros()
|
|
|
|
|
|
|
|
|
|
! switch to global numbering
|
|
|
|
|
if (sv%ipar(1) >= 0 ) then
|
|
|
|
|
if (sv%ipar(1) == mld_global_solver_ ) then
|
|
|
|
|
call psb_loc_to_glob(acoo%ja(1:nztota), desc_a, info, iact='I')
|
|
|
|
|
call psb_loc_to_glob(acoo%ia(1:nztota), desc_a, info, iact='I')
|
|
|
|
|
end if
|
|
|
|
|
@ -155,13 +165,13 @@
|
|
|
|
|
sv%id%nz = acoo%get_nzeros()
|
|
|
|
|
sv%id%job = 4
|
|
|
|
|
!call psb_barrier(ictxt)
|
|
|
|
|
write(*,*)'calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
|
|
|
|
|
call cmumps(sv%id)
|
|
|
|
|
write(*,*)iam, ' calling mumps N,nz,nz_loc',sv%id%n,sv%id%nz,sv%id%nz_loc
|
|
|
|
|
call dmumps(sv%id)
|
|
|
|
|
!call psb_barrier(ictxt)
|
|
|
|
|
info = sv%id%infog(1)
|
|
|
|
|
if (info /= psb_success_) then
|
|
|
|
|
info=psb_err_from_subroutine_
|
|
|
|
|
ch_err='mld_cmumps_fact '
|
|
|
|
|
ch_err='mld_dmumps_fact '
|
|
|
|
|
call psb_errpush(info,name,a_err=ch_err)
|
|
|
|
|
goto 9999
|
|
|
|
|
end if
|
|
|
|
|
@ -173,7 +183,7 @@
|
|
|
|
|
sv%built=.true.
|
|
|
|
|
|
|
|
|
|
if (debug_level >= psb_debug_outer_) &
|
|
|
|
|
& write(debug_unit,*) me,' ',trim(name),' end'
|
|
|
|
|
& write(debug_unit,*) iam,' ',trim(name),' end'
|
|
|
|
|
|
|
|
|
|
call psb_erractionrestore(err_act)
|
|
|
|
|
return
|
|
|
|
|
@ -188,5 +198,5 @@
|
|
|
|
|
#else
|
|
|
|
|
write(psb_err_unit,*) "MUMPS Not Configured, fix make.inc and recompile "
|
|
|
|
|
#endif
|
|
|
|
|
end subroutine c_mumps_solver_bld
|
|
|
|
|
end subroutine c_mumps_solver_bld
|
|
|
|
|
|
|
|
|
|
|
Salvatore Filippone
6 years ago