FTN4 SUBROUTINE ITEQU(ITN,IDS,KBUF,IBASE), 92080-1X315 REV.2026 800515 C C SOURCE 92080-18315 C C C C ************************************************************** C * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * C ************************************************************** C C C C********************************************************************* C* * C* THIS SUBROUTINE IS USED TO SEARCH ALL THE KEY * C* ITEMS # WHICH CORRESPONDS TO THE SAME KEY IN AN IMAGE DATA * C* BASE. THIS SUBROUTINE CAN ALSO BE USED TO DETERMINE IF AN ITEM C* IS A KEY OR NON-KEY ITEM (& WHETHER IT IS IN A MASTER OR DETAIL.* C* * C* CALL PARMS: ITN=1. THE KEY ITEM # THAT YOU WANT TO THE EQUIVA-* C* LENT ITEMS FOR. * C* 2. OR ITEM# THAT YOU WANT TO DETERMINE IS A * C* KEY OR NON-KEY ITEM. * C* IDS = DATA SET # * C* IBASE=DB NAMR USED IN THE DBOPN CALL * C* KBUF= 16 WORDS LONG BUFFER IN WHICH INFORMATION * C* WILL BE RETURNED TO THE CALLING PROGRAM. * C* * C* RETURN : KBUF = 1. LIST OF KEY ITEM#(BINARY) THAT ARE * C* EQUIVALENT TO ITN. * C* ITEM# IN BITS 0-7 * C* DS# IN BITS 8-15 * C* ITEM# BITS 0-7 * C* DATA SET# BITS 8-15 * C* 2. OR IF KBUF(1)=-1 & KBUF(2)=-1 MEANS * C* ITN IS A NON-KEY ITEM & IS A MEMBER * C* OF MASTER DATA SET. * C* 3. OR IF KBUF(1)=-1 & KBUF(2)=-2 MEANS * C* ITN IS A NON-KEY ITEM & IS A MEMBER * C* OF A DETAIL DATA SET. * C* 4. OR IF KBUF(1)=-1 & KBUF(2)=0 MEANS * C* AN ERROR STATUS WAS RETURNED FROM AN * C* IMAGE CALL. * C* * C* NOTE: IN 2,3,4 ABOVE, KBUF(3) CONSTAINS* C* THE DATA SET NUMBER. * C* * C* IF AN ERROR IS DETECTED KBUF(1)=-1 ON RETURN * C* * C********************************************************************* C DIMENSION KBUF(1),IBUF(128),IBASE(1),ISTAT(10) C C C INITIALISE KBUF C DO 100 I=1,16 100 KBUF(I)=0 C C-----PERFORM CHECKS : DETERMINE IF ITEM IS A KEY OR NON-KEY ITEM C C -GET ALL DS THIS ITEM IS IN C CALL DBINF(IBASE,ITN,204,ISTAT,IBUF) C NERR=1 C CALL DUMPI(NERR,ITN,IDS,KBUF,ISTAT,IBUF) C IF(ISTAT.NE.0) GO TO 130 C -GET INFO ABOUT 1ST DS C IDS=IBUF(2) C IF(IDS.LT.0) IDS=-1*IDS CALL DBINF(IBASE,IDS,202,ISTAT,IBUF) D NERR=2 D CALL DUMPI(NERR,ITN,IDS,KBUF,ISTAT,IBUF) IF(ISTAT.NE.0) GO TO 130 C------MASTER OR DETAIL? (110 IF DTL) IF(IAND(IBUF(9),177400B).EQ.42000B) GO TO 110 C C------MASTER: GET MASTER'S KEY ITEM C IMSTR=IDS CALL DBINF(IBASE,IMSTR,302,ISTAT,IBUF) D NERR=3 D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) IF(ISTAT.NE.0) GO TO 130 C -KEY IN MASTER? D NERR=4 D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) IF(ITN.NE.IBUF(1)) GO TO 135 C------YES, NOW GET EQUIVALENT ITEMS CALL DBINF(IBASE,IMSTR,301,ISTAT,IBUF) D NERR=5 D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) IF(ISTAT.NE.0) GO TO 130 J=1 DO 105 I=1,IBUF(1) IF(ITN.EQ.IBUF(3*I) .AND. IMSTR.EQ.IBUF(3*I-1)) GO TO 105 C -BITS 0-7 = ITN#, BITS 8-15 = DS# OF EQUIV. ITEMS. KBUF(J)=IBUF(3*I)+IBUF(3*I-1)*256 J=J+1 105 CONTINUE D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) GO TO 125 C C-----DETAIL: GET INFO ABOUT MASTER LINKED TO THIS DETAIL C 110 IDTL=IDS CALL DBINF(IBASE,IDTL,301,ISTAT,IBUF) D NERR=6 D CALL DUMPI(NERR,ITN,IDTL,KBUF,ISTAT,IBUF) IF(ISTAT.NE.0) GO TO 130 C -SEARCH FOR ITN IN LIST OF KEY ITEMS IN THIS DETAIL. DO 112 I=1,IBUF(1) IF(ITN.EQ.IBUF(3*I)) GO TO 113 112 CONTINUE C -NOT IN LIST IMPLIES ITN IS NON-KEY ITEM IN A DTL DS D NERR=7 D CALL DUMPI(NERR,ITN,IDTL,KBUF,ISTAT,IBUF) GO TO 140 C C------NOW WE KNOW THAT ITN IS A KEY ITEM IN THIS DETAIL. NEXT GET C -THE KEY ITEM FROM THE LINKED MASTER SINCE THIS IS ALSO C -EQUIVALENT TO ITN. C 113 IMSTR=IBUF(3*I-1) CALL DBINF(IBASE,IMSTR,302,ISTAT,IBUF) D NERR=9 D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) IF(ISTAT.NE.0) GO TO 130 C -PUT IT 1ST IN THE LIST OF ITEMS EQUIVALENT TO ITN. C -FORMAT IN KBUF: ITEM# BITS 0-7 C DATA SET# BITS 8-15 KBUF(1)=IBUF(1)+IMSTR*256 C -GET THE REST OF THE EQUIVALENT ITEMS CALL DBINF(IBASE,IMSTR,301,ISTAT,IBUF) D NERR=10 D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) IF(ISTAT.NE.0) GO TO 130 J=2 DO 119 I=1,IBUF(1) IF(IDTL.EQ.IBUF(3*I-1)) GO TO 119 C IF(ITN.EQ.IBUF(3*I)) GO TO 119 KBUF(J)=IBUF(3*I)+IBUF(3*I-1)*256 J=J+1 119 CONTINUE C C-----NORMAL RETURN C 125 CONTINUE D NERR=125 D CALL DUMPI(NERR,ITN,IDTL,KBUF,ISTAT,IBUF) RETURN C C-----ERROR RETURN : DUE TO ERROR STATUS RETURNED FROM AN IMAGE CALL C 130 KBUF(1)=-1 KBUF(2)=0 D NERR=130 D CALL DUMPI(NERR,ITN,IDTL,KBUF,ISTAT,IBUF) RETURN C C-----NON-KEY RETURNS : 135 & 140 C C -MEANS ITEM IS A NON-KEY ITEM IN A MASTER 135 KBUF(1)=-1 KBUF(2)=-1 KBUF(3)=IMSTR D NERR=135 D CALL DUMPI(NERR,ITN,IMSTR,KBUF,ISTAT,IBUF) RETURN C -MEANS ITEM IS A NON-KEY ITEM IN A DETAIL 140 KBUF(1)=-1 KBUF(2)=-2 KBUF(3)=IDTL D NERR=140 D CALL DUMPI(NERR,ITN,IDTL,KBUF,ISTAT,IBUF) RETURN C END C D SUBROUTINE DUMPI(NERR,ITN,IDS,KBUF,ISTAT,IBUF) D DIMENSION KBUF(1),ISTAT(1),IBUF(1),LR(32) D WRITE(6,144) D WRITE(6,145) NERR,ITN,IDS D J=1 D DO 140 I=1,16 D LR(J)=IAND(KBUF(I),177400B)/256 D J=J+1 D LR(J)=IAND(KBUF(I),377B) D J=J+1 D140 CONTINUE D WRITE(6,154) (LR(I),I=1,16) D WRITE(6,154) (LR(I),I=17,32) D WRITE(6,150) (ISTAT(I),I=1,10) D WRITE(6,151) (ISTAT(I),I=1,10) D WRITE(6,152) (IBUF(I),I=1,10) D WRITE(6,153) (IBUF(I),I=1,10) D WRITE(6,152) (IBUF(I),I=11,20) D WRITE(6,153) (IBUF(I),I=11,20) D WRITE(6,152) (IBUF(I),I=21,30) D WRITE(6,153) (IBUF(I),I=21,30) D144 FORMAT("0'DUMPI' FROM 'ITEQU'") D145 FORMAT(" NERR=",I7," : ITN=",I7," : IDS=",I7) D150 FORMAT(" ISTAT =",10@7) D151 FORMAT(" ISTAT =",10I7) D152 FORMAT(" IBUF =",10@7) D153 FORMAT(" IBUF =",10I7) D154 FORMAT(" KBUF =",16I3) D RETURN C D END END$