- Timestamp:
- 2021-05-11T12:50:43+02:00 (3 years ago)
- 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 416 416 zuwdav2 (:,:) = 0._wp 417 417 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. 419 422 420 423 ! ! ==================== ! … … 723 726 END DO ! end loop ! 724 727 ! ! ==================== ! 728 lints = .FALSE. 725 729 ! ----------------------------------------------------------------------------- 726 730 ! 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 69 69 IF( PRESENT(psgn15) ) CALL load_ptr_/**/XD/**/_/**/PRECISION( pt15, cdna15, psgn15, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 70 70 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 77 100 ! 78 101 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 39 39 END INTERFACE 40 40 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 41 49 INTERFACE lbc_lnk_neicoll 42 50 MODULE PROCEDURE lbc_lnk_neicoll_sp ,lbc_lnk_neicoll_dp 43 51 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 44 56 ! 45 57 INTERFACE lbc_lnk_icb … … 115 127 !! *** lbc_lnk_pt2pt_[sd]p *** 116 128 !! *** lbc_lnk_neicoll_[sd]p *** 129 !! *** lbc_lnk_newpt2pt_[sd]p *** 117 130 !! 118 131 !! * Argument : dummy argument use in lbc_lnk_... routines … … 133 146 # define BUFFRCV buffrcv_sp 134 147 # include "lbc_lnk_pt2pt_generic.h90" 148 # include "lbc_lnk_newpt2pt_generic.h90" 149 # include "lbc_lnk_oldpt2pt_generic.h90" 135 150 # include "lbc_lnk_neicoll_generic.h90" 151 # include "lbc_lnk_persistent.h90" 136 152 # undef MPI_TYPE 137 153 # undef BUFFSND … … 146 162 # define BUFFRCV buffrcv_dp 147 163 # include "lbc_lnk_pt2pt_generic.h90" 164 # include "lbc_lnk_newpt2pt_generic.h90" 165 # include "lbc_lnk_oldpt2pt_generic.h90" 148 166 # include "lbc_lnk_neicoll_generic.h90" 167 # include "lbc_lnk_persistent.h90" 149 168 # undef MPI_TYPE 150 169 # undef BUFFSND -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lib_mpp.F90
r14433 r14835 70 70 PUBLIC mpp_ini_znl 71 71 PUBLIC mpp_ini_nc 72 PUBLIC mpp_ini_pers 72 73 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 73 74 PUBLIC mppsend_sp, mpprecv_sp ! needed by TAM and ICB routines … … 207 208 REAL(dp) , PUBLIC :: compute_time = 0._dp, elapsed_time = 0._dp 208 209 209 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend210 211 210 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms 212 211 INTEGER, PUBLIC :: nn_comm !: namelist control of comms … … 218 217 INTEGER, PUBLIC, PARAMETER :: jpfillmpi = 5 219 218 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 220 225 !! * Substitutions 221 226 # include "do_loop_substitute.h90" … … 1147 1152 END SUBROUTINE mpp_ini_nc 1148 1153 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 1149 1236 1150 1237 SUBROUTINE mpp_ini_north -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/mppini.F90
r14433 r14835 39 39 INTEGER :: numbot = -1 ! 'bottom_level' local logical unit 40 40 INTEGER :: numbdy = -1 ! 'bdy_msk' local logical unit 41 42 41 !!---------------------------------------------------------------------- 43 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 146 145 & cn_ice, nn_ice_dta, & 147 146 & 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 149 148 !!---------------------------------------------------------------------- 150 149 ! … … 170 169 WRITE(numout,*) ' avoid use of mpi_allgather at the north fold ln_nnogather = ', ln_nnogather 171 170 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 172 173 ENDIF 173 174 ! … … 565 566 END DO 566 567 ENDIF 568 ! 569 IF( ln_tspers ) CALL mpp_ini_pers ! initialize persistent call 567 570 ! 568 571 CALL init_ioipsl ! Prepare NetCDF output file (if necessary)
Note: See TracChangeset
for help on using the changeset viewer.