source: palm/trunk/SOURCE/user_flight.f90 @ 4598

Last change on this file since 4598 was 4498, checked in by raasch, 4 years ago

bugfix for creation of filetypes, argument removed from rd_mpi_io_open, files re-formatted to follow the PALM coding standard

  • Property svn:keywords set to Id
File size: 3.0 KB
RevLine 
[3684]1!> @file user_flight.f90
[4498]2!--------------------------------------------------------------------------------------------------!
[2696]3! This file is part of the PALM model system.
[1957]4!
[4498]5! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
6! Public License as published by the Free Software Foundation, either version 3 of the License, or
7! (at your option) any later version.
[1957]8!
[4498]9! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
10! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
11! Public License for more details.
[1957]12!
[4498]13! You should have received a copy of the GNU General Public License along with PALM. If not, see
14! <http://www.gnu.org/licenses/>.
[1957]15!
[4360]16! Copyright 1997-2020 Leibniz Universitaet Hannover
[4498]17!--------------------------------------------------------------------------------------------------!
[1957]18!
[4498]19!
[1957]20! Current revisions:
[4498]21! -----------------
[1957]22!
[2001]23!
[1957]24! Former revisions:
25! -----------------
26! $Id: user_flight.f90 4498 2020-04-15 14:26:31Z suehring $
[4498]27! file re-formatted to follow the PALM coding standard
28!
29!
30! 4360 2020-01-07 11:25:50Z suehring
[4182]31! Corrected "Former revisions" section
[4498]32!
[4182]33! 3768 2019-02-27 14:35:58Z raasch
[3768]34! unused variables commented out + statement added to avoid compiler warnings
[4498]35!
[3768]36! 3684 2019-01-20 20:20:58Z knoop
[2716]37! Corrected "Former revisions" section
[4498]38!
[4182]39! 1957 2016-07-07 10:43:48Z suehring
40! Initial revision
[1957]41!
42! Description:
43! ------------
[4498]44!> Calculation of user-defined output quantity for flight measurements after each timestep.
45!--------------------------------------------------------------------------------------------------!
[1957]46 SUBROUTINE user_flight( var, id )
47
48    USE control_parameters
[4498]49
[1957]50    USE grid_variables
51
52    USE indices
53
54    USE kinds
55
56    USE user
57
58    USE arrays_3d
59
60    IMPLICIT NONE
61
[3768]62!    INTEGER(iwp) ::  i  !< index along x
63!    INTEGER(iwp) ::  j  !< index along y
64!    INTEGER(iwp) ::  k  !< index along z
[4498]65    INTEGER(iwp) ::  id  !< variable identifyer, according to the settings in user_init_flight
[1957]66
[4498]67    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< treated variable
68
[1957]69!
[3768]70!-- Next line is to avoid compiler warning about unused variables. Please remove.
71    IF ( id == 0  .OR.  var(nzb,nysg,nxlg) == 0.0_wp )  CONTINUE
72
73!
[4498]74!-- Here, the respective variable is calculated. There is no call of exchange_horiz necessary.
75!-- The variable identifyer (id) must be set according to the settings in user_init_flight.
[1957]76!-- Please note, so far, variable must be located at the center of a grid box.
77!     var = 0.0_wp
78
79!     SELECT CASE ( id )
[4498]80!
[1957]81!        CASE ( 1 )
[4498]82!           DO  i = nxl-1, nxr+1
83!              DO  j = nys-1, nyn+1
84!                 DO  k = nzb, nzt
[1957]85!                    var(k,j,i) = ABS( u(k,j,i )
86!                 ENDDO
87!              ENDDO
88!           ENDDO
[4498]89!
[1957]90!        CASE ( 2 )
[4498]91!           DO  i = nxl-1, nxr+1
92!              DO  j = nys-1, nyn+1
93!                 DO  k = nzb, nzt
[1957]94!                    var(k,j,i) = ABS( v(k,j,i) )
95!                 ENDDO
96!              ENDDO
97!           ENDDO
[4498]98!
[1957]99!     END SELECT
100
101
102 END SUBROUTINE user_flight
Note: See TracBrowser for help on using the repository browser.