Changeset 1926 for branches/DEV_1879_mpp_sca/NEMO/OPA_SRC/opa.F90
- Timestamp:
- 2010-06-10T13:06:13+02:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_1879_mpp_sca/NEMO/OPA_SRC/opa.F90
r1793 r1926 257 257 ENDIF 258 258 !!gm c1d end 259 260 CALL opa_northcomms ! Initialise the northfold neighbour lists (must be done after the masks are defined) 259 261 260 262 IF( ln_ctl ) CALL prt_ctl_init ! Print control … … 407 409 END SUBROUTINE opa_closefile 408 410 411 SUBROUTINE opa_northcomms 412 !!====================================================================== 413 !! *** ROUTINE opa_northcomms *** 414 !! opa_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 415 !!===================================================================== 416 !!---------------------------------------------------------------------- 417 !! 418 !! ** Purpose : Initialization of the northern neighbours lists. 419 !!---------------------------------------------------------------------- 420 421 INTEGER :: ji, jj, jk, ij ! dummy loop indices 422 INTEGER :: ijpj ! ??? 423 INTEGER, DIMENSION (jpi,4,4) :: ifoldnbrs 424 REAL(wp), DIMENSION (jpi,jpj) :: znnbrs ! workspace 425 LOGICAL, DIMENSION (jpnij) :: lrankset ! workspace 426 427 IF(lwp) WRITE(numout,*) 428 IF(lwp) WRITE(numout,*) 'opa_northcomms : Initialization of the northern neighbours lists' 429 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 430 431 !!---------------------------------------------------------------------- 432 nsndto = 0 433 isendto = -1 434 ijpj = 4 435 ! 436 ! Exchange and store ranks on northern rows 437 438 lrankset = .FALSE. 439 znnbrs = narea * tmask(:,:,1) 440 CALL lbc_lnk( znnbrs, 'T', 1. ) 441 442 IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 443 do jj = nlcj-ijpj+1, nlcj 444 ij = jj - nlcj + ijpj 445 ifoldnbrs(:,ij,1) = int(znnbrs(:,jj)) 446 do ji = 1,jpi 447 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 448 & lrankset(int(znnbrs(ji,jj))) = .true. 449 end do 450 end do 451 452 do jj = 1,jpnij 453 IF (lrankset(jj)) THEN 454 nsndto(1) = nsndto(1) + 1 455 IF(nsndto(1) .gt. jpmaxngh ) THEN 456 CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 457 & ' jpmaxngh will need to be increased ') 458 ENDIF 459 isendto(nsndto(1),1) = jj-1 ! narea converted to MPI rank 460 ENDIF 461 end do 462 ENDIF 463 464 lrankset = .FALSE. 465 znnbrs = narea * umask(:,:,1) 466 CALL lbc_lnk( znnbrs, 'U', 1. ) 467 468 IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 469 do jj = nlcj-ijpj+1, nlcj 470 ij = jj - nlcj + ijpj 471 ifoldnbrs(:,ij,2) = int(znnbrs(:,jj)) 472 do ji = 1,jpi 473 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 474 & lrankset(int(znnbrs(ji,jj))) = .true. 475 end do 476 end do 477 478 do jj = 1,jpnij 479 IF (lrankset(jj)) THEN 480 nsndto(2) = nsndto(2) + 1 481 IF(nsndto(2) .gt. jpmaxngh ) THEN 482 CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 483 & ' jpmaxngh will need to be increased ') 484 ENDIF 485 isendto(nsndto(2),2) = jj-1 ! narea converted to MPI rank 486 ENDIF 487 end do 488 ENDIF 489 490 lrankset = .FALSE. 491 znnbrs = narea * vmask(:,:,1) 492 CALL lbc_lnk( znnbrs, 'V', 1. ) 493 494 IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 495 do jj = nlcj-ijpj+1, nlcj 496 ij = jj - nlcj + ijpj 497 ifoldnbrs(:,ij,3) = int(znnbrs(:,jj)) 498 do ji = 1,jpi 499 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 500 & lrankset(int(znnbrs(ji,jj))) = .true. 501 end do 502 end do 503 504 do jj = 1,jpnij 505 IF (lrankset(jj)) THEN 506 nsndto(3) = nsndto(3) + 1 507 IF(nsndto(3) .gt. jpmaxngh ) THEN 508 CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 509 & ' jpmaxngh will need to be increased ') 510 ENDIF 511 isendto(nsndto(3),3) = jj-1 ! narea converted to MPI rank 512 ENDIF 513 end do 514 ENDIF 515 516 lrankset = .FALSE. 517 znnbrs = narea * fmask(:,:,1) 518 ! 519 ! filter top rows to counter any strong slip conditions 520 ! 521 do jj = nlcj-ijpj+1, nlcj 522 do ji = 1,jpi 523 znnbrs(ji,jj) = narea * MIN(1.0,fmask(ji,jj,1)) 524 end do 525 enddo 526 CALL lbc_lnk( znnbrs, 'F', 1. ) 527 528 IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 529 do jj = nlcj-ijpj+1, nlcj 530 ij = jj - nlcj + ijpj 531 ifoldnbrs(:,ij,4) = int(znnbrs(:,jj)) 532 do ji = 1,jpi 533 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 534 & lrankset(int(znnbrs(ji,jj))) = .true. 535 end do 536 end do 537 538 do jj = 1,jpnij 539 IF (lrankset(jj)) THEN 540 nsndto(4) = nsndto(4) + 1 541 IF(nsndto(4) .gt. jpmaxngh ) THEN 542 CALL ctl_stop( ' Too many neighbours in opa_northcomms ', & 543 & ' jpmaxngh will need to be increased ') 544 ENDIF 545 isendto(nsndto(4),4) = jj-1 ! narea converted to MPI rank 546 ENDIF 547 end do 548 549 lnorth_nogather = .TRUE. 550 ENDIF 551 552 END SUBROUTINE opa_northcomms 409 553 !!====================================================================== 410 554 END MODULE opa
Note: See TracChangeset
for help on using the changeset viewer.