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 14835 for NEMO – NEMO

Changeset 14835 for NEMO


Ignore:
Timestamp:
2021-05-11T12:50:43+02:00 (3 years ago)
Author:
girrmann
Message:

Add new communication schemes, non blocking with diagonals and persistent calls for time splitting

Location:
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE
Files:
2 added
5 edited

Legend:

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

    r14433 r14835  
    416416         zuwdav2 (:,:) = 0._wp  
    417417         zvwdav2 (:,:) = 0._wp    
    418       END IF  
     418      END IF 
     419      ! 
     420      ! indicate that communications can use persistent calls if ln_pers_ts is TRUE 
     421      lints = .TRUE. 
    419422 
    420423      !                                             ! ==================== ! 
     
    723726      END DO                                               !        end loop      ! 
    724727      !                                                    ! ==================== ! 
     728      lints = .FALSE. 
    725729      ! ----------------------------------------------------------------------------- 
    726730      ! Phase 3. update the general trend with the barotropic trend 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_call_generic.h90

    r14433 r14835  
    6969      IF( PRESENT(psgn15) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    7070      IF( PRESENT(psgn16) )   CALL load_ptr_/**/XD/**/_/**/PRECISION( pt16, cdna16, psgn16, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    71       !      
    72       IF( nn_comm == 1 ) THEN  
    73          CALL lbc_lnk_pt2pt(   cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
    74       ELSE 
    75          CALL lbc_lnk_neicoll( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
    76       ENDIF 
     71      ! 
     72       
     73      IF( lints ) THEN   ! in time splitting 
     74         IF( ln_tspers ) THEN 
     75            CALL lbc_lnk_persistent( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     76         ELSE 
     77            SELECT CASE (nn_comm) 
     78            CASE (1) 
     79               CALL lbc_lnk_pt2pt(    cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     80            CASE (2) 
     81               CALL lbc_lnk_neicoll(  cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     82            CASE (3) 
     83               CALL lbc_lnk_newpt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     84            CASE (4) 
     85               CALL lbc_lnk_oldpt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     86            END SELECT 
     87         END IF 
     88      ELSE               ! No persistent call outside time-splitting 
     89         SELECT CASE (nn_comm) 
     90         CASE (1) 
     91            CALL lbc_lnk_pt2pt(    cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     92         CASE (2) 
     93            CALL lbc_lnk_neicoll(  cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     94         CASE (3) 
     95            CALL lbc_lnk_newpt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     96         CASE (4) 
     97            CALL lbc_lnk_oldpt2pt( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, khls, lsend, lrecv, ld4only ) 
     98         END SELECT 
     99      END IF 
    77100      ! 
    78101   END SUBROUTINE lbc_lnk_call_/**/XD/**/_/**/PRECISION 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbclnk.F90

    r14433 r14835  
    3939   END INTERFACE 
    4040 
     41   INTERFACE lbc_lnk_newpt2pt 
     42      MODULE PROCEDURE   lbc_lnk_newpt2pt_sp, lbc_lnk_newpt2pt_dp 
     43   END INTERFACE lbc_lnk_newpt2pt 
     44 
     45   INTERFACE lbc_lnk_oldpt2pt 
     46      MODULE PROCEDURE   lbc_lnk_oldpt2pt_sp, lbc_lnk_oldpt2pt_dp 
     47   END INTERFACE lbc_lnk_oldpt2pt 
     48    
    4149   INTERFACE lbc_lnk_neicoll 
    4250      MODULE PROCEDURE   lbc_lnk_neicoll_sp ,lbc_lnk_neicoll_dp 
    4351   END INTERFACE 
     52 
     53   INTERFACE lbc_lnk_persistent 
     54      MODULE PROCEDURE   lbc_lnk_persistent_sp, lbc_lnk_persistent_dp 
     55   END INTERFACE lbc_lnk_persistent 
    4456   ! 
    4557   INTERFACE lbc_lnk_icb 
     
    115127   !!                   ***  lbc_lnk_pt2pt_[sd]p  *** 
    116128   !!                  ***  lbc_lnk_neicoll_[sd]p  *** 
     129   !!                 ***  lbc_lnk_newpt2pt_[sd]p   *** 
    117130   !! 
    118131   !!   * Argument : dummy argument use in lbc_lnk_... routines 
     
    133146#  define BUFFRCV buffrcv_sp 
    134147#  include "lbc_lnk_pt2pt_generic.h90" 
     148#  include "lbc_lnk_newpt2pt_generic.h90" 
     149#  include "lbc_lnk_oldpt2pt_generic.h90" 
    135150#  include "lbc_lnk_neicoll_generic.h90" 
     151#  include "lbc_lnk_persistent.h90" 
    136152#  undef MPI_TYPE 
    137153#  undef BUFFSND 
     
    146162#  define BUFFRCV buffrcv_dp 
    147163#  include "lbc_lnk_pt2pt_generic.h90" 
     164#  include "lbc_lnk_newpt2pt_generic.h90" 
     165#  include "lbc_lnk_oldpt2pt_generic.h90" 
    148166#  include "lbc_lnk_neicoll_generic.h90" 
     167#  include "lbc_lnk_persistent.h90" 
    149168#  undef MPI_TYPE 
    150169#  undef BUFFSND 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lib_mpp.F90

    r14433 r14835  
    7070   PUBLIC   mpp_ini_znl 
    7171   PUBLIC   mpp_ini_nc 
     72   PUBLIC   mpp_ini_pers 
    7273   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    7374   PUBLIC   mppsend_sp, mpprecv_sp                          ! needed by TAM and ICB routines 
     
    207208   REAL(dp)              , PUBLIC ::  compute_time = 0._dp, elapsed_time = 0._dp 
    208209 
    209    REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::   tampon   ! buffer in case of bsend 
    210  
    211210   LOGICAL, PUBLIC ::   ln_nnogather                !: namelist control of northfold comms 
    212211   INTEGER, PUBLIC ::   nn_comm                     !: namelist control of comms 
     
    218217   INTEGER, PUBLIC, PARAMETER ::   jpfillmpi     = 5 
    219218 
     219   ! Variables for eventual persistent call 
     220   REAL(wp), DIMENSION(:), ALLOCATABLE, PUBLIC :: buffS_pers, buffR_pers 
     221   INTEGER , DIMENSION(:), ALLOCATABLE, PUBLIC :: nreq_pers 
     222   LOGICAL                            , PUBLIC :: lints = .FALSE.   ! indicate if currently in time-splitting (for persistent calls) 
     223   LOGICAL                            , PUBLIC :: ln_tspers         ! indicate if persistent call enabled in time-splitting 
     224    
    220225   !! * Substitutions 
    221226#  include "do_loop_substitute.h90" 
     
    11471152   END SUBROUTINE mpp_ini_nc 
    11481153 
     1154    
     1155   SUBROUTINE mpp_ini_pers 
     1156      !!---------------------------------------------------------------------- 
     1157      !!               ***  routine mpp_ini_pers  *** 
     1158      !! 
     1159      !! ** Purpose :   Initialize special requests and buffers for persistent calls 
     1160      !! 
     1161      !! ** Method  : - Allocate buffers to the size required in dynspg_ts's communications 
     1162      !!              - Need :   shift in buffer to get to first element of region (E-W-N-S + diag) 
     1163      !!                         size of that region 
     1164      !!                         MPI index of neighbour and tag 
     1165      !! 
     1166      !! ** output 
     1167      !!         - requests to be used in communications called in dynspg_ts 
     1168      !! ** Note 
     1169      !!         - only coded for 2D arrays in dynspg_ts with 1 halo 
     1170      !!---------------------------------------------------------------------- 
     1171      INTEGER, DIMENSION(8)      :: ishtS, ishtR, iStag, iRtag   ! shifts, tag 
     1172      INTEGER, DIMENSION(8)      :: icount                       ! size of buffer 
     1173      LOGICAL, DIMENSION(8)      :: llsend, llrecv 
     1174      INTEGER                    :: iszS, iszR 
     1175      INTEGER                    :: ireq, idxreq 
     1176      INTEGER                    :: ifldmax, ierr, MPI_TYPE 
     1177      INTEGER                    :: jn 
     1178      !!---------------------------------------------------------------------- 
     1179 
     1180      if( wp == dp ) then 
     1181         MPI_TYPE = MPI_DOUBLE_PRECISION 
     1182      else if ( wp == sp ) then 
     1183         MPI_TYPE = MPI_REAL 
     1184      else 
     1185         CALL ctl_stop( "Error defining type, wp is neither dp nor sp" ) 
     1186      end if 
     1187      ! 
     1188      ! 
     1189      ! Size of region 
     1190      ifldmax = 6   ! 6 arrays updated max in a single call in dynspg_ts 
     1191      icount(1:2) = ifldmax * (jpi-2)   ! west  - east 
     1192      icount(3:4) = ifldmax * (jpj-2)   ! south - north 
     1193      icount(5:8) = ifldmax             ! diagonals 
     1194      ! 
     1195      llsend(:) = mpiSnei(1,:) >= 0   ! hypothesis : 1 halo in time splitting 
     1196      llrecv(:) = mpiRnei(1,:) >= 0 
     1197      ! 
     1198      ! Shift in buffer to get to the first element of region 
     1199      ishtS(1) = 0   ;   ishtR(1) = 0 
     1200      DO jn = 2, 8 
     1201         ishtS(jn) = ishtS(jn-1) + icount(jn-1) * COUNT( (/llsend(jn-1)/) ) 
     1202         ishtR(jn) = ishtR(jn-1) + icount(jn-1) * COUNT( (/llrecv(jn-1)/) ) 
     1203      END DO 
     1204      ! 
     1205      ! Allocate buffer here, might be possible to allocate in dynspg_ts 
     1206      iszS = SUM(icount, mask = llsend)   ! send buffer size 
     1207      iszR = SUM(icount, mask = llrecv)   ! recv buffer size 
     1208      ALLOCATE( buffS_pers(iszS), buffR_pers(iszR) ) 
     1209      ! 
     1210      ! Tags 
     1211      iStag = (/ 1, 2, 3, 4, 5, 6, 7, 8 /)   ! any value but each one must be different 
     1212      ! define iRtag with the corresponding iStag, e.g. data received at west where sent at east. 
     1213      iRtag(jpwe) = iStag(jpea)   ;   iRtag(jpea) = iStag(jpwe)   ;   iRtag(jpso) = iStag(jpno)   ;   iRtag(jpno) = iStag(jpso) 
     1214      iRtag(jpsw) = iStag(jpne)   ;   iRtag(jpse) = iStag(jpnw)   ;   iRtag(jpnw) = iStag(jpse)   ;   iRtag(jpne) = iStag(jpsw) 
     1215      !    
     1216      ! Requests 
     1217      ! Allocate requests (initialization at MPI_REQUEST_NULL is not allowed with persistent calls) 
     1218      ireq = COUNT(llsend)+COUNT(llrecv) 
     1219      ALLOCATE( nreq_pers(ireq) ) 
     1220      idxreq = 1 
     1221      DO jn = 1, 8 
     1222         IF( llsend(jn) ) THEN    ! MPI_Start(requests) behaves as MPI_Isend 
     1223            CALL MPI_Send_init(buffS_pers(ishtS(jn)+1), icount(jn), MPI_TYPE, mpiSnei(nn_hls,jn), iStag(jn), mpi_comm_oce, nreq_pers(idxreq), ierr) 
     1224            idxreq = idxreq + 1 
     1225         END IF 
     1226      END DO 
     1227      DO jn = 1, 8 
     1228         IF( llrecv(jn) ) THEN    ! MPI_Start(requests) behaves as MPI_Irecv 
     1229            CALL MPI_Recv_init(buffR_pers(ishtR(jn)+1), icount(jn), MPI_TYPE, mpiRnei(nn_hls,jn), iRtag(jn), mpi_comm_oce, nreq_pers(idxreq), ierr) 
     1230            idxreq = idxreq + 1 
     1231         END IF 
     1232      END DO 
     1233      !       
     1234    END SUBROUTINE mpp_ini_pers 
     1235    
    11491236 
    11501237   SUBROUTINE mpp_ini_north 
  • NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/mppini.F90

    r14433 r14835  
    3939   INTEGER ::   numbot = -1   ! 'bottom_level' local logical unit 
    4040   INTEGER ::   numbdy = -1   ! 'bdy_msk'      local logical unit 
    41  
    4241   !!---------------------------------------------------------------------- 
    4342   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    146145           &             cn_ice, nn_ice_dta,                                     & 
    147146           &             ln_vol, nn_volctl, nn_rimwidth 
    148       NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm 
     147      NAMELIST/nammpp/ jpni, jpnj, nn_hls, ln_nnogather, ln_listonly, nn_comm, ln_tspers 
    149148      !!---------------------------------------------------------------------- 
    150149      ! 
     
    170169            WRITE(numout,*) '      avoid use of mpi_allgather at the north fold  ln_nnogather = ', ln_nnogather 
    171170            WRITE(numout,*) '      halo width (applies to both rows and columns)       nn_hls = ', nn_hls 
     171            WRITE(numout,*) '      communication type                                 nn_comm = ', nn_comm 
     172            WRITE(numout,*) '      switch to persistent calls in time-splitting    ln_tspers = ', ln_tspers 
    172173      ENDIF 
    173174      ! 
     
    565566         END DO 
    566567      ENDIF 
     568      ! 
     569      IF( ln_tspers ) CALL mpp_ini_pers   ! initialize persistent call 
    567570      ! 
    568571      CALL init_ioipsl           ! Prepare NetCDF output file (if necessary) 
Note: See TracChangeset for help on using the changeset viewer.