Skip to content
Snippets Groups Projects
Commit 54f801cb authored by Behrens, Prof. Dr. Jörn's avatar Behrens, Prof. Dr. Jörn
Browse files

update IO_utils in flash-sphere to the version in flash (latest version)

parent 4525ad40
No related branches found
No related tags found
No related merge requests found
Show whitespace changes
Inline Side-by-side
flash2d/src/flash-sphere/IO_utils.f90
+ 111
− 261
View file @ 54f801cb
......@@ -129,7 +129,6 @@
!
!*****************************************************************
MODULE IO_utils
USE FLASH_metadata
USE FLASH_parameters
USE MISC_timing
USE MISC_system
......@@ -200,14 +199,6 @@
CASE('-r') eval_option !--- print release information ---
shoversion= .true.
i= i+1
! CASE('-i') eval_option !--- select interactive input mode ---
! help= .false.
! l_ict= .true.
! i= i+1
! CASE('-d') eval_option !--- switch on diagnostics ---
! help= .false.
! l_dia= .true.
! i= i+1
CASE('-l') eval_option !--- switch on logging ---
help= .false.
p_cmd%cmd%l_logging= .true.
......@@ -216,12 +207,6 @@
help= .false.
p_cmd%cmd%l_output= .true.
i= i+1
! CASE('-b') eval_option !--- select batch input mode ---
! help= .false.
! l_bat= .true.
! IF(a_infln == 'xxxxxxxxxxxxxxxxxxxx') &
! a_infln= 'Parameters.in' !--- default input file name ---
! i= i+1
CASE('-f') eval_option !--- supply input file name ---
help= .false.
i= i+1
......@@ -255,9 +240,6 @@
p_cmd%cmd%c_infile = a_infln
p_cmd%cmd%c_directory = a_outfln
! p_cmd%cmd%l_interactive= l_ict
! p_cmd%cmd%l_diagnostics= l_dia
! p_cmd%cmd%l_batchmode= l_bat
!---------- print help information
......@@ -349,193 +331,14 @@
p_param%io%c_domainfile = 'Domain.dat'
p_param%io%c_triangfile = 'Triang.dat'
!---------- allocate from meta data structure
!---------- initialize meta data
log_init: IF(l_logused) THEN
ALLOCATE(p_param%phy%phy_log(i_lognum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_initparams]: could not allocate log pointers')
END IF log_init
char_init: IF(l_charused) THEN
ALLOCATE(p_param%phy%phy_char(i_charnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_initparams]: could not allocate char pointers')
END IF char_init
int_init: IF(l_intused) THEN
i_maxsize= maxval(i_intsizes)
ALLOCATE(p_param%phy%phy_int(i_maxsize,i_intnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_initparams]: could not allocate int pointers')
END IF int_init
real_init: IF(l_realused) THEN
i_maxsize= maxval(i_realsizes)
ALLOCATE(p_param%phy%phy_real(i_maxsize,i_realnum), stat=i_alct)
IF(i_alct /= 0) CALL grid_error(c_error='[io_initparams]: could not allocate real pointers')
END IF real_init
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_getinterinput(p_param)
!
! ---------- local declarations
!
! IMPLICIT NONE
!
! TYPE (control_struct), INTENT(out) :: p_param
! INTEGER :: i_iost, i_tmp, i_cln
! CHARACTER (len=io_fillen) :: c_tmp
!
! ---------- initialize
!
! CALL io_initparams(p_param)
! i_cln= MAX(GRID_parameters%i_stringlength,io_fillen)
!
! ---------- prompt user for input (loop in case of wrong input)
!
! write(GRID_parameters%ioout,1000) GRID_parameters%program_name, GRID_parameters%version, &
! GRID_parameters%subversion, GRID_parameters%patchversion
!
! ---------- Experiment Control
!
! write(GRID_parameters%ioout,1001)
! write(GRID_parameters%ioout,1010)
! write(GRID_parameters%ioout,1011,advance='NO')
! read(*,*) p_param%phy%i_experiment
!
! ---------- Adaptivity Control
!
! write(GRID_parameters%ioout,1001)
! write(GRID_parameters%ioout,1020)
! write(GRID_parameters%ioout,1021,advance='NO')
! read(*,*) p_param%phy%i_reflevel
! write(GRID_parameters%ioout,1022,advance='NO')
! read(*,*) p_param%phy%i_crslevel
! write(GRID_parameters%ioout,1023,advance='NO')
! read(*,*) p_param%phy%r_reftolerance
! write(GRID_parameters%ioout,1024,advance='NO')
! read(*,*) p_param%phy%r_crstolerance
! write(GRID_parameters%ioout,1025,advance='NO')
! read(*,*) p_param%phy%r_refwatermark
! write(GRID_parameters%ioout,1026,advance='NO')
! read(*,*) p_param%phy%r_crswatermark
!
! ---------- Time Step Control
!
! write(GRID_parameters%ioout,1001)
! write(GRID_parameters%ioout,1030)
! write(GRID_parameters%ioout,1031,advance='NO')
! read(*,*) p_param%phy%r_deltatime
! write(GRID_parameters%ioout,1032,advance='NO')
! read(*,*) p_param%phy%i_frsttimestep
! write(GRID_parameters%ioout,1033,advance='NO')
! read(*,*) p_param%phy%i_lasttimestep
!
! ---------- Output Control
!
! write(GRID_parameters%ioout,1001)
! write(GRID_parameters%ioout,1040)
! write(GRID_parameters%ioout,1041,advance='NO')
! read(*,*) p_param%io%i_saveoffset
! write(GRID_parameters%ioout,1043,advance='NO')
! read(*,*) p_param%io%i_savelast
! write(GRID_parameters%ioout,1042,advance='NO')
! read(*,*) p_param%io%i_plotoffset
! write(GRID_parameters%ioout,1049,advance='NO')
! read(*,*) i_tmp
! IF(i_tmp /= 0) THEN
! p_param%io%l_matlab= .True.
! END IF
! write(GRID_parameters%ioout,10491,advance='NO')
! read(*,*) i_tmp
! IF(i_tmp /= 0) THEN
! p_param%io%l_gmv= .True.
! END IF
! -- BEGIN added for visnetplot [flo]
! write(GRID_parameters%ioout,10492,advance='NO')
! read(*,*) i_tmp
! IF(i_tmp /= 0) THEN
! p_param%io%l_visnet= .True.
! END IF
! write(GRID_parameters%ioout,10493,advance='NO')
! read(*,*) i_tmp
! IF(i_tmp /= 0) THEN
! p_param%io%l_visnet_tiff= .True.
! END IF
! -- END
! write(GRID_parameters%ioout,1047,advance='NO')
! read(*,2000,iostat=i_iost) c_tmp
! IF(i_iost == 0) THEN
! p_param%io%c_triangfile(1:i_cln)= c_tmp(1:i_cln)
! END IF
!
! ---------- Iteration Control
!
! write(GRID_parameters%ioout,1001)
! write(GRID_parameters%ioout,1050)
! write(GRID_parameters%ioout,1051,advance='NO')
! read(*,*) p_param%phy%i_adviterations
! write(GRID_parameters%ioout,1002)
!
! ---------- error handling
!
! no_value: IF((p_param%phy%r_deltatime < 0.0) .OR. &
! (p_param%phy%r_reftolerance < 0.0) .OR. &
! (p_param%phy%r_crstolerance < 0.0) .OR. &
! (p_param%phy%r_refwatermark < 0.0) .OR. &
! (p_param%phy%r_crswatermark < 0.0) .OR. &
! (p_param%phy%i_experiment < 0) .OR. &
! (p_param%phy%i_crslevel < 0) .OR. &
! (p_param%phy%i_reflevel < 0) .OR. &
! (p_param%phy%i_frsttimestep < 0) .OR. &
! (p_param%phy%i_lasttimestep < 0) .OR. &
! (p_param%io%i_plotoffset < 0) .OR. &
! (p_param%io%i_saveoffset < 0) .OR. &
! (p_param%phy%i_adviterations < 0)) THEN
! CALL grid_error(20)
! END IF no_value
! RETURN
!
! 1000 FORMAT(1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/ &
! 1x,'***** PROGRAM: ',a15,24x,'*****',/ &
! 1x,'***** VERSION: ',i2.2,'.',i2.2,'.',i2.2,31x,'*****',/ &
! 1x,'***** Started in INTERACTIVE input mode *****',/ &
! 1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/)
! 1001 FORMAT(1x,'-----------------------------------------------------------',/)
! 1002 FORMAT(1x,'---------------------- end of input -----------------------',/)
! 1010 FORMAT(1x,' Experiment')
! 1020 FORMAT(1x,' Adaptivity Control')
! 1030 FORMAT(1x,' Timestep Control')
! 1040 FORMAT(1x,' Input/Output Control')
! 1050 FORMAT(1x,' Iteration Control')
! 1011 FORMAT(1x,'INPUT: Experiment No. (first exp. = 0) > ')
! 1021 FORMAT(1x,'INPUT: Finest level of refinement > ')
! 1022 FORMAT(1x,'INPUT: Coarsest level of refinement > ')
! 1023 FORMAT(1x,'INPUT: Tolerance for refinement (|t_r| < 1) > ')
! 1024 FORMAT(1x,'INPUT: Tolerance for Coarsening (t_c < t_r) > ')
! 1025 FORMAT(1x,'INPUT: Watermark for refinement (|w_r| < 1) > ')
! 1026 FORMAT(1x,'INPUT: Watermark for coarsening (|w_c| < 1) > ')
! 1031 FORMAT(1x,'INPUT: Timestep length (delta t) > ')
! 1032 FORMAT(1x,'INPUT: First timestep number > ')
! 1033 FORMAT(1x,'INPUT: Last timestep number > ')
! 1041 FORMAT(1x,'INPUT: Number of timesteps between saves > ')
! 1042 FORMAT(1x,'INPUT: Number of timesteps between plots > ')
! 1043 FORMAT(1x,'INPUT: Save last step for next experiment (no = 0) > ')
! 1045 FORMAT(1x,'INPUT: Plot polygonal outline (no = 0) > ')
! 10451 FORMAT(1x,'INPUT: Filename for polygon data (Polyline.dat) > ')
! 1046 FORMAT(1x,'INPUT: Read wind data from file (no = 0) > ')
! 10461 FORMAT(1x,'INPUT: Filename for wind data (Flow.dat) > ')
! 1047 FORMAT(1x,'INPUT: Filename for triangulation (Triang.dat) > ')
! 1049 FORMAT(1x,'INPUT: Write matlab compatible output file (no = 0) > ')
! 10491 FORMAT(1x,'INPUT: Write gmv compatible output file (no = 0) > ')
! -- BEGIN added for visnetplot [flo]:
! 10492 FORMAT(1x,'INPUT: Plot to visnet window (no = 0) > ')
! 10493 FORMAT(1x,'INPUT: Make visnet screenshots (no = 0) > ')
! -- END
! 1051 FORMAT(1x,'INPUT: Iterations in trajectory estimation > ')
!
! 2000 FORMAT(a32)
!
! END SUBROUTINE io_getinterinput
!*****************************************************************
SUBROUTINE io_getbatchinput(p_param)
......@@ -548,15 +351,12 @@
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
CHARACTER (LEN=2*io_fillen) :: c_inputfile, ctest
! CHARACTER (LEN=io_fillen) :: c_inputfile
INTEGER, PARAMETER :: i_filstrlen=2*io_fillen
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)
i_iost= 0
!---------- input file
......@@ -647,39 +447,86 @@
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 comment_line
IF(l_logused) THEN
log_loop: DO i_cnt=1,i_lognum
IF(a_filrow(1:i_comparlen) == c_logkeywds(i_cnt)) THEN
read(i_iofil,*) p_param%phy%phy_log(i_cnt)
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
END DO log_loop
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
IF(l_charused) THEN
char_loop: DO i_cnt=1,i_charnum
IF(a_filrow(1:i_comparlen) == c_charkeywds(i_cnt)) THEN
read(i_iofil,*) p_param%phy%phy_char(i_cnt)
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
IF(l_intused) THEN
int_loop: DO i_cnt=1,i_intnum
IF(a_filrow(1:i_comparlen) == c_intkeywds(i_cnt)) THEN
DO i_len=1,i_intsizes(i_cnt)
read(i_iofil,*) p_param%phy%phy_int(i_len,i_cnt)
END DO
END IF
END DO int_loop
END IF
IF(l_realused) THEN
real_loop: DO i_cnt=1,i_realnum
IF(a_filrow(1:i_comparlen) == c_realkeywds(i_cnt)) THEN
DO i_len=1,i_realsizes(i_cnt)
read(i_iofil,*) p_param%phy%phy_real(i_len,i_cnt)
END DO
END IF
END DO real_loop
END IF
END IF comment_line
END IF file_end
END DO read_loop
......@@ -735,6 +582,7 @@
1x,'***** ***** ***** ***** ***** ***** ***** ***** ***** *****',/)
2000 FORMAT(a80)
2010 FORMAT(a32)
2020 FORMAT(a)
END SUBROUTINE io_getbatchinput
!*****************************************************************
......@@ -972,36 +820,38 @@
!---------- write statements for the generic phy part
IF(l_logused) THEN
log_loop: DO i_cnt=1,i_lognum
write(i_unit,1011) c_logkeywds(i_cnt)
IF(p_param%phy%phy_log(i_cnt)) THEN
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(l_charused) THEN
char_loop: DO i_cnt=1,i_charnum
write(i_unit,1011) c_charkeywds(i_cnt)
write(i_unit,*) p_param%phy%phy_char(i_cnt)
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(l_intused) THEN
int_loop: DO i_cnt=1,i_intnum
write(i_unit,1011) c_intkeywds(i_cnt)
DO i_len=1,i_intsizes(i_cnt)
write(i_unit,*) p_param%phy%phy_int(i_len,i_cnt)
END DO
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(l_realused) THEN
real_loop: DO i_cnt=1,i_realnum
write(i_unit,1011) c_realkeywds(i_cnt)
DO i_len=1,i_realsizes(i_cnt)
write(i_unit,*) p_param%phy%phy_real(i_len,i_cnt)
END DO
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)
......@@ -1058,7 +908,7 @@
i8)
1004 FORMAT('# --- --- End of parameter file --- --- --- --- ---')
1010 FORMAT(a28,i4.4)
1011 FORMAT(a12) ! CAUTION: Make sure this is exactly as long as i_comparlen in FLASH_metadata
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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment