SUBROUTINE read_3d_binary !------------------------------------------------------------------------------! ! Actual revisions: ! ----------------- ! ! ! Former revisions: ! ----------------- ! $Id: read_3d_binary.f90 39 2007-03-01 12:46:59Z raasch $ ! +qswst, qswst_m, tswst, tswst_m ! ! 19 2007-02-23 04:53:48Z raasch ! ! RCS Log replace by Id keyword, revision history cleaned up ! ! Revision 1.4 2006/08/04 15:02:32 raasch ! +iran, iran_part ! ! Revision 1.1 2004/04/30 12:47:27 raasch ! Initial revision ! ! ! Description: ! ------------ ! Binary input of variables and arrays from restart file !------------------------------------------------------------------------------! USE arrays_3d USE averaging USE control_parameters USE cpulog USE indices USE interfaces USE particle_attributes USE pegrid USE profil_parameter USE random_function_mod USE statistics IMPLICIT NONE CHARACTER (LEN=10) :: binary_version, version_on_file CHARACTER (LEN=20) :: field_chr CHARACTER (LEN=10), DIMENSION(:), ALLOCATABLE :: chdum10 CHARACTER (LEN=40), DIMENSION(:), ALLOCATABLE :: chdum40 CHARACTER (LEN=100), DIMENSION(:), ALLOCATABLE :: chdum100 INTEGER :: idum1, myid_on_file, numprocs_on_file, nxl_on_file, & nxr_on_file, nyn_on_file, nys_on_file, nzb_on_file, nzt_on_file INTEGER, DIMENSION(:), ALLOCATABLE :: idum REAL, DIMENSION(:), ALLOCATABLE :: rdum ! !-- Read data from previous model run. unit 13 already opened in parin CALL cpu_log( log_point_s(14), 'read_3d_binary', 'start' ) ! !-- First compare the version numbers READ ( 13 ) version_on_file binary_version = '3.0' IF ( TRIM( version_on_file ) /= TRIM( binary_version ) ) THEN IF ( myid == 0 ) THEN PRINT*, '+++ init_3d_model: version mismatch concerning data ', & 'from prior run' PRINT*, ' version on file = "', TRIM( version_on_file ),& '"' PRINT*, ' version in program = "', TRIM( binary_version ), & '"' ENDIF CALL local_stop ENDIF ! !-- Read and compare number of processors, processor-id and array ranges READ ( 13 ) numprocs_on_file, myid_on_file, nxl_on_file, nxr_on_file, & nys_on_file, nyn_on_file, nzb_on_file, nzt_on_file IF ( numprocs_on_file /= numprocs ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' numprocs on file = ', numprocs_on_file PRINT*, ' numprocs = ', numprocs CALL local_stop ENDIF IF ( myid_on_file /= myid ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run' PRINT*, ' myid_on_file = ', myid_on_file PRINT*, ' myid = ', myid #if defined( __parallel ) CALL MPI_ABORT( comm2d, 9999, ierr ) #else CALL local_stop #endif ENDIF IF ( nxl_on_file /= nxl ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' nxl on file = ', nxl_on_file PRINT*, ' nxl = ', nxl #if defined( __parallel ) CALL MPI_ABORT( comm2d, 9999, ierr ) #else CALL local_stop #endif ENDIF IF ( nxr_on_file /= nxr ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' nxr on file = ', nxr_on_file PRINT*, ' nxr = ', nxr #if defined( __parallel ) CALL MPI_ABORT( comm2d, 9999, ierr ) #else CALL local_stop #endif ENDIF IF ( nys_on_file /= nys ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' nys on file = ', nys_on_file PRINT*, ' nys = ', nys #if defined( __parallel ) CALL MPI_ABORT( comm2d, 9999, ierr ) #else CALL local_stop #endif ENDIF IF ( nyn_on_file /= nyn ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' nyn on file = ', nyn_on_file PRINT*, ' nyn = ', nyn #if defined( __parallel ) CALL MPI_ABORT( comm2d, 9999, ierr ) #else CALL local_stop #endif ENDIF IF ( nzb_on_file /= nzb ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' nzb on file = ', nzb_on_file PRINT*, ' nzb = ', nzb CALL local_stop ENDIF IF ( nzt_on_file /= nzt ) THEN PRINT*, '+++ init_3d_model: mismatch between actual data and data ' PRINT*, ' from prior run on PE ', myid PRINT*, ' nzt on file = ', nzt_on_file PRINT*, ' nzt = ', nzt CALL local_stop ENDIF ! !-- Local arrays that may be required for possible temporary information !-- storage in the following ALLOCATE( chdum10(crmax), chdum40(crmax), chdum100(crmax), & idum(100*crmax), rdum(100*crmax) ) ! !-- Initialize spectra (for the case of just starting spectra computation !-- in continuation runs) IF ( dt_dosp /= 9999999.9 ) THEN spectrum_x = 0.0 spectrum_y = 0.0 ENDIF ! !-- Read arrays !-- ATTENTION: If the following read commands have been altered, the !-- ---------- version number of the variable binary_version must be altered, !-- too. Furthermore, the output list of arrays in write_3d_binary !-- must also be altered accordingly. READ ( 13 ) field_chr DO WHILE ( TRIM( field_chr ) /= '*** end ***' ) SELECT CASE ( TRIM( field_chr ) ) CASE ( 'e' ) READ ( 13 ) e CASE ( 'e_av' ) ALLOCATE( e_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) e_av CASE ( 'e_m' ) READ ( 13 ) e_m CASE ( 'iran' ) READ ( 13 ) iran, iran_part CASE ( 'kh' ) READ ( 13 ) kh CASE ( 'kh_m' ) READ ( 13 ) kh_m CASE ( 'km' ) READ ( 13 ) km CASE ( 'km_m' ) READ ( 13 ) km_m CASE ( 'lwp_av' ) ALLOCATE( lwp_av(nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) lwp_av CASE ( 'p' ) READ ( 13 ) p CASE ( 'p_av' ) ALLOCATE( p_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) p_av CASE ( 'pc_av' ) ALLOCATE( pc_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) pc_av CASE ( 'pr_av' ) ALLOCATE( pr_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) pr_av CASE ( 'pt' ) READ ( 13 ) pt CASE ( 'pt_av' ) ALLOCATE( pt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) pt_av CASE ( 'pt_m' ) READ ( 13 ) pt_m CASE ( 'q' ) READ ( 13 ) q CASE ( 'q_av' ) ALLOCATE( q_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) q_av CASE ( 'q_m' ) READ ( 13 ) q_m CASE ( 'ql' ) READ ( 13 ) ql CASE ( 'ql_av' ) ALLOCATE( ql_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) ql_av CASE ( 'ql_c_av' ) ALLOCATE( ql_c_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) ql_c_av CASE ( 'ql_v_av' ) ALLOCATE( ql_v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) ql_v_av CASE ( 'ql_vp_av' ) ALLOCATE( ql_vp_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) ql_vp_av CASE ( 'qs' ) READ ( 13 ) qs CASE ( 'qsws' ) READ ( 13 ) qsws CASE ( 'qsws_m' ) READ ( 13 ) qsws_m CASE ( 'qswst' ) READ ( 13 ) qswst CASE ( 'qswst_m' ) READ ( 13 ) qswst_m CASE ( 'qv_av' ) ALLOCATE( qv_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) qv_av CASE ( 'random_iv' ) READ ( 13 ) random_iv READ ( 13 ) random_iy CASE ( 'rif' ) READ ( 13 ) rif CASE ( 'rif_m' ) READ ( 13 ) rif_m CASE ( 's_av' ) ALLOCATE( s_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) s_av CASE ( 'shf' ) READ ( 13 ) shf CASE ( 'shf_m' ) READ ( 13 ) shf_m CASE ( 'tswst' ) READ ( 13 ) tswst CASE ( 'tswst_m' ) READ ( 13 ) tswst_m CASE ( 'spectrum_x' ) READ ( 13 ) spectrum_x CASE ( 'spectrum_y' ) READ ( 13 ) spectrum_y CASE ( 'ts' ) READ ( 13 ) ts CASE ( 'ts_av' ) ALLOCATE( ts_av(nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) ts_av CASE ( 'u' ) READ ( 13 ) u CASE ( 'u_av' ) ALLOCATE( u_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) u_av CASE ( 'u_m' ) READ ( 13 ) u_m CASE ( 'us' ) READ ( 13 ) us CASE ( 'usws' ) READ ( 13 ) usws CASE ( 'usws_m' ) READ ( 13 ) usws_m CASE ( 'us_av' ) ALLOCATE( us_av(nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) us_av CASE ( 'v' ) READ ( 13 ) v CASE ( 'volume_flow_area' ) READ ( 13 ) volume_flow_area CASE ( 'volume_flow_initial' ) READ ( 13 ) volume_flow_initial CASE ( 'v_av' ) ALLOCATE( v_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) v_av CASE ( 'v_m' ) READ (13 ) v_m CASE ( 'vpt' ) READ ( 13 ) vpt CASE ( 'vpt_av' ) ALLOCATE( vpt_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) vpt_av CASE ( 'vpt_m' ) READ ( 13 ) vpt_m CASE ( 'vsws' ) READ ( 13 ) vsws CASE ( 'vsws_m' ) READ ( 13 ) vsws_m CASE ( 'w' ) READ ( 13 ) w CASE ( 'w_av' ) ALLOCATE( w_av(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ) READ ( 13 ) w_av CASE ( 'w_m' ) READ ( 13 ) w_m CASE ( 'z0' ) READ ( 13 ) z0 CASE ( 'cross_linecolors' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_linecolors ELSE READ ( 13 ) idum ENDIF CASE ( 'cross_linestyles' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_linestyles ELSE READ ( 13 ) idum ENDIF CASE ( 'cross_normalized_x' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_normalized_x ELSE READ ( 13 ) chdum10 ENDIF CASE ( 'cross_normalized_y' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_normalized_y ELSE READ ( 13 ) chdum10 ENDIF CASE ( 'cross_normx_factor' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_normx_factor ELSE READ ( 13 ) rdum ENDIF CASE ( 'cross_normy_factor' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_normy_factor ELSE READ ( 13 ) rdum ENDIF CASE ( 'cross_profiles' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_profiles ELSE READ ( 13 ) chdum100 ENDIF CASE ( 'cross_profile_n_coun' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_profile_number_count ELSE READ ( 13 ) idum(1:crmax) ENDIF CASE ( 'cross_profile_number' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_profile_numbers ELSE READ ( 13 ) idum ENDIF CASE ( 'cross_uxmax' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmax ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmax_computed' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmax_computed ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmax_normaliz' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmax_normalized ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmax_norm_com' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmax_normalized_computed ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmin' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmin ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmin_computed' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmin_computed ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmin_normaliz' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmin_normalized ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uxmin_norm_com' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uxmin_normalized_computed ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uymax' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uymax ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_uymin' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_uymin ELSE READ ( 13 ) rdum(1:crmax) ENDIF CASE ( 'cross_xtext' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) cross_xtext ELSE READ ( 13 ) chdum40 ENDIF CASE ( 'dopr_crossindex' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) dopr_crossindex ELSE READ ( 13 ) idum(1:100) ENDIF CASE ( 'dopr_time_count' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) dopr_time_count ELSE READ ( 13 ) idum1 ENDIF CASE ( 'hom_sum' ) READ ( 13 ) hom_sum CASE ( 'profile_columns' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) profile_columns ELSE READ ( 13 ) idum1 ENDIF CASE ( 'profile_number' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) profile_number ELSE READ ( 13 ) idum1 ENDIF CASE ( 'profile_rows' ) IF ( use_prior_plot1d_parameters ) THEN READ ( 13 ) profile_rows ELSE READ ( 13 ) idum1 ENDIF CASE DEFAULT PRINT*, '+++ init_3d_model: unknown field named "', & TRIM( field_chr ), '" found in' PRINT*, ' data from prior run on PE ', myid CALL local_stop END SELECT ! !-- Read next character string READ ( 13 ) field_chr ENDDO DEALLOCATE( chdum10, chdum40, chdum100, idum, rdum ) ! !-- End of time measuring for reading binary data CALL cpu_log( log_point_s(14), 'read_3d_binary', 'stop' ) END SUBROUTINE read_3d_binary