source: palm/trunk/SOURCE/user_init_plant_canopy.f90 @ 213

Last change on this file since 213 was 211, checked in by raasch, 15 years ago

user interface was split into one single file per subroutine

  • Property svn:keywords set to Id
File size: 2.1 KB
Line 
1 SUBROUTINE user_init_plant_canopy
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Former file user_interface.f90 split into one file per subroutine
7!
8! Former revisions:
9! -----------------
10! $Id: user_init_plant_canopy.f90 211 2008-11-11 04:46:24Z raasch $
11!
12! Description:
13! ------------
14! Initialisation of the leaf area density array (for scalar grid points) and
15! the array of the canopy drag coefficient, if the user has not chosen any
16! of the default cases
17!------------------------------------------------------------------------------!
18
19    USE arrays_3d
20    USE control_parameters
21    USE indices
22    USE user
23
24    IMPLICIT NONE
25
26    INTEGER :: i, j 
27
28!
29!-- Here the user-defined grid initializing actions follow:
30
31!
32!-- Set the 3D-arrays lad_s and cdc for user defined canopies
33    SELECT CASE ( TRIM( canopy_mode ) )
34
35       CASE ( 'block' )
36!
37!--       Not allowed here since this is the standard case used in init_3d_model.
38
39       CASE ( 'user_defined_canopy_1' )
40!
41!--       Here the user can define his own topography.
42!--       The following lines contain an example in that the
43!--       plant canopy extends only over the second half of the
44!--       model domain along x
45!          DO  i = nxl-1, nxr+1
46!             IF ( i >= INT(nx+1/2) ) THEN
47!                DO  j = nys-1, nyn+1
48!                   lad_s(:,j,i) = lad(:)
49!                   cdc(:,j,i)   = drag_coefficient
50!                ENDDO
51!             ELSE
52!                lad_s(:,:,i) = 0.0
53!                cdc(:,:,i)   = 0.0
54!             ENDIF
55!          ENDDO
56!--       After definition, please
57!--       remove the following three lines!
58          PRINT*, '+++ user_init_plant_canopy: canopy_mode "', &
59               canopy_mode, '" not available yet'
60
61       CASE DEFAULT
62!
63!--       The DEFAULT case is reached if the parameter canopy_mode contains a
64!--       wrong character string that is neither recognized in init_3d_model nor
65!--       here in user_init_plant_canopy.
66          PRINT*, '+++ user_init_plant_canopy: unknown canopy_mode "', &
67               canopy_mode, '"'
68          CALL local_stop
69
70    END SELECT
71
72
73 END SUBROUTINE user_init_plant_canopy
74
Note: See TracBrowser for help on using the repository browser.