Index: branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90
===================================================================
--- branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90	(revision 4622)
+++ branches/2014/dev_r4621_NOC4_BDY_VERT_INTERP/NEMOGCM/NEMO/OPA_SRC/ICB/icblbc.F90	(revision 5038)
@@ -280,5 +280,5 @@
          zwebergs(1) = ibergs_to_send_e
          CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req1)
-         CALL mpprecv( 11, zewbergs(2), 1 )
+         CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
          IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
          ibergs_rcvd_from_e = INT( zewbergs(2) )
@@ -288,6 +288,6 @@
          CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req2)
          CALL mppsend( 12, zwebergs(1), 1, ipe_E, iml_req3)
-         CALL mpprecv( 11, zewbergs(2), 1 )
-         CALL mpprecv( 12, zwebergs(2), 1 )
+         CALL mpprecv( 11, zewbergs(2), 1, ipe_E )
+         CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
          IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
          IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
@@ -297,5 +297,5 @@
          zewbergs(1) = ibergs_to_send_w
          CALL mppsend( 11, zewbergs(1), 1, ipe_W, iml_req4)
-         CALL mpprecv( 12, zwebergs(2), 1 )
+         CALL mpprecv( 12, zwebergs(2), 1, ipe_W )
          IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
          ibergs_rcvd_from_w = INT( zwebergs(2) )
@@ -411,5 +411,5 @@
          zsnbergs(1) = ibergs_to_send_n
          CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req1)
-         CALL mpprecv( 15, znsbergs(2), 1 )
+         CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
          IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
          ibergs_rcvd_from_n = INT( znsbergs(2) )
@@ -419,6 +419,6 @@
          CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req2)
          CALL mppsend( 16, zsnbergs(1), 1, ipe_N, iml_req3)
-         CALL mpprecv( 15, znsbergs(2), 1 )
-         CALL mpprecv( 16, zsnbergs(2), 1 )
+         CALL mpprecv( 15, znsbergs(2), 1, ipe_N )
+         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
          IF( l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
          IF( l_isend ) CALL mpi_wait( iml_req3, iml_stat, iml_err )
@@ -428,5 +428,5 @@
          znsbergs(1) = ibergs_to_send_s
          CALL mppsend( 15, znsbergs(1), 1, ipe_S, iml_req4)
-         CALL mpprecv( 16, zsnbergs(2), 1 )
+         CALL mpprecv( 16, zsnbergs(2), 1, ipe_S )
          IF( l_isend ) CALL mpi_wait( iml_req4, iml_stat, iml_err )
          ibergs_rcvd_from_s = INT( zsnbergs(2) )
@@ -581,5 +581,6 @@
       INTEGER                             :: ifldproc, iproc, ipts
       INTEGER                             :: iine, ijne
-      REAL(wp), DIMENSION(2)              :: zsbergs, znbergs
+      INTEGER                             :: jjn
+      REAL(wp), DIMENSION(0:3)            :: zsbergs, znbergs
       INTEGER                             :: iml_req1, iml_req2, iml_err
       INTEGER, DIMENSION(MPI_STATUS_SIZE) :: iml_stat
@@ -591,4 +592,93 @@
       ! its of fixed size, the first -1 marks end of list of processors
       !
+      nicbfldnsend(:) = 0
+      nicbfldexpect(:) = 0
+      nicbfldreq(:) = 0
+      !
+      ! Since each processor may be communicating with more than one northern
+      ! neighbour, cycle through the sends so that the receive order can be
+      ! controlled.
+      !
+      ! First compute how many icebergs each active neighbour should expect
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            nicbfldnsend(jn) = 0
+
+            ! Find number of bergs that need to be exchanged
+            ! Pick out exchanges with processor ifldproc
+            ! if ifldproc is this processor then don't send
+            !
+            IF( ASSOCIATED(first_berg) ) THEN
+               this => first_berg
+               DO WHILE (ASSOCIATED(this))
+                  pt => this%current_point
+                  iine = INT( pt%xi + 0.5 )
+                  ijne = INT( pt%yj + 0.5 )
+                  iproc = nicbflddest(mi1(iine))
+                  IF( ijne .GT. mjg(nicbej) ) THEN
+                     IF( iproc == ifldproc ) THEN
+                        !
+                        IF( iproc /= narea ) THEN
+                           tmpberg => this
+                           nicbfldnsend(jn) = nicbfldnsend(jn) + 1
+                        ENDIF
+                        !
+                     ENDIF
+                  ENDIF
+                  this => this%next
+               END DO
+            ENDIF
+            !
+         ENDIF
+         !
+      END DO
+      !
+      ! Now tell each active neighbour how many icebergs to expect
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+   
+            zsbergs(0) = narea
+            zsbergs(1) = nicbfldnsend(jn)
+            !IF ( nicbfldnsend(jn) .GT. 0) write(numicb,*) 'ICB sending ',nicbfldnsend(jn),' to ', ifldproc
+            CALL mppsend( 21, zsbergs(0:1), 2, ifldproc-1, nicbfldreq(jn))
+         ENDIF
+         !
+      END DO
+      !
+      ! and receive the heads-up from active neighbours preparing to send
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+
+            CALL mpprecv( 21, znbergs(1:2), 2 )
+            DO jjn = 1,jpni
+             IF( nicbfldproc(jjn) .eq. INT(znbergs(1)) ) EXIT
+            END DO
+            IF( jjn .GT. jpni ) write(numicb,*) 'ICB ERROR'
+            nicbfldexpect(jjn) = INT( znbergs(2) )
+            !IF ( nicbfldexpect(jjn) .GT. 0) write(numicb,*) 'ICB expecting ',nicbfldexpect(jjn),' from ', nicbfldproc(jjn)
+            !CALL FLUSH(numicb)
+         ENDIF
+         !
+      END DO
+      !
+      ! post the mpi waits if using immediate send protocol
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+
+            IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err )
+         ENDIF
+         !
+      END DO
+   
+         !
+         ! Cycle through the icebergs again, this time packing and sending any
+         ! going through the north fold. They will be expected.
       DO jn = 1, jpni
          IF( nicbfldproc(jn) /= -1 ) THEN
@@ -646,19 +736,25 @@
             IF( ifldproc == narea ) CYCLE
    
-            zsbergs(1) = ibergs_to_send
-            CALL mppsend( 21, zsbergs(1), 1, ifldproc-1, iml_req1)
-            CALL mpprecv( 21, znbergs(2), 1 )
-            IF( l_isend ) CALL mpi_wait( iml_req1, iml_stat, iml_err )
-            ibergs_to_rcv = INT( znbergs(2) )
-   
             ! send bergs
    
             IF( ibergs_to_send > 0 )  &
-                CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, iml_req2 )
+                CALL mppsend( 12, obuffer_f%data, ibergs_to_send*jp_buffer_width, ifldproc-1, nicbfldreq(jn) )
+            !
+         ENDIF
+         !
+      END DO
+      !
+      ! Now receive the expected number of bergs from the active neighbours
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+            ibergs_to_rcv = nicbfldexpect(jn)
+
             IF( ibergs_to_rcv  > 0 ) THEN
                CALL icb_increase_ibuffer(ibuffer_f, ibergs_to_rcv)
-               CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width )
-            ENDIF
-            IF( ibergs_to_send > 0 .AND. l_isend ) CALL mpi_wait( iml_req2, iml_stat, iml_err )
+               CALL mpprecv( 12, ibuffer_f%data, ibergs_to_rcv*jp_buffer_width, ifldproc-1 )
+            ENDIF
+            !
             DO jk = 1, ibergs_to_rcv
                IF( nn_verbose_level >= 4 ) THEN
@@ -668,5 +764,15 @@
                CALL icb_unpack_from_buffer(first_berg, ibuffer_f, jk )
             END DO
-            !
+         ENDIF
+         !
+      END DO
+      !
+      ! Finally post the mpi waits if using immediate send protocol
+      DO jn = 1, jpni
+         IF( nicbfldproc(jn) /= -1 ) THEN
+            ifldproc = nicbfldproc(jn)
+            IF( ifldproc == narea ) CYCLE
+
+            IF( l_isend ) CALL mpi_wait( nicbfldreq(jn), iml_stat, iml_err )
          ENDIF
          !
