source: palm/tags/release-5.0/SOURCE/data_output_flight.f90 @ 4106

Last change on this file since 4106 was 2696, checked in by kanani, 6 years ago

Merge of branch palm4u into trunk

  • Property svn:keywords set to Id
File size: 4.7 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
6! terms of the GNU General Public License as published by the Free Software
7! Foundation, either version 3 of the License, or (at your option) any later
8! 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-2017 Leibniz Universitaet Hannover
18!------------------------------------------------------------------------------!
19!
20! Current revisions:
21! ------------------
22!
23!
24! Former revisions:
25! -----------------
26! $Id: data_output_flight.f90 2696 2017-12-14 17:12:51Z gronemeier $
27!
28! 2000 2016-08-20 18:09:15Z knoop
29! Forced header and separation lines into 80 columns
30!
31! 1957 2016-07-07 10:43:48Z suehring
32! Initial revision
33!
34!
35! Description:
36! ------------
37!> Writing data from flight measurements on file.
38!------------------------------------------------------------------------------!
39 SUBROUTINE data_output_flight
40 
41#if defined( __netcdf )
42    USE control_parameters,                                                    &
43        ONLY:  message_string, num_leg, num_var_fl, run_description_header,    &
44               time_since_reference_point, virtual_flight
45
46    USE cpulog,                                                                &
47        ONLY:  cpu_log, log_point
48
49    USE flight_mod,                                                            &
50        ONLY:  sensor, x_pos, y_pos, z_pos
51
52    USE kinds
53
54    USE NETCDF
55
56    USE netcdf_interface,                                                      &
57        ONLY:  dofl_time_count, id_set_fl, id_var_dofl, id_var_time_fl,        &
58               id_var_x_fl, id_var_y_fl, id_var_z_fl, netcdf_handle_error,     &
59               nc_stat 
60             
61    USE pegrid
62
63    IMPLICIT NONE
64
65    INTEGER(iwp) ::  i !< loop variable for output quantities
66    INTEGER(iwp) ::  l !< loop variable for flight legs
67    INTEGER(iwp) ::  k !< internal count for variable labels and units
68
69    CALL cpu_log( log_point(64), 'data_output_flight', 'start' )
70
71!
72!-- Check if virtual flights are carried out
73    IF ( .NOT. virtual_flight )  RETURN
74
75!
76!-- Output is only performed on PE0
77    IF ( myid == 0 )  THEN
78
79!
80!--    Open file for flight output in NetCDF format
81       CALL check_open( 199 )
82
83!
84!--    Increment the counter for number of output times
85       dofl_time_count = dofl_time_count + 1
86
87!
88!--    Update the flight-output time and spatial coordinates
89       nc_stat = NF90_PUT_VAR( id_set_fl, id_var_time_fl,                      &
90                               (/ time_since_reference_point /),               &
91                               start = (/ dofl_time_count /),                  &
92                               count = (/ 1 /) )
93       CALL netcdf_handle_error( 'data_output_flight', 554 )
94
95       DO  l = 1, num_leg
96          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_x_fl(l),                   &
97                                  (/ x_pos(l) /),                              &
98                                  start = (/ dofl_time_count /),               &
99                                  count = (/ 1 /) )
100          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_y_fl(l),                   &
101                                  (/ y_pos(l) /),                              &
102                                  start = (/ dofl_time_count /),               &
103                                  count = (/ 1 /) )
104          nc_stat = NF90_PUT_VAR( id_set_fl, id_var_z_fl(l),                   &
105                                  (/ z_pos(l) /),                              &
106                                  start = (/ dofl_time_count /),               &
107                                  count = (/ 1 /) )
108          CALL netcdf_handle_error( 'data_output_flight', 555 )
109       ENDDO
110!
111!--    Output measured quantities
112       k = 1
113       DO  l = 1, num_leg
114          DO i = 1, num_var_fl
115             nc_stat = NF90_PUT_VAR( id_set_fl, id_var_dofl(k),                &
116                                     (/ sensor(i,l) /),                        &
117                                     start = (/ dofl_time_count /),            &
118                                     count = (/ 1 /) )
119
120             CALL netcdf_handle_error( 'data_output_flight', 556 )
121         
122             k = k + 1
123          ENDDO
124       ENDDO
125    ENDIF
126   
127    CALL cpu_log( log_point(64), 'data_output_flight', 'stop' )
128   
129#endif
130 END SUBROUTINE data_output_flight
Note: See TracBrowser for help on using the repository browser.