Changeset 12719 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90
- Timestamp:
- 2020-04-08T17:45:31+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90
r12586 r12719 51 51 SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn , kfillmode, pfillval, lsend, lrecv ) 52 52 #endif 53 ARRAY_TYPE( 1-nn_hls+1:,1-nn_hls+1:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied53 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied 54 54 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine 55 55 CHARACTER(len=1) , INTENT(in ) :: NAT_IN(:) ! nature of array grid-points … … 142 142 ! -------------------------------------------------- ! 143 143 ! 144 145 144 ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 146 isize = nn_hls * ( jpj + nn_hls - 1 )* ipk * ipl * ipf145 isize = nn_hls * jpj * ipk * ipl * ipf 147 146 ! 148 147 ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 149 IF( llsend_we ) ALLOCATE( zsnd_we(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )150 IF( llsend_ea ) ALLOCATE( zsnd_ea(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )151 IF( llrecv_we ) ALLOCATE( zrcv_we(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )152 IF( llrecv_ea ) ALLOCATE( zrcv_ea(nn_hls, 1-nn_hls+1:jpj,ipk,ipl,ipf) )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) ) 153 152 ! 154 153 IF( llsend_we ) THEN ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 155 ishift = 1156 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls154 ishift = nn_hls 155 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 157 156 zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! nn_hls + 1 -> 2*nn_hls 158 157 END DO ; END DO ; END DO ; END DO ; END DO 159 158 ENDIF 160 159 ! 161 IF( llsend_ea) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI162 ishift = jpi - 163 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls160 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_hls 162 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 164 163 zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf) ! jpi - 2*nn_hls + 1 -> jpi - nn_hls 165 164 END DO ; END DO ; END DO ; END DO ; END DO … … 169 168 ! 170 169 ! non-blocking send of the western/eastern side using local temporary arrays 171 IF( llsend_we ) CALL mppsend( 1, zsnd_we(1,1 -nn_hls+1,1,1,1), isize, nowe, ireq_we )172 IF( llsend_ea ) CALL mppsend( 2, zsnd_ea(1,1 -nn_hls+1,1,1,1), isize, noea, ireq_ea )170 IF( llsend_we ) CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 171 IF( llsend_ea ) CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 173 172 ! blocking receive of the western/eastern halo in local temporary arrays 174 IF( llrecv_we ) CALL mpprecv( 2, zrcv_we(1,1 -nn_hls+1,1,1,1), isize, nowe )175 IF( llrecv_ea ) CALL mpprecv( 1, zrcv_ea(1,1 -nn_hls+1,1,1,1), isize, noea )173 IF( llrecv_we ) CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 174 IF( llrecv_ea ) CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 176 175 ! 177 176 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 188 187 CASE ( jpfillnothing ) ! no filling 189 188 CASE ( jpfillmpi ) ! use data received by MPI 190 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls191 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> nn_hls189 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 190 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf) ! 1 -> nn_hls 192 191 END DO; END DO ; END DO ; END DO ; END DO 193 192 CASE ( jpfillperio ) ! use east-weast periodicity 194 193 ishift2 = jpi - 2 * nn_hls 195 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls196 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)194 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 195 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 197 196 END DO; END DO ; END DO ; END DO ; END DO 198 197 CASE ( jpfillcopy ) ! filling with inner domain values 199 198 DO jf = 1, ipf ! number of arrays to be treated 200 199 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 201 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls202 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(1+ji,jj,jk,jl,jf)200 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 201 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 203 202 END DO ; END DO ; END DO ; END DO 204 203 ENDIF … … 207 206 DO jf = 1, ipf ! number of arrays to be treated 208 207 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 209 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls210 ARRAY_IN(ji -nn_hls+1,jj,jk,jl,jf) = zland208 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 209 ARRAY_IN(ji,jj,jk,jl,jf) = zland 211 210 END DO; END DO ; END DO ; END DO 212 211 ENDIF … … 220 219 CASE ( jpfillnothing ) ! no filling 221 220 CASE ( jpfillmpi ) ! use data received by MPI 222 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls221 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 223 222 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf) ! jpi - nn_hls + 1 -> jpi 224 223 END DO ; END DO ; END DO ; END DO ; END DO 225 224 CASE ( jpfillperio ) ! use east-weast periodicity 226 ishift2 = 1227 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls225 ishift2 = nn_hls 226 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 228 227 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 229 228 END DO ; END DO ; END DO ; END DO ; END DO 230 229 CASE ( jpfillcopy ) ! filling with inner domain values 231 ishift2 = jpi - 2*nn_hls 232 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1-nn_hls+1, jpj ; DO ji = 1, nn_hls 233 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 230 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 231 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 234 232 END DO ; END DO ; END DO ; END DO ; END DO 235 233 CASE ( jpfillcst ) ! filling with constant value 236 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1 -nn_hls+1, jpj ; DO ji = 1, nn_hls234 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, jpj ; DO ji = 1, nn_hls 237 235 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 238 236 END DO; END DO ; END DO ; END DO ; END DO … … 260 258 ! ---------------------------------------------------- ! 261 259 ! 262 IF( llsend_so ) ALLOCATE( zsnd_so( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )263 IF( llsend_no ) ALLOCATE( zsnd_no( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )264 IF( llrecv_so ) ALLOCATE( zrcv_so( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )265 IF( llrecv_no ) ALLOCATE( zrcv_no( 1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) )266 ! 267 isize = ( jpi + nn_hls - 1 )* nn_hls * ipk * ipl * ipf260 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 * ipf 268 266 269 267 ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 270 268 IF( llsend_so ) THEN ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 271 ishift = 1272 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi269 ishift = nn_hls 270 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 273 271 zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! nn_hls+1 -> 2*nn_hls 274 272 END DO ; END DO ; END DO ; END DO ; END DO … … 277 275 IF( llsend_no ) THEN ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 278 276 ishift = jpj - 2 * nn_hls 279 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi277 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 280 278 zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf) ! jpj-2*nn_hls+1 -> jpj-nn_hls 281 279 END DO ; END DO ; END DO ; END DO ; END DO … … 285 283 ! 286 284 ! non-blocking send of the southern/northern side 287 IF( llsend_so ) CALL mppsend( 3, zsnd_so(1 -nn_hls+1,1,1,1,1), isize, noso, ireq_so )288 IF( llsend_no ) CALL mppsend( 4, zsnd_no(1 -nn_hls+1,1,1,1,1), isize, nono, ireq_no )285 IF( llsend_so ) CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 286 IF( llsend_no ) CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 289 287 ! blocking receive of the southern/northern halo 290 IF( llrecv_so ) CALL mpprecv( 4, zrcv_so(1 -nn_hls+1,1,1,1,1), isize, noso )291 IF( llrecv_no ) CALL mpprecv( 3, zrcv_no(1 -nn_hls+1,1,1,1,1), isize, nono )288 IF( llrecv_so ) CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 289 IF( llrecv_no ) CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 292 290 ! 293 291 IF( ln_timing ) CALL tic_tac(.FALSE.) … … 303 301 CASE ( jpfillnothing ) ! no filling 304 302 CASE ( jpfillmpi ) ! use data received by MPI 305 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi306 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> nn_hls303 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 304 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf) ! 1 -> nn_hls 307 305 END DO; END DO ; END DO ; END DO ; END DO 308 306 CASE ( jpfillperio ) ! use north-south periodicity 309 307 ishift2 = jpj - 2 * nn_hls 310 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi311 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf)308 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 309 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 312 310 END DO; END DO ; END DO ; END DO ; END DO 313 311 CASE ( jpfillcopy ) ! filling with inner domain values 314 312 DO jf = 1, ipf ! number of arrays to be treated 315 313 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 316 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi317 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,1+jj,jk,jl,jf)314 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 315 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 318 316 END DO ; END DO ; END DO ; END DO 319 317 ENDIF … … 322 320 DO jf = 1, ipf ! number of arrays to be treated 323 321 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 324 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi325 ARRAY_IN(ji,jj -nn_hls+1,jk,jl,jf) = zland322 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 323 ARRAY_IN(ji,jj,jk,jl,jf) = zland 326 324 END DO; END DO ; END DO ; END DO 327 325 ENDIF … … 335 333 CASE ( jpfillnothing ) ! no filling 336 334 CASE ( jpfillmpi ) ! use data received by MPI 337 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi335 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 338 336 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf) ! jpj-nn_hls+1 -> jpj 339 337 END DO ; END DO ; END DO ; END DO ; END DO 340 338 CASE ( jpfillperio ) ! use north-south periodicity 341 ishift2 = 1342 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi339 ishift2 = nn_hls 340 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 343 341 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 344 342 END DO; END DO ; END DO ; END DO ; END DO 345 343 CASE ( jpfillcopy ) ! filling with inner domain values 346 ishift2 = jpj - 2*nn_hls 347 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1-nn_hls+1, jpi 348 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 344 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 345 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 349 346 END DO; END DO ; END DO ; END DO ; END DO 350 347 CASE ( jpfillcst ) ! filling with constant value 351 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1 -nn_hls+1, jpi348 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, jpi 352 349 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 353 350 END DO; END DO ; END DO ; END DO ; END DO
Note: See TracChangeset
for help on using the changeset viewer.
