*** empty log message ***

src/internals/psi_compute_size.f90

@@ -51,7 +51,6 @@ subroutine psi_compute_size(desc_data,&
   i=1
   do while (index_in(i).ne.-1)
      proc=index_in(i)
-!     write(0,'(i2," index_in(i)  ",2i10)')myrow,proc,index_in(i+index_in(i+1)+2)
      if ((proc.gt.np-1).or.(proc.lt.0)) then
         info = 115
         int_err(1) = 11

src/internals/psi_crea_index.f90

@@ -14,7 +14,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
 !         ....local scalars...      
   integer    :: me,npcol,mycol,nprow,i,j,k,&
        & mode, int_err(5), err, err_act, np,&
-       & dl_lda, icontxt
+       & dl_lda, icontxt, proc, nerv, nesd
 !         ...parameters...
   integer, pointer     :: dep_list(:,:), length_dl(:)
   integer,parameter    :: root=0,no_comm=-1
@@ -35,6 +35,13 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,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_data,index_in,dep_list,&
           & length_dl,loc_to_glob,glob_to_loc,desc_index,&
@@ -66,6 +73,7 @@ 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)
+!  dl_lda=dl_lda+3
   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...
@@ -100,6 +108,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
   call psi_desc_index(desc_a%matrix_data,index_in,dep_list(1:,me),&
        & length_dl(me),desc_a%loc_to_glob,desc_a%glob_to_loc,&
        & index_out,glob_idx,info)
+
   if(info.ne.0) then
      call psb_errpush(4010,name,a_err='psi_desc_index')
      goto 9999

src/internals/psi_dl_check.f90

@@ -8,38 +8,41 @@ subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
   ! locals
   integer  :: proc, proc2, i, j
 
-! ...i must order communication in in halo
+  ! ...i must order communication in in halo
 
-! ...if in dep_list of process i there is j
-!     and in dep_list of process j there isn't i,
-!     add to it process i...
+  ! ...if in dep_list of process i there is j
+  !     and in dep_list of process j there isn't i,
+  !     add to it process i...
 
   do proc=0,np-1
-     i=1
-     do while (i.le.length_dl(proc))
-        proc2=dep_list(i,proc)
-        if (proc2.ne.psb_no_comm_) then
-           ! ...search proc in proc2's dep_list....
-           j=1
-           do while ((j.le.length_dl(proc2).and.&
-                & dep_list(j,proc2).ne.proc))
-              j=j+1
-           enddo
-           if ((dep_list(j,proc2).ne.proc).or.&
-                & (j.gt.length_dl(proc2))) then
+    i=1
+    outer: do 
+      if (i >length_dl(proc)) exit outer
+      proc2=dep_list(i,proc)
+      if (proc2.ne.psb_no_comm_) then
+        ! ...search proc in proc2's dep_list....
+        j=1
+        p2loop:do 
+          if (j > length_dl(proc2)) exit p2loop
+          if (dep_list(j,proc2) == proc) exit p2loop
+          j=j+1
+        enddo p2loop
 
-              ! ...proc not found...
-              ! ...add proc to proc2's dep_list.....
-              length_dl(proc2)=length_dl(proc2)+1
-              if (length_dl(proc2).gt.size(dep_list,1)) then
-                 write(0,*)'error in crea_halo', proc2,&
-                      & length_dl(proc2),'>',size(dep_list,1)
-              endif
-              dep_list(length_dl(proc2),proc2)=proc
-           endif
+        if (j > length_dl(proc2)) then
+          ! ...add proc to proc2 s dep_list.....',proc,proc2
+          length_dl(proc2)     = length_dl(proc2)+1
+          if (length_dl(proc2) > size(dep_list,1)) then
+            write(0,*)'error in crea_halo', proc2,proc,&
+                 & length_dl(proc2),'>',size(dep_list,1)
+          endif
+          dep_list(length_dl(proc2),proc2) = proc
+        else if (dep_list(j,proc2) /= proc) then 
+          write(0,*) 'PSI_DL_CHECK This should not happen!!! ',&
+               & j,proc2,dep_list(j,proc2),proc
         endif
-        i=i+1
-     enddo
+      endif
+      i=i+1
+    enddo outer
   enddo
 
 end subroutine psi_dl_check

src/internals/psi_extrct_dl.f

@@ -139,6 +139,7 @@ c           ..if number of element to be exchanged !=0
               info = 3999
               goto 998
             endif
+!            if((me.eq.1).and.(proc.eq.3))write(0,*)'found 3'
             if (mode.eq.1) then
 c              ...search if already exist proc 
 c                 in dep_list(*,me)...  
@@ -254,6 +255,7 @@ c        ...send to root dependence list....
 
         endif
       end if 
+
       return
 
  9999 continue

src/methd/psb_dcg.f90

@@ -146,8 +146,7 @@ Subroutine psb_dcg(a,prec,b,x,eps,desc_a,info,&
     itrac = -1
   end if
 
-!!$  DIAGL  = 'U'
-!!$  DIAGU  = 'R'
+  itx=0
 
   ! Ensure global coherence for convergence checks.
   call blacs_get(icontxt,16,isvch)

src/modules/psb_prec_type.f90

@@ -51,15 +51,15 @@ module psb_prec_type
 
   type psb_dbase_prec
 
-    type(psb_dspmat_type), pointer :: av(:) => null()
+    type(psb_dspmat_type), pointer :: av(:) => null() !
     real(kind(1.d0)), pointer      :: d(:)  => null()
-    type(psb_desc_type), pointer   :: desc_data => null()
-    integer, pointer               :: iprcparm(:) => null()
-    real(kind(1.d0)), pointer      :: dprcparm(:) => null()
+    type(psb_desc_type), pointer   :: desc_data => null() !
+    integer, pointer               :: iprcparm(:) => null() !
+    real(kind(1.d0)), pointer      :: dprcparm(:) => null() !
     integer, pointer               :: perm(:)  => null(), invperm(:) => null()
-    integer, pointer               :: mlia(:)  => null(), nlaggr(:)  => null()
-    type(psb_dspmat_type), pointer :: aorig    => null()
-    real(kind(1.d0)), pointer      :: dorig(:) => null()
+    integer, pointer               :: mlia(:)  => null(), nlaggr(:)  => null() !
+    type(psb_dspmat_type), pointer :: aorig    => null() !
+    real(kind(1.d0)), pointer      :: dorig(:) => null() !
     
  end type psb_dbase_prec
   
@@ -347,7 +347,6 @@ contains
     endif
     if (associated(p%dorig)) then 
       deallocate(p%dorig,stat=info)
-      nullify(p%dorig) 
     endif
 
     if (associated(p%mlia)) then 
@@ -358,6 +357,14 @@ contains
       deallocate(p%nlaggr,stat=info)
     endif
 
+    if (associated(p%perm)) then 
+      deallocate(p%perm,stat=info)
+    endif
+
+    if (associated(p%invperm)) then 
+      deallocate(p%invperm,stat=info)
+    endif
+
     if (associated(p%iprcparm)) then 
       if (p%iprcparm(f_type_)==f_slu_) then 
         call fort_slu_free(p%iprcparm(slu_ptr_),info)

src/prec/psb_dcsrsetup.f90

@@ -132,16 +132,6 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
     endif
 
     call blacs_get(icontxt,10,icomm )
-!!$    call MPI_Comm_rank(icomm,irank,ierr)
-!!$    idscb  = mpe_log_get_event_number()
-!!$    idsce  = mpe_log_get_event_number()
-!!$    iovrb  = mpe_log_get_event_number()
-!!$    iovre  = mpe_log_get_event_number()
-!!$    if (irank==0) then 
-!!$      info = mpe_describe_state(idscb,idsce,"DSCASB ","NavyBlue")
-!!$      info = mpe_describe_state(iovrb,iovre,"DSCOVR ","DeepPink")
-!!$    endif
-!!$
 
     Call blacs_gridinfo(icontxt,nprow,npcol,me,mycol)
     If(debug)Write(0,*)'BEGIN dcsrsetup',me,upd,novr
@@ -151,13 +141,13 @@ Subroutine psb_dcsrsetup(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
       !
       !  Build the  auiliary descriptor',desc_p%matrix_data(psb_n_row_)
       ! 
-      call psb_dscov(a,desc_data,novr,desc_p,info)
-      if(info /= 0) then
-        info=4010
-        ch_err='psb_dscov'
-        call psb_errpush(info,name,a_err=ch_err)
-        goto 9999
-      end if
+       call psb_dscov(a,desc_data,novr,desc_p,info)
+       if(info /= 0) then
+          info=4010
+          ch_err='psb_dscov'
+          call psb_errpush(info,name,a_err=ch_err)
+          goto 9999
+       end if
     Endif
 
     if(debug) write(0,*) me,' From dscov _:',desc_p%matrix_data(psb_n_row_),desc_p%matrix_data(psb_n_col_)

src/psblas/psb_dspmm.f90

@@ -154,8 +154,8 @@ subroutine  psb_dspmm(alpha,a,x,beta,y,desc_a,info,&
 
   ! check for presence/size of a work area
   liwork= 2*ncol
-  if (a%pr(1) /= 0) llwork = liwork + n * ik
-  if (a%pl(1) /= 0) llwork = llwork + m * ik
+  if (a%pr(1) /= 0) liwork = liwork + n * ik
+  if (a%pl(1) /= 0) liwork = liwork + m * ik
   if (present(work)) then     
      if(size(work).lt.liwork) then
         call psb_realloc(liwork,work,info)

src/tools/psb_descasb.f90

@@ -72,18 +72,6 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
   tch = 0.0
   t4 = 0.0
   call blacs_get(icontxt,10,icomm )
-!!$  call MPI_Comm_rank(icomm,irank,ierr)
-!!$  idscb  = mpe_log_get_event_number()
-!!$  idsce  = mpe_log_get_event_number()
-!!$  iovrb  = mpe_log_get_event_number()
-!!$  iovre  = mpe_log_get_event_number()
-!!$  icrhb  = mpe_log_get_event_number()
-!!$  icrhe  = mpe_log_get_event_number()
-!!$  if (irank==0) then 
-!!$    info = mpe_describe_state(idscb,idsce,"DSCLOOP ","gold")
-!!$    info = mpe_describe_state(icrhb,icrhe,"CRTHAL ","turquoise3")
-!!$    info = mpe_describe_state(iovrb,iovre,"CNVRTC ","red4")
-!!$  endif
 
   mglob = desc_a%matrix_data(psb_m_)
   m     = desc_a%matrix_data(psb_n_row_)
@@ -117,8 +105,6 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
   tot_recv              = 0
   counter_h             = 1
   counter_o             = 1
-!!$  write(0,*) 'Before ',tmp_ovr_idx(1:10)
-!!$  ierr = MPE_Log_event( idscb, 0, "st DSCLP " )
 
   ! See comment in main loop below.
   call InitPairSearchTree(info)
@@ -552,6 +538,7 @@ Subroutine psb_descasb(n_ovr,desc_p,desc_a,a,&
 !!$      ierr = MPE_Log_event( icrhb, 0, "st CRTHAL" )
         if (debug) write(0,*) myrow,'Checktmp_o_i 1',tmp_ovr_idx(1:10)
         if (debug) write(0,*) myrow,'Calling Crea_Halo'
+        
         call psi_crea_index(desc_p,t_halo_in,t_halo_out,.false.,info)
 !!$        Call psi_crea_halo(desc_p%matrix_data,t_halo_in,&
 !!$             & np,t_halo_out,Size(t_halo_out),dep_list,&

src/tools/psb_dscasb.f90

@@ -169,7 +169,8 @@ subroutine psb_dscasb(desc_a,info)
     ! Ok, register into MATRIX_DATA &  free temporary work areas
     desc_a%matrix_data(psb_dec_type_) = psb_desc_asb_
 
-    deallocate(halo_index,ovrlap_index, stat=info)
+    deallocate(ovrlap_index, stat=info)
+    deallocate(halo_index, stat=info)
     if (info /= 0) then
        info =4000
        call psb_errpush(info,name)

src/tools/psb_dscov.f90

@@ -179,7 +179,7 @@ Subroutine psb_dscov(a,desc_a,novr,desc_ov,info)
   ! The real work goes on in here....
   !
   Call psb_descasb(novr,desc_ov,desc_a,a,&
-       & l_tmp_halo,l_tmp_ovr_idx,lworks,lworkr,info)
+       & l_tmp_halo,l_tmp_ovr_idx,lworks,lworkr,info) 
   if (info.ne.0) then
      info=4010
      ch_err='psb_descasb'