Ignore:
Timestamp:
2010-01-06T20:20:12+01:00 (11 years ago)
Author:
rblod
Message:

Adaptation to use iomput with AGRIF, see ticket #630

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMO/OPA_SRC/lib_mpp.F90

    r1718 r1793  
    112112   INTEGER ::   mppsize        ! number of process 
    113113   INTEGER ::   mpprank        ! process number  [ 0 - size-1 ] 
    114    INTEGER ::   mpi_comm_opa   ! opa local communicator 
     114!$AGRIF_DO_NOT_TREAT 
     115   INTEGER, PUBLIC ::   mpi_comm_opa   ! opa local communicator 
     116!$AGRIF_END_DO_NOT_TREAT 
    115117 
    116118   ! variables used in case of sea-ice 
     
    191193      WRITE(ldtxt(6),*) '      size in bytes of exported buffer   nn_buffer   = ', nn_buffer 
    192194 
    193 #if defined key_agrif 
    194       IF( Agrif_Root() ) THEN 
    195 #endif 
    196          !!bug RB : should be clean to use Agrif in coupled mode 
    197 #if ! defined key_agrif 
    198          CALL mpi_initialized ( mpi_was_called, code ) 
    199          IF( code /= MPI_SUCCESS ) THEN 
    200             WRITE(*, cform_err) 
    201             WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
    202             CALL mpi_abort( mpi_comm_world, code, ierr ) 
    203          ENDIF 
    204  
    205          IF( PRESENT(localComm) .and. mpi_was_called ) THEN 
    206             mpi_comm_opa = localComm 
    207             SELECT CASE ( cn_mpi_send ) 
    208             CASE ( 'S' )                ! Standard mpi send (blocking) 
    209                WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    210             CASE ( 'B' )                ! Buffer mpi send (blocking) 
    211                WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    212                CALL mpi_init_opa( ierr )  
    213             CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    214                WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    215                l_isend = .TRUE. 
    216             CASE DEFAULT 
    217                WRITE(ldtxt(7),cform_err) 
    218                WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    219                nstop = nstop + 1 
    220             END SELECT 
    221          ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
    222             WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
    223             WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
    224             nstop = nstop + 1 
    225          ELSE 
    226 #endif 
    227             SELECT CASE ( cn_mpi_send ) 
    228             CASE ( 'S' )                ! Standard mpi send (blocking) 
    229                WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
    230                CALL mpi_init( ierr ) 
    231             CASE ( 'B' )                ! Buffer mpi send (blocking) 
    232                WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
    233                CALL mpi_init_opa( ierr ) 
    234             CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    235                WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
    236                l_isend = .TRUE. 
    237                CALL mpi_init( ierr ) 
    238             CASE DEFAULT 
    239                WRITE(ldtxt(7),cform_err) 
    240                WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
    241                nstop = nstop + 1 
    242             END SELECT 
    243  
    244 #if ! defined key_agrif 
    245             CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
    246             IF( code /= MPI_SUCCESS ) THEN 
    247                WRITE(*, cform_err) 
    248                WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
    249                CALL mpi_abort( mpi_comm_world, code, ierr ) 
    250             ENDIF 
    251             ! 
    252          ENDIF 
    253 #endif 
    254 #if defined key_agrif 
    255       ELSE 
     195      CALL mpi_initialized ( mpi_was_called, code ) 
     196      IF( code /= MPI_SUCCESS ) THEN 
     197         WRITE(*, cform_err) 
     198         WRITE(*, *) 'lib_mpp: Error in routine mpi_initialized' 
     199         CALL mpi_abort( mpi_comm_world, code, ierr ) 
     200      ENDIF 
     201 
     202      IF( mpi_was_called ) THEN 
     203         ! 
    256204         SELECT CASE ( cn_mpi_send ) 
    257205         CASE ( 'S' )                ! Standard mpi send (blocking) 
     
    259207         CASE ( 'B' )                ! Buffer mpi send (blocking) 
    260208            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     209            CALL mpi_init_opa( ierr )  
    261210         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
    262211            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     
    267216            nstop = nstop + 1 
    268217         END SELECT 
     218      ELSE IF ( PRESENT(localComm) .and. .not. mpi_was_called ) THEN 
     219         WRITE(ldtxt(7),*) ' lib_mpp: You cannot provide a local communicator ' 
     220         WRITE(ldtxt(8),*) '          without calling MPI_Init before ! ' 
     221         nstop = nstop + 1 
     222      ELSE 
     223         SELECT CASE ( cn_mpi_send ) 
     224         CASE ( 'S' )                ! Standard mpi send (blocking) 
     225            WRITE(ldtxt(7),*) '           Standard blocking mpi send (send)' 
     226            CALL mpi_init( ierr ) 
     227         CASE ( 'B' )                ! Buffer mpi send (blocking) 
     228            WRITE(ldtxt(7),*) '           Buffer blocking mpi send (bsend)' 
     229            CALL mpi_init_opa( ierr ) 
     230         CASE ( 'I' )                ! Immediate mpi send (non-blocking send) 
     231            WRITE(ldtxt(7),*) '           Immediate non-blocking send (isend)' 
     232            l_isend = .TRUE. 
     233            CALL mpi_init( ierr ) 
     234         CASE DEFAULT 
     235            WRITE(ldtxt(7),cform_err) 
     236            WRITE(ldtxt(8),*) '           bad value for cn_mpi_send = ', cn_mpi_send 
     237            nstop = nstop + 1 
     238         END SELECT 
     239         ! 
    269240      ENDIF 
    270241 
    271       mpi_comm_opa = mpi_comm_world 
    272 #endif 
     242      IF( PRESENT(localComm) ) THEN  
     243         IF( Agrif_Root() ) THEN 
     244            mpi_comm_opa = localComm 
     245         ENDIF 
     246      ELSE 
     247         CALL mpi_comm_dup( mpi_comm_world, mpi_comm_opa, code) 
     248         IF( code /= MPI_SUCCESS ) THEN 
     249            WRITE(*, cform_err) 
     250            WRITE(*, *) ' lib_mpp: Error in routine mpi_comm_dup' 
     251            CALL mpi_abort( mpi_comm_world, code, ierr ) 
     252         ENDIF 
     253      ENDIF  
     254 
    273255      CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 
    274256      CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr ) 
Note: See TracChangeset for help on using the changeset viewer.