source: palm/trunk/SOURCE/user_check_data_output_pr.f90 @ 1310

Last change on this file since 1310 was 1310, checked in by raasch, 10 years ago

update of GPL copyright

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