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

Last change on this file since 211 was 211, checked in by raasch, 15 years ago

user interface was split into one single file per subroutine

  • Property svn:keywords set to Id
File size: 2.1 KB
Line 
1 SUBROUTINE user_check_data_output_pr( variable, var_count, unit )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Former file user_interface.f90 split into one file per subroutine
7!
8! Former revisions:
9! -----------------
10! $Id: user_check_data_output_pr.f90 211 2008-11-11 04:46:24Z raasch $
11!
12! Description:
13! ------------
14! Set the unit of user defined profile output quantities. For those variables
15! not recognized by the user, the parameter unit is set to "illegal", which
16! tells the calling routine that the output variable is not defined and leads
17! to a program abort.
18!------------------------------------------------------------------------------!
19
20    USE arrays_3d
21    USE indices
22    USE netcdf_control
23    USE profil_parameter
24    USE statistics
25    USE user
26
27    IMPLICIT NONE
28
29    CHARACTER (LEN=*) ::  unit, variable
30
31    INTEGER ::  index, var_count
32
33
34    SELECT CASE ( TRIM( variable ) )
35
36!
37!--    Uncomment and extend the following lines, if necessary.
38!--    Add additional CASE statements depending on the number of quantities
39!--    for which profiles are to be calculated. The respective calculations
40!--    to be performed have to be added in routine user_statistics.
41!--    The quantities are (internally) identified by a user-profile-number
42!--    (see variable "index" below). The first user-profile must be assigned
43!--    the number "pr_palm+1", the second one "pr_palm+2", etc. The respective
44!--    user-profile-numbers have also to be used in routine user_statistics!
45!       CASE ( 'u*v*' )                      ! quantity string as given in
46!                                            ! data_output_pr_user
47!          index = pr_palm + 1
48!          dopr_index(var_count)  = index    ! quantities' user-profile-number
49!          dopr_unit(var_count)   = 'm2/s2'  ! quantity unit
50!          hom(:,2,index,:)       = SPREAD( zu, 2, statistic_regions+1 )
51!                                            ! grid on which the quantity is
52!                                            ! defined (use zu or zw)
53
54       CASE DEFAULT
55          unit = 'illegal'
56
57    END SELECT
58
59
60 END SUBROUTINE user_check_data_output_pr
61
Note: See TracBrowser for help on using the repository browser.