source: palm/trunk/SOURCE/data_output_tseries.f90 @ 339

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

changes for coupling with independent precursor runs; z_i calculation with Sullivan criterion

  • Property svn:keywords set to Id
File size: 2.8 KB
Line 
1 SUBROUTINE data_output_tseries
2
3!------------------------------------------------------------------------------!
4! Current revisions:
5! -----------------
6! simulated_time in NetCDF output replaced by time_since_reference_point.
7! Output of NetCDF messages with aid of message handling routine.
8!
9!
10! Former revisions:
11! -----------------
12! $Id: data_output_tseries.f90 291 2009-04-16 12:07:26Z raasch $
13!
14! 48 2007-03-06 12:28:36Z raasch
15! Collection of time series quantities moved to routine flow_statistics,
16! output for "profil" removed
17!
18! RCS Log replace by Id keyword, revision history cleaned up
19!
20! Revision 1.13  2006/03/14 12:42:51  raasch
21! Error removed: NetCDF output only if switched on
22!
23! Revision 1.1  1998/03/03 08:00:13  raasch
24! Initial revision
25!
26!
27! Description:
28! ------------
29! Time series output for PROFIL. Always all time series are stored. A selection
30! can be applied via the PROFIL-parameters in close_file.
31!------------------------------------------------------------------------------!
32
33    USE control_parameters
34    USE cpulog
35    USE indices
36    USE interfaces
37    USE netcdf_control
38    USE pegrid
39    USE profil_parameter
40    USE statistics
41
42    IMPLICIT NONE
43
44
45    INTEGER ::  file_id, i, j, sr
46
47
48!
49!-- If required, compute statistics.
50    IF ( .NOT. flow_statistics_called )  CALL flow_statistics
51
52!
53!-- Flow_statistics has its own cpu-time measuring.
54    CALL cpu_log( log_point(21), 'data_output_tseries', 'start' )
55
56    IF ( myid == 0 )  THEN
57
58!
59!--    Open file for time series output in NetCDF format
60       IF ( netcdf_output )  THEN
61          dots_time_count = dots_time_count + 1
62          CALL check_open( 105 )
63#if defined( __netcdf )
64!
65!--       Update the time series time axis
66          nc_stat = NF90_PUT_VAR( id_set_ts, id_var_time_ts,        &
67                                  (/ time_since_reference_point /), &
68                                  start = (/ dots_time_count /),    &
69                                  count = (/ 1 /) )
70          CALL handle_netcdf_error( 'data_output_tseries', 350 )
71#endif
72       ENDIF
73
74!
75!--    Time series output for the total domain (and each subregion, if
76!--    applicable)
77       DO  sr = 0, statistic_regions
78
79#if defined( __netcdf )
80          IF ( netcdf_output )  THEN
81             DO  i = 1, dots_num
82                nc_stat = NF90_PUT_VAR( id_set_ts, id_var_dots(i,sr),  &
83                                        (/ ts_value(i,sr) /),          &
84                                        start = (/ dots_time_count /), &
85                                        count = (/ 1 /) )
86                CALL handle_netcdf_error( 'data_output_tseries', 351 )
87             ENDDO
88          ENDIF
89#endif
90
91       ENDDO
92
93    ENDIF
94
95
96    CALL cpu_log( log_point(21), 'data_output_tseries','stop', 'nobarrier' )
97
98!
99!-- formats
100500 FORMAT (23(E15.7,1X))
101
102 END SUBROUTINE data_output_tseries
Note: See TracBrowser for help on using the repository browser.