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

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

ONLY-attribute added to USE-statements,
kind-parameters added to all INTEGER and REAL declaration statements,
kinds are defined in new module kinds,
old module precision_kind is removed,
revision history before 2012 removed,
comment fields (!:) to be used for variable explanations added to all variable declaration statements

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