*-- Author : Stephen J. Maxfield 04/09/92 SUBROUTINE FTKRAN *KEEP,BCS. INTEGER NHROW,NHCOL,NHLEN PARAMETER (NHROW = 2, NHCOL = 1, NHLEN=2) INTEGER NBOSIW PARAMETER (NBOSIW=1000000) INTEGER IW(NBOSIW) REAL RW(NBOSIW) COMMON /BCS/ IW EQUIVALENCE (RW(1),IW(1)) SAVE /BCS/ *KEEP,BOSMDL. C ------BOSMDL LOGICAL BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT COMMON/BOSMDL/BEGJOB,ENDRUN,BEGRUN,REVENT,ENDJOB,OTHDAT, + LCCRUN,NCCRUN,NEVENT, + IHA,IBS,IDB,IDATEL,LUP,ISN,JSN SAVE /BOSMDL/ C ------ *KEEP,STFUNCT. * index of element before row number IROW INDR(IND,IROW)=IND+2+IW(IND+1)*(IROW-1) * index of L'th element of row number IROW INDCR(IND,L,IROW)=INDR(IND,IROW) + L * L'th integer element of the IROW'th row of bank with index IND IBTAB(IND,L,IROW)=IW(INDCR(IND,L,IROW)) * L'th real element of the IROW'th row of bank with index IND RBTAB(IND,L,IROW)=RW(INDCR(IND,L,IROW)) *KEND. INDTKR = NLINK('FTKR',0) IF(INDTKR .EQ.0) RETURN NTRKS = IW(INDTKR+2) DO 1 J = 1, NTRKS NX = IBTAB(INDTKR, 19, J) IF(NX .GE. 0) THEN X = RBTAB(INDTKR, 4, J) Y = RBTAB(INDTKR, 5, J) Z = RBTAB(INDTKR, 6, J) CALL SHD(900, 0, X, Y) CALL SHD(901, 0, Z, Y) ENDIF 1 CONTINUE RETURN END *