Subroutine to run a test with MUSST
Type | Attributes | Name | Initial | |||
---|---|---|---|---|---|---|
character(len=128) | :: | prg_arg | ||||
character(len=128) | :: | job_file | ||||
character(len=8) | :: | date | ||||
character(len=10) | :: | time | ||||
character(len=15) | :: | repos | ||||
integer(kind=I4) | :: | archive |
program main
use omp_lib
use test_musst
use data_arch, only : I4, NB_THREADS_MAX, OUT_U=>OPU, get_unit
use num_param, only : VERBOSE, OUTPUT_FILE, OPU
use solver, only : SOLVER_BS, SOLVER_TS, SOLV_MESS
implicit none
character(len=128) :: prg_arg
character(len=128) :: job_file
character(len= 8) :: date
character(len=10) :: time
character(len=15) :: repos
integer(kind=I4) :: archive
! a result directory is created under "/out" with the date as name
! ----------------------------------------------------------------
call date_and_time(date, time)
repos = date//'_'//time(1:6)
call execute_command_line("mkdir out/"//repos, wait=.true.)
! the job file is the program argument
! ------------------------------------
prg_arg = repeat(' ', len(prg_arg ))
job_file = repeat(' ', len(job_file))
call get_command_argument(1, prg_arg) ! argument one: job file
if (len_trim(prg_arg) == 0) then ! if there is no job file, stop
stop 'no job file, stop'
else
job_file = trim(adjustl(prg_arg))
endif
! the job file is copied in the result directory
! ----------------------------------------------
call execute_command_line("cp "//trim(job_file)//" out/"//repos, wait=.true.)
! the job file is processed
! -------------------------
call read_config
call run_test
if (OPU/=OUT_U) close(OPU)
stop
contains
subroutine read_config()
implicit none
integer(kind=I4) :: jf, err_read
character(len=032) :: word
character(len=128) :: job_copy
job_copy = "out/"//repos//job_file(4:len_trim(job_file))
VERBOSE = 20
SOLV_MESS = 0
OPU = 0
OUTPUT_FILE = "no_file"
SOLVER_BS = 3
SOLVER_TS = 2
NB_THREADS_MAX = -1
archive = 0
test_num = 0
call get_unit(jf) ; open(jf, file = trim(job_file), status = 'old')
do
word = repeat(' ', len(word))
read(jf, *, iostat = err_read) word
if ( index(word, 'END_FILE' ) /= 0 ) exit
if ( index(word, 'VERBOSE' ) /= 0 ) then
read(jf, *) VERBOSE
endif
if ( index(word, 'SOLV_MESS' ) /= 0 ) then
read(jf, *) SOLV_MESS
endif
if ( index(word, 'OUTPUT_UNIT' ) /= 0 ) then
read(jf, *) OPU
if (OPU==0) then
OPU = OUT_U
else
read(jf, *) OUTPUT_FILE
call get_unit(OPU)
open(unit = OPU, &
file = "out/"//repos//"/"//trim(adjustl(OUTPUT_FILE)), &
status = 'unknown')
endif
endif
if ( index(word, 'SOLVER_BS' ) /= 0 ) then
read(jf, *) SOLVER_BS
if (SOLVER_BS==1) stop "some remaining problems with SuLU, choose '3' instead"
if (SOLVER_BS==2) stop "MUMPS is multithreaded, it is designed for TS, choose '3' instead"
endif
if ( index(word, 'SOLVER_TS' ) /= 0 ) then
read(jf, *) SOLVER_TS
endif
if ( index(word, 'PROBLEM_TYPE' ) /= 0 ) then
read(jf, *) test_num
endif
if ( index(word, 'PARAM_MUSST' ) /= 0 ) then
call read_data(jf, repos)
endif
if ( index(word, 'NB_THREADS_MAX') /= 0 ) then
read(jf, *) NB_THREADS_MAX
if (NB_THREADS_MAX<0) then
!$ NB_THREADS_MAX = omp_get_num_procs()
endif
endif
if ( index(word, 'ARCHIVE') /= 0 ) then
read(jf, *) archive
if (ARCHIVE==1) then
call execute_command_line("sh bin/save/save.sh", wait=.true.)
call execute_command_line("mv *.7z out/"//repos//"/")
endif
endif
enddo
close(jf)
return
endsubroutine read_config
endprogram main