Index: /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90
===================================================================
--- /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2480)
+++ /branches/nemo_v3_3_beta/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90	(revision 2481)
@@ -175,5 +175,5 @@
       CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
       INTEGER, OPTIONAL            , INTENT(in   ) ::   localComm
-      INTEGER ::   mynode, ierr, code
+      INTEGER ::   mynode, ierr, code, ji, ii
       LOGICAL ::   mpi_was_called
       
@@ -181,17 +181,21 @@
       !!----------------------------------------------------------------------
       !
-      WRITE(ldtxt(1),*)
-      WRITE(ldtxt(2),*) 'mynode : mpi initialisation'
-      WRITE(ldtxt(3),*) '~~~~~~ '
+      ii = 1
+      WRITE(ldtxt(ii),*)                                                                          ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) 'mynode : mpi initialisation'                                            ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '~~~~~~ '                                                                ;   ii = ii + 1
       !
       REWIND( numnam )               ! Namelist namrun : parameters of the run
       READ  ( numnam, nammpp )
       !                              ! control print
-      WRITE(ldtxt(4),*) '   Namelist nammpp'
-      WRITE(ldtxt(5),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send
-      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer
+      WRITE(ldtxt(ii),*) '   Namelist nammpp'                                                     ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      mpi send type                      cn_mpi_send = ', cn_mpi_send   ;   ii = ii + 1
+      WRITE(ldtxt(ii),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer     ;   ii = ii + 1
 
       CALL mpi_initialized ( mpi_was_called, code )
       IF( code /= MPI_SUCCESS ) THEN
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
          WRITE(*, cform_err)
          WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
@@ -203,35 +207,35 @@
          SELECT CASE ( cn_mpi_send )
          CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
          CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-            CALL mpi_init_opa( ierr ) 
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr ) 
          CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
             l_isend = .TRUE.
          CASE DEFAULT
-            WRITE(ldtxt(7),cform_err)
-            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
+            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
             nstop = nstop + 1
          END SELECT
       ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN
-         WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator '
-         WRITE(ldtxt(8),*) '          without calling MPI_Init before ! '
+         WRITE(ldtxt(ii),*) ' lib_mpp: You cannot provide a local communicator '                  ;   ii = ii + 1
+         WRITE(ldtxt(ii),*) '          without calling MPI_Init before ! '                        ;   ii = ii + 1
          nstop = nstop + 1
       ELSE
          SELECT CASE ( cn_mpi_send )
          CASE ( 'S' )                ! Standard mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
+            WRITE(ldtxt(ii),*) '           Standard blocking mpi send (send)'                     ;   ii = ii + 1
             CALL mpi_init( ierr )
          CASE ( 'B' )                ! Buffer mpi send (blocking)
-            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-            CALL mpi_init_opa( ierr )
+            WRITE(ldtxt(ii),*) '           Buffer blocking mpi send (bsend)'                      ;   ii = ii + 1
+            IF( Agrif_Root() )   CALL mpi_init_opa( ldtxt, ii, ierr )
          CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
+            WRITE(ldtxt(ii),*) '           Immediate non-blocking send (isend)'                   ;   ii = ii + 1
             l_isend = .TRUE.
             CALL mpi_init( ierr )
          CASE DEFAULT
-            WRITE(ldtxt(7),cform_err)
-            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
+            WRITE(ldtxt(ii),cform_err)                                                            ;   ii = ii + 1
+            WRITE(ldtxt(ii),*) '           bad value for cn_mpi_send = ', cn_mpi_send             ;   ii = ii + 1
             nstop = nstop + 1
          END SELECT
@@ -246,4 +250,7 @@
          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
          IF( code /= MPI_SUCCESS ) THEN
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
             WRITE(*, cform_err)
             WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
@@ -2282,5 +2289,5 @@
 
 
-   SUBROUTINE mpi_init_opa( code )
+   SUBROUTINE mpi_init_opa( ldtxt, ksft, code )
       !!---------------------------------------------------------------------
       !!                   ***  routine mpp_init.opa  ***
@@ -2294,11 +2301,18 @@
       !!            08/04 :: R. Benshila, generalisation
       !!---------------------------------------------------------------------
-      INTEGER                                 :: code, ierr
-      LOGICAL                                 :: mpi_was_called
+      CHARACTER(len=*),DIMENSION(:), INTENT(  out) ::   ldtxt 
+      INTEGER                      , INTENT(inout) ::   ksft
+      INTEGER                      , INTENT(  out) ::   code
+      INTEGER                                      ::   ierr, ji
+      LOGICAL                                      ::   mpi_was_called
       !!---------------------------------------------------------------------
       !
       CALL mpi_initialized( mpi_was_called, code )      ! MPI initialization
       IF ( code /= MPI_SUCCESS ) THEN
-         CALL ctl_stop( ' lib_mpp: Error in routine mpi_initialized' )
+         DO ji = 1, SIZE(ldtxt) 
+            IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+         END DO         
+         WRITE(*, cform_err)
+         WRITE(*, *) ' lib_mpp: Error in routine mpi_initialized'
          CALL mpi_abort( mpi_comm_world, code, ierr )
       ENDIF
@@ -2308,5 +2322,9 @@
          CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code )
          IF ( code /= MPI_SUCCESS ) THEN
-            CALL ctl_stop( ' lib_mpp: Error in routine mpi_comm_dup' )
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
             CALL mpi_abort( mpi_comm_world, code, ierr )
          ENDIF
@@ -2314,8 +2332,16 @@
       !
       IF( nn_buffer > 0 ) THEN
-         IF ( lwp ) WRITE(numout,*) 'mpi_bsend, buffer allocation of  : ', nn_buffer
+         WRITE(ldtxt(ksft),*) 'mpi_bsend, buffer allocation of  : ', nn_buffer   ;   ksft = ksft + 1
          ! Buffer allocation and attachment
-         ALLOCATE( tampon(nn_buffer) )
-         CALL mpi_buffer_attach( tampon, nn_buffer,code )
+         ALLOCATE( tampon(nn_buffer), stat = ierr )
+         IF (ierr /= 0) THEN 
+            DO ji = 1, SIZE(ldtxt) 
+               IF( TRIM(ldtxt(ji)) /= '' )   WRITE(*,*) ldtxt(ji)      ! control print of mynode
+            END DO
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in ALLOCATE', ierr
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         END IF
+         CALL mpi_buffer_attach( tampon, nn_buffer, code )
       ENDIF
       !
