Changeset 4185

Timestamp:

2013-11-13T15:14:28+01:00 (10 years ago)

Author:

epico

Message:

northfold update in OFF_SRC

File:

• branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90 (modified) (2 diffs)

branches/2013/dev_CMCC_2013/NEMOGCM/NEMO/OFF_SRC/nemogcm.F90

@@ -46 +46 @@
    USE timing          ! Timing
    USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
+   USE lbcnfd, ONLY: isendto, nsndto
 
    IMPLICIT NONE
@@ -520 +521 @@
       !!======================================================================
       !!                     ***  ROUTINE  nemo_northcomms  ***
-      !! nemo_northcomms    :  Setup for north fold exchanges with explicit peer to peer messaging
+      !! nemo_northcomms    :  Setup for north fold exchanges with explicit 
+      !!                       point-to-point 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
+      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
+      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC) 
+      !!----------------------------------------------------------------------
+
+      INTEGER  ::   sxM, dxM, sxT, dxT, jn
+      INTEGER  ::   njmppmax
+
+      njmppmax = MAXVAL( njmppt )
+
+      !initializes the north-fold communication variables
+      isendto(:) = 0
       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
-
-      DO jtyp = 1,4
-
-         lrankset = .FALSE.
-         znnbrs = narea
-         SELECT CASE (jtyp)
-            CASE(1)
-               CALL lbc_lnk( znnbrs, 'T', 1. )      ! Type 1: T,W-points
-            CASE(2)
-               CALL lbc_lnk( znnbrs, 'U', 1. )      ! Type 2: U-point
-            CASE(3)
-               CALL lbc_lnk( znnbrs, 'V', 1. )      ! Type 3: V-point
-            CASE(4)
-               CALL lbc_lnk( znnbrs, 'F', 1. )      ! Type 4: F-point
-         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.
-         !
-      ENDIF
-      DEALLOCATE( znnbrs )
-      DEALLOCATE( lrankset )
+
+      !if I am a process in the north
+      IF ( njmpp == njmppmax ) THEN
+          !sxM is the first point (in the global domain) needed to compute the
+          !north-fold for the current process
+          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
+          !dxM is the last point (in the global domain) needed to compute the
+          !north-fold for the current process
+          dxM = jpiglo - nimppt(narea) + 2
+
+          !loop over the other north-fold processes to find the processes
+          !managing the points belonging to the sxT-dxT range
+          DO jn = jpnij - jpni +1, jpnij
+             IF ( njmppt(jn) == njmppmax ) THEN
+                !sxT is the first point (in the global domain) of the jn
+                !process
+                sxT = nimppt(jn)
+                !dxT is the last point (in the global domain) of the jn
+                !process
+                dxT = nimppt(jn) + nlcit(jn) - 1
+                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((sxM .le. sxT) .AND. (dxM .gt. dxT)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
+                   nsndto = nsndto + 1
+                   isendto(nsndto) = jn
+                END IF
+             END IF
+          END DO
+      ENDIF
+      l_north_nogather = .TRUE.
 
    END SUBROUTINE nemo_northcomms