SUBROUTINE data_output_tseries !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: data_output_tseries.f90 4 2007-02-13 11:33:16Z raasch $ ! 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 REAL :: ts_value(30) ! !-- 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 ! !-- Open file for time series output. IF ( profil_output ) THEN file_id = 50 + sr CALL check_open( file_id ) ENDIF ! !-- Collect and printout all time series quantities in a single line. ts_value(1) = hom(nzb+4,1,var_hom,sr) ! E ts_value(2) = hom(nzb+5,1,var_hom,sr) ! E* ts_value(3) = dt_3d ts_value(4) = hom(nzb,1,var_hom,sr) ! u* ts_value(5) = hom(nzb+3,1,var_hom,sr) ! th* ts_value(6) = u_max ts_value(7) = v_max ts_value(8) = w_max ts_value(9) = hom(nzb+10,1,var_sum,sr) ! new divergence ts_value(10) = hom(nzb+9,1,var_hom,sr) ! old Divergence ts_value(11) = hom(nzb+6,1,var_hom,sr) ! z_i(1) ts_value(12) = hom(nzb+7,1,var_hom,sr) ! z_i(2) ts_value(13) = hom(nzb+8,1,var_hom,sr) ! w* ts_value(14) = hom(nzb,1,16,sr) ! w'pt' at k=0 ts_value(15) = hom(nzb+1,1,16,sr) ! w'pt' at k=1 ts_value(16) = hom(nzb+1,1,18,sr) ! wpt at k=1 ts_value(17) = hom(nzb,1,4,sr) ! pt(0) ts_value(18) = hom(nzb+1,1,4,sr) ! pt(zp) ts_value(19) = hom(nzb+9,1,var_hom-1,sr) ! splptx ts_value(20) = hom(nzb+10,1,var_hom-1,sr) ! splpty ts_value(21) = hom(nzb+11,1,var_hom-1,sr) ! splptz IF ( ts_value(5) /= 0.0 ) THEN ts_value(22) = ts_value(4)**2 / & ( kappa * g * ts_value(5) / ts_value(18) ) ! L ELSE ts_value(22) = 10000.0 ENDIF #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) /), & start = (/ dots_time_count /), & count = (/ 1 /) ) IF ( nc_stat /= NF90_NOERR ) CALL handle_netcdf_error( 351 ) ENDDO ENDIF #endif IF ( profil_output ) THEN WRITE ( file_id, 500 ) simulated_time, ts_value(1:22) ! !-- y-value range of the crosses to be drawn by PROFIL !-- If required, enlarge them, provided they have not yet been !-- specified in !-- check_parameters DO i = 1, dots_n j = dots_crossindex(i) IF ( cross_ts_uymin(j) == 999.999 ) THEN ! !-- When the value range of the first line in the corresponding !-- cross is determined, its value range is simply adopted. IF ( cross_ts_uymin_computed(j) == 999.999 ) & THEN cross_ts_uymin_computed(j) = ts_value(dots_index(i)) ELSE cross_ts_uymin_computed(j) = & MIN(cross_ts_uymin_computed(j),ts_value(dots_index(i))) ENDIF ENDIF IF ( cross_ts_uymax(j) == 999.999 ) THEN ! !-- When the value range of the first line in the corresponding !-- cross is determined, its value range is simply adopted. IF ( cross_ts_uymax_computed(j) == 999.999 ) & THEN cross_ts_uymax_computed(j) = ts_value(dots_index(i)) ELSE cross_ts_uymax_computed(j) = & MAX(cross_ts_uymax_computed(j),ts_value(dots_index(i))) ENDIF ENDIF ENDDO ENDIF ENDDO ! Loop of subregions. ENDIF CALL cpu_log( log_point(21), 'data_output_tseries','stop', 'nobarrier' ) ! !-- formats 500 FORMAT (23(E15.7,1X)) END SUBROUTINE data_output_tseries