Changeset 11262
- Timestamp:
- 2019-07-12T11:40:17+02:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/DYN/dynspg_ts.F90
r11261 r11262 691 691 ELSE 692 692 CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp ) 693 ELSE !* domain lateral boundary694 CALL lbc_lnk_multi( 'dynspg_ts', ua_e , 'U', -1._wp, va_e , 'V', -1._wp )695 !696 693 ENDIF 697 694 ! -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/lbc_lnk_multi_generic.h90
r11195 r11262 19 19 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 20 20 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 21 & , kfillmode, pfillval, lsend, lrecv )21 & , kfillmode, pfillval, lsend, lrecv, ihlcom ) 22 22 !!--------------------------------------------------------------------- 23 23 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine … … 31 31 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 32 32 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 33 INTEGER , OPTIONAL , INTENT(in ) :: ihlcom ! number of ranks and rows to be communicated 33 34 !! 34 35 INTEGER :: kfld ! number of elements that will be attributed … … 55 56 IF( PRESENT(psgn11) ) CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 56 57 ! 57 CALL lbc_lnk_ptr ( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )58 CALL lbc_lnk_ptr ( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 58 59 ! 59 60 END SUBROUTINE ROUTINE_MULTI -
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/LBC/mpp_lnk_generic.h90
r11195 r11262 46 46 47 47 #if defined MULTI 48 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv )48 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 49 49 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 50 50 #else 51 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , kfillmode, pfillval, lsend, lrecv )51 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , kfillmode, pfillval, lsend, lrecv, ihlcom ) 52 52 #endif 53 53 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied … … 55 55 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points 56 56 REAL(wp) , INTENT(in ) :: SGN_IN(:) ! sign used across the north fold boundary 57 INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant)58 REAL(wp), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries)57 INTEGER , OPTIONAL, INTENT(in ) :: kfillmode ! filling method for halo over land (default = constant) 58 REAL(wp), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 59 59 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 60 INTEGER ,OPTIONAL, INTENT(in ) :: ihlcom ! number of ranks and rows to be communicated 60 61 ! 61 62 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices … … 64 65 INTEGER :: ireq_we, ireq_ea, ireq_so, ireq_no ! mpi_request id 65 66 INTEGER :: ierr 66 INTEGER :: ifill_we, ifill_ea, ifill_so, ifill_no 67 INTEGER :: ifill_we, ifill_ea, ifill_so, ifill_no 68 INTEGER :: ihl ! number of ranks and rows to be communicated 67 69 REAL(wp) :: zland 68 70 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: istat ! for mpi_isend … … 81 83 ipl = L_SIZE(ptab) ! 4th - 82 84 ipf = F_SIZE(ptab) ! 5th - use in "multi" case (array of pointers) 85 ! 86 IF( PRESENT(ihlcom) ) THEN ; ihl = ihlcom 87 ELSE ; ihl = 1 88 END IF 83 89 ! 84 90 IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) … … 143 149 ! 144 150 ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 145 isize = nn_hls* jpj * ipk * ipl * ipf151 isize = ihl * jpj * ipk * ipl * ipf 146 152 ! 147 153 ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 148 IF( llsend_we ) ALLOCATE( zsnd_we( nn_hls,jpj,ipk,ipl,ipf) )149 IF( llsend_ea ) ALLOCATE( zsnd_ea( nn_hls,jpj,ipk,ipl,ipf) )150 IF( llrecv_we ) ALLOCATE( zrcv_we( nn_hls,jpj,ipk,ipl,ipf) )151 IF( llrecv_ea ) ALLOCATE( zrcv_ea( nn_hls,jpj,ipk,ipl,ipf) )154 IF( llsend_we ) ALLOCATE( zsnd_we(ihl,jpj,ipk,ipl,ipf) ) 155 IF( llsend_ea ) ALLOCATE( zsnd_ea(ihl,jpj,ipk,ipl,ipf) ) 156 IF( llrecv_we ) ALLOCATE( zrcv_we(ihl,jpj,ipk,ipl,ipf) ) 157 IF( llrecv_ea ) ALLOCATE( zrcv_ea(ihl,jpj,ipk,ipl,ipf) ) 152 158 ! 153 159 IF( llsend_we ) THEN ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 154 ishift = nn_hls155 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls156 zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! nn_hls + 1 -> 2*nn_hls160 ishift = ihl 161 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 162 zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! ihl + 1 -> 2*ihl 157 163 END DO ; END DO ; END DO ; END DO ; END DO 158 164 ENDIF 159 165 ! 160 166 IF(llsend_ea ) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 161 ishift = jpi - 2 * nn_hls162 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls163 zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! jpi - 2* nn_hls + 1 -> jpi - nn_hls167 ishift = jpi - 2 * ihl 168 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 169 zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! jpi - 2*ihl + 1 -> jpi - ihl 164 170 END DO ; END DO ; END DO ; END DO ; END DO 165 171 ENDIF … … 183 189 ! 2.1 fill weastern halo 184 190 ! ---------------------- 185 ! ishift = 0 ! fill halo from ji = 1 to nn_hls191 ! ishift = 0 ! fill halo from ji = 1 to ihl 186 192 SELECT CASE ( ifill_we ) 187 193 CASE ( jpfillnothing ) ! no filling 188 194 CASE ( jpfillmpi ) ! use data received by MPI 189 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls190 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> nn_hls195 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 196 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> ihl 191 197 END DO; END DO ; END DO ; END DO ; END DO 192 198 CASE ( jpfillperio ) ! use east-weast periodicity 193 ishift2 = jpi - 2 * nn_hls194 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls199 ishift2 = jpi - 2 * ihl 200 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 195 201 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 196 202 END DO; END DO ; END DO ; END DO ; END DO … … 198 204 DO jf = 1, ipf ! number of arrays to be treated 199 205 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 200 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls201 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN( nn_hls+1,jj,jk,jl,jf)206 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 207 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 202 208 END DO ; END DO ; END DO ; END DO 203 209 ENDIF … … 206 212 DO jf = 1, ipf ! number of arrays to be treated 207 213 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 208 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls214 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 209 215 ARRAY_IN(ji,jj,jk,jl,jf) = zland 210 216 END DO; END DO ; END DO ; END DO … … 215 221 ! 2.2 fill eastern halo 216 222 ! --------------------- 217 ishift = jpi - nn_hls ! fill halo from ji = jpi-nn_hls+1 to jpi223 ishift = jpi - ihl ! fill halo from ji = jpi-ihl+1 to jpi 218 224 SELECT CASE ( ifill_ea ) 219 225 CASE ( jpfillnothing ) ! no filling 220 226 CASE ( jpfillmpi ) ! use data received by MPI 221 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls222 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf) ! jpi - nn_hls+ 1 -> jpi227 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 228 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf) ! jpi - ihl + 1 -> jpi 223 229 END DO ; END DO ; END DO ; END DO ; END DO 224 230 CASE ( jpfillperio ) ! use east-weast periodicity 225 ishift2 = nn_hls226 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls231 ishift2 = ihl 232 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 227 233 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 228 234 END DO ; END DO ; END DO ; END DO ; END DO 229 235 CASE ( jpfillcopy ) ! filling with inner domain values 230 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls236 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 231 237 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 232 238 END DO ; END DO ; END DO ; END DO ; END DO 233 239 CASE ( jpfillcst ) ! filling with constant value 234 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls240 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, ihl 235 241 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 236 242 END DO; END DO ; END DO ; END DO ; END DO … … 258 264 ! ---------------------------------------------------- ! 259 265 ! 260 IF( llsend_so ) ALLOCATE( zsnd_so(jpi, nn_hls,ipk,ipl,ipf) )261 IF( llsend_no ) ALLOCATE( zsnd_no(jpi, nn_hls,ipk,ipl,ipf) )262 IF( llrecv_so ) ALLOCATE( zrcv_so(jpi, nn_hls,ipk,ipl,ipf) )263 IF( llrecv_no ) ALLOCATE( zrcv_no(jpi, nn_hls,ipk,ipl,ipf) )264 ! 265 isize = jpi * nn_hls* ipk * ipl * ipf266 IF( llsend_so ) ALLOCATE( zsnd_so(jpi,ihl,ipk,ipl,ipf) ) 267 IF( llsend_no ) ALLOCATE( zsnd_no(jpi,ihl,ipk,ipl,ipf) ) 268 IF( llrecv_so ) ALLOCATE( zrcv_so(jpi,ihl,ipk,ipl,ipf) ) 269 IF( llrecv_no ) ALLOCATE( zrcv_no(jpi,ihl,ipk,ipl,ipf) ) 270 ! 271 isize = jpi * ihl * ipk * ipl * ipf 266 272 267 273 ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 268 274 IF( llsend_so ) THEN ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 269 ishift = nn_hls270 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi271 zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! nn_hls+1 -> 2*nn_hls275 ishift = ihl 276 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 277 zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! ihl+1 -> 2*ihl 272 278 END DO ; END DO ; END DO ; END DO ; END DO 273 279 ENDIF 274 280 ! 275 281 IF( llsend_no ) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 276 ishift = jpj - 2 * nn_hls277 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi278 zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! jpj-2* nn_hls+1 -> jpj-nn_hls282 ishift = jpj - 2 * ihl 283 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 284 zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! jpj-2*ihl+1 -> jpj-ihl 279 285 END DO ; END DO ; END DO ; END DO ; END DO 280 286 ENDIF … … 297 303 ! 5.1 fill southern halo 298 304 ! ---------------------- 299 ! ishift = 0 ! fill halo from jj = 1 to nn_hls305 ! ishift = 0 ! fill halo from jj = 1 to ihl 300 306 SELECT CASE ( ifill_so ) 301 307 CASE ( jpfillnothing ) ! no filling 302 308 CASE ( jpfillmpi ) ! use data received by MPI 303 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi304 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> nn_hls309 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 310 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> ihl 305 311 END DO; END DO ; END DO ; END DO ; END DO 306 312 CASE ( jpfillperio ) ! use north-south periodicity 307 ishift2 = jpj - 2 * nn_hls308 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi313 ishift2 = jpj - 2 * ihl 314 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 309 315 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 310 316 END DO; END DO ; END DO ; END DO ; END DO … … 312 318 DO jf = 1, ipf ! number of arrays to be treated 313 319 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 314 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi315 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji, nn_hls+1,jk,jl,jf)320 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 321 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ihl+1,jk,jl,jf) 316 322 END DO ; END DO ; END DO ; END DO 317 323 ENDIF … … 320 326 DO jf = 1, ipf ! number of arrays to be treated 321 327 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 322 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi328 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 323 329 ARRAY_IN(ji,jj,jk,jl,jf) = zland 324 330 END DO; END DO ; END DO ; END DO … … 329 335 ! 5.2 fill northern halo 330 336 ! ---------------------- 331 ishift = jpj - nn_hls ! fill halo from jj = jpj-nn_hls+1 to jpj337 ishift = jpj - ihl ! fill halo from jj = jpj-ihl+1 to jpj 332 338 SELECT CASE ( ifill_no ) 333 339 CASE ( jpfillnothing ) ! no filling 334 340 CASE ( jpfillmpi ) ! use data received by MPI 335 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi336 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf) ! jpj- nn_hls+1 -> jpj341 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 342 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf) ! jpj-ihl+1 -> jpj 337 343 END DO ; END DO ; END DO ; END DO ; END DO 338 344 CASE ( jpfillperio ) ! use north-south periodicity 339 ishift2 = nn_hls340 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi345 ishift2 = ihl 346 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 341 347 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 342 348 END DO; END DO ; END DO ; END DO ; END DO 343 349 CASE ( jpfillcopy ) ! filling with inner domain values 344 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi350 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 345 351 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 346 352 END DO; END DO ; END DO ; END DO ; END DO 347 353 CASE ( jpfillcst ) ! filling with constant value 348 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls; DO ji = 1, jpi354 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, ihl ; DO ji = 1, jpi 349 355 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 350 356 END DO; END DO ; END DO ; END DO ; END DO
Note: See TracChangeset
for help on using the changeset viewer.