Fixes for complex halo gather.

psb_dasmatbld.f90

@@ -191,14 +191,8 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
 
     n_row = desc_p%matrix_data(psb_n_row_)
     t2 = psb_wtime()
-!!$    open(60+me)
+
-!!$    call psb_cdprt(60+me,desc_p,short=.false.)
-!!$    close(60+me)
-!!$    call psb_barrier(ictxt)
     if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
-!!$    ierr = MPE_Log_event( iovrb, 0, "st OVR" )
-!!$    blk%m = n_row-nrow_a
-!!$    blk%k = n_row
 
     if (present(outfmt)) then 
       if(debug) write(0,*) me,': Calling outfmt SPHALO with ',size(blk%ia2)
@@ -217,7 +211,6 @@ Subroutine psb_dasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
     end if
 
     if (debug) write(0,*) 'After psb_sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
-!!$    ierr = MPE_Log_event( iovre, 0, "ed OVR" )
 
     t3 = psb_wtime()
     if (debugprt) then 

psb_dbjac_bld.f90

@@ -68,7 +68,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
   character ::        trans, unitd
   type(psb_dspmat_type) :: blck, atmp
   real(kind(1.d0)) :: t1,t2,t3,t4,t5,t6, t7, t8
-  logical, parameter :: debugprt=.false., debug=.false., aggr_dump=.false.
+  logical, parameter :: debugprt=.true., debug=.false., aggr_dump=.false.
   integer   nztota, nztotb, nztmp, nzl, nnr, ir, err_act,&
        & n_row, nrow_a,n_col, nhalo, ind, iind, i1,i2,ia
   integer :: ictxt,np,me
@@ -198,7 +198,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
 
     case(f_umf_)
 
-      call psb_ipcoo2csc(atmp,info)
+      call psb_ipcoo2csc(atmp,info,clshr=.true.)
       if (info /= 0) then
         call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
         goto 9999
@@ -240,6 +240,16 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
 
     case(f_ilu_n_,f_ilu_e_) 
 
+    if (debugprt) then 
+      call psb_barrier(ictxt)
+      open(40+me) 
+      call psb_csprt(40+me,a,head='% Local matrix')
+      close(40+me)
+      open(60+me) 
+      call psb_csprt(60+me,blck,head='% Halo matrix')
+      close(60+me)
+    endif
+
       call psb_ipcoo2csr(blck,info,rwshr=.true.)
 
       if(info/=0) then
@@ -302,7 +312,7 @@ subroutine psb_dbjac_bld(a,desc_a,p,upd,info)
         goto 9999
       end if
       call psb_rwextd(atmp%m+blck%m,atmp,info,blck,rowscale=.true.) 
-      if (info == 0) call psb_ipcoo2csc(atmp,info)
+      if (info == 0) call psb_ipcoo2csc(atmp,info,clshr=.true.)
       if (info /= 0) then
         call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
         goto 9999

psb_dilu_fct.f90

@@ -179,7 +179,7 @@ contains
       ! use spgtblk, slower but able (in principle) to handle 
       ! anything. 
       !
-      if (a%fida=='CSR') then 
+      if (toupper(a%fida)=='CSR') then 
         do j = a%ia2(i), a%ia2(i+1) - 1
           k = a%ia1(j)
           !           write(0,*)'KKKKK',k
@@ -318,7 +318,7 @@ contains
       d(i) = 0.d0
 
 
-      if (b%fida=='CSR') then 
+      if (toupper(b%fida)=='CSR') then 
 
         do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1
           k = b%ia1(j)

psb_zasmatbld.f90

@@ -86,6 +86,8 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
 
   If(debug) Write(0,*)'IN DASMATBLD  ', upd
   ictxt=desc_data%matrix_data(psb_ctxt_)
+  Call psb_info(ictxt, me, np)
+
   tot_recv=0
 
   nrow_a = desc_data%matrix_data(psb_n_row_)
@@ -129,7 +131,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
     !
     !
 
-    ictxt=desc_data%matrix_data(psb_ctxt_)
 
     if (novr < 0) then
       info=3
@@ -138,7 +139,7 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
       goto 9999
     endif
 
-    if (novr == 0) then 
+    if ((novr == 0).or.(np==1)) then 
       !
       ! This is really just Block Jacobi.....
       !
@@ -169,7 +170,6 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
 
     call psb_get_mpicomm(ictxt,icomm)
 
-    Call psb_info(ictxt, me, np)
     If(debug)Write(0,*)'BEGIN dasmatbld',me,upd,novr
     t1 = psb_wtime()
 
@@ -186,7 +186,8 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
       end if
     Endif
 
-    if(debug) write(0,*) me,' From bldext:',desc_p%matrix_data(psb_n_row_),desc_p%matrix_data(psb_n_col_)
+    if(debug) write(0,*) me,' From cdbldext _:',desc_p%matrix_data(psb_n_row_),&
+         & desc_p%matrix_data(psb_n_col_)
 
 
     n_row = desc_p%matrix_data(psb_n_row_)
@@ -195,11 +196,11 @@ Subroutine psb_zasmatbld(ptype,novr,a,blk,desc_data,upd,desc_p,info,outfmt)
     if (debug) write(0,*) 'Before sphalo ',blk%fida,blk%m,psb_nnz_,blk%infoa(psb_nnz_)
 
     if (present(outfmt)) then 
-      if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2)
+      if(debug) write(0,*) me,': Calling outfmt SPHALO with ',size(blk%ia2)
-      Call psb_sphalo(a,desc_p,blk,info,outfmt=outfmt)
+      Call psb_sphalo(a,desc_p,blk,info,outfmt=outfmt,data=psb_comm_ext_)
     else
       if(debug) write(0,*) me,': Calling SPHALO with ',size(blk%ia2)
-      Call psb_sphalo(a,desc_p,blk,info)
+      Call psb_sphalo(a,desc_p,blk,info,data=psb_comm_ext_)
     end if
 
 

psb_zbjac_bld.f90

@@ -78,7 +78,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
 
   if(psb_get_errstatus().ne.0) return 
   info=0
-  name='psb_bjac_bld'
+  name='psb_zbjac_bld'
   call psb_erractionsave(err_act)
 
   ictxt=psb_cd_get_context(desc_a)
@@ -113,9 +113,7 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
        & blck,desc_a,upd,p%desc_data,info,outfmt=coofmt)
 
   if(info/=0) then
-    info=4010
+    call psb_errpush(4010,name,a_err='psb_asmatbld')
-    ch_err='psb_asmatbld'
-    call psb_errpush(info,name,a_err=ch_err)
     goto 9999
   end if
 
@@ -124,7 +122,9 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
   if (debug) call psb_barrier(ictxt)
 
 
-  if (p%iprcparm(iren_) > 0) then 
+  select case(p%iprcparm(iren_)) 
+
+  case (1:)
 
     !
     ! Here we allocate a full copy to hold local A and received BLK
@@ -133,10 +133,8 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
 
     call  psb_sp_renum(a,desc_a,blck,p,atmp,info)
 
-    if(info/=0) then
+    if (info/=0) then
-      info=4010
+      call psb_errpush(4010,name,a_err='psb_sp_renum')
-      ch_err='psb_sp_renum'
-      call psb_errpush(info,name,a_err=ch_err)
       goto 9999
     end if
 
@@ -155,20 +153,20 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
     case(f_ilu_n_,f_ilu_e_) 
 
       call psb_ipcoo2csr(atmp,info)
+
       if (info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
-        call psb_errpush(info,name,a_err='psb_ipcoo2csr')
         goto 9999
       end if
 
       call psb_ilu_bld(atmp,p%desc_data,p,upd,info)
 
-      if(info/=0) then
+      if (info/=0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_ilu_bld')
-        call psb_errpush(info,name,a_err='psb_ilu_bld')
         goto 9999
       end if
 
+
       if (debugprt) then 
 
         open(80+me)
@@ -188,15 +186,13 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
 
       call psb_ipcoo2csr(atmp,info)
       if (info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
-        call psb_errpush(info,name,a_err='psb_ipcoo2csr')
         goto 9999
       end if
 
       call psb_slu_bld(atmp,p%desc_data,p,info)
       if(info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='slu_bld')
-        call psb_errpush(info,name,a_err='slu_bld')
         goto 9999
       end if
 
@@ -204,16 +200,14 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
 
       call psb_ipcoo2csc(atmp,info)
       if (info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
-        call psb_errpush(info,name,a_err='psb_ipcoo2csc')
         goto 9999
       end if
 
       call psb_umf_bld(atmp,p%desc_data,p,info)
       if(debug) write(0,*)me,': Done umf_bld ',info
       if (info /= 0) then
-        info = 4010
+        call psb_errpush(4010,name,a_err='umf_bld')
-        call psb_errpush(info,name,a_err='umf_bld')
         goto 9999
       end if
 
@@ -231,14 +225,15 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
 
 
     call psb_sp_free(atmp,info) 
+
     if(info/=0) then
-      info=4010
+      call psb_errpush(4010,name,a_err='psb_sp_free')
-      call psb_errpush(info,name,a_err='psb_sp_free')
       goto 9999
     end if
 
 
-  else if (p%iprcparm(iren_) == 0) then
+
+  case(0)  ! No renumbering
 
 
     select case(p%iprcparm(f_type_))
@@ -247,14 +242,19 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
 
       call psb_ipcoo2csr(blck,info,rwshr=.true.)
 
-      if (info==0) call psb_ilu_bld(a,desc_a,p,upd,info,blck=blck)
+      if(info/=0) then
+        call psb_errpush(4010,name,a_err='psb_ipcoo2csr')
+        goto 9999
+      end if
+
+      call psb_ilu_bld(a,desc_a,p,upd,info,blck=blck)
 
       if(info/=0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_ilu_bld')
-        call psb_errpush(info,name,a_err='psb_ilu_bld')
         goto 9999
       end if
 
+
       if (debugprt) then 
 
         open(80+me)
@@ -270,63 +270,65 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
       endif
 
 
-
     case(f_slu_)
 
       atmp%fida='COO'
       call psb_csdp(a,atmp,info)
       if (info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_csdp')
-        call psb_errpush(info,name,a_err='psb_csdp')
         goto 9999
       end if
       call psb_rwextd(atmp%m+blck%m,atmp,info,blck,rowscale=.true.) 
-      call psb_ipcoo2csr(atmp,info)
+      if (info == 0) call psb_ipcoo2csr(atmp,info)
-      call psb_slu_bld(atmp,p%desc_data,p,info)
+      if (info == 0) call psb_slu_bld(atmp,p%desc_data,p,info)
       if(info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='slu_bld')
-        call psb_errpush(info,name,a_err='slu_bld')
         goto 9999
       end if
 
       call psb_sp_free(atmp,info) 
       if(info/=0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_sp_free')
-        call psb_errpush(info,name,a_err='psb_sp_free')
         goto 9999
       end if
 
 
     case(f_umf_)
 
-      atmp%fida='COO'
       atmp%fida='COO'
       call psb_csdp(a,atmp,info)
       if (info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_csdp')
-        call psb_errpush(info,name,a_err='psb_csdp')
         goto 9999
       end if
+    if (debugprt) then 
+      call psb_barrier(ictxt)
+      open(40+me) 
+      call psb_csprt(40+me,atmp,head='% Local matrix')
+      close(40+me)
+      open(60+me) 
+      call psb_csprt(60+me,blck,head='% Halo matrix')
+      close(60+me)
+    endif
+
       call psb_rwextd(atmp%m+blck%m,atmp,info,blck,rowscale=.true.) 
       if (info == 0) call psb_ipcoo2csc(atmp,info)
+
       if (info /= 0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_ipcoo2csc')
-        call psb_errpush(info,name,a_err='psb_ipcoo2csc')
         goto 9999
       end if
 
       call psb_umf_bld(atmp,p%desc_data,p,info)
       if(debug) write(0,*)me,': Done umf_bld ',info
       if (info /= 0) then
-        info = 4010
+        call psb_errpush(4010,name,a_err='umf_bld')
-        call psb_errpush(info,name,a_err='umf_bld')
         goto 9999
       end if
 
       call psb_sp_free(atmp,info) 
       if(info/=0) then
-        info=4010
+        call psb_errpush(4010,name,a_err='psb_sp_free')
-        call psb_errpush(info,name,a_err='psb_sp_free')
         goto 9999
       end if
 
@@ -342,22 +344,25 @@ subroutine psb_zbjac_bld(a,desc_a,p,upd,info)
       goto 9999
     end select
 
+  case default
+    info=4010
+    call psb_errpush(info,name,a_err='Invalid renum_')
+    goto 9999
 
-  endif
+  end select
 
   t6 = psb_wtime()
 
   call psb_sp_free(blck,info)
   if(info/=0) then
-    info=4010
+    call psb_errpush(4010,name,a_err='psb_sp_free')
-    ch_err='psb_sp_free'
-    call psb_errpush(info,name,a_err=ch_err)
     goto 9999
   end if
 
   if (debug) write(0,*) me,'End of ilu_bld'
 
   call psb_erractionrestore(err_act)
+
   return
 
 9999 continue

psb_zilu_fct.f90

@@ -175,7 +175,7 @@ contains
       ! use spgtblk, slower but able (in principle) to handle 
       ! anything. 
       !
-      if (a%fida=='CSR') then 
+      if (toupper(a%fida)=='CSR') then 
         do j = a%ia2(i), a%ia2(i+1) - 1
           k = a%ia1(j)
           !           write(0,*)'KKKKK',k
@@ -314,22 +314,19 @@ contains
       d(i) = zzero
 
 
-      if (b%fida=='CSR') then 
+      if (toupper(b%fida)=='CSR') then 
 
         do j = b%ia2(i-ma), b%ia2(i-ma+1) - 1
           k = b%ia1(j)
-          !           if (me.eq.2)  write(0,*)'ecco k=',k
           if ((k < i).and.(k >= 1)) then
             l1 = l1 + 1
             laspk(l1) = b%aspk(j)
             lia1(l1) = k
-            !              if(me.eq.2) write(0,*)'scrivo l'
           else if (k == i) then
             d(i) = b%aspk(j)
           else if ((k > i).and.(k <= m)) then
             l2 = l2 + 1
             uaspk(l2) = b%aspk(j)
-            !              write(0,*)'KKKKK',k
             uia1(l2) = k
           end if
         enddo
@@ -352,7 +349,6 @@ contains
           if (ktrw > trw%infoa(psb_nnz_)) exit
           if (trw%ia1(ktrw) > i) exit
           k = trw%ia2(ktrw)
-          ! write(0,*)'KKKKK',k
           if ((k < i).and.(k >= 1)) then
             l1 = l1 + 1
             laspk(l1) = trw%aspk(ktrw)