- Timestamp:
- 2011-10-07T18:26:05+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r2883 r2899 652 652 isendto = -1 653 653 ijpj = 4 654 !655 ! This routine has been called because ln_nnogather has been set true ( nammpp )656 ! However, these first few exchanges have to use the mpi_allgather method to657 ! establish the neighbour lists to use in subsequent peer to peer exchanges.658 ! Consequently, set l_north_nogather to be false here and set it true only after659 ! the lists have been established.660 !654 ! 655 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 656 ! However, these first few exchanges have to use the mpi_allgather method to 657 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 658 ! Consequently, set l_north_nogather to be false here and set it true only after 659 ! the lists have been established. 660 ! 661 661 l_north_nogather = .FALSE. 662 662 ! 663 ! Exchange and store ranks on northern rows 664 665 DO jtyp = 1,4 666 667 lrankset = .FALSE. 668 znnbrs = narea 669 SELECT CASE (jtyp) 670 CASE(1) 671 ! 672 ! Type 1: T,W-points 673 ! 674 CALL lbc_lnk( znnbrs, 'T', 1. ) 675 CASE(2) 676 ! 677 ! Type 2: U-point 678 ! 679 CALL lbc_lnk( znnbrs, 'U', 1. ) 680 CASE(3) 681 ! 682 ! Type 3: V-point 683 ! 684 CALL lbc_lnk( znnbrs, 'V', 1. ) 685 CASE(4) 686 ! 687 ! Type 5: F-point 688 ! 689 CALL lbc_lnk( znnbrs, 'F', 1. ) 690 END SELECT 691 692 IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN 693 do jj = nlcj-ijpj+1, nlcj 694 ij = jj - nlcj + ijpj 695 do ji = 1,jpi 696 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) & 697 & lrankset(int(znnbrs(ji,jj))) = .true. 698 end do 699 end do 700 701 do jj = 1,jpnij 702 IF (lrankset(jj)) THEN 703 nsndto(jtyp) = nsndto(jtyp) + 1 704 IF(nsndto(jtyp) .gt. jpmaxngh ) THEN 705 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 706 & ' jpmaxngh will need to be increased ') 707 ENDIF 708 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 709 ENDIF 710 end do 711 ENDIF 712 713 END DO 714 715 ! 716 ! Type 5: I-point 717 ! 718 ! ICE point exchanges may involve some averaging. The neighbours list is 719 ! built up using two exchanges to ensure that the whole stencil is covered. 720 ! lrankset should not be reset between these 'J' and 'K' point exchanges 663 ! Exchange and store ranks on northern rows 664 665 DO jtyp = 1,4 666 667 lrankset = .FALSE. 668 znnbrs = narea 669 SELECT CASE (jtyp) 670 CASE(1) 671 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 672 CASE(2) 673 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 674 CASE(3) 675 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 676 CASE(4) 677 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 678 END SELECT 679 680 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 681 DO jj = nlcj-ijpj+1, nlcj 682 ij = jj - nlcj + ijpj 683 DO ji = 1,jpi 684 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 685 & lrankset(INT(znnbrs(ji,jj))) = .true. 686 END DO 687 END DO 688 689 DO jj = 1,jpnij 690 IF ( lrankset(jj) ) THEN 691 nsndto(jtyp) = nsndto(jtyp) + 1 692 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 693 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 694 & ' jpmaxngh will need to be increased ') 695 ENDIF 696 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 697 ENDIF 698 END DO 699 ENDIF 700 701 END DO 702 703 ! 704 ! Type 5: I-point 705 ! 706 ! ICE point exchanges may involve some averaging. The neighbours list is 707 ! built up using two exchanges to ensure that the whole stencil is covered. 708 ! lrankset should not be reset between these 'J' and 'K' point exchanges 721 709 722 710 jtyp = 5 … … 725 713 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 726 714 727 IF ( njmppt(narea) . eq. MAXVAL( njmppt )) THEN728 dojj = nlcj-ijpj+1, nlcj729 ij = jj - nlcj + ijpj730 doji = 1,jpi731 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) &732 & lrankset(int(znnbrs(ji,jj))) = .true.733 end do734 end do715 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 716 DO jj = nlcj-ijpj+1, nlcj 717 ij = jj - nlcj + ijpj 718 DO ji = 1,jpi 719 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 720 & lrankset(INT(znnbrs(ji,jj))) = .true. 721 END DO 722 END DO 735 723 ENDIF 736 724 … … 738 726 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 739 727 740 IF ( njmppt(narea) . eq. MAXVAL( njmppt )) THEN741 dojj = nlcj-ijpj+1, nlcj742 ij = jj - nlcj + ijpj743 doji = 1,jpi744 if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) &745 & lrankset(int(znnbrs(ji,jj))) = .true.746 end do747 end do748 749 dojj = 1,jpnij750 IF (lrankset(jj)) THEN751 nsndto(jtyp) = nsndto(jtyp) + 1752 IF(nsndto(jtyp) .gt. jpmaxngh ) THEN753 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &754 &' jpmaxngh will need to be increased ')755 ENDIF756 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank757 ENDIF758 end do759 !760 ! For northern row areas, set l_north_nogather so that all subsequent exchanges can use 761 !peer to peer communications at the north fold762 !763 l_north_nogather = .TRUE.764 !728 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 729 DO jj = nlcj-ijpj+1, nlcj 730 ij = jj - nlcj + ijpj 731 DO ji = 1,jpi 732 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 733 & lrankset( INT(znnbrs(ji,jj))) = .true. 734 END DO 735 END DO 736 737 DO jj = 1,jpnij 738 IF ( lrankset(jj) ) THEN 739 nsndto(jtyp) = nsndto(jtyp) + 1 740 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 741 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 742 & ' jpmaxngh will need to be increased ') 743 ENDIF 744 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 745 ENDIF 746 END DO 747 ! 748 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 749 ! can use peer to peer communications at the north fold 750 ! 751 l_north_nogather = .TRUE. 752 ! 765 753 ENDIF 766 754 DEALLOCATE( znnbrs )
Note: See TracChangeset
for help on using the changeset viewer.
