Changeset 1793 for trunk/NEMO/OPA_SRC

Timestamp:

2010-01-06T20:20:12+01:00 (14 years ago)

Author:

rblod

Message:

Adaptation to use iomput with AGRIF, see ticket #630

Location:

trunk/NEMO/OPA_SRC

Files:

• IOM/iom.F90 (modified) (3 diffs)
• lib_mpp.F90 (modified) (4 diffs)
• opa.F90 (modified) (3 diffs)
• step.F90 (modified) (1 diff)

trunk/NEMO/OPA_SRC/IOM/iom.F90

@@ -43 +43 @@
    LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag
 #endif
-   PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
+   PUBLIC iom_init, iom_swap, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put
 
    PRIVATE iom_rp0d, iom_rp1d, iom_rp2d, iom_rp3d
@@ -86 +86 @@
       !!----------------------------------------------------------------------
       ! read the xml file
-      CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)...
+      IF( Agrif_Root() ) CALL event__parse_xml_file( 'iodef.xml' )   ! <- to get from the nameliste (namrun)...
+      CALL iom_swap
 
       ! calendar parameters
@@ -119 +120 @@
 
    END SUBROUTINE iom_init
+
+
+   SUBROUTINE iom_swap
+      !!---------------------------------------------------------------------
+      !!                   ***  SUBROUTINE  iom_swap  ***
+      !!
+      !! ** Purpose :  swap context between different agrif grid for xmlio_server
+      !!---------------------------------------------------------------------
+#if defined key_iomput
+
+     IF( TRIM(Agrif_CFixed()) == '0' ) THEN
+        CALL event__swap_context("nemo")
+     ELSE
+        CALL event__swap_context(TRIM(Agrif_CFixed())//"_nemo")
+     ENDIF
+
+#endif
+   END SUBROUTINE iom_swap
 
 

trunk/NEMO/OPA_SRC/lib_mpp.F90

@@ -112 +112 @@
    INTEGER ::   mppsize        ! number of process
    INTEGER ::   mpprank        ! process number  [ 0 - size-1 ]
-   INTEGER ::   mpi_comm_opa   ! opa local communicator
+!$AGRIF_DO_NOT_TREAT
+   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator
+!$AGRIF_END_DO_NOT_TREAT
 
    ! variables used in case of sea-ice
@@ -191 +193 @@
       WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer
 
-#if defined key_agrif
-      IF( Agrif_Root() ) THEN
-#endif
-         !!bug RB : should be clean to use Agrif in coupled mode
-#if ! defined key_agrif
-         CALL mpi_initialized ( mpi_was_called, code )
-         IF( code /= MPI_SUCCESS ) THEN
-            WRITE(*, cform_err)
-            WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
-            CALL mpi_abort( mpi_comm_world, code, ierr )
-         ENDIF
-
-         IF( PRESENT(localComm) .and. mpi_was_called ) THEN
-            mpi_comm_opa = localComm
-            SELECT CASE ( cn_mpi_send )
-            CASE ( 'S' )                ! Standard mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-            CASE ( 'B' )                ! Buffer mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-               CALL mpi_init_opa( ierr ) 
-            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-               l_isend = .TRUE.
-            CASE DEFAULT
-               WRITE(ldtxt(7),cform_err)
-               WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send
-               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 ! '
-            nstop = nstop + 1
-         ELSE
-#endif
-            SELECT CASE ( cn_mpi_send )
-            CASE ( 'S' )                ! Standard mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
-               CALL mpi_init( ierr )
-            CASE ( 'B' )                ! Buffer mpi send (blocking)
-               WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
-               CALL mpi_init_opa( ierr )
-            CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
-               WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
-               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
-               nstop = nstop + 1
-            END SELECT
-
-#if ! defined key_agrif
-            CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
-            IF( code /= MPI_SUCCESS ) THEN
-               WRITE(*, cform_err)
-               WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
-               CALL mpi_abort( mpi_comm_world, code, ierr )
-            ENDIF
-            !
-         ENDIF
-#endif
-#if defined key_agrif
-      ELSE
+      CALL mpi_initialized ( mpi_was_called, code )
+      IF( code /= MPI_SUCCESS ) THEN
+         WRITE(*, cform_err)
+         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized'
+         CALL mpi_abort( mpi_comm_world, code, ierr )
+      ENDIF
+
+      IF( mpi_was_called ) THEN
+         !
          SELECT CASE ( cn_mpi_send )
          CASE ( 'S' )                ! Standard mpi send (blocking)
@@ -259 +207 @@
          CASE ( 'B' )                ! Buffer mpi send (blocking)
             WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
+            CALL mpi_init_opa( ierr ) 
          CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
             WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
@@ -267 +216 @@
             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 ! '
+         nstop = nstop + 1
+      ELSE
+         SELECT CASE ( cn_mpi_send )
+         CASE ( 'S' )                ! Standard mpi send (blocking)
+            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)'
+            CALL mpi_init( ierr )
+         CASE ( 'B' )                ! Buffer mpi send (blocking)
+            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)'
+            CALL mpi_init_opa( ierr )
+         CASE ( 'I' )                ! Immediate mpi send (non-blocking send)
+            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)'
+            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
+            nstop = nstop + 1
+         END SELECT
+         !
       ENDIF
 
-      mpi_comm_opa = mpi_comm_world
-#endif
+      IF( PRESENT(localComm) ) THEN 
+         IF( Agrif_Root() ) THEN
+            mpi_comm_opa = localComm
+         ENDIF
+      ELSE
+         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code)
+         IF( code /= MPI_SUCCESS ) THEN
+            WRITE(*, cform_err)
+            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup'
+            CALL mpi_abort( mpi_comm_world, code, ierr )
+         ENDIF
+      ENDIF 
+
       CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr )
       CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )

trunk/NEMO/OPA_SRC/opa.F90

@@ -156 +156 @@
       CALL opa_closefile
 #if defined key_oasis3 || defined key_oasis4
-      CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_finalize           ! end coupling and mpp communications with OASIS
+     ENDIF 
 #else
       IF( lk_mpp )   CALL mppstop       ! end mpp communications
@@ -191 +193 @@
 #if defined key_iomput
 # if defined key_oasis3 || defined key_oasis4
-      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
-      CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it)
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+         CALL init_ioclient()                    ! io_server will get its communicators (if needed) from oasis (we don't see it)
+      ENDIF
 # else
-      CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server
+      IF( Agrif_Root() ) THEN
+         CALL init_ioclient( ilocal_comm )       ! nemo local communicator (used or not) given by the io_server
+      ENDIF
 # endif
       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection
@@ -200 +206 @@
 #else
 # if defined key_oasis3 || defined key_oasis4
-      CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+      IF( Agrif_Root() ) THEN
+         CALL cpl_prism_init( ilocal_comm )      ! nemo local communicator given by oasis
+      ENDIF
       narea = mynode( cltxt, ilocal_comm )    ! Nodes selection (control print return in cltxt)
 # else

trunk/NEMO/OPA_SRC/step.F90

@@ -166 +166 @@
 #if defined key_agrif
       kstp = nit000 + Agrif_Nb_Step()
-!      IF ( Agrif_Root() .and. lwp) Write(*,*) '---'
-!      IF (lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
+!      IF( Agrif_Root() .and. lwp) Write(*,*) '---'
+!      IF(lwp) Write(*,*) 'Grid Number',Agrif_Fixed(),' time step ',kstp
+# if defined key_iomput
+      IF( Agrif_Nbstepint() == 0) CALL iom_swap
+# endif   
 #endif   
       indic = 1                                       ! reset to no error condition