Changeset 4370 for palm/trunk
- Timestamp:
- Jan 10, 2020 2:00:44 PM (5 years ago)
- Location:
- palm/trunk
- Files:
-
- 2 added
- 27 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SCRIPTS/create_basic_static_driver.py
r4072 r4370 14 14 # PALM. If not, see <http://www.gnu.org/licenses/>. 15 15 # 16 # Copyright 1997-20 19Leibniz Universitaet Hannover16 # Copyright 1997-2020 Leibniz Universitaet Hannover 17 17 #------------------------------------------------------------------------------# 18 18 -
palm/trunk/SCRIPTS/document_changes
r3802 r4370 15 15 # PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 # 17 # Copyright 1997-20 19Leibniz Universitaet Hannover17 # Copyright 1997-2020 Leibniz Universitaet Hannover 18 18 #------------------------------------------------------------------------------# 19 19 # -
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r4360 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! vector directives added to force vectorization on Intel19 compiler 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 31 ! topography information used in wall_flags_static_0 … … 1397 1400 DO i = nxl, nxr 1398 1401 DO j = nys, nyn 1402 !following directive is required to vectorize on Intel19 1403 !DIR$ IVDEP 1399 1404 DO k = nzb+1, nzt 1400 1405 qc_p(k,j,i) = qc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & … … 1487 1492 DO i = nxl, nxr 1488 1493 DO j = nys, nyn 1494 !following directive is required to vectorize on Intel19 1495 !DIR$ IVDEP 1489 1496 DO k = nzb+1, nzt 1490 1497 nc_p(k,j,i) = nc(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & … … 1584 1591 DO i = nxl, nxr 1585 1592 DO j = nys, nyn 1593 !following directive is required to vectorize on Intel19 1594 !DIR$ IVDEP 1586 1595 DO k = nzb+1, nzt 1587 1596 qr_p(k,j,i) = qr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & … … 1674 1683 DO i = nxl, nxr 1675 1684 DO j = nys, nyn 1685 !following directive is required to vectorize on Intel19 1686 !DIR$ IVDEP 1676 1687 DO k = nzb+1, nzt 1677 1688 nr_p(k,j,i) = nr(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & -
palm/trunk/SOURCE/chemistry_model_mod.f90
r4346 r4370 27 27 ! ----------------- 28 28 ! $Id$ 29 ! vector directives added to force vectorization on Intel19 compiler 30 ! 31 ! 4346 2019-12-18 11:55:56Z motisi 29 32 ! Introduction of wall_flags_total_0, which currently sets bits based on static 30 33 ! topography information used in wall_flags_static_0 … … 2744 2747 DO i = nxl, nxr 2745 2748 DO j = nys, nyn 2749 !following directive is required to vectorize on Intel19 2750 !DIR$ IVDEP 2746 2751 DO k = nzb+1, nzt 2747 2752 chem_species(ilsp)%conc_p(k,j,i) = chem_species(ilsp)%conc(k,j,i) & -
palm/trunk/SOURCE/fft_xy_mod.f90
r4366 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! bugfix for Temperton-fft usage on GPU 28 ! 29 ! 4366 2020-01-09 08:12:43Z raasch 27 30 ! Vectorized Temperton-fft added 28 31 ! … … 76 79 77 80 PRIVATE 78 PUBLIC fft_x, fft_x_1d, fft_y, fft_y_1d, fft_init, fft_x_m, fft_y_m, f_vec , temperton_fft_vec81 PUBLIC fft_x, fft_x_1d, fft_y, fft_y_1d, fft_init, fft_x_m, fft_y_m, f_vec_x, temperton_fft_vec 79 82 80 83 INTEGER(iwp), DIMENSION(:), ALLOCATABLE, SAVE :: ifax_x !< … … 92 95 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: trigs_y !< 93 96 94 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: f_vec 97 REAL(wp), DIMENSION(:,:), ALLOCATABLE, SAVE :: f_vec_x 95 98 96 99 #if defined( __ibm ) … … 105 108 REAL(wp), DIMENSION(nau1), SAVE :: auy3 !< 106 109 107 #elif defined( __nec )110 #elif defined( __nec_fft ) 108 111 INTEGER(iwp), SAVE :: nz1 !< 109 112 … … 180 183 SUBROUTINE fft_init 181 184 185 USE pegrid, & 186 ONLY: pdims 187 182 188 IMPLICIT NONE 183 189 … … 192 198 REAL(wp), DIMENSION(nau2) :: aux4 !< 193 199 REAL(wp), DIMENSION(nau2) :: auy4 !< 194 #elif defined( __nec )200 #elif defined( __nec_fft ) 195 201 REAL(wp), DIMENSION(0:nx+3,nz+1) :: work_x !< 196 202 REAL(wp), DIMENSION(0:ny+3,nz+1) :: work_y !< … … 207 213 ENDIF 208 214 215 #if defined( _OPENACC ) && defined( __cuda_fft ) 216 fft_method = 'system-specific' 217 #endif 218 209 219 ! 210 220 !-- Switch to tell the Poisson-solver that the vectorized version of Temperton-fft is to be used. 211 IF ( fft_method == 'temperton-algorithm' .AND. loop_optimization == 'vector' ) THEN 221 IF ( fft_method == 'temperton-algorithm' .AND. loop_optimization == 'vector' .AND. & 222 pdims(1) /= 1 .AND. pdims(2) /= 1 ) THEN 212 223 temperton_fft_vec = .TRUE. 213 224 ENDIF 214 215 216 #if defined( _OPENACC ) && defined( __cuda_fft )217 fft_method = 'system-specific'218 #endif219 225 220 226 IF ( fft_method == 'system-specific' ) THEN … … 237 243 CALL DCRFT( 1, worky, 1, worky, 1, ny+1, 1, -1, sqr_dny, auy3, nau1, & 238 244 auy4, nau2 ) 239 #elif defined( __nec )245 #elif defined( __nec_fft ) 240 246 message_string = 'fft method "' // TRIM( fft_method) // & 241 247 '" currently does not work on NEC' … … 285 291 286 292 IF ( temperton_fft_vec ) THEN 287 ALLOCATE( f_vec ((nyn_x-nys_x+1)*(nzt_x-nzb_x+1),0:nx+2) )293 ALLOCATE( f_vec_x((nyn_x-nys_x+1)*(nzt_x-nzb_x+1),0:nx+2) ) 288 294 ENDIF 289 295 … … 361 367 REAL(wp), DIMENSION(nau2) :: aux2 !< 362 368 REAL(wp), DIMENSION(nau2) :: aux4 !< 363 #elif defined( __nec )369 #elif defined( __nec_fft ) 364 370 REAL(wp), DIMENSION(6*(nx+1)) :: work2 !< 365 371 #elif defined( __cuda_fft ) … … 475 481 ALLOCATE( work_vec( (nyn_x-nys_x+1)*(nzt_x-nzb_x+1),nx+2) ) 476 482 ! 477 !-- f_vec is already set in transpose_zx478 CALL fft991cy_vec( f_vec , work_vec, trigs_x, ifax_x, nx+1, -1 )483 !-- f_vec_x is already set in transpose_zx 484 CALL fft991cy_vec( f_vec_x, work_vec, trigs_x, ifax_x, nx+1, -1 ) 479 485 DEALLOCATE( work_vec ) 480 486 … … 485 491 mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1) 486 492 DO i = 0, (nx+1)/2 487 ar_inv(j,k,i) = f_vec (mm,2*i)493 ar_inv(j,k,i) = f_vec_x(mm,2*i) 488 494 ENDDO 489 495 DO i = 1, (nx+1)/2-1 490 ar_inv(j,k,nx+1-i) = f_vec (mm,2*i+1)496 ar_inv(j,k,nx+1-i) = f_vec_x(mm,2*i+1) 491 497 ENDDO 492 498 ENDDO … … 499 505 mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1) 500 506 DO i = 0, (nx+1)/2 501 ar(i,j,k) = f_vec (mm,2*i)507 ar(i,j,k) = f_vec_x(mm,2*i) 502 508 ENDDO 503 509 DO i = 1, (nx+1)/2-1 504 ar(nx+1-i,j,k) = f_vec (mm,2*i+1)510 ar(nx+1-i,j,k) = f_vec_x(mm,2*i+1) 505 511 ENDDO 506 512 ENDDO … … 546 552 mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1) 547 553 DO i = 0, (nx+1)/2 548 f_vec (mm,2*i) = ar_inv(j,k,i)554 f_vec_x(mm,2*i) = ar_inv(j,k,i) 549 555 ENDDO 550 556 DO i = 1, (nx+1)/2-1 551 f_vec (mm,2*i+1) = ar_inv(j,k,nx+1-i)557 f_vec_x(mm,2*i+1) = ar_inv(j,k,nx+1-i) 552 558 ENDDO 553 559 ENDDO … … 560 566 mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1) 561 567 DO i = 0, (nx+1)/2 562 f_vec (mm,2*i) = ar(i,j,k)568 f_vec_x(mm,2*i) = ar(i,j,k) 563 569 ENDDO 564 570 DO i = 1, (nx+1)/2-1 565 f_vec (mm,2*i+1) = ar(nx+1-i,j,k)571 f_vec_x(mm,2*i+1) = ar(nx+1-i,j,k) 566 572 ENDDO 567 573 ENDDO … … 569 575 570 576 ENDIF 571 f_vec (:,1) = 0.0_wp572 f_vec (:,nx+2) = 0.0_wp577 f_vec_x(:,1) = 0.0_wp 578 f_vec_x(:,nx+2) = 0.0_wp 573 579 574 580 ALLOCATE( work_vec((nyn_x-nys_x+1)*(nzt_x-nzb_x+1),nx+2) ) 575 CALL fft991cy_vec( f_vec , work_vec, trigs_x, ifax_x, nx+1, 1 )581 CALL fft991cy_vec( f_vec_x, work_vec, trigs_x, ifax_x, nx+1, 1 ) 576 582 DEALLOCATE( work_vec ) 577 583 … … 707 713 ENDIF 708 714 709 #elif defined( __nec )715 #elif defined( __nec_fft ) 710 716 711 717 IF ( forward_fft ) THEN … … 842 848 REAL(wp), DIMENSION(nau2) :: aux2 !< 843 849 REAL(wp), DIMENSION(nau2) :: aux4 !< 844 #elif defined( __nec )850 #elif defined( __nec_fft ) 845 851 REAL(wp), DIMENSION(6*(nx+1)) :: work2 !< 846 852 #endif … … 989 995 990 996 ENDIF 991 #elif defined( __nec )997 #elif defined( __nec_fft ) 992 998 IF ( forward_fft ) THEN 993 999 … … 1072 1078 REAL(wp), DIMENSION(ny+2) :: work1 !< 1073 1079 1074 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: f_vec 1080 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: f_vec_y 1075 1081 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: work_vec 1076 1082 … … 1084 1090 REAL(wp), DIMENSION(nau2) :: auy2 !< 1085 1091 REAL(wp), DIMENSION(nau2) :: auy4 !< 1086 #elif defined( __nec )1092 #elif defined( __nec_fft ) 1087 1093 REAL(wp), DIMENSION(6*(ny+1)) :: work2 !< 1088 1094 #elif defined( __cuda_fft ) … … 1194 1200 ! 1195 1201 !-- Vector version of Temperton-fft. Computes multiple 1-D FFT's. 1196 ALLOCATE( f_vec ((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),0:ny+2) )1202 ALLOCATE( f_vec_y((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),0:ny+2) ) 1197 1203 1198 1204 mm = 1 1199 1205 DO k = nzb_y, nzt_y 1200 1206 DO i = nxl_y_l, nxr_y_l 1201 f_vec (mm,0:nx) = ar(0:nx,i,k)1207 f_vec_y(mm,0:nx) = ar(0:nx,i,k) 1202 1208 mm = mm+1 1203 1209 ENDDO … … 1205 1211 1206 1212 ALLOCATE( work_vec( (nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),ny+2) ) 1207 CALL fft991cy_vec( f_vec , work_vec, trigs_y, ifax_y, ny+1, -1 )1213 CALL fft991cy_vec( f_vec_y, work_vec, trigs_y, ifax_y, ny+1, -1 ) 1208 1214 DEALLOCATE( work_vec ) 1209 1215 … … 1214 1220 mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1) 1215 1221 DO j = 0, (ny+1)/2 1216 ar_inv(i,k,j) = f_vec (mm,2*j)1222 ar_inv(i,k,j) = f_vec_y(mm,2*j) 1217 1223 ENDDO 1218 1224 DO j = 1, (ny+1)/2 - 1 1219 ar_inv(i,k,ny+1-j) = f_vec (mm,2*j+1)1225 ar_inv(i,k,ny+1-j) = f_vec_y(mm,2*j+1) 1220 1226 ENDDO 1221 1227 ENDDO … … 1228 1234 mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1) 1229 1235 DO j = 0, (ny+1)/2 1230 ar(j,i,k) = f_vec (mm,2*j)1236 ar(j,i,k) = f_vec_y(mm,2*j) 1231 1237 ENDDO 1232 1238 DO j = 1, (ny+1)/2 - 1 1233 ar(ny+1-j,i,k) = f_vec (mm,2*j+1)1239 ar(ny+1-j,i,k) = f_vec_y(mm,2*j+1) 1234 1240 ENDDO 1235 1241 ENDDO … … 1238 1244 ENDIF 1239 1245 1240 DEALLOCATE( f_vec )1246 DEALLOCATE( f_vec_y ) 1241 1247 1242 1248 ENDIF … … 1269 1275 ELSE 1270 1276 1271 ALLOCATE( f_vec ((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),0:ny+2) )1277 ALLOCATE( f_vec_y((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),0:ny+2) ) 1272 1278 1273 1279 IF ( PRESENT( ar_inv ) ) THEN … … 1277 1283 mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1) 1278 1284 DO j = 0, (ny+1)/2 1279 f_vec (mm,2*j) = ar_inv(i,k,j)1285 f_vec_y(mm,2*j) = ar_inv(i,k,j) 1280 1286 ENDDO 1281 1287 DO j = 1, (ny+1)/2 - 1 1282 f_vec (mm,2*j+1) = ar_inv(i,k,ny+1-j)1288 f_vec_y(mm,2*j+1) = ar_inv(i,k,ny+1-j) 1283 1289 ENDDO 1284 1290 ENDDO … … 1291 1297 mm = i-nxl_y_l+1+(k-nzb_y)*(nxr_y_l-nxl_y_l+1) 1292 1298 DO j = 0, (ny+1)/2 1293 f_vec (mm,2*j) = ar(j,i,k)1299 f_vec_y(mm,2*j) = ar(j,i,k) 1294 1300 ENDDO 1295 1301 DO j = 1, (ny+1)/2 - 1 1296 f_vec (mm,2*j+1) = ar(ny+1-j,i,k)1302 f_vec_y(mm,2*j+1) = ar(ny+1-j,i,k) 1297 1303 ENDDO 1298 1304 ENDDO … … 1301 1307 ENDIF 1302 1308 1303 f_vec (:,1) = 0.0_wp1304 f_vec (:,ny+2) = 0.0_wp1309 f_vec_y(:,1) = 0.0_wp 1310 f_vec_y(:,ny+2) = 0.0_wp 1305 1311 1306 1312 ALLOCATE( work_vec((nxr_y_l-nxl_y_l+1)*(nzt_y-nzb_y+1),ny+2) ) 1307 CALL fft991cy_vec( f_vec , work_vec, trigs_y, ifax_y, ny+1, 1 )1313 CALL fft991cy_vec( f_vec_y, work_vec, trigs_y, ifax_y, ny+1, 1 ) 1308 1314 DEALLOCATE( work_vec ) 1309 1315 … … 1311 1317 DO k = nzb_y, nzt_y 1312 1318 DO i = nxl_y_l, nxr_y_l 1313 ar(0:ny,i,k) = f_vec (mm,0:ny)1319 ar(0:ny,i,k) = f_vec_y(mm,0:ny) 1314 1320 mm = mm+1 1315 1321 ENDDO 1316 1322 ENDDO 1317 1323 1318 DEALLOCATE( f_vec )1324 DEALLOCATE( f_vec_y ) 1319 1325 1320 1326 ENDIF … … 1423 1429 1424 1430 ENDIF 1425 #elif defined( __nec )1431 #elif defined( __nec_fft ) 1426 1432 IF ( forward_fft ) THEN 1427 1433 … … 1556 1562 REAL(wp), DIMENSION(nau2) :: auy2 !< 1557 1563 REAL(wp), DIMENSION(nau2) :: auy4 !< 1558 #elif defined( __nec )1564 #elif defined( __nec_fft ) 1559 1565 REAL(wp), DIMENSION(6*(ny+1)) :: work2 !< 1560 1566 #endif … … 1705 1711 1706 1712 ENDIF 1707 #elif defined( __nec )1713 #elif defined( __nec_fft ) 1708 1714 IF ( forward_fft ) THEN 1709 1715 … … 1760 1766 INTEGER(iwp) :: k !< 1761 1767 INTEGER(iwp) :: siza !< 1762 #if defined( __nec )1768 #if defined( __nec_fft ) 1763 1769 INTEGER(iwp) :: sizw 1764 1770 #endif … … 1768 1774 REAL(wp), DIMENSION(6*(nx+4),nz+1) :: work1 !< 1769 1775 1770 #if defined( __nec )1776 #if defined( __nec_fft ) 1771 1777 COMPLEX(wp), DIMENSION(:,:), ALLOCATABLE :: work 1772 1778 #endif … … 1813 1819 ELSEIF ( fft_method == 'system-specific' ) THEN 1814 1820 1815 #if defined( __nec )1821 #if defined( __nec_fft ) 1816 1822 ALLOCATE( work((nx+4)/2+1,nz+1) ) 1817 1823 siza = SIZE( ai, 1 ) … … 1896 1902 INTEGER(iwp) :: ny1 !< 1897 1903 INTEGER(iwp) :: siza !< 1898 #if defined( __nec )1904 #if defined( __nec_fft ) 1899 1905 INTEGER(iwp) :: sizw 1900 1906 #endif … … 1904 1910 REAL(wp), DIMENSION(6*(ny+4),nz+1) :: work1 !< 1905 1911 1906 #if defined( __nec )1912 #if defined( __nec_fft ) 1907 1913 COMPLEX(wp), DIMENSION(:,:), ALLOCATABLE :: work 1908 1914 #endif … … 1950 1956 ELSEIF ( fft_method == 'system-specific' ) THEN 1951 1957 1952 #if defined( __nec )1958 #if defined( __nec_fft ) 1953 1959 ALLOCATE( work((ny+4)/2+1,nz+1) ) 1954 1960 siza = SIZE( ai, 1 ) -
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r4362 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! collective read switched off on NEC Aurora to avoid hang situations 28 ! 29 ! 4362 2020-01-07 17:15:02Z suehring 27 30 ! Input of plant canopy variables from static driver moved to plant-canopy 28 31 ! model … … 4135 4138 collective_read = .FALSE. 4136 4139 ELSE 4140 #if defined( __nec ) 4141 collective_read = .FALSE. ! collective read causes hang situations on NEC Aurora 4142 #else 4137 4143 collective_read = .TRUE. 4144 #endif 4138 4145 ENDIF 4139 4146 #else -
palm/trunk/SOURCE/ocean_mod.f90
r4346 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! vector directives added to force vectorization on Intel19 compiler 28 ! 29 ! 4346 2019-12-18 11:55:56Z motisi 27 30 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 31 ! topography information used in wall_flags_static_0 … … 1679 1682 DO i = nxl, nxr 1680 1683 DO j = nys, nyn 1684 !following directive is required to vectorize on Intel19 1685 !DIR$ IVDEP 1681 1686 DO k = nzb+1, nzt 1682 1687 sa_p(k,j,i) = sa(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & -
palm/trunk/SOURCE/prognostic_equations.f90
r4360 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! vector directives added to force vectorization on Intel19 compiler 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 31 ! topography information used in wall_flags_static_0 … … 936 939 DO i = nxlu, nxr 937 940 DO j = nys, nyn 941 !following directive is required to vectorize on Intel19 942 !DIR$ IVDEP 938 943 DO k = nzb+1, nzt 939 944 u_p(k,j,i) = u(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + & … … 1039 1044 DO i = nxl, nxr 1040 1045 DO j = nysv, nyn 1046 !following directive is required to vectorize on Intel19 1047 !DIR$ IVDEP 1041 1048 DO k = nzb+1, nzt 1042 1049 v_p(k,j,i) = v(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + & … … 1138 1145 DO i = nxl, nxr 1139 1146 DO j = nys, nyn 1147 !following directive is required to vectorize on Intel19 1148 !DIR$ IVDEP 1140 1149 DO k = nzb+1, nzt-1 1141 1150 w_p(k,j,i) = w(k,j,i) + ( dt_3d * ( tsc(2) * tend(k,j,i) + & … … 1277 1286 DO i = nxl, nxr 1278 1287 DO j = nys, nyn 1288 !following directive is required to vectorize on Intel19 1289 !DIR$ IVDEP 1279 1290 DO k = nzb+1, nzt 1280 1291 pt_p(k,j,i) = pt(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & … … 1400 1411 DO i = nxl, nxr 1401 1412 DO j = nys, nyn 1413 !following directive is required to vectorize on Intel19 1414 !DIR$ IVDEP 1402 1415 DO k = nzb+1, nzt 1403 1416 q_p(k,j,i) = q(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & … … 1520 1533 DO i = nxl, nxr 1521 1534 DO j = nys, nyn 1535 !following directive is required to vectorize on Intel19 1536 !DIR$ IVDEP 1522 1537 DO k = nzb+1, nzt 1523 1538 s_p(k,j,i) = s(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & -
palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
r4366 r4370 26 26 ! ----------------- 27 27 ! $Id$ 28 ! bugfix: openacc porting for vector version of OL calculation added 29 ! 30 ! 4366 2020-01-09 08:12:43Z raasch 28 31 ! vector version for calculation of Obukhov length via Newton iteration added 29 32 ! … … 863 866 864 867 LOGICAL, DIMENSION(surf%ns) :: convergence_reached !< convergence switch for vectorization 868 !$ACC DECLARE CREATE( convergence_reached ) 865 869 866 870 REAL(wp) :: f, & !< Function for Newton iteration: f = Ri - [...]/[...]^2 = 0 … … 873 877 REAL(wp), DIMENSION(surf%ns) :: ol_old_vec !< temporary array required for vectorization 874 878 REAL(wp), DIMENSION(surf%ns) :: z_mo_vec !< temporary array required for vectorization 879 !$ACC DECLARE CREATE( ol_old_vec, z_mo_vec ) 875 880 876 881 ! … … 1063 1068 !-- Calculate the Obukhov length using Newton iteration 1064 1069 !-- First set arrays required for vectorization 1070 !$ACC PARALLEL LOOP & 1071 !$ACC PRESENT(surf) 1065 1072 DO m = 1, surf%ns 1066 1073 … … 1077 1084 IF ( surf%rib(m) < 0.0_wp ) surf%ol(m) = -0.01_wp 1078 1085 ENDIF 1086 ! 1087 !-- Initialize convergence flag 1088 convergence_reached(m) = .FALSE. 1079 1089 1080 1090 ENDDO … … 1082 1092 ! 1083 1093 !-- Iteration to find Obukhov length 1084 convergence_reached(:) = .FALSE.1085 1094 iter = 0 1086 1095 DO … … 1090 1099 !-- In case of divergence, use the value(s) of the previous time step 1091 1100 IF ( iter > 1000 ) THEN 1101 !$ACC PARALLEL LOOP & 1102 !$ACC PRESENT(surf) 1092 1103 DO m = 1, surf%ns 1093 IF ( .NOT. convergence_reached(m) ) surf%ol( 1:surf%ns) = ol_old1104 IF ( .NOT. convergence_reached(m) ) surf%ol(m) = ol_old_vec(m) 1094 1105 ENDDO 1095 1106 EXIT 1096 1107 ENDIF 1097 1108 1098 1109 !$ACC PARALLEL LOOP PRIVATE(ol_m, ol_l, ol_u, f, f_d_ol) & 1110 !$ACC PRESENT(surf) 1099 1111 DO m = 1, surf%ns 1100 1112 … … 1182 1194 ! 1183 1195 !-- Assure that Obukhov length does not become zero 1196 !$ACC PARALLEL LOOP & 1197 !$ACC PRESENT(surf) 1184 1198 DO m = 1, surf%ns 1185 1199 IF ( convergence_reached(m) ) CYCLE -
palm/trunk/SOURCE/temperton_fft_mod.f90
r4366 r4370 9 9 ! ----------------- 10 10 ! $Id$ 11 ! unused variables removed 12 ! 13 ! 4366 2020-01-09 08:12:43Z raasch 11 14 ! vectorized routines added 12 15 ! … … 2245 2248 INTEGER(iwp) :: j !< 2246 2249 INTEGER(iwp) :: jbase !< 2247 INTEGER(iwp) :: jj !<2248 2250 INTEGER(iwp) :: k !< 2249 2251 INTEGER(iwp) :: la !< 2250 INTEGER(iwp) :: nb !<2251 INTEGER(iwp) :: nblox !<2252 2252 INTEGER(iwp) :: nfax !< 2253 2253 INTEGER(iwp) :: nvex !< 2254 2254 INTEGER(iwp) :: nx !< 2255 INTEGER(iwp) :: mm !<2256 2255 2257 2256 … … 2264 2263 nx = n + 1 2265 2264 IF ( MOD(n,2) == 1 ) nx = n 2266 nblox = 12267 2265 nvex = 1 2268 2266 -
palm/trunk/SOURCE/transpose.f90
r4366 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! vector array renamed 28 ! 29 ! 4366 2020-01-09 08:12:43Z raasch 27 30 ! modifications for NEC vectorization 28 31 ! … … 270 273 271 274 USE fft_xy, & 272 ONLY: f_vec , temperton_fft_vec275 ONLY: f_vec_x, temperton_fft_vec 273 276 274 277 USE indices, & … … 307 310 ! 308 311 !-- Reorder input array for transposition. Data from the vectorized Temperton-fft is stored in 309 !-- different array format (f_vec ).312 !-- different array format (f_vec_x). 310 313 IF ( temperton_fft_vec ) THEN 311 314 … … 316 319 DO j = nys_x, nyn_x 317 320 mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1) 318 work(j,i-xs+1,k,l) = f_vec (mm,i)321 work(j,i-xs+1,k,l) = f_vec_x(mm,i) 319 322 ENDDO 320 323 ENDDO … … 862 865 863 866 USE fft_xy, & 864 ONLY: f_vec , temperton_fft_vec867 ONLY: f_vec_x, temperton_fft_vec 865 868 866 869 USE indices, & … … 944 947 ! 945 948 !-- Reorder transposed array. 946 !-- Data for the vectorized Temperton-fft is stored in different array format (f_vec ) which saves947 !-- additional data copy in fft_x.949 !-- Data for the vectorized Temperton-fft is stored in different array format (f_vec_x) which 950 !-- saves additional data copy in fft_x. 948 951 IF ( temperton_fft_vec ) THEN 949 952 … … 954 957 DO j = nys_x, nyn_x 955 958 mm = j-nys_x+1+(k-nzb_x)*(nyn_x-nys_x+1) 956 f_vec (mm,i) = work(j,i-xs+1,k,l)959 f_vec_x(mm,i) = work(j,i-xs+1,k,l) 957 960 ENDDO 958 961 ENDDO -
palm/trunk/SOURCE/turbulence_closure_mod.f90
r4346 r4370 25 25 ! ----------------- 26 26 ! $Id$ 27 ! vector directives added to force vectorization on Intel19 compiler 28 ! 29 ! 4346 2019-12-18 11:55:56Z motisi 27 30 ! Introduction of wall_flags_total_0, which currently sets bits based on static 28 31 ! topography information used in wall_flags_static_0 … … 2272 2275 DO i = nxl, nxr 2273 2276 DO j = nys, nyn 2277 !following directive is required to vectorize on Intel19 2278 !DIR$ IVDEP 2274 2279 DO k = nzb+1, nzt 2275 2280 e_p(k,j,i) = e(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & -
palm/trunk/TUTORIALS/cases/dispersion_eulerian_and_lpm_extended/USER_CODE/user_module.f90
r4002 r4370 15 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 ! 17 ! Copyright 1997-20 19Leibniz Universitaet Hannover17 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 18 !------------------------------------------------------------------------------! 19 19 ! -
palm/trunk/TUTORIALS/cases/lsm_short/USER_CODE/user_module.f90
r4222 r4370 15 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 ! 17 ! Copyright 1997-20 19Leibniz Universitaet Hannover17 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 18 !------------------------------------------------------------------------------! 19 19 ! -
palm/trunk/UTIL/agent_preprocessing/agent_preprocessing.f90
r3665 r4370 15 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 16 16 ! 17 ! Copyright 1997-20 19Leibniz Universitaet Hannover17 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 18 !------------------------------------------------------------------------------! 19 19 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/kpp4palm/templates/module_header
r3833 r4370 37 37 ! PALM. If not, see <http://www.gnu.org/licenses/>. 38 38 ! 39 ! Copyright 1997-20 19Leibniz Universitaet Hannover39 ! Copyright 1997-2020 Leibniz Universitaet Hannover 40 40 !--------------------------------------------------------------------------------! 41 41 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_cbm4/chem_gasphase_mod.f90
r3944 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive/chem_gasphase_mod.f90
r3833 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_passive1/chem_gasphase_mod.f90
r3944 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstat/chem_gasphase_mod.f90
r3944 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_phstatp/chem_gasphase_mod.f90
r3944 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_salsa+phstat/chem_gasphase_mod.f90
r3949 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_salsa+simple/chem_gasphase_mod.f90
r4016 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_salsagas/chem_gasphase_mod.f90
r3944 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simple/chem_gasphase_mod.f90
r4016 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_simplep/chem_gasphase_mod.f90
r4016 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 ! -
palm/trunk/UTIL/chemistry/gasphase_preproc/mechanisms/def_smog/chem_gasphase_mod.f90
r3833 r4370 41 41 ! PALM. If not,see <http://www.gnu.org/licenses/>. 42 42 ! 43 ! Copyright 1997-20 19Leibniz Universitaet Hannover43 ! Copyright 1997-2020 Leibniz Universitaet Hannover 44 44 !--------------------------------------------------------------------------------! 45 45 !
Note: See TracChangeset
for help on using the changeset viewer.