!*****************************************************************
!
! MODULE NAME:
! IO_utils
! FUNCTION:
! input/output routines (io_get...something, io_put...something)
! CONTAINS:
!-----------------------------------------------------------------
!
! NAME:
! io_getcmdline
! FUNCTION:
! read options from command line
! SYNTAX:
! call io_getcmdline(param)
! ON INPUT:
!
! ON OUTPUT:
! p_param: control parameters TYPE(control_struct)
! CALLS:
!
! COMMENTS:
!
!-----------------------------------------------------------------
!
! NAME:
! io_getinterinput
! FUNCTION:
! get user input interactively
! SYNTAX:
! call io_getinterinput(param)
! ON INPUT:
!
! ON OUTPUT:
! p_param: control parameters TYPE(control_struct)
! CALLS:
!
! COMMENTS:
!
!-----------------------------------------------------------------
!
! NAME:
! io_getbatchinput
! FUNCTION:
! read user input from file
! SYNTAX:
! call io_getbatchinput(param)
! ON INPUT:
!
! ON OUTPUT:
! p_param: control parameters TYPE(control_struct)
! CALLS:
!
! COMMENTS:
!
!-----------------------------------------------------------------
!
! NAME:
! io_putparameters
! FUNCTION:
! write out parameters in a nice way
! SYNTAX:
! call io_putparameters(param)
! ON INPUT:
! p_param: data structure containing parameters TYPE(control_struct)
! ON OUTPUT:
!
! CALLS:
!
! COMMENTS:
!
!-----------------------------------------------------------------
!
! NAME:
! io_putruntimeinfo
! FUNCTION:
! print some information on the current run time status
! SYNTAX:
! call io_putruntimeinfo(grid, info)
! ON INPUT:
! p_ghand: grid handle for no. of elements... TYPE(grid_handle)
! p_info: structure containing other info TYPE(rt_info)
! ON OUTPUT:
! p_info: structure reseted TYPE(rt_info)
! CALLS:
!
! COMMENTS:
!
!-----------------------------------------------------------------
!
! NAME:
! io_putinputfile
! FUNCTION:
! print an input file conforming to io_getbatchinput
! SYNTAX:
! call io_putinputfile(param)
! ON INPUT:
! p_param: global parameter data structure TYPE(control_struct)
! ON OUTPUT:
!
! CALLS:
!
! COMMENTS:
!
!-----------------------------------------------------------------
!
! PUBLIC:
! io_getcmdline, io_getinterinput, io_getbatchinput,
! io_putparameters, io_putruntimeinfo, io_putinputfile
! COMMENTS:
!
! USES:
! MISC_globalparam, MISC_error, MISC_timing, IO_plotdefine,
! FEM_handle
! LIBRARIES:
!
! REFERENCES:
!
! VERSION(S):
! 1. original version j. behrens 7/96
! 2. largely extended j. behrens 11/96
! 3. changed command line io j. behrens 1/97
! 4. changed runtime output (adaptations) j. behrens 1/97
! 5. control data struct, less command io j. behrens 12/97
! 6. tiff file plotting included j. behrens 1/98
! 7. adapted to BJuGL j. behrens 1/2000
! 8. compliant to amatos 1.0 j. behrens 12/2000
! 3. compliant to amatos 1.2 j. behrens 3/2002
!
!*****************************************************************
MODULE IO_utils
USE FLASH_parameters
USE MISC_timing
USE MISC_system
USE GRID_api
PRIVATE
INTEGER, PARAMETER :: i_ioerr=0
PUBLIC :: io_getcmdline, io_getinterinput, io_getbatchinput, &
io_putparameters, io_putruntimeinfo, io_putinputfile, io_initparams
CONTAINS
!*****************************************************************
SUBROUTINE io_getcmdline(p_cmd)
!---------- local declarations
IMPLICIT NONE
TYPE (control_struct), INTENT(out) :: p_cmd
LOGICAL :: l_ict
LOGICAL :: l_bat
LOGICAL :: l_mtl
LOGICAL :: l_dia
CHARACTER (len=io_fillen) :: a_infln
CHARACTER (len=io_fillen) :: a_outfln
INTEGER :: numargs
INTEGER :: i= 1
INTEGER :: i_fst
LOGICAL :: help= .true.
LOGICAL :: shoversion= .false.
CHARACTER (len=2) :: option
CHARACTER (len=15) :: comdnam
CHARACTER (len=io_fillen) :: c_dummy
!---------- initialize output variables
a_infln = adjustl(trim('Parameters.in'))
a_outfln= adjustl(trim('./'))
l_ict= .false.
l_bat= .false.
l_mtl= .false.
l_dia= .false.
!---------- read number commandline arguments
! this is possibly non standard f90, but definitely quasi standard
numargs= sys_numcmdargs()
CALL sys_getcmdargs(0,c_dummy,i_len=len(c_dummy))
comdnam= c_dummy(1:15)
check_args: IF(numargs < 1) THEN
GOTO 100 ! print_help
ELSE check_args
!---------- read command line arguments one by one
DO WHILE (i <= numargs)
CALL sys_getcmdargs(i,c_dummy,i_len=len(c_dummy))
option= c_dummy(1:2)
!---------- select the CASEs for command line options
eval_option: SELECT CASE (option)
CASE('-h') eval_option !--- request for help ---
help= .true.
i= i+1
CASE('-?') eval_option !--- request for help ---
help= .true.
i= i+1
CASE('-r') eval_option !--- print release information ---
shoversion= .true.
i= i+1
CASE('-l') eval_option !--- switch on logging ---
help= .false.
p_cmd%cmd%l_logging= .true.
i= i+1
CASE('-o') eval_option !--- redirect output into file ---
help= .false.
p_cmd%cmd%l_output= .true.
i= i+1
CASE('-f') eval_option !--- supply input file name ---
help= .false.
i= i+1
CALL sys_getcmdargs(i,c_dummy,i_len=len(c_dummy))
a_infln= c_dummy(1:io_fillen)
IF(a_infln(1:1) == '-') THEN !--- check correctnes of file name ---
help= .true.
GOTO 100 ! print_help
ELSE
i= i+1
END IF
CASE('-d') eval_option !--- directory path in which to find and write data ---
help= .false.
i= i+1
CALL sys_getcmdargs(i,c_dummy,i_len=len(c_dummy))
a_outfln= c_dummy(1:io_fillen)
IF(a_outfln(1:1) == '-') THEN !--- check correctnes of file name ---
help= .true.
GOTO 100 ! print_help
ELSE
i= i+1
END IF
CASE DEFAULT eval_option !--- default CASE: show help ---
help= .true.
GOTO 100 ! print_help
END SELECT eval_option
END DO
END IF check_args
!---------- update output structure
p_cmd%cmd%c_infile = a_infln
p_cmd%cmd%c_directory = a_outfln
!---------- print help information
100 print_help: IF(help) THEN
IF(shoversion) THEN
write(GRID_parameters%ioout,1001) GRID_parameters%program_name, GRID_parameters%version, GRID_parameters%subversion, &
GRID_parameters%patchversion, GRID_parameters%datemonth, GRID_parameters%dateyear, &
GRID_parameters%author_name, GRID_parameters%author_email, GRID_parameters%author_affil1, &
GRID_parameters%author_affil2, GRID_parameters%author_affil3
write(GRID_parameters%ioout,1002) comdnam
write(i_ioerr,*) 'STOPPED ... this is all I can say'
STOP
ELSE
write(GRID_parameters%ioout,1010) comdnam
write(GRID_parameters%ioout,1011) GRID_parameters%author_name
write(i_ioerr,*) 'STOPPED ... hope this made it clear'
STOP
END IF
END IF print_help
!---------- print version information
print_version: IF(shoversion) THEN
write(GRID_parameters%ioout,1001) GRID_parameters%program_name, GRID_parameters%version, GRID_parameters%subversion, &
GRID_parameters%patchversion, GRID_parameters%datemonth, GRID_parameters%dateyear, &
GRID_parameters%author_name, GRID_parameters%author_email, GRID_parameters%author_affil1, &
GRID_parameters%author_affil2, GRID_parameters%author_affil3
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1001) GRID_parameters%program_name, GRID_parameters%version, GRID_parameters%subversion, &
GRID_parameters%patchversion, GRID_parameters%datemonth, GRID_parameters%dateyear, &
GRID_parameters%author_name, GRID_parameters%author_email, GRID_parameters%author_affil1, &
GRID_parameters%author_affil2, GRID_parameters%author_affil3
END IF print_version
RETURN
1001 FORMAT(1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/ &
1x,'***** PROGRAM: ',a15,24x,'*****',/ &
1x,'***** VERSION: ',i2.2,'.',i2.2,'.',i2.2,31x,'*****',/ &
1x,'***** DATE: ',i2.2,'/',i4.4,32x,'*****',/ &
1x,'***** AUTHOR: ',a12,27x,'*****',/ &
1x,'***** E-MAIL: ',a39,'*****',/ &
1x,'***** ADDRESS: ',a39,'*****',/ &
1x,'***** ',a39,'*****',/ &
1x,'***** ',a39,'*****',/ &
1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****')
1002 FORMAT(1x,'***** TYPE ',a15,' -h, to get help',12x,'*****',/ &
1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****')
1010 FORMAT(1x,'USAGE: ',a15,' {-d dir} {-f file} {-h} {-l} {-o} {-r}',/ &
1x,' -d: determine input/output file directory path << dir >>, default ./',/ &
1x,' -f: input filename is << name >>, default Parameters.in',/ &
1x,' -h: help information (this output)',/ &
1x,' -l: switch on log file output',/ &
1x,' -o: redirect standard output to a file',/ &
1x,' -r: release information')
1011 FORMAT(1x,'Copyright (c) 2016',a13)
END SUBROUTINE io_getcmdline
!*****************************************************************
SUBROUTINE io_initparams(p_param)
!---------- local declarations
IMPLICIT NONE
TYPE (control_struct), INTENT(out) :: p_param
INTEGER :: i_maxsize, i_alct
!---------- initialize
p_param%num%r_deltatime = -1.0
p_param%num%r_reftolerance = -1.0
p_param%num%r_crstolerance = -1.0
p_param%num%r_refwatermark = -1.0
p_param%num%r_crswatermark = -1.0
p_param%num%i_experiment = -1
p_param%num%i_crslevel = -1
p_param%num%i_reflevel = -1
p_param%num%i_frsttimestep = -1
p_param%num%i_lasttimestep = -1
p_param%num%r_starttime = -1.0
p_param%num%r_finaltime = -1.0
p_param%num%i_adviterations = -1
p_param%io%i_plotoffset = -1
p_param%io%i_saveoffset = -1
p_param%io%i_savelast = -1
p_param%io%l_diagnostics = .FALSE.
p_param%io%l_vtu = .FALSE.
p_param%io%l_netcdf = .FALSE.
p_param%io%c_domainfile = 'Domain.dat'
p_param%io%c_triangfile = 'Triang.dat'
!---------- initialize meta data
p_param%tst%i_lognum = 0
p_param%tst%i_intnum = 0
p_param%tst%i_charnum = 0
p_param%tst%i_realnum = 0
END SUBROUTINE io_initparams
!*****************************************************************
SUBROUTINE io_getbatchinput(p_param)
!---------- local declarations
IMPLICIT NONE
TYPE (control_struct), INTENT(out) :: p_param
INTEGER, PARAMETER :: i_iofil= 10
CHARACTER (len=80) :: a_filrow
CHARACTER (LEN=GRID_parameters%i_stringlength) :: c_tmp
INTEGER :: i_iost, i_ioend, &
i_tmp, i_cln, i_cnt, i_len, i_alct, i_maxsize
CHARACTER (LEN=2*io_fillen) :: c_inputfile
!---------- initialize
i_cln= MIN(GRID_parameters%i_stringlength,io_fillen)
!---------- input file
WRITE(c_inputfile,*) trim(p_param%cmd%c_directory),p_param%cmd%c_infile
c_inputfile= adjustl(trim(c_inputfile))
!---------- open input file
OPEN(unit= i_iofil, file= c_inputfile, status= 'OLD', action= 'READ', iostat= i_iost)
file_notopen: IF(i_iost /= 0) THEN
WRITE(i_ioerr,*) 'ERROR: Filename: ', c_inputfile
IF(GRID_parameters%iolog > 0) &
WRITE(GRID_parameters%iolog,*) 'ERROR: Filename: ', c_inputfile
CALL grid_error(c_error='[io_getbatchinput]: Could not open parameters file')
ELSE file_notopen
WRITE(GRID_parameters%ioout,1000) GRID_parameters%program_name, GRID_parameters%version, GRID_parameters%subversion, &
GRID_parameters%patchversion, c_inputfile
IF(GRID_parameters%iolog > 0) THEN
WRITE(GRID_parameters%iolog,*) 'INFO: Filename: ', c_inputfile, ' opened on unit: ', i_iofil
WRITE(GRID_parameters%iolog,1000) GRID_parameters%program_name, GRID_parameters%version, GRID_parameters%subversion, &
GRID_parameters%patchversion, c_inputfile
END IF
END IF file_notopen
!---------- read line by line
read_loop: DO
READ(i_iofil,2000,iostat=i_ioend) a_filrow
!---------- if file ended
file_end: IF(i_ioend /= 0) THEN
CLOSE(i_iofil)
IF(GRID_parameters%iolog > 0) &
WRITE(GRID_parameters%iolog,*) 'INFO: Closed file on unit: ', i_iofil
EXIT
ELSE file_end
!---------- decide what to DO with line according to first character
comment_line: IF(a_filrow(1:1) == '#' .or. a_filrow(1:1) == '!') THEN
CYCLE read_loop
ELSE IF(a_filrow(1:14) == 'EXPERIMENT_NUM') THEN comment_line
read(i_iofil,*) p_param%num%i_experiment
ELSE IF(a_filrow(1:14) == 'FINE_GRID_LEVE') THEN comment_line
read(i_iofil,*) p_param%num%i_reflevel
ELSE IF(a_filrow(1:14) == 'COARSE_GRID_LE') THEN comment_line
read(i_iofil,*) p_param%num%i_crslevel
ELSE IF(a_filrow(1:14) == 'TOLERANCE_OF_R') THEN comment_line
read(i_iofil,*) p_param%num%r_reftolerance
ELSE IF(a_filrow(1:14) == 'TOLERANCE_OF_C') THEN comment_line
read(i_iofil,*) p_param%num%r_crstolerance
ELSE IF(a_filrow(1:14) == 'WATERMARK_OF_R') THEN comment_line
read(i_iofil,*) p_param%num%r_refwatermark
ELSE IF(a_filrow(1:14) == 'WATERMARK_OF_C') THEN comment_line
read(i_iofil,*) p_param%num%r_crswatermark
ELSE IF(a_filrow(1:14) == 'TIMESTEP_LENGT') THEN comment_line
read(i_iofil,*) p_param%num%r_deltatime
ELSE IF(a_filrow(1:14) == 'BEGINNING_TIME') THEN comment_line
read(i_iofil,*) p_param%num%i_frsttimestep
ELSE IF(a_filrow(1:14) == 'FINISHING_TIME') THEN comment_line
read(i_iofil,*) p_param%num%i_lasttimestep
ELSE IF(a_filrow(1:14) == 'TIMESTEPPING_S') THEN comment_line
read(i_iofil,*) p_param%num%r_starttime
ELSE IF(a_filrow(1:14) == 'TIMESTEPPING_E') THEN comment_line
read(i_iofil,*) p_param%num%r_finaltime
ELSE IF(a_filrow(1:14) == 'SLM_ITERATION_') THEN comment_line
read(i_iofil,*) p_param%num%i_adviterations
ELSE IF(a_filrow(1:14) == 'STEPS_BTW_PLOT') THEN comment_line
read(i_iofil,*) p_param%io%i_plotoffset
ELSE IF(a_filrow(1:14) == 'SWITCH_ON_DIAG') THEN comment_line
read(i_iofil,*) i_tmp
IF(i_tmp /= 0) p_param%io%l_diagnostics= .TRUE.
ELSE IF(a_filrow(1:14) == 'NETCDF_FILE_PL') THEN comment_line
read(i_iofil,*) i_tmp
IF(i_tmp /= 0) p_param%io%l_netcdf= .TRUE.
ELSE IF(a_filrow(1:14) == 'VTU_FILE_PLOTT') THEN comment_line
read(i_iofil,*) i_tmp
IF(i_tmp /= 0) p_param%io%l_vtu= .TRUE.
ELSE IF(a_filrow(1:14) == 'STEPS_BTW_SAVE') THEN comment_line
read(i_iofil,*) p_param%io%i_saveoffset
ELSE IF(a_filrow(1:14) == 'SAVE_FINISH_CO') THEN comment_line
read(i_iofil,*) p_param%io%i_savelast
ELSE IF(a_filrow(1:14) == 'DOMAIN_FILE_NA') THEN comment_line
read(i_iofil,2010,iostat=i_tmp) c_tmp
IF(i_tmp == 0) p_param%io%c_domainfile(1:i_cln)= c_tmp(1:i_cln)
ELSE IF(a_filrow(1:14) == 'TRIANG_FILE_NA') THEN comment_line
read(i_iofil,2010,iostat=i_tmp) c_tmp
IF(i_tmp == 0) p_param%io%c_triangfile(1:i_cln)= c_tmp(1:i_cln)
!---------- look for additional parameters in the physical parameter set
ELSE IF(a_filrow(1:14) == 'TST_INT_PARAME') THEN comment_line
read(i_iofil,*) p_param%tst%i_intnum
IF (p_param%tst%i_intnum > 0) THEN
!---------- allocate integer data structure for parameters and read the structure
ALLOCATE(p_param%tst%i_intsizes(p_param%tst%i_intnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: intsizes parameter not allocated')
read(i_iofil,2010,iostat=i_tmp) c_tmp
IF(c_tmp(1:14) .NE. 'TST_INT_STRUCT') CALL grid_error(c_error='[io_getbatchinput]: inconsistent integer params')
read(i_iofil,*) p_param%tst%i_intsizes
!---------- allocate space for keywords
ALLOCATE(p_param%tst%c_intkeywds(p_param%tst%i_intnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: intkeywds parameter not allocated')
!---------- allocate space for parameters
i_maxsize= maxval(p_param%tst%i_intsizes)
ALLOCATE(p_param%tst%tst_int(i_maxsize,p_param%tst%i_intnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: could not allocate int pointers')
!---------- read keywords and parameters
int_loop: DO i_cnt=1,p_param%tst%i_intnum
read(i_iofil,2010,iostat=i_tmp) c_tmp
p_param%tst%c_intkeywds(i_cnt)=c_tmp(1:i_comparlen)
read(i_iofil,*) p_param%tst%tst_int(1:p_param%tst%i_intsizes(i_cnt),i_cnt)
END DO int_loop
END IF
ELSE IF(a_filrow(1:14) == 'TST_REAL_PARAM') THEN comment_line
read(i_iofil,*) p_param%tst%i_realnum
IF (p_param%tst%i_realnum > 0) THEN
!---------- allocate real data structure for parameters and read the structure
ALLOCATE(p_param%tst%i_realsizes(p_param%tst%i_realnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: realsizes parameter not allocated')
read(i_iofil,2010,iostat=i_tmp) c_tmp
IF(c_tmp(1:14) .NE. 'TST_REAL_STRUC') CALL grid_error(c_error='[io_getbatchinput]: inconsistent real params')
read(i_iofil,*) p_param%tst%i_realsizes
!---------- allocate space for keywords
ALLOCATE(p_param%tst%c_realkeywds(p_param%tst%i_realnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: realkeywds parameter not allocated')
!---------- allocate space for parameters
i_maxsize= maxval(p_param%tst%i_realsizes)
ALLOCATE(p_param%tst%tst_real(i_maxsize,p_param%tst%i_realnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: could not allocate real pointers')
!---------- read keywords and parameters
real_loop: DO i_cnt=1,p_param%tst%i_realnum
read(i_iofil,2010,iostat=i_tmp) c_tmp
p_param%tst%c_realkeywds(i_cnt)=c_tmp(1:i_comparlen)
read(i_iofil,*) p_param%tst%tst_real(1:p_param%tst%i_realsizes(i_cnt),i_cnt)
END DO real_loop
END IF
ELSE IF(a_filrow(1:14) == 'TST_LOG_PARAME') THEN comment_line
read(i_iofil,*) p_param%tst%i_lognum
IF (p_param%tst%i_lognum > 0) THEN
!---------- allocate space for keywords
ALLOCATE(p_param%tst%c_logkeywds(p_param%tst%i_lognum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: logkeywds parameter not allocated')
!---------- allocate space for parameters
ALLOCATE(p_param%tst%tst_log(p_param%tst%i_lognum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: could not allocate logical pointers')
!---------- read keywords and parameters
log_loop: DO i_cnt=1,p_param%tst%i_lognum
read(i_iofil,2010,iostat=i_tmp) c_tmp
p_param%tst%c_logkeywds(i_cnt)=c_tmp(1:i_comparlen)
p_param%tst%tst_log(i_cnt)= .FALSE. ! default value!
read(i_iofil,*) i_tmp
IF(i_tmp /= 0) p_param%tst%tst_log(i_cnt)= .TRUE.
END DO log_loop
END IF
ELSE IF(a_filrow(1:14) == 'TST_CHAR_PARAM') THEN comment_line
read(i_iofil,*) p_param%tst%i_charnum
IF (p_param%tst%i_charnum > 0) THEN
!---------- allocate space for keywords
ALLOCATE(p_param%tst%c_charkeywds(p_param%tst%i_charnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: charkeywds parameter not allocated')
!---------- allocate space for parameters
ALLOCATE(p_param%tst%tst_char(p_param%tst%i_charnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_getbatchinput]: could not allocate char pointers')
!---------- read keywords and parameters
char_loop: DO i_cnt=1,p_param%tst%i_charnum
read(i_iofil,2010,iostat=i_tmp) c_tmp
p_param%tst%c_charkeywds(i_cnt)=c_tmp(1:i_comparlen)
read(i_iofil,2020,iostat=i_tmp) p_param%tst%tst_char(i_cnt)
END DO char_loop
END IF
END IF comment_line
END IF file_end
END DO read_loop
!---------- for backward compatibility we accept time step input, but
! it is necessary to compute the initial and final time...
no_inittime: IF((p_param%num%r_starttime < 0.0) .OR. &
(p_param%num%r_finaltime < 0.0)) THEN
!---------- check if at least first and last timestep are given
no_step: IF((p_param%num%i_frsttimestep < 0) .OR. &
(p_param%num%i_lasttimestep < 0)) THEN
CALL grid_error(c_error='[io_getbatchinput]: incomplete time stepping info')
END IF no_step
!---------- check if delta time is given
no_delta: IF((p_param%num%r_deltatime < 0.0)) THEN
CALL grid_error(c_error='[io_getbatchinput]: incomplete delta t')
END IF no_delta
!---------- now compute initial and final time from time stepping info
p_param%num%r_starttime = p_param%num%r_deltatime * p_param%num%i_frsttimestep
p_param%num%r_finaltime = p_param%num%r_deltatime * p_param%num%i_lasttimestep
END IF no_inittime
!---------- error handling
no_value: IF((p_param%num%r_deltatime < 0.0) .OR. &
(p_param%num%r_starttime < 0.0) .OR. &
(p_param%num%r_finaltime < 0.0) .OR. &
(p_param%num%r_reftolerance < 0.0) .OR. &
(p_param%num%r_crstolerance < 0.0) .OR. &
(p_param%num%r_refwatermark < 0.0) .OR. &
(p_param%num%r_crswatermark < 0.0) .OR. &
(p_param%num%i_experiment < 0) .OR. &
(p_param%num%i_crslevel < 0) .OR. &
(p_param%num%i_reflevel < 0) .OR. &
(p_param%io%i_plotoffset < 0) .OR. &
(p_param%io%i_saveoffset < 0) .OR. &
(p_param%num%i_adviterations < 0)) THEN
CALL grid_error(c_error='[io_getbatchinput]: Insufficient input parameters')
END IF no_value
RETURN
1000 FORMAT(1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/ &
1x,'***** PROGRAM: ',a15,22x,'*****',/ &
1x,'***** VERSION: ',i2.2,'.',i2.2,'.',i2.2,29x,'*****',/ &
1x,'***** Started in BATCH input mode',10x,'*****',/ &
1x,'***** INPUTFILE: ',a20,17x,'*****',/ &
1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/)
2000 FORMAT(a80)
2010 FORMAT(a32)
2020 FORMAT(a)
END SUBROUTINE io_getbatchinput
!*****************************************************************
SUBROUTINE io_putparameters(p_param)
!---------- local declarations
IMPLICIT NONE
TYPE (control_struct), INTENT(in) :: p_param
INTEGER :: i1, i2, i3, i9, i10, i11, i12, i13, i14
REAL (KIND = GRID_SR) :: r4, r5, r6, r7, r8, r9, r10
CHARACTER (len=3) :: c_diag, c_netc, c_vtup
!---------- temporary store
i1 = p_param%num%i_experiment
i2 = p_param%num%i_reflevel
i3 = p_param%num%i_crslevel
r4 = p_param%num%r_reftolerance
r5 = p_param%num%r_crstolerance
r6 = p_param%num%r_refwatermark
r7 = p_param%num%r_crswatermark
r8 = p_param%num%r_deltatime
r9 = p_param%num%r_starttime
r10= p_param%num%r_finaltime
i11= p_param%io%i_saveoffset
i12= p_param%io%i_plotoffset
i13= p_param%io%i_savelast
i14= p_param%num%i_adviterations
IF(p_param%io%l_diagnostics) THEN
c_diag= ' ON'
ELSE
c_diag= 'OFF'
END IF
IF(p_param%io%l_netcdf) THEN
c_netc= ' ON'
ELSE
c_netc= 'OFF'
END IF
IF(p_param%io%l_vtu) THEN
c_vtup= ' ON'
ELSE
c_vtup= 'OFF'
END IF
!---------- write satement
write(GRID_parameters%ioout,1000) i1, i2, i3, r4, r5, r6, r7, r8, r9, r10, i11, i12, &
i13, i14, c_diag, c_netc, c_vtup
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1000) i1, i2, i3, r4, r5, r6, r7, r8, r9, r10, i11, i12, &
i13, i14, c_diag, c_netc, c_vtup
RETURN
1000 FORMAT(1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/ &
1x,'***** Global Parameters',16x,'*****',/ &
1x,'***** ----- ----- ----- ----- ----- ----- ----- ----- *****',/ &
1x,'***** Experiment No.',25x,i8,' *****',/ &
1x,'***** ----- ----- ----- ----- ----- ----- ----- ----- *****',/ &
1x,'***** Finest grid level',22x,i8,' *****',/ &
1x,'***** Coarsest grid level',20x,i8,' *****',/ &
1x,'***** Refinement tolerance',15x,e12.4,' *****',/ &
1x,'***** Coarsening tolerance',15x,e12.4,' *****',/ &
1x,'***** Refinement watermark',15x,e12.4,' *****',/ &
1x,'***** Coarsening watermark',15x,e12.4,' *****',/ &
1x,'***** ----- ----- ----- ----- ----- ----- ----- ----- *****',/ &
1x,'***** Timestep length',20x,e12.4,' *****',/ &
1x,'***** Start time',25x,e12.4,' *****',/ &
1x,'***** Final time',25x,e12.4,' *****',/ &
1x,'***** ----- ----- ----- ----- ----- ----- ----- ----- *****',/ &
1x,'***** Timesteps between save',17x,i8,' *****',/ &
1x,'***** Timesteps between plot',17x,i8,' *****',/ &
1x,'***** Flag for last save',21x,i8,' *****',/ &
1x,'***** ----- ----- ----- ----- ----- ----- ----- ----- *****',/ &
1x,'***** Iterations for trajectories',12x,i8,' *****',/ &
1x,'***** ----- ----- ----- ----- ----- ----- ----- ----- *****',/ &
1x,'***** Diagnostics switched',24x,a3,' *****',/ &
1x,'***** NetCDF plotting switched',20x,a3,' *****',/ &
1x,'***** VTU plotting switched',23x,a3,' *****',/ &
1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/)
END SUBROUTINE io_putparameters
!*****************************************************************
SUBROUTINE io_putruntimeinfo(p_ghand, p_info, p_time)
!---------- local declarations
IMPLICIT NONE
TYPE (grid_handle), INTENT(in) :: p_ghand
TYPE (rt_info), INTENT(inout) :: p_info
TYPE (sw_info), INTENT(inout) :: p_time
INTEGER :: i_cnt
!---------- output
write(GRID_parameters%ioout,1000) p_info%i_step, p_info%r_modeltime, p_info%i_adapit, &
p_ghand%i_enumber, p_ghand%i_enumfine, &
p_ghand%i_gnumber, p_ghand%i_gnumfine, &
p_ghand%i_nnumber
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1000) p_info%i_step, p_info%r_modeltime, p_info%i_adapit, &
p_ghand%i_enumber, p_ghand%i_enumfine, &
p_ghand%i_gnumber, p_ghand%i_gnumfine, &
p_ghand%i_nnumber
times_loop: DO i_cnt=1,p_time%i_num
write(GRID_parameters%ioout,1003) p_time%p_tim(i_cnt)%c_tim, p_time%p_tim(i_cnt)%r_tim
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1003) p_time%p_tim(i_cnt)%c_tim, p_time%p_tim(i_cnt)%r_tim
END DO times_loop
save_perf: IF(p_info%l_saved) THEN
write(GRID_parameters%ioout,1002)
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1002)
also_plot: IF(p_info%l_ploted) THEN
write(GRID_parameters%ioout,1005)
write(GRID_parameters%ioout,1006)
IF(GRID_parameters%iolog > 0) THEN
write(GRID_parameters%iolog,1005)
write(GRID_parameters%iolog,1006)
END IF
ELSE also_plot
write(GRID_parameters%ioout,1005)
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1005)
END IF also_plot
ELSE save_perf
but_plot: IF(p_info%l_ploted) THEN
write(GRID_parameters%ioout,1002)
write(GRID_parameters%ioout,1006)
IF(GRID_parameters%iolog > 0) THEN
write(GRID_parameters%iolog,1002)
write(GRID_parameters%iolog,1006)
END IF
END IF but_plot
END IF save_perf
write(GRID_parameters%ioout,1010)
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,1010)
!---------- reset info structure
p_info%i_step = 0
p_info%i_adapit= 0
p_info%l_saved = .FALSE.
p_info%l_ploted= .FALSE.
RETURN
1000 FORMAT(1x,'+++++ +++++ +++++ +++++ +++++ +++++ +++++ +++++ +++++ +++++',/ &
1x,'+++++ Runtime Information Output +++++',/ &
1x,'+++++ ----- ----- ----- ----- ----- ----- ----- ----- +++++',/ &
1x,'+++++ Timestep Number',24x,i8,' +++++',/ &
1x,'+++++ Model time',25x,e12.4,' +++++',/ &
1x,'+++++ ----- ----- ----- ----- ----- ----- ----- ----- +++++',/ &
1x,'+++++ Inner iterations (for adaptation)',6x,i8,' +++++',/ &
1x,'+++++ ----- ----- ----- ----- ----- ----- ----- ----- +++++',/ &
1x,'+++++ Number of elements',21x,i8,' +++++',/ &
1x,'+++++ Number of elements (fine grid)',9x,i8,' +++++',/ &
1x,'+++++ Number of edges',24x,i8,' +++++',/ &
1x,'+++++ Number of edges (fine grid)',12x,i8,' +++++',/ &
1x,'+++++ Number of nodes',24x,i8,' +++++',/ &
1x,'+++++ ----- ----- ----- ----- ----- ----- ----- ----- +++++')
1002 FORMAT(1x,'+++++ ----- ----- ----- ----- ----- ----- ----- ----- +++++')
1003 FORMAT(1x,'+++++ Time spent in ',a16,5x,e12.4,' +++++')
1005 FORMAT(1x,'+++++ Saveset transferred to disk in this step +++++')
1006 FORMAT(1x,'+++++ Plotting performed in this step +++++')
1010 FORMAT(1x,'+++++ +++++ +++++ +++++ +++++ +++++ +++++ +++++ +++++ +++++',/)
END SUBROUTINE io_putruntimeinfo
!*****************************************************************
SUBROUTINE io_putinputfile(p_param)
!---------- local declarations
IMPLICIT NONE
TYPE (control_struct), INTENT(in) :: p_param
INTEGER :: i1, i2, i3, i9, i10, i11, &
i12, i13, i14, i15, i16, i17, i18, i19, i20, i31
INTEGER :: i_cnt, i_true, i_false, i_len
REAL (KIND = GRID_SR) :: r4, r5, r6, r7, r8, r9, r10
INTEGER :: i_unit=15, i_fst
CHARACTER (len=32) :: c_file
CHARACTER (len=28) :: c_tmp
!---------- temporary store
i1 = p_param%num%i_experiment+ 1
i2 = p_param%num%i_reflevel
i3 = p_param%num%i_crslevel
r4 = p_param%num%r_reftolerance
r5 = p_param%num%r_crstolerance
r6 = p_param%num%r_refwatermark
r7 = p_param%num%r_crswatermark
r8 = p_param%num%r_deltatime
r9 = p_param%num%r_finaltime
r10= p_param%num%r_finaltime + (p_param%num%r_finaltime- p_param%num%r_starttime)
i12= 0
IF(p_param%io%l_netcdf) i12= 1
i11= 0
IF(p_param%io%l_vtu) i11= 1
i31= 0
IF(p_param%io%l_diagnostics) i31= 1
i13= p_param%io%i_plotoffset
i14= p_param%io%i_saveoffset
i15= p_param%io%i_savelast
i16= p_param%num%i_adviterations
i_true= 1
i_false= 0
!---------- open file
write(c_tmp,*) trim(GRID_parameters%program_name), '_input.'
write(c_file,1010) trim(c_tmp), i1
c_file= adjustl(c_file)
open(i_unit, file= c_file, action= 'write', form= 'formatted', &
status='replace', iostat= i_fst)
not_opened: IF(i_fst /= 0) THEN
CALL grid_error(c_error='[io_putinputfile]: Could not open parameters file for output')
END IF not_opened
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,*) 'INFO: Filename: ', c_file, ' opened on unit: ', i_unit
!---------- write statement
write(i_unit,1001) c_file, GRID_parameters%program_name
write(i_unit,1002) i1, i2, i3, r4, r5, r6, r7, r8, r9, r10
write(i_unit,1003) i12, i11, i31, i13, i14, &
i15, p_param%io%c_domainfile, p_param%io%c_triangfile, i16
!---------- write statements for the generic phy part
IF(p_param%tst%i_lognum > 0) THEN
log_loop: DO i_cnt=1,p_param%tst%i_lognum
write(i_unit,1011) p_param%tst%c_logkeywds(i_cnt)
IF(p_param%tst%tst_log(i_cnt)) THEN
write(i_unit,*) i_true
ELSE
write(i_unit,*) i_false
END IF
END DO log_loop
END IF
IF(p_param%tst%i_charnum > 0) THEN
char_loop: DO i_cnt=1,p_param%tst%i_charnum
write(i_unit,1011) p_param%tst%c_charkeywds(i_cnt)
write(i_unit,*) p_param%tst%tst_char(i_cnt)
END DO char_loop
END IF
IF(p_param%tst%i_intnum > 0) THEN
write(i_unit,1011) 'TST_INT_STRUCT'
write(i_unit,*) p_param%tst%i_intsizes
int_loop: DO i_cnt=1,p_param%tst%i_intnum
write(i_unit,1011) p_param%tst%c_intkeywds(i_cnt)
i_len=p_param%tst%i_intsizes(i_cnt)
write(i_unit,*) p_param%tst%tst_int(1:i_len,i_cnt)
END DO int_loop
END IF
IF(p_param%tst%i_realnum > 0) THEN
write(i_unit,1011) 'TST_REAL_STRUC'
write(i_unit,*) p_param%tst%i_realsizes
real_loop: DO i_cnt=1,p_param%tst%i_realnum
write(i_unit,1011) p_param%tst%c_realkeywds(i_cnt)
i_len=p_param%tst%i_realsizes(i_cnt)
write(i_unit,*) p_param%tst%tst_real(1:i_len,i_cnt)
END DO real_loop
END IF
write(i_unit,1004)
!---------- close file
close(i_unit)
IF(GRID_parameters%iolog > 0) &
write(GRID_parameters%iolog,*) 'INFO: Closed file on unit: ', i_unit
RETURN
1001 FORMAT('# --- --- --- --- --- --- --- --- --- --- --- --- ---',/ &
'# Parameter file ',a32,/ &
'# created automatically by program ',a15,/ &
'# --- --- --- --- --- --- --- --- --- --- --- --- ---')
1002 FORMAT('EXPERIMENT_NUMBER',/ &
i8,/ &
'FINE_GRID_LEVEL',/ &
i8,/ &
'COARSE_GRID_LEVEL',/ &
i8,/ &
'TOLERANCE_OF_REFINEMENT',/ &
e12.4,/ &
'TOLERANCE_OF_COARSENING',/ &
e12.4,/ &
'WATERMARK_OF_REFINEMENT',/ &
e12.4,/ &
'WATERMARK_OF_COARSENING',/ &
e12.4,/ &
'TIMESTEP_LENGTH',/ &
e12.4,/ &
'TIMESTEPPING_START_TIME',/ &
e12.4,/ &
'TIMESTEPPING_END_TIME',/ &
e12.4)
1003 FORMAT('NETCDF_FILE_PLOTTING',/ &
i8,/ &
'VTU_FILE_PLOTTING',/ &
i8,/ &
'SWITCH_ON_DIAGNOSTICS',/ &
i8,/ &
'STEPS_BTW_PLOTS',/ &
i8,/ &
'STEPS_BTW_SAVES',/ &
i8,/ &
'SAVE_FINISH_CONFIGURATION',/ &
i8,/ &
'DOMAIN_FILE_NAME',/ &
a32,/ &
'TRIANG_FILE_NAME',/ &
a32,/ &
'SLM_ITERATION_NUMBER',/ &
i8)
1004 FORMAT('# --- --- End of parameter file --- --- --- --- ---')
1010 FORMAT(a28,i4.4)
1011 FORMAT(a14) ! CAUTION: Make sure this is exactly as long as i_comparlen in FLASH_metadata
END SUBROUTINE io_putinputfile
END MODULE IO_utils