New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14379 for NEMO/branches/2021 – NEMO

Changeset 14379 for NEMO/branches/2021


Ignore:
Timestamp:
2021-02-03T09:11:51+01:00 (3 years ago)
Author:
smasson
Message:

dev_r14312_MPI_Interface: refactoring of lbc_lnk_pt2pt_generic, #2598

File:
1 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14312_MPI_Interface/src/OCE/LBC/lbc_lnk_pt2pt_generic.h90

    r14367 r14379  
    11   
     2#if ! defined BLOCK_ISEND && ! defined BLOCK_FILL 
    23   SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
    34      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    … …  
    172173      ! 
    173174      DO jn = 1, 2 
    174          IF( llsend(jn) ) THEN 
    175             ishti = ishtSi(jn) 
    176             ishtj = ishtSj(jn) 
    177             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    178                BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) 
    179                idxs = idxs + 1 
    180             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    181 #if ! defined key_mpi_off 
    182             IF( ln_timing ) CALL tic_tac(.TRUE.) 
    183             ! non-blocking send of the west/east side using local buffer 
    184             CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, nreq_p2p(jn), ierr ) 
    185             IF( ln_timing ) CALL tic_tac(.FALSE.) 
    186 #endif 
    187          ENDIF 
     175#define BLOCK_ISEND 
     176#  include "lbc_lnk_pt2pt_generic.h90"          
     177#undef BLOCK_ISEND 
    188178      END DO 
    189179      ! 
    … …  
    193183      ! 
    194184      DO jn = 1, 2 
    195          ishti = ishtRi(jn) 
    196          ishtj = ishtRj(jn) 
    197          SELECT CASE ( ifill(jn) ) 
    198          CASE ( jpfillnothing )               ! no filling  
    199          CASE ( jpfillmpi   )                 ! fill with data received by MPI 
    200 #if ! defined key_mpi_off 
    201             IF( ln_timing ) CALL tic_tac(.TRUE.) 
    202             !                                 ! blocking receive of the west/east halo in local temporary arrays 
    203             CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 
    204             IF( ln_timing ) CALL tic_tac(.FALSE.) 
    205 #endif 
    206             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    207                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr) 
    208                idxr = idxr + 1 
    209             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    210          CASE ( jpfillperio )                 ! use periodicity 
    211             ishti2 = ishtPi(jn) 
    212             ishtj2 = ishtPj(jn) 
    213             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    214                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    215             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    216          CASE ( jpfillcopy  )                 ! filling with inner domain values 
    217             ishti2 = ishtSi(jn) 
    218             ishtj2 = ishtSj(jn) 
    219             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    220                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    221             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    222          CASE ( jpfillcst   )                 ! filling with constant value 
    223             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    224                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
    225             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    226          END SELECT 
     185#define BLOCK_FILL 
     186#  include "lbc_lnk_pt2pt_generic.h90"          
     187#undef BLOCK_FILL 
     188      END DO 
     189      ! 
     190      ! ------------------------------------------------- ! 
     191      !     5. Do north and south MPI_Isend if needed     ! 
     192      ! ------------------------------------------------- ! 
     193      ! 
     194      DO jn = 3, 4 
     195#define BLOCK_ISEND 
     196#  include "lbc_lnk_pt2pt_generic.h90"          
     197#undef BLOCK_ISEND 
    227198      END DO 
    228199      ! 
    229200      ! ------------------------------- ! 
    230       !     5. north fold treatment     ! 
     201      !     6. north fold treatment     ! 
    231202      ! ------------------------------- ! 
    232203      ! 
    233       ! do it before south directions so concerned processes can do it without waiting for the comm with the sourthern neighbor 
     204      ! Must be done after receiving data from East/West neighbourgs (as it is coded in mpp_nfd, to be changed one day...) 
     205      ! Do it after MPI_iSend to south/north neighbourgs so they won't wait (too much) to receive their data 
     206      ! Do if before MPI_Recv from south/north neighbourgs so we have more time to receive data 
    234207      ! 
    235208      IF( ll_IdoNFold ) THEN 
    … …  
    239212      ENDIF 
    240213      ! 
    241       ! ------------------------------------------------- ! 
    242       !     6. Do north and south MPI_Isend if needed     ! 
    243       ! ------------------------------------------------- ! 
    244       ! 
    245       DO jn = 3, 4 
    246          IF( llsend(jn) ) THEN 
    247             ishti = ishtSi(jn) 
    248             ishtj = ishtSj(jn) 
    249             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    250                BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) 
    251                idxs = idxs + 1 
    252             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    253 #if ! defined key_mpi_off 
    254             IF( ln_timing ) CALL tic_tac(.TRUE.) 
    255             ! non-blocking send of the south/north side using local buffer 
    256             CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, nreq_p2p(jn), ierr ) 
    257             IF( ln_timing ) CALL tic_tac(.FALSE.) 
    258 #endif 
    259          ENDIF 
    260       END DO 
    261       ! 
    262214      ! ------------------------------------- ! 
    263215      !     7. Fill south and north halos     ! 
    … …  
    265217      ! 
    266218      DO jn = 3, 4 
    267          ishti = ishtRi(jn) 
    268          ishtj = ishtRj(jn) 
    269          SELECT CASE ( ifill(jn) ) 
    270          CASE ( jpfillnothing )               ! no filling  
    271          CASE ( jpfillmpi   )                 ! fill with data received by MPI 
    272 #if ! defined key_mpi_off 
    273             IF( ln_timing ) CALL tic_tac(.TRUE.) 
    274             !                                 ! blocking receive of the south/north halo in local temporary arrays 
    275             CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 
    276             IF( ln_timing ) CALL tic_tac(.FALSE.) 
    277 #endif 
    278             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    279                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr) 
    280                idxr = idxr + 1 
    281             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    282          CASE ( jpfillperio )                 ! use periodicity 
    283             ishti2 = ishtPi(jn) 
    284             ishtj2 = ishtPj(jn) 
    285             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    286                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    287             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    288          CASE ( jpfillcopy  )                 ! filling with inner domain values 
    289             ishti2 = ishtSi(jn) 
    290             ishtj2 = ishtSj(jn) 
    291             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    292                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    293             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    294          CASE ( jpfillcst   )                 ! filling with constant value 
    295             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    296                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
    297             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    298          END SELECT 
     219#define BLOCK_FILL 
     220#  include "lbc_lnk_pt2pt_generic.h90"          
     221#undef BLOCK_FILL 
    299222      END DO 
    300223      ! 
    … …  
    305228      ! 
    306229      DO jn = 5, 8 
    307          IF( llsend(jn) ) THEN 
    308             ishti = ishtSi(jn) 
    309             ishtj = ishtSj(jn) 
    310             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    311                BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) 
    312                idxs = idxs + 1 
    313             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    314 #if ! defined key_mpi_off 
    315             IF( ln_timing ) CALL tic_tac(.TRUE.) 
    316             ! non-blocking send of the corners using local buffer 
    317             CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, nreq_p2p(jn), ierr ) 
    318             IF( ln_timing ) CALL tic_tac(.FALSE.) 
    319 #endif 
    320          ENDIF 
     230#define BLOCK_ISEND 
     231#  include "lbc_lnk_pt2pt_generic.h90"          
     232#undef BLOCK_ISEND 
    321233      END DO 
    322234      DO jn = 5, 8 
    323          IF( llrecv(jn) ) THEN 
    324 #if ! defined key_mpi_off 
    325             IF( ln_timing ) CALL tic_tac(.TRUE.) 
    326             ! blocking receive of the corner halo in local temporary arrays 
    327             CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 
    328             IF( ln_timing ) CALL tic_tac(.FALSE.) 
    329 #endif 
    330             ishti = ishtRi(jn) 
    331             ishtj = ishtRj(jn) 
    332             DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
    333                ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr) 
    334                idxr = idxr + 1 
    335             END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    336          ENDIF 
     235#define BLOCK_FILL 
     236#  include "lbc_lnk_pt2pt_generic.h90"          
     237#undef BLOCK_FILL 
    337238      END DO 
    338239      ! 
    … …  
    349250      ! 
    350251   END SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION 
     252#endif 
    351253 
     254#if defined BLOCK_ISEND 
     255   IF( llsend(jn) ) THEN 
     256      ishti = ishtSi(jn) 
     257      ishtj = ishtSj(jn) 
     258      DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     259         BUFFSND(idxs) = ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) 
     260         idxs = idxs + 1 
     261      END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     262#if ! defined key_mpi_off 
     263      IF( ln_timing ) CALL tic_tac(.TRUE.) 
     264      ! non-blocking send of the west/east side using local buffer 
     265      CALL MPI_ISEND( BUFFSND(ishtS(jn)+1), iszall(jn), MPI_TYPE, mpiSnei(ihls,jn), iStag(jn), icomm, nreq_p2p(jn), ierr ) 
     266      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     267#endif 
     268   ENDIF 
     269#endif 
     270 
     271#if defined BLOCK_FILL 
     272   ishti = ishtRi(jn) 
     273   ishtj = ishtRj(jn) 
     274   SELECT CASE ( ifill(jn) ) 
     275   CASE ( jpfillnothing )               ! no filling  
     276   CASE ( jpfillmpi   )                 ! fill with data received by MPI 
     277#if ! defined key_mpi_off 
     278      IF( ln_timing ) CALL tic_tac(.TRUE.) 
     279      !                                 ! blocking receive of the west/east halo in local temporary arrays 
     280      CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 
     281      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     282#endif 
     283      DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     284         ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idxr) 
     285         idxr = idxr + 1 
     286      END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     287   CASE ( jpfillperio )                 ! use periodicity 
     288      ishti2 = ishtPi(jn) 
     289      ishtj2 = ishtPj(jn) 
     290      DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     291         ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
     292      END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     293   CASE ( jpfillcopy  )                 ! filling with inner domain values 
     294      ishti2 = ishtSi(jn) 
     295      ishtj2 = ishtSj(jn) 
     296      DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     297         ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
     298      END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     299   CASE ( jpfillcst   )                 ! filling with constant value 
     300      DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
     301         ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
     302      END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     303   END SELECT 
     304#endif 
Note: See TracChangeset for help on using the changeset viewer.