- Timestamp:
- 2019-11-22T18:44:17+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11470_HPC_12_mpi3/src/OCE/LBC/mpp_nc_generic.h90
r11940 r11955 183 183 ! --------------------------------------------------- ! 184 184 ! 185 ! 2.1 fill weastern halo 185 !!! Patch to solve MPI3 bug when we have only two processes columns 186 IF(jpni .eq. 2) THEN 187 ! --------------------- 188 ! 2.2 fill eastern halo 189 ! --------------------- 190 idx = 1 191 ishift = jpi - ihl ! fill halo from ji = jpi-ihl+1 to jpi 192 SELECT CASE ( ifill_ea ) 193 CASE ( jpfillnothing ) ! no filling 194 CASE ( jpfillmpi ) ! use data received by MPI 195 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 196 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx) ! jpi - ihl + 1 -> jpi 197 idx = idx + 1 198 END DO ; END DO ; END DO ; END DO ; END DO 199 CASE ( jpfillperio ) ! use east-weast periodicity 200 ishift2 = ihl 201 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 202 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 203 END DO ; END DO ; END DO ; END DO ; END DO 204 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 205 CASE ( jpfillcopy ) ! filling with inner domain values 206 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 207 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 208 END DO ; END DO ; END DO ; END DO ; END DO 209 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 210 CASE ( jpfillcst ) ! filling with constant value 211 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 212 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 213 END DO; END DO ; END DO ; END DO ; END DO 214 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 215 END SELECT 216 ! ---------------------- 217 ! 2.1 fill weastern halo 218 ! ---------------------- 219 SELECT CASE ( ifill_we ) 220 CASE ( jpfillnothing ) ! no filling 221 CASE ( jpfillmpi ) ! use data received by MPI 222 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 223 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) ! 1 -> ihl 224 idx = idx + 1 225 END DO; END DO ; END DO ; END DO ; END DO 226 CASE ( jpfillperio ) ! use east-weast periodicity 227 ishift2 = jpi - 2 * ihl 228 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 229 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 230 END DO; END DO ; END DO ; END DO ; END DO 231 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 232 CASE ( jpfillcopy ) ! filling with inner domain values 233 DO jf = 1, ipf ! number of arrays to be treated 234 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 235 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 236 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 237 END DO ; END DO ; END DO ; END DO 238 ENDIF 239 END DO 240 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 241 CASE ( jpfillcst ) ! filling with constant value 242 DO jf = 1, ipf ! number of arrays to be treated 243 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 244 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 245 ARRAY_IN(ji,jj,jk,jl,jf) = zland 246 END DO; END DO ; END DO ; END DO 247 ENDIF 248 END DO 249 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 250 END SELECT 251 252 ELSE 253 ! ---------------------- 254 ! 2.1 fill weastern halo 255 ! ---------------------- 256 idx = 1 257 SELECT CASE ( ifill_we ) 258 CASE ( jpfillnothing ) ! no filling 259 CASE ( jpfillmpi ) ! use data received by MPI 260 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 261 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) ! 1 -> ihl 262 idx = idx + 1 263 END DO; END DO ; END DO ; END DO ; END DO 264 CASE ( jpfillperio ) ! use east-weast periodicity 265 ishift2 = jpi - 2 * ihl 266 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 267 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 268 END DO; END DO ; END DO ; END DO ; END DO 269 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 270 CASE ( jpfillcopy ) ! filling with inner domain values 271 DO jf = 1, ipf ! number of arrays to be treated 272 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 273 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 274 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 275 END DO ; END DO ; END DO ; END DO 276 ENDIF 277 END DO 278 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 279 CASE ( jpfillcst ) ! filling with constant value 280 DO jf = 1, ipf ! number of arrays to be treated 281 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point 282 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 283 ARRAY_IN(ji,jj,jk,jl,jf) = zland 284 END DO; END DO ; END DO ; END DO 285 ENDIF 286 END DO 287 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 288 END SELECT 289 ! --------------------- 290 ! 2.2 fill eastern halo 291 ! --------------------- 292 ishift = jpi - ihl ! fill halo from ji = jpi-ihl+1 to jpi 293 SELECT CASE ( ifill_ea ) 294 CASE ( jpfillnothing ) ! no filling 295 CASE ( jpfillmpi ) ! use data received by MPI 296 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 297 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx) ! jpi - ihl + 1 -> jpi 298 idx = idx + 1 299 END DO ; END DO ; END DO ; END DO ; END DO 300 CASE ( jpfillperio ) ! use east-weast periodicity 301 ishift2 = ihl 302 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 303 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 304 END DO ; END DO ; END DO ; END DO ; END DO 305 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 306 CASE ( jpfillcopy ) ! filling with inner domain values 307 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 308 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 309 END DO ; END DO ; END DO ; END DO ; END DO 310 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 311 CASE ( jpfillcst ) ! filling with constant value 312 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl 313 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 314 END DO; END DO ; END DO ; END DO ; END DO 315 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf 316 END SELECT 317 END IF 186 318 ! ---------------------- 187 idx = 1188 SELECT CASE ( ifill_we )189 CASE ( jpfillnothing ) ! no filling190 CASE ( jpfillmpi ) ! use data received by MPI191 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl192 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) ! 1 -> ihl193 idx = idx + 1194 END DO; END DO ; END DO ; END DO ; END DO195 CASE ( jpfillperio ) ! use east-weast periodicity196 ishift2 = jpi - 2 * ihl197 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl198 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)199 END DO; END DO ; END DO ; END DO ; END DO200 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf201 CASE ( jpfillcopy ) ! filling with inner domain values202 DO jf = 1, ipf ! number of arrays to be treated203 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point204 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl205 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf)206 END DO ; END DO ; END DO ; END DO207 ENDIF208 END DO209 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf210 CASE ( jpfillcst ) ! filling with constant value211 DO jf = 1, ipf ! number of arrays to be treated212 IF( .NOT. NAT_IN(jf) == 'F' ) THEN ! do nothing for F point213 DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl214 ARRAY_IN(ji,jj,jk,jl,jf) = zland215 END DO; END DO ; END DO ; END DO216 ENDIF217 END DO218 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf219 END SELECT220 !221 ! 2.2 fill eastern halo222 ! ---------------------223 ishift = jpi - ihl ! fill halo from ji = jpi-ihl+1 to jpi224 SELECT CASE ( ifill_ea )225 CASE ( jpfillnothing ) ! no filling226 CASE ( jpfillmpi ) ! use data received by MPI227 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl228 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv(idx) ! jpi - ihl + 1 -> jpi229 idx = idx + 1230 END DO ; END DO ; END DO ; END DO ; END DO231 CASE ( jpfillperio ) ! use east-weast periodicity232 ishift2 = ihl233 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl234 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf)235 END DO ; END DO ; END DO ; END DO ; END DO236 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf237 CASE ( jpfillcopy ) ! filling with inner domain values238 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl239 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf)240 END DO ; END DO ; END DO ; END DO ; END DO241 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf242 CASE ( jpfillcst ) ! filling with constant value243 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = ihl + 1, jpj - ihl ; DO ji = 1, ihl244 ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland245 END DO; END DO ; END DO ; END DO ; END DO246 idx = idx + (jpj-2*ihl)*ihl*ipk*ipl*ipf247 END SELECT248 !249 319 ! 2.3 fill southern halo 250 320 ! ---------------------- … … 281 351 idx = idx + (jpi-2*ihl)*ihl*ipk*ipl*ipf 282 352 END SELECT 283 ! 353 ! ---------------------- 284 354 ! 2.4 fill northern halo 285 355 ! ----------------------
Note: See TracChangeset
for help on using the changeset viewer.
