Changeset 2232 for palm/trunk/SOURCE/poismg_mod.f90
- Timestamp:
- May 30, 2017 5:47:52 PM (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/poismg_mod.f90
r2101 r2232 26 26 ! $Id$ 27 27 ! 28 ! 2084 2016-12-09 15:59:42Z knoop29 ! Bugfix: missing rho_air_mg even/odd sorting implemented30 !31 28 ! 2073 2016-11-30 14:34:05Z raasch 32 29 ! change of openmp directives in restrict … … 111 108 REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: f1_mg_b, f2_mg_b, f3_mg_b !< blocked version of f1_mg ... 112 109 113 REAL(wp), DIMENSION(:,:), SAVE, ALLOCATABLE :: rho_air_mg_b !< blocked version of rho_air_mg114 115 110 INTERFACE poismg 116 111 MODULE PROCEDURE poismg … … 320 315 kp1 = k-ind_even_odd 321 316 r(k,j,i) = f_mg(k,j,i) & 322 - rho_air_mg _b(k,l) * ddx2_mg(l) * &317 - rho_air_mg(k,l) * ddx2_mg(l) * & 323 318 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 324 - rho_air_mg _b(k,l) * ddy2_mg(l) * &319 - rho_air_mg(k,l) * ddy2_mg(l) * & 325 320 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 326 321 - f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 333 328 kp1 = k+ind_even_odd+1 334 329 r(k,j,i) = f_mg(k,j,i) & 335 - rho_air_mg _b(k,l) * ddx2_mg(l) * &330 - rho_air_mg(k,l) * ddx2_mg(l) * & 336 331 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 337 - rho_air_mg _b(k,l) * ddy2_mg(l) * &332 - rho_air_mg(k,l) * ddy2_mg(l) * & 338 333 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 339 334 - f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 766 761 kp1 = k-ind_even_odd 767 762 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 768 rho_air_mg _b(k,l) * ddx2_mg(l) * &763 rho_air_mg(k,l) * ddx2_mg(l) * & 769 764 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 770 + rho_air_mg _b(k,l) * ddy2_mg(l) * &765 + rho_air_mg(k,l) * ddy2_mg(l) * & 771 766 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 772 767 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 785 780 kp1 = k-ind_even_odd 786 781 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 787 rho_air_mg _b(k,l) * ddx2_mg(l) * &782 rho_air_mg(k,l) * ddx2_mg(l) * & 788 783 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 789 + rho_air_mg _b(k,l) * ddy2_mg(l) * &784 + rho_air_mg(k,l) * ddy2_mg(l) * & 790 785 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 791 786 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 804 799 kp1 = k+ind_even_odd+1 805 800 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 806 rho_air_mg _b(k,l) * ddx2_mg(l) * &801 rho_air_mg(k,l) * ddx2_mg(l) * & 807 802 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 808 + rho_air_mg _b(k,l) * ddy2_mg(l) * &803 + rho_air_mg(k,l) * ddy2_mg(l) * & 809 804 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 810 805 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 823 818 kp1 = k+ind_even_odd+1 824 819 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 825 rho_air_mg _b(k,l) * ddx2_mg(l) * &820 rho_air_mg(k,l) * ddx2_mg(l) * & 826 821 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 827 + rho_air_mg _b(k,l) * ddy2_mg(l) * &822 + rho_air_mg(k,l) * ddy2_mg(l) * & 828 823 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 829 824 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 854 849 j = jj 855 850 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 856 rho_air_mg _b(k,l) * ddx2_mg(l) * &851 rho_air_mg(k,l) * ddx2_mg(l) * & 857 852 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 858 + rho_air_mg _b(k,l) * ddy2_mg(l) * &853 + rho_air_mg(k,l) * ddy2_mg(l) * & 859 854 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 860 855 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 863 858 j = jj+2 864 859 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 865 rho_air_mg _b(k,l) * ddx2_mg(l) * &860 rho_air_mg(k,l) * ddx2_mg(l) * & 866 861 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 867 + rho_air_mg _b(k,l) * ddy2_mg(l) * &862 + rho_air_mg(k,l) * ddy2_mg(l) * & 868 863 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 869 864 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 880 875 j = jj 881 876 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 882 rho_air_mg _b(k,l) * ddx2_mg(l) * &877 rho_air_mg(k,l) * ddx2_mg(l) * & 883 878 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 884 + rho_air_mg _b(k,l) * ddy2_mg(l) * &879 + rho_air_mg(k,l) * ddy2_mg(l) * & 885 880 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 886 881 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 889 884 j = jj+2 890 885 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 891 rho_air_mg _b(k,l) * ddx2_mg(l) * &886 rho_air_mg(k,l) * ddx2_mg(l) * & 892 887 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 893 + rho_air_mg _b(k,l) * ddy2_mg(l) * &888 + rho_air_mg(k,l) * ddy2_mg(l) * & 894 889 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 895 890 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 906 901 j = jj 907 902 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 908 rho_air_mg _b(k,l) * ddx2_mg(l) * &903 rho_air_mg(k,l) * ddx2_mg(l) * & 909 904 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 910 + rho_air_mg _b(k,l) * ddy2_mg(l) * &905 + rho_air_mg(k,l) * ddy2_mg(l) * & 911 906 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 912 907 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 915 910 j = jj+2 916 911 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 917 rho_air_mg _b(k,l) * ddx2_mg(l) * &912 rho_air_mg(k,l) * ddx2_mg(l) * & 918 913 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 919 + rho_air_mg _b(k,l) * ddy2_mg(l) * &914 + rho_air_mg(k,l) * ddy2_mg(l) * & 920 915 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 921 916 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 932 927 j = jj 933 928 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 934 rho_air_mg _b(k,l) * ddx2_mg(l) * &929 rho_air_mg(k,l) * ddx2_mg(l) * & 935 930 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 936 + rho_air_mg _b(k,l) * ddy2_mg(l) * &931 + rho_air_mg(k,l) * ddy2_mg(l) * & 937 932 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 938 933 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 941 936 j = jj+2 942 937 p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * ( & 943 rho_air_mg _b(k,l) * ddx2_mg(l) * &938 rho_air_mg(k,l) * ddx2_mg(l) * & 944 939 ( p_mg(k,j,i+1) + p_mg(k,j,i-1) ) & 945 + rho_air_mg _b(k,l) * ddy2_mg(l) * &940 + rho_air_mg(k,l) * ddy2_mg(l) * & 946 941 ( p_mg(k,j+1,i) + p_mg(k,j-1,i) ) & 947 942 + f2_mg_b(k,l) * p_mg(kp1,j,i) & … … 1758 1753 1759 1754 USE arrays_3d, & 1760 ONLY: f1_mg, f2_mg, f3_mg , rho_air_mg1755 ONLY: f1_mg, f2_mg, f3_mg 1761 1756 1762 1757 USE control_parameters, & … … 1784 1779 ALLOCATE( f1_mg_b(nzb:nzt+1,maximum_grid_level), & 1785 1780 f2_mg_b(nzb:nzt+1,maximum_grid_level), & 1786 f3_mg_b(nzb:nzt+1,maximum_grid_level), & 1787 rho_air_mg_b(nzb:nzt+1,maximum_grid_level) ) 1781 f3_mg_b(nzb:nzt+1,maximum_grid_level) ) 1788 1782 1789 1783 ! … … 1806 1800 f3_mg_b(nzb:nzt_mg(grid_level)+1,l), & 1807 1801 l ) 1808 CALL sort_k_to_even_odd_blocks( rho_air_mg(nzb+1:nzt_mg(grid_level),l), &1809 rho_air_mg_b(nzb:nzt_mg(grid_level)+1,l), &1810 l )1811 1802 ENDDO 1812 1803
Note: See TracChangeset
for help on using the changeset viewer.