Changeset 4822

Timestamp:

Dec 11, 2020 2:18:43 PM (3 years ago)

Author:

raasch

Message:

reading of namelist file and actions in case of namelist errors revised so that statement labels and goto statements are not required any more

Location:

palm/trunk/SOURCE

Files:

• biometeorology_mod.f90 (modified) (3 diffs)
• chemistry_model_mod.f90 (modified) (7 diffs)
• global_min_max.f90 (modified) (2 diffs)
• timestep.f90 (modified) (1 diff)

palm/trunk/SOURCE/biometeorology_mod.f90

@@ -26 +26 @@
 ! -----------------
 ! $Id$
+! reading of namelist file and actions in case of namelist errors revised so that statement labels
+! and goto statements are not required any more
+!
+! 4807 2020-12-02 21:02:28Z gronemeier
 ! Add checks for setup of UV exposure (only workaround!); corrected formatting errors.
 !
@@ -1383 +1387 @@
 !
 !-- Internal variables
-    CHARACTER (LEN=80) ::  line  !< Dummy string for current line in parameter file
+    CHARACTER (LEN=100) ::  line  !< Dummy string for current line in parameter file
+
+    INTEGER(iwp) ::  io_status   !< Status after reading the namelist file
 
     NAMELIST /biometeorology_parameters/  clothing,                                                &
@@ -1393 +1399 @@
                                           uv_exposure
 
-
-!-- Try to find biometeorology_parameters namelist
-    REWIND ( 11 )
-    line = ' '
-    DO WHILE ( INDEX( line, '&biometeorology_parameters' ) == 0 )
-       READ ( 11, '(A)', END = 20 )  line
-    ENDDO
-    BACKSPACE ( 11 )
-
-!
-!-- Read biometeorology_parameters namelist
-    READ ( 11, biometeorology_parameters, ERR = 10, END = 20 )
-
-!
-!-- Set flag that indicates that the biomet_module is switched on
-    biometeorology = .TRUE.
-
-    GOTO 20
-
-!
-!-- In case of error
- 10 BACKSPACE( 11 )
-    READ( 11 , '(A)') line
-    CALL parin_fail_message( 'biometeorology_parameters', line )
-
-!
-!-- Complete
- 20 CONTINUE
-
+!
+!-- Move to the beginning of the namelist file and try to find and read the namelist named
+!-- biometeorology_parameters.
+    REWIND( 11 )
+    READ( 11, biometeorology_parameters, IOSTAT=io_status )
+!
+!-- Action depending on the READ status
+    IF ( io_status == 0 )  THEN
+!
+!--    biometeorology_parameters namelist was found and read correctly. Set flag that
+!--    biometeorology_mod is switched on.
+       biometeorology = .TRUE.
+
+    ELSEIF ( io_status > 0 )  THEN
+!
+!--    biometeorology_parameters namelist was found, but contained errors. Print an error message
+!--    containing the line that caused the problem.
+       BACKSPACE( 11 )
+       READ( 11 , '(A)') line
+       CALL parin_fail_message( 'biometeorology_parameters', line )
+
+    ENDIF
 
  END SUBROUTINE bio_parin
+
 
 !--------------------------------------------------------------------------------------------------!

palm/trunk/SOURCE/chemistry_model_mod.f90

@@ -26 +26 @@
 ! -----------------
 ! $Id$
+! reading of namelist file and actions in case of namelist errors revised so that statement labels
+! and goto statements are not required any more
+!
+! 4768 2020-11-02 19:11:23Z suehring
 ! Enable 3D data output also with 64-bit precision
 !
@@ -43 +47 @@
 ! - Bugfix in variable name separation in profile-output initialization
 ! - Bugfix in counting the number of chemistry profiles
-! 
+!
 ! 4581 2020-06-29 08:49:58Z suehring
 ! Enable output of resolved-scale vertical fluxes of chemical species.
-! 
+!
 ! 4577 2020-06-25 09:53:58Z raasch
 ! further re-formatting to follow the PALM coding standard
@@ -2504 +2508 @@
 
 
-    CHARACTER (LEN=80) ::  line                        !< dummy string that contains the current
+    CHARACTER(LEN=100) ::  line                        !< dummy string that contains the current
                                                        !< line of the parameter file
+    CHARACTER(LEN=8)   ::  solver_type
 
     INTEGER(iwp) ::  i                                 !<
+    INTEGER(iwp) ::  io_status                         !< Status after reading the namelist file
     INTEGER(iwp) ::  max_pr_cs_tmp                     !<
 
@@ -2566 +2572 @@
     !>  If the respective concentration profile should be constant with height, then use "cs_surface( number of spcs)"
     !>  then write these cs_surface values to chem_species(lsp)%conc_pr_init(:)
+
 !
 !-- Read chem namelist
-    CHARACTER(LEN=8)    :: solver_type
-
     icntrl    = 0
     rcntrl    = 0.0_wp
@@ -2577 +2582 @@
     rtol = 0.01_wp
 !
-!-- Try to find chemistry package
-    REWIND ( 11 )
-    line = ' '
-    DO   WHILE ( INDEX( line, '&chemistry_parameters' ) == 0 )
-       READ ( 11, '(A)', END=20 )  line
-    ENDDO
-    BACKSPACE ( 11 )
-!
-!-- Read chemistry namelist
-    READ ( 11, chemistry_parameters, ERR = 10, END = 20 )
-!
-!-- Enable chemistry model
-    air_chemistry = .TRUE.
-    GOTO 20
-
- 10 BACKSPACE( 11 )
-    READ( 11 , '(A)') line
-    CALL parin_fail_message( 'chemistry_parameters', line )
-
- 20 CONTINUE
-
-
+!-- Move to the beginning of the namelist file and try to find and read the namelist named
+!-- chemistry_parameters.
+    REWIND( 11 )
+    READ( 11, chemistry_parameters, IOSTAT=io_status )
+!
+!-- Action depending on the READ status
+    IF ( io_status == 0 )  THEN
+!
+!      chemistry_parameters namelist was found and read correctly. Switch on chemistry model.
+       air_chemistry = .TRUE.
+
+    ELSEIF ( io_status > 0 )  THEN
+!
+!--    chemistry_parameters namelist was found, but contained errors. Print an error message
+!--    including the line that caused the problem.
+       BACKSPACE( 11 )
+       READ( 11 , '(A)') line
+       CALL parin_fail_message( 'chemistry_parameters', line )
+
+    ENDIF
 
 !
@@ -2743 +2746 @@
 !
 !-- Set Solver Type
-    IF(icntrl(3) == 0)  THEN
+    IF ( icntrl(3) == 0 )  THEN
        solver_type = 'rodas3'           !Default
-    ELSE IF(icntrl(3) == 1)  THEN
+    ELSEIF ( icntrl(3) == 1 )  THEN
        solver_type = 'ros2'
-    ELSE IF(icntrl(3) == 2)  THEN
+    ELSEIF ( icntrl(3) == 2 )  THEN
        solver_type = 'ros3'
-    ELSE IF(icntrl(3) == 3)  THEN
+    ELSEIF ( icntrl(3) == 3 )  THEN
        solver_type = 'ro4'
-    ELSE IF(icntrl(3) == 4)  THEN
+    ELSEIF ( icntrl(3) == 4 )  THEN
        solver_type = 'rodas3'
-    ELSE IF(icntrl(3) == 5)  THEN
+    ELSEIF ( icntrl(3) == 5 )  THEN
        solver_type = 'rodas4'
-    ELSE IF(icntrl(3) == 6)  THEN
+    ELSEIF ( icntrl(3) == 6 )  THEN
        solver_type = 'Rang3'
     ELSE
@@ -3351 +3354 @@
 !--    Sum-up profiles for vertical fluxes of the the species. Note, in case of WS5 scheme the
 !--    profiles of resolved-scale fluxes have been already summed-up, while resolved-scale fluxes
-!--    need to be calculated in case of PW scheme. 
+!--    need to be calculated in case of PW scheme.
 !--    For summation employ a temporary array.
        !$OMP PARALLEL PRIVATE( i, j, k, tn, lpr, sums_tmp, flag )

palm/trunk/SOURCE/global_min_max.f90

@@ -375 +375 @@
           value     = fmax(1)
           value_ijk = fmax_ijk
-          IF ( fmax_ijk(1) < 0 )  THEN
+          IF ( fmax_ijk(1) <= -10 )  THEN
+!
+!--          Index needs to be corrected because it has been modified above to indicate negative
+!--          values
+             value_ijk(1) = -value_ijk(1) - 10
+!
+!--          For this reason also change the sign of the quantity
              value        = -value
-             value_ijk(1) = -value_ijk(1) - 10         !???
           ENDIF
 
@@ -389 +394 @@
     IF ( value_ijk(2) > ny ) value_ijk(2) = value_ijk(2) - (ny+1)
 
+    WRITE (9,*) 'global_min_max: value = ', value, ' kji = ', value_ijk, ' ar=', &
+                ar(value_ijk(1),value_ijk(2),value_ijk(3))
 
  END SUBROUTINE global_min_max

palm/trunk/SOURCE/timestep.f90

@@ -223 +223 @@
 !
 !-- Determine the maxima of the velocity components, including their grid index positions.
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0_wp, u_max, u_max_ijk )
-    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0_wp, v_max, v_max_ijk )
+!    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, u, 'abs', 0.0_wp, u_max, u_max_ijk )
+!    CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, v, 'abs', 0.0_wp, v_max, v_max_ijk )
     CALL global_min_max( nzb, nzt+1, nysg, nyng, nxlg, nxrg, w, 'abs', 0.0_wp, w_max, w_max_ijk )