Changeset 2882 for branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

Timestamp:

2011-09-30T17:57:57+02:00 (13 years ago)

Author:

acc

Message:

Branch 2011/dev_r2855_NOCS_mppsca. Code to avoid the use of MPI_ALLGATHER at the north fold. Prace investigations suggest this can improve scalability for large domain decompositions. This is a completion and replacement of work started on branch DEV_1879_mpp_sca. See #679

File:

• branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 (modified) (2 diffs)

branches/2011/dev_r2855_NOCS_mppsca/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

@@ -291 +291 @@
                             CALL     dom_cfg    ! Domain configuration
                             CALL     dom_init   ! Domain
+
+      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
 
       IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
@@ -617 +619 @@
    END SUBROUTINE factorise
 
+   SUBROUTINE nemo_northcomms
+      !!======================================================================
+      !!                     ***  ROUTINE  nemo_northcomms  ***
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging
+      !!=====================================================================
+      !!----------------------------------------------------------------------
+      !! 
+      !! ** Purpose :   Initialization of the northern neighbours lists.
+      !!----------------------------------------------------------------------
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE) 
+      !!----------------------------------------------------------------------
+
+      INTEGER ::   ji, jj, jk, ij, jtyp    ! dummy loop indices
+      INTEGER ::   ijpj                    ! number of rows involved in north-fold exchange
+      INTEGER ::   northcomms_alloc        ! allocate return status
+      REAL(wp), ALLOCATABLE, DIMENSION ( :,: ) ::   znnbrs     ! workspace
+      LOGICAL,  ALLOCATABLE, DIMENSION ( : )   ::   lrankset   ! workspace
+
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'nemo_northcomms : Initialization of the northern neighbours lists'
+      IF(lwp) WRITE(numout,*) '~~~~~~~~~~'
+
+      !!----------------------------------------------------------------------
+      ALLOCATE( znnbrs(jpi,jpj), stat = northcomms_alloc )
+      ALLOCATE( lrankset(jpnij), stat = northcomms_alloc )
+      IF( northcomms_alloc /= 0 ) THEN
+         WRITE(numout,cform_war)
+         WRITE(numout,*) 'northcomms_alloc : failed to allocate arrays'
+         CALL ctl_stop( 'STOP', 'nemo_northcomms : unable to allocate temporary arrays' )
+      ENDIF
+      nsndto = 0
+      isendto = -1
+      ijpj   = 4
+!
+! This routine has been called because ln_nnogather has been set true ( nammpp )
+! However, these first few exchanges have to use the mpi_allgather method to
+! establish the neighbour lists to use in subsequent peer to peer exchanges.
+! Consequently, set l_north_nogather to be false here and set it true only after
+! the lists have been established.
+!
+      l_north_nogather = .FALSE.
+      !
+! Exchange and store ranks on northern rows
+        WRITE(numout,*) narea, njmppt(narea) , MAXVAL( njmppt ) ; FLUSH(numout)
+
+     DO jtyp = 1,4
+
+        lrankset = .FALSE.
+        znnbrs = narea
+        SELECT CASE (jtyp)
+        CASE(1)
+           !
+           ! Type 1: T,W-points
+           !
+           CALL lbc_lnk( znnbrs, 'T', 1. )
+        CASE(2)
+           !
+           ! Type 2: U-point
+           !
+           CALL lbc_lnk( znnbrs, 'U', 1. )
+        CASE(3)
+           !
+           ! Type 3: V-point
+           !
+           CALL lbc_lnk( znnbrs, 'V', 1. )
+        CASE(4)
+           !
+           ! Type 5: F-point
+           !
+           CALL lbc_lnk( znnbrs, 'F', 1. )
+        END SELECT
+
+        IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN
+          do jj = nlcj-ijpj+1, nlcj
+           ij = jj - nlcj + ijpj
+           do ji = 1,jpi
+            if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) &
+         &         lrankset(int(znnbrs(ji,jj))) = .true.
+           end do
+          end do
+
+          do jj = 1,jpnij
+           IF (lrankset(jj)) THEN
+            nsndto(jtyp) = nsndto(jtyp) + 1
+            IF(nsndto(jtyp) .gt. jpmaxngh ) THEN
+             CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+           &                ' jpmaxngh will need to be increased ')
+            ENDIF
+            isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+           ENDIF
+          end do
+        ENDIF
+
+     END DO
+
+!
+! Type 5: I-point
+!
+! ICE point exchanges may involve some averaging. The neighbours list is
+! built up using two exchanges to ensure that the whole stencil is covered.
+! lrankset should not be reset between these 'J' and 'K' point exchanges
+
+      jtyp = 5
+      lrankset = .FALSE.
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'J', 1. ) ! first ice U-V point
+
+      IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN
+        do jj = nlcj-ijpj+1, nlcj
+         ij = jj - nlcj + ijpj
+         do ji = 1,jpi
+          if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) &
+         &       lrankset(int(znnbrs(ji,jj))) = .true.
+         end do
+        end do
+      ENDIF
+
+      znnbrs = narea 
+      CALL lbc_lnk( znnbrs, 'K', 1. ) ! second ice U-V point
+
+      IF ( njmppt(narea) .eq. MAXVAL( njmppt )) THEN
+        do jj = nlcj-ijpj+1, nlcj
+         ij = jj - nlcj + ijpj
+         do ji = 1,jpi
+          if(int(znnbrs(ji,jj)) .ne. 0 .and. int(znnbrs(ji,jj)) .ne. narea ) &
+         &       lrankset(int(znnbrs(ji,jj))) = .true.
+         end do
+        end do
+
+        do jj = 1,jpnij
+         IF (lrankset(jj)) THEN
+          nsndto(jtyp) = nsndto(jtyp) + 1
+          IF(nsndto(jtyp) .gt. jpmaxngh ) THEN
+           CALL ctl_stop( ' Too many neighbours in nemo_northcomms ', &
+           &              ' jpmaxngh will need to be increased ')
+          ENDIF
+          isendto(nsndto(jtyp),jtyp) = jj-1   ! narea converted to MPI rank
+         ENDIF
+        end do
+!
+! For northern row areas, set l_north_nogather so that all subsequent exchanges can use
+! peer to peer communications at the north fold
+!
+        l_north_nogather = .TRUE.
+!
+        DO jtyp=1,5
+         write(numout,'(i4,a,2i4,a,8i5)') narea-1,' : ',jtyp,nsndto(jtyp),' ids ',(isendto(ij,jtyp),ij=1,nsndto(jtyp))
+        END DO
+        CALL FLUSH(numout)
+      ENDIF
+        WRITE(numout,*) narea, ' l_north_nogather ',l_north_nogather; FLUSH(numout)
+      DEALLOCATE( znnbrs )
+      DEALLOCATE( lrankset )
+
+   END SUBROUTINE nemo_northcomms
    !!======================================================================
 END MODULE nemogcm