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

Last change on this file since 1359 was 1354, checked in by heinze, 10 years ago

last commit documented

  • Property svn:keywords set to Id
File size: 3.6 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-2014 Leibniz Universitaet Hannover
18!--------------------------------------------------------------------------------!
19!
20! Current revisions:
21! -----------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: user_init_plant_canopy.f90 1354 2014-04-08 15:22:57Z hoffmann $
27!
28! 1353 2014-04-08 15:21:23Z heinze
29! REAL constants provided with KIND-attribute
30!
31! 1320 2014-03-20 08:40:49Z raasch
32! kind-parameters added to all INTEGER and REAL declaration statements,
33! kinds are defined in new module kinds,
34! old module precision_kind is removed,
35! revision history before 2012 removed,
36! comment fields (!:) to be used for variable explanations added to
37! all variable declaration statements
38!
39! 1036 2012-10-22 13:43:42Z raasch
40! code put under GPL (PALM 3.9)
41!
42! 211 2008-11-11 04:46:24Z raasch
43! Former file user_interface.f90 split into one file per subroutine
44!
45! Description:
46! ------------
47! Initialisation of the leaf area density array (for scalar grid points) and
48! the array of the canopy drag coefficient, if the user has not chosen any
49! of the default cases
50!------------------------------------------------------------------------------!
51
52    USE arrays_3d
53   
54    USE control_parameters
55   
56    USE indices
57   
58    USE kinds
59   
60    USE user
61
62    IMPLICIT NONE
63
64    INTEGER(iwp) :: i   !:
65    INTEGER(iwp) :: j   !:
66
67!
68!-- Here the user-defined grid initializing actions follow:
69
70!
71!-- Set the 3D-arrays lad_s and cdc for user defined canopies
72    SELECT CASE ( TRIM( canopy_mode ) )
73
74       CASE ( 'block' )
75!
76!--       Not allowed here since this is the standard case used in init_3d_model.
77
78       CASE ( 'user_defined_canopy_1' )
79!
80!--       Here the user can define his own topography.
81!--       The following lines contain an example in that the
82!--       plant canopy extends only over the second half of the
83!--       model domain along x
84!          DO  i = nxlg, nxrg
85!             IF ( i >= INT(nx+1/2) ) THEN
86!                DO  j = nysg, nyng
87!                   lad_s(:,j,i) = lad(:)
88!                   cdc(:,j,i)   = drag_coefficient
89!                ENDDO
90!             ELSE
91!                lad_s(:,:,i) = 0.0_wp
92!                cdc(:,:,i)   = 0.0_wp
93!             ENDIF
94!          ENDDO
95!--       After definition, please
96!--       remove the following three lines!
97          message_string = 'canopy_mode "' // canopy_mode // &
98                           '" not available yet'
99          CALL message( 'user_init_plant_canopy', 'UI0007', 0, 1, 0, 6, 0 )
100         
101       CASE DEFAULT
102!
103!--       The DEFAULT case is reached if the parameter canopy_mode contains a
104!--       wrong character string that is neither recognized in init_3d_model nor
105!--       here in user_init_plant_canopy.
106          message_string = 'unknown canopy_mode "' // canopy_mode // '"'
107          CALL message( 'user_init_plant_canopy', 'UI0008', 1, 2, 0, 6, 0 )
108
109    END SELECT
110
111
112 END SUBROUTINE user_init_plant_canopy
113
Note: See TracBrowser for help on using the repository browser.