*** empty log message ***

Make.inc

@@ -10,8 +10,8 @@ F90=ifort
 FC=ifort
 CC=icc
 F77=$(FC)
-F90COPT= -check arg_temp_created
-FCOPT=-check arg_temp_created
+F90COPT= -check all -g -CB -no_cpprt
+FCOPT=-check all -g -CB -no_cpprt
 CCOPT=
 
 #######################  Section 2 #######################

src/comm/psb_dhalo.f90

@@ -69,7 +69,7 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
   n = desc_a%matrix_data(psb_n_)
   nrow = desc_a%matrix_data(psb_n_row_)
   
-  maxk=size(x,2)-jx+1
+  maxk=size(x,2)-ijx+1
   
   if(present(ik)) then
      if(ik.gt.maxk) then
@@ -118,8 +118,18 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
   end if
 
   liwork=ncol
-  if (present(work).and.(size(work).ge.liwork)) then
-     iwork => work
+  if (present(work)) then
+     if(size(work).ge.liwork) then
+        iwork => work
+     else
+        call psb_realloc(liwork,iwork,info)
+        if(info.ne.0) then
+           info=4010
+           ch_err='psb_realloc'
+           call psb_errpush(info,name,a_err=ch_err)
+           goto 9999
+        end if
+     end if
   else
      call psb_realloc(liwork,iwork,info)
      if(info.ne.0) then
@@ -147,7 +157,8 @@ subroutine  psb_dhalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
   end if
 
   if(info.ne.0) then
-     call psb_errpush(4010,name,a_err='PSI_dSwap...')
+     ch_err='PSI_dSwap...'
+     call psb_errpush(4010,name,a_err=ch_err)
      goto 9999
   end if
 
@@ -266,8 +277,18 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
   end if
 
   liwork=ncol
-  if (present(work).and.(size(work).ge.liwork)) then
-     iwork => work
+  if (present(work)) then
+     if(size(work).ge.liwork) then
+        iwork => work
+     else
+        call psb_realloc(liwork,iwork,info)
+        if(info.ne.0) then
+           info=4010
+           ch_err='psb_realloc'
+           call psb_errpush(info,name,a_err=ch_err)
+           goto 9999
+        end if
+     end if
   else
      call psb_realloc(liwork,iwork,info)
      if(info.ne.0) then
@@ -288,7 +309,8 @@ subroutine  psb_dhalov(x,desc_a,info,alpha,work,tran,mode)
   end if
 
   if(info.ne.0) then
-     call psb_errpush(4010,name,a_err='PSI_dSwap...')
+     ch_err='PSI_dSwap...'
+     call psb_errpush(4010,name,a_err=ch_err)
      goto 9999
   end if
 

src/comm/psb_dovrl.f90

@@ -112,8 +112,18 @@ subroutine  psb_dovrlm(x,desc_a,info,jx,ik,work,choice,update_type)
 
   ! check for presence/size of a work area
   liwork=ncol
-  if (present(work).and.(size(work).ge.liwork)) then
-     iwork => work
+  if (present(work)) then
+     if(size(work).ge.liwork) then
+        iwork => work
+     else
+        call psb_realloc(liwork,iwork,info)
+        if(info.ne.0) then
+           info=4010
+           ch_err='psb_realloc'
+           call psb_errpush(info,name,a_err=ch_err)
+           goto 9999
+        end if
+     end if
   else
      call psb_realloc(liwork,iwork,info)
      if(info.ne.0) then
@@ -279,8 +289,18 @@ subroutine  psb_dovrlv(x,desc_a,info,work,choice,update_type)
 
   ! check for presence/size of a work area
   liwork=ncol
-  if (present(work).and.(size(work).ge.liwork)) then
-     iwork => work
+  if (present(work)) then
+     if(size(work).ge.liwork) then
+        iwork => work
+     else
+        call psb_realloc(liwork,iwork,info)
+        if(info.ne.0) then
+           info=4010
+           ch_err='psb_realloc'
+           call psb_errpush(info,name,a_err=ch_err)
+           goto 9999
+        end if
+     end if
   else
      call psb_realloc(liwork,iwork,info)
      if(info.ne.0) then

src/comm/psb_ihalo.f90

@@ -1,3 +1,4 @@
+
 ! File:  psb_ihalo.f90
 !
 ! Subroutine: psb_ihalom
@@ -120,8 +121,18 @@ subroutine  psb_ihalom(x,desc_a,info,alpha,jx,ik,work,tran,mode)
 !!$  end if
 
   liwork=ncol
-  if (present(work).and.(size(work).ge.liwork)) then
-     iwork => work
+  if (present(work)) then
+     if(size(work).ge.liwork) then
+        iwork => work
+     else
+        call psb_realloc(liwork,iwork,info)
+        if(info.ne.0) then
+           info=4010
+           ch_err='psb_realloc'
+           call psb_errpush(info,name,a_err=ch_err)
+           goto 9999
+        end if
+     end if
   else
      call psb_realloc(liwork,iwork,info)
      if(info.ne.0) then
@@ -262,8 +273,18 @@ subroutine  psb_ihalov(x,desc_a,info,alpha,work,tran,mode)
 !!$  end if
 
   liwork=ncol
-  if (present(work).and.(size(work).ge.liwork)) then
-     iwork => work
+  if (present(work)) then
+     if(size(work).ge.liwork) then
+        iwork => work
+     else
+        call psb_realloc(liwork,iwork,info)
+        if(info.ne.0) then
+           info=4010
+           ch_err='psb_realloc'
+           call psb_errpush(info,name,a_err=ch_err)
+           goto 9999
+        end if
+     end if
   else
      call psb_realloc(liwork,iwork,info)
      if(info.ne.0) then

src/internals/psi_crea_index.f90

@@ -8,7 +8,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
   type(psb_desc_type), intent(in)  :: desc_a
   integer, intent(out)             :: info
   integer, intent(in)              :: index_in(:)
-  integer, intent(out)             :: index_out(:)
+  integer, pointer                 :: index_out(:)
   logical                          :: glob_idx
   
 !         ....local scalars...      
@@ -21,6 +21,32 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
   logical,parameter    :: debug=.false.
   character(len=20)    :: name, ch_err
 
+  interface
+     subroutine psi_compute_size(desc_data,&
+          & index_in, dl_lda, info)
+       integer  :: info, dl_lda
+       integer  :: desc_data(:), index_in(:)
+     end subroutine psi_compute_size
+  end interface
+
+  interface
+     subroutine psi_sort_dl(dep_list,l_dep_list,np,info)
+       integer :: np,dep_list(:,:), l_dep_list(:), info
+     end subroutine psi_sort_dl
+  end interface
+
+  interface
+     subroutine psi_desc_index(desc_data,index_in,dep_list,&
+          & length_dl,loc_to_glob,glob_to_loc,desc_index,&
+          & isglob_in,info)
+       integer :: desc_data(:),index_in(:),dep_list(:)
+       integer :: loc_to_glob(:),glob_to_loc(:)
+       integer,pointer :: desc_index(:)
+       integer :: length_dl, info
+       logical :: isglob_in
+     end subroutine psi_desc_index
+  end interface
+
   info = 0
   name='psi_crea_index'
   call psb_erractionsave(err_act)
@@ -40,7 +66,7 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
 
   ! allocate dependency list
   call psi_compute_size(desc_a%matrix_data, index_in, dl_lda, info)
-  allocate(dep_list(dl_lda,0:np-1),length_dl(0:np-1))
+  allocate(dep_list(max(1,dl_lda),0:np-1),length_dl(0:np-1))
   ! ...extract dependence list (ordered list of identifer process
   !    which every process must communcate with...
   if (debug) write(*,*) 'crea_halo: calling extract_dep_list'
@@ -70,9 +96,13 @@ subroutine psi_crea_index(desc_a,index_in,index_out,glob_idx,info)
   ! ...create desc_halo array.....
   if(debug) write(0,*)'in psi_crea_index calling psi_desc_index',&
        & size(index_out)
-  call psi_desc_index(desc_a%matrix_data,index_in,dep_list(1,me),&
+  call psi_desc_index(desc_a%matrix_data,index_in,dep_list(1:,me),&
        & length_dl(me),desc_a%loc_to_glob,desc_a%glob_to_loc,&
-       & index_out,glob_idx)
+       & index_out,glob_idx,info)
+  if(info.ne.0) then
+     call psb_errpush(4010,name,a_err='psi_desc_index')
+     goto 9999
+  end if
   
   deallocate(dep_list,length_dl)
   call psb_erractionrestore(err_act)

src/internals/psi_dl_check.f90

@@ -3,7 +3,7 @@ subroutine psi_dl_check(dep_list,dl_lda,np,length_dl)
   use psb_const_mod
   implicit none
 
-  integer  :: np,dl_lda,length_dl(:)
+  integer  :: np,dl_lda,length_dl(0:np)
   integer  :: dep_list(dl_lda,0:np-1)
   ! locals
   integer  :: proc, proc2, i, j

src/methd/Makefile

@@ -20,6 +20,6 @@ veryclean: clean
 	/bin/rm -f $(LIBNAME)
 
 clean:
-	/bin/rm -f $(F90OBJS) $(LOCAL_MODS)
+	/bin/rm -f $(OBJS) $(LOCAL_MODS)
 
 veryclean: clean

src/modules/psb_desc_type.f90

@@ -8,6 +8,7 @@
 
 module psb_descriptor_type
   use psb_const_mod
+  implicit none
 
   ! desc_type contains data for communications.
   type psb_desc_type
@@ -47,35 +48,35 @@ contains
   logical function psb_is_ok_dec(dectype)
     integer :: dectype
     
-    psb_is_ok_dec = ((dectype == desc_asb).or.(dectype == desc_bld).or.&
-         &(dectype == desc_upd).or.(dectype== desc_upd_asb))
+    psb_is_ok_dec = ((dectype == psb_desc_asb_).or.(dectype == psb_desc_bld_).or.&
+         &(dectype == psb_desc_upd_).or.(dectype== psb_desc_upd_asb_))
     
   end function psb_is_ok_dec
 
   logical function psb_is_bld_dec(dectype)
     integer :: dectype
 
-    psb_is_bld_dec = (dectype == desc_bld)
+    psb_is_bld_dec = (dectype == psb_desc_bld_)
   end function psb_is_bld_dec
 
   logical function psb_is_upd_dec(dectype)          
     integer :: dectype
 
-    psb_is_upd_dec = (dectype == desc_upd)
+    psb_is_upd_dec = (dectype == psb_desc_upd_)
 
   end function psb_is_upd_dec
 
   logical function psb_is_asb_upd_dec(dectype)
     integer :: dectype
 
-    psb_is_asb_upd_dec = (dectype == desc_upd_asb)
+    psb_is_asb_upd_dec = (dectype == psb_desc_upd_asb_)
 
   end function psb_is_asb_upd_dec
 
   logical function psb_is_asb_dec(dectype)
     integer :: dectype
 
-    psb_is_asb_dec = (dectype == desc_asb)
+    psb_is_asb_dec = (dectype == psb_desc_asb_)
 
   end function psb_is_asb_dec
 

src/modules/psb_error_mod.f90

@@ -113,8 +113,8 @@ contains
   subroutine psb_errpush(err_c, r_name, i_err, a_err)
 
     integer, intent(in)              ::  err_c
-    character(len=20), intent(in)    ::  r_name
-    character(len=20), optional      ::  a_err
+    character(len=*), intent(in)     ::  r_name
+    character(len=*), optional       ::  a_err
     integer, optional                ::  i_err(5)
 
     type(psb_errstack_node), pointer     ::  new_node

src/modules/psi_mod.f90

@@ -26,7 +26,7 @@ module psi_mod
        type(psb_desc_type), intent(in)  :: desc_a
        integer, intent(out)             :: info
        integer, intent(in)              :: index_in(:)
-       integer, intent(out)             :: index_out(:)
+       integer, pointer                 :: index_out(:)
        logical                          :: glob_idx
      end subroutine psi_crea_index
   end interface

src/prec/psb_dprec.f90

@@ -23,6 +23,35 @@ subroutine psb_dprecaply(prec,x,y,desc_data,info,trans, work)
   real(kind(1.d0)), parameter       :: one=1.d0, zero=0.d0
   external mpi_wtime
   character(len=20)   :: name, ch_err
+
+  interface
+     subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
+       use psb_descriptor_type
+       use psb_prec_type
+       type(psb_desc_type),intent(in)    :: desc_data
+       type(psb_dbase_prec), intent(in)  :: prec
+       real(kind(0.d0)),intent(inout)    :: x(:), y(:)
+       real(kind(0.d0)),intent(in)       :: beta
+       character(len=1)                  :: trans
+       real(kind(0.d0)),target           :: work(:)
+       integer, intent(out)              :: info
+     end subroutine psb_dbaseprcaply
+  end interface
+
+  interface
+     subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
+       use psb_descriptor_type
+       use psb_prec_type
+       type(psb_desc_type),intent(in)    :: desc_data
+       type(psb_dbase_prec), intent(in)  :: baseprecv(:)
+       real(kind(0.d0)),intent(in)       :: beta
+       real(kind(0.d0)),intent(inout)    :: x(:), y(:)
+       character                         :: trans
+       real(kind(0.d0)),target           :: work(:)
+       integer, intent(out)              :: info
+     end subroutine psb_dmlprcaply
+  end interface
+  
   name='psb_dprecaply'
   info = 0
   call psb_erractionsave(err_act)
@@ -111,6 +140,20 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
   external mpi_wtime
   character(len=20)   :: name, ch_err
 
+  interface
+     subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
+       use psb_descriptor_type
+       use psb_prec_type
+       type(psb_desc_type), intent(in)       :: desc_data
+       type(psb_dbase_prec), intent(in)      :: prec
+       real(kind(0.d0)),intent(inout)        :: x(:), y(:)
+       real(kind(0.d0)),intent(in)           :: beta
+       character(len=1)                      :: trans
+       real(kind(0.d0)),target               :: work(:)
+       integer, intent(out)                  :: info
+     end subroutine psb_dbjacaply
+  end interface
+  
   name='psb_dbaseprcaply'
   info = 0
   call psb_erractionsave(err_act)
@@ -161,6 +204,7 @@ subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
 
   case(bja_)
 
+     write(0,*)'calling bja'
     call psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
     if(info.ne.0) then
        info=4010
@@ -330,6 +374,8 @@ subroutine psb_dbjacaply(prec,x,beta,y,desc_data,trans,work,info)
   real(kind(1.d0)), parameter       :: one=1.d0, zero=0.d0
   external mpi_wtime
   character(len=20)   :: name, ch_err
+  write(0,*)'inside bja'
+
   name='psb_dbjacaply'
   info = 0
   call psb_erractionsave(err_act)
@@ -543,6 +589,21 @@ subroutine psb_dmlprcaply(baseprecv,x,beta,y,desc_data,trans,work,info)
   integer      :: ismth
   external mpi_wtime
   character(len=20)   :: name, ch_err
+
+  interface
+     subroutine psb_dbaseprcaply(prec,x,beta,y,desc_data,trans,work,info)
+       use psb_descriptor_type
+       use psb_prec_type
+       type(psb_desc_type),intent(in)    :: desc_data
+       type(psb_dbase_prec), intent(in)  :: prec
+       real(kind(0.d0)),intent(inout)    :: x(:), y(:)
+       real(kind(0.d0)),intent(in)       :: beta
+       character(len=1)                  :: trans
+       real(kind(0.d0)),target           :: work(:)
+       integer, intent(out)              :: info
+     end subroutine psb_dbaseprcaply
+  end interface
+
   name='psb_dmlprcaply'
   info = 0
   call psb_erractionsave(err_act)

src/psblas/Makefile

@@ -21,6 +21,6 @@ veryclean: clean
 	/bin/rm -f $(LIBNAME)
 
 clean: 
-	/bin/rm -f $(F90_PSDOBJS) $(LOCAL_MODS)
+	/bin/rm -f $(OBJS) $(LOCAL_MODS)
 
 veryclean: clean

src/psblas/psb_dspmm.f90

@@ -419,6 +419,7 @@ subroutine  psb_dspmv(alpha,a,x,beta,y,desc_a,info,&
   iy = 1
   jy = 1
   ik = 1
+  ib = 1
 
   if (present(doswap)) then
      idoswap = doswap

src/serial/coo/dcoomm.f

@@ -22,7 +22,7 @@ C     .. Local Scalars ..
 
 
 C     .. External Subroutines ..
-      EXTERNAL          DCOOMV, XSPERR
+      EXTERNAL          DCOOMV
 C     .. Executable Statements ..
 C
 C

src/serial/coo/dcoosm.f

@@ -11,7 +11,6 @@
       CHARACTER         DESCRA*11
       INTEGER           I, K, ERR_ACT
       CHARACTER         DIAG, UPLO
-      EXTERNAL          XERBLA
       INTRINSIC         DBLE, IDINT
       CHARACTER*20      NAME
 

src/serial/csr/dcsrck.f

@@ -68,8 +68,6 @@ C     .. Array Arguments ..
       CHARACTER        DESCRA*11
 C     .. Local Scalars ..
       INTEGER          I, J, nrow, nind
-C     .. External Subroutines ..
-      EXTERNAL          XERBLA
 C
 C     .. Executable Statements ..
 C

src/serial/f77/dcsmm.f

@@ -180,7 +180,7 @@ C     .. Local Array..
       DOUBLE PRECISION  REAL_VAL(5)
       CHARACTER*30      STRINGS(2)
 C     .. External Subroutines ..
-      EXTERNAL          DSWMM, DLPUPD, DSCAL, XERBLA
+      EXTERNAL          DSWMM, DLPUPD, DSCAL
 C     .. Intrinsic Functions ..
       INTRINSIC         DBLE, IDINT
       

src/serial/f77/dcsrp.f

@@ -99,7 +99,7 @@ C     .. Array Arguments ..
       INTEGER          IA1(*), IA2(*), INFOA(*), P(*), INT_VAL(5)
       CHARACTER        DESCRA*11, FIDA*5
 C     .. External Subroutines ..
-      EXTERNAL          DCSRRP, XERBLA
+      EXTERNAL          DCSRRP
       logical          debug
       parameter        (debug=.false.)
 

src/serial/f77/dcssm.f

@@ -188,7 +188,7 @@ C     .. Parameters ..
       LOGICAL           DEBUG
       PARAMETER         (DEBUG=.FALSE.)
 C     .. External Subroutines ..
-      EXTERNAL         DSWSM, DLPUPD, XERBLA
+      EXTERNAL         DSWSM, DLPUPD
 C     .. Intrinsic Functions ..
       INTRINSIC        DBLE, IDINT
 C     .. Executable Statements ..

src/serial/psb_cest.f90

@@ -19,7 +19,7 @@ subroutine psb_cest(afmt, nnz, lia1, lia2, lar, up, info)
      afmt = psb_fidef_
   endif
 
-  if (up.eq.'y') then
+  if ((up.eq.'y').or.(up.eq.'Y')) then
      if (afmt.eq.'JAD') then 
         lia1 = 2*(nnz + nnz/5) +1000
         lia2 = 2*(nnz + nnz/5) +1000
@@ -38,7 +38,7 @@ subroutine psb_cest(afmt, nnz, lia1, lia2, lar, up, info)
         goto 9999
      endif
 
-  else if (up.eq.'n') then
+  else if ((up.eq.'n').or.(up.eq.'N')) then
 
      if (afmt.eq.'JAD') then 
         lia1 = nnz + nnz/5

src/tools/psb_dallc.f90

@@ -34,6 +34,7 @@ subroutine psb_dalloc(m, n, x, desc_a, info, js)
   integer, allocatable:: prc_v(:)
   character(len=20)   :: name, ch_err
 
+  name='psb_dallc'
   info=0
   err=0
   int_err(1)=0
@@ -193,6 +194,7 @@ subroutine psb_dallocv(m, x, desc_a,info)
   character(len=20)   :: name, ch_err
 
   info=0
+  name='psb_dallcv'
   call psb_erractionsave(err_act)
    
   icontxt=desc_a%matrix_data(psb_ctxt_)

test/pargen/RUNS/ppde.inp

@@ -1,11 +1,11 @@
 7                      Number of entries below this
 BICGSTAB               Iterative method BICGSTAB CGS  BICG BICGSTABL
-ILU                    Preconditioner ILU DIAGSC NONE 
-SSR                    A Storage format CSR COO JAD 
+NONE                   Preconditioner ILU DIAGSC NONE 
+CSR                    A Storage format CSR COO JAD 
 20                     Domain size (acutal sistem is this**3)
 1                      Stopping criterion
 080                    MAXIT
-00                     ITRACE
+-1                     ITRACE
 02                     ML
 
 

test/pargen/ppde90.f90

@@ -184,7 +184,7 @@ program pde90
   !
   ! iterative method parameters 
   !
-  write(*,*) 'calling iterative method', size(b),ml
+  write(*,*) 'calling iterative method', a%ia2(7999:8001)
   call blacs_barrier(icontxt,'ALL')
   t1 = mpi_wtime()  
   eps   = 1.d-9
@@ -454,12 +454,12 @@ contains
     nnz = ((n*9)/(nprow*npcol))
     write(*,*) 'size: n ',n
     call psb_dscall(n,n,parts,icontxt,desc_a,info)
-    write(*,*) 'allocating a : nnz',nnz
+    write(*,*) 'allocating a : nnz',nnz, info
     call psb_spalloc(a,desc_a,info,nnz=nnz)
     ! define  rhs from boundary conditions; also build initial guess 
-    write(*,*) 'allocating b'
+    write(*,*) 'allocating b', info
     call psb_alloc(n,b,desc_a,info)
-    write(*,*) 'allocating t'
+    write(*,*) 'allocating t', info
     call psb_alloc(n,t,desc_a,info)
     if(info.ne.0) then
        info=4010