Changeset 4600 for palm/trunk
- Timestamp:
- Jul 13, 2020 6:50:12 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_data_output_mod.f90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_data_output_mod.f90
r4577 r4600 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - Change: adjustmens for mpi-io - surface data is transformed to a 2D-based surface array 28 ! before writing. 29 ! - Bugfix in counting of surface elements 30 ! - Bugfix in data-output of averaged surface data in case of restarts 31 ! 32 ! 4577 2020-06-25 09:53:58Z raasch 27 33 ! File re-formatted to follow the PALM coding standard 28 34 ! … … 178 184 179 185 USE restart_data_mpi_io_mod, & 180 ONLY: rd_mpi_io_check_array, & 181 rrd_mpi_io, & 182 wrd_mpi_io 186 ONLY: rrd_mpi_io, & 187 rd_mpi_io_check_array, & 188 rrd_mpi_io_surface, & 189 rd_mpi_io_surface_filetypes, & 190 wrd_mpi_io, & 191 wrd_mpi_io_surface 183 192 184 193 USE surface_mod, & … … 213 222 REAL(wp), DIMENSION(:), ALLOCATABLE :: zs !< z-coordinate for NetCDF output 214 223 REAL(wp), DIMENSION(:), ALLOCATABLE :: zenith !< zenith orientation coordinate for NetCDF output 215 REAL(wp), DIMENSION(:), ALLOCATABLE :: var_out !< output variable s216 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var_av !< variable sused for averaging224 REAL(wp), DIMENSION(:), ALLOCATABLE :: var_out !< output variable 225 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: var_av !< variable used for averaging 217 226 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: points !< points / vertices of a surface element 218 227 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: polygons !< polygon data of a surface element … … 398 407 399 408 #if defined( __netcdf4_parallel ) 400 CHARACTER (LEN=100) :: filename 401 CHARACTER (LEN=80) :: 402 CHARACTER (LEN=4000) :: 409 CHARACTER (LEN=100) :: filename !< name of output file 410 CHARACTER (LEN=80) :: time_average_text !< string written to file attribute time_avg 411 CHARACTER (LEN=4000) :: var_list !< list of variables written to NetCDF file 403 412 404 413 INTEGER(iwp) :: av !< flag for averaged (=1) and non-averaged (=0) data … … 436 445 surfaces%npoints = 0 437 446 DO l = 0, 1 438 DO m = 1, surf_def_h( 0)%ns447 DO m = 1, surf_def_h(l)%ns 439 448 ! 440 449 !-- Determine the indices of the respective grid cell inside the topography 441 i = surf_def_h( 0)%i(m) + surf_def_h(0)%ioff442 j = surf_def_h( 0)%j(m) + surf_def_h(0)%joff443 k = surf_def_h( 0)%k(m) + surf_def_h(0)%koff450 i = surf_def_h(l)%i(m) + surf_def_h(l)%ioff 451 j = surf_def_h(l)%j(m) + surf_def_h(l)%joff 452 k = surf_def_h(l)%k(m) + surf_def_h(l)%koff 444 453 ! 445 454 !-- Check if the vertices that define the surface element are already defined, if not, … … 4579 4588 CASE ( 'average_count_surf' ) 4580 4589 READ ( 13 ) average_count_surf 4590 CASE ( 'time_dosurf_av' ) 4591 READ ( 13 ) time_dosurf_av 4581 4592 4582 4593 CASE DEFAULT … … 4598 4609 4599 4610 CALL rrd_mpi_io( 'average_count_surf', average_count_surf ) 4611 CALL rrd_mpi_io( 'time_dosurf_av', time_dosurf_av ) 4600 4612 4601 4613 END SUBROUTINE surface_data_output_rrd_global_mpi … … 4645 4657 IMPLICIT NONE 4646 4658 4647 LOGICAL :: array_found !< 4648 4649 4650 CALL rd_mpi_io_check_array( 'surfaces%var_av' , found = array_found ) 4651 4652 !> does not work this way: surface%var_av has non-standard dimensions 4653 ! IF ( array_found ) THEN 4654 ! IF ( .NOT. ALLOCATED( surfaces%var_av ) ) ALLOCATE( ....... ) 4655 ! CALL rrd_mpi_io( 'surfaces%var_av', surfaces%var_av ) 4656 ! ENDIF 4659 CHARACTER(LEN=3) :: dum !< dummy string to create output-variable name 4660 4661 INTEGER(iwp) :: i !< grid index in x-direction 4662 INTEGER(iwp) :: j !< grid index in y-direction 4663 INTEGER(iwp) :: l !< running index surface orientation 4664 INTEGER(iwp) :: m !< running index surface elements 4665 INTEGER(iwp) :: n !< counting variable 4666 INTEGER(iwp) :: nv !< running index over number of variables 4667 4668 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< end index of surface data at (j,i) 4669 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: global_start_index !< index array for surface data (MPI-IO) 4670 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: num_surf !< number of surface data at (j,i) 4671 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< start index of surface data at (j,i) 4672 4673 LOGICAL :: array_found !< flag indicating whether variable is in restart data or not 4674 LOGICAL :: ldum !< dummy variable 4675 4676 REAL(wp), DIMENSION(:), ALLOCATABLE :: surf_in !< input array in expected restart format 4677 4678 ! 4679 !-- Note, surface data which is written to file is organized in a different way than 4680 !-- the output surface data. The output surface data is a concatenated array of the 4681 !-- different surface types and orientations, while the mpi-io expects surface data that 4682 !-- is consecutive in terms of start- and end-index, i.e. organized along the (j,i) 4683 !-- grid index. Hence, data need to be tranformed back to the output surface data. 4684 ALLOCATE( end_index(nys:nyn,nxl:nxr) ) 4685 ALLOCATE( num_surf(nys:nyn,nxl:nxr) ) 4686 ALLOCATE( start_index(nys:nyn,nxl:nxr) ) 4687 ALLOCATE( global_start_index(nys:nyn,nxl:nxr) ) 4688 4689 ALLOCATE( surf_in(1:surfaces%ns) ) 4690 4691 CALL rd_mpi_io_check_array( 'surfaces%start_index', found = array_found ) 4692 IF ( array_found ) CALL rrd_mpi_io( 'surfaces%start_index', start_index ) 4693 4694 CALL rd_mpi_io_check_array( 'surfaces%end_index', found = array_found ) 4695 IF ( array_found ) CALL rrd_mpi_io( 'surfaces%end_index', end_index ) 4696 4697 CALL rd_mpi_io_check_array( 'surfaces%global_start_index', found = array_found ) 4698 IF ( array_found ) CALL rrd_mpi_io( 'surfaces%global_start_index', global_start_index ) 4699 4700 CALL rd_mpi_io_surface_filetypes( start_index, end_index, ldum, global_start_index ) 4701 4702 DO nv = 1, dosurf_no(1) 4703 IF ( nv < 10 ) WRITE( dum, '(I1)') nv 4704 IF ( nv < 100 .AND. nv >= 10 ) WRITE( dum, '(I2)') nv 4705 IF ( nv < 1000 .AND. nv >= 100 ) WRITE( dum, '(I3)') nv 4706 4707 CALL rd_mpi_io_check_array( 'surfaces%var_av' // TRIM( dum ), found = array_found ) 4708 4709 IF ( array_found ) THEN 4710 4711 CALL rrd_mpi_io_surface( 'surfaces%var_av' // TRIM(dum), surf_in ) 4712 ! 4713 !-- Write temporary input variable back to surface-output data array. 4714 n = 0 4715 num_surf = 0 4716 DO l = 0, 1 4717 DO m = 1, surf_def_h(l)%ns 4718 i = surf_def_h(l)%i(m) 4719 j = surf_def_h(l)%j(m) 4720 n = n + 1 4721 surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i)) 4722 num_surf(j,i) = num_surf(j,i) + 1 4723 ENDDO 4724 ENDDO 4725 DO m = 1, surf_lsm_h%ns 4726 i = surf_lsm_h%i(m) 4727 j = surf_lsm_h%j(m) 4728 n = n + 1 4729 surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i)) 4730 num_surf(j,i) = num_surf(j,i) + 1 4731 ENDDO 4732 DO m = 1, surf_usm_h%ns 4733 i = surf_usm_h%i(m) 4734 j = surf_usm_h%j(m) 4735 n = n + 1 4736 surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i)) 4737 num_surf(j,i) = num_surf(j,i) + 1 4738 ENDDO 4739 4740 DO l = 0, 3 4741 DO m = 1, surf_def_v(l)%ns 4742 i = surf_def_v(l)%i(m) 4743 j = surf_def_v(l)%j(m) 4744 n = n + 1 4745 surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i)) 4746 num_surf(j,i) = num_surf(j,i) + 1 4747 ENDDO 4748 DO m = 1, surf_lsm_v(l)%ns 4749 i = surf_lsm_v(l)%i(m) 4750 j = surf_lsm_v(l)%j(m) 4751 n = n + 1 4752 surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i)) 4753 num_surf(j,i) = num_surf(j,i) + 1 4754 ENDDO 4755 DO m = 1, surf_usm_v(l)%ns 4756 i = surf_usm_v(l)%i(m) 4757 j = surf_usm_v(l)%j(m) 4758 n = n + 1 4759 surfaces%var_av(n,nv) = surf_in(start_index(j,i)+num_surf(j,i)) 4760 num_surf(j,i) = num_surf(j,i) + 1 4761 ENDDO 4762 ENDDO 4763 ENDIF 4764 ENDDO 4765 4657 4766 4658 4767 END SUBROUTINE surface_data_output_rrd_local_mpi … … 4673 4782 WRITE ( 14 ) average_count_surf 4674 4783 4784 CALL wrd_write_string( 'time_dosurf_av' ) 4785 WRITE ( 14 ) time_dosurf_av 4786 4675 4787 ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN 4676 4788 4677 4789 CALL wrd_mpi_io( 'average_count_surf', average_count_surf ) 4790 CALL wrd_mpi_io( 'time_dosurf_av', time_dosurf_av ) 4678 4791 4679 4792 ENDIF … … 4691 4804 IMPLICIT NONE 4692 4805 4806 CHARACTER(LEN=3) :: dum !< dummy string to create output-variable name 4807 4808 INTEGER(iwp) :: i !< grid index in x-direction 4809 INTEGER(iwp) :: j !< grid index in y-direction 4810 INTEGER(iwp) :: l !< running index surface orientation 4811 INTEGER(iwp) :: m !< running index surface elements 4812 INTEGER(iwp) :: n !< counting variable 4813 INTEGER(iwp) :: nv !< running index over number of variables 4814 INTEGER(iwp) :: start_index_aggregated !< sum of start-index at (j,i) over all surface types 4815 4816 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< end index of surface data at (j,i) 4817 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: global_start_index !< index array for surface data (MPI-IO) 4818 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: num_surf !< number of surface data at (j,i) 4819 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< start index of surface data at (j,i) 4820 4821 LOGICAL :: surface_data_to_write !< switch for MPI-I/O if PE has surface data to write 4822 4823 REAL(wp), DIMENSION(:), ALLOCATABLE :: surf_out !< surface data in expected restart format 4824 4825 4693 4826 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 4694 4827 … … 4699 4832 4700 4833 ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN 4701 4702 IF ( ALLOCATED( surfaces%var_av ) ) CALL wrd_mpi_io( 'surfaces%var_av', surfaces%var_av ) 4834 ! 4835 !-- Note, surface data which is written to file is organized in a different way than 4836 !-- the output surface data. The output surface data is a concatenated array of the 4837 !-- different surface types and orientations, while the mpi-io expects surface data that 4838 !-- is consecutive in terms of start- and end-index, i.e. organized along the (j,i) 4839 !-- grid index. Hence, data need to be tranformed before it can be written to file. 4840 IF ( ALLOCATED( surfaces%var_av ) ) THEN 4841 ALLOCATE( end_index(nys:nyn,nxl:nxr) ) 4842 ALLOCATE( num_surf(nys:nyn,nxl:nxr) ) 4843 ALLOCATE( start_index(nys:nyn,nxl:nxr) ) 4844 ALLOCATE( global_start_index(nys:nyn,nxl:nxr) ) 4845 ALLOCATE( surf_out(1:surfaces%ns) ) 4846 ! 4847 !-- Determine the start and end index at each (j,i)-pair and resort the surface data 4848 start_index = 1 4849 end_index = 0 4850 start_index_aggregated = 1 4851 num_surf = 0 4852 DO l = 0, 1 4853 DO m = 1, surf_def_h(l)%ns 4854 i = surf_def_h(l)%i(m) 4855 j = surf_def_h(l)%j(m) 4856 num_surf(j,i) = num_surf(j,i) + 1 4857 ENDDO 4858 ENDDO 4859 DO m = 1, surf_lsm_h%ns 4860 i = surf_lsm_h%i(m) 4861 j = surf_lsm_h%j(m) 4862 num_surf(j,i) = num_surf(j,i) + 1 4863 ENDDO 4864 DO m = 1, surf_usm_h%ns 4865 i = surf_usm_h%i(m) 4866 j = surf_usm_h%j(m) 4867 num_surf(j,i) = num_surf(j,i) + 1 4868 ENDDO 4869 4870 DO l = 0, 3 4871 DO m = 1, surf_def_v(l)%ns 4872 i = surf_def_v(l)%i(m) 4873 j = surf_def_v(l)%j(m) 4874 num_surf(j,i) = num_surf(j,i) + 1 4875 ENDDO 4876 DO m = 1, surf_lsm_v(l)%ns 4877 i = surf_lsm_v(l)%i(m) 4878 j = surf_lsm_v(l)%j(m) 4879 num_surf(j,i) = num_surf(j,i) + 1 4880 ENDDO 4881 DO m = 1, surf_usm_v(l)%ns 4882 i = surf_usm_v(l)%i(m) 4883 j = surf_usm_v(l)%j(m) 4884 num_surf(j,i) = num_surf(j,i) + 1 4885 ENDDO 4886 ENDDO 4887 4888 start_index = 0 4889 end_index = 0 4890 start_index_aggregated = 1 4891 DO i = nxl, nxr 4892 DO j = nys, nyn 4893 start_index(j,i) = start_index_aggregated 4894 end_index(j,i) = start_index(j,i) + num_surf(j,i) - 1 4895 start_index_aggregated = start_index_aggregated + num_surf(j,i) 4896 ENDDO 4897 ENDDO 4898 4899 CALL rd_mpi_io_surface_filetypes( start_index, end_index, surface_data_to_write, & 4900 global_start_index ) 4901 CALL wrd_mpi_io( 'surfaces%start_index', start_index ) 4902 CALL wrd_mpi_io( 'surfaces%end_index', end_index ) 4903 CALL wrd_mpi_io( 'surfaces%global_start_index', global_start_index ) 4904 4905 DO nv = 1, dosurf_no(1) 4906 n = 0 4907 num_surf = 0 4908 DO l = 0, 1 4909 DO m = 1, surf_def_h(l)%ns 4910 i = surf_def_h(l)%i(m) 4911 j = surf_def_h(l)%j(m) 4912 n = n + 1 4913 surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv) 4914 num_surf(j,i) = num_surf(j,i) + 1 4915 ENDDO 4916 ENDDO 4917 DO m = 1, surf_lsm_h%ns 4918 i = surf_lsm_h%i(m) 4919 j = surf_lsm_h%j(m) 4920 n = n + 1 4921 surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv) 4922 num_surf(j,i) = num_surf(j,i) + 1 4923 ENDDO 4924 DO m = 1, surf_usm_h%ns 4925 i = surf_usm_h%i(m) 4926 j = surf_usm_h%j(m) 4927 n = n + 1 4928 surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv) 4929 num_surf(j,i) = num_surf(j,i) + 1 4930 ENDDO 4931 4932 DO l = 0, 3 4933 DO m = 1, surf_def_v(l)%ns 4934 i = surf_def_v(l)%i(m) 4935 j = surf_def_v(l)%j(m) 4936 n = n + 1 4937 surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv) 4938 num_surf(j,i) = num_surf(j,i) + 1 4939 ENDDO 4940 DO m = 1, surf_lsm_v(l)%ns 4941 i = surf_lsm_v(l)%i(m) 4942 j = surf_lsm_v(l)%j(m) 4943 n = n + 1 4944 surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv) 4945 num_surf(j,i) = num_surf(j,i) + 1 4946 ENDDO 4947 DO m = 1, surf_usm_v(l)%ns 4948 i = surf_usm_v(l)%i(m) 4949 j = surf_usm_v(l)%j(m) 4950 n = n + 1 4951 surf_out(start_index(j,i)+num_surf(j,i)) = surfaces%var_av(n,nv) 4952 num_surf(j,i) = num_surf(j,i) + 1 4953 ENDDO 4954 ENDDO 4955 4956 IF ( nv < 10 ) WRITE( dum, '(I1)') nv 4957 IF ( nv < 100 .AND. nv >= 10 ) WRITE( dum, '(I2)') nv 4958 IF ( nv < 1000 .AND. nv >= 100 ) WRITE( dum, '(I3)') nv 4959 4960 CALL wrd_mpi_io_surface( 'surfaces%var_av' // TRIM( dum ), surf_out ) 4961 ENDDO 4962 4963 ENDIF 4703 4964 4704 4965 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.
