Skip to content
Snippets Groups Projects
Select Git revision
  • 8d5c25f920dd0f69e0d5d701c509b5bf97f649f0
  • master default
  • v0.6.9
  • v0.6.8
  • v0.6.7
  • v0.6.6
  • v0.6.5
  • v0.6.4
  • v0.6.2
9 results

SCRN0007.TXT

Blame
  • Code owners
    Assign users and groups as approvers for specific file changes. Learn more.
    IO_utils.f90 34.30 KiB
    !*****************************************************************
    !
    ! 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