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