*** empty log message ***

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 #######################

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
 

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)

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(:)

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
 

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_)

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
 

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  

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)

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.'