source: palm/trunk/SOURCE/user_data_output_dvrp.f90 @ 250

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

further changes for dvrp clipping

  • Property svn:keywords set to Id
File size: 1.8 KB
Line 
1 SUBROUTINE user_data_output_dvrp( output_variable, local_pf )
2
3!------------------------------------------------------------------------------!
4! Actual revisions:
5! -----------------
6! Clipping implemented
7!
8! Former revisions:
9! -----------------
10! $Id: user_data_output_dvrp.f90 246 2009-02-27 11:42:39Z letzel $
11!
12! 211 2008-11-11 04:46:24Z raasch
13! Former file user_interface.f90 split into one file per subroutine
14!
15! Description:
16! ------------
17! Execution of user-defined dvrp output
18!------------------------------------------------------------------------------!
19
20    USE control_parameters
21    USE dvrp_variables
22    USE indices
23    USE pegrid
24    USE user
25
26    IMPLICIT NONE
27
28    CHARACTER (LEN=*) ::  output_variable
29
30    INTEGER ::  i, j, k
31
32    REAL, DIMENSION(nxl_dvrp:nxr_dvrp+1,nys_dvrp:nyn_dvrp+1,nzb:nz_do3d) ::  &
33                                                                       local_pf
34
35!
36!-- Here the user-defined DVRP output follows:
37
38!
39!-- Move original array to intermediate array
40    SELECT CASE ( output_variable )
41
42!       CASE ( 'u2', 'u2_xy', 'u2_xz', 'u2_yz'  )
43!!
44!!--       Here the user can add user_defined output quantities.
45!!--       Uncomment and extend the following lines, if necessary.
46!          DO  i = nxl_dvrp, nxr_dvrp+1
47!             DO  j = nys_dvrp, nyn_dvrp+1
48!                DO  k = nzb, nz_do3d
49!                   local_pf(i,j,k) = u2(k,j,i)
50!                ENDDO
51!             ENDDO
52!          ENDDO
53
54
55       CASE DEFAULT
56!
57!--       The DEFAULT case is reached if output_variable contains a
58!--       wrong character string that is neither recognized in data_output_dvrp
59!--       nor here in user_data_output_dvrp.
60          IF ( myid == 0 )  THEN
61             PRINT*,'+++ (user_)data_output_dvrp: no output possible for: ', &
62                  output_variable
63          ENDIF
64
65    END SELECT
66
67
68 END SUBROUTINE user_data_output_dvrp
69
Note: See TracBrowser for help on using the repository browser.