source: palm/trunk/SOURCE/user_check_data_output_pr.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: 2.9 KB
Line 
1 SUBROUTINE user_check_data_output_pr( variable, var_count, unit )
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!
24! Former revisions:
25! -----------------
26! $Id: user_check_data_output_pr.f90 1036 2012-10-22 13:43:42Z raasch $
27!
28! 211 2008-11-11 04:46:24Z raasch
29! Former file user_interface.f90 split into one file per subroutine
30!
31! Description:
32! ------------
33! Set the unit of user defined profile output quantities. For those variables
34! not recognized by the user, the parameter unit is set to "illegal", which
35! tells the calling routine that the output variable is not defined and leads
36! to a program abort.
37!------------------------------------------------------------------------------!
38
39    USE arrays_3d
40    USE indices
41    USE netcdf_control
42    USE profil_parameter
43    USE statistics
44    USE user
45
46    IMPLICIT NONE
47
48    CHARACTER (LEN=*) ::  unit, variable
49
50    INTEGER ::  index, var_count
51
52
53    SELECT CASE ( TRIM( variable ) )
54
55!
56!--    Uncomment and extend the following lines, if necessary.
57!--    Add additional CASE statements depending on the number of quantities
58!--    for which profiles are to be calculated. The respective calculations
59!--    to be performed have to be added in routine user_statistics.
60!--    The quantities are (internally) identified by a user-profile-number
61!--    (see variable "index" below). The first user-profile must be assigned
62!--    the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
63!--    user-profile-numbers have also to be used in routine user_statistics!
64!       CASE ( 'u*v*' )                      ! quantity string as given in
65!                                            ! data_output_pr_user
66!          index = pr_palm + 1
67!          dopr_index(var_count)  = index    ! quantities' user-profile-number
68!          dopr_unit(var_count)   = 'm2/s2'  ! quantity unit
69!          hom(:,2,index,:)       = SPREAD( zu, 2, statistic_regions+1 )
70!                                            ! grid on which the quantity is
71!                                            ! defined (use zu or zw)
72
73       CASE DEFAULT
74          unit = 'illegal'
75
76    END SELECT
77
78
79 END SUBROUTINE user_check_data_output_pr
80
Note: See TracBrowser for help on using the repository browser.