blacs-mpi-1.1/ 40755 1750 144 0 6710306457 12363 5ustar pfrauenfusersblacs-mpi-1.1/BMAKES/ 40755 1750 144 0 6710306457 13325 5ustar pfrauenfusersblacs-mpi-1.1/BMAKES/Bmake.CMMD-CM5100644 1750 144 15347 6332725740 15517 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = CMMD # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = CM5 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I/usr/include/cm # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # --------------------------------------------------------------------- # Which CMMD node timer should the BLACS use for it's internal timings? # --------------------------------------------------------------------- TIMERNUM = -DTIMERNUM=63 # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(TIMERNUM) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -u F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = cmmd-ld F77LOADFLAGS = -comp $(F77) -node CC = cc CCFLAGS = -O4 CCLOADER = cmmd-ld CCLOADFLAGS = -comp $(CC) -node # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-ALPHA100644 1750 144 25367 6332725740 15670 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = ALPHA # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = alpha MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1 # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-HPPA100644 1750 144 25414 6332725740 15564 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = HPPA # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = hpux MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a -lV3 # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = -Wl,-B,immediate CC = cc CCFLAGS = -O -Aa CCLOADER = $(CC) CCLOADFLAGS = -Wl,-B,immediate # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-I860100644 1750 144 25325 6332725737 15471 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = I860 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_nx MPIplat = intelnx MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = if77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = $(F77) F77LOADFLAGS = CC = icc CCFLAGS = -O4 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar860 ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-LINUX100644 1750 144 25360 6332725740 15733 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = LINUX # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = LINUX MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -Df77IsF2C # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -Nx400 F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = CC = gcc CCFLAGS = -O4 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-POWCHALL100644 1750 144 25342 6333154420 16235 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = IRIX64 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = $(HOME)/mpich MPIdev = ch_shmem MPIplat = IRIX64 MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # MPILIB = -lmpi # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1. If you are unsure whether pointers are # longer than integers, you can run BLACS/INSTALL/xtranscomm): TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1 # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-RS6K100644 1750 144 25352 6332725740 15562 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = RS6K # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = rs6000 MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = xlf F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = CC = xlc CCFLAGS = -O3 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-SGI5100644 1750 144 25366 6333151765 15552 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = SGI5 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = IRIX MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1 # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = CC = gcc CCFLAGS = -O2 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-SP2100644 1750 144 25266 6332725740 15445 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = SP2 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = MPIdev = MPIplat = MPILIBdir = MPIINCdir = /usr/lpp/ppe.poe/include MPILIB = # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. # TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = mpxlf F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 -qarch=pwr2 F77LOADER = $(F77) F77LOADFLAGS = CC = mpcc CCFLAGS = -O3 -qarch=pwr2 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-SUN4100644 1750 144 25352 6332725740 15566 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = SUN4 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = sun4 MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -u -f F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = $(F77) F77LOADFLAGS = CC = gcc CCFLAGS = -O2 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-SUN4SOL2100644 1750 144 25377 6332726704 16236 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = SUN4SOL2 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /usr/local/mpi MPIdev = ch_p4 MPIplat = solaris MPILIBdir = $(MPIdir)/lib/$(MPIplat)/$(MPIdev) MPIINCdir = $(MPIdir)/include MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) -lsocket -lnsl # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. # TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -u -f F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -xO4 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-T3D100644 1750 144 25346 6332725737 15440 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = T3D # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /mpp MPILIBdir = $(MPIdir)/lib MPIINCdir = /usr/include/mpp MPILIB = $(MPILIBdir)/libmpi.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DUpCase # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. # SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1.) For help on setting TRANSCOMM, you can # run BLACS/INSTALL/xtc_CsameF77 and BLACS/INSTALL/xtc_UseMpich as # explained in BLACS/INSTALL/README. # TRANSCOMM = -DUseMpich # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system has this problem (compile and run # BLACS/INSTALL/xsyserrors to check if unsure), replace the empty macro # definition below with the macro definition on the following line. # SYSERRORS = -DZeroByteTypeBug # --------------------------------------------------------------------------- SYSERRORS = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) $(SYSERRORS) \ -DCRAY #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = cf77 F77NO_OPTFLAGS = -dp -Ccray-t3d F77FLAGS = $(F77NO_OPTFLAGS) -O1 F77LOADER = $(F77) F77LOADFLAGS = $(F77FLAGS) CC = cc CCFLAGS = -O3 -Tcray-t3d CCLOADER = $(CC) CCLOADFLAGS = $(CCFLAGS) # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPI-T3E100644 1750 144 24763 6332724575 15442 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPI # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = T3E # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSFINIT = $(BLACSdir)/blacsF77init_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSCINIT = $(BLACSdir)/blacsCinit_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the MPI library. # ------------------------------------- MPIdir = /opt/ctl/mpt/mpt MPILIBdir = $(MPIdir) MPIINCdir = $(MPIdir)/include MPILIB = # # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSFINIT) $(BLACSLIB) $(BLACSFINIT) $(MPILIB) # ------------------------------------------------ # If BTINTFACE = C, we test the C interface BLACS; # else we test the fortran interface BLACS. # ------------------------------------------------ BTINTFACE = F # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE TESTexe = $(TESTdir)/x$(BTINTFACE)btest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. # NOTE: The MPI defaults have been set for MPICH. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(MPIINCdir) # ------------------------------------------------------- # The Fortran 77 to C interface to be used. Choices are: # Add_, NoChange, UpCase, or f77IsF2C. # ------------------------------------------------------- INTFACE = -DUpCase # ------------------------------------------------------------------------ # Allows the user to vary the topologies that the BLACS default topologies # (TOP = ' ') correspond to. If you wish to use a particular topology # (as opposed to letting the BLACS make the choice), uncomment the # following macros, and replace the character in single quotes with the # topology of your choice. # ------------------------------------------------------------------------ # DEFBSTOP = -DDefBSTop="'1'" # DEFCOMBTOP = -DDefCombTop="'1'" # ------------------------------------------------------------------- # If your MPI_Send is locally-blocking, substitute the following line # for the empty macro definition below. SENDIS = -DSndIsLocBlk # ------------------------------------------------------------------- # SENDIS = # -------------------------------------------------------------------- # If your MPI handles packing of non-contiguous messages by copying to # another buffer or sending extra bytes, better performance may be # obtained by replacing the empty macro definition below with the # macro definition on the following line. # BUFF = -DNoMpiBuff # -------------------------------------------------------------------- BUFF = # ----------------------------------------------------------------------- # If you know something about your system, you may make it easier for the # BLACS to translate between C and fortran communicators. If the empty # macro defininition is left alone, this translation will cause the C # BLACS to globally block for MPI_COMM_WORLD on calls to BLACS_GRIDINIT # and BLACS_GRIDMAP. If you choose one of the options for translating # the context, neither the C or fortran calls will globally block. # If you are using MPICH, or a derivitive system, you can replace the # empty macro definition below with the following (note that if you let # MPICH do the translation between C and fortran, you must also indicate # here if your system has pointers that are longer than integers. If so, # define -DPOINTER_64_BITS=1): # TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1 # # If you know that your MPI uses the same handles for fortran and C # communicators, you can replace the empty macro definition below with # the macro definition on the following line. TRANSCOMM = -DCSameF77 # ----------------------------------------------------------------------- # TRANSCOMM = # -------------------------------------------------------------------------- # You may choose to have the BLACS internally call either the C or Fortran77 # interface to MPI by varying the following macro. If TRANSCOMM is left # empty, the C interface BLACS_GRIDMAP/BLACS_GRIDINIT will globally-block if # you choose to use the fortran internals, and the fortran interface will # block if you choose to use the C internals. It is recommended that the # user leave this macro definition blank, unless there is a strong reason # to prefer one MPI interface over the other. # WHATMPI = -DUseF77Mpi # WHATMPI = -DUseCMpi # -------------------------------------------------------------------------- WHATMPI = # --------------------------------------------------------------------------- # Some early versions of MPICH and its derivatives cannot handle user defined # zero byte data types. If your system does, Replace the macro definition # below with the empty macro definition on the following line. # SYSERRORS = # --------------------------------------------------------------------------- SYSERRORS = -DZeroByteTypeBug # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(SENDIS) $(BUFF) $(TRANSCOMM) $(WHATMPI) \ $(SYSERRORS) -DCRAY #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f90 F77NO_OPTFLAGS = -dp F77FLAGS = $(F77NO_OPTFLAGS) -O3,aggress F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O3 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPL-SP1100644 1750 144 14666 6332725737 15457 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPL # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = SP1 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = mpxlf F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = -lsp CC = mpcc CCFLAGS = -O3 CCLOADER = $(CC) CCLOADFLAGS = -lsp # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.MPL-SP2100644 1750 144 14704 6332725737 15451 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = MPL # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = SP2 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = mpxlf F77NO_OPTFLAGS = -qarch=pwr2 F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = CC = mpcc CCFLAGS = -qarch=pwr2 -O3 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.NX-I860100644 1750 144 15556 6332725737 15376 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = NX # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- PLAT = I860 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(BTOPdir)/INSTALL/EXE # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(BTOPdir)/TESTING/EXE FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # ------------------------------------------------------------------ # This macro determines what force type message ID range the BLACS # will use. If you don't want the BLACS to use force type messages, # Use the following line: # FORCETYPE = -DBeginForceType=0 -DEndForceType=0 # ------------------------------------------------------------------ FORCETYPE = -DBeginForceType=1073741824 -DEndForceType=1999999999 # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(FORCETYPE) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = if77 F77NO_OPTFLAGS = -nx F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = $(F77) F77LOADFLAGS = -nx CC = icc CCFLAGS = -O4 -nx CCLOADER = $(CC) CCLOADFLAGS = -nx # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar860 ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-ALPHA100644 1750 144 16737 6332725737 15714 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = ALPHA # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-HPPA100644 1750 144 16753 6333143304 15576 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = HPPA # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = -DUseTIMES # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-LINUX100644 1750 144 16754 6332725737 15765 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = LINUX # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -Df77IsF2C # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -Nx400 F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = CC = gcc CCFLAGS = -O4 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-PMAX100644 1750 144 16736 6332725737 15633 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = PMAX # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-RS6K100644 1750 144 16745 6332725737 15613 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = RS6K # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DNoChange # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = xlf F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = CC = xlc CCFLAGS = -O3 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-SGI5100644 1750 144 16737 6333151773 15570 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = SGI5 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = F77FLAGS = $(F77NO_OPTFLAGS) -O3 F77LOADER = $(F77) F77LOADFLAGS = CC = gcc CCFLAGS = -O2 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = echo #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-SUN4100644 1750 144 16746 6332725737 15620 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = SUN4 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -u -f F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -O4 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/BMAKES/Bmake.PVM-SUN4SOL2100644 1750 144 16771 6332726736 16256 0ustar pfrauenfusers#============================================================================= #====================== SECTION 1: PATHS AND LIBRARIES ======================= #============================================================================= # The following macros specify the name and location of libraries required by # the BLACS and its tester. #============================================================================= # -------------------------------------- # Make sure we've got a consistent shell # -------------------------------------- SHELL = /bin/sh # ----------------------------- # The top level BLACS directory # ----------------------------- BTOPdir = $(HOME)/BLACS # --------------------------------------------------------------------------- # The communication library your BLACS have been written for. # Known choices (and the machines they run on) are: # # COMMLIB MACHINE # ....... .............................................................. # CMMD Thinking Machine's CM-5 # MPI Wide variety of systems # MPL IBM's SP series (SP1 and SP2) # NX Intel's supercomputer series (iPSC2, iPSC/860, DELTA, PARAGON) # PVM Most unix machines; See PVM User's Guide for details # --------------------------------------------------------------------------- COMMLIB = PVM # ------------------------------------------------------------- # The platform identifier to suffix to the end of library names # ------------------------------------------------------------- # PLAT = $(PVM_ARCH) PLAT = SUN4SOL2 # ---------------------------------------------------------- # Name and location of the BLACS library. See section 2 for # details on BLACS debug level (BLACSDBGLVL). # ---------------------------------------------------------- BLACSdir = $(BTOPdir)/LIB BLACSDBGLVL = 0 BLACSLIB = $(BLACSdir)/blacs_$(COMMLIB)-$(PLAT)-$(BLACSDBGLVL).a # ------------------------------------- # Name and location of the PVM library. # ------------------------------------- PVMdir = $(PVM_ROOT) PVMLIBdir = $(PVMdir)/lib/$(PLAT) PVMINCdir = $(PVMdir)/include PVMLIB = $(PVMLIBdir)/libfpvm3.a $(PVMLIBdir)/libpvm3.a # ------------------------------------- # All libraries required by the tester. # ------------------------------------- BTLIBS = $(BLACSLIB) $(PVMLIB) -lsocket -lnsl # ---------------------------------------------------------------- # The directory to put the installation help routines' executables # ---------------------------------------------------------------- INSTdir = $(HOME)/pvm3/bin/$(PLAT) # ------------------------------------------------ # The name and location of the tester's executable # ------------------------------------------------ TESTdir = $(HOME)/pvm3/bin/$(PLAT) FTESTexe = $(TESTdir)/xFbtest_$(COMMLIB)-$(BLACSDBGLVL) CTESTexe = $(TESTdir)/xCbtest_$(COMMLIB)-$(BLACSDBGLVL) #============================================================================= #=============================== End SECTION 1 =============================== #============================================================================= #============================================================================= #========================= SECTION 2: BLACS INTERNALS ======================== #============================================================================= # The following macro definitions set preprocessor values for the BLACS. # The file Bconfig.h sets these values if they are not set by the makefile. # User's compiling only the tester can skip this entire section. #============================================================================= # ----------------------------------------------------------------------- # The directory to find the required communication library include files, # if they are required by your system. # ----------------------------------------------------------------------- SYSINC = -I$(PVMINCdir) # --------------------------------------------------------------------------- # The Fortran 77 to C interface to be used. If you are unsure of the correct # setting for your platform, compile and run BLACS/INSTALL/xintface. # Choices are: Add_, NoChange, UpCase, or f77IsF2C. # --------------------------------------------------------------------------- INTFACE = -DAdd_ # -------------------------------------------------------------------- # By default, the BLACS use getrusage() to determine cputime. If this # is not satisfactory, can use times() instead, by substituting the # following line for the empty macro definition below. # WHICHTIMER = -DUseTIMES # -------------------------------------------------------------------- WHICHTIMER = # ----------------------------------------------------------------- # If you want output to go to your /tmp/pvml. files instead of # to process 0's standard out, substitute the following line for # the empty macro definition below. # CATCHOUT = -DBLACSNoCatchout # ----------------------------------------------------------------- CATCHOUT = # ------------------------------------------------------------------ # These macros set the debug level for the BLACS. The fastest # code is produced by BlacsDebugLvl 0. Higher levels provide # more debug information at the cost of performance. Present levels # of debug are: # 0 : No debug information # 1 : Mainly parameter checking. # ------------------------------------------------------------------ DEBUGLVL = -DBlacsDebugLvl=$(BLACSDBGLVL) # ------------------------------------------------------------------------- # All BLACS definitions needed for compile (DEFS1 contains definitions used # by all BLACS versions). # ------------------------------------------------------------------------- DEFS1 = -DSYSINC $(SYSINC) $(INTFACE) $(DEFBSTOP) $(DEFCOMBTOP) $(DEBUGLVL) BLACSDEFS = $(DEFS1) $(CATCHOUT) $(WHICHTIMER) #============================================================================= #=============================== End SECTION 2 =============================== #============================================================================= #============================================================================= #=========================== SECTION 3: COMPILERS ============================ #============================================================================= # The following macros specify compilers, linker/loaders, the archiver, # and their options. Some of the fortran files need to be compiled with no # optimization. This is the F77NO_OPTFLAG. The usage of the remaining # macros should be obvious from the names. #============================================================================= F77 = f77 F77NO_OPTFLAGS = -u -f F77FLAGS = $(F77NO_OPTFLAGS) -O4 F77LOADER = $(F77) F77LOADFLAGS = CC = cc CCFLAGS = -xO4 CCLOADER = $(CC) CCLOADFLAGS = # -------------------------------------------------------------------------- # The archiver and the flag(s) to use when building an archive (library). # Also the ranlib routine. If your system has no ranlib, set RANLIB = echo. # -------------------------------------------------------------------------- ARCH = ar ARCHFLAGS = r RANLIB = ranlib #============================================================================= #=============================== End SECTION 3 =============================== #============================================================================= blacs-mpi-1.1/INSTALL/ 40755 1750 144 0 6710306457 13471 5ustar pfrauenfusersblacs-mpi-1.1/INSTALL/Makefile100644 1750 144 3104 6333140156 15215 0ustar pfrauenfusersinclude ../Bmake.inc help : @ echo " " @ echo " " @ echo "You need to specify which INSTALL executable to build." @ echo "General choices are: xsize, xintface, xsyserrors" @ echo "MPI specific choices are: xsyserrors, xtc_CsameF77, xtc_UseMpich," @ echo " xcmpi_sane, xfmpi_sane" @ echo " " @ echo "Here is a brief explanation of each of these routines: " cat README xsize : $(INSTdir)/xsize xintface : $(INSTdir)/xintface xsyserrors : $(INSTdir)/xsyserrors xcmpi_sane : $(INSTdir)/xcmpi_sane xfmpi_sane : $(INSTdir)/xfmpi_sane xtc_CsameF77 : $(INSTdir)/xtc_CsameF77 xtc_UseMpich : $(INSTdir)/xtc_UseMpich $(INSTdir)/xsize : size.o $(CCLOADER) $(CCLOADFLAGS) -o $@ size.o $(INSTdir)/xintface : Fintface.o Cintface.o $(F77LOADER) $(F77LOADFLAGS) -o $@ Fintface.o Cintface.o $(INSTdir)/xsyserrors : syserrors.o $(CCLOADER) $(CCLOADFLAGS) -o $@ syserrors.o $(MPILIB) $(INSTdir)/xtc_CsameF77 : mpif.h tc_fCsameF77.o tc_cCsameF77.o $(F77LOADER) $(F77LOADFLAGS) -o $@ tc_fCsameF77.o tc_cCsameF77.o $(MPILIB) $(INSTdir)/xtc_UseMpich : tc_UseMpich.o $(CCLOADER) $(CCLOADFLAGS) -o $@ tc_UseMpich.o $(MPILIB) $(INSTdir)/xcmpi_sane : cmpi_sane.o $(CCLOADER) $(CCLOADFLAGS) -o $@ cmpi_sane.o $(MPILIB) $(INSTdir)/xfmpi_sane : mpif.h fmpi_sane.o $(F77LOADER) $(F77LOADFLAGS) -o $@ fmpi_sane.o $(MPILIB) clean: rm -f size.o Fintface.o Cintface.o syserrors.o transcomm.o \ mpi_sane.o fmpi_sane.o mpif.h : $(MPIINCdir)/mpif.h rm -f mpif.h ln -s $(MPIINCdir)/mpif.h mpif.h .f.o: ; $(F77) -c $(F77FLAGS) $*.f .c.o: $(CC) -c $(CCFLAGS) $(BLACSDEFS) $< blacs-mpi-1.1/INSTALL/Cintface.c100644 1750 144 624 6333146372 15427 0ustar pfrauenfusers#include void c_intface_(int *i) { fprintf(stderr, "For this platform, set INTFACE = -DAdd_\n"); } void c_intface(int *i) { fprintf(stderr, "For this platform, set INTFACE = -DNoChange\n"); } void c_intface__(int *i) { fprintf(stderr, "For this platform, set INTFACE = -Df77IsF2C\n"); } void C_INTFACE(int *i) { fprintf(stderr, "For this platform, set INTFACE = -DUpCase\n"); } blacs-mpi-1.1/INSTALL/Fintface.f100644 1750 144 164 6320547046 15433 0ustar pfrauenfusers program intface external c_intface integer i call c_intface(i) stop end blacs-mpi-1.1/INSTALL/cmpi_sane.c100644 1750 144 3750 6331715641 15673 0ustar pfrauenfusers#include #include "mpi.h" /* * Increase/decrease this value to test if a process of a particular size can * be spawned to a particular machine */ #define WASTE_SIZE 100 #define NPROC 4 main(int narg, char **args) /* * This program checks to make sure that you can run a basic program on your * machine using MPI. Can increase WASTE_SIZE if you think size of executable * may be causing launching problems. */ { int i, Iam, Np; int irank[NPROC]; double WasteOfSpace[WASTE_SIZE]; MPI_Comm mcom; MPI_Group wgrp, mgrp; MPI_Status stat; MPI_Init(&narg, &args); MPI_Comm_size(MPI_COMM_WORLD, &Np); if (Np < NPROC) { fprintf(stderr, "Not enough processes to run sanity check; need %d, but I've only got %d\n", NPROC, Np); MPI_Abort(MPI_COMM_WORLD, -1); } for (i=0; i != WASTE_SIZE; i++) WasteOfSpace[i] = 0.0; /* page in Waste */ /* * Form context with NPROC members */ for (i=0; i != NPROC; i++) irank[i] = i; MPI_Comm_group(MPI_COMM_WORLD, &wgrp); MPI_Group_incl(wgrp, NPROC, irank, &mgrp); MPI_Comm_create(MPI_COMM_WORLD, mgrp, &mcom); MPI_Group_free(&mgrp); /* * Everyone in new communicator sends a message to his neighbor */ if (mcom != MPI_COMM_NULL) { MPI_Comm_rank(mcom, &Iam); /* * Odd nodes receive first, so we don't hang if MPI_Send is globally blocking */ if (Iam % 2) { MPI_Recv(&i, 1, MPI_INT, (NPROC+Iam-1)%NPROC, 0, mcom, &stat); MPI_Send(&Iam, 1, MPI_INT, (Iam+1)%NPROC, 0, mcom); } else { MPI_Send(&Iam, 1, MPI_INT, (Iam+1)%NPROC, 0, mcom); MPI_Recv(&i, 1, MPI_INT, (NPROC+Iam-1)%NPROC, 0, mcom, &stat); } /* * Make sure we've received the right information */ if (i != (NPROC+Iam-1)%NPROC) { fprintf(stderr, "Communication does not seem to work properly!!\n"); MPI_Abort(MPI_COMM_WORLD, -1); } } fprintf(stdout, "%d: C MPI sanity test passed\n", Iam); MPI_Finalize(); exit(0); } blacs-mpi-1.1/INSTALL/fmpi_sane.f100644 1750 144 4416 6332415742 15701 0ustar pfrauenfusers program fmpi_sane * * This program checks to make sure that you can run a basic program * on your machine using the Fortran77 interface to MPI. * Can increase parameter wastesz, if you think size of executable * is causing launching problem. * include 'mpif.h' integer nproc, wastesz parameter (nproc = 4) parameter (wastesz = 100) integer i, Iam, Np, ierr integer mcom, wgrp, mgrp integer irank(nproc), stat(MPI_STATUS_SIZE) double precision WasteSpc(wastesz) call mpi_init(ierr) call mpi_comm_size(MPI_COMM_WORLD, Np, ierr) if (Np .lt. nproc) then print*,'Not enough processes to run sanity check' call mpi_abort(MPI_COMM_WORLD, -1, ierr) end if * * Access all of WasteSpc * do 10 i = 1, wastesz WasteSpc(i) = 0.0D0 10 continue * * Form context with NPROC members * do 20 i = 1, nproc irank(i) = i - 1 20 continue call mpi_comm_group(MPI_COMM_WORLD, wgrp, ierr) call mpi_group_incl(wgrp, nproc, irank, mgrp, ierr) call mpi_comm_create(MPI_COMM_WORLD, mgrp, mcom, ierr) call mpi_group_free(mgrp, ierr) * * Everyone in new communicator sends a message to his neighbor * if (mcom .ne. MPI_COMM_NULL) then call mpi_comm_rank(mcom, Iam, ierr) * * Odd nodes receive first, so we don't hang if MPI_Send is * globally blocking * if (mod(Iam, 2) .ne. 0) then call mpi_recv(i, 1, MPI_INTEGER, MOD(nproc+Iam-1, nproc), & 0, mcom, stat, ierr) call mpi_send(Iam, 1, MPI_INTEGER, MOD(Iam+1, nproc), & 0, mcom, ierr) else call mpi_send(Iam, 1, MPI_INTEGER, MOD(Iam+1, nproc), & 0, mcom, ierr) call mpi_recv(i, 1, MPI_INTEGER, MOD(nproc+Iam-1, nproc), & 0, mcom, stat, ierr) end if * * Make sure we've received the right information * if (i .ne. MOD(nproc+Iam-1, nproc)) then print*,'Communication does not seem to work properly!!' call mpi_abort(MPI_COMM_WORLD, -1, ierr) end if end if print*,Iam,' F77 MPI sanity test passed.' call mpi_finalize(ierr) stop end blacs-mpi-1.1/INSTALL/size.c100644 1750 144 303 6313276046 14657 0ustar pfrauenfusers#include main() { printf("ISIZE=%d\nSSIZE=%d\nDSIZE=%d\nCSIZE=%d\nZSIZE=%d\n", sizeof(int), sizeof(float), sizeof(double), 2*sizeof(float), 2*sizeof(double)); } blacs-mpi-1.1/INSTALL/syserrors.c100644 1750 144 1423 6332423552 16001 0ustar pfrauenfusers#include #include main(int nargs, char **args) { MPI_Datatype Dtype, Dt; int i, j, ierr; MPI_Init(&nargs, &args); printf( "If this routine does not complete, you should set SYSERRORS = -DZeroByteTypeBug.\n"); i = 0; j = 1; ierr = MPI_Type_indexed(1, &i, &j, MPI_INT, &Dtype); if (ierr == MPI_SUCCESS) { MPI_Type_commit(&Dtype); ierr = MPI_Type_vector(0, 1, 1, MPI_INT, &Dt); if (ierr != MPI_SUCCESS) printf("MPI_Type_vector returned %d, set SYSERRORS = -DZeroByteTypeBug\n", ierr); else MPI_Type_commit(&Dt); } else printf("MPI_Type_commit returned %d, set SYSERRORS = -DZeroByteTypeBug\n", ierr); if (ierr == MPI_SUCCESS) printf("Leave SYSERRORS blank for this system.\n"); MPI_Finalize(); } blacs-mpi-1.1/INSTALL/tc_UseMpich.c100644 1750 144 1251 6333151043 16122 0ustar pfrauenfusers#include #include main() { MPI_Comm ccomm; int fcomm; extern void *MPIR_ToPointer(); extern int MPIR_FromPointer(); extern void *MPIR_RmPointer(); if (sizeof(int) < sizeof(int*)) { fcomm = MPIR_FromPointer(MPI_COMM_WORLD); ccomm = (MPI_Comm) MPIR_ToPointer(fcomm); if (ccomm == MPI_COMM_WORLD) printf("Set TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1\n"); else printf("Do _NOT_ set TRANSCOMM = -DUseMpich -DPOINTER_64_BITS=1\n"); } else { printf("Compile and run xtc_CsameF77 for correct TRANSCOMM setting.\n"); printf("If xtc_CsameF77 fails, leave TRANSCOMM blank.\n"); } } blacs-mpi-1.1/INSTALL/tc_cCsameF77.c100644 1750 144 1512 6331706213 16067 0ustar pfrauenfusers#include int Ccommcheck(int F77World, int f77comm) { int Np, Iam, i, OK=1; if (sizeof(int) != sizeof(MPI_Comm)) OK=0; else if ((MPI_Comm) F77World != MPI_COMM_WORLD) OK=0; else { MPI_Comm_rank(MPI_COMM_WORLD, &Iam); if (Iam > 1) OK = ((MPI_Comm) f77comm == MPI_COMM_NULL); else { i = MPI_Comm_size((MPI_Comm) f77comm, &Np); if (i != MPI_SUCCESS) OK = 0; else if (Np != 2) OK = 0; } } MPI_Allreduce(&OK, &i, 1, MPI_INT, MPI_MIN, MPI_COMM_WORLD); return(i); } /* * Fortran interfaces */ int CCOMMCHECK(int *F77World, int *f77comm) { return(Ccommcheck(*F77World, *f77comm)); } int ccommcheck_(int *F77World, int *f77comm) { return(Ccommcheck(*F77World, *f77comm)); } int ccommcheck(int *F77World, int *f77comm) { return(Ccommcheck(*F77World, *f77comm)); } blacs-mpi-1.1/INSTALL/tc_fCsameF77.f100644 1750 144 2477 6333133057 16112 0ustar pfrauenfusers program tctst include 'mpif.h' integer f77com, wgrp, f77grp, Iam, i, ierr integer irank(2) external Ccommcheck integer Ccommcheck call mpi_init(ierr) call mpi_comm_size(MPI_COMM_WORLD, i, ierr) call mpi_comm_rank(MPI_COMM_WORLD, Iam, ierr) if (i .lt. 2) then print*,'Need at least 2 processes to run test, aborting.' else if (Iam .eq. 0) then print*,'If this routine does not complete successfully,' print*,'Do _NOT_ set TRANSCOMM = -DCSameF77' print*,' ' print*,' ' end if * * Form context with 2 members * irank(1) = 0 irank(2) = 1 call mpi_comm_group(MPI_COMM_WORLD, wgrp, ierr) call mpi_group_incl(wgrp, 2, irank, f77grp, ierr) call mpi_comm_create(MPI_COMM_WORLD, f77grp, f77com, ierr) call mpi_group_free(f77grp, ierr) i = Ccommcheck(MPI_COMM_WORLD, f77com) if (Iam .eq. 0) then if (i .eq. 0) then print*,'Do _NOT_ set TRANSCOMM = -DCSameF77' else print*,'Set TRANSCOMM = -DCSameF77' end if end if if (f77grp .ne. MPI_COMM_NULL) call mpi_comm_free(f77com, ierr) end if call mpi_finalize(ierr) stop end blacs-mpi-1.1/INSTALL/README100644 1750 144 2325 6331734140 14441 0ustar pfrauenfusersThese routines help to configure the BLACS and its tester during installation. See the paper "Installing and testing the BLACS" for details. xintface will tell you the correct setting for Bmake.inc's INTFACE macro. xsize prints out the correct sizes for various data types, which are hardwired in btprim_PVM.c ibtsizeof. ============================ MPI SPECIFIC ROUTINES ============================ xsyserrors indicates the correct setting for Bmake.inc's SYSERRORS macro. xcmpi_sane will give you a sanity test to see if the most basic MPI program will run on your system using the C interface to MPI. xfmpi_sane will give you a sanity test to see if the most basic MPI program will run on your system using the Fortran77 interface to MPI. ***** FINDING THE CORRECT TRANSCOMM SETTING ***** The remaining routines exist in order to allow the user to find the correct setting for Bmake.inc's TRANSCOMM macro. THESE ROUTINES USE HEURISTICS, AND THUS MAY BE INCORRECT. First make and run xtc_CsameF77. If this reports back not to set TRANSCOMM to -DCSameF77 or does not complete, make and run xtc_UseMpich. If this fails to compile or does not tell you what to set TRANSCOMM to, you must leave TRANSCOMM blank. blacs-mpi-1.1/INSTALL/EXE/ 40755 1750 144 0 6710306457 14112 5ustar pfrauenfusersblacs-mpi-1.1/INSTALL/EXE/Makefile100644 1750 144 561 6331712470 15624 0ustar pfrauenfusersxsize : ( cd ../ ; make xsize ) xintface : ( cd ../ ; make xintface ) xsyserrors : ( cd ../ ; make xsyserrors ) xtranscomm : ( cd ../ ; make xtranscomm ) xmpi_sane : ( cd ../ ; make xmpi_sane ) xfmpi_sane : ( cd ../ ; make xfmpi_sane ) xtc_CsameF77: ( cd ../ ; make xtc_CsameF77 ) xtc_UseMpich: ( cd ../ ; make xtc_UseMpich ) clean: ( cd ../ ; make clean ) blacs-mpi-1.1/LIB/ 40755 1750 144 0 6710306457 12771 5ustar pfrauenfusersblacs-mpi-1.1/LIB/LIB.log100644 1750 144 342 6313274057 14155 0ustar pfrauenfusers LIBRARY COMPILE FLAGS BlacsDebugLvl DATE BUILT BY ---------------- ------------- ------------- -------- -------------- Blacs_sun4-0.a -O4 0 11/09/69 Joe Bozo blacs-mpi-1.1/Makefile100644 1750 144 2145 6326225475 14125 0ustar pfrauenfusershelp : @ echo @ echo "Make sure you are using the correct Bmake.inc for your system." @ echo "At this level, assuming you have downloaded the necessary files," @ echo "you may make the BLACS tester (make tester), or one of the BLACS" @ echo "versions (make cmmd, make mpl, make nx, or make pvm)" @ echo "You can define the make macro 'what' to perform a specific action." @ echo "(eg., make tester what=clean)" @ echo "There are short README files in TESTING/ and SRC/." @ echo all : mpi cmmd mpl nx pvm tester cleanall: ( cd TESTING ; make clean ) ( cd SRC/CMMD ; make clean ) ( cd SRC/MPL ; make clean ) ( cd SRC/NX ; make clean ) ( cd SRC/PVM ; make clean ) testing: tester xbtest : tester test : tester tester : ( cd TESTING ; make $(what) ) CM5 : CMMD cmmd : CMMD CMMD : ( cd SRC/CMMD ; make $(what) ) SP1 : MPL SP2 : MPL mpl : MPL MPL : ( cd SRC/MPL ; make $(what) ) intel : NX ipsc2 : NX i860 : NX delta : NX gamma : NX paragon : NX nx : NX NX : ( cd SRC/NX ; make $(what) ) pvm : PVM PVM : ( cd SRC/PVM ; make $(what) ) mpi : MPI MPI : ( cd SRC/MPI ; make $(what) ) blacs-mpi-1.1/README100644 1750 144 2511 6326225347 13340 0ustar pfrauenfusersAll users of the BLACS should read "A User's Guide to the BLACS v1.1". Users may also be interested in the quick reference guides for the C and Fortran77 interfaces to the BLACS. Before you can compile anything, you must first edit and correct the file BLACS/Bmake.inc. Sample Bmake.inc's can be found in the BLACS/BMAKES directories. See the paper "Installing and Testing the BLACS" for details. Users of the MPIBLACS should also read the two small notes on the BLACS and their interaction with MPI: "Outstanding Issues in the MPIBLACS", and "Some Plebian Extensions to MPI". All of these papers are available in the blacs/ directory on netlib. If you possess mosaic, these papers may be downloaded by accessing URL = http://www.netlib.org/blacs/Blacs.html. This is the BLACS homepage, and provides documentation and troubleshooting. Downloading by anonymous ftp can be accomplished by "ftp ftp.netlib.org" directory "blacs/". To download the files via netlib's e-mail option, type "mail netlib@www.netlib.org", and in the body of the message type "send FILE from blacs". More details on downloading are available in the paper "Installing and Testing the BLACS", whose filename on netlib is "blacs_install.ps". If you have questions or comments that are not addressed by these papers or the BLACS homepage, send e-mail to blacs@cs.utk.edu. blacs-mpi-1.1/SRC/ 40755 1750 144 0 6710306457 13012 5ustar pfrauenfusersblacs-mpi-1.1/SRC/README100644 1750 144 515 6316034174 13744 0ustar pfrauenfusers(1) To compile, just go to the BLACS directory you want to build, and type "make". You must first edit and correct the file BLACS/Bmake.inc. Sample Bmake.inc's can be found in the BLACS/BMAKES directory. (2) Type "make clean" to get rid of old .o files. (3) All of this may be done from the top-level makefile. blacs-mpi-1.1/SRC/MPI/ 40755 1750 144 0 6710306457 13437 5ustar pfrauenfusersblacs-mpi-1.1/SRC/MPI/Makefile100644 1750 144 20700 6331714551 15210 0ustar pfrauenfusersdlvl = ../.. include $(dlvl)/Bmake.inc # -------------------------- # The communication routines # -------------------------- comm = igesd2d_.o sgesd2d_.o dgesd2d_.o cgesd2d_.o zgesd2d_.o \ itrsd2d_.o strsd2d_.o dtrsd2d_.o ctrsd2d_.o ztrsd2d_.o \ igerv2d_.o sgerv2d_.o dgerv2d_.o cgerv2d_.o zgerv2d_.o \ itrrv2d_.o strrv2d_.o dtrrv2d_.o ctrrv2d_.o ztrrv2d_.o \ igebs2d_.o sgebs2d_.o dgebs2d_.o cgebs2d_.o zgebs2d_.o \ igebr2d_.o sgebr2d_.o dgebr2d_.o cgebr2d_.o zgebr2d_.o \ itrbs2d_.o strbs2d_.o dtrbs2d_.o ctrbs2d_.o ztrbs2d_.o \ itrbr2d_.o strbr2d_.o dtrbr2d_.o ctrbr2d_.o ztrbr2d_.o \ igsum2d_.o sgsum2d_.o dgsum2d_.o cgsum2d_.o zgsum2d_.o \ igamx2d_.o sgamx2d_.o dgamx2d_.o cgamx2d_.o zgamx2d_.o \ igamn2d_.o sgamn2d_.o dgamn2d_.o cgamn2d_.o zgamn2d_.o # ----------------------------------------------------------------------------- # These names are too long for the archiver to distinguish based on the suffix. # I'm going to use logical links to get around this problem. It's hokey, but # it lets us use the suffix rule and keep the makefile portable. # ----------------------------------------------------------------------------- long = blacs_gridinit_.o blacs_gridmap_.o blacs_freebuff_.o \ blacs_gridexit_.o blacs_gridinfo_.o blacs_barrier_.o \ sys2blacs_handle_.o free_blacs_system_handle_.o \ blacs2sys_handle_.o Clong = Cblacs_gridinit_.C Cblacs_gridmap_.C Cblacs_freebuff_.C \ Cblacs_gridexit_.C Cblacs_gridinfo_.C Cblacs_barrier_.C \ Csys2blacs_handle_.C Cfree_blacs_system_handle_.C \ Cblacs2sys_handle_.C # -------------------- # The support routines # -------------------- supp = blacs_setup_.o blacs_set_.o blacs_get_.o \ blacs_abort_.o blacs_exit_.o blacs_pnum_.o blacs_pcoord_.o \ ksendid_.o krecvid_.o kbsid_.o kbrid_.o \ dcputime00_.o dwalltime00_.o # ---------------------------- # The fortran and C interfaces # ---------------------------- Fintobj = $(comm) $(supp) $(long) Cintobj = $(comm:.o=.C) $(supp:.o=.C) $(Clong) # --------------------- # The internal routines # --------------------- internal = BI_HypBS.o BI_HypBR.o BI_IdringBS.o BI_IdringBR.o \ BI_MpathBS.o BI_MpathBR.o BI_SringBS.o BI_SringBR.o \ BI_TreeBS.o BI_TreeBR.o \ BI_Ssend.o BI_Rsend.o BI_Srecv.o BI_Asend.o BI_Arecv.o \ BI_TreeComb.o BI_BeComb.o BI_MringComb.o \ BI_ArgCheck.o BI_TransDist.o BI_GetBuff.o BI_UpdateBuffs.o \ BI_EmergencyBuff.o BI_BlacsErr.o BI_BlacsWarn.o BI_BlacsAbort.o \ BI_BuffIsFree.o BI_imvcopy.o BI_smvcopy.o BI_dmvcopy.o \ BI_ivmcopy.o BI_svmcopy.o BI_dvmcopy.o \ BI_Pack.o BI_Unpack.o BI_GetMpiGeType.o BI_GetMpiTrType.o \ BI_ivvsum.o BI_svvsum.o BI_dvvsum.o BI_cvvsum.o BI_zvvsum.o \ BI_ivvamx.o BI_svvamx.o BI_dvvamx.o BI_cvvamx.o BI_zvvamx.o \ BI_ivvamx2.o BI_svvamx2.o BI_dvvamx2.o BI_cvvamx2.o BI_zvvamx2.o \ BI_ivvamn.o BI_svvamn.o BI_dvvamn.o BI_cvvamn.o BI_zvvamn.o \ BI_ivvamn2.o BI_svvamn2.o BI_dvvamn2.o BI_cvvamn2.o BI_zvvamn2.o \ BI_iMPI_amx.o BI_sMPI_amx.o BI_dMPI_amx.o BI_cMPI_amx.o \ BI_zMPI_amx.o BI_iMPI_amx2.o BI_sMPI_amx2.o BI_dMPI_amx2.o \ BI_cMPI_amx2.o BI_zMPI_amx2.o BI_iMPI_amn.o BI_sMPI_amn.o \ BI_dMPI_amn.o BI_cMPI_amn.o BI_zMPI_amn.o BI_iMPI_amn2.o \ BI_sMPI_amn2.o BI_dMPI_amn2.o BI_cMPI_amn2.o BI_zMPI_amn2.o \ BI_cMPI_sum.o BI_zMPI_sum.o BI_ContxtNum.o BI_GlobalVars.o \ BI_MPI_F77_to_c_trans_comm.o BI_MPI_C_to_f77_trans_comm.o \ BI_TransUserComm.o bi_f77_mpi_attr_get.o bi_f77_mpi_op_create.o \ bi_f77_mpi_initialized.o bi_f77_mpi_test.o bi_f77_mpi_testall.o \ bi_f77_get_constants.o lib : all f77lib : flib F77lib : flib Clib : clib # --------------------------------------- # Make both C and fortran interface BLACS # --------------------------------------- all : INTERN $(Fintobj) $(Cintobj) rm -f $(BLACSFINIT) $(BLACSCINIT) make $(BLACSFINIT) make $(BLACSCINIT) $(ARCH) $(ARCHFLAGS) $(BLACSLIB) $(Fintobj) $(Cintobj) $(RANLIB) $(BLACSLIB) $(BLACSFINIT) : $(CC) -o Cblacs_pinfo.o -c $(CCFLAGS) $(BLACSDEFS) -DCallFromC -DMainInF77 \ blacs_pinfo_.c $(CC) -c $(CCFLAGS) $(BLACSDEFS) -DMainInF77 blacs_pinfo_.c $(ARCH) $(ARCHFLAGS) $(BLACSFINIT) blacs_pinfo_.o Cblacs_pinfo.o $(RANLIB) $(BLACSFINIT) $(BLACSCINIT) : $(CC) -o Cblacs_pinfo.o -c $(CCFLAGS) $(BLACSDEFS) -DCallFromC -DMainInC \ blacs_pinfo_.c $(CC) -c $(CCFLAGS) $(BLACSDEFS) -DMainInC blacs_pinfo_.c $(ARCH) $(ARCHFLAGS) $(BLACSCINIT) blacs_pinfo_.o Cblacs_pinfo.o $(RANLIB) $(BLACSCINIT) # ------------------ # Make the internals # ------------------ INTERN : ( cd INTERNAL ; $(MAKE) -f ../Makefile I_int "dlvl=$(BTOPdir)" ) I_int : Bdef.h Bconfig.h $(internal) $(ARCH) $(ARCHFLAGS) $(BLACSLIB) $(internal) Bdef.h : ../Bdef.h rm -f Bdef.h ln -s ../Bdef.h Bdef.h Bconfig.h : ../Bconfig.h rm -f Bconfig.h ln -s ../Bconfig.h Bconfig.h # ----------------------- # Delete the object files # ----------------------- clean : rm -f $(Cintobj) $(Fintobj) $(long:.o=.C) rm -f blacs_pinfo_.o Cblacs_pinfo.o ( cd INTERNAL ; rm -f bi_f77_get_constants.o bi_f77_mpi_attr_get.o \ bi_f77_mpi_initialized.o bi_f77_mpi_op_create.o \ bi_f77_mpi_test.o bi_f77_mpi_testall.o \ Bdef.h Bconfig.h mpif.h ) ( cd INTERNAL ; rm -f $(internal) ) # ------------------------------------- # Delete the library, object and source # ------------------------------------- killib : $(MAKE) clean rm -f $(Fintobj:.o=.c) Bdef.h Bconfig.h rm -f blacs_pinfo_.c ( cd INTERNAL ; rm -f $(internal:.o=.c) Bdef.h Bconfig.h ) ( cd INTERNAL ; rm -f bi_f77_get_constants.f bi_f77_mpi_attr_get.f \ bi_f77_mpi_initialized.f bi_f77_mpi_op_create.f \ bi_f77_mpi_test.f bi_f77_mpi_testall.f mpif.h ) # ------------------------------------------------------------------------- # Establish how to make logical links to the long-name C interface routines # that are distinct in first 13 characters from their Fortran interface # equivalents. # ------------------------------------------------------------------------- Cblacs_gridinit_.C : blacs_gridinit_.C rm -f Cblacs_gridinit_.C ln -s blacs_gridinit_.C Cblacs_gridinit_.C Cblacs_gridinfo_.C : blacs_gridinfo_.C rm -f Cblacs_gridinfo_.C ln -s blacs_gridinfo_.C Cblacs_gridinfo_.C Cblacs_gridexit_.C : blacs_gridexit_.C rm -f Cblacs_gridexit_.C ln -s blacs_gridexit_.C Cblacs_gridexit_.C Cblacs_gridmap_.C : blacs_gridmap_.C rm -f Cblacs_gridmap_.C ln -s blacs_gridmap_.C Cblacs_gridmap_.C Cblacs_freebuff_.C : blacs_freebuff_.C rm -f Cblacs_freebuff_.C ln -s blacs_freebuff_.C Cblacs_freebuff_.C Cblacs_barrier_.C : blacs_barrier_.C rm -f Cblacs_barrier_.C ln -s blacs_barrier_.C Cblacs_barrier_.C Csys2blacs_handle_.C : sys2blacs_handle_.C rm -f Csys2blacs_handle_.C ln -s sys2blacs_handle_.C Csys2blacs_handle_.C Cblacs2sys_handle_.C : blacs2sys_handle_.C rm -f Cblacs2sys_handle_.C ln -s blacs2sys_handle_.C Cblacs2sys_handle_.C Cfree_blacs_system_handle_.C : free_blacs_system_handle_.C rm -f Cfree_blacs_system_handle_.C ln -s free_blacs_system_handle_.C Cfree_blacs_system_handle_.C # ------------------------------------- # Compile the (ouch!) fortran internals # ------------------------------------- bi_f77_get_constants.o : mpif.h bi_f77_get_constants.f $(F77) -c $(F77FLAGS) $*.f bi_f77_mpi_attr_get.o : mpif.h bi_f77_mpi_attr_get.f $(F77) -c $(F77FLAGS) $*.f bi_f77_mpi_initialized.o : mpif.h bi_f77_mpi_initialized.f $(F77) -c $(F77FLAGS) $*.f bi_f77_mpi_op_create.o : mpif.h bi_f77_mpi_op_create.f $(F77) -c $(F77FLAGS) $*.f bi_f77_mpi_test.o : mpif.h bi_f77_mpi_test.f $(F77) -c $(F77FLAGS) $*.f bi_f77_mpi_testall.o : mpif.h bi_f77_mpi_testall.f $(F77) -c $(F77FLAGS) $*.f mpif.h : $(MPIINCdir)/mpif.h rm -f mpif.h ln -s $(MPIINCdir)/mpif.h mpif.h # ------------------------------------------------------------------------ # We move C .o files to .C so that we can use the portable suffix rule for # compilation, and still have them coexist with the fortran interface # .o files. # ------------------------------------------------------------------------ .SUFFIXES: .o .C .c.C: $(CC) -o C$*.o -c $(CCFLAGS) $(BLACSDEFS) -DCallFromC $< mv C$*.o $*.C .c.o: $(CC) -c $(CCFLAGS) $(BLACSDEFS) $< blacs-mpi-1.1/SRC/MPI/blacs2sys_handle_.c100644 1750 144 1466 6316033743 17263 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) BI_MPI_Comm Cblacs2sys_handle(int BlacsCtxt) #else int blacs2sys_handle_(int *BlacsCtxt) #endif { #if (INTFACE == C_CALL) int i[2]; extern int BI_MaxNSysCtxt; extern BI_MPI_Comm *BI_SysContxts; if (BI_F77_MPI_COMM_WORLD == NULL) Cblacs_pinfo(i, &i[1]); if ( (BlacsCtxt >= BI_MaxNSysCtxt) || (BlacsCtxt < 0) ) { BI_BlacsErr(-1, __LINE__, __FILE__, "No system context corresponding to BLACS system context handle %d\n", BlacsCtxt); } else if (BI_SysContxts[BlacsCtxt] == BI_MPI_COMM_NULL) { BI_BlacsErr(-1, __LINE__, __FILE__, "No system context corresponding to BLACS system context handle %d\n", BlacsCtxt); } return(BI_SysContxts[BlacsCtxt]); #else return(*BlacsCtxt); #endif } blacs-mpi-1.1/SRC/MPI/blacs_abort_.c100644 1750 144 1063 6316033743 16307 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_abort(int ConTxt, int ErrNo) #else F_VOID_FUNC blacs_abort_(int *ConTxt, int *ErrNo) #endif { void Cblacs_gridinfo(int, int *, int *, int *, int *); void BI_BlacsAbort(int ErrNo); int nprow, npcol, myrow, mycol; extern int BI_Iam; Cblacs_gridinfo(Mpval(ConTxt), &nprow, &npcol, &myrow, &mycol); fprintf(stderr, "{%d,%d}, pnum=%d, Contxt=%d, killed other procs, exiting with error #%d.\n\n", myrow, mycol, BI_Iam, Mpval(ConTxt), Mpval(ErrNo)); BI_BlacsAbort(Mpval(ErrNo)); } blacs-mpi-1.1/SRC/MPI/blacs_barrier_.c100644 1750 144 1051 6316033743 16623 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_barrier(int ConTxt, char *scope) #else F_VOID_FUNC blacs_barrier_(int *ConTxt, F_CHAR scope) #endif { char tscope; int ierr; BLACSCONTEXT *ctxt; tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); MGetConTxt(Mpval(ConTxt), ctxt); switch(tscope) { case 'r': BI_MPI_Barrier(ctxt->rscp.comm, ierr); break; case 'c': BI_MPI_Barrier(ctxt->cscp.comm, ierr); break; case 'a': BI_MPI_Barrier(ctxt->ascp.comm, ierr); break; } } blacs-mpi-1.1/SRC/MPI/blacs_exit_.c100644 1750 144 2100 6327204026 16136 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_exit(int NotDone) #else F_VOID_FUNC blacs_exit_(int *NotDone) #endif { void Cblacs_gridexit(int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BLACBUFF *bp; extern BLACBUFF *BI_ReadyB, *BI_ActiveQ, BI_AuxBuff; int i; extern int BI_MaxNCtxt, BI_Np; extern BLACSCONTEXT **BI_MyContxts; /* * Destroy all contexts */ for (i=0; i < BI_MaxNCtxt; i++) if (BI_MyContxts[i]) Cblacs_gridexit(i); free(BI_MyContxts); if (BI_ReadyB) free(BI_ReadyB); while (BI_ActiveQ != NULL) { bp = BI_ActiveQ; BI_BuffIsFree(bp, 1); /* wait for async sends to complete */ BI_ActiveQ = bp->next; free(bp); } free (BI_AuxBuff.Aops); /* * Reset parameters to initial values */ BI_MaxNCtxt = 0; BI_MyContxts = NULL; BI_Np = -1; #ifndef UseF77Mpi BI_MPI_Type_free(&BI_MPI_COMPLEX, i); BI_MPI_Type_free(&BI_MPI_DOUBLE_COMPLEX, i); #endif if (!Mpval(NotDone)) { BI_MPI_Finalize(i); } BI_ReadyB = NULL; } blacs-mpi-1.1/SRC/MPI/blacs_freebuff_.c100644 1750 144 771 6316033743 16751 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_freebuff(int ConTxt, int Wait) #else F_VOID_FUNC blacs_freebuff_(int *ConTxt, int *Wait) #endif { void BI_UpdateBuffs(BLACBUFF *); int BI_BuffIsFree(BLACBUFF *, int); extern BLACBUFF *BI_ReadyB, *BI_ActiveQ; if (Mpval(Wait)) /* wait for all buffers to be done */ { while (BI_ActiveQ != NULL) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(NULL); if (BI_ReadyB) { free(BI_ReadyB); BI_ReadyB = NULL; } } blacs-mpi-1.1/SRC/MPI/blacs_get_.c100644 1750 144 5164 6316033743 15765 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_get(int ConTxt, int what, int *val) #else F_VOID_FUNC blacs_get_(int *ConTxt, int *what, int *val) #endif { int Csys2blacs_handle(MPI_Comm); int ierr, *iptr; #ifdef UseF77Mpi MPI_Comm comm; #else int comm; #endif BLACSCONTEXT *ctxt; switch( Mpval(what) ) { case SGET_SYSCONTXT: if (BI_F77_MPI_COMM_WORLD == NULL) Cblacs_pinfo(val, &ierr); #if (INTFACE == C_CALL) *val = Csys2blacs_handle(MPI_COMM_WORLD); #else *val = *BI_F77_MPI_COMM_WORLD; #endif break; case SGET_MSGIDS: if (BI_F77_MPI_COMM_WORLD == NULL) Cblacs_pinfo(val, &val[1]); iptr = &val[1]; BI_MPI_Attr_get(BI_MPI_COMM_WORLD, BI_MPI_TAG_UB, (BVOID **) &iptr, val, ierr); val[0] = 0; val[1] = *iptr; break; case SGET_DEBUGLVL: *val = BlacsDebugLvl; break; case SGET_BLACSCONTXT: MGetConTxt(Mpval(ConTxt), ctxt); #if (INTFACE == C_CALL) #ifdef UseF77Mpi #if (BI_TransComm == BONEHEAD) if (ctxt->C_comm == MPI_COMM_NULL) { BI_MPI_F77_to_c_trans_comm(ctxt->pscp.comm, &ctxt->C_comm); } *val = Csys2blacs_handle(ctxt->C_comm); #else BI_MPI_F77_to_c_trans_comm(ctxt->pscp.comm, &comm); *val = Csys2blacs_handle(comm); #endif #else /* we are returning a C handle, and using the C MPI interface */ *val = Csys2blacs_handle(ctxt->pscp.comm); #endif #else /* if user called the fortran interface to the BLACS */ #ifdef UseF77Mpi *val = ctxt->pscp.comm; #else /* User called F77 interface, but we're using C interface MPI */ #if (BI_TransComm == BONEHEAD) if (ctxt->F77_comm == NULL) { ctxt->F77_comm = (int *) malloc(sizeof(int)); BI_MPI_C_to_f77_trans_comm(ctxt->pscp.comm, ctxt->F77_comm); } *val = *ctxt->F77_comm; #else BI_MPI_C_to_f77_trans_comm(ctxt->pscp.comm, &comm); *val = comm; #endif #endif #endif break; case SGET_NR_BS: MGetConTxt(Mpval(ConTxt), ctxt); *val = ctxt->Nr_bs; break; case SGET_NB_BS: MGetConTxt(Mpval(ConTxt), ctxt); *val = ctxt->Nb_bs - 1; break; case SGET_NR_CO: MGetConTxt(Mpval(ConTxt), ctxt); *val = ctxt->Nr_co; break; case SGET_NB_CO: MGetConTxt(Mpval(ConTxt), ctxt); *val = ctxt->Nb_co - 1; break; case SGET_TOPSREPEAT: MGetConTxt(Mpval(ConTxt), ctxt); *val = ctxt->TopsRepeat; break; case SGET_TOPSCOHRNT: MGetConTxt(Mpval(ConTxt), ctxt); *val = ctxt->TopsCohrnt; break; default: BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Unknown WHAT (%d)", Mpval(what)); } } blacs-mpi-1.1/SRC/MPI/blacs_gridexit_.c100644 1750 144 2135 6316033743 17020 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_gridexit(int ConTxt) #else F_VOID_FUNC blacs_gridexit_(int *ConTxt) #endif { int i; BLACSCONTEXT *ctxt; extern int BI_MaxNCtxt; extern BLACSCONTEXT **BI_MyContxts; if ( (Mpval(ConTxt) < 0) || (Mpval(ConTxt) >= BI_MaxNCtxt) ) BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Trying to exit non-existent context"); if (BI_MyContxts[Mpval(ConTxt)] == NULL) BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Trying to exit an already freed context"); MGetConTxt(Mpval(ConTxt), ctxt); /* * Destroy context */ BI_MPI_Comm_free(&ctxt->pscp.comm, i); BI_MPI_Comm_free(&ctxt->ascp.comm, i); BI_MPI_Comm_free(&ctxt->rscp.comm, i); BI_MPI_Comm_free(&ctxt->cscp.comm, i); #if (BI_TransComm == BONEHEAD) #ifdef UseF77Mpi if (ctxt->C_comm != MPI_COMM_NULL) MPI_Comm_free(&ctxt->C_comm); #else if (ctxt->F77_comm != NULL) { mpi_comm_free_(ctxt->F77_comm, &i); free(ctxt->F77_comm); ctxt->F77_comm = NULL; } #endif #endif free(ctxt); BI_MyContxts[Mpval(ConTxt)] = NULL; } blacs-mpi-1.1/SRC/MPI/blacs_gridinfo_.c100644 1750 144 1477 6316033743 17012 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_gridinfo(int ConTxt, int *nprow, int *npcol, int *myrow, int *mycol) #else F_VOID_FUNC blacs_gridinfo_(int *ConTxt, int *nprow, int *npcol, int *myrow, int *mycol) #endif { extern BLACSCONTEXT **BI_MyContxts; extern int BI_MaxNCtxt; BLACSCONTEXT *ctxt; /* * Make sure context handle is in range */ if ( (Mpval(ConTxt) >= 0) && (Mpval(ConTxt) < BI_MaxNCtxt) ) { /* * Make sure context is still defined */ ctxt = BI_MyContxts[Mpval(ConTxt)]; if (ctxt != NULL) { *nprow = ctxt->cscp.Np; *npcol = ctxt->rscp.Np; *myrow = ctxt->cscp.Iam; *mycol = ctxt->rscp.Iam; } else *nprow = *npcol = *myrow = *mycol = -1; } else *nprow = *npcol = *myrow = *mycol = -1; } blacs-mpi-1.1/SRC/MPI/blacs_gridinit_.c100644 1750 144 2006 6316033743 17007 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Cblacs_gridinit(int *ConTxt, char *order, int nprow, int npcol) #else F_VOID_FUNC blacs_gridinit_(int *ConTxt, F_CHAR order, int *nprow, int *npcol) #endif { void Cblacs_gridmap(int *, int *, int, int, int); int *tmpgrid, *iptr; int i, j; /* * Grid can be row- or column-major natural ordering when blacs_gridinit is * called. Define a tmpgrid to reflect this, and call blacs_gridmap to * set it up */ iptr = tmpgrid = (int*) malloc( Mpval(nprow)*Mpval(npcol)*sizeof(*tmpgrid) ); if (Mlowcase(F2C_CharTrans(order)) == 'c') { i = Mpval(npcol) * Mpval(nprow); for (j=0; j < i; j++) iptr[j] = j; } else { for (j=0; j < Mpval(npcol); j++) { for (i=0; i < Mpval(nprow); i++) iptr[i] = i * Mpval(npcol) + j; iptr += Mpval(nprow); } } #if (INTFACE == C_CALL) Cblacs_gridmap(ConTxt, tmpgrid, nprow, nprow, npcol); #else blacs_gridmap_(ConTxt, tmpgrid, nprow, nprow, npcol); #endif free(tmpgrid); } blacs-mpi-1.1/SRC/MPI/blacs_gridmap_.c100644 1750 144 13212 6327211452 16637 0ustar pfrauenfusers#include "Bdef.h" /* This file from mpiblacs_patch01 */ #if (INTFACE == C_CALL) void Cblacs_gridmap(int *ConTxt, int *usermap, int ldup, int nprow0, int npcol0) #else F_VOID_FUNC blacs_gridmap_(int *ConTxt, int *usermap, int *ldup, int *nprow0, int *npcol0) #endif { void Cblacs_pinfo(int *, int *); void Cblacs_get(int, int, int *); #ifdef UseF77Mpi int BI_TransUserComm(MPI_Comm, int, int *); #else MPI_Comm BI_TransUserComm(int, int, int *); #endif MPI_Comm Cblacs2sys_handle(int); int info, i, j, Iam, *iptr; int myrow, mycol, nprow, npcol, Ng; BLACSCONTEXT *ctxt, **tCTxts; BI_MPI_Comm comm, tcomm; BI_MPI_Group grp, tgrp; #if (BI_TransComm == BONEHEAD) #ifdef UseF77Mpi MPI_Comm Ucomm, Ccomm=MPI_COMM_NULL; MPI_Group Cgrp, Cgrp2; #else int Fgrp, Fgrp2, *Fcomm=NULL; #endif #endif extern BLACSCONTEXT **BI_MyContxts; extern BLACBUFF BI_AuxBuff; extern int BI_Iam, BI_Np, BI_MaxNCtxt; extern BI_MPI_Status *BI_Stats; /* * If first call to blacs_gridmap */ if (BI_MaxNCtxt == 0) { Cblacs_pinfo(&BI_Iam, &BI_Np); BI_AuxBuff.nAops = 0; BI_AuxBuff.Aops = (BI_MPI_Request*)malloc(BI_Np*sizeof(*BI_AuxBuff.Aops)); BI_Stats = (BI_MPI_Status *) malloc(BI_Np * BI_MPI_STATUS_SIZE * sizeof(BI_MPI_Status)); #ifndef UseF77Mpi BI_MPI_Type_contiguous(2, MPI_FLOAT, &BI_MPI_COMPLEX, info); BI_MPI_Type_commit(&BI_MPI_COMPLEX, info); BI_MPI_Type_contiguous(2, MPI_DOUBLE, &BI_MPI_DOUBLE_COMPLEX, info); BI_MPI_Type_commit(&BI_MPI_DOUBLE_COMPLEX, info); #endif } nprow = Mpval(nprow0); npcol = Mpval(npcol0); Ng = nprow * npcol; if ( (Ng > BI_Np) || (nprow < 1) || (npcol < 1) ) BI_BlacsErr(-1, -1, "BLACS_GRIDINIT/BLACS_GRIDMAP", "Illegal grid (%d x %d), #procs=%d", nprow, npcol, BI_Np); /* * Form MPI communicator for scope = 'all' */ if (Ng > 2) i = Ng; else i = 2; iptr = (int *) malloc(i*sizeof(int)); for (j=0; j < npcol; j++) { for (i=0; i < nprow; i++) iptr[i*npcol+j] = usermap[j*Mpval(ldup)+i]; } #if (INTFACE == C_CALL) #ifdef UseF77Mpi comm = BI_TransUserComm(Cblacs2sys_handle(*ConTxt), Ng, iptr); /* * If we globally blocked to translate the User's communicator from C to F77, * go ahead and translate the new context back to F77 in case he calls blacs_get */ #if (BI_TransComm == BONEHEAD) Ucomm = Cblacs2sys_handle(*ConTxt); MPI_Comm_group(Ucomm, &Cgrp); /* find input comm's group */ MPI_Group_incl(Cgrp, Ng, iptr, &Cgrp2); /* form new group */ MPI_Comm_create(Ucomm, Cgrp2, &Ccomm); /* create new comm */ MPI_Group_free(&Cgrp2); #endif #else #define BI_FormComm tcomm = Cblacs2sys_handle(*ConTxt); #endif #else /* gridmap called from f77 */ #ifdef UseF77Mpi #define BI_FormComm tcomm = *ConTxt; #else comm = BI_TransUserComm(*ConTxt, Ng, iptr); #if (BI_TransComm == BONEHEAD) Fcomm = (int *) malloc(sizeof(int)); mpi_comm_group_(ConTxt, &Fgrp, &info); mpi_group_incl_(&Fgrp, &Ng, iptr, &Fgrp2, &info); mpi_comm_create_(ConTxt, &Fgrp2, Fcomm, &info); mpi_group_free_(&Fgrp2, &info); #endif #endif #endif #ifdef BI_FormComm BI_MPI_Comm_group(tcomm, &grp, info); /* find input comm's group */ BI_MPI_Group_incl(grp, Ng, iptr, &tgrp, info); /* form new group */ BI_MPI_Comm_create(tcomm, tgrp, &comm, info); /* create new comm */ BI_MPI_Group_free(&tgrp, info); #endif /* * Weed out callers who are not participating in present grid */ if (comm == BI_MPI_COMM_NULL) { *ConTxt = NOTINCONTEXT; free(iptr); return; } /* * ================================================== * Get new context and add it to my array of contexts * ================================================== */ ctxt = (BLACSCONTEXT *) malloc(sizeof(BLACSCONTEXT)); /* * Find free slot in my context array */ for (i=0; i < BI_MaxNCtxt; i++) if (BI_MyContxts[i] == NULL) break; /* * Get bigger context pointer array, if needed */ if (i == BI_MaxNCtxt) { j = BI_MaxNCtxt + MAXNCTXT; tCTxts = (BLACSCONTEXT **) malloc(j * sizeof(*tCTxts)); for (i=0; i < BI_MaxNCtxt; i++) tCTxts[i] = BI_MyContxts[i]; BI_MaxNCtxt = j; for(j=i; j < BI_MaxNCtxt; j++) tCTxts[j] = NULL; if (BI_MyContxts) free(BI_MyContxts); BI_MyContxts = tCTxts; } BI_MyContxts[i] = ctxt; *ConTxt = i; #if (BI_TransComm == BONEHEAD) #ifdef UseF77Mpi ctxt->C_comm = Ccomm; #else ctxt->F77_comm = Fcomm; #endif #endif ctxt->ascp.comm = comm; BI_MPI_Comm_dup(comm, &ctxt->pscp.comm, info); /* copy acomm for pcomm */ BI_MPI_Comm_rank(comm, &Iam, info); /* find my rank in new comm */ myrow = Iam / npcol; mycol = Iam % npcol; /* * Form MPI communicators for scope = 'row' */ BI_MPI_Comm_split(comm, myrow, mycol, &ctxt->rscp.comm, info); /* * Form MPI communicators for scope = 'Column' */ BI_MPI_Comm_split(comm, mycol, myrow, &ctxt->cscp.comm, info); ctxt->rscp.Np = npcol; ctxt->rscp.Iam = mycol; ctxt->cscp.Np = nprow; ctxt->cscp.Iam = myrow; ctxt->pscp.Np = ctxt->ascp.Np = Ng; ctxt->pscp.Iam = ctxt->ascp.Iam = Iam; ctxt->Nr_bs = ctxt->Nr_co = 1; ctxt->Nb_bs = ctxt->Nb_co = 2; ctxt->TopsRepeat = ctxt->TopsCohrnt = 0; /* * =========================== * Set up the message id stuff * =========================== */ Cblacs_get(-1, 1, iptr); ctxt->pscp.MinId = ctxt->rscp.MinId = ctxt->cscp.MinId = ctxt->ascp.MinId = ctxt->pscp.ScpId = ctxt->rscp.ScpId = ctxt->cscp.ScpId = ctxt->ascp.ScpId = iptr[0]; ctxt->pscp.MaxId = ctxt->rscp.MaxId = ctxt->cscp.MaxId = ctxt->ascp.MaxId = iptr[1]; free(iptr); } blacs-mpi-1.1/SRC/MPI/blacs_pcoord_.c100644 1750 144 642 6316033743 16450 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_pcoord(int ConTxt, int nodenum, int *prow, int *pcol) #else F_VOID_FUNC blacs_pcoord_(int *ConTxt, int *nodenum, int *prow, int *pcol) #endif { BLACSCONTEXT *ctxt; MGetConTxt(Mpval(ConTxt), ctxt); if ( (Mpval(nodenum) >= 0) && (Mpval(nodenum) < ctxt->ascp.Np) ) { Mpcoord(ctxt, Mpval(nodenum), *prow, *pcol); } else *prow = *pcol = -1; } blacs-mpi-1.1/SRC/MPI/blacs_pinfo_.c100644 1750 144 2206 6316033743 16313 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_pinfo(int *mypnum, int *nprocs) #else F_VOID_FUNC blacs_pinfo_(int *mypnum, int *nprocs) #endif { int ierr; extern int BI_Iam, BI_Np; /* * If this is our first call, will need to set up some stuff */ if (BI_F77_MPI_COMM_WORLD == NULL) { /* * The BLACS always call f77's mpi_init. If the user is using C, he should * explicitly call MPI_Init . . . */ MPI_Initialized(nprocs); #ifdef MainInF77 if (!(*nprocs)) mpi_init_(&ierr); #else if (!(*nprocs)) BI_BlacsErr(-1, -1, __FILE__, "Users with C main programs must explicitly call MPI_Init"); #endif BI_F77_MPI_COMM_WORLD = (int *) malloc(sizeof(int)); #ifdef UseF77Mpi BI_F77_MPI_CONSTANTS = (int *) malloc(23*sizeof(int)); ierr = 1; bi_f77_get_constants_(BI_F77_MPI_COMM_WORLD, &ierr, BI_F77_MPI_CONSTANTS); #else ierr = 0; bi_f77_get_constants_(BI_F77_MPI_COMM_WORLD, &ierr, nprocs); #endif BI_MPI_Comm_size(BI_MPI_COMM_WORLD, &BI_Np, ierr); BI_MPI_Comm_rank(BI_MPI_COMM_WORLD, &BI_Iam, ierr); } *mypnum = BI_Iam; *nprocs = BI_Np; } blacs-mpi-1.1/SRC/MPI/blacs_pnum_.c100644 1750 144 653 6316033743 16143 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Cblacs_pnum(int ConTxt, int prow, int pcol) #else F_INT_FUNC blacs_pnum_(int *ConTxt, int *prow, int *pcol) #endif { BLACSCONTEXT *ctxt; MGetConTxt(Mpval(ConTxt), ctxt); if ( (Mpval(prow) >= 0) && (Mpval(prow) < ctxt->cscp.Np) && (Mpval(pcol) >= 0) && (Mpval(pcol) < ctxt->rscp.Np) ) return( Mkpnum(ctxt, Mpval(prow), Mpval(pcol)) ); else return(-1); } blacs-mpi-1.1/SRC/MPI/blacs_set_.c100644 1750 144 4317 6316307062 15776 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_set(int ConTxt, int what, int *val) #else F_VOID_FUNC blacs_set_(int *ConTxt, int *what, int *val) #endif { BLACSCONTEXT *ctxt; switch( Mpval(what) ) { case SGET_SYSCONTXT: BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Cannot set BLACS system context, can only BLACS_GET"); break; case SGET_MSGIDS: BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "No need to set message ID range due to MPI communicator."); break; case SGET_DEBUGLVL: BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Cannot set BLACS debug level; must recompile to change"); break; case SGET_BLACSCONTXT: BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Cannot set BLACS context, can only BLACS_GET"); break; case SGET_NR_BS: MGetConTxt(Mpval(ConTxt), ctxt); if (*val) ctxt->Nr_bs = *val; else BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "BSBR nrings cannot be set to zero"); break; case SGET_NB_BS: MGetConTxt(Mpval(ConTxt), ctxt); if (*val > 0) ctxt->Nb_bs = *val + 1; else BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Illegal BSBR nbranches (%d); must be strictly positive", *val); break; case SGET_NR_CO: MGetConTxt(Mpval(ConTxt), ctxt); if (*val) ctxt->Nr_co = *val; else BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "COMB nrings cannot be set to zero"); break; case SGET_NB_CO: MGetConTxt(Mpval(ConTxt), ctxt); if (*val > 0) ctxt->Nb_co = *val + 1; else BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Illegal COMB nbranches (%d); must be strictly positive", *val); break; case SGET_TOPSREPEAT: MGetConTxt(Mpval(ConTxt), ctxt); ctxt->TopsRepeat = *val; break; case SGET_TOPSCOHRNT: MGetConTxt(Mpval(ConTxt), ctxt); ctxt->TopsCohrnt = *val; break; default: BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "Unknown WHAT (%d)", Mpval(what)); } } blacs-mpi-1.1/SRC/MPI/blacs_setup_.c100644 1750 144 455 6316033743 16324 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cblacs_setup(int *mypnum, int *nprocs) #else F_VOID_FUNC blacs_setup_(int *mypnum, int *nprocs) #endif { /* * blacs_setup same as blacs_pinfo for non-PVM versions of the BLACS */ void Cblacs_pinfo(int *, int *); Cblacs_pinfo(mypnum, nprocs); } blacs-mpi-1.1/SRC/MPI/cgamn2d_.c100644 1750 144 26670 6316033743 15402 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgamn2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC cgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amn operation for complex rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amn of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amn of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amn of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amn. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amn. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_cvvamn(int, char *, char *); void BI_cvvamn2(int, char *, char *); void BI_cMPI_amn(void *, void *, int *, BI_MPI_Datatype *); void BI_cMPI_amn2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amn is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_cvvamn; length = N * sizeof(SCOMPLEX); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(SCOMPLEX) > j) j = sizeof(SCOMPLEX); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_cmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_COMPLEX; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_cvvamn2; length = N * sizeof(SCOMPLEX); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_cmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_COMPLEX; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_cMPI_amn2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_cMPI_amn, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amn array */ if (bp != &BI_AuxBuff) BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/cgamx2d_.c100644 1750 144 26667 6316033743 15422 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgamx2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC cgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amx operation for complex rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amx of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amx of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amx of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amx. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amx. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_cvvamx(int, char *, char *); void BI_cvvamx2(int, char *, char *); void BI_cMPI_amx(void *, void *, int *, BI_MPI_Datatype *); void BI_cMPI_amx2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amx is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_cvvamx; length = N * sizeof(SCOMPLEX); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(SCOMPLEX) > j) j = sizeof(SCOMPLEX); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_cmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_COMPLEX; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_cvvamx2; length = N * sizeof(SCOMPLEX); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_cmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_COMPLEX; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_cMPI_amx2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_cMPI_amx, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amx array */ if (bp != &BI_AuxBuff) BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/cgebr2d_.c100644 1750 144 14031 6320547540 15363 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgebr2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC cgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for general complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, receive and send directly to/from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } /* * If A is not contiguous, we receive message as packed so it can be * forwarded without further system intervention */ else { send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif } #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If we buffered, unpack. */ #ifndef MpiBuffGood if (bp != &BI_AuxBuff) { BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); } else #endif { BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } blacs-mpi-1.1/SRC/MPI/cgebs2d_.c100644 1750 144 12335 6320547544 15375 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgebs2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda) #else F_VOID_FUNC cgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for general complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, send directly from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } else { send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); } #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end cgebs2d_ */ blacs-mpi-1.1/SRC/MPI/cgerv2d_.c100644 1750 144 5005 6316033743 15370 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgerv2d(int ConTxt, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC cgerv2d_(int *ConTxt, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point general complex receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tlda; int ierr; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/cgesd2d_.c100644 1750 144 5650 6316033743 15355 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgesd2d(int ConTxt, int m, int n, float *A, int lda, int rdest, int cdest) #else F_VOID_FUNC cgesd2d_(int *ConTxt, int *m, int *n, float *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point general complex send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int dest, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "CGESD2D", 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of cgesd2d */ blacs-mpi-1.1/SRC/MPI/cgsum2d_.c100644 1750 144 16045 6316033743 15426 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Ccgsum2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int rdest, int cdest) #else F_VOID_FUNC cgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine sum operation for complex rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the sum. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the sum. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_cvvsum(int, char *, char *); void BI_cMPI_sum(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int N, length, dest, tlda, trdest, ierr; BI_MPI_Op BlacComb; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one. Also, we can't use MPI functions if we need to * guarantee repeatability. */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); length = N * sizeof(SCOMPLEX); /* * If A is contiguous, we can use it as one of the buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } /* * Otherwise, we must allocate both buffers */ else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_cmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->dtype = bp2->dtype = BI_MPI_COMPLEX; bp->N = bp2->N = N; switch(ttop) { case ' ': /* use MPI's reduction by default */ length = 1; BI_MPI_Op_create(BI_cMPI_sum, length, &BlacComb, ierr); if (dest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } BI_MPI_Op_free(&BlacComb, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, BI_cvvsum, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, BI_cvvsum, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, BI_cvvsum, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, BI_cvvsum, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, BI_cvvsum, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, BI_cvvsum, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, BI_cvvsum, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, BI_cvvsum); else BI_TreeComb(ctxt, bp, bp2, N, BI_cvvsum, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If I am selected to receive answer */ if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) BI_cvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); BI_UpdateBuffs(bp); } else { if (BI_ActiveQ) BI_UpdateBuffs(NULL); BI_BuffIsFree(bp, 1); } } blacs-mpi-1.1/SRC/MPI/ctrbr2d_.c100644 1750 144 14650 6320547547 15433 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cctrbr2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC ctrbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for trapezoidal complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope, tuplo, tdiag; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #else send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } #ifdef MpiBuffGood BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); #endif #ifndef MpiBuffGood BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); #endif } blacs-mpi-1.1/SRC/MPI/ctrbs2d_.c100644 1750 144 13715 6320547553 15432 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cctrbs2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, float *A, int lda) #else F_VOID_FUNC ctrbs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for trapezoidal complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope, tuplo, tdiag; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #endif /* * Pack and use non-blocking sends for broadcast if MPI's data types aren't * more efficient */ #ifndef MpiBuffGood send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end ctrbs2d_ */ blacs-mpi-1.1/SRC/MPI/ctrrv2d_.c100644 1750 144 6503 6316033743 15426 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cctrrv2d(int ConTxt, char *uplo, char *diag, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC ctrrv2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point trapezoidal complex receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tuplo, tdiag, tlda; int ierr, length; BLACBUFF *bp; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tdiag = F2C_CharTrans(diag); tuplo = F2C_CharTrans(uplo); tdiag = Mlowcase(tdiag); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/ctrsd2d_.c100644 1750 144 7317 6316033743 15411 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cctrsd2d(int ConTxt, char *uplo, char *diag, int m, int n, float *A, int lda, int rdest, int cdest) #else F_VOID_FUNC ctrsd2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point trapezoidal complex send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); char tuplo, tdiag; int dest, length, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tuplo = F2C_CharTrans(uplo); tdiag = F2C_CharTrans(diag); tuplo = Mlowcase(tuplo); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "CTRSD2D", 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_COMPLEX, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of ctrsd2d */ blacs-mpi-1.1/SRC/MPI/dcputime00_.c100644 1750 144 206 6316033743 15764 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) double Cdcputime00(void) #else F_DOUBLE_FUNC dcputime00_(void) #endif { return(-1.0); } blacs-mpi-1.1/SRC/MPI/dgamn2d_.c100644 1750 144 26701 6316033743 15376 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgamn2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC dgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amn operation for double precision rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amn of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amn of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amn of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amn. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amn. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_dvvamn(int, char *, char *); void BI_dvvamn2(int, char *, char *); void BI_dMPI_amn(void *, void *, int *, BI_MPI_Datatype *); void BI_dMPI_amn2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amn is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_dvvamn; length = N * sizeof(double); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(double) > j) j = sizeof(double); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_DOUBLE; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_dvvamn2; length = N * sizeof(double); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_DOUBLE; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_dMPI_amn2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_dMPI_amn, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amn array */ if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/dgamx2d_.c100644 1750 144 26701 6316033743 15410 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgamx2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC dgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amx operation for double precision rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amx of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amx of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amx of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amx. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amx. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_dvvamx(int, char *, char *); void BI_dvvamx2(int, char *, char *); void BI_dMPI_amx(void *, void *, int *, BI_MPI_Datatype *); void BI_dMPI_amx2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amx is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_dvvamx; length = N * sizeof(double); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(double) > j) j = sizeof(double); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_DOUBLE; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_dvvamx2; length = N * sizeof(double); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_DOUBLE; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_dMPI_amx2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_dMPI_amx, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amx array */ if (bp != &BI_AuxBuff) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/dgebr2d_.c100644 1750 144 14054 6320547561 15374 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgebr2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC dgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for general double precision arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, receive and send directly to/from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } /* * If A is not contiguous, we receive message as packed so it can be * forwarded without further system intervention */ else { send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif } #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If we buffered, unpack. */ #ifndef MpiBuffGood if (bp != &BI_AuxBuff) { BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); } else #endif { BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } blacs-mpi-1.1/SRC/MPI/dgebs2d_.c100644 1750 144 12360 6320547565 15377 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgebs2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda) #else F_VOID_FUNC dgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for general double precision arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, send directly from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } else { send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); } #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end dgebs2d_ */ blacs-mpi-1.1/SRC/MPI/dgerv2d_.c100644 1750 144 5030 6316033743 15367 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgerv2d(int ConTxt, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC dgerv2d_(int *ConTxt, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point general double precision receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tlda; int ierr; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/dgesd2d_.c100644 1750 144 5674 6316033744 15365 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgesd2d(int ConTxt, int m, int n, double *A, int lda, int rdest, int cdest) #else F_VOID_FUNC dgesd2d_(int *ConTxt, int *m, int *n, double *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point general double precision send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int dest, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "DGESD2D", 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of dgesd2d */ blacs-mpi-1.1/SRC/MPI/dgsum2d_.c100644 1750 144 15555 6316033744 15435 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdgsum2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int rdest, int cdest) #else F_VOID_FUNC dgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine sum operation for double precision rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the sum. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the sum. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_dvvsum(int, char *, char *); /* * Variable Declarations */ BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int N, length, dest, tlda, trdest, ierr; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one. Also, we can't use MPI functions if we need to * guarantee repeatability. */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); length = N * sizeof(double); /* * If A is contiguous, we can use it as one of the buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } /* * Otherwise, we must allocate both buffers */ else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_dmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->dtype = bp2->dtype = BI_MPI_DOUBLE; bp->N = bp2->N = N; switch(ttop) { case ' ': /* use MPI's reduction by default */ if (dest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BI_MPI_SUM, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BI_MPI_SUM, ctxt->scp->comm, ierr); BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, BI_dvvsum, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, BI_dvvsum); else BI_TreeComb(ctxt, bp, bp2, N, BI_dvvsum, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If I am selected to receive answer */ if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) BI_dvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); BI_UpdateBuffs(bp); } else { if (BI_ActiveQ) BI_UpdateBuffs(NULL); BI_BuffIsFree(bp, 1); } } blacs-mpi-1.1/SRC/MPI/dtrbr2d_.c100644 1750 144 14673 6320547570 15435 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdtrbr2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC dtrbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for trapezoidal double precision arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope, tuplo, tdiag; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #else send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } #ifdef MpiBuffGood BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); #endif #ifndef MpiBuffGood BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); #endif } blacs-mpi-1.1/SRC/MPI/dtrbs2d_.c100644 1750 144 13740 6320547573 15433 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdtrbs2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, double *A, int lda) #else F_VOID_FUNC dtrbs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for trapezoidal double precision arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope, tuplo, tdiag; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #endif /* * Pack and use non-blocking sends for broadcast if MPI's data types aren't * more efficient */ #ifndef MpiBuffGood send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end dtrbs2d_ */ blacs-mpi-1.1/SRC/MPI/dtrrv2d_.c100644 1750 144 6526 6316033744 15435 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdtrrv2d(int ConTxt, char *uplo, char *diag, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC dtrrv2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point trapezoidal double precision receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tuplo, tdiag, tlda; int ierr, length; BLACBUFF *bp; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tdiag = F2C_CharTrans(diag); tuplo = F2C_CharTrans(uplo); tdiag = Mlowcase(tdiag); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/dtrsd2d_.c100644 1750 144 7342 6316033744 15411 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cdtrsd2d(int ConTxt, char *uplo, char *diag, int m, int n, double *A, int lda, int rdest, int cdest) #else F_VOID_FUNC dtrsd2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point trapezoidal double precision send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double precision two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); char tuplo, tdiag; int dest, length, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tuplo = F2C_CharTrans(uplo); tdiag = F2C_CharTrans(diag); tuplo = Mlowcase(tuplo); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "DTRSD2D", 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of dtrsd2d */ blacs-mpi-1.1/SRC/MPI/dwalltime00_.c100644 1750 144 222 6316033744 16133 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) double Cdwalltime00(void) #else F_DOUBLE_FUNC dwalltime00_(void) #endif { return(BI_MPI_Wtime()); } blacs-mpi-1.1/SRC/MPI/free_blacs_system_handle_.c100644 1750 144 2755 6316033744 21052 0ustar pfrauenfusers#include "Bdef.h" /* This file from mpiblacs_patch01 */ #if (INTFACE == C_CALL) void Cfree_blacs_system_handle(int ISysCtxt) #else void free_blacs_system_handle_(int *ISysCxt) #endif { #if (INTFACE == C_CALL) int i, j, DEF_WORLD; BI_MPI_Comm *tSysCtxt; extern int BI_MaxNSysCtxt; extern BI_MPI_Comm *BI_SysContxts; if ( (ISysCtxt < BI_MaxNSysCtxt) && (ISysCtxt > 0) ) { if (BI_SysContxts[ISysCtxt] != BI_MPI_COMM_NULL) BI_SysContxts[ISysCtxt] = BI_MPI_COMM_NULL; else BI_BlacsWarn(-1, __LINE__, __FILE__, "Trying to free non-existent system context handle %d", ISysCtxt); } else if (ISysCtxt == 0) return; /* never free MPI_COMM_WORLD */ else BI_BlacsWarn(-1, __LINE__, __FILE__, "Trying to free non-existent system context handle %d", ISysCtxt); /* * See if we have freed enough space to decrease the size of our table */ for (i=j=0; i < BI_MaxNSysCtxt; i++) if (BI_SysContxts[i] == BI_MPI_COMM_NULL) j++; /* * If needed, get a smaller system context array */ if (j > 2*MAXNSYSCTXT) { j = BI_MaxNSysCtxt - MAXNSYSCTXT; tSysCtxt = (BI_MPI_Comm *) malloc(j * sizeof(BI_MPI_Comm)); for (i=j=0; i < BI_MaxNSysCtxt; i++) { if (BI_SysContxts[i] != BI_MPI_COMM_NULL) tSysCtxt[j++] = BI_SysContxts[i]; } BI_MaxNSysCtxt -= MAXNSYSCTXT; for(; j < BI_MaxNSysCtxt; j++) tSysCtxt[j] = BI_MPI_COMM_NULL; free(BI_SysContxts); BI_SysContxts = tSysCtxt; } #endif } blacs-mpi-1.1/SRC/MPI/igamn2d_.c100644 1750 144 26573 6316033744 15413 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigamn2d(int ConTxt, char *scope, char *top, int m, int n, int *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC igamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, int *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amn operation for integer rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amn of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amn of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amn of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amn. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amn. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_ivvamn(int, char *, char *); void BI_ivvamn2(int, char *, char *); void BI_iMPI_amn(void *, void *, int *, BI_MPI_Datatype *); void BI_iMPI_amn2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amn is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_ivvamn; length = N * sizeof(int); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(int) > j) j = sizeof(int); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_INT; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_ivvamn2; length = N * sizeof(int); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_INT; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_iMPI_amn2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_iMPI_amn, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amn array */ if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/igamx2d_.c100644 1750 144 26573 6316033744 15425 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigamx2d(int ConTxt, char *scope, char *top, int m, int n, int *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC igamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, int *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amx operation for integer rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amx of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amx of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amx of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amx. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amx. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_ivvamx(int, char *, char *); void BI_ivvamx2(int, char *, char *); void BI_iMPI_amx(void *, void *, int *, BI_MPI_Datatype *); void BI_iMPI_amx2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amx is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_ivvamx; length = N * sizeof(int); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(int) > j) j = sizeof(int); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_INT; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_ivvamx2; length = N * sizeof(int); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_INT; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_iMPI_amx2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_iMPI_amx, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amx array */ if (bp != &BI_AuxBuff) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/igebr2d_.c100644 1750 144 14021 6320547577 15402 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigebr2d(int ConTxt, char *scope, char *top, int m, int n, int *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC igebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, int *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for general integer arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, receive and send directly to/from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } /* * If A is not contiguous, we receive message as packed so it can be * forwarded without further system intervention */ else { send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif } #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If we buffered, unpack. */ #ifndef MpiBuffGood if (bp != &BI_AuxBuff) { BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); } else #endif { BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } blacs-mpi-1.1/SRC/MPI/igebs2d_.c100644 1750 144 12325 6320547602 15375 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigebs2d(int ConTxt, char *scope, char *top, int m, int n, int *A, int lda) #else F_VOID_FUNC igebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, int *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for general integer arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, send directly from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } else { send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); } #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end igebs2d_ */ blacs-mpi-1.1/SRC/MPI/igerv2d_.c100644 1750 144 4775 6316033744 15414 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigerv2d(int ConTxt, int m, int n, int *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC igerv2d_(int *ConTxt, int *m, int *n, int *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point general integer receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tlda; int ierr; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/igesd2d_.c100644 1750 144 5640 6316033744 15363 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigesd2d(int ConTxt, int m, int n, int *A, int lda, int rdest, int cdest) #else F_VOID_FUNC igesd2d_(int *ConTxt, int *m, int *n, int *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point general integer send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int dest, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "IGESD2D", 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of igesd2d */ blacs-mpi-1.1/SRC/MPI/igsum2d_.c100644 1750 144 15444 6316033744 15437 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cigsum2d(int ConTxt, char *scope, char *top, int m, int n, int *A, int lda, int rdest, int cdest) #else F_VOID_FUNC igsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, int *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine sum operation for integer rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the sum. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the sum. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_ivvsum(int, char *, char *); /* * Variable Declarations */ BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int N, length, dest, tlda, trdest, ierr, itr; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one. Note that integer operations are always * repeatable. */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) ) ttop = '1'; N = Mpval(m) * Mpval(n); length = N * sizeof(int); /* * If A is contiguous, we can use it as one of the buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } /* * Otherwise, we must allocate both buffers */ else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_imvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->dtype = bp2->dtype = BI_MPI_INT; bp->N = bp2->N = N; switch(ttop) { case ' ': /* use MPI's reduction by default */ if (dest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BI_MPI_SUM, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BI_MPI_SUM, ctxt->scp->comm, ierr); BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, BI_ivvsum, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, BI_ivvsum, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, BI_ivvsum, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, BI_ivvsum, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, BI_ivvsum, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, BI_ivvsum, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, BI_ivvsum, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, BI_ivvsum); else BI_TreeComb(ctxt, bp, bp2, N, BI_ivvsum, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If I am selected to receive answer */ if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) BI_ivmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); BI_UpdateBuffs(bp); } else { if (BI_ActiveQ) BI_UpdateBuffs(NULL); BI_BuffIsFree(bp, 1); } } blacs-mpi-1.1/SRC/MPI/itrbr2d_.c100644 1750 144 14640 6320547605 15433 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Citrbr2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, int *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC itrbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, int *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for trapezoidal integer arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope, tuplo, tdiag; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #else send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } #ifdef MpiBuffGood BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); #endif #ifndef MpiBuffGood BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); #endif } blacs-mpi-1.1/SRC/MPI/itrbs2d_.c100644 1750 144 13705 6320547610 15431 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Citrbs2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, int *A, int lda) #else F_VOID_FUNC itrbs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, int *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for trapezoidal integer arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope, tuplo, tdiag; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #endif /* * Pack and use non-blocking sends for broadcast if MPI's data types aren't * more efficient */ #ifndef MpiBuffGood send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end itrbs2d_ */ blacs-mpi-1.1/SRC/MPI/itrrv2d_.c100644 1750 144 6473 6316033744 15443 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Citrrv2d(int ConTxt, char *uplo, char *diag, int m, int n, int *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC itrrv2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, int *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point trapezoidal integer receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tuplo, tdiag, tlda; int ierr, length; BLACBUFF *bp; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tdiag = F2C_CharTrans(diag); tuplo = F2C_CharTrans(uplo); tdiag = Mlowcase(tdiag); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/itrsd2d_.c100644 1750 144 7307 6316033744 15417 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Citrsd2d(int ConTxt, char *uplo, char *diag, int m, int n, int *A, int lda, int rdest, int cdest) #else F_VOID_FUNC itrsd2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, int *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point trapezoidal integer send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to integer two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); char tuplo, tdiag; int dest, length, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tuplo = F2C_CharTrans(uplo); tdiag = F2C_CharTrans(diag); tuplo = Mlowcase(tuplo); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "ITRSD2D", 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_INT, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of itrsd2d */ blacs-mpi-1.1/SRC/MPI/kbrid_.c100644 1750 144 1073 6316033744 15131 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Ckbrid(int ConTxt, char *scope, int rsrc, int csrc) #else F_INT_FUNC kbrid_(int *ConTxt, F_CHAR scope, int *rsrc, int *csrc) #endif { int msgid; char tmpscope; BLACSCONTEXT *ctxt; MGetConTxt(Mpval(ConTxt), ctxt); tmpscope = Mlowcase(F2C_CharTrans(scope)); switch(tmpscope) { case 'c' : ctxt->scp = &ctxt->cscp; break; case 'r' : ctxt->scp = &ctxt->cscp; break; case 'a' : ctxt->scp = &ctxt->cscp; break; } msgid = Mscopeid(ctxt); return (msgid); } blacs-mpi-1.1/SRC/MPI/kbsid_.c100644 1750 144 1020 6316033744 15122 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Ckbsid(int ConTxt, char *scope) #else F_INT_FUNC kbsid_(int *ConTxt, F_CHAR scope) #endif { char tmpscope; int msgid; BLACSCONTEXT *ctxt; MGetConTxt(Mpval(ConTxt), ctxt); tmpscope = Mlowcase(F2C_CharTrans(scope)); switch(tmpscope) { case 'c' : ctxt->scp = &ctxt->cscp; break; case 'r' : ctxt->scp = &ctxt->rscp; break; case 'a' : ctxt->scp = &ctxt->ascp; break; } msgid = Mscopeid(ctxt); return(msgid); } blacs-mpi-1.1/SRC/MPI/krecvid_.c100644 1750 144 311 6316033744 15437 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Ckrecvid(int ConTxt, int rsrc, int csrc) #else F_INT_FUNC krecvid_(int *ConTxt, int *rsrc, int *csrc) #endif { return(PT2PTID+1); } /* end krecvid */ blacs-mpi-1.1/SRC/MPI/ksendid_.c100644 1750 144 315 6316033744 15435 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Cksendid(int ConTxt, int rdest, int cdest) #else F_INT_FUNC ksendid_(int *ConTxt, int *rdest, int *cdest) #endif { return(PT2PTID+1); } /* end ksendid */ blacs-mpi-1.1/SRC/MPI/sgamn2d_.c100644 1750 144 26641 6316033744 15421 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgamn2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC sgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amn operation for real rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amn of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amn of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amn of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amn. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amn. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_svvamn(int, char *, char *); void BI_svvamn2(int, char *, char *); void BI_sMPI_amn(void *, void *, int *, BI_MPI_Datatype *); void BI_sMPI_amn2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amn is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_svvamn; length = N * sizeof(float); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(float) > j) j = sizeof(float); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_FLOAT; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_svvamn2; length = N * sizeof(float); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_FLOAT; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_sMPI_amn2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_sMPI_amn, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amn array */ if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/sgamx2d_.c100644 1750 144 26641 6316033744 15433 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgamx2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC sgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amx operation for real rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amx of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amx of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amx of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amx. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amx. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_svvamx(int, char *, char *); void BI_svvamx2(int, char *, char *); void BI_sMPI_amx(void *, void *, int *, BI_MPI_Datatype *); void BI_sMPI_amx2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amx is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_svvamx; length = N * sizeof(float); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(float) > j) j = sizeof(float); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_FLOAT; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_svvamx2; length = N * sizeof(float); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_FLOAT; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_sMPI_amx2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_sMPI_amx, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amx array */ if (bp != &BI_AuxBuff) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/sgebr2d_.c100644 1750 144 14021 6320547613 15403 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgebr2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC sgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for general real arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, receive and send directly to/from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } /* * If A is not contiguous, we receive message as packed so it can be * forwarded without further system intervention */ else { send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif } #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If we buffered, unpack. */ #ifndef MpiBuffGood if (bp != &BI_AuxBuff) { BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); } else #endif { BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } blacs-mpi-1.1/SRC/MPI/sgebs2d_.c100644 1750 144 12325 6320547616 15414 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgebs2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda) #else F_VOID_FUNC sgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for general real arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, send directly from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } else { send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); } #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end sgebs2d_ */ blacs-mpi-1.1/SRC/MPI/sgerv2d_.c100644 1750 144 4775 6316033744 15426 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgerv2d(int ConTxt, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC sgerv2d_(int *ConTxt, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point general real receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tlda; int ierr; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/sgesd2d_.c100644 1750 144 5640 6316033744 15375 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgesd2d(int ConTxt, int m, int n, float *A, int lda, int rdest, int cdest) #else F_VOID_FUNC sgesd2d_(int *ConTxt, int *m, int *n, float *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point general real send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int dest, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "SGESD2D", 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of sgesd2d */ blacs-mpi-1.1/SRC/MPI/sgsum2d_.c100644 1750 144 15521 6316033744 15445 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Csgsum2d(int ConTxt, char *scope, char *top, int m, int n, float *A, int lda, int rdest, int cdest) #else F_VOID_FUNC sgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, float *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine sum operation for real rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the sum. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the sum. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_svvsum(int, char *, char *); /* * Variable Declarations */ BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int N, length, dest, tlda, trdest, ierr; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one. Also, we can't use MPI functions if we need to * guarantee repeatability. */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); length = N * sizeof(float); /* * If A is contiguous, we can use it as one of the buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } /* * Otherwise, we must allocate both buffers */ else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_smvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->dtype = bp2->dtype = BI_MPI_FLOAT; bp->N = bp2->N = N; switch(ttop) { case ' ': /* use MPI's reduction by default */ if (dest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BI_MPI_SUM, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BI_MPI_SUM, ctxt->scp->comm, ierr); BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, BI_svvsum, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, BI_svvsum, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, BI_svvsum, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, BI_svvsum, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, BI_svvsum, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, BI_svvsum, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, BI_svvsum, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, BI_svvsum); else BI_TreeComb(ctxt, bp, bp2, N, BI_svvsum, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If I am selected to receive answer */ if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) BI_svmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); BI_UpdateBuffs(bp); } else { if (BI_ActiveQ) BI_UpdateBuffs(NULL); BI_BuffIsFree(bp, 1); } } blacs-mpi-1.1/SRC/MPI/strbr2d_.c100644 1750 144 14640 6320547622 15444 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cstrbr2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC strbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for trapezoidal real arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope, tuplo, tdiag; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #else send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } #ifdef MpiBuffGood BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); #endif #ifndef MpiBuffGood BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); #endif } blacs-mpi-1.1/SRC/MPI/strbs2d_.c100644 1750 144 13705 6320547625 15451 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cstrbs2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, float *A, int lda) #else F_VOID_FUNC strbs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for trapezoidal real arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope, tuplo, tdiag; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #endif /* * Pack and use non-blocking sends for broadcast if MPI's data types aren't * more efficient */ #ifndef MpiBuffGood send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end strbs2d_ */ blacs-mpi-1.1/SRC/MPI/strrv2d_.c100644 1750 144 6473 6316033744 15455 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cstrrv2d(int ConTxt, char *uplo, char *diag, int m, int n, float *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC strrv2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point trapezoidal real receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tuplo, tdiag, tlda; int ierr, length; BLACBUFF *bp; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tdiag = F2C_CharTrans(diag); tuplo = F2C_CharTrans(uplo); tdiag = Mlowcase(tdiag); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/strsd2d_.c100644 1750 144 7307 6316033744 15431 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cstrsd2d(int ConTxt, char *uplo, char *diag, int m, int n, float *A, int lda, int rdest, int cdest) #else F_VOID_FUNC strsd2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, float *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point trapezoidal real send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to real two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); char tuplo, tdiag; int dest, length, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tuplo = F2C_CharTrans(uplo); tdiag = F2C_CharTrans(diag); tuplo = Mlowcase(tuplo); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "STRSD2D", 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_FLOAT, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of strsd2d */ blacs-mpi-1.1/SRC/MPI/sys2blacs_handle_.c100644 1750 144 3125 6316033744 17256 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) int Csys2blacs_handle(BI_MPI_Comm SysCtxt) #else int sys2blacs_handle_(int *SysCtxt) #endif { #if (INTFACE == C_CALL) int i, j, DEF_WORLD; BI_MPI_Comm *tSysCtxt; extern int BI_MaxNSysCtxt; extern BI_MPI_Comm *BI_SysContxts; if (BI_F77_MPI_COMM_WORLD == NULL) Cblacs_pinfo(&i, &j); if (SysCtxt == BI_MPI_COMM_NULL) BI_BlacsErr(-1, __LINE__, __FILE__, "Cannot define a BLACS system handle based on MPI_COMM_NULL"); /* * See if we already have this system handle stored */ for (i=0; i < BI_MaxNSysCtxt; i++) if (BI_SysContxts[i] == SysCtxt) return(i); /* * The first time in this routine, we need to define MPI_COMM_WORLD, if it isn't * what is already being defined. */ DEF_WORLD = ( (!BI_SysContxts) && (SysCtxt != BI_MPI_COMM_WORLD) ); /* * Find free slot in system context array */ for (i=0; i < BI_MaxNSysCtxt; i++) if (BI_SysContxts[i] == BI_MPI_COMM_NULL) break; /* * If needed, get a bigger system context array */ if (i == BI_MaxNSysCtxt) { j = BI_MaxNSysCtxt + MAXNSYSCTXT; if ( (MAXNSYSCTXT == 1) && (DEF_WORLD) ) j++; tSysCtxt = (BI_MPI_Comm *) malloc(j * sizeof(BI_MPI_Comm)); for (i=0; i < BI_MaxNSysCtxt; i++) tSysCtxt[i] = BI_SysContxts[i]; BI_MaxNSysCtxt = j; for (j=i; j < BI_MaxNSysCtxt; j++) tSysCtxt[j] = BI_MPI_COMM_NULL; if (BI_SysContxts) free(BI_SysContxts); BI_SysContxts = tSysCtxt; } if (DEF_WORLD) BI_SysContxts[i++] = BI_MPI_COMM_WORLD; BI_SysContxts[i] = SysCtxt; return(i); #else return(*SysCtxt); #endif } blacs-mpi-1.1/SRC/MPI/zgamn2d_.c100644 1750 144 26725 6316033744 15433 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgamn2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC zgamn2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amn operation for double complex rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amn of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amn of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amn of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amn. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amn. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_zvvamn(int, char *, char *); void BI_zvvamn2(int, char *, char *); void BI_zMPI_amn(void *, void *, int *, BI_MPI_Datatype *); void BI_zMPI_amn2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amn is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_zvvamn; length = N * sizeof(DCOMPLEX); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(DCOMPLEX) > j) j = sizeof(DCOMPLEX); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_zmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_DOUBLE_COMPLEX; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_zvvamn2; length = N * sizeof(DCOMPLEX); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_zmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_DOUBLE_COMPLEX; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_zMPI_amn2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_zMPI_amn, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amn array */ if (bp != &BI_AuxBuff) BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/zgamx2d_.c100644 1750 144 26725 6316033745 15446 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgamx2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int *rA, int *cA, int ldia, int rdest, int cdest) #else F_VOID_FUNC zgamx2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rA, int *cA, int *ldia, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine amx operation for double complex rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RA (output) Integer Array, dimension (LDIA, N) * Contains process row that the amx of each element * of A was found on: i.e., rA(1,2) contains the process * row that the amx of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * CA (output) Integer Array, dimension (LDIA, N) * Contains process column that the amx of each element * of A was found on: i.e., cA(1,2) contains the process * column that the max/min of A(1,2) was found on. * Values are left on process {rdest, cdest} only, others * may be modified, but not left with interesting data. * If rdest == -1, then result is left on all processes in scope. * If LDIA == -1, this array is not accessed, and need not exist. * * LDIA (input) Ptr to int * If (LDIA == -1), then the arrays RA and CA are not accessed. * ELSE leading dimension of the arrays RA and CA. LDIA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the amx. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the amx. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_zvvamx(int, char *, char *); void BI_zvvamx2(int, char *, char *); void BI_zMPI_amx(void *, void *, int *, BI_MPI_Datatype *); void BI_zMPI_amx2(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ VVFUNPTR vvop; BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int i, j, N, dest, idist, length, tlda, tldia, trdest, ierr; int len[2]; BI_MPI_Aint disp[2]; BI_MPI_Datatype dtypes[2]; BI_MPI_Op BlacComb; BI_MPI_Datatype MyType; BI_DistType *dist, mydist; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); if (Mpval(ldia) < Mpval(m)) { if (Mpval(ldia) != -1) BI_BlacsWarn(Mpval(ConTxt), __LINE__, __FILE__, "LDIA too small (LDIA=%d, but M=%d)", Mpval(ldia), Mpval(m)); } #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); if (Mpval(ldia) < Mpval(m)) tldia = Mpval(m); else tldia = Mpval(ldia); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); /* * If process who has amx is to be communicated, must set up distance * vector after value vector */ if (Mpval(ldia) != -1) { vvop = BI_zvvamx; length = N * sizeof(DCOMPLEX); i = length % sizeof(BI_DistType); /* ensure dist vec aligned correctly */ if (i) length += sizeof(BI_DistType) - i; idist = length; length += N * sizeof(BI_DistType); /* * For performance, insist second buffer is at least 8-byte aligned */ j = 8; if (sizeof(DCOMPLEX) > j) j = sizeof(DCOMPLEX); i = length % j; if (i) length += j - i; i = 2 * length; bp = BI_GetBuff(i); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_zmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); /* * Fill in distance vector */ if (dest == -1) mydist = ctxt->scp->Iam; else mydist = (ctxt->scp->Np + ctxt->scp->Iam - dest) % ctxt->scp->Np; dist = (BI_DistType *) &bp->Buff[idist]; for (i=0; i < N; i++) dist[i] = mydist; /* * Create the MPI datatype holding both user's buffer and distance vector */ len[0] = len[1] = N; disp[0] = 0; disp[1] = idist; dtypes[0] = BI_MPI_DOUBLE_COMPLEX; dtypes[1] = BI_MpiDistType; #ifdef ZeroByteTypeBug if (N > 0) { #endif i = 2; BI_MPI_Type_struct(i, len, disp, dtypes, &MyType, ierr); BI_MPI_Type_commit(&MyType, ierr); bp->N = bp2->N = 1; bp->dtype = bp2->dtype = MyType; #ifdef ZeroByteTypeBug } else { bp->N = bp2->N = 0; bp->dtype = bp2->dtype = BI_MPI_INT; } #endif } else { vvop = BI_zvvamx2; length = N * sizeof(DCOMPLEX); /* * If A is contiguous, we can use it as one of our buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_zmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->N = bp2->N = N; bp->dtype = bp2->dtype = BI_MPI_DOUBLE_COMPLEX; } switch(ttop) { case ' ': /* use MPI's reduction by default */ i = 1; if (Mpval(ldia) == -1) { BI_MPI_Op_create(BI_zMPI_amx2, i, &BlacComb, ierr); } else { BI_MPI_Op_create(BI_zMPI_amx, i, &BlacComb, ierr); BI_AuxBuff.Len = N; /* set this up for the MPI OP wrappers */ } if (trdest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) { BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, (BI_DistType *) &bp2->Buff[idist], trdest, Mpval(cdest)); } BI_MPI_Op_free(&BlacComb, ierr); if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, vvop); else BI_TreeComb(ctxt, bp, bp2, N, vvop, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } if (Mpval(ldia) != -1) #ifdef ZeroByteTypeBug if (N > 0) #endif BI_MPI_Type_free(&MyType, ierr); /* * If I am selected to receive answer */ if ( (ctxt->scp->Iam == dest) || (dest == -1) ) { /* * Translate the distances stored in the latter part of bp->Buff into * process grid coordinates, and output these coordinates in the * arrays rA and cA. */ if (Mpval(ldia) != -1) BI_TransDist(ctxt, tscope, Mpval(m), Mpval(n), rA, cA, tldia, dist, trdest, Mpval(cdest)); /* * Unpack the amx array */ if (bp != &BI_AuxBuff) BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } } blacs-mpi-1.1/SRC/MPI/zgebr2d_.c100644 1750 144 14060 6320547636 15422 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgebr2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC zgebr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for general double complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, receive and send directly to/from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } /* * If A is not contiguous, we receive message as packed so it can be * forwarded without further system intervention */ else { send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif } #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If we buffered, unpack. */ #ifndef MpiBuffGood if (bp != &BI_AuxBuff) { BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); } else #endif { BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } } blacs-mpi-1.1/SRC/MPI/zgebs2d_.c100644 1750 144 12364 6320547641 15424 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgebs2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda) #else F_VOID_FUNC zgebs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for general double complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifndef MpiBuffGood /* * If A is contiguous, send directly from it */ else if ( (tlda == Mpval(m)) || (Mpval(n) == 1) ) { #endif send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #ifndef MpiBuffGood } else { send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); } #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end zgebs2d_ */ blacs-mpi-1.1/SRC/MPI/zgerv2d_.c100644 1750 144 5034 6316033745 15423 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgerv2d(int ConTxt, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC zgerv2d_(int *ConTxt, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point general double complex receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tlda; int ierr; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/zgesd2d_.c100644 1750 144 5677 6316033745 15417 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgesd2d(int ConTxt, int m, int n, double *A, int lda, int rdest, int cdest) #else F_VOID_FUNC zgesd2d_(int *ConTxt, int *m, int *n, double *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point general double complex send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int dest, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "ZGESD2D", 'a', 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiGeType(ctxt, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of zgesd2d */ blacs-mpi-1.1/SRC/MPI/zgsum2d_.c100644 1750 144 16074 6316033745 15461 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Czgsum2d(int ConTxt, char *scope, char *top, int m, int n, double *A, int lda, int rdest, int cdest) #else F_VOID_FUNC zgsum2d_(int *ConTxt, F_CHAR scope, F_CHAR top, int *m, int *n, double *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Combine sum operation for double complex rectangular matrices. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination of the sum. * If rdest == -1, then result is left on all processes in scope. * * CDEST (input) Ptr to int * The process column of the destination of the sum. * If rdest == -1, then CDEST ignored. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_MringComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_TreeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR, int, int); void BI_BeComb(BLACSCONTEXT *, BLACBUFF *, BLACBUFF *, int, VVFUNPTR); void BI_zvvsum(int, char *, char *); void BI_zMPI_sum(void *, void *, int *, BI_MPI_Datatype *); /* * Variable Declarations */ BLACBUFF *bp, *bp2; BLACSCONTEXT *ctxt; char ttop, tscope; int N, length, dest, tlda, trdest, ierr; BI_MPI_Op BlacComb; extern BLACBUFF *BI_ActiveQ; extern BLACBUFF BI_AuxBuff; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); /* * If the user has set the default combine topology, use it instead of * BLACS default */ #ifdef DefCombTop if (ttop == ' ') ttop = DefCombTop; #endif if (Mpval(cdest) == -1) trdest = -1; else trdest = Mpval(rdest); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_COMB, __FILE__, tscope, 'u', 'u', Mpval(m), Mpval(n), Mpval(lda), 1, &trdest, Mpaddress(cdest)); #endif if (Mpval(lda) >= Mpval(m)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; if (trdest == -1) dest = -1; else dest = Mpval(cdest); break; case 'c': ctxt->scp = &ctxt->cscp; dest = trdest; break; case 'a': ctxt->scp = &ctxt->ascp; if (trdest == -1) dest = -1; else dest = Mvkpnum(ctxt, trdest, Mpval(cdest)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } /* * It's not defined how MPI reacts to 0 element reductions, so use BLACS 1-tree * topology if we've got one. Also, we can't use MPI functions if we need to * guarantee repeatability. */ if (ttop == ' ') if ( (Mpval(m) < 1) || (Mpval(n) < 1) || (ctxt->TopsRepeat) ) ttop = '1'; N = Mpval(m) * Mpval(n); length = N * sizeof(DCOMPLEX); /* * If A is contiguous, we can use it as one of the buffers */ if ( (Mpval(m) == tlda) || (Mpval(n) == 1) ) { bp = &BI_AuxBuff; bp->Buff = (char *) A; bp2 = BI_GetBuff(length); } /* * Otherwise, we must allocate both buffers */ else { bp = BI_GetBuff(length*2); bp2 = &BI_AuxBuff; bp2->Buff = &bp->Buff[length]; BI_zmvcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); } bp->dtype = bp2->dtype = BI_MPI_DOUBLE_COMPLEX; bp->N = bp2->N = N; switch(ttop) { case ' ': /* use MPI's reduction by default */ length = 1; BI_MPI_Op_create(BI_zMPI_sum, length, &BlacComb, ierr); if (dest != -1) { BI_MPI_Reduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, dest, ctxt->scp->comm, ierr); if (ctxt->scp->Iam == dest) BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } else { BI_MPI_Allreduce(bp->Buff, bp2->Buff, bp->N, bp->dtype, BlacComb, ctxt->scp->comm, ierr); BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp2->Buff); } BI_MPI_Op_free(&BlacComb, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; break; case 'i': BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, 1); break; case 'd': BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, -1); break; case 's': BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, 2); break; case 'm': BI_MringComb(ctxt, bp, bp2, N, BI_zvvsum, dest, ctxt->Nr_co); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, ttop-47); break; case 'f': BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, FULLCON); break; case 't': BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, ctxt->Nb_co); break; case 'h': /* * Use bidirectional exchange if everyone wants answer */ if ( (trdest == -1) && !(ctxt->TopsCohrnt) ) BI_BeComb(ctxt, bp, bp2, N, BI_zvvsum); else BI_TreeComb(ctxt, bp, bp2, N, BI_zvvsum, dest, 2); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } /* * If I am selected to receive answer */ if (bp != &BI_AuxBuff) { if ( (ctxt->scp->Iam == dest) || (dest == -1) ) BI_zvmcopy(Mpval(m), Mpval(n), A, tlda, bp->Buff); BI_UpdateBuffs(bp); } else { if (BI_ActiveQ) BI_UpdateBuffs(NULL); BI_BuffIsFree(bp, 1); } } blacs-mpi-1.1/SRC/MPI/ztrbr2d_.c100644 1750 144 14677 6320547644 15471 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cztrbr2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC ztrbr2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/receive for trapezoidal double complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_IdringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_SringBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_TreeBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); BLACSCONTEXT *ctxt; BLACBUFF *bp=NULL; SDRVPTR send; BI_MPI_Datatype MatTyp; int length, src, tlda, error, one=1; char ttop, tscope, tuplo, tdiag; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BR, __FILE__, tscope, tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(m) <= Mpval(lda)) tlda = Mpval(lda); else tlda = Mpval(m); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; src = Mpval(csrc); break; case 'c': ctxt->scp = &ctxt->cscp; src = Mpval(rsrc); break; case 'a': ctxt->scp = &ctxt->ascp; src = Mvkpnum(ctxt, Mpval(rsrc), Mpval(csrc)); break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, src, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #else send = BI_Asend; BI_MPI_Pack_size(one, MatTyp, ctxt->scp->comm, &length, error); bp = BI_GetBuff(length); bp->N = length; bp->dtype = BI_MPI_PACKED; #if ZeroByteTypeBug if (MatTyp == BI_MPI_BYTE) { send = BI_Ssend; bp->N = 0; bp->dtype = BI_MPI_BYTE; } #endif #endif switch(ttop) { case 'h': error = BI_HypBR(ctxt, bp, send, src); if (error == NPOW2) BI_TreeBR(ctxt, bp, send, src, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBR(ctxt, bp, send, src, ttop-47); break; case 't': BI_TreeBR(ctxt, bp, send, src, ctxt->Nb_bs); break; case 'i': BI_IdringBR(ctxt, bp, send, src, 1); break; case 'd': BI_IdringBR(ctxt, bp, send, src, -1); break; case 's': BI_SringBR(ctxt, bp, send, src); break; case 'm': BI_MpathBR(ctxt, bp, send, src, ctxt->Nr_bs); break; case 'f': BI_MpathBR(ctxt, bp, send, src, FULLCON); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } #ifdef MpiBuffGood BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); #endif #ifndef MpiBuffGood BI_Unpack(ctxt, (BVOID *) A, bp, MatTyp); BI_UpdateBuffs(bp); #endif } blacs-mpi-1.1/SRC/MPI/ztrbs2d_.c100644 1750 144 13744 6320547647 15467 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cztrbs2d(int ConTxt, char *scope, char *top, char *uplo, char *diag, int m, int n, double *A, int lda) #else F_VOID_FUNC ztrbs2d_(int *ConTxt, F_CHAR scope, F_CHAR top, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Broadcast/send for trapezoidal double complex arrays. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * SCOPE (input) Ptr to char * Limit the scope of the operation. * = 'R' : Operation is performed by a process row. * = 'C' : Operation is performed by a process column. * = 'A' : Operation is performed by all processes in grid. * * TOP (input) Ptr to char * Controls fashion in which messages flow within the operation. * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); int BI_HypBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_IdringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_SringBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_TreeBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); char ttop, tscope, tuplo, tdiag; int error, tlda; BI_MPI_Datatype MatTyp; SDRVPTR send; BLACBUFF *bp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; /* * get context, lowcase char variables, and perform parameter checking */ MGetConTxt(Mpval(ConTxt), ctxt); ttop = F2C_CharTrans(top); ttop = Mlowcase(ttop); tscope = F2C_CharTrans(scope); tscope = Mlowcase(tscope); tuplo = F2C_CharTrans(uplo); tuplo = Mlowcase(tuplo); tdiag = F2C_CharTrans(diag); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_BS, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 0, NULL, NULL); #endif /* * If the user has set the default broadcast topology, use it instead of * BLACS default */ #ifdef DefBSTop if (ttop == ' ') ttop = DefBSTop; #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); switch(tscope) { case 'r': ctxt->scp = &ctxt->rscp; break; case 'c': ctxt->scp = &ctxt->cscp; break; case 'a': ctxt->scp = &ctxt->ascp; break; default: BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown scope '%c'", tscope); } MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); /* * If using default topology, use MPI native broadcast */ if (ttop == ' ') { BI_MPI_Bcast(A, BI_AuxBuff.N, MatTyp, ctxt->scp->Iam, ctxt->scp->comm, error); BI_MPI_Type_free(&MatTyp, error); if (BI_ActiveQ) BI_UpdateBuffs(NULL); return; } /* * If MPI handles non-contiguous buffering well, always use MPI data types * instead of packing */ #ifdef MpiBuffGood send = BI_Ssend; BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; bp = &BI_AuxBuff; #endif /* * Pack and use non-blocking sends for broadcast if MPI's data types aren't * more efficient */ #ifndef MpiBuffGood send = BI_Asend; bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); #endif /* * Call correct topology for BS/BR */ switch(ttop) { case 'h': error = BI_HypBS(ctxt, bp, send); if (error == NPOW2) BI_TreeBS(ctxt, bp, send, 2); break; case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': BI_TreeBS(ctxt, bp, send, ttop-47); break; case 't': BI_TreeBS(ctxt, bp, send, ctxt->Nb_bs); break; case 'i': BI_IdringBS(ctxt, bp, send, 1); break; case 'd': BI_IdringBS(ctxt, bp, send, -1); break; case 's': BI_SringBS(ctxt, bp, send); break; case 'f': BI_MpathBS(ctxt, bp, send, FULLCON); break; case 'm': BI_MpathBS(ctxt, bp, send, ctxt->Nr_bs); break; default : BI_BlacsErr(Mpval(ConTxt), __LINE__, __FILE__, "Unknown topology '%c'", ttop); } BI_MPI_Type_free(&MatTyp, error); if (bp == &BI_AuxBuff) { if (BI_ActiveQ) BI_UpdateBuffs(NULL); } else BI_UpdateBuffs(bp); } /* end ztrbs2d_ */ blacs-mpi-1.1/SRC/MPI/ztrrv2d_.c100644 1750 144 6532 6316033745 15461 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cztrrv2d(int ConTxt, char *uplo, char *diag, int m, int n, double *A, int lda, int rsrc, int csrc) #else F_VOID_FUNC ztrrv2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rsrc, int *csrc) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Globally-blocking point to point trapezoidal double complex receive. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (output) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * * RSRC (input) Ptr to int * The process row of the source of the matrix. * * CSRC (input) Ptr to int * The process column of the source of the matrix. * * * ------------------------------------------------------------------------ */ { /* * Prototypes and variable declarations */ void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); void BI_Unpack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int tuplo, tdiag, tlda; int ierr, length; BLACBUFF *bp; BI_MPI_Datatype MatTyp; BLACSCONTEXT *ctxt; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tdiag = F2C_CharTrans(diag); tuplo = F2C_CharTrans(uplo); tdiag = Mlowcase(tdiag); tuplo = Mlowcase(tuplo); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_RV, __FILE__, 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rsrc), Mpaddress(csrc)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Srecv(ctxt, Mkpnum(ctxt, Mpval(rsrc), Mpval(csrc)), PT2PTID, &BI_AuxBuff); BI_MPI_Type_free(&MatTyp, ierr); if (BI_ActiveQ) BI_UpdateBuffs(NULL); } blacs-mpi-1.1/SRC/MPI/ztrsd2d_.c100644 1750 144 7346 6316033745 15444 0ustar pfrauenfusers#include "Bdef.h" #if (INTFACE == C_CALL) void Cztrsd2d(int ConTxt, char *uplo, char *diag, int m, int n, double *A, int lda, int rdest, int cdest) #else F_VOID_FUNC ztrsd2d_(int *ConTxt, F_CHAR uplo, F_CHAR diag, int *m, int *n, double *A, int *lda, int *rdest, int *cdest) #endif /* * -- V1.1 BLACS routine -- * University of Tennessee, May 1, 1996 * Written by Clint Whaley. * * Purpose * ======= * Locally-blocking point-to-point trapezoidal double complex send. * * Arguments * ========= * * ConTxt (input) Ptr to int * Index into MyConTxts00 (my contexts array). * * UPLO (input) Ptr to char * Specifies the part of the matrix to be sent. * = 'U': Upper trapezoidal part * ELSE : Lower trapezoidal part * * DIAG (input) Ptr to char * Specifies whether the matrix is unit diagonal or not. * = 'U': Matrix is unit diagonal, diagonal not communicated. * ELSE : Matrix is not unit diagonal, diagonal is communicated. * * M (input) Ptr to int * The number of rows of the matrix A. M >= 0. * * N (input) Ptr to int * The number of columns of the matrix A. N >= 0. * * A (input) Ptr to double complex two dimensional array * The m by n matrix A. Fortran77 (column-major) storage * assumed. * If UPLO = 'U', only the upper trapezoid is accessed; * if UPLO = 'L', only the lower trapezoid is accessed. * * LDA (input) Ptr to int * The leading dimension of the array A. LDA >= M. * * RDEST (input) Ptr to int * The process row of the destination process. * * CDEST (input) Ptr to int * The process column of the destination process. * * ------------------------------------------------------------------------ */ { void BI_ArgCheck(int, int, char *, char, char, char, int, int, int, int, int *, int *); BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *, char, char, int, int, int, BI_MPI_Datatype, int *); BLACBUFF *BI_Pack(BLACSCONTEXT *, BVOID *, BLACBUFF *, BI_MPI_Datatype); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Asend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); char tuplo, tdiag; int dest, length, tlda, ierr; BLACBUFF *bp; BLACSCONTEXT *ctxt; BI_MPI_Datatype MatTyp; extern BLACBUFF BI_AuxBuff, *BI_ActiveQ; MGetConTxt(Mpval(ConTxt), ctxt); tuplo = F2C_CharTrans(uplo); tdiag = F2C_CharTrans(diag); tuplo = Mlowcase(tuplo); tdiag = Mlowcase(tdiag); #if (BlacsDebugLvl > 0) BI_ArgCheck(Mpval(ConTxt), RT_SD, "ZTRSD2D", 'a', tuplo, tdiag, Mpval(m), Mpval(n), Mpval(lda), 1, Mpaddress(rdest), Mpaddress(cdest)); #endif if (Mpval(lda) < Mpval(m)) tlda = Mpval(m); else tlda = Mpval(lda); dest = Mvkpnum(ctxt, Mpval(rdest), Mpval(cdest)); ctxt->scp = &ctxt->pscp; MatTyp = BI_GetMpiTrType(ctxt, tuplo, tdiag, Mpval(m), Mpval(n), tlda, BI_MPI_DOUBLE_COMPLEX, &BI_AuxBuff.N); #ifdef SndIsLocBlk BI_AuxBuff.Buff = (char *) A; BI_AuxBuff.dtype = MatTyp; BI_Ssend(ctxt, dest, PT2PTID, &BI_AuxBuff); #else bp = BI_Pack(ctxt, (BVOID *) A, NULL, MatTyp); BI_Asend(ctxt, Mkpnum(ctxt, Mpval(rdest), Mpval(cdest)), PT2PTID, bp); #endif BI_MPI_Type_free(&MatTyp, ierr); /* * Having started the async send, update the buffers (reform links, check if * active buffers have become inactive, etc.) */ #ifdef SndIsLocBlk if (BI_ActiveQ) BI_UpdateBuffs(NULL); #else BI_UpdateBuffs(bp); #endif } /* end of ztrsd2d */ blacs-mpi-1.1/SRC/MPI/Bconfig.h100644 1750 144 6107 6313301034 15241 0ustar pfrauenfusers/* * This file includes the standard C libraries, as well as system dependant * include files. All BLACS routines include this file. */ #ifndef BCONFIG_H #define BCONFIG_H 1 /* * Include files */ #include #include #include #ifdef __STDC__ #include #else #include #endif #include /* * These macros define the naming strategy needed for a fortran77 * routine to call a C routine, and whether to build so they may be * called from C or f77. For the f77 call C interface, ADD_ assumes that * f77 calls expect C routines to have an underscore postfixed to the name * (Suns, and the Intel expect this). NOCHANGE indicates that f77 expects * the name called by fortran to be identical to that compiled by C * (RS6K's do this). UPCASE says it expects C routines called by fortran * to be in all upcase (CRAY wants this). The variable F77_CALL_C is always * set to one of these values. If the BLACS will be called from C, we define * INTFACE to be CALL_C, otherwise, it is set to F77_CALL_C. */ #define ADD_ 0 #define NOCHANGE 1 #define UPCASE 2 #define F77ISF2C 3 #define C_CALL 4 #ifdef UpCase #define F77_CALL_C UPCASE #endif #ifdef NoChange #define F77_CALL_C NOCHANGE #endif #ifdef Add_ #define F77_CALL_C ADD_ #endif #ifdef f77IsF2C #define F77_CALL_C F77ISF2C #endif #ifndef F77_CALL_C #define F77_CALL_C ADD_ #endif #ifdef CallFromC #define INTFACE C_CALL #else #define INTFACE F77_CALL_C #endif /* * Uncomment these macro definitions, and substitute the topology of your * choice to vary the default topology (TOP = ' ') for broadcast and combines. #define DefBSTop '1' #define DefCombTop '1' */ /* * Uncomment this line if your MPI_Send provides a locally-blocking send */ /* #define SndIsLocBlk */ /* * Comment out the following line if your MPI does a data copy on every * non-contiguous send */ #ifndef NoMpiBuff #define MpiBuffGood #endif /* * If your MPI cannot form data types of zero length, uncomment the * following definition */ /* #define ZeroByteTypeBug */ /* * Figure out how to translate between C and fortran communicators. */ #define USEMPICH 1 #define CSAMEF77 2 #define BONEHEAD 3 #ifdef UseMpich #define BI_TransComm USEMPICH #endif #ifdef CSameF77 #define BI_TransComm CSAMEF77 #endif #ifndef BI_TransComm #define BI_TransComm BONEHEAD #endif /* * If the user has not chosen which MPI interface to use, use F77 if * BLACS_GRIDMAP/INIT is going to block, and C otherwise */ #ifndef UseCMpi #ifndef UseF77Mpi #if (BI_TransComm == BONEHEAD) #define UseF77Mpi #endif #endif #endif /* * These macros set the timing and debug levels for the BLACS. The fastest * code is produced by setting both values to 0. Higher levels provide * more timing/debug information at the cost of performance. Present levels * of debug are: * 0 : No debug information * 1 : Mainly parameter checking. * * Present levels of timing are: * 0 : No timings taken */ #ifndef BlacsDebugLvl #define BlacsDebugLvl 0 #endif #ifndef BlacsTimingLvl #define BlacsTimingLvl 0 #endif #include "Bdef.h" #endif blacs-mpi-1.1/SRC/MPI/Bdef.h100644 1750 144 150152 6327232211 14577 0ustar pfrauenfusers#ifndef BDEF_H #define BDEF_H 1 /* This file from mpiblacs_patch01 */ /* * Include the system dependant and user defined stuff */ #include "Bconfig.h" /* * ======================================================================== * TYPEDEF'S USED IN THE BLACS * ======================================================================== */ /* * --------------------------------------------------------------------------- * Define MPI's data types differently depending on whether we are using MPI's * fortran or C interface * --------------------------------------------------------------------------- */ #ifdef UseF77Mpi #define BI_MPI_Aint int #define BI_MPI_Comm int #define BI_MPI_Datatype int #define BI_MPI_Group int #define BI_MPI_Op int #define BI_MPI_Request int #define BI_MPI_Status int #else #define BI_MPI_Aint MPI_Aint #define BI_MPI_Comm MPI_Comm #define BI_MPI_Datatype MPI_Datatype #define BI_MPI_Group MPI_Group #define BI_MPI_Op MPI_Op #define BI_MPI_Request MPI_Request #define BI_MPI_Status MPI_Status #endif /* * Data type defining a scope for the BLACS */ typedef struct bLaCsScOpE BLACSSCOPE; struct bLaCsScOpE { BI_MPI_Comm comm; int ScpId, MaxId, MinId; int Np, Iam; }; /* * Data type defining a context for the BLACS */ typedef struct bLaCsCoNtExT BLACSCONTEXT; struct bLaCsCoNtExT { BLACSSCOPE rscp, cscp, ascp, pscp; /* row, column, all, and pt2pt scopes */ BLACSSCOPE *scp; /* pointer to present scope */ #if (BI_TransComm == BONEHEAD) #ifdef UseF77Mpi MPI_Comm C_comm; #else int *F77_comm; #endif #endif int TopsRepeat; /* Use only repeatable topologies? */ int TopsCohrnt; /* Use only coherent topologies? */ int Nb_bs, Nr_bs; /* for bcast general tree and multiring tops */ int Nb_co, Nr_co; /* for combine general tree and multiring tops */ }; /* * Define the fortran 77 data types COMPLEX*8 (SCOMPLEX) * and COMPLEX*16 (DCOMPLEX). */ typedef struct {double r, i;} DCOMPLEX; typedef struct {float r, i;} SCOMPLEX; /* * These variables will be defined to be MPI datatypes for complex and double * complex if we are using the C interface to MPI. If we use the fortran * interface, we need to declare the contants array. I'm too lazy to declare * these guys external in every file that needs them. */ #ifndef GlobalVars #ifdef UseF77Mpi extern int *BI_F77_MPI_CONSTANTS, *BI_F77_MPI_COMM_WORLD; #else extern BI_MPI_Datatype BI_MPI_COMPLEX, BI_MPI_DOUBLE_COMPLEX; extern int *BI_F77_MPI_COMM_WORLD; #endif #endif /* * Definition of buffer type for BLACS' asynchronous operations */ typedef struct bLaCbUfF BLACBUFF; struct bLaCbUfF { char *Buff; /* send/recv buffer */ int Len; /* length of buffer in bytes */ int nAops; /* number of asynchronous operations out of buff */ BI_MPI_Request *Aops; /* list of async. operations out of buff */ BI_MPI_Datatype dtype; /* data type of buffer */ int N; /* number of elements of data type in buff */ BLACBUFF *prev, *next; /* pointer to the other BLACBUFF in queue */ }; /* * Pointer to the combine's vector-vector functions */ #ifdef __STDC__ typedef void (*VVFUNPTR)(int, char *, char *); typedef void (*SDRVPTR)(BLACSCONTEXT *, int, int, BLACBUFF *); #else typedef void (*VVFUNPTR)(); typedef void (*SDRVPTR)(); #endif /* * ======================================================================== * MACRO CONSTANTS * ======================================================================== */ /* * ---------------------------------------------- * Define MPI's constants for fortran77 interface * ---------------------------------------------- */ #ifdef UseF77Mpi /* * return codes */ #define BI_MPI_SUCCESS BI_F77_MPI_CONSTANTS[0] #define BI_MPI_ERR_UNKNOWN BI_F77_MPI_CONSTANTS[1] #define BI_MPI_ERR_OTHER BI_F77_MPI_CONSTANTS[2] #define BI_MPI_ERR_INTERN BI_F77_MPI_CONSTANTS[3] /* * Assorted constants */ #define BI_MPI_ANY_SOURCE BI_F77_MPI_CONSTANTS[4] #define BI_MPI_UNDEFINED BI_F77_MPI_CONSTANTS[5] /* * Status size and reserved index values */ #define BI_MPI_STATUS_SIZE BI_F77_MPI_CONSTANTS[6] #define BI_MPI_SOURCE BI_F77_MPI_CONSTANTS[7] #define BI_MPI_TAG BI_F77_MPI_CONSTANTS[8] /* * Elementary datatypes */ #define BI_MPI_INT BI_F77_MPI_CONSTANTS[9] #define BI_MPI_FLOAT BI_F77_MPI_CONSTANTS[10] #define BI_MPI_DOUBLE BI_F77_MPI_CONSTANTS[11] #define BI_MPI_COMPLEX BI_F77_MPI_CONSTANTS[12] #define BI_MPI_DOUBLE_COMPLEX BI_F77_MPI_CONSTANTS[13] #define BI_MPI_PACKED BI_F77_MPI_CONSTANTS[14] #define BI_MPI_BYTE BI_F77_MPI_CONSTANTS[15] /* * Reserved communicators */ #define BI_MPI_COMM_WORLD BI_F77_MPI_CONSTANTS[16] #define BI_MPI_COMM_NULL BI_F77_MPI_CONSTANTS[17] /* * Environmental inquiry keys */ #define BI_MPI_TAG_UB BI_F77_MPI_CONSTANTS[18] /* * Collective operations */ #define BI_MPI_MAX BI_F77_MPI_CONSTANTS[19] #define BI_MPI_MIN BI_F77_MPI_CONSTANTS[20] #define BI_MPI_SUM BI_F77_MPI_CONSTANTS[21] /* * NULL handles */ #define BI_MPI_REQUEST_NULL BI_F77_MPI_CONSTANTS[22] /* * Data types to use in the combine operations */ #define BI_DistType int #define BI_MpiDistType BI_MPI_INT /* * ==================================== * Define MPI constants for C interface * ==================================== */ #else /* * return codes */ #define BI_MPI_SUCCESS MPI_SUCCESS #define BI_MPI_ERR_UNKNOWN MPI_ERR_UNKNOWN #define BI_MPI_ERR_OTHER MPI_ERR_OTHER #define BI_MPI_ERR_INTERN MPI_ERR_INTERN /* * Assorted constants */ #define BI_MPI_ANY_SOURCE MPI_ANY_SOURCE #define BI_MPI_UNDEFINED MPI_UNDEFINED /* * Status size and reserved index values */ #define BI_MPI_STATUS_SIZE 1 /* * Elementary datatypes */ #define BI_MPI_SHORT MPI_SHORT #define BI_MPI_INT MPI_INT #define BI_MPI_FLOAT MPI_FLOAT #define BI_MPI_DOUBLE MPI_DOUBLE #define BI_MPI_PACKED MPI_PACKED #define BI_MPI_BYTE MPI_BYTE /* * Reserved communicators */ #define BI_MPI_COMM_WORLD MPI_COMM_WORLD #define BI_MPI_COMM_NULL MPI_COMM_NULL /* * Environmental inquiry keys */ #define BI_MPI_TAG_UB MPI_TAG_UB /* * Collective operations */ #define BI_MPI_MAX MPI_MAX #define BI_MPI_MIN MPI_MIN #define BI_MPI_SUM MPI_SUM /* * NULL handles */ #define BI_MPI_REQUEST_NULL MPI_REQUEST_NULL /* * Data types to use in the combine operations */ #define BI_DistType unsigned short #define BI_MpiDistType MPI_UNSIGNED_SHORT #endif #define BUFFALIGN 8 /* force all buffers to 8 byte alignment */ #define BANYNODE BI_MPI_ANY_SOURCE #define PT2PTID 9976 /* TAG used for point to point */ #define NOTINCONTEXT -1 /* Indicates node called gridmap, but not in grid */ #define MAXNCTXT 10 /* initial guess at max # of contexts */ #define MAXNSYSCTXT 10 /* initial guess at max # of system context */ #define AOPDONE BI_MPI_REQUEST_NULL #define BUFWAIT 120 /* Length of time to wait for emergency buff */ /* * Error codes */ #define NORV 1 /* No receiver (only 1 proc in scoped op) */ #define NPOW2 2 /* Number of procs is not a power of 2 */ #define BADSCP 3 /* Scope not row, column or all */ /* * Data types */ #define INTEGER 3 #define SINGLE 4 #define DOUBLE 6 #define COMPLEX8 5 #define COMPLEX16 7 #define FULLCON 0 /* top is fully connected */ /* * Routine types */ #define RT_SD 1 #define RT_RV 2 #define RT_BS 3 #define RT_BR 4 #define RT_COMB 5 /* * Legal WHAT values for BLACS_SET */ #define SGET_SYSCONTXT 0 #define SGET_MSGIDS 1 #define SGET_DEBUGLVL 2 #define SGET_BLACSCONTXT 10 #define SGET_NR_BS 11 #define SGET_NB_BS 12 #define SGET_NR_CO 13 #define SGET_NB_CO 14 #define SGET_TOPSREPEAT 15 #define SGET_TOPSCOHRNT 16 /* * These are prototypes for error and warning functions -- I don't want * to prototype them in each routine. */ #ifdef __STDC__ void BI_BlacsWarn(int ConTxt, int line, char *file, char *form, ...); void BI_BlacsErr(int ConTxt, int line, char *file, char *form, ...); int BI_ContxtNum(BLACSCONTEXT *ctxt); #else void BI_BlacsWarn(); void BI_BlacsErr(); int BI_ContxtNum(); #endif /* * If we've got an ANSI standard C compiler, we can use void pointers, * otherwise use char pointers */ #ifdef __STDC__ #define BVOID void #else #define BVOID char #endif /* * ======================================================================== * PREPROCESSOR MACRO FUNCTIONS USED FOR OPTIMIZATION & CONVENIENCE * ======================================================================== */ #define Mlowcase(C) ( ((C) > 64 && (C) < 91) ? (C) | 32 : (C) ) /* * Slightly modified gridinfo substitute */ #define Mgridinfo(ctxt, Ng0, nprow0, npcol0, myrow0, mycol0)\ {\ (Ng0) = (ctxt)->ascp.Np;\ (nprow0) = (ctxt)->cscp.Np;\ (npcol0) = (ctxt)->rscp.Np;\ (myrow0) = (ctxt)->cscp.Iam;\ (mycol0) = (ctxt)->rscp.Iam;\ } /* * These routines return coordinates based on nodes number, or node number * based on coordinates. Those routines with v after the M return virtual * nodes numbers (i.e., in respect to the grid, not physical node numbers) * based on grid coordinates, or grid coordinates based on virtual node numbers. */ #define Mpcoord(ctxt, node, prow, pcol)\ {\ (prow) = (node) / (ctxt)->rscp.Np;\ (pcol) = (node) % (ctxt)->rscp.Np;\ } #define Mvpcoord(ctxt, node, prow, pcol) \ Mpcoord((ctxt), (node), (prow), (pcol)); #define Mkpnum(ctxt, prow, pcol) ( (prow)*(ctxt)->rscp.Np+(pcol) ) #define Mvkpnum(ctxt, prow, pcol) ( (prow)*(ctxt)->rscp.Np+(pcol) ) /* * This macro returns scoped message ID's. */ #define Mscopeid(ctxt) (ctxt)->scp->ScpId; \ if (++(ctxt)->scp->ScpId == (ctxt)->scp->MaxId) \ (ctxt)->scp->ScpId = (ctxt)->scp->MinId; /* * Get context, and check for validity if debug level is high */ #if (BlacsDebugLvl > 0) #define MGetConTxt(Context, ctxtptr)\ {\ extern BLACSCONTEXT **BI_MyContxts;\ extern int BI_MaxNCtxt;\ if ( ((Context) >= BI_MaxNCtxt) || ((Context) < 0) )\ BI_BlacsErr(-1, __LINE__, __FILE__, "Invalid context handle: %d",\ (Context));\ else if (BI_MyContxts[(Context)] == NULL)\ BI_BlacsErr(-1, __LINE__, __FILE__, "Invalid context, handle=%d",\ (Context));\ (ctxtptr) = BI_MyContxts[(Context)];\ } #else #define MGetConTxt(Context, ctxtptr)\ {\ extern BLACSCONTEXT **BI_MyContxts;\ (ctxtptr) = BI_MyContxts[(Context)];\ } #endif /* * This macro handles MPI errors */ #if(BlacsDebugLvl > 0) #define Mmpierror(ierr, rout, ctxt, line, file) \ { \ if ( (ierr) != BI_MPI_SUCCESS )\ BI_BlacsErr(BI_ContxtNum((ctxt)), (line), (file), \ "MPI error %d on call to %s", (ierr), (rout)); \ } #else #define Mmpierror(ierr, rout, ctxt, line, file) #endif /* * A small macro useful for debugging */ #define ErrPrint \ { \ extern int BI_Iam; \ fprintf(stderr, "%d: line %d of file %s\n", BI_Iam, __LINE__, __FILE__); \ } /* * These macros allow for the funky function declarations and character handling * needed on the CRAY to have a C routine callable from fortran */ #define F_VOID_FUNC void #define F_INT_FUNC int #define F_DOUBLE_FUNC double #ifdef CRAY #define float double #include #endif #if (INTFACE == C_CALL) #define F2C_CharTrans(c) *(c) #else #ifdef CRAY #define F2C_CharTrans(c) *( _fcdtocp((c)) ) #define F_CHAR _fcd #else #define F2C_CharTrans(c) *(c) #define F_CHAR char * #endif #endif /* * These macros allow for accessing values and addresses of parameters, which * will be pointers if we're using fortran, and values if we're using C. */ #if (INTFACE == C_CALL) #define Mpval(para) (para) #define Mpaddress(para) (&(para)) #define Mwalltime Cdwalltime00 #else #define Mpval(para) (*(para)) #define Mpaddress(para) (para) #define Mwalltime dwalltime00_ #endif /* * Real and complex absolute values */ #define Rabs(x) ( (x) < 0 ? (x) * -1 : (x) ) #define Cabs(z) ( (((z).i) < 0 ? ((z).i) * -1 : ((z).i)) + (((z).r) < 0 ? ((z).r) * -1 : ((z).r)) ) /* * Figures the length of packed trapezoidal matrix */ #define trsize(diag, m, n, bytes, length)\ {\ if ( (diag) == 'u' ) (length) = 1;\ else (length) = 0;\ if ( (m) > (n) )\ (length) = ( (n) * ( (m) - (n) ) + ( (n)*(n) ) - ( (n)*(n) )/2 +\ (n)/2 - (n) * (length) ) * (bytes);\ else\ (length) = ( (m) * ( (n) - (m) ) + ( (m)*(m) ) - ( (m)*(m) )/2 +\ (m)/2 - (m) * (length) ) * (bytes);\ } /* * These macros call the correct packing/unpacking routines */ #define BI_cmvcopy(m, n, A, lda, buff) \ BI_smvcopy(2*(m), (n), (float *) (A), 2*(lda), (float *) (buff)) #define BI_cvmcopy(m, n, A, lda, buff) \ BI_svmcopy(2*(m), (n), (float *) (A), 2*(lda), (float *) (buff)) #define BI_zmvcopy(m, n, A, lda, buff) \ BI_dmvcopy(2*(m), (n), (double *) (A), 2*(lda), (double *) (buff)) #define BI_zvmcopy(m, n, A, lda, buff) \ BI_dvmcopy(2*(m), (n), (double *) (A), 2*(lda), (double *) (buff)) #if (F77_CALL_C == ADD_) /* * These defines set up the naming scheme required to have a fortran 77 * routine call a C routine (which is what the BLACS are written in). * No redefinition necessary to have following Fortran to C interface: * FORTRAN CALL C DECLARATION * call dgebs2d(...) void dgebs2d_(...) */ #endif #if (F77_CALL_C == NOCHANGE) /* * These defines set up the naming scheme required to have a fortran 77 * routine call a C routine (which is what the BLACS are written in) * for the following Fortran to C interface: * FORTRAN CALL C DECLARATION * call dgebs2d(...) void dgebs2d(...) */ /* * Support routines */ #define blacs_pinfo_ blacs_pinfo #define blacs_setup_ blacs_setup #define setpvmtids_ setpvmtids #define blacs_set_ blacs_set #define blacs_get_ blacs_get #define blacs_gridinit_ blacs_gridinit #define blacs_gridmap_ blacs_gridmap #define ksendid_ ksendid #define krecvid_ krecvid #define kbsid_ kbsid #define kbrid_ kbrid #define blacs_freebuff_ blacs_freebuff #define blacs_gridexit_ blacs_gridexit #define blacs_abort_ blacs_abort #define blacs_exit_ blacs_exit #define blacs_gridinfo_ blacs_gridinfo #define blacs_pnum_ blacs_pnum #define blacs_pcoord_ blacs_pcoord #define dcputime00_ dcputime00 #define dwalltime00_ dwalltime00 #define blacs_barrier_ blacs_barrier /* * Main, type dependent, routines */ #define igesd2d_ igesd2d #define igerv2d_ igerv2d #define igebs2d_ igebs2d #define igebr2d_ igebr2d #define itrsd2d_ itrsd2d #define itrrv2d_ itrrv2d #define itrbs2d_ itrbs2d #define itrbr2d_ itrbr2d #define igsum2d_ igsum2d #define igamx2d_ igamx2d #define igamn2d_ igamn2d #define sgesd2d_ sgesd2d #define sgerv2d_ sgerv2d #define sgebs2d_ sgebs2d #define sgebr2d_ sgebr2d #define strsd2d_ strsd2d #define strrv2d_ strrv2d #define strbs2d_ strbs2d #define strbr2d_ strbr2d #define sgsum2d_ sgsum2d #define sgamx2d_ sgamx2d #define sgamn2d_ sgamn2d #define dgesd2d_ dgesd2d #define dgerv2d_ dgerv2d #define dgebs2d_ dgebs2d #define dgebr2d_ dgebr2d #define dtrsd2d_ dtrsd2d #define dtrrv2d_ dtrrv2d #define dtrbs2d_ dtrbs2d #define dtrbr2d_ dtrbr2d #define dgsum2d_ dgsum2d #define dgamx2d_ dgamx2d #define dgamn2d_ dgamn2d #define cgesd2d_ cgesd2d #define cgerv2d_ cgerv2d #define cgebs2d_ cgebs2d #define cgebr2d_ cgebr2d #define ctrsd2d_ ctrsd2d #define ctrrv2d_ ctrrv2d #define ctrbs2d_ ctrbs2d #define ctrbr2d_ ctrbr2d #define cgsum2d_ cgsum2d #define cgamx2d_ cgamx2d #define cgamn2d_ cgamn2d #define zgesd2d_ zgesd2d #define zgerv2d_ zgerv2d #define zgebs2d_ zgebs2d #define zgebr2d_ zgebr2d #define ztrsd2d_ ztrsd2d #define ztrrv2d_ ztrrv2d #define ztrbs2d_ ztrbs2d #define ztrbr2d_ ztrbr2d #define zgsum2d_ zgsum2d #define zgamx2d_ zgamx2d #define zgamn2d_ zgamn2d /* * If we are using the fortran interface to MPI, need to redefine the names */ #ifdef UseF77Mpi #define mpi_abort_ mpi_abort #define mpi_allreduce_ mpi_allreduce #define bi_f77_mpi_attr_get_ bi_f77_mpi_attr_get #define mpi_barrier_ mpi_barrier #define mpi_bcast_ mpi_bcast #define mpi_comm_create_ mpi_comm_create #define mpi_comm_dup_ mpi_comm_dup #define mpi_comm_free_ mpi_comm_free #define mpi_comm_group_ mpi_comm_group #define mpi_comm_rank_ mpi_comm_rank #define mpi_comm_size_ mpi_comm_size #define mpi_comm_split_ mpi_comm_split #define mpi_error_class_ mpi_error_class #define mpi_finalize_ mpi_finalize #define mpi_get_count_ mpi_get_count #define mpi_group_incl_ mpi_group_incl #define mpi_group_free_ mpi_group_free #define mpi_init_ mpi_init #define bi_f77_mpi_initialized_ bi_f77_mpi_initialized #define mpi_irecv_ mpi_irecv #define mpi_isend_ mpi_isend #define bi_f77_mpi_op_create_ bi_f77_mpi_op_create #define mpi_op_free_ mpi_op_free #define mpi_pack_ mpi_pack #define mpi_pack_size_ mpi_pack_size #define mpi_recv_ mpi_recv #define mpi_reduce_ mpi_reduce #define mpi_rsend_ mpi_rsend #define mpi_send_ mpi_send #define mpi_sendrecv_ mpi_sendrecv #define bi_f77_mpi_test_ bi_f77_mpi_test #define bi_f77_mpi_testall_ bi_f77_mpi_testall #define mpi_type_commit_ mpi_type_commit #define mpi_type_contiguous_ mpi_type_contiguous #define mpi_type_free_ mpi_type_free #define mpi_type_indexed_ mpi_type_indexed #define mpi_type_struct_ mpi_type_struct #define mpi_type_vector_ mpi_type_vector #define mpi_unpack_ mpi_unpack #define mpi_waitall_ mpi_waitall #define mpi_wtime_ mpi_wtime #define bi_f77_get_constants_ bi_f77_get_constants #else #define mpi_init_ mpi_init #define bi_f77_get_constants_ bi_f77_get_constants #if (BI_TransComm == BONEHEAD) #define mpi_comm_group_ mpi_comm_group #define mpi_group_translate_ranks_ mpi_group_translate_ranks #endif #endif #endif #if (F77_CALL_C == UPCASE) /* * These defines set up the naming scheme required to have a fortran 77 * routine call a C routine (which is what the BLACS are written in) * for the following Fortran to C interface: * FORTRAN CALL C DECLARATION * call dgebs2d(...) void DGEBS2D(...) */ /* * Support routines */ #define blacs_pinfo_ BLACS_PINFO #define blacs_setup_ BLACS_SETUP #define setpvmtids_ SETPVMTIDS #define blacs_set_ BLACS_SET #define blacs_get_ BLACS_GET #define blacs_gridinit_ BLACS_GRIDINIT #define blacs_gridmap_ BLACS_GRIDMAP #define ksendid_ KSENDID #define krecvid_ KRECVID #define kbsid_ KBSID #define kbrid_ KBRID #define blacs_freebuff_ BLACS_FREEBUFF #define blacs_gridexit_ BLACS_GRIDEXIT #define blacs_abort_ BLACS_ABORT #define blacs_exit_ BLACS_EXIT #define blacs_gridinfo_ BLACS_GRIDINFO #define blacs_pnum_ BLACS_PNUM #define blacs_pcoord_ BLACS_PCOORD #define dcputime00_ DCPUTIME00 #define dwalltime00_ DWALLTIME00 #define blacs_barrier_ BLACS_BARRIER /* * Main, type dependent, routines */ #define igesd2d_ IGESD2D #define igerv2d_ IGERV2D #define igebs2d_ IGEBS2D #define igebr2d_ IGEBR2D #define itrsd2d_ ITRSD2D #define itrrv2d_ ITRRV2D #define itrbs2d_ ITRBS2D #define itrbr2d_ ITRBR2D #define igsum2d_ IGSUM2D #define igamx2d_ IGAMX2D #define igamn2d_ IGAMN2D #define sgesd2d_ SGESD2D #define sgerv2d_ SGERV2D #define sgebs2d_ SGEBS2D #define sgebr2d_ SGEBR2D #define strsd2d_ STRSD2D #define strrv2d_ STRRV2D #define strbs2d_ STRBS2D #define strbr2d_ STRBR2D #define sgsum2d_ SGSUM2D #define sgamx2d_ SGAMX2D #define sgamn2d_ SGAMN2D #define dgesd2d_ DGESD2D #define dgerv2d_ DGERV2D #define dgebs2d_ DGEBS2D #define dgebr2d_ DGEBR2D #define dtrsd2d_ DTRSD2D #define dtrrv2d_ DTRRV2D #define dtrbs2d_ DTRBS2D #define dtrbr2d_ DTRBR2D #define dgsum2d_ DGSUM2D #define dgamx2d_ DGAMX2D #define dgamn2d_ DGAMN2D #define cgesd2d_ CGESD2D #define cgerv2d_ CGERV2D #define cgebs2d_ CGEBS2D #define cgebr2d_ CGEBR2D #define ctrsd2d_ CTRSD2D #define ctrrv2d_ CTRRV2D #define ctrbs2d_ CTRBS2D #define ctrbr2d_ CTRBR2D #define cgsum2d_ CGSUM2D #define cgamx2d_ CGAMX2D #define cgamn2d_ CGAMN2D #define zgesd2d_ ZGESD2D #define zgerv2d_ ZGERV2D #define zgebs2d_ ZGEBS2D #define zgebr2d_ ZGEBR2D #define ztrsd2d_ ZTRSD2D #define ztrrv2d_ ZTRRV2D #define ztrbs2d_ ZTRBS2D #define ztrbr2d_ ZTRBR2D #define zgsum2d_ ZGSUM2D #define zgamx2d_ ZGAMX2D #define zgamn2d_ ZGAMN2D /* * If we are using the fortran interface to MPI, need to redefine the names */ #ifdef UseF77Mpi #define mpi_abort_ MPI_ABORT #define mpi_allreduce_ MPI_ALLREDUCE #define bi_f77_mpi_attr_get_ BI_F77_MPI_ATTR_GET #define mpi_barrier_ MPI_BARRIER #define mpi_bcast_ MPI_BCAST #define mpi_comm_create_ MPI_COMM_CREATE #define mpi_comm_dup_ MPI_COMM_DUP #define mpi_comm_free_ MPI_COMM_FREE #define mpi_comm_group_ MPI_COMM_GROUP #define mpi_comm_rank_ MPI_COMM_RANK #define mpi_comm_size_ MPI_COMM_SIZE #define mpi_comm_split_ MPI_COMM_SPLIT #define mpi_error_class_ MPI_ERROR_CLASS #define mpi_finalize_ MPI_FINALIZE #define mpi_get_count_ MPI_GET_COUNT #define mpi_group_incl_ MPI_GROUP_INCL #define mpi_group_free_ MPI_GROUP_FREE #define mpi_init_ MPI_INIT #define bi_f77_mpi_initialized_ BI_F77_MPI_INITIALIZED #define mpi_irecv_ MPI_IRECV #define mpi_isend_ MPI_ISEND #define bi_f77_mpi_op_create_ BI_F77_MPI_OP_CREATE #define mpi_op_free_ MPI_OP_FREE #define mpi_pack_ MPI_PACK #define mpi_pack_size_ MPI_PACK_SIZE #define mpi_recv_ MPI_RECV #define mpi_reduce_ MPI_REDUCE #define mpi_rsend_ MPI_RSEND #define mpi_send_ MPI_SEND #define mpi_sendrecv_ MPI_SENDRECV #define bi_f77_mpi_test_ BI_F77_MPI_TEST #define bi_f77_mpi_testall_ BI_F77_MPI_TESTALL #define mpi_type_commit_ MPI_TYPE_COMMIT #define mpi_type_contiguous_ MPI_TYPE_CONTIGUOUS #define mpi_type_free_ MPI_TYPE_FREE #define mpi_type_indexed_ MPI_TYPE_INDEXED #define mpi_type_struct_ MPI_TYPE_STRUCT #define mpi_type_vector_ MPI_TYPE_VECTOR #define mpi_unpack_ MPI_UNPACK #define mpi_waitall_ MPI_WAITALL #define mpi_wtime_ MPI_WTIME #define bi_f77_get_constants_ BI_F77_GET_CONSTANTS #else #define mpi_init_ MPI_INIT #define bi_f77_get_constants_ BI_F77_GET_CONSTANTS #if (BI_TransComm == BONEHEAD) #define mpi_comm_group_ MPI_COMM_GROUP #define mpi_group_translate_ranks_ MPI_GROUP_TRANSLATE_RANKS #endif #endif #endif #if (F77_CALL_C == F77ISF2C) /* * These defines set up the naming scheme required to have a fortran 77 * routine call a C routine (which is what the BLACS are written in) * for systems where the fortran "compiler" is actually f2c (a fortran * to C conversion utility). */ /* * Initialization routines */ #define blacs_pinfo_ blacs_pinfo__ #define blacs_setup_ blacs_setup__ #define blacs_set_ blacs_set__ #define blacs_get_ blacs_get__ #define blacs_gridinit_ blacs_gridinit__ #define blacs_gridmap_ blacs_gridmap__ /* * Destruction routines */ #define blacs_freebuff_ blacs_freebuff__ #define blacs_gridexit_ blacs_gridexit__ #define blacs_abort_ blacs_abort__ #define blacs_exit_ blacs_exit__ /* * Informational & misc. */ #define blacs_gridinfo_ blacs_gridinfo__ #define blacs_pnum_ blacs_pnum__ #define blacs_pcoord_ blacs_pcoord__ #define blacs_barrier_ blacs_barrier__ /* * If we are using the fortran interface to MPI, need to redefine the names */ #ifdef UseF77Mpi #define mpi_abort_ mpi_abort__ #define mpi_allreduce_ mpi_allreduce__ #define mpi_barrier_ mpi_barrier__ #define mpi_bcast_ mpi_bcast__ #define mpi_init_ mpi_init__ #define mpi_finalize_ mpi_finalize__ #define mpi_irecv_ mpi_irecv__ #define mpi_pack_ mpi_pack__ #define mpi_isend_ mpi_isend__ #define mpi_recv_ mpi_recv__ #define mpi_reduce_ mpi_reduce__ #define mpi_rsend_ mpi_rsend__ #define mpi_send_ mpi_send__ #define mpi_sendrecv_ mpi_sendrecv__ #define mpi_unpack_ mpi_unpack__ #define mpi_waitall_ mpi_waitall__ #define mpi_wtime_ mpi_wtime__ #define mpi_comm_create_ mpi_comm_create__ #define mpi_comm_dup_ mpi_comm_dup__ #define mpi_comm_free_ mpi_comm_free__ #define mpi_comm_group_ mpi_comm_group__ #define mpi_comm_rank_ mpi_comm_rank__ #define mpi_comm_size_ mpi_comm_size__ #define mpi_comm_split_ mpi_comm_split__ #define mpi_error_class_ mpi_error_class__ #define mpi_get_count_ mpi_get_count__ #define mpi_group_incl_ mpi_group_incl__ #define mpi_group_free_ mpi_group_free__ #define mpi_op_free_ mpi_op_free__ #define mpi_pack_size_ mpi_pack_size__ #define mpi_type_commit_ mpi_type_commit__ #define mpi_type_contiguous_ mpi_type_contiguous__ #define mpi_type_free_ mpi_type_free__ #define mpi_type_indexed_ mpi_type_indexed__ #define mpi_type_struct_ mpi_type_struct__ #define mpi_type_vector_ mpi_type_vector__ #define bi_f77_get_constants_ bi_f77_get_constants__ #define mpi_group_translate_ranks_ mpi_group_translate_ranks__ #define bi_f77_mpi_initialized_ bi_f77_mpi_initialized__ #define bi_f77_mpi_test_ bi_f77_mpi_test__ #define bi_f77_mpi_testall_ bi_f77_mpi_testall__ #define bi_f77_mpi_attr_get_ bi_f77_mpi_attr_get__ #define bi_f77_mpi_op_create_ bi_f77_mpi_op_create__ #else #define mpi_init_ mpi_init__ #define bi_f77_get_constants_ bi_f77_get_constants__ #if (BI_TransComm == BONEHEAD) #define mpi_comm_group_ mpi_comm_group__ #define mpi_group_translate_ranks_ mpi_group_translate_ranks__ #endif #endif #endif /* * ========================================================================== * Prototype the fortran interface MPI functions if they are going to be used * ========================================================================== */ #ifdef UseF77Mpi #ifdef __STDC__ F_VOID_FUNC mpi_abort_(int*, int*, int*); F_VOID_FUNC mpi_allreduce_(void*, void*, int*, int*, int*, int*, int*); F_VOID_FUNC bi_f77_mpi_attr_get_(int*, int*, int*, int*, int*); F_VOID_FUNC mpi_barrier_(int*, int*); F_VOID_FUNC mpi_bcast_(void*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_comm_create_(int*, int*, int*, int*); F_VOID_FUNC mpi_comm_dup_(int*, int*, int*); F_VOID_FUNC mpi_comm_free_(int*, int*); F_VOID_FUNC mpi_comm_group_(int*, int*, int*); F_VOID_FUNC mpi_comm_rank_(int*, int*, int*); F_VOID_FUNC mpi_comm_size_(int*, int*, int*); F_VOID_FUNC mpi_comm_split_(int*, int*, int*, int*, int*); F_VOID_FUNC mpi_error_class_(int*, int*, int*); F_VOID_FUNC mpi_finalize_(int*); F_VOID_FUNC mpi_get_count_(int*, int*, int*, int*); F_VOID_FUNC mpi_group_incl_(int*, int*, int*, int*, int*); F_VOID_FUNC mpi_group_free_(int*, int*); F_VOID_FUNC mpi_init_(int*); F_VOID_FUNC bi_f77_mpi_initialized_(int*, int*); F_VOID_FUNC mpi_irecv_(void*, int*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_isend_(void*, int*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC bi_f77_mpi_op_create_(void func(void*, void*, int*, int*), int*, int*, int*); F_VOID_FUNC mpi_op_free_(int*, int*); F_VOID_FUNC mpi_pack_(void*, int*, int*, void*, int*, int*, int*, int*); F_VOID_FUNC mpi_pack_size_(int*, int*, int*, int*, int*); F_VOID_FUNC mpi_recv_(void *, int*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_reduce_(void*, void*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_rsend_(void*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_send_(void*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_sendrecv_(void*, int*, int*, int*, int*, void*, int*, int*, int*, int*, int*, int*, int*); F_VOID_FUNC bi_f77_mpi_test_(int*, int*, int*, int*); F_VOID_FUNC bi_f77_mpi_testall_(int*, int*, int*, int*, int*); F_VOID_FUNC mpi_type_commit_(int*, int*); F_VOID_FUNC mpi_type_contiguous_(int*, int*, int*, int*); F_VOID_FUNC mpi_type_free_(int*, int*); F_VOID_FUNC mpi_type_indexed_(int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_type_struct_(int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_type_vector_(int*, int*, int*, int*, int*, int*); F_VOID_FUNC mpi_unpack_(void*, int*, int*, void*, int*, int*, int*, int*); F_VOID_FUNC mpi_waitall_(int*, int*, int*, int*); F_DOUBLE_FUNC mpi_wtime(void); #else F_VOID_FUNC mpi_abort_(); F_VOID_FUNC mpi_allreduce_(); F_VOID_FUNC bi_f77_mpi_attr_get_(); F_VOID_FUNC mpi_barrier_(); F_VOID_FUNC mpi_bcast_(); F_VOID_FUNC mpi_comm_create_(); F_VOID_FUNC mpi_comm_dup_(); F_VOID_FUNC mpi_comm_free_(); F_VOID_FUNC mpi_comm_group_(); F_VOID_FUNC mpi_comm_rank_(); F_VOID_FUNC mpi_comm_size_(); F_VOID_FUNC mpi_comm_split_(); F_VOID_FUNC mpi_error_class_(); F_VOID_FUNC mpi_finalize_(); F_VOID_FUNC mpi_get_count_(); F_VOID_FUNC mpi_group_incl_(); F_VOID_FUNC mpi_group_free_(); F_VOID_FUNC mpi_init_(); F_VOID_FUNC bi_f77_mpi_initialized_(); F_VOID_FUNC mpi_irecv_(); F_VOID_FUNC mpi_isend_(); F_VOID_FUNC bi_f77_mpi_op_create_(); F_VOID_FUNC mpi_op_free_(); F_VOID_FUNC mpi_pack_(); F_VOID_FUNC mpi_pack_size_(); F_VOID_FUNC mpi_recv_(); F_VOID_FUNC mpi_reduce_(); F_VOID_FUNC mpi_rsend_(); F_VOID_FUNC mpi_send_(); F_VOID_FUNC mpi_sendrecv_(); F_VOID_FUNC bi_f77_mpi_test_(); F_VOID_FUNC bi_f77_mpi_testall_(); F_VOID_FUNC mpi_type_commit_(); F_VOID_FUNC mpi_type_contiguous_(); F_VOID_FUNC mpi_type_free_(); F_VOID_FUNC mpi_type_indexed_(); F_VOID_FUNC mpi_type_struct_(); F_VOID_FUNC mpi_type_vector_(); F_VOID_FUNC mpi_unpack_(); F_VOID_FUNC mpi_waitall_(); F_DOUBLE_FUNC BI_MPI_Wtime(); #endif /* * If we are using the C interface, still may need some f77 functions to do * context translation */ #else #if (BI_TransComm == BONEHEAD) #ifdef __STDC__ F_VOID_FUNC mpi_comm_create_(int*, int*, int*, int*); F_VOID_FUNC mpi_comm_free_(int*, int*); F_VOID_FUNC mpi_comm_group_(int*, int*, int*); F_VOID_FUNC mpi_comm_size_(int*, int*, int*); F_VOID_FUNC mpi_group_incl_(int*, int*, int*, int*, int*); F_VOID_FUNC mpi_group_free_(int*, int*); F_VOID_FUNC mpi_group_translate_ranks_(int*, int*, int*, int*, int*, int*); #else F_VOID_FUNC mpi_comm_create_(); F_VOID_FUNC mpi_comm_free_(); F_VOID_FUNC mpi_comm_group_(); F_VOID_FUNC mpi_comm_size_(); F_VOID_FUNC mpi_group_incl_(); F_VOID_FUNC mpi_group_free_(); F_VOID_FUNC mpi_group_translate_ranks_(); #endif #endif #endif /* * ================================================ * Define MPI functions for C and fortran interface * ================================================ */ #ifdef UseF77Mpi #define BI_MPI_Abort(comm_, errcode_, ierr_)\ { \ mpi_abort_(&(comm_), &(errcode_), &(ierr_)); \ Mmpierror((ierr_), "MPI_ABORT", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Abort(comm_, errcode_, ierr_)\ { \ (ierr_) = MPI_Abort((comm_), (errcode_)); \ Mmpierror((ierr_), "MPI_Abort", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Allreduce(sbuf_, rbuf_, count_, dtype_, op_, comm_, ierr_)\ { \ mpi_allreduce_((sbuf_), (rbuf_), &(count_), &(dtype_), &(op_), &(comm_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_ALLREDUCE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Allreduce(sbuf_, rbuf_, count_, dtype_, op_, comm_, ierr_)\ { \ (ierr_) = MPI_Allreduce((sbuf_), (rbuf_), (count_), (dtype_), (op_), \ (comm_)); \ Mmpierror((ierr_), "MPI_Allreduce", NULL, __LINE__, __FILE__); \ } #endif /* * Need to be sure to set attr_ to pointing at int before call . . . * int *iptr=&i; BI_MPI_Attr_get(... &iptr ...); */ #ifdef UseF77Mpi #define BI_MPI_Attr_get(comm_, keyval_, attr_, flag_, ierr_) \ { \ bi_f77_mpi_attr_get_(&(comm_), &(keyval_), (int *) *(attr_), (flag_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_ATTR_GET", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Attr_get(comm_, keyval_, attr_, flag_, ierr_) \ { \ (ierr_) = MPI_Attr_get((comm_), (keyval_), (attr_), (flag_)); \ Mmpierror((ierr_), "MPI_Attr_get", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Barrier(comm_, ierr_) \ { \ mpi_barrier_(&(comm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_BARRIER", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Barrier(comm_, ierr_) \ { \ (ierr_) = MPI_Barrier((comm_)); \ Mmpierror((ierr_), "MPI_Barrier", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Bcast(buff_, count_, dtype_, root_, comm_, ierr_) \ { \ mpi_bcast_((buff_), &(count_), &(dtype_), &(root_), &(comm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_BCAST", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Bcast(buff_, count_, dtype_, root_, comm_, ierr_) \ { \ (ierr_) = MPI_Bcast((buff_), (count_), (dtype_), (root_), (comm_)); \ Mmpierror((ierr_), "MPI_Bcast", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_create(comm_, group_, newcomm_, ierr_) \ { \ mpi_comm_create_(&(comm_), &(group_), (newcomm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_CREATE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_create(comm_, group_, newcomm_, ierr_) \ { \ (ierr_) = MPI_Comm_create((comm_), (group_), (newcomm_)); \ Mmpierror((ierr_), "MPI_Comm_create", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_dup(comm_, newcomm_, ierr_) \ { \ mpi_comm_dup_(&(comm_), (newcomm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_DUP", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_dup(comm_, newcomm_, ierr_) \ { \ (ierr_) = MPI_Comm_dup((comm_), (newcomm_)); \ Mmpierror((ierr_), "MPI_Comm_dup", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_free(comm_, ierr_) \ { \ mpi_comm_free_((comm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_FREE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_free(comm_, ierr_) \ { \ (ierr_) = MPI_Comm_free((comm_)); \ Mmpierror((ierr_), "MPI_Comm_free", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_group(comm_, grp_, ierr_) \ { \ mpi_comm_group_(&(comm_), (grp_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_GROUP", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_group(comm_, grp_, ierr_) \ { \ (ierr_) = MPI_Comm_group((comm_), (grp_)); \ Mmpierror((ierr_), "MPI_Comm_group", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_rank(comm_, rank_, ierr_) \ { \ mpi_comm_rank_(&(comm_), (rank_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_RANK", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_rank(comm_, rank_, ierr_) \ { \ (ierr_) = MPI_Comm_rank((comm_), (rank_)); \ Mmpierror((ierr_), "MPI_Comm_rank", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_size(comm_, size_, ierr_) \ { \ mpi_comm_size_(&(comm_), (size_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_SIZE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_size(comm_, size_, ierr_) \ { \ (ierr_) = MPI_Comm_size((comm_), (size_)); \ Mmpierror((ierr_), "MPI_Comm_size", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Comm_split(comm_, color_, key_, newcomm_, ierr_) \ { \ mpi_comm_split_(&(comm_), &(color_), &(key_), (newcomm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_COMM_SPLIT", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Comm_split(comm_, color_, key_, newcomm_, ierr_) \ { \ (ierr_) = MPI_Comm_split((comm_), (color_), (key_), (newcomm_)); \ Mmpierror((ierr_), "MPI_Comm_split", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Error_class(errcode_, errclass_, ierr_) \ { \ mpi_error_class_(&(errcode_), (errclass_), &(ierr_)); \ Mmpierror((ierr_), "MPI_ERROR_CLASS", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Error_class(errcode_, errclass_, ierr_) \ { \ (ierr_) = MPI_Error_class((errcode_), (errclass_)); \ Mmpierror((ierr_), "MPI_Error_class", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Finalize(ierr_) \ { \ mpi_finalize_(&(ierr_)); \ Mmpierror((ierr_), "MPI_FINALIZE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Finalize(ierr_) \ { \ (ierr_) = MPI_Finalize(); \ Mmpierror((ierr_), "MPI_Finalize", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Get_count(stat_, dtype_, count_, ierr_) \ { \ mpi_get_count_((stat_), &(dtype_), (count_), &(ierr_)); \ Mmpierror((ierr_), "MPI_GET_COUNT", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Get_count(stat_, dtype_, count_, ierr_) \ { \ (ierr_) = MPI_Get_count((stat_), (dtype_), (count_)); \ Mmpierror((ierr_), "MPI_Get_count", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Group_free(grp_, ierr_) \ { \ mpi_group_free_((grp_), &(ierr_)); \ Mmpierror((ierr_), "MPI_GROUP_FREE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Group_free(grp_, ierr_) \ { \ (ierr_) = MPI_Group_free(grp_); \ Mmpierror((ierr_), "MPI_Group_free", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Group_incl(grp_, n_, ranks_, newgrp_, ierr_) \ { \ mpi_group_incl_(&(grp_), &(n_), (ranks_), (newgrp_), &(ierr_)); \ Mmpierror((ierr_), "MPI_GROUP_INCL", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Group_incl(grp_, n_, ranks_, newgrp_, ierr_) \ { \ (ierr_) = MPI_Group_incl((grp_), (n_), (ranks_), (newgrp_)); \ Mmpierror((ierr_), "MPI_Group_incl", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Group_translate_ranks(grp1_, n_, ranks1_, grp2_, ranks2_, ierr_) \ { \ MPI_Group_translate_ranks(&(grp1_), &(n_), (ranks1_), &(grp2_), (ranks2_),\ &(ierr_)); \ Mmpierror((ierr_), "MPI_GROUP_TRANSLATE_RANKS", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Group_translate_ranks(grp1_, n_, ranks1_, grp2_, ranks2_, ierr_) \ { \ (ierr_) = MPI_Group_translate_ranks((grp1_), (n_), (ranks1_), (grp2_),\ (ranks2_)); \ Mmpierror((ierr_), "MPI_Group_translate_ranks", NULL, __LINE__, __FILE__); \ } #endif /* * The BLACS always call f77's mpi_init. If the user is using C, he should * explicitly call MPI_Init . . . */ #define BI_MPI_Init(argc_, argv_, ierr_) \ { \ mpi_init_(&(ierr_)); \ Mmpierror((ierr_), "MPI_INIT", NULL, __LINE__, __FILE__); \ } #ifdef UseF77Mpi #define BI_MPI_Initialized(flag_, ierr_) \ { \ bi_f77_mpi_initialized_((flag_), &(ierr_)); \ Mmpierror((ierr_), "MPI_INITIALIZED", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Initialized(flag_, ierr_) \ { \ (ierr_) = MPI_Initialized((flag_)); \ Mmpierror((ierr_), "MPI_Initialized", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Irecv(buf_, count_, dtype_, src_, tag_, comm_, req_, ierr_) \ mpi_irecv_((buf_), &(count_), &(dtype_), &(src_), &(tag_), &(comm_), \ (req_), &(ierr_)) #else #define BI_MPI_Irecv(buf_, count_, dtype_, src_, tag_, comm_, req_, ierr_) \ (ierr_) = MPI_Irecv((buf_), (count_), (dtype_), (src_), (tag_), (comm_), \ (req_)) #endif #ifdef UseF77Mpi #define BI_MPI_Isend(buf_, count_, dtype_, dest_, tag_, comm_, req_, ierr_) \ mpi_isend_((buf_), &(count_), &(dtype_), &(dest_), &(tag_), &(comm_), \ (req_), &(ierr_)); #else #define BI_MPI_Isend(buf_, count_, dtype_, dest_, tag_, comm_, req_, ierr_) \ (ierr_) = MPI_Isend((buf_), (count_), (dtype_), (dest_), (tag_), (comm_), \ (req_)) #endif #ifdef UseF77Mpi #define BI_MPI_Op_create(func_, commute_, op_, ierr_) \ { \ bi_f77_mpi_op_create_((func_), &(commute_), (op_), &(ierr_)); \ Mmpierror((ierr_), "MPI_OP_CREATE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Op_create(func_, commute_, op_, ierr_) \ { \ (ierr_) = MPI_Op_create((func_), (commute_), (op_)); \ Mmpierror((ierr_), "MPI_Op_create", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Op_free(op_, ierr_) \ { \ mpi_op_free_((op_), &(ierr_)); \ Mmpierror((ierr_), "MPI_OP_FREE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Op_free(op_, ierr_) \ { \ (ierr_) = MPI_Op_free((op_)); \ Mmpierror((ierr_), "MPI_Op_free", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Pack(inbuf_, incount_, dtype_, outbuf_, outsiz_, pos_, comm_, ierr_) \ { \ mpi_pack_((inbuf_), &(incount_), &(dtype_), (outbuf_), &(outsiz_), \ (pos_), &(comm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_PACK", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Pack(inbuf_, incount_, dtype_, outbuf_, outsiz_, pos_, comm_, ierr_) \ { \ (ierr_) = MPI_Pack((inbuf_), (incount_), (dtype_), (outbuf_), (outsiz_), \ (pos_), (comm_)); \ Mmpierror((ierr_), "MPI_Pack", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Pack_size(incount_, dtype_, comm_, size_, ierr_) \ { \ mpi_pack_size_(&(incount_), &(dtype_), &(comm_), (size_), &(ierr_)); \ Mmpierror((ierr_), "MPI_PACK_SIZE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Pack_size(incount_, dtype_, comm_, size_, ierr_) \ { \ (ierr_) = MPI_Pack_size((incount_), (dtype_), (comm_), (size_)); \ Mmpierror((ierr_), "MPI_Pack_size", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Recv(buf_, count_, dtype_, src_, tag_, comm_, stat_, ierr_) \ { \ mpi_recv_((buf_), &(count_), &(dtype_), &(src_), &(tag_), &(comm_), \ (stat_), &(ierr_)); \ Mmpierror((ierr_), "MPI_RECV", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Recv(buf_, count_, dtype_, src_, tag_, comm_, stat_, ierr_) \ { \ (ierr_) = MPI_Recv((buf_), (count_), (dtype_), (src_), (tag_), (comm_), \ (stat_)); \ Mmpierror((ierr_), "MPI_Recv", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Reduce(sbuf_, rbuf_, count_, dtype_, op_, root_, comm_, ierr_) \ { \ mpi_reduce_((sbuf_), (rbuf_), &(count_), &(dtype_), &(op_), &(root_), \ &(comm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_REDUCE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Reduce(sbuf_, rbuf_, count_, dtype_, op_, root_, comm_, ierr_) \ { \ (ierr_) = MPI_Reduce((sbuf_), (rbuf_), (count_), (dtype_), (op_), (root_), \ (comm_)); \ Mmpierror((ierr_), "MPI_Reduce", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Rsend(buf_, count_, dtype_, dest_, tag_, comm_, ierr_) \ { \ mpi_rsend_((buf_), &(count_), &(dtype_), &(dest_), &(tag_), &(comm_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_RSEND", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Rsend(buf_, count_, dtype_, dest_, tag_, comm_, ierr_) \ { \ (ierr_) = MPI_Rsend((buf_), (count_), (dtype_), (dest_), (tag_), (comm_)); \ Mmpierror((ierr_), "MPI_Rsend", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Send(buf_, count_, dtype_, dest_, tag_, comm_, ierr_) \ { \ mpi_send_((buf_), &(count_), &(dtype_), &(dest_), &(tag_), &(comm_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_SEND", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Send(buf_, count_, dtype_, dest_, tag_, comm_, ierr_) \ { \ (ierr_) = MPI_Send((buf_), (count_), (dtype_), (dest_), (tag_), (comm_)); \ Mmpierror((ierr_), "MPI_Send", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Sendrecv(sbuf_, scount_, stype_, dest_, stag_, rbuf_, rcount_, rtype_, src_, rtag_, comm_, stat_, ierr_) \ { \ mpi_sendrecv_((sbuf_), &(scount_), &(stype_), &(dest_), &(stag_), \ (rbuf_), &(rcount_), &(rtype_), &(src_), &(rtag_), \ &(comm_), (stat_), &(ierr_)); \ Mmpierror((ierr_), "MPI_SENDRECV", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Sendrecv(sbuf_, scount_, stype_, dest_, stag_, rbuf_, rcount_, rtype_, src_, rtag_, comm_, stat_, ierr_) \ { \ (ierr_) = MPI_Sendrecv((sbuf_), (scount_), (stype_), (dest_), (stag_), \ (rbuf_), (rcount_), (rtype_), (src_), (rtag_), \ (comm_), (stat_)); \ Mmpierror((ierr_), "MPI_Sendrecv", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Test(req_, flag_, stat_, ierr_) \ { \ bi_f77_mpi_test_(&(req_), (flag_), (stat_), &(ierr_)); \ Mmpierror((ierr_), "MPI_TEST", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Test(req_, flag_, stat_, ierr_) \ { \ (ierr_) = MPI_Test((req_), (flag_), (stat_)); \ Mmpierror((ierr_), "MPI_Test", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Testall(count_, reqs_, flag_, stats_, ierr_) \ { \ bi_f77_mpi_testall_(&(count_), (reqs_), (flag_), (stats_), &(ierr_)); \ Mmpierror((ierr_), "MPI_TESTALL", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Testall(count_, reqs_, flag_, stats_, ierr_) \ { \ (ierr_) = MPI_Testall((count_), (reqs_), (flag_), (stats_)); \ Mmpierror((ierr_), "MPI_Testall", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Type_commit(dtype_, ierr_) \ { \ mpi_type_commit_((dtype_), &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_COMMIT", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Type_commit(dtype_, ierr_) \ { \ (ierr_) = MPI_Type_commit((dtype_)); \ Mmpierror((ierr_), "MPI_Type_commit", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Type_contiguous(count_, oldtype_, newtype_, ierr_) \ { \ mpi_type_contiguous_(&(count_), &(oldtype_), (newtype_), &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_CONTIGUOUS", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Type_contiguous(count_, oldtype_, newtype_, ierr_) \ { \ (ierr_) = MPI_Type_contiguous((count_), (oldtype_), (newtype_)); \ Mmpierror((ierr_), "MPI_Type_contiguous", NULL, __LINE__, __FILE__); \ } #endif /* * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, * so we set type MPI_BYTE as a flag for a 0 byte message */ #ifdef ZeroByteTypeBug #ifdef UseF77Mpi #define BI_MPI_Type_free(dtype_, ierr_) \ { \ if ( *(dtype_) != BI_MPI_BYTE) \ { \ mpi_type_free_((dtype_), &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_FREE", NULL, __LINE__, __FILE__); \ } \ } #else #define BI_MPI_Type_free(dtype_, ierr_) \ { \ if ( *(dtype_) != BI_MPI_BYTE) \ { \ (ierr_) = MPI_Type_free((dtype_)); \ Mmpierror((ierr_), "MPI_Type_free", NULL, __LINE__, __FILE__); \ } \ } #endif #else #ifdef UseF77Mpi #define BI_MPI_Type_free(dtype_, ierr_) \ { \ mpi_type_free_((dtype_), &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_FREE", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Type_free(dtype_, ierr_) \ { \ (ierr_) = MPI_Type_free((dtype_)); \ Mmpierror((ierr_), "MPI_Type_free", NULL, __LINE__, __FILE__); \ } #endif #endif #ifdef UseF77Mpi #define BI_MPI_Type_indexed(count_, lens_, disp_, oldtype_, newtype_, ierr_) \ { \ mpi_type_indexed_(&(count_), (lens_), (disp_), &(oldtype_), (newtype_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_INDEXED", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Type_indexed(count_, lens_, disp_, oldtype_, newtype_, ierr_) \ { \ (ierr_) = MPI_Type_indexed((count_), (lens_), (disp_), (oldtype_), \ (newtype_)); \ Mmpierror((ierr_), "MPI_Type_indexed", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Type_struct(count_, lens_, disps_, types_, newtype_, ierr_) \ { \ mpi_type_struct_(&(count_), (lens_), (disps_), (types_), (newtype_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_STRUCT", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Type_struct(count_, lens_, disps_, types_, newtype_, ierr_) \ { \ (ierr_) = MPI_Type_struct((count_), (lens_), (disps_), (types_), \ (newtype_)); \ Mmpierror((ierr_), "MPI_Type_struct", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Type_vector(count_, len_, stride_, oldtype_, newtype_, ierr_) \ { \ mpi_type_vector_(&(count_), &(len_), &(stride_), &(oldtype_), (newtype_), \ &(ierr_)); \ Mmpierror((ierr_), "MPI_TYPE_VECTOR", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Type_vector(count_, len_, stride_, oldtype_, newtype_, ierr_) \ { \ (ierr_) = MPI_Type_vector((count_), (len_), (stride_), (oldtype_), \ (newtype_)); \ Mmpierror((ierr_), "MPI_Type_vector", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Unpack(inbuf_, insize_, pos_, outbuf_, outcount_, dtype_, comm_, ierr_) \ { \ mpi_unpack_((inbuf_), &(insize_), (pos_), (outbuf_), &(outcount_), \ &(dtype_), &(comm_), &(ierr_)); \ Mmpierror((ierr_), "MPI_UNPACK", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Unpack(inbuf_, insize_, pos_, outbuf_, outcount_, dtype_, comm_, ierr_) \ { \ (ierr_) = MPI_Unpack((inbuf_), (insize_), (pos_), (outbuf_), (outcount_), \ (dtype_), (comm_)); \ Mmpierror((ierr_), "MPI_Unpack", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Waitall(count_, reqs_, stats_, ierr_) \ { \ mpi_waitall_(&(count_), (reqs_), (stats_), &(ierr_)); \ Mmpierror((ierr_), "MPI_WAITALL", NULL, __LINE__, __FILE__); \ } #else #define BI_MPI_Waitall(count_, reqs_, stats_, ierr_) \ { \ (ierr_) = MPI_Waitall((count_), (reqs_), (stats_)); \ Mmpierror((ierr_), "MPI_Waitall", NULL, __LINE__, __FILE__); \ } #endif #ifdef UseF77Mpi #define BI_MPI_Wtime mpi_wtime_ #else #define BI_MPI_Wtime MPI_Wtime #endif #ifdef CRAY #ifndef UseF77Mpi #undef BI_MPI_FLOAT #define BI_MPI_FLOAT BI_MPI_DOUBLE #endif #endif #endif blacs-mpi-1.1/SRC/MPI/INTERNAL/ 40755 1750 144 0 6710306457 14653 5ustar pfrauenfusersblacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Arecv.c100644 1750 144 2267 6313301024 16515 0ustar pfrauenfusers#include "Bdef.h" void BI_Arecv(BLACSCONTEXT *ctxt, int src, int msgid, BLACBUFF *bp) { int i, info, errclass; BI_MPI_Irecv(bp->Buff, bp->N, bp->dtype, src, msgid, ctxt->scp->comm, &bp->Aops[bp->nAops], info); while(info != BI_MPI_SUCCESS) { BI_MPI_Error_class(info, &errclass, i); if ( (errclass != BI_MPI_ERR_UNKNOWN) && (errclass != BI_MPI_ERR_OTHER) && (errclass != BI_MPI_ERR_INTERN) ) { Mmpierror(info, "MPI_Irecv", ctxt, __LINE__, __FILE__); BI_BlacsErr(BI_ContxtNum(ctxt), __LINE__, __FILE__, "MPI error %d on call to MPI_Irecv", info); } #if (BlacsDebugLvl > 0) else BI_BlacsWarn(BI_ContxtNum(ctxt), __LINE__, __FILE__, "MPI error %d assumed to mean out of non-blocking resources on call to MPI_Irecv", info); #endif BI_MPI_Irecv(bp->Buff, bp->N, bp->dtype, src, msgid, ctxt->scp->comm, &bp->Aops[bp->nAops], info); } bp->nAops++; /* * Signal if we need to use status to figure out true length of received message * We only need do this if we are doing our own buffering */ #ifndef MpiBuffGood if (bp->dtype == BI_MPI_PACKED) bp->N = -bp->nAops; #endif } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ArgCheck.c100644 1750 144 6710 6313301024 17121 0ustar pfrauenfusers#include "Bdef.h" void BI_ArgCheck(int ConTxt, int RoutType, char *routine, char scope, char uplo, char diag, int m, int n, int lda, int nprocs, int *prows, int *pcols) { #if (BlacsDebugLvl > 0) char *srcdest; int i=1, prow, pcol, Ng, nprow, npcol, myrow, mycol; BLACSCONTEXT *ctxt; MGetConTxt(ConTxt, ctxt); Mgridinfo(ctxt, Ng, nprow, npcol, myrow, mycol); if ( (scope != 'r') && (scope != 'c') && (scope != 'a') ) BI_BlacsErr(ConTxt, -1, routine, "Unknown scope, scope=%c", scope); if ( (uplo != 'u') && (uplo != 'l') ) { if (RoutType != RT_COMB) BI_BlacsWarn(ConTxt, -1, routine, "UPLO=%c, will be assumed to mean LOWER", uplo); else i = 0; /* combine aux, for rect. matrix */ } if ( (diag != 'u') && (diag != 'n') ) { if (i) BI_BlacsWarn(ConTxt, -1, routine, "DIAG=%c, will be assumed to mean NON-UNIT", diag); } if (m * n != 0) { if (m < 0) BI_BlacsErr(ConTxt, -1, routine, "Illegal number of rows, M=%d", m); if (n < 0) BI_BlacsErr(ConTxt, -1, routine, "Illegal number of columns, N=%d", n); if (lda < m) BI_BlacsWarn(ConTxt, -1, routine, "Illegal LDA, LDA=%d, M=%d; LDA assumed to be %d", lda, m, m); } if ( (RoutType == RT_RV) || (RoutType == RT_BR) ) srcdest = "SRC"; else srcdest = "DEST"; if (RoutType == RT_SD) { if ( (nprocs > Ng) || (nprocs < 0) ) BI_BlacsErr(ConTxt, -1, routine, "Trying to send to %d procs, but only %d in grid", nprocs, Ng); } for (i=0; i < nprocs; i++) { prow = prows[i]; pcol = pcols[i]; if ( (prow < 0) || (prow >= nprow) ) { if ( !((RoutType == RT_COMB) && (prow == -1)) ) BI_BlacsErr(ConTxt, -1, routine, "R%s out of range; R%s=%d, NPROW=%d", srcdest, srcdest, prow, nprow); } if ( (pcol < 0) || (pcol >= npcol) ) { if ( !((RoutType == RT_COMB) && (prow == -1)) ) BI_BlacsErr(ConTxt, -1, routine, "C%s out of range; C%s=%d, NPCOL=%d", srcdest, srcdest, pcol, npcol); } if (RoutType == RT_SD) /* point to point send */ { if ( (prow == myrow) && (pcol == mycol) ) BI_BlacsWarn(ConTxt, -1, routine, "Node sending message to itself"); } else if (RoutType == RT_RV) /* point to point send */ { if ( (prow == myrow) && (pcol == mycol) ) BI_BlacsWarn(ConTxt, -1, routine, "Node recving message from itself"); } else if (RoutType == RT_BR) /* broadcast/recv */ { if ( (prow == myrow) && (pcol == mycol) ) BI_BlacsErr(ConTxt, -1, routine, "Node tries to recv its own broadcast"); if (scope == 'r') { if (myrow != prow) BI_BlacsWarn(ConTxt, -1, routine, "Row broadcast: MYROW=%d, but RSRC=%d", myrow, prow); } else if (scope == 'c') { if (mycol != pcol) { BI_BlacsErr(ConTxt, -1, routine, "Column broadcast: MYCOL=%d, but CSRC=%d", mycol, pcol); } } } } #endif } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Asend.c100644 1750 144 1731 6313301024 16502 0ustar pfrauenfusers#include "Bdef.h" void BI_Asend(BLACSCONTEXT *ctxt, int dest, int msgid, BLACBUFF *bp) { int i, info, errclass; BI_MPI_Isend(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm, &bp->Aops[bp->nAops], info); while(info != BI_MPI_SUCCESS) { BI_MPI_Error_class(info, &errclass, i); if ( (errclass != BI_MPI_ERR_UNKNOWN) && (errclass != BI_MPI_ERR_OTHER) && (errclass != BI_MPI_ERR_INTERN) ) { Mmpierror(info, "MPI_Isend", ctxt, __LINE__, __FILE__); BI_BlacsErr(BI_ContxtNum(ctxt), __LINE__, __FILE__, "MPI error %d on call to MPI_Isend", info); } #if (BlacsDebugLvl > 0) else BI_BlacsWarn(BI_ContxtNum(ctxt), __LINE__, __FILE__, "MPI error %d assumed to mean out of non-blocking resources on call to MPI_Isend", info); #endif BI_MPI_Isend(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm, &bp->Aops[bp->nAops], info); } bp->nAops++; } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_BeComb.c100644 1750 144 6722 6313301024 16604 0ustar pfrauenfusers#include "Bdef.h" /* * The bidirectional exchange topology (BE) is specialized for dealing with * case where all nodes participating in the operation need to * receive the answer. It works best when # of nodes is some even * power of two. This topology is based on an algorithm presented by * Robert van de Geijn, et al. */ void BI_BeComb(BLACSCONTEXT *ctxt, BLACBUFF *bp, BLACBUFF *bp2, int N, VVFUNPTR Xvvop) /* * -- V1.1ALPHA (test version) BLACS routine -- * University of Tennessee, October 1, 1995 * Written by Clint Whaley. * * Purpose * ======= * Perform a element-by-element combine on vectors. * The answer will be left on all participating processes. Since this method * uses a hypercube communication pattern, the number of nodes participating * in the operation must be a power of 2 for it to perform efficiently. * * Arguments * ========= * CTXT (input) pointer to BLACSCONTEXT * The BLACS context where operation is taking place. * * BP (input/output) pointer to BLACBUFF. * BLACBUFF is a special data type used by the BLACS to control * buffers and the asynchronous operations coming out of them. * This BLACBUFF should have a buffer who's first N elements * contain the data to be combined. Additional space may be * required, depending upon what combine is being performed. * * BP2 (workspace) pointer to BLACBUFF. * This BLACBUFF is used to receive information for combining with * this process's information. * * N (input) int * The number of elements in the vector to be combined. * * Xvvop (input) pointer to typed operation function * Points to a typed function which performs the required operation * (e.g. summation) on the two N-element vectors. * * ------------------------------------------------------------------------ */ { void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Rsend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Arecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); int Np, Iam, dest, msgid, Rmsgid, np2, bit, ierr; extern BI_MPI_Status *BI_Stats; Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); Rmsgid = Mscopeid(ctxt); for (np2=4; np2 < Np; np2 <<= 1); if (np2 > Np) np2 >>= 1; if (np2 != Np) { dest = (Iam ^ np2); if (Iam >= np2) /* I'm node beyond power of 2 */ { BI_Arecv(ctxt, dest, Rmsgid, bp); BI_Ssend(ctxt, dest, msgid, bp); BI_BuffIsFree(bp, 1); } else if (Iam < (Np^np2)) /* need to fan in contents of */ { /* non-power of 2 nodes */ BI_Srecv(ctxt, dest, msgid, bp2); Xvvop(N, bp->Buff, bp2->Buff); } } if (Iam < np2) { for (bit=1; (bit ^ np2); bit <<= 1) { dest = Iam ^ bit; BI_MPI_Sendrecv(bp->Buff, bp->N, bp->dtype, dest, msgid, bp2->Buff, bp2->N, bp2->dtype, dest, msgid, ctxt->scp->comm, BI_Stats, ierr); Xvvop(N, bp->Buff, bp2->Buff); } /* * For nodes that are not part of the hypercube proper, we must * send data back. */ if (Iam < (Np^np2)) BI_Rsend(ctxt, (Iam ^ np2), Rmsgid, bp); } /* end if (nodes inside power of 2) */ } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_BlacsAbort.c100644 1750 144 231 6313301024 17436 0ustar pfrauenfusers#include "Bdef.h" void BI_BlacsAbort(int ErrNo) { int ierr; fflush(stderr); fflush(stdout); BI_MPI_Abort(BI_MPI_COMM_WORLD, ErrNo, ierr); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_BlacsErr.c100644 1750 144 1740 6313301024 17145 0ustar pfrauenfusers#include "Bdef.h" #ifdef __STDC__ void BI_BlacsErr(int ConTxt, int line, char *file, char *form, ...) #else void BI_BlacsErr(va_alist) va_dcl #endif { #ifdef __STDC__ void BI_BlacsAbort(int ErrNo); #else void BI_BlacsAbort(); #endif extern int BI_Iam; int myrow, mycol; va_list argptr; char cline[100]; BLACSCONTEXT *ctxt; #ifdef __STDC__ va_start(argptr, form); #else char *file, *form; int ConTxt, line; va_start(argptr); ConTxt = va_arg(argptr, int); line = va_arg(argptr, int); file = va_arg(argptr, char *); form = va_arg(argptr, char *); #endif vsprintf(cline, form, argptr); va_end(argptr); if (ConTxt > -1) { MGetConTxt(ConTxt, ctxt); myrow = ctxt->cscp.Iam; mycol = ctxt->rscp.Iam; } else myrow = mycol = -1; fprintf(stderr, "BLACS ERROR '%s'\nfrom {%d,%d}, pnum=%d, Contxt=%d, on line %d of file '%s'.\n\n", cline, myrow, mycol, BI_Iam, ConTxt, line, file); BI_BlacsAbort(1); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_BlacsWarn.c100644 1750 144 1606 6313301024 17325 0ustar pfrauenfusers#include "Bdef.h" #ifdef __STDC__ void BI_BlacsWarn(int ConTxt, int line, char *file, char *form, ...) #else void BI_BlacsWarn(va_alist) va_dcl #endif { extern int BI_Iam; extern BLACSCONTEXT **BI_MyContxts; int myrow, mycol; va_list argptr; char cline[100]; #ifdef __STDC__ va_start(argptr, form); #else char *file, *form; int ConTxt, line; va_start(argptr); ConTxt = va_arg(argptr, int); line = va_arg(argptr, int); file = va_arg(argptr, char *); form = va_arg(argptr, char *); #endif vsprintf(cline, form, argptr); va_end(argptr); if (ConTxt > -1) { myrow = BI_MyContxts[ConTxt]->cscp.Iam; mycol = BI_MyContxts[ConTxt]->rscp.Iam; } else myrow = mycol = -1; fprintf(stderr, "BLACS WARNING '%s'\nfrom {%d,%d}, pnum=%d, Contxt=%d, on line %d of file '%s'.\n\n", cline, myrow, mycol, BI_Iam, ConTxt, line, file); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_BuffIsFree.c100644 1750 144 3257 6313301024 17435 0ustar pfrauenfusers#include "Bdef.h" int BI_BuffIsFree(BLACBUFF *bp, int Wait) /* * Check to see if buff is finished with async. operations. If Wait != 0, * wait for all async. operations to complete. */ { int i, info; extern BI_MPI_Status *BI_Stats; extern int BI_Np; if (!Wait) { BI_MPI_Testall(bp->nAops, bp->Aops, &i, BI_Stats, info); if (!i) { /* * If we are doing our own Packing, need to check true length of receive */ #ifndef MpiBuffGood /* * If we have an outstanding receive, make sure that when it * completes we correctly set bp->N, if required */ if (bp->N < 0) { if (bp->Aops[-bp->N-1] == BI_MPI_REQUEST_NULL) { BI_MPI_Get_count(&BI_Stats[(-bp->N-1)*BI_MPI_STATUS_SIZE], BI_MPI_PACKED, &i, info); if (i != BI_MPI_UNDEFINED) bp->N = i; else BI_BlacsWarn(-1, __LINE__, __FILE__, "MPI_Get_count returned MPI_UNDEFINED.\n"); } } #endif return(0); } } else { BI_MPI_Waitall(bp->nAops, bp->Aops, BI_Stats, info); } bp->nAops = 0; /* * If we are doing our own packing, need to check true length of receive */ #ifndef MpiBuffGood /* * If we had an outstanding receive, make sure that we correctly set bp->N, * if required */ if (bp->N < 0) { BI_MPI_Get_count(&BI_Stats[(-bp->N-1)*BI_MPI_STATUS_SIZE], BI_MPI_PACKED, &i, info); if (i != BI_MPI_UNDEFINED) bp->N = i; else BI_BlacsWarn(-1, __LINE__, __FILE__, "MPI_Get_count returned MPI_UNDEFINED.\n"); } #endif return(1); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ContxtNum.c100644 1750 144 612 6313301027 17367 0ustar pfrauenfusers#include "Bdef.h" int BI_ContxtNum(BLACSCONTEXT *ctxt) /* * Returns the integer ID of ctxt */ { int i; extern int BI_MaxNCtxt; extern BLACSCONTEXT **BI_MyContxts; if (ctxt == NULL) return(-1); for (i=0; i < BI_MaxNCtxt; i++) if (BI_MyContxts[i] == ctxt) break; if (i == BI_MaxNCtxt) BI_BlacsErr(-1, -1, "BLACS INTERNAL ROUTINE", "illegal context"); return(i); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_EmergencyBuff.c100644 1750 144 3067 6313301024 20175 0ustar pfrauenfusers#include "Bdef.h" /*************************************************************************** * If there is insufficient space to allocate a needed buffer, this * * routine is called. It moniters active buffers for the time defined by * * the user-changeable macro value BUFWAIT. If in that time no active * * buffer becomes inactive, a hang is assumed, and the grid is killed. * ***************************************************************************/ void BI_EmergencyBuff(int length) { void BI_UpdateBuffs(BLACBUFF *); char *cptr; int i, j; double Mwalltime(void); double t1; extern int BI_Np; extern BLACBUFF *BI_ReadyB, *BI_ActiveQ; j = sizeof(BLACBUFF); if (j % sizeof(BI_MPI_Request)) j += sizeof(BI_MPI_Request) - j % sizeof(BI_MPI_Request); i = j + BI_Np*sizeof(BI_MPI_Request); if (i % BUFFALIGN) i += BUFFALIGN - i % BUFFALIGN; t1 = Mwalltime(); while ( (BI_ActiveQ) && (Mwalltime() - t1 < BUFWAIT) && !(BI_ReadyB) ) { BI_UpdateBuffs(NULL); if (BI_ReadyB) { if (BI_ReadyB->Len < length) { free(BI_ReadyB); cptr = malloc(length + i); BI_ReadyB = (BLACBUFF *) cptr; if (BI_ReadyB) { BI_ReadyB->nAops = 0; BI_ReadyB->Aops = (BI_MPI_Request *) &cptr[j]; BI_ReadyB->Buff = &cptr[i]; BI_ReadyB->Len = length; } } } } if (BI_ReadyB == NULL) { BI_BlacsErr(-1, __LINE__, __FILE__, "BLACS out of buffer space"); } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_GetBuff.c100644 1750 144 6454 6313301024 17001 0ustar pfrauenfusers#include "Bdef.h" /*************************************************************************** * The mpi implements globally blocking sends. I.e., a send blocks until * * the dest. node issues a recv. The BLACS assume locally-blocking sends.* * Therefore, the BLACS must fake locally-blocking sends. To do this * * requires an indeterminate number of buffers and the use of * * non-blocking sends. However, it is very important that even though I * * provide a dynamic number of buffers, that getting these buffers does * * not take too long in the critical part of a send operation. * * Therefore, the buffer management is broken into two routines. * * * * Inside the BLACS there are two states a buffer may be in. If the buff * * is currently being used (for instance, an asynchronous send is coming * * from it), it is classified as an ACTIVE buffer, and is on the active * * buffer queue. Otherwise, a buffer is READY: it is not being used * * and is available for the next buffer operation. * * In order to avoid buffer proliferation, only one ready buffer is kept, * * and as active buffers become inactive they either become the ready * * buffer, or are freed. * * * * The first routine, BI_GetBuff, checks if the ready buffer is big enough * * to fulfill the buffer request. If not, the present ready buffer is * * is freed, and a new buffer of the required length is allocated. If * * the buffer is of sufficent size already, no action is taken. * * This routine is purposely very short, as it is called at the beginning * * of each broadcast/send operation. All participating nodes * * are waiting on the source node, so this routine must be very cheap. * * * * The second routine, BI_UpdateBuffs, moves the ready buffer to the active * * buffer queue (if needed). It also checks the entire active buffer * * queue to see if any have finished their operations. If so, they are * * are either moved to the ready buff, or freed. This routine is called * * AFTER the send/broadcast has been started, and thus I am free to make * * it a little more complex. * ***************************************************************************/ BLACBUFF *BI_GetBuff(int length) { void BI_EmergencyBuff(int length); char *cptr; int i, j; extern int BI_Np; extern BLACBUFF *BI_ReadyB; /* * If ready buffer already exists, and is big enough, return it. Otherwise, * free the buffer (if it exists) and get one of correct size */ if (BI_ReadyB) { if (BI_ReadyB->Len >= length) return(BI_ReadyB); else free(BI_ReadyB); } /* * Make sure all buffers aligned correctly */ j = sizeof(BLACBUFF); if (j % sizeof(BI_MPI_Request)) j += sizeof(BI_MPI_Request) - j % sizeof(BI_MPI_Request); i = j + BI_Np*sizeof(BI_MPI_Request); if (i % BUFFALIGN) i += BUFFALIGN - i % BUFFALIGN; cptr = malloc(i + length); BI_ReadyB = (BLACBUFF *) cptr; if (BI_ReadyB != NULL) { BI_ReadyB->nAops = 0; BI_ReadyB->Aops = (BI_MPI_Request *) &cptr[j]; BI_ReadyB->Buff = &cptr[i]; BI_ReadyB->Len = length; } else BI_EmergencyBuff(length); return(BI_ReadyB); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_GetMpiGeType.c100644 1750 144 1103 6313301025 17745 0ustar pfrauenfusers#include "Bdef.h" BI_MPI_Datatype BI_GetMpiGeType(BLACSCONTEXT *ctxt, int m, int n, int lda, BI_MPI_Datatype Dtype, int *N) { int info; BI_MPI_Datatype GeType; /* * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, * so we set type MPI_BYTE as a flag for a 0 byte message */ #ifdef ZeroByteTypeBug if ( (m < 1) || (n < 1) ) { *N = 0; return (BI_MPI_BYTE); } #endif *N = 1; BI_MPI_Type_vector(n, m, lda, Dtype, &GeType, info); BI_MPI_Type_commit(&GeType, info); return(GeType); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_GetMpiTrType.c100644 1750 144 4364 6313301025 20013 0ustar pfrauenfusers#include "Bdef.h" BI_MPI_Datatype BI_GetMpiTrType(BLACSCONTEXT *ctxt, char uplo, char diag, int m, int n, int lda, BI_MPI_Datatype Dtype, int *N) { BLACBUFF *BI_GetBuff(int); BI_MPI_Datatype TrType; int info, start, i, k; int *len, *disp; BLACBUFF *bp; if (diag == 'u') start = 1; else start = 0; /* * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, * so we set type MPI_BYTE as a flag for a 0 byte message */ #ifdef ZeroByteTypeBug if (m > n) i = n * (m-n) + (n*n) - (n*n)/2 + n/2 - n*start; else i = m * (n-m) + (m*m) - (m*m)/2 + m/2 - m*start; if (i < 1) { *N = 0; return (BI_MPI_BYTE); } #endif *N = 1; /* * Get space to hold the length and displacement values */ bp = BI_GetBuff( 2 * n * sizeof(int) ); len = (int *) bp->Buff; disp = (int *) &bp->Buff[n*sizeof(int)]; if (m > n) { if (uplo == 'u') { k = m - n + 1 - start; for (i=0; i < n; i++) { len[i] = k + i; disp[i] = i*lda; } } else /* uplo = 'l' and m > n */ { k = m - start; lda++; len[0] = k; disp[0] = start; for (i=1; i < n; i++) { len[i] = k - i; disp[i] = disp[i-1] + lda; } } } else /* m <= n */ { if (uplo == 'u') { k = 1 - start; for (i=0; i < m; i++) { len[i] = i + k; disp[i] = i*lda; } for (; i < n; i++) { len[i] = m; disp[i] = i*lda; } } else /* uplo = 'l' and m <= n */ { k = n - m; for (i=0; i < k; i++) { len[i] = m; disp[i] = i*lda; } if (i < n) { k = n - start; len[i] = k - i; disp[i] = i*lda + start; lda++; for (i++; i < n; i++) { len[i] = k - i; disp[i] = disp[i-1] + lda; } } } } BI_MPI_Type_indexed(n, len, disp, Dtype, &TrType, i); BI_MPI_Type_commit(&TrType, i); return(TrType); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_GlobalVars.c100644 1750 144 1373 6313301027 17511 0ustar pfrauenfusers#include "Bdef.h" /* * Define global variables */ int BI_MaxNCtxt=0; /* Number of context pointers allocated */ int BI_MaxNSysCtxt=0; /* Number of system ctxt ptrs allocated */ int BI_Iam, BI_Np=(-1); /* My pnum, and # of procs in system */ BLACBUFF *BI_ReadyB=NULL; /* buffer that is ready for use */ BLACBUFF *BI_ActiveQ=NULL; /* pointer to start of active buffer queue */ BLACBUFF BI_AuxBuff; BLACSCONTEXT **BI_MyContxts=NULL; /* Array of pointers to my contexts */ BI_MPI_Comm *BI_SysContxts=NULL; #ifdef UseF77Mpi int *BI_F77_MPI_CONSTANTS; /* Array of fortran MPI constants */ #else BI_MPI_Datatype BI_MPI_COMPLEX, BI_MPI_DOUBLE_COMPLEX; #endif int *BI_F77_MPI_COMM_WORLD=NULL; BI_MPI_Status *BI_Stats=NULL; blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_HypBR.c100644 1750 144 1016 6313301023 16427 0ustar pfrauenfusers#include "Bdef.h" int BI_HypBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src) { void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); int relnode, bit, Np, Iam, msgid; Np = ctxt->scp->Np; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); for (bit=2; bit < Np; bit <<= 1); if (bit^Np) return(NPOW2); /* not a power of 2 */ relnode = Iam ^ src; BI_Srecv(ctxt, BANYNODE, msgid, bp); for(bit=1; (bit^Np); bit <<= 1) if (bit > relnode) send(ctxt, Iam^bit, msgid, bp); return(0); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_HypBS.c100644 1750 144 650 6313301023 16413 0ustar pfrauenfusers#include "Bdef.h" int BI_HypBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send) { int bit, Np, Iam, msgid; Np = ctxt->scp->Np; if (Np < 2) return(NORV); Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); for (bit=2; bit < Np; bit <<= 1); if (bit^Np) return(NPOW2); /* not a power of 2 */ for(bit=1; (bit^Np); bit <<= 1) send(ctxt, (Iam^bit), msgid, bp); return(0); /* error-free return */ } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_IdringBR.c100644 1750 144 607 6313301023 17070 0ustar pfrauenfusers#include "Bdef.h" void BI_IdringBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src, int step) { void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); int Np, Iam, msgid, dest; Np = ctxt->scp->Np; Iam = ctxt->scp->Iam; dest = (Np + Iam + step) % Np; msgid = Mscopeid(ctxt); BI_Srecv(ctxt, BANYNODE, msgid, bp); if (dest != src) send(ctxt, dest, msgid, bp); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_IdringBS.c100644 1750 144 411 6313301023 17062 0ustar pfrauenfusers#include "Bdef.h" void BI_IdringBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int step) { int Np, Iam, msgid; Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); send(ctxt, (Np+Iam+step)%Np, msgid, bp); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_MPI_C_to_f77_trans_comm.c100644 1750 144 4337 6327212117 21764 0ustar pfrauenfusers#include "Bdef.h" /* This file from mpiblacs_patch01 */ void BI_MPI_C_to_f77_trans_comm(MPI_Comm Ccomm, int *F77comm) /* * Here I am using system-dependent internals to tranlate a C communicator * to a f77 communicator. Since these routines are * not part of the standard, this routine is fragile, and may change with * releases. If no translation is possible, we can convert all ranks to * MPI_COMM_WORLD, and thus make the translation. However, * this approach makes it so all processes in MPI_COMM_WORLD must call * this routine it to complete. */ { /* * If the MPI we're using is based on MPICH, can use MPICH's internal * translation routines (I found these routines in MPICH version 1.0.9, * June, 1995). */ #if (BI_TransComm == USEMPICH) #ifdef POINTER_64_BITS extern void *MPIR_ToPointer(); extern int MPIR_FromPointer(); extern void MPIR_RmPointer(); #else #define MPIR_ToPointer(a) (a) #define MPIR_FromPointer(a) (int)(a) #define MPIR_RmPointer(a) #endif *F77comm = MPIR_FromPointer(Ccomm); #endif /* * Some systems may implement it so fortran and C handles are the same. If so, * this guy does the obvious replacement . . . */ #if (BI_TransComm == CSAMEF77) *F77comm = (int) Ccomm; #endif /* * If we don't know a clever way to perform translation, we do the boneheaded * thing, and translate all ranks to MPI_COMM_WORLD (which we assume means * the same thing in both languages, i.e. rank 1 in C's MPI_COMM_WORLD is * rank 1 in F77's MPI_COMM_WORLD). We form our new comm based on * MPI_COMM_WORLD, which means that all processes in MPI_COMM_WORLD must * call this routine . . . */ #if (BI_TransComm == BONEHEAD) int i, Np, *pmap; int bgrp, ugrp; MPI_Group Ugrp, Wgrp; /* * Translate ranks based on user's comm to MPI_COMM_WORLD */ MPI_Comm_size(Ccomm, &Np); MPI_Comm_group(Ccomm, &Ugrp); MPI_Comm_group(MPI_COMM_WORLD, &Wgrp); pmap = (int *) malloc(Np * sizeof(int)); for (i=0; i < Np; i++) { MPI_Group_translate_ranks(Ugrp, 1, &i, Wgrp, &pmap[i]); } mpi_comm_group_(BI_F77_MPI_COMM_WORLD, &ugrp, &i); mpi_group_incl_(&ugrp, &Np, pmap, &bgrp, &i); free(pmap); mpi_comm_create_(BI_F77_MPI_COMM_WORLD, &bgrp, F77comm, &i); mpi_group_free_(&bgrp, &i); #endif } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_MPI_F77_to_c_trans_comm.c100644 1750 144 4330 6331451531 21755 0ustar pfrauenfusers#include "Bdef.h" /* This file from mpiblacs_patch01 */ void BI_MPI_F77_to_c_trans_comm(int F77comm, MPI_Comm *Ccomm) /* * Here I am using system-dependent internals to tranlate a C * communicator to a F77 communicator, or vice versa. Since these routines are * not part of the standard, this routine is fragile, and may change with * releases. If no translation is possible, we can convert all ranks to * MPI_COMM_WORLD, and thus make the translation. However, * this approach makes it so all processes in MPI_COMM_WORLD must call * this routine for it to complete. */ { /* * If the MPI we're using is based on MPICH, can use MPICH's internal * translation * routines (I found these routines in MPICH version 1.0.9, * June, 1995). */ #if (BI_TransComm == USEMPICH) #ifdef POINTER_64_BITS extern void *MPIR_ToPointer(); extern int MPIR_FromPointer(); extern void MPIR_RmPointer(); #else #define MPIR_ToPointer(a) (a) #define MPIR_FromPointer(a) (int)(a) #define MPIR_RmPointer(a) #endif *Ccomm = (MPI_Comm) MPIR_ToPointer(F77comm); #endif /* * Some systems may implement it so fortran and C handles are the same. If so, * this guy does the obvious replacement . . . */ #if (BI_TransComm == CSAMEF77) *Ccomm = (MPI_Comm) F77comm; #endif /* * If we don't know a clever way to perform translation, we do the boneheaded * thing, and translate all ranks to MPI_COMM_WORLD (which we assume means * the same thing in both languages, i.e. rank 1 in C's MPI_COMM_WORLD is * rank 1 in F77's MPI_COMM_WORLD). We form our new comm based on * MPI_COMM_WORLD, which means that all processes in MPI_COMM_WORLD must * call this routine . . . */ #if (BI_TransComm == BONEHEAD) int i, Np, *pmap; int Fgrp, Wgrp, ierr, one=1; MPI_Group wgrp, cgrp; mpi_comm_size_(&F77comm, &Np, &ierr); pmap = (int *) malloc(Np * sizeof(int)); mpi_comm_group_(&F77comm, &Fgrp, &ierr); mpi_comm_group_(BI_F77_MPI_COMM_WORLD, &Wgrp, &ierr); for (i=0; i < Np; i++) { mpi_group_translate_ranks_(&Fgrp, &one, &i, &Wgrp, &pmap[i], &ierr); } MPI_Comm_group(MPI_COMM_WORLD, &wgrp); MPI_Group_incl(wgrp, Np, pmap, &cgrp); free(pmap); MPI_Comm_create(MPI_COMM_WORLD, cgrp, Ccomm); MPI_Group_free(&cgrp); #endif } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_MpathBR.c100644 1750 144 2537 6313301023 16751 0ustar pfrauenfusers#include "Bdef.h" void BI_MpathBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src, int npaths) { void BI_Arecv(BLACSCONTEXT *, int, int, BLACBUFF *); int BI_BuffIsFree(BLACBUFF *, int); int pathlen; /* the minimal length of each path */ int mydist; /* my distance from src */ int faredge; /* node at far end of path */ int lastlong; /* distance to node on end of last path with extra node */ int Np, Iam, msgid, Np_1, dest; msgid = Mscopeid(ctxt); BI_Arecv(ctxt, BANYNODE, msgid, bp); Np = ctxt->scp->Np; Iam = ctxt->scp->Iam; Np_1 = Np - 1; if (npaths == FULLCON) npaths = Np_1; if (npaths > 0) { dest = (Iam+1) % Np; mydist = (Np + Iam - src) % Np; } else { dest = (Np_1+Iam) % Np; mydist = (Np + src - Iam) % Np; npaths = -npaths; } /* * Make sure npaths is cool */ if (npaths > Np_1) npaths = Np_1; pathlen = Np_1 / npaths; lastlong = (Np_1%npaths) * (pathlen+1); if (lastlong) { if (mydist <= lastlong) faredge = ((mydist-1)/(pathlen+1)+1)*(pathlen+1); else faredge = ((lastlong-1)/(pathlen+1)+1) * (pathlen+1) + ((mydist-lastlong-1)/pathlen + 1) * pathlen; } else faredge = ((mydist-1)/pathlen + 1) * pathlen; BI_BuffIsFree(bp, 1); /* wait for recv to complete */ if (mydist < faredge) send(ctxt, dest, msgid, bp); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_MpathBS.c100644 1750 144 2402 6313301023 16741 0ustar pfrauenfusers#include "Bdef.h" void BI_MpathBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int npaths) { int pathlen; /* the length of each path */ int dist; /* the distance to the node closest to src on each path */ int pdest; /* part of dest calculation -- saves unneeded ops */ int lastlong; /* number of paths with extra node */ int Np, Iam, msgid, Np_1, dir; Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); Np_1 = Np - 1; if (npaths == FULLCON) npaths = Np_1; if (npaths > 0) /* paths are increasing rings */ { pdest = Iam; dir = 1; } else /* paths are decreasing rings */ { pdest = Np + Iam; dir = -1; npaths = -npaths; } /* * Ensure npaths is correct */ if (npaths > Np_1) npaths = Np_1; pathlen = Np_1 / npaths; /* * Loop over all long paths (paths with an extra node), if there are any */ lastlong = (Np_1 % npaths) * (pathlen+1); /* last node in long ring */ for (dist=1; dist < lastlong; dist += pathlen+1) send(ctxt, (pdest+dir*dist)%Np, msgid, bp); /* * Loop over all normal length paths */ while (dist < Np) { send(ctxt, (pdest+dir*dist)%Np, msgid, bp); dist += pathlen; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_MringComb.c100644 1750 144 4454 6316306351 17345 0ustar pfrauenfusers#include "Bdef.h" void BI_MringComb(BLACSCONTEXT *ctxt, BLACBUFF *bp, BLACBUFF *bp2, int N, VVFUNPTR Xvvop, int dest, int nrings) { void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_MpathBS(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int); void BI_MpathBR(BLACSCONTEXT *, BLACBUFF *, SDRVPTR, int, int); int Np, Iam, msgid, i, inc, mysrc, mydest, Np_1; int mydist, ringlen, myring; int nearedge, faredge; /* edge closest and farthest from dest */ int REBS; /* Is result leave-on-all? */ Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); if (REBS = (dest == -1)) dest = 0; if (nrings > 0) { mydist = (Np + dest - Iam) % Np; inc = 1; } else { mydist = (Np + Iam - dest) % Np; inc = -1; nrings = -nrings; } Np_1 = Np - 1; if (nrings > Np_1) nrings = Np_1; /* * If I'm not the destination */ if (Iam != dest) { ringlen = Np_1 / nrings; myring = (mydist-1) / ringlen; if (myring >= nrings) myring = nrings - 1; nearedge = (myring*ringlen) + 1; faredge = nearedge + ringlen - 1; if (myring == nrings-1) faredge += Np_1 % nrings; if (mydist == nearedge) mydest = dest; else mydest = (Np + Iam + inc) % Np; if (mydist != faredge) { BI_Srecv(ctxt, (Np + Iam - inc) % Np, msgid, bp2); Xvvop(N, bp->Buff, bp2->Buff); } BI_Ssend(ctxt, mydest, msgid, bp); if (REBS) BI_MpathBR(ctxt, bp, BI_Ssend, dest, nrings); } /* * If I'm the destination process */ else { if (!ctxt->TopsRepeat) { for(i=nrings; i; i--) { BI_Srecv(ctxt, BANYNODE, msgid, bp2); Xvvop(N, bp->Buff, bp2->Buff); } } else { ringlen = Np_1 / nrings; if (inc == 1) mysrc = (Np + Iam - 1) % Np; else mysrc = (Iam + 1) % Np; for(i=nrings; i; i--) { BI_Srecv(ctxt, mysrc, msgid, bp2); Xvvop(N, bp->Buff, bp2->Buff); if (inc == 1) mysrc = (Np + mysrc - ringlen) % Np; else mysrc = (mysrc + ringlen) % Np; } } if (REBS) BI_MpathBS(ctxt, bp, BI_Ssend, nrings); } } /* end BI_MringComb */ blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Pack.c100644 1750 144 2637 6327203430 16343 0ustar pfrauenfusers#include "Bdef.h" BLACBUFF *BI_Pack(BLACSCONTEXT *ctxt, BVOID *A, BLACBUFF *bp, BI_MPI_Datatype Dtype) { BLACBUFF *BI_GetBuff(int); int i, info, one=1; BI_MPI_Aint eltsiz; #ifdef ZeroByteTypeBug char *cptr; extern BLACBUFF BI_AuxBuff; extern int BI_Np; #endif /* * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, * so we have set MPI_BYTE as a flag for a 0 byte message */ #ifdef ZeroByteTypeBug if (Dtype == BI_MPI_BYTE) { info = sizeof(BLACBUFF); if (info % sizeof(BI_MPI_Request)) info += sizeof(BI_MPI_Request) - info % sizeof(BI_MPI_Request); i = info + BI_Np*sizeof(BI_MPI_Request); if (i % BUFFALIGN) i += BUFFALIGN - i % BUFFALIGN; cptr = malloc(i); if (cptr) { bp = (BLACBUFF *) cptr; bp->Len = bp->N = bp->nAops = 0; bp->Aops = (BI_MPI_Request *) &cptr[info]; bp->Buff = (char *) &bp->Len; bp->dtype = BI_MPI_BYTE; return(bp); } else BI_BlacsErr(BI_ContxtNum(ctxt), __LINE__, __FILE__, "Not enough memory to allocate 0 byte buffer\n"); } #endif if (bp == NULL) { BI_MPI_Pack_size(one, Dtype, ctxt->scp->comm, &i, info); bp = BI_GetBuff(i); } i = 0; BI_MPI_Pack(A, one, Dtype, bp->Buff, bp->Len, &i, ctxt->scp->comm, info); bp->dtype = BI_MPI_PACKED; bp->N = i; return(bp); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Rsend.c100644 1750 144 274 6313301024 16504 0ustar pfrauenfusers#include "Bdef.h" void BI_Rsend(BLACSCONTEXT *ctxt, int dest, int msgid, BLACBUFF *bp) { int info; BI_MPI_Rsend(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm, info); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Srecv.c100644 1750 144 1231 6313301024 16525 0ustar pfrauenfusers#include "Bdef.h" void BI_Srecv(BLACSCONTEXT *ctxt, int src, int msgid, BLACBUFF *bp) { int i, info; extern BI_MPI_Status *BI_Stats; BI_MPI_Recv(bp->Buff, bp->N, bp->dtype, src, msgid, ctxt->scp->comm, BI_Stats, info); /* * If we are doing our own buffering, need to determine the true length of * the message just received */ #ifndef MpiBuffGood if (bp->dtype == BI_MPI_PACKED) { BI_MPI_Get_count(BI_Stats, BI_MPI_PACKED, &i, info); if (i != BI_MPI_UNDEFINED) bp->N = i; else BI_BlacsWarn(BI_ContxtNum(ctxt), __LINE__, __FILE__, "MPI_Get_count returned MPI_UNDEFINED.\n"); } #endif } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_SringBR.c100644 1750 144 1276 6313301023 16761 0ustar pfrauenfusers#include "Bdef.h" void BI_SringBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src) { void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); int mydist; /* my distance from source */ int Np, Iam, msgid, rightedge; Np = ctxt->scp->Np; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); mydist = (Np + Iam - src) % Np; rightedge = Np/2; BI_Srecv(ctxt, BANYNODE, msgid, bp); /* * If I'm between source & right edge of split ring, send to right */ if (mydist < rightedge) send(ctxt, (Iam+1)%Np, msgid, bp); /* * If I'm between source and left edge of split ring, send to left */ else if (mydist > rightedge+1) send(ctxt, (Np+Iam-1)%Np, msgid, bp); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_SringBS.c100644 1750 144 462 6313301023 16736 0ustar pfrauenfusers#include "Bdef.h" void BI_SringBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send) { int Np, Iam, msgid; Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); send(ctxt, (Iam + 1)%Np, msgid, bp); if (Np > 2) send(ctxt, (Np + Iam - 1)%Np, msgid, bp); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Ssend.c100644 1750 144 271 6313301023 16501 0ustar pfrauenfusers#include "Bdef.h" void BI_Ssend(BLACSCONTEXT *ctxt, int dest, int msgid, BLACBUFF *bp) { int info; BI_MPI_Send(bp->Buff, bp->N, bp->dtype, dest, msgid, ctxt->scp->comm, info); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_TransDist.c100644 1750 144 2563 6313301024 17367 0ustar pfrauenfusers#include "Bdef.h" void BI_TransDist(BLACSCONTEXT *ctxt, char scope, int m, int n, int *rA, int *cA, int ldrc, BI_DistType *dist, int rdest, int cdest) /* * This routine translates distances (offsets from the destination node), * stored in location dist, into row and column coordinates. */ { int i, j, k, dest; int Ng, nprow, npcol, myrow, mycol; Mgridinfo(ctxt, Ng, nprow, npcol, myrow, mycol); if (rdest == -1) rdest = cdest = 0; switch (scope) { case 'r': for (j=0; j < n; j++) { for (i=0; i < m; i++) { rA[i] = myrow; cA[i] = (int) (cdest + dist[i]) % npcol; } rA += ldrc; cA += ldrc; dist += m; } break; case 'c': for (j=0; j < n; j++) { for (i=0; i < m; i++) { rA[i] = (int) (rdest + dist[i]) % nprow; cA[i] = mycol; } rA += ldrc; cA += ldrc; dist += m; } break; case 'a': dest = Mvkpnum(ctxt, rdest, cdest); for (j=0; j < n; j++) { for (i=0; i < m; i++) { k = (int) (dest + dist[i]) % Ng; /* figure node number */ Mvpcoord(ctxt, k, rA[i], cA[i]); /* figure node coordinates */ } rA += ldrc; cA += ldrc; dist += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_TransUserComm.c100644 1750 144 3654 6327212245 20233 0ustar pfrauenfusers#include "Bdef.h" #ifdef UseF77Mpi int BI_TransUserComm(MPI_Comm Ucomm, int Np, int *pmap) #else MPI_Comm BI_TransUserComm(int Ucomm, int Np, int *pmap) #endif /* * Here I am using system-dependent internals to tranlate a fortran * communicator to a C communicator, or vice versa. Since these routines are * not part of the standard, this routine is fragile, and may change with * releases. If no translation is possible, we can convert all ranks to * MPI_COMM_WORLD, and thus make the translation. However, * this approach makes it so all processes in MPI_COMM_WORLD must call * BLACS_GRIDMAP for it to complete, when the translation takes place. I.e., * if BLACS_GRIDMAP is called from C, but the F77 internals are used. */ { BI_MPI_Comm bcomm, ucomm; BI_MPI_Group bgrp, ugrp; int i; #ifdef UseF77Mpi void BI_MPI_C_to_f77_trans_comm(MPI_Comm, int *); #else void BI_MPI_F77_to_c_trans_comm(int F77comm, MPI_Comm *Ccomm); #endif #if (BI_TransComm == BONEHEAD) int k; #ifdef UseF77Mpi MPI_Group Ugrp, Wgrp; /* * Translate ranks based on user's comm to MPI_COMM_WORLD */ MPI_Comm_group(Ucomm, &Ugrp); MPI_Comm_group(MPI_COMM_WORLD, &Wgrp); for (i=0; i < Np; i++) { k = pmap[i]; MPI_Group_translate_ranks(Ugrp, 1, &k, Wgrp, &pmap[i]); } ucomm = *BI_F77_MPI_COMM_WORLD; #else int Ugrp, Wgrp, ierr, one=1; mpi_comm_group_(&Ucomm, &Ugrp, &ierr); mpi_comm_group_(BI_F77_MPI_COMM_WORLD, &Wgrp, &ierr); for (i=0; i < Np; i++) { k = pmap[i]; mpi_group_translate_ranks_(&Ugrp, &one, &k, &Wgrp, &pmap[i], &ierr); } ucomm = MPI_COMM_WORLD; #endif #else #ifdef UseF77Mpi BI_MPI_C_to_f77_trans_comm(Ucomm, &ucomm); #else BI_MPI_F77_to_c_trans_comm(Ucomm, &ucomm); #endif #endif BI_MPI_Comm_group(ucomm, &ugrp, i); BI_MPI_Group_incl(ugrp, Np, pmap, &bgrp, i); BI_MPI_Comm_create(ucomm, bgrp, &bcomm, i); BI_MPI_Group_free(&bgrp, i); return(bcomm); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_TreeBR.c100644 1750 144 1675 6313301023 16601 0ustar pfrauenfusers#include "Bdef.h" void BI_TreeBR(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int src, int nbranches) { void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); int Np, Iam, msgid, i, j; int mydist; /* my distance from src */ int destdist; /* the distance of the destination node */ Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); mydist = (Np + Iam - src) % Np; /* * Go up to first step of tree where I send data to other nodes */ for (i=nbranches; i < Np; i *= nbranches); for (i /= nbranches; (mydist%i); i /= nbranches); BI_Srecv(ctxt, BANYNODE, msgid, bp); /* * While I need to send data to others */ while ( (i > 1) && !(mydist%i) ) { i /= nbranches; j = 1; do { destdist = mydist + j*i; if (destdist < Np) send(ctxt, (src+destdist)%Np, msgid, bp); } while(++j < nbranches); } } /* end BI_TreeBR */ blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_TreeBS.c100644 1750 144 4376 6313301023 16603 0ustar pfrauenfusers#include "Bdef.h" /* * Tree_bs/br is a algorithm that does a broadcast send/recv such that the * communication pattern is a tree with an arbitrary number of branches. * The following two pairs of graphs give different ways of viewing the same * algorithm. The first pair shows the trees as they should be visualized * when examining the algorithm. The second pair are isomorphic graphs of * of the first, which show the actual pattern of data movement. * Note that a tree broadcast with NBRANCHES = 2 is isomorphic with a * hypercube broadcast (however, it does not require the nodes be a * power of two to work). * * TREE BROADCAST, NBRANCHES = 2 * TREE BROADCAST, NBRANCHES = 3 * * * i=4 &______________ * * | \ * * i=2 &______ &______ * i=3 &______________________ * | \ | \ * | \ \ * i=1 &__ &__ &__ &__ * i=1 &______ &______ &__ * | \ | \ | \ | \ * | \ \ | \ \ | \ * 0 1 2 3 4 5 6 7 * 0 1 2 3 4 5 6 7 * * * ISOMORPHIC GRAPHS OF ABOVE, SHOWN IN MORE FAMILIAR TERMS: * * 0 0 * _________|_________ ___________|____________ * / | \ / | | \ * 4 2 1 6 3 2 1 * / \ | | / \ * 6 5 3 7 4 5 * | * 7 */ void BI_TreeBS(BLACSCONTEXT *ctxt, BLACBUFF *bp, SDRVPTR send, int nbranches) { int Np, Iam, msgid, i, j; int destdist; /* the distance of the destination node */ Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); for (i=nbranches; i < Np; i*=nbranches); for (i /= nbranches; i > 0; i /= nbranches) { j = 1; do { destdist = i*j; if (destdist < Np) send(ctxt, (destdist+Iam)%Np, msgid, bp); } while(++j < nbranches); } } /* end BI_TreeBS */ blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_TreeComb.c100644 1750 144 11774 6314345645 17222 0ustar pfrauenfusers#include "Bdef.h" /* * This topology supports trees with arbitrary numbers of branches at * each step. The following pictures show the tree that should be visualized * when examining the algorithm. * * TREE GLOBAL OP, NBRANCHES = 2 * TREE GLOBAL OP, NBRANCHES = 3 * * * i=4 &______________ * * | \ * * i=2 &______ &______ * i=3 &______________________ * | \ | \ * | \ \ * i=1 &__ &__ &__ &__ * i=1 &______ &______ &__ * | \ | \ | \ | \ * | \ \ | \ \ | \ * 0 1 2 3 4 5 6 7 * 0 1 2 3 4 5 6 7 */ void BI_TreeComb(BLACSCONTEXT *ctxt, BLACBUFF *bp, BLACBUFF *bp2, int N, VVFUNPTR Xvvop, int dest, int nbranches) /* * -- V1.1ALPHA (test version) BLACS routine -- * University of Tennessee, October 1, 1995 * Written by Clint Whaley. * * Purpose * ======= * Perform a element-by-element combine on vectors. * If rdest1 = -1, the answer will be left on all participating processes. * Otherwise, only the process at grid coordinates {rdest1, cdest1} will * have the final answer. Other Processes will have intermediate (useless) * values. * * Arguments * ========= * CTXT (input) pointer to BLACSCONTEXT * The BLACS context where operation is taking place. * * BP (input/output) pointer to BLACBUFF. * BLACBUFF is a special data type used by the BLACS to control * buffers and the asynchronous operations coming out of them. * This BLACBUFF should have a buffer who's first N elements * contain the data to be combined. Additional space may be * required, depending upon what combine is being performed. * * BP2 (workspace) pointer to BLACBUFF. * This BLACBUFF is used to receive information for combining with * this process's information. * * DEST (input) int * Node to receive answer. If DEST == -1, all nodes in receive * the answer. * * N (input) int * The number of elements in the vector. N >= 0. * * Xvvop (input) pointer to typed operation function * Points to a typed function which performs the required operation * (e.g. summation) on the two N-element vectors. * * NBRANCHES (input) int * Indicates the degree of the tree to use (see picture above). * * ------------------------------------------------------------------------ */ { void BI_UpdateBuffs(BLACBUFF *); BLACBUFF *BI_GetBuff(int); int BI_BuffIsFree(BLACBUFF *, int); void BI_Ssend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Srecv(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Rsend(BLACSCONTEXT *, int, int, BLACBUFF *); void BI_Arecv(BLACSCONTEXT *, int, int, BLACBUFF *); int Np, Iam, msgid, Rmsgid, i, j; int nrcvs=0; /* Number of ReCeiVeS to do */ int REBS; /* should info be RE-BroadcaSt? */ int rightedge; /* right-most receiving node */ int mydist; /* my distance from destination node */ int dist; int src; /* Used if we must force repeatability */ Np = ctxt->scp->Np; if (Np < 2) return; Iam = ctxt->scp->Iam; msgid = Mscopeid(ctxt); Rmsgid = Mscopeid(ctxt); if (REBS = (dest == -1)) dest = 0; mydist = (Np + Iam - dest) % Np; if (REBS) { dist = mydist; if (mydist != 0) BI_Arecv(ctxt, BANYNODE, Rmsgid, bp); } if (nbranches == FULLCON) nbranches = Np; rightedge = Np - 1 - (Np-1)%nbranches; for (i=1; (i < Np); i *= nbranches) { if (mydist%nbranches) /* nodes that send to other nodes */ { BI_Ssend(ctxt, (dest + (mydist-mydist%nbranches)*i)%Np, msgid, bp); break; /* I'm done */ } else { if (mydist != rightedge) nrcvs = nbranches - 1; else nrcvs = (Np + i - 1) / i - rightedge - 1; mydist /= nbranches; rightedge /= nbranches; rightedge -= (rightedge % nbranches); if (!ctxt->TopsRepeat) { for (j=nrcvs; j; j--) { BI_Srecv(ctxt, BANYNODE, msgid, bp2); Xvvop(N, bp->Buff, bp2->Buff); } } else { src = (Iam + i) % Np; for (j=nrcvs; j; j--) { BI_Srecv(ctxt, src, msgid, bp2); Xvvop(N, bp->Buff, bp2->Buff); src = (src + i) % Np; } } } } /* * Broadcast answer to everyone if RDEST == -1 */ if (REBS) { mydist = dist; for (i=2; i < Np; i <<= 1); if (mydist > 0) BI_BuffIsFree(bp, 1); while (i > 1) { if ( !(mydist%i) ) { i >>= 1; dist = mydist + i; if (dist < Np) BI_Rsend(ctxt, dist, Rmsgid, bp); } else i >>= 1; } } } /* end BI_TreeComb */ blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_Unpack.c100644 1750 144 706 6313301025 16653 0ustar pfrauenfusers#include "Bdef.h" void BI_Unpack(BLACSCONTEXT *ctxt, BVOID *A, BLACBUFF *bp, BI_MPI_Datatype Dtype) { int i=0, info, one=1; /* * Some versions of mpich and its derivitives cannot handle 0 byte typedefs, * so we have set MPI_BYTE as a flag for a 0 byte message */ #ifdef ZeroByteTypeBug if (Dtype == BI_MPI_BYTE) return; #endif BI_MPI_Unpack(bp->Buff, bp->Len, &i, A, one, Dtype, ctxt->scp->comm, info); BI_MPI_Type_free(&Dtype, info); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_UpdateBuffs.c100644 1750 144 2522 6313301024 17657 0ustar pfrauenfusers#include "Bdef.h" void BI_UpdateBuffs(BLACBUFF *Newbp) { int BI_BuffIsFree(BLACBUFF *, int); BLACBUFF *bp, *bp2; extern BLACBUFF *BI_ReadyB, *BI_ActiveQ; if (Newbp) { if (BI_ActiveQ == NULL) BI_ActiveQ = Newbp->prev = Newbp; else { BI_ActiveQ->prev->next = Newbp; Newbp->prev = BI_ActiveQ->prev; BI_ActiveQ->prev = Newbp; } Newbp->next = NULL; if (Newbp == BI_ReadyB) BI_ReadyB = NULL; } /* * See if any active buffers are ready for reuse. */ for (bp=BI_ActiveQ; bp != NULL; bp = bp2) { bp2 = bp->next; if ( BI_BuffIsFree(bp, 0) ) /* if all of buff's Aops are done */ { /* * Remove bp from BI_ActiveQ -- update pointers */ if (bp->next) bp->next->prev = bp->prev; else BI_ActiveQ->prev = bp->prev; if (bp != BI_ActiveQ) bp->prev->next = bp->next; else BI_ActiveQ = BI_ActiveQ->next; /* * If no ready buffer, inactive buff becomes ready */ if (BI_ReadyB == NULL) BI_ReadyB = bp; /* * If inactive buff bigger than present ready buff, release ready, * and inactive buff becomes ready */ else if (BI_ReadyB->Len < bp->Len) { free(BI_ReadyB); BI_ReadyB = bp; } /* * If ready buffer exists and is bigger than inactive buff, * free inactive buff */ else free(bp); } } } /* end BI_UpdateBuffs */ blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cMPI_amn.c100644 1750 144 320 6313301027 17047 0ustar pfrauenfusers#include "Bdef.h" void BI_cMPI_amn(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_cvvamn(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_cvvamn(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cMPI_amn2.c100644 1750 144 246 6313301027 17140 0ustar pfrauenfusers#include "Bdef.h" void BI_cMPI_amn2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_cvvamn2(int, char *, char *); BI_cvvamn2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cMPI_amx.c100644 1750 144 320 6313301026 17060 0ustar pfrauenfusers#include "Bdef.h" void BI_cMPI_amx(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_cvvamx(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_cvvamx(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cMPI_amx2.c100644 1750 144 246 6313301027 17152 0ustar pfrauenfusers#include "Bdef.h" void BI_cMPI_amx2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_cvvamx2(int, char *, char *); BI_cvvamx2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cMPI_sum.c100644 1750 144 243 6313301026 17103 0ustar pfrauenfusers#include "Bdef.h" void BI_cMPI_sum(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_cvvsum(int, char *, char *); BI_cvvsum(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cvvamn.c100644 1750 144 1354 6313301026 16745 0ustar pfrauenfusers#include "Bdef.h" void BI_cvvamn(int N, char *vec1, char *vec2) { SCOMPLEX *v1=(SCOMPLEX*)vec1, *v2=(SCOMPLEX*)vec2; float diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(SCOMPLEX); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Cabs(v1[k]) - Cabs(v2[k]); if (diff > 0) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cvvamn2.c100644 1750 144 1331 6325251637 17041 0ustar pfrauenfusers#include "Bdef.h" void BI_cvvamn2(int N, char *vec1, char *vec2) { int r, i; float *v1=(float*)vec1, *v2=(float*)vec2; float diff; N *= 2; for (r=0, i=1; r != N; r += 2, i += 2) { diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); if (diff > 0) { v1[r] = v2[r]; v1[i] = v2[i]; } else if (diff == 0) { if (v1[r] != v2[r]) { if (v1[r] < v2[r]) { v1[r] = v2[r]; v1[i] = v2[i]; } } else { if (v1[i] < v2[i]) { v1[r] = v2[r]; v1[i] = v2[i]; } } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cvvamx.c100644 1750 144 1354 6313301025 16756 0ustar pfrauenfusers#include "Bdef.h" void BI_cvvamx(int N, char *vec1, char *vec2) { SCOMPLEX *v1=(SCOMPLEX*)vec1, *v2=(SCOMPLEX*)vec2; float diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(SCOMPLEX); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Cabs(v1[k]) - Cabs(v2[k]); if (diff < 0) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cvvamx2.c100644 1750 144 1331 6325251637 17053 0ustar pfrauenfusers#include "Bdef.h" void BI_cvvamx2(int N, char *vec1, char *vec2) { int r, i; float *v1=(float*)vec1, *v2=(float*)vec2; float diff; N *= 2; for (r=0, i=1; r != N; r += 2, i += 2) { diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); if (diff < 0) { v1[r] = v2[r]; v1[i] = v2[i]; } else if (diff == 0) { if (v1[r] != v2[r]) { if (v1[r] < v2[r]) { v1[r] = v2[r]; v1[i] = v2[i]; } } else { if (v1[i] < v2[i]) { v1[r] = v2[r]; v1[i] = v2[i]; } } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_cvvsum.c100644 1750 144 256 6313301025 16755 0ustar pfrauenfusers#include "Bdef.h" void BI_cvvsum(int N, char *vec1, char *vec2) { float *v1=(float*)vec1, *v2=(float*)vec2; int k; N *=2; for (k=0; k < N; k++) v1[k] += v2[k]; } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dMPI_amn.c100644 1750 144 320 6313301027 17050 0ustar pfrauenfusers#include "Bdef.h" void BI_dMPI_amn(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_dvvamn(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_dvvamn(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dMPI_amn2.c100644 1750 144 246 6313301027 17141 0ustar pfrauenfusers#include "Bdef.h" void BI_dMPI_amn2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_dvvamn2(int, char *, char *); BI_dvvamn2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dMPI_amx.c100644 1750 144 320 6313301026 17061 0ustar pfrauenfusers#include "Bdef.h" void BI_dMPI_amx(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_dvvamx(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_dvvamx(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dMPI_amx2.c100644 1750 144 246 6313301027 17153 0ustar pfrauenfusers#include "Bdef.h" void BI_dMPI_amx2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_dvvamx2(int, char *, char *); BI_dvvamx2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dmvcopy.c100644 1750 144 771 6313301025 17115 0ustar pfrauenfusers#include "Bdef.h" void BI_dmvcopy(int m, int n, double *A, int lda, double *buff) /* * Performs a matrix to vector copy (pack) for the data type double */ { int i, j; if ( (m == lda) || (n == 1) ) { m = n * m; for (i=0; i < m; i++) buff[i] = A[i]; } else if (m == 1) { for (j=0; j < n; j++) buff[j] = A[j*lda]; } else { for (j=0; j < n; j++) { for (i=0; i < m; i++) buff[i] = A[i]; A += lda; buff += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dvmcopy.c100644 1750 144 775 6313301025 17121 0ustar pfrauenfusers#include "Bdef.h" void BI_dvmcopy(int m, int n, double *A, int lda, double *buff) /* * performs an vector to matrix copy (unpack) for the data type double */ { int i, j; if ( (m == lda) || (n == 1) ) { m = n * m; for (i=0; i < m; i++) A[i] = buff[i]; } else if (m == 1) { for (j=0; j < n; j++) A[j*lda] = buff[j]; } else { for (j=0; j< n; j++) { for (i=0; i < m; i++) A[i] = buff[i]; A += lda; buff += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dvvamn.c100644 1750 144 1242 6313301026 16742 0ustar pfrauenfusers#include "Bdef.h" void BI_dvvamn(int N, char *vec1, char *vec2) { double *v1=(double*)vec1, *v2=(double*)vec2; double diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(double); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff > 0) { v1[k] = v2[k]; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k] = v2[k]; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dvvamn2.c100644 1750 144 473 6325251637 17030 0ustar pfrauenfusers#include "Bdef.h" void BI_dvvamn2(int N, char *vec1, char *vec2) { int k; double *v1=(double*)vec1, *v2=(double*)vec2; double diff; for (k=0; k != N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff > 0) v1[k] = v2[k]; else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dvvamx.c100644 1750 144 1242 6313301025 16753 0ustar pfrauenfusers#include "Bdef.h" void BI_dvvamx(int N, char *vec1, char *vec2) { double *v1=(double*)vec1, *v2=(double*)vec2; double diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(double); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff < 0) { v1[k] = v2[k]; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k] = v2[k]; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dvvamx2.c100644 1750 144 473 6325251637 17042 0ustar pfrauenfusers#include "Bdef.h" void BI_dvvamx2(int N, char *vec1, char *vec2) { int k; double *v1=(double*)vec1, *v2=(double*)vec2; double diff; for (k=0; k != N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff < 0) v1[k] = v2[k]; else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_dvvsum.c100644 1750 144 247 6313301025 16756 0ustar pfrauenfusers#include "Bdef.h" void BI_dvvsum(int N, char *vec1, char *vec2) { double *v1=(double*)vec1, *v2=(double*)vec2; int k; for (k=0; k < N; k++) v1[k] += v2[k]; } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_iMPI_amn.c100644 1750 144 320 6313301027 17055 0ustar pfrauenfusers#include "Bdef.h" void BI_iMPI_amn(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_ivvamn(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_ivvamn(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_iMPI_amn2.c100644 1750 144 246 6313301027 17146 0ustar pfrauenfusers#include "Bdef.h" void BI_iMPI_amn2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_ivvamn2(int, char *, char *); BI_ivvamn2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_iMPI_amx.c100644 1750 144 320 6313301026 17066 0ustar pfrauenfusers#include "Bdef.h" void BI_iMPI_amx(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_ivvamx(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_ivvamx(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_iMPI_amx2.c100644 1750 144 246 6313301026 17157 0ustar pfrauenfusers#include "Bdef.h" void BI_iMPI_amx2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_ivvamx2(int, char *, char *); BI_ivvamx2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_imvcopy.c100644 1750 144 760 6313301024 17117 0ustar pfrauenfusers#include "Bdef.h" void BI_imvcopy(int m, int n, int *A, int lda, int *buff) /* * Performs a matrix to vector copy (pack) for the data type int */ { int i, j; if ( (m == lda) || (n == 1) ) { m = n * m; for (i=0; i < m; i++) buff[i] = A[i]; } else if (m == 1) { for (j=0; j < n; j++) buff[j] = A[j*lda]; } else { for (j=0; j < n; j++) { for (i=0; i < m; i++) buff[i] = A[i]; A += lda; buff += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ivmcopy.c100644 1750 144 764 6313301024 17123 0ustar pfrauenfusers#include "Bdef.h" void BI_ivmcopy(int m, int n, int *A, int lda, int *buff) /* * performs an vector to matrix copy (unpack) for the data type int */ { int i, j; if ( (m == lda) || (n == 1) ) { m = n * m; for (i=0; i < m; i++) A[i] = buff[i]; } else if (m == 1) { for (j=0; j < n; j++) A[j*lda] = buff[j]; } else { for (j=0; j< n; j++) { for (i=0; i < m; i++) A[i] = buff[i]; A += lda; buff += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ivvamn.c100644 1750 144 1223 6313301026 16746 0ustar pfrauenfusers#include "Bdef.h" void BI_ivvamn(int N, char *vec1, char *vec2) { int *v1=(int*)vec1, *v2=(int*)vec2; int diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(int); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff > 0) { v1[k] = v2[k]; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k] = v2[k]; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ivvamn2.c100644 1750 144 460 6325251637 17031 0ustar pfrauenfusers#include "Bdef.h" void BI_ivvamn2(int N, char *vec1, char *vec2) { int k; int *v1=(int*)vec1, *v2=(int*)vec2; int diff; for (k=0; k != N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff > 0) v1[k] = v2[k]; else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ivvamx.c100644 1750 144 1223 6313301025 16757 0ustar pfrauenfusers#include "Bdef.h" void BI_ivvamx(int N, char *vec1, char *vec2) { int *v1=(int*)vec1, *v2=(int*)vec2; int diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(int); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff < 0) { v1[k] = v2[k]; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k] = v2[k]; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ivvamx2.c100644 1750 144 457 6325251637 17051 0ustar pfrauenfusers#include "Bdef.h" void BI_ivvamx2(int N, char *vec1, char *vec2) { int k; int *v1=(int*)vec1, *v2=(int*)vec2; int diff; for (k=0; k != N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff < 0) v1[k] = v2[k]; else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_ivvsum.c100644 1750 144 236 6313301025 16761 0ustar pfrauenfusers#include "Bdef.h" void BI_ivvsum(int N, char *vec1, char *vec2) { int *v1=(int*)vec1, *v2=(int*)vec2; int k; for (k=0; k < N; k++) v1[k] += v2[k]; } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_sMPI_amn.c100644 1750 144 320 6313301027 17067 0ustar pfrauenfusers#include "Bdef.h" void BI_sMPI_amn(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_svvamn(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_svvamn(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_sMPI_amn2.c100644 1750 144 246 6313301027 17160 0ustar pfrauenfusers#include "Bdef.h" void BI_sMPI_amn2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_svvamn2(int, char *, char *); BI_svvamn2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_sMPI_amx.c100644 1750 144 320 6313301026 17100 0ustar pfrauenfusers#include "Bdef.h" void BI_sMPI_amx(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_svvamx(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_svvamx(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_sMPI_amx2.c100644 1750 144 246 6313301027 17172 0ustar pfrauenfusers#include "Bdef.h" void BI_sMPI_amx2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_svvamx2(int, char *, char *); BI_svvamx2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_smvcopy.c100644 1750 144 766 6313301024 17137 0ustar pfrauenfusers#include "Bdef.h" void BI_smvcopy(int m, int n, float *A, int lda, float *buff) /* * Performs a matrix to vector copy (pack) for the data type float */ { int i, j; if ( (m == lda) || (n == 1) ) { m = n * m; for (i=0; i < m; i++) buff[i] = A[i]; } else if (m == 1) { for (j=0; j < n; j++) buff[j] = A[j*lda]; } else { for (j=0; j < n; j++) { for (i=0; i < m; i++) buff[i] = A[i]; A += lda; buff += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_svmcopy.c100644 1750 144 772 6313301025 17135 0ustar pfrauenfusers#include "Bdef.h" void BI_svmcopy(int m, int n, float *A, int lda, float *buff) /* * performs an vector to matrix copy (unpack) for the data type float */ { int i, j; if ( (m == lda) || (n == 1) ) { m = n * m; for (i=0; i < m; i++) A[i] = buff[i]; } else if (m == 1) { for (j=0; j < n; j++) A[j*lda] = buff[j]; } else { for (j=0; j< n; j++) { for (i=0; i < m; i++) A[i] = buff[i]; A += lda; buff += m; } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_svvamn.c100644 1750 144 1235 6313301026 16763 0ustar pfrauenfusers#include "Bdef.h" void BI_svvamn(int N, char *vec1, char *vec2) { float *v1=(float*)vec1, *v2=(float*)vec2; float diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(float); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff > 0) { v1[k] = v2[k]; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k] = v2[k]; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_svvamn2.c100644 1750 144 467 6325251637 17052 0ustar pfrauenfusers#include "Bdef.h" void BI_svvamn2(int N, char *vec1, char *vec2) { int k; float *v1=(float*)vec1, *v2=(float*)vec2; float diff; for (k=0; k != N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff > 0) v1[k] = v2[k]; else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_svvamx.c100644 1750 144 1235 6313301025 16774 0ustar pfrauenfusers#include "Bdef.h" void BI_svvamx(int N, char *vec1, char *vec2) { float *v1=(float*)vec1, *v2=(float*)vec2; float diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(float); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff < 0) { v1[k] = v2[k]; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k] = v2[k]; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_svvamx2.c100644 1750 144 467 6325251637 17064 0ustar pfrauenfusers#include "Bdef.h" void BI_svvamx2(int N, char *vec1, char *vec2) { int k; float *v1=(float*)vec1, *v2=(float*)vec2; float diff; for (k=0; k != N; k++) { diff = Rabs(v1[k]) - Rabs(v2[k]); if (diff < 0) v1[k] = v2[k]; else if (diff == 0) if (v1[k] < v2[k]) v1[k] = v2[k]; } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_svvsum.c100644 1750 144 244 6313301025 16772 0ustar pfrauenfusers#include "Bdef.h" void BI_svvsum(int N, char *vec1, char *vec2) { float *v1=(float*)vec1, *v2=(float*)vec2; int k; for (k=0; k < N; k++) v1[k] += v2[k]; } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zMPI_amn.c100644 1750 144 320 6313301027 17076 0ustar pfrauenfusers#include "Bdef.h" void BI_zMPI_amn(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_zvvamn(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_zvvamn(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zMPI_amn2.c100644 1750 144 246 6313301027 17167 0ustar pfrauenfusers#include "Bdef.h" void BI_zMPI_amn2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_zvvamn2(int, char *, char *); BI_zvvamn2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zMPI_amx.c100644 1750 144 320 6313301026 17107 0ustar pfrauenfusers#include "Bdef.h" void BI_zMPI_amx(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_zvvamx(int, char *, char *); extern BLACBUFF BI_AuxBuff; BI_zvvamx(BI_AuxBuff.Len, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zMPI_amx2.c100644 1750 144 246 6313301027 17201 0ustar pfrauenfusers#include "Bdef.h" void BI_zMPI_amx2(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_zvvamx2(int, char *, char *); BI_zvvamx2(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zMPI_sum.c100644 1750 144 243 6313301026 17132 0ustar pfrauenfusers#include "Bdef.h" void BI_zMPI_sum(void *in, void *inout, int *N, BI_MPI_Datatype *dtype) { void BI_zvvsum(int, char *, char *); BI_zvvsum(*N, inout, in); } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zvvamn.c100644 1750 144 1355 6313301026 16775 0ustar pfrauenfusers#include "Bdef.h" void BI_zvvamn(int N, char *vec1, char *vec2) { DCOMPLEX *v1=(DCOMPLEX*)vec1, *v2=(DCOMPLEX*)vec2; double diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(DCOMPLEX); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Cabs(v1[k]) - Cabs(v2[k]); if (diff > 0) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zvvamn2.c100644 1750 144 1335 6325251637 17074 0ustar pfrauenfusers#include "Bdef.h" void BI_zvvamn2(int N, char *vec1, char *vec2) { int r, i; double *v1=(double*)vec1, *v2=(double*)vec2; double diff; N *= 2; for (r=0, i=1; r != N; r += 2, i += 2) { diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); if (diff > 0) { v1[r] = v2[r]; v1[i] = v2[i]; } else if (diff == 0) { if (v1[r] != v2[r]) { if (v1[r] < v2[r]) { v1[r] = v2[r]; v1[i] = v2[i]; } } else { if (v1[i] < v2[i]) { v1[r] = v2[r]; v1[i] = v2[i]; } } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zvvamx.c100644 1750 144 1355 6313301025 17006 0ustar pfrauenfusers#include "Bdef.h" void BI_zvvamx(int N, char *vec1, char *vec2) { DCOMPLEX *v1=(DCOMPLEX*)vec1, *v2=(DCOMPLEX*)vec2; double diff; BI_DistType *dist1, *dist2; int i, k; k = N * sizeof(DCOMPLEX); i = k % sizeof(BI_DistType); if (i) k += sizeof(BI_DistType) - i; dist1 = (BI_DistType *) &vec1[k]; dist2 = (BI_DistType *) &vec2[k]; for (k=0; k < N; k++) { diff = Cabs(v1[k]) - Cabs(v2[k]); if (diff < 0) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } else if (diff == 0) { if (dist1[k] > dist2[k]) { v1[k].r = v2[k].r; v1[k].i = v2[k].i; dist1[k] = dist2[k]; } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zvvamx2.c100644 1750 144 1335 6325251637 17106 0ustar pfrauenfusers#include "Bdef.h" void BI_zvvamx2(int N, char *vec1, char *vec2) { int r, i; double *v1=(double*)vec1, *v2=(double*)vec2; double diff; N *= 2; for (r=0, i=1; r != N; r += 2, i += 2) { diff = (Rabs(v1[r]) + Rabs(v1[i])) - (Rabs(v2[r]) + Rabs(v2[i])); if (diff < 0) { v1[r] = v2[r]; v1[i] = v2[i]; } else if (diff == 0) { if (v1[r] != v2[r]) { if (v1[r] < v2[r]) { v1[r] = v2[r]; v1[i] = v2[i]; } } else { if (v1[i] < v2[i]) { v1[r] = v2[r]; v1[i] = v2[i]; } } } } } blacs-mpi-1.1/SRC/MPI/INTERNAL/BI_zvvsum.c100644 1750 144 261 6313301025 17000 0ustar pfrauenfusers#include "Bdef.h" void BI_zvvsum(int N, char *vec1, char *vec2) { double *v1=(double*)vec1, *v2=(double*)vec2; int k; N *=2; for (k=0; k < N; k++) v1[k] += v2[k]; } blacs-mpi-1.1/SRC/MPI/INTERNAL/bi_f77_get_constants.f100644 1750 144 2007 6313301027 21111 0ustar pfrauenfusers* SUBROUTINE BI_F77_GET_CONSTANTS(F77COMMWORLD, SETUP, CONST) INCLUDE 'mpif.h' INTEGER F77COMMWORLD, SETUP INTEGER CONST(*) * F77COMMWORLD = MPI_COMM_WORLD IF (SETUP .NE. 0) THEN CONST( 1) = MPI_SUCCESS CONST( 2) = MPI_ERR_UNKNOWN CONST( 3) = MPI_ERR_OTHER CONST( 4) = MPI_ERR_INTERN CONST( 5) = MPI_ANY_SOURCE CONST( 6) = MPI_UNDEFINED CONST( 7) = MPI_STATUS_SIZE CONST( 8) = MPI_SOURCE CONST( 9) = MPI_TAG CONST(10) = MPI_INTEGER CONST(11) = MPI_REAL CONST(12) = MPI_DOUBLE_PRECISION CONST(13) = MPI_COMPLEX CONST(14) = MPI_DOUBLE_COMPLEX CONST(15) = MPI_PACKED CONST(16) = MPI_BYTE CONST(17) = MPI_COMM_WORLD CONST(18) = MPI_COMM_NULL CONST(19) = MPI_TAG_UB CONST(20) = MPI_MAX CONST(21) = MPI_MIN CONST(22) = MPI_SUM CONST(23) = MPI_REQUEST_NULL END IF * RETURN END blacs-mpi-1.1/SRC/MPI/INTERNAL/bi_f77_mpi_attr_get.f100644 1750 144 503 6313301027 20673 0ustar pfrauenfusers SUBROUTINE BI_F77_MPI_ATTR_GET(COMM, KEYVAL, ATTR, FLAG, IERR) INCLUDE 'mpif.h' INTEGER COMM, KEYVAL, ATTR, IERR, FLAG LOGICAL FLAG2 * CALL MPI_ATTR_GET(COMM, KEYVAL, ATTR, FLAG2, IERR) IF (FLAG2) THEN FLAG = 1 ELSE FLAG = 0 END IF * RETURN END blacs-mpi-1.1/SRC/MPI/INTERNAL/bi_f77_mpi_initialized.f100644 1750 144 417 6313301027 21373 0ustar pfrauenfusers* SUBROUTINE BI_F77_MPI_INITIALIZED(FLAG, IERR) INCLUDE 'mpif.h' INTEGER FLAG, IERR LOGICAL FLAG2 * CALL MPI_INITIALIZED(FLAG2, IERR) IF (FLAG2) THEN FLAG = 1 ELSE FLAG = 0 END IF * RETURN END blacs-mpi-1.1/SRC/MPI/INTERNAL/bi_f77_mpi_op_create.f100644 1750 144 537 6313301030 21024 0ustar pfrauenfusers* SUBROUTINE BI_F77_MPI_OP_CREATE(FUNC, COMMUTE, OP, IERR) INCLUDE 'mpif.h' EXTERNAL FUNC INTEGER COMMUTE, OP, IERR LOGICAL COMMUTE2 * IF (COMMUTE .EQ. 0) THEN COMMUTE2 = .FALSE. ELSE COMMUTE2 = .TRUE. END IF CALL MPI_OP_CREATE(FUNC, COMMUTE2, OP, IERR) * RETURN END blacs-mpi-1.1/SRC/MPI/INTERNAL/bi_f77_mpi_test.f100644 1750 144 522 6313301030 20034 0ustar pfrauenfusers* SUBROUTINE BI_F77_MPI_TEST(REQUEST, FLAG, STATUS, IERR) INCLUDE 'mpif.h' INTEGER FLAG, REQUEST, IERR INTEGER STATUS(MPI_STATUS_SIZE) LOGICAL FLAG2 * CALL MPI_TEST(REQUEST, FLAG2, STATUS, IERR) IF (FLAG2) THEN FLAG = 1 ELSE FLAG = 0 END IF * RETURN END blacs-mpi-1.1/SRC/MPI/INTERNAL/bi_f77_mpi_testall.f100644 1750 144 563 6313301030 20532 0ustar pfrauenfusers* SUBROUTINE BI_F77_MPI_TESTALL(COUNT, REQUESTS, FLAG, STATS, IERR) INCLUDE 'mpif.h' INTEGER COUNT, FLAG, IERR INTEGER REQUESTS(*), STATS(MPI_STATUS_SIZE, *) LOGICAL FLAG2 * CALL MPI_TESTALL(COUNT, REQUESTS, FLAG2, STATS, IERR) IF (FLAG2) THEN FLAG = 1 ELSE FLAG = 0 END IF * RETURN END