!=======================================================================
! RCS Header:
!   Revision     [$Revision: 1.4.2.1 $]     Named [$Name: release#2_9_b5 $]
!   Last checkin [$Date: 2001/12/06 10:14:08 $]
!   Author       [$Author: frpb $]
!=======================================================================

! *****************************COPYRIGHT*******************************
! (c) CROWN COPYRIGHT 2001, Met Office, All Rights Reserved.           
! Please refer to Copyright file in top level GCOM directory
!                 for further details
! *****************************COPYRIGHT*******************************

!=======================================================================
!  This is an INTERNAL routine to be used within the GC interface ONLY.
!=======================================================================

#include "gc_prolog.h"   

#if defined(SHM_SRC)
 
      SUBROUTINE GC__LOST_LOCK (RECI, OWNER_PE, ISTAT)

      IMPLICIT NONE
      INTEGER RECI, ISTAT, OWNER_PE

      INTEGER GC_ME, GC_NPROC, IOSTAT

      WRITE(0,9965) GC_ME(), RECI, OWNER_PE, ISTAT
      WRITE(6,9965) GC_ME(), RECI, OWNER_PE, ISTAT
 9965 FORMAT(/'PE ',I4,' has lost the lock on PE ',I4,
     &       ' for PE ',I4,'  -  status = ',Z17/)
      CALL FLUSH(6, IOSTAT)
      CALL GC_ABORT(GC_ME(), GC_NPROC(), 'SHM_NAM lost lock')

      RETURN
      END

#else

      SUBROUTINE GC__LOST_LOCK(dummy1,dummy2,dummy3)
      
      IMPLICIT NONE
      
      INTEGER dummy1,dummy2,dummy3
      
#include "gc__init_common.h"
      
      CALL GC_ABORT(GC__ME,GC__NPROC,
     &              'GC__LOST_LOCK called for non-SHMEM')
      
      RETURN
      END
#endif