Changeset 14899 for NEMO/branches/2021
- Timestamp:
- 2021-05-25T15:53:20+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE
- Files:
-
- 8 edited
-
DYN/dynspg_ts.F90 (modified) (2 diffs)
-
LBC/lbc_lnk_call_generic.h90 (modified) (4 diffs)
-
LBC/lbc_lnk_newpt2pt_generic.h90 (modified) (1 diff)
-
LBC/lbc_lnk_oldpt2pt_generic.h90 (modified) (2 diffs)
-
LBC/lbc_lnk_pt2pt_async.h90 (modified) (16 diffs)
-
LBC/lbclnk.F90 (modified) (1 diff)
-
LBC/lib_mpp.F90 (modified) (1 diff)
-
LBC/mppini.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/DYN/dynspg_ts.F90
r14835 r14899 522 522 !-- ssh = ssh - delta_t' * [ frc + div( flux ) ] --! 523 523 !-------------------------------------------------------------------------! 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 530 535 ! 531 536 ! Duplicate sea level across open boundaries (this is only cosmetic if linssh=T) … … 836 841 CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) ) ! Barotropic V Velocity 837 842 ! 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 838 852 END SUBROUTINE dyn_spg_ts 839 853 840 854 855 841 856 SUBROUTINE ts_wgt( ll_av, ll_fw, jpit, zwgt1, zwgt2) 842 857 !!--------------------------------------------------------------------- -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_call_generic.h90
r14892 r14899 43 43 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 44 44 LOGICAL , OPTIONAL , INTENT(in ) :: ld4only ! if .T., do only 4-neighbour comm (ignore corners) 45 !!46 INTEGER :: kfld ! number of elements that will be attributed47 TYPE(PTR_4d_/**/PRECISION), DIMENSION(16) :: ptab_ptr ! pointer array48 CHARACTER(len=1) , DIMENSION(16) :: cdna_ptr ! nature of ptab_ptr grid-points49 REAL(PRECISION) , DIMENSION(16) :: psgn_ptr ! sign used across the north fold boundary50 45 interface 51 46 subroutine loop_fct(i0, i1, j0, j1, k0, k1, buf) … … 55 50 end interface 56 51 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 57 58 !!--------------------------------------------------------------------- 58 59 ! … … 83 84 IF( ln_tspers ) THEN 84 85 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 ) 87 88 ELSE 88 89 SELECT CASE (nn_comm) … … 97 98 END SELECT 98 99 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 ) 101 102 ELSE ! No persistent call outside time-splitting 102 103 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 144 144 ! 145 145 ! Allocate local temporary arrays to be sent/received. 146 iszS = COUNT( llsend )147 iszR = COUNT( llrecv )148 146 iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf 149 147 ishtS(1) = 0 -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbc_lnk_oldpt2pt_generic.h90
r14872 r14899 252 252 END DO ; END DO ; END DO ; END DO ; END DO 253 253 #if ! defined key_mpi_off 254 IF( ln_timing ) CALL tic_tac(.TRUE.)254 !IF( ln_timing ) CALL tic_tac(.TRUE.) 255 255 ! non-blocking send of the west/east side using local buffer 256 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.)257 !IF( ln_timing ) CALL tic_tac(.FALSE.) 258 258 #endif 259 259 ENDIF … … 267 267 CASE ( jpfillmpi ) ! fill with data received by MPI 268 268 #if ! defined key_mpi_off 269 IF( ln_timing ) CALL tic_tac(.TRUE.)269 !IF( ln_timing ) CALL tic_tac(.TRUE.) 270 270 ! ! blocking receive of the west/east halo in local temporary arrays 271 271 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.) 273 273 #endif 274 274 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 2 2 #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 ) 4 4 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 11 6 TYPE(PTR_4d_/**/PRECISION), DIMENSION(:), INTENT(inout) :: ptab ! pointer of arrays on which apply the b.c. 12 7 CHARACTER(len=1), DIMENSION(:), INTENT(in ) :: cd_nat ! nature of array grid-points … … 18 13 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 19 14 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 20 22 ! 21 23 INTEGER :: ji, jj, jk, jl, jf, jn ! dummy loop indices … … 56 58 ! take care of optional parameters 57 59 ! 58 ihls = nn_hls ! default definition60 ihls = nn_hls ! default definition 59 61 IF( PRESENT( khls ) ) ihls = khls 60 62 IF( ihls > n_hlsmax ) THEN 61 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax63 WRITE(ctmp1,*) TRIM(cdname), ' is calling lbc_lnk with khls > n_hlsmax : ', khls, '>', n_hlsmax 62 64 CALL ctl_stop( 'STOP', ctmp1 ) 63 65 ENDIF … … 81 83 llsend(1:4) = lsend(1:4) ; llrecv(1:4) = lrecv(1:4) 82 84 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' 84 86 CALL ctl_stop( 'STOP', ctmp1 ) 85 87 ELSE ! default neighbours … … 92 94 ! define ifill: which method should be used to fill each parts (sides+corners) of the halos 93 95 ! default definition 94 DO jn = 1, 496 DO jn = 1, 8 95 97 IF( llrecv(jn) ) THEN ; ifill(jn) = jpfillmpi ! with an mpi communication 96 98 ELSEIF( l_SelfPerio(jn) ) THEN ; ifill(jn) = jpfillperio ! with self-periodicity … … 104 106 ENDIF 105 107 END DO 106 !107 108 ! north fold treatment 108 109 ll_IdoNFold = l_IdoNFold .AND. ifill(jpno) /= jpfillnothing … … 111 112 ifill( (/jpno/) ) = jpfillnothing ! we do north fold -> do nothing for northern halo 112 113 ENDIF 113 114 114 115 ! We first define the localization and size of the parts of the array that will be sent (s), received (r) 115 116 ! or used for periodocity (p). The localization is defined as "the bottom left corner - 1" in i and j directions. … … 129 130 ! 130 131 iwewe(:) = (/ jpwe,jpea,jpwe,jpea /) ; issnn(:) = (/ jpso,jpso,jpno,jpno /) 131 ! cdsides: west east south north ; corners: so-we, so-ea, no-we, no-ea132 isizei(1:4) = (/ ihls, ihls, ipi, ipi/) ; isizei(5:8) = ihls ! i- count133 isizej(1:4) = (/ ipj, ipj, ihls, ihls /) ; isizej(5:8) = ihls ! j- count134 ishtSi(1:4) = (/ ip1i, im1i, ip 0i, ip0i /) ; ishtSi(5:8) = ishtSi( iwewe ) ! i- shift send data135 ishtSj(1:4) = (/ ip 0j, ip0j, ip1j, im1j /) ; ishtSj(5:8) = ishtSj( issnn ) ! j- shift send data136 ishtRi(1:4) = (/ ip0i, im0i, ip 0i, ip0i /) ; ishtRi(5:8) = ishtRi( iwewe ) ! i- shift received data location137 ishtRj(1:4) = (/ ip 0j, ip0j, ip0j, im0j /) ; ishtRj(5:8) = ishtRj( issnn ) ! j- shift received data location138 ishtPi(1:4) = (/ im1i, ip1i, ip 0i, ip0i /) ; ishtPi(5:8) = ishtPi( iwewe ) ! i- shift data used for periodicity139 ishtPj(1:4) = (/ ip 0j, ip0j, im1j, ip1j /) ; ishtPj(5:8) = ishtPj( issnn ) ! j- shift data used for periodicity132 ! 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 140 141 ! 141 142 ! -------------------------------- ! … … 148 149 iRtag(jpsw) = iStag(jpne) ; iRtag(jpse) = iStag(jpnw) ; iRtag(jpnw) = iStag(jpse) ; iRtag(jpne) = iStag(jpsw) 149 150 ! 151 ! Allocate local temporary arrays to be sent/received. 150 152 iszall(:) = isizei(:) * isizej(:) * ipk * ipl * ipf 151 153 ishtS(1) = 0 … … 157 159 ishtR(jn) = ishtR(jn-1) + iszall(jn-1) * COUNT( (/llrecv(jn-1)/) ) 158 160 END DO 159 161 160 162 ! Allocate buffer arrays to be sent/received if needed 161 163 iszS = SUM(iszall, mask = llsend) ! send buffer size … … 179 181 ! ------------------------------------------------------------- ! 180 182 ! 181 DO jn = 1, 4! TODO maybe to 8 for corners183 DO jn = 1, 8 ! TODO maybe to 8 for corners 182 184 #define BLOCK_IRECV 183 185 # include "lbc_lnk_pt2pt_async.h90" … … 198 200 ! ------------------------------------------------------------- ! 199 201 ! 200 DO jn = 1, 4202 DO jn = 1, 8 201 203 #define BLOCK_ISEND 202 204 # include "lbc_lnk_pt2pt_async.h90" … … 209 211 ! ----------------------------------- ! 210 212 ! 211 DO jn = 1, 2213 DO jn = 1, 8 212 214 #define BLOCK_FILL 213 215 # include "lbc_lnk_pt2pt_async.h90" … … 233 235 ! ------------------------------------- ! 234 236 ! 235 DO jn = 3, 4236 #define BLOCK_FILL237 # include "lbc_lnk_pt2pt_async.h90"238 #undef BLOCK_FILL239 END DO237 ! DO jn = 3, 4 238 ! #define BLOCK_FILL 239 ! # include "lbc_lnk_pt2pt_async.h90" 240 ! #undef BLOCK_FILL 241 ! END DO 240 242 !! ! 241 243 !! ! ----------------------------------------------- ! … … 266 268 ENDIF 267 269 ! 268 END SUBROUTINE lbc_lnk_ pt2pt_/**/PRECISION270 END SUBROUTINE lbc_lnk_async_/**/PRECISION 269 271 #endif 270 272 … … 309 311 IF( ln_timing ) CALL tic_tac(.TRUE.) 310 312 ! ! waiting receive of the west/east halo in local temporary arrays 311 call MPI_WAIT(ire f(jn), MPI_STATUS_IGNORE, ier)313 call MPI_WAIT(ireq(jn), MPI_STATUS_IGNORE, ierr) 312 314 IF( ln_timing ) CALL tic_tac(.FALSE.) 313 315 #endif -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lbclnk.F90
r14891 r14899 54 54 MODULE PROCEDURE lbc_lnk_persistent_sp, lbc_lnk_persistent_dp 55 55 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 56 60 ! 57 61 INTERFACE lbc_lnk_icb -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/lib_mpp.F90
r14835 r14899 222 222 LOGICAL , PUBLIC :: lints = .FALSE. ! indicate if currently in time-splitting (for persistent calls) 223 223 LOGICAL , PUBLIC :: ln_tspers ! indicate if persistent call enabled in time-splitting 224 LOGICAL , PUBLIC :: ln_async ! indicate if asynchronous communications enabled 224 225 225 226 !! * Substitutions -
NEMO/branches/2021/dev_r14447_HPC-07_Irrmann_try_new_pt2pt/src/OCE/LBC/mppini.F90
r14835 r14899 145 145 & cn_ice, nn_ice_dta, & 146 146 & 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 148 148 !!---------------------------------------------------------------------- 149 149 !
Note: See TracChangeset
for help on using the changeset viewer.
