C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C C CONTENTS C -------- C C NAME DESCRIPTION C ____ ___________ C C C COVER FORMATS THE COVER PAGE C TITSET $TITLE DIRECTIVE PROCESSOR C COMENT $COMMENT DIRECTIVE PROCESSOR C CREATE $CREATED DIRECTIVE PROCESSOR C REVISE $REVISED DIRECTIVE PROCESSOR C CLRSET $COLORS DIRECTIVE PROCESSOR C SLKSET $SLACK DIRECTIVE PROCESSOR SUBROUTINE COVER C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE FORMATS THE COVER PAGE OF THE WIRE LISTING REPORT C C COMPILATION INSTRUCTIONS: C C COVER,COVER/-SP=COVER C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - COVER - DOCUMENTATION. C C THIS ROUTINE WRITES THE FIXED INFORMATION OF THE COVER PAGE TO THE C FIRST PAGE OF THE WIRE LIST REPORT. C C CALLING SEQUENCE: C C CALL BY: CALL COVER C C C C ON EXIT: THIS ROUTINE PRODUCES LISTING OUTPUT C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - COVER - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - COVER C WRITE (ISYSOU, 100) WRITE (ISYSOU, 200) WRITE (ISYSOU, 300) VERSN WRITE (ISYSOU, 400) (IDATE(I),I=1,9), (ITIME(I),I=1,8) WRITE (ISYSOU, 500) WRITE (ISYSOU, 600) WRITE (ISYSOU, 700) WRITE (ISYSOU, 800) WRITE (ISYSOU, 900) WRITE (ISYSOU, 1000) IPAGE=2 ILINE=4 RETURN C C 100 FORMAT (1H1,/////////) C C 200 FORMAT (1H ,T56,'WIRE LISTING REPORT') C C 300 FORMAT (' ',/////,' ',T53, 'GENERATED BY WIRAP V', A8) C C 400 FORMAT ('0', T54, 'ON ', 9A1, ' AT ', 8A1) C C 500 FORMAT ('0', /////, ' ', T70, 'PROGRAM DEVELOPED BY:') C C 600 FORMAT (' ', T70, 'RICHARD L. AURBACH') C C 700 FORMAT (' ', T70, 'RESEARCH COMPUTING GROUP') C C 800 FORMAT (' ', T70, 'MONSANTO AGRICULTURAL PRODUCTS CO.') C C 900 FORMAT (' ', T70, 'ST. LOUIS, MISSOURI') C C 1000 FORMAT (1H1,////) C C END SUBROUTINE TITSET C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PROCESSES THE $TITLE DIRECTIVE. C C COMPILATION INSTRUCTIONS: C C TITSET,TITSET/-SP=TITSET C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - TITSET - DOCUMENTATION. C C THE FORMAT OF THE $TITLE DIRECTIVE IS: C C $TITLE TEXT_STRING C C THIS ROUTINE PRINTS THE TEXT STRING ON THE LISTING FILE COVER PAGE AND C FILLS IN THE COMMON AREA RESERVED FOR THE TITLE. C C CALLING SEQUENCE: C C CALL BY: CALL TITSET C C C ON ENTRY: NEXCHR IS POINTING AT THE FIRST CHARACTER AFTER C $TITLE ON THE LINE. C C ON EXIT: NEXCHR IS MODIFIED, LISTING OUTPUT IS PRODUCED, C AND THE TITLE FIELD IN IOPAR IS FILLED IN. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C CHOP HDRCHK TRANSF C C PAGE 3 - TITSET - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX BYTE SBTTL(24) !BLANK SUBTITLE FIELD C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 24*' ' / C C PAGE 4 - TITSET C CALL CHOP CALL HDRCHK(SBTTL,2) WRITE (ISYSOU, 1000) (LINBUF(I),I=NEXCHR,ICHAR) I=ICHAR-NEXCHR+1 CALL TRANSF(LINBUF(NEXCHR),I,TITLE,72) RETURN C C 1000 FORMAT (1H0, 'CARD TITLE: ', 132A1) C C END SUBROUTINE COMENT C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PROCESSES THE $COMMENT DIRECTIVE. C C COMPILATION INSTRUCTIONS: C C COMENT,COMENT/-SP=COMENT C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - COMENT - DOCUMENTATION. C C THE COMMAND SYNTAX FOR THE $COMMENT DIRECTIVE IS: C C $COMMENT [OPTIONAL TEXT] C TEXT_LINE C ... C C WHERE [OPTIONAL TEXT] MEANS THAT IF TEXT APPEARS ON THE SAME LINE AS C THE $COMMENT DIRECTIVE, THAT TEXT WILL BE PRINTED. C C THE LINES OF TEXT WHICH FOLLOW THE $COMMENT DIRECTIVE WILL ALSO BE PRINTED. C THIS PROCESS WILL CONTINUE UNTIL AN EOF IS SEEN OR UNTIL THE $ OF THE NEXT C COMMAND IS SEEN IN THE FIRST COLUMN OF A LINE. C C CALLING SEQUENCE: C C CALL BY: CALL COMENT C C C C ON EXIT: THIS ROUTINE PRODUCES OUTPUT. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C LISTER CHOP HDRCHK C C PAGE 3 - COMENT - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX BYTE SBTTL(24) !BLANK SUBTITLE FIELD C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 24*' ' / C C PAGE 4 - COMENT C C C *** CHECK OUT THE REST OF THE COMMAND LINE C CALL CHOP !STRIP THE DIRECTIVE OFF THE LINE IF (NEXCHR .EQ. ICHAR) GOTO 100 !DON'T PRINT IF THERE IS NOTHING THERE CALL HDRCHK(SBTTL,1) WRITE (ISYSOU, 1000) (LINBUF(I),I=NEXCHR,ICHAR) C C *** PRINT ALL THE REMAINING LINES C 100 CALL LISTER(SBTTL) RETURN C C 1000 FORMAT (1H ,132A1) C C END SUBROUTINE CREATE C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PROCESSES THE $CREATED DIRECTIVE C C COMPILATION INSTRUCTIONS: C C CREATE,CREATE/-SP=CREATE C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 9-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - CREATE - DOCUMENTATION. C C THE $CREATED DIRECTIVE HAS THE FORMAT: C C $CREATED TEXT_STRING C OPTIONAL_TEXT_LINES C C WHERE THE FIRST 9 CHARACTERS OF THE TEXT STRING SHOULD BE THE DATE BECAUSE C THESE CHARACTERS WILL BE STORED IN A SPECIAL AREA AND PRINTED AS PART OF C THE LISTING PAGE HEADER. C C ALL TEXT INCLUDED IN THE $CREATED DIRECTIVE WILL APPEAR ON THE COVER PAGE C OF THE LISTING. C C CALLING SEQUENCE: C C CALL BY: CALL CREATE C C C C ON EXIT: THIS ROUTINE PRODUCES LISTING OUTPUT C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C CHOP TRANSF HDRCHK LISTER C C PAGE 3 - CREATE - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DUMMY VARIABLE BYTE SBTTL(24) !BLANK SUBTITLE FIELD C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 24*' ' / C C PAGE 4 - CREATE C CALL CHOP I=ICHAR-NEXCHR+1 IF (I .GT. 9) I=9 CALL TRANSF(LINBUF(NEXCHR),I,ICRDAT,9) CALL HDRCHK(SBTTL,6) WRITE (ISYSOU, 1000) (LINBUF(I),I=NEXCHR,ICHAR) CALL LISTER(SBTTL) RETURN C C C 1000 FORMAT (1H0, T8, 'WIRE-LIST REVISION LOG' ///, 1 ' ', 'CREATED:', T12, 120A1) C C END SUBROUTINE REVISE C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THE ROUTINE PROCESSES THE $REVISED DIRECTIVE C C COMPILATION INSTRUCTIONS: C C REVISE,REVISE/-SP=REVISE C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 9-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - REVISE - DOCUMENTATION. C C THE $REVISED DIRECTIVE HAS THE FOLLOWING FORMAT: C C $REVISED TEXT_STRING C OPTIONAL_TEXT_LINES C C WHERE THE FIRST 9 CHARACTERS OF THE TEXT_STRING ARE USED IN THE LISTING PAGE C HEADER AND SHOULD THEREFORE BE A DATE. ALL INCLUDED TEXT MATERIAL WILL BE C WRITTEN ON THE COVER PAGE OF THE LISTING OUTPUT. C C CALLING SEQUENCE: C C CALL BY: CALL REVISE C C C C ON EXIT: THE ROUTINE PRODUCES LISTING OUTPUT C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C CHOP TRANSF HDRCHK LISTER C C PAGE 3 - REVISE - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DUMMY VARIABLE BYTE SBTTL(24) !BLANK SUBTITLE FIELD C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 24*' ' / C C PAGE 4 - REVISE C CALL CHOP I=ICHAR-NEXCHR+1 IF (I .GT. 9) I=9 CALL TRANSF(LINBUF(NEXCHR),I,IRVDAT,9) CALL HDRCHK(SBTTL,2) WRITE (ISYSOU, 1000) (LINBUF(I),I=NEXCHR,ICHAR) CALL LISTER(SBTTL) RETURN C C C 1000 FORMAT (1H0, 'REVISED:', T12, 120A1) C C END SUBROUTINE CLRSET C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PROCESSES THE $COLORS DIRECTIVE C C COMPILATION INSTRUCTIONS: C C CLRSET,CLRSET/-SP=CLRSET C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 9-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - CLRSET - DOCUMENTATION. C C THE FORMAT OF THE $COLORS DIRECTIVE IS AS FOLLOWS: C C $COLORS [STRING[,STRING[,STRING[...]]]] C C WHERE THE COLOR STRINGS ARE OPTIONAL, ARBITRARY IN NUMBER (ALTHOUGH ONLY A C MAXIMUM OF NMCOLR OF THEM WILL BE USED) AND MUST BE ALPHAMERIC STRINGS. C C THIS COMMAND EXISTS COMPLETELY ON A SINGLE LINE. C C CALLING SEQUENCE: C C CALL BY: CALL CLRSET C C C C ON EXIT: THIS ROUTINE PRODUCES LISTING OUTPUT C C ERROR CONDITIONS: C C THE FOLLOWING ERRORS ARE WARNINGS ONLY: C A) NAME OF A COLOR OCCURS MORE THAN ONCE IN THE LIST C B) NUMERIC SYMBOL SPECIFIED FOR THE COLOR C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C GETLEX TRANS MSG POP HDRCHK C C PAGE 3 - CLRSET - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' INCLUDE 'PARAM.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ITMP !GETLEX ASSOCIATED VARIABLE BYTE SBTTL(24) !BLANK SUBTITLE FIELD C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 24*' ' / C C PAGE 4 - CLRSET C NCOL=0 C C *** GET THE NEXT COLOR. C 10 CALL GETLEX(ITMP) GOTO (40, 40, 10, 20, 30) ITMP C 20 IF (NCOL .GE. NMCOLR) GOTO 29 CALL TRANS(COLORS(NCOL+1)) IF (NCOL .EQ. 0) GOTO 23 DO 22 ITMP=1,NCOL IF (COLORS(ITMP) .EQ. COLORS(NCOL+1)) GOTO 25 22 CONTINUE 23 NCOL=NCOL+1 GOTO 10 C C *** PROCESSING FOR A REPEATED COLOR C 25 CALL DSKMSG(12,1) GOTO 10 C C *** PROCESSING FOR A COLOR WE CAN'T USE (TOO MANY SPECIFIED) OR A C NUMERIC SYMBOL. C 29 CALL POP(ITMP) 30 CALL POP(ITMP) CALL DSKMSG(13,1) GOTO 10 C C *** DONE WITH LINE. NOW PRINT THINGS OUT ON THE COVER PAGE. C 40 IF (NCOL .EQ. 0) GOTO 50 CALL HDRCHK(SBTTL,NCOL+2) WRITE (ISYSOU, 1000) NCOL, (COLORS(ITMP),ITMP=1,NCOL) 50 RETURN C C C 1000 FORMAT (1H0, 'WIRE INSULATION WILL BE SPECIFIED IN THE FOLLOWING', 1 I3, ' COLORS:',//, ( ' ', T8, A8,/)) C C END SUBROUTINE SLKSET C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PROCESSES THE $SLACK DIRECTIVE. C C COMPILATION INSTRUCTIONS: C C SLKSET,SLKSET/-SP=SLKSET C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - SLKSET - DOCUMENTATION. C C THE FORMAT OF THE $SLACK DIRECTIVE IS: C C $SLACK LENGTH C C WHERE LENGTH IS THE INTEGER NUMBER OF TENTHS OF INCHES TO ALLOW AS SLACK. C C CALLING SEQUENCE: C C CALL BY: CALL SLKSET C C C C ON EXIT: THIS ROUTINE PRODUCES LISTING OUTPUT C C ERROR CONDITIONS: C C AN INVALID VALUE OF LENGTH (SUCH AS AN ALPHAMERIC) CAUSES A FATAL C ERROR. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C GETLEX HDRCHK POP C C PAGE 3 - SLKSET - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' INCLUDE 'PARAM.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ITMP !GETLEX ASSOCIATED VARIABLE BYTE SBTTL(24) !BLANK SUBTITLE FIELD C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 24*' ' / C C PAGE 4 - SLKSET C SLACK=0.0 10 CALL GETLEX(ITMP) GOTO (30, 30, 10, 40, 20) ITMP C 20 CALL POP(ITMP) SLACK=FLOAT(ITMP)/10. CALL HDRCHK(SBTTL,2) WRITE (ISYSOU, 100) SLACK RETURN C C 30 CALL DSKMSG(10,5) C C 40 CALL DSKMSG(11,5) C C 100 FORMAT (1H0, 'WIRE LENGTHS INCLUDE',F4.1,' INCHES OF SLACK.') C C END