Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 1392


Ignore:
Timestamp:
May 6, 2014 9:10:05 AM (11 years ago)
Author:
raasch
Message:

bugfix: KIND attribute added to CMPLX functions

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/fft_xy.f90

    r1375 r1392  
    2020! Current revisions:
    2121! -----------------
    22 !
     22! bugfix: KIND attribute added to CMPLX functions
    2323!
    2424! Former revisions:
    … …  
    424424
    425425                   DO  i = 0, nx
    426                       cwork(i) = CMPLX( ar(i,j,k) )
     426                      cwork(i) = CMPLX( ar(i,j,k), KIND=wp )
    427427                   ENDDO
    428428
    … …  
    448448                DO  j = nys_x, nyn_x
    449449
    450                    cwork(0) = CMPLX( ar(0,j,k), 0.0_wp )
     450                   cwork(0) = CMPLX( ar(0,j,k), 0.0_wp, KIND=wp )
    451451                   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 )
    456458
    457459                   ishape = SHAPE( cwork )
    … …  
    566568                   IF ( PRESENT( ar_2d ) )  THEN
    567569
    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 )
    569571                      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 )
    571574                      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 )
    573577
    574578                   ELSE
    575579
    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 )
    577581                      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 )
    579583                      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 )
    581586
    582587                   ENDIF
    … …  
    726731                DO  j = nys_x, nyn_x
    727732
    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 )
    729734
    730735                   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 )
    734741
    735742                ENDDO
    … …  
    807814
    808815             DO  i = 0, nx
    809                 cwork(i) = CMPLX( ar(i) )
     816                cwork(i) = CMPLX( ar(i), KIND=wp )
    810817             ENDDO
    811818             ishape = SHAPE( cwork )
    … …  
    820827          ELSE
    821828
    822              cwork(0) = CMPLX( ar(0), 0.0_wp )
     829             cwork(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
    823830             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 )
    828835
    829836             ishape = SHAPE( cwork )
    … …  
    888895         ELSE
    889896
    890              x_out(0) = CMPLX( ar(0), 0.0_wp )
     897             x_out(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
    891898             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 )
    895902
    896903             CALL FFTW_EXECUTE_DFT_C2R( plan_xi, x_out, x_in)
    … …  
    10671074
    10681075                   DO  j = 0, ny
    1069                       cwork(j) = CMPLX( ar(j,i,k) )
     1076                      cwork(j) = CMPLX( ar(j,i,k), KIND=wp )
    10701077                   ENDDO
    10711078
    … …  
    10911098                DO  i = nxl_y_l, nxr_y_l
    10921099
    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 )
    10941101                   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 )
    10991109
    11001110                   jshape = SHAPE( cwork )
    … …  
    11951205                DO  i = nxl_y_l, nxr_y_l
    11961206
    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 )
    11981208                   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 )
    12021214
    12031215                   CALL FFTW_EXECUTE_DFT_C2R( plan_yi, y_out, y_in )
    … …  
    13421354                DO  i = nxl_y, nxr_y
    13431355
    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 )
    13451357
    13461358                   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 )
    13501364
    13511365                ENDDO
    … …  
    14231437
    14241438             DO  j = 0, ny
    1425                 cwork(j) = CMPLX( ar(j) )
     1439                cwork(j) = CMPLX( ar(j), KIND=wp )
    14261440             ENDDO
    14271441
    … …  
    14381452          ELSE
    14391453
    1440              cwork(0) = CMPLX( ar(0), 0.0_wp )
     1454             cwork(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
    14411455             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 )
    14461460
    14471461             jshape = SHAPE( cwork )
    … …  
    15061520          ELSE
    15071521
    1508              y_out(0) = CMPLX( ar(0), 0.0_wp )
     1522             y_out(0) = CMPLX( ar(0), 0.0_wp, KIND=wp )
    15091523             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 )
    15131527
    15141528             CALL FFTW_EXECUTE_DFT_C2R( plan_yi, y_out, y_in )
    … …  
    17111725             ENDIF
    17121726             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 )
    17141728                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 )
    17181732             ENDDO
    17191733
    … …  
    18541868             ENDIF
    18551869             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 )
    18571871                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 )
    18611875             ENDDO
    18621876
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |