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 14899 for NEMO/branches/2021 – NEMO

Changeset 14899 for NEMO/branches/2021


Ignore:
Timestamp:
2021-05-25T15:53:20+02:00 (3 years ago)
Author:
girrmann
Message:

Asynchronous communications now works in time splitting with nncomm == 3 (newpt2pt communication) and yiels identical results but is not compatible with other schemes. Under investigation...

Location:
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE
Files:
8 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/DYN/dynspg_ts.F90

    r14835 r14899  
    522522         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
    523523         !-------------------------------------------------------------------------! 
    524          DO_2D( 0, 0, 0, 0 ) 
    525             zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    526             ssha_e(ji,jj) = (  sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
    527          END_2D 
    528          ! 
    529          CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     524 
     525         ! 
     526         IF( ln_async )  THEN 
     527            CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp, loop_fct=loop_fct1 ) 
     528         ELSE 
     529            DO_2D( 0, 0, 0, 0 ) 
     530                zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
     531                ssha_e(ji,jj) = (  sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
     532            END_2D 
     533            CALL lbc_lnk( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     534         END IF 
    530535         ! 
    531536         ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) 
     
    836841      CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) )  ! Barotropic  V Velocity 
    837842      ! 
     843    CONTAINS 
     844      subroutine loop_fct1(i0, i1, j0, j1, k0, k1, buf) 
     845        integer, intent(in) :: i0, i1, j0, j1, k0, k1 
     846        REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
     847        DO_2D( 0, 0, 0, 0 ) 
     848            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
     849            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rDt_e * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
     850        END_2D 
     851      end subroutine loop_fct1 
    838852   END SUBROUTINE dyn_spg_ts 
    839853 
    840854 
     855                 
    841856   SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) 
    842857      !!--------------------------------------------------------------------- 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_call_generic.h90

    r14892 r14899  
    4343      LOGICAL, DIMENSION(4), OPTIONAL        , INTENT(in   ) ::   lsend, lrecv   ! indicate how communications are to be carried out 
    4444      LOGICAL              , OPTIONAL        , INTENT(in   ) ::   ld4only     ! if .T., do only 4-neighbour comm (ignore corners) 
    45       !! 
    46       INTEGER                          ::   kfld        ! number of elements that will be attributed 
    47       TYPE(PTR_4d_/**/PRECISION), DIMENSION(16) ::   ptab_ptr    ! pointer array 
    48       CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
    49       REAL(PRECISION)  , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary 
    5045      interface 
    5146        subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 
     
    5550      end interface 
    5651      optional :: loop_fct 
     52      !! 
     53      INTEGER                          ::   kfld        ! number of elements that will be attributed 
     54      TYPE(PTR_4d_/**/PRECISION), DIMENSION(16) ::   ptab_ptr    ! pointer array 
     55      CHARACTER(len=1) , DIMENSION(16) ::   cdna_ptr    ! nature of ptab_ptr grid-points 
     56      REAL(PRECISION)  , DIMENSION(16) ::   psgn_ptr    ! sign used across the north fold boundary 
     57 
    5758      !!--------------------------------------------------------------------- 
    5859      ! 
     
    8384         IF( ln_tspers ) THEN 
    8485            CALL lbc_lnk_persistent( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
    85          elseif(present(loop_fct) .and. ln_async) 
    86             CALL lbc_lnk_pt2pt_async( cdname, loop_fct, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     86         ELSE IF( PRESENT(loop_fct) .AND. ln_async ) THEN 
     87            CALL lbc_lnk_async( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only, loop_fct ) 
    8788         ELSE 
    8889            SELECT CASE (nn_comm) 
     
    9798            END SELECT 
    9899         END IF 
    99       elseif(present(loop_fct) .and. ln_async) 
    100          CALL lbc_lnk_pt2pt_async( cdname, loop_fct, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     100      ELSE IF( PRESENT(loop_fct) .AND. ln_async ) THEN 
     101         CALL lbc_lnk_async( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only, loop_fct ) 
    101102      ELSE               ! No persistent call outside time-splitting 
    102103         SELECT CASE (nn_comm) 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_newpt2pt_generic.h90

    r14835 r14899  
    144144      ! 
    145145      ! Allocate local temporary arrays to be sent/received. 
    146       iszS = COUNT( llsend ) 
    147       iszR = COUNT( llrecv ) 
    148146      iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf 
    149147      ishtS(1) = 0 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_oldpt2pt_generic.h90

    r14872 r14899  
    252252      END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    253253#if ! defined key_mpi_off 
    254       IF( ln_timing ) CALL tic_tac(.TRUE.) 
     254      !IF( ln_timing ) CALL tic_tac(.TRUE.) 
    255255      ! non-blocking send of the west/east side using local buffer 
    256256      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.) 
     257      !IF( ln_timing ) CALL tic_tac(.FALSE.) 
    258258#endif 
    259259   ENDIF 
     
    267267   CASE ( jpfillmpi   )                 ! fill with data received by MPI 
    268268#if ! defined key_mpi_off 
    269       IF( ln_timing ) CALL tic_tac(.TRUE.) 
     269      !IF( ln_timing ) CALL tic_tac(.TRUE.) 
    270270      !                                 ! blocking receive of the west/east halo in local temporary arrays 
    271271      CALL MPI_RECV( BUFFRCV(ishtR(jn)+1), iszall(jn), MPI_TYPE, mpiRnei(ihls,jn), iRtag(jn), icomm, MPI_STATUS_IGNORE, ierr ) 
    272       IF( ln_timing ) CALL tic_tac(.FALSE.) 
     272      !IF( ln_timing ) CALL tic_tac(.FALSE.) 
    273273#endif 
    274274      DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jn)  ;  DO ji = 1,isizei(jn) 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_pt2pt_async.h90

    r14891 r14899  
    1 ! vim: ft=fortran : 
     1 
    22#if ! defined BLOCK_ISEND && ! defined BLOCK_IRECV && ! defined BLOCK_FILL 
    3    SUBROUTINE lbc_lnk_pt2pt_async/**/PRECISION( cdname, loop_fct, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     3   SUBROUTINE lbc_lnk_async_/**/PRECISION( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only, loop_fct ) 
    44      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    5       interface 
    6         subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 
    7           integer, intent(in) :: i0, i1, j0, j1, k0, k1 
    8           REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
    9         end subroutine loop_fct 
    10       end interface 
     5 
    116      TYPE(PTR_4d_/**/PRECISION),  DIMENSION(:), INTENT(inout) ::   ptab        ! pointer of arrays on which apply the b.c. 
    127      CHARACTER(len=1), DIMENSION(:), INTENT(in   ) ::   cd_nat      ! nature of array grid-points 
     
    1813      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    1914      LOGICAL,              OPTIONAL, INTENT(in   ) ::   ld4only     ! if .T., do only 4-neighbour comm (ignore corners) 
     15      interface 
     16         subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) 
     17           integer, intent(in) :: i0, i1, j0, j1, k0, k1 
     18           REAL*8, dimension(:,:,:,:,:,:), optional, intent(out) :: buf 
     19         end subroutine loop_fct 
     20      end interface 
     21      optional :: loop_fct 
    2022      ! 
    2123      INTEGER  ::     ji,   jj,  jk,  jl,  jf, jn     ! dummy loop indices 
     
    5658      ! take care of optional parameters 
    5759      ! 
    58       ihls = nn_hls   ! default definition 
     60      ihls = nn_hls       ! default definition 
    5961      IF( PRESENT( khls ) )   ihls = khls 
    6062      IF( ihls > n_hlsmax ) THEN 
    61          WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax 
     63         WRITE(ctmp1,*) TRIM(cdname), '  is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax 
    6264         CALL ctl_stop( 'STOP', ctmp1 ) 
    6365      ENDIF 
     
    8183         llsend(1:4) = lsend(1:4)   ;   llrecv(1:4) = lrecv(1:4) 
    8284      ELSE IF( PRESENT(lsend) .OR.  PRESENT(lrecv) ) THEN 
    83          WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with only one of the two arguments lsend or lrecv' 
     85         WRITE(ctmp1,*) TRIM(cdname), '  is calling lbc_lnk with only one of the two arguments lsend or lrecv' 
    8486         CALL ctl_stop( 'STOP', ctmp1 ) 
    8587      ELSE                                              ! default neighbours 
     
    9294      ! define ifill: which method should be used to fill each parts (sides+corners) of the halos 
    9395      ! default definition 
    94       DO jn = 1, 4 
     96      DO jn = 1, 8 
    9597         IF(             llrecv(jn) ) THEN   ;   ifill(jn) = jpfillmpi    ! with an mpi communication 
    9698         ELSEIF(    l_SelfPerio(jn) ) THEN   ;   ifill(jn) = jpfillperio  ! with self-periodicity 
     
    104106         ENDIF 
    105107      END DO 
    106          ! 
    107108      ! north fold treatment 
    108109      ll_IdoNFold = l_IdoNFold .AND. ifill(jpno) /= jpfillnothing 
     
    111112         ifill( (/jpno/) ) = jpfillnothing   ! we do north fold -> do nothing for northern halo 
    112113      ENDIF 
    113  
     114       
    114115      ! We first define the localization and size of the parts of the array that will be sent (s), received (r) 
    115116      ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions. 
     
    129130      ! 
    130131      iwewe(:) = (/ jpwe,jpea,jpwe,jpea /)   ;   issnn(:) = (/ jpso,jpso,jpno,jpno /) 
    131       !cd     sides:     west  east south north      ;   corners: so-we, so-ea, no-we, no-ea 
    132       isizei(1:4) = (/ ihls, ihls,  ipi,  ipi /)   ;   isizei(5:8) = ihls              ! i- count 
    133       isizej(1:4) = (/  ipj,  ipj, ihls, ihls /)   ;   isizej(5:8) = ihls              ! j- count 
    134       ishtSi(1:4) = (/ ip1i, im1i, ip0i, ip0i /)   ;   ishtSi(5:8) = ishtSi( iwewe )   ! i- shift send data 
    135       ishtSj(1:4) = (/ ip0j, ip0j, ip1j, im1j /)   ;   ishtSj(5:8) = ishtSj( issnn )   ! j- shift send data 
    136       ishtRi(1:4) = (/ ip0i, im0i, ip0i, ip0i /)   ;   ishtRi(5:8) = ishtRi( iwewe )   ! i- shift received data location 
    137       ishtRj(1:4) = (/ ip0j, ip0j, ip0j, im0j /)   ;   ishtRj(5:8) = ishtRj( issnn )   ! j- shift received data location 
    138       ishtPi(1:4) = (/ im1i, ip1i, ip0i, ip0i /)   ;   ishtPi(5:8) = ishtPi( iwewe )   ! i- shift data used for periodicity 
    139       ishtPj(1:4) = (/ ip0j, ip0j, im1j, ip1j /)   ;   ishtPj(5:8) = ishtPj( issnn )   ! j- shift data used for periodicity 
     132      !     sides:     west  east south north      ;   corners: so-we, so-ea, no-we, no-ea 
     133      isizei(1:4) = (/ ihls, ihls, Ni_0, Ni_0 /)   ;   isizei(5:8) = ihls              ! i- count 
     134      isizej(1:4) = (/ Nj_0, Nj_0, ihls, ihls /)   ;   isizej(5:8) = ihls              ! j- count 
     135      ishtSi(1:4) = (/ ip1i, im1i, ip1i, ip1i /)   ;   ishtSi(5:8) = ishtSi( iwewe )   ! i- shift send data 
     136      ishtSj(1:4) = (/ ip1j, ip1j, ip1j, im1j /)   ;   ishtSj(5:8) = ishtSj( issnn )   ! j- shift send data 
     137      ishtRi(1:4) = (/ ip0i, im0i, ip1i, ip1i /)   ;   ishtRi(5:8) = ishtRi( iwewe )   ! i- shift received data location 
     138      ishtRj(1:4) = (/ ip1j, ip1j, ip0j, im0j /)   ;   ishtRj(5:8) = ishtRj( issnn )   ! j- shift received data location 
     139      ishtPi(1:4) = (/ im1i, ip1i, ip1i, ip1i /)   ;   ishtPi(5:8) = ishtPi( iwewe )   ! i- shift data used for periodicity 
     140      ishtPj(1:4) = (/ ip1j, ip1j, im1j, ip1j /)   ;   ishtPj(5:8) = ishtPj( issnn )   ! j- shift data used for periodicity 
    140141      ! 
    141142      ! -------------------------------- ! 
     
    148149      iRtag(jpsw) = iStag(jpne)   ;   iRtag(jpse) = iStag(jpnw)   ;   iRtag(jpnw) = iStag(jpse)   ;   iRtag(jpne) = iStag(jpsw) 
    149150      ! 
     151      ! Allocate local temporary arrays to be sent/received. 
    150152      iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf 
    151153      ishtS(1) = 0 
     
    157159         ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) ) 
    158160      END DO 
    159  
     161       
    160162      ! Allocate buffer arrays to be sent/received if needed 
    161163      iszS = SUM(iszall, mask = llsend)                             ! send buffer size 
     
    179181      ! ------------------------------------------------------------- ! 
    180182      ! 
    181       DO jn = 1, 4 ! TODO maybe to 8 for corners 
     183      DO jn = 1, 8 ! TODO maybe to 8 for corners 
    182184#define BLOCK_IRECV 
    183185#  include "lbc_lnk_pt2pt_async.h90" 
     
    198200      ! ------------------------------------------------------------- ! 
    199201      ! 
    200       DO jn = 1, 4 
     202      DO jn = 1, 8 
    201203#define BLOCK_ISEND 
    202204#  include "lbc_lnk_pt2pt_async.h90" 
     
    209211      ! ----------------------------------- ! 
    210212      ! 
    211       DO jn = 1, 2 
     213      DO jn = 1, 8 
    212214#define BLOCK_FILL 
    213215#  include "lbc_lnk_pt2pt_async.h90" 
     
    233235      ! ------------------------------------- ! 
    234236      ! 
    235       DO jn = 3, 4 
    236 #define BLOCK_FILL 
    237 #  include "lbc_lnk_pt2pt_async.h90" 
    238 #undef BLOCK_FILL 
    239       END DO 
     237!       DO jn = 3, 4 
     238! #define BLOCK_FILL 
     239! #  include "lbc_lnk_pt2pt_async.h90" 
     240! #undef BLOCK_FILL 
     241!       END DO 
    240242!!      ! 
    241243!!      ! ----------------------------------------------- ! 
     
    266268      ENDIF 
    267269      ! 
    268    END SUBROUTINE lbc_lnk_pt2pt_/**/PRECISION 
     270   END SUBROUTINE lbc_lnk_async_/**/PRECISION 
    269271#endif 
    270272 
     
    309311      IF( ln_timing ) CALL tic_tac(.TRUE.) 
    310312      !                                 ! waiting receive of the west/east halo in local temporary arrays 
    311       call MPI_WAIT(iref(jn), MPI_STATUS_IGNORE, ier) 
     313      call MPI_WAIT(ireq(jn), MPI_STATUS_IGNORE, ierr) 
    312314      IF( ln_timing ) CALL tic_tac(.FALSE.) 
    313315#endif 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbclnk.F90

    r14891 r14899  
    5454      MODULE PROCEDURE   lbc_lnk_persistent_sp, lbc_lnk_persistent_dp 
    5555   END INTERFACE lbc_lnk_persistent 
     56 
     57   INTERFACE lbc_lnk_async 
     58      MODULE PROCEDURE   lbc_lnk_async_sp, lbc_lnk_async_dp 
     59   END INTERFACE lbc_lnk_async 
    5660   ! 
    5761   INTERFACE lbc_lnk_icb 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lib_mpp.F90

    r14835 r14899  
    222222   LOGICAL                            , PUBLIC :: lints = .FALSE.   ! indicate if currently in time-splitting (for persistent calls) 
    223223   LOGICAL                            , PUBLIC :: ln_tspers         ! indicate if persistent call enabled in time-splitting 
     224   LOGICAL                            , PUBLIC :: ln_async          ! indicate if asynchronous communications enabled 
    224225    
    225226   !! * Substitutions 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/mppini.F90

    r14835 r14899  
    145145           &             cn_ice, nn_ice_dta,                                     & 
    146146           &             ln_vol, nn_volctl, nn_rimwidth 
    147       NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm, ln_tspers 
     147      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm, ln_tspers, ln_async 
    148148      !!---------------------------------------------------------------------- 
    149149      ! 
Note: See TracChangeset for help on using the changeset viewer.