Started playing around with type extensions and typebound
procedures. Merged performance fixes from trunk.psblas3-type-indexed
Salvatore Filippone
17 years ago
parent
32e6a17188
commit
00c1468c6c
@ -1,99 +0,0 @@
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
##########################################################
|
||||
F90=/usr/local/bin/g95
|
||||
FC=/usr/local/bin/g95
|
||||
F77=$(FC)
|
||||
F90COPT= -O3
|
||||
FCOPT=-O3
|
||||
CCOPT=-O3
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-I
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
F90LINK=/usr/local/mpich-g95/bin/mpif90
|
||||
FLINK=/usr/local/mpich-g95/bin/mpif77
|
||||
MPF90=/usr/local/mpich-g95/bin/mpif90
|
||||
MPF77=/usr/local/mpich-g95/bin/mpif77
|
||||
MPCC=/usr/local/mpich-g95/bin/mpicc
|
||||
MPI_FINC=-DMPI_MOD
|
||||
#$(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lblasg95 -L$(HOME)/LIB
|
||||
BLACS=-lmpiblacsg95 -L$(HOME)/LIB
|
||||
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerUnderscore
|
||||
#
|
||||
PSBFDEFINES=-DHAVE_KSENDID $(MPI_FINC) -DHAVE_MOVE_ALLOC
|
||||
# -DHAVE_METIS
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,103 +0,0 @@
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
##########################################################
|
||||
GNU42BIN=/usr/local/gcc42/bin
|
||||
F90=$(GNU42BIN)/gfortran
|
||||
FC=$(GNU42BIN)/gfortran
|
||||
F77=$(FC)
|
||||
CC=$(GNU42BIN)/gcc
|
||||
F90COPT=-O3 -march=native
|
||||
FCOPT=-O3 -march=native
|
||||
CCOPT=-O3 -march=native
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-I
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
MPIDIR=/usr/local/mpich-gcc42
|
||||
MPIBIN=$(MPIDIR)/bin
|
||||
F90LINK=$(MPIBIN)/mpif90
|
||||
FLINK=$(MPIBIN)/mpif77
|
||||
MPF90=$(MPIBIN)/mpif90
|
||||
MPF77=$(MPIBIN)/mpif77
|
||||
MPCC=$(MPIBIN)/mpicc
|
||||
MPI_FINC=-DMPI_MOD
|
||||
#$(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lblas-gcc42 -L$(HOME)/LIB
|
||||
BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB
|
||||
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerUnderscore
|
||||
#
|
||||
PSBFDEFINES=-DHAVE_KSENDID $(MPI_FINC) -DHAVE_MOVE_ALLOC
|
||||
# -DHAVE_METIS
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,102 +0,0 @@
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
##########################################################
|
||||
F90=/usr/local/gcc42/bin/gfortran
|
||||
FC=/usr/local/gcc42/bin/gfortran
|
||||
F77=$(FC)
|
||||
CC=/usr/local/gcc42/bin/gcc
|
||||
F90COPT=-O3
|
||||
FCOPT=-O3
|
||||
CCOPT=-O3
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-I
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
F90LINK=$(FC)
|
||||
FLINK=$(FC)
|
||||
MPF90=$(FC)
|
||||
MPF77=$(FC)
|
||||
MPCC=$(CC)
|
||||
MPI_FINC=-DMPI_MOD
|
||||
#$(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lblas-gcc42 -L$(HOME)/LIB
|
||||
# No BLACS in serialMPI. But we need the fakempi.o
|
||||
#BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB
|
||||
EXTRA_COBJS=fakempi.o
|
||||
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerUnderscore
|
||||
#
|
||||
PSBFDEFINES=-DHAVE_MOVE_ALLOC -DSERIAL_MPI $(MPI_FINC)
|
||||
# -DHAVE_METIS
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,103 +0,0 @@
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
##########################################################
|
||||
GNU43BIN=/usr/local/gcc43/bin
|
||||
F90=$(GNU43BIN)/gfortran
|
||||
FC=$(GNU43BIN)/gfortran
|
||||
F77=$(FC)
|
||||
CC=$(GNU43BIN)/gcc
|
||||
F90COPT=-O3 -march=native
|
||||
FCOPT=-O3 -march=native
|
||||
CCOPT=-O3 -march=native
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-I
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
MPIDIR=/usr/local/mpich-gcc43
|
||||
MPIBIN=$(MPIDIR)/bin
|
||||
F90LINK=$(MPIBIN)/mpif90
|
||||
FLINK=$(MPIBIN)/mpif77
|
||||
MPF90=$(MPIBIN)/mpif90
|
||||
MPF77=$(MPIBIN)/mpif77
|
||||
MPCC=$(MPIBIN)/mpicc
|
||||
MPI_FINC=-DMPI_MOD
|
||||
#$(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lblas-gcc42 -L$(HOME)/LIB
|
||||
BLACS=-lmpiblacs-gcc42 -L$(HOME)/LIB
|
||||
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerUnderscore
|
||||
#
|
||||
PSBFDEFINES=-DHAVE_KSENDID $(MPI_FINC) -DHAVE_MOVE_ALLOC
|
||||
# -DHAVE_METIS
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,105 +0,0 @@
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
##########################################################
|
||||
IFC9=/opt/intel/fc/9.1.033
|
||||
F90=$(IFC9)/bin/ifort
|
||||
FC=$(IFC9)/bin/ifort
|
||||
F77=$(FC)
|
||||
CC=gcc
|
||||
F90COPT=-O3
|
||||
FCOPT=-O3
|
||||
CCOPT=-O3
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-I
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
MPIDIR=/usr/local/mpich-ifc91
|
||||
MPIBIN=$(MPIDIR)/bin
|
||||
F90LINK=$(MPIBIN)/mpif90
|
||||
FLINK=$(MPIBIN)/mpif77
|
||||
MPF90=$(MPIBIN)/mpif90
|
||||
MPF77=$(MPIBIN)/mpif77
|
||||
MPCC=$(MPIBIN)/mpicc
|
||||
MPI_FINC=-DMPI_MOD
|
||||
#$(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lblas-ifort91 -L$(HOME)/LIB
|
||||
BLACS=-lmpiblacs-ifort91 -L$(HOME)/LIB
|
||||
|
||||
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerUnderscore
|
||||
#
|
||||
# Note: MOVE_ALLOC is only on Intel Fortran 9.1, NOT on 9.0
|
||||
PSBFDEFINES=-DHAVE_KSENDID $(MPI_FINC) -DHAVE_MOVE_ALLOC
|
||||
# -DHAVE_METIS
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,103 +0,0 @@
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
# These seems to be valid as of XLF 10.1 #
|
||||
##########################################################
|
||||
F90=xlf95 -qsuffix=f=f90:cpp=F90
|
||||
FC=xlf -qsuffix=cpp=F
|
||||
F77=$(FC)
|
||||
CC=xlc
|
||||
F90COPT= -O3
|
||||
FCOPT=-O3
|
||||
CCOPT=-O3
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-I
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
MPF90=mpxlf95 -qsuffix=f=f90:cpp=F90
|
||||
F90LINK=$(MPF90)
|
||||
FLINK=$(MPF90)
|
||||
MPF77=mpxlf95 -qfixed
|
||||
MPCC=mpcc
|
||||
MPI_FINC=-WF,-DMPI_MOD
|
||||
#$(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lessl
|
||||
BLACS=-lblacssmp
|
||||
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerCase -DPtr64Bits
|
||||
#
|
||||
PSBFDEFINES=-WF,-DHAVE_ESSL_BLACS $(MPI_FINC)
|
||||
# There's no MOVE_ALLOC yet in XLF 10.1.
|
||||
#-WF,-DHAVE_MOVE_ALLOC -WF,-DHAVE_METIS
|
||||
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -1,102 +0,0 @@
|
||||
#Makefile for Sun Fortran Compiler version 6.2
|
||||
|
||||
.mod=.mod
|
||||
.fh=.fh
|
||||
.SUFFIXES:
|
||||
.SUFFIXES: .f90 .F90 $(.mod) .F .f .c .o
|
||||
|
||||
|
||||
####################### Section 1 #######################
|
||||
# Define your compilers and compiler flags here #
|
||||
##########################################################
|
||||
F90=f90
|
||||
FC=f90
|
||||
F77=$(FC)
|
||||
CC=cc
|
||||
F90COPT=-fast
|
||||
FCOPT=-fast
|
||||
CCOPT=-fast
|
||||
#
|
||||
# Which flag does your compiler use for module inclusion?
|
||||
# Most compilers use -I but Sun uses -M
|
||||
# FIFLAG is for INCLUDE
|
||||
FMFLAG=-M
|
||||
FIFLAG=-I
|
||||
|
||||
####################### Section 2 #######################
|
||||
# Define your linker and linker flags here #
|
||||
# Does your MPI provide mpi.mod or mpif.h? #
|
||||
# MPI_FINC=-DMPI_H or MPI_FINC=-DMPI_MOD #
|
||||
# If necessary add MPIINCDIR #
|
||||
##########################################################
|
||||
F90LINK=mpf90
|
||||
FLINK=mpf90 -lf77compat
|
||||
MPF90=mpf90
|
||||
MPF77=mpf90 -lf77compat
|
||||
MPCC=mpcc
|
||||
MPI_FINC=-DMPI_H $(FIFLAG)/opt/SUNWhpc/include
|
||||
|
||||
####################### Section 3 #######################
|
||||
# Specify paths to libraries #
|
||||
##########################################################
|
||||
BLAS=-lblas
|
||||
BLACS=-lblacsCinit_MPI-SUN4SOL2-0.a -lblacsF77init_MPI-SUN4SOL2-0.a -lblacs_MPI-SUN4SOL2-0.a -L$(HOME)/LIB
|
||||
BLACS=$(HOME)/LIB/libblacs_MPI-SUN4SOL2-0.a $(HOME)/LIB/libblacsCinit_MPI-SUN4SOL2-0.a $(HOME)/LIB/libblacsF77init_MPI-SUN4SOL2-0.a $(HOME)/LIB/libblacs_MPI-SUN4SOL2-0.a -lmpi
|
||||
|
||||
####################### Section 4 #######################
|
||||
# Other useful tools&defines #
|
||||
##########################################################
|
||||
#
|
||||
# The examples can make use of METIS from U. Minnesota.
|
||||
# http://www.cs.umn.edu:~karypis
|
||||
# but it's optional
|
||||
#
|
||||
#METIS_LIB = -L$(HOME)/NUMERICAL/metis-4.0 -lmetis
|
||||
PSBLDLIBS=$(BLACS) $(BLAS) $(METIS_LIB)
|
||||
|
||||
# Add -DPtr64Bits if needed
|
||||
PSBCDEFINES=-DLowerUnderscore
|
||||
# SUN compiler does not have MOVE_ALLOC.
|
||||
PSBFDEFINES=-DHAVE_KSENDID $(MPI_FINC)
|
||||
# -DHAVE_MOVE_ALLOC
|
||||
# -DHAVE_METIS
|
||||
|
||||
AR=ar -cur
|
||||
RANLIB=ranlib
|
||||
|
||||
|
||||
|
||||
####################### Section 5 #######################
|
||||
# Do not edit this #
|
||||
##########################################################
|
||||
LIBDIR=lib
|
||||
BASELIBNAME=libpsb_base.a
|
||||
PRECLIBNAME=libpsb_prec.a
|
||||
METHDLIBNAME=libpsb_krylov.a
|
||||
UTILLIBNAME=libpsb_util.a
|
||||
|
||||
CDEFINES=$(PSBCDEFINES)
|
||||
FDEFINES=$(PSBFDEFINES)
|
||||
|
||||
$(.mod).o:
|
||||
|
||||
.c.o:
|
||||
$(CC) $(CCOPT) $(CINCLUDES) $(CDEFINES) -c $<
|
||||
.f.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f$(.mod):
|
||||
$(FC) $(FCOPT) $(FINCLUDES) -c $<
|
||||
.f90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.f90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) -c $<
|
||||
.F.o:
|
||||
$(FC) $(FCOPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90.o:
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
.F90$(.mod):
|
||||
$(F90) $(F90COPT) $(FINCLUDES) $(FDEFINES) -c $<
|
||||
|
||||
|
||||
|
||||
|
||||
@ -0,0 +1,300 @@
|
||||
!!$
|
||||
!!$ 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.
|
||||
!!$
|
||||
!!$
|
||||
!
|
||||
! File: psi_fnd_owner.f90
|
||||
!
|
||||
! Subroutine: psi_fnd_owner
|
||||
! Figure out who owns global indices.
|
||||
!
|
||||
! Arguments:
|
||||
! nv - integer Number of indices required on the calling
|
||||
! process
|
||||
! idx(:) - integer Required indices on the calling process.
|
||||
! Note: the indices should be unique!
|
||||
! iprc(:) - integer, allocatable Output: process identifiers for the corresponding
|
||||
! indices
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. return code.
|
||||
!
|
||||
subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
|
||||
use psb_descriptor_type
|
||||
use psb_serial_mod
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_penv_mod
|
||||
use psb_realloc_mod
|
||||
use psi_mod, psb_protect_name => psi_fnd_owner
|
||||
#ifdef MPI_MOD
|
||||
use mpi
|
||||
#endif
|
||||
|
||||
implicit none
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
integer, intent(in) :: nv
|
||||
integer, intent(in) :: idx(:)
|
||||
integer, allocatable, intent(out) :: iprc(:)
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer, intent(out) :: info
|
||||
|
||||
|
||||
integer, allocatable :: hsz(:),hidx(:),helem(:),hproc(:),&
|
||||
& sdsz(:),sdidx(:), rvsz(:), rvidx(:),answers(:,:),idxsrch(:,:)
|
||||
|
||||
integer :: i,n_row,n_col,err_act,ih,icomm,hsize,ip,isz,k,j,&
|
||||
& last_ih, last_j
|
||||
integer :: ictxt,np,me
|
||||
logical, parameter :: gettime=.false.
|
||||
real(psb_dpk_) :: t0, t1, t2, t3, t4, tamx, tidx
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psi_fnd_owner'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ictxt = psb_cd_get_context(desc)
|
||||
icomm = psb_cd_get_mpic(desc)
|
||||
n_row = psb_cd_get_local_rows(desc)
|
||||
n_col = psb_cd_get_local_cols(desc)
|
||||
|
||||
|
||||
! check on blacs grid
|
||||
call psb_info(ictxt, me, np)
|
||||
if (np == -1) then
|
||||
info = 2010
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (nv < 0 ) then
|
||||
info = 2010
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (.not.(psb_is_ok_desc(desc))) then
|
||||
call psb_errpush(4010,name,a_err='invalid desc')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (gettime) then
|
||||
t0 = psb_wtime()
|
||||
end if
|
||||
!
|
||||
! The basic idea is very simple.
|
||||
! First we collect (to all) all the requests.
|
||||
Allocate(hidx(np+1),hsz(np),&
|
||||
& sdsz(0:np-1),sdidx(0:np-1),&
|
||||
& rvsz(0:np-1),rvidx(0:np-1),&
|
||||
& stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
hsz = 0
|
||||
hsz(me+1) = nv
|
||||
call psb_amx(ictxt,hsz,info)
|
||||
hidx(1) = 0
|
||||
do i=1, np
|
||||
hidx(i+1) = hidx(i) + hsz(i)
|
||||
end do
|
||||
hsize = hidx(np+1)
|
||||
Allocate(helem(hsize),hproc(hsize),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (gettime) then
|
||||
t3 = psb_wtime()
|
||||
end if
|
||||
|
||||
call mpi_allgatherv(idx,hsz(me+1),mpi_integer,&
|
||||
& hproc,hsz,hidx,mpi_integer,&
|
||||
& icomm,info)
|
||||
if (gettime) then
|
||||
tamx = psb_wtime() - t3
|
||||
end if
|
||||
|
||||
! Second, we figure out locally whether we own the indices (whoever is
|
||||
! asking for them).
|
||||
if (gettime) then
|
||||
t3 = psb_wtime()
|
||||
end if
|
||||
call psi_idx_cnv(hsize,hproc,helem,desc,info,owned=.true.)
|
||||
if (gettime) then
|
||||
tidx = psb_wtime()-t3
|
||||
end if
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psi_idx_cnv')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
! Third: we build the answers for those indices we own,
|
||||
! with a section for each process asking.
|
||||
hidx = hidx +1
|
||||
j = 0
|
||||
do ip = 0, np-1
|
||||
sdidx(ip) = j
|
||||
sdsz(ip) = 0
|
||||
do i=hidx(ip+1), hidx(ip+1+1)-1
|
||||
if ((0 < helem(i)).and. (helem(i) <= n_row)) then
|
||||
j = j + 1
|
||||
hproc(j) = hproc(i)
|
||||
sdsz(ip) = sdsz(ip) + 1
|
||||
end if
|
||||
end do
|
||||
end do
|
||||
|
||||
if (gettime) then
|
||||
t3 = psb_wtime()
|
||||
end if
|
||||
! Collect all the answers with alltoallv (need sizes)
|
||||
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info)
|
||||
|
||||
isz = sum(rvsz)
|
||||
|
||||
allocate(answers(isz,2),idxsrch(nv,2),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
j = 0
|
||||
do ip=0, np-1
|
||||
rvidx(ip) = j
|
||||
j = j + rvsz(ip)
|
||||
end do
|
||||
call mpi_alltoallv(hproc,sdsz,sdidx,mpi_integer,&
|
||||
& answers(:,1),rvsz,rvidx,mpi_integer,&
|
||||
& icomm,info)
|
||||
if (gettime) then
|
||||
tamx = psb_wtime() - t3 + tamx
|
||||
end if
|
||||
j = 1
|
||||
do ip = 0,np-1
|
||||
do k=1,rvsz(ip)
|
||||
answers(j,2) = ip
|
||||
j = j + 1
|
||||
end do
|
||||
end do
|
||||
! Sort the answers and the requests, so we can
|
||||
! match them efficiently
|
||||
call psb_msort(answers(:,1),ix=answers(:,2),&
|
||||
& flag=psb_sort_keep_idx_)
|
||||
idxsrch(1:nv,1) = idx(1:nv)
|
||||
call psb_msort(idxsrch(1:nv,1),ix=idxsrch(1:nv,2))
|
||||
|
||||
! Now extract the answers for our local query
|
||||
call psb_realloc(nv,iprc,info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_realloc')
|
||||
goto 9999
|
||||
end if
|
||||
last_ih = -1
|
||||
last_j = -1
|
||||
j = 1
|
||||
do i=1, nv
|
||||
ih = idxsrch(i,1)
|
||||
if (ih == last_ih) then
|
||||
iprc(idxsrch(i,2)) = answers(last_j,2)
|
||||
else
|
||||
|
||||
do
|
||||
if (j > size(answers,1)) then
|
||||
! Last resort attempt.
|
||||
call ibsrch(j,ih,size(answers,1),answers(:,1))
|
||||
if (j == -1) then
|
||||
write(0,*) me,'psi_fnd_owner: searching for ',ih, &
|
||||
& 'not found : ',size(answers,1),':',answers(:,1)
|
||||
info = 4001
|
||||
call psb_errpush(4001,name,a_err='out bounds srch ih')
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
if (answers(j,1) == ih) exit
|
||||
if (answers(j,1) > ih) then
|
||||
k = j
|
||||
call ibsrch(j,ih,k,answers(1:k,1))
|
||||
if (j == -1) then
|
||||
write(0,*) me,'psi_fnd_owner: searching for ',ih, &
|
||||
& 'not found : ',size(answers,1),':',answers(:,1)
|
||||
info = 4001
|
||||
call psb_errpush(4001,name,a_err='out bounds srch ih')
|
||||
goto 9999
|
||||
end if
|
||||
end if
|
||||
|
||||
j = j + 1
|
||||
end do
|
||||
! Note that the answers here are given in order
|
||||
! of sending process, so we are implicitly getting
|
||||
! the max process index in case of overlap.
|
||||
last_ih = ih
|
||||
do
|
||||
last_j = j
|
||||
iprc(idxsrch(i,2)) = answers(j,2)
|
||||
j = j + 1
|
||||
if (j > size(answers,1)) exit
|
||||
if (answers(j,1) /= ih) exit
|
||||
end do
|
||||
end if
|
||||
end do
|
||||
|
||||
if (gettime) then
|
||||
call psb_barrier(ictxt)
|
||||
t1 = psb_wtime()
|
||||
t1 = t1 -t0 - tamx - tidx
|
||||
call psb_amx(ictxt,tamx)
|
||||
call psb_amx(ictxt,tidx)
|
||||
call psb_amx(ictxt,t1)
|
||||
if (me==psb_root_) then
|
||||
write(*,'(" fnd_owner idx time : ",es10.4)') tidx
|
||||
write(*,'(" fnd_owner amx time : ",es10.4)') tamx
|
||||
write(*,'(" fnd_owner remainedr : ",es10.4)') t1
|
||||
endif
|
||||
end if
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error(ictxt)
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psi_fnd_owner
|
||||
@ -1,168 +0,0 @@
|
||||
!!$
|
||||
!!$ 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.
|
||||
!!$
|
||||
!!$
|
||||
!
|
||||
! File: psi_fnd_owner.f90
|
||||
!
|
||||
! Subroutine: psi_fnd_owner
|
||||
! Figure out who owns global indices.
|
||||
!
|
||||
! Arguments:
|
||||
! nv - integer Number of indices required on the calling
|
||||
! process
|
||||
! idx(:) - integer Required indices on the calling process
|
||||
! iprc(:) - integer, allocatable Output: process identifiers for the corresponding
|
||||
! indices
|
||||
! desc_a - type(psb_desc_type). The communication descriptor.
|
||||
! info - integer. return code.
|
||||
!
|
||||
subroutine psi_fnd_owner(nv,idx,iprc,desc,info)
|
||||
use psb_descriptor_type
|
||||
use psb_serial_mod
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_penv_mod
|
||||
use psb_realloc_mod
|
||||
use psi_mod, psb_protect_name => psi_fnd_owner
|
||||
|
||||
implicit none
|
||||
integer, intent(in) :: nv
|
||||
integer, intent(in) :: idx(:)
|
||||
integer, allocatable, intent(out) :: iprc(:)
|
||||
type(psb_desc_type), intent(in) :: desc
|
||||
integer, intent(out) :: info
|
||||
|
||||
|
||||
integer,allocatable :: hsz(:),hidx(:),helem(:),hproc(:)
|
||||
|
||||
integer :: i,n_row,n_col, err_act,ih,icomm,hsize
|
||||
integer :: ictxt,np,me
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name = 'psi_fnd_owner'
|
||||
call psb_erractionsave(err_act)
|
||||
|
||||
ictxt = psb_cd_get_context(desc)
|
||||
icomm = psb_cd_get_mpic(desc)
|
||||
n_row = psb_cd_get_local_rows(desc)
|
||||
n_col = psb_cd_get_local_cols(desc)
|
||||
|
||||
|
||||
! check on blacs grid
|
||||
call psb_info(ictxt, me, np)
|
||||
if (np == -1) then
|
||||
info = 2010
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (nv < 0 ) then
|
||||
info = 2010
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (.not.(psb_is_ok_desc(desc))) then
|
||||
call psb_errpush(4010,name,a_err='invalid desc')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
!
|
||||
! The basic idea is very simple.
|
||||
! First we figure out the total number of requests.
|
||||
Allocate(hidx(np+1),hsz(np),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
hsz = 0
|
||||
hsz(me+1) = nv
|
||||
call psb_amx(ictxt,hsz,info)
|
||||
hidx(1) = 1
|
||||
do i=1, np
|
||||
hidx(i+1) = hidx(i) + hsz(i)
|
||||
end do
|
||||
hsize = hidx(np+1)-1
|
||||
Allocate(helem(hsize),hproc(hsize),stat=info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='Allocate')
|
||||
goto 9999
|
||||
end if
|
||||
! Second we build the aggregate list of requests (with psb_amx)
|
||||
helem(:) = 0
|
||||
ih = hidx(me+1)
|
||||
do i=1, hsz(me+1)
|
||||
helem(ih+i-1) = idx(i)
|
||||
end do
|
||||
call psb_amx(ictxt,helem,info)
|
||||
! Third, we figure out locally whether we own the indices (whoever is
|
||||
! asking for them) and build our part of the reply (we shift process
|
||||
! indices so that they're 1-based)
|
||||
call psi_idx_cnv(hsize,helem,desc,info,owned=.true.)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psi_idx_cnv')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
do i=1,hsize
|
||||
if ((0< helem(i)).and. (helem(i) <= n_row))then
|
||||
hproc(i) = me+1
|
||||
else
|
||||
hproc(i) = 0
|
||||
end if
|
||||
end do
|
||||
|
||||
! Fourth, we do a psb_amx on the replies so that we have everybody's answers
|
||||
call psb_amx(ictxt,hproc,info)
|
||||
|
||||
! Fifth, we extract the answers for our local query, and shift back the
|
||||
! process indices to 0-based.
|
||||
|
||||
call psb_realloc(nv,iprc,info)
|
||||
ih = hidx(me+1)
|
||||
do i=1, hsz(me+1)
|
||||
iprc(i) = hproc(ih+i-1) - 1
|
||||
end do
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error(ictxt)
|
||||
end if
|
||||
return
|
||||
|
||||
end subroutine psi_fnd_owner
|
||||
@ -1,338 +0,0 @@
|
||||
!!$
|
||||
!!$ Parallel Sparse BLAS v2.0
|
||||
!!$ (C) Copyright 2006 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.
|
||||
!!$
|
||||
!!$
|
||||
!
|
||||
!
|
||||
! File: psi_inter_desc_index.f90
|
||||
!
|
||||
! Subroutine: psi_inter_desc_index
|
||||
! Converts a list of data exchanges from build format to assembled format.
|
||||
! See below for a description of the formats.
|
||||
!
|
||||
! Arguments:
|
||||
! desc_a - type(psb_desc_type) The descriptor; in this context only the index
|
||||
! mapping parts are used.
|
||||
! index_in(:) - integer The index list, build format
|
||||
! index_out(:) - integer, allocatable The index list, assembled format
|
||||
! glob_idx - logical Whether the input indices are in local or global
|
||||
! numbering; the global numbering is used when
|
||||
! converting the overlap exchange lists.
|
||||
! nxch - integer The number of data exchanges on the calling process
|
||||
! nsnd - integer Total send buffer size on the calling process
|
||||
! nrcv - integer Total receive buffer size on the calling process
|
||||
!
|
||||
! The format of the index lists. Copied from base/modules/psb_desc_type
|
||||
!
|
||||
! 7. The data exchange is based on lists of local indices to be exchanged; all the
|
||||
! lists have the same format, as follows:
|
||||
! the list is composed of variable dimension blocks, one for each process to
|
||||
! communicate with; each block contains indices of local elements to be
|
||||
! exchanged. We do choose the order of communications: do not change
|
||||
! the sequence of blocks unless you know what you're doing, or you'll
|
||||
! risk a deadlock. NOTE: This is the format when the state is PSB_ASB_.
|
||||
! See below for BLD. The end-of-list is marked with a -1.
|
||||
!
|
||||
! notation stored in explanation
|
||||
! --------------- --------------------------- -----------------------------------
|
||||
! process_id index_v(p+proc_id_) identifier of process with which
|
||||
! data is exchanged.
|
||||
! n_elements_recv index_v(p+n_elem_recv_) number of elements to receive.
|
||||
! elements_recv index_v(p+elem_recv_+i) indexes of local elements to
|
||||
! receive. these are stored in the
|
||||
! array from location p+elem_recv_ to
|
||||
! location p+elem_recv_+
|
||||
! index_v(p+n_elem_recv_)-1.
|
||||
! n_elements_send index_v(p+n_elem_send_) number of elements to send.
|
||||
! elements_send index_v(p+elem_send_+i) indexes of local elements to
|
||||
! send. these are stored in the
|
||||
! array from location p+elem_send_ to
|
||||
! location p+elem_send_+
|
||||
! index_v(p+n_elem_send_)-1.
|
||||
!
|
||||
! This organization is valid for both halo and overlap indices; overlap entries
|
||||
! need to be updated to ensure that a variable at a given global index
|
||||
! (assigned to multiple processes) has the same value. The way to resolve the
|
||||
! issue is to exchange the data and then sum (or average) the values. See
|
||||
! psb_ovrl subroutine.
|
||||
!
|
||||
! 8. When the descriptor is in the BLD state the INDEX vectors contains only
|
||||
! the indices to be received, organized as a sequence
|
||||
! of entries of the form (proc,N,(lx1,lx2,...,lxn)) with owning process,
|
||||
! number of indices (most often N=1), list of local indices.
|
||||
! This is because we only know the list of halo indices to be received
|
||||
! as we go about building the sparse matrix pattern, and we want the build
|
||||
! phase to be loosely synchronized. Thus we record the indices we have to ask
|
||||
! for, and at the time we call PSB_CDASB we match all the requests to figure
|
||||
! out who should be sending what to whom.
|
||||
! However this implies that we know who owns the indices; if we are in the
|
||||
! LARGE case (as described above) this is actually only true for the OVERLAP list
|
||||
! that is filled in at CDALL time, and not for the HALO; thus the HALO list
|
||||
! is rebuilt during the CDASB process (in the psi_ldsc_pre_halo subroutine).
|
||||
!
|
||||
!
|
||||
subroutine psi_inter_desc_index(desc,index_in,dep_list,&
|
||||
& length_dl,nsnd,nrcv,desc_index,isglob_in,info)
|
||||
use psb_descriptor_type
|
||||
use psb_realloc_mod
|
||||
use psb_error_mod
|
||||
use psb_const_mod
|
||||
#ifdef MPI_MOD
|
||||
use mpi
|
||||
#endif
|
||||
use psb_penv_mod
|
||||
use psi_mod, psb_protect_name => psi_inter_desc_index
|
||||
implicit none
|
||||
#ifdef MPI_H
|
||||
include 'mpif.h'
|
||||
#endif
|
||||
|
||||
! ...array parameters.....
|
||||
type(psb_desc_type) :: desc
|
||||
integer :: index_in(:),dep_list(:)
|
||||
integer,allocatable :: desc_index(:)
|
||||
integer :: length_dl,nsnd,nrcv,info
|
||||
logical :: isglob_in
|
||||
! ....local scalars...
|
||||
integer :: j,me,np,i,proc
|
||||
! ...parameters...
|
||||
integer :: ictxt
|
||||
integer, parameter :: no_comm=-1
|
||||
! ...local arrays..
|
||||
integer,allocatable :: brvindx(:),rvsz(:),&
|
||||
& bsdindx(:),sdsz(:), sndbuf(:), rcvbuf(:)
|
||||
|
||||
integer :: ihinsz,ntot,k,err_act,nidx,&
|
||||
& idxr, idxs, iszs, iszr, nesd, nerv, icomm
|
||||
|
||||
logical,parameter :: usempi=.true.
|
||||
integer :: debug_level, debug_unit
|
||||
character(len=20) :: name
|
||||
|
||||
info = 0
|
||||
name='psi_inter_desc_index'
|
||||
call psb_erractionsave(err_act)
|
||||
debug_unit = psb_get_debug_unit()
|
||||
debug_level = psb_get_debug_level()
|
||||
|
||||
ictxt = psb_cd_get_context(desc)
|
||||
icomm = psb_cd_get_mpic(desc)
|
||||
call psb_info(ictxt,me,np)
|
||||
if (np == -1) then
|
||||
info = 2010
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
endif
|
||||
|
||||
if (debug_level >= psb_debug_inner_) then
|
||||
write(debug_unit,*) me,' ',trim(name),': start'
|
||||
call psb_barrier(ictxt)
|
||||
endif
|
||||
|
||||
!
|
||||
! first, find out the sizes to be exchanged.
|
||||
! note: things marked here as sndbuf/rcvbuf (for mpi) corresponds to things
|
||||
! to be received/sent (in the final psblas descriptor).
|
||||
! be careful of the inversion
|
||||
!
|
||||
allocate(sdsz(np),rvsz(np),bsdindx(np),brvindx(np),stat=info)
|
||||
if(info /= 0) then
|
||||
info=4000
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
sdsz(:) = 0
|
||||
rvsz(:) = 0
|
||||
bsdindx(:) = 0
|
||||
brvindx(:) = 0
|
||||
i = 1
|
||||
do
|
||||
if (index_in(i) == -1) exit
|
||||
proc = index_in(i)
|
||||
i = i + 1
|
||||
nerv = index_in(i)
|
||||
sdsz(proc+1) = sdsz(proc+1) + nerv
|
||||
i = i + nerv + 1
|
||||
end do
|
||||
ihinsz=i
|
||||
call mpi_alltoall(sdsz,1,mpi_integer,rvsz,1,mpi_integer,icomm,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='mpi_alltoall')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
i = 1
|
||||
idxs = 0
|
||||
idxr = 0
|
||||
do i=1, length_dl
|
||||
proc = dep_list(i)
|
||||
bsdindx(proc+1) = idxs
|
||||
idxs = idxs + sdsz(proc+1)
|
||||
brvindx(proc+1) = idxr
|
||||
idxr = idxr + rvsz(proc+1)
|
||||
end do
|
||||
iszs = sum(sdsz)
|
||||
iszr = sum(rvsz)
|
||||
nsnd = iszr
|
||||
nrcv = iszs
|
||||
|
||||
if ((iszs /= idxs).or.(iszr /= idxr)) then
|
||||
write(0,*) 'strange results?', iszs,idxs,iszr,idxr
|
||||
end if
|
||||
if (debug_level >= psb_debug_inner_) then
|
||||
write(debug_unit,*) me,' ',trim(name),': computed sizes ',iszr,iszs
|
||||
call psb_barrier(ictxt)
|
||||
endif
|
||||
|
||||
ntot = (3*(count((sdsz>0).or.(rvsz>0)))+ iszs + iszr) + 1
|
||||
if (allocated(desc_index)) then
|
||||
nidx = size(desc_index)
|
||||
else
|
||||
nidx = 0
|
||||
endif
|
||||
|
||||
if (nidx < ntot) then
|
||||
call psb_realloc(ntot,desc_index,info)
|
||||
endif
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='psb_realloc')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (debug_level >= psb_debug_inner_) then
|
||||
write(debug_unit,*) me,' ',trim(name),': computed allocated workspace ',iszr,iszs
|
||||
call psb_barrier(ictxt)
|
||||
endif
|
||||
allocate(sndbuf(iszs),rcvbuf(iszr),stat=info)
|
||||
if(info /= 0) then
|
||||
info=4000
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
!
|
||||
! Second build the lists of requests
|
||||
!
|
||||
i = 1
|
||||
do
|
||||
if (i > ihinsz) then
|
||||
write(0,*) me,' did not find index_in end??? ',i,ihinsz
|
||||
exit
|
||||
end if
|
||||
if (index_in(i) == -1) exit
|
||||
proc = index_in(i)
|
||||
i = i + 1
|
||||
nerv = index_in(i)
|
||||
!
|
||||
! note that here bsdinx is zero-based, hence the following loop
|
||||
!
|
||||
if (isglob_in) then
|
||||
do j=1, nerv
|
||||
sndbuf(bsdindx(proc+1)+j) = (index_in(i+j))
|
||||
end do
|
||||
else
|
||||
|
||||
do j=1, nerv
|
||||
sndbuf(bsdindx(proc+1)+j) = desc%loc_to_glob(index_in(i+j))
|
||||
end do
|
||||
endif
|
||||
bsdindx(proc+1) = bsdindx(proc+1) + nerv
|
||||
i = i + nerv + 1
|
||||
end do
|
||||
|
||||
if (debug_level >= psb_debug_inner_) then
|
||||
write(debug_unit,*) me,' ',trim(name),': prepared send buffer '
|
||||
call psb_barrier(ictxt)
|
||||
endif
|
||||
!
|
||||
! now have to regenerate bsdindx
|
||||
!
|
||||
idxs = 0
|
||||
idxr = 0
|
||||
do i=1, length_dl
|
||||
proc = dep_list(i)
|
||||
bsdindx(proc+1) = idxs
|
||||
idxs = idxs + sdsz(proc+1)
|
||||
brvindx(proc+1) = idxr
|
||||
idxr = idxr + rvsz(proc+1)
|
||||
end do
|
||||
|
||||
call mpi_alltoallv(sndbuf,sdsz,bsdindx,mpi_integer,&
|
||||
& rcvbuf,rvsz,brvindx,mpi_integer,icomm,info)
|
||||
if(info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='mpi_alltoallv')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
!
|
||||
! at this point we can finally build the output desc_index. beware
|
||||
! of snd/rcv inversion.
|
||||
!
|
||||
i = 1
|
||||
do k = 1, length_dl
|
||||
proc = dep_list(k)
|
||||
desc_index(i) = proc
|
||||
i = i + 1
|
||||
nerv = sdsz(proc+1)
|
||||
desc_index(i) = nerv
|
||||
call psi_idx_cnv(nerv,sndbuf(bsdindx(proc+1)+1:bsdindx(proc+1)+nerv),&
|
||||
& desc_index(i+1:i+nerv),desc,info)
|
||||
i = i + nerv + 1
|
||||
nesd = rvsz(proc+1)
|
||||
desc_index(i) = nesd
|
||||
call psi_idx_cnv(nesd,rcvbuf(brvindx(proc+1)+1:brvindx(proc+1)+nesd),&
|
||||
& desc_index(i+1:i+nesd),desc,info)
|
||||
i = i + nesd + 1
|
||||
end do
|
||||
desc_index(i) = - 1
|
||||
|
||||
deallocate(sdsz,rvsz,bsdindx,brvindx,sndbuf,rcvbuf,stat=info)
|
||||
if (info /= 0) then
|
||||
info=4000
|
||||
call psb_errpush(info,name)
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
if (debug_level >= psb_debug_inner_) then
|
||||
write(debug_unit,*) me,' ',trim(name),': done'
|
||||
call psb_barrier(ictxt)
|
||||
endif
|
||||
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
if (err_act == psb_act_abort_) then
|
||||
call psb_error(ictxt)
|
||||
return
|
||||
end if
|
||||
return
|
||||
end subroutine psi_inter_desc_index
|
||||
@ -1,617 +0,0 @@
|
||||
!!$
|
||||
!!$ Parallel Sparse BLAS v2.0
|
||||
!!$ (C) Copyright 2006 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_item_mod
|
||||
type psb_item_int2
|
||||
integer :: key, val
|
||||
end type psb_item_int2
|
||||
interface psb_sizeof
|
||||
module procedure psb_item_int2_size
|
||||
end interface
|
||||
contains
|
||||
function psb_item_int2_size(node)
|
||||
use psb_const_mod
|
||||
type(psb_item_int2) :: node
|
||||
psb_item_int2_size = psb_sizeof_int * 2
|
||||
end function psb_item_int2_size
|
||||
|
||||
subroutine psb_print_item_key_val(iout,item)
|
||||
integer, intent(in) :: iout
|
||||
type(psb_item_int2), intent(in) :: item
|
||||
write(iout,*) 'Value: ',item%key,item%val
|
||||
end subroutine psb_print_item_key_val
|
||||
end module psb_item_mod
|
||||
|
||||
module psb_avl_mod
|
||||
|
||||
use psb_item_mod
|
||||
|
||||
integer, parameter :: LeftHigh = -1, EqualHeight=0, RightHigh=1
|
||||
integer, parameter :: AVLTreeDuplicate = -123, AVLTreeOK=0, &
|
||||
& AVLTreeOutOfMemory=-512, AVLTreeFatalError=-1024
|
||||
integer :: level,outlev
|
||||
integer, parameter :: poolsize = 1024
|
||||
|
||||
type psb_treenode_int2
|
||||
type(psb_item_int2) :: item
|
||||
type(psb_treenode_int2), pointer :: left=>null(), right=>null()
|
||||
integer :: balance
|
||||
end type psb_treenode_int2
|
||||
|
||||
type psb_treevect_int2
|
||||
type(psb_treenode_int2) :: pool(poolsize)
|
||||
integer :: avail
|
||||
type(psb_treevect_int2), pointer :: next=>null(), prev=>null()
|
||||
end type psb_treevect_int2
|
||||
|
||||
type psb_tree_int2
|
||||
type(psb_treevect_int2), pointer :: head=>null(), current=>null()
|
||||
type(psb_treenode_int2), pointer :: root=>null()
|
||||
integer :: nnodes
|
||||
end type psb_tree_int2
|
||||
|
||||
interface psb_sizeof
|
||||
module procedure psb_Sizeof_Tree_int2, psb_sizeof_node_int2
|
||||
end interface
|
||||
|
||||
interface InitSearchTree
|
||||
module procedure InitSearchTree_int2
|
||||
end interface
|
||||
|
||||
interface FreeSearchTree
|
||||
module procedure FreeSearchTree_int2
|
||||
end interface
|
||||
|
||||
interface SearchKey
|
||||
module procedure SearchKey_int2
|
||||
end interface
|
||||
|
||||
interface SearchInsKey
|
||||
module procedure SearchInsKey_int2
|
||||
end interface
|
||||
|
||||
interface GetAVLTree
|
||||
module procedure GetAVLTree_int2
|
||||
end interface
|
||||
|
||||
interface CloneSearchTree
|
||||
module procedure CloneSearchTree_int2
|
||||
end interface
|
||||
|
||||
interface CloneAVLTree
|
||||
module procedure CloneAVLTree_int2
|
||||
end interface
|
||||
|
||||
interface GetAVLNode
|
||||
module procedure GetAVLNode_int2
|
||||
end interface
|
||||
interface UnGetAVLNode
|
||||
module procedure UnGetAVLNode_int2
|
||||
end interface
|
||||
|
||||
interface VisitAVLTree
|
||||
module procedure VisitAVLTree_int2, VisitAVLTreeNode_int2
|
||||
end interface
|
||||
|
||||
interface VisitAVLTreeLev
|
||||
module procedure VisitAVLTreeLev_int2, VisitAVLTreeNodeLev_int2
|
||||
end interface
|
||||
|
||||
interface AVLTreeLeftBalance
|
||||
module procedure AVLTreeLeftBalance_int2
|
||||
end interface
|
||||
|
||||
interface AVLTreeRightBalance
|
||||
module procedure AVLTreeRightBalance_int2
|
||||
end interface
|
||||
|
||||
interface AVLTreeRotateLeft
|
||||
module procedure AVLTreeRotateLeft_int2
|
||||
end interface
|
||||
|
||||
interface AVLTreeRotateRight
|
||||
module procedure AVLTreeRotateRight_int2
|
||||
end interface
|
||||
|
||||
interface AVLSearchKey
|
||||
module procedure AVLSearchKey_int2
|
||||
end interface
|
||||
|
||||
interface AVLSearchInsKey
|
||||
module procedure AVLSearchInsKey_int2
|
||||
end interface
|
||||
|
||||
interface AVLSearchInsNode
|
||||
module procedure AVLSearchInsNode_int2
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
subroutine InitSearchTree_int2(tree, info)
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info
|
||||
|
||||
if (associated(tree)) then
|
||||
call FreeSearchTree(tree,info)
|
||||
end if
|
||||
call GetAVLTree(tree,info)
|
||||
|
||||
end subroutine InitSearchTree_int2
|
||||
|
||||
subroutine CloneSearchTree_int2(treein, treeout)
|
||||
type(psb_tree_int2), pointer :: treein,treeout
|
||||
integer :: info
|
||||
if (.not.associated(treein)) then
|
||||
treeout => null()
|
||||
return
|
||||
endif
|
||||
call GetAVLTree(treeout,info)
|
||||
call CloneAVLTree(treein%root,treeout)
|
||||
|
||||
end subroutine CloneSearchTree_int2
|
||||
|
||||
recursive subroutine CloneAVLTree_int2(root, tree)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info, key,val,next
|
||||
if (.not.associated(root)) return
|
||||
key = root%item%key
|
||||
next = root%item%val
|
||||
call SearchInsKey(tree,key,val,next,info)
|
||||
call CloneAVLTree(root%left,tree)
|
||||
call CloneAVLTree(root%right,tree)
|
||||
end subroutine CloneAVLTree_int2
|
||||
|
||||
subroutine FreeSearchTree_int2(tree, info)
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info
|
||||
type(psb_treevect_int2), pointer :: current,next
|
||||
|
||||
if (.not.associated(tree)) return
|
||||
current => tree%head
|
||||
do
|
||||
if (.not.associated(current)) exit
|
||||
next => current%next
|
||||
deallocate(current,stat=info)
|
||||
if (info /= 0) then
|
||||
info = AVLTreeFatalError
|
||||
return
|
||||
end if
|
||||
current => next
|
||||
end do
|
||||
deallocate(tree,stat=info)
|
||||
if (info /= 0) then
|
||||
info = AVLTreeFatalError
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine FreeSearchTree_int2
|
||||
|
||||
function psb_Sizeof_Tree_int2(tree)
|
||||
use psb_const_mod
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: psb_Sizeof_Tree_int2
|
||||
integer :: val
|
||||
type(psb_treevect_int2), pointer :: current,next
|
||||
|
||||
val = 0
|
||||
if (associated(tree)) then
|
||||
current => tree%head
|
||||
do
|
||||
if (.not.associated(current)) exit
|
||||
val = val + 3*psb_sizeof_int + poolsize*psb_sizeof(current%pool(1))
|
||||
current => current%next
|
||||
end do
|
||||
end if
|
||||
psb_Sizeof_Tree_int2 = val
|
||||
end function psb_Sizeof_Tree_int2
|
||||
|
||||
function psb_sizeof_node_int2(node)
|
||||
|
||||
use psb_const_mod
|
||||
type(psb_treenode_int2) :: node
|
||||
integer :: psb_sizeof_node_int2
|
||||
integer :: val
|
||||
|
||||
|
||||
psb_sizeof_node_int2 = 3*psb_sizeof_int + psb_sizeof(node%item)
|
||||
|
||||
end function psb_sizeof_node_int2
|
||||
|
||||
subroutine SearchKey_int2(tree,key,val,info)
|
||||
type(psb_tree_int2), target :: tree
|
||||
integer :: key,val,info
|
||||
type(psb_item_int2), pointer :: retval
|
||||
info = 0
|
||||
call AVLSearchKey(tree,key,retval,info)
|
||||
if (associated(retval)) then
|
||||
val = retval%val
|
||||
else
|
||||
val = -1
|
||||
end if
|
||||
end subroutine SearchKey_int2
|
||||
|
||||
subroutine SearchInsKey_int2(tree,key,val, nextval,info)
|
||||
type(psb_tree_int2), target :: tree
|
||||
integer :: key,val,nextval,info
|
||||
|
||||
call AVLSearchInsKey(tree,key,val,nextval,info)
|
||||
|
||||
end subroutine SearchInsKey_int2
|
||||
|
||||
subroutine GetAVLTree_int2(tree, info)
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info
|
||||
|
||||
allocate(tree, stat=info)
|
||||
if (info == 0) allocate(tree%head,stat=info)
|
||||
if (info == 0) then
|
||||
tree%current => tree%head
|
||||
tree%head%avail = 0
|
||||
tree%nnodes=0
|
||||
end if
|
||||
|
||||
if (info /= 0) then
|
||||
write(0,*) 'Failed allocation 1 GetAVLTree '
|
||||
info = AVLTreeOutOfMemory
|
||||
|
||||
return
|
||||
end if
|
||||
|
||||
end subroutine GetAVLTree_int2
|
||||
|
||||
subroutine VisitAVLTree_int2(tree, info,iout)
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info
|
||||
integer, optional :: iout
|
||||
|
||||
info = 0
|
||||
if (.not.associated(tree)) return
|
||||
call VisitAVLTree(tree%root,iout)
|
||||
|
||||
end subroutine VisitAVLTree_int2
|
||||
|
||||
recursive subroutine VisitAVLTreeNode_int2(root,iout)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
integer, optional :: iout
|
||||
integer :: info
|
||||
|
||||
if (.not.associated(root)) return
|
||||
call VisitAVLTree(root%left,iout)
|
||||
if (present(iout)) then
|
||||
call psb_print_item_key_val(iout,root%item)
|
||||
else
|
||||
call psb_print_item_key_val(6,root%item)
|
||||
end if
|
||||
call VisitAVLTree(root%right,iout)
|
||||
end subroutine VisitAVLTreeNode_int2
|
||||
|
||||
subroutine VisitAVLTreeLev_int2(tree, info)
|
||||
type(psb_tree_int2), pointer :: tree
|
||||
integer :: info
|
||||
|
||||
if (.not.associated(tree)) return
|
||||
do outlev = 0, 3
|
||||
write(6,*) 'Tree level : ',outlev
|
||||
call VisitAVLTreeLev(tree%root,0)
|
||||
end do
|
||||
|
||||
end subroutine VisitAVLTreeLev_int2
|
||||
|
||||
recursive subroutine VisitAVLTreeNodeLev_int2(root,level)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
integer :: info,level
|
||||
|
||||
if (.not.associated(root)) return
|
||||
call VisitAVLTreeLev(root%left,level+1)
|
||||
if (level == outlev) call psb_print_item_key_val(6,root%item)
|
||||
call VisitAVLTreeLev(root%right,level+1)
|
||||
end subroutine VisitAVLTreeNodeLev_int2
|
||||
|
||||
|
||||
function GetAVLNode_int2(tree, info)
|
||||
type(psb_tree_int2), target :: tree
|
||||
type(psb_treenode_int2), pointer :: GetAVLNode_int2
|
||||
integer :: info
|
||||
type(psb_treevect_int2), pointer :: current, temp
|
||||
|
||||
GetAVLNode_int2 => null()
|
||||
|
||||
if (.not.associated(tree%current)) then
|
||||
allocate(tree%head,stat=info)
|
||||
if (info /= 0) then
|
||||
info = AVLTreeOutOfMemory
|
||||
return
|
||||
end if
|
||||
tree%current => tree%head
|
||||
tree%current%avail = 0
|
||||
end if
|
||||
current => tree%current
|
||||
do
|
||||
if (current%avail < poolsize) exit
|
||||
if (.not.(associated(current%next))) then
|
||||
allocate(temp,stat=info)
|
||||
if (info /= 0) then
|
||||
info = AVLTreeOutOfMemory
|
||||
return
|
||||
end if
|
||||
temp%avail = 0
|
||||
temp%prev => current
|
||||
current%next => temp
|
||||
end if
|
||||
current => current%next
|
||||
end do
|
||||
tree%current => current
|
||||
current%avail = current%avail + 1
|
||||
GetAVLNode_int2 => current%pool(current%avail)
|
||||
|
||||
end function GetAVLNode_int2
|
||||
|
||||
subroutine UnGetAVLNode_int2(tree, info)
|
||||
type(psb_tree_int2), target :: tree
|
||||
integer :: info
|
||||
|
||||
|
||||
if (.not.associated(tree%current)) then
|
||||
return
|
||||
end if
|
||||
if (tree%current%avail > 0) &
|
||||
& tree%current%avail = tree%current%avail - 1
|
||||
return
|
||||
end subroutine UnGetAVLNode_int2
|
||||
|
||||
subroutine AVLSearchKey_int2(tree,key,retval,info)
|
||||
type(psb_tree_int2), target :: tree
|
||||
integer :: key,info
|
||||
type(psb_item_int2), pointer :: retval
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
|
||||
retval => null()
|
||||
root => tree%root
|
||||
do
|
||||
if (.not.associated(root)) exit
|
||||
if (key < root%item%key) then
|
||||
root => root%left
|
||||
else if (key == root%item%key) then
|
||||
retval => root%item
|
||||
exit
|
||||
else if (key > root%item%key) then
|
||||
root => root%right
|
||||
end if
|
||||
end do
|
||||
|
||||
end subroutine AVLSearchKey_int2
|
||||
|
||||
subroutine AVLSearchInsKey_int2(tree,key,val,nextval,info)
|
||||
type(psb_tree_int2), target :: tree
|
||||
integer :: key,val,nextval,info
|
||||
type(psb_treenode_int2), pointer :: itemp
|
||||
logical :: taller
|
||||
|
||||
itemp => GetAVLNode(tree,info)
|
||||
if (info /=0) then
|
||||
return
|
||||
end if
|
||||
if (.not.associated(itemp)) then
|
||||
info = -5
|
||||
return
|
||||
endif
|
||||
itemp%item%key = key
|
||||
itemp%item%val = nextval
|
||||
itemp%left => null()
|
||||
itemp%right => null()
|
||||
|
||||
call AVLSearchInsNode(tree%root,itemp,taller,info)
|
||||
val = itemp%item%val
|
||||
if (info == AVLTreeDuplicate) then
|
||||
call UnGetAVLNode(tree,info)
|
||||
!!$ write(0,*) 'From searchInsNode ',key,val,nextval
|
||||
info = 0
|
||||
return
|
||||
else if (info == AVLTreeOK) then
|
||||
tree%nnodes = tree%nnodes + 1
|
||||
info = 0
|
||||
return
|
||||
else
|
||||
write(0,*) 'Error from inner SearchInsNode '
|
||||
endif
|
||||
|
||||
end subroutine AVLSearchInsKey_int2
|
||||
|
||||
|
||||
recursive subroutine AVLSearchInsNode_int2(root,node,taller,info)
|
||||
type(psb_treenode_int2), pointer :: root, node
|
||||
integer :: info
|
||||
logical :: taller
|
||||
|
||||
info = AVLTreeOK
|
||||
taller = .false.
|
||||
if (.not.associated(root)) then
|
||||
root => node
|
||||
node%balance = EqualHeight
|
||||
node%left => null()
|
||||
node%right => null()
|
||||
taller = .true.
|
||||
else if (node%item%key == root%item%key) then
|
||||
!!$ write(0,*) 'SearchInsNode : found key',node%item%key,node%item%val,&
|
||||
!!$ &root%item%key,root%item%val
|
||||
info = AVLTreeDuplicate
|
||||
node%item%val = root%item%val
|
||||
return
|
||||
|
||||
else if (node%item%key < root%item%key) then
|
||||
|
||||
call AVLSearchInsNode(root%left,node,taller,info)
|
||||
if (info == AVLTreeDuplicate) return
|
||||
if (info == AVLTreeFatalError) return
|
||||
if (taller) then
|
||||
select case(root%balance)
|
||||
case(LeftHigh)
|
||||
call AVLTreeLeftBalance(root,taller)
|
||||
case(EqualHeight)
|
||||
root%balance = LeftHigh
|
||||
case(RightHigh)
|
||||
root%balance = EqualHeight
|
||||
taller = .false.
|
||||
case default
|
||||
info = AVLTreeFatalError
|
||||
end select
|
||||
end if
|
||||
else if (node%item%key > root%item%key) then
|
||||
call AVLSearchInsNode(root%right,node,taller,info)
|
||||
if (info == AVLTreeDuplicate) return
|
||||
if (info == AVLTreeFatalError) return
|
||||
if (taller) then
|
||||
select case(root%balance)
|
||||
case(LeftHigh)
|
||||
root%balance = EqualHeight
|
||||
taller = .false.
|
||||
case(EqualHeight)
|
||||
root%balance = RightHigh
|
||||
case(RightHigh)
|
||||
call AVLTreeRightBalance(root,taller)
|
||||
case default
|
||||
info = AVLTreeFatalError
|
||||
end select
|
||||
end if
|
||||
end if
|
||||
|
||||
end subroutine AVLSearchInsNode_int2
|
||||
|
||||
|
||||
|
||||
recursive subroutine AVLTreeLeftBalance_int2(root,taller)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
logical :: taller
|
||||
|
||||
type(psb_treenode_int2), pointer :: rs, ls
|
||||
|
||||
ls => root%left
|
||||
select case (ls%balance)
|
||||
case(LeftHigh)
|
||||
root%balance = EqualHeight
|
||||
ls%balance = EqualHeight
|
||||
call AVLTreeRotateRight(root)
|
||||
taller = .false.
|
||||
case(EqualHeight)
|
||||
write(0,*) 'Warning: balancing and already balanced left tree? '
|
||||
case(RightHigh)
|
||||
rs => ls%right
|
||||
select case(rs%balance)
|
||||
case(LeftHigh)
|
||||
root%balance = RightHigh
|
||||
ls%balance = EqualHeight
|
||||
case(EqualHeight)
|
||||
root%balance = EqualHeight
|
||||
ls%balance = EqualHeight
|
||||
case(RightHigh)
|
||||
root%balance = EqualHeight
|
||||
ls%balance = LeftHigh
|
||||
end select
|
||||
rs%balance = EqualHeight
|
||||
call AVLTreeRotateLeft(root%left)
|
||||
call AVLTreeRotateRight(root)
|
||||
taller = .false.
|
||||
end select
|
||||
|
||||
end subroutine AVLTreeLeftBalance_int2
|
||||
|
||||
|
||||
recursive subroutine AVLTreeRightBalance_int2(root,taller)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
logical :: taller
|
||||
type(psb_treenode_int2), pointer :: rs, ls
|
||||
|
||||
rs => root%right
|
||||
select case (rs%balance)
|
||||
case(RightHigh)
|
||||
root%balance = EqualHeight
|
||||
rs%balance = EqualHeight
|
||||
call AVLTreeRotateLeft(root)
|
||||
taller = .false.
|
||||
case(EqualHeight)
|
||||
write(0,*) 'Warning: balancing and already balanced right tree? '
|
||||
case(LeftHigh)
|
||||
ls => rs%left
|
||||
select case(ls%balance)
|
||||
case(RightHigh)
|
||||
root%balance = LeftHigh
|
||||
rs%balance = EqualHeight
|
||||
case(EqualHeight)
|
||||
root%balance = EqualHeight
|
||||
rs%balance = EqualHeight
|
||||
case(LeftHigh)
|
||||
root%balance = EqualHeight
|
||||
rs%balance = RightHigh
|
||||
end select
|
||||
ls%balance = EqualHeight
|
||||
call AVLTreeRotateRight(root%right)
|
||||
call AVLTreeRotateLeft(root)
|
||||
taller = .false.
|
||||
end select
|
||||
end subroutine AVLTreeRightBalance_int2
|
||||
|
||||
|
||||
|
||||
subroutine AVLTreeRotateLeft_int2(root)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
type(psb_treenode_int2), pointer :: temp
|
||||
if (.not.associated(root)) then
|
||||
return
|
||||
endif
|
||||
if (.not.associated(root%right)) then
|
||||
return
|
||||
endif
|
||||
temp => root%right
|
||||
root%right => temp%left
|
||||
temp%left => root
|
||||
root => temp
|
||||
|
||||
end subroutine AVLTreeRotateLeft_int2
|
||||
|
||||
subroutine AVLTreeRotateRight_int2(root)
|
||||
type(psb_treenode_int2), pointer :: root
|
||||
type(psb_treenode_int2), pointer :: temp
|
||||
if (.not.associated(root)) then
|
||||
return
|
||||
endif
|
||||
if (.not.associated(root%left)) then
|
||||
return
|
||||
endif
|
||||
temp => root%left
|
||||
root%left => temp%right
|
||||
temp%right => root
|
||||
root => temp
|
||||
|
||||
end subroutine AVLTreeRotateRight_int2
|
||||
|
||||
|
||||
end module psb_avl_mod
|
||||
@ -0,0 +1,340 @@
|
||||
!!$
|
||||
!!$ Parallel Sparse BLAS v2.0
|
||||
!!$ (C) Copyright 2006 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.
|
||||
!!$
|
||||
!!$
|
||||
!
|
||||
! package: psb_hash_mod
|
||||
!
|
||||
! This module implements a very simple minded hash table.
|
||||
! The hash is based on the idea of open addressing with double hashing;
|
||||
! the primary hash function h1(K) is simply the remainder modulo 2^N, while
|
||||
! the secondary hash function is 1 if H1(k) == 0, otherwise IOR((2^N-H1(k)),1)
|
||||
! (See Knuth: TAOCP, Vol. 3, sec. 6.4)
|
||||
! These hash functions are not very smart; however they are very simple and fast.
|
||||
! The intended usage of this hash table is to store indices of halo points, which
|
||||
! are supposed to be few compared to the internal indices
|
||||
! (which are stored elsewhere), so in this context they are acceptable.
|
||||
!
|
||||
!
|
||||
!
|
||||
module psb_hash_mod
|
||||
use psb_const_mod
|
||||
|
||||
!
|
||||
! For us a hash is a Nx2 table.
|
||||
! Note: we are assuming that the keys are positive numbers.
|
||||
! Allocatable scalars would be a nice solution...
|
||||
!
|
||||
type psb_hash_type
|
||||
integer :: nbits, hsize, hmask, nk
|
||||
integer, allocatable :: table(:,:)
|
||||
integer(psb_long_int_k_) :: nsrch, nacc
|
||||
end type psb_hash_type
|
||||
|
||||
|
||||
integer, parameter :: HashDuplicate = 123, HashOK=0, HashOutOfMemory=-512,&
|
||||
& HashFreeEntry = -1, HashNotFound = -256
|
||||
|
||||
interface psb_hash_init
|
||||
module procedure psb_hash_init_v, psb_hash_init_n
|
||||
end interface
|
||||
interface psb_sizeof
|
||||
module procedure psb_sizeof_hash_type
|
||||
end interface
|
||||
|
||||
contains
|
||||
|
||||
|
||||
function hashval(key) result(val)
|
||||
integer, intent(in) :: key
|
||||
integer, parameter :: ival=5381, mask=2147483647
|
||||
integer :: key_, val, i
|
||||
|
||||
key_ = key
|
||||
val = ival
|
||||
do i=1, 4
|
||||
val = val * 33 + iand(key_,255)
|
||||
key_ = ishft(key_,-8)
|
||||
end do
|
||||
|
||||
val = val + ishft(val,-5)
|
||||
val = iand(val,mask)
|
||||
|
||||
end function hashval
|
||||
|
||||
|
||||
function psb_Sizeof_hash_type(hash) result(val)
|
||||
type(psb_hash_type), pointer :: hash
|
||||
integer(psb_long_int_k_) :: val
|
||||
val = 0
|
||||
if (associated(hash)) then
|
||||
val = val + psb_sizeof_int * size(hash%table)
|
||||
end if
|
||||
end function psb_Sizeof_hash_type
|
||||
|
||||
|
||||
function psb_hash_avg_acc(hash)
|
||||
type(psb_hash_type), intent(in) :: hash
|
||||
real(psb_dpk_) :: psb_hash_avg_acc
|
||||
|
||||
psb_hash_avg_acc = dble(hash%nacc)/dble(hash%nsrch)
|
||||
end function psb_hash_avg_acc
|
||||
|
||||
subroutine HashTransfer(hashin,hashout,info)
|
||||
use psb_realloc_mod
|
||||
type(psb_hash_type) :: hashin
|
||||
type(psb_hash_type) :: hashout
|
||||
integer, intent(out) :: info
|
||||
|
||||
info = HashOk
|
||||
hashout%nbits = hashin%nbits
|
||||
hashout%hsize = hashin%hsize
|
||||
hashout%hmask = hashin%hmask
|
||||
hashout%nk = hashin%nk
|
||||
hashout%nsrch = hashin%nsrch
|
||||
hashout%nacc = hashin%nacc
|
||||
call psb_transfer(hashin%table, hashout%table,info)
|
||||
|
||||
end subroutine HashTransfer
|
||||
|
||||
subroutine HashCopy(hashin,hashout,info)
|
||||
use psb_realloc_mod
|
||||
type(psb_hash_type) :: hashin
|
||||
type(psb_hash_type) :: hashout
|
||||
integer, intent(out) :: info
|
||||
|
||||
info = HashOk
|
||||
hashout%nbits = hashin%nbits
|
||||
hashout%hsize = hashin%hsize
|
||||
hashout%hmask = hashin%hmask
|
||||
hashout%nk = hashin%nk
|
||||
hashout%nsrch = hashin%nsrch
|
||||
hashout%nacc = hashin%nacc
|
||||
call psb_safe_ab_cpy(hashin%table, hashout%table,info)
|
||||
|
||||
end subroutine HashCopy
|
||||
|
||||
subroutine CloneHashTable(hashin,hashout,info)
|
||||
type(psb_hash_type), pointer :: hashin
|
||||
type(psb_hash_type), pointer :: hashout
|
||||
integer, intent(out) :: info
|
||||
|
||||
if (associated(hashout)) then
|
||||
deallocate(hashout,stat=info)
|
||||
!if (info /= 0) return
|
||||
end if
|
||||
if (associated(hashin)) then
|
||||
allocate(hashout,stat=info)
|
||||
if (info /= 0) return
|
||||
call HashCopy(hashin,hashout,info)
|
||||
end if
|
||||
|
||||
end subroutine CloneHashTable
|
||||
|
||||
subroutine psb_hash_init_V(v,hash,info)
|
||||
integer, intent(in) :: v(:)
|
||||
type(psb_hash_type), intent(out) :: hash
|
||||
integer, intent(out) :: info
|
||||
|
||||
integer :: i,j,k,hsize,nbits, nv
|
||||
|
||||
info = 0
|
||||
nv = size(v)
|
||||
call psb_hash_init(nv,hash,info)
|
||||
if (info /= 0) return
|
||||
do i=1,nv
|
||||
call psb_hash_searchinskey(v(i),j,i,hash,info)
|
||||
if ((j /= i).or.(info /= HashOK)) then
|
||||
write(0,*) 'Error from hash_ins',i,v(i),j,info
|
||||
info = HashNotFound
|
||||
return
|
||||
end if
|
||||
end do
|
||||
end subroutine psb_hash_init_V
|
||||
|
||||
subroutine psb_hash_init_n(nv,hash,info)
|
||||
integer, intent(in) :: nv
|
||||
type(psb_hash_type), intent(out) :: hash
|
||||
integer, intent(out) :: info
|
||||
|
||||
integer :: i,j,k,hsize,nbits
|
||||
|
||||
info = 0
|
||||
nbits = 12
|
||||
hsize = 2**nbits
|
||||
!
|
||||
! Figure out the smallest power of 2 bigger than NV
|
||||
!
|
||||
do
|
||||
if (hsize < 0) then
|
||||
write(0,*) 'Error: hash size overflow ',hsize,nbits
|
||||
info = -2
|
||||
return
|
||||
end if
|
||||
if (hsize > nv) exit
|
||||
nbits = nbits + 1
|
||||
hsize = hsize * 2
|
||||
end do
|
||||
|
||||
hash%nbits = nbits
|
||||
hash%hsize = hsize
|
||||
hash%hmask = hsize-1
|
||||
hash%nsrch = 0
|
||||
hash%nacc = 0
|
||||
allocate(hash%table(0:hsize-1,2),stat=info)
|
||||
if (info /= 0) then
|
||||
write(0,*) 'Error: memory allocation failure ',hsize
|
||||
info = HashOutOfMemory
|
||||
return
|
||||
end if
|
||||
hash%table = HashFreeEntry
|
||||
hash%nk = 0
|
||||
end subroutine psb_hash_init_n
|
||||
|
||||
|
||||
subroutine psb_hash_realloc(hash,info)
|
||||
type(psb_hash_type), intent(inout) :: hash
|
||||
integer, intent(out) :: info
|
||||
type(psb_hash_type) :: nhash
|
||||
integer :: nk, key, val, nextval,i
|
||||
|
||||
info = HashOk
|
||||
|
||||
call psb_hash_init((hash%hsize+1),nhash,info)
|
||||
|
||||
if (info /= HashOk) then
|
||||
info = HashOutOfMemory
|
||||
return
|
||||
endif
|
||||
do i=0, hash%hsize-1
|
||||
key = hash%table(i,1)
|
||||
nextval = hash%table(i,2)
|
||||
if (key /= HashFreeEntry) then
|
||||
call psb_hash_searchinskey(key,val,nextval,nhash,info)
|
||||
if (info /= 0) then
|
||||
info = HashOutOfMemory
|
||||
return
|
||||
end if
|
||||
end if
|
||||
end do
|
||||
call HashTransfer(nhash,hash,info)
|
||||
end subroutine psb_hash_realloc
|
||||
|
||||
recursive subroutine psb_hash_searchinskey(key,val,nextval,hash,info)
|
||||
integer, intent(in) :: key,nextval
|
||||
type(psb_hash_type) :: hash
|
||||
integer, intent(out) :: val, info
|
||||
|
||||
integer :: i,j,k,hsize,hmask, hk, hd
|
||||
|
||||
info = HashOK
|
||||
hsize = hash%hsize
|
||||
hmask = hash%hmask
|
||||
|
||||
hk = iand(hashval(key),hmask)
|
||||
if (hk == 0) then
|
||||
hd = 1
|
||||
else
|
||||
hd = hsize - hk
|
||||
hd = ior(hd,1)
|
||||
end if
|
||||
|
||||
hash%nsrch = hash%nsrch + 1
|
||||
do
|
||||
hash%nacc = hash%nacc + 1
|
||||
if (hash%table(hk,1) == key) then
|
||||
val = hash%table(hk,2)
|
||||
info = HashDuplicate
|
||||
return
|
||||
end if
|
||||
if (hash%table(hk,1) == HashFreeEntry) then
|
||||
if (hash%nk == hash%hsize -1) then
|
||||
!
|
||||
! Note: because of the way we allocate things at CDALL
|
||||
! time this is really unlikely; if we get here, we
|
||||
! have at least as many halo indices as internals, which
|
||||
! means we're already in trouble. But we try to keep going.
|
||||
!
|
||||
call psb_hash_realloc(hash,info)
|
||||
if (info /= HashOk) then
|
||||
info = HashOutOfMemory
|
||||
return
|
||||
else
|
||||
call psb_hash_searchinskey(key,val,nextval,hash,info)
|
||||
return
|
||||
end if
|
||||
else
|
||||
hash%nk = hash%nk + 1
|
||||
hash%table(hk,1) = key
|
||||
hash%table(hk,2) = nextval
|
||||
val = nextval
|
||||
return
|
||||
end if
|
||||
end if
|
||||
hk = hk - hd
|
||||
if (hk < 0) hk = hk + hsize
|
||||
end do
|
||||
end subroutine psb_hash_searchinskey
|
||||
|
||||
subroutine psb_hash_searchkey(key,val,hash,info)
|
||||
integer, intent(in) :: key
|
||||
type(psb_hash_type) :: hash
|
||||
integer, intent(out) :: val, info
|
||||
|
||||
integer :: i,j,k,hsize,hmask, hk, hd
|
||||
|
||||
info = HashOK
|
||||
hsize = hash%hsize
|
||||
hmask = hash%hmask
|
||||
hk = iand(hashval(key),hmask)
|
||||
if (hk == 0) then
|
||||
hd = 1
|
||||
else
|
||||
hd = hsize - hk
|
||||
hd = ior(hd,1)
|
||||
end if
|
||||
|
||||
hash%nsrch = hash%nsrch + 1
|
||||
do
|
||||
hash%nacc = hash%nacc + 1
|
||||
if (hash%table(hk,1) == key) then
|
||||
val = hash%table(hk,2)
|
||||
return
|
||||
end if
|
||||
if (hash%table(hk,1) == HashFreeEntry) then
|
||||
val = HashFreeEntry
|
||||
!!$ info = HashNotFound
|
||||
return
|
||||
end if
|
||||
hk = hk - hd
|
||||
if (hk < 0) hk = hk + hsize
|
||||
end do
|
||||
end subroutine psb_hash_searchkey
|
||||
|
||||
end module psb_hash_mod
|
||||
@ -0,0 +1,123 @@
|
||||
!!$
|
||||
!!$ 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.
|
||||
!!$
|
||||
!!$
|
||||
subroutine psb_cd_set_ovl_bld(desc,info)
|
||||
!
|
||||
! Change state of a descriptor into ovl_build.
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_penv_mod
|
||||
use psi_mod
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod, psb_protect_name => psb_cd_set_ovl_bld
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc
|
||||
integer :: info
|
||||
|
||||
call psb_cd_set_bld(desc,info)
|
||||
if (info == 0) desc%matrix_data(psb_dec_type_) = psb_cd_ovl_bld_
|
||||
|
||||
end subroutine psb_cd_set_ovl_bld
|
||||
|
||||
subroutine psb_cd_set_bld(desc,info)
|
||||
!
|
||||
! Change state of a descriptor into BUILD.
|
||||
! If the descriptor is LARGE, check the AVL search tree
|
||||
! and initialize it if necessary.
|
||||
!
|
||||
use psb_const_mod
|
||||
use psb_error_mod
|
||||
use psb_penv_mod
|
||||
use psi_mod
|
||||
use psb_descriptor_type
|
||||
use psb_tools_mod, psb_protect_name => psb_cd_set_bld
|
||||
implicit none
|
||||
type(psb_desc_type), intent(inout) :: desc
|
||||
integer :: info
|
||||
!locals
|
||||
integer :: np,me,ictxt, err_act,idx,gidx,lidx,nc
|
||||
logical, parameter :: debug=.false.,debugprt=.false.
|
||||
character(len=20) :: name
|
||||
if (debug) write(0,*) me,'Entered CDCPY'
|
||||
if (psb_get_errstatus() /= 0) return
|
||||
info = 0
|
||||
call psb_erractionsave(err_act)
|
||||
name = 'psb_cd_set_bld'
|
||||
|
||||
ictxt = psb_cd_get_context(desc)
|
||||
|
||||
if (debug) write(0,*)'Entered CDSETBLD',ictxt
|
||||
! check on blacs grid
|
||||
call psb_info(ictxt, me, np)
|
||||
if (debug) write(0,*) me,'Entered CDSETBLD'
|
||||
if (psb_is_asb_desc(desc)) then
|
||||
end if
|
||||
|
||||
desc%matrix_data(psb_dec_type_) = psb_desc_bld_
|
||||
|
||||
if (psb_is_large_desc(desc)) then
|
||||
!
|
||||
! The idea: first build glb_lc with the info on
|
||||
! rows we already have, then leave space in
|
||||
! hash for newcomers (halo indices).
|
||||
! The policy is to allocate for as many entries
|
||||
! as there are rows; if we ever fill them up, we can
|
||||
! try and enlarge again, but by the time the hash
|
||||
! fills up it means we have as many halo as internals,
|
||||
! therefore there are much worse problems ahead than
|
||||
! the hash occupancy.
|
||||
!
|
||||
nc = psb_cd_get_local_cols(desc)
|
||||
if (.not.associated(desc%hash)) allocate(desc%hash,stat=info)
|
||||
if (info == 0)&
|
||||
& call psb_hash_init(nc,desc%hash,info)
|
||||
if (info == 0) call psi_bld_hash(desc,info)
|
||||
if (info /= 0) then
|
||||
call psb_errpush(4010,name,a_err='hashInit')
|
||||
goto 9999
|
||||
end if
|
||||
|
||||
end if
|
||||
|
||||
if (debug) write(0,*) me,'SET_BLD: done'
|
||||
call psb_erractionrestore(err_act)
|
||||
return
|
||||
|
||||
9999 continue
|
||||
call psb_erractionrestore(err_act)
|
||||
|
||||
if (err_act == psb_act_ret_) then
|
||||
return
|
||||
else
|
||||
call psb_error(ictxt)
|
||||
end if
|
||||
return
|
||||
end subroutine psb_cd_set_bld
|
||||
Binary file not shown.
|
Before Width: | Height: | Size: 544 B After Width: | Height: | Size: 393 B |
Binary file not shown.
|
Before Width: | Height: | Size: 255 B After Width: | Height: | Size: 341 B |
Binary file not shown.
|
Before Width: | Height: | Size: 387 B After Width: | Height: | Size: 258 B |
Binary file not shown.
|
Before Width: | Height: | Size: 250 B After Width: | Height: | Size: 193 B |
Binary file not shown.
|
Before Width: | Height: | Size: 244 B After Width: | Height: | Size: 134 B |
Binary file not shown.
|
Before Width: | Height: | Size: 276 B After Width: | Height: | Size: 255 B |
Binary file not shown.
|
Before Width: | Height: | Size: 374 B After Width: | Height: | Size: 387 B |
Binary file not shown.
|
Before Width: | Height: | Size: 222 B After Width: | Height: | Size: 250 B |
Binary file not shown.
|
Before Width: | Height: | Size: 259 B After Width: | Height: | Size: 244 B |
Binary file not shown.
|
Before Width: | Height: | Size: 804 B After Width: | Height: | Size: 276 B |
Binary file not shown.
|
Before Width: | Height: | Size: 408 B After Width: | Height: | Size: 374 B |
Binary file not shown.
|
Before Width: | Height: | Size: 131 B After Width: | Height: | Size: 544 B |
Binary file not shown.
|
Before Width: | Height: | Size: 419 B After Width: | Height: | Size: 222 B |
Binary file not shown.
|
Before Width: | Height: | Size: 354 B After Width: | Height: | Size: 259 B |
Binary file not shown.
|
Before Width: | Height: | Size: 310 B After Width: | Height: | Size: 804 B |
Binary file not shown.
|
Before Width: | Height: | Size: 835 B After Width: | Height: | Size: 408 B |
Binary file not shown.
|
Before Width: | Height: | Size: 335 B After Width: | Height: | Size: 419 B |
Binary file not shown.
|
Before Width: | Height: | Size: 497 B After Width: | Height: | Size: 354 B |
Binary file not shown.
|
Before Width: | Height: | Size: 403 B After Width: | Height: | Size: 310 B |
Binary file not shown.
|
Before Width: | Height: | Size: 266 B After Width: | Height: | Size: 835 B |
Binary file not shown.
|
Before Width: | Height: | Size: 533 B After Width: | Height: | Size: 335 B |
Binary file not shown.
|
Before Width: | Height: | Size: 544 B After Width: | Height: | Size: 497 B |
Binary file not shown.
|
Before Width: | Height: | Size: 240 B After Width: | Height: | Size: 129 B |
Binary file not shown.
|
Before Width: | Height: | Size: 334 B After Width: | Height: | Size: 403 B |
Binary file not shown.
|
Before Width: | Height: | Size: 231 B After Width: | Height: | Size: 266 B |
Binary file not shown.
|
Before Width: | Height: | Size: 519 B After Width: | Height: | Size: 533 B |
Binary file not shown.
|
Before Width: | Height: | Size: 604 B After Width: | Height: | Size: 544 B |
Binary file not shown.
|
Before Width: | Height: | Size: 577 B After Width: | Height: | Size: 334 B |
Binary file not shown.
|
Before Width: | Height: | Size: 210 B After Width: | Height: | Size: 231 B |
Binary file not shown.
|
Before Width: | Height: | Size: 568 B After Width: | Height: | Size: 519 B |
Binary file not shown.
|
Before Width: | Height: | Size: 743 B After Width: | Height: | Size: 604 B |
Binary file not shown.
|
Before Width: | Height: | Size: 276 B After Width: | Height: | Size: 577 B |
Binary file not shown.
|
Before Width: | Height: | Size: 521 B After Width: | Height: | Size: 210 B |
Binary file not shown.
|
Before Width: | Height: | Size: 192 B After Width: | Height: | Size: 3.1 KiB |
Binary file not shown.
|
Before Width: | Height: | Size: 267 B After Width: | Height: | Size: 568 B |
Binary file not shown.
|
Before Width: | Height: | Size: 568 B After Width: | Height: | Size: 743 B |
Binary file not shown.
|
Before Width: | Height: | Size: 239 B After Width: | Height: | Size: 276 B |
Binary file not shown.
|
Before Width: | Height: | Size: 0 B After Width: | Height: | Size: 521 B |
Binary file not shown.
|
Before Width: | Height: | Size: 0 B After Width: | Height: | Size: 267 B |
Binary file not shown.
|
Before Width: | Height: | Size: 371 B After Width: | Height: | Size: 568 B |
Binary file not shown.
|
Before Width: | Height: | Size: 431 B After Width: | Height: | Size: 239 B |
Binary file not shown.
|
Before Width: | Height: | Size: 916 B After Width: | Height: | Size: 0 B |
Binary file not shown.
|
Before Width: | Height: | Size: 677 B After Width: | Height: | Size: 0 B |
Binary file not shown.
|
Before Width: | Height: | Size: 234 B After Width: | Height: | Size: 371 B |
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue