external/atm_ocn/mpi_more.F

   1       SUBROUTINE GLOB_ABORT(ie,s,rc)
   2 #if defined( DM_PARALLEL )
   3       implicit none
   4 !      include 'mpif.h'
   5       integer rc,ie,ierr
   6       character*(*) s
   7       character*500 message
   8       if (ie.ne.0) then
   9  3038    format("GLOB_ABORT: ",A," ie,rc:",I0,"  ",I0)
  10          write(message,3038) trim(s),ie,rc
  11
  12          if(rc.eq.0) then
  13             call wrf_message(message)
  14          else
  15             call wrf_error_fatal(message)
  16          endif
  17 !        write(0,*) 'GLOB_ABORT: '//s//' ie,rc:',ie,rc
  18 !        if (rc.eq.0) RETURN
  19 !        CALL MPI_ABORT(MPI_COMM_WORLD,rc,ierr)
  20       end if
  21 #endif
  22       RETURN
  23       END
  24
  25 #ifdef PRETEND_WRF_FOR_DMITRY
  26 ! For Dmitry's sake for testing this code outside of WRF, these are
  27 ! implementations of the WRF_MESSAGE and WRF_ERROR_FATAL functions.
  28
  29       subroutine WRF_MESSAGE(s)
  30       character(*) :: s
  31       print *,trim(s)
  32       end subroutine WRF_MESSAGE
  33
  34       subroutine WRF_ERROR_FATAL(s)
  35       include 'mpif.h'
  36       character(*) :: s
  37       print *,trim(s)
  38       write(0,*) trim(s)
  39       CALL MPI_ABORT(MPI_COMM_WORLD,rc,ierr)
  40       end subroutine WRF_ERROR_FATAL
  41 #endif
  42 !
  43 !***********************************************************************
  44 !