source: palm/trunk/SOURCE/user_init_grid.f90 @ 222

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