- Timestamp:
- 2013-11-18T12:57:11+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_LOCEAN_CMCC_INGV_2013/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r4152 r4230 86 86 USE sbctide, ONLY: lk_tide 87 87 USE crsini ! initialise grid coarsening utility 88 USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges 88 89 89 90 IMPLICIT NONE … … 755 756 !!====================================================================== 756 757 !! *** ROUTINE nemo_northcomms *** 757 !! nemo_northcomms : Setup for north fold exchanges with explicit peer to peer messaging 758 !! nemo_northcomms : Setup for north fold exchanges with explicit 759 !! point-to-point messaging 758 760 !!===================================================================== 759 761 !!---------------------------------------------------------------------- … … 762 764 !!---------------------------------------------------------------------- 763 765 !! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) 764 !!---------------------------------------------------------------------- 765 766 INTEGER :: ji, jj, jk, ij, jtyp ! dummy loop indices 767 INTEGER :: ijpj ! number of rows involved in north-fold exchange 768 INTEGER :: northcomms_alloc ! allocate return status 769 REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) :: znnbrs ! workspace 770 LOGICAL, ALLOCATABLE, DIMENSION ( : ) :: lrankset ! workspace 771 772 IF(lwp) WRITE(numout,*) 773 IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists' 774 IF(lwp) WRITE(numout,*) '~~~~~~~~~~' 775 776 !!---------------------------------------------------------------------- 777 ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc ) 778 ALLOCATE( lrankset(jpnij), stat = northcomms_alloc ) 779 IF( northcomms_alloc /= 0 ) THEN 780 WRITE(numout,cform_war) 781 WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays' 782 CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' ) 783 ENDIF 766 !! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 767 !!---------------------------------------------------------------------- 768 769 INTEGER :: sxM, dxM, sxT, dxT, jn 770 INTEGER :: njmppmax 771 772 njmppmax = MAXVAL( njmppt ) 773 774 !initializes the north-fold communication variables 775 isendto(:) = 0 784 776 nsndto = 0 785 isendto = -1 786 ijpj = 4 787 ! 788 ! This routine has been called because ln_nnogather has been set true ( nammpp ) 789 ! However, these first few exchanges have to use the mpi_allgather method to 790 ! establish the neighbour lists to use in subsequent peer to peer exchanges. 791 ! Consequently, set l_north_nogather to be false here and set it true only after 792 ! the lists have been established. 793 ! 794 l_north_nogather = .FALSE. 795 ! 796 ! Exchange and store ranks on northern rows 797 798 DO jtyp = 1,4 799 800 lrankset = .FALSE. 801 znnbrs = narea 802 SELECT CASE (jtyp) 803 CASE(1) 804 CALL lbc_lnk( znnbrs, 'T', 1. ) ! Type 1: T,W-points 805 CASE(2) 806 CALL lbc_lnk( znnbrs, 'U', 1. ) ! Type 2: U-point 807 CASE(3) 808 CALL lbc_lnk( znnbrs, 'V', 1. ) ! Type 3: V-point 809 CASE(4) 810 CALL lbc_lnk( znnbrs, 'F', 1. ) ! Type 4: F-point 811 END SELECT 812 813 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 814 DO jj = nlcj-ijpj+1, nlcj 815 ij = jj - nlcj + ijpj 816 DO ji = 1,jpi 817 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 818 & lrankset(INT(znnbrs(ji,jj))) = .true. 819 END DO 820 END DO 821 822 DO jj = 1,jpnij 823 IF ( lrankset(jj) ) THEN 824 nsndto(jtyp) = nsndto(jtyp) + 1 825 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 826 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 827 & ' jpmaxngh will need to be increased ') 828 ENDIF 829 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 830 ENDIF 831 END DO 832 ENDIF 833 834 END DO 835 836 ! 837 ! Type 5: I-point 838 ! 839 ! ICE point exchanges may involve some averaging. The neighbours list is 840 ! built up using two exchanges to ensure that the whole stencil is covered. 841 ! lrankset should not be reset between these 'J' and 'K' point exchanges 842 843 jtyp = 5 844 lrankset = .FALSE. 845 znnbrs = narea 846 CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point 847 848 IF ( njmppt(narea) .EQ. MAXVAL( njmppt ) ) THEN 849 DO jj = nlcj-ijpj+1, nlcj 850 ij = jj - nlcj + ijpj 851 DO ji = 1,jpi 852 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 853 & lrankset(INT(znnbrs(ji,jj))) = .true. 854 END DO 855 END DO 856 ENDIF 857 858 znnbrs = narea 859 CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point 860 861 IF ( njmppt(narea) .EQ. MAXVAL( njmppt )) THEN 862 DO jj = nlcj-ijpj+1, nlcj 863 ij = jj - nlcj + ijpj 864 DO ji = 1,jpi 865 IF ( INT(znnbrs(ji,jj)) .NE. 0 .AND. INT(znnbrs(ji,jj)) .NE. narea ) & 866 & lrankset( INT(znnbrs(ji,jj))) = .true. 867 END DO 868 END DO 869 870 DO jj = 1,jpnij 871 IF ( lrankset(jj) ) THEN 872 nsndto(jtyp) = nsndto(jtyp) + 1 873 IF ( nsndto(jtyp) .GT. jpmaxngh ) THEN 874 CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', & 875 & ' jpmaxngh will need to be increased ') 876 ENDIF 877 isendto(nsndto(jtyp),jtyp) = jj-1 ! narea converted to MPI rank 878 ENDIF 879 END DO 880 ! 881 ! For northern row areas, set l_north_nogather so that all subsequent exchanges 882 ! can use peer to peer communications at the north fold 883 ! 884 l_north_nogather = .TRUE. 885 ! 886 ENDIF 887 DEALLOCATE( znnbrs ) 888 DEALLOCATE( lrankset ) 889 777 778 !if I am a process in the north 779 IF ( njmpp == njmppmax ) THEN 780 !sxM is the first point (in the global domain) needed to compute the 781 !north-fold for the current process 782 sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1 783 !dxM is the last point (in the global domain) needed to compute the 784 !north-fold for the current process 785 dxM = jpiglo - nimppt(narea) + 2 786 787 !loop over the other north-fold processes to find the processes 788 !managing the points belonging to the sxT-dxT range 789 DO jn = jpnij - jpni +1, jpnij 790 IF ( njmppt(jn) == njmppmax ) THEN 791 !sxT is the first point (in the global domain) of the jn 792 !process 793 sxT = nimppt(jn) 794 !dxT is the last point (in the global domain) of the jn 795 !process 796 dxT = nimppt(jn) + nlcit(jn) - 1 797 IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 798 nsndto = nsndto + 1 799 isendto(nsndto) = jn 800 ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN 801 nsndto = nsndto + 1 802 isendto(nsndto) = jn 803 ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 804 nsndto = nsndto + 1 805 isendto(nsndto) = jn 806 END IF 807 END IF 808 END DO 809 ENDIF 810 l_north_nogather = .TRUE. 890 811 END SUBROUTINE nemo_northcomms 891 812 #else
Note: See TracChangeset
for help on using the changeset viewer.
