Changeset 4525
- Timestamp:
- May 10, 2020 5:05:07 PM (5 years ago)
- Location:
- palm/trunk
- Files:
-
- 5 edited
-
SOURCE/Makefile (modified) (2 diffs)
-
SOURCE/module_interface.f90 (modified) (6 diffs)
-
SOURCE/plant_canopy_model_mod.f90 (modified) (4 diffs)
-
SOURCE/salsa_mod.f90 (modified) (16 diffs)
-
TUTORIALS/cases/dispersion_eulerian_and_lpm_extended/USER_CODE/user_module.f90 (modified) (53 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r4522 r4525 25 25 # ----------------- 26 26 # $Id$ 27 # dependency for salsa_mod updated 28 # 29 # 4522 2020-05-06 14:17:05Z suehring 27 30 # routine user_init_flight renamed to user_init_flight_mod 28 31 # … … 1110 1113 palm_date_time_mod.o \ 1111 1114 plant_canopy_model_mod.o \ 1115 restart_data_mpi_io_mod.o \ 1112 1116 surface_mod.o \ 1113 1117 netcdf_data_input_mod.o -
palm/trunk/SOURCE/module_interface.f90
r4518 r4525 25 25 ! ----------------- 26 26 ! $Id$ 27 ! added restart I/O for global salsa data, 28 ! added restart with MPI-IO for salsa 29 ! 30 ! 4518 2020-05-04 15:44:28Z suehring 27 31 ! Call of doq_rrd_local enabled 28 32 ! … … 489 493 salsa_data_output_3d, & 490 494 salsa_statistics, & 495 salsa_rrd_global, & 491 496 salsa_rrd_local, & 497 salsa_wrd_global, & 492 498 salsa_wrd_local 493 499 … … 1736 1742 IF ( .NOT. found ) CALL pcm_rrd_global( found ) 1737 1743 IF ( .NOT. found ) CALL ocean_rrd_global( found ) ! ToDo: change interface to pass variable 1744 IF ( .NOT. found ) CALL salsa_rrd_global( found ) 1738 1745 IF ( .NOT. found ) CALL stg_rrd_global ( found ) ! ToDo: change interface to pass variable 1739 1746 IF ( .NOT. found ) CALL wtm_rrd_global( found ) ! ToDo: change interface to pass variable … … 1767 1774 IF ( plant_canopy ) CALL pcm_rrd_global 1768 1775 IF ( ocean_mode ) CALL ocean_rrd_global 1776 IF ( salsa ) CALL salsa_rrd_global 1769 1777 IF ( syn_turb_gen ) CALL stg_rrd_global 1770 1778 IF ( wind_turbine ) CALL wtm_rrd_global … … 1798 1806 IF ( plant_canopy ) CALL pcm_wrd_global 1799 1807 IF ( ocean_mode ) CALL ocean_wrd_global 1808 IF ( salsa ) CALL salsa_wrd_global 1800 1809 IF ( syn_turb_gen ) CALL stg_wrd_global 1801 1810 IF ( wind_turbine ) CALL wtm_wrd_global … … 2004 2013 IF ( ocean_mode ) CALL ocean_rrd_local 2005 2014 IF ( radiation ) CALL radiation_rrd_local 2006 !IF ( salsa ) CALL salsa_rrd_local2015 IF ( salsa ) CALL salsa_rrd_local 2007 2016 IF ( urban_surface ) CALL usm_rrd_local 2008 2017 IF ( surface_output ) CALL surface_data_output_rrd_local -
palm/trunk/SOURCE/plant_canopy_model_mod.f90
r4517 r4525 27 27 ! ----------------- 28 28 ! $Id$ 29 ! bugfix for reading/writing pcm_...rate_av with MPI-IO 30 ! 31 ! 4517 2020-05-03 14:29:30Z raasch 29 32 ! added restart with MPI-IO for reading local arrays 30 33 ! … … 1771 1774 LOGICAL :: array_found !< 1772 1775 1773 1774 !> TODO: following code does not work because arrays are sized 0:pch_index along k!!!!! 1776 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_3d !< temporary array to store pcm data with 1777 !< non-standard vertical index bounds 1778 1779 ! 1780 !-- Plant canopy arrays have non standard reduced vertical index bounds. They are stored with 1781 !-- full vertical bounds (bzb:nzt+1) in the restart file and must be re-stored after reading. 1775 1782 CALL rd_mpi_io_check_array( 'pcm_heatrate_av' , found = array_found ) 1776 1783 IF ( array_found ) THEN 1777 IF ( .NOT. ALLOCATED( pcm_heatrate_av ) ) ALLOCATE( pcm_heatrate_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1778 CALL rrd_mpi_io( 'pcm_heatrate_av', pcm_heatrate_av ) 1784 IF ( .NOT. ALLOCATED( pcm_heatrate_av ) ) THEN 1785 ALLOCATE( pcm_heatrate_av(nzb:pch_index,nysg:nyng,nxlg:nxrg) ) 1786 ENDIF 1787 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1788 CALL rrd_mpi_io( 'pcm_heatrate_av', tmp_3d ) 1789 pcm_heatrate_av = tmp_3d(nzb:pch_index,:,:) 1790 DEALLOCATE( tmp_3d ) 1779 1791 ENDIF 1780 1792 1781 1793 CALL rd_mpi_io_check_array( 'pcm_latentrate_av' , found = array_found ) 1782 1794 IF ( array_found ) THEN 1783 IF ( .NOT. ALLOCATED( pcm_latentrate_av ) ) ALLOCATE( pcm_latentrate_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1784 CALL rrd_mpi_io( 'pcm_latentrate_av', pcm_latentrate_av ) 1795 IF ( .NOT. ALLOCATED( pcm_latentrate_av ) ) THEN 1796 ALLOCATE( pcm_latentrate_av(nzb:pch_index,nysg:nyng,nxlg:nxrg) ) 1797 ENDIF 1798 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1799 CALL rrd_mpi_io( 'pcm_latentrate_av', tmp_3d ) 1800 pcm_latentrate_av = tmp_3d(nzb:pch_index,:,:) 1801 DEALLOCATE( tmp_3d ) 1785 1802 ENDIF 1786 1803 1787 1804 CALL rd_mpi_io_check_array( 'pcm_transpirationrate_av' , found = array_found ) 1788 1805 IF ( array_found ) THEN 1789 IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) ) ALLOCATE( pcm_transpirationrate_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1790 CALL rrd_mpi_io( 'pcm_transpirationrate_av', pcm_transpirationrate_av ) 1806 IF ( .NOT. ALLOCATED( pcm_transpirationrate_av ) ) THEN 1807 ALLOCATE( pcm_transpirationrate_av(nzb:pch_index,nysg:nyng,nxlg:nxrg) ) 1808 ENDIF 1809 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1810 CALL rrd_mpi_io( 'pcm_transpirationrate_av', tmp_3d ) 1811 pcm_transpirationrate_av = tmp_3d(nzb:pch_index,:,:) 1812 DEALLOCATE( tmp_3d ) 1791 1813 ENDIF 1792 1814 … … 2570 2592 SUBROUTINE pcm_wrd_local 2571 2593 2594 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_3d !< temporary array to store pcm data with 2595 !< non-standard vertical index bounds 2596 2572 2597 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 2573 2598 … … 2589 2614 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN 2590 2615 2591 IF ( ALLOCATED( pcm_heatrate_av ) ) CALL wrd_mpi_io( 'pcm_heatrate_av', pcm_heatrate_av ) 2616 ! 2617 !-- Plant canopy arrays have non standard reduced vertical index bounds. They are stored with 2618 !-- full vertical bounds (bzb:nzt+1) in the restart file and must be re-stored before writing. 2619 IF ( ALLOCATED( pcm_heatrate_av ) ) THEN 2620 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 2621 tmp_3d(nzb:pch_index,:,:) = pcm_heatrate_av 2622 tmp_3d(pch_index+1:nzt+1,:,:) = 0.0_wp 2623 CALL wrd_mpi_io( 'pcm_heatrate_av', tmp_3d ) 2624 DEALLOCATE( tmp_3d ) 2625 ENDIF 2592 2626 IF ( ALLOCATED( pcm_latentrate_av ) ) THEN 2593 CALL wrd_mpi_io( 'pcm_latentrate_av', pcm_latentrate_av ) 2627 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 2628 tmp_3d(nzb:pch_index,:,:) = pcm_latentrate_av 2629 tmp_3d(pch_index+1:nzt+1,:,:) = 0.0_wp 2630 CALL wrd_mpi_io( 'pcm_latentrate_av', tmp_3d ) 2631 DEALLOCATE( tmp_3d ) 2594 2632 ENDIF 2595 2633 IF ( ALLOCATED( pcm_transpirationrate_av ) ) THEN 2596 CALL wrd_write_string( 'pcm_transpirationrate_av', pcm_transpirationrate_av ) 2634 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 2635 tmp_3d(nzb:pch_index,:,:) = pcm_transpirationrate_av 2636 tmp_3d(pch_index+1:nzt+1,:,:) = 0.0_wp 2637 CALL wrd_mpi_io( 'pcm_transpirationrate_av', tmp_3d ) 2638 DEALLOCATE( tmp_3d ) 2597 2639 ENDIF 2598 2640 -
palm/trunk/SOURCE/salsa_mod.f90
r4512 r4525 26 26 ! ----------------- 27 27 ! $Id$ 28 ! added reading/writing of global restart data, 29 ! added reading/writing restart data with MPI-IO, 30 ! variable write_binary_salsa removed 31 ! 32 ! 4512 2020-04-30 12:55:34Z monakurppa 28 33 ! Fixed a bug in component_index_constructor: index out of bounds if all chemical 29 34 ! components are used … … 306 311 bc_radiation_s, coupling_char, debug_output, dt_3d, intermediate_timestep_count, & 307 312 intermediate_timestep_count_max, land_surface, max_pr_salsa, message_string, & 308 monotonic_limiter_z, plant_canopy, pt_surface, salsa, scalar_advec,&309 s urface_pressure, time_since_reference_point, timestep_scheme, tsc, urban_surface,&310 ws_scheme_sca313 monotonic_limiter_z, plant_canopy, pt_surface, restart_data_format_output, salsa, & 314 scalar_advec, surface_pressure, time_since_reference_point, timestep_scheme, tsc, & 315 urban_surface, ws_scheme_sca 311 316 312 317 USE indices, & … … 320 325 321 326 USE pegrid 327 328 USE restart_data_mpi_io_mod, & 329 ONLY: rd_mpi_io_check_array, rrd_mpi_io, rrd_mpi_io_global_array, wrd_mpi_io, & 330 wrd_mpi_io_global_array 322 331 323 332 USE statistics, & … … 551 560 LOGICAL :: salsa_gases_from_chem = .FALSE. !< Transfer the gaseous components to SALSA 552 561 LOGICAL :: van_der_waals_coagc = .FALSE. !< Include van der Waals and viscous forces in coagulation 553 LOGICAL :: write_binary_salsa = .TRUE. !< read binary for salsa554 562 555 563 ! … … 986 994 END INTERFACE salsa_prognostic_equations 987 995 996 INTERFACE salsa_rrd_global 997 MODULE PROCEDURE salsa_rrd_global_ftn 998 MODULE PROCEDURE salsa_rrd_global_mpi 999 END INTERFACE salsa_rrd_global 1000 988 1001 INTERFACE salsa_rrd_local 989 MODULE PROCEDURE salsa_rrd_local 1002 MODULE PROCEDURE salsa_rrd_local_ftn 1003 MODULE PROCEDURE salsa_rrd_local_mpi 990 1004 END INTERFACE salsa_rrd_local 991 1005 … … 1002 1016 MODULE PROCEDURE salsa_tendency_ij 1003 1017 END INTERFACE salsa_tendency 1018 1019 INTERFACE salsa_wrd_global 1020 MODULE PROCEDURE salsa_wrd_global 1021 END INTERFACE salsa_wrd_global 1004 1022 1005 1023 INTERFACE salsa_wrd_local … … 1035 1053 salsa_parin, & 1036 1054 salsa_prognostic_equations, & 1055 salsa_rrd_global, & 1037 1056 salsa_rrd_local, & 1038 1057 salsa_statistics, & 1039 1058 salsa_swap_timelevel, & 1059 salsa_wrd_global, & 1040 1060 salsa_wrd_local 1041 1061 … … 1130 1150 ocnv_init, & 1131 1151 ocsv_init, & 1132 read_restart_data_salsa, &1133 1152 reglim, & 1134 1153 salsa, & … … 1139 1158 skip_time_do_salsa, & 1140 1159 surface_aerosol_flux, & 1141 van_der_waals_coagc, & 1142 write_binary_salsa 1160 van_der_waals_coagc 1143 1161 1144 1162 line = ' ' … … 2972 2990 ! Description: 2973 2991 ! ------------ 2974 !> This routine reads the respective restart data. 2975 !------------------------------------------------------------------------------! 2976 SUBROUTINE salsa_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & 2977 nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found ) 2992 !> Read module-specific global restart data (Fortran binary format). 2993 !------------------------------------------------------------------------------! 2994 SUBROUTINE salsa_rrd_global_ftn( found ) 2995 2996 USE control_parameters, & 2997 ONLY: length, restart_string 2998 2999 3000 IMPLICIT NONE 3001 3002 LOGICAL, INTENT(OUT) :: found 3003 3004 3005 found = .TRUE. 3006 3007 SELECT CASE ( restart_string(1:length) ) 3008 3009 CASE ( 'listspec' ) 3010 READ ( 13 ) listspec 3011 3012 CASE ( 'nbin' ) 3013 READ ( 13 ) nbin 3014 3015 CASE ( 'nf2a' ) 3016 READ ( 13 ) nf2a 3017 3018 CASE ( 'ncc' ) 3019 READ ( 13 ) ncc 3020 3021 CASE ( 'mass_fracs_a' ) 3022 READ ( 13 ) mass_fracs_a 3023 3024 CASE ( 'mass_fracs_b' ) 3025 READ ( 13 ) mass_fracs_b 3026 3027 CASE DEFAULT 3028 3029 found = .FALSE. 3030 3031 END SELECT 3032 3033 END SUBROUTINE salsa_rrd_global_ftn 3034 3035 3036 !------------------------------------------------------------------------------! 3037 ! Description: 3038 ! ------------ 3039 !> Read module-specific global restart data (MPI-IO). 3040 !------------------------------------------------------------------------------! 3041 SUBROUTINE salsa_rrd_global_mpi 3042 3043 IMPLICIT NONE 3044 3045 CHARACTER(LEN=1) :: counter !< counter used for output-variable names 3046 3047 INTEGER(iwp) :: i !< loop counter 3048 3049 3050 DO i = 1, 7 3051 WRITE( counter, '(I1)' ) i 3052 CALL rrd_mpi_io( 'listspec_' // counter, listspec(i) ) 3053 ENDDO 3054 3055 CALL rrd_mpi_io_global_array( 'nbin', nbin ) 3056 CALL rrd_mpi_io( 'nf2a', nf2a ) 3057 CALL rrd_mpi_io( 'ncc', ncc ) 3058 CALL rrd_mpi_io_global_array( 'mass_fracs_a', mass_fracs_a ) 3059 CALL rrd_mpi_io_global_array( 'mass_fracs_b', mass_fracs_b ) 3060 3061 END SUBROUTINE salsa_rrd_global_mpi 3062 3063 3064 !------------------------------------------------------------------------------! 3065 ! Description: 3066 ! ------------ 3067 !> Read module-specific local restart data arrays (Fortran binary format). 3068 !------------------------------------------------------------------------------! 3069 SUBROUTINE salsa_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & 3070 nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found ) 2978 3071 2979 3072 USE control_parameters, & … … 3004 3097 DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< 3005 3098 3006 found = .FALSE. 3007 3008 IF ( read_restart_data_salsa ) THEN 3099 found = .TRUE. 3009 3100 3010 3101 SELECT CASE ( restart_string(1:length) ) 3011 3102 3012 CASE ( 'aerosol_mass' ) 3013 DO ic = 1, ncomponents_mass * nbins_aerosol 3103 CASE ( 'aerosol_mass' ) 3104 DO ic = 1, ncomponents_mass * nbins_aerosol 3105 IF ( k == 1 ) READ ( 13 ) tmp_3d 3106 aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3107 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3108 ENDDO 3109 3110 CASE ( 'aerosol_number' ) 3111 DO ib = 1, nbins_aerosol 3112 IF ( k == 1 ) READ ( 13 ) tmp_3d 3113 aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3114 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3115 ENDDO 3116 3117 CASE( 'salsa_gases_av' ) 3118 IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN 3119 ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) 3120 ENDIF 3121 DO ig = 1, ngases_salsa 3122 IF ( k == 1 ) READ ( 13 ) tmp_3d 3123 salsa_gases_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ig) = & 3124 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3125 ENDDO 3126 3127 CASE ( 'ldsa_av' ) 3128 IF ( .NOT. ALLOCATED( ldsa_av ) ) ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3129 IF ( k == 1 ) READ ( 13 ) tmp_3d 3130 ldsa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3131 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3132 3133 CASE ( 'mbins_av' ) 3134 IF ( .NOT. ALLOCATED( mbins_av ) ) THEN 3135 ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) 3136 ENDIF 3137 DO ib = 1, nbins_aerosol 3138 IF ( k == 1 ) READ ( 13 ) tmp_3d 3139 mbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = & 3140 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3141 ENDDO 3142 3143 CASE ( 'nbins_av' ) 3144 IF ( .NOT. ALLOCATED( nbins_av ) ) THEN 3145 ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) 3146 ENDIF 3147 DO ib = 1, nbins_aerosol 3148 IF ( k == 1 ) READ ( 13 ) tmp_3d 3149 nbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = & 3150 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3151 ENDDO 3152 3153 CASE ( 'ntot_av' ) 3154 IF ( .NOT. ALLOCATED( ntot_av ) ) ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3155 IF ( k == 1 ) READ ( 13 ) tmp_3d 3156 ntot_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3157 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3158 found = .TRUE. 3159 3160 CASE ( 'nufp_av' ) 3161 IF ( .NOT. ALLOCATED( nufp_av ) ) ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3162 IF ( k == 1 ) READ ( 13 ) tmp_3d 3163 nufp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3164 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3165 3166 CASE ( 'pm01_av' ) 3167 IF ( .NOT. ALLOCATED( pm01_av ) ) ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3168 IF ( k == 1 ) READ ( 13 ) tmp_3d 3169 pm01_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3170 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3171 3172 CASE ( 'pm25_av' ) 3173 IF ( .NOT. ALLOCATED( pm25_av ) ) ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3174 IF ( k == 1 ) READ ( 13 ) tmp_3d 3175 pm25_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3176 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3177 3178 CASE ( 'pm10_av' ) 3179 IF ( .NOT. ALLOCATED( pm10_av ) ) ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3180 IF ( k == 1 ) READ ( 13 ) tmp_3d 3181 pm10_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3182 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3183 3184 CASE ( 's_mass_av' ) 3185 IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN 3186 ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) ) 3187 ENDIF 3188 DO ic = 1, ncomponents_mass 3189 IF ( k == 1 ) READ ( 13 ) tmp_3d 3190 s_mass_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ic) = & 3191 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3192 ENDDO 3193 3194 CASE ( 's_h2o_av' ) 3195 IF ( .NOT. ALLOCATED( s_h2o_av ) ) ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3196 IF ( k == 1 ) READ ( 13 ) tmp_3d 3197 s_h2o_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3198 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3199 3200 CASE ( 'salsa_gas' ) 3201 IF ( .NOT. salsa_gases_from_chem ) THEN 3202 DO ig = 1, ngases_salsa 3014 3203 IF ( k == 1 ) READ ( 13 ) tmp_3d 3015 aerosol_mass(ic)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =&3204 salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3016 3205 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3017 3206 ENDDO 3018 found = .TRUE. 3019 3020 CASE ( 'aerosol_number' ) 3021 DO ib = 1, nbins_aerosol 3022 IF ( k == 1 ) READ ( 13 ) tmp_3d 3023 aerosol_number(ib)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3024 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3025 ENDDO 3026 found = .TRUE. 3027 3028 CASE( 'salsa_gases_av' ) 3029 IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN 3030 ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ngases_salsa) ) 3031 ENDIF 3032 DO ig = 1, ngases_salsa 3033 IF ( k == 1 ) READ ( 13 ) tmp_3d 3034 salsa_gases_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ig) = & 3035 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3036 ENDDO 3037 found = .TRUE. 3038 3039 CASE ( 'ldsa_av' ) 3040 IF ( .NOT. ALLOCATED( ldsa_av ) ) ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3041 IF ( k == 1 ) READ ( 13 ) tmp_3d 3042 ldsa_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3043 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3044 found = .TRUE. 3045 3046 CASE ( 'mbins_av' ) 3047 IF ( .NOT. ALLOCATED( mbins_av ) ) THEN 3048 ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) 3049 ENDIF 3050 DO ib = 1, nbins_aerosol 3051 IF ( k == 1 ) READ ( 13 ) tmp_3d 3052 mbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = & 3053 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3054 found = .TRUE. 3055 ENDDO 3056 3057 CASE ( 'nbins_av' ) 3058 IF ( .NOT. ALLOCATED( nbins_av ) ) THEN 3059 ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,nbins_aerosol) ) 3060 ENDIF 3061 DO ib = 1, nbins_aerosol 3062 IF ( k == 1 ) READ ( 13 ) tmp_3d 3063 nbins_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ib) = & 3064 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3065 found = .TRUE. 3066 ENDDO 3067 3068 CASE ( 'ntot_av' ) 3069 IF ( .NOT. ALLOCATED( ntot_av ) ) ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3070 IF ( k == 1 ) READ ( 13 ) tmp_3d 3071 ntot_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3072 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3073 found = .TRUE. 3074 3075 CASE ( 'nufp_av' ) 3076 IF ( .NOT. ALLOCATED( nufp_av ) ) ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3077 IF ( k == 1 ) READ ( 13 ) tmp_3d 3078 nufp_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3079 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3080 found = .TRUE. 3081 3082 CASE ( 'pm01_av' ) 3083 IF ( .NOT. ALLOCATED( pm01_av ) ) ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3084 IF ( k == 1 ) READ ( 13 ) tmp_3d 3085 pm01_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3086 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3087 found = .TRUE. 3088 3089 CASE ( 'pm25_av' ) 3090 IF ( .NOT. ALLOCATED( pm25_av ) ) ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3091 IF ( k == 1 ) READ ( 13 ) tmp_3d 3092 pm25_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3093 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3094 found = .TRUE. 3095 3096 CASE ( 'pm10_av' ) 3097 IF ( .NOT. ALLOCATED( pm10_av ) ) ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3098 IF ( k == 1 ) READ ( 13 ) tmp_3d 3099 pm10_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3100 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3101 found = .TRUE. 3102 3103 CASE ( 's_mass_av' ) 3104 IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN 3105 ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,ncomponents_mass) ) 3106 ENDIF 3107 DO ic = 1, ncomponents_mass 3108 IF ( k == 1 ) READ ( 13 ) tmp_3d 3109 s_mass_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp,ic) = & 3110 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3111 ENDDO 3112 found = .TRUE. 3113 3114 CASE ( 's_h2o_av' ) 3115 IF ( .NOT. ALLOCATED( s_h2o_av ) ) ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3116 IF ( k == 1 ) READ ( 13 ) tmp_3d 3117 s_h2o_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3118 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3119 found = .TRUE. 3120 3121 CASE ( 'salsa_gas' ) 3122 IF ( .NOT. salsa_gases_from_chem ) THEN 3123 DO ig = 1, ngases_salsa 3124 IF ( k == 1 ) READ ( 13 ) tmp_3d 3125 salsa_gas(ig)%conc(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3126 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3127 ENDDO 3128 found = .TRUE. 3129 ENDIF 3130 3131 CASE DEFAULT 3132 found = .FALSE. 3133 3134 END SELECT 3135 ENDIF 3136 3137 END SUBROUTINE salsa_rrd_local 3207 ENDIF 3208 3209 CASE DEFAULT 3210 found = .FALSE. 3211 3212 END SELECT 3213 3214 END SUBROUTINE salsa_rrd_local_ftn 3215 3138 3216 3139 3217 !------------------------------------------------------------------------------! 3140 3218 ! Description: 3141 3219 ! ------------ 3142 !> This routine writes the respective restart data. 3220 !> Read module-specific local restart data arrays (MPI-IO). 3221 !------------------------------------------------------------------------------! 3222 SUBROUTINE salsa_rrd_local_mpi 3223 3224 USE indices, & 3225 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzt 3226 3227 IMPLICIT NONE 3228 3229 CHARACTER(LEN=3) :: counter !< counter used for input-variable names 3230 3231 INTEGER(iwp) :: ib !< 3232 INTEGER(iwp) :: ic !< 3233 INTEGER(iwp) :: ig !< 3234 3235 LOGICAL :: array_found !< 3236 3237 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_3d !< temporary array to store aerosal data 3238 !< as single 3d-standard arrays 3239 3240 3241 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3242 3243 DO ic = 1, nbins_aerosol * ncomponents_mass 3244 WRITE( counter, '(I3.3)') ic 3245 CALL rrd_mpi_io( 'aerosol_mass_' // counter, tmp_3d ) 3246 aerosol_mass(ic)%conc = tmp_3d 3247 ENDDO 3248 3249 DO ib = 1, nbins_aerosol 3250 WRITE( counter, '(I3.3)') ib 3251 CALL rrd_mpi_io( 'aerosol_number_' // counter, tmp_3d ) 3252 aerosol_number(ic)%conc = tmp_3d 3253 ENDDO 3254 3255 IF ( .NOT. salsa_gases_from_chem ) THEN 3256 CALL rd_mpi_io_check_array( 'salsa_gases_av_001', found = array_found ) 3257 IF ( array_found ) THEN 3258 IF ( .NOT. ALLOCATED( salsa_gases_av ) ) THEN 3259 ALLOCATE( salsa_gases_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:ngases_salsa) ) 3260 ENDIF 3261 DO ig = 1, ngases_salsa 3262 WRITE( counter, '(I3.3)') ig 3263 CALL rrd_mpi_io( 'salsa_gases_av_' // counter , tmp_3d ) 3264 salsa_gases_av(:,:,:,ig) = tmp_3d 3265 ENDDO 3266 ENDIF 3267 ENDIF 3268 3269 CALL rd_mpi_io_check_array( 'ldsa_av', found = array_found ) 3270 IF ( array_found ) THEN 3271 IF ( .NOT. ALLOCATED( ldsa_av ) ) ALLOCATE( ldsa_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3272 CALL rrd_mpi_io( 'ldsa_av', ldsa_av ) 3273 ENDIF 3274 3275 CALL rd_mpi_io_check_array( 'mbins_av_001', found = array_found ) 3276 IF ( array_found ) THEN 3277 IF ( .NOT. ALLOCATED( mbins_av ) ) THEN 3278 ALLOCATE( mbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:nbins_aerosol) ) 3279 ENDIF 3280 DO ib = 1, nbins_aerosol 3281 WRITE( counter, '(I3.3)') ib 3282 CALL rrd_mpi_io( 'mbins_av_' // counter, tmp_3d ) 3283 mbins_av(:,:,:,ib) = tmp_3d 3284 ENDDO 3285 ENDIF 3286 3287 CALL rd_mpi_io_check_array( 'nbins_av_001', found = array_found ) 3288 IF ( array_found ) THEN 3289 IF ( .NOT. ALLOCATED( nbins_av ) ) THEN 3290 ALLOCATE( nbins_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:nbins_aerosol) ) 3291 ENDIF 3292 DO ib = 1, nbins_aerosol 3293 WRITE( counter, '(I3.3)') ib 3294 CALL rrd_mpi_io( 'nbins_av_' // counter, tmp_3d ) 3295 nbins_av(:,:,:,ib) = tmp_3d 3296 ENDDO 3297 ENDIF 3298 3299 CALL rd_mpi_io_check_array( 'ntot_av', found = array_found ) 3300 IF ( array_found ) THEN 3301 IF ( .NOT. ALLOCATED( ntot_av ) ) ALLOCATE( ntot_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3302 CALL rrd_mpi_io( 'ntot_av', ntot_av ) 3303 ENDIF 3304 3305 CALL rd_mpi_io_check_array( 'nufp_av', found = array_found ) 3306 IF ( array_found ) THEN 3307 IF ( .NOT. ALLOCATED( nufp_av ) ) ALLOCATE( nufp_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3308 CALL rrd_mpi_io( 'nufp_av', nufp_av ) 3309 ENDIF 3310 3311 CALL rd_mpi_io_check_array( 'pm01_av', found = array_found ) 3312 IF ( array_found ) THEN 3313 IF ( .NOT. ALLOCATED( pm01_av ) ) ALLOCATE( pm01_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3314 CALL rrd_mpi_io( 'pm01_av', pm01_av ) 3315 ENDIF 3316 3317 CALL rd_mpi_io_check_array( 'pm25_av', found = array_found ) 3318 IF ( array_found ) THEN 3319 IF ( .NOT. ALLOCATED( pm25_av ) ) ALLOCATE( pm25_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3320 CALL rrd_mpi_io( 'pm25_av', pm25_av ) 3321 ENDIF 3322 3323 CALL rd_mpi_io_check_array( 'pm10_av', found = array_found ) 3324 IF ( array_found ) THEN 3325 IF ( .NOT. ALLOCATED( pm10_av ) ) ALLOCATE( pm10_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3326 CALL rrd_mpi_io( 'pm10_av', pm10_av ) 3327 ENDIF 3328 3329 CALL rd_mpi_io_check_array( 's_h20_av', found = array_found ) 3330 IF ( array_found ) THEN 3331 IF ( .NOT. ALLOCATED( s_h2o_av ) ) ALLOCATE( s_h2o_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3332 CALL rrd_mpi_io( 's_h2o_av', s_h2o_av ) 3333 ENDIF 3334 3335 CALL rd_mpi_io_check_array( 's_mass_av_001', found = array_found ) 3336 IF ( array_found ) THEN 3337 IF ( .NOT. ALLOCATED( s_mass_av ) ) THEN 3338 ALLOCATE( s_mass_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg,1:ncomponents_mass) ) 3339 ENDIF 3340 DO ic = 1, ncomponents_mass 3341 WRITE( counter, '(I3.3)') ib 3342 CALL rrd_mpi_io( 's_mass_av_' // counter, tmp_3d ) 3343 s_mass_av(:,:,:,ic) = tmp_3d 3344 ENDDO 3345 ENDIF 3346 3347 IF ( .NOT. salsa_gases_from_chem ) THEN 3348 DO ig = 1, ngases_salsa 3349 WRITE( counter, '(I3.3)') ig 3350 CALL rrd_mpi_io( 'salsa_gas_' // counter, tmp_3d ) 3351 salsa_gas(ig)%conc = tmp_3d 3352 ENDDO 3353 ENDIF 3354 3355 DEALLOCATE( tmp_3d ) 3356 3357 END SUBROUTINE salsa_rrd_local_mpi 3358 3359 3360 !------------------------------------------------------------------------------! 3361 ! Description: 3362 ! ------------ 3363 !> Write module-specific global restart data. 3364 !------------------------------------------------------------------------------! 3365 SUBROUTINE salsa_wrd_global 3366 3367 IMPLICIT NONE 3368 3369 CHARACTER(LEN=1) :: counter !< counter used for output-variable names 3370 3371 INTEGER(iwp) :: i !< loop counter 3372 3373 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 3374 3375 CALL wrd_write_string( 'listpec' ) 3376 WRITE ( 14 ) listspec 3377 3378 CALL wrd_write_string( 'nbin' ) 3379 WRITE ( 14 ) nbin 3380 3381 CALL wrd_write_string( 'nf2a' ) 3382 WRITE ( 14 ) nf2a 3383 3384 CALL wrd_write_string( 'ncc' ) 3385 WRITE ( 14 ) ncc 3386 3387 CALL wrd_write_string( 'mass_fracs_a' ) 3388 WRITE ( 14 ) mass_fracs_a 3389 3390 CALL wrd_write_string( 'mass_fracs_b' ) 3391 WRITE ( 14 ) mass_fracs_b 3392 3393 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN 3394 3395 DO i = 1, 7 3396 WRITE( counter, '(I1)' ) i 3397 CALL wrd_mpi_io( 'listspec_' // counter, listspec(i) ) 3398 ENDDO 3399 3400 CALL wrd_mpi_io_global_array( 'nbin', nbin ) 3401 CALL wrd_mpi_io( 'nf2a', nf2a ) 3402 CALL wrd_mpi_io( 'ncc', ncc ) 3403 CALL wrd_mpi_io_global_array( 'mass_fracs_a', mass_fracs_a ) 3404 CALL wrd_mpi_io_global_array( 'mass_fracs_b', mass_fracs_b ) 3405 3406 ENDIF 3407 3408 END SUBROUTINE salsa_wrd_global 3409 3410 3411 !------------------------------------------------------------------------------! 3412 ! Description: 3413 ! ------------ 3414 !> This routine writes the respective local restart data. 3143 3415 !> Note that the following input variables in PARIN have to be equal between 3144 3416 !> restart runs: 3145 !> listspec, nbin, n bin2, nf2a, ncc, mass_fracs_a, mass_fracs_b3417 !> listspec, nbin, nf2a, ncc, mass_fracs_a, mass_fracs_b 3146 3418 !------------------------------------------------------------------------------! 3147 3419 SUBROUTINE salsa_wrd_local 3148 3420 3149 USE control_parameters, &3150 ONLY: write_binary3151 3152 3421 IMPLICIT NONE 3422 3423 CHARACTER(LEN=3) :: counter !< counter used for output-variable names 3153 3424 3154 3425 INTEGER(iwp) :: ib !< … … 3156 3427 INTEGER(iwp) :: ig !< 3157 3428 3158 IF ( write_binary .AND. write_binary_salsa ) THEN 3429 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: tmp_3d !< temporary array to store aerosal data 3430 !< as single 3d-standard arrays 3431 3432 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 3159 3433 3160 3434 CALL wrd_write_string( 'aerosol_mass' ) … … 3179 3453 3180 3454 IF ( ALLOCATED( ldsa_av ) ) THEN 3181 CALL wrd_write_string( 'ldsa_av' )3182 WRITE ( 14 ) ldsa_av3455 CALL wrd_write_string( 'ldsa_av' ) 3456 WRITE ( 14 ) ldsa_av 3183 3457 ENDIF 3184 3458 … … 3240 3514 ENDDO 3241 3515 ENDIF 3516 3517 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN 3518 3519 ALLOCATE( tmp_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3520 3521 DO ic = 1, nbins_aerosol * ncomponents_mass 3522 WRITE( counter, '(I3.3)') ic 3523 tmp_3d = aerosol_mass(ic)%conc 3524 CALL wrd_mpi_io( 'aerosol_mass_' // counter, tmp_3d ) 3525 ENDDO 3526 3527 DO ib = 1, nbins_aerosol 3528 WRITE( counter, '(I3.3)') ib 3529 tmp_3d = aerosol_number(ib)%conc 3530 CALL wrd_mpi_io( 'aerosol_number_' // counter, tmp_3d ) 3531 ENDDO 3532 3533 IF ( .NOT. salsa_gases_from_chem ) THEN 3534 3535 IF ( ALLOCATED( salsa_gases_av ) ) THEN 3536 DO ig = 1, ngases_salsa 3537 WRITE( counter, '(I3.3)') ig 3538 tmp_3d = salsa_gases_av(:,:,:,ig) 3539 CALL wrd_mpi_io( 'salsa_gases_av_' // counter, tmp_3d ) 3540 ENDDO 3541 ENDIF 3542 ENDIF 3543 3544 IF ( ALLOCATED( ldsa_av ) ) CALL wrd_mpi_io( 'ldsa_av', ldsa_av ) 3545 3546 3547 IF ( ALLOCATED( mbins_av ) ) THEN 3548 DO ib = 1, nbins_aerosol 3549 WRITE( counter, '(I3.3)') ib 3550 tmp_3d = mbins_av(:,:,:,ib) 3551 CALL wrd_mpi_io( 'mbins_av_' // counter, tmp_3d ) 3552 ENDDO 3553 ENDIF 3554 3555 IF ( ALLOCATED( nbins_av ) ) THEN 3556 DO ib = 1, nbins_aerosol 3557 WRITE( counter, '(I3.3)') ib 3558 tmp_3d = nbins_av(:,:,:,ib) 3559 CALL wrd_mpi_io( 'nbins_av_' // counter, tmp_3d ) 3560 ENDDO 3561 ENDIF 3562 3563 IF ( ALLOCATED( ntot_av ) ) CALL wrd_mpi_io( 'ntot_av', ntot_av ) 3564 IF ( ALLOCATED( nufp_av ) ) CALL wrd_mpi_io( 'nufp_av', nufp_av ) 3565 IF ( ALLOCATED( pm01_av ) ) CALL wrd_mpi_io( 'pm01_av', pm01_av ) 3566 IF ( ALLOCATED( pm25_av ) ) CALL wrd_mpi_io( 'pm25_av', pm25_av ) 3567 IF ( ALLOCATED( pm10_av ) ) CALL wrd_mpi_io( 'pm10_av', pm10_av ) 3568 IF ( ALLOCATED( s_h2o_av ) ) CALL wrd_mpi_io( 's_h2o_av', s_h2o_av ) 3569 3570 IF ( ALLOCATED( s_mass_av ) ) THEN 3571 DO ic = 1, ncomponents_mass 3572 WRITE( counter, '(I3.3)') ic 3573 tmp_3d = s_mass_av(:,:,:,ic) 3574 CALL wrd_mpi_io( 's_mass_av_' // counter, tmp_3d ) 3575 ENDDO 3576 ENDIF 3577 3578 IF ( .NOT. salsa_gases_from_chem ) THEN 3579 DO ig = 1, ngases_salsa 3580 WRITE( counter, '(I3.3)') ig 3581 tmp_3d = salsa_gas(ig)%conc 3582 CALL wrd_mpi_io( 'salsa_gas_' // counter, tmp_3d ) 3583 ENDDO 3584 ENDIF 3585 3586 DEALLOCATE( tmp_3d ) 3242 3587 3243 3588 ENDIF … … 13067 13412 13068 13413 USE control_parameters, & 13069 ONLY: end_time, initializing_actions,spinup_time13414 ONLY: end_time, spinup_time 13070 13415 13071 13416 USE palm_date_time_mod, & … … 13139 13484 ! 13140 13485 !-- Initialize boundary data. Please note, do not initialize boundaries in case of restart runs. 13141 IF ( TRIM( initializing_actions ) /= 'read_restart_data' .AND. read_restart_data_salsa ) & 13142 THEN 13486 IF ( .NOT. read_restart_data_salsa ) THEN 13143 13487 IF ( bc_dirichlet_l ) THEN 13144 13488 DO ib = 1, nbins_aerosol -
palm/trunk/TUTORIALS/cases/dispersion_eulerian_and_lpm_extended/USER_CODE/user_module.f90
r4370 r4525 1 1 !> @file user_module.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 !------------------------------------------------------------------------------! 17 !--------------------------------------------------------------------------------------------------! 18 ! 19 19 ! 20 20 ! Current revisions: … … 24 24 ! Former revisions: 25 25 ! ----------------- 26 ! $Id: user_module.f90 3986 2019-05-20 14:08:14Z Giersch $ 26 ! $Id: user_module.f90 4517 2020-05-03 14:29:30Z raasch $ 27 ! Modified user-interface has been adapted to r4521 28 ! 29 ! 4517 2020-05-03 14:29:30Z raasch 30 ! added restart with MPI-IO for reading local arrays 31 ! 32 ! 4504 2020-04-20 12:11:24Z raasch 33 ! hint for setting rmask arrays added 34 ! 35 ! 4497 2020-04-15 10:20:51Z raasch 36 ! file re-formatted to follow the PALM coding standard 37 ! 38 ! 4495 2020-04-13 20:11:20Z raasch 39 ! restart data handling with MPI-IO added 40 ! 41 ! 4360 2020-01-07 11:25:50Z suehring 42 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 43 ! information used in wall_flags_static_0 44 ! 45 ! 4329 2019-12-10 15:46:36Z motisi 46 ! Renamed wall_flags_0 to wall_flags_static_0 47 ! 48 ! 4287 2019-11-01 14:50:20Z raasch 49 ! reading of namelist file and actions in case of namelist errors revised so that statement labels 50 ! and goto statements are not required any more; this revision also removes a previous bug which 51 ! appeared when the namelist has been commented out in the namelist file 52 ! 53 ! 4182 2019-08-22 15:20:23Z scharf 54 ! Corrected "Former revisions" section 55 ! 56 ! 3986 2019-05-20 14:08:14Z Giersch 27 57 ! Redundant integration of control parameters in user_rrd_global removed 28 ! 58 ! 29 59 ! 3911 2019-04-17 12:26:19Z knoop 30 60 ! Bugfix: added before_prognostic_equations case in user_actions 31 ! 61 ! 32 62 ! 3768 2019-02-27 14:35:58Z raasch 33 63 ! variables commented + statements added to avoid compiler warnings about unused variables … … 35 65 ! 3767 2019-02-27 08:18:02Z raasch 36 66 ! unused variable for file index removed from rrd-subroutines parameter list 37 ! 67 ! 38 68 ! 3747 2019-02-16 15:15:23Z gronemeier 39 69 ! Add routine user_init_arrays 40 ! 70 ! 41 71 ! 3703 2019-01-29 16:43:53Z knoop 42 72 ! An example for a user defined global variable has been added (Giersch) 43 !44 ! 2718 2018-01-02 08:49:38Z suehring45 ! Corrected "Former revisions" section46 !47 ! 2696 2017-12-14 17:12:51Z kanani48 ! Change in file header (GPL part)49 !50 ! 2101 2017-01-05 16:42:31Z suehring51 !52 ! 2000 2016-08-20 18:09:15Z knoop53 ! Forced header and separation lines into 80 columns54 !55 ! 1873 2016-04-18 14:50:06Z maronga56 ! Module renamed (removed _mod)57 !58 !59 ! 1850 2016-04-08 13:29:27Z maronga60 ! Module renamed61 !62 !63 ! 1682 2015-10-07 23:56:08Z knoop64 ! Code annotations made doxygen readable65 !66 ! 1320 2014-03-20 08:40:49Z raasch67 ! kind-parameters added to all INTEGER and REAL declaration statements,68 ! kinds are defined in new module kinds,69 ! old module precision_kind is removed,70 ! revision history before 2012 removed,71 ! comment fields (!:) to be used for variable explanations added to72 ! all variable declaration statements73 !74 ! 1036 2012-10-22 13:43:42Z raasch75 ! code put under GPL (PALM 3.9)76 73 ! 77 74 ! Revision 1.1 1998/03/24 15:29:04 raasch … … 81 78 ! Description: 82 79 ! ------------ 83 !> Declaration of user-defined variables. This module may only be used 84 !> in the user-defined routines(contained in user_interface.f90).85 !------------------------------------------------------------------------------ !80 !> Declaration of user-defined variables. This module may only be used in the user-defined routines 81 !> (contained in user_interface.f90). 82 !--------------------------------------------------------------------------------------------------! 86 83 MODULE user 87 84 88 89 85 USE arrays_3d 90 86 … … 105 101 IMPLICIT NONE 106 102 107 INTEGER(iwp) :: dots_num_palm !<108 INTEGER(iwp) :: dots_num_user = 0 !< 109 INTEGER(iwp) :: user_idummy !<110 111 LOGICAL :: user_module_enabled = .FALSE. !<112 113 REAL(wp) :: user_rdummy !<103 INTEGER(iwp) :: dots_num_palm !< 104 INTEGER(iwp) :: dots_num_user = 0 !< 105 INTEGER(iwp) :: user_idummy !< 106 107 LOGICAL :: user_module_enabled = .FALSE. !< 108 109 REAL(wp) :: user_rdummy !< 114 110 115 111 ! 116 112 !-- Sample for user-defined output 117 ! REAL(wp) :: global_parameter !< user defined global parameter 118 ! 119 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: u2 !< user defined array 120 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: u2_av !< user defined array 121 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ustvst !< user defined array 122 113 ! REAL(wp) :: global_parameter !< user defined global parameter 114 ! 115 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: u2 !< user defined array 116 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: u2_av !< user defined array 117 ! REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ustvst !< user defined array 118 119 ! 123 120 !-- User-defined parameters 124 121 INTEGER(iwp), DIMENSION(1:3) :: s_ts_pos_x_ind = 0 … … 130 127 REAL(wp), DIMENSION(1:3) :: s_ts_pos_x = 0.0 131 128 REAL(wp), DIMENSION(1:3) :: s_ts_pos_y = 0.0 132 133 129 SAVE 134 130 … … 137 133 ! 138 134 !- Public functions 139 PUBLIC & 140 user_parin, & 141 user_check_parameters, & 142 user_check_data_output_ts, & 143 user_check_data_output_pr, & 144 user_check_data_output, & 145 user_define_netcdf_grid, & 146 user_init, & 147 user_init_arrays, & 148 user_header, & 149 user_actions, & 150 user_3d_data_averaging, & 151 user_data_output_2d, & 152 user_data_output_3d, & 153 user_statistics, & 154 user_rrd_global, & 155 user_rrd_local, & 156 user_wrd_global, & 157 user_wrd_local, & 158 user_last_actions 135 PUBLIC & 136 user_actions, & 137 user_check_data_output, & 138 user_check_data_output_pr, & 139 user_check_data_output_ts, & 140 user_check_parameters, & 141 user_data_output_2d, & 142 user_data_output_3d, & 143 user_define_netcdf_grid, & 144 user_header, & 145 user_init, & 146 user_init_arrays, & 147 user_last_actions, & 148 user_parin, & 149 user_rrd_global, & 150 user_rrd_local, & 151 user_statistics, & 152 user_3d_data_averaging, & 153 user_wrd_global, & 154 user_wrd_local 155 159 156 160 157 ! 161 158 !- Public parameters, constants and initial values 162 PUBLIC &159 PUBLIC & 163 160 user_module_enabled 164 161 … … 221 218 222 219 INTERFACE user_rrd_global 223 MODULE PROCEDURE user_rrd_global 220 MODULE PROCEDURE user_rrd_global_ftn 221 MODULE PROCEDURE user_rrd_global_mpi 224 222 END INTERFACE user_rrd_global 225 223 226 224 INTERFACE user_rrd_local 227 MODULE PROCEDURE user_rrd_local 225 MODULE PROCEDURE user_rrd_local_ftn 226 MODULE PROCEDURE user_rrd_local_mpi 228 227 END INTERFACE user_rrd_local 229 228 … … 244 243 245 244 246 !------------------------------------------------------------------------------ !245 !--------------------------------------------------------------------------------------------------! 247 246 ! Description: 248 247 ! ------------ 249 248 !> Parin for &user_parameters for user module 250 !------------------------------------------------------------------------------ !249 !--------------------------------------------------------------------------------------------------! 251 250 SUBROUTINE user_parin 252 251 253 254 CHARACTER (LEN=80) :: line !< 255 256 INTEGER(iwp) :: i !< 257 INTEGER(iwp) :: j !< 258 259 260 NAMELIST /user_parameters/ & 261 user_module_enabled, & 262 data_output_pr_user, & 263 data_output_user, & 264 region, & 265 data_output_masks_user, & 266 emission_stripe_orig_y, emission_stripe_width_y, & 267 s_ts_pos_x, s_ts_pos_y 252 CHARACTER (LEN=80) :: line !< string containing the last line read from namelist file 253 254 INTEGER(iwp) :: i !< 255 INTEGER(iwp) :: io_status !< status after reading the namelist file 256 INTEGER(iwp) :: j !< 257 258 259 NAMELIST /user_parameters/ & 260 data_output_masks_user, & 261 data_output_pr_user, & 262 data_output_user, & 263 region, & 264 emission_stripe_orig_y, & 265 emission_stripe_width_y, & 266 s_ts_pos_x, & 267 s_ts_pos_y 268 268 269 269 270 ! … … 274 275 275 276 ! 276 !-- Set revision number of this default interface version. It will be checked within 277 !-- the main program (palm). Please change the revision number in case that the 278 !-- current revision does not match with previous revisions (e.g. if routines 279 !-- have been added/deleted or if parameter lists in subroutines have been changed). 280 user_interface_current_revision = 'r3703' 281 282 ! 283 !-- Position the namelist-file at the beginning (it was already opened in 284 !-- parin), search for user-defined namelist-group ("userpar", but any other 285 !-- name can be choosed) and position the file at this line. 277 !-- Set revision number of this default interface version. It will be checked within the main 278 !-- program (palm). Please change the revision number in case that the current revision does not 279 !-- match with previous revisions (e.g. if routines have been added/deleted or if parameter lists 280 !-- in subroutines have been changed). 281 user_interface_current_revision = 'r4495' 282 283 ! 284 !-- Position the namelist-file at the beginning (it has already been opened in parin), and try to 285 !-- read (find) a namelist named "user_parameters". 286 286 REWIND ( 11 ) 287 288 line = ' ' 289 DO WHILE ( INDEX( line, '&user_parameters' ) == 0 ) 290 READ ( 11, '(A)', END=12 ) line 291 ENDDO 292 BACKSPACE ( 11 ) 293 294 !-- Set default module switch to true 295 user_module_enabled = .TRUE. 296 297 !-- Read user-defined namelist 298 READ ( 11, user_parameters, ERR = 10 ) 299 300 GOTO 12 301 302 10 BACKSPACE( 11 ) 303 READ( 11 , '(A)') line 304 CALL parin_fail_message( 'user_parameters', line ) 305 306 12 CONTINUE 307 308 ! 309 !-- Determine the number of user-defined profiles and append them to the 310 !-- standard data output (data_output_pr) 287 READ( 11, user_parameters, IOSTAT=io_status ) 288 289 ! 290 !-- Actions depending on the READ status 291 IF ( io_status == 0 ) THEN 292 ! 293 !-- User namelist found and correctly read. Set default module switch to true. This activates 294 !-- calls of the user-interface subroutines. 295 user_module_enabled = .TRUE. 296 297 ELSEIF ( io_status > 0 ) THEN 298 ! 299 !-- User namelist was found, but contained errors. Print an error message containing the line 300 !-- that caused the problem 301 BACKSPACE( 11 ) 302 READ( 11 , '(A)') line 303 CALL parin_fail_message( 'user_parameters', line ) 304 305 ENDIF 306 307 ! 308 !-- Determine the number of user-defined profiles and append them to the standard data output 309 !-- (data_output_pr) 311 310 IF ( user_module_enabled ) THEN 312 311 IF ( data_output_pr_user(1) /= ' ' ) THEN … … 329 328 330 329 331 !------------------------------------------------------------------------------ !330 !--------------------------------------------------------------------------------------------------! 332 331 ! Description: 333 332 ! ------------ 334 333 !> Check &userpar control parameters and deduce further quantities. 335 !------------------------------------------------------------------------------ !334 !--------------------------------------------------------------------------------------------------! 336 335 SUBROUTINE user_check_parameters 337 336 338 339 !-- Here the user may add code to check the validity of further &userpar 340 !-- control parameters ordeduce further quantities.337 ! 338 !-- Here the user may add code to check the validity of further &userpar control parameters or 339 !-- deduce further quantities. 341 340 342 341 … … 344 343 345 344 346 !------------------------------------------------------------------------------ !345 !--------------------------------------------------------------------------------------------------! 347 346 ! Description: 348 347 ! ------------ 349 348 !> Set module-specific timeseries units and labels 350 !------------------------------------------------------------------------------ !349 !--------------------------------------------------------------------------------------------------! 351 350 SUBROUTINE user_check_data_output_ts( dots_max, dots_num, dots_label, dots_unit ) 352 351 352 INTEGER(iwp), INTENT(IN) :: dots_max !< 353 INTEGER(iwp), INTENT(INOUT) :: dots_num !< 354 355 CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label !< 356 CHARACTER(LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit !< 353 357 354 358 INTEGER(iwp) :: i 355 356 INTEGER(iwp), INTENT(IN) :: dots_max357 INTEGER(iwp), INTENT(INOUT) :: dots_num358 359 359 CHARACTER(LEN=7) :: i_char = '' 360 CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_label361 CHARACTER (LEN=*), DIMENSION(dots_max), INTENT(INOUT) :: dots_unit362 363 360 364 361 ! … … 367 364 368 365 ! 369 !-- Sample for user-defined time series 370 !-- For each time series quantity you have to give a label and a unit, 371 !-- which will be used for the NetCDF file. They must not contain more than 372 !-- seven characters. The value of dots_num has to be increased by the 373 !-- number of new time series quantities. Its old value has to be store in 374 !-- dots_num_palm. See routine user_statistics on how to output calculate 375 !-- and output these quantities. 366 !-- Sample for user-defined time series: 367 !-- For each time series quantity you have to give a label and a unit, which will be used for the 368 !-- NetCDF file. They must not contain more than seven characters. The value of dots_num has to be 369 !-- increased by the number of new time series quantities. Its old value has to be stored in 370 !-- dots_num_palm. See routine user_statistics on how to calculate and output these quantities. 376 371 377 372 ! dots_num_palm = dots_num … … 387 382 ! dots_unit(dots_num) = 'm/s' 388 383 384 ! 389 385 !-- Additional timeseries output 390 386 size_of_pos_array = SIZE(s_ts_pos_x) … … 399 395 dots_num = dots_num + size_of_pos_array 400 396 401 402 397 END SUBROUTINE user_check_data_output_ts 403 398 404 399 405 !------------------------------------------------------------------------------! 406 ! Description: 407 ! ------------ 408 !> Set the unit of user defined profile output quantities. For those variables 409 !> not recognized by the user, the parameter unit is set to "illegal", which 410 !> tells the calling routine that the output variable is not defined and leads 411 !> to a program abort. 412 !------------------------------------------------------------------------------! 400 !--------------------------------------------------------------------------------------------------! 401 ! Description: 402 ! ------------ 403 !> Set the unit of user defined profile output quantities. For those variables not recognized by the 404 !> user, the parameter unit is set to "illegal", which tells the calling routine that the 405 !> output variable is not defined and leads to a program abort. 406 !--------------------------------------------------------------------------------------------------! 413 407 SUBROUTINE user_check_data_output_pr( variable, var_count, unit, dopr_unit ) 414 408 … … 417 411 418 412 419 CHARACTER (LEN=*) :: unit !<420 CHARACTER (LEN=*) :: variable !<413 CHARACTER (LEN=*) :: unit !< 414 CHARACTER (LEN=*) :: variable !< 421 415 CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit 422 416 423 ! INTEGER(iwp) :: user_pr_index !<424 INTEGER(iwp) :: var_count !<417 ! INTEGER(iwp) :: user_pr_index !< 418 INTEGER(iwp) :: var_count !< 425 419 426 420 ! … … 432 426 ! 433 427 !-- Uncomment and extend the following lines, if necessary. 434 !-- Add additional CASE statements depending on the number of quantities 435 !-- for which profiles are to be calculated. The respective calculations 436 !-- to be performed have to be added in routine user_statistics. 437 !-- The quantities are (internally) identified by a user-profile-number 438 !-- (see variable "user_pr_index" below). The first user-profile must be assigned 439 !-- the number "pr_palm+1", the second one "pr_palm+2", etc. The respective 440 !-- user-profile-numbers have also to be used in routine user_statistics! 441 ! CASE ( 'u*v*' ) ! quantity string as given in 442 ! ! data_output_pr_user 428 !-- Add additional CASE statements depending on the number of quantities for which profiles are 429 !-- to be calculated. The respective calculations to be performed have to be added in routine 430 !-- user_statistics. The quantities are (internally) identified by a user-profile-number 431 !-- (see variable "user_pr_index" below). The first user-profile must be assigned the number 432 !-- "pr_palm+1", the second one "pr_palm+2", etc. The respective user-profile-numbers have also 433 !-- to be used in routine user_statistics! 434 ! CASE ( 'u*v*' ) ! quantity string as given in data_output_pr_user 443 435 ! user_pr_index = pr_palm + 1 444 436 ! dopr_index(var_count) = user_pr_index ! quantities' user-profile-number 445 437 ! dopr_unit = 'm2/s2' ! quantity unit 446 438 ! unit = dopr_unit 447 ! hom(:,2,user_pr_index,:) 448 ! ! grid on which the quantity is 449 ! ! defined (use zu or zw)439 ! hom(:,2,user_pr_index,:) = SPREAD( zu, 2, statistic_regions+1 ) 440 ! ! grid on which the quantity is defined (use zu or zw) 441 ! 450 442 451 443 CASE DEFAULT … … 458 450 459 451 460 !------------------------------------------------------------------------------! 461 ! Description: 462 ! ------------ 463 !> Set the unit of user defined output quantities. For those variables 464 !> not recognized by the user, the parameter unit is set to "illegal", which 465 !> tells the calling routine that the output variable is not defined and leads 466 !> to a program abort. 467 !------------------------------------------------------------------------------! 452 !--------------------------------------------------------------------------------------------------! 453 ! Description: 454 ! ------------ 455 !> Set the unit of user defined output quantities. For those variables not recognized by the user, 456 !> the parameter unit is set to "illegal", which tells the calling routine that the output variable 457 !> is not defined and leads to a program abort. 458 !--------------------------------------------------------------------------------------------------! 468 459 SUBROUTINE user_check_data_output( variable, unit ) 469 460 470 461 471 CHARACTER (LEN=*) :: unit !<472 CHARACTER (LEN=*) :: variable !<462 CHARACTER (LEN=*) :: unit !< 463 CHARACTER (LEN=*) :: variable !< 473 464 474 465 … … 492 483 493 484 494 !------------------------------------------------------------------------------ !485 !--------------------------------------------------------------------------------------------------! 495 486 ! Description: 496 487 ! ------------ 497 488 !> Initialize user-defined arrays 498 !------------------------------------------------------------------------------ !489 !--------------------------------------------------------------------------------------------------! 499 490 SUBROUTINE user_init_arrays 500 491 … … 512 503 ! 513 504 !-- Example for defining a statistic region: 505 !-- ATTENTION: rmask = 0 is required at the ghost boundaries to guarantee correct statistic 506 !-- evaluations (otherwise ghost points would be counted twice). This setting has 507 !-- already been cared for in routine init_3d_model. Please don't set the ghost points 508 !-- /= 0. i.e. run the following loop only over nxl,nxr and nys,nyn. 514 509 ! IF ( statistic_regions >= 1 ) THEN 515 510 ! region = 1 516 ! 511 ! 517 512 ! rmask(:,:,region) = 0.0_wp 518 513 ! DO i = nxl, nxr … … 525 520 ! ENDIF 526 521 ! ENDDO 527 ! 522 ! 528 523 ! ENDIF 529 524 … … 531 526 532 527 533 !------------------------------------------------------------------------------ !528 !--------------------------------------------------------------------------------------------------! 534 529 ! Description: 535 530 ! ------------ 536 531 !> Execution of user-defined initializing actions 537 !------------------------------------------------------------------------------ !532 !--------------------------------------------------------------------------------------------------! 538 533 SUBROUTINE user_init 539 534 540 541 535 USE grid_variables 542 536 543 ! CHARACTER (LEN=20) :: field_char!<544 545 537 ! CHARACTER(LEN=20) :: field_char !< 538 539 INTEGER(iwp), DIMENSION(1:2) :: eso_ind !< index values of emission_stripe_orig 546 540 INTEGER(iwp) :: esw_ind !< index value of emission_stripe_width 547 541 INTEGER(iwp) :: i, j, m !< running index … … 578 572 ENDDO 579 573 ENDDO 580 581 574 582 575 END SUBROUTINE user_init 583 576 584 577 585 !------------------------------------------------------------------------------! 586 ! Description: 587 ! ------------ 588 !> Set the grids on which user-defined output quantities are defined. 589 !> Allowed values for grid_x are "x" and "xu", for grid_y "y" and "yv", and 590 !> for grid_z "zu" and "zw". 591 !------------------------------------------------------------------------------! 578 !--------------------------------------------------------------------------------------------------! 579 ! Description: 580 ! ------------ 581 !> Set the grids on which user-defined output quantities are defined. Allowed values for grid_x are 582 !> "x" and "xu", for grid_y "y" and "yv", and for grid_z "zu" and "zw". 583 !--------------------------------------------------------------------------------------------------! 592 584 SUBROUTINE user_define_netcdf_grid( variable, found, grid_x, grid_y, grid_z ) 593 585 … … 631 623 632 624 633 !------------------------------------------------------------------------------ !625 !--------------------------------------------------------------------------------------------------! 634 626 ! Description: 635 627 ! ------------ 636 628 !> Print a header with user-defined information. 637 !------------------------------------------------------------------------------ !629 !--------------------------------------------------------------------------------------------------! 638 630 SUBROUTINE user_header( io ) 639 631 640 632 641 INTEGER(iwp) :: i !< 642 INTEGER(iwp) :: io !< 643 644 ! 645 !-- If no user-defined variables are read from the namelist-file, no 646 !-- information will be printed. 633 INTEGER(iwp) :: i !< 634 INTEGER(iwp) :: io !< 635 636 ! 637 !-- If no user-defined variables are read from the namelist-file, no information will be printed. 647 638 IF ( .NOT. user_module_enabled ) THEN 648 639 WRITE ( io, 100 ) … … 663 654 WRITE ( io, 122 ) 664 655 WRITE ( io, 123 ) s_ts_pos_x, s_ts_pos_y 665 666 656 667 657 IF ( statistic_regions /= 0 ) THEN … … 675 665 !-- Format-descriptors 676 666 100 FORMAT (//' *** no user-defined variables found'/) 677 110 FORMAT (//1X,78('#') & 678 //' User-defined variables and actions:'/ & 679 ' -----------------------------------'//) 667 110 FORMAT (//1X,78('#') // ' User-defined variables and actions:' / & 668 ' -----------------------------------'//) 680 669 120 FORMAT (' Parameters for traffic emission:' /) 681 670 121 FORMAT ('stripe origin(s) in y-direction (in m): ',F5.1,', ',F5.1,' , stripe width in y-direction (in m): ',F5.1) … … 689 678 690 679 691 !------------------------------------------------------------------------------ !680 !--------------------------------------------------------------------------------------------------! 692 681 ! Description: 693 682 ! ------------ 694 683 !> Call for all grid points 695 !------------------------------------------------------------------------------ !684 !--------------------------------------------------------------------------------------------------! 696 685 SUBROUTINE user_actions( location ) 697 686 698 687 699 CHARACTER (LEN=*) :: location !<700 701 ! INTEGER(iwp) :: i !<702 ! INTEGER(iwp) :: j !<703 ! INTEGER(iwp) :: k !<688 CHARACTER(LEN=*) :: location !< 689 690 ! INTEGER(iwp) :: i !< 691 ! INTEGER(iwp) :: j !< 692 ! INTEGER(iwp) :: k !< 704 693 705 694 CALL cpu_log( log_point(24), 'user_actions', 'start' ) 706 695 707 696 ! 708 !-- Here the user-defined actions follow 709 !-- No calls for single grid points are allowed at locations before and 710 !-- after the timestep, since these calls are not within an i,j-loop 697 !-- Here the user-defined actions follow. No calls for single grid points are allowed at locations 698 !-- before and after the timestep, since these calls are not within an i,j-loop 711 699 SELECT CASE ( location ) 712 700 … … 721 709 CASE ( 'after_integration' ) 722 710 ! 723 !-- Enter actions to be done after every time integration (before 724 !-- data output) 711 !-- Enter actions to be done after every time integration (before data output) 725 712 !-- Sample for user-defined output: 726 713 ! DO i = nxlg, nxrg … … 735 722 ! DO k = nzb, nzt+1 736 723 ! ustvst(k,j,i) = & 737 ! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * &724 ! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,0) ) * & 738 725 ! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,0) ) 739 726 ! ENDDO … … 783 770 784 771 785 !------------------------------------------------------------------------------ !772 !--------------------------------------------------------------------------------------------------! 786 773 ! Description: 787 774 ! ------------ 788 775 !> Call for grid point i,j 789 !------------------------------------------------------------------------------ !776 !--------------------------------------------------------------------------------------------------! 790 777 SUBROUTINE user_actions_ij( i, j, location ) 791 778 792 779 793 CHARACTER (LEN=*) :: location794 795 INTEGER(iwp) :: i 796 INTEGER(iwp) :: j 780 CHARACTER(LEN=*) :: location !< 781 782 INTEGER(iwp) :: i !< 783 INTEGER(iwp) :: j !< 797 784 798 785 ! … … 839 826 840 827 841 !------------------------------------------------------------------------------ !842 ! Description: 843 ! ------------ 844 !> Sum up and time-average user-defined output quantities as well as allocate 845 !> the array necessaryfor storing the average.846 !------------------------------------------------------------------------------ !828 !--------------------------------------------------------------------------------------------------! 829 ! Description: 830 ! ------------ 831 !> Sum up and time-average user-defined output quantities as well as allocate the array necessary 832 !> for storing the average. 833 !--------------------------------------------------------------------------------------------------! 847 834 SUBROUTINE user_3d_data_averaging( mode, variable ) 848 835 849 836 850 CHARACTER (LEN=*) :: mode !<851 CHARACTER (LEN=*) :: variable !<852 853 ! INTEGER(iwp) :: i !<854 ! INTEGER(iwp) :: j !<855 ! INTEGER(iwp) :: k !<837 CHARACTER(LEN=*) :: mode !< 838 CHARACTER(LEN=*) :: variable !< 839 840 ! INTEGER(iwp) :: i !< 841 ! INTEGER(iwp) :: j !< 842 ! INTEGER(iwp) :: k !< 856 843 857 844 IF ( mode == 'allocate' ) THEN … … 861 848 ! 862 849 !-- Uncomment and extend the following lines, if necessary. 863 !-- The arrays for storing the user defined quantities (here u2_av) have 864 !-- to be declared anddefined by the user!850 !-- The arrays for storing the user defined quantities (here u2_av) have to be declared and 851 !-- defined by the user! 865 852 !-- Sample for user-defined output: 866 853 ! CASE ( 'u2' ) … … 881 868 ! 882 869 !-- Uncomment and extend the following lines, if necessary. 883 !-- The arrays for storing the user defined quantities (here u2 and 884 !-- u2_av) have to be declaredand defined by the user!870 !-- The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared 871 !-- and defined by the user! 885 872 !-- Sample for user-defined output: 886 873 ! CASE ( 'u2' ) 887 ! IF ( ALLOCATED( u2_av ) ) THEN874 ! IF ( ALLOCATED( u2_av ) ) THEN 888 875 ! DO i = nxlg, nxrg 889 876 ! DO j = nysg, nyng … … 906 893 ! 907 894 !-- Uncomment and extend the following lines, if necessary. 908 !-- The arrays for storing the user defined quantities (here u2_av) have 909 !-- to be declared anddefined by the user!895 !-- The arrays for storing the user defined quantities (here u2_av) have to be declared and 896 !-- defined by the user! 910 897 !-- Sample for user-defined output: 911 898 ! CASE ( 'u2' ) 912 ! IF ( ALLOCATED( u2_av ) ) THEN899 ! IF ( ALLOCATED( u2_av ) ) THEN 913 900 ! DO i = nxlg, nxrg 914 901 ! DO j = nysg, nyng … … 928 915 929 916 930 !------------------------------------------------------------------------------! 931 ! Description: 932 ! ------------ 933 !> Resorts the user-defined output quantity with indices (k,j,i) to a 934 !> temporary array with indices (i,j,k) and sets the grid on which it is defined. 935 !> Allowed values for grid are "zu" and "zw". 936 !------------------------------------------------------------------------------! 917 !--------------------------------------------------------------------------------------------------! 918 ! Description: 919 ! ------------ 920 !> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices 921 !> (i,j,k) and sets the grid on which it is defined. Allowed values for grid are "zu" and "zw". 922 !--------------------------------------------------------------------------------------------------! 937 923 SUBROUTINE user_data_output_2d( av, variable, found, grid, local_pf, two_d, nzb_do, nzt_do ) 938 924 939 925 940 CHARACTER (LEN=*) :: grid !<941 CHARACTER (LEN=*) :: variable !<942 943 INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data944 ! INTEGER(iwp) :: i !< grid index along x-direction945 ! INTEGER(iwp) :: j !< grid index along y-direction946 ! INTEGER(iwp) :: k !< grid index along z-direction947 ! INTEGER(iwp) :: m !< running index surface elements948 INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb)949 INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1)950 951 LOGICAL :: found !<952 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections)926 CHARACTER(LEN=*) :: grid !< 927 CHARACTER(LEN=*) :: variable !< 928 929 INTEGER(iwp) :: av !< flag to control data output of instantaneous or time-averaged data 930 ! INTEGER(iwp) :: i !< grid index along x-direction 931 ! INTEGER(iwp) :: j !< grid index along y-direction 932 ! INTEGER(iwp) :: k !< grid index along z-direction 933 ! INTEGER(iwp) :: m !< running index surface elements 934 INTEGER(iwp) :: nzb_do !< lower limit of the domain (usually nzb) 935 INTEGER(iwp) :: nzt_do !< upper limit of the domain (usually nzt+1) 936 937 LOGICAL :: found !< 938 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 953 939 954 940 ! REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 955 941 956 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<942 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 957 943 958 944 ! … … 967 953 ! 968 954 !-- Uncomment and extend the following lines, if necessary. 969 !-- The arrays for storing the user defined quantities (here u2 and u2_av) 970 !-- have to be declaredand defined by the user!955 !-- The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared 956 !-- and defined by the user! 971 957 !-- Sample for user-defined output: 972 958 ! CASE ( 'u2_xy', 'u2_xz', 'u2_yz' ) … … 980 966 ! ENDDO 981 967 ! ELSE 982 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN968 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 983 969 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 984 970 ! u2_av = REAL( fill_value, KIND = wp ) … … 995 981 ! grid = 'zu' 996 982 ! 997 !-- In case two-dimensional surface variables are output, the user 998 !-- has to access related surface-type. Uncomment and extend following lines 999 !-- appropriately (example output of vertical surface momentum flux of u- 1000 !-- component). Please note, surface elements can be distributed over 1001 !-- several data type, depending on their respective surface properties. 983 !-- In case two-dimensional surface variables are output, the user has to access related 984 !-- surface-type. Uncomment and extend following lines appropriately (example output of vertical 985 !-- surface momentum flux of u-component). Please note, surface elements can be distributed over 986 !-- several data types, depending on their respective surface properties. 1002 987 ! CASE ( 'usws_xy' ) 1003 988 ! IF ( av == 0 ) THEN … … 1026 1011 ! 1027 1012 ! grid = 'zu' 1028 !-- 1013 !-- 1029 1014 1030 1015 … … 1039 1024 1040 1025 1041 !------------------------------------------------------------------------------ !1042 ! Description: 1043 ! ------------ 1044 !> Resorts the user-defined output quantity with indices (k,j,i) to a 1045 !> temporary array with indices(i,j,k).1046 !------------------------------------------------------------------------------ !1026 !--------------------------------------------------------------------------------------------------! 1027 ! Description: 1028 ! ------------ 1029 !> Resorts the user-defined output quantity with indices (k,j,i) to a temporary array with indices 1030 !> (i,j,k). 1031 !--------------------------------------------------------------------------------------------------! 1047 1032 SUBROUTINE user_data_output_3d( av, variable, found, local_pf, nzb_do, nzt_do ) 1048 1033 1049 1034 1050 CHARACTER (LEN=*) :: variable !<1051 1052 INTEGER(iwp) :: av !<1053 ! INTEGER(iwp) :: i !<1054 ! INTEGER(iwp) :: j !<1055 ! INTEGER(iwp) :: k !<1035 CHARACTER(LEN=*) :: variable !< 1036 1037 INTEGER(iwp) :: av !< 1038 ! INTEGER(iwp) :: i !< 1039 ! INTEGER(iwp) :: j !< 1040 ! INTEGER(iwp) :: k !< 1056 1041 INTEGER(iwp) :: nzb_do !< lower limit of the data output (usually 0) 1057 1042 INTEGER(iwp) :: nzt_do !< vertical upper limit of the data output (usually nz_do3d) 1058 1043 1059 LOGICAL :: found !<1060 1061 ! REAL(wp) :: fill_value = -999.0_wp 1062 1063 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !<1044 LOGICAL :: found !< 1045 1046 ! REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 1047 1048 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 1064 1049 1065 1050 ! … … 1074 1059 ! 1075 1060 !-- Uncomment and extend the following lines, if necessary. 1076 !-- The arrays for storing the user defined quantities (here u2 and u2_av) 1077 !-- have to be declaredand defined by the user!1061 !-- The arrays for storing the user defined quantities (here u2 and u2_av) have to be declared 1062 !-- and defined by the user! 1078 1063 !-- Sample for user-defined output: 1079 1064 ! CASE ( 'u2' ) … … 1087 1072 ! ENDDO 1088 1073 ! ELSE 1089 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN1074 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 1090 1075 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1091 1076 ! u2_av = REAL( fill_value, KIND = wp ) … … 1110 1095 1111 1096 1112 !------------------------------------------------------------------------------! 1113 ! Description: 1114 ! ------------ 1115 !> Calculation of user-defined statistics, i.e. horizontally averaged profiles 1116 !> and time series. 1117 !> This routine is called for every statistic region sr defined by the user, 1118 !> but at least for the region "total domain" (sr=0). 1119 !> See section 3.5.4 on how to define, calculate, and output user defined 1120 !> quantities. 1121 !------------------------------------------------------------------------------! 1097 !--------------------------------------------------------------------------------------------------! 1098 ! Description: 1099 ! ------------ 1100 !> Calculation of user-defined statistics, i.e. horizontally averaged profiles and time series. 1101 !> This routine is called for every statistic region sr defined by the user, but at least for the 1102 !> region "total domain" (sr=0). See section 3.5.4 on how to define, calculate, and output user 1103 !> defined quantities. 1104 !--------------------------------------------------------------------------------------------------! 1122 1105 SUBROUTINE user_statistics( mode, sr, tn ) 1123 1124 1106 1125 1107 USE netcdf_interface, & 1126 1108 ONLY: dots_max 1127 1128 CHARACTER (LEN=*) :: mode !<1129 INTEGER(iwp) :: i 1130 ! INTEGER(iwp) :: j 1131 ! INTEGER(iwp) :: k 1132 INTEGER(iwp) :: sr !<1133 INTEGER(iwp) :: tn !<1134 1135 ! REAL(wp), DIMENSION(:), ALLOCATABLE :: ts_value_l 1109 1110 CHARACTER(LEN=*) :: mode !< 1111 INTEGER(iwp) :: i !< 1112 ! INTEGER(iwp) :: j !< 1113 ! INTEGER(iwp) :: k !< 1114 INTEGER(iwp) :: sr !< 1115 INTEGER(iwp) :: tn !< 1116 1117 ! REAL(wp), DIMENSION(:), ALLOCATABLE :: ts_value_l !< 1136 1118 REAL(wp), DIMENSION(dots_num_palm+1:dots_max) :: ts_value_l !< 1137 1119 … … 1143 1125 1144 1126 ! 1145 !-- Sample on how to calculate horizontally averaged profiles of user- 1146 !-- defined quantities. Each quantity is identified by the index 1147 !-- "pr_palm+#" where "#" is an integer starting from 1. These 1148 !-- user-profile-numbers must also be assigned to the respective strings 1149 !-- given by data_output_pr_user in routine user_check_data_output_pr. 1127 !-- Sample on how to calculate horizontally averaged profiles of user-defined quantities. Each 1128 !-- quantity is identified by the index "pr_palm+#" where "#" is an integer starting from 1. 1129 !-- These user-profile-numbers must also be assigned to the respective strings given by 1130 !-- data_output_pr_user in routine user_check_data_output_pr. 1150 1131 ! !$OMP DO 1151 1132 ! DO i = nxl, nxr … … 1153 1134 ! DO k = nzb+1, nzt 1154 1135 !! 1155 !!-- Sample on how to calculate the profile of the resolved-scale 1156 !!-- horizontal momentum flux u*v* 1157 ! sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) + & 1158 ! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) *& 1159 ! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) & 1160 ! * rmask(j,i,sr) & 1161 ! * MERGE( 1.0_wp, 0.0_wp, & 1162 ! BTEST( wall_flags_0(k,j,i), 0 ) ) 1136 !!-- Sample on how to calculate the profile of the resolved-scale horizontal momentum 1137 !!-- flux u*v* 1138 ! sums_l(k,pr_palm+1,tn) = sums_l(k,pr_palm+1,tn) + & 1139 ! ( 0.5_wp * ( u(k,j,i) + u(k,j,i+1) ) - hom(k,1,1,sr) ) * & 1140 ! ( 0.5_wp * ( v(k,j,i) + v(k,j+1,i) ) - hom(k,1,2,sr) ) * & 1141 ! rmask(j,i,sr) * MERGE( 1.0_wp, 0.0_wp, & 1142 ! BTEST( wall_flags_total_0(k,j,i), 0 ) ) 1163 1143 !! 1164 !!-- Further profiles can be defined and calculated by increasing 1165 !!-- the second index of array sums_l (replace ... appropriately) 1166 ! sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... & 1167 ! * rmask(j,i,sr) 1144 !!-- Further profiles can be defined and calculated by increasing the second index of 1145 !!-- array sums_l (replace ... appropriately) 1146 ! sums_l(k,pr_palm+2,tn) = sums_l(k,pr_palm+2,tn) + ... * rmask(j,i,sr) 1168 1147 ! ENDDO 1169 1148 ! ENDDO … … 1176 1155 ! 1177 1156 !-- Sample on how to add values for the user-defined time series quantities. 1178 !-- These have to be defined before in routine user_init. This sample 1179 !-- creates two time series for the absolut values of the horizontal 1180 !-- velocities u and v. 1157 !-- These have to be defined before in routine user_init. This sample creates two time series for 1158 !-- the absolut values of the horizontal velocities u and v. 1181 1159 ! ts_value_l = 0.0_wp 1182 1160 ! ts_value_l(1) = ABS( u_max ) … … 1184 1162 ! 1185 1163 !-- Collect / send values to PE0, because only PE0 outputs the time series. 1186 !-- CAUTION: Collection is done by taking the sum over all processors. 1187 !-- You may have to normalize this sum, depending on the quantity 1188 !-- that you like to calculate. For serial runs, nothing has to be 1189 !-- done. 1190 !-- HINT: If the time series value that you are calculating has the same 1191 !-- value on all PEs, you can omit the MPI_ALLREDUCE call and 1192 !-- assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly. 1164 !-- CAUTION: Collection is done by taking the sum over all processors. You may have to normalize 1165 !-- this sum, depending on the quantity that you like to calculate. For serial runs, 1166 !-- nothing has to be done. 1167 !-- HINT: If the time series value that you are calculating has the same value on all PEs, you 1168 !-- can omit the MPI_ALLREDUCE call and assign ts_value(dots_num_palm+1:,sr) = ts_value_l directly. 1193 1169 !#if defined( __parallel ) 1194 1170 ! IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 1195 ! CALL MPI_ALLREDUCE( ts_value_l(1), & 1196 ! ts_value(dots_num_palm+1,sr), & 1197 ! dots_num_user, MPI_REAL, MPI_MAX, comm2d, & 1198 ! ierr ) 1171 ! CALL MPI_ALLREDUCE( ts_value_l(1), ts_value(dots_num_palm+1,sr), dots_num_user, MPI_REAL, & 1172 ! MPI_MAX, comm2d, ierr ) 1199 1173 !#else 1200 1174 ! ts_value(dots_num_palm+1:dots_num_palm+dots_num_user,sr) = ts_value_l 1201 1175 !#endif 1202 1203 1176 1204 1177 ts_value_l = 0.0_wp … … 1239 1212 1240 1213 1241 !------------------------------------------------------------------------------ !1242 ! Description: 1243 ! ------------ 1244 !> Read ing global restart data that has been defined by the user.1245 !------------------------------------------------------------------------------ !1246 SUBROUTINE user_rrd_global ( found )1247 1248 1249 LOGICAL, INTENT(OUT) :: found 1214 !--------------------------------------------------------------------------------------------------! 1215 ! Description: 1216 ! ------------ 1217 !> Read module-specific global restart data (Fortran binary format). 1218 !--------------------------------------------------------------------------------------------------! 1219 SUBROUTINE user_rrd_global_ftn( found ) 1220 1221 1222 LOGICAL, INTENT(OUT) :: found !< 1250 1223 1251 1224 … … 1259 1232 1260 1233 CASE DEFAULT 1261 1234 1262 1235 found = .FALSE. 1263 1236 … … 1265 1238 1266 1239 1267 END SUBROUTINE user_rrd_global 1268 1269 1270 !------------------------------------------------------------------------------! 1271 ! Description: 1272 ! ------------ 1273 !> Reading processor specific restart data from file(s) that has been defined 1274 !> by the user. 1275 !> Subdomain index limits on file are given by nxl_on_file, etc. 1276 !> Indices nxlc, etc. indicate the range of gridpoints to be mapped from the 1277 !> subdomain on file (f) to the subdomain of the current PE (c). They have been 1278 !> calculated in routine rrd_local. 1279 !------------------------------------------------------------------------------! 1280 SUBROUTINE user_rrd_local( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, & 1281 nxr_on_file, nynf, nync, nyn_on_file, nysf, & 1282 nysc, nys_on_file, tmp_3d, found ) 1240 END SUBROUTINE user_rrd_global_ftn 1241 1242 1243 !--------------------------------------------------------------------------------------------------! 1244 ! Description: 1245 ! ------------ 1246 !> Read module-specific global restart data (MPI-IO). 1247 !--------------------------------------------------------------------------------------------------! 1248 SUBROUTINE user_rrd_global_mpi 1249 1250 ! USE restart_data_mpi_io_mod, & 1251 ! ONLY: rrd_mpi_io 1252 1253 ! CALL rrd_mpi_io( 'global_parameter', global_parameter ) 1254 CONTINUE 1255 1256 END SUBROUTINE user_rrd_global_mpi 1257 1258 1259 !--------------------------------------------------------------------------------------------------! 1260 ! Description: 1261 ! ------------ 1262 !> Read module-specific local restart data arrays (Fortran binary format). 1263 !> Subdomain 1264 !> index limits on file are given by nxl_on_file, etc. Indices nxlc, etc. indicate the range of 1265 !> gridpoints to be mapped from the subdomain on file (f) to the subdomain of the current PE (c). 1266 !> They have been calculated in routine rrd_local. 1267 !--------------------------------------------------------------------------------------------------! 1268 SUBROUTINE user_rrd_local_ftn( k, nxlf, nxlc, nxl_on_file, nxrf, nxrc, nxr_on_file, nynf, nync, & 1269 nyn_on_file, nysf, nysc, nys_on_file, tmp_3d, found ) 1283 1270 1284 1271 … … 1298 1285 INTEGER(iwp) :: nys_on_file !< 1299 1286 1300 LOGICAL, INTENT(OUT) :: found 1301 1302 REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d 1287 LOGICAL, INTENT(OUT) :: found !< 1288 1289 REAL(wp), DIMENSION(nzb:nzt+1,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< 1303 1290 1304 1291 ! … … 1316 1303 1317 1304 CASE ( 'u2_av' ) 1318 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN1305 ! IF ( .NOT. ALLOCATED( u2_av ) ) THEN 1319 1306 ! ALLOCATE( u2_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 1320 1307 ! ENDIF 1321 1308 ! IF ( k == 1 ) READ ( 13 ) tmp_3d 1322 ! u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = &1323 ! 1309 ! u2_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 1310 ! tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 1324 1311 ! 1325 1312 CASE DEFAULT … … 1329 1316 END SELECT 1330 1317 1331 END SUBROUTINE user_rrd_local 1332 1333 1334 !------------------------------------------------------------------------------! 1335 ! Description: 1336 ! ------------ 1337 !> Writes global and user-defined restart data into binary file(s) for restart 1338 !> runs. 1339 !------------------------------------------------------------------------------! 1318 END SUBROUTINE user_rrd_local_ftn 1319 1320 1321 !--------------------------------------------------------------------------------------------------! 1322 ! Description: 1323 ! ------------ 1324 !> Read module-specific local restart data arrays (MPI-IO). 1325 !--------------------------------------------------------------------------------------------------! 1326 SUBROUTINE user_rrd_local_mpi 1327 1328 ! USE restart_data_mpi_io_mod, & 1329 ! ONLY: rd_mpi_io_check_array, rrd_mpi_io 1330 1331 ! CALL rd_mpi_io_check_array( 'u2_av' , found = array_found ) 1332 ! IF ( array_found ) THEN 1333 ! IF ( .NOT. ALLOCATED( u2_av ) ) ALLOCATE( u2_av(nysg:nyng,nxlg:nxrg) ) 1334 ! CALL rrd_mpi_io( 'rad_u2_av', rad_u2_av ) 1335 ! ENDIF 1336 1337 CONTINUE 1338 1339 END SUBROUTINE user_rrd_local_mpi 1340 1341 1342 !--------------------------------------------------------------------------------------------------! 1343 ! Description: 1344 ! ------------ 1345 !> Writes global and user-defined restart data into binary file(s) for restart runs. 1346 !--------------------------------------------------------------------------------------------------! 1340 1347 SUBROUTINE user_wrd_global 1341 1348 1342 ! CALL wrd_write_string( 'global_parameter' ) 1343 ! WRITE ( 14 ) global_parameter 1349 ! USE restart_data_mpi_io_mod, & 1350 ! ONLY: wrd_mpi_io 1351 1352 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 1353 1354 ! CALL wrd_write_string( 'global_parameter' ) 1355 ! WRITE ( 14 ) global_parameter 1356 1357 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN 1358 1359 ! CALL rrd_mpi_io( 'global_parameter', global_parameter ) 1360 1361 ENDIF 1344 1362 1345 1363 END SUBROUTINE user_wrd_global 1346 1364 1347 1365 1348 !------------------------------------------------------------------------------! 1349 ! Description: 1350 ! ------------ 1351 !> Writes processor specific and user-defined restart data into binary file(s) 1352 !> for restart runs. 1353 !------------------------------------------------------------------------------! 1366 !--------------------------------------------------------------------------------------------------! 1367 ! Description: 1368 ! ------------ 1369 !> Writes processor specific and user-defined restart data into binary file(s) for restart runs. 1370 !--------------------------------------------------------------------------------------------------! 1354 1371 SUBROUTINE user_wrd_local 1372 1373 ! USE restart_data_mpi_io_mod, & 1374 ! ONLY: wrd_mpi_io 1355 1375 1356 1376 ! 1357 1377 !-- Here the user-defined actions at the end of a job follow. 1358 1378 !-- Sample for user-defined output: 1359 ! IF ( ALLOCATED( u2_av ) ) THEN 1360 ! CALL wrd_write_string( 'u2_av' ) 1361 ! WRITE ( 14 ) u2_av 1362 ! ENDIF 1379 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 1380 1381 ! IF ( ALLOCATED( u2_av ) ) THEN 1382 ! CALL wrd_write_string( 'u2_av' ) 1383 ! WRITE ( 14 ) u2_av 1384 ! ENDIF 1385 1386 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN 1387 1388 ! IF ( ALLOCATED( u2_av ) ) CALL wrd_mpi_io( 'u2_av', u2_av ) 1389 1390 ENDIF 1363 1391 1364 1392 END SUBROUTINE user_wrd_local 1365 1393 1366 1394 1367 !------------------------------------------------------------------------------ !1395 !--------------------------------------------------------------------------------------------------! 1368 1396 ! Description: 1369 1397 ! ------------ 1370 1398 !> Execution of user-defined actions at the end of a job. 1371 !------------------------------------------------------------------------------ !1399 !--------------------------------------------------------------------------------------------------! 1372 1400 SUBROUTINE user_last_actions 1373 1401
Note: See TracChangeset
for help on using the changeset viewer.
