FTN4,L
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C     SOURCE PART NUMBER :92067-18417 
C 
C     RELOCATABLE PART NUMBER : 92067-16361 
C 
C     PROGRAMER(S)   : J.M.N. 
C 
C 
C 
C     THIS ROUTINE TESTS A NAMR IN IPBUF AGAINST
C     THE CURRENT INPUT FILES IN THE TRANSFER STACK 
C 
C 
      SUBROUTINE ACTIN(IPBUF,IERR) ,92067-16361 REV.1940 781024 
      COMMON /ACOMB /ISTK(90),IPT 
      DIMENSION IPBUF(11) 
      IERR=0
C 
C     TEST ALL NAMRS IN STACK 
C 
      DO 200 I=1,IPT+7,8
      DO 100 J=1,3
      IF(IPBUF(J).NE.ISTK(I+J-1)) GO TO 200 
  100 CONTINUE
      ICR=IPBUF(6)
      IF(ICR.EQ.0.OR.ICR.EQ.ISTK(I+5)) GO TO 300
  200 CONTINUE
C 
C     NO MATCH RETURN 
C 
      RETURN
C 
C     FOUND MATCH 
C 
  300 IERR=-215 
      RETURN
      END 
                                                                                                              