xfygogo/phasicFlow
1
0
Fork 0
mirror of https://github.com/PhasicFlow/phasicFlow.git synced 2025-07-28 03:27:05 +00:00
Code Issues Packages Projects Releases Wiki Activity
Files
d7479cf1bd622bae858523bbb0b8356903edf63a
phasicFlow/thirdParty/Zoltan/src/fdriver/fdr_input.f90
Hamidreza d7479cf1bd Zoltan is added as thirdParty package
2025-05-15 21:58:43 +03:30

578 lines
21 KiB
Fortran
Raw Blame History

!!
!! @HEADER
!!
!!!!**********************************************************************
!!
!! Zoltan Toolkit for Load-balancing, Partitioning, Ordering and Coloring
!! Copyright 2012 Sandia Corporation
!!
!! Under the terms of Contract DE-AC04-94AL85000 with Sandia Corporation,
!! the U.S. Government retains certain rights in this software.
!!
!! Redistribution and use in source and binary forms, with or without
!! modification, are permitted provided that the following conditions are
!! met:
!!
!! 1. Redistributions of source code must retain the above copyright
!! notice, this list of conditions and the following disclaimer.
!!
!! 2. Redistributions in binary form must reproduce the above copyright
!! notice, this list of conditions and the following disclaimer in the
!! documentation and/or other materials provided with the distribution.
!!
!! 3. Neither the name of the Corporation nor the names of the
!! contributors may be used to endorse or promote products derived from
!! this software without specific prior written permission.
!!
!! THIS SOFTWARE IS PROVIDED BY SANDIA CORPORATION "AS IS" AND ANY
!! EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
!! IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
!! PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL SANDIA CORPORATION OR THE
!! CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
!! EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
!! PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
!! PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
!! LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
!! NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
!! SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
!!
!! Questions? Contact Karen Devine kddevin@sandia.gov
!! Erik Boman egboman@sandia.gov
!!
!!!!**********************************************************************
!!
!! @HEADER
!!
module dr_input
use zoltan
use dr_const
use mpi_h
implicit none
private
public :: read_cmd_file, check_inp, brdcst_cmd_info, gen_par_filename, &
PARIO_INFO, NEMESIS_FILE, CHACO_FILE, MM_FILE
!--------------------------------------------------------------------------
! Purpose: Determine file types for command files and read in the parallel
! ExodusII command file.
! Taken from nemesis utilites nem_spread and nem_join.
!--------------------------------------------------------------------------
! Author(s): Matthew M. St.John (9226)
! Translated to Fortran by William F. Mitchell
!--------------------------------------------------------------------------
!--------------------------------------------------------------------------
! Revision History:
! 14 April 1999: Date of creation.
! 02 September 1999: Fortran translation
!--------------------------------------------------------------------------
integer(Zoltan_INT), parameter :: NEMESIS_FILE = 0, &
CHACO_FILE = 1, &
MM_FILE = 2
integer(Zoltan_INT), parameter :: MAX_INPUT_STR_LN = 4096 ! maximum string length
! for read_string()
! Structure used to store the information necessary for parallel I/O.
type PARIO_INFO
integer(Zoltan_INT) :: init_dist_pins
integer(Zoltan_INT) :: dsk_list_cnt
integer(Zoltan_INT), pointer :: dsk_list(:)
integer(Zoltan_INT) :: rdisk
integer(Zoltan_INT) :: num_dsk_ctrlrs ! The number of disk controllers.
integer(Zoltan_INT) :: pdsk_add_fact ! The offset from zero used by the
! the target machine.
integer(Zoltan_INT) :: zeros
! 1 - if the target machine uses leading zeros when
! designating the disk number (eg - the paragon
! uses /pfs/io_01)
! 0 - if it does not (eg - the tflop uses
! /pfs/tmp_1)
integer(Zoltan_INT) :: file_type ! input file type
! The root location of the parallel disks
character(len=FILENAME_MAX+1) :: pdsk_root
! The subdirectory to write files to
character(len=FILENAME_MAX+1) :: pdsk_subdir
! The base name of the input file.
character(len=FILENAME_MAX+1) :: pexo_fname
end type PARIO_INFO
contains
function lowercase(string)
character(len=*), intent(in) :: string
character(len=len(string)) :: lowercase
! returns the string converted to lower case
integer, parameter :: int_A = iachar("A"), &
int_Z = iachar("Z"), &
a_A_diff = iachar("a") - iachar("A")
integer :: i, int_char
do i=1,len(string)
int_char = iachar(string(i:i))
if (int_char >= int_A .and. int_char <= int_Z) then
lowercase(i:i) = achar(int_char + a_A_diff)
else
lowercase(i:i) = string(i:i)
endif
end do
end function lowercase
!***************************************************************************
!***************************************************************************
logical function read_cmd_file(filename, prob, pio_info)
character(len=*) :: filename
type(PROB_INFO) :: prob
type(PARIO_INFO) :: pio_info
!
! * This function reads the ASCII parallel-exodus command file.
! *
! * Input
! * -----
! * filename - The name of the command file.
! * pio_info - parallel I/O information.
!
! I'm really coping out here. This was written for debugging and initial
! testing of the Fortran interface, and doesn't need the full capability
! of reading the command files. So currently it assumes the command file
! looks like the Chaco test files that existed at the time it was written.
! WFM 9/1/99
! local declarations
integer, parameter :: file_cmd = 11
character(len=MAX_INPUT_STR_LN + 1) :: inp_line, command, temp_string
integer :: iostat
logical :: more_params
!**************************** BEGIN EXECUTION *****************************
! Open the file
open(unit=file_cmd,file=filename,action='read',iostat=iostat)
if (iostat /= 0) then
read_cmd_file = .false.
return
endif
! assume no more than 15 parameters
allocate(prob%params(0:15))
prob%num_params = 1
prob%params(0)%str(0) = "DEBUG_MEMORY"
prob%params(0)%str(1) = "1"
! Begin parsing the input file
do ! while not end of data
read(unit=file_cmd,fmt="(a)",iostat=iostat) inp_line
if (iostat /= 0) exit ! end of data
! skip any line that is a comment
if (inp_line == '') cycle
if (inp_line(1:1) == '#') cycle
! find what is before the equal sign
command = inp_line(1:index(inp_line,"=")-1)
! if there is a tab, take what is before the tab
if (index(command," ") /= 0) then ! "tab"
command = command(1:index(command," ")-1) ! "tab"
endif
! ****** File Name ******
if (lowercase(trim(command)) == "file name") then
! assumes there is one blank between "=" and the file name
pio_info%pexo_fname = trim(inp_line(index(inp_line,"=")+2:))
endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! hacks to allow more of input file to be read (KDD, 10/2000) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
if (lowercase(trim(command)) == "decomposition method") then
! assumes there is one blank between "=" and the method
prob%method = trim(inp_line(index(inp_line,"=")+2:))
endif
if (lowercase(trim(command)) == "file type") then
! assumes there is one blank between "=" and the file type
if (lowercase(trim(inp_line(index(inp_line,"=")+2:))) == "chaco") then
pio_info%file_type = CHACO_FILE
else if (lowercase(trim(inp_line(index(inp_line,"=")+2:))) == "matrixmarket") then
pio_info%file_type = MM_FILE
else
print *, "Error: zfdrive can read only Chaco or MatrixMarket format files."
read_cmd_file = .false.
endif
endif
if ((lowercase(trim(command)) == "zoltan parameters").or. &
(lowercase(trim(command)) == "zoltan parameter")) then
! assumes there is one blank between "=" and the parameter name
temp_string = lowercase(trim(inp_line(index(inp_line,"=")+2:)))
! assumes no blanks between second "=" and the parameter name
! skip the input line if there are no parameters specified on it.
if (index(temp_string,"=").gt.0) then
more_params = .true.
do while (more_params)
if (index(temp_string, ",").gt.0) then
more_params = .true.
prob%params(prob%num_params)%str(1) = &
temp_string(index(temp_string,"=")+1:index(temp_string,",")-1)
else
more_params = .false.
prob%params(prob%num_params)%str(1) = &
temp_string(index(temp_string,"=")+1:)
endif
prob%params(prob%num_params)%str(0) = &
temp_string(1:index(temp_string,"=")-1)
prob%num_params = prob%num_params+1
if (more_params) then
temp_string = temp_string(index(temp_string,",")+1:)
do while (temp_string(1:1).eq." ") !skip white space
temp_string = temp_string(2:)
enddo
endif
enddo
endif
endif
if (lowercase(trim(command)) == "test multi callbacks") then
! assumes there is one blank between "=" and the input value
Test_Multi_Callbacks = iachar(trim(inp_line(index(inp_line,"= ")+2:))) - iachar('0')
endif
if (lowercase(trim(command)) == "test graph callbacks") then
Test_Graph_Callbacks = iachar(trim(inp_line(index(inp_line,"= ")+2:))) - iachar('0')
endif
if (lowercase(trim(command)) == "test hypergraph callbacks") then
Test_Hypergraph_Callbacks = iachar(trim(inp_line(index(inp_line,"= ")+2:))) - iachar('0')
endif
if (lowercase(trim(command)) == "test local partitions") then
! assumes there is one blank between "=" and the input value
Test_Local_Partitions = iachar(trim(inp_line(index(inp_line,"=")+2:))) - iachar('0')
endif
if (lowercase(trim(command)) == "test generate files") then
! assumes there is one blank between "=" and the input value
Test_Gen_Files = iachar(trim(inp_line(index(inp_line,"= ")+2:))) - iachar('0')
endif
if (lowercase(trim(command)) == "test drops") then
! assumes there is one blank between "=" and the input value
Test_Drops = iachar(trim(inp_line(index(inp_line,"= ")+2:))) - iachar('0')
endif
if (lowercase(trim(command)) == "zdrive action") then
! assumes there is one blank between "=" and the input value
Driver_Action = iachar(trim(inp_line(index(inp_line,"= ")+2:))) - iachar('0')
endif
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! end of hacks to allow more of input file to be read (KDD, 10/2000) !
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Added JDT 3/2007 to save the zoltanparams file name
! Note: we assume a good format here:
! zoltanparams file = thefile.name
if (lowercase(trim(command)) == "zoltanparams file") then
prob%ztnPrm_file = lowercase(trim(inp_line(index(inp_line,"=")+2:)))
endif
!
! The other commands are not processed. In the initial tests they either
! always have the same value (in which case they are set after this loop)
! or they do not appear.
end do ! while not end of data
! Assume parallel disk info is number=0
pio_info%num_dsk_ctrlrs = 0
! Close the command file
close(file_cmd)
read_cmd_file = .true.
end function read_cmd_file
!***************************************************************************
!***************************************************************************
!***************************************************************************
logical function check_inp(prob, pio_info)
type(PROB_INFO) :: prob
type(PARIO_INFO) :: pio_info
!**************************** BEGIN EXECUTION *****************************
! check for the parallel Nemesis file for proc 0
if (len_trim(pio_info%pexo_fname) <= 0) then
print *, "fatal: must specify file base name"
check_inp = .false.
return
endif
! Not supporting NEMESIS
! default file type is nemesis
! if (pio_info->file_type < 0) pio_info->file_type = NEMESIS_FILE;
!
!#ifndef ZOLTAN_NEMESIS
!
! * if compiling without the ZOLTAN_NEMESIS flag (i.e., not linking with
! * Nemesis library), can't use NEMESIS_FILE file type.
!
!
! if (pio_info->file_type == NEMESIS_FILE) {
! Gen_Error(0, "fatal: must link with Nemesis libraries for Nemesis "
! "file types");
! return 0;
! }
!#endif !ZOLTAN_NEMESIS
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! Check the parallel IO specifications
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! check that there is a list of disks, or a number of raids
if ((pio_info%dsk_list_cnt <= 0) .and. (pio_info%num_dsk_ctrlrs < 0)) then
pio_info%num_dsk_ctrlrs = 0 ! default to single directory
endif
! default is not to have preceeding 0's in the disk names
if (pio_info%zeros < 0) pio_info%zeros = 0
! most systems that we deal with start their files systems with 1 not 0
if (pio_info%pdsk_add_fact < 0) pio_info%pdsk_add_fact = 1
!
! * if there are parallel disks, then the root and subdir locations must
! * be specified
!
if (pio_info%num_dsk_ctrlrs > 0 .or. pio_info%dsk_list_cnt > 0) then
if (len_trim(pio_info%pdsk_root) == 0) then
print *, "fatal: must specify parallel disk root name"
check_inp = .false.
return
endif
if (len_trim(pio_info%pdsk_subdir) == 0) then
print *, "fatal: must specify parallel disk subdirectory"
check_inp = .false.
return
endif
else
if (len_trim(pio_info%pdsk_root) == 0) then
pio_info%pdsk_root = "." ! default is execution directory
endif
endif
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
! Check the Zoltan specifications
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!
! * Make sure a load-balancing method was provided.
!
if (len_trim(prob%method) == 0) then
print *, "fatal: load balance method must be specified"
check_inp = .false.
return
endif
check_inp = .true.
end function check_inp
!***************************************************************************
!***************************************************************************
!***************************************************************************
subroutine brdcst_cmd_info(Proc, prob, pio_info)
integer(Zoltan_INT) :: Proc
type(PROB_INFO) :: prob
type(PARIO_INFO) :: pio_info
! local declarations
integer(Zoltan_INT) :: ctrl_id
integer(Zoltan_INT) :: size
integer(Zoltan_INT) :: ierr, i
!**************************** BEGIN EXECUTION *****************************
call MPI_Bcast(Test_Multi_Callbacks, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(Test_Local_Partitions, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(Test_Drops, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(Test_Gen_Files, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(Driver_Action, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%dsk_list_cnt, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%rdisk, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%num_dsk_ctrlrs, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%pdsk_add_fact, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%zeros, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%file_type, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%pdsk_root, len(pio_info%pdsk_root), MPI_CHARACTER, &
0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%pdsk_subdir, len(pio_info%pdsk_root), MPI_CHARACTER, &
0, MPI_COMM_WORLD, ierr)
call MPI_Bcast(pio_info%pexo_fname, len(pio_info%pdsk_root), MPI_CHARACTER, &
0, MPI_COMM_WORLD, ierr)
if(pio_info%dsk_list_cnt > 0) then
if(Proc /= 0) then
allocate(pio_info%dsk_list(0:pio_info%dsk_list_cnt-1))
endif
call MPI_Bcast(pio_info%dsk_list, pio_info%dsk_list_cnt, MPI_INTEGER, &
0, MPI_COMM_WORLD, ierr)
endif
! broadcast the param file name
call MPI_Bcast(prob%ztnPrm_file, len(prob%ztnPrm_file), MPI_CHARACTER, &
0, MPI_COMM_WORLD, ierr)
! and broadcast the problem specifications
call MPI_Bcast(prob%method, len(prob%method), MPI_CHARACTER, 0,MPI_COMM_WORLD,ierr)
call MPI_Bcast(prob%num_params, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr)
if (prob%num_params > 0) then
size = len(prob%params(0)%str(0))
if (Proc /= 0) then
allocate(prob%params(0:prob%num_params-1))
endif
do i=0,prob%num_params-1
call MPI_Bcast(prob%params(i)%str(0), size, MPI_CHARACTER, 0, &
MPI_COMM_WORLD, ierr)
call MPI_Bcast(prob%params(i)%str(1), size, MPI_CHARACTER, 0, &
MPI_COMM_WORLD, ierr)
end do
endif
! now calculate where the file for this processor is
if(pio_info%dsk_list_cnt <= 0) then
if (pio_info%num_dsk_ctrlrs > 0) then
ctrl_id = mod(Proc,pio_info%num_dsk_ctrlrs)
pio_info%rdisk = ctrl_id + pio_info%pdsk_add_fact
endif
else
ctrl_id = mod(Proc,pio_info%dsk_list_cnt)
pio_info%rdisk = pio_info%dsk_list(ctrl_id)
endif
end subroutine brdcst_cmd_info
!***************************************************************************
!***************************************************************************
!***************************************************************************
subroutine gen_par_filename(scalar_fname, par_fname, pio_info, proc_for, nprocs)
character(len=*) :: scalar_fname, par_fname
type(PARIO_INFO) :: pio_info
integer(Zoltan_INT) :: proc_for, nprocs
!----------------------------------------------------------------------------
! *
! * Author(s): Gary Hennigan (1421)
! Translated to Fortran by William F. Mitchell
! *----------------------------------------------------------------------------
! * Function which generates the name of a parallel file for a
! * particular processor. The function does this by appending
! * "N.p" to the end of the input parameter "scalar_fname", where:
! *
! * N - The number of processors utilized
! * p - The processor ID.
! *
! * In addition, the location of the parallel disk system is prepended
! * to each file name.
! *---------------------------------------------------------------------------
! * Example:
! *
! * scalar_fname = "Parallel-exoII-" (Input)
! * par_fname = "/raid/io_01/tmp/rf_crew/Parallel-exoII-8.0" (Output)
! *
! * where, for this example:
! *
! * N = 8 processors
! * p = 0 particular processor ID
! *---------------------------------------------------------------------------
! * Revision History:
! *
! * 05 November 1993: Date of Creation
! 02 September 1999: Fortran translation
! *---------------------------------------------------------------------------
!
! Local variables
integer(Zoltan_INT) :: iTemp1
integer(Zoltan_INT) :: iMaxDigit, iMyDigit
character(len=FILENAME_MAX) :: cTemp
character(len=6) :: frmat
character(len=32) :: nproc_str, myproc_str
character(len=2) :: rdisk_str
!************************ EXECUTION BEGINS ******************************
!
! * Find out the number of digits needed to specify the processor ID.
! * This allows numbers like 01-99, i.e., prepending zeros to the
! * name to preserve proper alphabetic sorting of the files.
!
iMaxDigit = 0
iTemp1 = nprocs
do while (iTemp1 >= 1)
iTemp1 = iTemp1/10
iMaxDigit = iMaxDigit + 1
end do
iMyDigit = 0
iTemp1 = proc_for
do while (iTemp1 >= 1)
iTemp1 = iTemp1/10
iMyDigit = iMyDigit + 1
end do
! create the character strings containing the numbers
frmat=""
write(frmat,"(a2,i1,a1)") "(I",iMaxDigit,")"
write(nproc_str,frmat) nprocs
frmat=""
write(frmat,"(a2,i1,a1,i1,a1)") "(I",iMaxDigit,".",iMaxDigit,")"
write(myproc_str,frmat) proc_for
! create the filename with the digit suffixes
cTemp = trim(scalar_fname)//"."//trim(nproc_str)//"."//trim(myproc_str)
!
! * Finally, generate the complete file specification for the parallel
! * file used by this processor.
!
if (pio_info%num_dsk_ctrlrs > 0) then
if(pio_info%zeros /= 0) then
write(rdisk_str,"(I2.2)") pio_info%rdisk
else
write(rdisk_str,"(I2)") pio_info%rdisk
rdisk_str = adjustl(rdisk_str)
endif
par_fname = trim(pio_info%pdsk_root)//trim(rdisk_str)//"/"//&
trim(pio_info%pdsk_subdir)//trim(cTemp)
else
par_fname = trim(pio_info%pdsk_root)//"/"//trim(cTemp)
endif
end subroutine gen_par_filename
end module dr_input
Reference in New Issue View Git Blame Copy Permalink