Changeset 1984 for palm

Timestamp:

Aug 1, 2016 2:48:05 PM (8 years ago)

Author:

suehring

Message:

Bugfix: checking for bottom and top boundary condition for humidity and scalars

File:

• palm/trunk/SOURCE/check_parameters.f90 (modified) (10 diffs)

palm/trunk/SOURCE/check_parameters.f90

@@ -19 +19 @@
 ! Current revisions:
 ! -----------------
-! 
+! Bugfix: checking for bottom and top boundary condition for humidity and scalars
 ! 
 ! Former revisions:
@@ -780 +780 @@
                   '''single_street_canyon'' & or ''read_from_file''.',         &
                   ' & Choose ''cell_edge'' or ''cell_center''.'
-             CALL message( 'user_check_parameters', 'PA0239', 1, 2, 0, 6, 0 )
+             CALL message( 'check_parameters', 'PA0239', 1, 2, 0, 6, 0 )
           ELSE
 !--          The default value is applicable here.
@@ -796 +796 @@
                'The value for "topography_grid_convention" is ',               &
                'not recognized. & Choose ''cell_edge'' or ''cell_center''.'
-          CALL message( 'user_check_parameters', 'PA0240', 1, 2, 0, 6, 0 )
+          CALL message( 'check_parameters', 'PA0240', 1, 2, 0, 6, 0 )
        ENDIF
 
@@ -1712 +1712 @@
 !-- Set boundary conditions for total water content
     IF ( humidity )  THEN
-       CALL check_bc_scalars( 'q', bc_q_b, bc_q_t, ibc_q_b, ibc_q_t,           &
-                              'PA0071', 'PA0072', 'PA0073', 'PA0074',          &
-                              surface_waterflux, constant_waterflux,           &
-                              q_surface_initial_change )
+       CALL set_bc_scalars( 'q', bc_q_b, bc_q_t, ibc_q_b, ibc_q_t,           &
+                            'PA0071', 'PA0072' )
 
        IF ( surface_waterflux == 9999999.9_wp  )  THEN
@@ -1737 +1735 @@
        ENDIF
 
+       CALL check_bc_scalars( 'q', bc_q_b, ibc_q_b, 'PA0073', 'PA0074',        &
+                              constant_waterflux, q_surface_initial_change )
+
     ENDIF
     
     IF ( passive_scalar )  THEN
-       CALL check_bc_scalars( 's', bc_s_b, bc_s_t, ibc_s_b, ibc_s_t,           &
-                              'PA0071', 'PA0072', 'PA0073', 'PA0074',          &
-                              surface_scalarflux, constant_scalarflux,         &
-                              s_surface_initial_change )
+       CALL set_bc_scalars( 's', bc_s_b, bc_s_t, ibc_s_b, ibc_s_t,             &
+                            'PA0071', 'PA0072' )
+
+       CALL check_bc_scalars( 's', bc_s_b, ibc_s_b, 'PA0073', 'PA0074',        &
+                              constant_scalarflux, s_surface_initial_change )
     ENDIF
 !
@@ -3875 +3877 @@
 ! Description:
 ! ------------
-!> Check the bottom and top boundary conditions for humidity and scalars.
+!> Set the bottom and top boundary conditions for humidity and scalars.
 !------------------------------------------------------------------------------!
 
-    SUBROUTINE check_bc_scalars( sq, bc_b, bc_t, ibc_b, ibc_t,                 &
-                                 err_nr_b, err_nr_t, err_nr_3, err_nr_4,       &
-                                 surface_flux, constant_flux, surface_initial_change )
+    SUBROUTINE set_bc_scalars( sq, bc_b, bc_t, ibc_b, ibc_t, err_nr_b, err_nr_t ) 
 
 
@@ -3890 +3890 @@
        CHARACTER (LEN=*)   ::  err_nr_b
        CHARACTER (LEN=*)   ::  err_nr_t
-       CHARACTER (LEN=*)   ::  err_nr_3
-       CHARACTER (LEN=*)   ::  err_nr_4
-       
+
        INTEGER(iwp)        ::  ibc_b
        INTEGER(iwp)        ::  ibc_t
-       
-       LOGICAL             ::  constant_flux
-       
-       REAL(wp)            ::  surface_flux
-       REAL(wp)            ::  surface_initial_change
-       
-
+
+!
+!--    Set Integer flags and check for possilbe errorneous settings for bottom
+!--    boundary condition
        IF ( bc_b == 'dirichlet' )  THEN
           ibc_b = 0
@@ -3911 +3906 @@
           CALL message( 'check_parameters', err_nr_b, 1, 2, 0, 6, 0 )
        ENDIF
-       
+!
+!--    Set Integer flags and check for possilbe errorneous settings for top
+!--    boundary condition
        IF ( bc_t == 'dirichlet' )  THEN
           ibc_t = 0
@@ -3923 +3920 @@
           CALL message( 'check_parameters', err_nr_t, 1, 2, 0, 6, 0 )
        ENDIF
-  
+       
+    
+    END SUBROUTINE set_bc_scalars   
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check for consistent settings of bottom boundary conditions for humidity 
+!> and scalars.
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE check_bc_scalars( sq, bc_b, ibc_b,                 &
+                                 err_nr_1, err_nr_2,       &
+                                 constant_flux, surface_initial_change )
+
+
+       IMPLICIT NONE    
+    
+       CHARACTER (LEN=1)   ::  sq                       !< 
+       CHARACTER (LEN=*)   ::  bc_b
+       CHARACTER (LEN=*)   ::  err_nr_1
+       CHARACTER (LEN=*)   ::  err_nr_2
+       
+       INTEGER(iwp)        ::  ibc_b
+       
+       LOGICAL             ::  constant_flux
+       
+       REAL(wp)            ::  surface_initial_change
+ 
 !
 !--    A given surface value implies Dirichlet boundary condition for
@@ -3934 +3961 @@
                               '= "' // TRIM( bc_b ) // '" is not allowed with ' // &
                               'prescribed surface flux'
-             CALL message( 'check_parameters', err_nr_3, 1, 2, 0, 6, 0 )
+             CALL message( 'check_parameters', err_nr_1, 1, 2, 0, 6, 0 )
           ENDIF
        ENDIF
-       IF ( constant_waterflux  .AND.  surface_initial_change /= 0.0_wp )  THEN
+       IF ( constant_flux  .AND.  surface_initial_change /= 0.0_wp )  THEN
           WRITE( message_string, * )  'a prescribed surface flux is not allo', &
                  'wed with ', sq, '_surface_initial_change (/=0) = ',          &
                  surface_initial_change
-          CALL message( 'check_parameters', err_nr_4, 1, 2, 0, 6, 0 )
+          CALL message( 'check_parameters', err_nr_2, 1, 2, 0, 6, 0 )
        ENDIF