Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

      SUBROUTINE SLCTF(NSRCH,ID)
C*****FINDS THE FILE ID ON DISK AND PUTS ITS POINTER FILE AND FORMAT
C*****SPECIFICATIONS INTO COMMON
C*****NSRCH=N   SEARCH ONLY PACK N  N=0 TO K
C*****     -N   SEARCH ALL PACKS  0 THRU N
      DIMENSION IPAR(10),IFRMTF(1)
      COMMON IPAR,IFRMTF
      DIMENSION IB(10)
      IDONE=0
C*****CALCULATE THE ADDRESS OF THE PACK POINTER FILE
	IF(NSRCH.LT.0)GO TO 8
	LR=NSRCH*1000000+1
	CALL DIO(LR,1,IPAR,1)
	CALL ADDMSK(NSRCH)
	IF(IFIND(ID,0,0))999,999,22
22    LR=IPAR(6)
	MOD=LR/1000000
      GO TO 99
C*****SEE IF WE HAVE SEARCHED ALL THE REQUESTED DISKS
8	NP=-NSRCH
	DO 88 MOD=1,NP+1
	LR=(MOD-1)*1000000+1
	CALL DIO(LR,1,IPAR,1)
	CALL ADDMSK(MOD-1)
	IF(IFIND(ID,0,0))88,88,22
88	CONTINUE
C*****TYPE ERROR MESSAGE AND EXIT
999   TYPE 100,ID
100   FORMAT(10H ERROR ID ,A5,3X,11HNOT ON DISK)
      CALL EXIT
C*****READ THE IDS POINTER FILE INTO COMMON
99    CALL DIO(LR,1,IPAR,1)
	CALL ADDMSK(MOD)
C*****FOR THE FORMAT SPECIFICATIONS
      IF (IPAR(8)) 80,80,81
81	NFACT=1
	IF(IPAR(8)/10*10.EQ.IPAR(8))NFACT=0
	I=(3*IPAR(8))/10+1*NFACT
2     K=ISUB(1,1)
	LR=IPAR(7)
	NW=3*IPAR(8)
	NS=10
	DO 200 J=1,I
	CALL DIO(LR,1,IB,1)
	IF(NW.LT.10)NS=NW
	DO 201 K1=1,NS
201	IFRMTF(10*(J-1)+K+K1-1)=IB(K1)
	LR=LR+1
	NW=NW-10
200	CONTINUE
80    RETURN
	END
	SUBROUTINE ADDMSK(MOD)
C	ENABLES THE SYSTEM TO HANDLE MORE THAN ONE PACK IN SAME PROGRAM
C	PACKS MAY BE ON DIFFERENT FILE STRUCTURES
	COMMON IPAR(10)
	DO 1 I=1,9
	IF(I.EQ.1.OR.I.EQ.5.OR.I.EQ.8)GO TO 1
	IPAR(I)=IPAR(I)+MOD*1000000
1	CONTINUE
	RETURN
	END