source: palm/tags/release-3.6/SOURCE/user_init_grid.f90 @ 3636

Last change on this file since 3636 was 226, checked in by raasch, 15 years ago

preparations for the next release

  • Property svn:keywords set to Id
File size: 2.1 KB
Line 
1 SUBROUTINE user_init_grid( gls, nzb_local )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6!
7!
8! Former revisions:
9! -----------------
10! $Id: user_init_grid.f90 226 2009-02-02 07:39:34Z raasch $
11!
12! 217 2008-12-09 18:00:48Z letzel
13! +topography_grid_convention
14! Former file user_interface.f90 split into one file per subroutine
15!
16! Description:
17! ------------
18! Execution of user-defined grid initializing actions
19! First argument gls contains the number of ghost layers, which is > 1 if the
20! multigrid method for the pressure solver is used
21!------------------------------------------------------------------------------!
22
23    USE control_parameters
24    USE indices
25    USE user
26
27    IMPLICIT NONE
28
29    INTEGER ::  gls
30
31    INTEGER, DIMENSION(-gls:ny+gls,-gls:nx+gls) ::  nzb_local
32
33!
34!-- Here the user-defined grid initializing actions follow:
35
36!
37!-- Set the index array nzb_local for non-flat topography.
38!-- Here consistency checks concerning domain size and periodicity are necessary
39    SELECT CASE ( TRIM( topography ) )
40
41       CASE ( 'flat', 'single_building' )
42!
43!--       Not allowed here since these are the standard cases used in init_grid.
44
45       CASE ( 'user_defined_topography_1' )
46!
47!--       Here the user can define his own topography.
48
49!
50!--       For each user-defined topography, the topography grid convention has
51!--       to be explicitly set to either 'cell_edge' or 'cell_center'.
52!--       topography_grid_convention = 'cell_edge'     ! OR:
53!--       topography_grid_convention = 'cell_center'
54
55!
56!--       After definition, please remove the following three lines!
57          PRINT*, '+++ user_init_grid: topography "', &
58               topography, '" not available yet'
59          CALL local_stop
60
61       CASE DEFAULT
62!
63!--       The DEFAULT case is reached if the parameter topography contains a
64!--       wrong character string that is neither recognized in init_grid nor
65!--       here in user_init_grid.
66          PRINT*, '+++ (user_)init_grid: unknown topography "', &
67               topography, '"'
68          CALL local_stop
69
70    END SELECT
71
72
73 END SUBROUTINE user_init_grid
74
Note: See TracBrowser for help on using the repository browser.