Ignore:
Timestamp:
May 15, 2008 8:46:15 AM (13 years ago)
Author:
raasch
Message:

optimization of transpositions for 2D decompositions, workaround for using -env option with mpiexec, adjustments for lcxt4

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/transpose.f90

    r4 r164  
    1  SUBROUTINE transpose_xy( f_in, work1, f_inv, work2, f_out )
     1 SUBROUTINE transpose_xy( f_in, work, f_out )
    22
    33!------------------------------------------------------------------------------!
    44! Actual revisions:
    55! -----------------
    6 !
     6! f_inv changed from subroutine argument to automatic array in order to do
     7! re-ordering from f_in to f_inv in one step, one array work is needed instead
     8! of work1 and work2
    79!
    810! Former revisions:
     
    4446             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
    4547             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
    46              work1(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa), work2(nnx*nny*nnz)
     48             work(nnx*nny*nnz)
    4749
    4850#if defined( __parallel )
     
    5153!-- Rearrange indices of input array in order to make data to be send
    5254!-- by MPI contiguous
    53     DO  k = nzb_x, nzt_xa
    54        DO  j = nys_x, nyn_xa
    55           DO  i = 0, nxa
    56              work1(j,k,i) = f_in(i,j,k)
    57           ENDDO
    58        ENDDO
    59     ENDDO
    60 
    61 !
    62 !-- Move data to different array, because memory location of work1 is
    63 !-- needed further below (work1 = work2)
    6455    DO  i = 0, nxa
    6556       DO  k = nzb_x, nzt_xa
    6657          DO  j = nys_x, nyn_xa
    67              f_inv(j,k,i) = work1(j,k,i)
     58             f_inv(j,k,i) = f_in(i,j,k)
    6859          ENDDO
    6960       ENDDO
     
    7465    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    7566    CALL MPI_ALLTOALL( f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
    76                        work2(1),             sendrecvcount_xy, MPI_REAL, &
     67                       work(1),              sendrecvcount_xy, MPI_REAL, &
    7768                       comm1dy, ierr )
    7869    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    8778             DO  j = ys, ys + nyn_xa - nys_x
    8879                m = m + 1
    89                 f_out(j,i,k) = work2(m)
     80                f_out(j,i,k) = work(m)
    9081             ENDDO
    9182          ENDDO
     
    9889
    9990
    100  SUBROUTINE transpose_xz( f_in, work1, f_inv, work2, f_out )
     91 SUBROUTINE transpose_xz( f_in, work, f_out )
    10192
    10293!------------------------------------------------------------------------------!
     
    119110   
    120111    REAL ::  f_in(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),             &
    121              f_inv(nxl:nxra,nys:nyna,1:nza),                    &
     112             f_inv(nys:nyna,nxl:nxra,1:nza),                    &
    122113             f_out(1:nza,nys:nyna,nxl:nxra),                    &
    123              work1(1:nza,nys:nyna,nxl:nxra), work2(nnx*nny*nnz)
     114             work(nnx*nny*nnz)
    124115
    125116#if defined( __parallel )
     
    135126          xs = 0 + l * nnx
    136127          DO  k = nzb_x, nzt_xa
    137              DO  j = nys_x, nyn_xa
    138                 DO  i = xs, xs + nnx - 1
     128             DO  i = xs, xs + nnx - 1
     129                DO  j = nys_x, nyn_xa
    139130                   m = m + 1
    140                    work2(m) = f_in(i,j,k)
     131                   work(m) = f_in(i,j,k)
    141132                ENDDO
    142133             ENDDO
     
    147138!--    Transpose array
    148139       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    149        CALL MPI_ALLTOALL( work2(1),         sendrecvcount_zx, MPI_REAL, &
    150                           f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
     140       CALL MPI_ALLTOALL( work(1),          sendrecvcount_zx, MPI_REAL, &
     141                          f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
    151142                          comm1dx, ierr )
    152143       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    154145!
    155146!--    Reorder transposed array in a way that the z index is in first position
    156        DO  i = nxl, nxra
    157           DO  j = nys, nyna
    158              DO  k = 1, nza
    159                 work1(k,j,i) = f_inv(i,j,k)
     147       DO  k = 1, nza
     148          DO  i = nxl, nxra
     149             DO  j = nys, nyna
     150                f_out(k,j,i) = f_inv(j,i,k)
    160151             ENDDO
    161152          ENDDO
     
    167158          DO  j = nys, nyna
    168159             DO  k = 1, nza
    169                 work1(k,j,i) = f_in(i,j,k)
    170              ENDDO
    171           ENDDO
    172        ENDDO
     160                f_inv(j,i,k) = f_in(i,j,k)
     161             ENDDO
     162          ENDDO
     163       ENDDO
     164
     165       DO  k = 1, nza
     166          DO  i = nxl, nxra
     167             DO  j = nys, nyna
     168                f_out(k,j,i) = f_inv(j,i,k)
     169             ENDDO
     170          ENDDO
     171       ENDDO
     172
    173173    ENDIF
    174174
    175 !
    176 !-- Move data to output array
    177     DO  i = nxl, nxra
    178        DO  j = nys, nyna
    179           DO  k = 1, nza
    180              f_out(k,j,i) = work1(k,j,i)
    181           ENDDO
    182        ENDDO
    183     ENDDO
    184175
    185176#endif
     
    188179
    189180
    190  SUBROUTINE transpose_yx( f_in, work1, f_inv, work2, f_out )
     181 SUBROUTINE transpose_yx( f_in, work, f_out )
    191182
    192183!------------------------------------------------------------------------------!
     
    211202             f_inv(nys_x:nyn_xa,nzb_x:nzt_xa,0:nxa),                    &
    212203             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                    &
    213              work1(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa), work2(nnx*nny*nnz)
     204             work(nnx*nny*nnz)
    214205
    215206#if defined( __parallel )
     
    224215             DO  j = ys, ys + nyn_xa - nys_x
    225216                m = m + 1
    226                 work2(m) = f_in(j,i,k)
     217                work(m) = f_in(j,i,k)
    227218             ENDDO
    228219          ENDDO
     
    233224!-- Transpose array
    234225    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    235     CALL MPI_ALLTOALL( work2(1),             sendrecvcount_xy, MPI_REAL, &
     226    CALL MPI_ALLTOALL( work(1),              sendrecvcount_xy, MPI_REAL, &
    236227                       f_inv(nys_x,nzb_x,0), sendrecvcount_xy, MPI_REAL, &
    237228                       comm1dy, ierr )
     
    243234       DO  k = nzb_x, nzt_xa
    244235          DO  j = nys_x, nyn_xa
    245              work1(i,j,k) = f_inv(j,k,i)
    246           ENDDO
    247        ENDDO
    248     ENDDO
    249 
    250 !
    251 !-- Move data to output array
    252     DO  k = nzb_x, nzt_xa
    253        DO  j = nys_x, nyn_xa
    254           DO  i = 0, nxa
    255              f_out(i,j,k) = work1(i,j,k)
     236             f_out(i,j,k) = f_inv(j,k,i)
    256237          ENDDO
    257238       ENDDO
     
    263244
    264245
    265  SUBROUTINE transpose_yxd( f_in, work1, f_inv, work2, f_out )
     246 SUBROUTINE transpose_yxd( f_in, work, f_out )
    266247
    267248!------------------------------------------------------------------------------!
     
    287268    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,1:nza,nys:nyna), &
    288269             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
    289              work1(nxl:nxra,1:nza,nys:nyna), work2(nnx*nny*nnz)
     270             work(nnx*nny*nnz)
    290271
    291272#if defined( __parallel )
     
    297278       DO  j = nys, nyna
    298279          DO  i = nxl, nxra
    299              work1(i,k,j) = f_in(k,j,i)
    300           ENDDO
    301        ENDDO
    302     ENDDO
    303 
    304 !
    305 !-- Move data to different array, because memory location of work1 is
    306 !-- needed further below (work1 = work2)
    307     DO  j = nys, nyna
    308        DO  k = 1, nza
    309           DO  i = nxl, nxra
    310              f_inv(i,k,j) = work1(i,k,j)
     280             f_inv(i,k,j) = f_in(k,j,i)
    311281          ENDDO
    312282       ENDDO
     
    317287    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    318288    CALL MPI_ALLTOALL( f_inv(nxl,1,nys), sendrecvcount_xy, MPI_REAL, &
    319                        work2(1),         sendrecvcount_xy, MPI_REAL, &
     289                       work(1),          sendrecvcount_xy, MPI_REAL, &
    320290                       comm1dx, ierr )
    321291    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    330300             DO  i = xs, xs + nnx - 1
    331301                m = m + 1
    332                 f_out(i,j,k) = work2(m)
     302                f_out(i,j,k) = work(m)
    333303             ENDDO
    334304          ENDDO
     
    341311
    342312
    343  SUBROUTINE transpose_yz( f_in, work1, f_inv, work2, f_out )
     313 SUBROUTINE transpose_yz( f_in, work, f_out )
    344314
    345315!------------------------------------------------------------------------------!
     
    364334             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
    365335             f_out(nxl_z:nxr_za,nys_z:nyn_za,1:nza),                    &
    366              work1(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya), work2(nnx*nny*nnz)
     336             work(nnx*nny*nnz)
    367337
    368338#if defined( __parallel )
     
    371341!-- Rearrange indices of input array in order to make data to be send
    372342!-- by MPI contiguous
    373     DO  k = nzb_y, nzt_ya
    374        DO  i = nxl_y, nxr_ya
    375           DO  j = 0, nya
    376              work1(i,k,j) = f_in(j,i,k)
     343    DO  j = 0, nya
     344       DO  k = nzb_y, nzt_ya
     345          DO  i = nxl_y, nxr_ya
     346             f_inv(i,k,j) = f_in(j,i,k)
    377347          ENDDO
    378348       ENDDO
     
    388358          DO  k = nzb_y, nzt_ya
    389359             DO  i = nxl_y, nxr_ya
    390                 f_out(i,j,k) = work1(i,k,j)
     360                f_out(i,j,k) = f_inv(i,k,j)
    391361             ENDDO
    392362          ENDDO
    393363       ENDDO
    394364       RETURN
    395     ELSE
    396        DO  j = 0, nya
    397           DO  k = nzb_y, nzt_ya
    398              DO  i = nxl_y, nxr_ya
    399                 f_inv(i,k,j) = work1(i,k,j)
    400              ENDDO
    401           ENDDO
    402        ENDDO
    403365    ENDIF
    404366
     
    407369    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    408370    CALL MPI_ALLTOALL( f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
    409                        work2(1),             sendrecvcount_yz, MPI_REAL, &
     371                       work(1),              sendrecvcount_yz, MPI_REAL, &
    410372                       comm1dx, ierr )
    411373    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    420382             DO  i = nxl_z, nxr_za
    421383                m = m + 1
    422                 f_out(i,j,k) = work2(m)
     384                f_out(i,j,k) = work(m)
    423385             ENDDO
    424386          ENDDO
     
    431393
    432394
    433  SUBROUTINE transpose_zx( f_in, work1, f_inv, work2, f_out )
     395 SUBROUTINE transpose_zx( f_in, work, f_out )
    434396
    435397!------------------------------------------------------------------------------!
     
    451413    INTEGER ::  i, j, k, l, m, xs
    452414   
    453     REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nxl:nxra,nys:nyna,1:nza), &
     415    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
    454416             f_out(0:nxa,nys_x:nyn_xa,nzb_x:nzt_xa),                        &
    455              work1(nxl:nxra,nys:nyna,1:nza), work2(nnx*nny*nnz)
     417             work(nnx*nny*nnz)
    456418
    457419#if defined( __parallel )
     
    460422!-- Rearrange indices of input array in order to make data to be send
    461423!-- by MPI contiguous
    462     DO  i = nxl, nxra
    463        DO  j = nys, nyna
    464           DO  k = 1,nza
    465              work1(i,j,k) = f_in(k,j,i)
     424    DO  k = 1,nza
     425       DO  i = nxl, nxra
     426          DO  j = nys, nyna
     427             f_inv(j,i,k) = f_in(k,j,i)
    466428          ENDDO
    467429       ENDDO
     
    475437    IF ( pdims(1) == 1 )  THEN
    476438       DO  k = 1, nza
    477           DO  j = nys, nyna
    478              DO  i = nxl, nxra
    479                 f_out(i,j,k) = work1(i,j,k)
     439          DO  i = nxl, nxra
     440             DO  j = nys, nyna
     441                f_out(i,j,k) = f_inv(j,i,k)
    480442             ENDDO
    481443          ENDDO
    482444       ENDDO
    483445       RETURN
    484     ELSE
    485        DO  k = 1, nza
    486           DO  j = nys, nyna
    487              DO  i = nxl, nxra
    488                 f_inv(i,j,k) = work1(i,j,k)
    489              ENDDO
    490           ENDDO
    491        ENDDO
    492446    ENDIF
    493447
     
    495449!-- Transpose array
    496450    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    497     CALL MPI_ALLTOALL( f_inv(nxl,nys,1), sendrecvcount_zx, MPI_REAL, &
    498                        work2(1),         sendrecvcount_zx, MPI_REAL, &
     451    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zx, MPI_REAL, &
     452                       work(1),          sendrecvcount_zx, MPI_REAL, &
    499453                       comm1dx, ierr )
    500454    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    506460       xs = 0 + l * nnx
    507461       DO  k = nzb_x, nzt_xa
    508           DO  j = nys_x, nyn_xa
    509              DO  i = xs, xs + nnx - 1
     462          DO  i = xs, xs + nnx - 1
     463             DO  j = nys_x, nyn_xa
    510464                m = m + 1
    511                 f_out(i,j,k) = work2(m)
     465                f_out(i,j,k) = work(m)
    512466             ENDDO
    513467          ENDDO
     
    520474
    521475
    522  SUBROUTINE transpose_zy( f_in, work1, f_inv, work2, f_out )
     476 SUBROUTINE transpose_zy( f_in, work, f_out )
    523477
    524478!------------------------------------------------------------------------------!
     
    543497             f_inv(nxl_y:nxr_ya,nzb_y:nzt_ya,0:nya),                    &
    544498             f_out(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya),                    &
    545              work1(0:nya,nxl_y:nxr_ya,nzb_y:nzt_ya), work2(nnx*nny*nnz)
     499             work(nnx*nny*nnz)
    546500
    547501#if defined( __parallel )
     
    560514                DO  i = nxl_z, nxr_za
    561515                   m = m + 1
    562                    work2(m) = f_in(i,j,k)
     516                   work(m) = f_in(i,j,k)
    563517                ENDDO
    564518             ENDDO
     
    569523!--    Transpose array
    570524       CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    571        CALL MPI_ALLTOALL( work2(1),             sendrecvcount_yz, MPI_REAL, &
     525       CALL MPI_ALLTOALL( work(1),              sendrecvcount_yz, MPI_REAL, &
    572526                          f_inv(nxl_y,nzb_y,0), sendrecvcount_yz, MPI_REAL, &
    573527                          comm1dx, ierr )
     
    576530!
    577531!--    Reorder transposed array in a way that the y index is in first position
     532       DO  j = 0, nya
     533          DO  k = nzb_y, nzt_ya
     534             DO  i = nxl_y, nxr_ya
     535                f_out(j,i,k) = f_inv(i,k,j)
     536             ENDDO
     537          ENDDO
     538       ENDDO
     539    ELSE
     540!
     541!--    Reorder the array in a way that the y index is in first position
     542       DO  k = nzb_y, nzt_ya
     543          DO  j = 0, nya
     544             DO  i = nxl_y, nxr_ya
     545                f_inv(i,k,j) = f_in(i,j,k)
     546             ENDDO
     547          ENDDO
     548       ENDDO
     549!
     550!--    Move data to output array
    578551       DO  k = nzb_y, nzt_ya
    579552          DO  i = nxl_y, nxr_ya
    580553             DO  j = 0, nya
    581                 work1(j,i,k) = f_inv(i,k,j)
    582              ENDDO
    583           ENDDO
    584        ENDDO
    585     ELSE
    586 !
    587 !--    Reorder the array in a way that the y index is in first position
    588        DO  k = nzb_y, nzt_ya
    589           DO  i = nxl_y, nxr_ya
    590              DO  j = 0, nya
    591                 work1(j,i,k) = f_in(i,j,k)
    592              ENDDO
    593           ENDDO
    594        ENDDO
     554                f_out(j,i,k) = f_inv(i,k,j)
     555             ENDDO
     556          ENDDO
     557       ENDDO
     558
    595559    ENDIF
    596560
    597 !
    598 !-- Move data to output array
    599     DO  k = nzb_y, nzt_ya
    600        DO  i = nxl_y, nxr_ya
    601           DO  j = 0, nya
    602              f_out(j,i,k) = work1(j,i,k)
    603           ENDDO
    604        ENDDO
    605     ENDDO
    606 
    607561#endif
    608562
     
    610564
    611565
    612  SUBROUTINE transpose_zyd( f_in, work1, f_inv, work2, f_out )
     566 SUBROUTINE transpose_zyd( f_in, work, f_out )
    613567
    614568!------------------------------------------------------------------------------!
     
    634588    REAL ::  f_in(1:nza,nys:nyna,nxl:nxra), f_inv(nys:nyna,nxl:nxra,1:nza), &
    635589             f_out(0:nya,nxl_yd:nxr_yda,nzb_yd:nzt_yda),                    &
    636              work1(nys:nyna,nxl:nxra,1:nza), work2(nnx*nny*nnz)
     590             work(nnx*nny*nnz)
    637591
    638592#if defined( __parallel )
     
    644598       DO  j = nys, nyna
    645599          DO  k = 1, nza
    646              work1(j,i,k) = f_in(k,j,i)
     600             f_inv(j,i,k) = f_in(k,j,i)
    647601          ENDDO
    648602       ENDDO
     
    658612          DO  i = nxl, nxra
    659613             DO  j = nys, nyna
    660                 f_out(j,i,k) = work1(j,i,k)
     614                f_out(j,i,k) = f_inv(j,i,k)
    661615             ENDDO
    662616          ENDDO
    663617       ENDDO
    664618       RETURN
    665     ELSE
    666        DO  k = 1, nza
    667           DO  i = nxl, nxra
    668              DO  j = nys, nyna
    669                 f_inv(j,i,k) = work1(j,i,k)
    670              ENDDO
    671           ENDDO
    672        ENDDO
    673619    ENDIF
    674620
     
    677623    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'start' )
    678624    CALL MPI_ALLTOALL( f_inv(nys,nxl,1), sendrecvcount_zyd, MPI_REAL, &
    679                        work2(1),         sendrecvcount_zyd, MPI_REAL, &
     625                       work(1),          sendrecvcount_zyd, MPI_REAL, &
    680626                       comm1dy, ierr )
    681627    CALL cpu_log( log_point_s(32), 'mpi_alltoall', 'stop' )
     
    690636             DO  j = ys, ys + nny - 1
    691637                m = m + 1
    692                 f_out(j,i,k) = work2(m)
     638                f_out(j,i,k) = work(m)
    693639             ENDDO
    694640          ENDDO
Note: See TracChangeset for help on using the changeset viewer.