From 54f801cb0592771dc0c6a70f2cf53cd13b5c3c4c Mon Sep 17 00:00:00 2001 From: Joern Behrens <joern.behrens@uni-hamburg.de> Date: Tue, 16 Feb 2021 07:45:15 +0100 Subject: [PATCH] update IO_utils in flash-sphere to the version in flash (latest version) --- flash2d/src/flash-sphere/IO_utils.f90 | 372 ++++++++------------------ 1 file changed, 111 insertions(+), 261 deletions(-) diff --git a/flash2d/src/flash-sphere/IO_utils.f90 b/flash2d/src/flash-sphere/IO_utils.f90 index 96a6d6c..7cfc271 100644 --- a/flash2d/src/flash-sphere/IO_utils.f90 +++ b/flash2d/src/flash-sphere/IO_utils.f90 @@ -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) - END IF - END DO log_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) - END IF - 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 + 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 @@ -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 -- GitLab