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

Last change on this file since 1036 was 1036, checked in by raasch, 11 years ago

code has been put under the GNU General Public License (v3)

  • Property svn:keywords set to Id
File size: 3.2 KB
Line 
1 SUBROUTINE user_init_plant_canopy
2
3!--------------------------------------------------------------------------------!
4! This file is part of PALM.
5!
6! PALM is free software: you can redistribute it and/or modify it under the terms
7! of the GNU General Public License as published by the Free Software Foundation,
8! either version 3 of the License, or (at your option) any later version.
9!
10! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
11! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
12! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
13!
14! You should have received a copy of the GNU General Public License along with
15! PALM. If not, see <http://www.gnu.org/licenses/>.
16!
17! Copyright 1997-2012  Leibniz University Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23! Former revisions:
24! -----------------
25! $Id: user_init_plant_canopy.f90 1036 2012-10-22 13:43:42Z raasch $
26!
27! 667 2010-12-23 12:06:00Z suehring/gryschka
28! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng
29!
30! 274 2009-03-26 15:11:21Z heinze
31! Output of messages replaced by message handling routine.
32!
33! 211 2008-11-11 04:46:24Z raasch
34! Former file user_interface.f90 split into one file per subroutine
35!
36! Description:
37! ------------
38! Initialisation of the leaf area density array (for scalar grid points) and
39! the array of the canopy drag coefficient, if the user has not chosen any
40! of the default cases
41!------------------------------------------------------------------------------!
42
43    USE arrays_3d
44    USE control_parameters
45    USE indices
46    USE user
47
48    IMPLICIT NONE
49
50    INTEGER :: i, j 
51
52!
53!-- Here the user-defined grid initializing actions follow:
54
55!
56!-- Set the 3D-arrays lad_s and cdc for user defined canopies
57    SELECT CASE ( TRIM( canopy_mode ) )
58
59       CASE ( 'block' )
60!
61!--       Not allowed here since this is the standard case used in init_3d_model.
62
63       CASE ( 'user_defined_canopy_1' )
64!
65!--       Here the user can define his own topography.
66!--       The following lines contain an example in that the
67!--       plant canopy extends only over the second half of the
68!--       model domain along x
69!          DO  i = nxlg, nxrg
70!             IF ( i >= INT(nx+1/2) ) THEN
71!                DO  j = nysg, nyng
72!                   lad_s(:,j,i) = lad(:)
73!                   cdc(:,j,i)   = drag_coefficient
74!                ENDDO
75!             ELSE
76!                lad_s(:,:,i) = 0.0
77!                cdc(:,:,i)   = 0.0
78!             ENDIF
79!          ENDDO
80!--       After definition, please
81!--       remove the following three lines!
82          message_string = 'canopy_mode "' // canopy_mode // &
83                           '" not available yet'
84          CALL message( 'user_init_plant_canopy', 'UI0007', 0, 1, 0, 6, 0 )
85         
86       CASE DEFAULT
87!
88!--       The DEFAULT case is reached if the parameter canopy_mode contains a
89!--       wrong character string that is neither recognized in init_3d_model nor
90!--       here in user_init_plant_canopy.
91          message_string = 'unknown canopy_mode "' // canopy_mode // '"'
92          CALL message( 'user_init_plant_canopy', 'UI0008', 1, 2, 0, 6, 0 )
93
94    END SELECT
95
96
97 END SUBROUTINE user_init_plant_canopy
98
Note: See TracBrowser for help on using the repository browser.