Added tests

krylov/psb_ckrylovsubspace_mod.F90

@@ -44,6 +44,8 @@ module psb_ckrylovsubspace_mod
   use psb_util_mod
   use psb_krylov_mod
   implicit none
+  private
+  public psb_cpolkrylov
 
   type :: psb_cpolkrylov
     type(psb_c_vect_type), allocatable, dimension(:) :: v
@@ -180,7 +182,8 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_) :: err_act, info
     character(len=20) :: name, ch_err
-    real(psb_spk_) :: nrm0,scal
+    real(psb_spk_) :: nrm0
+    complex(psb_spk_) :: scal
 
     info = psb_success_
     name = 'psb_carnoldi_kryl'
@@ -251,7 +254,8 @@ contains
         goto 9999
       end if
       scal = cone/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      ! call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_geaxpby(scal,kryl%v(i1),czero,kryl%v(i1),desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -295,7 +299,7 @@ contains
     call psb_info(ctxt,iam,np)
 
     if (iam == psb_root_) then
-      call mm_array_write(kryl%h,"Projected Matrix",info,filename=filename//"_h")
+      call mm_array_write(kryl%h,"Projected Matrix",info,filename=trim(filename)//"_h")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -315,7 +319,7 @@ contains
       vglobal(:,i) = w
     end do
     if (iam == psb_root_) then
-      call mm_array_write(vglobal,"Krylov basis",info,filename=filename//"_v")
+      call mm_array_write(vglobal,"Krylov basis",info,filename=trim(filename)//"_v")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

krylov/psb_dkrylovsubspace_mod.F90

@@ -44,6 +44,8 @@ module psb_dkrylovsubspace_mod
   use psb_util_mod
   use psb_krylov_mod
   implicit none
+  private
+  public psb_dpolkrylov
 
   type :: psb_dpolkrylov
     type(psb_d_vect_type), allocatable, dimension(:) :: v
@@ -180,7 +182,8 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_) :: err_act, info
     character(len=20) :: name, ch_err
-    real(psb_dpk_) :: nrm0,scal
+    real(psb_dpk_) :: nrm0
+    real(psb_dpk_) :: scal
 
     info = psb_success_
     name = 'psb_darnoldi_kryl'
@@ -251,7 +254,8 @@ contains
         goto 9999
       end if
       scal = done/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      ! call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_geaxpby(scal,kryl%v(i1),dzero,kryl%v(i1),desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -295,7 +299,7 @@ contains
     call psb_info(ctxt,iam,np)
 
     if (iam == psb_root_) then
-      call mm_array_write(kryl%h,"Projected Matrix",info,filename=filename//"_h")
+      call mm_array_write(kryl%h,"Projected Matrix",info,filename=trim(filename)//"_h")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -315,7 +319,7 @@ contains
       vglobal(:,i) = w
     end do
     if (iam == psb_root_) then
-      call mm_array_write(vglobal,"Krylov basis",info,filename=filename//"_v")
+      call mm_array_write(vglobal,"Krylov basis",info,filename=trim(filename)//"_v")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

krylov/psb_skrylovsubspace_mod.F90

@@ -44,6 +44,8 @@ module psb_skrylovsubspace_mod
   use psb_util_mod
   use psb_krylov_mod
   implicit none
+  private
+  public psb_spolkrylov
 
   type :: psb_spolkrylov
     type(psb_s_vect_type), allocatable, dimension(:) :: v
@@ -180,7 +182,8 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_) :: err_act, info
     character(len=20) :: name, ch_err
-    real(psb_spk_) :: nrm0,scal
+    real(psb_spk_) :: nrm0
+    real(psb_spk_) :: scal
 
     info = psb_success_
     name = 'psb_sarnoldi_kryl'
@@ -251,7 +254,8 @@ contains
         goto 9999
       end if
       scal = sone/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      ! call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_geaxpby(scal,kryl%v(i1),szero,kryl%v(i1),desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -295,7 +299,7 @@ contains
     call psb_info(ctxt,iam,np)
 
     if (iam == psb_root_) then
-      call mm_array_write(kryl%h,"Projected Matrix",info,filename=filename//"_h")
+      call mm_array_write(kryl%h,"Projected Matrix",info,filename=trim(filename)//"_h")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -315,7 +319,7 @@ contains
       vglobal(:,i) = w
     end do
     if (iam == psb_root_) then
-      call mm_array_write(vglobal,"Krylov basis",info,filename=filename//"_v")
+      call mm_array_write(vglobal,"Krylov basis",info,filename=trim(filename)//"_v")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

krylov/psb_zkrylovsubspace_mod.F90

@@ -44,6 +44,8 @@ module psb_zkrylovsubspace_mod
   use psb_util_mod
   use psb_krylov_mod
   implicit none
+  private
+  public psb_zpolkrylov
 
   type :: psb_zpolkrylov
     type(psb_z_vect_type), allocatable, dimension(:) :: v
@@ -180,7 +182,8 @@ contains
     type(psb_ctxt_type) :: ctxt
     integer(psb_ipk_) :: err_act, info
     character(len=20) :: name, ch_err
-    real(psb_dpk_) :: nrm0,scal
+    real(psb_dpk_) :: nrm0
+    complex(psb_dpk_) :: scal
 
     info = psb_success_
     name = 'psb_zarnoldi_kryl'
@@ -251,7 +254,8 @@ contains
         goto 9999
       end if
       scal = zone/kryl%h(i1,i)
-      call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      ! call psb_gescal(kryl%v(i1),scal,kryl%v(i1),desc_a,info)
+      call psb_geaxpby(scal,kryl%v(i1),zzero,kryl%v(i1),desc_a,info)
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -295,7 +299,7 @@ contains
     call psb_info(ctxt,iam,np)
 
     if (iam == psb_root_) then
-      call mm_array_write(kryl%h,"Projected Matrix",info,filename=filename//"_h")
+      call mm_array_write(kryl%h,"Projected Matrix",info,filename=trim(filename)//"_h")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)
@@ -315,7 +319,7 @@ contains
       vglobal(:,i) = w
     end do
     if (iam == psb_root_) then
-      call mm_array_write(vglobal,"Krylov basis",info,filename=filename//"_v")
+      call mm_array_write(vglobal,"Krylov basis",info,filename=trim(filename)//"_v")
       if (info /= psb_success_) then
         info=psb_err_from_subroutine_non_
         call psb_errpush(info,name)

test/krylovspace/Makefile

@@ -0,0 +1,52 @@
+INSTALLDIR=../..
+INCDIR=$(INSTALLDIR)/include/
+MODDIR=$(INSTALLDIR)/modules/
+include $(INCDIR)/Make.inc.psblas
+#
+# Libraries used
+#
+LIBDIR=$(INSTALLDIR)/lib/
+PSBLAS_LIB= -L$(LIBDIR) -lpsb_util -lpsb_krylov -lpsb_prec -lpsb_base
+LDLIBS=$(PSBLDLIBS)
+
+FINCLUDES=$(FMFLAG)$(MODDIR) $(FMFLAG).
+
+SFOBJS=getp.o  psb_sf_sample.o   
+DFOBJS=getp.o  psb_df_sample.o   
+CFOBJS=getp.o  psb_cf_sample.o   
+ZFOBJS=getp.o  psb_zf_sample.o   
+
+EXEDIR=./runs
+
+all: runsd psb_sf_sample psb_df_sample psb_cf_sample psb_zf_sample 
+
+runsd:
+	(if test ! -d runs ; then mkdir runs; fi)
+
+psb_sf_sample.o psb_df_sample.o psb_cf_sample.o psb_zf_sample.o: getp.o
+
+psb_sf_sample: $(SFOBJS)
+	$(FLINK) $(LOPT) $(SFOBJS) -o psb_sf_sample $(PSBLAS_LIB) $(LDLIBS) 
+	/bin/mv psb_sf_sample $(EXEDIR) 
+psb_df_sample: $(DFOBJS)
+	$(FLINK) $(LOPT) $(DFOBJS) -o psb_df_sample $(PSBLAS_LIB) $(LDLIBS) 
+	/bin/mv psb_df_sample $(EXEDIR) 
+psb_cf_sample: $(CFOBJS)
+	$(FLINK) $(LOPT) $(CFOBJS) -o psb_cf_sample $(PSBLAS_LIB) $(LDLIBS)
+	/bin/mv psb_cf_sample $(EXEDIR) 
+psb_zf_sample: $(ZFOBJS)
+	$(FLINK) $(LOPT) $(ZFOBJS) -o psb_zf_sample $(PSBLAS_LIB) $(LDLIBS)
+	/bin/mv psb_zf_sample $(EXEDIR) 
+
+.f90.o:
+	$(MPFC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
+
+clean: 
+	/bin/rm -f $(DFOBJS) $(ZFOBJS) $(SFOBJS) $(CFOBJS)\
+        *$(.mod) $(EXEDIR)/psb_*f_sample 
+
+lib:
+	(cd ../../; make library)
+verycleanlib:
+	(cd ../../; make veryclean)
+

test/krylovspace/getp.f90

@@ -0,0 +1,281 @@
+!   
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone    
+!        Alfredo Buttari      
+!   
+!    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 getp
+  interface get_parms
+    module procedure get_dparms, get_sparms
+  end interface
+
+contains
+  !
+  ! Get iteration parameters from the command line
+  !
+  subroutine  get_dparms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,&
+       & afmt,istopc,itmax,itrace,irst,eps)
+    use psb_base_mod
+    type(psb_ctxt_type) :: ctxt
+    character(len=2)  :: filefmt
+    character(len=40) :: kmethd, mtrx_file, rhs_file, ptype
+    character(len=20) :: part
+    integer(psb_ipk_) :: iret, istopc,itmax,itrace,irst
+    character(len=40) :: charbuf
+    real(psb_dpk_) :: eps
+    character    :: afmt*5
+    integer(psb_ipk_) :: np, iam
+    integer(psb_ipk_) :: inparms(40), ip, inp_unit
+    character(len=1024)   :: filename 
+
+    call psb_info(ctxt,iam,np)
+    if (iam == 0) then
+      if (command_argument_count()>0) then
+        call get_command_argument(1,filename)
+        inp_unit = 30
+        open(inp_unit,file=filename,action='read',iostat=info)
+        if (info /= 0) then
+          write(psb_err_unit,*) 'Could not open file ',filename,' for input'
+          call psb_abort(ctxt)
+          stop
+        else
+          write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
+        end if
+      else
+        inp_unit=psb_inp_unit
+      end if
+      ! Read Input Parameters
+      read(inp_unit,*) ip
+      if (ip >= 5) then
+        read(inp_unit,*) mtrx_file
+        read(inp_unit,*) rhs_file
+        read(inp_unit,*) filefmt
+        read(inp_unit,*) kmethd
+        read(inp_unit,*) ptype
+        read(inp_unit,*) afmt
+        read(inp_unit,*) part
+
+
+        call psb_bcast(ctxt,mtrx_file)
+        call psb_bcast(ctxt,rhs_file)
+        call psb_bcast(ctxt,filefmt)
+        call psb_bcast(ctxt,kmethd)
+        call psb_bcast(ctxt,ptype)
+        call psb_bcast(ctxt,afmt)
+        call psb_bcast(ctxt,part)
+
+        if (ip >= 7) then
+          read(inp_unit,*) istopc
+        else
+          istopc=1        
+        endif
+        if (ip >= 8) then
+          read(inp_unit,*) itmax
+        else
+          itmax=500
+        endif
+        if (ip >= 9) then
+          read(inp_unit,*) itrace
+        else
+          itrace=-1
+        endif
+        if (ip >= 10) then
+          read(inp_unit,*) irst
+        else
+          irst  = 1
+        endif
+        if (ip >= 11) then
+          read(inp_unit,*) eps
+        else
+          eps=1.d-6
+        endif
+        inparms(1) = istopc
+        inparms(2) = itmax
+        inparms(3) = itrace
+        inparms(4) = irst
+        call psb_bcast(ctxt,inparms(1:4))
+        call psb_bcast(ctxt,eps)
+
+        write(psb_out_unit,'("Solving matrix       : ",a)')  mtrx_file      
+        write(psb_out_unit,'("Number of processors : ",i3)') np
+        write(psb_out_unit,'("Data distribution    : ",a)') part
+        write(psb_out_unit,'("Iterative method     : ",a)')  kmethd
+        write(psb_out_unit,'("Preconditioner       : ",a)')  ptype
+        write(psb_out_unit,'("Restart parameter    : ",i2)') irst
+        write(psb_out_unit,'("Storage format       : ",a)')  afmt(1:3)
+        write(psb_out_unit,'(" ")')
+      else
+        write(psb_err_unit,*) 'Wrong format for input file'
+        call psb_abort(ctxt)
+        stop 1
+      end if
+      if (inp_unit /= psb_inp_unit) then
+        close(inp_unit)
+      end if
+    else
+      ! Receive Parameters
+      call psb_bcast(ctxt,mtrx_file)
+      call psb_bcast(ctxt,rhs_file)
+      call psb_bcast(ctxt,filefmt)
+      call psb_bcast(ctxt,kmethd)
+      call psb_bcast(ctxt,ptype)
+      call psb_bcast(ctxt,afmt)
+      call psb_bcast(ctxt,part)
+
+      call psb_bcast(ctxt,inparms(1:4))
+      istopc =  inparms(1) 
+      itmax  =  inparms(2) 
+      itrace =  inparms(3) 
+      irst   =  inparms(4) 
+      call psb_bcast(ctxt,eps)
+
+    end if
+
+  end subroutine get_dparms
+  
+  subroutine  get_sparms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,part,&
+       & afmt,istopc,itmax,itrace,irst,eps)
+    use psb_base_mod
+    type(psb_ctxt_type) :: ctxt
+    character(len=2)  :: filefmt
+    character(len=40) :: kmethd, mtrx_file, rhs_file, ptype
+    character(len=20) :: part
+    integer(psb_ipk_) :: iret, istopc,itmax,itrace,irst
+    character(len=40) :: charbuf
+    real(psb_spk_) :: eps
+    character    :: afmt*5
+    integer(psb_ipk_) :: np, iam
+    integer(psb_ipk_) :: inparms(40), ip, inp_unit
+    character(len=1024)   :: filename
+
+    call psb_info(ctxt,iam,np)
+    if (iam == 0) then
+      if (command_argument_count()>0) then
+        call get_command_argument(1,filename)
+        inp_unit = 30
+        open(inp_unit,file=filename,action='read',iostat=info)
+        if (info /= 0) then
+          write(psb_err_unit,*) 'Could not open file ',filename,' for input'
+          call psb_abort(ctxt)
+          stop
+        else
+          write(psb_err_unit,*) 'Opened file ',trim(filename),' for input'
+        end if
+      else
+        inp_unit=inp_unit
+      end if
+      ! Read Input Parameters
+      read(inp_unit,*) ip
+      if (ip >= 5) then
+        read(inp_unit,*) mtrx_file
+        read(inp_unit,*) rhs_file
+        read(inp_unit,*) filefmt
+        read(inp_unit,*) kmethd
+        read(inp_unit,*) ptype
+        read(inp_unit,*) afmt
+        read(inp_unit,*) ipart
+
+
+        call psb_bcast(ctxt,mtrx_file)
+        call psb_bcast(ctxt,rhs_file)
+        call psb_bcast(ctxt,filefmt)
+        call psb_bcast(ctxt,kmethd)
+        call psb_bcast(ctxt,ptype)
+        call psb_bcast(ctxt,afmt)
+        call psb_bcast(ctxt,part)
+
+        if (ip >= 7) then
+          read(inp_unit,*) istopc
+        else
+          istopc=1        
+        endif
+        if (ip >= 8) then
+          read(inp_unit,*) itmax
+        else
+          itmax=500
+        endif
+        if (ip >= 9) then
+          read(inp_unit,*) itrace
+        else
+          itrace=-1
+        endif
+        if (ip >= 10) then
+          read(inp_unit,*) irst
+        else
+          irst  = 1
+        endif
+        if (ip >= 11) then
+          read(inp_unit,*) eps
+        else
+          eps=1.d-6
+        endif
+        inparms(1) = istopc
+        inparms(2) = itmax
+        inparms(3) = itrace
+        inparms(4) = irst
+        call psb_bcast(ctxt,inparms(1:4))
+        call psb_bcast(ctxt,eps)
+
+        write(psb_out_unit,'("Solving matrix       : ",a)')  mtrx_file      
+        write(psb_out_unit,'("Number of processors : ",i3)') np
+        write(psb_out_unit,'("Data distribution    : ",a)') part
+        write(psb_out_unit,'("Iterative method     : ",a)')  kmethd
+        write(psb_out_unit,'("Preconditioner       : ",a)')  ptype
+        write(psb_out_unit,'("Restart parameter    : ",i2)') irst
+        write(psb_out_unit,'("Storage format       : ",a)')  afmt(1:3)
+        write(psb_out_unit,'(" ")')
+      else
+        write(psb_err_unit,*) 'Wrong format for input file'
+        call psb_abort(ctxt)
+        stop 1
+      end if
+      if (inp_unit /= psb_inp_unit) then
+        close(inp_unit)
+      end if
+    else
+      ! Receive Parameters
+      call psb_bcast(ctxt,mtrx_file)
+      call psb_bcast(ctxt,rhs_file)
+      call psb_bcast(ctxt,filefmt)
+      call psb_bcast(ctxt,kmethd)
+      call psb_bcast(ctxt,ptype)
+      call psb_bcast(ctxt,afmt)
+      call psb_bcast(ctxt,part)
+
+      call psb_bcast(ctxt,inparms(1:4))
+      istopc =  inparms(1) 
+      itmax  =  inparms(2) 
+      itrace =  inparms(3) 
+      irst   =  inparms(4) 
+      call psb_bcast(ctxt,eps)
+
+    end if
+
+  end subroutine get_sparms
+
+end module getp

test/krylovspace/psb_cf_sample.f90

@@ -0,0 +1,250 @@
+!
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone
+!        Alfredo Buttari
+!
+!    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.
+!
+!
+program psb_ckrylov_sample
+  use psb_base_mod
+  use psb_prec_mod
+  use psb_krylov_mod
+  use psb_util_mod
+  use psb_ckrylovsubspace_mod
+  use getp
+  implicit none
+
+  ! input parameters
+  character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
+
+  ! sparse matrices
+  type(psb_cspmat_type)  :: a
+  type(psb_lcspmat_type) :: aux_a
+  ! Krylov space
+  type(psb_cpolkrylov) :: kryl
+
+  ! dense matrices
+  complex(psb_spk_), allocatable, target ::  aux_b(:,:), d(:)
+  complex(psb_spk_), allocatable , save  :: x_col_glob(:), r_col_glob(:)
+  complex(psb_spk_), pointer  :: b_col_glob(:)
+  type(psb_c_vect_type)    :: b_col, x_col, r_col
+
+  ! communications data structure
+  type(psb_desc_type):: desc_a
+
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: iam, np
+  integer(psb_lpk_) :: lnp
+  ! solver paramters
+  integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
+       & methd, istopc, irst
+  integer(psb_epk_) :: amatsize, descsize
+  real(psb_spk_)   :: err, eps, cond
+
+  character(len=5)   :: afmt
+  character(len=20)  :: name, part
+  character(len=2)   :: filefmt
+  integer(psb_ipk_), parameter :: iunit=12
+  integer(psb_ipk_) :: iparm(20)
+
+  ! other variables
+  integer(psb_ipk_) :: i,info,j,m_problem, err_act
+  integer(psb_ipk_) :: internal, m,ii,nnzero
+  real(psb_dpk_) :: t1, t2, tprec
+  real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp
+  integer(psb_ipk_) :: nrhs, nrow, n_row, dim, ne, nv
+  integer(psb_ipk_), allocatable :: ivg(:)
+  integer(psb_ipk_), allocatable :: ipv(:)
+  character(len=40)  :: fname, fnout
+
+
+  call psb_init(ctxt)
+  call psb_info(ctxt,iam,np)
+
+  if (iam < 0) then
+    ! This should not happen, but just in case
+    call psb_exit(ctxt)
+    stop
+  endif
+
+
+  name='psb_ckrylov_sample'
+  if(psb_errstatus_fatal()) goto 9999
+  info=psb_success_
+  call psb_set_errverbosity(itwo)
+  !
+  ! Hello world
+  !
+  if (iam == psb_root_) then
+    write(*,*) 'Welcome to PSBLAS version: ',psb_version_string_
+    write(*,*) 'This is the ',trim(name),' sample program'
+  end if
+  !
+  !  get parameters
+  !
+  call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
+       & part,afmt,istopc,itmax,itrace,irst,eps)
+
+  call psb_barrier(ctxt)
+  t1 = psb_wtime()
+  ! read the input matrix to be processed and (possibly) the rhs
+  nrhs = 1
+
+  if (iam == psb_root_) then
+    select case(psb_toupper(filefmt))
+    case('MM')
+      ! For Matrix Market we have an input file for the matrix
+      ! and an (optional) second file for the RHS.
+      call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
+      if (info == psb_success_) then
+        if (rhs_file /= 'NONE') then
+          call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file)
+        end if
+      end if
+
+    case ('HB')
+      ! For Harwell-Boeing we have a single file which may or may not
+      ! contain an RHS.
+      call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
+
+    case default
+      info = -1
+      write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
+    end select
+    if (info /= psb_success_) then
+      write(psb_err_unit,*) 'Error while reading input matrix '
+      call psb_abort(ctxt)
+    end if
+
+    m_problem = aux_a%get_nrows()
+    call psb_bcast(ctxt,m_problem)
+
+    ! At this point aux_b may still be unallocated
+    if (size(aux_b,dim=1) == m_problem) then
+      ! if any rhs were present, broadcast the first one
+      write(psb_err_unit,'("Ok, got an rhs ")')
+      b_col_glob =>aux_b(:,1)
+    else
+      write(psb_out_unit,'("Generating an rhs...")')
+      write(psb_out_unit,'(" ")')
+      call psb_realloc(m_problem,1,aux_b,ircode)
+      if (ircode /= 0) then
+         call psb_errpush(psb_err_alloc_dealloc_,name)
+         goto 9999
+      endif
+
+      b_col_glob => aux_b(:,1)
+      do i=1, m_problem
+         b_col_glob(i) = cone
+      enddo
+    endif
+
+  else
+    call psb_bcast(ctxt,m_problem)
+
+  end if
+
+  ! switch over different partition types
+  select case(psb_toupper(part))
+  case('BLOCK')
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+
+  case('GRAPH')
+    if (iam == psb_root_) then
+      write(psb_out_unit,'("Partition type: graph vector")')
+      write(psb_out_unit,'(" ")')
+      !      write(psb_err_unit,'("Build type: graph")')
+      call aux_a%cscnv(info,type='csr')
+      lnp = np
+      call build_mtpart(aux_a,lnp)
+
+    endif
+    call psb_barrier(ctxt)
+    call distr_mtpart(psb_root_,ctxt)
+    call getv_mtpart(ivg)
+    call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
+
+  case default
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+  end select
+
+  call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
+  call psb_geall(x_col,desc_a,info)
+  call x_col%zero()
+  call psb_geasb(x_col,desc_a,info)
+  call psb_geall(r_col,desc_a,info)
+  call r_col%zero()
+  call psb_geasb(r_col,desc_a,info)
+  t2 = psb_wtime() - t1
+
+
+  call psb_amx(ctxt, t2)
+
+  if (iam == psb_root_) then
+     write(psb_out_unit,'(" ")')
+     write(psb_out_unit,'("Time to read and partition matrix : ",es12.5)')t2
+     write(psb_out_unit,'(" ")')
+  end if
+
+  ! Allocate the Krylov space
+  call kryl%allocate(desc_a,itmax,info)
+  ! Build
+  call kryl%arnoldi(a,desc_a,b_col,istopc)
+  ! Write
+  call kryl%write(desc_a,mtrx_file)
+
+  amatsize = a%sizeof()
+  descsize = desc_a%sizeof()
+  call psb_sum(ctxt,amatsize)
+  call psb_sum(ctxt,descsize)
+  if (iam == psb_root_) then
+    write(psb_out_unit,'("Matrix: ",a)')mtrx_file
+    write(psb_out_unit,'("Computed space on ",i8," processors")')np
+    write(psb_out_unit,'("Time to build space      : ",es12.5)')t2
+    write(psb_out_unit,'("Time per iteration       : ",es12.5)')t2/(iter)
+    write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
+    write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
+    write(psb_out_unit,'("Storage format for A              : ",a)')&
+         &  a%get_fmt()
+    write(psb_out_unit,'("Storage format for DESC_A         : ",a)')&
+         &  desc_a%get_fmt()
+  end if
+
+  call psb_gefree(b_col, desc_a,info)
+  call psb_gefree(x_col, desc_a,info)
+  call psb_spfree(a, desc_a,info)
+  call kryl%free(desc_a,info)
+  call psb_cdfree(desc_a,info)
+  call psb_exit(ctxt)
+  stop
+
+9999 call psb_error(ctxt)
+
+  stop
+end program psb_ckrylov_sample

test/krylovspace/psb_df_sample.f90

@@ -0,0 +1,250 @@
+!
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone
+!        Alfredo Buttari
+!
+!    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.
+!
+!
+program psb_dkrylov_sample
+  use psb_base_mod
+  use psb_prec_mod
+  use psb_krylov_mod
+  use psb_util_mod
+  use psb_dkrylovsubspace_mod
+  use getp
+  implicit none
+
+  ! input parameters
+  character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
+
+  ! sparse matrices
+  type(psb_dspmat_type)  :: a
+  type(psb_ldspmat_type) :: aux_a
+  ! Krylov space
+  type(psb_dpolkrylov) :: kryl
+
+  ! dense matrices
+  real(psb_dpk_), allocatable, target ::  aux_b(:,:), d(:)
+  real(psb_dpk_), allocatable , save  :: x_col_glob(:), r_col_glob(:)
+  real(psb_dpk_), pointer  :: b_col_glob(:)
+  type(psb_d_vect_type)    :: b_col, x_col, r_col
+
+  ! communications data structure
+  type(psb_desc_type):: desc_a
+
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: iam, np
+  integer(psb_lpk_) :: lnp
+  ! solver paramters
+  integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
+       & methd, istopc, irst
+  integer(psb_epk_) :: amatsize, descsize
+  real(psb_dpk_)   :: err, eps, cond
+
+  character(len=5)   :: afmt
+  character(len=20)  :: name, part
+  character(len=2)   :: filefmt
+  integer(psb_ipk_), parameter :: iunit=12
+  integer(psb_ipk_) :: iparm(20)
+
+  ! other variables
+  integer(psb_ipk_) :: i,info,j,m_problem, err_act
+  integer(psb_ipk_) :: internal, m,ii,nnzero
+  real(psb_dpk_) :: t1, t2, tprec
+  real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp
+  integer(psb_ipk_) :: nrhs, nrow, n_row, dim, ne, nv
+  integer(psb_ipk_), allocatable :: ivg(:)
+  integer(psb_ipk_), allocatable :: ipv(:)
+  character(len=40)  :: fname, fnout
+
+
+  call psb_init(ctxt)
+  call psb_info(ctxt,iam,np)
+
+  if (iam < 0) then
+    ! This should not happen, but just in case
+    call psb_exit(ctxt)
+    stop
+  endif
+
+
+  name='psb_dkrylov_sample'
+  if(psb_errstatus_fatal()) goto 9999
+  info=psb_success_
+  call psb_set_errverbosity(itwo)
+  !
+  ! Hello world
+  !
+  if (iam == psb_root_) then
+    write(*,*) 'Welcome to PSBLAS version: ',psb_version_string_
+    write(*,*) 'This is the ',trim(name),' sample program'
+  end if
+  !
+  !  get parameters
+  !
+  call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
+       & part,afmt,istopc,itmax,itrace,irst,eps)
+
+  call psb_barrier(ctxt)
+  t1 = psb_wtime()
+  ! read the input matrix to be processed and (possibly) the rhs
+  nrhs = 1
+
+  if (iam == psb_root_) then
+    select case(psb_toupper(filefmt))
+    case('MM')
+      ! For Matrix Market we have an input file for the matrix
+      ! and an (optional) second file for the RHS.
+      call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
+      if (info == psb_success_) then
+        if (rhs_file /= 'NONE') then
+          call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file)
+        end if
+      end if
+
+    case ('HB')
+      ! For Harwell-Boeing we have a single file which may or may not
+      ! contain an RHS.
+      call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
+
+    case default
+      info = -1
+      write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
+    end select
+    if (info /= psb_success_) then
+      write(psb_err_unit,*) 'Error while reading input matrix '
+      call psb_abort(ctxt)
+    end if
+
+    m_problem = aux_a%get_nrows()
+    call psb_bcast(ctxt,m_problem)
+
+    ! At this point aux_b may still be unallocated
+    if (size(aux_b,dim=1) == m_problem) then
+      ! if any rhs were present, broadcast the first one
+      write(psb_err_unit,'("Ok, got an rhs ")')
+      b_col_glob =>aux_b(:,1)
+    else
+      write(psb_out_unit,'("Generating an rhs...")')
+      write(psb_out_unit,'(" ")')
+      call psb_realloc(m_problem,1,aux_b,ircode)
+      if (ircode /= 0) then
+         call psb_errpush(psb_err_alloc_dealloc_,name)
+         goto 9999
+      endif
+
+      b_col_glob => aux_b(:,1)
+      do i=1, m_problem
+         b_col_glob(i) = done
+      enddo
+    endif
+
+  else
+    call psb_bcast(ctxt,m_problem)
+
+  end if
+
+  ! switch over different partition types
+  select case(psb_toupper(part))
+  case('BLOCK')
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+
+  case('GRAPH')
+    if (iam == psb_root_) then
+      write(psb_out_unit,'("Partition type: graph vector")')
+      write(psb_out_unit,'(" ")')
+      !      write(psb_err_unit,'("Build type: graph")')
+      call aux_a%cscnv(info,type='csr')
+      lnp = np
+      call build_mtpart(aux_a,lnp)
+
+    endif
+    call psb_barrier(ctxt)
+    call distr_mtpart(psb_root_,ctxt)
+    call getv_mtpart(ivg)
+    call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
+
+  case default
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+  end select
+
+  call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
+  call psb_geall(x_col,desc_a,info)
+  call x_col%zero()
+  call psb_geasb(x_col,desc_a,info)
+  call psb_geall(r_col,desc_a,info)
+  call r_col%zero()
+  call psb_geasb(r_col,desc_a,info)
+  t2 = psb_wtime() - t1
+
+
+  call psb_amx(ctxt, t2)
+
+  if (iam == psb_root_) then
+     write(psb_out_unit,'(" ")')
+     write(psb_out_unit,'("Time to read and partition matrix : ",es12.5)')t2
+     write(psb_out_unit,'(" ")')
+  end if
+
+  ! Allocate the Krylov space
+  call kryl%allocate(desc_a,itmax,info)
+  ! Build
+  call kryl%arnoldi(a,desc_a,b_col,istopc)
+  ! Write
+  call kryl%write(desc_a,mtrx_file)
+
+  amatsize = a%sizeof()
+  descsize = desc_a%sizeof()
+  call psb_sum(ctxt,amatsize)
+  call psb_sum(ctxt,descsize)
+  if (iam == psb_root_) then
+    write(psb_out_unit,'("Matrix: ",a)')mtrx_file
+    write(psb_out_unit,'("Computed space on ",i8," processors")')np
+    write(psb_out_unit,'("Time to build space      : ",es12.5)')t2
+    write(psb_out_unit,'("Time per iteration       : ",es12.5)')t2/(iter)
+    write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
+    write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
+    write(psb_out_unit,'("Storage format for A              : ",a)')&
+         &  a%get_fmt()
+    write(psb_out_unit,'("Storage format for DESC_A         : ",a)')&
+         &  desc_a%get_fmt()
+  end if
+
+  call psb_gefree(b_col, desc_a,info)
+  call psb_gefree(x_col, desc_a,info)
+  call psb_spfree(a, desc_a,info)
+  call kryl%free(desc_a,info)
+  call psb_cdfree(desc_a,info)
+  call psb_exit(ctxt)
+  stop
+
+9999 call psb_error(ctxt)
+
+  stop
+end program psb_dkrylov_sample

test/krylovspace/psb_sf_sample.f90

@@ -0,0 +1,250 @@
+!
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone
+!        Alfredo Buttari
+!
+!    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.
+!
+!
+program psb_skrylov_sample
+  use psb_base_mod
+  use psb_prec_mod
+  use psb_krylov_mod
+  use psb_util_mod
+  use psb_skrylovsubspace_mod
+  use getp
+  implicit none
+
+  ! input parameters
+  character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
+
+  ! sparse matrices
+  type(psb_sspmat_type)  :: a
+  type(psb_lsspmat_type) :: aux_a
+  ! Krylov space
+  type(psb_spolkrylov) :: kryl
+
+  ! dense matrices
+  real(psb_spk_), allocatable, target ::  aux_b(:,:), d(:)
+  real(psb_spk_), allocatable , save  :: x_col_glob(:), r_col_glob(:)
+  real(psb_spk_), pointer  :: b_col_glob(:)
+  type(psb_s_vect_type)    :: b_col, x_col, r_col
+
+  ! communications data structure
+  type(psb_desc_type):: desc_a
+
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: iam, np
+  integer(psb_lpk_) :: lnp
+  ! solver paramters
+  integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
+       & methd, istopc, irst
+  integer(psb_epk_) :: amatsize, descsize
+  real(psb_spk_)   :: err, eps, cond
+
+  character(len=5)   :: afmt
+  character(len=20)  :: name, part
+  character(len=2)   :: filefmt
+  integer(psb_ipk_), parameter :: iunit=12
+  integer(psb_ipk_) :: iparm(20)
+
+  ! other variables
+  integer(psb_ipk_) :: i,info,j,m_problem, err_act
+  integer(psb_ipk_) :: internal, m,ii,nnzero
+  real(psb_dpk_) :: t1, t2, tprec
+  real(psb_spk_) :: r_amax, b_amax, scale,resmx,resmxp
+  integer(psb_ipk_) :: nrhs, nrow, n_row, dim, ne, nv
+  integer(psb_ipk_), allocatable :: ivg(:)
+  integer(psb_ipk_), allocatable :: ipv(:)
+  character(len=40)  :: fname, fnout
+
+
+  call psb_init(ctxt)
+  call psb_info(ctxt,iam,np)
+
+  if (iam < 0) then
+    ! This should not happen, but just in case
+    call psb_exit(ctxt)
+    stop
+  endif
+
+
+  name='psb_skrylov_sample'
+  if(psb_errstatus_fatal()) goto 9999
+  info=psb_success_
+  call psb_set_errverbosity(itwo)
+  !
+  ! Hello world
+  !
+  if (iam == psb_root_) then
+    write(*,*) 'Welcome to PSBLAS version: ',psb_version_string_
+    write(*,*) 'This is the ',trim(name),' sample program'
+  end if
+  !
+  !  get parameters
+  !
+  call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
+       & part,afmt,istopc,itmax,itrace,irst,eps)
+
+  call psb_barrier(ctxt)
+  t1 = psb_wtime()
+  ! read the input matrix to be processed and (possibly) the rhs
+  nrhs = 1
+
+  if (iam == psb_root_) then
+    select case(psb_toupper(filefmt))
+    case('MM')
+      ! For Matrix Market we have an input file for the matrix
+      ! and an (optional) second file for the RHS.
+      call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
+      if (info == psb_success_) then
+        if (rhs_file /= 'NONE') then
+          call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file)
+        end if
+      end if
+
+    case ('HB')
+      ! For Harwell-Boeing we have a single file which may or may not
+      ! contain an RHS.
+      call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
+
+    case default
+      info = -1
+      write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
+    end select
+    if (info /= psb_success_) then
+      write(psb_err_unit,*) 'Error while reading input matrix '
+      call psb_abort(ctxt)
+    end if
+
+    m_problem = aux_a%get_nrows()
+    call psb_bcast(ctxt,m_problem)
+
+    ! At this point aux_b may still be unallocated
+    if (size(aux_b,dim=1) == m_problem) then
+      ! if any rhs were present, broadcast the first one
+      write(psb_err_unit,'("Ok, got an rhs ")')
+      b_col_glob =>aux_b(:,1)
+    else
+      write(psb_out_unit,'("Generating an rhs...")')
+      write(psb_out_unit,'(" ")')
+      call psb_realloc(m_problem,1,aux_b,ircode)
+      if (ircode /= 0) then
+         call psb_errpush(psb_err_alloc_dealloc_,name)
+         goto 9999
+      endif
+
+      b_col_glob => aux_b(:,1)
+      do i=1, m_problem
+         b_col_glob(i) = sone
+      enddo
+    endif
+
+  else
+    call psb_bcast(ctxt,m_problem)
+
+  end if
+
+  ! switch over different partition types
+  select case(psb_toupper(part))
+  case('BLOCK')
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+
+  case('GRAPH')
+    if (iam == psb_root_) then
+      write(psb_out_unit,'("Partition type: graph vector")')
+      write(psb_out_unit,'(" ")')
+      !      write(psb_err_unit,'("Build type: graph")')
+      call aux_a%cscnv(info,type='csr')
+      lnp = np
+      call build_mtpart(aux_a,lnp)
+
+    endif
+    call psb_barrier(ctxt)
+    call distr_mtpart(psb_root_,ctxt)
+    call getv_mtpart(ivg)
+    call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
+
+  case default
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+  end select
+
+  call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
+  call psb_geall(x_col,desc_a,info)
+  call x_col%zero()
+  call psb_geasb(x_col,desc_a,info)
+  call psb_geall(r_col,desc_a,info)
+  call r_col%zero()
+  call psb_geasb(r_col,desc_a,info)
+  t2 = psb_wtime() - t1
+
+
+  call psb_amx(ctxt, t2)
+
+  if (iam == psb_root_) then
+     write(psb_out_unit,'(" ")')
+     write(psb_out_unit,'("Time to read and partition matrix : ",es12.5)')t2
+     write(psb_out_unit,'(" ")')
+  end if
+
+  ! Allocate the Krylov space
+  call kryl%allocate(desc_a,itmax,info)
+  ! Build
+  call kryl%arnoldi(a,desc_a,b_col,istopc)
+  ! Write
+  call kryl%write(desc_a,mtrx_file)
+
+  amatsize = a%sizeof()
+  descsize = desc_a%sizeof()
+  call psb_sum(ctxt,amatsize)
+  call psb_sum(ctxt,descsize)
+  if (iam == psb_root_) then
+    write(psb_out_unit,'("Matrix: ",a)')mtrx_file
+    write(psb_out_unit,'("Computed space on ",i8," processors")')np
+    write(psb_out_unit,'("Time to build space      : ",es12.5)')t2
+    write(psb_out_unit,'("Time per iteration       : ",es12.5)')t2/(iter)
+    write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
+    write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
+    write(psb_out_unit,'("Storage format for A              : ",a)')&
+         &  a%get_fmt()
+    write(psb_out_unit,'("Storage format for DESC_A         : ",a)')&
+         &  desc_a%get_fmt()
+  end if
+
+  call psb_gefree(b_col, desc_a,info)
+  call psb_gefree(x_col, desc_a,info)
+  call psb_spfree(a, desc_a,info)
+  call kryl%free(desc_a,info)
+  call psb_cdfree(desc_a,info)
+  call psb_exit(ctxt)
+  stop
+
+9999 call psb_error(ctxt)
+
+  stop
+end program psb_skrylov_sample

test/krylovspace/psb_zf_sample.f90

@@ -0,0 +1,250 @@
+!
+!                Parallel Sparse BLAS  version 3.5
+!      (C) Copyright 2006-2018
+!        Salvatore Filippone
+!        Alfredo Buttari
+!
+!    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.
+!
+!
+program psb_zkrylov_sample
+  use psb_base_mod
+  use psb_prec_mod
+  use psb_krylov_mod
+  use psb_util_mod
+  use psb_zkrylovsubspace_mod
+  use getp
+  implicit none
+
+  ! input parameters
+  character(len=40) :: kmethd, ptype, mtrx_file, rhs_file
+
+  ! sparse matrices
+  type(psb_zspmat_type)  :: a
+  type(psb_lzspmat_type) :: aux_a
+  ! Krylov space
+  type(psb_zpolkrylov) :: kryl
+
+  ! dense matrices
+  complex(psb_dpk_), allocatable, target ::  aux_b(:,:), d(:)
+  complex(psb_dpk_), allocatable , save  :: x_col_glob(:), r_col_glob(:)
+  complex(psb_dpk_), pointer  :: b_col_glob(:)
+  type(psb_z_vect_type)    :: b_col, x_col, r_col
+
+  ! communications data structure
+  type(psb_desc_type):: desc_a
+
+  type(psb_ctxt_type) :: ctxt
+  integer(psb_ipk_) :: iam, np
+  integer(psb_lpk_) :: lnp
+  ! solver paramters
+  integer(psb_ipk_) :: iter, itmax, ierr, itrace, ircode,&
+       & methd, istopc, irst
+  integer(psb_epk_) :: amatsize, descsize
+  real(psb_dpk_)   :: err, eps, cond
+
+  character(len=5)   :: afmt
+  character(len=20)  :: name, part
+  character(len=2)   :: filefmt
+  integer(psb_ipk_), parameter :: iunit=12
+  integer(psb_ipk_) :: iparm(20)
+
+  ! other variables
+  integer(psb_ipk_) :: i,info,j,m_problem, err_act
+  integer(psb_ipk_) :: internal, m,ii,nnzero
+  real(psb_dpk_) :: t1, t2, tprec
+  real(psb_dpk_) :: r_amax, b_amax, scale,resmx,resmxp
+  integer(psb_ipk_) :: nrhs, nrow, n_row, dim, ne, nv
+  integer(psb_ipk_), allocatable :: ivg(:)
+  integer(psb_ipk_), allocatable :: ipv(:)
+  character(len=40)  :: fname, fnout
+
+
+  call psb_init(ctxt)
+  call psb_info(ctxt,iam,np)
+
+  if (iam < 0) then
+    ! This should not happen, but just in case
+    call psb_exit(ctxt)
+    stop
+  endif
+
+
+  name='psb_zkrylov_sample'
+  if(psb_errstatus_fatal()) goto 9999
+  info=psb_success_
+  call psb_set_errverbosity(itwo)
+  !
+  ! Hello world
+  !
+  if (iam == psb_root_) then
+    write(*,*) 'Welcome to PSBLAS version: ',psb_version_string_
+    write(*,*) 'This is the ',trim(name),' sample program'
+  end if
+  !
+  !  get parameters
+  !
+  call get_parms(ctxt,mtrx_file,rhs_file,filefmt,kmethd,ptype,&
+       & part,afmt,istopc,itmax,itrace,irst,eps)
+
+  call psb_barrier(ctxt)
+  t1 = psb_wtime()
+  ! read the input matrix to be processed and (possibly) the rhs
+  nrhs = 1
+
+  if (iam == psb_root_) then
+    select case(psb_toupper(filefmt))
+    case('MM')
+      ! For Matrix Market we have an input file for the matrix
+      ! and an (optional) second file for the RHS.
+      call mm_mat_read(aux_a,info,iunit=iunit,filename=mtrx_file)
+      if (info == psb_success_) then
+        if (rhs_file /= 'NONE') then
+          call mm_array_read(aux_b,info,iunit=iunit,filename=rhs_file)
+        end if
+      end if
+
+    case ('HB')
+      ! For Harwell-Boeing we have a single file which may or may not
+      ! contain an RHS.
+      call hb_read(aux_a,info,iunit=iunit,b=aux_b,filename=mtrx_file)
+
+    case default
+      info = -1
+      write(psb_err_unit,*) 'Wrong choice for fileformat ', filefmt
+    end select
+    if (info /= psb_success_) then
+      write(psb_err_unit,*) 'Error while reading input matrix '
+      call psb_abort(ctxt)
+    end if
+
+    m_problem = aux_a%get_nrows()
+    call psb_bcast(ctxt,m_problem)
+
+    ! At this point aux_b may still be unallocated
+    if (size(aux_b,dim=1) == m_problem) then
+      ! if any rhs were present, broadcast the first one
+      write(psb_err_unit,'("Ok, got an rhs ")')
+      b_col_glob =>aux_b(:,1)
+    else
+      write(psb_out_unit,'("Generating an rhs...")')
+      write(psb_out_unit,'(" ")')
+      call psb_realloc(m_problem,1,aux_b,ircode)
+      if (ircode /= 0) then
+         call psb_errpush(psb_err_alloc_dealloc_,name)
+         goto 9999
+      endif
+
+      b_col_glob => aux_b(:,1)
+      do i=1, m_problem
+         b_col_glob(i) = zone
+      enddo
+    endif
+
+  else
+    call psb_bcast(ctxt,m_problem)
+
+  end if
+
+  ! switch over different partition types
+  select case(psb_toupper(part))
+  case('BLOCK')
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+
+  case('GRAPH')
+    if (iam == psb_root_) then
+      write(psb_out_unit,'("Partition type: graph vector")')
+      write(psb_out_unit,'(" ")')
+      !      write(psb_err_unit,'("Build type: graph")')
+      call aux_a%cscnv(info,type='csr')
+      lnp = np
+      call build_mtpart(aux_a,lnp)
+
+    endif
+    call psb_barrier(ctxt)
+    call distr_mtpart(psb_root_,ctxt)
+    call getv_mtpart(ivg)
+    call psb_matdist(aux_a, a, ctxt,desc_a,info,fmt=afmt,vg=ivg)
+
+  case default
+    if (iam == psb_root_) write(psb_out_unit,'("Partition type: block")')
+    call psb_matdist(aux_a, a,  ctxt,desc_a,info,fmt=afmt,parts=part_block)
+  end select
+
+  call psb_scatter(b_col_glob,b_col,desc_a,info,root=psb_root_)
+  call psb_geall(x_col,desc_a,info)
+  call x_col%zero()
+  call psb_geasb(x_col,desc_a,info)
+  call psb_geall(r_col,desc_a,info)
+  call r_col%zero()
+  call psb_geasb(r_col,desc_a,info)
+  t2 = psb_wtime() - t1
+
+
+  call psb_amx(ctxt, t2)
+
+  if (iam == psb_root_) then
+     write(psb_out_unit,'(" ")')
+     write(psb_out_unit,'("Time to read and partition matrix : ",es12.5)')t2
+     write(psb_out_unit,'(" ")')
+  end if
+
+  ! Allocate the Krylov space
+  call kryl%allocate(desc_a,itmax,info)
+  ! Build
+  call kryl%arnoldi(a,desc_a,b_col,istopc)
+  ! Write
+  call kryl%write(desc_a,mtrx_file)
+
+  amatsize = a%sizeof()
+  descsize = desc_a%sizeof()
+  call psb_sum(ctxt,amatsize)
+  call psb_sum(ctxt,descsize)
+  if (iam == psb_root_) then
+    write(psb_out_unit,'("Matrix: ",a)')mtrx_file
+    write(psb_out_unit,'("Computed space on ",i8," processors")')np
+    write(psb_out_unit,'("Time to build space      : ",es12.5)')t2
+    write(psb_out_unit,'("Time per iteration       : ",es12.5)')t2/(iter)
+    write(psb_out_unit,'("Total memory occupation for A:      ",i12)')amatsize
+    write(psb_out_unit,'("Total memory occupation for DESC_A: ",i12)')descsize
+    write(psb_out_unit,'("Storage format for A              : ",a)')&
+         &  a%get_fmt()
+    write(psb_out_unit,'("Storage format for DESC_A         : ",a)')&
+         &  desc_a%get_fmt()
+  end if
+
+  call psb_gefree(b_col, desc_a,info)
+  call psb_gefree(x_col, desc_a,info)
+  call psb_spfree(a, desc_a,info)
+  call kryl%free(desc_a,info)
+  call psb_cdfree(desc_a,info)
+  call psb_exit(ctxt)
+  stop
+
+9999 call psb_error(ctxt)
+
+  stop
+end program psb_zkrylov_sample