SUBROUTINE data_output_3d( av ) !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: data_output_3d.f90 98 2007-06-21 09:36:33Z forkel $ ! ! 96 2007-06-04 08:07:41Z raasch ! Output of density and salinity ! ! 75 2007-03-22 09:54:05Z raasch ! 2nd+3rd argument removed from exchange horiz ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.3 2006/06/02 15:18:59 raasch ! +argument "found", -argument grid in call of routine user_data_output_3d ! ! Revision 1.2 2006/02/23 10:23:07 raasch ! Former subroutine plot_3d renamed data_output_3d, pl.. renamed do.., ! .._anz renamed .._n, ! output extended to (almost) all quantities, output of user-defined quantities ! ! Revision 1.1 1997/09/03 06:29:36 raasch ! Initial revision ! ! ! Description: ! ------------ ! Output of the 3D-arrays in NetCDF and/or AVS format. !------------------------------------------------------------------------------! USE array_kind USE arrays_3d USE averaging USE cloud_parameters USE control_parameters USE cpulog USE indices USE interfaces USE netcdf_control USE particle_attributes USE pegrid IMPLICIT NONE CHARACTER (LEN=9) :: simulated_time_mod INTEGER :: av, i, if, j, k, n, pos, prec, psi LOGICAL :: found, resorted REAL :: mean_r, s_r3, s_r4 REAL(spk), DIMENSION(:,:,:), ALLOCATABLE :: local_pf REAL, DIMENSION(:,:,:), POINTER :: to_be_resorted ! !-- Return, if nothing to output IF ( do3d_no(av) == 0 ) RETURN CALL cpu_log (log_point(14),'data_output_3d','start') ! !-- Open output file. !-- Also creates coordinate and fld-file for AVS. !-- In case of a run on more than one PE, each PE opens its own file and !-- writes the data of its subdomain in binary format (regardless of the format !-- the user has requested). After the run, these files are combined to one !-- file by combine_plot_fields in the format requested by the user (netcdf !-- and/or avs). IF ( avs_output .OR. ( numprocs > 1 ) ) CALL check_open( 30 ) #if defined( __netcdf ) IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 106+av*10 ) #endif ! !-- Allocate a temporary array with the desired output dimensions. ALLOCATE( local_pf(nxl-1:nxr+1,nys-1:nyn+1,nzb:nz_do3d) ) ! !-- Update the NetCDF time axis #if defined( __netcdf ) do3d_time_count(av) = do3d_time_count(av) + 1 IF ( myid == 0 .AND. netcdf_output ) THEN nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_time_3d(av), & (/ simulated_time /), & start = (/ do3d_time_count(av) /), & count = (/ 1 /) ) IF (nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 1009 ) ENDIF #endif ! !-- Loop over all variables to be written. if = 1 DO WHILE ( do3d(av,if)(1:1) /= ' ' ) ! !-- Set the precision for data compression. IF ( do3d_compress ) THEN DO i = 1, 100 IF ( plot_3d_precision(i)%variable == do3d(av,if) ) THEN prec = plot_3d_precision(i)%precision EXIT ENDIF ENDDO ENDIF ! !-- Store the array chosen on the temporary array. resorted = .FALSE. SELECT CASE ( TRIM( do3d(av,if) ) ) CASE ( 'e' ) IF ( av == 0 ) THEN to_be_resorted => e ELSE to_be_resorted => e_av ENDIF CASE ( 'p' ) IF ( av == 0 ) THEN to_be_resorted => p ELSE to_be_resorted => p_av ENDIF CASE ( 'pc' ) ! particle concentration (requires ghostpoint exchange) IF ( av == 0 ) THEN tend = prt_count CALL exchange_horiz( tend ) DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 DO k = nzb, nz_do3d local_pf(i,j,k) = tend(k,j,i) ENDDO ENDDO ENDDO resorted = .TRUE. ELSE CALL exchange_horiz( pc_av ) to_be_resorted => pc_av ENDIF CASE ( 'pr' ) ! mean particle radius IF ( av == 0 ) THEN DO i = nxl, nxr DO j = nys, nyn DO k = nzb, nzt+1 psi = prt_start_index(k,j,i) s_r3 = 0.0 s_r4 = 0.0 DO n = psi, psi+prt_count(k,j,i)-1 s_r3 = s_r3 + particles(n)%radius**3 s_r4 = s_r4 + particles(n)%radius**4 ENDDO IF ( s_r3 /= 0.0 ) THEN mean_r = s_r4 / s_r3 ELSE mean_r = 0.0 ENDIF tend(k,j,i) = mean_r ENDDO ENDDO ENDDO CALL exchange_horiz( tend ) DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 DO k = nzb, nzt+1 local_pf(i,j,k) = tend(k,j,i) ENDDO ENDDO ENDDO resorted = .TRUE. ELSE CALL exchange_horiz( pr_av ) to_be_resorted => pr_av ENDIF CASE ( 'pt' ) IF ( av == 0 ) THEN IF ( .NOT. cloud_physics ) THEN to_be_resorted => pt ELSE DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 DO k = nzb, nz_do3d local_pf(i,j,k) = pt(k,j,i) + l_d_cp * & pt_d_t(k) * & ql(k,j,i) ENDDO ENDDO ENDDO resorted = .TRUE. ENDIF ELSE to_be_resorted => pt_av ENDIF CASE ( 'q' ) IF ( av == 0 ) THEN to_be_resorted => q ELSE to_be_resorted => q_av ENDIF CASE ( 'ql' ) IF ( av == 0 ) THEN to_be_resorted => ql ELSE to_be_resorted => ql_av ENDIF CASE ( 'ql_c' ) IF ( av == 0 ) THEN to_be_resorted => ql_c ELSE to_be_resorted => ql_c_av ENDIF CASE ( 'ql_v' ) IF ( av == 0 ) THEN to_be_resorted => ql_v ELSE to_be_resorted => ql_v_av ENDIF CASE ( 'ql_vp' ) IF ( av == 0 ) THEN to_be_resorted => ql_vp ELSE to_be_resorted => ql_vp_av ENDIF CASE ( 'qv' ) IF ( av == 0 ) THEN DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 DO k = nzb, nz_do3d local_pf(i,j,k) = q(k,j,i) - ql(k,j,i) ENDDO ENDDO ENDDO resorted = .TRUE. ELSE to_be_resorted => qv_av ENDIF CASE ( 'rho' ) IF ( av == 0 ) THEN to_be_resorted => rho ELSE to_be_resorted => rho_av ENDIF CASE ( 's' ) IF ( av == 0 ) THEN to_be_resorted => q ELSE to_be_resorted => q_av ENDIF CASE ( 'sa' ) IF ( av == 0 ) THEN to_be_resorted => sa ELSE to_be_resorted => sa_av ENDIF CASE ( 'u' ) IF ( av == 0 ) THEN to_be_resorted => u ELSE to_be_resorted => u_av ENDIF CASE ( 'v' ) IF ( av == 0 ) THEN to_be_resorted => v ELSE to_be_resorted => v_av ENDIF CASE ( 'vpt' ) IF ( av == 0 ) THEN to_be_resorted => vpt ELSE to_be_resorted => vpt_av ENDIF CASE ( 'w' ) IF ( av == 0 ) THEN to_be_resorted => w ELSE to_be_resorted => w_av ENDIF CASE DEFAULT ! !-- User defined quantity CALL user_data_output_3d( av, do3d(av,if), found, local_pf, & nz_do3d ) resorted = .TRUE. IF ( myid == 0 .AND. .NOT. found ) THEN PRINT*, '+++ data_output_3d: no output available for: ', & do3d(av,if) ENDIF END SELECT ! !-- Resort the array to be output, if not done above IF ( .NOT. resorted ) THEN DO i = nxl-1, nxr+1 DO j = nys-1, nyn+1 DO k = nzb, nz_do3d local_pf(i,j,k) = to_be_resorted(k,j,i) ENDDO ENDDO ENDDO ENDIF ! !-- Output of the volume data information for the AVS-FLD-file. do3d_avs_n = do3d_avs_n + 1 IF ( myid == 0 .AND. avs_output ) THEN ! !-- AVS-labels must not contain any colons. Hence they must be removed !-- from the time character string. simulated_time_mod = simulated_time_chr DO WHILE ( SCAN( simulated_time_mod, ':' ) /= 0 ) pos = SCAN( simulated_time_mod, ':' ) simulated_time_mod(pos:pos) = '/' ENDDO IF ( av == 0 ) THEN WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), & skip_do_avs, TRIM( do3d(av,if) ), & TRIM( simulated_time_mod ) ELSE WRITE ( 33, 3300 ) do3d_avs_n, TRIM( avs_data_file ), & skip_do_avs, TRIM( do3d(av,if) ) // & ' averaged', TRIM( simulated_time_mod ) ENDIF ! !-- Determine the Skip-value for the next array. Record end and start !-- require 4 byte each. skip_do_avs = skip_do_avs + ( ((nx+2)*(ny+2)*(nz_do3d+1)) * 4 + 8 ) ENDIF ! !-- Output of the 3D-array. (compressed/uncompressed) IF ( do3d_compress ) THEN ! !-- Compression, output of compression information on FLD-file and output !-- of compressed data. CALL write_compressed( local_pf, 30, 33, myid, nxl, nxr, nyn, nys, & nzb, nz_do3d, prec ) ELSE ! !-- Uncompressed output. #if defined( __parallel ) IF ( netcdf_output .AND. myid == 0 ) THEN WRITE ( 30 ) simulated_time, do3d_time_count(av), av ENDIF WRITE ( 30 ) nxl-1, nxr+1, nys-1, nyn+1, nzb, nz_do3d WRITE ( 30 ) local_pf #else IF ( avs_output ) THEN WRITE ( 30 ) local_pf(nxl:nxr+1,nys:nyn+1,:) ENDIF #if defined( __netcdf ) IF ( netcdf_output ) THEN nc_stat = NF90_PUT_VAR( id_set_3d(av), id_var_do3d(av,if), & local_pf(nxl:nxr+1,nys:nyn+1,nzb:nz_do3d), & start = (/ 1, 1, 1, do3d_time_count(av) /), & count = (/ nx+2, ny+2, nz_do3d-nzb+1, 1 /) ) IF ( nc_stat /= NF90_NOERR) CALL handle_netcdf_error( 1010 ) ENDIF #endif #endif ENDIF if = if + 1 ENDDO ! !-- Deallocate temporary array. DEALLOCATE( local_pf ) CALL cpu_log (log_point(14),'data_output_3d','stop','nobarrier') ! !-- Formats. 3300 FORMAT ('variable ',I4,' file=',A,' filetype=unformatted skip=',I12/ & 'label = ',A,A) END SUBROUTINE data_output_3d