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 EDCHAN EDIT THE CHAIN LISTS C CHACHK PERFORM LOGICAL CHECK ON THE CHAINLIST C CHACHP PERFORM ELECTRICAL CHECKS ON THE CHAINLIST C MINI OPTIMIZE THE CHAINS C COLOUR ASSIGN WIRE COLORS C MSGPRT ERROR MESSAGE LISTING GENERATOR C WIRLEN WIRE INVENTORY ROUTINE C WIRLST WIRE LISTING GENERATOR C CREF CROSS REFERENCE LISTING GENERATOR C STATS STATISTICS PAGE GENERATOR SUBROUTINE EDCHAN 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.02 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE TRANSFERS THE CHAINS STORED IN THE WORK AREA TO THE COMMON C AREA "CHAINS", CONCATENATING SUBCHAINS WITH THE SAME CHAIN NUMBER. C C COMPILATION INSTRUCTIONS: C C EDCHAN,EDCHAN/-SP=EDCHAN C [FILE WIRCOM.FTN INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 17-MAY-78 ORIGINAL CODE C V01.01 RLA 1-JUN-78 MODIFY TO USE PNSPEC ROUTINE. C V01.02 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - EDCHAN - DOCUMENTATION. C C THIS ROUTINE LOOPS THROUGH ALL CHAINS STORED IN IWCHAN. C FOR EACH UNIQUE CHAIN, THE CHAIN IS TRANSFERRED TO ICHAIN, ALONG WITH ANY C OTHER CHAINS IN IWCHAN WITH THE SAME VALUE OF IWNUM. C C THE CONCATENATED CHAIN IS THEN PRINTED IN THE LISTING FILE, ALONG WITH THE C ASSIGNED CHAIN NUMBER. C C CALLING SEQUENCE: C C CALL BY: CALL EDCHAN C C C C ON EXIT: THE CHAIN LISTS HAVE BEEN TRANSFERRED TO THE "CHAINS" C AREA AND THE CONTENTS OF THE WORK AREA MAY NOW BE C DESTROYED. C C ERROR CONDITIONS: C C THIS ROUTINE DOES ARRAY CHECKING ON THE ARRAYS ICNLOC AND ICHAIN C AS THESE ARRAYS ARE FILLED. IF THE ARRAY BOUNDS ARE EXCEEDED, A C FATAL ERROR IS GENERATED. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C HDR HDRCHK MSG LINCLR PNSPEC C C PAGE 3 - EDCHAN - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' INCLUDE 'PARSE.COM' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER NUM !NUMBER OF PINS IN CHAIN INTEGER I,J,K,L,M,N !DO INDICES INTEGER JS,JF !DO LIMITS INTEGER IDEV !INTERNAL DEVICE NUMBER INTEGER IPIN !INTERNAL PIN NUMBER REAL*8 SBTTL(3) !SUBTITLE FIELD C C COMMON AREAS C INTEGER IWNCN !NUMBER OF CHAINS IN WORK SPACE INTEGER IWLOC(NMCHAN) !POINTER TO START OF WORKSPACE CHAINLIST BYTE IWCHAN(2,NMCHPN) !WORK SPACE CHAIN LIST INTEGER IWNXT !NEXT UNUSED LOCATION IN IWCHAN INTEGER IWNUM(NMCHAN) !INTERNAL CHAIN NUMBER INTEGER IWCUR !INTERNAL CHAIN NUMBER TO BE USED NEXT BYTE IWTYP(NMCHAN) !CHAIN TYPE BYTE IW(7+5*NMCHAN+2*NMCHPN) !WORK SPACE ALLOCATION EQUIVALENCE (IWNCN,IW(1)) EQUIVALENCE (IWLOC(1),IW(3)) EQUIVALENCE (IWCHAN(1,1),IW(3+2*NMCHAN)) EQUIVALENCE (IWNXT,IW(3+2*NMCHAN+2*NMCHPN)) EQUIVALENCE (IWNUM(1),IW(5+2*NMCHAN+2*NMCHPN)) EQUIVALENCE (IWCUR,IW(5+4*NMCHAN+2*NMCHPN)) EQUIVALENCE (IWTYP(1),IW(7+4*NMCHAN+2*NMCHPN)) COMMON / WORK / IW C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 'CHAIN LI', 'ST', ' ' / C C PAGE 4 - EDCHAN C C C *** PREPARE FOR PROCESSING CHAINS BY SETTING UP A CLEAN PAGE FOR OUTPUT, C AND INITIALIZING THE NECESSARY POINTERS AND FLAGS. C CALL HDR(SBTTL) IWNXT=1 NCN=0 IWCUR=0 C C *** MAIN PROCESSING LOOP. C SKIP SUBCHAINS ALREADY PROCESSED. C FOR A NEW CHAIN, INCREMENT NCN, SET UP THE ICNLOC POINTER, AND ZERO C THE PINS COUNTER. C ARRAY CHECK ICNLOC. C DO 100 I=1,IWNCN IF (IWNUM(I) .LE. IWCUR) GOTO 100 IWCUR=IWNUM(I) NUM=0 NCN=NCN+1 IF (NCN .GT. NMCHAN) GOTO 200 ICNLOC(NCN)=IWNXT C C *** SECONDARY PROCESSING LOOP. C FOR THIS AND ALL FOLLOWING CHAINS, SEARCH FOR CHAINS FOR WHICH IWNUM C IS EQUAL TO IWCUR. ALL SUCH CHAINS ARE PARTS OF THE CURRENT CHAIN. C FOR EACH SUCH CHAIN, COPY IT INTO THE ICHAIN AREA, INCREMENTING THE C ICHAIN POINTER (IWNXT) AND THE NUMBER OF PINS (NUM) AS WE GO. C WHEN THIS PROCESS IS OVER, THE CONTENTS OF THE NEWLY FORMED REGION C OF ICHAIN WILL CONSIST OF THE CONCATENATED CHAIN. C DO 50 J=I,IWNCN IF (IWNUM(J) .NE. IWCUR) GOTO 50 JS=IWLOC(J) JF=IWLOC(J+1)-1 DO 50 K=JS,JF IF (IWCHAN(1,K) .EQ. 0) GOTO 50 ICHAIN(1,IWNXT)=IWCHAN(1,K) ICHAIN(2,IWNXT)=IWCHAN(2,K) IWNXT=IWNXT+1 NUM=NUM+1 IF (IWNXT .GT. NMCHPN) GOTO 300 50 CONTINUE C C *** NEXT WE FILL IN THE CHAIN-TYPE FIELD. C ICNTYP(NCN)=IWTYP(I) C C PAGE 5 - EDCHAN C C C *** NOW WE WANT TO PRINT THE ENTIRE CHAIN. C THE PRINTOUT SHOULD INCLUDE THE CHAIN NUMBER ASSIGNED (IN THIS CASE C NCN), AND ALL OF THE PIN SPECIFICATIONS (USING LOCATION SYMBOLS AS C APPROPRIATE AND PIN ALIASES FOR CONNECTORS AS NEEDED. C C TEN PIN SPECS WILL BE PRINTED ON THE LINE. IF THE CHAIN CONTAINS C MORE THAN TEN PINS, THE REST OF THE PINS WILL BE LISTED ON C CONTINUATION LINES (CHAIN NUMBER FIELD BLANK, FIRST PIN SPEC FIELD C BLANK, AND UP TO NINE PIN SPEC FIELDS ON THE REMAINDER OF THE LINE.) C CALL LINCLR ENCODE (6,1000,LINBUF) NCN M=NUM IF (M .GT. 10) M=10 J=12 N=1 60 DO 70 K=N,M KK=ICNLOC(NCN)+K-1 IDEV=ICHAIN(1,KK) IPIN=ICHAIN(2,KK) CALL PNSPEC(IDEV,IPIN,1,LINBUF(J)) J=J+11 70 CONTINUE CALL HDRCHK(SBTTL,1) WRITE (ISYSOU,1200) (LINBUF(IC),IC=1,IBF) IF (NUM .LE. M) GOTO 90 N=M+1 M=M+9 IF (M .GT. NUM) M=NUM J=23 CALL LINCLR GOTO 60 C C *** NOW WE CHECK TO SEE IF THE CHAIN JUST PRINTED CONTAINED ONLY ONE PIN. C IF IT DID, THIS IS AN ERROR. WE PRINT A WARNING MESSAGE (BOTH IN THE C ERROR FILE AND IN THE CHAIN LIST), AND DELETE THE ONE-PIN CHAIN. C 90 IF (NUM .GT. 1) GOTO 100 CALL DSKMSG(72,1) CALL HDRCHK(SBTTL,1) WRITE (ISYSOU,1400) NCN=NCN-1 C C *** DONE WITH THE MAIN PROCESSING LOOP. C 100 CONTINUE C C PAGE 5 A - EDCHAN C C C *** LEAVE A POINTER BEHIND SO THAT IT IS POSSIBLE TO CALCULATE THE C LENGTH OF THE LAST CHAIN. C ICNLOC(NCN+1)=IWNXT RETURN C C PAGE 6 - EDCHAN C C C *** ERROR MESSAGE HANDLERS C 200 CALL DSKMSG(73,4) C 300 CALL DSKMSG(74,4) C C C *** FORMAT STATEMENTS C C 1000 FORMAT (I6) C 1200 FORMAT (' ', 132A1) C 1400 FORMAT (' [NULL CHAIN DELETED]') C C END SUBROUTINE CHACHK 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: V02.02 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PERFORMS SOME BASIC CONSISTENCY CHECKS ON THE INTEGRITY C OF THE CHAIN LIST. C C IT CHECKS FOR MULTIPLE APPEARANCES OF A PIN IN A CHAIN, C AND C IT CHECKS FOR APPEARANCES OF A PIN IN MORE THAT ONE CHAIN. C C COMPILATION INSTRUCTIONS: C C CHACHK,CHACHK/-SP=CHACHK C [FILE WIRCOM.FTN INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 9-JUL-75 ORIGINAL CODE C V02.00 RLA 17-MAY-78 DATA BASE CHANGES. ALSO SEPARATION C OF CHAIN INPUT FROM THE CHECKING. C V02.01 RLA 18-MAY-78 USE NEW PNSPEC ROUTINE IN LISTING. C V02.02 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - CHACHK - DOCUMENTATION. C C THE ROUTINE CONSISTS OF ONE BIG LOOP OVER ALL CHAINS. WITHIN THE BIG C LOOP, ARE TWO BASIC LOOPS. ONE OF THEM CHECKS TO MAKE SURE THAT EACH PIN C SPECIFIED IN THE CHAIN OCCURS ONLY ONCE. IF NOT, AN ERROR MESSAGE IS C PRINTED INDICATING THAT THERE IS A LOOP AROUND THE PIN. C C THE OTHER LOOP LOOKS TO MAKE SURE THAT THE PIN DOES NOT OCCUR IN ANY OTHER C CHAIN. IF IT DOES, AN ERROR MESSAGE IS PRINTED INDICATING THAT THERE IS C AN INTERCHAIN CONNECTION. C C CALLING SEQUENCE: C C CALL BY: CALL CHACHK C C C C C ERROR CONDITIONS: C C THE ROUTINE IS AN ERROR-CHECKING PROCEDURE. C THE ERRORS DETECTED ARE DESCRIBED ABOVE. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C MSG PNSPEC C C PAGE 3 - CHACHK - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'CHAINS.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I,J,K,KK,L !DO INDICES INTEGER I1,J1,JS,LS,JF,LF !DO LIMITS INTEGER JDEV,JPIN !DEVICE AND PIN NUMBERS BYTE LTMP(4) !TEMPORARY STORAGE FOR STRING C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - CHACHK C C C *** LOOP OVER ALL CHAINS. C C FOR EACH CHAIN, LOOP OVER ALL PINS OF THE CHAIN. C C LOOP OVER ALL REMAINING PINS IN THE CHAIN. IF THE PIN SPEC OF ONE OF C THE REMAINING PINS IN THE CHAIN IS THE SAME AS THE PIN SPEC OF THIS C PIN, DECLARE AN ERROR AND FORMAT THE APPROPRIATE ERROR MESSAGE. C DO 100 I=1,NCN I1=I+1 JS=ICNLOC(I) JF=ICNLOC(I1)-1 DO 90 J=JS,JF JDEV=ICHAIN(1,J) JPIN=ICHAIN(2,J) J1=J+1 IF (J .EQ. JF) GOTO 50 DO 40 K=J1,JF IF (ICHAIN(1,K) .NE. JDEV) GOTO 40 IF (ICHAIN(2,K) .NE. JPIN) GOTO 40 ENCODE (52,230,LINBUF) I CALL PNSPEC(JDEV,JPIN,1,LINBUF(42)) CALL MSG(52,LINBUF,0) 40 CONTINUE C C *** LOOP OVER ALL REMAINING CHAINS. FOR EACH REMAINING CHAIN, LOOP C OVER ALL PINS IN THAT CHAIN. IF THE PIN SPEC OF A PIN IS THE SAME C AS THE PIN SPEC OF THIS PIN, DECLARE AN ERROR AND FORMAT THE C APPROPRIATE ERROR MESSAGE. C 50 IF (I .EQ. NCN) GOTO 90 DO 80 K=I1,NCN LS=ICNLOC(K) LF=ICNLOC(K+1)-1 DO 70 L=LS,LF IF (ICHAIN(1,L) .NE. JDEV) GOTO 70 IF (ICHAIN(2,L) .NE. JPIN) GOTO 70 ENCODE (67,260,LINBUF) I, K CALL PNSPEC(JDEV,JPIN,1,LINBUF(35)) CALL MSG(67,LINBUF,0) 70 CONTINUE 80 CONTINUE 90 CONTINUE 100 CONTINUE C C *** ALL DONE. C RETURN C C PAGE 5 - CHACHK C C C *** FORMAT STATEMENTS C C 230 FORMAT ('( 75) Loop within chain # ',I3,' around pin',10X,'.') C C 260 FORMAT ('( 76) Interchain connection: Pin ',10X,' in chains ', 1 I3,' and ',I3,'.') C C END SUBROUTINE CHACHP 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: V02.02 C C AUTHOR: RL AURBACH MAPC 27-OCT-78 C C THIS ROUTINE CHECKS FOR VIOLATIONS OF STANDARD ELECTRICAL RULES WITHIN C A CHAIN. C C COMPILATION INSTRUCTIONS: C C CHACHP,CHACHP/-SP=CHACHP C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE ELECTR.COM INCLUDED] C [FILE LEXATT.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 9-JUL-75 ORIGINAL CODE C V02.00 RLA 22-MAY-78 NEW DATA BASE SUPPORT. THE ROUTINE C WAS REWRITTEN TO BE TABLE-DRIVEN. C V02.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C V02.02 RLA 27-OCT-78 ADD THREE NEW DEVICE TYPES C C C PAGE 2 - CHACHP - DOCUMENTATION. C C THE ROUTINE OPENS THE FILE 'CHACHP.DAT' AND READS IT INTO THE WORK AREA, C CONVERTING THE STYLIZED FORMAT OF THE TABLE TO AN INTEGER NOTATION SUITABLE C FOR USE WITH COMPUTED GOTO DISPATCHING. C C THEN A LOOP IS MADE OVER ALL CHAINS. FOR EACH CHAIN, THE ELECTRICAL CODE C OF EACH PIN IS LOOKED UP. THE CORRESPONDING ENTRY IN THE WORK TABLE IS C FOUND AND A CHECK IS MADE TO SEE IF THE OBSERVED PROPERTY OF THIS PIN IS C SUCH AS TO MAKE A CHECK FLAG TRUE, FALSE, OR DON'T CARE. C C WHEN THE CHAIN IS DONE, THE APPROPRIATE COMBINATION OF ENTRIES IS CHECKED C TO SEE IF AN ERROR OF THE GIVEN TYPE SHOULD BE DECLARED. IF IT SHOULD BE C DECLARED, THE APPROPRIATE ERROR MESSAGE IS PRINTED. C C DURING THESE CHECKS, THE TOTAL FANOUTS AND LOADING OF THE CHAIN IS DETERMINED C SO THAT LOADING ERRORS MAY BE DETECTED ALSO. C C THE FORMAT OF THE CHACHP.DAT FILE AND THE INTERNAL WORK FILE WILL BE C DESCRIBED BELOW. ALSO THE ERROR-GENERATION REQUIREMENTS/OPTIONS WILL BE C DISCUSSED. C C CALLING SEQUENCE: C C CALL BY: CALL CHACHP C C C C ON EXIT: ERROR MESSAGES WILL HAVE BEEN GENERATED FOR ANY C DETECTED ERROR CONDITIONS. C C ERROR CONDITIONS: C C THIS ROUTINE IS AN ERROR CHECKER. THE BEST STATEMENT OF WHAT ERRORS C IT CURRENTLY DETECTS MAY BE OBTAINED BY STUDYING THE CHACHP.DAT C FILE. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C MSG SAVE RESTOR GETLEX POP TRANSF C C PAGE 2 A - CHACHP - FILE CHACHP.DAT FORMAT C C THIS FILE CHACHP.DAT IS THE FILE WHICH CONTAINS THE ERROR-CHECKING TABLES. C THE FILE CONSISTS OF AN ARBITRARY NUMBER OF LINES (UP TO 60 NON-COMMENT C LINES ARE CURRENTLY ALLOWED), EACH OF WHICH CONTAINS THE INFORMATION NEEDED C FOR ONE ELECTRICAL CHECK. THE FORMAT OF A LINE IS: C C Q Q Q Q Q Q Q Q Q Q Q Q Q Q Q Q Q Q Q Q %MESSAGE C C WHERE C Q IS ANY ALLOWED SINGLE-CHARACTER SYMBOL (SEE BELOW) C % IS THE MESSAGE-TEXT SPECIAL DELIMITER. THIS CHARACTER MUST C BE PRESENT. THE ERROR MESSAGE WILL BEGIN IN THE CHARACTER C POSITION IMMEDIATELY FOLLOWING THIS CHARACTER. C MESSAGE IS THE ERROR MESSAGE (MINUS THE ***WARNING: CHAIN # NNN: C HEADER, WHICH IS ADDED ELSEWHERE). MESSAGE LENGTHS MAY BE UP C TO 40 CHARACTERS (ADDITIONAL LENGTH IS HARMLESS -- IT WILL C NOT BE DISPLAYED). C C THE TERMINATORS MAY BE ANY NON-ALPHANUMERIC CHARACTERS. SPACES ARE C USUALLY USED BETWEEN SYMBOLS AND A TAB IS USUALLY USED BETWEEN C THE LAST SYMBOL AND THE % SYMBOL. C C THE 20 SYMBOLS REPRESENT THE CONDITIONS NECESSARY ON ELECTRICAL CODES FOR C THE CHAIN TO CONTAIN AN ERROR. SINCE THERE ARE 20 LEGAL ELECTRICAL CODES, C THERE ARE 20 ENTRIES, WHICH MUST BE IN ORDER (STARTING WITH 0 AND GOING TO C 19). MISSING CODES ARE NOT PERMITTED. C C THE ELECTRICAL CODES ARE: C 0 NOT USED C 1 TTL INPUT C 2 TTL TOTEM POLE OUTPUT C 3 DIGITAL POWER C 4 DIGITAL GROUND C 5 DON'T CARE C 6 ANALOG C 7 TTL OPEN-COLLECTOR OUTPUT C 8 TTL TRI-STATE OUTPUT C 9 RESISTOR PULLUP C 10 NON-TTL INPUT C 11 NON-TTL OUTPUT C 12 POSITIVE ANALOG SUPPLY C 13 NEGATIVE ANALOG SUPPLY C 14 ANALOG GROUND C 15 OTHER POWER SUPPLY C 16 AC POWER C 17 SWITCH CLOSURE C 18 DISCRETE COMPONENTS USED AS DIGITAL CIRCUIT ELEMENTS C 19 LED, LAMP, RELAY, ETC -- POWER DEVICE C C C PAGE 2 B - CHACHP - FILE CHACHP.DAT FORMAT (CONTINUED) C C THERE ARE 7 VALID VALUES FOR THE SYMBOLS WHICH OCCUR IN THE 20 ENTRIES C IN A LINE IN THE TABLE. THESE VALUES ARE RELATED TO THE REQUIREMENTS C WHICH MUST BE TRUE FOR AN ERROR OF THE TYPE DESCRIBED BY THAT LINE IN C TABLE TO BE DETECTED. C C THE PHILOSOPHY BEHIND THE SELECTION OF THE VALUES IS THAT ONE WOULD LIKE C TO BE ABLE TO SPECIFY AN ERROR BEING A DETECTED IF A CHAIN HAD (FOR EXAMPLE) C NO PINS OF ONE TYPE AND AT LEAST ONE PIN OF A SECOND TYPE AND EITHER PINS C OF TYPES THREE OR FOUR. C C IN ORDER TO REPRESENT SUCH A REQUIREMENT, THE VALUES FALL INTO THREE CLASSES. C THE FIRST CLASS IS THE DON'T CARE CLASS. IF IT IS IRRELEVANT WHETHER OR NOT C THE CHAIN CONTAINS PINS OF THAT ELECTRICAL TYPE FOR AN ERROR TO OCCUR, THEN C THE ENTRY IN THE ERROR TABLE WOULD BE DONT-CARE (SYMBOL X). FOR EXAMPLE, C IT IS IRRELEVANT HOW MANY INPUTS ARE SPECIFIED (IF ANY) IF YOU ARE CHECKING C FOR WHETHER A TOTEM-POLE OUTPUT IS CONNECTED TO AN OPEN-COLLECTOR OUTPUT. C C THE SECOND CLASS OF VALUES ARE THE "AND" VALUES. THESE VALUES DEAL WITH C CONDITIONS WHICH MUST ALL BE SATISFIED IF AN ERROR IS TO BE DECLARED. C FOR EXAMPLE, IF YOU ARE CHECKING ON WHETHER A CHAIN WITH INPUTS HAS ANY C OUTPUTS, THE CHECK MUST FAIL IF THE CHAIN HAS NO INPUTS. THERE ARE THREE C "AND"-CLASS VALUES. IF THERE IS AN ERROR WHEN NO PINS HAVE THAT C CHARACTERISTIC, SPECIFY THE VALUE N. IF THERE IS AN ERROR WHEN ONE OR MORE C PINS HAVE THAT CHARACTERISTIC, SPECIFY THE VALUE Y. IF THERE IS AN ERROR C WHEN MORE THAN ONE PIN HAS THAT CHARACTERISTIC, SPECIFY M. C C THE FINAL CLASS OF VALUES ARE THE "OR" VALUES. THESE VALUES DEAL WITH C CASES WHEN AN ERROR OCCURS WHEN ONE OR MORE OF SEVERAL CONDITIONS ARE MET. C "OR"-CLASS CONDITIONS ARE ALL LOGICAL-ORED TOGETHER AND THEN LOGICAL-ANDED C WITH THE "AND" CLASS CONDITIONS. AN EXAMPLE IS THE CASE WHEN WE ARE C CHECKING FOR A MIXTURE OF TOTEM-POLE, OPEN-COLLECTOR, AND TRI-STATE C OUTPUTS IN A SINGLE CHAIN. THE CHECK CONDITION IS AT LEAST ONE TOTEM-POLE C OUTPUT AND EITHER AT LEAST ONE OPEN-COLLECTOR OUTPUT OR AT LEAST ONE C TRI-STATE OUTPUT. IF AN ERROR OCCURS FOR NO PINS OF THAT CHARACTERISTIC C SPECIFY 0. IF AN ERROR OCCURS FOR AT LEAST ONE PIN WITH THAT CHARACTERISTIC C SPECIFY 1. IF AN ERROR OCCURS FOR MORE THAN ONE PIN WITH THAT C CHARACTERISTIC, SPECIFY 2. C C NOTE THAT THE CONDITIONS SPECIFIED IN THE CHACHP.DAT FILE ARE THE CONDITIONS C WHICH, IF SATISFIED, RESULT IN AN ERROR, NOT LEGAL CONDITIONS. C C TO SUMMARIZE: C X DON'T CARE C N "AND"-CLASS ERROR IF NO PINS OF THIS TYPE PRESENT C Y "AND"-CLASS ERROR IF AT LEAST ONE PIN OF THIS TYPE PRESENT C M "AND"-CLASS ERROR IF AT LEAST 2 PINS OF THIS TYPE PRESENT C 0 "OR"-CLASS ERROR IF NO PINS OF THIS TYPE PRESENT C 1 "OR"-CLASS ERROR IS AT LEAST 1 PIN OF THIS TYPE PRESENT C 2 "OR"-CLASS ERROR IF AT LEAST 2 PINS OF THIS TYPE PRESENT C C C C PAGE 2 C - CHACHP - INTERNAL FORMAT C C C WHEN THIS FILE IS READ AND STORED INTERNALLY, THESE SYMBOLS ARE CONVERTED C TO INTEGERS SO THAT DISPATCHING MAY BE DONE VIA A COMPUTED GOTO STATEMENT. C THE FORMAT FOR THIS CONVERSION IS: C C !-------!-------! C !NUMBER ! SYMBOL! C !-------!-------! C ! 1 ! 0 ! C !-------!-------! C ! 2 ! 1 ! C !-------!-------! C ! 3 ! 2 ! C !-------!-------! C ! 4 ! N ! C !-------!-------! C ! 5 ! Y ! C !-------!-------! C ! 6 ! M ! C !-------!-------! C ! 7 ! X ! C !-------!-------! C C C PAGE 3 - CHACHP - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARSE.COM' INCLUDE 'CHAINS.COM' INCLUDE 'ELECTR.COM' INCLUDE 'LEXATT.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER NERR !NUMBER OF ERROR CHECKS IN FILE INTEGER ITMP,I,J,K,L !DUMMY VARIABLES INTEGER JS,JF,JD,JP,JE !DUMMY VARIABLES INTEGER JOR,NCHR !DUMMY VARIABLES INTEGER IOUT,IIN,IDELT !DUMMY VARIABLES LOGICAL LAND,LOR !LOGICAL VARIABLES INTEGER JN,JY,JM,JX !CHARACTER VARIABLES BYTE PRCENT !'%' C C COMMON AREAS C INTEGER IWERR(MXELCD,60) !STORAGE FOR ERROR CODES FROM FILE INTEGER IWMSGL(60) !LENGTH OF STORED ERROR MESSAGES BYTE IWMSG(40,60) !STORED ERROR MESSAGES INTEGER IWTMP(2,MXELCD) !STORAGE FOR INFO ABOUT THE CURRENT CHAIN BYTE IW(124*(MXELCD)+2520) EQUIVALENCE (IWERR(1,1),IW(1)) EQUIVALENCE (IWMSGL(1),IW(1+120*(MXELCD))) EQUIVALENCE (IWMSG(1,1),IW(1+120*(MXELCD+1))) EQUIVALENCE (IWTMP(1,1),IW(1+120*(MXELCD+1)+2400)) COMMON / WORK / IW C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA JN,JY,JM,JX / 'N ', 'Y ', 'M ', 'X ' / DATA PRCENT / '%' / C C PAGE 4 - CHACHP C C C *** OPEN THE ERROR TABLE FILE 'CHACHP.DAT' ON LUN ISYS2, SAVING THE STATE C OF THE SYSTEM FOR FUTURE USE. C OPEN (UNIT=ISYS2,NAME='CHACHP.DAT',READONLY,TYPE='OLD',ERR=1000) CALL SAVE ISYSIN=ISYS2 NERR=0 C C *** FIND THE NEXT LINE OF ERROR-TABLE INPUT. C 10 CALL GETLEX(ITMP) GOTO (90,10,10,11,11) ITMP 11 NERR=NERR+1 C C *** LOOP OVER ALL LEGAL ENTREES IN THIS LINE OF THE TABLE. STORE A BYTE C FOR EACH ELECTRICAL TYPE. IF THE ENTRY FOR THE TYPE IS AN INTEGER, C STORE THE INTEGER + 1. CONVERT THE LETTER ENTRIES TO NUMBERS AS C DISCUSSED ABOVE. C DO 20 I=1,MXELCD 12 IF (I .NE. 1) CALL GETLEX(ITMP) 13 GOTO (1010,1010,14,16,15) ITMP C C CHECK FOR A % SYMBOL. IF FOUND, THE ERROR LIST DOES NOT CONTAIN ALL OF C THE NECESSARY ENTRIES. THIS IS AN ERROR. C 14 IF (LINBUF(NEXCHR-1) .EQ. PRCENT) GOTO 1010 GOTO 12 C C THE CHARACTER IS A NUMBER. PUT THE NUMBER+1 IN THE TABLE ENTRY. C 15 CALL POP(ITMP) IWERR(I,NERR)=ITMP+1 GOTO 20 C C THE CHARACTER IS A LETTER. CONVERT THE LETTER TO A NUMBER ACCORDING C TO THE PROCEEDING DISCUSSION AND STORE SAME. C 16 CALL POP(ITMP) IF (ITMP .GT. 1) GOTO 1020 !CHARACTER STRING LENGTH ILLEGAL CALL POP(ITMP) CALL TRANSF(LINBUF(ITMP),1,J,2) ITMP=0 IF (J .EQ. JN) ITMP=4 IF (J .EQ. JY) ITMP=5 IF (J .EQ. JM) ITMP=6 IF (J .EQ. JX) ITMP=7 IF (ITMP .EQ. 0) GOTO 1030 !CHARACTER CODE NOT RECOGNIZED. IWERR(I,NERR)=ITMP C 20 CONTINUE C C PAGE 4 A - CHACHP C C C *** NOW WE GO GET THE ERROR MESSAGE AND STORE IT IN THE TABLE. C 30 CALL GETLEX(ITMP) GOTO (1010,1010,33,31,32) ITMP 31 CALL POP(ITMP) 32 CALL POP(ITMP) CALL DSKMSG(77,0) IWMSGL(NERR)=0 GOTO 10 33 IF (LINBUF(NEXCHR-1) .NE. PRCENT) GOTO 30 C C WE FOUND THE ERROR MESSAGE. CALCULATE ITS LENGTH AND STORE IT AWAY. C IWMSGL(NERR)=ICHAR-NEXCHR+1 CALL TRANSF(LINBUF(NEXCHR),IWMSGL(NERR),IWMSG(1,NERR),40) C C *** NOW WE ARE DONE STORING THIS TABLE ENTRY. GO GET THE NEXT ONE. C NEWLIN=.TRUE. GOTO 10 C C *** WE HAVE COME TO THE END OF THE TABLE. CLOSE THE FILE, RESTORE THE C OLD CONTEXT AND PROCEED WITH THE PROCESSING. C 90 IF (ICODE .EQ. 2) GOTO 1005 CLOSE (UNIT=ISYS2) CALL RESTOR C C PAGE 5 - CHACHP C C C *** THE PROCESSING OF THE ERROR CHECKING IS A BIG LOOP OVER ALL CHAINS. C EACH CHAIN IS CONSIDERED INDIVIDUALLY. THE FIRST STEP IS TO GO C THROUGH THE CHAIN AND STORE IN A TEMPORARY ARRAY THE NUMBER OF C INSTANCES OF EACH ELECTRICAL TYPE IN THE CHAIN (IN IWTMP(1,N)) AND C THE TOTAL LOADING FACTOR FOR THAT TYPE (IN IWTMP(2,N)). C THE IWTMP ARRAY WILL FIRST, OF COURSE, BE CLEARED. C NOTE ALSO THAT ELECTRICAL TYPES RUN FROM 0 TO 16 CURRENTLY. THEY WILL C BE ENTERED IN ELEMENTS 1 TO 17 RESPECTIVELY OF THE IWTMP ARRAY. C DO 180 I=1,NCN JS=ICNLOC(I) JF=ICNLOC(I+1)-1 DO 100 J=1,MXELCD IWTMP(1,J)=0 100 IWTMP(2,J)=0 DO 110 J=JS,JF JD=ICHAIN(1,J) JP=ICHAIN(2,J) JE=IELOC(JD)+JP-1 K=IPINEL(1,JE)+1 L=IPINEL(2,JE) IWTMP(1,K)=IWTMP(1,K)+1 110 IWTMP(2,K)=IWTMP(2,K)+L C C PAGE 5 A - CHACHP C C C *** NOW WE ARE READY FOR THE CHECKS. WE LOOP OVER ALL ERROR CHECKS. C FOR EACH CHECK, WE LOOP OVER ALL POSSIBLE ELECTRICAL CONDITIONS. C IF A GIVEN CONDITION IS SATISFIED, THE RESPECTIVE "AND" OR "OR" C FLAG IS MODIFIED AND AN INDICATOR IS SET TO INDICATE THAT THE C RESPECTIVE FLAG HAS BEEN USED. C DO 150 J=1,NERR LAND=.TRUE. JOR=0 LOR=.FALSE. DO 140 K=1,MXELCD ITMP=IWERR(K,J) GOTO (121,122,123,124,125,126,140) ITMP C 121 JOR=1 IF (IWTMP(1,K) .NE. 0) GOTO 140 LOR=.TRUE. GOTO 140 C 122 JOR=1 IF (IWTMP(1,K) .EQ. 0) GOTO 140 LOR=.TRUE. GOTO 140 C 123 JOR=1 IF (IWTMP(1,K) .LT. 2) GOTO 140 LOR=.TRUE. GOTO 140 C 124 IF (.NOT. LAND) GOTO 140 IF (IWTMP (1,K) .NE. 0) LAND=.FALSE. GOTO 140 C 125 IF (.NOT. LAND) GOTO 140 IF (IWTMP(1,K) .EQ. 0) LAND=.FALSE. GOTO 140 C 126 IF (.NOT. LAND) GOTO 140 IF (IWTMP(1,K) .LT. 2) LAND=.FALSE. GOTO 140 C 140 CONTINUE C C PAGE 5 B - CHACHP C IF (JOR .EQ. 1) LAND=LAND .AND. LOR C C *** IF LAND IS FALSE, THERE IS NO ERROR. C ELSE, AN ERROR HAS BEEN FOUND -- PRINT THE ERROR MESSAGE. C IF (.NOT. LAND) GOTO 150 K=IWMSGL(J) NCHR=K+16 ENCODE (NCHR,2000,LINBUF) I,(IWMSG(L,J),L=1,K) CALL MSG(NCHR,LINBUF,0) 150 CONTINUE C C PAGE 5 C - CHACHP C C C *** NOW WE MUST CHECK ON FANOUT. C C THE 20 ELECTRICAL TYPES MAY BE CATEGORIZED AS HAVING "INPUT-LIKE" C FAN-IN PROPERTIES, "OUTPUT-LIKE" FAN-OUT PROPERTIES, OR NO LOADING C PROPERTIES. FOR EXAMPLE, A RELAY COIL HAS "INPUT-LIKE" FAN-IN, AN C OPEN-COLLECTOR OUTPUT HAS "OUTPUT-LIKE" FAN-OUT, AND THE ELECTRICAL C POWER CONNECTIONS HAVE NO ASSOCIATED LOADING CHARACTERISTICS. C C THE FAN-IN OF ALL "INPUT-LIKE" DEVICES IS SUMMED, AS IS THE FAN-OUT C OF ALL "OUTPUT-LIKE" DEVICES. IF A CHAIN HAS A TOTAL FANOUT OF ZERO, C IT IS ASSUMED THAT DEVICES WHICH HAVE NO LOADING PROVIDE THE NEEDED C FANOUT. IF, HOWEVER, AN OUTPUT FANOUT IS SPECIFIED, THEN IT MUST BE C GREATER THAN OR EQUAL TO THE INPUT LOADING. C IOUT=IWTMP(2,3)+IWTMP(2,6)+IWTMP(2,8)+IWTMP(2,9)+IWTMP(2,12) IIN=IWTMP(2,2)+IWTMP(2,10)+IWTMP(2,11)+IWTMP(2,19)+IWTMP(2,20) IF (IOUT .EQ. 0) GOTO 180 IF (IOUT .GE. IIN) GOTO 180 C C *** THIS IS THE COMMON ERROR PROCESSOR FOR FANOUT ERRORS C C AN APPROPRIATE MESSAGE IS CONSTRUCTED AND PRINTED. C 170 IDELT=IIN-IOUT ENCODE (66,2010,LINBUF) I,IDELT CALL MSG(65,LINBUF,0) C C 180 CONTINUE RETURN C C PAGE 6 - CHACHP C C C *** ERROR HANDLERS C C 1000 CALL DSKMSG(78,0) RETURN C C 1005 CALL DSKMSG(79,0) RETURN C C 1010 CALL DSKMSG(80,0) IF (ICODE .EQ. 2) GOTO 1005 1011 NEWLIN=.TRUE. LEXSP=LEXMX+1 IWMSGL(NERR)=0 GOTO 10 C C 1020 CALL DSKMSG(81,0) GOTO 1011 C C 1030 CALL DSKMSG(82,0) GOTO 1011 C C *** ENCODE FORMAT STATEMENTS C C 2000 FORMAT ('In chain #',I4,': ',40A1) C C 2010 FORMAT ('( 83) In chain #',I4, 1 ': input loading exceeded fanout by', 1 I4,' loads.') C C END SUBROUTINE MINI 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.02 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE MINIMIZES THE TOTAL LENGTH OF EACH CHAIN BY REARRANGING C THE ORDER IN WHICH THE POSTS ARE CONNECTED. C C THE ROUTINE WILL HANDLE CHAINS WITH AS MANY AS 100 POSTS. C C COMPILATION INSTRUCTIONS: C C MINI,MINI/-SP=MINI C [FILE WIRCOM.FTN INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 9-JUL-75 ORIGINAL CODE C V01.01 RLA 24-MAY-78 MINOR CHANGES IN DATA BASE USE C V01.02 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - MINI - DOCUMENTATION. C C THIS ROUTINE IS A LOOP OVER ALL CHAINS. C C FOR EACH CHAIN, THE ROUTINE FIRST CALCULATES AND PRESTORES THE DISTANCE C BETWEEN EVERY PAIR OF POSTS. ALL POSTS EXCEPT THE FIRST ARE SHOWN AS C UNUSED. THE MINIMIZATION IS THEN BASED ON THE GENERATION OF A TREE WITH C LEFT AND RIGHT BRANCHES. THE FIRST POST GOES IN THE LEFT BRANCH. THE C NEAREST POST GOES INTO THE RIGHT BRANCH. THEN WE CALCULATE THE CLOSEST C POSTS TO THE ENDS OF THE LEFT AND RIGHT BRANCHES. WHICHEVER IS CLOSER TO C ITS RESPECTIVE BRANCH-END IS ADDED TO ITS RESPECTIVE BRANCH. THIS PROCESS C CONTINUES UNTIL ALL POSTS ARE USED. C C WHEN ALL DONE, THE POSTS ARE COPIED IN CORRECT ORDER INTO A TEMPORARY C ARRAY AND FROM THAT BACK INTO THE AREA OF ICHAIN IN WHICH THE CHAIN IS C STORED. (NOTE THAT THE COPY MAY NOT BE MADE DIRECTLY BECAUSE OF PROBLEMS C OF OVERWRITTEN DATA.) C C CALLING SEQUENCE: C C CALL BY: CALL MINI C C C ON ENTRY: THE ICHAIN ARRAY HAS NOT BEEN ORDERED. C C ON EXIT: THE ICHAIN ARRAY HAS BEEN ORDERED SO AS TO MINIMIZE C WIRE LENGTH. C C ERROR CONDITIONS: C C ARRAY CHECKING INVOLVES MAKING SURE THAT NPOSTS IS NOT GREATER THAT C NMPOST. THE ERROR IS HIGHLY FATAL. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C INDX MINLEN LENGTH MSG C C PAGE 3 - MINI - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' D INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I,J,K,M INTEGER II,IT,JDEV,JPIN,JT,JS,JF INTEGER J1,KDEV,KPIN INTEGER NLF,NRT,JLF,JRT,JRM,JLM INTEGER LRM,LLM,NTOT C C COMMON AREAS C PARAMETER NMPOST=100 INTEGER NPOSTS BYTE IPOST(NMPOST) BYTE ILF(NMPOST) BYTE IRT(NMPOST) BYTE LENRT(NMPOST) BYTE LENLF(NMPOST) BYTE ITMP(2,NMPOST) BYTE LEN(NMPOST*(NMPOST-1)/2) BYTE IW(NMPOST*(NMPOST+13)/2+2) EQUIVALENCE (NPOSTS,IW(1)) EQUIVALENCE (IPOST(1),IW(3)) EQUIVALENCE (ILF(1),IW(3+NMPOST)) EQUIVALENCE (IRT(1),IW(3+2*NMPOST)) EQUIVALENCE (LENRT(1),IW(3+3*NMPOST)) EQUIVALENCE (LENLF(1),IW(3+4*NMPOST)) EQUIVALENCE (ITMP(1,1),IW(3+5*NMPOST)) EQUIVALENCE (LEN(1),IW(3+7*NMPOST)) COMMON / WORK / IW C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - MINI C C C *** DO BIG LOOP OVER ALL CHAINS C DO 200 M=1,NCN JS=ICNLOC(M) JF=ICNLOC(M+1)-1 C C *** FIRST CALCULATE THE DISTANCE BETWEEN EACH PAIR OF POSTS IN THE CHAIN C AND SAVE IT IN AN ARRAY FOR FAST RETRIEVAL. C DO 20 J=JS,JF IF (J .EQ. JF) GOTO 20 J1=J+1 JT=J-JS+1 JDEV=ICHAIN(1,J) JPIN=ICHAIN(2,J) DO 30 K=J1,JF KDEV=ICHAIN(1,K) KPIN=ICHAIN(2,K) IT=LENGTH(JDEV,JPIN,KDEV,KPIN) LEN(INDX(JT,K-JS+1))=IT 30 CONTINUE 20 CONTINUE C C *** CALCULATE THE NUMBER OF POSTS. (ARRAY CHECK) C SET THE FIRST POST 'USED' AND ALL OTHERS 'UNUSED'. C NPOSTS=JF-JS+1 IF (NPOSTS .GT. NMPOST) CALL DSKMSG(84,4) IPOST(1)=.TRUE. DO 40 I=2,NPOSTS 40 IPOST(I)=.FALSE. C C PAGE 5 - MINI C C C *** PUT THE FIRST POST INTO THE LEFT BRANCH AND FIND THE NEAREST POST. C THIS POST BECOMES THE START OF THE RIGHT BRANCH. C NLF=1 ILF(NLF)=1 CALL MINLEN(1,JRM,LRM) NRT=1 IRT(NRT)=JRM LENRT(NRT)=LRM IPOST(JRM)=.TRUE. C C *** CHECK IF ALL DONE C 70 NTOT=NLF+NRT IF (NTOT .GE. NPOSTS) GOTO 80 C C *** -- NOT DONE -- C C PICK THE POST CLOSEST TO THE END OF EACH BRANCH AND FIND THE POST C OR POSTS CLOSEST TO EACH OF THESE. C JLF=ILF(NLF) JRT=IRT(NRT) CALL MINLEN(JLF,JLM,LLM) CALL MINLEN(JRT,JRM,LRM) IF (LRM-LLM) 50,50,60 C C *** POST CLOSEST TO RIGHT END IS CLOSER TO THE RIGHT END THAN THE POST C CLOSEST TO THE LEFT END IS TO THE LEFT END. C 50 NRT=NRT+1 IRT(NRT)=JRM LENRT(NRT)=LRM IPOST(JRM)=.TRUE. GOTO 70 C C *** LEFT BRANCH WINS C 60 NLF=NLF+1 ILF(NLF)=JLM LENLF(NLF)=LLM IPOST(JLM)=.TRUE. GOTO 70 C C PAGE 6 - MINI C C C *** -- ALL DONE WITH THIS CHAIN -- C C PUT THE REARRANGED POSTS INTO A TEMPORARY ARRAY AND THEN REWRITE C THEM INTO THEIR ORIGINAL REGION OF ICHAIN. C C NOTE THAT LENLF(1) IS MEANINGLESS AND ITS POSITION IN ICNLEN IS C OVERLAID BY LENRT(1). C 80 DO 90 I=1,NLF II=NLF-I+1 ITMP(1,I)=ICHAIN(1,JS+ILF(II)-1) ITMP(2,I)=ICHAIN(2,JS+ILF(II)-1) ICNLEN(JS+I-1)=LENLF(II) 90 CONTINUE C C DO 100 I=1,NRT ITMP(1,NLF+I)=ICHAIN(1,JS+IRT(I)-1) ITMP(2,NLF+I)=ICHAIN(2,JS+IRT(I)-1) ICNLEN(JS+NLF+I-2)=LENRT(I) 100 CONTINUE C C DO 110 I=1,NPOSTS ICHAIN(1,JS+I-1)=ITMP(1,I) ICHAIN(2,JS+I-1)=ITMP(2,I) 110 CONTINUE C C 200 CONTINUE RETURN END SUBROUTINE COLOUR 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.02 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PICKS A COLOR FOR EACH CHAIN AND TRIES TO MINIMIZE THE C NUMBER OF TIMES TWO ADJACENT POSTS IN DIFFERENT CHAINS HAVE THE SAME C COLOR WIRE ON THEM. C C COMPILATION INSTRUCTIONS: C C COLOUR,COLOUR/-SP=COLOUR C [FILE WIRCOM.FTN INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RC 1-AUG-75 ORIGINAL CODE C V01.01 RLA 25-MAY-78 MINOR DATA BASE CHANGES C V01.02 RLA 1-SEP-78 REORGAINIZED INCLUDED COMMON AREAS C C C PAGE 2 - COLOUR - DOCUMENTATION. C C THIS ROUTINE SELECTS A COLOR FOR EACH CHAIN. AT EVERY POINT IN THE C PROCESS, THAT COLOR IS SELECTED WHICH MINIMIZES THE NUMBER OF TIMES C THAT ADJACENT PINS OF DIFFERENT CHAINS HAVE THE SAME COLOR. C C THE ROUTINE HAS AN INITIATION SECTION IN WHICH THE TEMPORARY WORK ARRAYS C ARE SET UP. C C THEN THE ROUTINE ENTERS PHASE 1. IN PHASE 1, SELECTS A PAIR OF CHAINS FOR C EACH COLOR. THIS PAIR HAVE THE PROPERTY THAT THEY HAVE THE MINIMUM NUMBER C OF ADJACENT PINS OF ANY TWO CURRENTLY UNASSIGNED CHAINS. THIS GETS THINGS C STARTED. C C NOTE THAT THERE IS AN OBVIOUS EXCEPTION TO PHASE 1 PROCESSING. IF AT ANY C POINT, THE NUMBER OF CHAINS LEFT UNASSIGNED IS EQUAL TO OR LESS THAN THE C NUMBER OF COLORS, THE REMAINING CHAINS ARE BETTER ASSIGNED ONE AT A TIME C THAN IN PAIRS. C C IN PHASE 2, EACH UNASSIGNED CHAIN IS PROCESSED INDIVIDUALLY. THE CHAIN IS C TRIED WITH ALL POSSIBLE COLORS. THE COLOR WHICH RESULTS IN THE FEWEST C OCCURRENCES OF ADJACENT PINS OF OTHER CHAINS HAVING THAT COLOR IS SELECTED C FOR USE. C C FINALLY, THE ICNCOL ARRAY IS WRITTEN, STORING THE ASSIGNED COLORS FOR EACH C CHAIN. C C CALLING SEQUENCE: C C CALL BY: CALL COLOUR C C C C ON EXIT: THE ICNCOL ARRAY IS FILLED IN. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NEXT C C PAGE 3 - COLOUR - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' INCLUDE 'PARAM.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER NCNM1 !NUMBER OF CHAINS - 1 INTEGER I,J,NC,ICN !DO INDICES INTEGER N !NUMBER OF UNASSIGNED CHAINS INTEGER NMIN !CURRENT MINIMUM # ADJACENT PINS BETWEEN CHAINS INTEGER I1,M,II,JJ !DUMMY VARIABLES INTEGER NM !SUM OF ALL PINS OF OTHER CHAINS OF THE SAME ! COLOR WHICH ARE ADJACENT. INTEGER JF !CURRENT NUMBER OF ASSIGNED CHAINS WITH A ! GIVEN COLOR. INTEGER NCM !CURRENT BEST CHOICE FOR THE COLOR OF THE CHAIN C C COMMON AREAS C BYTE IUSE(NMCHAN) INTEGER ICOL(NMCHAN,NMCOLR) INTEGER INCOL(NMCOLR) BYTE IW(NMCHAN+2*NMCOLR*(NMCHAN+1)) EQUIVALENCE (IUSE(1),IW(1)) EQUIVALENCE (ICOL(1,1),IW(1+NMCHAN)) EQUIVALENCE (INCOL(1),IW(1+NMCHAN+2*NMCHAN*NMCOLR)) COMMON / WORK / IW C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - COLOUR C C C *** FIRST ASSIGN PAIRS OF CHAINS TO DIFFERENT COLORS IN ORDER OF LEAST C # OF NEIGHBOR PINS UNTIL # OF REMAINING CHAINS IS <= # OF COLORS. C C C INIT THE 'CHAIN ASSIGNED' ARRAY AND THE COLOR LIST POINTER C ARRAY. C NCNM1=NCN-1 DO 30 I=1,NCN IUSE(I)=.FALSE. 30 CONTINUE DO 40 I=1,NCOL INCOL(I)=0 40 CONTINUE C C PAGE 5 - COLOUR C C C *** IN THE FIRST PHASE COLOUR SEEKS OUT PAIRS OF CHAINS WITH A C MINIMUM NUMBER OF NEIGHBOR PINS-ONE PAIR FOR EACH COLOR. C C COMMENCE BY SETTING UP COUNTER '# OF UNASSIGNED CHAINS' C N=NCN DO 90 NC=1,NCOL C C GO TO NEXT PHASE IF # OF REMAINING CHAINS <= # OF COLORS C IF (N.LE.NCOL) GOTO 130 C C PICK THE PAIR OF CHAINS WITH THE LEAST # OF NEIGHBOR PINS C NMIN=1000 DO 100 I=1,NCNM1 C C SKIP IF CHAIN I IS ALREADY ASSIGNED C IF (IUSE(I)) GOTO 100 I1=I+1 DO 120 J=I1,NCN C C SKIP IF CHAIN J IS ALREADY ASSIGNED C IF (IUSE(J)) GOTO 120 M=NEXT(I,J) IF (M.GE.NMIN) GOTO 120 C C THIS IS THE PAIR WITH THE MINIMUM # OF NEIGHBOR PINS SO FAR: C REMEMBER THE CHAINS & THE # OF PINS. QUIT IF # OF C NEIGHBOR PINS IS ZERO. C II=I JJ=J IF (M.EQ.0) GOTO 80 NMIN=M 120 CONTINUE 100 CONTINUE C C NOW ASSIGN THIS PAIR TO THE PRESENT COLOR AND FLAG THE CHAINS C AS USED. C 80 M=INCOL(NC)+2 ICOL(M-1,NC)=II IUSE(II)=.TRUE. ICOL(M,NC)=JJ IUSE(JJ)=.TRUE. INCOL(NC)=M N=N-2 90 CONTINUE C C PAGE 6 - COLOUR C C C *** PHASE 2. C C WE NOW HAVE MAX(NCN-2*NC,MOD(NCH,2)) CHAINS LEFT. ASSIGN THEM TO C THE COLOR WHICH WILL RESULT IN A MINIMUM # OF NEIGHBOR PINS. C FIRST, FIND AN UNASSIGNED CHAIN & QUIT IF THERE ARE NONE. C 130 DO 150 ICN=1,NCN IF (.NOT.IUSE(ICN)) GOTO 160 150 CONTINUE GOTO 140 C C *** TRY THIS CHAIN (ICN) WITH ALL COLORS & SEE WHICH YIELDS MINIMUM C NEIGHBOR PINS. C 160 NMIN=1000 DO 170 I=1,NCOL C C GO TO THE NEXT COLOR. C NC=NC+1 IF (NC.GT.NCOL) NC=1 NM=0 JF=INCOL(NC) IF (JF.EQ.0) GOTO 50 DO 180 J=1,JF NM=NM+NEXT(ICN,ICOL(J,NC)) 180 CONTINUE IF (NM.GE.NMIN) GOTO 170 C C *** THIS COLOR GIVES MINIMUM NEIGHBOR POSTS SO FAR: REMEMBER IT. C 50 NCM=NC IF (NM.EQ.0) GOTO 110 NMIN=NM 170 CONTINUE C C *** NOW ASSIGN THE CHAIN TO THE COLOR & FLAG IT AS USED. C 110 M=INCOL(NCM)+1 ICOL(M,NCM)=ICN IUSE(ICN)=.TRUE. INCOL(NCM)=M GOTO 130 C C PAGE 7 - COLOUR C C C *** TERMINATION CODE -- C C TELL EACH CHAIN WHAT COLOR IT IS C 140 DO 190 NC=1,NCOL JF=INCOL(NC) IF (JF.EQ.0) GOTO 190 DO 200 J=1,JF ICNCOL(ICOL(J,NC))=NC 200 CONTINUE 190 CONTINUE RETURN END SUBROUTINE MSGPRT 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: V02.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE PRINTS THE ERROR MESSAGES STORED IN THE ERROR MESSAGE FILE. C C COMPILATION INSTRUCTIONS: C C MSGPRT,MSGPRT/-SP=MSGPRT C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS 11-FEB-76 ORIGINAL CODE (USED FOR $MESSAGE C DIRECTIVE) C V02.00 RLA 6-JUN-78 NEW VERSION FOR USE WITH ERROR MESSAGE C PROCESSING C V02.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - MSGPRT - DOCUMENTATION. C C IF THE ERROR MESSAGE TEMPORARY FILE IS NOT OPEN (THAT IS, IF NO ERROR C MESSAGES OCCURRED), THE ROUTINE SIMPLY RETURNS. C C ELSE IT REWINDS THE ERROR MESSAGE TEMPORARY FILE, PRINTS THE ERROR-MESSAGE C HEADER ON A NEW LISTING PAGE, PRINTS THE ERROR MESSAGES STORED IN THE FILE C ON THE LISTING, AND CLOSES THE ERROR MESSAGE FILE (DELETING IT). C C CALLING SEQUENCE: C C CALL BY: CALL MSGPRT 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 HDR HDRCHK C C PAGE 3 - MSGPRT - 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,J !DO INDICES REAL*8 SBTTL(3) !"ERROR MESSAGES" C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 'ERROR ME', 'SSAGES', ' ' / C C PAGE 4 - MSGPRT C C C *** IF THE ERROR MESSAGE FILE IS NOT OPEN, SIMPLY RETURN C IF (.NOT. IOPEN) RETURN C C *** REWIND THE ERROR MESSAGE FILE C REWIND ISYSER C C *** PRINT THE HEADER FOR THE NEW OUTPUT PAGE C CALL HDR(SBTTL) C C *** WRITE ALL LINES OF INFORMATION FROM THE ERROR MESSAGE FILE TO THE C LISTING. C DO 20 J=1,NUMERR READ (ISYSER) LINBUF, ICHAR CALL HDRCHK(SBTTL,1) WRITE (ISYSOU, 1000) (LINBUF(I),I=1,ICHAR) 20 CONTINUE C C *** CLOSE THE ERROR MESSAGE FILE AND DELETE IT. C CLOSE (UNIT=ISYSER, DISPOSE='DELETE') IOPEN=.FALSE. RETURN C C C C *** FORMAT STATEMENT C 1000 FORMAT (1H ,132A1) C C END SUBROUTINE WIRLEN 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: V02.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THE ROUTINE CALCULATES THE NUMBER OF WIRES OF EACH COLOR USED IN THE C WIRE-LIST AND PRINTS THE INVENTORY, INCLUDING TOTALS. C C COMPILATION INSTRUCTIONS: C C WIRLEN,WIRLEN/-SP=WIRLEN C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS 1976 ORIGINAL CODE C V02.00 RLA 25-MAY-78 DATA BASE CHANGES PLUS ADDITION OF C TOTALS. C V02.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - WIRLEN - DOCUMENTATION. C C THIS ROUTINE CALCULATES THE NUMBER OF WIRES OF EACH COLOR USED IN THE C WIRE-LIST. THE OUTPUT OF THIS ROUTINE IS A FORMATTED WIRE INVENTORY. C INCLUDED IN THE INVENTORY IS AN ORDERED LIST (BY WIRE LENGTH) OF THE C NUMBER OF WIRES OF EACH COLOR USED OF THAT LENGTH AND THE TOTAL NUMBER OF C WIRES OF THAT LENGTH USED. C AT THE BOTTOM OF THE INVENTORY ARE THE TOTAL LENGTH OF WIRE USED, THE TOTAL C NUMBER OF WIRES USED, AND THE TOTAL NUMBER OF WIRES OF EACH COLOR USED. C C THE SEARCH ALGORITHM USES TWO LENGTH INDICATORS: C ILENG1 WHICH IS THE LAST LENGTH PRINTED C ILENG2 WHICH IS CURRENTLY SMALLEST LENGTH GREATER THAN ILENG1 C ENCOUNTERED. C THE ALGORITHM ALSO USES THE LOGICAL VARIABLE ISEARC. ITS USE IS EXPLAINED C BELOW. C C THE ALGORITHM PROCEEDS IN TWO PASSES. C C IN THE FIRST PASS, THE LENGTH OF THE SHORTEST WIRE LONGER THAN ILENG1 IS C FOUND AND PLACED IN ILENG2. IF THERE IS NO SUCH WIRE, ISEARC WILL BE FALSE C WHEN THIS PASS IS OVER. OTHERWISE IT WILL BE TRUE. C C IF ISEARC IS TRUE, THE SECOND PASS IS BEGUN. IF ISEARC IS FALSE, WE ARE C DONE, AND THE TERMINATION CODE (INCLUDING PRINTING THE ACCUMULATED TOTALS) C IS USED. ISEARC=.FALSE. IS THE ONLY WAY OUT OF THIS ROUTINE. C C IN PASS TWO, THE NUMBER OF WIRES OF EACH COLOR OF THE CORRECT LENGTH ARE C COUNTED. WHEN DONE, THE RESULTS ARE PRINTED, ILENG1 IS UPDATED TO THE C CURRENT LENGTH, AND THE PROGRAM LOOPS BACK TO PASS 1. C C CALLING SEQUENCE: C C CALL BY: CALL WIRLEN C C C C ON EXIT: THIS ROUTINE PRODUCES PRINTOUT. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C HDR HDRCHK C C PAGE 3 - WIRLEN - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARAM.COM' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C LOGICAL ISEARC !TRUE IF THERE ARE STILL WIRES TO COUNT REAL*8 SBTTL(3) !'WIRE-LENGTH INVENTORY' INTEGER ICLRCT(NMCOLR) !STORAGE FOR NUMBER OF WIRES OF GIVEN LENGTH ! FOR EACH COLOR INTEGER ICLRSM(NMCOLR) !STORAGE FOR TOTALS OF NUMBER OF WIRES OF ! EACH COLOR INTEGER ILENG1 !LAST LENGTH PRINTED INTEGER ILENG2 !NEXT LENGTH TO BE PRINTED INTEGER I,J !DO INDICES INTEGER ITMP0,ITMP1 !DO LIMITS REAL*4 FTMP !REAL LENGTH OF WIRE INTEGER ISUM0,ISUM1 !SUMMING VARIABLES REAL*4 FSUM !TOTAL WIRE LENGTH C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 'WIRE-LEN', 'GTH INVE', 'NTORY' / C C PAGE 4 - WIRLEN C C C *** INITIATORY CODE. C C PRINT HEADER, SET ILENG1 AND SUM VARIABLES TO 0. C CALL HDR(SBTTL) CALL HDRCHK(SBTTL,2) WRITE (ISYSOU, 1000) (COLORS(I),I=1,NCOL) WRITE (ISYSOU, 1010) ILENG1=0 ISUM1=0 FSUM=0.0 DO 10 I=1,NCOL 10 ICLRSM(I)=0 C C *** FIRST PASS. C C SEARCH FOR NEXT LARGEST LENGTH. C 20 ISEARC=.FALSE. ILENG2=1000 DO 40 I=1,NCN ITMP0=ICNLOC(I) ITMP1=ICNLOC(I+1)-2 DO 30 J=ITMP0,ITMP1 LEN=ICNLEN(J) IF ((ISLACK(LEN) .GE. ILENG2) .OR. 1 (ISLACK(LEN) .LE. ILENG1)) GOTO 30 ISEARC=.TRUE. ILENG2=ISLACK(LEN) 30 CONTINUE 40 CONTINUE C C PAGE 5 - WIRLEN C C C *** SECOND PASS. C C IF NO NEXT LENGTH FOUND IN PASS 1, BRANCH TO THE TERMINATING CODE. C C OTHERWISE ACCUMULATE IN ICLRCT THE NUMBER OF WIRES OF EACH COLOR C ENCOUNTERED FOR THE CURRENT LENGTH. C IF (.NOT. ISEARC) GOTO 100 ILENG1=ILENG2 DO 50 I=1,NCOL 50 ICLRCT(I)=0 DO 70 I=1,NCN ITMP0=ICNLOC(I) ITMP1=ICNLOC(I+1)-2 DO 60 J=ITMP0,ITMP1 LEN=ICNLEN(J) IF (ISLACK(LEN) .EQ. ILENG1) 1 ICLRCT(ICNCOL(I))=ICLRCT(ICNCOL(I))+1 60 CONTINUE 70 CONTINUE C C *** NOW PREPARE THE PRINTOUT BY: C 1) CALCULATING THE REAL WIRE LENGTH (FTMP) C 2) CALCULATING THE SUM OF ALL ENTRIES IN ICLRCT (ISUM0) C 3) PRINTING FTMP, ISUM0, AND THE ICLRCT ENTRIES C 4) ADDING FTMP*ISUM0 TO FSUM AND ADDING ISUM0 TO ISUM1. C FTMP=FLOAT(ILENG1)/10. ISUM0=0 DO 80 I=1,NCOL ISUM0=ISUM0+ICLRCT(I) ICLRSM(I)=ICLRSM(I)+ICLRCT(I) 80 CONTINUE CALL HDRCHK(SBTTL,1) WRITE (ISYSOU, 1020) FTMP,ISUM0,(ICLRCT(I),I=1,NCOL) FSUM=FSUM+FTMP*FLOAT(ISUM0) ISUM1=ISUM1+ISUM0 GOTO 20 C C PAGE 6 - WIRLEN C C C *** DONE. C C PRINT THE FINAL TOTALS. C 100 CALL HDRCHK(SBTTL,2) WRITE (ISYSOU, 1010) WRITE (ISYSOU, 1030) FSUM,ISUM1,(ICLRSM(I),I=1,NCOL) RETURN C C *** FORMAT STATEMENTS C C 1000 FORMAT (' ',4X,'LENGTH',7X,'TOTAL',6X,8(4X,A8)) C C 1010 FORMAT (' ',124('*')) C C 1020 FORMAT (' ',F8.1,3X,'**',3X,I4,3X,'**',3X,8(I8,4X)) C C 1030 FORMAT (' ',F8.1,8X,I4,8X,8(I8,4X)) C C END SUBROUTINE WIRLST 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: V02.02 C C AUTHOR: RL AURBACH MAPC 19-DEC-78 C C THIS ROUTINE USES THE DATA BASES SET UP BY THE PREVIOUS MODULES OF THE C PROGRAM TO PRINT OUT THE WIRE-LISTS. C C COMPILATION INSTRUCTIONS: C C WIRLST,WIRLST/-SP=WIRLST C [FILE WIRCOM.FTN INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 5-DEC-75 ORIGINAL CODE C V02.00 RLA 1-JUN-78 NEW DATA BASES. ALSO MODIFY OUTPUT C TO SUPPORT NEW SPECIFICATION FORMATS. C V02.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C V02.02 RLA 19-DEC-78 FIX INDEXING ERROR IN TOP-TO-BOTTOM C WRAP CODE C C C PAGE 2 - WIRLST - DOCUMENTATION. C C THIS ROUTINE TAKES ADVANTAGE OF THE ORDERING OF EACH CHAIN BY THE MINI C ROUTINE. ON ENTRY, THE CHAIN-LIST IS ORDERED SO THAT WIRING THE PINS IN C THE ORDER FOUND WILL BE OPTIMUM. C C THE BOTTOM-TO-BOTTOM WRAPS ARE THE WIRES THAT CONNECT THE FIRST AND SECOND, C THE THIRD AND FOURTH, THE FIFTH AND SIXTH, ETC. PINS. THE TOP-TO-TOP C WRAPS ARE THOSE WHICH THEN CONNECT TOGETHER THE SECOND AND THIRD, THE C FOURTH AND FIFTH, THE SIXTH AND SEVENTH, ETC. PINS. FINALLY IF THE NUMBER C OF PINS IN THE CHAIN IS ODD, THE NEXT-TO-LAST AND THE LAST PINS MUST BE C CONNECTED TOGETHER BY A TOP-TO-BOTTOM WRAP. C C THE ROUTINE SEARCHES THROUGH ALL WIRES OF EACH OF THESE THREE TYPES AND C PRINTS THE WIRES IN DECENDING ORDER BY LENGTH. C C CALLING SEQUENCE: C C CALL BY: CALL WIRLST C C C ON ENTRY: THE CHAIN-LISTS HAVE BEEN ORDERED BY MINI. 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 HDR HDRCHK PNSPEC C C PAGE 3 - WIRLST - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' INCLUDE 'PARAM.COM' INCLUDE 'IOPAR.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER IPHASE !PHASE: 1=BOTTOM-TO-BOTTOM ! 2=TOP-TO-TOP ! 3=TOP-TO-BOTTOM INTEGER LMAX !LAST MAX VALUE FOUND INTEGER LNMAX !NEXT MAX VALUE TO BE USED INTEGER I,J,K !DO INDICES INTEGER JS,JF !DO INDEX LIMITS INTEGER LT !RUN LENGTH BYTE SPEC1(10) !STORAGE FOR THE PIN SPEC WRITTEN BY PNSPEC BYTE SPEC2(10) ! DITTO REAL*4 FL !WIRE LENGTH IN INCHES REAL*8 FCOL !CURRENT WIRE COLOR FIELD (A8 FORMAT) REAL*8 FLIT0 !8 ASCII BLANKS REAL*8 SBTTL(3,3) !SUBTITLE STORAGE C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA FLIT0 / ' ' / DATA SBTTL / 'BOTTOM-T', 'O-BOTTOM', ' WRAPS', 1 'TOP-TO-T', 'OP WRAPS', ' ', 2 'TOP-TO-B', 'OTTOM WR', 'APS' / C C PAGE 4 - WIRLST C C C *** LOOP OVER THE THREE PHASES :: C C PHASE 1 -- BOTTOM-TO-BOTTOM WRAPS C PHASE 2 -- TOP-TO-TOP WRAPS C PHASE 3 -- TOP-TO-BOTTOM WRAPS C DO 120 IPHASE=1,3 C C *** START A NEW PAGE FOR EACH PHASE C CALL HDR(SBTTL(1,IPHASE)) C C *** FIND THE NEXT LONGEST (LNMAX) RUN AND PRINT ALL THOSE RUNS WITH THE C LENGTH OF THE LAST LONGEST RUN (LMAX). WE START WITH LMAX MUCH TOO C BIG SO THAT WE DON'T PRINT ANYTHING THE FIRST TIME THROUGH. WE ARE C DONE WHEN LNMAX COMES OUT TO BE ZERO. C LMAX=10000 20 LNMAX=0 DO 110 I=1,NCN JS=ICNLOC(I) JF=ICNLOC(I+1)-2 GOTO (60, 40, 50), IPHASE C C PHASE 2: LOOK ONLY AT TOP-TO-TOP WRAPS. SET JS SO THAT WE LOOK AT C SECOND-THIRD, FOURTH-FIFTH, ETC. ALSO SET JF SO THAT C WE DON'T GO TOO FAR. THE LAST PIN OF THE CHAIN MUST C NOT HAVE A TOP WRAP ON IT. C 40 JS=JS+1 JF=JF-1 GOTO 60 C C PHASE 3: LOOK ONLY AT THE LAST TWO PINS OF THE CHAIN (AND THEN ONLY C IF THE NUMBER OF PINS IN THE CHAIN IS ODD). C 50 JS=JS+2*((JF-JS)/2)+1 C C *** WE PERFORM A CHECK TO ELIMINATE INCORRECT CASES (SUCH AS TOP-TO- C BOTTOM WHEN THE NUMBER OF PINS IN THE CHAIN IS EVEN), SET THE COLOR C FOR THE CHAIN (INCLUDING PROVISIONS FOR NO COLORS SPECIFIED), AND C LOOP THROUGH THE PINS WE WANT TO LOOK AT. C 60 IF (JF .LT. JS) GOTO 110 FCOL=FLIT0 IF ((ICNCOL(I) .LE. 0) .OR. (ICNCOL(I) .GT. NCOL)) GOTO 68 FCOL=COLORS(ICNCOL(I)) C C PAGE 5 - WIRLST C C C *** NOW PERFORM THE LOOP OVER ALL WIRE RUNS OF THIS PHASE OF THIS CHAIN, C LOOKING FOR RUNS TO PRINT AND ALSO LOOKING FOR THE NEXT LONGEST RUN C FOR PRINTING NEXT TIME THROUGH THE CODE. C 68 DO 100 J=JS,JF,2 LT=ICNLEN(J) IF (LT-LMAX) 70,80,100 C C THIS WRAP LENGTH IS NOT EQUAL TO THE LAST MAX, SO WE DON'T PRINT IT. C IT'S NOT GREATER THAT THE LAST MAX, SO WE HAVEN'T PRINTED IT YET. C THUS IT IS A CANDIDATE FOR PRINTING NEXT TIME. WE COMPARE IT TO C THE PRESENT NEXT MAX AND REPLACE LNMAX IF IT IS BIGGER. C 70 LNMAX=MAX0(LNMAX,LT) GOTO 100 C C THIS WRAP LENGTH IS EQUAL TO THE LAST MAX. THIS MEANS THAT IT IS C LONGER OR SAME AS ANY OF THE WRAPS OF THIS PHASE WHICH WE HAVE NOT C YET PRINTED. THUS, WE PRINT IT. C 80 FL=FLOAT(LT)/10. CALL LINCLR IDEV=ICHAIN(1,J) IPIN=ICHAIN(2,J) CALL PNSPEC(IDEV,IPIN,2,SPEC1) IDEV=ICHAIN(1,J+1) IPIN=ICHAIN(2,J+1) CALL PNSPEC(IDEV,IPIN,2,SPEC2) CALL HDRCHK(SBTTL(1,IPHASE),1) WRITE (ISYSOU,200) FCOL,FSLACK(FL),(SPEC1(K),K=1,10), 1 (SPEC2(K),K=1,10) C C 100 CONTINUE 110 CONTINUE C C *** DONE WITH ALL CHAINS WITH THIS LENGTH IN THIS PHASE. PREPARE TO C LOOK FOR THE NEXT LENGTH BY ESTABLISHING THE LAST MAX TO BE THE C CURRENT LENGTH. IF THE NEXT LENGTH IS ZERO, WE ARE DONE. C LMAX=LNMAX IF (LNMAX .NE. 0) GOTO 20 C C DONE WITH ALL PHASES! C 120 CONTINUE RETURN C C PAGE 6 - WIRLST C C C C 200 FORMAT (' ',10X,A8,3X,F6.1,5X,10A1,5X,10A1) C C END SUBROUTINE CREF 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: V02.02 C C AUTHOR: RL AURBACH MAPC 27-OCT-78 C C CREF IS THE CROSS-REFERENCE LISTING MODULE FOR THE WIRE-WRAP PROGRAM. C THE MODULE LISTS INFORMATION ABOUT EACH CHIP AND THEN LISTS THE CONNECTIONS C ATTACHED TO EACH PIN OF THE CHIP. C C COMPILATION INSTRUCTIONS: C C CREF,CREF/-SP=CREF C [FILE WIRCOM.FTN INCLUDED] C [FILE PARAM.COM INCLUDED] C [FILE CHAINS.COM INCLUDED] C [FILE CNPAR.COM INCLUDED] C [FILE PLAIN.COM INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE SPCING.COM INCLUDED] C [FILE ELECTR.COM INCLUDED] C [FILE ALIAS.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS 3-DEC-75 ORIGINAL CODE C V02.00 RLA 5-JUN-78 NEW DATA BASE + ADDED LISTING FEATURES C V02.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C V02.02 RLA 27-OCT-78 ADD NEW ELECTRICAL TYPES AND MODIFY C LISTING FORMAT. C C C PAGE 2 - CREF - DOCUMENTATION. C C CREF IS THE CROSS-REFERENCE PROGRAM. C C FOR EACH PIN OF EACH DEVICE ON THE CARD, THE PROGRAM LISTS THE IMMEDIATE C CONNECTIONS. C C FOR EACH DEVICE, A ONE-LINE HEADER IS PRINTED. THE FORMAT OF THE HEADER IS: C C LOCN - ICNAME DEVICE WITH NN PINS. BASE VECTOR: (XXX,YYY) @ MMM DEGREES. C C WHERE C LOCN IS THE DEVICE LOCATION SYMBOL C ICNAME IS THE NAME OF THE DEVICE PRESENT AT THAT LOCATION C DEVICE IS A CHARACTER-STRING WHICH INDICATES THE TYPE OF DEVICE THAT C THIS CHIP IS. ALLOWED VALUES ARE: C TYPE 0 IC C TYPE 1 CARRIER C TYPE 2 DISCRETE C TYPE 5 CONNECTR C TYPES 3,4,12,13,14,15 PLANE C OTHER TYPES ???? C NN IS THE NUMBER OF PINS WHICH THAT DEVICE HAS C XXX IS THE X COORDINATE OF THE BASE VECTOR OF THE CHIP C YYY IS THE Y COORDINATE OF THE BASE VECTOR OF THE CHIP C MMM IS THE ROTATION ANGLE OF THE CHIP IN DEGREES. C C FOLLOWING THIS HEADER IS A SERIES OF LINES OF INFORMATION, ONE PER PIN. C THE LINES CONTAIN MANDATORY AND OPTIONAL FIELDS. IN THE FOLLOWING, OPTIONAL C FIELDS ARE ENCLOSED IN BRACES {}. THE FORMAT OF THE LINE IS: C C NN {OPT1} TYPE {JUMPER} {PIN_SPEC_1} {PIN_SPEC_2} COLOR {CHAIN} {LENGTH} C C WHERE C NN IS THE PIN NUMBER C OPT1 IS AN OPTIONAL FIELD. IF THE DEVICE IS A CONNECTOR FOR WHICH C PIN-ALIASES HAVE BEEN DEFINED, AND IF THIS PIN HAS AN ALIAS, C THEN OPT1 WILL CONTAIN THE PIN ALIAS. C C IF THE DEVICE IS A PLANE, THEN OPT1 WILL CONTAIN THE ABSOLUTE C POSITION OF THIS PIN. C C ELSE OPT1 WILL BE BLANK. C C PAGE 2 A - CREF - DOCUMENTATION (CONTINUED) C C C C TYPE IS A MNEMONIC SYMBOL INDICATING THE DEVICE TYPE. THE MNEMONICS C ARE: C TYPE 0 NO CONN C TYPE 1 INPUT C TYPE 2 OUTPUT C TYPE 3 +5V PWR C TYPE 4 DIG GND C TYPE 5 SPECIAL C TYPE 6 ANALOG C TYPE 7 O/C OUT C TYPE 8 T/S OUT C TYPE 9 PULLUP C TYPE 10 *INPUT C TYPE 11 *OUTPUT C TYPE 12 +HV PWR C TYPE 13 -HV PWR C TYPE 14 ANA GND C TYPE 15 OTHER C TYPE 16 AC C TYPE 17 CLOSURE C TYPE 18 DISCRETE C TYPE 19 LED/COIL C JUMPER IF A HARDWARE JUMPER IS CONNECTED TO THIS PIN, THE WORD JUMPER C APPEARS. ELSE THIS FIELD IS BLANK. C PIN_SPEC_1 IF THERE ARE NO PINS CONNECTED TO THIS PIN, THIS FIELD IS C BLANK. IF THERE ARE ONE OR TWO PINS CONNECTED, THIS FIELD C CONTAINS ONE PIN SPECIFICATION. C PIN_SPEC_2 IF TWO PINS ARE CONNECTED TO THIS PIN, THIS FIELD CONTAINS C THE SECOND PIN SPECIFICATION. ELSE IT IS BLANK. C COLOR IS THE COLOR OF THE WIRES ATTACHED TO THIS PIN. IF NO WIRES C ARE CONNECTED, THE WORD NONE APPEARS HERE. C CHAIN IS THE NUMBER OF THE CHAIN IN WHICH THIS PIN IS FOUND. IF THE C COLOR WAS NONE, THIS FIELD WILL BE BLANK. C LENGTH IS THE NUMBER OF PINS (TOTAL) IN THIS CHAIN. IF CHAIN IS BLANK C THIS FIELD WILL BE ALSO. C C C PAGE 2 B - CREF - DOCUMENTATION (CONTINUED) C C C CALLING SEQUENCE: C C CALL BY: CALL CREF 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 HDR HDRCHK LINCLR PNSPEC TRANSF C C PAGE 3 - CREF - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARAM.COM' INCLUDE 'CHAINS.COM' INCLUDE 'CNPAR.COM' INCLUDE 'PLAIN.COM' INCLUDE 'IOPAR.COM' INCLUDE 'SPCING.COM' INCLUDE 'ELECTR.COM' INCLUDE 'ALIAS.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C LOGICAL IPLANE !IF .T., DEVICE IS A PLANE LOGICAL IAL !IF .T., DEVICE HAS DEFINED PIN ALIASES. LOGICAL ILTMP !IF .T., THIS PIN HAS A JUMPER ON IT. INTEGER IDEV,IPIN !DO INDICES INTEGER ICHN,ICONN !DO INDICES INTEGER N,ILWR,IUPR !DO LOOP LIMITS INTEGER IR,I !DUMMY VARIABLES INTEGER IE !ELECTRICAL PROPERTIES OF CURRENT DEVICE INTEGER NP !NUMBER OF PINS IN CURRENT CHAIN C REAL*8 SBTTL(3) !"CROSS-REFERENCE LISTING" REAL*4 ROT(4) !ROTATION ANGLE STRINGS REAL*8 ELSYM(MXELCD) !ELECTRICAL TYPE SYMBOLS REAL*8 DVTYPE(MXELCD) !CHIP DEVICE TYPE SYMBOLS REAL*4 NONE !"NONE" REAL*8 JUMPER !"JUMPER" C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 'CROSS-RE', 'FERENCE ', 'LISTING ' / DATA ROT / ' 0', ' 90', ' 180', ' 270' / DATA ELSYM / 'NO CONN', 'INPUT', 'OUTPUT', '+5V PWR', 'DIG GND', 1 'SPECIAL', 'ANALOG', 'O/C OUT', 'T/S OUT', 'PULL-UP', 2 '*INPUT*', '*OUTPUT*', '+HV PWR', '-HV PWR', 'ANAL GND', 3 'OTHR PWR', 'AC LINE', 'CLOSURE', 'DISCRETE', 'LED/COIL' / DATA DVTYPE / 'IC', 'CARRIER', 'DISCRETE', 2*'PLANE', 'CONNECTR', 1 6*'????', 4*'PLANE', 4*'????' / DATA NONE / 'NONE' / DATA JUMPER / 'JUMPER' / C C PAGE 4 - CREF C C C *** BEGIN BY STARTING A NEW LISTING PAGE C CALL HDR(SBTTL) C C *** THE MAJOR LOOP IS OVER ALL DEVICES. FOR EACH DEVICE, GENERATE THE C HEADER LINE. C DO 70 IDEV=1,NENT IR=IROT(IDEV)+1 IT=ITYPE(IDEV)+1 CALL HDRCHK(SBTTL,2) WRITE (ISYSOU, 1000) (SYMBL(I,IDEV),I=1,4), (ICNAME(I,IDEV),I=1,8), 1 DVTYPE(IT), INUM(IDEV), (ISBASE(I,IDEV),I=1,2), ROT(IR) C C *** NOW WE MUST CHECK TO SEE IF THE DEVICE IS A PLANE. (IF IT IS, SPECIAL C PROCESSING WILL TAKE PLACE BELOW.) C IPLANE=.FALSE. DO 5 I=1,NMPLAN IF (IDEV .EQ. IPENT(I)) IPLANE=.TRUE. 5 CONTINUE C C *** WE MUST ALSO CHECK WHETHER THE DEVICE IS A CONNECTOR WHICH HAS DEFINED C ALIAS SYMBOLS. C IAL=.FALSE. IF ((ITYPE(IDEV) .EQ. 5) .AND. (IALOC(IDEV) .NE. 0)) IAL=.TRUE. C C *** NOW LOOP OVER ALL PINS OF THE DEVICE. BEGIN BY FILLING IN MANDATORY C INFORMATION. C N=INUM(IDEV) IF (N .EQ. 0) GOTO 70 !NO PINS - NOTHING TO DO. DO 60 IPIN=1,N IE=IPINEL(1,IELOC(IDEV)+IPIN-1) CALL LINCLR ENCODE (4,1010,LINBUF(9)) IPIN C C *** NOW CHECK TO SEE IF THE PIN HAS AN ALIAS. IF IT DOES, PUT THE ALIAS C INTO THE CORRECT SLOT OF THE LISTING. C IF (.NOT. IAL) GOTO 10 IR=IALOC(IDEV)+IPIN-1 IF (IPINAS(1,IR) .EQ. 0) GOTO 10 CALL TRANSF(IPINAS(1,IR),4,LINBUF(19),4) GOTO 20 C C *** CHECK TO SEE IF THE PIN IS PART OF A PLANE. IF IT IS, THEN THE C ABSOLUTE LOCATION OF THE PIN IS PLACED IN A SPECIAL FIELD. C 10 IF (IPLANE) CALL PNSPEC(IDEV,IPIN,2,LINBUF(17)) C C PAGE 4 A - CREF C C C *** PUT IN THE ELECTRICAL TYPE MNEMONIC. C 20 CALL TRANSF(ELSYM(IE+1),8,LINBUF(30),8) C C *** CHECK TO SEE IF A JUMPER IS CONNECTED TO THIS PIN. IF IT IS, PUT THE C WORD "JUMPER" IN ITS FIELD. C IF (IPLANE) GOTO 30 ILTMP=.FALSE. DO 22 I=1,NMPLAN IF (IE .NE. IPTYP(I)) GOTO 22 ILTMP=.TRUE. IR=I 22 CONTINUE IF (.NOT. ILTMP) GOTO 30 IF ((IPFLG(IR) .EQ. 1) .AND. (ITYPE(IDEV) .LT. 2)) 1 CALL TRANSF(JUMPER,8,LINBUF(42),8) C C PAGE 5 - CREF C C C *** NOW WE ARE READY TO LOOK FOR PINS ATTACHED TO THIS PIN. C C WE BEGIN BY SETTING UP THE FIELD FOR THE CASE IN WHICH WE DON'T FIND C ANY. C 30 CALL TRANSF(NONE,4,LINBUF(83),4) C C *** NOW WE LOOP OVER ALL CHAINS, LOOKING FOR ONE WHICH CONTAINS THIS PIN. C WHEN WE FIND IT, WE WRITE THE CHAIN COLOR OVER THE "NONE", AND ADD C THE CHAIN-NUMBER FIELD AND THE NUMBER-OF-PINS-IN-THE-CHAIN FIELD. C DO 50 ICHN=1,NCN ILWR=ICNLOC(ICHN) IUPR=ICNLOC(ICHN+1)-1 NP=IUPR-ILWR+1 DO 40 ICONN=ILWR,IUPR IF (ICHAIN(1,ICONN) .NE. IDEV) GOTO 40 IF (ICHAIN(2,ICONN) .NE. IPIN) GOTO 40 ICOL=ICNCOL(ICHN) IF (ICOL .NE. 0) CALL TRANSF(COLORS(ICOL),8,LINBUF(83),8) ENCODE (4,1010,LINBUF(95)) ICHN ENCODE (4,1010,LINBUF(103)) NP C C *** WE HAVE FOUND THE PIN IN A CHAIN. THERE ARE THREE POSSIBILITIES. C IF THE PIN IS THE FIRST PIN IN THE CHAIN, IT HAS ONLY ONE PIN C CONNECTED TO IT -- THE SECOND PIN IN THE CHAIN. C C IF THE PIN IS THE LAST PIN IN THE CHAIN, IT ALSO HAS ONE ONE PIN C CONNECTED TO IT -- THE NEXT-TO-LAST PIN IN THE CHAIN. C C OTHERWISE IT HAS THE PIN BEFORE IT AND THE PIN AFTER IT CONNECTED C TO IT. C C *** HANDLE THE CASE OF THE PIN BEING THE FIRST IN THE CHAIN. C IF (ICONN .NE. ILWR) GOTO 33 I=ICHAIN(1,ICONN+1) IR=ICHAIN(2,ICONN+1) CALL PNSPEC(I,IR,1,LINBUF(53)) GOTO 40 C C *** HANDLE THE CASE OF THE PIN BEING THE LAST IN THE CHAIN. C 33 IF (ICONN .NE. IUPR) GOTO 36 I=ICHAIN(1,ICONN-1) IR=ICHAIN(2,ICONN-1) CALL PNSPEC(I,IR,1,LINBUF(53)) GOTO 40 C C PAGE 5 A - CREF C C C *** HANDLE THE CASE OF THE PIN BEING SURROUNDED BY TWO OTHER PINS. C 36 I=ICHAIN(1,ICONN-1) IR=ICHAIN(2,ICONN-1) CALL PNSPEC(I,IR,1,LINBUF(53)) I=ICHAIN(1,ICONN+1) IR=ICHAIN(2,ICONN+1) CALL PNSPEC(I,IR,1,LINBUF(68)) 40 CONTINUE 50 CONTINUE C C *** DONE WITH THIS PIN -- PRINT THE LINE THAT HAS BEEN BUILT. C CALL HDRCHK(SBTTL,1) WRITE (ISYSOU, 1020) (LINBUF(IC),IC=1,IBF) 60 CONTINUE 70 CONTINUE RETURN C C C C *** FORMAT STATEMENTS C C 1000 FORMAT (1H0,4X,4A1,' - ',8A1,1X,A8,' WITH ',I3,' PINS.', 1 ' BASE VECTOR: (',I3,',',I3,') @',A4,' DEGREES.') C C 1010 FORMAT (I4) C C 1020 FORMAT (' ', 132A1) C C END SUBROUTINE STATS 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 PRODUCES A PAGE OF LISTING OUTPUT CONTAINING STATISTICS C CONCERNING THE CARD PROCESSED BY WIRAP. C C COMPILATION INSTRUCTIONS: C C STATS,STATS/-SP=STATS C [FILE WIRCOM.FTN INCLUDED] C [FILE IOPAR.COM INCLUDED] C [FILE PARAM.COM INCLUDED] C [FILE PLAIN.COM INCLUDED] C [FILE CHAINS.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 7-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZED INCLUDED COMMON AREAS C C C PAGE 2 - STATS - DOCUMENTATION. C C THIS ROUTINE PRODUCES A NEW PAGE OF LISTING OUTPUT CONTAINING THE C FOLLOWING INFORMATION: C C [PROGRAM EXECUTION ABORTED DUE TO FATAL ERRORS] (IF TRUE) C C THIS CARD USED NNN DEVICES C INCLUDING NNN CONNECTORS C AND NNN POWER OR GROUND PLANES. C C THERE WERE NNN DIFFERENT WIRING CHAINS C INVOLVING NNN PINS. C C THE PROGRAM GENERATED NNN WIRES. C C DURING PROGRAM EXECUTION, NNN WARNINGS AND/OR FATAL ERROR MESSAGES C WERE GENERATED. C C PROGRAM EXECUTION REQUIRED XXXX.XX SECONDS. C C C CALLING SEQUENCE: C C CALL BY: CALL STATS 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 HDR C C PAGE 3 - STATS - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'IOPAR.COM' INCLUDE 'PARAM.COM' INCLUDE 'PLAIN.COM' INCLUDE 'CHAINS.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX INTEGER N !DUMMY VARIABLE REAL*8 SBTTL(3) !"RUN STATISTICS" C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA SBTTL / 'RUN STAT', 'ISTICS', ' ' / C C PAGE 4 - STATS C C C *** START NEW PAGE WITH HEADER C CALL HDR(SBTTL) C C *** IF THERE IS A FATAL ERROR, WRITE AN APPROPRIATE MESSAGE. C IF (IFATAL) WRITE (ISYSOU,100) C C *** WRITE NUMBER OF DEVICES, CALCULATE AND WRITE NUMBER OF CONNECTORS C AND NUMBER OF PLANES USED. C WRITE (ISYSOU,200) NENT N=0 DO 10 I=1,NENT IF (ITYPE(I) .EQ. 5) N=N+1 10 CONTINUE WRITE (ISYSOU, 300) N N=0 DO 20 I=1,NMPLAN IF (IPDEF(I) .NE. 0) N=N+1 20 CONTINUE WRITE (ISYSOU, 400) N C C *** WRITE NUMBER OF CHAINS, NUMBER OF PINS, AND NUMBER OF WIRES. C WRITE (ISYSOU, 500) NCN N=ICNLOC(NCN+1)-1 WRITE (ISYSOU, 600) N WRITE (ISYSOU, 700) N-NCN C C *** WRITE NUMBER OF CALLS TO MSG AND ELAPSE TIME. C WRITE (ISYSOU, 800) NUMMSG WRITE (ISYSOU, 900) SECNDS(ELAPS) RETURN C C PAGE 5 - STATS C C C *** FORMAT STATEMENTS C C 100 FORMAT (1H0, '[PROGRAM EXECUTION ABORTED DUE TO FATAL ERROR]') C 200 FORMAT (1H0/1H0, 'THIS CARD USED ', I4, ' DEVICES') C 300 FORMAT (1H ,T8, 'INCLUDING ', I4, ' CONNECTORS') C 400 FORMAT (1H ,T8, 'AND ', I2, ' POWER AND/OR GROUND PLANES.') C 500 FORMAT (1H0, 'THERE WERE ', I4, ' DIFFERENT WIRING CHAINS') C 600 FORMAT (1H ,T8, 'INVOLVING ', I4, ' PINS.') C 700 FORMAT (1H0, 'THE PROGRAM GENERATED ', I4, ' WIRES.') C 800 FORMAT (1H0, 'DURING PROGRAM EXECUTION, ', I4, ' WARNING MESSAGES', 1 ' AND/OR FATAL ERROR MESSAGES' / 1H ,T8,'WERE GENERATED.') C 900 FORMAT (1H0/1H0, 'PROGRAM EXECUTION REQUIRED ', F7.2, ' SECONDS.') C C END