SUBROUTINE data_output_tseries !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: data_output_tseries.f90 77 2007-03-29 04:26:56Z raasch $ ! ! 48 2007-03-06 12:28:36Z raasch ! Collection of time series quantities moved to routine flow_statistics, ! output for "profil" removed ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.13 2006/03/14 12:42:51 raasch ! Error removed: NetCDF output only if switched on ! ! Revision 1.1 1998/03/03 08:00:13 raasch ! Initial revision ! ! ! Description: ! ------------ ! Time series output for PROFIL. Always all time series are stored. A selection ! can be applied via the PROFIL-parameters in close_file. !------------------------------------------------------------------------------! USE control_parameters USE cpulog USE indices USE interfaces USE netcdf_control USE pegrid USE profil_parameter USE statistics IMPLICIT NONE INTEGER :: file_id, i, j, sr ! !-- If required, compute statistics. IF ( .NOT. flow_statistics_called ) CALL flow_statistics ! !-- Flow_statistics has its own cpu-time measuring. CALL cpu_log( log_point(21), 'data_output_tseries', 'start' ) IF ( myid == 0 ) THEN ! !-- Open file for time series output in NetCDF format IF ( netcdf_output ) THEN dots_time_count = dots_time_count + 1 CALL check_open( 105 ) #if defined( __netcdf ) ! !-- Update the time series time axis nc_stat = NF90_PUT_VAR( id_set_ts, id_var_time_ts, & (/ simulated_time /), & start = (/ dots_time_count /), & count = (/ 1 /) ) IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 350 ) #endif ENDIF ! !-- Time series output for the total domain (and each subregion, if !-- applicable) DO sr = 0, statistic_regions #if defined( __netcdf ) IF ( netcdf_output ) THEN DO i = 1, dots_num nc_stat = NF90_PUT_VAR( id_set_ts, id_var_dots(i,sr), & (/ ts_value(i,sr) /), & start = (/ dots_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 351 ) ENDDO ENDIF #endif ENDDO ENDIF CALL cpu_log( log_point(21), 'data_output_tseries','stop', 'nobarrier' ) ! !-- formats 500 FORMAT (23(E15.7,1X)) END SUBROUTINE data_output_tseries