psblas3/base/serial/psb_update_mod.f90

!!$ 
!!$              Parallel Sparse BLAS  version 2.2
!!$    (C) Copyright 2006/2007/2008
!!$                       Salvatore Filippone    University of Rome Tor Vergata
!!$                       Alfredo Buttari        University of Rome Tor Vergata
!!$ 
!!$  Redistribution and use in source and binary forms, with or without
!!$  modification, are permitted provided that the following conditions
!!$  are met:
!!$    1. Redistributions of source code must retain the above copyright
!!$       notice, this list of conditions and the following disclaimer.
!!$    2. Redistributions in binary form must reproduce the above copyright
!!$       notice, this list of conditions, and the following disclaimer in the
!!$       documentation and/or other materials provided with the distribution.
!!$    3. The name of the PSBLAS group or the names of its contributors may
!!$       not be used to endorse or promote products derived from this
!!$       software without specific written permission.
!!$ 
!!$  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
!!$  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
!!$  TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!!$  PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE PSBLAS GROUP OR ITS CONTRIBUTORS
!!$  BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
!!$  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
!!$  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
!!$  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
!!$  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
!!$  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
!!$  POSSIBILITY OF SUCH DAMAGE.
!!$ 
!!$  
module psb_update_mod

  interface psb_srch_upd
    module procedure psb_s_srch_upd, psb_d_srch_upd, psb_c_srch_upd, psb_z_srch_upd
  end interface

  interface coo_srch_upd
    module procedure s_coo_srch_upd, d_coo_srch_upd, c_coo_srch_upd, z_coo_srch_upd
  end interface

  interface csr_srch_upd
    module procedure s_csr_srch_upd, d_csr_srch_upd, c_csr_srch_upd, z_csr_srch_upd
  end interface

  interface jad_srch_upd
    module procedure s_jad_srch_upd, d_jad_srch_upd, c_jad_srch_upd, z_jad_srch_upd
  end interface

contains


  subroutine psb_s_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_sspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    info  = 0

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif
    end if
    select case(psb_tolower(a%fida))
    case ('csr') 
      call  csr_srch_upd(nz,ia,ja,val,nza,a,&
           & imin,imax,jmin,jmax,nzl,info,gtl,ng)
    case ('coo') 
      call  coo_srch_upd(nz,ia,ja,val,nza,a,&
           & imin,imax,jmin,jmax,nzl,info,gtl,ng)
    case ('jad') 
      call  jad_srch_upd(nz,ia,ja,val,nza,a,&
           & imin,imax,jmin,jmax,nzl,info,gtl,ng)
      
    case default
      
      info = -9
      
    end select

  end subroutine psb_s_srch_upd

  subroutine psb_d_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_dspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    info  = 0

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif
    end if
    select case(psb_tolower(a%fida))
    case ('csr') 
      call  csr_srch_upd(nz,ia,ja,val,nza,a,&
           & imin,imax,jmin,jmax,nzl,info,gtl,ng)
    case ('coo') 
      call  coo_srch_upd(nz,ia,ja,val,nza,a,&
           & imin,imax,jmin,jmax,nzl,info,gtl,ng)
    case ('jad') 
      call  jad_srch_upd(nz,ia,ja,val,nza,a,&
           & imin,imax,jmin,jmax,nzl,info,gtl,ng)
      
    case default
      
      info = -9
      
    end select

  end subroutine psb_d_srch_upd

  subroutine psb_c_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_cspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    info  = 0

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(psb_toupper(a%fida))
      case ('CSR') 
!!$      write(0,*) 'Calling csr_srch_upd'
        call  csr_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info,gtl,ng)
!!$      write(0,*) 'From csr_srch_upd:',info
      case ('COO') 
        call  coo_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info,gtl,ng)

      case default

        info = -9

      end select
    else
      select case(psb_toupper(a%fida))
      case ('CSR') 
!!$      write(0,*) 'Calling csr_srch_upd'
        call  csr_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info)
!!$      write(0,*) 'From csr_srch_upd:',info
      case ('COO') 
        call  coo_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info)

      case default

        info = -9

      end select
    end if

  end subroutine psb_c_srch_upd


  subroutine psb_z_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_zspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    info  = 0

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(psb_toupper(a%fida))
      case ('CSR') 
!!$      write(0,*) 'Calling csr_srch_upd'
        call  csr_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info,gtl,ng)
!!$      write(0,*) 'From csr_srch_upd:',info
      case ('COO') 
        call  coo_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info,gtl,ng)

      case default

        info = -9

      end select
    else
      select case(psb_toupper(a%fida))
      case ('CSR') 
!!$      write(0,*) 'Calling csr_srch_upd'
        call  csr_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info)
!!$      write(0,*) 'From csr_srch_upd:',info
      case ('COO') 
        call  coo_srch_upd(nz,ia,ja,val,nza,a,&
             & imin,imax,jmin,jmax,nzl,info)

      case default

        info = -9

      end select
    end if

  end subroutine psb_z_srch_upd


  subroutine s_csr_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    use psb_error_mod
    implicit none 

    type(psb_sspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer  :: debug_level, debug_unit
    character(len=20)    :: name='s_csr_srch_upd'
    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,lb,ub,m,dupl

    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc=i2-i1

              call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                if (debug_level >= psb_debug_serial_) &
                     & write(debug_unit,*) trim(name),&
                     & ': Was searching ',ic,' in: ',i1,i2,&
                     & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if

            else

              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc = i2-i1
              call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                  if (debug_level >= psb_debug_serial_) &
                       & write(debug_unit,*) trim(name),&
                       & ': Was searching ',ic,' in: ',i1,i2,&
                       & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 

          if ((ir > 0).and.(ir <= a%m)) then 

            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc=i2-i1

            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Was searching ',ic,' in: ',i1,i2,&
                   & ' : ',a%ia1(i1:i2-1)
              info = i
              return
            end if

          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if

        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 
            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc = i2-i1
            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i
              return
            end if
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select
    end if

  end subroutine s_csr_srch_upd

  subroutine s_coo_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_sspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)
    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,nnz,dupl
    integer              :: debug_level, debug_unit
    character(len=20)    :: name='s_coo_srch_upd'

    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (psb_sp_getifld(psb_srtd_,a,info) /= psb_isrtdcoo_) then 
      info = -4
      return
    end if

    ilr = -1 
    ilc = -1 
    nnz = psb_sp_getifld(psb_nnz_,a,info)


    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                info = i 
                return
              end if
            else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
            endif
          end if
        end do
      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic) 
            if ((ir > 0).and.(ir <= a%m)) then 

              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                info = i 
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'              
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    end if

  end subroutine s_coo_srch_upd

  subroutine s_jad_srch_upd(nz,ia,ja,val,nza,a,imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    
    implicit none

    type(psb_sspmat_type), intent(inout), target :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer, pointer     :: ia1(:), ia2(:), ia3(:),&
         & ja_(:), ka_(:)
    integer, allocatable :: indices(:), blks(:), rows(:) 
    integer  :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr,&
         & i,j,nr,dupl, ii, ir, ic

    info = 0
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    png = a%ia2(1) ! points to the number of blocks
    pia = a%ia2(2) ! points to the beginning of ia(3,png)
    pja = a%ia2(3) ! points to the beginning of ja(:)

    ngr  =  a%ia2(png)              ! the number of blocks
    ja_  => a%ia2(pja:)            ! the array containing the pointers to ka and aspk
    ka_  => a%ia1(:)               ! the array containing the column indices
    ia1 => a%ia2(pia:pja-1:3)      ! the array containing the first row index 
    ! of each block
    ia2 => a%ia2(pia+1:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first jad column
    ia3 => a%ia2(pia+2:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first csr column


    if (a%pl(1) /= 0) then

      if (present(gtl)) then 
        if (.not.present(ng)) then 
          info = -1
          return
        endif


        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=ng)) then 
            ir = gtl(ir)
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd_gtl: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd_gtl
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd_gtl
            end if
          end do blkfnd_gtl
        end do


        ! cycle over elements
        update_gtl: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              call ibsrch(i,ir,nr,rows)

              ! find which block the row belongs to
              blk = blks(i)

              ! extract first part of the row from the jad block
              ipx = ia1(blk)             ! the first row index of the block
              k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
              rb  = indices(i)-ipx       ! the row offset within the block
              npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

              do  col = ia2(blk), ia3(blk)-1 
                if (ic ==  ka_(ja_(col)+rb)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(ja_(col)+rb) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do

              ! extract second part of the row from the csr tail just in case
              row=ia3(blk)+rb
              do j=ja_(row), ja_(row+1)-1
                if (ic ==  ka_(j)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(j) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(j) = a%aspk(j) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do
            end if
          end if
        end do update_gtl

      else

        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=a%m)) then 
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd
            end if
          end do blkfnd
        end do


        ! cycle over elements
        update: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=a%m).and.(ic>=1).and.(ic<=a%k)) then 
            call ibsrch(i,ir,nr,rows)
            ! find which block the row belongs to
            blk = blks(i)

            ! extract first part of the row from the jad block
            ipx = ia1(blk)             ! the first row index of the block
            k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
            rb  = indices(i)-ipx       ! the row offset within the block
            npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

            do  col = ia2(blk), ia3(blk)-1 
              if (ic ==  ka_(ja_(col)+rb)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(ja_(col)+rb) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                end select
                cycle update
              endif
            end do

            ! extract second part of the row from the csr tail just in case
            row=ia3(blk)+rb
            do j=ja_(row), ja_(row+1)-1
              if (ic ==  ka_(j)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(j) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(j) = a%aspk(j) + val(ii)
                end select
                cycle update
              endif
            end do
          end if
        end do update

      end if
    else
      ! There might be some problems
      info=134
    end if

  end subroutine s_jad_srch_upd

  subroutine d_csr_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    use psb_error_mod
    implicit none 

    type(psb_dspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer  :: debug_level, debug_unit
    character(len=20)    :: name='d_csr_srch_upd'
    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,lb,ub,m,dupl

    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc=i2-i1

              call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                if (debug_level >= psb_debug_serial_) &
                     & write(debug_unit,*) trim(name),&
                     & ': Was searching ',ic,' in: ',i1,i2,&
                     & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if

            else

              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc = i2-i1
              call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                  if (debug_level >= psb_debug_serial_) &
                       & write(debug_unit,*) trim(name),&
                       & ': Was searching ',ic,' in: ',i1,i2,&
                       & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if

          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 

          if ((ir > 0).and.(ir <= a%m)) then 

            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc=i2-i1

            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Was searching ',ic,' in: ',i1,i2,&
                   & ' : ',a%ia1(i1:i2-1)
              info = i
              return
            end if
            
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if

        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 
            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc = i2-i1
            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i
              return
            end if
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select
    end if

  end subroutine d_csr_srch_upd

  subroutine d_coo_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_dspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)
    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,nnz,dupl
    integer              :: debug_level, debug_unit
    character(len=20)    :: name='d_coo_srch_upd'

    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (psb_sp_getifld(psb_srtd_,a,info) /= psb_isrtdcoo_) then 
      info = -4
      return
    end if

    ilr = -1 
    ilc = -1 
    nnz = psb_sp_getifld(psb_nnz_,a,info)


    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                info = i 
                return
              end if
            else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
            endif
          end if
        end do
      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic) 
            if ((ir > 0).and.(ir <= a%m)) then 

              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                info = i 
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'              
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    end if

  end subroutine d_coo_srch_upd

  subroutine d_jad_srch_upd(nz,ia,ja,val,nza,a,imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    
    implicit none

    type(psb_dspmat_type), intent(inout), target :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    real(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer, pointer     :: ia1(:), ia2(:), ia3(:),&
         & ja_(:), ka_(:)
    integer, allocatable :: indices(:), blks(:), rows(:) 
    integer  :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr,&
         & i,j,nr,dupl, ii, ir, ic

    info = 0
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    png = a%ia2(1) ! points to the number of blocks
    pia = a%ia2(2) ! points to the beginning of ia(3,png)
    pja = a%ia2(3) ! points to the beginning of ja(:)

    ngr  =  a%ia2(png)              ! the number of blocks
    ja_  => a%ia2(pja:)            ! the array containing the pointers to ka and aspk
    ka_  => a%ia1(:)               ! the array containing the column indices
    ia1 => a%ia2(pia:pja-1:3)      ! the array containing the first row index 
    ! of each block
    ia2 => a%ia2(pia+1:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first jad column
    ia3 => a%ia2(pia+2:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first csr column


    if (a%pl(1) /= 0) then

      if (present(gtl)) then 
        if (.not.present(ng)) then 
          info = -1
          return
        endif


        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=ng)) then 
            ir = gtl(ir)
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd_gtl: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd_gtl
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd_gtl
            end if
          end do blkfnd_gtl
        end do


        ! cycle over elements
        update_gtl: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              call ibsrch(i,ir,nr,rows)

              ! find which block the row belongs to
              blk = blks(i)

              ! extract first part of the row from the jad block
              ipx = ia1(blk)             ! the first row index of the block
              k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
              rb  = indices(i)-ipx       ! the row offset within the block
              npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

              do  col = ia2(blk), ia3(blk)-1 
                if (ic ==  ka_(ja_(col)+rb)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(ja_(col)+rb) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do

              ! extract second part of the row from the csr tail just in case
              row=ia3(blk)+rb
              do j=ja_(row), ja_(row+1)-1
                if (ic ==  ka_(j)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(j) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(j) = a%aspk(j) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do
            end if
          end if
        end do update_gtl

      else

        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=a%m)) then 
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd
            end if
          end do blkfnd
        end do


        ! cycle over elements
        update: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=a%m).and.(ic>=1).and.(ic<=a%k)) then 
            call ibsrch(i,ir,nr,rows)
            ! find which block the row belongs to
            blk = blks(i)

            ! extract first part of the row from the jad block
            ipx = ia1(blk)             ! the first row index of the block
            k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
            rb  = indices(i)-ipx       ! the row offset within the block
            npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

            do  col = ia2(blk), ia3(blk)-1 
              if (ic ==  ka_(ja_(col)+rb)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(ja_(col)+rb) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                end select
                cycle update
              endif
            end do

            ! extract second part of the row from the csr tail just in case
            row=ia3(blk)+rb
            do j=ja_(row), ja_(row+1)-1
              if (ic ==  ka_(j)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(j) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(j) = a%aspk(j) + val(ii)
                end select
                cycle update
              endif
            end do
          end if
        end do update

      end if
    else
      ! There might be some problems
      info=134
    end if

  end subroutine d_jad_srch_upd


  subroutine c_csr_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_cspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,lb,ub,m,dupl

    integer  :: debug_level, debug_unit
    character(len=20)    :: name='c_csr_srch_upd'

    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc=i2-i1

              call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                if (debug_level >= psb_debug_serial_) &
                     & write(debug_unit,*) trim(name),&
                     & ': Was searching ',ic,' in: ',i1,i2,&
                     & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if

            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc = i2-i1
              call issrch(ip,ic,nc,a%ia1(i1:i2-1))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                  if (debug_level >= psb_debug_serial_) &
                       & write(debug_unit,*) trim(name),&
                       & ': Was searching ',ic,' in: ',i1,i2,&
                       & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 

          if ((ir > 0).and.(ir <= a%m)) then 

            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc=i2-i1

            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Was searching ',ic,' in: ',i1,i2,&
                   & ' : ',a%ia1(i1:i2-1)
              info = i
              return
            end if
            
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if

        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 
            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc = i2-i1
            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i
              return
            end if
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select
    end if

  end subroutine c_csr_srch_upd

  subroutine c_coo_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_cspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)
    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,nnz,dupl
    integer              :: debug_level, debug_unit
    character(len=20)    :: name='c_coo_srch_upd'


    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (psb_sp_getifld(psb_srtd_,a,info) /= psb_isrtdcoo_) then 
      info = -4
      return
    end if

    ilr = -1 
    ilc = -1 
    nnz = psb_sp_getifld(psb_nnz_,a,info)


    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                info = i 
                return
              end if
            else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
            endif
          end if
        end do
      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic) 
            if ((ir > 0).and.(ir <= a%m)) then 

              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                info = i 
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'              
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    end if

  end subroutine c_coo_srch_upd



  subroutine c_jad_srch_upd(nz,ia,ja,val,nza,a,imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    
    implicit none

    type(psb_cspmat_type), intent(inout), target :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_spk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer, pointer     :: ia1(:), ia2(:), ia3(:),&
         & ja_(:), ka_(:)
    integer, allocatable :: indices(:), blks(:), rows(:) 
    integer  :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr,&
         & i,j,nr,dupl, ii, ir, ic

    info = 0
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    png = a%ia2(1) ! points to the number of blocks
    pia = a%ia2(2) ! points to the beginning of ia(3,png)
    pja = a%ia2(3) ! points to the beginning of ja(:)

    ngr  =  a%ia2(png)              ! the number of blocks
    ja_  => a%ia2(pja:)            ! the array containing the pointers to ka and aspk
    ka_  => a%ia1(:)               ! the array containing the column indices
    ia1 => a%ia2(pia:pja-1:3)      ! the array containing the first row index 
    ! of each block
    ia2 => a%ia2(pia+1:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first jad column
    ia3 => a%ia2(pia+2:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first csr column


    if (a%pl(1) /= 0) then

      if (present(gtl)) then 
        if (.not.present(ng)) then 
          info = -1
          return
        endif


        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=ng)) then 
            ir = gtl(ir)
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd_gtl: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd_gtl
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd_gtl
            end if
          end do blkfnd_gtl
        end do


        ! cycle over elements
        update_gtl: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              call ibsrch(i,ir,nr,rows)

              ! find which block the row belongs to
              blk = blks(i)

              ! extract first part of the row from the jad block
              ipx = ia1(blk)             ! the first row index of the block
              k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
              rb  = indices(i)-ipx       ! the row offset within the block
              npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

              do  col = ia2(blk), ia3(blk)-1 
                if (ic ==  ka_(ja_(col)+rb)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(ja_(col)+rb) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do

              ! extract second part of the row from the csr tail just in case
              row=ia3(blk)+rb
              do j=ja_(row), ja_(row+1)-1
                if (ic ==  ka_(j)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(j) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(j) = a%aspk(j) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do
            end if
          end if
        end do update_gtl

      else

        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=a%m)) then 
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd
            end if
          end do blkfnd
        end do


        ! cycle over elements
        update: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=a%m).and.(ic>=1).and.(ic<=a%k)) then 
            call ibsrch(i,ir,nr,rows)
            ! find which block the row belongs to
            blk = blks(i)

            ! extract first part of the row from the jad block
            ipx = ia1(blk)             ! the first row index of the block
            k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
            rb  = indices(i)-ipx       ! the row offset within the block
            npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

            do  col = ia2(blk), ia3(blk)-1 
              if (ic ==  ka_(ja_(col)+rb)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(ja_(col)+rb) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                end select
                cycle update
              endif
            end do

            ! extract second part of the row from the csr tail just in case
            row=ia3(blk)+rb
            do j=ja_(row), ja_(row+1)-1
              if (ic ==  ka_(j)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(j) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(j) = a%aspk(j) + val(ii)
                end select
                cycle update
              endif
            end do
          end if
        end do update

      end if
    else
      ! There might be some problems
      info=134
    end if

  end subroutine c_jad_srch_upd

  subroutine z_csr_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_zspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,lb,ub,m,dupl

    integer  :: debug_level, debug_unit
    character(len=20)    :: name='z_csr_srch_upd'

    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()

    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc=i2-i1

              call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                if (debug_level >= psb_debug_serial_) &
                     & write(debug_unit,*) trim(name),&
                     & ': Was searching ',ic,' in: ',i1,i2,&
                     & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if

            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic)
            if ((ir > 0).and.(ir <= a%m)) then 
              i1 = a%ia2(ir)
              i2 = a%ia2(ir+1)
              nc = i2-i1
              call issrch(ip,ic,nc,a%ia1(i1:i2-1))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                  if (debug_level >= psb_debug_serial_) &
                       & write(debug_unit,*) trim(name),&
                       & ': Was searching ',ic,' in: ',i1,i2,&
                       & ' : ',a%ia1(i1:i2-1)
                info = i
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'
            end if

          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.

        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 

          if ((ir > 0).and.(ir <= a%m)) then 

            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc=i2-i1

            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))    
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Was searching ',ic,' in: ',i1,i2,&
                   & ' : ',a%ia1(i1:i2-1)
              info = i
              return
            end if
            
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if

        end do

      case(psb_dupl_add_)
        ! Add
        ilr = -1 
        ilc = -1 
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 
            i1 = a%ia2(ir)
            i2 = a%ia2(ir+1)
            nc = i2-i1
            call ibsrch(ip,ic,nc,a%ia1(i1:i2-1))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i
              return
            end if
          else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select
    end if

  end subroutine z_csr_srch_upd

  subroutine z_coo_srch_upd(nz,ia,ja,val,nza,a,&
       & imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    implicit none 

    type(psb_zspmat_type), intent(inout) :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)
    integer  :: i,ir,ic, ilr, ilc, ip, &
         & i1,i2,nc,nnz,dupl
    integer              :: debug_level, debug_unit
    character(len=20)    :: name='z_coo_srch_upd'


    info = 0
    debug_unit  = psb_get_debug_unit()
    debug_level = psb_get_debug_level()
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    if (psb_sp_getifld(psb_srtd_,a,info) /= psb_isrtdcoo_) then 
      info = -4
      return
    end if

    ilr = -1 
    ilc = -1 
    nnz = psb_sp_getifld(psb_nnz_,a,info)


    if (present(gtl)) then 
      if (.not.present(ng)) then 
        info = -1
        return
      endif

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = val(i)
              else
                info = i 
                return
              end if
            else
            if (debug_level >= psb_debug_serial_) &
                 & write(debug_unit,*) trim(name),&
                 & ': Discarding row that does not belong to us.'
            endif
          end if
        end do
      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            ic = gtl(ic) 
            if ((ir > 0).and.(ir <= a%m)) then 

              if (ir /= ilr) then 
                call ibsrch(i1,ir,nnz,a%ia1)
                i2 = i1
                do 
                  if (i2+1 > nnz) exit
                  if (a%ia1(i2+1) /= a%ia1(i2)) exit
                  i2 = i2 + 1
                end do
                do 
                  if (i1-1 < 1) exit
                  if (a%ia1(i1-1) /= a%ia1(i1)) exit
                  i1 = i1 - 1
                end do
                ilr = ir
              else
                i1 = 1
                i2 = 1
              end if
              nc = i2-i1+1
              call issrch(ip,ic,nc,a%ia2(i1:i2))
              if (ip>0) then 
                a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
              else
                info = i 
                return
              end if
            else
              if (debug_level >= psb_debug_serial_) &
                   & write(debug_unit,*) trim(name),&
                   & ': Discarding row that does not belong to us.'              
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    else

      select case(dupl)
      case(psb_dupl_ovwrt_,psb_dupl_err_)
        ! Overwrite.
        ! Cannot test for error, should have been caught earlier.
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case(psb_dupl_add_)
        ! Add
        do i=1, nz
          ir = ia(i)
          ic = ja(i) 
          if ((ir > 0).and.(ir <= a%m)) then 

            if (ir /= ilr) then 
              call ibsrch(i1,ir,nnz,a%ia1)
              i2 = i1
              do 
                if (i2+1 > nnz) exit
                if (a%ia1(i2+1) /= a%ia1(i2)) exit
                i2 = i2 + 1
              end do
              do 
                if (i1-1 < 1) exit
                if (a%ia1(i1-1) /= a%ia1(i1)) exit
                i1 = i1 - 1
              end do
              ilr = ir
            else
              i1 = 1
              i2 = 1
            end if
            nc = i2-i1+1
            call issrch(ip,ic,nc,a%ia2(i1:i2))
            if (ip>0) then 
              a%aspk(i1+ip-1) = a%aspk(i1+ip-1) + val(i)
            else
              info = i 
              return
            end if
          end if
        end do

      case default
        info = -3
        if (debug_level >= psb_debug_serial_) &
             & write(debug_unit,*) trim(name),&
             & ': Duplicate handling: ',dupl
      end select

    end if

  end subroutine z_coo_srch_upd



  subroutine z_jad_srch_upd(nz,ia,ja,val,nza,a,imin,imax,jmin,jmax,nzl,info,gtl,ng)

    use psb_spmat_type
    use psb_const_mod
    use psb_realloc_mod
    use psb_string_mod
    use psb_serial_mod
    
    implicit none

    type(psb_zspmat_type), intent(inout), target :: a
    integer, intent(in) :: nz, imin,imax,jmin,jmax,nzl
    integer, intent(in) :: ia(:),ja(:)
    integer, intent(inout) :: nza
    complex(psb_dpk_), intent(in) :: val(:)
    integer, intent(out) :: info
    integer, intent(in), optional  :: ng,gtl(:)

    integer, pointer     :: ia1(:), ia2(:), ia3(:),&
         & ja_(:), ka_(:)
    integer, allocatable :: indices(:), blks(:), rows(:) 
    integer  :: png, pia, pja, ipx, blk, rb, row, k_pt, npg, col, ngr,&
         & i,j,nr,dupl, ii, ir, ic

    info = 0
    dupl = psb_sp_getifld(psb_dupl_,a,info)

    png = a%ia2(1) ! points to the number of blocks
    pia = a%ia2(2) ! points to the beginning of ia(3,png)
    pja = a%ia2(3) ! points to the beginning of ja(:)

    ngr  =  a%ia2(png)              ! the number of blocks
    ja_  => a%ia2(pja:)            ! the array containing the pointers to ka and aspk
    ka_  => a%ia1(:)               ! the array containing the column indices
    ia1 => a%ia2(pia:pja-1:3)      ! the array containing the first row index 
    ! of each block
    ia2 => a%ia2(pia+1:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first jad column
    ia3 => a%ia2(pia+2:pja-1:3)    ! the array containing a pointer to the pos. 
    ! in ja to the first csr column


    if (a%pl(1) /= 0) then

      if (present(gtl)) then 
        if (.not.present(ng)) then 
          info = -1
          return
        endif


        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=ng)) then 
            ir = gtl(ir)
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd_gtl: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd_gtl
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd_gtl
            end if
          end do blkfnd_gtl
        end do


        ! cycle over elements
        update_gtl: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=ng).and.(ic>=1).and.(ic<=ng)) then 
            ir = gtl(ir)
            if ((ir > 0).and.(ir <= a%m)) then 
              ic = gtl(ic) 
              call ibsrch(i,ir,nr,rows)

              ! find which block the row belongs to
              blk = blks(i)

              ! extract first part of the row from the jad block
              ipx = ia1(blk)             ! the first row index of the block
              k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
              rb  = indices(i)-ipx       ! the row offset within the block
              npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

              do  col = ia2(blk), ia3(blk)-1 
                if (ic ==  ka_(ja_(col)+rb)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(ja_(col)+rb) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do

              ! extract second part of the row from the csr tail just in case
              row=ia3(blk)+rb
              do j=ja_(row), ja_(row+1)-1
                if (ic ==  ka_(j)) then 
                  select case(dupl)
                  case(psb_dupl_ovwrt_,psb_dupl_err_)
                    a%aspk(j) = val(ii)
                  case(psb_dupl_add_)
                    a%aspk(j) = a%aspk(j) + val(ii)
                  end select
                  cycle update_gtl
                endif
              end do
            end if
          end if
        end do update_gtl

      else

        allocate(rows(nz),stat=info) 
        if (info /= 0) then 
          info = -4010
          return
        endif
        j=0
        do i=1,nz
          ir = ia(i)
          if ((ir >=1).and.(ir<=a%m)) then 
            j = j + 1
            rows(j) = ir
          endif
        enddo
        call psb_msort_unique(rows(1:j),nr)
        allocate(indices(nr),blks(nr),stat=info)
        if (info /= 0) then 
          info = -4010
          return
        endif

        do i=1,nr
          indices(i)=a%pl(rows(i))
          j=0
          blkfnd: do
            j=j+1
            if(ia1(j) == indices(i)) then
              blks(i)=j
              ipx = ia1(j)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j)+rb
              exit blkfnd
            else if(ia1(j) > indices(i)) then
              blks(i)=j-1
              ipx = ia1(j-1)         ! the first row index of the block
              rb  = indices(i)-ipx   ! the row offset within the block
              row = ia3(j-1)+rb
              exit blkfnd
            end if
          end do blkfnd
        end do


        ! cycle over elements
        update: do ii=1,nz
          ir = ia(ii)
          ic = ja(ii) 
          if ((ir >=1).and.(ir<=a%m).and.(ic>=1).and.(ic<=a%k)) then 
            call ibsrch(i,ir,nr,rows)
            ! find which block the row belongs to
            blk = blks(i)

            ! extract first part of the row from the jad block
            ipx = ia1(blk)             ! the first row index of the block
            k_pt= ia2(blk)             ! the pointer to the beginning of a column in ja
            rb  = indices(i)-ipx       ! the row offset within the block
            npg = ja_(k_pt+1)-ja_(k_pt)  ! the number of rows in the block

            do  col = ia2(blk), ia3(blk)-1 
              if (ic ==  ka_(ja_(col)+rb)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(ja_(col)+rb) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(ja_(col)+rb) = a%aspk(ja_(col)+rb) + val(ii)
                end select
                cycle update
              endif
            end do

            ! extract second part of the row from the csr tail just in case
            row=ia3(blk)+rb
            do j=ja_(row), ja_(row+1)-1
              if (ic ==  ka_(j)) then 
                select case(dupl)
                case(psb_dupl_ovwrt_,psb_dupl_err_)
                  a%aspk(j) = val(ii)
                case(psb_dupl_add_)
                  a%aspk(j) = a%aspk(j) + val(ii)
                end select
                cycle update
              endif
            end do
          end if
        end do update

      end if
    else
      ! There might be some problems
      info=134
    end if

  end subroutine z_jad_srch_upd


end module psb_update_mod