Changeset 1320 for palm/trunk/SOURCE/poisfft.f90
- Timestamp:
- Mar 20, 2014 8:40:49 AM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/poisfft.f90 (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/poisfft.f90
r1319 r1320 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! kind-parameters added to all INTEGER and REAL declaration statements, 24 ! kinds are defined in new module kinds, 25 ! old module precision_kind is removed, 26 ! revision history before 2012 removed, 27 ! comment fields (!:) to be used for variable explanations added to 28 ! all variable declaration statements 23 29 ! 24 30 ! Former revisions: … … 95 101 ! (most of the code is unneeded by check_namelist_files). 96 102 ! 97 ! 763 2011-10-06 09:32:09Z suehring98 ! Comment added concerning the last change.99 !100 ! 761 2011-10-05 17:58:52Z suehring101 ! Bugfix: Avoid divisions by zero in case of using a 'neumann' bc for the102 ! pressure at the top of the model domain.103 !104 ! 696 2011-03-18 07:03:49Z raasch105 ! work_fftx removed from PRIVATE clauses in fftx_tr_xy and tr_yx_fftx106 !107 ! 683 2011-02-09 14:25:15Z raasch108 ! openMP parallelization for 2d-domain-decomposition109 !110 ! 667 2010-12-23 12:06:00Z suehring/gryschka111 ! ddzu replaced by ddzu_pres due to changes in zu(0)112 !113 ! 622 2010-12-10 08:08:13Z raasch114 ! optional barriers included in order to speed up collective operations115 !116 ! 377 2009-09-04 11:09:00Z raasch117 ! __lcmuk changed to __lc to avoid problems with Intel compiler on sgi-ice118 !119 ! 164 2008-05-15 08:46:15Z raasch120 ! Arguments removed from transpose routines121 !122 ! 128 2007-10-26 13:11:14Z raasch123 ! Bugfix: wavenumber calculation for even nx in routines maketri124 !125 ! 85 2007-05-11 09:35:14Z raasch126 ! Bugfix: work_fft*_vec removed from some PRIVATE-declarations127 !128 ! 76 2007-03-29 00:58:32Z raasch129 ! Tridiagonal coefficients adjusted for Neumann boundary conditions both at130 ! the bottom and the top.131 !132 ! RCS Log replace by Id keyword, revision history cleaned up133 !134 ! Revision 1.24 2006/08/04 15:00:24 raasch135 ! Default setting of the thread number tn in case of not using OpenMP136 !137 ! Revision 1.23 2006/02/23 12:48:38 raasch138 ! Additional compiler directive in routine tridia_1dd for preventing loop139 ! exchange on NEC-SX6140 !141 ! Revision 1.20 2004/04/30 12:38:09 raasch142 ! Parts of former poisfft_hybrid moved to this subroutine,143 ! former subroutine changed to a module, renaming of FFT-subroutines and144 ! -module, FFTs completely substituted by calls of fft_x and fft_y,145 ! NAG fft used in the non-parallel case completely removed, l in maketri146 ! is now a 1d-array, variables passed by modules instead of using parameter147 ! lists, enlarged transposition arrays introduced148 !149 103 ! Revision 1.1 1997/07/24 11:24:14 raasch 150 104 ! Initial revision … … 167 121 !------------------------------------------------------------------------------! 168 122 169 USE fft_xy 170 USE indices 171 USE transpose_indices 172 USE tridia_solver 123 USE fft_xy, & 124 ONLY: fft_init, fft_y, fft_y_1d, fft_y_m, fft_x, fft_x_1d, fft_x_m 125 126 USE indices, & 127 ONLY: nnx, nny, nx, nxl, nxr, ny, nys, nyn, nz 128 129 USE transpose_indices, & 130 ONLY: nxl_y, nxl_z, nxr_y, nxr_z, nys_x, nys_z, nyn_x, nyn_z, nzb_x, & 131 nzb_y, nzt_x, nzt_y 132 133 USE tridia_solver, & 134 ONLY: tridia_1dd, tridia_init, tridia_substi, tridia_substi_overlap 173 135 174 136 IMPLICIT NONE … … 200 162 SUBROUTINE poisfft_init 201 163 202 USE arrays_3d, ONLY: ddzu_pres, ddzw 164 USE arrays_3d, & 165 ONLY: ddzu_pres, ddzw 166 167 USE kinds 203 168 204 169 IMPLICIT NONE 205 170 206 INTEGER :: k171 INTEGER(iwp) :: k !: 207 172 208 173 … … 219 184 SUBROUTINE poisfft( ar ) 220 185 221 USE control_parameters, ONLY : fft_method, transpose_compute_overlap 222 USE cpulog 186 USE control_parameters, & 187 ONLY: fft_method, transpose_compute_overlap 188 189 USE cpulog, & 190 ONLY: cpu_log, cpu_log_nowait, log_point_s 191 192 USE kinds 193 223 194 USE pegrid 224 195 225 196 IMPLICIT NONE 226 197 227 INTEGER :: ii, iind, inew, jj, jind, jnew, ki, kk, knew, n, nblk, & 228 nnx_y, nny_z, nnz_t, nnz_x, nxl_y_bound, nxr_y_bound 229 INTEGER, DIMENSION(4) :: isave 230 231 REAL, DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar 198 INTEGER(iwp) :: ii !: 199 INTEGER(iwp) :: iind !: 200 INTEGER(iwp) :: inew !: 201 INTEGER(iwp) :: jj !: 202 INTEGER(iwp) :: jind !: 203 INTEGER(iwp) :: jnew !: 204 INTEGER(iwp) :: ki !: 205 INTEGER(iwp) :: kk !: 206 INTEGER(iwp) :: knew !: 207 INTEGER(iwp) :: n !: 208 INTEGER(iwp) :: nblk !: 209 INTEGER(iwp) :: nnx_y !: 210 INTEGER(iwp) :: nny_z !: 211 INTEGER(iwp) :: nnz_t !: 212 INTEGER(iwp) :: nnz_x !: 213 INTEGER(iwp) :: nxl_y_bound !: 214 INTEGER(iwp) :: nxr_y_bound !: 215 216 INTEGER(iwp), DIMENSION(4) :: isave !: 217 218 REAL(wp), DIMENSION(1:nz,nys:nyn,nxl:nxr) :: ar !: 232 219 !$acc declare create( ar_inv ) 233 REAL, DIMENSION(nys:nyn,nxl:nxr,1:nz) :: ar_inv 234 235 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ar1, f_in, f_inv, f_out_y, & 236 f_out_z 220 REAL(wp), DIMENSION(nys:nyn,nxl:nxr,1:nz) :: ar_inv !: 221 222 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ar1 !: 223 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f_in !: 224 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f_inv !: 225 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f_out_y !: 226 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: f_out_z !: 237 227 238 228 … … 723 713 !------------------------------------------------------------------------------! 724 714 725 USE control_parameters 726 USE cpulog 727 USE indices 715 USE control_parameters, & 716 ONLY: host 717 718 USE cpulog, & 719 ONLY: cpu_log, log_point_s 720 721 USE kinds 722 728 723 USE pegrid 729 USE transpose_indices730 724 731 725 IMPLICIT NONE 732 726 733 INTEGER :: i, iend, iouter, ir, j, k 734 INTEGER, PARAMETER :: stridex = 4 735 736 REAL, DIMENSION(0:ny,stridex) :: work_ffty 727 INTEGER(iwp) :: i !: 728 INTEGER(iwp) :: iend !: 729 INTEGER(iwp) :: iouter !: 730 INTEGER(iwp) :: ir !: 731 INTEGER(iwp) :: j !: 732 INTEGER(iwp) :: k !: 733 734 INTEGER(iwp), PARAMETER :: stridex = 4 !: 735 736 REAL(wp), DIMENSION(0:ny,stridex) :: work_ffty !: 737 737 #if defined( __nec ) 738 REAL , DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec738 REAL(wp), DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec !: 739 739 #endif 740 REAL , DIMENSION(1:nz,0:ny,nxl:nxr) :: f_in741 REAL , DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_out742 REAL , DIMENSION(nxl:nxr,1:nz,0:ny) :: work740 REAL(wp), DIMENSION(1:nz,0:ny,nxl:nxr) :: f_in !: 741 REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_out !: 742 REAL(wp), DIMENSION(nxl:nxr,1:nz,0:ny) :: work !: 743 743 744 744 ! … … 840 840 !------------------------------------------------------------------------------! 841 841 842 USE control_parameters 843 USE cpulog 844 USE indices 842 USE control_parameters, & 843 ONLY: host 844 845 USE cpulog, & 846 ONLY: cpu_log, log_point_s 847 848 USE kinds 849 845 850 USE pegrid 846 USE transpose_indices847 851 848 852 IMPLICIT NONE 849 853 850 INTEGER :: i, iend, iouter, ir, j, k 851 INTEGER, PARAMETER :: stridex = 4 852 853 REAL, DIMENSION(0:ny,stridex) :: work_ffty 854 INTEGER(iwp) :: i !: 855 INTEGER(iwp) :: iend !: 856 INTEGER(iwp) :: iouter !: 857 INTEGER(iwp) :: ir !: 858 INTEGER(iwp) :: j !: 859 INTEGER(iwp) :: k !: 860 861 INTEGER(iwp), PARAMETER :: stridex = 4 !: 862 863 REAL(wp), DIMENSION(0:ny,stridex) :: work_ffty !: 854 864 #if defined( __nec ) 855 REAL , DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec865 REAL(wp), DIMENSION(0:ny+1,1:nz,nxl:nxr) :: work_ffty_vec !: 856 866 #endif 857 REAL , DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_in858 REAL , DIMENSION(1:nz,0:ny,nxl:nxr) :: f_out859 REAL , DIMENSION(nxl:nxr,1:nz,0:ny) :: work867 REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: f_in !: 868 REAL(wp), DIMENSION(1:nz,0:ny,nxl:nxr) :: f_out !: 869 REAL(wp), DIMENSION(nxl:nxr,1:nz,0:ny) :: work !: 860 870 861 871 ! … … 960 970 !------------------------------------------------------------------------------! 961 971 962 USE control_parameters 963 USE cpulog 964 USE grid_variables 965 USE indices 972 USE control_parameters, & 973 ONLY: host 974 975 USE cpulog, & 976 ONLY: cpu_log, log_point_s 977 978 USE grid_variables, & 979 ONLY: ddx2, ddy2 980 981 USE kinds 982 966 983 USE pegrid 967 USE transpose_indices968 984 969 985 IMPLICIT NONE 970 986 971 INTEGER :: i, j, k, m, n, omp_get_thread_num, tn 972 973 REAL, DIMENSION(0:nx) :: work_fftx 974 REAL, DIMENSION(0:nx,1:nz) :: work_trix 975 REAL, DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: ar 976 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri 987 INTEGER(iwp) :: i !: 988 INTEGER(iwp) :: j !: 989 INTEGER(iwp) :: k !: 990 INTEGER(iwp) :: m !: 991 INTEGER(iwp) :: n !: 992 INTEGER(iwp) :: omp_get_thread_num !: 993 INTEGER(iwp) :: tn !: 994 995 REAL(wp), DIMENSION(0:nx) :: work_fftx !: 996 REAL(wp), DIMENSION(0:nx,1:nz) :: work_trix !: 997 REAL(wp), DIMENSION(nnx,1:nz,nys_x:nyn_x,pdims(1)) :: ar !: 998 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tri !: 977 999 978 1000 … … 1091 1113 !------------------------------------------------------------------------------! 1092 1114 1093 USE control_parameters 1094 USE cpulog 1095 USE indices 1115 USE control_parameters, & 1116 ONLY: host 1117 1118 USE cpulog, & 1119 ONLY: cpu_log, log_point_s 1120 1121 USE kinds 1122 1096 1123 USE pegrid 1097 USE transpose_indices1098 1124 1099 1125 IMPLICIT NONE 1100 1126 1101 INTEGER :: i, j, k 1102 1103 REAL, DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx 1104 REAL, DIMENSION(1:nz,nys:nyn,0:nx) :: f_in 1105 REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: f_out 1106 REAL, DIMENSION(nys:nyn,1:nz,0:nx) :: work 1127 INTEGER(iwp) :: i !: 1128 INTEGER(iwp) :: j !: 1129 INTEGER(iwp) :: k !: 1130 1131 REAL(wp), DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx !: 1132 REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx) :: f_in !: 1133 REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: f_out !: 1134 REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx) :: work !: 1107 1135 1108 1136 ! … … 1196 1224 !------------------------------------------------------------------------------! 1197 1225 1198 USE control_parameters 1199 USE cpulog 1200 USE indices 1226 USE control_parameters, & 1227 ONLY: host 1228 1229 USE cpulog, & 1230 ONLY: cpu_log, log_point_s 1231 1232 USE kinds 1233 1201 1234 USE pegrid 1202 USE transpose_indices1203 1235 1204 1236 IMPLICIT NONE 1205 1237 1206 INTEGER :: i, j, k 1207 1208 REAL, DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx 1209 REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: f_in 1210 REAL, DIMENSION(1:nz,nys:nyn,0:nx) :: f_out 1211 REAL, DIMENSION(nys:nyn,1:nz,0:nx) :: work 1238 INTEGER(iwp) :: i !: 1239 INTEGER(iwp) :: j !: 1240 INTEGER(iwp) :: k !: 1241 1242 REAL(wp), DIMENSION(0:nx,1:nz,nys:nyn) :: work_fftx !: 1243 REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: f_in !: 1244 REAL(wp), DIMENSION(1:nz,nys:nyn,0:nx) :: f_out !: 1245 REAL(wp), DIMENSION(nys:nyn,1:nz,0:nx) :: work !: 1212 1246 1213 1247 ! … … 1301 1335 !------------------------------------------------------------------------------! 1302 1336 1303 USE control_parameters 1304 USE cpulog 1305 USE grid_variables 1306 USE indices 1337 USE control_parameters, & 1338 ONLY: host 1339 1340 USE cpulog, & 1341 ONLY: cpu_log, log_point_s 1342 1343 USE grid_variables, & 1344 ONLY: ddx2, ddy2 1345 1346 USE kinds 1347 1307 1348 USE pegrid 1308 USE transpose_indices1309 1349 1310 1350 IMPLICIT NONE 1311 1351 1312 INTEGER :: i, j, k, m, n, omp_get_thread_num, tn 1313 1314 REAL, DIMENSION(0:ny) :: work_ffty 1315 REAL, DIMENSION(0:ny,1:nz) :: work_triy 1316 REAL, DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: ar 1317 REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: tri 1352 INTEGER(iwp) :: i !: 1353 INTEGER(iwp) :: j !: 1354 INTEGER(iwp) :: k !: 1355 INTEGER(iwp) :: m !: 1356 INTEGER(iwp) :: n !: 1357 INTEGER(iwp) :: omp_get_thread_num !: 1358 INTEGER(iwp) :: tn !: 1359 1360 REAL(wp), DIMENSION(0:ny) :: work_ffty !: 1361 REAL(wp), DIMENSION(0:ny,1:nz) :: work_triy !: 1362 REAL(wp), DIMENSION(nny,1:nz,nxl_y:nxr_y,pdims(2)) :: ar !: 1363 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tri !: 1318 1364 1319 1365
Note: See TracChangeset
for help on using the changeset viewer.
