Changeset 4232
- Timestamp:
- 2013-11-18T13:11:55+01:00 (10 years ago)
- Location:
- branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO
- Files:
-
- 2 edited
-
OPA_SRC/LBC/lib_mpp.F90 (modified) (1 diff)
-
SAS_SRC/nemogcm.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
r4230 r4232 2667 2667 END DO 2668 2668 ENDIF 2669 CALL mpp_lbc_nfd( ztabl, ztabr _3d, cd_type, psgn ) ! North fold boundary condition2669 CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn ) ! North fold boundary condition 2670 2670 ! 2671 2671 DO jk = 1, jpk -
branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90
r4166 r4232 54 54 #endif 55 55 USE sbcssm 56 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 56 57 57 58 IMPLICIT NONE … … 558 559 !!====================================================================== 559 560 !! *** ROUTINE nemo_northcomms *** 560 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 561 !! nemo_northcomms : Setup for north fold exchanges with explicit 562 !! point-to-point messaging 561 563 !!===================================================================== 562 564 !!---------------------------------------------------------------------- 563 !! 565 !! 564 566 !! ** Purpose : Initialization of the northern neighbours lists. 565 567 !!---------------------------------------------------------------------- 566 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 567 !!---------------------------------------------------------------------- 568 569 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 570 INTEGER :: ijpj ! number of rows involved in north-fold exchange 571 INTEGER :: northcomms_alloc ! allocate return status 572 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 573 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 574 575 IF(lwp) WRITE(numout,*) 576 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 577 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 578 579 !!---------------------------------------------------------------------- 580 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 581 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 582 IF( northcomms_alloc /= 0 ) THEN 583 WRITE(numout,cform_war) 584 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 585 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 586 ENDIF 568 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 569 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 570 !!---------------------------------------------------------------------- 571 572 INTEGER :: sxM, dxM, sxT, dxT, jn 573 INTEGER :: njmppmax 574 575 njmppmax = MAXVAL( njmppt ) 576 577 !initializes the north-fold communication variables 578 isendto(:) = 0 587 579 nsndto = 0 588 isendto = -1 589 ijpj = 4 590 ! 591 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 592 ! However, these first few exchanges have to use the mpi_allgather method to 593 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 594 ! Consequently, set l_north_nogather to be false here and set it true only after 595 ! the lists have been established. 596 ! 597 l_north_nogather = .FALSE. 598 ! 599 ! Exchange and store ranks on northern rows 600 601 DO jtyp = 1,4 602 603 lrankset = .FALSE. 604 znnbrs = narea 605 SELECT CASE (jtyp) 606 CASE(1) 607 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 608 CASE(2) 609 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 610 CASE(3) 611 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 612 CASE(4) 613 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 614 END SELECT 615 616 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 617 DO jj = nlcj-ijpj+1, nlcj 618 ij = jj - nlcj + ijpj 619 DO ji = 1,jpi 620 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 621 & lrankset(INT(znnbrs(ji,jj))) = .true. 622 END DO 623 END DO 624 625 DO jj = 1,jpnij 626 IF ( lrankset(jj) ) THEN 627 nsndto(jtyp) = nsndto(jtyp) + 1 628 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 629 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 630 & ' jpmaxngh will need to be increased ') 631 ENDIF 632 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 633 ENDIF 634 END DO 635 ENDIF 636 637 END DO 638 639 ! 640 ! Type 5: I-point 641 ! 642 ! ICE point exchanges may involve some averaging. The neighbours list is 643 ! built up using two exchanges to ensure that the whole stencil is covered. 644 ! lrankset should not be reset between these 'J' and 'K' point exchanges 645 646 jtyp = 5 647 lrankset = .FALSE. 648 znnbrs = narea 649 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 650 651 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 652 DO jj = nlcj-ijpj+1, nlcj 653 ij = jj - nlcj + ijpj 654 DO ji = 1,jpi 655 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 656 & lrankset(INT(znnbrs(ji,jj))) = .true. 657 END DO 658 END DO 659 ENDIF 660 661 znnbrs = narea 662 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 663 664 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 665 DO jj = nlcj-ijpj+1, nlcj 666 ij = jj - nlcj + ijpj 667 DO ji = 1,jpi 668 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 669 & lrankset( INT(znnbrs(ji,jj))) = .true. 670 END DO 671 END DO 672 673 DO jj = 1,jpnij 674 IF ( lrankset(jj) ) THEN 675 nsndto(jtyp) = nsndto(jtyp) + 1 676 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 677 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 678 & ' jpmaxngh will need to be increased ') 679 ENDIF 680 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 681 ENDIF 682 END DO 683 ! 684 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 685 ! can use peer to peer communications at the north fold 686 ! 687 l_north_nogather = .TRUE. 688 ! 689 ENDIF 690 DEALLOCATE( znnbrs ) 691 DEALLOCATE( lrankset ) 692 580 581 !if I am a process in the north 582 IF ( njmpp == njmppmax ) THEN 583 !sxM is the first point (in the global domain) needed to compute the 584 !north-fold for the current process 585 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 586 !dxM is the last point (in the global domain) needed to compute the 587 !north-fold for the current process 588 dxM = jpiglo - nimppt(narea) + 2 589 590 !loop over the other north-fold processes to find the processes 591 !managing the points belonging to the sxT-dxT range 592 DO jn = jpnij - jpni +1, jpnij 593 IF ( njmppt(jn) == njmppmax ) THEN 594 !sxT is the first point (in the global domain) of the jn 595 !process 596 sxT = nimppt(jn) 597 !dxT is the last point (in the global domain) of the jn 598 !process 599 dxT = nimppt(jn) + nlcit(jn) - 1 600 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 601 nsndto = nsndto + 1 602 isendto(nsndto) = jn 603 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 604 nsndto = nsndto + 1 605 isendto(nsndto) = jn 606 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 607 nsndto = nsndto + 1 608 isendto(nsndto) = jn 609 END IF 610 END IF 611 END DO 612 ENDIF 613 l_north_nogather = .TRUE. 693 614 END SUBROUTINE nemo_northcomms 615 694 616 #else 695 617 SUBROUTINE nemo_northcomms ! Dummy routine
Note: See TracChangeset
for help on using the changeset viewer.
