Changeset 4832 for palm/trunk/SOURCE
- Timestamp:
- Jan 7, 2021 7:15:12 AM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 3 edited
-
poismg_mod.f90 (modified) (8 diffs)
-
poismg_noopt_mod.f90 (modified) (8 diffs)
-
restart_data_mpi_io_mod.f90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/poismg_mod.f90
r4828 r4832 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix in redblack algorithm: lower i,j indices need to start alternatively with even or odd 28 ! value on the coarsest grid level, if the subdomain has an uneven number of gridpoints along x/y 29 ! 30 ! 4828 2021-01-05 11:21:41Z Giersch 27 31 ! File re-formatted to follow the PALM coding standard 28 32 ! … … 742 746 INTEGER(iwp) :: l !< grid level 743 747 INTEGER(iwp) :: n !< loop variable GauÃ-Seidel iterations 744 745 746 LOGICAL :: unroll !< flag indicating whether loop unrolling is possible 748 INTEGER(iwp) :: save_nxl_mg !< to save nxl_mg on coarsest level 1 749 INTEGER(iwp) :: save_nys_mg !< to save nys_mg on coarsest level 1 750 751 752 LOGICAL :: adjust_lower_i_index !< adjust lower limit of i loop in case of odd number of grid points 753 LOGICAL :: adjust_lower_j_index !< adjust lower limit of j loop in case of odd number of grid points 754 LOGICAL :: unroll !< flag indicating whether loop unrolling is possible 747 755 748 756 REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1, & … … 751 759 nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) :: p_mg !< perturbation pressure 752 760 761 753 762 l = grid_level 754 763 755 764 unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0 .AND. MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 ) 756 765 766 ! 767 !-- The red/black decomposition requires that on the lower i,j indices need to start alternatively with an 768 !-- even or odd value on the coarsest grid level, depending on the core-id, and if the subdomain has an 769 !-- uneven number of gridpoints along x/y. Set the respective steering switches here. 770 IF ( l == 1 .AND. MOD( myidx, 2 ) /= 0 .AND. MOD( nxl_mg(l) - nxr_mg(l), 2 ) == 0 ) THEN 771 adjust_lower_i_index = .TRUE. 772 save_nxl_mg = nxl_mg(1) 773 ELSE 774 adjust_lower_i_index = .FALSE. 775 ENDIF 776 IF ( l == 1 .AND. MOD( myidy, 2 ) /= 0 .AND. MOD( nyn_mg(l) - nys_mg(l), 2 ) == 0 ) THEN 777 adjust_lower_j_index = .TRUE. 778 save_nys_mg = nys_mg(l) 779 ELSE 780 adjust_lower_j_index = .FALSE. 781 ENDIF 782 783 757 784 DO n = 1, ngsrb 758 785 … … 762 789 763 790 CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'start' ) 791 792 IF ( adjust_lower_i_index ) THEN 793 nxl_mg(l) = save_nxl_mg + 1 794 ENDIF 795 796 IF ( adjust_lower_j_index ) THEN 797 IF ( color == 1 ) THEN 798 nys_mg(l) = save_nys_mg - 1 799 ELSE 800 nys_mg(l) = save_nys_mg + 1 801 ENDIF 802 ENDIF 764 803 ! 765 804 !-- Without unrolling of loops, no cache optimization … … 784 823 ENDDO 785 824 825 IF ( adjust_lower_i_index ) THEN 826 nxl_mg(l) = save_nxl_mg - 1 827 ENDIF 828 829 IF ( adjust_lower_j_index ) THEN 830 IF ( color == 1 ) THEN 831 nys_mg(l) = save_nys_mg + 1 832 ELSE 833 nys_mg(l) = save_nys_mg - 1 834 ENDIF 835 ENDIF 836 786 837 !$OMP DO 787 838 DO i = nxl_mg(l)+1, nxr_mg(l), 2 … … 803 854 ENDDO 804 855 856 IF ( adjust_lower_i_index ) THEN 857 nxl_mg(l) = save_nxl_mg + 1 858 ENDIF 859 860 IF ( adjust_lower_j_index ) THEN 861 IF ( color == 1 ) THEN 862 nys_mg(l) = save_nys_mg + 1 863 ELSE 864 nys_mg(l) = save_nys_mg - 1 865 ENDIF 866 ENDIF 867 805 868 !$OMP DO 806 869 DO i = nxl_mg(l), nxr_mg(l), 2 … … 821 884 ENDDO 822 885 ENDDO 886 887 IF ( adjust_lower_i_index ) THEN 888 nxl_mg(l) = save_nxl_mg - 1 889 ENDIF 890 891 IF ( adjust_lower_j_index ) THEN 892 IF ( color == 1 ) THEN 893 nys_mg(l) = save_nys_mg - 1 894 ELSE 895 nys_mg(l) = save_nys_mg + 1 896 ENDIF 897 ENDIF 823 898 824 899 !$OMP DO … … 1013 1088 ENDDO 1014 1089 1090 ! 1091 !-- Reset lower index limits to their standard values (may happen on coarsest levels only) 1092 IF ( adjust_lower_i_index ) THEN 1093 nxl_mg(l) = save_nxl_mg 1094 ENDIF 1095 1096 IF ( adjust_lower_j_index ) THEN 1097 nys_mg(l) = save_nys_mg 1098 ENDIF 1099 1100 1015 1101 END SUBROUTINE redblack 1016 1102 -
palm/trunk/SOURCE/poismg_noopt_mod.f90
r4828 r4832 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix in redblack algorithm: lower i,j indices need to start alternatively with even or odd 28 ! value on the coarsest grid level, if the subdomain has an uneven number of gridpoints along x/y 29 ! 30 ! 4828 2021-01-05 11:21:41Z Giersch 27 31 ! File re-formatted to follow the PALM coding standard 28 !29 32 ! 30 33 ! 4457 2020-03-11 14:20:43Z raasch … … 801 804 IMPLICIT NONE 802 805 803 INTEGER(iwp) :: color !< 804 INTEGER(iwp) :: i !< 805 INTEGER(iwp) :: ic !< 806 INTEGER(iwp) :: j !< 807 INTEGER(iwp) :: jc !< 808 INTEGER(iwp) :: jj !< 809 INTEGER(iwp) :: k !< 810 INTEGER(iwp) :: l !< 811 INTEGER(iwp) :: n !< 812 806 INTEGER(iwp) :: color !< 807 INTEGER(iwp) :: i !< 808 INTEGER(iwp) :: ic !< 809 INTEGER(iwp) :: j !< 810 INTEGER(iwp) :: jc !< 811 INTEGER(iwp) :: jj !< 812 INTEGER(iwp) :: k !< 813 INTEGER(iwp) :: l !< 814 INTEGER(iwp) :: n !< 815 INTEGER(iwp) :: save_nxl_mg !< to save nxl_mg on coarsest level 1 816 INTEGER(iwp) :: save_nys_mg !< to save nys_mg on coarsest level 1 817 818 LOGICAL :: adjust_lower_i_index !< adjust lower limit of i loop in case of odd number of grid points 819 LOGICAL :: adjust_lower_j_index !< adjust lower limit of j loop in case of odd number of grid points 813 820 LOGICAL :: unroll !< 814 821 … … 855 862 MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 ) 856 863 864 ! 865 !-- The red/black decomposition requires that on the lower i,j indices need to start alternatively with an 866 !-- even or odd value on the coarsest grid level, depending on the core-id, and if the subdomain has an 867 !-- uneven number of gridpoints along x/y. Set the respective steering switches here. 868 IF ( l == 1 .AND. MOD( myidx, 2 ) /= 0 .AND. MOD( nxl_mg(l) - nxr_mg(l), 2 ) == 0 ) THEN 869 adjust_lower_i_index = .TRUE. 870 save_nxl_mg = nxl_mg(1) 871 ELSE 872 adjust_lower_i_index = .FALSE. 873 ENDIF 874 IF ( l == 1 .AND. MOD( myidy, 2 ) /= 0 .AND. MOD( nyn_mg(l) - nys_mg(l), 2 ) == 0 ) THEN 875 adjust_lower_j_index = .TRUE. 876 save_nys_mg = nys_mg(l) 877 ELSE 878 adjust_lower_j_index = .FALSE. 879 ENDIF 880 881 857 882 DO n = 1, ngsrb 858 883 … … 863 888 CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'start' ) 864 889 890 IF ( adjust_lower_i_index ) THEN 891 nxl_mg(l) = save_nxl_mg + 1 892 ENDIF 893 894 IF ( adjust_lower_j_index ) THEN 895 IF ( color == 1 ) THEN 896 nys_mg(l) = save_nys_mg - 1 897 ELSE 898 nys_mg(l) = save_nys_mg + 1 899 ENDIF 900 ENDIF 865 901 ! 866 902 !-- Without unrolling of loops, no cache optimization … … 897 933 ENDDO 898 934 ENDDO 935 936 IF ( adjust_lower_i_index ) THEN 937 nxl_mg(l) = save_nxl_mg - 1 938 ENDIF 939 940 IF ( adjust_lower_j_index ) THEN 941 IF ( color == 1 ) THEN 942 nys_mg(l) = save_nys_mg + 1 943 ELSE 944 nys_mg(l) = save_nys_mg - 1 945 ENDIF 946 ENDIF 899 947 900 948 DO i = nxl_mg(l)+1, nxr_mg(l), 2 … … 924 972 ENDDO 925 973 974 IF ( adjust_lower_i_index ) THEN 975 nxl_mg(l) = save_nxl_mg + 1 976 ENDIF 977 978 IF ( adjust_lower_j_index ) THEN 979 IF ( color == 1 ) THEN 980 nys_mg(l) = save_nys_mg + 1 981 ELSE 982 nys_mg(l) = save_nys_mg - 1 983 ENDIF 984 ENDIF 985 926 986 DO i = nxl_mg(l), nxr_mg(l), 2 927 987 DO j = nys_mg(l) + (color-1), nyn_mg(l), 2 … … 949 1009 ENDDO 950 1010 ENDDO 1011 1012 IF ( adjust_lower_i_index ) THEN 1013 nxl_mg(l) = save_nxl_mg - 1 1014 ENDIF 1015 1016 IF ( adjust_lower_j_index ) THEN 1017 IF ( color == 1 ) THEN 1018 nys_mg(l) = save_nys_mg - 1 1019 ELSE 1020 nys_mg(l) = save_nys_mg + 1 1021 ENDIF 1022 ENDIF 951 1023 952 1024 DO i = nxl_mg(l)+1, nxr_mg(l), 2 … … 1215 1287 1216 1288 ! 1217 !-- Set pressure within topography and at the topography surfaces 1289 !-- Reset lower index limits to their standard values (may happen on coarsest levels only) 1290 IF ( adjust_lower_i_index ) THEN 1291 nxl_mg(l) = save_nxl_mg 1292 ENDIF 1293 1294 IF ( adjust_lower_j_index ) THEN 1295 nys_mg(l) = save_nys_mg 1296 ENDIF 1297 1298 ! 1299 !-- Set pressure within topography and at the topography surfaces 1218 1300 !$OMP PARALLEL PRIVATE (i,j,k,wall_left,wall_north,wall_right,wall_south,wall_top,wall_total) 1219 1301 !$OMP DO -
palm/trunk/SOURCE/restart_data_mpi_io_mod.f90
r4828 r4832 25 25 ! ----------------- 26 26 ! $Id$ 27 ! some debug output flushed 28 ! 29 ! 4828 2021-01-05 11:21:41Z Giersch 27 30 ! interface for 3d logical arrays added 28 31 ! … … 2355 2358 INT( (iog%nx+1), KIND = rd_offset_kind ) * wp 2356 2359 2357 write(9,*) 'array_position real3d ',trim(name),' ',array_position 2360 IF ( debug_output ) THEN 2361 WRITE (9,*) 'array_position real3d ', TRIM( name ), ' ', array_position 2362 FLUSH( 9 ) 2363 ENDIF 2358 2364 2359 2365 END SUBROUTINE wrd_mpi_io_real_3d
Note: See TracChangeset
for help on using the changeset viewer.
