From bc65ec0ca7cc24f3f060803d97930a1fff6971ea Mon Sep 17 00:00:00 2001 From: Franziska Hild Date: Tue, 30 Jan 2024 14:31:17 +0100 Subject: [PATCH 01/14] Bug fix read-in: try all possible options for general $ variables --- src/readintools/readintools.f90 | 202 +++++++++++++++++++++++++++++++- 1 file changed, 199 insertions(+), 3 deletions(-) diff --git a/src/readintools/readintools.f90 b/src/readintools/readintools.f90 index 6b19805fd..7131b3f29 100644 --- a/src/readintools/readintools.f90 +++ b/src/readintools/readintools.f90 @@ -1219,7 +1219,7 @@ SUBROUTINE GetGeneralOption(value, name, proposal) CLASS(Option),POINTER :: multi CLASS(OPTION),ALLOCATABLE :: newopt CHARACTER(LEN=:),ALLOCATABLE :: testname -INTEGER :: i,k +INTEGER :: i,k,trimDigits,j,foundIndex,numberOfIndexes CHARACTER(LEN=20) :: fmtName ! Temporary arrays to create new options CHARACTER(LEN=255) :: tmpValue @@ -1294,22 +1294,48 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SDEALLOCATE(testname) ! safety check ALLOCATE(CHARACTER(LEN_TRIM(name)) :: testname) ! Testname must not be trimmed! Otherwise, the INDEX test will fail as testname < name + + ! Check how many indexes are present + numberOfIndexes = 0 testname = name DO i = 1, LEN(name) ! Start replacing the index from the left IF(INDEX('0123456789',testname(i:i)).GT.0) THEN - testname(i:i) = '$' + numberOfIndexes = numberOfIndexes + 1 DO k = i+1, LEN(testname) ! Check if it is a multi-digit number and remove all following numbers IF(SCAN(testname(i+1:i+1),'0123456789').EQ.0) EXIT + testname(i+1:LEN(testname)-1) = testname(i+2:LEN(testname)) + testname(LEN(testname):LEN(testname)) = ' ' + END DO + END IF + END DO + IF (numberOfIndexes.GT.3) CALL abort(__STAMP__,'Variable name has more than three indexes! Change variable name!') + ! General options can be checked for a maximum of three $ per variable! + ! Replacing one index X by $ (up to three options are tested in the following order: $-X-X, X-$-X, X-X-$ / $-X, X-$) + DO i = 1, LEN(name) + ! Loop can be skipped if variable consists of only one digit to be possibly replaced by $ --> done by third loop, replacing all digits by $ + IF (numberOfIndexes.EQ.1) EXIT + ! Reset testname to name + testname = name + trimDigits = 0 + ! Start replacing one index after each other from left to right + IF(INDEX('0123456789',testname(i:i)).GT.0) THEN + ! Skip if index before is digit - then it is a multi-digit number (already done) + IF(SCAN(testname(i-1:i-1),'0123456789').GT.0) CYCLE + testname(i:i) = '$' + DO k = i+1, LEN(testname) + ! Check if it is a multi-digit number and remove all following numbers + IF(SCAN(testname(i+1:i+1),'0123456789').EQ.0) EXIT testname(i+1:LEN(testname)-1) = testname(i+2:LEN(testname)) testname(LEN(testname):LEN(testname)) = ' ' + trimDigits = trimDigits + 1 END DO ! Check if we can find this name check => prms%firstLink DO WHILE (associated(check)) - IF (check%opt%NAMEEQUALS(TRIM(testname)) .AND. check%opt%isSet) THEN + IF (check%opt%NAMEEQUALS(testname(1:LEN(testname)-trimDigits)) .AND. check%opt%isSet) THEN multi => check%opt ! copy value from option to result variable SELECT TYPE (multi) @@ -1372,6 +1398,176 @@ SUBROUTINE GetGeneralOption(value, name, proposal) END DO END IF END DO + + ! Replacing two indexes X out of three by $ (three options are tested in the following order: $-$-X, $-X-$, X-$-$) + DO j = 1, 3 + ! Loop can be skipped if variable consists of only one or two digits to be possibly replaced by $ + IF (numberOfIndexes.EQ.1.OR.numberOfIndexes.EQ.2) EXIT + ! Reset testname to name + testname = name + trimDigits = 0 + foundIndex = 0 + DO i = 1, LEN(name) + ! Start replacing the index from the left + IF(INDEX('0123456789',testname(i:i)).GT.0) THEN + ! Skip to keep index X + foundIndex = foundIndex + 1 + IF (foundIndex.EQ.(4-j)) CYCLE + testname(i:i) = '$' + DO k = i+1, LEN(testname) + ! Check if it is a multi-digit number and remove all following numbers + IF(SCAN(testname(i+1:i+1),'0123456789').EQ.0) EXIT + testname(i+1:LEN(testname)-1) = testname(i+2:LEN(testname)) + testname(LEN(testname):LEN(testname)) = ' ' + trimDigits = trimDigits + 1 + END DO + END IF + END DO + ! Check if we can find this name + check => prms%firstLink + DO WHILE (associated(check)) + IF (check%opt%NAMEEQUALS(testname(1:LEN(testname)-trimDigits)) .AND. check%opt%isSet) THEN + multi => check%opt + ! copy value from option to result variable + SELECT TYPE (multi) + CLASS IS (IntOption) + SELECT TYPE(value) + TYPE IS (INTEGER) + value = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(intopt) + WRITE(tmpValue, *) multi%value + CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + CLASS IS (RealOption) + SELECT TYPE(value) + TYPE IS (REAL) + value = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(realopt) + WRITE(tmpValue, *) multi%value + CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + CLASS IS (LogicalOption) + SELECT TYPE(value) + TYPE IS (LOGICAL) + value = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(logicalopt) + WRITE(tmpValue, *) multi%value + CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + CLASS IS (StringOption) + SELECT TYPE(value) + TYPE IS (STR255) + value%chars = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(stringopt) + WRITE(tmpValue,'(A)') multi%value + CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + END SELECT + + ! print option and value to stdout. Custom print, so do it here + WRITE(fmtName,*) prms%maxNameLen + SWRITE(UNIT_stdOut,'(a3)', ADVANCE='NO') " | " + CALL set_formatting("blue") + SWRITE(UNIT_stdOut,"(a"//fmtName//")", ADVANCE='NO') TRIM(name) + CALL clear_formatting() + SWRITE(UNIT_stdOut,'(a3)', ADVANCE='NO') " | " + CALL multi%printValue(prms%maxValueLen) + SWRITE(UNIT_stdOut,"(a3)", ADVANCE='NO') ' | ' + CALL set_formatting("blue") + SWRITE(UNIT_stdOut,'(a7)', ADVANCE='NO') "*MULTI" + CALL clear_formatting() + SWRITE(UNIT_stdOut,"(a3)") ' | ' + ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used + multi%isUsedMulti = .TRUE. + RETURN + END IF + check => check%next + END DO + END DO + + ! Replacing all (up to three) indexes X by $ ($-$-$ / $-$ / $) + testname = name + DO i = 1, LEN(name) + ! Start replacing the index from the left + IF(INDEX('0123456789',testname(i:i)).GT.0) THEN + testname(i:i) = '$' + DO k = i+1, LEN(testname) + ! Check if it is a multi-digit number and remove all following numbers + IF(SCAN(testname(i+1:i+1),'0123456789').EQ.0) EXIT + testname(i+1:LEN(testname)-1) = testname(i+2:LEN(testname)) + testname(LEN(testname):LEN(testname)) = ' ' + END DO + END IF + END DO + ! Check if we can find this name + check => prms%firstLink + DO WHILE (associated(check)) + IF (check%opt%NAMEEQUALS(TRIM(testname)) .AND. check%opt%isSet) THEN + multi => check%opt + ! copy value from option to result variable + SELECT TYPE (multi) + CLASS IS (IntOption) + SELECT TYPE(value) + TYPE IS (INTEGER) + value = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(intopt) + WRITE(tmpValue, *) multi%value + CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + CLASS IS (RealOption) + SELECT TYPE(value) + TYPE IS (REAL) + value = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(realopt) + WRITE(tmpValue, *) multi%value + CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + CLASS IS (LogicalOption) + SELECT TYPE(value) + TYPE IS (LOGICAL) + value = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(logicalopt) + WRITE(tmpValue, *) multi%value + CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + CLASS IS (StringOption) + SELECT TYPE(value) + TYPE IS (STR255) + value%chars = multi%value + ! insert option with numbered name ($ replaced by number) + ALLOCATE(stringopt) + WRITE(tmpValue,'(A)') multi%value + CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + END SELECT + END SELECT + + ! print option and value to stdout. Custom print, so do it here + WRITE(fmtName,*) prms%maxNameLen + SWRITE(UNIT_stdOut,'(a3)', ADVANCE='NO') " | " + CALL set_formatting("blue") + SWRITE(UNIT_stdOut,"(a"//fmtName//")", ADVANCE='NO') TRIM(name) + CALL clear_formatting() + SWRITE(UNIT_stdOut,'(a3)', ADVANCE='NO') " | " + CALL multi%printValue(prms%maxValueLen) + SWRITE(UNIT_stdOut,"(a3)", ADVANCE='NO') ' | ' + CALL set_formatting("blue") + SWRITE(UNIT_stdOut,'(a7)', ADVANCE='NO') "*MULTI" + CALL clear_formatting() + SWRITE(UNIT_stdOut,"(a3)") ' | ' + ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used + multi%isUsedMulti = .TRUE. + RETURN + END IF + check => check%next + END DO + ! create new instance of multiple option ALLOCATE(newopt, source=current%opt) ! set name of new option like name in read line and set it being not multiple numbered From 15cebbfc3d6dd6acbe0b388356b25748738cec65 Mon Sep 17 00:00:00 2001 From: Paul Nizenkov Date: Mon, 29 Jan 2024 16:51:33 +0100 Subject: [PATCH 02/14] Increase number of particles and tolerance to avoid failure due to statistical fluctuations --- .../analyze.ini | 2 +- .../parameter.ini | 2 +- .../parameter_macrorestart.ini | 5 ++--- .../analyze.ini | 2 +- .../parameter.ini | 2 +- .../parameter_macrorestart.ini | 3 +-- .../analyze.ini | 2 +- .../parameter.ini | 3 +-- .../parameter_macrorestart.ini | 5 ++--- 9 files changed, 11 insertions(+), 15 deletions(-) diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/analyze.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/analyze.ini index 131d751de..c86bdbbad 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/analyze.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/analyze.ini @@ -2,5 +2,5 @@ compare_column_file = PartAnalyze.csv ! data file name compare_column_reference_file = PartAnalyze_ref.csv ! reference data file name compare_column_index = 2,4 ! Comparison of pressure values at BCs -compare_column_tolerance_value = 15e-2 ! tolerance +compare_column_tolerance_value = 20e-2 ! tolerance compare_column_tolerance_type = relative ! absolute or relative comparison diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter.ini index 973f4a414..e8648cfeb 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter.ini @@ -74,7 +74,7 @@ Part-FIBGMdeltas=(/2.5e-6,1e-5,1e-5/) ! Species1 - O2 ! =============================================================================== ! Part-Species1-MassIC=5.31352E-26 -Part-Species1-MacroParticleFactor=1E3 +Part-Species1-MacroParticleFactor=5E2 Part-Species1-nInits=1 Part-Species1-Init1-SpaceIC=cell_local diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter_macrorestart.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter_macrorestart.ini index 853d565fc..c7355f1db 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter_macrorestart.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_FixedAverage/parameter_macrorestart.ini @@ -38,7 +38,6 @@ UseH5IOLoadBalance = T ! =============================================================================== ! ! PARTICLES ! =============================================================================== ! -Part-maxParticleNumber=200000 Part-nSpecies=1 Part-nBounds=6 Part-Boundary1-SourceName=BC_Xplus @@ -73,7 +72,7 @@ Part-FIBGMdeltas=(/2.5e-6,1e-5,1e-5/) ! Species1 - O2 ! =============================================================================== ! Part-Species1-MassIC=5.31352E-26 -Part-Species1-MacroParticleFactor=5E2 +Part-Species1-MacroParticleFactor=2.5E2 Part-Species1-nInits=1 Part-Species1-Init1-SpaceIC=cell_local @@ -136,7 +135,7 @@ Particles-MacroscopicRestart-Filename = ConstPressure_DSMCState_000.000050000000 ! =============================================================================== ! ! Species1, O2 ! =============================================================================== ! -Part-Species1-InteractionID = 2 +Part-Species1-InteractionID = 2 Part-Species1-Tref = 273 Part-Species1-dref = 4.07E-10 Part-Species1-omega=0.27 diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/analyze.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/analyze.ini index 131d751de..c86bdbbad 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/analyze.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/analyze.ini @@ -2,5 +2,5 @@ compare_column_file = PartAnalyze.csv ! data file name compare_column_reference_file = PartAnalyze_ref.csv ! reference data file name compare_column_index = 2,4 ! Comparison of pressure values at BCs -compare_column_tolerance_value = 15e-2 ! tolerance +compare_column_tolerance_value = 20e-2 ! tolerance compare_column_tolerance_type = relative ! absolute or relative comparison diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter.ini index a1b3f17d2..8fb227814 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter.ini @@ -74,7 +74,7 @@ Part-FIBGMdeltas=(/2.5e-6,1e-5,1e-5/) ! Species1 - O2 ! =============================================================================== ! Part-Species1-MassIC=5.31352E-26 -Part-Species1-MacroParticleFactor=2E3 +Part-Species1-MacroParticleFactor=1E3 Part-Species1-nInits=1 Part-Species1-Init1-SpaceIC=cell_local diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter_macrorestart.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter_macrorestart.ini index fa62fdd2c..f003c312f 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter_macrorestart.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_Relaxation/parameter_macrorestart.ini @@ -38,7 +38,6 @@ UseH5IOLoadBalance = T ! =============================================================================== ! ! PARTICLES ! =============================================================================== ! -Part-maxParticleNumber=200000 Part-nSpecies=1 Part-nBounds=6 Part-Boundary1-SourceName=BC_Xplus @@ -135,7 +134,7 @@ Particles-MacroscopicRestart-Filename = ConstPressure_DSMCState_000.000050000000 ! =============================================================================== ! ! Species1, O2 ! =============================================================================== ! -Part-Species1-InteractionID = 2 +Part-Species1-InteractionID = 2 Part-Species1-Tref = 273 Part-Species1-dref = 4.07E-10 Part-Species1-omega=0.27 diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/analyze.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/analyze.ini index 131d751de..c86bdbbad 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/analyze.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/analyze.ini @@ -2,5 +2,5 @@ compare_column_file = PartAnalyze.csv ! data file name compare_column_reference_file = PartAnalyze_ref.csv ! reference data file name compare_column_index = 2,4 ! Comparison of pressure values at BCs -compare_column_tolerance_value = 15e-2 ! tolerance +compare_column_tolerance_value = 20e-2 ! tolerance compare_column_tolerance_type = relative ! absolute or relative comparison diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter.ini index 3de5cda38..f1b2a36ce 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter.ini @@ -39,7 +39,6 @@ UseH5IOLoadBalance = T ! =============================================================================== ! ! PARTICLES ! =============================================================================== ! -Part-maxParticleNumber=200000 Part-nSpecies=1 Part-nBounds=6 Part-Boundary1-SourceName=BC_Xplus @@ -74,7 +73,7 @@ Part-FIBGMdeltas=(/2.5e-6,1e-5,1e-5/) ! Species1 - O2 ! =============================================================================== ! Part-Species1-MassIC=5.31352E-26 -Part-Species1-MacroParticleFactor=1E3 +Part-Species1-MacroParticleFactor=5E2 Part-Species1-nInits=1 Part-Species1-Init1-SpaceIC=cell_local diff --git a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter_macrorestart.ini b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter_macrorestart.ini index eefeb3658..136b1257a 100644 --- a/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter_macrorestart.ini +++ b/regressioncheck/WEK_DSMC/ChannelFlow_AdaptiveBoundary_ConstPressure_TruncAverage/parameter_macrorestart.ini @@ -38,7 +38,6 @@ UseH5IOLoadBalance = T ! =============================================================================== ! ! PARTICLES ! =============================================================================== ! -Part-maxParticleNumber=200000 Part-nSpecies=1 Part-nBounds=6 Part-Boundary1-SourceName=BC_Xplus @@ -73,7 +72,7 @@ Part-FIBGMdeltas=(/2.5e-6,1e-5,1e-5/) ! Species1 - O2 ! =============================================================================== ! Part-Species1-MassIC=5.31352E-26 -Part-Species1-MacroParticleFactor=5E2 +Part-Species1-MacroParticleFactor=2.5E2 Part-Species1-nInits=1 Part-Species1-Init1-SpaceIC=cell_local @@ -136,7 +135,7 @@ Particles-MacroscopicRestart-Filename = ConstPressure_DSMCState_000.000050000000 ! =============================================================================== ! ! Species1, O2 ! =============================================================================== ! -Part-Species1-InteractionID = 2 +Part-Species1-InteractionID = 2 Part-Species1-Tref = 273 Part-Species1-dref = 4.07E-10 Part-Species1-omega=0.27 From 0ceb50ed5bc889006489a81c58748de94d44c2ba Mon Sep 17 00:00:00 2001 From: Paul Nizenkov Date: Thu, 1 Feb 2024 00:38:43 +0100 Subject: [PATCH 03/14] WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage: Increased tolerance due to statistics --- .../2DAxi_ChannelFlow_ConstPressure_TruncAverage/analyze.ini | 2 +- .../2DAxi_ChannelFlow_ConstPressure_TruncAverage/parameter.ini | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/analyze.ini b/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/analyze.ini index e92b04f76..b9c801897 100644 --- a/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/analyze.ini +++ b/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/analyze.ini @@ -2,5 +2,5 @@ compare_column_file = PartAnalyze.csv ! data file name compare_column_reference_file = PartAnalyze_ref.csv ! reference data file name compare_column_index = 2,3,5 ! Comparison of mass flow (only at SF=1) and pressure values at BCs -compare_column_tolerance_value = 15e-2 ! tolerance +compare_column_tolerance_value = 20e-2 ! tolerance compare_column_tolerance_type = relative ! absolute or relative comparison diff --git a/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/parameter.ini b/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/parameter.ini index f196ee316..bfee0a2b4 100644 --- a/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/parameter.ini +++ b/regressioncheck/WEK_DSMC/2DAxi_ChannelFlow_ConstPressure_TruncAverage/parameter.ini @@ -42,7 +42,6 @@ UseH5IOLoadBalance = T ! =============================================================================== ! ! PARTICLES ! =============================================================================== ! -Part-maxParticleNumber=500000 Part-nSpecies=1 Part-nBounds=6 Part-Boundary1-SourceName=BC_Xplus From 9bc426e9e2902a0a59d3150d4f0eb1e1d8bad06c Mon Sep 17 00:00:00 2001 From: Stephen Copplestone Date: Thu, 1 Feb 2024 12:39:50 +0100 Subject: [PATCH 04/14] AppImage creation: The entry "Icon=piclas" in "piclas.desktop" now requires an icon file under "AppDir/usr/share/icons/hicolor/64x64/apps", which is created via mkdir -p AppDir/usr/share/icons/hicolor/64x64/apps/ ln -sf ../../../${PROG}.png AppDir/usr/share/icons/hicolor/64x64/apps in the ".github/workflows/cmake-ninja.yml" GitHub Actions config file. --- .github/workflows/cmake-ninja.yml | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/.github/workflows/cmake-ninja.yml b/.github/workflows/cmake-ninja.yml index 6c62c052b..020ec1742 100644 --- a/.github/workflows/cmake-ninja.yml +++ b/.github/workflows/cmake-ninja.yml @@ -225,6 +225,8 @@ jobs: DESTDIR=AppDir ninja install mkdir -p AppDir/usr/share/icons cp ../docs/logo.png AppDir/usr/share/icons/${PROG}.png + mkdir -p AppDir/usr/share/icons/hicolor/64x64/apps/ + ln -sf ../../../${PROG}.png AppDir/usr/share/icons/hicolor/64x64/apps/ cp ../.github/workflows/piclas.desktop template.desktop mv template.desktop ${PROG}.desktop sed -i -e "s/Name=.*/Name=${PROG}/" ${PROG}.desktop @@ -252,6 +254,8 @@ jobs: DESTDIR=AppDir ninja install mkdir -p AppDir/usr/share/icons cp ../docs/logo.png AppDir/usr/share/icons/${PROG}.png + mkdir -p AppDir/usr/share/icons/hicolor/64x64/apps/ + ln -sf ../../../${PROG}.png AppDir/usr/share/icons/hicolor/64x64/apps/ cp ../.github/workflows/piclas.desktop template.desktop mv template.desktop ${PROG}.desktop sed -i -e "s/Name=.*/Name=${PROG}/" ${PROG}.desktop @@ -278,6 +282,8 @@ jobs: DESTDIR=AppDir ninja install mkdir -p AppDir/usr/share/icons cp ../docs/logo.png AppDir/usr/share/icons/${PROG}.png + mkdir -p AppDir/usr/share/icons/hicolor/64x64/apps/ + ln -sf ../../../${PROG}.png AppDir/usr/share/icons/hicolor/64x64/apps/ cp ../.github/workflows/piclas.desktop template.desktop mv template.desktop ${PROG}.desktop sed -i -e "s/Name=.*/Name=${PROG}/" ${PROG}.desktop From 9fdb840e7754cb47ff625c471d1bf8b837d5a074 Mon Sep 17 00:00:00 2001 From: Stephen Copplestone Date: Thu, 1 Feb 2024 16:13:49 +0100 Subject: [PATCH 05/14] Increased version number of Github artefacts --- .github/workflows/cmake-ninja.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/cmake-ninja.yml b/.github/workflows/cmake-ninja.yml index 020ec1742..e728992ad 100644 --- a/.github/workflows/cmake-ninja.yml +++ b/.github/workflows/cmake-ninja.yml @@ -318,7 +318,7 @@ jobs: - name: Upload artifacts uses: actions/upload-artifact@v3 with: - name: piclas-binaries-v3.0.0 + name: piclas-binaries-v3.1.0 path: artifacts - name: Upload release asset From 8fe7f5856fe5686f42dad68ce0d6c8c2c6e81f88 Mon Sep 17 00:00:00 2001 From: Stephen Copplestone Date: Thu, 1 Feb 2024 16:41:59 +0100 Subject: [PATCH 06/14] Updated Release.md template --- .gitlab/merge_request_templates/Release.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.gitlab/merge_request_templates/Release.md b/.gitlab/merge_request_templates/Release.md index 2929e79a1..f0fb282aa 100644 --- a/.gitlab/merge_request_templates/Release.md +++ b/.gitlab/merge_request_templates/Release.md @@ -1,6 +1,8 @@ # Merge Request To-Do -* [ ] Update of version numbers in ./src/globals/globals_vars.f90 +* [ ] Update of version numbers in + * [ ] `./src/globals/globals_vars.f90` (`MajorVersion`, `MinorVersion` and `PatchVersion`) + * [ ] `.github/workflows/cmake-ninja.yml` (`piclas-binaries-vX.X.X`) * [ ] Release notes ## Regression Testing From 057743a1803b98c62a36518f2f8cc2a6854607d0 Mon Sep 17 00:00:00 2001 From: Julian Beyer Date: Wed, 7 Feb 2024 14:38:14 +0100 Subject: [PATCH 07/14] up --- .../WEK_DSMC_Radiation/Flow_N2-N_70degConeHot/parameter.ini | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regressioncheck/WEK_DSMC_Radiation/Flow_N2-N_70degConeHot/parameter.ini b/regressioncheck/WEK_DSMC_Radiation/Flow_N2-N_70degConeHot/parameter.ini index e27641770..c4ccd779b 100644 --- a/regressioncheck/WEK_DSMC_Radiation/Flow_N2-N_70degConeHot/parameter.ini +++ b/regressioncheck/WEK_DSMC_Radiation/Flow_N2-N_70degConeHot/parameter.ini @@ -144,6 +144,6 @@ Particles-Symmetry2D = T Particles-Symmetry2DAxisymmetric = T ! Radial Weighting Particles-RadialWeighting = T -Particles-RadialWeighting-PartScaleFactor = 10 !initially 60 +Particles-RadialWeighting-PartScaleFactor = 9 !initially 60 Particles-RadialWeighting-CloneMode = 2 Particles-RadialWeighting-CloneDelay = 5 From fed87cf9e5c6e8e9f3ca9b19605c4ea34d3b7e7f Mon Sep 17 00:00:00 2001 From: Stephen Copplestone Date: Sat, 10 Feb 2024 14:51:34 +0100 Subject: [PATCH 08/14] Perform arithmetic with 0-prefixed numbers: tell bash to use base-10 by specifying 10# --- .gitlab-ci.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml index 654dbc524..231254439 100644 --- a/.gitlab-ci.yml +++ b/.gitlab-ci.yml @@ -40,7 +40,8 @@ before_script: else day=$(cat reggie/.day); fi - - if [ "$(($day % 2))" == "0" ]; then + - echo "Perform arithmetic with 0-prefixed numbers by telling bash to use base-10 by specifying 10#" + - if [ "$((10#$day % 2))" == "0" ]; then echo "Even day number ($day). Loading OpenMPI"; module purge; module load cmake/3.26.4 gcc/13.2.0 openmpi/4.1.5/gcc/13.2.0 hdf5/1.14.0/gcc/13.2.0/openmpi/4.1.5 hopr/master/gcc/13.2.0/openmpi/4.1.5/hdf5/1.14.0 petsc/3.19.3/gcc/13.2.0/openmpi/4.1.5; From d940c5088dbc91d5c4664557429f16746c62ee3a Mon Sep 17 00:00:00 2001 From: Stephen Copplestone Date: Wed, 13 Mar 2024 18:20:32 +0100 Subject: [PATCH 09/14] Added single and double dollar variable to unit test --- unitTests/ReadInTools.f90 | 92 +++++++++++++++++++++++++++------------ unitTests/ReadInTools.ini | 11 ++++- 2 files changed, 75 insertions(+), 28 deletions(-) diff --git a/unitTests/ReadInTools.f90 b/unitTests/ReadInTools.f90 index 07442b0de..a8e3a84c0 100644 --- a/unitTests/ReadInTools.f90 +++ b/unitTests/ReadInTools.f90 @@ -68,6 +68,11 @@ PROGRAM ReadInToolsUnitTest !character(len=255) :: strArrayOpt_def(2) !character(len=255) :: strArrayOpt_mult(2) !character(len=255) :: strArrayOpt_mult_A(2) +INTEGER,ALLOCATABLE :: Dollar(:) +INTEGER :: nDollar,iDollar,nDollar2,iDollar2 +CHARACTER(32) :: hilf,hilf2 +INTEGER, ALLOCATABLE :: IntOption(:) +REAL, ALLOCATABLE :: RealOption(:,:) !================================================================================================================================== CALL InitMPI() ! Check for command line arguments to generate the reference solution @@ -75,38 +80,40 @@ PROGRAM ReadInToolsUnitTest IF (nArgs.GT.0) CALL abort(__STAMP__,'ERROR - Unknown command line argument.') CALL prms%SetSection("UnitTest") -CALL prms%CreateIntOption('intOpt' , "Description IntOpt") -CALL prms%CreateIntOption('intOpt_def' , "Description IntOpt with default value", '-1') -CALL prms%CreateIntOption('intOpt_mult' , "Description IntOpt multiple", multiple=.TRUE.) -CALL prms%CreateRealOption('realOpt' , "Description RealOpt") -CALL prms%CreateRealOption('realOptsci' , "Description RealOpt") -CALL prms%CreateRealOption('realOpt_def' , "Description RealOpt with default value", '-1.00') -CALL prms%CreateRealOption('realOpt_defsci' , "Description RealOpt with default value scientific", '0.3e-7') -CALL prms%CreateRealOption('realOpt_mult' , "Description RealOpt multiple", multiple=.TRUE.) -CALL prms%CreateRealOption('realOpt_multsci' , "Description RealOpt multiple", multiple=.TRUE.) -CALL prms%CreateLogicalOption('logOpt' , "Description LogOpt") -CALL prms%CreateLogicalOption('logOpt_def' , "Description LogOpt with default value", 'T') -CALL prms%CreateLogicalOption('logOpt_mult' , "Description LogOpt multiple", multiple=.TRUE.) -CALL prms%CreateStringOption('strOpt' , "Description StrOpt") -CALL prms%CreateStringOption('strOpt_def' , "Description StrOpt with default value", 'dummyValue') -CALL prms%CreateStringOption('strOpt_mult' , "Description StrOpt multiple", multiple=.TRUE.) +CALL prms%CreateIntOption('intOpt' , "Description IntOpt") +CALL prms%CreateIntOption('intOpt_def' , "Description IntOpt with default value" , '4') +CALL prms%CreateIntOption('intOpt_mult' , "Description IntOpt multiple" , multiple=.TRUE.) +CALL prms%CreateRealOption('realOpt' , "Description RealOpt") +CALL prms%CreateRealOption('realOptsci' , "Description RealOpt") +CALL prms%CreateRealOption('realOpt_def' , "Description RealOpt with default value" , '-1.00') +CALL prms%CreateRealOption('realOpt_defsci' , "Description RealOpt with default value scientific" , '0.3e-7') +CALL prms%CreateRealOption('realOpt_mult' , "Description RealOpt multiple" , multiple=.TRUE.) +CALL prms%CreateRealOption('realOpt_multsci' , "Description RealOpt multiple" , multiple=.TRUE.) +CALL prms%CreateLogicalOption('logOpt' , "Description LogOpt") +CALL prms%CreateLogicalOption('logOpt_def' , "Description LogOpt with default value" , 'T') +CALL prms%CreateLogicalOption('logOpt_mult' , "Description LogOpt multiple" , multiple=.TRUE.) +CALL prms%CreateStringOption('strOpt' , "Description StrOpt") +CALL prms%CreateStringOption('strOpt_def' , "Description StrOpt with default value" , 'dummyValue') +CALL prms%CreateStringOption('strOpt_mult' , "Description StrOpt multiple" , multiple=.TRUE.) -CALL prms%CreateIntArrayOption('intArrayOpt' , "Description IntOpt", no=0) -CALL prms%CreateIntArrayOption('intArrayOpt_def' , "Description IntOpt with default value", '-1,0,-3', no=2) -CALL prms%CreateIntArrayOption('intArrayOpt_mult' , "Description IntOpt multiple", multiple=.TRUE., no=0) -CALL prms%CreateRealArrayOption('realArrayOpt' , "Description RealOpt", no=0) -CALL prms%CreateRealArrayOption('realArrayOptsci' , "Description RealOpt", no=0) -CALL prms%CreateRealArrayOption('realArrayOpt_def' , "Description RealOpt with default value" , '-1.00,5.,22', no=3) -CALL prms%CreateRealArrayOption('realArrayOpt_defsci' , "Description RealOpt with default value scientific" , '0.3e-7,-5e2', no=2) -CALL prms%CreateRealArrayOption('realArrayOpt_mult' , "Description RealOpt multiple" , multiple=.TRUE., no=0) -CALL prms%CreateRealArrayOption('realArrayOpt_multsci' , "Description RealOpt multiple" , multiple=.TRUE., no=0) -CALL prms%CreateLogicalArrayOption('logArrayOpt' , "Description LogOpt", no=0) -CALL prms%CreateLogicalArrayOption('logArrayOpt_def' , "Description LogOpt with default value", '(/T,F/)', no=2) -CALL prms%CreateLogicalArrayOption('logArrayOpt_mult' , "Description LogOpt multiple", multiple=.TRUE., no=0) +CALL prms%CreateIntArrayOption('intArrayOpt' , "Description IntOpt" , no=0) +CALL prms%CreateIntArrayOption('intArrayOpt_def' , "Description IntOpt with default value" , '-1 , 0 , -3' , no=2) +CALL prms%CreateIntArrayOption('intArrayOpt_mult' , "Description IntOpt multiple" , multiple=.TRUE. , no=0) +CALL prms%CreateRealArrayOption('realArrayOpt' , "Description RealOpt" , no=0) +CALL prms%CreateRealArrayOption('realArrayOptsci' , "Description RealOpt" , no=0) +CALL prms%CreateRealArrayOption('realArrayOpt_def' , "Description RealOpt with default value" , '-1.00 , 5. , 22', no=3) +CALL prms%CreateRealArrayOption('realArrayOpt_defsci' , "Description RealOpt with default value scientific" , '0.3e-7 , -5e2' , no=2) +CALL prms%CreateRealArrayOption('realArrayOpt_mult' , "Description RealOpt multiple" , multiple=.TRUE. , no=0) +CALL prms%CreateRealArrayOption('realArrayOpt_multsci' , "Description RealOpt multiple" , multiple=.TRUE. , no=0) +CALL prms%CreateLogicalArrayOption('logArrayOpt' , "Description LogOpt" , no=0) +CALL prms%CreateLogicalArrayOption('logArrayOpt_def' , "Description LogOpt with default value" , '(/T , F/)' , no=2) +CALL prms%CreateLogicalArrayOption('logArrayOpt_mult' , "Description LogOpt multiple" , multiple=.TRUE. , no=0) !CALL prms%CreateStringArrayOption('strArrayOpt' , "Description StrOpt") !CALL prms%CreateStringArrayOption('strArrayOpt_def' , "Description StrOpt with default value", 'dum1,dum2') !CALL prms%CreateStringArrayOption('strArrayOpt_mult' , "Description StrOpt multiple", multiple=.TRUE.) +CALL prms%CreateIntOption('Dollar[$]-IntOption' , 'Single dollar variable.', '-1' , numberedmulti=.TRUE.) +CALL prms%CreateRealOption('Dollar[$]-Dollar[$]-RealOption' , 'Double dollar variable.', '-1.0' , numberedmulti=.TRUE.) !CALL PrintDefaultParameterFile(.FALSE.) CALL prms%read_options(FileName) @@ -192,6 +199,37 @@ PROGRAM ReadInToolsUnitTest !IF (strArrayOpt_mult(i).NE.strArrayOpt_mult_A(i)) CALL Abort(__STAMP__,"strArrayOpt_mult failed") !END DO +! Test single and double dollar variables +nDollar = ABS(intOpt) +nDollar2 = ABS(intOpt) +ALLOCATE(Dollar(1:nDollar)) +ALLOCATE(RealOption(nDollar,nDollar2)) +Dollar=0 +ALLOCATE(IntOption(nDollar)) +IntOption = 0 +! Loop twice. The default value <= zero is not allowed to appear +DO i = 1, 2 + write(UNIT_StdOut,'(A,I0,A)') "--------------",i,"--------------" + DO iDollar=1, nDollar + WRITE(UNIT=hilf,FMT='(I0)') iDollar + IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOption') + DO iDollar2 = 1, nDollar2 + WRITE(UNIT=hilf2,FMT='(I0)') iDollar2 + RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOption') + END DO ! iDollar2 = 1, nDollar2 + END DO ! iDollar=1, nDollar + IF(ANY(IntOption.LE.0)) CALL abort(__STAMP__,'IntOption cannot must be grater than zero') + IF(ANY(RealOption.LE.0)) CALL abort(__STAMP__,'RealOption cannot must be grater than zero') + + WRITE (*,*) "IntOption =", IntOption + DO iDollar=1, nDollar + WRITE (*,*) "RealOption(iDollar,:) =", RealOption(iDollar,:) + END DO + CALL prms%finalize(.TRUE.) ! is the same as CALL FinalizeParameters(), but considers load balancing +END DO ! i = 1, 2 + +CALL prms%finalize(.FALSE.) ! is the same as CALL FinalizeParameters(), but considers load balancing + #if USE_MPI ! we also have to finalize MPI itself here CALL MPI_FINALIZE(iError) diff --git a/unitTests/ReadInTools.ini b/unitTests/ReadInTools.ini index cb97dedca..8bfe3da1e 100644 --- a/unitTests/ReadInTools.ini +++ b/unitTests/ReadInTools.ini @@ -19,7 +19,7 @@ !================================================================================================== ! UnitTest !================================================================================================== -intOpt = -1 +intOpt = 4 intOpt_mult = -4 intOpt_mult = -4 realOpt = -1.00 @@ -53,3 +53,12 @@ strArrayOpt = (/ dum1, dum2 /) strArrayOpt_mult = (/ dum1, dum2 /) strArrayOpt_mult = (/ dum1, dum2 /) +! Single dollar +Dollar1-IntOption = 5 +Dollar3-IntOption = 3 +Dollar$-IntOption = 2 + +! Double dollar +Dollar$-Dollar$-RealOption = 0.1 +Dollar1-Dollar$-RealOption = 1.0 +Dollar2-Dollar$-RealOption = 2.0 From d56720e9a1506337909101b6614238e32a4ad155 Mon Sep 17 00:00:00 2001 From: Paul Nizenkov Date: Fri, 15 Mar 2024 17:24:15 +0100 Subject: [PATCH 10/14] ReadInTools unit test: Set a default for GETINT/GETREAL --- unitTests/ReadInTools.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/unitTests/ReadInTools.f90 b/unitTests/ReadInTools.f90 index a8e3a84c0..886002309 100644 --- a/unitTests/ReadInTools.f90 +++ b/unitTests/ReadInTools.f90 @@ -212,10 +212,10 @@ PROGRAM ReadInToolsUnitTest write(UNIT_StdOut,'(A,I0,A)') "--------------",i,"--------------" DO iDollar=1, nDollar WRITE(UNIT=hilf,FMT='(I0)') iDollar - IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOption') + IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOption','-1') DO iDollar2 = 1, nDollar2 WRITE(UNIT=hilf2,FMT='(I0)') iDollar2 - RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOption') + RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOption','-1.') END DO ! iDollar2 = 1, nDollar2 END DO ! iDollar=1, nDollar IF(ANY(IntOption.LE.0)) CALL abort(__STAMP__,'IntOption cannot must be grater than zero') From e4affa22ba7f859053e22103ae0356547b22fc92 Mon Sep 17 00:00:00 2001 From: Raphael Tietz Date: Wed, 10 Apr 2024 16:57:54 +0200 Subject: [PATCH 11/14] Trying to find the missing information during loadbalace getparams --- .../emission/particle_surface_flux_init.f90 | 1 + src/readintools/options.f90 | 6 +- src/readintools/readintools.f90 | 97 +++++++++++++++++-- 3 files changed, 91 insertions(+), 13 deletions(-) diff --git a/src/particles/emission/particle_surface_flux_init.f90 b/src/particles/emission/particle_surface_flux_init.f90 index 0ae442262..60c2dfda6 100644 --- a/src/particles/emission/particle_surface_flux_init.f90 +++ b/src/particles/emission/particle_surface_flux_init.f90 @@ -479,6 +479,7 @@ SUBROUTINE ReadInAndPrepareSurfaceFlux(MaxSurfacefluxBCs, nDataBC) SF%origin = GETREALARRAY('Part-Species'//TRIM(hilf2)//'-origin',2) WRITE(UNIT=hilf3,FMT='(E16.8)') HUGE(SF%rmax) SF%rmax = GETREAL('Part-Species'//TRIM(hilf2)//'-rmax',TRIM(hilf3)) + SWRITE(*,*) "!!!!!!!!!!!!!!!!!!!!!!!!! SF%rmax",SF%rmax SF%rmin = GETREAL('Part-Species'//TRIM(hilf2)//'-rmin') ! Total area of surface flux SF%totalAreaSF = Pi*(SF%rmax*SF%rmax - SF%rmin*SF%rmin) diff --git a/src/readintools/options.f90 b/src/readintools/options.f90 index e4425d009..fc12d7646 100644 --- a/src/readintools/options.f90 +++ b/src/readintools/options.f90 @@ -362,9 +362,9 @@ SUBROUTINE print(this, maxNameLen, maxValueLen, mode) INTEGER :: length INTEGER :: commentLen !================================================================================================================================== -#if USE_LOADBALANCE -IF(PerformLoadBalance) RETURN -#endif /*USE_LOADBALANCE*/ +! #if USE_LOADBALANCE +! IF(PerformLoadBalance) RETURN +! #endif /*USE_LOADBALANCE*/ IF(mode.EQ.1) commentLen=80 !--help IF(mode.EQ.2) commentLen=50 !--markdown WRITE(fmtName,*) maxNameLen diff --git a/src/readintools/readintools.f90 b/src/readintools/readintools.f90 index 0318ed618..38ce59a5d 100644 --- a/src/readintools/readintools.f90 +++ b/src/readintools/readintools.f90 @@ -359,6 +359,10 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm LOGICAL,INTENT(IN),OPTIONAL :: multiple !< marker if multiple option LOGICAL,INTENT(IN),OPTIONAL :: numberedmulti !< marker if numbered multiple option LOGICAL,INTENT(IN),OPTIONAL :: removed !< marker if removed option + + +CHARACTER(LEN=255) :: name_loc !< option name +CLASS(link),POINTER :: current ! LOCAL VARIABLES CLASS(link), POINTER :: newLink TYPE(Varying_String) :: aStr @@ -368,6 +372,19 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm ! 'Option "'//TRIM(name)//'" is already defined, can not be defined with the same name twice!') !END IF +! current => prms%firstLink +! DO WHILE (associated(current)) +! SWRITE(*,*) TRIM(current%opt%name)!," ", valuestr +! current => current%next +! END DO +! ! END IF +! SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" + +SWRITE(*,*) "CreateOption Name: ", name +! IF(SCAN(name,"[]").NE.0) THEN +! DO WHILE(SCAN(name,"[]").NE.0) +! END DO +! END IF opt%hasDefault = PRESENT(value) IF (opt%hasDefault) THEN CALL opt%parse(value) @@ -389,15 +406,18 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm aStr = Replace(aStr,"[]" ,"$",Every = .true.) aStr = Replace(aStr,"[$]" ,"$",Every = .true.) aStr = Replace(aStr,"[$$]","$",Every = .true.) + name_loc=aStr CALL LowCase(TRIM(CHAR(aStr)),opt%namelowercase) opt%ind = INDEX(TRIM(opt%namelowercase),"$") IF(opt%ind.LE.0)THEN CALL abort(__STAMP__& ,'[numberedmulti] parameter does not contain "$" symbol, which is required for these kinds of variables for ['//TRIM(name)//']') END IF ! opt%ind.LE.0 +ELSE + name_loc=name END IF ! opt%numberedmulti -opt%name = name +opt%name = TRIM(name_loc) opt%isSet = .FALSE. opt%description = description opt%section = this%actualSection @@ -1205,6 +1225,9 @@ END FUNCTION CountOption !================================================================================================================================== SUBROUTINE GetGeneralOption(value, name, proposal) USE MOD_Options +#if USE_LOADBALANCE +USE MOD_LoadBalance_Vars ,ONLY: PerformLoadBalance +#endif /*USE_LOADBALANCE*/ !---------------------------------------------------------------------------------------------------------------------------------- ! INPUT / OUTPUT VARIABLES CHARACTER(LEN=*),INTENT(IN) :: name !< parameter name @@ -1230,7 +1253,61 @@ SUBROUTINE GetGeneralOption(value, name, proposal) CLASS(StringOption) ,ALLOCATABLE,TARGET :: stringopt !================================================================================================================================== !================================================================================================================================== - +IF (PerformLoadBalance) THEN + current => prms%firstLink + DO WHILE (associated(current)) + opt => current%opt + SELECT TYPE (opt) + CLASS IS (IntOption) + SELECT TYPE(value) + TYPE IS (INTEGER) + value = opt%value + WRITE(tmpValue, *) opt%value + END SELECT + CLASS IS (RealOption) + SELECT TYPE(value) + TYPE IS (REAL) + value = opt%value + WRITE(tmpValue, *) opt%value + END SELECT + CLASS IS (LogicalOption) + SELECT TYPE(value) + TYPE IS (LOGICAL) + value = opt%value + WRITE(tmpValue, *) opt%value + END SELECT + CLASS IS (StringOption) + SELECT TYPE(value) + TYPE IS (STR255) + ! If the string contains a comma, strip it and provide the first part of this string. This might occur when directly running a regressioncheck file + ind = INDEX(opt%value,",") + IF (ind.GT.0) THEN + opt%value = opt%value(1:ind-1) + ! Print option and value to stdout. Custom print, so do it here + WRITE(fmtName,*) prms%maxNameLen + SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " + CALL set_formatting("blue") + SWRITE(UNIT_stdOut,"(A"//fmtName//")", ADVANCE='NO') TRIM(name) + CALL clear_formatting() + SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " + CALL opt%printValue(prms%maxValueLen) + SWRITE(UNIT_stdOut,"(A3)", ADVANCE='NO') ' | ' + CALL set_formatting("cyan") + SWRITE(UNIT_stdOut,'(A7)', ADVANCE='NO') "*SPLIT" + CALL clear_formatting() + SWRITE(UNIT_stdOut,"(A3)") ' | ' + ! Set mode to indicate print already occured + mode = 1 + END IF + value%chars = opt%value + END SELECT + END SELECT + SWRITE(*,*) TRIM(current%opt%name), " " ,tmpValue + current => current%next + END DO + SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" + ! READ(*,*) +END IF ! iterate over all options current => prms%firstLink DO WHILE (associated(current)) @@ -2444,14 +2521,14 @@ SUBROUTINE PrintOption(NameOpt,InfoOpt,IntOpt,IntArrayOpt,RealOpt,LogOpt,LogArra IF(.NOT.MPIRoot)RETURN ! Return if running loadbalance and printing static information -#if USE_LOADBALANCE -IF (PerformLoadBalance) THEN - SELECT CASE(TRIM(InfoOpt)) - CASE("INFO","PARAM","CALCUL.","OUTPUT","HDF5") - RETURN - END SELECT -END IF -#endif /*USE_LOADBALANCE*/ +! #if USE_LOADBALANCE +! IF (PerformLoadBalance) THEN +! SELECT CASE(TRIM(InfoOpt)) +! CASE("INFO","PARAM","CALCUL.","OUTPUT","HDF5") +! RETURN +! END SELECT +! END IF +! #endif /*USE_LOADBALANCE*/ ! set length of name WRITE(fmtName,*) prms%maxNameLen From e2bc5eedc336d7929b3b43c25e514570408768b6 Mon Sep 17 00:00:00 2001 From: Raphael Tietz Date: Tue, 28 May 2024 17:33:56 +0200 Subject: [PATCH 12/14] Added createfrommulti parameter in CreateGeneralOption --- .../emission/particle_surface_flux_init.f90 | 1 - src/readintools/options.f90 | 6 +- src/readintools/readintools.f90 | 225 +++++++++++------- 3 files changed, 147 insertions(+), 85 deletions(-) diff --git a/src/particles/emission/particle_surface_flux_init.f90 b/src/particles/emission/particle_surface_flux_init.f90 index 60c2dfda6..0ae442262 100644 --- a/src/particles/emission/particle_surface_flux_init.f90 +++ b/src/particles/emission/particle_surface_flux_init.f90 @@ -479,7 +479,6 @@ SUBROUTINE ReadInAndPrepareSurfaceFlux(MaxSurfacefluxBCs, nDataBC) SF%origin = GETREALARRAY('Part-Species'//TRIM(hilf2)//'-origin',2) WRITE(UNIT=hilf3,FMT='(E16.8)') HUGE(SF%rmax) SF%rmax = GETREAL('Part-Species'//TRIM(hilf2)//'-rmax',TRIM(hilf3)) - SWRITE(*,*) "!!!!!!!!!!!!!!!!!!!!!!!!! SF%rmax",SF%rmax SF%rmin = GETREAL('Part-Species'//TRIM(hilf2)//'-rmin') ! Total area of surface flux SF%totalAreaSF = Pi*(SF%rmax*SF%rmax - SF%rmin*SF%rmin) diff --git a/src/readintools/options.f90 b/src/readintools/options.f90 index fc12d7646..e4425d009 100644 --- a/src/readintools/options.f90 +++ b/src/readintools/options.f90 @@ -362,9 +362,9 @@ SUBROUTINE print(this, maxNameLen, maxValueLen, mode) INTEGER :: length INTEGER :: commentLen !================================================================================================================================== -! #if USE_LOADBALANCE -! IF(PerformLoadBalance) RETURN -! #endif /*USE_LOADBALANCE*/ +#if USE_LOADBALANCE +IF(PerformLoadBalance) RETURN +#endif /*USE_LOADBALANCE*/ IF(mode.EQ.1) commentLen=80 !--help IF(mode.EQ.2) commentLen=50 !--markdown WRITE(fmtName,*) maxNameLen diff --git a/src/readintools/readintools.f90 b/src/readintools/readintools.f90 index 38ce59a5d..e61692f42 100644 --- a/src/readintools/readintools.f90 +++ b/src/readintools/readintools.f90 @@ -349,7 +349,7 @@ END SUBROUTINE removeUnnecessary !> types of options. !> before creating check if option is already existing !================================================================================================================================== -SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedmulti, removed) +SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedmulti, removed, createfrommulti) ! INPUT/OUTPUT VARIABLES CLASS(Parameters),INTENT(INOUT) :: this !< CLASS(Parameters) CLASS(OPTION),INTENT(INOUT) :: opt !< option class @@ -359,6 +359,7 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm LOGICAL,INTENT(IN),OPTIONAL :: multiple !< marker if multiple option LOGICAL,INTENT(IN),OPTIONAL :: numberedmulti !< marker if numbered multiple option LOGICAL,INTENT(IN),OPTIONAL :: removed !< marker if removed option +LOGICAL,INTENT(IN),OPTIONAL :: createfrommulti !< marker if spacialize an generalized option CHARACTER(LEN=255) :: name_loc !< option name @@ -366,6 +367,7 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm ! LOCAL VARIABLES CLASS(link), POINTER :: newLink TYPE(Varying_String) :: aStr +LOGICAL :: loc_Specialized !================================================================================================================================== !IF(this%check_options(name)) THEN ! CALL Abort(__STAMP__, & @@ -380,7 +382,7 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm ! ! END IF ! SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" -SWRITE(*,*) "CreateOption Name: ", name +! SWRITE(*,*) "CreateOption Name: ", name ! IF(SCAN(name,"[]").NE.0) THEN ! DO WHILE(SCAN(name,"[]").NE.0) ! END DO @@ -389,6 +391,11 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm IF (opt%hasDefault) THEN CALL opt%parse(value) END IF +IF(PRESENT(createfrommulti)) THEN + loc_Specialized = createfrommulti +ELSE + loc_Specialized = .FALSE. +END IF opt%multiple = .FALSE. IF (PRESENT(multiple)) opt%multiple = multiple @@ -418,7 +425,11 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm END IF ! opt%numberedmulti opt%name = TRIM(name_loc) -opt%isSet = .FALSE. +IF(loc_Specialized .AND. opt%hasDefault) THEN + opt%isSet=.TRUE. +ELSE + opt%isSet = .FALSE. +END IF opt%description = description opt%section = this%actualSection opt%isRemoved = .FALSE. @@ -1253,65 +1264,69 @@ SUBROUTINE GetGeneralOption(value, name, proposal) CLASS(StringOption) ,ALLOCATABLE,TARGET :: stringopt !================================================================================================================================== !================================================================================================================================== -IF (PerformLoadBalance) THEN - current => prms%firstLink - DO WHILE (associated(current)) - opt => current%opt - SELECT TYPE (opt) - CLASS IS (IntOption) - SELECT TYPE(value) - TYPE IS (INTEGER) - value = opt%value - WRITE(tmpValue, *) opt%value - END SELECT - CLASS IS (RealOption) - SELECT TYPE(value) - TYPE IS (REAL) - value = opt%value - WRITE(tmpValue, *) opt%value - END SELECT - CLASS IS (LogicalOption) - SELECT TYPE(value) - TYPE IS (LOGICAL) - value = opt%value - WRITE(tmpValue, *) opt%value - END SELECT - CLASS IS (StringOption) - SELECT TYPE(value) - TYPE IS (STR255) - ! If the string contains a comma, strip it and provide the first part of this string. This might occur when directly running a regressioncheck file - ind = INDEX(opt%value,",") - IF (ind.GT.0) THEN - opt%value = opt%value(1:ind-1) - ! Print option and value to stdout. Custom print, so do it here - WRITE(fmtName,*) prms%maxNameLen - SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " - CALL set_formatting("blue") - SWRITE(UNIT_stdOut,"(A"//fmtName//")", ADVANCE='NO') TRIM(name) - CALL clear_formatting() - SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " - CALL opt%printValue(prms%maxValueLen) - SWRITE(UNIT_stdOut,"(A3)", ADVANCE='NO') ' | ' - CALL set_formatting("cyan") - SWRITE(UNIT_stdOut,'(A7)', ADVANCE='NO') "*SPLIT" - CALL clear_formatting() - SWRITE(UNIT_stdOut,"(A3)") ' | ' - ! Set mode to indicate print already occured - mode = 1 - END IF - value%chars = opt%value - END SELECT - END SELECT - SWRITE(*,*) TRIM(current%opt%name), " " ,tmpValue - current => current%next - END DO - SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" - ! READ(*,*) -END IF +! IF (PerformLoadBalance) THEN +! current => prms%firstLink +! DO WHILE (associated(current)) +! opt => current%opt +! SELECT TYPE (opt) +! CLASS IS (IntOption) +! SELECT TYPE(value) +! TYPE IS (INTEGER) +! value = opt%value +! WRITE(tmpValue, *) opt%value +! ! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,opt%value +! END SELECT +! CLASS IS (RealOption) +! SELECT TYPE(value) +! TYPE IS (REAL) +! value = opt%value +! WRITE(tmpValue, *) opt%value +! ! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,opt%value +! END SELECT +! CLASS IS (LogicalOption) +! SELECT TYPE(value) +! TYPE IS (LOGICAL) +! value = opt%value +! WRITE(tmpValue, *) opt%value +! ! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,opt%value +! END SELECT +! CLASS IS (StringOption) +! SELECT TYPE(value) +! TYPE IS (STR255) +! ! If the string contains a comma, strip it and provide the first part of this string. This might occur when directly running a regressioncheck file +! ind = INDEX(opt%value,",") +! IF (ind.GT.0) THEN +! opt%value = opt%value(1:ind-1) +! ! Print option and value to stdout. Custom print, so do it here +! WRITE(fmtName,*) prms%maxNameLen +! SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " +! CALL set_formatting("blue") +! SWRITE(UNIT_stdOut,"(A"//fmtName//")", ADVANCE='NO') TRIM(name) +! CALL clear_formatting() +! SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " +! CALL opt%printValue(prms%maxValueLen) +! SWRITE(UNIT_stdOut,"(A3)", ADVANCE='NO') ' | ' +! CALL set_formatting("cyan") +! SWRITE(UNIT_stdOut,'(A7)', ADVANCE='NO') "*SPLIT" +! CALL clear_formatting() +! SWRITE(UNIT_stdOut,"(A3)") ' | ' +! ! Set mode to indicate print already occured +! mode = 1 +! END IF +! value%chars = opt%value +! END SELECT +! END SELECT +! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,TRIM(tmpValue) +! current => current%next +! END DO +! SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" +! READ(*,*) +! END IF ! iterate over all options current => prms%firstLink DO WHILE (associated(current)) ! if name matches option + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) name," ",TRIM(current%opt%name),current%opt%isSet IF (.NOT.current%opt%isRemoved) THEN IF (current%opt%NAMEEQUALS(name)) THEN opt => current%opt @@ -1374,6 +1389,7 @@ SUBROUTINE GetGeneralOption(value, name, proposal) IF (mode.EQ.0) CALL opt%print(prms%maxNameLen, prms%maxValueLen, mode=0) ! remove the option from the linked list of all parameters IF(prms%removeAfterRead) current%opt%isRemoved = .TRUE. + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot .AND. PerformLoadBalance) EXIT RETURN END IF END IF @@ -1383,6 +1399,7 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! iterate over all options and compare reduced (all numbers removed) names with numberedmulti options current => prms%firstLink DO WHILE (associated(current)) + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) name," ",TRIM(current%opt%name),current%opt%numberedmulti,current%opt%isSet IF (.NOT.current%opt%numberedmulti) THEN current => current%next ELSE @@ -1444,7 +1461,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(intopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + intopt%isSet=.TRUE. END SELECT CLASS IS (RealOption) SELECT TYPE(value) @@ -1453,7 +1471,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(realopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalOption) SELECT TYPE(value) @@ -1462,7 +1481,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(logicalopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + logicalopt%isSet=.TRUE. END SELECT CLASS IS (StringOption) SELECT TYPE(value) @@ -1471,7 +1491,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(stringopt) WRITE(tmpValue,'(A)') multi%value - CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + stringopt%isSet=.TRUE. END SELECT END SELECT @@ -1490,6 +1511,15 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,"(a3)") ' | ' ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used multi%isUsedMulti = .TRUE. + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(check%opt%name),check%opt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) THEN + ! check => prms%firstLink + ! DO WHILE (associated(check)) + ! WRITE(*,*) "BB",name," ",TRIM(check%opt%name),check%opt%isSet + ! check => check%next + ! END DO + ! END IF RETURN END IF check => check%next @@ -1535,7 +1565,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(intopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + intopt%isSet=.TRUE. END SELECT CLASS IS (RealOption) SELECT TYPE(value) @@ -1544,7 +1575,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(realopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalOption) SELECT TYPE(value) @@ -1553,7 +1585,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(logicalopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + logicalopt%isSet=.TRUE. END SELECT CLASS IS (StringOption) SELECT TYPE(value) @@ -1562,7 +1595,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(stringopt) WRITE(tmpValue,'(A)') multi%value - CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + stringopt%isSet=.TRUE. END SELECT END SELECT @@ -1581,6 +1615,15 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,"(a3)") ' | ' ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used multi%isUsedMulti = .TRUE. + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(check%opt%name),check%opt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) THEN + ! check => prms%firstLink + ! DO WHILE (associated(check)) + ! WRITE(*,*) "BB",name," ",TRIM(check%opt%name),check%opt%isSet + ! check => check%next + ! END DO + ! END IF RETURN END IF check => check%next @@ -1615,7 +1658,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(intopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + intopt%isSet=.TRUE. END SELECT CLASS IS (RealOption) SELECT TYPE(value) @@ -1624,7 +1668,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(realopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalOption) SELECT TYPE(value) @@ -1633,7 +1678,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(logicalopt) WRITE(tmpValue, *) multi%value - CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + logicalopt%isSet=.TRUE. END SELECT CLASS IS (StringOption) SELECT TYPE(value) @@ -1642,7 +1688,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! insert option with numbered name ($ replaced by number) ALLOCATE(stringopt) WRITE(tmpValue,'(A)') multi%value - CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + stringopt%isSet=.TRUE. END SELECT END SELECT @@ -1661,6 +1708,15 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,"(a3)") ' | ' ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used multi%isUsedMulti = .TRUE. + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(check%opt%name),check%opt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) THEN + ! check => prms%firstLink + ! DO WHILE (associated(check)) + ! WRITE(*,*) "BB",name," ",TRIM(check%opt%name),check%opt%isSet + ! check => check%next + ! END DO + ! END IF RETURN END IF check => check%next @@ -1668,6 +1724,7 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! create new instance of multiple option ALLOCATE(newopt, source=current%opt) + ! SWRITE(*,*) "create new instance of multiple option ",TRIM(current%opt%name) ! set name of new option like name in read line and set it being not multiple numbered newopt%name = name newopt%numberedmulti = .FALSE. @@ -1676,6 +1733,7 @@ SUBROUTINE GetGeneralOption(value, name, proposal) IF ((PRESENT(proposal)).AND.(.NOT. newopt%isSet)) THEN proposal_loc = TRIM(proposal) CALL newopt%parse(proposal_loc) + newopt%isSet=.TRUE. ELSE ! no proposal, no default and also not set in parameter file => abort IF ((.NOT.newopt%hasDefault).AND.(.NOT.newopt%isSet)) THEN @@ -1713,6 +1771,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) IF(prms%removeAfterRead) newopt%isRemoved = .TRUE. ! insert option CALL insertOption(current, newopt) + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(current%opt%name),current%opt%isSet + ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet RETURN END IF current => current%next @@ -1851,7 +1911,8 @@ SUBROUTINE GetGeneralArrayOption(value, name, no, proposal) WRITE(tmpValue,'(*(I0))') (multi%value(j), ",",j=1,no) ! remove trailing comma tmpValue(len(TRIM(tmpValue)):len(TRIM(tmpValue))) = ' ' - CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + intopt%isSet=.TRUE. END SELECT CLASS IS (RealArrayOption) IF (SIZE(multi%value).NE.no) CALL Abort(__STAMP__,"Array size of option '"//TRIM(name)//"' is not correct!") @@ -1863,7 +1924,8 @@ SUBROUTINE GetGeneralArrayOption(value, name, no, proposal) WRITE(tmpValue,'(*(G0))') (multi%value(j), ",",j=1,no) ! remove trailing comma tmpValue(len(TRIM(tmpValue)):len(TRIM(tmpValue))) = ' ' - CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalArrayOption) IF (SIZE(multi%value).NE.no) CALL Abort(__STAMP__,"Array size of option '"//TRIM(name)//"' is not correct!") @@ -1875,7 +1937,8 @@ SUBROUTINE GetGeneralArrayOption(value, name, no, proposal) ! remove trailing comma tmpValue(len(TRIM(tmpValue)):len(TRIM(tmpValue))) = ' ' WRITE(tmpValue,'(*(L1))') (multi%value(j), ",",j=1,no) - CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.) + CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) + logicalopt%isSet=.TRUE. END SELECT END SELECT ! print option and value to stdout. Custom print, so do it here @@ -2521,14 +2584,14 @@ SUBROUTINE PrintOption(NameOpt,InfoOpt,IntOpt,IntArrayOpt,RealOpt,LogOpt,LogArra IF(.NOT.MPIRoot)RETURN ! Return if running loadbalance and printing static information -! #if USE_LOADBALANCE -! IF (PerformLoadBalance) THEN -! SELECT CASE(TRIM(InfoOpt)) -! CASE("INFO","PARAM","CALCUL.","OUTPUT","HDF5") -! RETURN -! END SELECT -! END IF -! #endif /*USE_LOADBALANCE*/ +#if USE_LOADBALANCE +IF (PerformLoadBalance) THEN + SELECT CASE(TRIM(InfoOpt)) + CASE("INFO","PARAM","CALCUL.","OUTPUT","HDF5") + RETURN + END SELECT +END IF +#endif /*USE_LOADBALANCE*/ ! set length of name WRITE(fmtName,*) prms%maxNameLen From 3d52270890c716020a453f8c4d3fa89eb9e88b4b Mon Sep 17 00:00:00 2001 From: Raphael Tietz Date: Tue, 28 May 2024 17:40:47 +0200 Subject: [PATCH 13/14] Removed Debug Messages --- src/readintools/readintools.f90 | 118 +------------------------------- 1 file changed, 1 insertion(+), 117 deletions(-) diff --git a/src/readintools/readintools.f90 b/src/readintools/readintools.f90 index e61692f42..492ab84d5 100644 --- a/src/readintools/readintools.f90 +++ b/src/readintools/readintools.f90 @@ -362,31 +362,11 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm LOGICAL,INTENT(IN),OPTIONAL :: createfrommulti !< marker if spacialize an generalized option -CHARACTER(LEN=255) :: name_loc !< option name -CLASS(link),POINTER :: current ! LOCAL VARIABLES CLASS(link), POINTER :: newLink TYPE(Varying_String) :: aStr LOGICAL :: loc_Specialized !================================================================================================================================== -!IF(this%check_options(name)) THEN -! CALL Abort(__STAMP__, & -! 'Option "'//TRIM(name)//'" is already defined, can not be defined with the same name twice!') -!END IF - -! current => prms%firstLink -! DO WHILE (associated(current)) -! SWRITE(*,*) TRIM(current%opt%name)!," ", valuestr -! current => current%next -! END DO -! ! END IF -! SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" - -! SWRITE(*,*) "CreateOption Name: ", name -! IF(SCAN(name,"[]").NE.0) THEN -! DO WHILE(SCAN(name,"[]").NE.0) -! END DO -! END IF opt%hasDefault = PRESENT(value) IF (opt%hasDefault) THEN CALL opt%parse(value) @@ -413,18 +393,15 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm aStr = Replace(aStr,"[]" ,"$",Every = .true.) aStr = Replace(aStr,"[$]" ,"$",Every = .true.) aStr = Replace(aStr,"[$$]","$",Every = .true.) - name_loc=aStr CALL LowCase(TRIM(CHAR(aStr)),opt%namelowercase) opt%ind = INDEX(TRIM(opt%namelowercase),"$") IF(opt%ind.LE.0)THEN CALL abort(__STAMP__& ,'[numberedmulti] parameter does not contain "$" symbol, which is required for these kinds of variables for ['//TRIM(name)//']') END IF ! opt%ind.LE.0 -ELSE - name_loc=name END IF ! opt%numberedmulti -opt%name = TRIM(name_loc) +opt%name = name IF(loc_Specialized .AND. opt%hasDefault) THEN opt%isSet=.TRUE. ELSE @@ -1236,9 +1213,6 @@ END FUNCTION CountOption !================================================================================================================================== SUBROUTINE GetGeneralOption(value, name, proposal) USE MOD_Options -#if USE_LOADBALANCE -USE MOD_LoadBalance_Vars ,ONLY: PerformLoadBalance -#endif /*USE_LOADBALANCE*/ !---------------------------------------------------------------------------------------------------------------------------------- ! INPUT / OUTPUT VARIABLES CHARACTER(LEN=*),INTENT(IN) :: name !< parameter name @@ -1264,64 +1238,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) CLASS(StringOption) ,ALLOCATABLE,TARGET :: stringopt !================================================================================================================================== !================================================================================================================================== -! IF (PerformLoadBalance) THEN -! current => prms%firstLink -! DO WHILE (associated(current)) -! opt => current%opt -! SELECT TYPE (opt) -! CLASS IS (IntOption) -! SELECT TYPE(value) -! TYPE IS (INTEGER) -! value = opt%value -! WRITE(tmpValue, *) opt%value -! ! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,opt%value -! END SELECT -! CLASS IS (RealOption) -! SELECT TYPE(value) -! TYPE IS (REAL) -! value = opt%value -! WRITE(tmpValue, *) opt%value -! ! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,opt%value -! END SELECT -! CLASS IS (LogicalOption) -! SELECT TYPE(value) -! TYPE IS (LOGICAL) -! value = opt%value -! WRITE(tmpValue, *) opt%value -! ! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,opt%value -! END SELECT -! CLASS IS (StringOption) -! SELECT TYPE(value) -! TYPE IS (STR255) -! ! If the string contains a comma, strip it and provide the first part of this string. This might occur when directly running a regressioncheck file -! ind = INDEX(opt%value,",") -! IF (ind.GT.0) THEN -! opt%value = opt%value(1:ind-1) -! ! Print option and value to stdout. Custom print, so do it here -! WRITE(fmtName,*) prms%maxNameLen -! SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " -! CALL set_formatting("blue") -! SWRITE(UNIT_stdOut,"(A"//fmtName//")", ADVANCE='NO') TRIM(name) -! CALL clear_formatting() -! SWRITE(UNIT_stdOut,'(A3)', ADVANCE='NO') " | " -! CALL opt%printValue(prms%maxValueLen) -! SWRITE(UNIT_stdOut,"(A3)", ADVANCE='NO') ' | ' -! CALL set_formatting("cyan") -! SWRITE(UNIT_stdOut,'(A7)', ADVANCE='NO') "*SPLIT" -! CALL clear_formatting() -! SWRITE(UNIT_stdOut,"(A3)") ' | ' -! ! Set mode to indicate print already occured -! mode = 1 -! END IF -! value%chars = opt%value -! END SELECT -! END SELECT -! SWRITE(*,*) TRIM(current%opt%name)," ",current%opt%isSet, " " ,TRIM(tmpValue) -! current => current%next -! END DO -! SWRITE(*,*) "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@q" -! READ(*,*) -! END IF ! iterate over all options current => prms%firstLink DO WHILE (associated(current)) @@ -1389,7 +1305,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) IF (mode.EQ.0) CALL opt%print(prms%maxNameLen, prms%maxValueLen, mode=0) ! remove the option from the linked list of all parameters IF(prms%removeAfterRead) current%opt%isRemoved = .TRUE. - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot .AND. PerformLoadBalance) EXIT RETURN END IF END IF @@ -1399,7 +1314,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! iterate over all options and compare reduced (all numbers removed) names with numberedmulti options current => prms%firstLink DO WHILE (associated(current)) - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) name," ",TRIM(current%opt%name),current%opt%numberedmulti,current%opt%isSet IF (.NOT.current%opt%numberedmulti) THEN current => current%next ELSE @@ -1511,15 +1425,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,"(a3)") ' | ' ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used multi%isUsedMulti = .TRUE. - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(check%opt%name),check%opt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) THEN - ! check => prms%firstLink - ! DO WHILE (associated(check)) - ! WRITE(*,*) "BB",name," ",TRIM(check%opt%name),check%opt%isSet - ! check => check%next - ! END DO - ! END IF RETURN END IF check => check%next @@ -1615,15 +1520,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,"(a3)") ' | ' ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used multi%isUsedMulti = .TRUE. - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(check%opt%name),check%opt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) THEN - ! check => prms%firstLink - ! DO WHILE (associated(check)) - ! WRITE(*,*) "BB",name," ",TRIM(check%opt%name),check%opt%isSet - ! check => check%next - ! END DO - ! END IF RETURN END IF check => check%next @@ -1708,15 +1604,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,"(a3)") ' | ' ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used multi%isUsedMulti = .TRUE. - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(check%opt%name),check%opt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) THEN - ! check => prms%firstLink - ! DO WHILE (associated(check)) - ! WRITE(*,*) "BB",name," ",TRIM(check%opt%name),check%opt%isSet - ! check => check%next - ! END DO - ! END IF RETURN END IF check => check%next @@ -1724,7 +1611,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! create new instance of multiple option ALLOCATE(newopt, source=current%opt) - ! SWRITE(*,*) "create new instance of multiple option ",TRIM(current%opt%name) ! set name of new option like name in read line and set it being not multiple numbered newopt%name = name newopt%numberedmulti = .FALSE. @@ -1771,8 +1657,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) IF(prms%removeAfterRead) newopt%isRemoved = .TRUE. ! insert option CALL insertOption(current, newopt) - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(current%opt%name),current%opt%isSet - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) "AA",name," ",TRIM(realopt%name),realopt%isSet RETURN END IF current => current%next From 81ccb45ce56f402a4194768f6c3652fb5170f9da Mon Sep 17 00:00:00 2001 From: Paul Nizenkov Date: Wed, 29 May 2024 00:44:32 +0200 Subject: [PATCH 14/14] UnitTest ReadInTools: added abort for unused variables, testing different combinations of default values for $ variables --- src/particles/particle_operations.f90 | 16 +----- src/readintools/readintools.f90 | 79 ++++++++++++--------------- unitTests/ReadInTools.f90 | 56 ++++++++++++++++--- unitTests/ReadInTools.ini | 30 +++++++++- 4 files changed, 110 insertions(+), 71 deletions(-) diff --git a/src/particles/particle_operations.f90 b/src/particles/particle_operations.f90 index 868f01312..a0a681a0c 100644 --- a/src/particles/particle_operations.f90 +++ b/src/particles/particle_operations.f90 @@ -159,8 +159,7 @@ SUBROUTINE RemoveParticle(PartID,BCID,alpha,crossedBC) USE MOD_HDG_Vars ,ONLY: UseFPC,FPC,UseEPC,EPC USE MOD_Mesh_Vars ,ONLY: BoundaryType #endif /*USE_HDG*/ -USE MOD_Particle_Vars ,ONLY: PartState, LastPartPos -!USE MOD_Particle_Mesh_Vars ,ONLY: GEO +USE MOD_Particle_Vars ,ONLY: PartState !----------------------------------------------------------------------------------------------------------------------------------! IMPLICIT NONE ! INPUT / OUTPUT VARIABLES @@ -300,19 +299,6 @@ SUBROUTINE RemoveParticle(PartID,BCID,alpha,crossedBC) END IF ! BCType.EQ.8 END IF ! UseEPC #endif /*USE_HDG*/ - - ! ! Debugging: Move particles that impact the left BC to a specific location - ! IF(TRIM(BoundaryName(PartBound%MapToFieldBC(BCID))).EQ.'BC_LEFT')THEN - ! PartSpecies(PartID) = 3 - ! PDM%ParticleInside(PartID) = .TRUE. - ! PartState(1,PartID) = -9e-9 - ! LastPartPos(1,PartID) = PartState(1,PartID) - ! CALL RANDOM_NUMBER(RandVal) - ! PartState(2,PartID) = RandVal(1)*(GEO%zmaxglob-GEO%zminglob) + GEO%zminglob - ! PartState(3,PartID) = RandVal(2)*(GEO%ymaxglob-GEO%yminglob) + GEO%yminglob - ! LastPartPos(2:3,PartID) = PartState(2:3,PartID) - ! PartState(4:6,PartID) = (/0., 0., 0./) - ! END IF ! TRIM(BoundaryName(PartBound%MapToFieldBC(BCID))).EQ.'BC_LEFT' END IF ! PRESENT(BCID) ! Tracking-relevant variables (not required if a particle is removed within the domain, e.g. removal due to radial weighting) diff --git a/src/readintools/readintools.f90 b/src/readintools/readintools.f90 index 492ab84d5..95c26d1c1 100644 --- a/src/readintools/readintools.f90 +++ b/src/readintools/readintools.f90 @@ -31,7 +31,7 @@ !> Now all the options are filled with the data from the parameter file and can be accessed via the functions GETINT(ARRAY), !> GETREAL(ARRAY), ... !> A call of these functions then removes the specific option from the linked list, such that -!> every option can only be read once. This is necessary for options with the same name, that occure multiple times in the parameter +!> every option can only be read once. This is necessary for options with the same name, that occur multiple times in the parameter !> file. !================================================================================================================================== MODULE MOD_ReadInTools @@ -64,22 +64,22 @@ MODULE MOD_ReadInTools CHARACTER(LEN=255) :: actualSection = "" !< actual section, to set section of an option, when inserted into list LOGICAL :: removeAfterRead=.TRUE. !< specifies whether options shall be marked as removed after being read CONTAINS - PROCEDURE :: WriteUnused !< routine that writes out parameters taht were set but not used + PROCEDURE :: WriteUnused !< routine that writes out parameters that were set but not used PROCEDURE :: SetSection !< routine to set 'actualSection' PROCEDURE :: CreateOption !< general routine to create a option and insert it into the linked list !< also checks if option is already created in the linked list PROCEDURE :: CreateIntOption !< routine to generate an integer option PROCEDURE :: CreateIntFromStringOption !< routine to generate an integer option with a optional string representation - PROCEDURE :: CreateLogicalOption !< routine to generate an logical option - PROCEDURE :: CreateRealOption !< routine to generate an real option - PROCEDURE :: CreateStringOption !< routine to generate an string option + PROCEDURE :: CreateLogicalOption !< routine to generate a logical option + PROCEDURE :: CreateRealOption !< routine to generate a real option + PROCEDURE :: CreateStringOption !< routine to generate a string option PROCEDURE :: CreateIntArrayOption !< routine to generate an integer array option - PROCEDURE :: CreateLogicalArrayOption !< routine to generate an logical array option - PROCEDURE :: CreateRealArrayOption !< routine to generate an real array option - !PROCEDURE :: CreateStringArrayOption !< routine to generate an string array option + PROCEDURE :: CreateLogicalArrayOption !< routine to generate a logical array option + PROCEDURE :: CreateRealArrayOption !< routine to generate a real array option + !PROCEDURE :: CreateStringArrayOption !< routine to generate a string array option PROCEDURE :: CountOption_ !< function to count the number of options of a given name PROCEDURE :: read_options !< routine that loops over the lines of a parameter files - !< and calls read_option for every option. Outputs all unknow options + !< and calls read_option for every option. Outputs all unknown options PROCEDURE :: read_option !< routine that parses a single line from the parameter file. PROCEDURE :: check_options !< routine that parses a given name and returns flag if found in linkes list. PROCEDURE :: finalize !< routine that resets the parameters either for loadbalance, restart or end @@ -359,22 +359,21 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm LOGICAL,INTENT(IN),OPTIONAL :: multiple !< marker if multiple option LOGICAL,INTENT(IN),OPTIONAL :: numberedmulti !< marker if numbered multiple option LOGICAL,INTENT(IN),OPTIONAL :: removed !< marker if removed option -LOGICAL,INTENT(IN),OPTIONAL :: createfrommulti !< marker if spacialize an generalized option - - +LOGICAL,INTENT(IN),OPTIONAL :: createfrommulti !< marker if option is created from $ input variable ! LOCAL VARIABLES CLASS(link), POINTER :: newLink TYPE(Varying_String) :: aStr -LOGICAL :: loc_Specialized +LOGICAL :: loc_createfrommulti !================================================================================================================================== opt%hasDefault = PRESENT(value) IF (opt%hasDefault) THEN CALL opt%parse(value) END IF +! Flag to identify options that are added due to Part-Int$ variables IF(PRESENT(createfrommulti)) THEN - loc_Specialized = createfrommulti + loc_createfrommulti = createfrommulti ELSE - loc_Specialized = .FALSE. + loc_createfrommulti = .FALSE. END IF opt%multiple = .FALSE. @@ -402,10 +401,12 @@ SUBROUTINE CreateOption(this, opt, name, description, value, multiple, numberedm END IF ! opt%numberedmulti opt%name = name -IF(loc_Specialized .AND. opt%hasDefault) THEN - opt%isSet=.TRUE. +! Flag has to be set here for variables created from a $ variable as these have not been read-in with read_option and otherwise will +! be skipped during a load balance +IF(loc_createfrommulti .AND. opt%hasDefault) THEN + opt%isSet = .TRUE. ELSE - opt%isSet = .FALSE. + opt%isSet = .FALSE. END IF opt%description = description opt%section = this%actualSection @@ -645,7 +646,7 @@ FUNCTION CountOption_(this, name) result(count) ! INPUT/OUTPUT VARIABLES CLASS(Parameters),INTENT(INOUT) :: this !< CLASS(Parameters) CHARACTER(LEN=*),INTENT(IN) :: name !< Search for this keyword in ini file -INTEGER :: count !< number of found occurences of keyword +INTEGER :: count !< number of found occurrences of keyword !---------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES CLASS(link),POINTER :: current @@ -670,7 +671,7 @@ FUNCTION count_setentries(this) result(count) !---------------------------------------------------------------------------------------------------------------------------------- ! INPUT/OUTPUT VARIABLES CLASS(Parameters),INTENT(IN) :: this !< CLASS(Parameters) -INTEGER :: count !< number of found occurences of keyword +INTEGER :: count !< number of found occurrences of keyword !---------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES CLASS(link),POINTER :: current @@ -693,7 +694,7 @@ FUNCTION count_entries(this) result(count) !---------------------------------------------------------------------------------------------------------------------------------- ! INPUT/OUTPUT VARIABLES CLASS(Parameters),INTENT(IN) :: this !< CLASS(Parameters) -INTEGER :: count !< number of found occurences of keyword +INTEGER :: count !< number of found occurrences of keyword !---------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES CLASS(link),POINTER :: current @@ -716,7 +717,7 @@ FUNCTION count_unread(this) result(count) !---------------------------------------------------------------------------------------------------------------------------------- ! INPUT/OUTPUT VARIABLES CLASS(Parameters),INTENT(IN) :: this !< CLASS(Parameters) -INTEGER :: count !< number of found occurences of keyword +INTEGER :: count !< number of found occurrences of keyword !---------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES CLASS(link),POINTER :: current @@ -1242,7 +1243,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) current => prms%firstLink DO WHILE (associated(current)) ! if name matches option - ! IF (name=="Part-Species2-Surfaceflux1-rmax" .AND. MPIRoot) WRITE(*,*) name," ",TRIM(current%opt%name),current%opt%isSet IF (.NOT.current%opt%isRemoved) THEN IF (current%opt%NAMEEQUALS(name)) THEN opt => current%opt @@ -1295,7 +1295,7 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,'(A7)', ADVANCE='NO') "*SPLIT" CALL clear_formatting() SWRITE(UNIT_stdOut,"(A3)") ' | ' - ! Set mode to indicate print already occured + ! Set mode to indicate print already occurred mode = 1 END IF value%chars = opt%value @@ -1322,10 +1322,9 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ! Check if we can find a general option, applying to all numberedmulti SDEALLOCATE(testname) ! safety check ALLOCATE(CHARACTER(LEN_TRIM(name)) :: testname) - ! Testname must not be trimmed! Otherwise, the INDEX test will fail as testname < name - ! Check how many indexes are present numberOfIndexes = 0 + ! Testname must not be trimmed! Otherwise, the INDEX test will fail as testname < name testname = name DO i = 1, LEN(name) ! Start replacing the index from the left @@ -1376,7 +1375,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(intopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - intopt%isSet=.TRUE. END SELECT CLASS IS (RealOption) SELECT TYPE(value) @@ -1386,7 +1384,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(realopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalOption) SELECT TYPE(value) @@ -1396,7 +1393,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(logicalopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - logicalopt%isSet=.TRUE. END SELECT CLASS IS (StringOption) SELECT TYPE(value) @@ -1406,7 +1402,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(stringopt) WRITE(tmpValue,'(A)') multi%value CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - stringopt%isSet=.TRUE. END SELECT END SELECT @@ -1423,7 +1418,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,'(a7)', ADVANCE='NO') "*MULTI" CALL clear_formatting() SWRITE(UNIT_stdOut,"(a3)") ' | ' - ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used + ! Indicate that parameter was read at least once and therefore remove the warning that the parameter with the $ was not used + ! This is different from the option set above multi%isUsedMulti = .TRUE. RETURN END IF @@ -1471,7 +1467,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(intopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - intopt%isSet=.TRUE. END SELECT CLASS IS (RealOption) SELECT TYPE(value) @@ -1481,7 +1476,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(realopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalOption) SELECT TYPE(value) @@ -1491,7 +1485,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(logicalopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - logicalopt%isSet=.TRUE. END SELECT CLASS IS (StringOption) SELECT TYPE(value) @@ -1501,7 +1494,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(stringopt) WRITE(tmpValue,'(A)') multi%value CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - stringopt%isSet=.TRUE. END SELECT END SELECT @@ -1518,7 +1510,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,'(a7)', ADVANCE='NO') "*MULTI" CALL clear_formatting() SWRITE(UNIT_stdOut,"(a3)") ' | ' - ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used + ! Indicate that parameter was read at least once and therefore remove the warning that the parameter with the $ was not used + ! This is different from the option set above multi%isUsedMulti = .TRUE. RETURN END IF @@ -1555,7 +1548,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(intopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(intopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - intopt%isSet=.TRUE. END SELECT CLASS IS (RealOption) SELECT TYPE(value) @@ -1565,7 +1557,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(realopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(realopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - realopt%isSet=.TRUE. END SELECT CLASS IS (LogicalOption) SELECT TYPE(value) @@ -1575,7 +1566,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(logicalopt) WRITE(tmpValue, *) multi%value CALL prms%CreateOption(logicalopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - logicalopt%isSet=.TRUE. END SELECT CLASS IS (StringOption) SELECT TYPE(value) @@ -1585,7 +1575,6 @@ SUBROUTINE GetGeneralOption(value, name, proposal) ALLOCATE(stringopt) WRITE(tmpValue,'(A)') multi%value CALL prms%CreateOption(stringopt, name, 'description', value=tmpValue, multiple=.FALSE., numberedmulti=.FALSE.,removed=.TRUE.,createfrommulti=.TRUE.) - stringopt%isSet=.TRUE. END SELECT END SELECT @@ -1602,7 +1591,8 @@ SUBROUTINE GetGeneralOption(value, name, proposal) SWRITE(UNIT_stdOut,'(a7)', ADVANCE='NO') "*MULTI" CALL clear_formatting() SWRITE(UNIT_stdOut,"(a3)") ' | ' - ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used + ! Indicate that parameter was read at least once and therefore remove the warning that the parameter with the $ was not used + ! This is different from the option set above multi%isUsedMulti = .TRUE. RETURN END IF @@ -1838,7 +1828,8 @@ SUBROUTINE GetGeneralArrayOption(value, name, no, proposal) SWRITE(UNIT_stdOut,'(a7)', ADVANCE='NO') "*MULTI" CALL clear_formatting() SWRITE(UNIT_stdOut,"(a3)") ' | ' - ! Indicate that parameter was read at least once and therefore remove the warning that the parameter was not used + ! Indicate that parameter was read at least once and therefore remove the warning that the parameter with the $ was not used + ! This is different from the option set above multi%isUsedMulti = .TRUE. RETURN END IF @@ -2332,7 +2323,7 @@ SUBROUTINE ExtractParameterFile(filename,prmfile,userblockFound) ! INPUT/OUTPUT VARIABLES CHARACTER(LEN=255),INTENT(IN) :: filename !< name of file to be read CHARACTER(LEN=*),INTENT(IN) :: prmfile !< name of file to be written -LOGICAL,INTENT(OUT) :: userblockFound !< logical indicating sucessful extraction of parameter file +LOGICAL,INTENT(OUT) :: userblockFound !< logical indicating successful extraction of parameter file !---------------------------------------------------------------------------------------------------------------------------------- ! LOCAL VARIABLES INTEGER :: stat,iniUnit,fileUnit @@ -2364,7 +2355,7 @@ SUBROUTINE ExtractParameterFile(filename,prmfile,userblockFound) iniFound = .FALSE. userblockFound = .FALSE. - ! infinte loop. Exit at EOF + ! infinite loop. Exit at EOF DO ! read a line into 'aStr' CALL Get(fileUnit,aStr,iostat=stat) diff --git a/unitTests/ReadInTools.f90 b/unitTests/ReadInTools.f90 index 886002309..870667e87 100644 --- a/unitTests/ReadInTools.f90 +++ b/unitTests/ReadInTools.f90 @@ -112,8 +112,15 @@ PROGRAM ReadInToolsUnitTest !CALL prms%CreateStringArrayOption('strArrayOpt_def' , "Description StrOpt with default value", 'dum1,dum2') !CALL prms%CreateStringArrayOption('strArrayOpt_mult' , "Description StrOpt multiple", multiple=.TRUE.) -CALL prms%CreateIntOption('Dollar[$]-IntOption' , 'Single dollar variable.', '-1' , numberedmulti=.TRUE.) -CALL prms%CreateRealOption('Dollar[$]-Dollar[$]-RealOption' , 'Double dollar variable.', '-1.0' , numberedmulti=.TRUE.) +CALL prms%CreateIntOption('Dollar[$]-IntOptionUndef' , 'Single dollar variable undefined.', numberedmulti=.TRUE.) +CALL prms%CreateRealOption('Dollar[$]-Dollar[$]-RealOptionUndef' , 'Double dollar variable undefined.', numberedmulti=.TRUE.) + +CALL prms%CreateIntOption('Dollar[$]-IntOption' , 'Single dollar variable with regular default.', '-1' , numberedmulti=.TRUE.) +CALL prms%CreateRealOption('Dollar[$]-Dollar[$]-RealOption' , 'Double dollar variable with regular default.', '-1.0' , numberedmulti=.TRUE.) + +CALL prms%CreateIntOption('Dollar[$]-IntOptionDef' , 'Single dollar variable with both defaults.', '-1' , numberedmulti=.TRUE.) +CALL prms%CreateRealOption('Dollar[$]-Dollar[$]-RealOptionDef' , 'Double dollar variable with both defaults.', '-1.0' , numberedmulti=.TRUE.) + !CALL PrintDefaultParameterFile(.FALSE.) CALL prms%read_options(FileName) @@ -203,28 +210,59 @@ PROGRAM ReadInToolsUnitTest nDollar = ABS(intOpt) nDollar2 = ABS(intOpt) ALLOCATE(Dollar(1:nDollar)) -ALLOCATE(RealOption(nDollar,nDollar2)) Dollar=0 +ALLOCATE(RealOption(nDollar,nDollar2)) +RealOption = 0 ALLOCATE(IntOption(nDollar)) IntOption = 0 ! Loop twice. The default value <= zero is not allowed to appear DO i = 1, 2 - write(UNIT_StdOut,'(A,I0,A)') "--------------",i,"--------------" + WRITE(UNIT_StdOut,'(A,I0,A)') "--------------",i,"--------------" + ! Test parameters read-in without a default in CreateOption nor GETVAR (Option to force a user input) DO iDollar=1, nDollar WRITE(UNIT=hilf,FMT='(I0)') iDollar - IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOption','-1') + IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOptionUndef') DO iDollar2 = 1, nDollar2 WRITE(UNIT=hilf2,FMT='(I0)') iDollar2 - RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOption','-1.') + RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOptionUndef') END DO ! iDollar2 = 1, nDollar2 END DO ! iDollar=1, nDollar - IF(ANY(IntOption.LE.0)) CALL abort(__STAMP__,'IntOption cannot must be grater than zero') - IF(ANY(RealOption.LE.0)) CALL abort(__STAMP__,'RealOption cannot must be grater than zero') - + IF(ANY(IntOption.LE.0)) CALL abort(__STAMP__,'ERROR: IntOption cannot be greater than zero!') + IF(ANY(RealOption.LE.0)) CALL abort(__STAMP__,'ERROR: RealOption cannot be greater than zero!') + ! Test parameters read-in with a default in CreateOption and not in GETVAR (Preferred option) + RealOption = 0 + IntOption = 0 + DO iDollar=1, nDollar + WRITE(UNIT=hilf,FMT='(I0)') iDollar + IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOption') + DO iDollar2 = 1, nDollar2 + WRITE(UNIT=hilf2,FMT='(I0)') iDollar2 + RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOption') + END DO ! iDollar2 = 1, nDollar2 + END DO ! iDollar=1, nDollar + IF(ANY(IntOption.LE.0)) CALL abort(__STAMP__,'ERROR: IntOption cannot be greater than zero!') + IF(ANY(RealOption.LE.0)) CALL abort(__STAMP__,'ERROR: RealOption cannot be greater than zero!') + ! Test parameters read-in with a default in CreateOption and in GETVAR (Rare cases, where e.g. HUGE is required) + RealOption = 0 + IntOption = 0 + DO iDollar=1, nDollar + WRITE(UNIT=hilf,FMT='(I0)') iDollar + IntOption(iDollar) = GETINT('Dollar'//TRIM(hilf)//'-IntOptionDef','-1') + DO iDollar2 = 1, nDollar2 + WRITE(UNIT=hilf2,FMT='(I0)') iDollar2 + RealOption(iDollar,iDollar2) = GETREAL('Dollar'//TRIM(hilf)//'-Dollar'//TRIM(hilf2)//'-RealOptionDef','-1.') + END DO ! iDollar2 = 1, nDollar2 + END DO ! iDollar=1, nDollar + IF(ANY(IntOption.LE.0)) CALL abort(__STAMP__,'ERROR: IntOption cannot be greater than zero!') + IF(ANY(RealOption.LE.0)) CALL abort(__STAMP__,'ERROR: RealOption cannot be greater than zero!') WRITE (*,*) "IntOption =", IntOption DO iDollar=1, nDollar WRITE (*,*) "RealOption(iDollar,:) =", RealOption(iDollar,:) END DO + IF(i .EQ. 1) THEN + CALL prms%WriteUnused() + IF(prms%count_unread().GT.0) CALL abort(__STAMP__,'ERROR: Unused parameters were found but are not allowed!') + END IF CALL prms%finalize(.TRUE.) ! is the same as CALL FinalizeParameters(), but considers load balancing END DO ! i = 1, 2 diff --git a/unitTests/ReadInTools.ini b/unitTests/ReadInTools.ini index 8bfe3da1e..686be6898 100644 --- a/unitTests/ReadInTools.ini +++ b/unitTests/ReadInTools.ini @@ -49,10 +49,23 @@ realArrayOpt_multsci = (/ -0.25E-07, 3.3 /) logArrayOpt = (/ T, F /) logArrayOpt_mult = (/ F, T /) logArrayOpt_mult = (/ F, T /) -strArrayOpt = (/ dum1, dum2 /) -strArrayOpt_mult = (/ dum1, dum2 /) -strArrayOpt_mult = (/ dum1, dum2 /) +! Currently not tested +!strArrayOpt = (/ dum1, dum2 /) +!strArrayOpt_mult = (/ dum1, dum2 /) +!strArrayOpt_mult = (/ dum1, dum2 /) +! Test parameters read-in without a default in CreateOption and GETVAR (Option to force a user input) +! Single dollar +Dollar1-IntOptionUndef = 5 +Dollar3-IntOptionUndef = 3 +Dollar$-IntOptionUndef = 2 + +! Double dollar +Dollar$-Dollar$-RealOptionUndef = 0.1 +Dollar1-Dollar$-RealOptionUndef = 1.0 +Dollar2-Dollar$-RealOptionUndef = 2.0 + +! Test parameters read-in with a default in CreateOption and not in GETVAR (Preferred option) ! Single dollar Dollar1-IntOption = 5 Dollar3-IntOption = 3 @@ -62,3 +75,14 @@ Dollar$-IntOption = 2 Dollar$-Dollar$-RealOption = 0.1 Dollar1-Dollar$-RealOption = 1.0 Dollar2-Dollar$-RealOption = 2.0 + +! Test parameters read-in with a default in CreateOption and in GETVAR (Rare cases, where e.g. HUGE is required) +! Single dollar +Dollar1-IntOptionDef = 5 +Dollar3-IntOptionDef = 3 +Dollar$-IntOptionDef = 2 + +! Double dollar +Dollar$-Dollar$-RealOptionDef = 0.1 +Dollar1-Dollar$-RealOptionDef = 1.0 +Dollar2-Dollar$-RealOptionDef = 2.0 \ No newline at end of file