source: palm/trunk/SOURCE/data_output_flight.f90

Last change on this file was 4828, checked in by Giersch, 3 years ago

Copyright updated to year 2021, interface pmc_sort removed to accelarate the nesting code

  • Property svn:keywords set to Id
File size: 5.1 KB
Line 
1!> @file data_output_flight.f90
2!--------------------------------------------------------------------------------------------------!
3! This file is part of the PALM model system.
4!
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.
8!
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.
12!
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/>.
15!
16! Copyright 1997-2021 Leibniz Universitaet Hannover
17!--------------------------------------------------------------------------------------------------!
18!
19! Current revisions:
20! ------------------
21!
22!
23! Former revisions:
24! -----------------
25! $Id: data_output_flight.f90 4828 2021-01-05 11:21:41Z banzhafs $
26! file re-formatted to follow the PALM coding standard
27!
28! 4360 2020-01-07 11:25:50Z suehring
29! Corrected "Former revisions" section
30!
31! 3655 2019-01-07 16:51:22Z knoop
32! unused variables removed
33!
34! 1957 2016-07-07 10:43:48Z suehring
35! Initial revision
36!
37!
38! Description:
39! ------------
40!> Writing data from flight measurements on file.
41!--------------------------------------------------------------------------------------------------!
42 SUBROUTINE data_output_flight
43
44#if defined( __netcdf )
45    USE control_parameters,                                                                        &
46        ONLY:  num_leg, num_var_fl, time_since_reference_point, virtual_flight
47
48    USE cpulog,                                                                                    &
49        ONLY:  cpu_log, log_point
50
51    USE flight_mod,                                                                                &
52        ONLY:  sensor, x_pos, y_pos, z_pos
53
54    USE kinds
55
56    USE NETCDF
57
58    USE netcdf_interface,                                                                          &
59        ONLY:  dofl_time_count, id_set_fl, id_var_dofl, id_var_time_fl, id_var_x_fl, id_var_y_fl,  &
60               id_var_z_fl, nc_stat, netcdf_handle_error
61
62    USE pegrid
63
64    IMPLICIT NONE
65
66    INTEGER(iwp) ::  i !< loop variable for output quantities
67    INTEGER(iwp) ::  l !< loop variable for flight legs
68    INTEGER(iwp) ::  k !< internal count for variable labels and units
69
70    CALL cpu_log( log_point(64), 'data_output_flight', 'start' )
71
72!
73!-- Check if virtual flights are carried out
74    IF ( .NOT. virtual_flight )  RETURN
75
76!
77!-- Output is only performed on PE0
78    IF ( myid == 0 )  THEN
79
80!
81!--    Open file for flight output in NetCDF format
82       CALL check_open( 199 )
83
84!
85!--    Increment the counter for number of output times
86       dofl_time_count = dofl_time_count + 1
87
88!
89!--    Update the flight-output time and spatial coordinates
90       nc_stat = NF90_PUT_VAR( id_set_fl, id_var_time_fl,                                          &
91                               (/ time_since_reference_point /),                                   &
92                               start = (/ dofl_time_count /),                                      &
93                               count = (/ 1 /) )
94       CALL netcdf_handle_error( 'data_output_flight', 554 )
95
96       DO  l = 1, num_leg
97          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_x_fl(l),                                       &
98                                  (/ x_pos(l) /),                                                  &
99                                  start = (/ dofl_time_count /),                                   &
100                                  count = (/ 1 /) )
101          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_y_fl(l),                                       &
102                                  (/ y_pos(l) /),                                                  &
103                                  start = (/ dofl_time_count /),                                   &
104                                  count = (/ 1 /) )
105          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_z_fl(l),                                       &
106                                  (/ z_pos(l) /),                                                  &
107                                  start = (/ dofl_time_count /),                                   &
108                                  count = (/ 1 /) )
109          CALL netcdf_handle_error( 'data_output_flight', 555 )
110       ENDDO
111!
112!--    Output measured quantities
113       k = 1
114       DO  l = 1, num_leg
115          DO i = 1, num_var_fl
116             nc_stat = NF90_PUT_VAR( id_set_fl, id_var_dofl(k),                                    &
117                                     (/ sensor(i,l) /),                                            &
118                                     start = (/ dofl_time_count /),                                &
119                                     count = (/ 1 /) )
120
121             CALL netcdf_handle_error( 'data_output_flight', 556 )
122
123             k = k + 1
124          ENDDO
125       ENDDO
126    ENDIF
127
128    CALL cpu_log( log_point(64), 'data_output_flight', 'stop' )
129
130#endif
131 END SUBROUTINE data_output_flight
Note: See TracBrowser for help on using the repository browser.