FTN SUBROUTINE ELEMT(ECNT,IINDX,IERR),92069-16015 REV.2026 800124 INTEGER ECNT C C C***************************************************************** C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. C****************************************************************** C C C SOURCE: 92069-18039 C RELOC: 92069-16015 C C C****************************************************************: C C C C ABSTRACT: C C THIS SUBROUTINE PROCESSES THE ELEMENT COUNT DEFINITION IN AN C "ITEMS:" COMMAND. WHEN NO ELEMENT COUNT IS GIVEN, THE COUNT IS C DEFAULTED TO 1. C C THE SUBROUTINE WILL DO ITS OWN CALL TO THE SUBROUTINE "GGLOB", AND C WILL PLACE THE ELEMENT COUNT INTO THE ITEM TABLE, AFTER THE COUNT C HAS BE CALCULATED. C C C CALLING SEQUENCE: C C CALL ELEMT(ECNT,IINDX,IERR) C C WHERE: C C ECNT C IS RETURNED BY THE SUBROUTINE. IT WILL CONTAIN THE NUMBER OF C ELEMENTS BEING DEFINED. C C IINDX C IS THE INDEX INTO THE ITEM TABLE FOR THE ITEM BEING PROCESSED. C C IERR C IS RETURNED BY THE SUBROUTINE TO INDICATE ERRORS. C 0 INDICATES NO ERROR C -1 INDICATES ERRORS C C C C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C C C CONSTANTS IN INTEGER C C C INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP,MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO, C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C INTEGER ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C INTEGER CARD,CHAR,CODE,CRDPR REAL CPACK INTEGER DSEC,DCRN INTEGER ENTL,ERROR LOGICAL NMFLG INTEGER FWAM INTEGER GGERR INTEGER ICNT,IDCB,INDX INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB INTEGER KPACK INTEGER LDCB,LGLOB,LIST,LWAM INTEGER MEDIA INTEGER NPACK,NSETS INTEGER OVRHD INTEGER PTHTB INTEGER RDEF,RESNO,RFILE,RINDX INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE INTEGER TYPE,PRGFLG C C C EXTERNAL REFERENCES C C INTEGER ROOTA C C CONSTANTS IN COMMON C C C COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 1 CAP,CNTRL,COLON,COMMA,CRDLM, 2 DATA,DETAIL,DOLLR,DOT, 3 ELSE,END,ENTY,EQUAL,ERR, 4 FIELD, 5 ICODE,INTGR,ITM, 6 LEVL,LPARN,LST, 7 MANU,MXCAP(2),MAXRC, 8 MXELE,MXENT,MXITM,MXLEV,MXSTR, 9 NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10), C NFO(10), C NOLST,NORES,NOTAB, 1 OPSET, 2 PMAX, 3 ROOTR,RPARN, 4 SEMI,SET,SMAX, 5 UPPER C C C C C DATA BASE OFFSETS C C C COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 1 DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 2 DBLVE C C C C ITEM TABLE OFFSETS C C C COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 1 ITSNO,ITECT,ITLNG,ITMSZ,ITMST C C C DATA SET TABLE OFFSETS C C COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 1 DSITP,DSCAP,DSCCT,DSPAN,SETSZ C C C C OFFSET TO OVERHEAD RECORD C C C COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC C C C C ERROR MESSAGES C C COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 1 DUPIT,ITLIM,ILITP,FLDER,ILXTP, 2 ILWR,ILTRM,NAMX,DUPST,STLIM, 3 ENTYX,NOITM,BDSET,BDKEY,DUPHS, 4 NOPTH,AERR,RCLIM,CAPX,ILCAP, 5 EMPTY,MXERR,EOF,NOSEG,NOMEM, 6 DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 7 ILRD,ILRNG,SETX,IGNSC,INMX, 8 PTDUP,DBKEY,ENDX,PDEFC,SIMPT, 9 BDCNT,RTERR,GOODS,GOODR,BADS, C BADR,ABORT,OPNER,XCNTR,ILLVN, 1 SRCH2,UEND,XITM,ELERR,ROTER, 2 UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 3 ILLSC,MORIT,ILPTH,DEFIT, 4 ILSRT,SIMPS,UNDST C C C VARIABLES C C C COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR COMMON DSEC,DCRN COMMON ENTL,ERROR COMMON NMFLG COMMON FWAM COMMON GGERR COMMON ICNT,IDCB(144),INDX COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB COMMON KPACK(50) COMMON LDCB(144),LGLOB,LIST,LWAM COMMON MEDIA COMMON NPACK(50),NSETS(50) COMMON OVRHD COMMON PTHTB(32) COMMON RDEF(64),RESNO,RFILE(3),RINDX COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE COMMON TYPE,PRGFLG C C C EXTERNAL REFERENCES C C EXTERNAL ROOTA C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980 C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB C PROCESS THE ELEMENT COUNT C ECNT = 1 C C SEE IF THERE IS AN ELEMENT COUNT C IF THERE IS NOT THEN DEFAULT IT TO 1 C CALL GGLOB IF(TYPE .NE. INTGR) GOTO 20 C IS NUMBER GREATER THAN MAXIMUM NUMBER OF ELEMENTS ALLOWED? IF ((IGLOB .GT. MXELE) .OR. (IGLOB .LT. 0)) GOTO 7010 ECNT = IGLOB C C GET THE ITEM TYPE C CALL GGLOB C C PUT ELEMENT COUNT IN ITEM TABLE C 20 CONTINUE CALL SROOT(IINDX+ITECT,ECNT) C C RETURN NO ERROR C IERR = 0 40 CONTINUE RETURN C C C C ERROR PROCESSORS C C C C OUTPUT "TOO MANY ELEMENTS" C 7010 CALL EMESS(ELERR) IERR = -1 C C GET THE ITEM TYPE C CALL GGLOB GOTO 40 END