source: palm/trunk/SOURCE/user_check_parameters.f90 @ 250

Last change on this file since 250 was 240, checked in by letzel, 15 years ago
  • External pressure gradient (check_parameters, init_3d_model, header, modules, parin, prognostic_equations)
  • New topography case 'single_street_canyon'
  • Property svn:keywords set to Id
File size: 2.8 KB
Line 
1 SUBROUTINE user_check_parameters
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! add default topography_grid_convention for the new topography case
7! 'single_street_canyon'
8!
9! Former revisions:
10! -----------------
11! $Id: user_check_parameters.f90 240 2009-02-18 17:50:38Z letzel $
12!
13! 217 2008-12-09 18:00:48Z letzel
14! Initial version
15!
16! Description:
17! ------------
18! Check &userpar control parameters and deduce further quantities.
19!------------------------------------------------------------------------------!
20
21    USE control_parameters
22    USE user
23
24    IMPLICIT NONE
25
26!
27!-- In case of non-flat topography, check whether the convention how to
28!-- define the topography grid has been set correctly, or whether the default
29!-- is applicable. If this is not possible, abort.
30    IF ( TRIM( topography ) /= 'flat' )  THEN
31       IF ( TRIM( topography_grid_convention ) == ' ' )  THEN
32          IF ( TRIM( topography ) /= 'single_building' .AND.  &
33               TRIM( topography ) /= 'single_street_canyon' .AND.  &
34               TRIM( topography ) /= 'read_from_file' )  THEN
35!--          The default value is not applicable here, because it is only valid
36!--          for the two standard cases 'single_building' and 'read_from_file'
37!--          defined in init_grid.
38             WRITE( message_string, * )  &
39                  'The value for "topography_grid_convention" ',  &
40                  'is not set. Its default value is & only valid for ',  &
41                  '"topography" = ''single_building'', ',  &
42                  '''single_street_canyon'' & or ''read_from_file''.',  &
43                  ' & Choose ''cell_edge'' or ''cell_center''.'
44             CALL message( 'user_check_parameters', 'UI0001', 1, 2, 0, 6, 0 )
45          ELSE
46!--          The default value is applicable here.
47!--          Set convention according to topography.
48             IF ( TRIM( topography ) == 'single_building' .OR.  &
49                  TRIM( topography ) == 'single_street_canyon' )  THEN
50                topography_grid_convention = 'cell_edge'
51             ELSEIF ( TRIM( topography ) == 'read_from_file' )  THEN
52                topography_grid_convention = 'cell_center'
53             ENDIF
54          ENDIF
55       ELSEIF ( TRIM( topography_grid_convention ) /= 'cell_edge' .AND.  &
56                TRIM( topography_grid_convention ) /= 'cell_center' )  THEN
57          WRITE( message_string, * )  &
58               'The value for "topography_grid_convention" is ', &
59               'not recognized. & Choose ''cell_edge'' or ''cell_center''.'
60          CALL message( 'user_check_parameters', 'UI0002', 1, 2, 0, 6, 0 )
61       ENDIF
62    ENDIF
63
64!
65!-- Here the user may add code to check the validity of further &userpar
66!-- control parameters or deduce further quantities.
67
68
69 END SUBROUTINE user_check_parameters
70
Note: See TracBrowser for help on using the repository browser.