diff --git a/Make.inc b/Make.inc index 54257046..f90f3688 100644 --- a/Make.inc +++ b/Make.inc @@ -10,8 +10,8 @@ F90=ifort FC=ifort CC=icc F77=$(FC) -F90COPT= -check all -g -CB -no_cpprt -FCOPT=-check all -g -CB -no_cpprt +F90COPT= -check all -g -CB -no_cpprt -warn interfaces +FCOPT=-check all -g -CB -no_cpprt -warn interfaces CCOPT= ####################### Section 2 ####################### diff --git a/src/comm/psb_dhalo.f90 b/src/comm/psb_dhalo.f90 index ee23d586..90872c5c 100644 --- a/src/comm/psb_dhalo.f90 +++ b/src/comm/psb_dhalo.f90 @@ -272,7 +272,7 @@ subroutine psb_dhalov(x,desc_a,info,alpha,work,tran,mode) if(present(alpha)) then if(alpha.ne.1.d0) then - call dscal(nrow,alpha,x,1) + call dscal(nrow,alpha,x,ione) end if end if diff --git a/src/internals/psi_crea_index.f90 b/src/internals/psi_crea_index.f90 index bf7f4855..96af75b0 100644 --- a/src/internals/psi_crea_index.f90 +++ b/src/internals/psi_crea_index.f90 @@ -66,14 +66,14 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info) ! allocate dependency list call psi_compute_size(desc_a%matrix_data, index_in, dl_lda, info) - allocate(dep_list(max(1,dl_lda),0:np-1),length_dl(0:np-1)) + allocate(dep_list(max(1,dl_lda),0:np),length_dl(0:np)) ! ...extract dependence list (ordered list of identifer process ! which every process must communcate with... if (debug) write(*,*) 'crea_halo: calling extract_dep_list' mode = 1 call psi_extract_dep_list(desc_a%matrix_data,index_in,& - & dep_list,length_dl,np,dl_lda,mode,info) + & dep_list,length_dl,np,max(1,dl_lda),mode,info) if(info /= 0) then call psb_errpush(4010,name,a_err='extrct_dl') goto 9999 @@ -85,7 +85,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info) if (debug) write(*,*) 'crea_halo: root sorting dep list' ! ....i must order communication in in halo - call psi_dl_check(dep_list,dl_lda,np,length_dl) + call psi_dl_check(dep_list,max(1,dl_lda),np,length_dl) ! ....now i can sort dependence list...... call psi_sort_dl(dep_list,length_dl,np,info) diff --git a/src/internals/psi_desc_index.f90 b/src/internals/psi_desc_index.f90 index 69dbf3bd..4c28e786 100644 --- a/src/internals/psi_desc_index.f90 +++ b/src/internals/psi_desc_index.f90 @@ -5,9 +5,9 @@ subroutine psi_desc_index(desc_data,index_in,dep_list,& use psb_realloc_mod use psb_error_mod use psb_const_mod + use mpi implicit none - include 'mpif.h' !c ...array parameters..... integer :: desc_data(:),index_in(:),dep_list(:) integer :: loc_to_glob(:),glob_to_loc(:) diff --git a/src/internals/psi_dl_check.f90 b/src/internals/psi_dl_check.f90 index f98c0a42..bc03a213 100644 --- a/src/internals/psi_dl_check.f90 +++ b/src/internals/psi_dl_check.f90 @@ -4,7 +4,7 @@ subroutine psi_dl_check(dep_list,dl_lda,np,length_dl) implicit none integer :: np,dl_lda,length_dl(0:np) - integer :: dep_list(dl_lda,0:np-1) + integer :: dep_list(dl_lda,0:np) ! locals integer :: proc, proc2, i, j diff --git a/src/internals/psi_dswapdata.f90 b/src/internals/psi_dswapdata.f90 index 59a54ed1..3680455a 100644 --- a/src/internals/psi_dswapdata.f90 +++ b/src/internals/psi_dswapdata.f90 @@ -8,7 +8,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) integer, intent(in) :: flag, n integer, intent(out) :: info real(kind(1.d0)) :: y(:,:), beta - real(kind(1.d0)), target ::work(:) + real(kind(1.d0)), target :: work(:) type(psb_desc_type) :: desc_a ! locals @@ -27,6 +27,10 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) character(len=20) :: name, ch_err interface psi_gth + subroutine psi_dgthmm(n,k,idx,x,y,myrow,icontxt) + integer :: n, k, idx(:),myrow,icontxt + real(kind(1.d0)) :: x(:,:), y(:) + end subroutine psi_dgthmm subroutine psi_dgthm(n,k,idx,x,y) integer :: n, k, idx(:) real(kind(1.d0)) :: x(:,:), y(:) @@ -91,7 +95,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) goto 9999 end if - swap_mpi = iand(flag,psb_swap_mpi_).ne.0 + swap_mpi = iand(flag,psb_swap_mpi_) .ne.0 swap_sync = iand(flag,psb_swap_sync_).ne.0 swap_send = iand(flag,psb_swap_send_).ne.0 swap_recv = iand(flag,psb_swap_recv_).ne.0 @@ -103,9 +107,6 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) rvhd(:) = mpi_request_null ! prepare info for communications - call blacs_barrier(icontxt,'All') - write(0,'(i2," Entering 1-st cycle")')myrow - call blacs_barrier(icontxt,'All') proc_to_comm = h_idx(point_to_proc+psb_proc_id_) do while (proc_to_comm.ne.-1) if(proc_to_comm .ne. myrow) totxch = totxch+1 @@ -127,13 +128,11 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) proc_to_comm = h_idx(point_to_proc+psb_proc_id_) end do - call blacs_barrier(icontxt,'All') - write(0,'(i2," out of 1-st cycle")')myrow - call blacs_barrier(icontxt,'All') if((idxr+idxs).lt.size(work)) then sndbuf => work(1:idxs) rcvbuf => work(idxs+1:idxs+idxr) else + write(0,'(i2," allocating",3(i6,2x))')myrow,idxs,idxr,size(work) allocate(sndbuf(idxs),rcvbuf(idxr), stat=info) if(info.ne.0) then call psb_errpush(4000,name) @@ -153,6 +152,7 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) idx_pt = point_to_proc+nerv+psb_elem_send_ snd_pt = bsdidx(proc_to_comm) + call psi_gth(nesd,n,h_idx(idx_pt:idx_pt+nesd-1),& & y,sndbuf(snd_pt:snd_pt+nesd*n-1)) @@ -249,9 +249,6 @@ subroutine psi_dswapdatam(flag,n,beta,y,desc_a,work,info) end do else if (swap_send .and. swap_recv) then - call blacs_barrier(icontxt,'All') - write(0,'(i2," Inside snd/rcv")')myrow - call blacs_barrier(icontxt,'All') ! First I post all the non blocking receives point_to_proc = 1 proc_to_comm = h_idx(point_to_proc+psb_proc_id_) diff --git a/src/internals/psi_gthsct.f90 b/src/internals/psi_gthsct.f90 index c574e639..ffde4eed 100644 --- a/src/internals/psi_gthsct.f90 +++ b/src/internals/psi_gthsct.f90 @@ -1,3 +1,23 @@ +subroutine psi_dgthmm(n,k,idx,x,y,myrow,icontxt) + + implicit none + + integer :: n, k, idx(:),myrow,icontxt + 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_dgthmm + subroutine psi_dgthm(n,k,idx,x,y) implicit none @@ -7,6 +27,8 @@ subroutine psi_dgthm(n,k,idx,x,y) ! Locals integer :: i, j, pt + + write(0,'("Inside gth ",5(i6,2x))')n,k,size(idx),size(x),size(y) pt=0 do j=1,k do i=1,n @@ -14,6 +36,7 @@ subroutine psi_dgthm(n,k,idx,x,y) y(pt)=x(idx(i),j) end do end do + write(0,'("Leaving gth")') end subroutine psi_dgthm diff --git a/src/modules/psb_check_mod.f90 b/src/modules/psb_check_mod.f90 index d044c113..9c37e8d2 100644 --- a/src/modules/psb_check_mod.f90 +++ b/src/modules/psb_check_mod.f90 @@ -125,7 +125,7 @@ contains ! Compute local indices for submatrix starting ! at global indices ix and jx if(present(iix)) iix=ix ! (for our applications iix=ix)) - if(present(jjx)) iix=ix ! (for our applications jjx=jx)) + if(present(jjx)) jjx=ix ! (for our applications jjx=jx)) call psb_erractionrestore(err_act) return diff --git a/src/tools/psb_dallc.f90 b/src/tools/psb_dallc.f90 index 8d757220..f65b9e98 100644 --- a/src/tools/psb_dallc.f90 +++ b/src/tools/psb_dallc.f90 @@ -188,7 +188,7 @@ subroutine psb_dallocv(m, x, desc_a,info) !locals integer :: nprow,npcol,myrow,mycol,err,n_col,n_row,dectype,i,err_act integer :: icontxt - integer :: int_err(5),temp(1),exch(2) + integer :: int_err(5),temp(1),exch real(kind(1.d0)) :: real_err(5) logical, parameter :: debug=.false. character(len=20) :: name, ch_err @@ -239,11 +239,11 @@ subroutine psb_dallocv(m, x, desc_a,info) !global check on m and n parameters if (myrow.eq.psb_root_) then - exch(1) = m + exch = m call igebs2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione) else call igebr2d(icontxt,psb_all_,psb_topdef_, ione,ione, exch, ione, psb_root_, 0) - if (exch(1) .ne. m) then + if (exch .ne. m) then info = 550 int_err(1) = 1 call psb_errpush(info,name,int_err) diff --git a/test/pargen/ppde90.f90 b/test/pargen/ppde90.f90 index c6054975..059a0cf6 100644 --- a/test/pargen/ppde90.f90 +++ b/test/pargen/ppde90.f90 @@ -117,7 +117,7 @@ program pde90 call psb_errpush(info,name,a_err=ch_err) goto 9999 end if - goto 9999 + dim=size(a%aspk) !!$ allocate(h%aspk(dim),h%ia1(dim),h%ia2(dim),h%pl(size(a%pl)),& @@ -670,8 +670,7 @@ contains write(0,*) ' assembly time',(t2-t1),' ',a%fida(1:4) call psb_asb(b,desc_a,info) - write(0,*)'Remeber This!!!!!!' -! call psb_asb(t,desc_a,info) + call psb_asb(t,desc_a,info) if(info.ne.0) then info=4010 ch_err='asb rout.'