Changeset 1392 for palm/trunk/SOURCE
- Timestamp:
- May 6, 2014 9:10:05 AM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/fft_xy.f90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/fft_xy.f90
r1375 r1392 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! bugfix: KIND attribute added to CMPLX functions 23 23 ! 24 24 ! Former revisions: … … 424 424 425 425 DO i = 0, nx 426 cwork(i) = CMPLX( ar(i,j,k) )426 cwork(i) = CMPLX( ar(i,j,k), KIND=wp ) 427 427 ENDDO 428 428 … … 448 448 DO j = nys_x, nyn_x 449 449 450 cwork(0) = CMPLX( ar(0,j,k), 0.0_wp )450 cwork(0) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp ) 451 451 DO i = 1, (nx+1)/2 - 1 452 cwork(i) = CMPLX( ar(i,j,k), -ar(nx+1-i,j,k) ) 453 cwork(nx+1-i) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k) ) 454 ENDDO 455 cwork((nx+1)/2) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp ) 452 cwork(i) = CMPLX( ar(i,j,k), -ar(nx+1-i,j,k), & 453 KIND=wp ) 454 cwork(nx+1-i) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k), & 455 KIND=wp ) 456 ENDDO 457 cwork((nx+1)/2) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, KIND=wp ) 456 458 457 459 ishape = SHAPE( cwork ) … … 566 568 IF ( PRESENT( ar_2d ) ) THEN 567 569 568 x_out(0) = CMPLX( ar_2d(0,j), 0.0_wp )570 x_out(0) = CMPLX( ar_2d(0,j), 0.0_wp, KIND=wp ) 569 571 DO i = 1, (nx+1)/2 - 1 570 x_out(i) = CMPLX( ar_2d(i,j), ar_2d(nx+1-i,j) ) 572 x_out(i) = CMPLX( ar_2d(i,j), ar_2d(nx+1-i,j), & 573 KIND=wp ) 571 574 ENDDO 572 x_out((nx+1)/2) = CMPLX( ar_2d((nx+1)/2,j), 0.0_wp ) 575 x_out((nx+1)/2) = CMPLX( ar_2d((nx+1)/2,j), 0.0_wp, & 576 KIND=wp ) 573 577 574 578 ELSE 575 579 576 x_out(0) = CMPLX( ar(0,j,k), 0.0_wp )580 x_out(0) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp ) 577 581 DO i = 1, (nx+1)/2 - 1 578 x_out(i) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k) )582 x_out(i) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k), KIND=wp ) 579 583 ENDDO 580 x_out((nx+1)/2) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp ) 584 x_out((nx+1)/2) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, & 585 KIND=wp ) 581 586 582 587 ENDIF … … 726 731 DO j = nys_x, nyn_x 727 732 728 ar_tmp(0,j,k) = CMPLX( ar(0,j,k), 0.0_wp )733 ar_tmp(0,j,k) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp ) 729 734 730 735 DO i = 1, (nx+1)/2 - 1 731 ar_tmp(i,j,k) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k) ) 732 ENDDO 733 ar_tmp((nx+1)/2,j,k) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp ) 736 ar_tmp(i,j,k) = CMPLX( ar(i,j,k), ar(nx+1-i,j,k), & 737 KIND=wp ) 738 ENDDO 739 ar_tmp((nx+1)/2,j,k) = CMPLX( ar((nx+1)/2,j,k), 0.0_wp, & 740 KIND=wp ) 734 741 735 742 ENDDO … … 807 814 808 815 DO i = 0, nx 809 cwork(i) = CMPLX( ar(i) )816 cwork(i) = CMPLX( ar(i), KIND=wp ) 810 817 ENDDO 811 818 ishape = SHAPE( cwork ) … … 820 827 ELSE 821 828 822 cwork(0) = CMPLX( ar(0), 0.0_wp )829 cwork(0) = CMPLX( ar(0), 0.0_wp, KIND=wp ) 823 830 DO i = 1, (nx+1)/2 - 1 824 cwork(i) = CMPLX( ar(i), -ar(nx+1-i) )825 cwork(nx+1-i) = CMPLX( ar(i), ar(nx+1-i) )826 ENDDO 827 cwork((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0_wp )831 cwork(i) = CMPLX( ar(i), -ar(nx+1-i), KIND=wp ) 832 cwork(nx+1-i) = CMPLX( ar(i), ar(nx+1-i), KIND=wp ) 833 ENDDO 834 cwork((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0_wp, KIND=wp ) 828 835 829 836 ishape = SHAPE( cwork ) … … 888 895 ELSE 889 896 890 x_out(0) = CMPLX( ar(0), 0.0_wp )897 x_out(0) = CMPLX( ar(0), 0.0_wp, KIND=wp ) 891 898 DO i = 1, (nx+1)/2 - 1 892 x_out(i) = CMPLX( ar(i), ar(nx+1-i) )893 ENDDO 894 x_out((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0_wp )899 x_out(i) = CMPLX( ar(i), ar(nx+1-i), KIND=wp ) 900 ENDDO 901 x_out((nx+1)/2) = CMPLX( ar((nx+1)/2), 0.0_wp, KIND=wp ) 895 902 896 903 CALL FFTW_EXECUTE_DFT_C2R( plan_xi, x_out, x_in) … … 1067 1074 1068 1075 DO j = 0, ny 1069 cwork(j) = CMPLX( ar(j,i,k) )1076 cwork(j) = CMPLX( ar(j,i,k), KIND=wp ) 1070 1077 ENDDO 1071 1078 … … 1091 1098 DO i = nxl_y_l, nxr_y_l 1092 1099 1093 cwork(0) = CMPLX( ar_tr(0,i,k), 0.0_wp )1100 cwork(0) = CMPLX( ar_tr(0,i,k), 0.0_wp, KIND=wp ) 1094 1101 DO j = 1, (ny+1)/2 - 1 1095 cwork(j) = CMPLX( ar_tr(j,i,k), -ar_tr(ny+1-j,i,k) ) 1096 cwork(ny+1-j) = CMPLX( ar_tr(j,i,k), ar_tr(ny+1-j,i,k) ) 1097 ENDDO 1098 cwork((ny+1)/2) = CMPLX( ar_tr((ny+1)/2,i,k), 0.0_wp ) 1102 cwork(j) = CMPLX( ar_tr(j,i,k), -ar_tr(ny+1-j,i,k), & 1103 KIND=wp ) 1104 cwork(ny+1-j) = CMPLX( ar_tr(j,i,k), ar_tr(ny+1-j,i,k), & 1105 KIND=wp ) 1106 ENDDO 1107 cwork((ny+1)/2) = CMPLX( ar_tr((ny+1)/2,i,k), 0.0_wp, & 1108 KIND=wp ) 1099 1109 1100 1110 jshape = SHAPE( cwork ) … … 1195 1205 DO i = nxl_y_l, nxr_y_l 1196 1206 1197 y_out(0) = CMPLX( ar_tr(0,i,k), 0.0_wp )1207 y_out(0) = CMPLX( ar_tr(0,i,k), 0.0_wp, KIND=wp ) 1198 1208 DO j = 1, (ny+1)/2 - 1 1199 y_out(j) = CMPLX( ar_tr(j,i,k), ar_tr(ny+1-j,i,k) ) 1200 ENDDO 1201 y_out((ny+1)/2) = CMPLX( ar_tr((ny+1)/2,i,k), 0.0_wp ) 1209 y_out(j) = CMPLX( ar_tr(j,i,k), ar_tr(ny+1-j,i,k, & 1210 KIND=wp) ) 1211 ENDDO 1212 y_out((ny+1)/2) = CMPLX( ar_tr((ny+1)/2,i,k), 0.0_wp, & 1213 KIND=wp ) 1202 1214 1203 1215 CALL FFTW_EXECUTE_DFT_C2R( plan_yi, y_out, y_in ) … … 1342 1354 DO i = nxl_y, nxr_y 1343 1355 1344 ar_tmp(0,i,k) = CMPLX( ar(0,i,k), 0.0_wp )1356 ar_tmp(0,i,k) = CMPLX( ar(0,i,k), 0.0_wp, KIND=wp ) 1345 1357 1346 1358 DO j = 1, (ny+1)/2 - 1 1347 ar_tmp(j,i,k) = CMPLX( ar(j,i,k), ar(ny+1-j,i,k) ) 1348 ENDDO 1349 ar_tmp((ny+1)/2,i,k) = CMPLX( ar((ny+1)/2,i,k), 0.0_wp ) 1359 ar_tmp(j,i,k) = CMPLX( ar(j,i,k), ar(ny+1-j,i,k), & 1360 KIND=wp ) 1361 ENDDO 1362 ar_tmp((ny+1)/2,i,k) = CMPLX( ar((ny+1)/2,i,k), 0.0_wp, & 1363 KIND=wp ) 1350 1364 1351 1365 ENDDO … … 1423 1437 1424 1438 DO j = 0, ny 1425 cwork(j) = CMPLX( ar(j) )1439 cwork(j) = CMPLX( ar(j), KIND=wp ) 1426 1440 ENDDO 1427 1441 … … 1438 1452 ELSE 1439 1453 1440 cwork(0) = CMPLX( ar(0), 0.0_wp )1454 cwork(0) = CMPLX( ar(0), 0.0_wp, KIND=wp ) 1441 1455 DO j = 1, (ny+1)/2 - 1 1442 cwork(j) = CMPLX( ar(j), -ar(ny+1-j) )1443 cwork(ny+1-j) = CMPLX( ar(j), ar(ny+1-j) )1444 ENDDO 1445 cwork((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0_wp )1456 cwork(j) = CMPLX( ar(j), -ar(ny+1-j), KIND=wp ) 1457 cwork(ny+1-j) = CMPLX( ar(j), ar(ny+1-j), KIND=wp ) 1458 ENDDO 1459 cwork((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0_wp, KIND=wp ) 1446 1460 1447 1461 jshape = SHAPE( cwork ) … … 1506 1520 ELSE 1507 1521 1508 y_out(0) = CMPLX( ar(0), 0.0_wp )1522 y_out(0) = CMPLX( ar(0), 0.0_wp, KIND=wp ) 1509 1523 DO j = 1, (ny+1)/2 - 1 1510 y_out(j) = CMPLX( ar(j), ar(ny+1-j) )1511 ENDDO 1512 y_out((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0_wp )1524 y_out(j) = CMPLX( ar(j), ar(ny+1-j), KIND=wp ) 1525 ENDDO 1526 y_out((ny+1)/2) = CMPLX( ar((ny+1)/2), 0.0_wp, KIND=wp ) 1513 1527 1514 1528 CALL FFTW_EXECUTE_DFT_C2R( plan_yi, y_out, y_in ) … … 1711 1725 ENDIF 1712 1726 DO k = 1, nz 1713 work(1,k) = CMPLX( ar(0,k), 0.0_wp )1727 work(1,k) = CMPLX( ar(0,k), 0.0_wp, KIND=wp ) 1714 1728 DO i = 1, (nx+1)/2 - 1 1715 work(i+1,k) = CMPLX( ar(i,k), ar(nx+1-i,k) )1716 ENDDO 1717 work(((nx+1)/2)+1,k) = CMPLX( ar((nx+1)/2,k), 0.0_wp )1729 work(i+1,k) = CMPLX( ar(i,k), ar(nx+1-i,k), KIND=wp ) 1730 ENDDO 1731 work(((nx+1)/2)+1,k) = CMPLX( ar((nx+1)/2,k), 0.0_wp, KIND=wp ) 1718 1732 ENDDO 1719 1733 … … 1854 1868 ENDIF 1855 1869 DO k = 1, nz 1856 work(1,k) = CMPLX( ar(0,k), 0.0_wp )1870 work(1,k) = CMPLX( ar(0,k), 0.0_wp, KIND=wp ) 1857 1871 DO j = 1, (ny+1)/2 - 1 1858 work(j+1,k) = CMPLX( ar(j,k), ar(ny+1-j,k) )1859 ENDDO 1860 work(((ny+1)/2)+1,k) = CMPLX( ar((ny+1)/2,k), 0.0_wp )1872 work(j+1,k) = CMPLX( ar(j,k), ar(ny+1-j,k), KIND=wp ) 1873 ENDDO 1874 work(((ny+1)/2)+1,k) = CMPLX( ar((ny+1)/2,k), 0.0_wp, KIND=wp ) 1861 1875 ENDDO 1862 1876
Note: See TracChangeset
for help on using the changeset viewer.
