Changeset 1793 for trunk/NEMO/OPA_SRC/lib_mpp.F90
- Timestamp:
- 2010-01-06T20:20:12+01:00 (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lib_mpp.F90
r1718 r1793 112 112 INTEGER :: mppsize ! number of process 113 113 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 115 117 116 118 ! variables used in case of sea-ice … … 191 193 WRITE(ldtxt(6),*) ' size in bytes of exported buffer nn_buffer = ', nn_buffer 192 194 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 ! 256 204 SELECT CASE ( cn_mpi_send ) 257 205 CASE ( 'S' ) ! Standard mpi send (blocking) … … 259 207 CASE ( 'B' ) ! Buffer mpi send (blocking) 260 208 WRITE(ldtxt(7),*) ' Buffer blocking mpi send (bsend)' 209 CALL mpi_init_opa( ierr ) 261 210 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 262 211 WRITE(ldtxt(7),*) ' Immediate non-blocking send (isend)' … … 267 216 nstop = nstop + 1 268 217 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 ! 269 240 ENDIF 270 241 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 273 255 CALL mpi_comm_rank( mpi_comm_opa, mpprank, ierr ) 274 256 CALL mpi_comm_size( mpi_comm_opa, mppsize, ierr )
Note: See TracChangeset
for help on using the changeset viewer.