(davel/ 777 37 1770 0 3572415533 5157 davel/vms/ 777 37 1770 0 3515020073 5750 davel/vms/ASMPWI.FOR;1 644 37 1770 5710 3515015440 7562 C.~* SYSTEM: SNIPS, PROGRAM: ASMPWI ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C ASSEMBLE A STRING DESCRIPTION OF A P.W.A. ENTRY, GIVEN THE PWI CHAIN C ENTRY AND A WORK ITEM TAG LIST. C C PARAMETERS: C PWIC(2,MAXPWI) - P.W.A. CHAIN, C IFWD - POINTER TO CURRENT ENTRY IN CHAIN FOR WHICH C A STRING IS TO BE FORMED, C TAGLIST(5,MAXNAC)-LIST OF ALL WORK ITEM TAGS, C IDAILY - 0 IF LAGS ARE TO BE DISPLAYED IN WEEKS, C NWDPW - NUMBER OF WORK DAYS PER WEEK, C LNE(10) - OUTPUT LINE INTO WHICH THE P.W.A. DESCRIPTION C IS TO BE PLACED, C ITYP - -1 IF A BLANK LINE IS OUTPUT WHEN IFWD WAS LESS C THAN 1, C 0 IF ASSEMBLED LINE IS A NOT-EARLIER-THAN START, C 1 IF IT WAS A REGULAR P.W.A., C 2 IF IT WAS A P.W.A. PLUS LAG, C 3 IF IT WAS A LAG FROM THE START OF A P.W.A., C C ICODTE - 0 TO DISPLAY DATE OF FORM 12-31-83 C - 3 TO DISPLAY COMPANY SPECIFIC DATE C C ENTER VIA: C CALL ASMPWI (PWIC, IFWD, TAGLIST, IDAILY, NWDPW, LNE, ITYP, ICODTE) C C SUBROUTINES REQUIRED: BLANK, LDAY, SUBSTR C FUNCTIONS REQUIRED: LENGTH, NPUT C C AUTHOR: D. N. ANDERSON -- LAST MOD: APR 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: MAR 1985 C C****************************************************************************** C SUBROUTINE ASMPWI (PWIC, IFWD, TAGLIST, IDAILY, NWDPW, LNE, ITYP, + ICODTE) C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXNAC=2000 PARAMETER MAXPWI=3000 C INTEGER*2 PWIC(2,MAXPWI), TAGLIST(5,MAXNAC), LNE(10) C C <> C C BLANK OUTPUT LINE C CALL BLANK (LNE, 1, 20) C C MARK AS BLANK LINE OUTPUT C ITYP = -1 C C RETURN IF POINTER DOES NOT POINT TO A REAL ENTRY C IF (IFWD .LT. 1) RETURN C C NUMBER OF P.W.A. OR NOT-EARLIER-THAN DATE C IF (IFWD .GT. MAXPWI) + CALL FATAL ( 11, 'BAD PWI CHAIN', IFWD, MAXPWI ) NPWI = PWIC (1,IFWD) IF (NPWI .GT. 0) GO TO 20 C C NOT-EARLIER THAN DATE C ITYP = 0 C CALL LDAY (LNE, ICODTE, -NPWI) RETURN C C P.W.A. (WITH / WITHOUT LAG) C 20 IF (NPWI .GT. MAXNAC) 1 CALL FATAL ( 12, 'PWI CHAIN HAS BAD REFERENCE',NPWI,MAXNAC) C CALL SUBSTR (LNE, 1, TAGLIST (1,NPWI), 1, 10) ITYP = 1 C C RETURN IF NO LAG C IF (PWIC (2,IFWD) .GE. 0) RETURN C C P.W.A. WITH LAG C ITYP = 2 CFUN LB = LENGTH (LNE, 10) + 2 C C INSERT + SIGN C CALL SUBSTR (LNE, LB, %REF('+'), 1, 1) C C POINTER TO LAG C NFD = -PWIC (2,IFWD) LAG = PWIC (1,NFD) C C BRANCH IF LAG IS FROM FINISH C IF (LAG .GE. 0) GO TO 30 C C LAG IS FROM START OF P.W.A. C ITYP = 3 LAG = -LAG C C DISPLAY IN WORK WEEKS IF REQUESTED C 30 IF (IDAILY .EQ. 0) LAG = (LAG + NWDPW / 2) / NWDPW LAG1 = LAG / 10 LAG2 = LAG - 10 * LAG1 CFUN LB = NPUT (LNE, LB + 2, 0, %REF('00'), LAG1) C CALL SUBSTR (LNE, LB, %REF('.'), 1, 1) CFUN LB = NPUT (LNE, LB + 1, 0, %REF('00'), LAG2) C C ADD "S" IF LAG IS BASED ON P.W.A. START C IF (ITYP .NE. 3) RETURN C CALL SUBSTR (LNE, LB + 1, %REF('S'), 1, 1) C RETURN END davel/vms/BARCH.DDN;1 644 37 1770 14167 3515015663 7415 C.~* SYSTEM: SNIPS, PROGRAM: BARCH ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C OVERSEE THE PLOTTING OF ALL BARCHART PAGES. C C INPUT: C NPA - NUMBER OF WORK ITEMS TO BE PLOTTED, C ISVEC - VECTOR CONTAINING THE NUMBER OF EACH RECORD C TO BE PLOTTED IN THE ORDER IT IS TO BE C PLOTTED, C NCDATE(1000) C - TABLE TO TRANSLATE DAYS TO DATES. C NPEND - NUMBER OF WORK DAYS IN SCHEDULE, C NFIRSTD - NUMBER OF THE FIRST DAY ACTUALLY USED FOR THIS SUBSET C NLASTD - NUMBER OF THE LAST WORK DAY USED ON CURRENT SUBSET C OF ACTIVITIES USED FOR THIS PLOT C IPFIL - 0 IF NO INSTALLATION PARAMETER FILE EXISTS, C 1 IF AN I. P. FILE EXISTS FOR THE PLOTTER, C IWARM - 1 TO REQUEST OPERATOR VERIFICATION OF PEN WARMUP, C IREPLOT - 1 TO PRESENT OPERATOR WITH THE OPPORTUNITY TO C REPLOT THE SAME CHART, C ICONTP - 1 TO PLOT PAGES CONTINUOUSLY WITHOUT REQUESTING C THE MOUNTING OF NEW SHEETS OF PAPER, C DRWG - 2 CHARACTER SYMBOL TO DESIGNATE THE DRAWING SIZE C AND LEGENDS, C NDAYPD - NUMBER OF WORK DAYS PER PLOTTED DATE WITHIN THE C DATE BARS, C NDATAD - DATA DATE (IN WORK DAYS), C ICSTART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESS FLOAT TIMES C C ENTER VIA: C CALL BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, IPFIL, C IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, NDATAD, ICSTART, C PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C C SUBROUTINES REQUIRED: BCHART, PLOTX, REPLY, USEIP C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: AUG 1984 C C********************************************************************** C SUBROUTINE BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, 1 IPFIL, IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, 2 NDATAD, ICSTART, PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C IMPLICIT INTEGER*2 (I-N) C COMMON /SCH04/ IREV(4), FEXTN(15), PLOTF(9) COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN COMMON /PENS/ NCP, NHOLD, NPINH(5), NPENS, 1 PDESCR(5,10), WX, WY, WW, WH, NWUP, IPFILE(9) C INTEGER*2 UP, DOWN, PDESCR INTEGER*2 NCDATE(1), DRWG INTEGER*2 FEXTN, PLOTF, ISVEC(1) C DATA WHPROP/0.7/, BH/0.17/, CH/0.07/, DOT/0.05/, DASH/0.12/, 1 UP/3/, DOWN/2/ C C <> C C C MAX. BARS PER SHEET C NBMAX = (H - PFCTR * BH * (4.0 + WHPROP)) / ((1.0 + WHPROP) 1 * BH * PFCTR) C C NUMBER OF SHEETS REQUIRED C NSHTS = (NPA - 1) / NBMAX + 1 C C NUMBER OF ACTIVITIES PER SHEET (EXCEPT LAST) C NAPERSHT = (NPA + NSHTS - 1) / NSHTS C C NUMBER OF DATES TO BE PLOTTED C NPENDX = NPEND NFDAY = 0 2 NDP = (NPENDX - NFDAY + 2 * NDAYPD - 2) / NDAYPD C C CHART WIDTH C CHARTW = PFCTR * (12.0 * CH + 3.0 * CH * NDP) C C CHART HEIGHT C DBARHT = 4.0 IF (ICODTE .EQ. 3) DBARHT = 8 ! TEK DATE BAR HEIGHT CHHT = PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + DBARHT + WHPROP) C C AUTO SCALE FACTOR VERTICALLY C PFCTR2 = H / CHHT C C AUTO SCALE FACTOR HORIZONTALLY C PFCTR1 = W / CHARTW IF (NFDAY .GE. NFIRSTD - 1) GO TO 4 IF (NPENDX .EQ. NLASTD) GO TO 3 ! 2ND PASS / NO DIFF IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING # OF DAYS FOR THIS SUBSET C NPENDX = NLASTD GO TO 2 3 IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING START DAY FOR SUBSET C NFDAY = NFIRSTD - 1 GO TO 2 4 IF (PFCTR2 .LT. PFCTR1) PFCTR1 = PFCTR2 PFCTR = PFCTR * PFCTR1 CHARTW = CHARTW * PFCTR1 C C TELL OPERATOR THE SCALE ACTUALLY USED C FCH = PFCTR * CH WRITE (6,5) NSHTS, PFCTR, FCH 5 FORMAT ('0 PAGES:',I2,' ACTUAL PLOT FACTOR USED:',F5.2, 1 ' CHAR. HEIGHT:',F6.3) C C PLOT EACH SHEET C C CALL OPLOTS ( PLOTF, 14) ! NECESSARY ONLY ON CALCOMP. C NFRST = 1 DO 40 ISH = 1, NSHTS C C ADJUST NUMBER FOR LAST SHEET C IF (ISH .EQ. NSHTS) NAPERSHT = NPA - NAPERSHT * (NSHTS - 1) C C OPEN PLOT FILE C CALL OPLOTS ( PLOTF, 14 ) C C CONTINUOUS PLOTTING? C IF (ICONTP .NE. 0) GO TO 8 C C NOT CONTINUOUS. ASK FOR NEW SHEET. C WRITE (6,7) ISH 7 FORMAT ('0MOUNT SHEET',I2,'. STRIKE RETURN.',$) C CALL REPLY (IANS, L, 0, *10, *10, *10, *10, 0) C NCP = 0 ! FORCE NEW WARMUP GO TO 10 C C MOVE DOWN TO NEW DRAWING AREA C 8 IF (ISH .EQ. 1) GO TO 10 C NOT NECESSARY FOR PLOTTING TERMINALS - DDN C CALL PLOTX (X + X + W, 0.0, -3) C C DRAW BORDERS AND TITLE NEW PAGE C 10 CALL USEIP (DRWG, ISH, NSHTS, IWARM, ICODTE) C IF (IREPLOT .EQ. 0) GO TO 20 WRITE (6,13) 13 FORMAT ('0REPLOT TITLE BLOCK(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *20, *20, *20, *20, 0) C IF (IANS .NE. 0) GO TO 10 C C SET UP COORDINATES OF LOWER C LEFT CORNER OF CHART AREA C 20 XX = X + (W ((- CHARTW) / 2.0 YY = Y + (H - PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + + DBARHT + WHPROP)) / 2.0 C C PLOT THE ACTUAL BAR CHART C 22 CALL BCHART (XX, YY, ISVEC(NFRST), NAPERSHT, NDP, NDAYPD, + NDATAD, ICSTART, PFCTR, NCDATE, NFDAY, NPENDX, IWARM, + ICODTE, ISFLOAT) C C SHOULD REPLOT BE OFFERED? C IF (IREPLOT .EQ. 0) GO TO 30 WRITE (6,23) 23 FORMAT ('0REPLOT BARCHART PAGE(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *30, *30, *30, *30, 0) C IF (IANS .NE. 0) GO TO 22 30 NFRST = NFRST + NAPERSHT C NEW PLOT PAGE REQUIRES C A PLOT LABEL TO BE WRITTEN. THIS C ALLOWS THE OPORATOR TO MOVE THE PEN C PLOTTING THE NEXT PAGE. C CALL PLOTX ( 0., 0., -3) ! NECESSARY ONLY ON CALCOMP C CALL CPLOTS ( PLOTF, 14) ! CLOSE THE PLOT OUTPUT FILE - DDN C ONE PLOT PAGE WRITTEN PER FILE. 40 CONTINUE C C CALL CPLOTS ( PLOTF, 14) ! CALCOMP CLOSE GOES HERE. C RETURN END ART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESdavel/vms/BARCH.FFR;1 644 37 1770 12655 3515015667 7431 C.~* SYSTEM: SNIPS, PROGRAM: BARCH ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C OVERSEE THE PLOTTING OF ALL BARCHART PAGES. C C INPUT: C NPA - NUMBER OF WORK ITEMS TO BE PLOTTED, C ISVEC - VECTOR CONTAINING THE NUMBER OF EACH RECORD C TO BE PLOTTED IN THE ORDER IT IS TO BE C PLOTTED, C NCDATE(1000) C - TABLE TO TRANSLATE DAYS TO DATES. C NPEND - NUMBER OF WORK DAYS IN SCHEDULE, C NFIRSTD - NUMBER OF THE FIRST DAY ACTUALLY USED FOR THIS SUBSET C NLASTD - NUMBER OF THE LAST WORK DAY USED ON CURRENT SUBSET C OF ACTIVITIES USED FOR THIS PLOT C IPFIL - 0 IF NO INSTALLATION PARAMETER FILE EXISTS, C 1 IF AN I. P. FILE EXISTS FOR THE PLOTTER, C IWARM - 1 TO REQUEST OPERATOR VERIFICATION OF PEN WARMUP, C IREPLOT - 1 TO PRESENT OPERATOR WITH THE OPPORTUNITY TO C REPLOT THE SAME CHART, C ICONTP - 1 TO PLOT PAGES CONTINUOUSLY WITHOUT REQUESTING C THE MOUNTING OF NEW SHEETS OF PAPER, C DRWG - 2 CHARACTER SYMBOL TO DESIGNATE THE DRAWING SIZE C AND LEGENDS, C NDAYPD - NUMBER OF WORK DAYS PER PLOTTED DATE WITHIN THE C DATE BARS, C NDATAD - DATA DATE (IN WORK DAYS), C ICSTART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESS FLOAT TIMES C C ENTER VIA: C CALL BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, IPFIL, C IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, NDATAD, ICSTART, C PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C C SUBROUTINES REQUIRED: BCHART, PLOT, PLOTS, REPLY, USEIP C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C C********************************************************************** C SUBROUTINE BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, 1 IPFIL, IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, 2 NDATAD, ICSTART, PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C IMPLICIT INTEGER*2 (I-N) C COMMON /SCH04/ IREV(4), FEXTN(15), PLOTF(9) COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN COMMON /PENS/ NCP, NHOLD, NPINH(5), NPENS, 1 PDESCR(5,10), WX, WY, WW, WH, NWUP, IPFILE(9) C INTEGER*2 UP, DOWN, PDESCR INTEGER*2 NCDATE(1), IM12(16), IM13(50), DRWG INTEGER*2 FEXTN, PLOTF, ISVEC(1) C DATA WHPROP/0.7/, BH/0.17/, CH/0.07/, DOT/0.05/, DASH/0.12/, 1 UP/3/, DOWN/2/ C C <> C C C MAX. BARS PER SHEET C NBMAX = (H - PFCTR * BH * (4.0 + WHPROP)) / ((1.0 + WHPROP) 1 * BH * PFCTR) C C NUMBER OF SHEETS REQUIRED C NSHTS = (NPA - 1) / NBMAX + 1 C C NUMBER OF ACTIVITIES PER SHEET (EXCEPT LAST) C NAPERSHT = (NPA + NSHTS - 1) / NSHTS C C NUMBER OF DATES TO BE PLOTTED C NPENDX = NPEND NFDAY = 0 2 NDP = (NPENDX - NFDAY + 2 * NDAYPD - 2) / NDAYPD C C CHART WIDTH C CHARTW = PFCTR * (12.0 * CH + 3.0 * CH * NDP) C C CHART HEIGHT C DBARHT = 4.0 IF (ICODTE .EQ. 3) DBARHT = 8 ! TEK DATE BAR HEIGHT CHHT = PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + DBARHT + WHPROP) C C AUTO SCALE FACTOR VERTICALLY C PFCTR2 = H / CHHT C C AUTO SCALE FACTOR HORIZONTALLY C PFCTR1 = W / CHARTW IF (NFDAY .GE. NFIRSTD - 1) GO TO 4 IF (NPENDX .EQ. NLASTD) GO TO 3 ! 2ND PASS / NO DIFF IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING # OF DAYS FOR THIS SUBSET C NPENDX = NLASTD GO TO 2 3 IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING START DAY FOR SUBSET C NFDAY = NFIRSTD - 1 GO TO 2 4 IF (PFCTR2 .LT. PFCTR1) PFCTR1 = PFCTR2 PFCTR = PFCTR * PFCTR1 CHARTW = CHARTW * PFCTR1 C C TELL OPERATOR THE SCALE ACTUALLY USED C FCH = PFCTR * CH WRITE (6,5) NSHTS, PFCTR, FCH 5 FORMAT ('0 PAGES:',I2,' ACTUAL PLOT FACTOR USED:',F5.2, 1 ' CHAR. HEIGHT:',F6.3) C C PLOT EACH SHEET C NFRST = 1 DO 40 ISH = 1, NSHTS C C ADJUST NUMBER FOR LAST SHEET C IF (ISH .EQ. NSHTS) NAPERSHT = NPA - NAPERSHT * (NSHTS - 1) C C OPEN PLOT FILE C CALL OPLOTS ( PLOTF, 14 ) C C CONTINUOUS PLOTTING? C IF (ICONTP .NE. 0) GO TO 8 C C NOT CONTINUOUS. ASK FOR NEW SHEET. C WRITE (6,7) ISH 7 FORMAT ('0MOUNT SHEET',I2,'. STRIKE RETURN.',$) C CALL REPLY (IANS, L, 0, *10, *10, *10, *10, 0) C NCP = 0 ! FORCE NEW WARMUP GO TO 10 C C MOVE DOWN TO NEW DRAWING AREA C 8 IF (ISH .EQ. 1) GO TO 10 C CALL PLOT (X + X + W, 0.0, -3) C C DRAW BORDERS AND TITLE NEW PAGE C 10 CALL USEIP (DRWG, ISH, NSHTS, IWARM, ICODTE) C IF (IREPLOT .EQ. 0) GO TO 20 WRITE (6,13) 13 FORMAT ('0REPLOT TITLE BLOCK(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *20, *20, *20, *20, 0) C IF (IANS .NE. 0) GO TO 10 C C SET UP COORDINATES OF LOWER C LEFT CORNER OF CHART AREA C 20 XX = X + (W - CHARTW) / 2.0 YY = Y + (H - PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + + DBARHT + WHPROP)) / 2.0 C C PLOT THE ACTUAL BAR CHART C 22 CALL BCHART (XX, YY, ISVEC(NFRST), NAPERSHT, NDP, NDAYPD, + NDATAD, ICSTART, PFCTR, NCDATE, NFDAY, NPENDX, IWARM, + ICODTE, ISFLOAT) C C SHOULD REPLOT BE OFFERED? C IF (IREPLOT .EQ. 0) GO TO 30 WRITE (6,23) 23 FORMAT ('0REPLOT BARCHART PAGE(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *30, *30, *30, *30, 0) C IF (IANS .NE. 0) GO TO 22 30 NFRST = NFRST + NAPERSHT C CALL CPLOTS( 0., 0. ) ! CLOSE PLOT FILE C 40 CONTINUE RETURN END davel/vms/BARCH.PLO;1 644 37 1770 14041 3515015673 7432 C.~* SYSTEM: SNIPS, PROGRAM: BARCH ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C OVERSEE THE PLOTTING OF ALL BARCHART PAGES. C C INPUT: C NPA - NUMBER OF WORK ITEMS TO BE PLOTTED, C ISVEC - VECTOR CONTAINING THE NUMBER OF EACH RECORD C TO BE PLOTTED IN THE ORDER IT IS TO BE C PLOTTED, C NCDATE(1000) C - TABLE TO TRANSLATE DAYS TO DATES. C NPEND - NUMBER OF WORK DAYS IN SCHEDULE, C NFIRSTD - NUMBER OF THE FIRST DAY ACTUALLY USED FOR THIS SUBSET C NLASTD - NUMBER OF THE LAST WORK DAY USED ON CURRENT SUBSET C OF ACTIVITIES USED FOR THIS PLOT C IPFIL - 0 IF NO INSTALLATION PARAMETER FILE EXISTS, C 1 IF AN I. P. FILE EXISTS FOR THE PLOTTER, C IWARM - 1 TO REQUEST OPERATOR VERIFICATION OF PEN WARMUP, C IREPLOT - 1 TO PRESENT OPERATOR WITH THE OPPORTUNITY TO C REPLOT THE SAME CHART, C ICONTP - 1 TO PLOT PAGES CONTINUOUSLY WITHOUT REQUESTING C THE MOUNTING OF NEW SHEETS OF PAPER, C DRWG - 2 CHARACTER SYMBOL TO DESIGNATE THE DRAWING SIZE C AND LEGENDS, C NDAYPD - NUMBER OF WORK DAYS PER PLOTTED DATE WITHIN THE C DATE BARS, C NDATAD - DATA DATE (IN WORK DAYS), C ICSTART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESS FLOAT TIMES C C ENTER VIA: C CALL BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, IPFIL, C IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, NDATAD, ICSTART, C PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C C SUBROUTINES REQUIRED: BCHART, PLOTX, REPLY, USEIP C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: AUG 1984 C C***************************************************((******************* C SUBROUTINE BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, 1 IPFIL, IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, 2 NDATAD, ICSTART, PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C IMPLICIT INTEGER*2 (I-N) C COMMON /SCH04/ IREV(4), FEXTN(15), PLOTF(9) COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN COMMON /PENS/ NCP, NHOLD, NPINH(5), NPENS, 1 PDESCR(5,10), WX, WY, WW, WH, NWUP, IPFILE(9) C INTEGER*2 UP, DOWN, PDESCR INTEGER*2 NCDATE(1), DRWG INTEGER*2 FEXTN, PLOTF, ISVEC(1) C DATA WHPROP/0.7/, BH/0.17/, CH/0.07/, DOT/0.05/, DASH/0.12/, 1 UP/3/, DOWN/2/ C C <> C C C MAX. BARS PER SHEET C NBMAX = (H - PFCTR * BH * (4.0 + WHPROP)) / ((1.0 + WHPROP) 1 * BH * PFCTR) C C NUMBER OF SHEETS REQUIRED C NSHTS = (NPA - 1) / NBMAX + 1 C C NUMBER OF ACTIVITIES PER SHEET (EXCEPT LAST) C NAPERSHT = (NPA + NSHTS - 1) / NSHTS C C NUMBER OF DATES TO BE PLOTTED C NPENDX = NPEND NFDAY = 0 2 NDP = (NPENDX - NFDAY + 2 * NDAYPD - 2) / NDAYPD C C CHART WIDTH C CHARTW = PFCTR * (12.0 * CH + 3.0 * CH * NDP) C C CHART HEIGHT C DBARHT = 4.0 IF (ICODTE .EQ. 3) DBARHT = 8 ! TEK DATE BAR HEIGHT CHHT = PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + DBARHT + WHPROP) C C AUTO SCALE FACTOR VERTICALLY C PFCTR2 = H / CHHT C C AUTO SCALE FACTOR HORIZONTALLY C PFCTR1 = W / CHARTW IF (NFDAY .GE. NFIRSTD - 1) GO TO 4 IF (NPENDX .EQ. NLASTD) GO TO 3 ! 2ND PASS / NO DIFF IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING # OF DAYS FOR THIS SUBSET C NPENDX = NLASTD GO TO 2 3 IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING START DAY FOR SUBSET C NFDAY = NFIRSTD - 1 GO TO 2 4 IF (PFCTR2 .LT. PFCTR1) PFCTR1 = PFCTR2 PFCTR = PFCTR * PFCTR1 CHARTW = CHARTW * PFCTR1 C C TELL OPERATOR THE SCALE ACTUALLY USED C FCH = PFCTR * CH WRITE (6,5) NSHTS, PFCTR, FCH 5 FORMAT ('0 PAGES:',I2,' ACTUAL PLOT FACTOR USED:',F5.2, 1 ' CHAR. HEIGHT:',F6.3) C C PLOT EACH SHEET C CALL OPLOTS ( PLOTF, 14) ! OPEN THE LOGICAL DEVICE FOR PLOT OUTPUT C NFRST = 1 DO 40 ISH = 1, NSHTS C C ADJUST NUMBER FOR LAST SHEET C IF (ISH .EQ. NSHTS) NAPERSHT = NPA - NAPERSHT * (NSHTS - 1) C C OPEN PLOT FILE - MOVED TO AREA BEFORE DO LOOP C C CALL OPLOTS ( PLOTF, 14 ) C C CONTINUOUS PLOTTING? C IF (ICONTP .NE. 0) GO TO 8 C C NOT CONTINUOUS. ASK FOR NEW SHEET. C WRITE (6,7) ISH 7 FORMAT ('0MOUNT SHEET',I2,'. STRIKE RETURN.',$) C CALL REPLY (IANS, L, 0, *10, *10, *10, *10, 0) C NCP = 0 ! FORCE NEW WARMUP GO TO 10 C C MOVE DOWN TO NEW DRAWING AREA C 8 IF (ISH .EQ. 1) GO TO 10 C NOT REQUIRED ON CALCOMP OR DDN C CALL PLOTX (X + X + W, 0.0, -3) C C DRAW BORDERS AND TITLE NEW PAGE C 10 CALL USEIP (DRWG, ISH, NSHTS, IWARM, ICODTE) C IF (IREPLOT .EQ. 0) GO TO 20 WRITE (6,13) 13 FORMAT ('0REPLOT TITLE BLOCK(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *20, *20, *20, *20, 0) C IF (IANS .NE. 0) GO TO 10 C C SET UP COORDINATES OF LOWER C LEFT CORNER OF CHART AREA C 20 XX = X + (W - CHARTW) / 2.0 YY = Y + (H - PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + + DBARHT + WHPROP)) / 2.0 C C PLOT THE ACTUAL BAR CHART C 22 CALL BCHART (XX, YY, ISVEC(NFRST), NAPERSHT, NDP, NDAYPD, + NDATAD, ICSTART, PFCTR, NCDATE, NFDAY, NPENDX, IWARM, + ICODTE, ISFLOAT) C C SHOULD REPLOT BE OFFERED? C IF (IREPLOT .EQ. 0) GO TO 30 WRITE (6,23) 23 FORMAT ('0REPLOT BARCHART PAGE(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *30, *30, *30, *30, 0) C IF (IANS .NE. 0) GO TO 22 30 NFRST = NFRST + NAPERSHT C NEW PLOT PAGE REQUIRES C CALCOMP A PLOT LABEL TO BE WRITTEN. THIS C ALLOWS THE OPORATOR TO MOVE THE PEN C PLOTTING THE NEXT PAGE. CALL PLOTX ( 0.0, 0.0, -3) C 40 CONTINUE C CALCOMP - CALL CPLOTS ( PLOTF, 14) ! CLOSE THE PLOT OUTPUT FILE C RETURN END EQ. NSHTS) NAPERSHT = NPA - NAPERSHT * (NSHTS - 1) C C OPEN PLOT FILE C CALL OPLOTS ( PLOTF, 14 ) C C CONTINUOUS PLOTTING? C IF (ICONTP .NE. 0) GO TO 8 C C NOT CONTINUOUS. ASK FOR NEW SHEET. C WRITE (6,7) ISH 7 FORMAT ('0MOUNT SHEET',I2,'. STRIKE RETURN.',$) C CALL REPLY (IANS, L, 0, *10, *10, *10, *10, 0) C NCP = 0 ! FORCE NEW WARMUP GO TO 10 C C MOVE DOWN TO NEW DRAWING AREA C 8 IF (ISH .EQ. 1) GO TO 10 C CALL PLOT (X + X + W, 0.0, -3) C C DRAW BORDdavel/vms/BARCH.SWN;1 644 37 1770 14167 3515015700 7447 C.~* SYSTEM: SNIPS, PROGRAM: BARCH ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C OVERSEE THE PLOTTING OF ALL BARCHART PAGES. C C INPUT: C NPA - NUMBER OF WORK ITEMS TO BE PLOTTED, C ISVEC - VECTOR CONTAINING THE NUMBER OF EACH RECORD C TO BE PLOTTED IN THE ORDER IT IS TO BE C PLOTTED, C NCDATE(1000) C - TABLE TO TRANSLATE DAYS TO DATES. C NPEND - NUMBER OF WORK DAYS IN SCHEDULE, C NFIRSTD - NUMBER OF THE FIRST DAY ACTUALLY USED FOR THIS SUBSET C NLASTD - NUMBER OF THE LAST WORK DAY USED ON CURRENT SUBSET C OF ACTIVITIES USED FOR THIS PLOT C IPFIL - 0 IF NO INSTALLATION PARAMETER FILE EXISTS, C 1 IF AN I. P. FILE EXISTS FOR THE PLOTTER, C IWARM - 1 TO REQUEST OPERATOR VERIFICATION OF PEN WARMUP, C IREPLOT - 1 TO PRESENT OPERATOR WITH THE OPPORTUNITY TO C REPLOT THE SAME CHART, C ICONTP - 1 TO PLOT PAGES CONTINUOUSLY WITHOUT REQUESTING C THE MOUNTING OF NEW SHEETS OF PAPER, C DRWG - 2 CHARACTER SYMBOL TO DESIGNATE THE DRAWING SIZE C AND LEGENDS, C NDAYPD - NUMBER OF WORK DAYS PER PLOTTED DATE WITHIN THE C DATE BARS, C NDATAD - DATA DATE (IN WORK DAYS), C ICSTART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESS FLOAT TIMES C C ENTER VIA: C CALL BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, IPFIL, C IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, NDATAD, ICSTART, C PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C C SUBROUTINES REQUIRED: BCHART, PLOTX, REPLY, USEIP C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: AUG 1984 C C********************************************************************** C SUBROUTINE BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, 1 IPFIL, IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, 2 NDATAD, ICSTART, PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C IMPLICIT INTEGER*2 (I-N) C COMMON /SCH04/ IREV(4), FEXTN(15), PLOTF(9) COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN COMMON /PENS/ NCP, NHOLD, NPINH(5), NPENS, 1 PDESCR(5,10), WX, WY, WW, WH, NWUP, IPFILE(9) C INTEGER*2 UP, DOWN, PDESCR INTEGER*2 NCDATE(1), DRWG INTEGER*2 FEXTN, PLOTF, ISVEC(1) C DATA WHPROP/0.7/, BH/0.17/, CH/0.07/, DOT/0.05/, DASH/0.12/, 1 UP/3/, DOWN/2/ C C <> C C C MAX. BARS PER SHEET C NBMAX = (H - PFCTR * BH * (4.0 + WHPROP)) / ((1.0 + WHPROP) 1 * BH * PFCTR) C C NUMBER OF SHEETS REQUIRED C NSHTS = (NPA - 1) / NBMAX + 1 C C NUMBER OF ACTIVITIES PER SHEET (EXCEPT LAST) C NAPERSHT = (NPA + NSHTS - 1) / NSHTS C C NUMBER OF DATES TO BE PLOTTED C NPENDX = NPEND NFDAY = 0 2 NDP = (NPENDX - NFDAY + 2 * NDAYPD - 2) / NDAYPD C C CHART WIDTH C CHARTW = PFCTR * (12.0 * CH + 3.0 * CH * NDP) C C CHART HEIGHT C DBARHT = 4.0 IF (ICODTE .EQ. 3) DBARHT = 8 ! TEK DATE BAR HEIGHT CHHT = PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + DBARHT + WHPROP) C C AUTO SCALE FACTOR VERTICALLY C PFCTR2 = H / CHHT C C AUTO SCALE FACTOR HORIZONTALLY C PFCTR1 = W / CHARTW IF (NFDAY .GE. NFIRSTD - 1) GO TO 4 IF (NPENDX .EQ. NLASTD) GO TO 3 ! 2ND PASS / NO DIFF IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING # OF DAYS FOR THIS SUBSET C NPENDX = NLASTD GO TO 2 3 IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING START DAY FOR SUBSET C NFDAY = NFIRSTD - 1 GO TO 2 4 IF (PFCTR2 .LT. PFCTR1) PFCTR1 = PFCTR2 PFCTR = PFCTR * PFCTR1 CHARTW = CHARTW * PFCTR1 C C TELL OPERATOR THE SCALE ACTUALLY USED C FCH = PFCTR * CH WRITE (6,5) NSHTS, PFCTR, FCH 5 FORMAT ('0 PAGES:',I2,' ACTUAL PLOT FACTOR USED:',F5.2, 1 ' CHAR. HEIGHT:',F6.3) C C PLOT EACH SHEET C C CALL OPLOTS ( PLOTF, 14) ! NECESSARY ONLY ON CALCOMP. C NFRST = 1 DO 40 ISH = 1, NSHTS C C ADJUST NUMBER FOR LAST SHEET C IF (ISH .EQ. NSHTS) NAPERSHT = NPA - NAPERSHT * (NSHTS - 1) C C OPEN PLOT FILE C CALL OPLOTS ( PLOTF, 14 ) C C CONTINUOUS PLOTTING? C IF (ICONTP .NE. 0) GO TO 8 C C NOT CONTINUOUS. ASK FOR NEW SHEET. C WRITE (6,7) ISH 7 FORMAT ('0MOUNT SHEET',I2,'. STRIKE RETURN.',$) C CALL REPLY (IANS, L, 0, *10, *10, *10, *10, 0) C NCP = 0 ! FORCE NEW WARMUP GO TO 10 C C MOVE DOWN TO NEW DRAWING AREA C 8 IF (ISH .EQ. 1) GO TO 10 C NOT NECESSARY FOR PLOTTING TERMINALS - DDN C CALL PLOTX (X + X + W, 0.0, -3) C C DRAW BORDERS AND TITLE NEW PAGE C 10 CALL USEIP (DRWG, ISH, NSHTS, IWARM, ICODTE) C IF (IREPLOT .EQ. 0) GO TO 20 WRITE (6,13) 13 FORMAT ('0REPLOT TITLE BLOCK(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *20, *20, *20, *20, 0) C IF (IANS .NE. 0) GO TO 10 C C SET UP COORDINATES OF LOWER C LEFT CORNER OF CHART AREA C 20 XX = X + (W ((- CHARTW) / 2.0 YY = Y + (H - PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + + DBARHT + WHPROP)) / 2.0 C C PLOT THE ACTUAL BAR CHART C 22 CALL BCHART (XX, YY, ISVEC(NFRST), NAPERSHT, NDP, NDAYPD, + NDATAD, ICSTART, PFCTR, NCDATE, NFDAY, NPENDX, IWARM, + ICODTE, ISFLOAT) C C SHOULD REPLOT BE OFFERED? C IF (IREPLOT .EQ. 0) GO TO 30 WRITE (6,23) 23 FORMAT ('0REPLOT BARCHART PAGE(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *30, *30, *30, *30, 0) C IF (IANS .NE. 0) GO TO 22 30 NFRST = NFRST + NAPERSHT C NEW PLOT PAGE REQUIRES C A PLOT LABEL TO BE WRITTEN. THIS C ALLOWS THE OPORATOR TO MOVE THE PEN C PLOTTING THE NEXT PAGE. C CALL PLOTX ( 0., 0., -3) ! NECESSARY ONLY ON CALCOMP C CALL CPLOTS ( PLOTF, 14) ! CLOSE THE PLOT OUTPUT FILE - DDN C ONE PLOT PAGE WRITTEN PER FILE. 40 CONTINUE C C CALL CPLOTS ( PLOTF, 14) ! CALCOMP CLOSE GOES HERE. C RETURN END ART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESdavel/vms/BARCH.XRX;1 644 37 1770 14262 3515015702 7457 C.~* SYSTEM: SNIPS, PROGRAM: BARCH ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C OVERSEE THE PLOTTING OF ALL BARCHART PAGES. C C INPUT: C NPA - NUMBER OF WORK ITEMS TO BE PLOTTED, C ISVEC - VECTOR CONTAINING THE NUMBER OF EACH RECORD C TO BE PLOTTED IN THE ORDER IT IS TO BE C PLOTTED, C NCDATE(1000) C - TABLE TO TRANSLATE DAYS TO DATES. C NPEND - NUMBER OF WORK DAYS IN SCHEDULE, C NFIRSTD - NUMBER OF THE FIRST DAY ACTUALLY USED FOR THIS SUBSET C NLASTD - NUMBER OF THE LAST WORK DAY USED ON CURRENT SUBSET C OF ACTIVITIES USED FOR THIS PLOT C IPFIL - 0 IF NO INSTALLATION PARAMETER FILE EXISTS, C 1 IF AN I. P. FILE EXISTS FOR THE PLOTTER, C IWARM - 1 TO REQUEST OPERATOR VERIFICATION OF PEN WARMUP, C IREPLOT - 1 TO PRESENT OPERATOR WITH THE OPPORTUNITY TO C REPLOT THE SAME CHART, C ICONTP - 1 TO PLOT PAGES CONTINUOUSLY WITHOUT REQUESTING C THE MOUNTING OF NEW SHEETS OF PAPER, C DRWG - 2 CHARACTER SYMBOL TO DESIGNATE THE DRAWING SIZE C AND LEGENDS, C NDAYPD - NUMBER OF WORK DAYS PER PLOTTED DATE WITHIN THE C DATE BARS, C NDATAD - DATA DATE (IN WORK DAYS), C ICSTART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE C PLOTTING AREA, C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C NSHTS - NUMBER OF SHEETS ACTUALLY PLOTTED. C ICODTE - 0 FOR REGULAR DATE BAR C 3 FOR EXPANDED DATE BAR FOR COMPANY DATES C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESS FLOAT TIMES C C ENTER VIA: C CALL BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, IPFIL, C IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, NDATAD, ICSTART, C PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C C SUBROUTINES REQUIRED: BCHART, PLOTX, REPLY, USEIP C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 XEROX C C********************************************************************** C SUBROUTINE BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, 1 IPFIL, IWARM, IREPLOT, ICONTP, DRWG, NDAYPD, 2 NDATAD, ICSTART, PFCTR, X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C IMPLICIT INTEGER*2 (I-N) C COMMON /SCH04/ IREV(4), FEXTN(15), PLOTF(9) COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN COMMON /PENS/ NCP, NHOLD, NPINH(5), NPENS, 1 PDESCR(5,10), WX, WY, WW, WH, NWUP, IPFILE(9) C INTEGER*2 UP, DOWN, PDESCR INTEGER*2 NCDATE(1), DRWG INTEGER*2 FEXTN, PLOTF, ISVEC(1) C DATA WHPROP/0.7/, BH/0.17/, CH/0.07/, DOT/0.05/, DASH/0.12/, 1 UP/3/, DOWN/2/ C C <> C C C MAX. BARS PER SHEET C NBMAX = (H - PFCTR * BH * (4.0 + WHPROP)) / ((1.0 + WHPROP) 1 * BH * PFCTR) C C NUMBER OF SHEETS REQUIRED C NSHTS = (NPA - 1) / NBMAX + 1 C C NUMBER OF ACTIVITIES PER SHEET (EXCEPT LAST) C NAPERSHT = (NPA + NSHTS - 1) / NSHTS C C NUMBER OF DATES TO BE PLOTTED C NPENDX = NPEND NFDAY = 0 2 NDP = (NPENDX - NFDAY + 2 * NDAYPD - 2) / NDAYPD C C CHART WIDTH C CHARTW = PFCTR * (12.0 * CH + 3.0 * CH * NDP) C C CHART HEIGHT C DBARHT = 4.0 IF (ICODTE .EQ. 3) DBARHT = 8 ! TEK DATE BAR HEIGHT CHHT = PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + DBARHT + WHPROP) C C AUTO SCALE FACTOR VERTICALLY C PFCTR2 = H / CHHT C C AUTO SCALE FACTOR HORIZONTALLY C PFCTR1 = W / CHARTW IF (NFDAY .GE. NFIRSTD - 1) GO TO 4 IF (NPENDX .EQ. NLASTD) GO TO 3 ! 2ND PASS / NO DIFF IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING # OF DAYS FOR THIS SUBSET C NPENDX = NLASTD GO TO 2 3 IF (PFCTR1 .GE. PFCTR2) GO TO 4 C C TRY USING START DAY FOR SUBSET C NFDAY = NFIRSTD - 1 GO TO 2 4 IF (PFCTR2 .LT. PFCTR1) PFCTR1 = PFCTR2 PFCTR = PFCTR * PFCTR1 CHARTW = CHARTW * PFCTR1 C C TELL OPERATOR THE SCALE ACTUALLY USED C FCH = PFCTR * CH WRITE (6,5) NSHTS, PFCTR, FCH 5 FORMAT ('0 PAGES:',I2,' ACTUAL PLOT FACTOR USED:',F5.2, 1 ' CHAR. HEIGHT:',F6.3) C C PLOT EACH SHEET C CALL OPLOTS ( PLOTF, 14) ! OPEN THE LOGICAL DEVICE FOR PLOT OUTPUT CALL PLOTX ( 0., 0., -3) ! INITIALIZE THE CALC925 CONTROLLER BUFFER NFRST = 1 DO 40 ISH = 1, NSHTS C C ADJUST NUMBER FOR LAST SHEET C IF (ISH .EQ. NSHTS) NAPERSHT = NPA - NAPERSHT * (NSHTS - 1) C C OPEN PLOT FILE - MOVED TO AREA BEFORE DO LOOP C C CALL OPLOTS ( PLOTF, 14 ) C C CONTINUOUS PLOTTING? C IF (ICONTP .NE. 0) GO TO 8 C C NOT CONTINUOUS. ASK FOR NEW SHEET. C WRITE (6,7) ISH 7 FORMAT ('0MOUNT SHEET',I2,'. STRIKE RETURN.',$) C CALL REPLY (IANS, L, 0, *10, *10, *10, *10, 0) C NCP = 0 ! FORCE NEW WARMUP GO TO 10 C C MOVE DOWN TO NEW DRAWING AREA C 8 IF (ISH .EQ. 1) GO TO 10 C NOT REQUIRED ON CALCOMP OR DDN C CALL PLOTX (X + X + W, 0.0, -3) C C DRAW BORDERS AND TITLE NEW PAGE C 10 CALL USEIP (DRWG, ISH, NSHTS, IWARM, ICODTE) C IF (IREPLOT .EQ. 0) GO TO 20 WRITE (6,13) 13 FORMAT ('0REPLOT TITLE BLOCK(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *20, *20, *20, *20, 0) C IF (IANS .NE. 0) GO TO 10 C C SET UP COORDINATES OF LOWER C LEFT CORNER OF CHART AREA C 20 XX = X + (W - CHARTW) / 2.0 YY = Y + (H - PFCTR * BH * (NAPERSHT * (1.0 + WHPROP) + + DBARHT + WHPROP)) / 2.0 C C PLOT THE ACTUAL BAR CHART C 22 CALL PLOTX ( XX, YY, 3) CALL BCHART (XX, YY, ISVEC(NFRST), NAPERSHT, NDP, NDAYPD, + NDATAD, ICSTART, PFCTR, NCDATE, NFDAY, NPENDX, IWARM, + ICODTE, ISFLOAT) C C SHOULD REPLOT BE OFFERED? C IF (IREPLOT .EQ. 0) GO TO 30 WRITE (6,23) 23 FORMAT ('0REPLOT BARCHART PAGE(Y/N)? ',$) C CALL REPLY (IANS, L, 0, *30, *30, *30, *30, 0) C IF (IANS .NE. 0) GO TO 22 30 NFRST = NFRST + NAPERSHT C NEW PLOT PAGE REQUIRES C CALCOMP A PLOT LABEL TO BE WRITTEN. THIS C ALLOWS THE OPORATOR TO MOVE THE PEN C PLOTTING THE NEXT PAGE. CALL PLOTX ( 0., 0., -3 ) CALL PLOTX ( 0., 0., -999) C 40 CONTINUE C CALCOMP - CALL CPLOTS ( PLOTF, 14) ! CLOSE THE PLOT OUTPUT FILE C RETURN END davel/vms/BCHART.FOR;1 644 37 1770 20177 3515015707 7557 C.~* SYSTEM: SNIPS, PROGRAM: BCHART ***** COPYRIGHT 1984 SOFTWARE NORTH **** C C VAX/VMS VERSION C C CONTROL PLOTTING OF A SINGLE BARCHART PAGE. C C INPUT: C X, Y - COORDINATES OF LOWER LEFT CORNER OF CHART, C ISVEC - VECTOR CONTAINING THE RECORD NUMBERS OF THE WORK ACTIVITIES C TO BE PLOTTED (IN THE ORDER THEY ARE TO APPEAR DOWN THE PAGE), C NTASK - NUMBER OF TASKS TO BE PLOTTED ON THIS PAGE, C NDP - NUMBER OF DATES PLOTTED ALONG THE UPPER AND LOWER EDGES, C NDAYPD - NO. OF DAYS PER DATE PLOTTED ALONG THE BORDERS, C NDATAD - DATA DATE (IN WORK DAYS), C ICSTART - CALENDAR START DATE, C PFCTR - PLOTTING FACTOR, C NCDATE - VECTOR CONTAINING THE DATES (IN DAYS SINCE 1-1-68) FOR C THE FIRST 'N' WORKING DAYS OF THIS PROJECT, C NFDAY - NUMBER OF DAY BEFORE 1ST ACTUALLY USED IN THE SUBSET C TO BE PLOTTED C N - NUMBER OF WORK DAYS IN THE PROJECT, C IWARM - 1 TO REQUIRE OPERATOR VERIFIED WARMUP OF EACH PEN. C ICODTE - 0 TO USE REGULAR 3 LINE DATE BAR C 3 TO USE ((5 LINE COMPANY DATE BAR C ISFLOAT - 0 TO OUTPUT FLOAT TIMES C 1 TO SUPPRESS FLOAT TIMES C C ENTER VIA: C CALL BCHART (X, Y, ISVEC, NTASK, NDP, NDAYPD, NDATAD, ICSTART, C PFCTR, NCDATE, NFDAY, N, IWARM, ICODTE, ISFLOAT) C C SUBROUTINES REQUIRED: BLANK, DBAR, DCLFIX, FACTRX, ITMTAG, PLOTX, SBAR, C SUBSTR, SYMBLX, WARM C FUNCTIONS REQUIRED: LENGTH C C AUTHOR: D. N. ANDERSON -- LAST MOD: DEC 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C************************************************************************** C SUBROUTINE BCHART (X, Y, ISVEC, NTASK, NDP, NDAYPD, NDATAD, + ICSTART, PFCTR, NCDATE, NFDAY, N, IWARM, ICODTE, ISFLOAT) C IMPLICIT INTEGER*2 (I-N) C COMMON /PENS/ NCP, ! NO. OF CURRENT PEN 1 NHOLD, ! NUMBER OF PEN HOLDERS 2 NPINH(5), ! NO. OF PEN IN EACH HOLDER 3 NPENS, ! NUMBER OF PENS TO USE 4 PDESCR(5,10), ! DESCRIPTIONS OF EACH PEN 5 WX, WY, ! COORDINATES OF WARMUP AREA 6 WW, WH, ! WIDTH & HEIGHT OF WARMUP AREA 7 NWUP, ! NO. OF WARMUPS DONE 8 IPFILE(9) ! NAME OF INSTALLATION PARAM. FILE C COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN COMMON /BLGND/ LGREC(21,4) C INTEGER*2 UP, DOWN, ISVEC(1), ICOLOR(3), PDESCR,NCDATE(1), 1 REC(50) INTEGER*2 IM12(16), IM13(50) C REAL LGLEN, W(4) C DATA LGREC / 7, 10*0, 1, 7, 1 'WO','RK',' D','ON','E ',' ',' ',' ', 2 3*0, 60, 0, 10, 3*70, 4*0, 3 'WO','RK',' R','EM','AI','NI','NG',' ', 4 5*0, 2*10, 2*70, 4*0, 5 'FR','EE','-F','LO','AT',' ',' ',' ', 6 5*0, 3*10, 70, 4*0, 7 'DE','PE','ND','EN','T ','FL','OA','T '/ C C <> C C SET UP TEMPORARY PLOTTING ORIGIN AND FACTOR PLOT SIZE C CALL PLOTX (X, Y, -3) C C CHANGE WARMUP COORDINATES TO COMPENSATE FOR NEW C ORIGIN AND FACTOR. SAVE OLD ONES FOR EXACT RESTORATION. C W(1) = WX W(2) = WY W(3) = WW W(4) = WH WX = (WX - X) / PFCTR WY = (WY - Y) / PFCTR WW = WW / PFCTR WH = WH / PFCTR C C SET UP OFFSET FOR COMPANY SPECIFIC DATE BAR (DOUBLE HEIGHT) C CSOFF = 0.0 IF (ICODTE .EQ. 3) CSOFF = BH + BH C C SET UP PLOT FACTOR FOR ACTUAL BARCHART C CALL FACTRX (PFCTR) C CALL WARM (1, IWARM) C C PLOT THE LOWER 'ITEM TAG' BOX C DX = 12.0 * CH TOP = 2.0 * BH + CSOFF XX = DX WHITE = WHPROP * BH XEND = XX + 3.0 * NDP * CH BACK1 = 4.0 * (BH + WHITE) - WHITE / 2.0 BACK2 = BH + WHITE / 2.0 XTAG = DX / 2.0 - 1.3 * CH ADJ = (BH - CH) / 2.0 ADJI = ADJ + CSOFF / 2.0 C CALL ITMTAG (XTAG, XX, 0.0, ADJI, TOP) C C PLOT REST OF BOTTOM DATE BAR C CALL DBAR (XX, CSOFF, NDP, NDAYPD, NCDATE, NFDAY, N, ICSTART, 1) IF (ICODTE .EQ. 3) CALL CODBAR (XX, 0.0, NDP, NDAYPD, NCDATE, + NFDAY, N, ICSTART, 1) C C CALC POSITION OF UPPER DATE BAR C YY = (NTASK + 1) * (BH + WHITE) + BH + CSOFF UPPER = YY C C PLOT LEFT BORDER OF CHART C CALL PLOTX (0.0, TOP, UP) C CALL PLOTX (0.0, YY, DOWN) C C PLOT UPPER 'ITEM TAG' BOX C CALL ITMTAG (XTAG, XX, YY, ADJ, TOP) C C PLOT UPPER DATE BAR C CALL DBAR (XX, YY, NDP, NDAYPD, NCDATE, NFDAY, N, ICSTART, 0) IF (ICODTE .EQ. 3) CALL CODBAR (XX, YY + CSOFF, NDP, NDAYPD, + NCDATE, NFDAY, N, ICSTART, 0) C C PLOT INDIVIDUAL TASK BARS C NPASS = 3 IF (NPENS .EQ. 2) NPASS = 2 IF (NPENS .EQ. 1) NPASS = 1 C C LOOP OVER ALL BARS ENOUGH TIMES TO EXERCISE ALL PENS C LEGND = 0 LGPASS = 0 ! LEGEND NOT PLOTTED YET IF (ISFLOAT .GT. 0) LEGND = 999 ! NO LEGEND IF FLOATS SUPPRESSED DO 40 NPSS = 1, NPASS ICOLOR(1) = 0 ICOLOR(2) = 0 ICOLOR(3) = 0 ICOLOR(NPSS) = NPSS IF (NPENS .LE. 2 .AND. NPSS .EQ. 1) ICOLOR(3) = 1 IF (NPENS .EQ. 1) ICOLOR(2) = 1 C CALL WARM (ICOLOR(NPSS), IWARM) C C RESTART Y-COORDINATE C YY = UPPER LGLEN = WHITE + 29.0 * CH RTMAX = 0.0 SCAL = 3.0 * CH / NDAYPD IGRID = 0 NGRID = 1 C C LOOP OVER INDIVIDUAL TASKS C DO 10 I = 1, NTASK C C ADJUST Y-COORDINATE C YY = YY - BH - WHITE C C READ TASK ITEM C READ (12' ISVEC(I)) IM12 IF (ISFLOAT .EQ. 0) GO TO 1 ! IS FLOAT TO BE SUPPRESSED ? IM12(7) = IM12(6) ! YES IM12(8) = IM12(6) 1 READ (13' ISVEC(I)) IM13 C C HORIZONTAL GRID LINES DUE? C IF (IGRID .LT. 6) GO TO 8 IGRID = 0 NGRID = NGRID + 1 IF (LEGND .GE. 2) GO TO 2 C C LEGEND BOX HAS NOT BEEN LOCATED. IS THERE ROOM? C IF (RTMAX .GT. XEND - LGLEN) GO TO 2 C C YES. MARK FOR PLOTTING. C IF (NPSS .EQ. 1 .OR. LGPASS .EQ. 1) LEGND = 1 C C PLOT UPPER GRID LINE OF A PAIR C 2 IF (ICOLOR(3) .EQ. 0) GO TO 3 C CALL WARM (ICOLOR(3), IWARM) C CALL PLOTX (0.0, YY + BACK1, UP) C XE = XEND IF (LEGND .EQ. 1 .OR. LEGND .EQ. NGRID) XE = XEND - LGLEN C CALL PLOTX (XE, YY + BACK1, DOWN) C 3 IF (LEGND .NE. 1 .AND. LEGND .NE. NGRID) GO TO 7 C C PLOT LEGEND BOX C XE = XEND - LGLEN LEGND = NGRID IF (ICOLOR(3) .EQ. 0) GO TO 4 C CALL PLOTX (XE, YY + BACK1 + 3.0 * (BH + WHITE), UP) C CALL PLOTX (XE, YY + BACK1 - 3.0 * (BH + WHITE), DOWN) C 4 XLG = XE + WHITE YLG = YY + BACK1 + 1.5 * WHITE + BH DO 5 J = 1,4 C CALL BLANK (REC, 13, 80) C CALL SUBSTR (REC, 14, LGREC(14,J), 1, 15) C CALL SBAR (XLG, YLG, XEND, 2, LGREC(1,J), LGREC(2,J), 1 REC, 0, ICOLOR, IWARM, XR) C YLG = YLG - WHITE - BH LGPASS = 1 5 CONTINUE 7 IF (ICOLOR(3) .EQ. 0) GO TO 6 C CALL WARM (ICOLOR(3), IWARM) C C PLOT LOWER GRID LINE OF A PAIR C CALL DCLFIX ( YY, BYY ) ! TRY TO FIX COMPILER ERROR C CALL PLOTX (XEND, BYY + BACK2, UP) C CALL PLOTX (0.0, BYY + BACK2, DOWN) C 6 RTMAX = 0.0 C C CENTER AND PLOT ITEM TAG C 8 IF (ICOLOR(1) .EQ. 0) GO TO 9 C CALL WARM (ICOLOR(1), IWARM) C L = LENGTH (IM13(2), 10) C CALL SYMBLX ((DX - L * CH) / 2.0, YY + ADJ, CH, IM13(2), 0.0, L) C C PLOT ACTUAL WORK ACTIVITY SCHEDULE BAR C 9 CALL SBAR (XX + 0.7 * CH, YY, XEND, NDAYPD, NDATAD, IM12, 1 IM13, NFDAY, ICOLOR, IWARM, XRIGHT) C IGRID = IGRID + 1 C C KEEP TRACK OF RIGHTMOST EXCURSION IN THIS GRID SECTION C IF (XRIGHT .GT. RTMAX) RTMAX = XRIGHT 10 CONTINUE IF (IGRID .LE. 4) GO TO 20 C C PLOT A LAST GRID LINE ON THIS PAGE C IF (ICOLOR(3) .EQ. 0) GO TO 20 C CALL WARM (ICOLOR(3), IWARM) C YY = YY + (IGRID - 3) * (BH + WHITE) - WHITE / 2.0 C CALL PLOTX (0.0, YY, UP) C CALL PLOTX (XEND,YY, DOWN) C C PLOT RIGHT CHART BORDER C 20 IF (ICOLOR(1) .EQ. 0) GO TO 30 C CALL WARM (ICOLOR(1), IWARM) C CALL PLOTX (XEND, TOP, UP) C CALL PLOTX (XEND, UPPER, DOWN) C 30 IF (NDATAD .LE. 0) GO TO 40 C C PLOT DATA DATE LINE C IF (ICOLOR(2) .EQ. 0) GO TO 40 C CALL WARM (ICOLOR(2), IWARM) C YY = UPPER XLG = XX + 0.7 * CH + (NDATAD - NFDAY) * 3.0 * CH / NDAYPD DO 36 K = 1, NTASK C CALL PLOTX (XLG, YY, UP) C YY = YY - WHITE C CALL PLOTX (XLG, YY, DOWN) C 36 YY = YY - BH C CALL PLOTX (XLG, YY, UP) C CALL PLOTX (XLG, TOP, DOWN) C 40 CONTINUE C C END OF LOOP OVER ALL COLORS C C RESTORE ORIGINAL COORDINATE SYSTEM AND FACTOR C CALL PLOTX (0.0, 0.0, UP) C CALL FACTRX (1.0) C C CALL PLOTX (-X, -Y, -3) ! NOT USED ON VAX VERSIONS C CALL PLOTX (0.0, 0.0, DOWN) C C RESTORE WARMUP AREA COORDINATES C WX = W(1) WY = W(2) WW = W(3) WH = W(4) RETURN END davel/vms/BILL.FOR;1 644 37 1770 10727 3515015713 7333 C.~* SYSTEM: SNIPS, PROGRAM: BILL ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C VAX/VMS VERSION C C RECORD IN THE CURRENT SCHEDULES BILLING FILE ANY TARIFF ASSOCIATED C WITH THIS PROGRAM EXECUTION. C C PARAMETERS: C NREC - NUMBER OF THE FIRST OF THREE RECORDS TO BE READ C FROM THE RATE FILE ('SNIPS.RT') TO USE IN COMPOSING C THE ITEMIZED ENTRIES FOR THIS BILLING, C IRATE - 0 IF THE RATES ARE TO BE NORMALLY COMPUTED, C 1 IF THE BILL IS TO CONTAIN ONLY N/C ENTRIES FOR THIS RUN C 2 IF NO ENTRIES ARE TO BE MADE IN THE BILL FOR THIS RUN, C T(6) - DATE & TIME OF THE START OF THIS RUN (MO, DAY, YR, HR, C MIN, SEC) C NC1 - COUNT OF A BILLABLE QUANTITY COLLECTED BY THE PROGRAM, C NC2 - COUNT OF A BILLABLE QUANTITY COLLECTED BY THE PROGRAM, C FILEBI - NAME OF THIS SCHEDULES BILL FILE. C C ENTER VIA: C CALL BILL (NREC, IRATE, T, NC1, NC2, FILEBI) C C BILLING ALGORITHM: C THIS SUBPROGRAM WILL ADD UP TO 3 LINE ITEMS TO A BILLING C FILE FOR THIS SCHEDULE. EACH LINE ITEM IS CONSTRUCTED C AS DIRECTED BY THE RATE FILE ('SNIPS.RT'). THE PRICE IS C COMPUTED FOR EACH LINE ITEM(I) ACORDING TO THE FORMULA; C PRICE = R(1,I) * MIN + R(2,I) * NC1 + R(3,I) * NC2 + R(4,I) C (EXCEPT THAT R(4,I) IS ASSUMED TO BE ZERO IF ALL C THE REMAINING TERMS ADD UP TO A ZERO CHARGE). C C MIN IS THE NUMBER OF MINUTES OF CONNECT TIME. IT IS CALCULATED C AS THE DIFFERENCE BETWEEN THE TIME ENTERED INTO THIS ROUTINE C AND THE CURRENT TIME. C THE R(J,I)'S ARE READ FROM THE RATE FILE ('SNIPS.RT') WHICH IS C PREPARED ACCORDING TO THE FOLLOWING FORMAT (3 RECORDS / PROGRAM): C C0L. 1-6 R(1,I) - THE RATE PER MINUTE (IN DOLLARS), C COL. 7-12 R(2,I) - THE RATE PER UNIT IN 'NC1', C COL. 13-18 R(3,I) - THE RATE PER UNIT IN 'NC2', C COL. 19-24 R(4,I) - THE MINIMUM RATE PER EXECUTION, C COL. 25-72 DESC(I) - THE DESCRIPTION FOR THIS LINE ITEM. C LINE ITEMS FOR WHICH THE RATES ARE ZERO OR FOR WHICH C THE COMPUTED PRICE IS LESS THAN $0.01 ARE NOT OUTPUT. C C SUBROUTINES REQUIRED: TIMEJLP C FUNCTIONS REQUIRED: NEWFIL C C AUTHOR: ((D. N. ANDERSON -- LAST MOD: DEC 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C MODIFY: D. C. LEE -- LAST MOD: MAR 1985 C C**************************************************************************** C SUBROUTINE BILL (NREC, IRATE, T, NC1, NC2, FILEBI) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C INTEGER*2 T2(3), T(6), FILEBI(9), DESC(24,3) C REAL R(4,3) C C <> C C ANY BILLING DESIRED? C IF (IRATE .EQ. 2) RETURN C C RETURN IF NO RATE FILE C IF (NEWFIL ('SNIPS.RT') .EQ. 1) RETURN C C "NEW" = 1 IF BILLING FILE ALREADY EXISTS C NEW = NEWFIL (FILEBI) + 1 C C OPEN RATE FILE OPEN (UNIT=8, FILE='SNIPS.RT', STATUS='OLD', RECL=72, + ORGANIZATION='SEQUENTIAL', RECORDTYPE='VARIABLE', + SHARED, READONLY, IOSTAT=IERR) IF (IERR .NE. 0) RETURN C C RATE FILE OPEN -- READ APPROPRIATE RECORDS C N = 1 I = 0 4 I = I + 1 READ (8,5) (R(J,N), J = 1, 4), (DESC(J,N), J = 1, 24) 5 FORMAT (4F6.0,24A2) IF (I .LT. NREC) GO TO 4 N = N + 1 IF (N .LE. 3) GO TO 4 CLOSE (UNIT=8, IOSTAT=IERR) C C OPEN ITEMIZED BILL FILE C OPEN (UNIT=8, FILE=FILEBI, IOSTAT=IERR, STATUS='UNKNOWN', + ACCESS='DIRECT', FORM='FORMATTED', + ORGANIZATION='RELATIVE', RECORDTYPE='FIXED', RECL=72 ) IF (IERR .NE. 0) + CALL FATAL ( 21, 'FAILED TO OPEN ITEM BILL FILE', IERR, 0 ) C C GET NUMBER OF LINES ALREADY IN FILE C IF (NEW .NE. 1) GO TO 20 READ (8'1,998) NLINES 998 FORMAT (I10) GO TO 30 C 20 NLINES = 1 WRITE (8'1,998) NLINES C C GET CURRENT TIME C 30 CALL TIMEJLP (T2) KH = T2(1)-T(4) IF (KH .LT. 0) KH = KH + 24 TT = 60 * KH + T2(2) - T(5) + (T2(3) - T(6)) / 60.0 C C MANUFACTURE UP TO 3 LINE ITEMS C TCOST = 0.0 DO 50 I = 1, 3 IF (R(1,I) + R(2,I) + R(3,I) + R(4,I) .LT. 0.000001) GO TO 50 COST = R(1,I) * TT + R(2,I) * NC1 + R(3,I) * NC2 IF (COST .GT. 0.00001) COST = COST + R(4,I) IF (COST .LT. 0.01) GO TO 50 NLINES = NLINES + 1 IF (IRATE .NE. 1) GO TO 44 C C NO CHARGE LINE ITEM C WRITE (8'NLINES,36) (T(J), J = 1, 5), (DESC(J,I), J = 1, 24) 36 FORMAT (I3,'/',I2,'/',I2,I4,':',I2,2X,24A2,' N/C') GO TO 48 C C REGULAR CHARGE LINE ITEM C 44 WRITE (8'NLINES,46) (T(J), J = 1, 5), (DESC(J,I), J = 1, 24), COST 46 FORMAT (I3,'/',I2,'/',I2,I4,':',I2,2X,24A2,F6.2) 48 TCOST = TCOST + COST 50 CONTINUE WRITE (8'1,998) NLINES CLOSE (UNIT=8, IOSTAT=IERR) C C WRITE COST TO CONSOLE C WRITE (6,60) TT, TCOST 60 FORMAT (F7.1,' MINUTES. $',F6.2) RETURN END X / 2.0 - 1.3 * CH ADJ = (BH - CH) / 2.0davel/vms/BLANK.FOR;1 644 37 1770 1555 3515015716 7422 C.~* SYSTEM: LIBRARY, PROGRAM: BLANK ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C ROUTINE TO BLANK CHARACTER STRINGS. C C PARAMETERS: C ISTRING - INTEGER ARRAY C ISTART - STARTING BYTE FOR BLANKING WITHIN 'ISTRING' C IEND - LAST BYTE TO INSERT BLANKS INTO. C C ENTER VIA: C CALL BLANK (ISTRING, ISTART, IEND) C C EXAMPLE: C ISTRING = 'ABCDEFGHIJ' AND WE C CALL BLANK (ISTRING, 3, 7) C WE THEN HAVE ISTRING = 'AB HIJ'. C C SUBROUTINES REQUIRED: FILL C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 VAX/VMS C C**************************************************************************** C SUBROUTINE BLANK (ISTRING, ISTART, IEND) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 ISTRING(1) C DATA IBLNK /' '/ C C <> C CALL FILL (ISTRING, ISTART, IEND, IBLNK) C RETURN END I + 1 READ (8,5) (R(J,N), J = 1, 4), (DESC(J,N), J = 1, 24) 5 FORMAT (4F6.0,24A2) IF (I .LT. NREC) GO TO 4 N = N + 1 IF (N .LE. 3) GO TO 4davel/vms/BSET.FOR;1 644 37 1770 2514 3515015721 7320 C.~* SYSTEM: LIBRARY, PROGRAM: BSET ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C ROUTINE TO SET 1 OR MORE BITS WITHIN AN ARRAY. C C INPUT: C IARRAY - THE ARRAY (OR WORD) WITHIN WHICH THE BIT(S) ARE TO BE C SET. BIT COUNTING STARTS WITH 1 AT THE LEFTMOST BIT C IN THE FIRST WORD OF 'IARRAY', C ISTART - NUMBER OF THE FIRST BIT IN 'IARRAY' TO BE SET TO 1, C IEND - NUMBER OF THE LAST BIT IN 'IARRAY' TO C BE SET. C C OUTPUT: C IARRAY - THE ARRAY AFTER THE SELECTED BITS HAVE BEEN SET TO 1. C C ENTER VIA: C CALL BSET (IARRAY, ISTART, IEND) C C EXAMPLES: C ASSUME A 2 WORD BIT ARRAY CONTAINS; C IARRAY = 0000 0000 0000 1100 0000 1000 0000 0000 C AFTER CALL BSET (IARRAY, 4, 7) C IARRAY = 0001 1110 0000 1100 0000 1000 0000 0000 C AND AFTER ANOTHER CALL BSET (IARRAY, 16, 22) C IARRAY = 0001 1110 0000 1101 1111 1100 0000 0000 C C SUBROUTINES REQUIRED: IIBSET (VAX FORTRAN INTRINSIC) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C*************************************************************************** C SUBROUTINE BSET (IARRAY, ISTART, IEND) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IARRAY(1) C C <> C DO 50 I = ISTART, IEND IW = (I + 15) / 16 IARRAY(IW) = IIBSET (IARRAY(IW), 16 * IW - I) ! SET 1 BIT TO 1 50 CONTINUE RETURN END OF LINES ALREADY IN FILE C IF (NEW .NE. 1) GO TO 20 READ (8'1,998) NLINES 998 FORMAT (I10) GO TO 30 C 20 NLINES = 1 WRITE (8'1,998) NLINES C C GETdavel/vms/BSNIPS.COM;1 644 37 1770 3432 3515015724 7554 !===================================B S N I P S================================ != = != COMMAND PROCEDURE TO EXECUTE THE RESPECTIVE PLOT LIBRARIES BSNIPS = != PROGRAM. THE COMMAND LINE MUST BE ENTERED MANUALY UNTIL A FUTURE = != PROCEDURE IS WRITTEN TO TRANSFER IF FROM THE COMMAND PROC. CALL TO = != THE PROGRAM CALL GIVEN ANY NUMBER OF ARGUMENTS, 0 - 30 MINIMUM. = != = != AUTHOR: DAVID C. LEE ASA -- 10/19/84 = != = !============================================================================== ! $ INQUIRE COMMAND_LINE ! $ WRITE SYS$OUTPUT " SELECT THE TYPE OF PLOT OUTPUT: " $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT " 1) CALCOMP 925 " $ WRITE SYS$OUTPUT " 2) CALCOMP 1055 " $ WRITE SYS$OUTPUT " 3) PREVIEW - DDN INTERFACE" $ WRITE SYS$OUTPUT " 4) VERSATEC " $ WRITE SYS$OUTPUT " 5) SWN ASCII PLOT OUTPUT " $ WRITE SYS$OUTPUT " " ! $ INQUIRE PLOTTYPE " ENTER PLOT TYPE SELECTION ... " $ WRITE SYS$OUTPUT " " ! $ IF PLOTTYPE .EQS. "1" THEN GOTO CALC925 $ IF PLOTTYPE .EQS. "2" THEN GOTO CALC1055 $ IF PLOTTYPE .EQS. "3" THEN GOTO DDN $ IF PLOTTYPE .EQS. "4" THEN GOTO VERSATEC $ IF PLOTTYPE .EQS. "5" THEN GOTO SWN $ GOTO END ! $ CALC925: $ CALBSNIPS 'COMMAND_LINE' $ GOTO END ! $ CALC1055: $ WRITE SYS$OUTPUT " CALCOMP 1055 IS NOT AVAILABLE ON THIS SYSTEM " $ GOTO END ! $ DDN: $ DDNBSNIPS 'COMMAND_LINE' $ GOTO END ! $ VERSATEC: $ WRITE SYS$OUTPUT " VERSATEC IS NOT AVAILABLE ON THIS SYSTEM " $ ! XRXBSNIPS 'COMMAND_LINE' $ GOTO END ! $ SWN: $ SWNBSNIPS 'COMMAND_LINE' $ GOTO END ! $ END: !============================================================================== ) * TT + R(2,I) * NC1 + R(3,I) * NC2 IF (COST .GT. 0.00001) COST = COST + R(4,I) IF (COST .LT. 0.01) GO TO 50 NLINES = NLINES + 1 IF (IRATE .NE. 1) GO TO 44 C C NO CHARGE LINE ITEM C WRITE (8'NLINES,36) (T(J), J = 1, davel/vms/BSNIPS.FOR;2 644 37 1770 15775 3515015734 7623 C.~* SYSYEM: SNIPS, PROGRAM: BSNIPS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PLOT THE SCHEDULE BARCHARTS BASED ON THE OUTPUT OF THE C CALCULATION PROGRAM 'CSNIPS' C C COMMAND LINE: C BSNIPS/A/W/C/R/F/N/K/X /P <0-9,A-Z>/U/C C /S ... /S /Z C /H /I /D C /F C C IS THE NAME OF THE SCHEDULE CALCULATED C BY 'CSNIPS'. THIS FILENAME WILL C BE REQUESTED IF IT WAS NOT ENTERED, C C /P IS THE NAME OF THE PLOTTING FILE, IF C NOT GIVEN IT IS ASSUMED TO BE C 'PLOTD.P1', C C <0-9,A-Z>/U/C NUMBER OF THE PRINT SUPPRESSION FILE C TO BE CREATED(/C) OR USED (/U). IF NO C SUPPRESION FILE IS REQUESTED ALL THE C WORK ACTIVITIES WILL BE INCLUDED IN THE C BARCHART. C C /S THE ORDER THE WORK ACTIVITIES WILL APPEAR C ON THE REPORT. THE FIRST KEY MENTIONED C IN THE COMMAND LINE WILL BE THE MOST C SIGNIFICANT.(( THE SORT KEY CODES ARE; C TAG - WORK ACTIVITY TAG, C ESTART - EARLY START DAY, C EFINISH - EARLY FINISH DAY., C FFINISH - FREE-FLOAT FINISH DAY, C LFINISH - LATE FINISH DAY. C C /Z DRAWING SIZE LETTER (USUALLY D OR E TO C DEFINE A STANDARD DRAWING). IT ALSO C INCLUDES THE DIRECTIONS FOR BORDERS, C TITLE BLOCKS, ETC AS DEFINED IN THE C FILE 'SNIPS.IP'. IF NOT GIVEN THE PLOT C SIZE PARAMETERS RECORDED IN THE SCHEDULE C WITH 'ESNIPS' ARE USED TO CALCULATE THE C AVAILABLE PLOTTING SURFACE. B0/Z DEFAULT. C C /H PEN HOLDERS AVAILABLE FOR USE AT YOUR C INSTALLATION. DEFAULTS TO THE VALUE GIVEN C IN 'SNIPS.IP' IF NOT PRESENT IN THE C COMMAND LINE. C C /I NUMBER OF PENS (OFTEN DIFFERENT COLORS OF C INK OR DIFFERENT PEN WIDTHS TO) TO USE. C MAY BE LESS OR GREATER THAN THE NUMBER OF C PEN HOLDERS AVAILABLE. TO OBTAIN C REASONABLE PEN MOUNTING MESSAGES THE C COLORS OF EACH PEN SHOULD BE DEFINED IN C 'SNIPS.IP', C C /D DETERMINES THE NUMBER OF WORK DAYS C THAT WILL BE SHOWN ON THE BARCHART BELOW C EACH PLOTTED DATE. MUST BE IN THE RANGE C 1-7 DAYS. OVERRIDES THE VALUE PROVIDED BY C THE SCHEDULE FILE PRODUCED BY 'ESNIPS', C C /F THE BARCHART (EXCLUDING THE DRAWING C DIMENSIONS GIVEN BY 'SNIPS.IP') WILL BE C EXPANDED (FACTORS > 1.0) OR SHRUNK (FACTORS C < 1.0) BY THIS FACTOR PRIOR TO PLOTTING. C THIS CHANGE IN SIZE IS CALCULATED IN WHEN C ESTIMATING THE NUMBER OF ACTIVITIES WHICH C CAN BE FITTED ON EACH PAGE. IT IS ALSO USED C IN ESTIMATING WHETHER THE NO. OF DAYS PER C PLOTTED DATE IS LARGE ENOUGH TO FIT ALL C SCHEDULE DAYS ACROSS THE PLOT PAGE. C THE NUMBER OF DAYS PER DATE WILL BE C ADJUSTED IF NECESSARY TO REMAIN C WITHIN THE PAGE. THE FACTOR GIVEN HERE C OVERRIDES THE VALUE ENTERED INTO THE C SCHEDULE FILE VIA 'ESNIPS'. C C GLOBAL SWITCHES; C /W WARM UP EACH PEN IN THE ASSIGNED C WARMUP AREA (DEFINED IN SNIPS.IP). IF NOT C DEFINED IN 'SNIPS.IP' USE THE AREA C JUST PRIOR TO X = 0.0. VERIFY C SATISFACTORY OPERATION WITH AN OPERATOR C QUESTION BEFORE PROCEEDING. C /R IF THIS SWITCH IS GIVEN THE OPERATOR WILL BE C ASKED AFTER EACH PAGE IS A REPLOT OVER THE C SAME DRAWING IS NECESSARY, C /A IF THIS SWITCH IS GIVEN THE BARCHART PAGES C ARE PLOTTED (ADVANCED) ONE AFTER ANOTHER C WITHOUT STOP TO MOUNT NEW PAPER. C /C TO DISPLAY DATES IN COMPANY SPECIFIC FORM C /F OMIT WORK ACTIVITIES THAT ARE C ACTUALLY FINISHED, C /X PLOT CARCHART WITHOUT ANY FLOAT BOXES C /N WRITE NO CHARGE ENTRIES IN THE BILLING C FILE FOR THIS RUN, C /K OMIT ALL ENTRIES IN THIS SCHEDULES C BILLING FILE. C C LOCAL SWITCHES; C ALL LOCAL SWITCHES ARE USED TO IDENTIFY C SPECIFIC PARAMETERS AS IDENTIFIED ABOVE. C C REQUIRES THE FILES: C XXXXXX.M1 C XXXXXX.A2 C XXXXXX.D3 C SNIPS.IP C WHERE XXXXXX IS THE NAME OF THE SCHEDULE. C AND POSSIBLY THE FILE: C XXXXXX.EY C WHERE Y IS THE SUPPRESSION FILE NUMBER. C C SUBROUTINES REQUIRED: BARCH, BILL, PREP4, PREPA, PREPB, SVECT C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C******************************************************************* C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXNAC=2000 ! MAX. NO. OF ACTIVITIES PARAMETER MAXWKD=3276 ! MAX. WORK DAYS - LARGEST # POSSIBLE C COMMON /CHANN/ FILEM1(9), FILEA2(9), FILED3(9), + FILEPS(9), FILEBI(9) COMMON /SCH04/ IREV(4), FEXTN(15), PLOTF(9) COMMON /PENS/ NCP, ! NO. OF CURRENT PEN 1 NHOLD, ! NUMBER OF PEN HOLDERS 2 NPINH(5), ! NO. OF PEN IN EACH HOLDER 3 NPENS, ! NUMBER OF PENS TO USE 4 PDESCR(5,10), ! DESCRIPTIONS OF EACH PEN 5 WX, WY, ! COORDINATES OF WARMUP AREA 6 WW, WH, ! WIDTH & HEIGHT OF WARMUP AREA 7 NWUP, ! NO. OF WARMUPS DONE 8 IPFILE(9) ! NAME OF INSTALLATION PARAM. FILE COMMON /TITLE/ T1(39), ! UPPER TITLE LINE 1 T2(39), ! LOWER TITLE LINE 2 BASED(10), ! 'ORIGINAL DURATION'/'REMAINING DURATION' 3 DTETME(10), ! CURRENT DATE TIME STRING 4 STAR(5), ! PROJECT START DATE STRING 5 FIN(5), ! PROJECT FINISH DATE STRING 6 DD(5), ! DATA DATE STRING 7 IDEV(9), ! SCHEDULE NAME 8 NUPDTE, ! UPDATE NUMBER 9 LPRTSL(2), ! NAME OF PRINT SELECT. FILE A INCLWD(4), ! INCL./OMIT WORK DAYS ON REPORT B INCLAC(4), ! INCL./OMIT FINISHED ACTIVITIES C NLPPG ! MAX. NO. OF LINES PER PAGE C INTEGER*2 FILEM1, FILEA2, FILED3, FILEPS, FILEBI, DT(6) INTEGER*2 T1, T2, BASED, DTETME, STAR, FIN, DD, KST(5) INTEGER*2 NCDATE(MAXWKD), ISVEC(MAXNAC) INTEGER*2 IPTST(250), PLOTF, FEXTN, PDESCR C DATA IREV /'07','-1','0-','85'/ DATA FEXTN /'.M','1 ',' ','.A','2 ',' ','.D','3 ',' ','.E', + '0 ',' ','.B','I ',' '/ DATA IPFILE /'SN','IP','S.','IP',' ',' ',' ',' ',' '/ DATA PLOTF /'PL','OT','D.','P0',' ',' ',' ',' ',' '/ C C <> C C CALL PREPARATION ROUTINE TO EXAMINE COMMAND STRING C GET SCHEDULE FILE NAME AND OPEN THEM. C CALL PREP4 (KST, NPSF, IUSE, IAFIN, IWARM, IREPLOT, 1 ICONTP, IDRWG, NDAYPD, PFCTR, ICODTE, IRATE, ISFLOAT) C CALL PREPA (IPTST, NPSF, IUSE) C CALL PREPB (NAC, KST, NCDATE, NPEND, IPFIL, IPTST, + IDRWG, NDAYPD, NDATAD, ICSTART, + PFCTR, X, Y, W, H, DT) C WRITE (6,23) 23 FORMAT (/,' SORT / SELECT ACTIVITIES.') C C PREPARE A SORT VECTOR TO ACCESS THE RECORDS IN C THE DESIRED ORDER. C CALL SVECT (KST, NAC, IPTST, IAFIN, ISVEC, NPA, NFIRSTD, NLASTD) C C GO PLOT THE BARCHARTS C CALL BARCH (NPA, ISVEC, NCDATE, NPEND, NFIRSTD, NLASTD, IPFIL, 1 IWARM, IREPLOT, ICONTP, IDRWG, NDAYPD, NDATAD, ICDATE, PFCTR, 2 X, Y, W, H, NSHTS, ICODTE, ISFLOAT) C C WRITE BILLING ENTRIES C IF (IRATE .EQ. 2) GO TO 200 C CLOSE (UNIT=8) CALL BILL (10, IRATE, DT, NPA, NSHTS, FILEBI) C C TERMINATE PROGRAM. C 200 END 10davel/vms/BSNIPS.HE;1 644 37 1770 20526 3515015737 7461 1 52PRINT SELECTION DIRECTIVES ARE USED TO DETERMINE WHICH WORK ACTIVITIES SHOULD BE PRINTED IN ANY PARTICULAR REPORT. THE PRINT SELECTION FILE CREATED MAY BE USED REPEATEDLY BY REFERENCING ITS NUMBER (OR LETTER) IN A REPORT PROGRAM COMMAND LINE. RULES: A) ALL TESTS ARE BASED ON MATCHING STRINGS OF 1 OR MORE CHARACTERS, B) ANY PARTICULAR MATCH MAY BE USED TO PREVENT PRINTING OF A WORK ACTIVITY (EXCLUSION TEST), C) ANY PATICULAR MATCH MAY BE USED TO FORCE PRINTING OF A WORK ACTIVITY (INCLUSION TEST), D) UP TO 49 TESTS OF EACH WORK ITEM MAY BE DEFINED (DEPENDING ON MATCH STRING LENGTH), E) IF AN EXCLUSION TEST MATCHES, NO FURTHER TESTS ARE PERFORMED AND THE WORK ITEM BEING TESTED WILL NOT BE PRINTED, F) IF AN INCLUSION TEST MATCHES, THE WORK ITEM WILL BE MARKED FOR PRINTING AND THE LIST OF TESTS CONTINUED. PRINTING/NON-PRINTING IS DETERMINED BY THE MARK IN FORCE AT THE TIME NO FURTHER TESTS ARE ENCOUNTERED, G) THE CHARACTER POSITIONS REFERED TO IN THE QUESTIONS ARE NUMBERED 1 10 WITHIN THE WORK ITEM TAG AND 11 THROUGH THROUGH 90 WITHIN THE WORK ITEM DESCRIPTION. 74A 'E' ANSWER WILL CAUSE THIS TEST TO BE AN EXCLUSION TEST. IF THIS TEST IS SUCCESSFUL (IT MATCHES) THE WORK ITEM WILL NOT BE PRINTED. A 'I' ANSWER WILL CAUSE THIS TEST TO BE AN INCLUSION TEST. IF THIS TEST IS SUCCESSFUL (IT MATCHES) THE WORK ITEM WILL BE TENTATIVELY MARKED FOR PRINTING AND THE TESTS CONTINUED. 79THE WORK ACTIVITY TAG COMPRISES CHARACTERS 1 THRU 10. THE ACTIVITY DESCRIPTION CONTAINS A MAX. OF 80 CHARACTERS NUMBERED 11 THRU 90. THE START CHARACTER NUMBER AND STOP CHARACTER NUMBER MUST DEFINE A MATCH TRIAL FIELD WHICH IS AT LEAST AS WIDE AS THE NUMBER OF CHARACTERS IN THE MATCH STRING. IF IT IS WIDER THAN THE MATCH STRING PROVIDED, A MATCH IS SUCCESSFUL IF THE MATCH STRING IS FOUND AT ANY POINT IN THE FIELD DEFINED. 86THIS STOP CHARACTER NUMBER DEFINES THE END OF THE FIELD WHICH IS TO BE TESTED FOR A MATCH. NUMBERS 1 - 10 SPAN THE ACTIVITY TAG AND NUMBERS 11 - 90 SPAN THE ACTIVITY DESCRIPTION. 89THE MATCH TEST STRING MAY BE ANY LENGTH UP TO THE LENGTH OF THE FIELD DEFINED WITHIN EACH WORK ITEM'S TAG - DESCRIPTION. THE COUNT SHOULD INCLUDE ANY BLANKS (INCLUDING ANY BLANKS BEFORE AND AFTER THE TEST STRING WHICH SHOULD BE CONSIDERED SIGNIFICANT). 93THIS STRING OF CHARACTERS WILL BE TESTED AGAINST THE PREVIOUSLY DEFINED FIELD WITHIN EACH WORK ACTIVITY RECORD TO DETERMINE WHETHER A MATCH CAN BE CLAIMED. 96THIS PROGRAM MUST BE PROVIDED WITH THE NAME OF A SCHEDULE WHICH HAS BEEN RUN THRU THE SCHEDULE CALCULATION PROGRAM. IF ONLY THE SCHEDULE NAME IS PROVIDED: A) ALL WORK(( ACTIVITIES WILL BE INCLUDED IN THE BARCHART, B) THE BARS WILL BE IN ASCENDING ORDER SORTED ON THE EARLY START DATE, FOLLOWED BY WORK ACTIVITY TAGS, C) THE OUTPUT WILL BE RUN DIRECTLY TO $PLT, D) NO DRAWING BORDERS OR LEGENDS WILL BE PLOTTED, E) THE NUMBER OF PENS AND PEN HOLDERS WILL DEFAULT TO THE NUMBERS INCLUDED IN THE INSTALLATION PARAMETER FILE (UP TO A MAX. OF 3 PENS), F) PEN WARMUP WILL NOT BE VERIFIED WITH THE OPERATOR, G) THE NUMBER OF DAYS PER PLOTTED DATE AND THE PLOTTING FACTOR WILL ASSUME THE VALUES ASSIGNED DURING THE PREPARATION OF THE SCHEDULE FILES. ------------------------------------------------------------------- IF ANY OTHER OPTIONS ARE DESIRED THEY MUST BE INCLUDED IN THE COMMAND LINE USED TO START THIS PROGRAM: BSNIPS/W/A/R/F/C/X /P <0-9,A-Z>/U/C /S ... /S /Z /H /I /D /F . IS THE NAME OF THE SCHEDULE CALCULATED BY 'CSNIPS'. THIS FILENAME WILL BE REQUESTED IF IT WAS NOT ENTERED, . /P IS THE NAME OF THE PLOTTING FILE, IF NOT GIVEN IT IS ASSUMED TO BE 'LPA0', . <0-9,A-Z>/U/C NUMBER OF THE PRINT SUPPRESSION FILE TO BE CREATED(/C) OR USED (/U). IF NO SUPPRESION FILE IS REQUESTED ALL THE WORK ACTIVITIES WILL BE INCLUDED IN THE BARCHART. . /S THE ORDER THE WORK ACTIVITIES WILL APPEAR ON THE REPORT. THE FIRST KEY MENTIONED IN THE COMMAND LINE WILL BE THE MOST SIGNIFICANT. THE SORT KEY CODES ARE; TAG - WORK ACTIVITY TAG, ESTART - EARLY START DAY, EFINISH - EARLY FINISH DAY., FFINISH - FREE-FLOAT FINISH DAY, LFINISH - LATE FINISH DAY. . /Z DRAWING SIZE LETTER (USUALLY D OR E TO DEFINE A STANDARD DRAWING). IT ALSO INCLUDES THE DIRECTIONS FOR BORDERS, TITLE BLOCKS, ETC AS DEFINED IN THE FILE 'SNIPS.IP'. IF NOT GIVEN THE PLOT SIZE PARAMETERS RECORDED IN THE SCHEDULE WITH 'ESNIPS' ARE USED TO CALCULATE THE AVAILABLE PLOTTING SURFACE. . /H PEN HOLDERS AVAILABLE FOR USE AT YOUR INSTALLATION. DEFAULTS TO THE VALUE GIVEN IN 'SNIPS.IP' IF NOT PRESENT IN THE COMMAND LINE. . /I NUMBER OF PENS (OFTEN DIFFERENT COLORS OF INK OR DIFFERENT PEN WIDTHS TO) TO USE. MAY BE LESS OR GREATER THAN THE NUMBER OF PEN HOLDERS AVAILABLE. TO OBTAIN REASONABLE PEN MOUNTING MESSAGES THE COLORS OF EACH PEN SHOULD BE DEFINED IN 'SNIPS.IP', . /D DETERMINES THE NUMBER OF WORK DAYS THAT WILL BE SHOWN ON THE BARCHART BELOW EACH PLOTTED DATE. MUST BE IN THE RANGE 1-7 DAYS. OVERRIDES THE VALUE PROVIDED BY THE SCHEDULE FILE PRODUCED BY 'ESNIPS', . /F THE BARCHART (EXCLUDING THE DRAWING DIMENSIONS GIVEN BY 'SNIPS.IP') WILL BE EXPANDED (FACTORS > 1.0) OR SHRUNK (FACTORS < 1.0) BY THIS FACTOR PRIOR TO PLOTTING. THIS CHANGE IN SIZE IS CALCULATED IN WHEN ESTIMATING THE NUMBER OF ACTIVITIES WHICH CAN BE FITTED ON EACH PAGE. IT IS ALSO USED IN ESTIMATING WHETHER THE NO. OF DAYS PER PLOTTED DATE IS LARGE ENOUGH TO FIT ALL SCHEDULE DAYS ACROSS THE PLOT PAGE. THE NUMBER OF DAYS PER DATE WILL BE ADJUSTED IF NECESSARY TO REMAIN WITHIN THE PAGE. THE FACTOR GIVEN HERE OVERRIDES THE VALUE ENTERED INTO THE SCHEDULE FILE VIA 'ESNIPS'. . GLOBAL SWITCHES; /W WARM UP EACH PEN IN THE ASSIGNED WARMUP AREA. IF NOT DEFINED IN 'SNIPS.IP' USE THE AREA JUST PRIOR TO X = 0.0. VERIFY SATISFACTORY OPERATION WITH AN OPERATOR QUESTION BEFORE PROCEEDING. /R IF THIS SWITCH IS GIVEN THE OPERATOR WILL BE ASKED AFTER EACH PAGE IS A REPLOT OVER THE SAME DRAWING IS NECESSARY, /A IF THIS SWITCH IS GIVEN THE BARCHART PAGES ARE PLOTTED ONE AFTER ANOTHER WITHOUT STOP TO MOUNT NEW PAPER. /F OMIT WORK ACTIVITIES THAT ARE ACTUALLY FINISHED. /C USE COMPANY SPECIFIC DATE BARS. /X COMPRESS ALL FLOAT BARS. . LOCAL SWITCHES; ALL LOCAL SWITCHES ARE USED TO IDENTIFY SPECIFIC PARAMETERS AS IDENTIFIED ABOVE. 205 DATA FEXTN /'.M','1 ',' ','.A','2 ',' ','.D','3 ',' ','.E', + '0 ',' ','.B','I ',' '/ DATA IPFILE /'SN','IP','S.','IP',' ',' ',' ',' ',' '/ DATA davel/vms/BSNIPS.HP;2 644 37 1770 36651 3515015747 7504  4PRINT SELECTION DIRECTIVES ARE USED TO DETERMINE WHICH WORK ACTIVITIES SHOULD BE PRINTED IN ANY PARTICULAR REPORT. THE PRINT SELECTION FILE CREATED MAY BE USED REPEATEDLY BY REFERENCING ITS NUMBER (OR LETTER) IN A REPORT PROGRAM COMMAND LINE. RULES: A) ALL TESTS ARE BASED ON MATCHING STRINGS OF 1 OR MORE CHARACTERS, B) ANY PARTICULAR MATCH MAY BE USED TO PREVENT PRINTING OF A WORK ACTIVITY (EXCLUSION TEST), (( C) ANY PATICULAR MATCH MAY BE USED TO FORCE PRINTING OF A WORK ACTIVITY (INCLUSION TEST), D) UP TO 49 TESTS OF EACH WORK ITEM MAY BE DEFINED (DEPENDING ON MATCH STRING LENGTH), E) IF AN EXCLUSION TEST MATCHES, NO FURTHER TESTS ARE PERFORME AND THE WORK ITEM BEING TESTED WILL NOT BE PRINTED, F) IF AN INCLUSION TEST MATCHES, THE WORK ITEM WILL BE MARKED FOR PRINTING AND THE LIST OF TESTS CONTINUED. PRINTING/NON-PRINTING IS DETERMINED BY THE MARK IN FORCE AT THE TIME NO FURTHER TESTS ARE ENCOUNTERED, G) THE CHARACTER POSITIONS REFERED TO IN THE QUESTIONS ARE NUMBERED 1 10 WITHIN THE WORK ITEM TAG AND 11 THROUGH THROUGH 90 WITHIN THE WORK ITEM DESCRIPTION. JA 'E' ANSWER WILL CAUSE THIS TEST TO BE AN EXCLUSION TEST. IF THIS TEST IS SUCCESSFUL (IT MATCHES) THE WORK ITEM WILL NOT BE PRINTED. A 'I' ANSWER WILL CAUSE THIS TEST TO BE AN INCLUSION TEST. IF THIS TEST IS SUCCESSFUL (IT MATCHES) THE WORK ITEM WILL BE TENTATIVELY MARKED FOR PRINTING AND THE TESTS CONTINUED. OTHE WORK ACTIVITY TAG COMPRISES CHARACTERS 1 THRU 10. THE ACTIVITY DESCRIPTION CONTAINS A MAX. OF 80 CHARACTERS NUMBERED 11 THRU 90. THE START CHARACTER NUMBER AND STOP CHARACTER NUMBER MUST DEFINE A MATCH TRIAL FIELD WHICH IS AT LEAST AS WIDE AS THE NUMBER OF CHARACTERS IN THE MATCH STRING. IF IT IS WIDER THAN THE MATCH STRING PROVIDED, A MATCH IS SUCCESSFUL IF THE MATCH STRING IS FOUND AT ANY POINT IN THE FIELD DEFINED. VTHIS STOP CHARACTER NUMBER DEFINES THE END OF THE FIELD WHICH IS TO BE TESTED FOR A MATCH. NUMBERS 1 - 10 SPAN THE ACTIVITY TAG AND NUMBERS 11 - 90 SPAN THE ACTIVITY DESCRIPTION. YTHE MATCH TEST STRING MAY BE ANY LENGTH UP TO THE LENGTH OF THE FIELD DEFINED WITHIN EACH WORK ITEM'S TAG - DESCRIPTION. THE COUNT SHOULD INCLUDE ANY BLANKS (INCLUDING ANY BLANKS BEFORE AND AFTER THE TEST STRING WHICH SHOULD BE CONSIDERED SIGNIFICANT). ]THIS STRING OF CHARACTERS WILL BE TESTED AGAINST THE PREVIOUSLY DEFINED FIELD WITHIN EACH WORK ACTIVITY RECORD TO DETERMINE WHETHER A MATCH CAN BE CLAIMED. `THIS PROGRAM MUST BE PROVIDED WITH THE NAME OF A SCHEDULE WHICH HAS BEEN RUN THRU THE SCHEDULE CALCULATION PROGRAM. IF ONLY THE SCHEDULE NAME IS PROVIDED: A) ALL WORK ACTIVITIES WILL BE INCLUDED IN THE BARCHART, B) THE BARS WILL BE IN ASCENDING ORDER SORTED ON THE EARLY START DATE, FOLLOWED BY WORK ACTIVITY TAGS, C) THE OUTPUT WILL BE RUN DIRECTLY TO $PLT, D) NO DRAWING BORDERS OR LEGENDS WILL BE PLOTTED, E) THE NUMBER OF PENS AND PEN HOLDERS WILL DEFAULT TO THE NUMBERS INCLUDED IN THE INSTALLATION PARAMETER FILE (UP TO A MAX. OF 3 PENS), F) PEN WARMUP WILL NOT BE VERIFIED WITH THE OPERATOR, G) THE NUMBER OF DAYS PER PLOTTED DATE AND THE PLOTTING FACTOR WILL ASSUME THE VALUES ASSIGNED DURING THE PREPARATION OF THE SCHEDULE FILES. ------------------------------------------------------------------- IF ANY OTHER OPTIONS ARE DESIRED THEY MUST BE INCLUDED IN THE COMMAND LINE USED TO START THIS PROGRAM: BSNIPS/W/A/R/F/C/X /P <0-9,A-Z>/U/C /S ... /S /Z /H /I /D /F . IS THE NAME OF THE SCHEDULE CALCULATED BY 'CSNIPS'. THIS FILENAME WILL BE REQUESTED IF IT WAS NOT ENTERED, . /P IS THE NAME OF THE PLOTTING FILE, IF NOT GIVEN IT IS ASSUMED TO BE 'LPA0', . <0-9,A-Z>/U/C NUMBER OF THE PRINT SUPPRESSION FILE TO BE CREATED(/C) OR USED (/U). IF NO SUPPRESION FILE IS REQUESTED ALL THE WORK ACTIVITIES WILL BE INCLUDED IN THE BARCHART. . /S THE ORDER THE WORK ACTIVITIES WILL APPEAR ON THE REPORT. THE FIRST KEY MENTIONED IN THE COMMAND LINE WILL BE THE MOST SIGNIFICANT. THE SORT KEY CODES ARE; TAG - WORK ACTIVITY TAG, ESTART - EARLY START DAY, EFINISH - EARLY FINISH DAY., FFINISH - FREE-FLOAT FINISH DAY, LFINISH - LATE FINISH DAY. . /Z DRAWING SIZE LETTER (USUALLY D OR E TO DEFINE A STANDARD DRAWING). IT ALSO INCLUDES THE DIRECTIONS FOR BORDERS, TITLE BLOCKS, ETC AS DEFINED IN THE FILE 'SNIPS.IP'. IF NOT GIVEN THE PLOT SIZE PARAMETERS RECORDED IN THE SCHEDULE WITH 'ESNIPS' ARE USED TO CALCULATE THE AVAILABLE PLOTTING SURFACE. . /H PEN HOLDERS AVAILABLE FOR USE AT YOUR INSTALLATION. DEFAULTS TO THE VALUE GIVEN IN 'SNIPS.IP' IF NOT PRESENT IN THE COMMAND LINE. . /I NUMBER OF PENS (OFTEN DIFFERENT COLORS OF INK OR DIFFERENT PEN WIDTHS TO) TO USE. MAY BE LESS OR GREATER THAN THE NUMBER OF PEN HOLDERS AVAILABLE. TO OBTAIN REASONABLE PEN MOUNTING MESSAGES THE COLORS OF EACH PEN SHOULD BE DEFINED IN 'SNIPS.IP', . /D DETERMINES THE NUMBER OF WORK DAYS THAT WILL BE SHOWN ON THE BARCHART BELOW EACH PLOTTED DATE. MUST BE IN THE RANGE 1-7 DAYS. OVERRIDES THE VALUE PROVIDED BY THE SCHEDULE FILE PRODUCED BY 'ESNIPS', . /F THE BARCHART (EXCLUDING THE DRAWING DIMENSIONS GIVEN BY 'SNIPS.IP') WILL BE EXPANDED (FACTORS > 1.0) OR SHRUNK (FACTORS < 1.0) BY THIS FACTOR PRIOR TO PLOTTING. THIS CHANGE IN SIZE IS CALCULATED IN WHEN ESTIMATING THE NUMBER OF ACTIVITIES WHICH CAN BE FITTED ON EACH PAGE. IT IS ALSO USED IN ESTIMATING WHETHER THE NO. OF DAYS PER PLOTTED DATE IS LARGE ENOUGH TO FIT ALL SCHEDULE DAYS ACROSS THE PLOT PAGE. THE NUMBER OF DAYS PER DATE WILL BE ADJUSTED IF NECESSARY TO REMAIN WITHIN THE PAGE. THE FACTOR GIVEN HERE OVERRIDES THE VALUE ENTERED INTO THE SCHEDULE FILE VIA 'ESNIPS'. . GLOBAL SWITCHES; /W WARM UP EACH PEN IN THE ASSIGNED WARMUP AREA. IF NOT DEFINED IN 'SNIPS.IP' USE THE AREA JUST PRIOR TO X = 0.0. VERIFY SATISFACTORY OPERATION WITH AN OPERATOR QUESTION BEFORE PROCEEDING. /R IF THIS SWITCH IS GIVEN THE OPERATOR WILL BE ASKED AFTER EACH PAGE IS A REPLOT OVER THE SAME DRAWING IS NECESSARY, (( /A IF THIS SWITCH IS GIVEN THE BARCHART PAGES ARE PLOTTED ONE AFTER ANOTHER WITHOUT STOP TO MOUNT NEW PAPER. /F OMIT WORK ACTIVITIES THAT ARE ACTUALLY FINISHED. /C USE COMPANY SPECIFIC DATE BARS. /X COMPRESS ALL FLOAT BARS. . LOCAL SWITCHES; ALL LOCAL SWITCHES ARE USED TO IDENTIFY SPECIFIC PARAMETERS AS IDENTIFIED ABOVE. THROUGH 90 WITHIN THE WORK ITEM DESCRIPTION. JA 'E' ANSdavel/vms/BUFF.CAL;1 644 37 1770 11317 3515015776 7311 SUBROUTINE BUFF(LOC,NCNT,ICNT,IBCD) CALCOMP BUFF SUBROUTINE F-77 VERAA LIBRARY NUMBER ZBPFA513 CALCOMP HCBS FOR 925 CONTROLLERS MAR,1983 * C SAVE C DIMENSION IBUFF(120),ISH(4),IOBUFF(120) C CHARACTER * (*) IBCD C DATA ISH/16777216,65536,256,1/ DATA JMAX/120/,IBUFF(1)/521738527/,ILOC2/0/,J/2/ DATA JSH/4/,NCW,NCWP/4,5/ C JCNT=IABS(NCNT) IF (ICNT) 40,200,2000 40 IF (ICNT+2) 99,60,100 60 LTAPE = LOC C ********************************************************************** C NOTE: IF YOU ARE INSTALLING THIS SUBROUTINE ON A C VAX-11 OPERATING SYSTEM UNIX USE THE C FOLLOWING COMMENTED 'OPEN STATEMENT' AFTER C CHANGING '/DEV/RMT0/' TO LOWER CASE LETTERS C AND COMMENT OUT 'OPEN STATEMENT' FOR VMS: C OPEN(UNIT= LOC,FILE='/DEV/RMT0', C 1FORM='UNFORMATTED',STATUS='OLD',ACCESS='SEQUENTIAL') C ********************************************************************** C ********************************************************************** C NOTE: IF YOU ARE INSTALLING THIS SUBROUTINE ON A C VAX-11 OPERATING SYSTEM VSM USE THE C FOLLOWING 'OPEN STATEMENT': C ********************************************************************** C TEKTRONIX: C SNIPS INSTALLATION REQUIRES MOVING THE OPEN STATEMENT FOR THE C CALCOMP PACKAGE TO OPLOTS.FOR IN ORDER TO OPEN THE REQUESTED C NAMED FILE. C C MODIFY: DAVID C. LEE -- LAST MOD: JUN 1984 C*********************************************************************** C OPEN(UNIT= LOC,RECORDSIZE=120,RECORDTYPE='FIXED',BLOCKSIZE=484, C 1FORM='UNFORMATTED',STATUS='NEW',ACCESS='SEQUENTIAL',FILE='PLT:') 99 RETURN 100 IF((JMAX-J)*NCW+JSH-JCNT) 120,120,99 120 JCNT=0 ILOC1=15 GO TO 1000 140 IF(JSH-NCW) 1000,160,1000 160 JCNT=1 IF(J-2) 99,99,1030 200 IF(JCNT)210,99,210 210 K=NCWP-JCNT IPF=0 ILOC = LOC 500 ILOC1=ILOC/ISH(K) ILOC=ILOC-ILOC1*ISH(K) 520 IF(ILOC) 530,540,540 530 ILOC1=ILOC1-1 540 IF(IPF) 550,580,550 550 IF(ILOC1) 560,570,570 560 ILOC1=ILOC1+256 570 ILOC1=MOD(ILOC1,128) GO TO 1000 580 IF(ILOC1) 590,1000,1000 590 ILOC2=ILOC2+1 1000 IF(JSH-NCW)1009,1001,1009 1001 ILOC2=0 IF(ILOC1-127)1002,1009,1004 1002 IF(ILOC1+129)1003,1003,1009 1003 ILOC2=1 GO TO 1009 1004 ILOC2=-1 1009 IF(ILOC2-8388608) 1012,1011,1012 1011 ILOC2=(ILOC2-1)*256+ILOC1+256 GO TO 1013 1012 ILOC2=ILOC2*256+ILOC1 1013 JSH=JSH-1 IF(JSH-1) 1040,1010,1100 1010 IF(J-JMAX) 1100,1020,1100 1020 ILOC2=ILOC2*256 + 15 IBUFF(J)=ILOC2 1030 CONTINUE C ********************************************************************** C THE VAX-11/780 UNIX OR VMS2 WORD STRUCTURE IS RIGHT TO LEFT WHICH C IS LOW MEMORY TO HIGH MEMORY. THE NORMAL CHARACTER STRUCTURE C WITHIN EACH 4-BYTE WORD IS LEFT-TO-RIGHT, AND THE VAX C IS STRUCTURED RIGHT TO LEFT WITHIN EACH 4-BYTE WORD. C ACCORDING TO ANSII FORTRAN-77 STANDARD X3.9 C(H MEM) WORD-4 << WORD-3 << WORD-2 << WORD-1 (LOW MEM) C BEFORE MNOP < IJKL < EFGH < ABCD C AFTER PONM < LKJI < HGFE < DCBA <<<<<<< ORDER C ********************************************************************** C DO 1027 I=1,JMAX IT2=0 C GET WORD TO SWAP BYTES IT1=IBUFF(I) C NCW=4 SO SWAP 4-BYTES AROUND DO 1025 K=1,NCW C SHIFT BYTE RIGHT 0,8,16,24 BITS IT3=IAND(ISHFT(IT1,-8*(K-1)),255) C SHIFT RIGHT -8*(K-1) BITS THEN LOGICAL "AND" WITH 255=(HEX FF) IT2=IT2+IT3 C IS THIS LAST TIME OF DO LOOP? IF(K.EQ.4) GO TO 1025 C SHIFT NEW WORD LEFT 8-BITS IT2=ISHFT(IT2,8) 1025 CONTINUE C NEW OUTPUT BUFFER = SWAPPED WORD 1027 IOBUFF(I)=IT2 C******************************************************************* C LOGICAL TAPE UNIT REPLACED WITH 14 FOR SNIPS PACKAGE. C ORIGIONAL WRITE STATEMENT WAS FOR: C WRITE(LTAPE)(IOBUFF(I),I=1,JMAX) C C MODIFY: DAVID C. LEE -- LAST MOD: JUN 1984 C C****************************************************************** WRITE(14)(IOBUFF(I),I=1,JMAX) J=2 GO TO 1050 1040 IBUFF(J)=ILOC2 J=J+1 1050 ILOC2=0 JSH=NCW 1100 JCNT=JCNT-1 IF(JCNT) 140,99,1120 1120 K=K+1 IF(IPF .NE. 0 ) GO TO 2250 IF(K-NCWP) 500,2240,2200 2000 K=NCWP IPF=0 ILOC1=JCNT JCNT=JCNT+1 IF(ILOC1)1000,2020,1000 2020 JCNT=2 NK=MOD( LOC,128) ILOC1=1 GO TO 1000 2200 IF(NCNT) 2220,2210,2230 2210 ILOC1=NK GO TO 1000 2220 IF(LOC .LT. 0 ) GO TO 2230 ILOC1 = MOD( LOC,128) GO TO 1000 2230 NK=1 2240 K=NK IPF=IPF+1 2250 ILOC1 = ICHAR(IBCD(K:K)) ILOC1 = MOD(ILOC1,128) GO TO 1000 END AME OF THE PLOTTING FILE, IF NOT GIVEN IT IS ASSUMED TO BE 'LPA0', . <0-9,A-Z>/U/C NUMBER OF THE PRINT SUPPRESSION FILE TO BE CREATED(/C)davel/vms/BZERO.FOR;1 644 37 1770 2632 3515016002 7436 C.~* SYSTEM: LIBRARY, PROGRAM: BZERO ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C ZERO 1 OR MORE BITS WITHIN AN ARRAY. C C INPUT: C IARRAY - THE ARRAY (OR WORD) WITHIN WHICH THE BIT(S) ARE TO BE C ZEROED. BIT COUNTING STARTS WITH 1 AT THE C IN THE FIRST WORD OF 'IARRAY', C ISTART - NUMBER OF THE FIRST BIT IN 'IARRAY' TO BE ZEROED, C IEND - NUMBER OF THE LAST BIT IN 'IARRAY' TO C BE ZEROED. C OUTPUT: C IARRAY - THE ARRAY WITH THE REQUESTED BITS SET TO ZERO. C C ENTER VIA: C CALL BZERO (IARRAY, ISTART, IEND) C C EXAMPLES: C ASSUME WE START WITH THE 2 WORD BIT ARRAY; C IARRAY = 1111 1111 0001 1111 1111 1111 0111 1111 C AND AFTER CALL BZERO (IARRAY, 2, 7) C IARRAY = 1000 0001 0001 1111 1111 1111 0111 1111 C AND AFTER CALL BZERO (IARRAY, 9, 20) C IARRAY = 1000 0001 0000 0000 0000 1111 0111 1111 C AND AFTER CALL BZERO (IARRAY, 22, 31) C IARRAY = 1000 0001 0000 0000 0000 1000 0000 0001 C C C SUBROUTINES REQUIRED: IIBCLR (VAX FORTRAN INTRINSIC) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C**************************************************************************** C SUBROUTINE BZERO (IARRAY, ISTART, IEND) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IARRAY(1) C C <> C DO 50 I = ISTART, IEND IW = (I + 15) / 16 IARRAY(IW) = IIBCLR (IARRAY(IW), 16 * IW - I) ! SETS 1 BIT TO ZERO 50 CONTINUE RETURN END T FOR THE C CALCOMP PACKAGE TO OPLOTS.FOR IN ORDER TO OPEN THE REQUESTED C NAMED FILE. C C davel/vms/CALCOM.COM;2 644 37 1770 4427 3515016011 7510 ! $ IF .NOT. P1 .EQS. "" THEN GOTO NEXT $ SET VERIFY !===========================C A L C C O M================================= != = != WRITTEN BY D. C. LEE -- JUNE 12, 1984 = != = != COMMAND FILE TO COMPILE A SNIPS CALCOMP FORTRAN PLOT SUBROUTINE = != SOURCE FILE TO A FORTRAN OBJECT FILE .. = != ().CAL ---> ().OBJ = != = != CALCOMP 32-BIT SOFTWARE: = != ().OBJ STOWED IN CALCOMP.OLB FOR LATER LINKAGE BY @CALLIN = != = != ***** PRINTOUT ON LPA0 ***** = != (( = !========================================================================= $ SET NOVERIFY $ INQUIRE PNT "Do you want a compiler listing printed ? (Y/N) ...." $ START: $ INQUIRE PROGRAM "Enter name of CALCOMP plot subroutine source module ...." $ GOTO NEXTA $ NEXT: $ PNT = "N" $ PROGRAM = P1 $ NEXTA: $ IF PROGRAM .EQS. "" THEN GOTO L1 $ ON ERROR THEN GOTO L2 $ IF PNT .EQS. "N" THEN GOTO LAB1 $! FORTRAN 'PROGRAM'.CAL /LIST /CROSS_REFERENCE- $! /CHECK /SHOW /NOSTANDARD $ FORTRAN 'PROGRAM'.CAL /LIST /CROSS_REFERENCE- /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO LAB2 $ LAB1: $! FORTRAN 'PROGRAM'.CAL /NOLIST /CROSS_REFERENCE- $! /CHECK /SHOW /NOSTANDARD $ FORTRAN 'PROGRAM'.CAL /NOLIST /CROSS_REFERENCE- /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ LAB2: $ LIBRARY/REPLACE CALCOMP 'PROGRAM' $ DELETE 'PROGRAM'.OBJ.* $ DIR 'PROGRAM'.* $ GOTO START $ L1: $ INQUIRE PNT "Do you want a library directory listing printed? (Y/N) ...." $ IF PNT .NES. "Y" THEN GOTO END $ LIBRARY CALCOMP /LIST=PLOTDLIST $ PRINT PLOTDLIST /DEVICE=LPA0 /DELETE $ GOTO END $ L2: $ IF PNT .EQS. "N" THEN GOTO START $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO START $ END: $ EXIT !========================================================================= = ISTART, IEND IW = (I + 15) / 16 IARRAY(IW) = IIBCLR (IARRAY(IW), 16 * IW - I) ! SETS 1 BIT TO ZERO 50 CONTINUE RETURN END T FOR THE C CALCOMP PACKAGE TO OPLOTS.FOR IN ORDER TO OPEN THE REQUESTED C NAMED FILE. C C davel/vms/CALEND.FOR;1 644 37 1770 7360 3515016022 7510 C.~* SYSTEM: SNIPS, PROGRAM: CALEND ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C NOVA VERSION C C ROUTINE TO SET UP A CONVERSON ARRAY FROM WORK DAY TO CALENDAR DATE C (IN DAYS SINCE 1-1-68). C C INPUT: C NAC - NO. OF WORK ACTIVITIES, C IREM - 0 IF CALCULATION IS TO BE MADE ON DURATION, C 1 IF ON REMAINING DURATION, C ICSTART - CALENDAR START DATE C NWDPW - NO. OF WORK DAYS PER WEEK C NHOL - NUMBER OF HOLIDAYS INPUT C IPSTART - PROJECT START DATE C HOLID(NHOL) C - LIST OF HOLIDAY DATES C IPEND - PROJECT FINISH DATE (DAYS SINCE 1-1-68 / ZERO) C IDATAD - DATA DATE (IN DAYS SINCE 1-1-68), C NEDEV - CHANNEL FOR ERROR MESSAGES, C C OUTPUT: C NCDATE(MAXWKD) - ARRAY OF THE FIRST 'MAXWKD' WORK DAYS, SHOWING C THE CALENDAR DATE FOR EACH (IN DAYS SINCE C 1-1-68) C NPEND - NUMBER OF WORK DAYS CORRESPONDING TO THE C PROJECT END DATE (OR ZERO IF AN END DATE C WAS NOT GIVEN). C NDATAD - DATA DATE (IN NUMBER OF PROJECT WORK DAYS), C C ENTER VIA: C CALL CALEND (NAC, IREM, NPEND, NDATAD, NCDATE, ICSTART, IPSTART, C IPEND, IDATAD, NEDEV, NWDPW, NHOL, HOLID) C C SUBROUTINES REQUIRED: SORTH C FUNCTIONS REQUIRED: N68WD C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C********************************************************************** C SUBROUTINE CALEND (NAC, IREM, NPEND, NDATAD, NCDATE, ICSTART, 1 IPSTART, IPEND, IDATAD, NEDEV, NWDPW, NHOL, HOLID) C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXHOL=100 ! MAX. NO. OF HOLIDAYS IN SCHEDULE PARAMETER MAXWKD=3276 ! MAX. NO. OF WORK DAYS IN ANY SCHEDULE C INTEGER*2 NCDATE(MAXWKD), HOLID(MAXHOL), IM12(16), IM13(50), IX(2) C C <> C C INITIALIZE CALENDAR DATE C NDTE = ICSTART C C POINT TO CURRENT NEXT HOLIDAY C IHOL=1 C C PROJECT WORK DAY COUNTER C NWD = 0 C C NO. DAYS IN WEEKEND C LWEND = 7 - NWDPW C C SORT HOLIDAYS INTO ASCENDING ORDER C CALL SORTH (HOLID, NHOL) C C LOOP OVER 'MAXWKD' WORK DAYS TO SET UP TABLE C INNER LOOP OVER EACH WEEK C 4 IWDPW = NWDPW 6 IF (IWDPW .LE. 0) GO TO 30 C C WITHIN WORK WEEK C IWDPW = IWDPW - 1 C C ARE WE STARTED WITH PROJECT YET? C IF (NDTE .LT. IPSTART) GO TO 26 C C WITHIN PROJECT C DOES CURRENT HOLIDAY CANCEL WORK TODAY? C 8 IF (NDTE - HOLID(IHOL)) 20, 26, 10 C C PAST CURRENT HOLIDAY. INCREMENT IF MORE & TRY AGAIN. C 10 IF (IHOL .GE. NHOL) GO TO 20 IHOL = IHOL + 1 GO TO 8 C C WITHIN PROJECT & IT'S A WORKING DAY C 20 NWD = NWD + 1 NCDATE(NWD) = NDTE IF (NWD .GE. MAXWKD) GO TO 40 C C INCREMENT DATE C 26 NDTE = NDTE + 1 GO TO 6 C C INCREMENT PAST WEEKEND C 30 NDTE = NDTE + LWEND GO TO 4 C C CONVERT PROJECT END INTO SCHEDULED WORK DAYS C 40 NPEND = N68WD (IPEND, NCDATE, MAXWKD) C C CONVERT DATA DATE INTO SCHEDULE WORK DAYS C NDATAD = N68WD (IDATAD, NCDATE, MAXWKD) C C DO WE NEED ACTUAL START AND FINISH DATES? C IF (IREM .EQ. 0) GO TO 100 C C YES. SET UP THE CALCULATION FILE WITH C THE WORK DAY EQUIVALENTS OF THE ACTUAL START C AND ACTUAL FINISH DAYS. C THEY ARE NEEDED IN THE CALCULATION BASED ON C REMAINING DURATION. C DO 70 I = 1, NAC READ (13'I) IM13 C C CONVERT AND TEST THE DATES C DO 60 J = 1, 2 IX(J) = N68WD (IM13(46 + J), NCDATE, MAXWKD) IF (IX(J) .LE. NDATAD) GO TO 60 WRITE (NEDEV,57) (IM13(K), K = 2, 6) 57 FORMAT(' *** WORK ITEM: ',5A2,' HAS ACTUAL START/FINISH', 1 ' DATE AFTER DATA DATE. SET TO DATA DATE.') IX(J) = NDATAD 60 CONTINUE READ (12'I) IM12 IM12(11) = IX(1) IM12(12) = IX(2) WRITE (12'I) IM12 70 CONTINUE 100 RETURN END IT2 C******************************************************************* C LOGICAL TAPE UNIT REPLACED WITH 14 FOR SNIPS PACKAGE. C ORIGIONAL WRITE STATEMENT WAS FOR: C WRITE(LTAPE)(IOBUFF(I),I=1,JMAX) C C MODIFY: DAVID C. LEE -- LAST MOD: JUN 1984 C C***************davel/vms/CALLIN.COM;1 644 37 1770 1606 3515016025 7514 !================================C A L L I N============================== != = != COMMAND FILE TO LINK THE BSNIPS MAIN OBJECT MODULE WITH THE SN = != LIBRARY AND THE 32-BIT VMS CALCOMP LIBRARY. = != = != AUTHOR: DAVID C. LEE ASA -- 10/18/84 = != = !========================================================================= ! $ LINK/NOMAP/EXECUTABLE=CALBSNIPS.EXE BSNIPS.OBJ+SN/LIBRARY+- PLOTPLO/LIBRARY+SN/LIBRARY+PLOTPLO/LIBRARY+- CALCOMP/LIBRARY $ DIR CALBSNIPS.EXE $ SET PROT=(S:RE,W:RE,O:RWED,G:RE) CALBSNIPS.EXE $ EXIT !========================================================================= ECT END DATE (OR ZERO IF AN END DATE C WAS NOT GIVEN). C NDATAD - DATA DATE (IN NUMBER OF davel/vms/CHACT.FOR;1 644 37 1770 14767 3515016035 7441 C.~* SYSTEM: SNIPS, PROGRAM: CHACT ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C ROUTINE TO DIRECT THE UPDATING OF ALL WORK ACTIVITIES ALONG WITH C THEIR INDIVIDUAL PROPERTIES SUCH AS: C WORK ACTIVITY TAG (ADD, REPLACE, DELETE ACTIVITIES), C BEGIN/END STATUS, C DESCRIPTION, C DURATION, C REMAINING DURATION, C PRECEDING WORK ACTIVITIES, C RESOURCES. C C PARAMETERS: C NEW - 1 = NEW DATA SET, C 0 = OLD DATA SET, C LSUPP - 1 TO SUPPRESS INFORMATIONAL MESSAGES, C NAC - NUMBER OF ACTIVITIES IN THE FILES, C NWID - NO. OF DELETED ACTIVITIES WITHIN 'NAC', C IDAILY - 1 IF DURATIONS ARE IN TENTHS OF DAYS, C 0 IF IN TENTHS OF WEEKS, C NPWICH - NO. OF ENTRIES IN PREV. WORK ACTIVITY CHAIN, C NPWID - NO. OF DELETED ENTRIES WITHIN 'NPWICH', C PWIC (2,NPWICH) C - PREVIOUS WORK ACTIVITY CHAINS, C IPSTART - PROJECT START DATE, C ICSTART - CALENDAR START DATE, C NWDPW - NO. OF WORK DAYS PER WEEK, C IDATAD - DATA DATE (IN DAYS SINCE 1-1-68) C IBUG - 0 IF A RAW FILE DUMP IS IN PROGRESS, C NWACH - NO. OF WORK ACTIVITIES REFERENCED, C ICODTE - 0 TO USE REGULAR DATES C 3 TO USE COMPANY INTERNAL DATES C *500 - RETURN TO THIS STATEMENT IF 'EXIT' WAS DETECTED. C C ENTER VIA: C CALL CHACT (NEW, LSUPP, NAC, NWID, IDAILY, NPWICH, NPWID, C PWIC, IPSTART, ICSTART, NWDPW, IDATAD, C IBUG, NWACH, ICODTE, *500) C C SUBROUTINES REQUIRED: BLANK, CHDES, CHDUR, CHPWI, CKFIL, INFOR, MENU, C RACTR, REPLY, SUBSTR, WACTR C FUNCTIONS REQUIRED: BITEST, IIBSET, IFIRST, INDEX C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C************************************************************************ C SUBROUTINE CHACT (NEW, LSUPP, NAC, TAGLIST, NWID, IDAILY, 1 NPWICH, NPWID, PWIC, IPSTART, 2 ICSTART, NWDPW, IDATAD, IBUG, NWACH, ICODTE, *) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C PARAMETER MAXPWI=3000 PARAMETER MAXNAC=2000 PARAMETER MAXCHT((=125 ! MAXCHT = (MAXNAC+15)/16 C INTEGER*2 IM13(50), TAGLIST(5,MAXNAC), WI(11), IM12(16) INTEGER*2 PWIC(2,MAXPWI), COPY(5) INTEGER*2 BMAP(MAXCHT) C C <> C C ASK WHICH FEATURES WILL BE CHANGED ON THIS EDITING C CALL MENU (NEW, ICHTAG, ICHDES, ICHDUR, ICHRMD, ICHPWI, *500) C IF (ICHTAG + ICHDES + ICHDUR + ICHRMD + ICHPWI .EQ. 0) GO TO 400 IF (LSUPP .NE. 0) GO TO 50 C C NOW OUTPUT THE SPECIFIC MESSAGES NEEDED FOR THESE C CHANGES ON THE CONSOLE C C CALL INFOR (ICHTAG, ICHDES, ICHDUR + ICHRMD, ICHPWI, IDAILY) C C ASSEMBLE A LIST OF THE ACTIVITY TAGS IN CORE C ALSO CHECK AND CORRECT THE PWI CHAIN C 50 IF (NAC .EQ. 0) GOTO 60 CALL CKFIL (TAGLIST, PWIC, NPWICH, NPWID, NAC, IBUG) C C INITIALIZE THE W.A. CHANGE BIT MAP C 60 DO 61 I=1, MAXCHT 61 BMAP(I) = 0 C C INITIALIZE THE EXIT FLAG C NOEXIT = 0 C C................................................................. C C REQUEST WORK ACTIVITY TAG C 62 WRITE (6, 64) 64 FORMAT ('0WORK ACTIVITY TAG? ',$) C CALL REPLY (WI, L, 21, *62, *62, *400, *500, 68) C CALL TAGLST( WI, NAC, TAGLIST, BMAP, *62 ) C C IS IT A CURRENT WORK ITEM? C COPY (1) = 0 CFUN IEQ = INDEX (WI, 1, L, %REF('='), 1, 1) IF (IEQ .EQ. 0) GO TO 78 C C EQUATE EXISTS. SEPARATE THE 2 NAMES. C CALL BLANK (COPY, 1, 10) CFUN J = IFIRST (WI, IEQ+1, L) IF (J .EQ. 0) GO TO 76 C CALL SUBSTR (COPY, 1, WI, J, L) C 76 CALL BLANK (WI, IEQ, L) C 78 NWACH = NWACH + 1 IF (NAC .EQ. 0) GO TO 84 DO 80 I=1, NAC CFUN IF (INDEX (TAGLIST(1,I), 1, 10, WI, 1, 10) .EQ. 1) GO TO 100 80 CONTINUE C C NOT A CURRENT WORK ITEM C 84 IF (ICHTAG .EQ. 1) GO TO 86 WRITE (6, 85) 85 FORMAT (5X,'*** NOT AN EXISTING TAG ***') GO TO 62 C C NEW WORK ITEM. FIND A PLACE FOR IT. C 86 IF (NWID .LE. 0) GO TO 89 C C SPACE FROM A DELETED W.I. IS AVAILABLE C NWID = NWID - 1 DO 88 J=1,NAC IF (TAGLIST (1,J) .EQ. 0) GO TO 90 88 CONTINUE C C FILE ERROR -- CORRECT DELETION COUNT C NWID = 0 C C ADD A SPACE TO THE END OF THE ACTIVITY LIST C 89 NAC = NAC + 1 J = NAC C C SET POINTER TO WORK ITEM LOCATION C 90 I = J C C MOVE NEW TAG INTO IN-CORE LIST & DESCRIPTION RECORD C CALL SUBSTR (TAGLIST (1,I), 1, WI, 1, 10) C CALL SUBSTR (IM13(2), 1, WI, 1, 10) C C MARK AS A NEW RECORD C IOLD = 0 NCH12 = 0 ! 'IM12' CHANGED C C COPY FROM ANOTHER RECORD IF DESIRED C IF (COPY(1) .EQ. 0) GO TO 91 IF (NAC .EQ. 0) GO TO 91 DO 106 J=1,NAC CFUN IF (INDEX (TAGLIST(1,J), 1, 10, COPY, 1, 10) .EQ. 1) GO TO 108 106 CONTINUE WRITE (6,107) COPY 107 FORMAT (5X, 'ACTIVITY: ',5A2,' IS NOT AVAILABLE FOR COPYING.') GO TO 91 C C GET RECORDS TO BE COPIED C 108 NCH13 = 0 C CALL RACTR (J, IM12, IM13, ICODTE) C IOLD = 1 IM12(1) = I IM13(1) = I GO TO 120 C C SET RECORD NUMBERS C 91 IM12(1) = I IM13(1) = I C C ZERO OUT THE REST OF THE CALCULATION RECORD C DO 92 J=2, 16 92 IM12(J) = 0 GO TO 120 C C ACTIVITY FOUND -- PICK UP DATA AND OUTPUT THE VALUES C THAT MAY BE CHANGED. C 100 IF (IEQ .EQ. 0) GO TO 104 WRITE (6,103) 103 FORMAT (5X,'*** CAN''T USE EQUATE TO FILL AN EXISTING WORK', 1 ' ACTIVITY ***') 104 IOLD = 1 NCH12 = 1 ! 'IM12' NOT CHANGED YET. NCH13 = 1 ! 'IM13' NOT CHANGED YET C CALL RACTR (I, IM12, IM13, ICODTE) C C ANY CHANGES IN TAG? C IF (ICHTAG .NE. 2) GO TO 120 110 WRITE (6,112) 112 FORMAT (5X,'REPLACEMENT WORK ACTIVITY TAG? ',$) C CALL REPLY (WI, L, 10, *110, *120, *400, *500, 75) C IF (L .LT. 1) GO TO 120 CALL TAGLST ( WI, NAC, TAGLIST, BMAP, *110 ) NCH13 = 0 DO 114 J=1,5 TAGLIST(J,I) = WI(J) 114 IM13(J+1) = WI(J) C C ANY CHANGES IN DESCRIPTION? C 120 IF (ICHDES .EQ. 0)GO TO 130 C CALL CHDES (IOLD, IM13, NCH13, *155) C C ANY CHANGES IN DURATIONS? C 130 IF (ICHDUR + ICHRMD .EQ. 0) GO TO 140 C CALL CHDUR (IOLD, IM12, NCH12, IM13, NCH13, ICHDUR, ICHRMD, 1 IDAILY, IPSTART, ICSTART, NWDPW, IDATAD, 2 *156, *154, *155) C C ANY CHANGE IN P. W. I.'S? C 140 IF (ICHPWI .EQ. 0 .OR. NAC .LT. 2) GO TO 154 C CALL CHPWI (IOLD, I, IM12, NCH12, NPWICH, PWIC, 1 NPWID, TAGLIST, NAC, IDAILY, NWDPW, IPSTART, 2 ICSTART, ICODTE, BMAP, *153) C GO TO 154 153 NOEXIT = 1 154 IDELETE = 0 GO TO 160 155 NOEXIT = 1 IF (IOLD .NE. 0) GO TO 154 C C DELETE REQUEST C 156 IDELETE = 1 C C RESTORE WORK ITEM TO DISK C 160 CALL WACTR ( I, IM12, NCH12, IM13, NCH13, PWIC, TAGLIST, 1 IDELETE, NAC, NWID, NPWICH, NPWID) C IF (NOEXIT .NE. 0) GO TO 500 C C FLAG WORK ITEM AS CHANGED C CALL BSET (BMAP, I, I) C GO TO 62 400 RETURN 500 RETURN 1 ! IEXIT END GO TO 1davel/vms/CHCAL.FOR;1 644 37 1770 11454 3515016041 7414 C.~* SYSTEM: SNIPS, PROGRAM: CHCAL ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C CHANGE CALENDAR PARAMETER OR ADD NEW ONES C C PARAMETERS: C C NEW - 1 IF NEW D.S C 0 IF OLD D.S C LSUPP - 1 TO SUPPRESS INFORMATIONAL MESSAGES, C IDAILY - 1 IF DURATIONS IN DAYS C ICSTART - CALENDAR START DATE IN DAYS FROM 1-1-68 MUST BE C PRIOR TO PROJECT START AND THE FIRST DAY OF A C WORK WEEK. C IPSTART - PROJECT START DATE, C IPEND - PROJECT COMPLETION DATE, C NWDPW - NUMBER OF WORK DAYS IN A FULL WORK-WEEK. C NHOL - NUMBR OF HOLIDAYS C HOLID(50) - LIST OF UP TO 50 HOLIDAY DATES IN DAYS SINCE 1-1-68. C ICODTE - 0 FOR REGULAR DATE C 3 FOR COMPANY SPECIFIC DATE C *99 - RETURN TO THIS STATEMENT IF 'EXIT' WAS TYPED IN. C C ENTER VIA: C C CALL CHCAL (NEW, LSUPP, IDAILY, ICSTART, IPSTART, IPEND, NWDPW, C NHOL, HOLID, ICODTE, *99) C C SUBROUTINES REQUIRED: BLANK, DATET, LDAY, REPLY C FUNCTIONS REQUIRED: INDEX, NDAY68 C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C C****************************************************************************** C SUBROUTINE CHCAL (NEW, LSUPP, IDAILY, ICSTART, IPSTART, IPEND, NWDPW, 1 NHOL, HOLID, ICODTE, *) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C PARAMETER MAXHOL=100 C COMMON /CHC00/ LETTER(2) C INTEGER*2 HOLID(MAXHOL), DSTR(5) C DATA LETTER /'W ', 'D '/ C C <> C C C DEFINE NORMAL CONSOLE OUTPUT PATH C IJLP = 6 C C INPUT/CHANGE: DAILY OR WEEKLY? C IF (NEW .NE. 0) GO TO 20 IX = IDAILY + 1 WRITE (6,10) LETTER(IX) 10 FORMAT ('0OLD VALUE: ',A1) 20 WRITE (6,22) 22 FORMAT (' DURATIONS IN WEEKS(W) OR DAYS(D)? ',$) C CALL REPLY (IANS, L, 1, *20, *24, *30, *500, 17) CFUN IF (INDEX (IANS, 1, 1, %REF('W'), 1, 1) .EQ. 0) GO TO 28 GO TO 26 C TRY AGAIN IF A NEW DATA SET 24 IF (NEW .NE. 0) GO TO 20 GO TO 30 C C WEEKLY DURATION INPUT C 26 IDAILY = 0 GO TO 30 CFUN 28 IF (INDEX (IANS, 1, 1, %REF('D'), 1 ,1) .EQ .0) GO TO 20 IDAILY = 1 C C WORK DAYS/WEEK? C 30 IF (NEW .NE. 0) GO TO 40 WRITE (6,32) NWDPW 32 FORMAT ('0OLD VALUE:', I2) 40 WRITE (6,42) 42 FORMAT (' NUMBER OF WORK DAYS/WEEK? ', $) C CALL REPLY (IANS, L, -1, *40, *46, *50, *500, 20) C IF (IANS .LT. 1 .OR. IANS .GT. 7) GO TO 40 NWDPW=IANS GO TO 50 C TRY AGAIN IF NUL ENTRY & NEW DATA SET 46 IF (NEW .NE. 0) GO TO 40 C C CALENDAR START DATE C 50 IF (NEW .NE. 0) GO TO 60 C CALL LDAY (DSTR, ICODTE, ICSTART) C WRITE (6,52) (DSTR(I), I = 1, 4) 52 FORMAT ('0OLD VALUE: ',4A2) 60 WRITE (6,62) 62 FORMAT (' CALENDAR START DATE(FIRST DAY OF A WORK WEEK)? ',$) C CALL REPLY (DSTR, L, 8, *60, *63, *64, *500, 24) C IF (L .LE .0) GO TO 63 CFUN ICSTART = NDAY68 (DSTR, IERR) IF (IERR .NE. 0) GO TO 60 GO TO 64 C TRY AGAIN IF NUL ENTRY & NEW DATA SET 63 IF (NEW .NE. 0) GO TO 60 C C PROJECT START DATE C 64 IF (NEW .NE. 0) GO TO 65 C CALL LDAY (DSTR, ICODTE, IPSTART) C WRITE (6,52) (DSTR(I), I = 1, 4) 65 WRITE (6,66) 66 FORMAT (' PROJECT START DATE? ',$) C CALL REPLY (DSTR, L, 8, *65, *67, *68, *500, 178) C IF (L .LE. 0) GO TO 67 C CALL DATET (IPSTART, DSTR, 0, ICSTART, NWDPW, 0, IJLP, *65) C GO TO 68 67 IF (NEW .NE. 0) GO TO 65 C C PROJECT COMPLETION DATE C 68 IF (NEW .NE. 0) GO TO 54 IF (IPEND .NE. 0) GO TO 69 C CALL BLANK (DSTR, 1, 8) C DSTR(1) = '30040'O GO TO 53 C 69 CALL LDAY (DSTR, ICODTE, IPEND) C 53 WRITE (6,52) (DSTR(I), I = 1, 4) 54 WRITE (6,55) 55 FORMAT (' PROJECT COMPLETION DATE (OR ZERO)? ',$) C CALL REPLY (DSTR, L, 8, *54, *57, *70, *500, 181) C IF (L .LE. 0) GO TO 57 IF (L .GT. 1) GO TO 56 CFUN IF (INDEX (DSTR, 1, 1, %REF('0'), 1, 1) .EQ. 0) GO TO 54 51 IPEND = 0 GO TO 70 C 56 CALL DATET (IPEND, DSTR, IPSTART, ICSTART, NWDPW, 0, IJLP, *54) C GO TO 70 57 IF (NEW .NE. 0) GO TO 51 C C HOLIDAYS C 70 IF (NEW .NE. 0) NHOL=0 IF (LSUPP .NE. 0) GO TO 73 WRITE (6,71) 71 FORMAT('0INDICATE COMPLETION OF HOLIDAY ENTRY WITH NULL ENTRY.'/ 1 ' DELETE HOLIDAYS BY ENTERING A ZERO DATE.'/) 73 DO 98 I=1, MAXHOL 72 IF (I .GT. NHOL) GO TO 75 C CALL LDAY (DSTR, ICODTE, HOLID(I)) C WRITE (6,74) (DSTR(M), M = 1, 4) 74 FORMAT (' OLD HOLIDAY DATE: ',4A2) 75 WRITE (6,76) 76 FORMAT (' ENTER HOLIDAY DATE? ',$) C CALL REPLY (DSTR, L, 8, *75, *78, *100, *500, 28) C IF (L - 1) 78,80,90 C C NUL ENTRY -- SKIP CURRENT ENTRY 78 IF (I .LE. NHOL) GO TO 98 GO TO 100 CFUN 80 IF (INDEX (DSTR, 1, 1, %REF('0'), 1, 1) .NE .1) GO TO 75 C C ZERO ENTRY -- REMOVE DUPLICATES K = I 82 IF (K - NHOL) 84,88,75 84 HOLID(K)= HOLID(K+1) K=K+1 GO TO 82 88 NHOL=NHOL-1 GO TO 72 C C ENTRY ENCOUNTERED C 90 CALL DATET (HOLID(I), DSTR, 0, ICSTART, NWDPW, 0, IJLP, *75) C IF (I .GT. NHOL) NHOL=I 98 CONTINUE C 100 RETURN 500 RETURN 1 ! IEXIT END , . <0-9,A-Z>/U/C NUMBER OF THE PRINT SUPPRESSION FILE TO BE CREATED(/C)((davel/vms/CHDES.FOR;1 644 37 1770 3305 3515016044 7407 C.~* SYSTEM: SNIPS, PROGRAM: CHDES ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C REQUEST AND ACCEPT CHANGES IN THE ACTIVITY DESCRIPTION. C THE DESCRIPTION RECORD IS RESTORED TO DISK IF ANY CHANGES ARE MADE. C C PARAMETERS: C IOLD - 1 IF WORK ITEM IS AN OLD ONE, C 0 IF IT DID NOT PREVIOUSLY EXIST, C IM13(50)- ARRAY CONTAINING WORK ITEM NUMBER (WORD 1), C TAG (WORDS 2-6), AND DESCRIPTION (WORDS 7-46), C ACTUAL START DATE(WORD 47), AND C ACTUAL FINISH DATE (WORD 48). C IT HAS NO DESCRIPTION IF 'IOLD' = 0, C NCH13 - 0 IF RECORD CONTAINED IT 'IM13' HAS BEEN CHANGED. C *300 - RETURN TO THIS STATEMENT IF 'EXIT WAS ENTERED. C C ENTER VIA: C CALL CHDES (IOLD, IM13, NCH13, *300) C C SUBROUTINES REQUIRED: REPLY, SUBSTR C FUNCTIONS REQUIRED: LENGTH C C AUTHOR: D.N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C************************************************************************** C SUBROUTINE CHDES (IOLD, IM13, NCH13, *) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IM13(50), IM(40) C C <> C IF (IOLD .EQ. 0) GO TO 150 CFUN L = (LENGTH (IM13(7), 80) + 1) / 2 + 6 WRITE (6, 12) (IM13(J), J = 7, L) 12 FORMAT (5X, 'OLD DESCRIPTION:'/1X, 35A2/1X, 5A2) C C ASK FOR NEW ACTIVITY DESCRIPTION C 150 WRITE (6,152) 152 FORMAT (5X, 'ACTIVITY DESCRIPTION?') C CALL REPLY (IM, L, 80, *150, *158, *154, *350, 77) C IF (L .LT. 1) GO TO 158 C C NEW DESCRIPTION ENTERED C 154 CALL SUBSTR (IM13(7), 1, IM, 1, 80) C NCH13 = 0 GO TO 160 C C NUL ENTRY. IS THIS A NEW ACTIVITY? C 158 IF (IOLD .EQ. 0) GO TO 150 160 IF (NCH13 .NE. 0) GO TO 200 NCH13 = 1 C C RESTORE RECORD TO DISK C WRITE (13'IM13(1)) IM13 200 RETURN 350 RETURN 1 ! IEXIT END OR DAYS(D)? ',$) C CALL REPLY (IANS, L, 1, *20, *24, *30, *500, 17) CFUN IF (INDEX (IANS, 1, 1, %REF('W'), 1, 1) .EQ. 0) GO TO 28 GO TO 26 C TRY AGAIN IF A NEW DATA SET 24 IF (NEW .NE. 0) GO TO 20 GO TO 30 C C WEEKLY DURATION INPUT C 26 IDAILY = 0 GO TO 30 CFUN 28 IF (INDEX (IANS, 1, 1, %REF('D'), davel/vms/CHDUR.FOR;1 644 37 1770 13304 3515016047 7451 C.~* SYSTEM: SNIPS, PROGRAM: CHDUR ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C REQUEST AND ACCEPT CHANGES IN DURATION & REMAINING DURATION. C C PARAMETERS: C IOLD - 1 IF EXISTING WORK ITEM, C 0 IF NEW WORK ITEM, C IM12(16)- ARRAY CONTAINING ACTIVITY INFORMATION INCLUDING: C WORD 2 = DURATION, C WORD 3 = REMAINING DURATION, C NCH12 - ZERO IF 'IM12' IS CHANGED AND WILL NEED TO BE C RESTORED TO DISK, C IM13(50)- ARRAY CONTAINING THE ACTIVITY TAG, DESCRIPTION, C ACTUAL START DATE(WORD 47) AND ACTUAL FINISH C DATE(WORD 48), C NCH13 - ZERO IF 'IM13' IS CHANGED AND WILL NEED TO BE C RESTORED TO DISK, C ICHDUR - 1 TO PERMIT ADDITION OR CHANGE OF DURATIONS, C ICHRMD - 0 NO CHANGE TO EXISTING REMAINING DURATIONS, C 1 REMAINING DURATIONS TO BE SET EQUAL TO DURATIONS, C 2 REMAINING DUR. WILL BE REQUESTED IN SAME UNITS AS C DURATIONS, C 3 REMAINING DURATIONS WILL BE REQUESTED AS % COMPLETE, C IDAILY - 1 DURATIONS IN TENTHS OF DAYS, C 0 DURATIONS IN TENTHS OF WEEKS, C IPSTART - PROJECT START DATE, C ICSTART - CALENDAR START DATE, C NWDPW - NO. OF WORK DAYS PER WEEK, C IDATAD - DATA DATE (IN DAYS SINCE 1-1-68), C *90 - RETURN TO THIS STATEMENT IF WORK ITEM IS TO BE DELETED, C *100 - RETURN TO THIS STATEMENT IF 'END' WAS ENTERED (THIS C REQUESTS NO MORE QUESTIONS FOR THIS WORK ITEM), C *200 - RETURN TO THIS STATEMENT IF 'EXIT' WAS ENTERED. C C ENTER VIA: C CALL CHDUR (IOLD, IM12, NCH12, IM13, NCH13, ICHDUR, ICHRMD, IDAILY, C IPSTART, ICSTART, NWDPW, IDATAD, *90, *100, *200) C C SUBROUTINES REQUIRED: DATET, REPLY C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C C************************************************************************* C SUBROUTINE CHDUR (IOLD, IM12, NCH12, IM13, NCH13, ICHDUR, ICHRMD, 1 IDAILY, IPSTART, ICSTART, NWDPW, IDATAD, *, *, *) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IM12(16), IM13(50), DSTR(4) C C <> C C C DEFINE NORMAL TERMINAL OUTPUT PATH C IJLP = 6 IDURCH = 1 ! FLAG SET TO NO DURATION CHANGE FD = IM12(2) / 10.0 RD = IM12(3) / 10.0 IF (IDAILY .NE. 0) GO TO 3 FD = FD / NWDPW RD = RD / NWDPW 3 IF (ICHDUR .EQ. 0) GO TO 50 IF (IOLD .NE. 0) WRITE (IJLP,6) FD 6 FORMAT (5X,'OLD DURATION:',F6.1) 5 IF (IDAILY .NE. 0) GO TO 12 WRITE (IJLP,7) NWDPW 7 FORMAT (5X,'DURATION (IN',I2,' DAY WORK WEEKS)? ',$) GO TO 8 12 WRITE (IJLP,13) 13 FORMAT (5X,'DURATION (IN DAYS)? ',$) C 8 CALL REPLY (IANS, L, -2, *5, *18, *100, *200, 82) C IF (IANS .NE. 0) GO TO 20 C C DURATION ZERO. TAKE DELETE EXIT. C 9 WRITE (IJLP,10) 10 FORMAT (5X,'*** DELETING WORK ITEM ***') RETURN 1 ! IDELETE C C NUL ENTRY. IF AN EXISTING DURATION IS AVAILABLE C DON'T CHANGE IT. 18 IF (IOLD .EQ. 0) GO TO 5 GO TO 50 C C NEW DURATION ENTERED C 20 IM12(2) = IANS IF (IDAILY .EQ. 0) IM12(2) = IANS * NWDPW C C MAKE SURE REMAINING DUR. IS NOT BIGGER THAN DURATION. C IF (IM12(2) .LT. IM12(3)) IM12(3) = IM12(2) IF (IOLD .EQ. 0) IM12(3) = IM12(2) NCH12 = 0 IDURCH = 0 ! FLAG DURATION CHANGED. C C ANY WORK ON REMAINING DURATIONS? C 50 IF (ICHRMD .NE. 3) GO TO 58 NPC = 100.0 * (1.0 - RD / FD) + 0.5 IF (IOLD .NE. 0) WRITE (IJLP,52) NPC 52 FORMAT (5X,'OLD % COMPLETE:',I6) GO TO 80 58 IF (ICHRMD .EQ. 2) GO TO 70 IF (ICHRMD .NE. 0) GO TO 62 IF (IDURCH .NE. 0) GO TO 90 IF (IM12(3) .EQ. IM12(2)) GO TO 146 IF (IM12(3) .EQ. 0) GO TO 150 C C IGNORE REQUEST NOT TO CHANGE R. D. IF THEY ARE C NOT EQUAL OR R.D = 0 C GO TO 70 C C SET REMAINING DURATION EQUAL TO DURATION C BUT ONLY IF DURATION WAS CHANGED. C 62 IF (IDURCH .NE. 0) GO TO 90 IM12(3) = IM12(2) NCH12 = 0 GO TO 146 C C SAME UNITS AS DURATION C 70 IF (IOLD .NE. 0) WRITE (IJLP,71) RD 71 FORMAT (5X,'OLD REMAINING DURATION:',F6.1) IF (IDAILY .NE. 0) GO TO 75 WRITE (IJLP,72) NWDPW 72 FORMAT (5X,'REMAINING DURATION (IN',I2,' DAY WORK WEEKS)? ',$) GO TO 77 75 WRITE (IJLP,76) 76 FORMAT (5X,'REMAINING DURATION (IN DAYS)? ',$) C 77 CALL REPLY (IANS, L, -2, *70, *78, *100, *202, 84) C IM12(3) = IANS * NWDPW IF (IDAILY .NE. 0) IM12(3) = IANS IF (IM12(3) .LE. IM12(2)) GO TO 74 WRITE (IJLP,73) 73 FORMAT (5X,'*** REMAINING DURATION GREATER THAN DURATION.', 1 ' PLEASE CHANGE.') GO TO 5 74 NCH12 = 0 GO TO 90 C TRY AGAIN IF NEW WORK ITEM 78 IF (IOLD .EQ. 0) GO TO 70 GO TO 90 C UNITS ARE % COMPLETE 80 WRITE (IJLP,82) 82 FORMAT (5X,'% COMPLETE? ',$) C CALL REPLY (IANS, L, -1, *80, *88, *100, *202, 85) C IF (IANS .LT. 0 .OR. IANS .GT. 100) GO TO 80 IM12(3) = ((100 - IANS) / 100.0) * IM12(2) + 0.5 NCH12 = 0 GO TO 90 C TRY AGAIN IF NEW WORK ITEM 88 IF (IOLD .EQ. 0) GO TO 80 C WORK ACTIVITY STARTED? 90 IF (IM12(3) .EQ. IM12(2)) GO TO 146 C YES GET ACTUAL START DATE. 92 WRITE (IJLP,94) 94 FORMAT (5X,'ACTUAL START DATE? ',$) C CALL REPLY (DSTR, L, 8, *92, *99, *92, *92, 187) C IF (L .LE. 0) GO TO 99 C CALL DATET (IM13(47), DSTR, IPSTART, ICSTART, NWDPW, IDATAD, 1 IJLP, *92) C NCH13 = 0 GO TO 140 C C NUL ENTRY C 99 IF (IM13(47) .LT. ICSTART) GO TO 92 C C IS WORK ITEM FINISHED? C 140 IF (IM12(3) .GT. 0) GO TO 148 C C YES. GET ACTUAL FINISH C 142 WRITE (IJLP,144) 144 FORMAT (5X,'ACTUAL FINISH DATE? ',$) C CALL REPLY (DSTR, L, 8, *142, *149, *142, *142, 193) C IF (L .LE. 0) GO TO 149 C CALL DATET (IM13(48), DSTR, IPSTART, ICSTART, NWDPW, IDATAD, 1 IJLP, *142) C NCH13 = 0 GO TO 150 146 IM13(47) = 0 148 IM13(48) = 0 NCH13 = 0 GO TO 150 C NUL ENTRY 149 IF (IM13(48) .LT. ICSTART) GO TO 142 C 150 RETURN C DELETE IF NEW ENTRY 100 IF (IOLD .EQ. 0) GO TO 9 RETURN 2 ! IEND C 200 IF (IOLD .NE. 0) RETURN 3 ! IEXIT GO TO 5 202 IF (IOLD .NE. 0) RETURN 3 ! IEXIT GO TO 50 END ESTART - EARLY START DAY, EFINISH - EARLY FINISH DAY., FFINISH - FREE-FLOAT FINISH DAY, LFINISH - LATE FINISH DAY. davel/vms/CHEKL.FOR;1 644 37 1770 11023 3515016053 7423 C*** SYSTEM: SNIPS, PROGRAM: CHEKL ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C CHECK FOR LOOPS IN SCHEDULE LOGIC. C C INPUT: C TAGLIST(5,MAXNAC) - LIST OF WORK ACTIVITY TAGS C NAC - # OF ACTIVITIES C PWIC(2,MAXPWI) - PWA CHAIN C C OPUTPUT: C IER - 2 IF LOOP FOUND C 1 IF DELETED ACTIVITY REFERENCE C 0 IF LOGIC OK C C ENTER VIA: C CALL CHEKL ( TAGLIST, NAC, PWIC, IER ) C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: (NONE) C C AU((THOR: D. N. ANDERSON -- AUGUST 1984 C MODIFY: D. C. LEE -- SEPT 1984 C C************************************************************************** C SUBROUTINE CHEKL ( TAGLIST, NAC, PWIC, IER ) C IMPLICIT INTEGER*2 (I-N) C PARAMETER (MAXPWI = 3000) PARAMETER (MAXNAC = 2000) C INTEGER*2 TAGLIST(5,MAXNAC), PWIC(2,MAXPWI), IM12(16) INTEGER*2 ISTACK(2,MAXNAC), I15(MAXNAC) C C <> C C SET RETURN FLAG TO NO LOGIC ERRORS IER = 0 C C CONSTRUCT INITIAL POINTERS TO PWI CHAINS DO 10 I=1, NAC READ (12,REC=I) IM12 I15(I) = IM12(15) C PTR TO PWI'S IF( IM12(1) .EQ. 0 ) I15(I) = -1 C INDICATE DELETION 10 CONTINUE C C START CHECKING FOR LOOPS IN PWA LOGIC. WORK BACK FROM C EACH ACTIVITY ALONG EVERY BRANCH IN TURN. SINCE THIS C CODE IS WRITTEN TO BE COMPATIBLE WITH NON-RECURSIVE C FORTRAN COMPILERS THE CURRENT CHAIN OF ACTIVITIES C BEING EXAMINED IS IN THE ARRAY "ISTACK". ISTACK(1,J) C CONTAINS THE NUMBER OF EACH ACTIVITY IN THE PWI CHAIN ('PWIC') C WHERE THE NEXT HIGHER STACK ELEMENT (IF ANY) WAS RETRIEVED. C THIS PERMITS RESUMPTION WITH ANOTHER BRANCH FROM C THIS ACTIVITY WHEN THE STACK LENGTH REDUCES TO MAKE C THIS THE TOP ELEMENT. 'ILEV' POINTS TO THE HIGHEST ELEMENT C IN THE CHAIN WHICH IS CURRENTLY BEING EXAMINED. C IACT = NAC + 1 20 IACT = IACT - 1 C MOVE TO NEXT LOWER ACTIVITY C IF( IACT .EQ. 0 ) RETURN C COMPLETE (EXIT THIS ROUTINE) C C IS THIS A DELETED ACTIVITY (OR ONE PREVIOUSLY SURVEYED) IF( I15(IACT) .LE. 0 ) GOTO 20 C YES. SKIP IT. C C START FORMING NEW STACK BY MAKING THIS THE FIRST ACTIVITY C ILEV = 1 ISTACK(1,ILEV) = IACT I = IACT C C PICK UP THE FORWARD POINTER FOR AN ACTIVITY AND TEST IT C 24 NF = I15(I) IF( NF .GT. 0 ) GOTO 72 C POINTS TO SOMETHING IF( NF .EQ. 0 ) GOTO 30 C ACTIVITY HAS NO PWA'S C REACHED DELETED ACTIVITY I2 = ISTACK(1,I-1) C C DIAGNOSE THE DELETED P.W.A. C WRITE(6,27) (TAGLIST(J,I),J=1,5), (TAGLIST(J,I2),J=1,5) 27 FORMAT(' *** ACTIVITY: ', 5A2,' HAS A DELETED ACTIVITY: ',5A2, + 'AS A P.W.A. ***') IF( IER .LT. 1 ) IER = 1 C C REACHED ACTIVITY WITH NO P.W.A.'S C DROP BACK TO PREVIOUS LEVEL 30 IF( ILEV .LE. 1) GOTO 20 C BACK TO BASE LEVEL I = ISTACK(1,ILEV) I15(I) = 0 C CUT OFF PWI CHAIN TO AVOID ILEV = ILEV - 1 C REPETITIVE SEARCHES. NF = ISTACK(2,ILEV) C PICK UP PWIC POINTER AT GOTO 74 C PREVOIUS LEVEL. C C POSITIVE POINTER - WHAT DOES IT POINT TO? C 72 NPW = PWIC(1,NF) IF( NPW .GT. 0 ) GOTO 80 C ACTIVITY C DROP THRU IF NOT-EARLIER-THAN START DATE AND GO C TO NEXT ITEM IN PWI CHAIN. C C MOVE ON TO NEXT ITEM IN PWIC CHAIN 74 NF = PWIC(2,NF) IF( NF .EQ. 0 ) GOTO 30 C END OF CHAIN IF( NF .GT. 0 ) GOTO 72 C POINTS TO DATE/ACTIVITY C SKIP OVER LAGS NF = -NF GOTO 74 C C HAVE REACHED THE # OF AN ACTIVITY IN THE PWI CHAIN. C PUT IT'S POINTER ON STACK AND TEST AGAINST PREVIOUS C ACTIVITIES ALONG THIS LOGICAL CHAIN. C 80 ISTACK(2,ILEV) = NF DO 82 I=1, ILEV IF( NPW .EQ. ISTACK(1,I) ) GOTO 84 82 CONTINUE C NO LOGIC LOOP - SO FAR ILEV = ILEV + 1 ISTACK(1,ILEV) = NPW I = NPW GOTO 24 C C FOUND A CIRCULAR CHAIN 84 WRITE(6,85) 85 FORMAT(' *** LOGIC LOOP THRU THE FOLLOWING ACTIVITIES:') DO 88 I1=I, ILEV J = ISTACK(1,I1) I15(J) = 0 C PREVENT REPEAT DIAGNOSES WRITE(6,87) (TAGLIST(K,J), K=1,5) 87 FORMAT(20X,5A2) 88 CONTINUE IER = 2 GOTO 20 END ) C IM12(3) = IANS * NWDPW IF (IDAILY .NE. 0) IM12(3) = IANS IF (IM12(3) .LE. IM12(2)) GO TO 74 WRITE (IJLP,73) 73 FORMAT (5X,'*** REMAINING DURATION GREATER THAN DURATION.', 1 ' PLEASE CHANGE.') GO TO 5 74 NCH12 = 0 GO TO 90 C TRY AGAIN IF NEW WORK ITEM 78 IF (IOLD .EQ. 0) GO TO 70 GO TO 90 C UNITS ARE % COMPLETE 80 WRITE (IJLP,82) 82 FORMAT (5X,'% COMPLETE? ',$) C CALL REPLY (IANS, L, -1, *80, *88, *100, *202, 85) C IF (IANS .LT. 0 .OR. IANS .GT. 100) GOdavel/vms/CHPLT.FOR;1 644 37 1770 3001 3515016056 7427 C.~* SYSTEM: SNIPS, PROGRAM: CHPLT ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C CHANGE THE FILE EMBEDDED DEFAULT PLOT PARAMETERS. C C PARAMETERS: C NEW - 1 IF NEW DATA SET, C 0 IF OLD DATA SET, C IBARDD - DAYS OF SCHEDULE PER PLOTTED DATE ON BARCHART (1-7), C BARFACT - BARCHART PLOTTING FACTOR, C *100 - RETURN TO THIS STATEMENT IF 'EXIT' IS ENTERED, C C ENTER VIA: C CALL CHPLT ( NEW, IBARDD, BARFACT, *100) C C SUBROUTINES REQUIRED: REPLY C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: SEP 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C************************************************************************** C SUBROUTINE CHPLT ( NEW, IBARDD, BARFACT, *) C IMPLICIT INTEGER*2 (I-N) C C <> C IF (NEW .EQ. 0) GO TO 130 C C NEW DATA SET -- SET DEFAULT PLOT VALUES C IBARDD = 1 ! DEFAULT TO 7 DAYS/PLOTTED DATE ON BARCHART BARFACT = 1.0 ! BARCHART PLOTTING FACTOR C C NOW LOOK FOR UPDATES TO PLOTTING VALUES C C DAYS PER PLOTTED BARCHART DATE C 130 WRITE (6,134) IBARDD 134 FORMAT (I3,' DAYS/PLOTTED DATE ON BARCHART. NEW VALUE(1-7)? ',$) CALL REPLY (IANS, L, -1, *130, *140, *400, *500, 164) IF (IANS .LT. 1 .OR. IANS .GT. 7) GO TO 130 IBARDD = IANS C C BARCHART PLOTTING FACTOR? C 140 WRITE (6,144) BARFACT 144 FORMAT (' BARCHART PLOT FACTOR =',F5.2,'. NEW FACTOR? ',$) CALL REPLY (IANS, L, -3, *140, *400, *400, *500, 166) IF (IANS .LT. 50 .OR. IANS .GT. 300) GO TO 140 BARFACT = IANS / 100.0 + 0.001 400 RETURN 500 RETURN 1 ! IEXIT END COMPLETE (EXIT THIS ROUTINE) C C IS THIS A DELETED ACTIVITY (OR ONE PREVIOUSLY SURVEYED) IF( I15(IACT) .LE. 0 ) GOTO 20 C YES. SKIP IT. C C START FORMING NEW STACK BY MAKING THIS THE FIRST ACTIVITY C ILEV = 1 ISTACK(1,ILEV) = IACT I = IACT C C PICK UP THE FORWARD POINTER FOR AN ACTIVITY AND TEST IT C 24 NF = I15(I) IF( NF .GT. 0 ) GOTO 72 C POINTS TO SOMETHING davel/vms/CHPWI.FOR;1 644 37 1770 11512 3515016064 7454 C.~* SYSTEM: SNIPS, PROGRAM: CHPWI ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C DELETE P. W. I.'S OR ADD THEM. C C PARAMETERS: C IOLD - 1 EXISTING WORK ITEM C - 0 NEW WORK ITEM C NCE - NUMBER OF CURRENT ENTRY IN 'IM12' C IM12(16)- ACTIVITY CALCULATION VECTOR: C WORD 15 - POINTER TO P. W. I. CHAIN C NCH12 - SET TO ZERO IF 'IM12' IS CHANGED C NPWICH - NUMBER OF ENTRIES IN P. W. I. CHAIN C PWIC(2,NPWICH) C - P. W. I. CHAIN C NPWID - NUMBER OF P. W. I.'S PREVIOUSLY DELETED FROM CHAIN C (P. W. I. NUMBER=0 INDICATES WHICH ONES). C TAGLIST(5,NAC) C - LIST OF WORK ITEM TAG. C NAC - NUMBER OF WORK ITEM TAGS. C IDAILY - 0 IF DURATIONS ARE TO BE DISPLAYED IN TENTHS OF WEEKS, C NWDPW - NO. OF WORK DAYS PER WEEK, C IPSTART - PROJECT START DATE, C ICSTART - CALENDER START DATE C ICODTE - 0 TO DISPLAY DATE IN FORM 12-31-83 C 3 TO DISPLAY DATE IN COMPANY SPECIFIC FORM C BMAP - BIT MAP SHOWING WHICH WORK ACTIVITIES HAVE BEEN CHANGED. C *200 - RETURN IF 'EXIT' ENTERED. C C ENTER VIA: C CALL CHPWI (IOLD, NCE, IM12, NCH12, NPWICH, PWIC, NPWID, TAGLIST, C NAC, IDAILY, NWDPW, IPSTART, ICSTART, ICODTE, BMAP, C *200 ) C C SUBROUTINES REQUIRED: ASMPWI, BLANK, DLPWI, INPWI, REPLY, SUBSTR C FUNCTIONS REQUIRED: FNUM, IFIRST, INDEX, NDAY68 C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C************************************************************************* C SUBROUTINE CHPWI (IOLD, NCE, IM12, NCH12, NPWICH, PWIC, 1 NPWID, TAGLIST, NAC, IDAILY, NWDPW, IPSTART, ICSTART, 2 ICODTE, BMAP, *) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C PARAMETER MAXPWI=3000 PARAMETER MAXNAC=2000 C INTEGER*2 IM12(16), PWIC(2,MAXPWI), TAGLIST(5,MAXNAC), TAG(5) INTEGER*2 LNE(30), BMAP(1) C C <> C IF (IOLD .NE. 0) GO TO 4 C C NEW ACTIVITY C NCH12 = 0 IM12(15) = 0 C C PICK UP POINTER TO FIRST RECORD IN PWI CHAIN C 4 IFWD = IM12(15) IBCK = 0 C C ANY EXISTING PWI'S LEFT TO OFFER FOR DELETION C 10 IF (IFWD .LE. 0) GO TO 24 C CALL ASMPWI (PWIC, IFWD, TAGLIST, IDAILY, NWDPW, LNE, ITYP, ICODTE) C IF (ITYP - 1) 8, 12, 14 8 WRITE (6,9) (LNE(J), J = 1, 4) 9 FORMAT (5X, 'DELETE NOT-EARLIER-THAN-START: ', 4A2, ' (Y/N)? ', $) GO TO 15 12 WRITE (6, 13) (LNE(J), J = 1, 5) 13 FORMAT (5X, 'DELETE P.W.A: ', 5A2, ' (Y/N)? ', $) GO TO 15 14 WRITE (6,17) (LNE(J), J = 1, 10) 17 FORMAT (5X, 'DELETE P.W.A: ', 10A2, ' (Y/N)? ', $)(( C 15 CALL REPLY (IANS, L, 0, *12, *20, *100, *200, 88) C IF (IANS .EQ. 0) GO TO 20 C C DELETION REQUESTED C CALL DLPWI (PWIC, NPWID, NPWICH, IM12(15), IFWD, IBCK, NCH12) C GO TO 10 C C P.W.A. IS TO BE RETAINED C 20 IBCK = IFWD IFWD = PWIC (2, IFWD) IF (IFWD .GE. 0) GO TO 10 IBCK = -IFWD IFWD = PWIC (2, IBCK) GO TO 10 C C REQUEST NEW OR ADDITIONAL P.W.I'S C 24 WRITE (6,26) 26 FORMAT (5X, 'NEW P.W.A.? ', $) C CALL REPLY (LNE, LEN, 60, *24, *100, *100, *200, 94) C CALL TAGLST ( LNE, NAC, TAGLIST, BMAP, *24 ) C 27 LB = 1 C C LOOK FOR COMMAS SEPARATING P.W.I'S CFUN 28 L = INDEX (LNE, LB, LEN, %REF(','), 1, 1) - 1 IF (L .EQ. -1) L = LEN LB1 = L + 2 LB = IFIRST (LNE, LB, L) IF (LB .EQ. 0) GO TO 31 C LOOK FOR + SIGN INDICATING A LAG FROM EITHER C THE FINISH OR START OF THE P.W.I C LBP = L CFUN IPLUS = INDEX (LNE, LB, L, %REF('+'),1, 1) IF (IPLUS .NE. 0) LBP = IPLUS - 1 IF (LBP .GT. LB + 9) LBP = LB + 9 C CALL BLANK (TAG, 1, 10) C CALL SUBSTR (TAG, 1, LNE, LB, LBP) C LB = LB1 C C SEARCH FOR NEW TAG IN THE LIST OF VALID ENTRIES C DO 30 I = 1, NAC CFUN IF (INDEX (TAGLIST(1,I), 1, 10, TAG, 1, 10) .EQ. 1) GO TO 34 30 CONTINUE C C LOOK FOR A VALID NOT-EARLER-THAN-START DATE CFUN IDT68 = NDAY68 (TAG, IERR) IF (IERR .NE. 0) GO TO 31 IPLUS = 0 I=-IDT68 CALL DATET ( IDT68, TAG, IPSTART, ICSTART, NWDPW, 0, 3, *65 ) GO TO 35 C 31 WRITE (6,32) TAG 32 FORMAT (5X, '*** ACTIVITY NOT FOUND: ', 5A2) GO TO 65 C C FOUND THIS PWA C CHECK IF IT REFERENCES ITSELF C 34 IF (I .NE. NCE) GO TO 35 WRITE (6,37) TAG 37 FORMAT (5X, '*** CAN''T PRECEED ITSELF: ', 5A2) GO TO 65 C C ANY FLAGS? C 35 LAG = 0 IF (IPLUS .EQ. 0) GO TO 50 C C PLUS SIGN GIVEN. LOOK FOR 'S' (START FLAG). C LBP = IPLUS + 1 IF (LBP .GT. L) GO TO 50 CFUN IES = INDEX (LNE, LBP, L, %REF('S'), 1, 1) IF (IES .NE. 0) L = IES - 1 IF (LBP .GT. L) GO TO 46 CFUN LAG = 10.0 * FNUM (LNE, LBP, L - LBP + 1, IERR) IF (IERR .NE. 0) GO TO 46 IF (LAG .GT. 0) GO TO 48 46 F = LAG / 10.0 WRITE (6,47) F 47 FORMAT (5X, '*** INVALID LAG: ', F6.1) GO TO 65 48 IF (IES .NE. 0) LAG = -LAG IF (IDAILY .EQ. 0) LAG = LAG * NWDPW C C INSERT PWI IN CHAIN C 50 CALL INPWI (PWIC, NPWID, NPWICH, IM12(15), IBCK, NCH12, I, LAG) C 65 IF (LB .LE. LEN) GO TO 28 GO TO 24 100 RETURN 200 RETURN 1 ! IEXIT END ) (LNE(J), J = 1, 5) 13 FORMAT (5X, 'DELETE P.W.A: ', 5A2, ' (Y/N)? ', $) GO TO 15 14 WRITE (6,17) (LNE(J), J = 1, 10) 17 FORMAT (5X, 'DELETE P.W.A: ', 10A2, ' (Y/N)? ', $)davel/vms/CHTIT.FOR;1 644 37 1770 3246 3515016071 7440 C.~* SYSTEM: SNIPS, PROGRAM: CHTIT ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C CHANGE TITLES/ADD NEW ONES C C PARAMETERS: C NEW -- 1 IF NEW DATA SET C 0 IF OLD DATA SET C T1(39) -- UPPER TITLE LINE C T2(39) -- LOWER TITLE LINE C *99 -- RETURN IF 'EXIT' IS INPUT C C ENTER VIA: C CALL CHTIT (NEW, T1, T2, *99) C C SUBROUTINES REQUIRED: REPLY, BLANK, SUBSTR C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C******************************************************************* C SUBROUTINE CHTIT (NEW, T1, T2, *) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 T1(39), T2(39), T3(40) C C <> C IF (NEW .NE. 0) GO TO 20 C C DISPLAY OLD ENTRY FOR UPPER TITLE C WRITE (6,10) T1 10 FORMAT (' OLD ENTRY:'/ ' ',39A2) C C REQUEST NEW ENTRY FOR UPPER TITLE C 20 WRITE (6,22) 22 FORMAT (' UPPER TITLE (RETAINED ON ALL REPORTS)? ') C C PICK UP REPLY C CALL REPLY (T3, L, 78, *20, *24, *70, *80, 9) C C CHANGE ONLY IF NON-NUL REPLY C IF (L .GT. 0) GO TO 30 C C NO ENTRY -- BLANK ONLY IF THIS IS A NEW DATA SET C 24 IF (NEW .NE. 0) CALL BLANK (T1, 1, 78) C GO TO 40 C C COPY NEW ENTRY TO UPPER TITLE LINE C 30 CALL SUBSTR (T1, 1, T3, 1, L) C IF (L .LT .78) CALL BLANK (T1, L+1, 78) 40 IF (NEW .NE. 0) GO TO 50 WRITE (6,10) T2 50 WRITE (6,52) 52 FORMAT (' LOWER TITLE (MAY BE REPLACED ON SELECTED REPORTS)?') C CALL REPLY (T3, L, 78, *50, *54, *70, *80, 9) C IF (L .GT .0) GO TO 60 C 54 IF (NEW .NE. 0) CALL BLANK (T2, 1, 78) C GO TO 70 C 60 CALL SUBSTR (T2, 1, T3, 1, L) C IF (L .LT .78) CALL BLANK (T2, L+1, 78) C 70 RETURN 80 RETURN 1 ! IEXIT END S .EQ. 0) GO TO 50 C C PLUS SIGN GIVEN. LOOK FOR 'S' (START FLAG). C LBP = IPLUS + 1 IF (LBP .GT. L) GO TO 50 CFUN IES = INDEX (LNE, LBP, L, %REF('S'), 1, 1) IF (IES .NE. 0) L = IES - 1 IF (LBP .GT. L) GO TO 46 CFUN LAG = 10.0 * FNUM (LNE, LBP, L - LBP + 1, IERR) IF (IERR .NE. 0) GO TO 46 IF (LAG .GT. 0) GO TO 48 46 F = LAG / 10.0 davel/vms/CKFIL.FOR;1 644 37 1770 7027 3515016073 7420 C.~* SYSTEM: SNIPS, PROGRAM: CKFIL ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C ASSEMBLE A LIST OF THE ACTIVITY TAGS IN MEMORY AND AT THE SAME TIME C CHECK THE P.W.I. CHAIN FOR VALID ENTRIES. MAKE CORRECTIONS AS NECESSARY. C C INPUT: C NAC - NUMBER OF ACTIVITIES ON FILE. C IBUG - ZERO IF A RAW DUMP FILE IS BEING WRITTEN. C PWIC(2,-) - P.W.I. CHAIN. C NPWICH - NUMBER OF HIGHEST ENTRY ON P.W.I. CHAIN. C NPWID - NUMBER OF DELETED ENTRIES WITHIN CHAIN. C C OUTPUT: C TAGLIST(5,NAC) - WORK ACTIVITY TAGS. C PWIC(2,-) - P.W.I. CHAIN. MAY BE MODIFIED IF ERRORS ARE FOUND. C C ENTER VIA: C CAL CKFIL (TAGLIST, PWIC, NPWICH, NPWID, NAC, IBUG) C C SUBROUTINES REQUIRED: BSET, BZERO, SUBSTR C FUNCTIONS REQUIRED: NBIT C C AUTHOR: D. N. ANDERSON -- LAST MOD: APR 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: AUG 1984 C C************************************************************************* C SUBROUTINE CKFIL (TAGLIST, PWIC, NPWICH, NPWID, NAC, IBUG) C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXNAC=2000 PARAMETER MAXPWI=3000 PARAMETER MAXBM=188 ! MAXBM=(MAXPWI+15)/16 C INTEGER*2 IM13(50), IM12(16), TAGLIST(5,MAXNAC) INTEGER*2 PWIC(2,MAXPWI), BMAP(MAXBM) C C <> C C ASSEMBLE A LIST OF THE ACTIVITY TAGS IN CORE C C C SET BIT MAP TO USE AS FLAGS FOR P.W.I. USE C DO 25 I = 1, MAXBM 25 BMAP(I) = -1 C C LOOP OVER ALL ACTIVITIES C DO 60 I=1,NAC READ (13'I) IM13 C TAGLIST(1,I) = 0 IF ( IM13(1) .EQ. 0) GO TO 60 ! DELETED ACTIVITY C CALL SUBSTR (TAGLIST(1,I), 1, IM13, 3, 12) C IF (IBUG .NE. 0) GO TO 40 C C RAW FILE DUMP C WRITE (4,52) IM13 52 FORMAT (I6, 1X, 5A2, 1X, 27A2, /, 18X, 13A2, 4I7) 40 READ (12'I) IM12 IF (IBUG .NE. 0) GO TO 42 WRITE (4,54) IM12 54 FORMAT (10I6/24X,6I6) C C MARK P.W.I.'S USED C 42 IF (IM12(1) .LE. 0) GO TO 60 IP = IM12(15) IF (IP .EQ. 0) GO TO 60 C C TEST VALUES OF THE POINTERS IN THE P.W.A. CHAIN C IF (IP .GT. 0 .AND. IP .LE. MAXPWI) GO TO 48 C C POINTER LANDS OUTSIDE THE CHAIN C 32 WRITE (6,33) (TAGLIST(J,I), J = 1, 5) 33 FORMAT ('0*** ERROR IN P.W.A. CHAIN FOR ACTIVITY: ',5A2, 1 ' -- P.W.A.''S DELETED.') IP = IM12(15) IM12(15) = 0 WRITE (12'I) IM12 34 IF (IP .LE. 0 .OR. IP .GT. MAXPWI) GO TO 60 36 PWIC(1,IP) = 0 C CALL BSET (BMAP, IP, IP) C IP = PWIC(2, IP) IF (IP .GE. 0) GO TO 34 IP = -IP GO TO 36 C C TEST PWI CHAIN ELEMENTS AFTER FIRST PTR C 48 IF (PWIC(1,IP) .NE. 0) 56,32,51 C C POSSIBLE # OF AN ACTIVITY C 51 IF (PWIC(1,IP) .GT. NAC) GO TO 32 C C VALID ACTIVITY # C MARK ACTIVITY FOR LATER CHAIN CHECK C 56 CALL BZERO (BMAP, IP ,IP) C IP = PWIC(2,IP) IF (IP) 58,60,48 58 IP = -IP ! POINTER TO LAG GO TO 56 60 CONTINUE C C C COUNT HOLES IN PWI CHAIN IP = 1 NDELI = 0 CFUN 70 I = NBIT (BMAP, IP, NPWICH) IF (I .EQ. 0) GO TO 71 NDELI = NDELI + 1 PWIC(1,I) = 0 IP = I + 1 IF (IP .LE. NPWICH) GO TO 70 C C CHECK THAT UPPER LIMIT IS LOW ENOUGH C 71 NOPWICH = NPWICH 72 IF (NDELI .EQ. 0) GO TO 74 CFUN I = NBIT (BMAP, NPWICH, NPWICH) IF (I .EQ. 0) GO TO 74 ! USED NPWICH = NPWICH - 1 ! NOT USED - SHORTEN LIST NDELI = NDELI - 1 GO TO 72 C C WRITE ERROR MESSAGES IF ANY C 74 IF (NDELI .EQ. NPWID) GO TO 76 WRITE (6,75) NPWID,NDELI 75 FORMAT ('0*** ERROR IN NO. OF HOLES IN P.W.A. CHAIN ON FILE.'/ 1 5X,'CORRECTED FROM',I6,' TO',I4) NPWID = NDELI 76 IF (NOPWICH .EQ. NPWICH) GO TO 80 WRITE (6,77) NOPWICH,NPWICH 77 FORMAT ('0*** ERROR IN MAX. ITEM NUMBER OF P.W.A. CHAIN ON FILE.'/ 1 5X,'CORRECTED FROM',I6,' TO',I4) 80 RETURN END LOGICAL CHAIN. C 80 ISTACK(2,ILEV) = NF DO 82 I=1, ILEV IF( NPW .EQ. ISTACK(1,I) ) GOTO 84 82 CONTINUE C NO LOGIC LOOP - SO FAR ILEV = ILEV + 1 ISTACK(1,ILEV) = NPW I = NPW GOTO 24 C C FOUND A CIRCULAR CHAIN 84 WRITE(6,85) 85 FORMAT(' *** LOGIC LOOP THRU THE FOLLOWING ACTIVITIES:') DO 88 I1=I, ILEV J = ISTACK(1,I1) I15(J) = 0 C PREVENT REPEAT DIAGNOSES WRITE(6,87) (TAGLIST(K,J), K=1,5) 87 FORMAT(20X,5A2) 88 CONTINUE IERdavel/vms/CODAY.FOR;1 644 37 1770 4442 3515016101 7415 ((C.~* SYSTEM: LIBRARY, PROGRAM: CODAY ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C TEXTRONIC VERSION (REPLACED BY EACH INSTALLATION COMPANY). C C FORM A COMPANY SPECIFIC DATE STRING. C C PARAMETERS: C NFM - 3 OR LARGER TO BE USED IN SELECTING WHICH C DATE STRING IS TO BE RETURNED (IF MORE THAN ONE) C ND68 - NUMBER OF DAYS SINCE 12-31-1967 (INTEGER) C IDY - DAY IN YEAR 'NUM(3)' C NUM(3) - DATE IN INTEGER FORM: C 1) MONTH (1-12) C 2) DAY (1-31) C 3) YEAR (0-99) C IDSTR(5)- THE STRING INTO WHICH A DATE IS TO BE PLACED. C C ENTER VIA: C CALL CODAY (IDSTR, NFM, ND68, IDY, NUM) C C SUBROUTINES REQUIRED: SUBSTR C FUNCTIONS REQUIRED: NPUT C C AUTHOR: D. N. ANDERSON -- LAST MOD: DEC 1983 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C C*************************************************************************** C SUBROUTINE CODAY (IDSTR, NFM, ND68, IDY, NUM) C PARAMETER MAXCRY = 16 ! # OF CRITICAL (371 DAY) YEARS C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IDSTR(5), NUM(3), NCRIT(2,MAXCRY) C DATA NCRIT/ 9, 147, 5, 2338, 0, 4165, 6, 6356, ! CONTAINS: + 2, 8547, 7, 10374, 4, 12929, 9, 14756, ! TEK YEAR + 5, 16947, 0, 18774, 6, 20965, 2, 22156, ! DAYS SINCE + 7, 24983, 3, 27174, 8, 29001, 4, 31192 / ! 12-31-1967 C C <> C DO 10 I = 1, MAXCRY IF (NCRIT(2,I) .GT. ND68) GO TO 20 10 CONTINUE I = MAXCRY + 1 20 I = I - 1 IF (I .GT. 0) GO TO 30 C C 1967 - 1968 C NY = 8 ND = ND68 + 217 NC = 0 GO TO 50 30 NY = NCRIT(1,I) ND = ND68 - NCRIT(2,I) NC = 7 IF (ND .LT. 371) GO TO 50 ND = ND - 371 NC = 0 40 NY = NY + 1 IF (ND .LT. 364) GO TO 50 ND = ND - 364 GO TO 40 C C YEAR DETERMINED (ALSO TYPE - NC = 0/7) C 50 NY = IMOD (NY, 10) MO = 1 IF (ND .LT. 28 + NC) GO TO 60 ND = ND - 28 - NC MO = ND / 28 ND = ND - 28 * MO MO = MO + 2 C C MONTH DETERMINED - GET WEEK AND DAY C 60 NWK = ND / 7 ND = ND - 7 * NWK + 1 NWK = NWK + 1 C C PUT IN STRING FORM C IS = NPUT (IDSTR, 1, 3, %REF('00'), 100 * NY + MO) CALL SUBSTR (IDSTR, 4, %REF('- - '), 1, 7) IS = NPUT (IDSTR, 5, 1, %REF(' '), NWK) IS = NPUT (IDSTR, 7, 1, %REF(' '), ND) RETURN END PWIC(2, IP) IF (IP .GE. 0) GO TO 34 IP = -IP GO TO 36 C C TEST PWI CHAIN ELEMENTS AFTER FIRST PTR C 48 IF (PWIC(1,IP) .NE. 0) 56,32,51 C C POSSIBLE # OF AN ACTIVITY C 51 IF (PWIC(1,IP) .GT. NAC) GO TO 32 C C Vdavel/vms/CODBAR.FOR;1 644 37 1770 11052 3515016104 7526 C.~* SYSTEM: SNIPS, PROGRAM: CODBAR ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PLOT A TEKTRONIX DATE BAR ON THE CALCOMP PLOTTER C C INPUT: C X - X-COORDINATE OF LOWER LEFT CORNER OF DATE BAR. C Y - Y-COORDINATE C NDP - NUMBER OF DATES TO BE PLOTTED C IFREQ - NUMBER OF WORK DAYS PER PLOTTED DATE (1-7 DAYS) C EACH DATE TAKES UP 0.63" IN UNFACTORED FORM C NCDATE(1000)- WORK DAY TRANSLATION VECTOR. INDEXED BY THE C PROJECT WORK DAY IT CONTAINS THE DATE IN C DAYS SINCE 12-31-67. C EG: NCDATE(1) = DATE (IN DAYS SINCE 12-31-67) C OF THE PROJECTS START C NCDATE(N) = LAST DATE TO PLOT IN DATE C BAR. C NFDAY - NUMBER OF DAY BEFORE 1ST ACTUALLY USED IN THE SUBSET C TO BE PLOTTED C N - NUMBER OF THE LAST WORK DAY TO BE COVERED BY C THE DATE BAR. C ICSTART - CALENDAR START DATE (DAYS SINCE 12-31-67) C IFLIP - 0 TO PUT DAYS IN LOWER HALF OF DATE BAR, C 1 TO PUT DAYS IN UPPER HALF OF DATE BAR. C C ENTER VIA: C CALL CODBAR (X, Y, NDP, IFREQ, NCDATE, NFDAY, N, ICSTART, IFLIP) C C SUBROUTINES REQUIRED: LDAY, PLOTX, SYMBLX C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: DEC 1983 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: JUN 1984 C C********************************************************************** C SUBROUTINE CODBAR (X, Y, NDP, IFREQ, NCDATE, NFDAY, N, ICSTART, + IFLIP) C IMPLICIT INTEGER*2 (I-N) C COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN C INTEGER*2 NCDATE(1), UP, DOWN, STR(5), OLDSTR(2) C C <> C C FIELD WIDTH FOR EACH DATE PLOTTED C FW = 3.0 * CH C C TOTAL BAR HEIGHT C TH = 2.0 * BH C C TOTAL BAR LENGTH C TL = NDP * FW C C PLOT OUTLINE OF BAR C CALL PLOTX (X, Y, UP) C CALL PLOTX (X + TL, Y, DOWN) C CALL PLOTX (X + TL, Y + TH, DOWN) C CALL PLOTX (X, Y + TH, DOWN) C CALL PLOTX (X, Y, DOWN) C C CALC Y-COORD. OF LETTERING C TH2 = TH / 2.0 DELTA = 0.5 * (TH2 - CH) Y1 = Y + DELTA Y2 = Y1 + TH2 Y3 = Y !TIC COORDINATE Y4 = Y - .35 * BH C C CHANGE IF MONTHS ON BOTTOM, DAYS ON TOP C IF (IFLIP .EQ. 0) GO TO 1 XX = Y2 Y2 = Y1 Y1 = XX Y4 = Y + TH Y3 = Y4 + .35 * BH C C SET UP MOVING DAY COORDINATE C 1 XX = X C C X-COORD. OF MONTH BEGINNING C XM1= X OLDSTR(1) = 0 C C WORK DAY COUNTER C ID = NFDAY + 1 C C INIT PREV. DAY COMPARITOR C IPDS = '70'O !'<0>8' C C DAY OFFSET C ADJ = 1.2 * CH C C COUNTER FOR PLOTTED DAYS C I = 1 2 IPT = 1 CALL LDAY (STR, 3, NCDATE(ID)) ID = ID + IFREQ DO 3 J = 1, 2 IF (OLDSTR(J) .NE. STR(J)) GO TO 5 3 CONTINUE C C MONTH AND YEAR STILL THE SAME C GO TO 16 C C CHANGE FOUND IN MONTH-YEAR C FIRST MONTH? C 5 IF (OLDSTR(1) .EQ. 0) GO TO 8 C C CHANGE OF MONTH PLOT MONTH SEPARATOR C 4 XM1=XX C CALL PLOTX (XM1, Y, UP) C CALL PLOTX (XM1, Y + TH, DOWN) C CALL PLOTX (XM1, Y + TH2, UP) C CALL PLOTX (XM, Y + TH2, DOWN) C C ENOUGH ROOM FOR FISCAL MONTH & YEAR? C IF (XM1 - XM .LT. 4.0 * CH) GO TO 8 C C YES. FIND START POINT C X2 = (XM + XM1) / 2.0 - 1.3 * CH C ENOUGH ROOM FOR "AP" DESIGNATION? IF( XM1 - XM .LT. 7.0*CH ) GOTO 6 C YES. PLOT IT. X2 = X2 + 1.5 * CH CALL SYMBLX ( X2-3.0*CH, Y2, CH, %REF('AP'), 0., 2 ) C PLOT YR-MONTH 6 CALL SYMBLX (X2, Y2, CH, OLDSTR(1), 0.0, 3) C C RESET TO START NEXT MONTH C 8 IF (I .GT. NDP) GO TO 50 XM = XM1 DO 12 J = 1, 2 12 OLDSTR(J) = STR(J) C C PLOT THE DAY C 16 CALL SYMBLX (XX + ADJ, Y1, CH, STR(4), 0.0, 1) C ICDS = STR(4) .AND. 255 !'<0>CURR. DAY' IF (ICDS .GT. IPDS) GO TO 20 C C PUT MARKER BETWEEN WEEKS C CALL PLOTX (XX, Y1 - DELTA, UP) CALL PLOTX (XX, Y1 + TH2 - DELTA, DOWN) 20 IPDS = ICDS C C INCR TO NEXT DAY POSITION C XX = XX + FW I = I + 1 IF (I .GT. NDP) GO TO 4 GO TO 2 50 RETURN END IM12(2) + 0.5 NCH12 = 0 GO TO 90 C TRY AGAIN IF NEW WORK ITEM 88 IF (IOLD .EQ. 0) GO TO 80 C WORK ACTIVITY STARTED? 90 IF (IM12(3) .EQ. IM12(2)) GO TO 146 C YES GET ACTUAL START DATE. 92 WRITE (IJLP,94) 94 FORMAT (5X,'ACTUAL START DATE? ',$) C CALL REPLY (DSTR, L, 8, *92, *99, *92, *92, 187) C IF (L .LE. 0) GO TO 99 C CALL DATET (IM13(47), DSTR, IPSTART, ICSTART, NWDPW, IDATAD, 1 IJLP, *92) C NCH13 = 0 GO TO 140 C C NUL ENTRY C 99 Idavel/vms/COMFI.FOR;1 644 37 1770 6766 3515016107 7434 C.~* SYSTEM: LIBRARY, PROGRAM: COMFI ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C DEC VAX/VMS VERSION C C READ THE COMMAND LINE (EMULATES THE EQUIVALENT ROUTINE ON THE C DATA GENERAL RDOS SYSTEM). C LOWER CASE INPUT IS CONVERTED TO UPPERCASE. C C INPUT: N - MAX. NO. OF FILE NAMES TO LOOK FOR. C C OUTPUT: N - NO. OF FILE NAMES READ (0 INDICATES NO NAMES OR FILE C NOT OPENED). C NAMFI - A 10 BY 'N' ARRAY INTO WHICH THE FILE NAMES ARE C PLACED (2 CHAR/WORD TERMINATED BY NULLS). C NSW - A 2 BY 'N' ARRAY CONTAINING THE SWITCHES ASSOCIATED C WITH EACH NAME IN 'NAMFI'. THE FIRST WORD CONTAINS C THE BITS FOR SWITCHES A THRU P. THE 2ND CONTAINS C Q THRU Z IN BITS 0 - 9. C C ENTER VIA: C CALL COMFI (N, NAMFI, NSW) C C EXAMPLE: C GIVEN A COMMAND LINE 'EHEADER/S 23/P 50/L FILE1' C C COMFI WILL RETURN; C C N I NSW(1-2,I) NAMFI(1-10,I) C - - ---------- ----------------- C 4 1 '0'O, '20000'O (BLANK) C 2 '1'O, '0'O 23 C 3 '20'O, '0'O 50 C 4 '0'O, '0'O FILE1 C C SUBROUTINES REQUIRED: BLANK, LIB GET_FOREIGN, SUBSTR, UPCASE C FUNCTIONS REQUIRED: IIBSET, LENGTH, NEXT C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1983 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C**************************************************************************** C SUBROUTINE COMFI (N, NAMFI, NSW) C IMPLIC((IT INTEGER*2 (I-N) C CHARACTER CLINE*80 C INTEGER*2 NAMFI(10,N), NSW(2,N), TEMPLN(40) C DATA IBLSL /' /'/ C C <> C CALL LIB$GET_FOREIGN (CLINE) C C COPY TO TEMPORARY INTEGER ARRARY FOR UPPER CASE CONVERSION C CALL SUBSTR ( TEMPLN, 1, %REF(CLINE), 1, 80 ) CALL UPCASE ( TEMPLN, 80 ) CALL SUBSTR ( %REF(CLINE), 1, TEMPLN, 1, 80 ) C L = LENGTH (%REF(CLINE), 80) ITYP = 32 J2 = 1 NN = 1 C C COLLECT THE 'N' ARGUMENTS (1ST IS BLANK) C DO 50 I = 1, N C C CLEAR OUT THE ARGUMENTS BEFORE REFILL C CALL BLANK (NAMFI(1,I), 1, 20) C NSW(1,I) = 0 NSW(2,I) = 0 C C ANY MORE LINE TO PROCCESS? C 10 J1 = J2 IF (J1 .GT. L) GO TO 50 C C GET TYPE AND POSITION OF 1ST NON-BLANK FOR I'TH ARG IN CMD C J2 = NEXT (%REF(CLINE), J1, L, ITYP) C C IS IT SLASH? C IF (ITYP .EQ. 47) GO TO 24 IF(ITYP .NE. 1 .AND. ITYP .NE. 2 .AND. ITYP .NE.46) GO TO 10 IF( I .EQ. 1 ) GO TO 48 C C STARTS AS ALPHANUMERIC C J3 = J2 16 J3 = NEXT (%REF(CLINE), J3, L, ITYP) IF (J3 .GT. L) GO TO 20 IF (ITYP .EQ. 1 .OR. ITYP .EQ. 2 .OR. ITYP .EQ. 46) GO TO 16 20 NN = I C CALL SUBSTR (NAMFI(1,I), 1, %REF(CLINE), J2, J3-1) C J2 = J3 IF (ITYP .NE. 47) GO TO 44 C C PROCESS A SWITCH C 24 J2 = J2 + 1 ITYP = 0 C J3 = NEXT (%REF(CLINE), J2, L, ITYP) IF (ITYP .NE. 1 .AND. ITYP .NE. 2) GO TO 50 C ICH = ICHAR (CLINE(J2:J2)) NB = 80 - ICH IF (NB .LT. 0) GO TO 30 IF (NB .GT. 15) GO TO 34 C C ALPHA SWITCHES (A-P) C NSW(1,I) = IIBSET (NSW(1,I), NB) GO TO 40 C C ALPHA SWITCHES (Q-Z) C 30 NB = NB + 16 GO TO 38 C C NUMERIC SWITCHES (0-5) C 34 NB = NB - 27 IF (NB .LT. 0) GO TO 40 C 38 NSW(2,I) = IIBSET (NSW(2,I), NB) 40 NN = I C C MOVE OFF SWITCH CHARACTER C ITYP = 0 C J2 = NEXT (%REF(CLINE), J2+1, L, ITYP) C C ANOTHER SWITCH ON THIS ARG? C IF (ITYP .EQ. 47) GO TO 24 C C NO. C SKIP OVER JUNK CHAR OR END ARGUMENT C 44 IF (ITYP .NE. 32 .AND. J2 .LE. L) GO TO 10 GO TO 50 48 ITYP = 32 50 CONTINUE C C RESET # OF ARGS RETURNED IF NECESSARY C N = NN RETURN END TH FOR EACdavel/vms/COMPILE.COM;3 644 37 1770 1105 3515016115 7636 N ASMPWI BCHART BILL BLANK BSET BZERO CALEND CHACT CHCAL CHDES CHDUR CHEKL CHPLT CHPWI CHTIT CKFIL CODAY CODBAR COMFI CSFIL DASHP DATE DATET DBAR DCLFIX DLPWI DTADTE EXLFS FATAL FIL2P FILFIX FILL FILLI FILPR FILRT FILTB FNUM FNUM8 GETIP HEDRS HELP HHCMM IFIRST INDEX INFOR INFREE INPWI IPATN ISLCT ITMTAG ITOC JLPFIX KOMPAR LDAY LENGTH LNTEXT MDYBN MENU MMKR N68WD NBIT NDAY68 NEWFIL NEXT NGET NPUT PNUM8 PREP1 PREP2 PREP3 PREP4 PREPA PREPB PREPR RACTR RDCALC RDM1 REPLY SBAR SCALC SCRPT SHADE SKEY SORTH SORTP SORTS SUBSTR SVECT TAGLST TIME TIMEJLP UPCASE USEIP WACTR WARM WRM1 (1,I) = 0 NSW(2,I) = 0 C C ANY MORE LINE TO PROCCESS? C 10 J1 = J2 IF (J1 .GT. L) GO TO 50 C C GET TYPE AND POSITION OF 1ST NON-BLANK FOR I'TH ARG IN CMD C J2 = NEXT (%REF(CLINE), J1, L, ITYP) C C IS IT SLASH? C IF (ITYP .EQ. 47) GO TO 24 IF(ITYP .NE. 1 .AND. ITYP .NE. 2 .AND. ITYP .NE.46) GO TO 10 IF( I .EQ. 1 ) GO TO 48 C C STARTS AS ALPHANUMERIC C J3 = J2 16 J3 = NEXT (%REF(CLINE), J3, L, ITYP) IF (J3 .GT. L) GO TO 20 davel/vms/CPLOTS.DDN;1 644 37 1770 1253 3515016120 7537 C*** SYSTEM: SNDDN, PROGRAM: CPLOTS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C PLOTDDN.OLB MEMBER C C VAX/VMS VERSION C C CLOSE THE PLOTTER OR PLOT FILE FOR OUTPUT C C >>>>> THIS ROUTINE MAY BE SYSTEM DEPENDENT <<<<< C C INPUT: C IFILE -- FILE NAME WHICH IS TO BE CLOSED. C LUN -- LOGICAL DEVICE TO CLOSE. C C ENTER VIA: C CALL CPLOTS( X, Y ) C C D. N. ANDERSON -- MARCH 1984 C D. C. LEE -- JUNE 1984 C C*************************************************************************** C SUBROUTINE CPLOTS ( IFILE, LUN ) INTEGER*2 IFILE(1), LUN C C <> C CALL PLOTX ( 0., 0., 999 ) ! OLD CALL TO CLOSE OUTPUT FILE C RETURN END GET TYPE AND POSITION OF 1ST NON-BLANK FOR I'TH ARG IN CMD C J2 = NEXT (%REF(CLINE), J1, L, ITYP) C C IS IT SLASH? C IF (ITYP .EQ. 47) GO TO 24 IF(ITYP .NE. 1 .AND. ITYP .NE. 2 .AND. ITYP .NE.46) GO TO 10 IF( I .EQ. 1 ) GO TO 48 C C STARTS AS ALPHANUMERIC C J3 = J2 16 J3 = NEXT (%REF(CLINE), J3, L, ITYP) IF (J3 .GT. L) GO TO 20 davel/vms/CPLOTS.PLO;1 644 37 1770 1317 3515016123 7570 C*** SYSTEM: BSNIPS, PROGRAM: CPLOTS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C PLOTD.OLB MEMBER C C VAX/VMS VERSION C C CLOSE THE PLOTTER OR PLOT FILE FOR OUTPUT C C >>>>> THIS ROUTINE MAY BE SYSTEM DEPENDENT <<<<< C C INPUT: C IFILE -- FILE NAME WHICH IS TO BE CLOSED. C LUN -- LOGICAL DEVICE TO CLOSE. C C ENTER VIA: C CALL CPLOTS( X, Y ) C C D. N. ANDERSON -- MARCH 1984 C D. C. LEE -- JUNE 1984 C C*************************************************************************** C SUBROUTINE CPLOTS ( IFILE, LUN ) INTEGER*2 IFILE(1), LUN C C <> C CALL PLOTX ( 0., 0., 999 ) ! OLD CALL TO CLOSE OUTPUT FILE C CLOSE (UNIT=LUN, IOSTAT=IERR) RETURN END NK FOR I'TH ARG IN CMD C J2 = NEXT (%REF(CLINE), J1, L, ITYP) C C IS IT SLASH? C IF (ITYP .EQ. 47) GO TO 24 IF(ITYP .NE. 1 .AND. ITYP .NE. 2 .AND. ITYP .NE.46) GO TO 10 IF( I .EQ. 1 ) GO TO 48 C C STARTS AS ALPHANUMERIC C J3 = J2 16 J3 = NEXT (%REF(CLINE), J3, L, ITYP) IF (J3 .GT. L) GO TO 20 davel/vms/CPLOTS.SWN;1 644 37 1770 1226 3515016125 7606 C*** SYSTEM: BSNIPS, PROGRAM: CPLOTS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C PLOTD.OLB MEMBER C C VAX/VMS VERSION C C CLOSE THE PLOTTER OR PLOT FILE FOR OUTPUT C C INPUT: C IFILE -- FILE NAME WHICH IS TO BE CLOSED. C LUN -- LOGICAL DEVICE TO CLOSE. C C ENTER VIA: C CALL CPLOTS( X, Y ) C C D. N. ANDERSON -- MARCH 1984 C D. C. LEE -- SEPT 1984 C C*************************************************************************** C SUBROUTINE CPLOTS ( IFILE, LUN ) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IFILE(1), LUN C C <> C CALL PLOTX ( 0., 0., 999 ) ! OLD CALL TO CLOSE OUTPUT FILE C RETURN END ILE C CLOSE (UNIT=LUN, IOSTAT=IERR) RETURN END NK FOR I'TH ARG IN CMD C J2 = NEXT (%REF(CLINE), J1, L, ITYP) C C IS IT SLASH? C IF (ITYP .EQ. 47) GO TO 24 IF(ITYP .NE. 1 .AND. ITYP .NE. 2 .AND. ITYP .NE.46) GO TO 10 IF( I .EQ. 1 ) GO TO 48 C C STARTS AS ALPHANUMERIC C J3 = J2 16 J3 = NEXT (%REF(CLINE), J3, L, ITYP) IF (J3 .GT. L) GO TO 20 davel/vms/CPLOTS.XRX;1 644 37 1770 1255 3515016130 7616 C*** SYSTEM: BSNIPS, PROGRAM: CPLOTS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C PLOTXEROX.OLB MEMBER C C VAX/VMS VERSION C C CLOSE THE PLOTTER OR PLOT FILE FOR OUTPUT C C >>>>> THIS ROUTINE MAY BE SYSTEM DEPENDENT <<<<< C C INPUT: C IFILE -- FILE NAME WHICH IS TO BE CLOSED. C LUN -- LOGICAL DEVICE TO CLOSE. C C ENTER VIA: C CALL CPLOTS( X, Y ) C C D. N. ANDERSON -- MARCH 1984 C D. C. LEE -- OCT 1984 C C*************************************************************************** C SUBROUTINE CPLOTS ( IFILE, LUN ) INTEGER*2 IFILE(1), LUN C C <> C CALL PLOTX ( 0., 0., 999 ) ! OLD CALL TO CLOSE OUTPUT FILE C RETURN END IT=LUN, IOSTAT=IERR) RETURN END NK FOR I'TH ARG IN CMD C J2 = NEXT (%REF(CLINE), J1, L, ITYP) C C IS IT SLASH? C IF (ITYP .EQ. 47) GO TO 24 IF(ITYP .NE. 1 .AND. ITYP .NE. 2 .AND. ITYP .NE.46) GO TO 10 IF( I .EQ. 1 ) GO TO 48 C C STARTS AS ALPHANUMERIC C J3 = J2 16 J3 = NEXT (%REF(CLINE), J3, L, ITYP) IF (J3 .GT. L) GO TO 20 davel/vms/CSFIL.FOR;1 644 37 1770 20364 3515016133 7444 ((C.~* SYSTEM: SNIPS, PROGRAM: CSFIL ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C REQUEST INFORMATION TO SET UP A PRINT SORT/SELECTION FILE. THIS FILE C IS USED TO SELECT WHICH WORK ACTIVITIES WILL BE INCLUDED IN THE C REPORTS AND WHICH EXCLUDED. IT ALSO IS USED TO SET UP DIRECTIVES C FOR SORTING THE OUTPUT. (IT HAS NO EFFECT ON THE PRECEDENCE C DIAGRAM WHICH INCLUDES ALL ACTIVITIES WHICH HAVE NOT BEEN C COMPLETED). C C PARAMETERS: C ISFILE(9) - NAME FOR THE FILE TO BE CREATED C IPTST(250) - THE SORT/SELECTION TEST VECTOR; C WORD 1 = NO. OF WORDS IN VECTOR, C WORDS 2-40 = REPLACEMENT 2ND TITLE LINE. WORD 2 C IS ZERO IF NO REPLACEMENT, C WORDS 41-45 = REGULAR SORT DIRECTIVES TO REPLACE C THOSE FOUND IN KST(5), C WORD 46 = NUMBER OF SORT FIELDS WITHIN THE TAG (0-3), C WORDS 47-49 = THREE WORDS FOR SORT FIELD 1 CONTAINING: C 1) LOWER LIMIT ON CHAR. POSITION, C 2) UPPER BOUND ON SORT FIELD, C 3) COLLATING SEQUENCE; C 0 -- ASCENDING ORDER, C -1 -- DESCENDING ORDER, C 1 -- USE THE SPECIAL C COLLATING SEQUENCE C WORDS 50-52 = THREE WORDS FOR TAG SORT FIELD 2, C WORDS 53-55 = THREE WORDS FOR TAG SORT FIELD 3, C WORD 56 = NUMBER OF CHARACTERS IN THE SPECIAL C COLLATING SEQUENCE (IF ANY). MAX. OF 40, C WORDS 57-76 = SPECIAL COLLATING SEQUENCE, C WORD 77 = NUMBER OF SELECTION TESTS, C WORD 78 = 0 TO START SELECTION BY ASSUMING INCLUSION, C 1 TO START BY ASSUMING EXCLUSION, C WORDS 79-250 = PACKETS DESCRIBING THE SELECTION TESTS: C WORD 1 - TYPE OF TEST, C 1 = EXCLUDE ON MATCH, C 0 = INCLUDE ON MATCH, C WORD 2 - START COL. FOR TEST, C WORD 3 - END COL. FOR TEST, C WORD 4 - NO. OF CHARACTERS IN MATCH STRING, C WORD 5+ - TEST STRING (2 CHAR/WORD), C C NO FURTHER TESTS ARE PERFORMED AFTER AN EXCLUDE TEST MATCHES. C AFTER A SUCCESSFUL INCLUDE MATCH THE TESTS WILL BE CONTINUED. C C ENTER VIA: C CALL CSFIL (IPTST, ISFILE) C C SUBROUTINES REQUIRED: REPLY C FUNCTIONS REQUIRED: INDEX C C AUTHOR: D. N. ANDERSON -- LAST MOD: MAR 1977 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C************************************************************************ C SUBROUTINE CSFIL (IPTST, ISFILE) C IMPLICIT INTEGER*2 (I-N) C PARAMETER IPMAX=250 ! MAX SIZE OF SORT/SELECTION VECTOR C EXTERNAL INDEX C INTEGER*2 IPTST(IPMAX), ISFILE(9) C C <> C DO 6 I=1, IPMAX IPTST(I) = 0 6 CONTINUE WRITE (6,10) ISFILE 10 FORMAT('0CONVERSATIONAL MODE TO BUILD OUTPUT SELECTION/SORT', + 'ING DIRECTIVES'/ + ' REQUEST ''HELP'' IF YOU NEED A DESCRIPTION', + ' OF THE RULES'/ + ' THIS DIALOGUE WILL PRODUCE A FILE NAMED: ',9A2) C C GET A REPLACEMENT FOR THE LOWER TITLE C 12 WRITE (6,13) 13 FORMAT ('0ENTER A REPLACEMENT LOWER TITLE (IF DESIRED)', + ' FOR THIS SUB-REPORT?') C CALL REPLY (IPTST(2), L, 78, *12, *14, *14, *14, 0) C GO TO 16 C C DON'T REPLACE LOWER TITLE C 14 IPTST(2) = 0 C C--------------- SECTION TO ENTER SORT DIRECTIVES ----------------------- C C DESCRIBE BASIC SORT OPTIONS C 16 WRITE (6,220) 220 FORMAT ('0----- ENTER DIRECTIVES TO SORT OUTPUT ----------'/ + ' WHEN A SELECTION/SORT FILE IS SPECIFIED ALL OTHER', + ' SORT DIRECTIVES'/ + ' ARE SUPPRESSED. YOU MAY ENTER UP TO 5'/ + ' SORT ITEMS STARTING WITH THE MOST SIGNIFICANT:'/ + 5X,'WORK ACTIVITY TAG ----- 1'/ + 5X,'EARLY START DAY ------- 2'/ + 5X,'EARLY FINISH DAY ------ 3'/ + 5X,'FREE-FLOAT FINISH DAY - 4'/ + 5X,'LATE FINISH DAY ------- 5'/ + ' ITEM 1 MAY BE FURTHER DETAILED IF SELECTED.'/ + ' STOP ENTRY WITH ''END'' OR NULL.') C C LOOP OVER UP TO 5 MAJOR SORT FIELDS C DO 250 I = 1, 5 230 WRITE (6,232) I 232 FORMAT (' NUMBER OF SORT ITEM (1-5) FOR FIELD', I2, '? ', $) C CALL REPLY (IANS, L, -1, *230, *300, *300, *300, 0) C IF (IANS .LT. 1 .OR. IANS .GT. 5) GO TO 230 IPTST (I+40) = IANS IF (IANS .NE. 1) GO TO 250 C C WORK ITEM TAG (SEE ABOUT DETAILED SORTING) C WRITE (6,238) 238 FORMAT (' THE WORK ACTIVITY TAG MAY BE USED AS UP TO', + ' 3 SUBFIELDS'/ + ' IN DETERMINING THE FINAL SORT SEQUENCE. ', + ' THESE 3 SUBFIELDS MAY'/ + ' START AND END AT ANY CHARACTER WITHIN THE', + ' TAG BUT MUST TOTAL'/ + ' NO MORE THAN 10 CHARACTERS. EACH SUBFIELD', + ' MAY BE SORTED IN'/ + ' ASCENDING ASCII SEQUENCE (A, DEFAULT),', + ' DESCENDING ASCII'/ + ' SEQUENCE (D) OR IN A SPECIAL COLLATING', + ' SEQUENCE TO BE ENTERED'/ + ' LATER (S). ANSWER WITH A NULL IF ENTIRE TAG', + ' IS TO BE USED IN'/ + ' ASCENDING ASCII SEQUENCE.') DO 245 J = 1, 3 K = 3 * J + 44 239 WRITE (6,240) J 240 FORMAT (' START COLUMN FOR SUBFIELD',I2,'? ',$) C CALL REPLY (IANS, L, -1, *239, *246, *246, *246, 0) C IF (IANS .LT. 1 .OR. IANS .GT. 10) GO TO 239 IPTST (K) = IANS 241 WRITE (6,242) J 242 FORMAT (' END COLUMN FOR SUBFIELD',I2,'? ',$) C CALL REPLY (IANS, L, -1, *241, *246, *246, *246, 0) C IF (IANS .LT. IPTST(K) .OR. IANS .GT. 10) GO TO 241 IPTST (K+1) = IANS IPTST (46) = IPTST(46) + 1 243 WRITE (6,244) J 244 FORMAT (' COLLATING SEQUENCE FOR SUBFIELD', I2/ 1 ' (A = ASCENDING, D = DESCENDING,', 2 ' S = SPECIAL)? ', $) C CALL REPLY (IANS, L, 1, *243, *245, *245, *245, 0) C IF (INDEX (IANS, 1, 1, %REF('D'), 1, 1) .NE. 0) 1 IPTST(K+2) = -1 IF (INDEX (IANS, 1, 1, %REF('S'), 1, 1) .EQ. 0) GO TO 245 IPTST (K + 2) = 1 IPTST (56) = 1 245 CONTINUE 246 IF (IPTST(56) .EQ. 0) GO TO 250 248 WRITE (6,249) 249 FORMAT (' SPECIAL COLLATING SEQUENCE REQUESTED IN', + ' SORTING WORK TAG.'/ + ' ENTER STRING OF ALL CHARACTERS THAT MAY', + ' OCCUR IN THE FIELD(S)'/ + ' IN THE COLLATING ORDER DESIRED. THE FIRST', + ' CHARACTER ENTERED'/ + ' WILL SORT TO THE TOP OF ALL REPORTS. BLANK', + ' MUST NOT BE THE LAST'/ + ' CHARACTER. ENTER STRING OF UP TO 40 CHARA', + 'CTERS :') C CALL REPLY (IPTST(57), L, 40, *248, *248, *248, *248, 0) C IPTST(56) = L 250 CONTINUE C C--------------- SECTION TO ENTER SELECTION CRITERIA -------------------- C C PRELIMINARY QUESTIONS PERTAINING TO SELECTION TESTS C 300 IP = 79 WRITE (6,322) 322 FORMAT ('0----- ENTER DIRECTIVES TO SELECT ACTIVITIES', + ' FOR OUTPUT -----'/ + ' SHOULD THE SELECTION TESTS START WITH EACH', + ' WORK ACTIVITY (NULL=ALL ACTIVITIES):'/ + 10X,'EXCLUDED FROM THE REPORTS (E), OR'/ + 10X,'INCLUDED(DEFAULT) IN THE REPORTS (I)? ',$) C CALL REPLY (IANS, L, 1, *300, *100, *300, *300, 52) C IF (INDEX (IANS, 1, 1, %REF('E'), 1, 1) .NE. 0) IPTST(78) = 1 C C LOOP OVER ALL TESTS C 30 IPTST (77) = IPTST(77) + 1 IF (IP + 4 .GT. IPMAX) GO TO 99 34 WRITE (6,36) IPTST(77) 36 FORMAT ('0SHOULD TEST #', I3, ' EXCLUDE(E) OR ', + 'INCLUDE(I) ANY WORK'/ + 10X, 'ACTIVITY IT MATCHES? ', $) C CALL REPLY (IANS, L, 1, *34, *100, *100, *100, 74) C IF (INDEX (IANS, 1, 1, %REF('E'), 1, 1) .NE. 0) IPTST(IP) = 1 40 IP = IP + 1 42 WRITE (6,44) 44 FORMAT (' START TESTING FOR A MATCH WITHIN TAG-DESCRIPTION'/ + 10X, 'AT CHARACTER(1-90)? ', $) C CALL REPLY (IPTST(IP), L, -1, *42, *42, *98, *98, 79) C IF (IPTST (IP) .LT. 1 .OR. IPTST(IP) .GT. 90) GO TO 42 IP = IP + 1 50 WRITE (6,52) 52 FORMAT (' STOP TESTING WITH CHARACTER? ', $) C CALL REPLY (IPTST(IP), L, -1, *50, *50, *96, *96, 86) C IF (IPTST(IP) .LT. IPTST(IP-1) .OR. IPTST(IP) .GT. 90) GO TO 50 IP = IP + 1 60 WRITE (6,62) 62 FORMAT (' HOW MANY CHARACTERS IN MATCH STRING', + ' (COUNT BLANKS)? ', $) C CALL REPLY (IPTST(IP), L, -1, *60, *60, *94, *94, 89) C IF (IPTST(IP) .LT. 1) GO TO 60 IF (IPTST(IP) .GT. IPTST(IP-1) - IPTST(IP-2) + 1) GO TO 60 IF (IP + (IPTST(IP) + 1) / 2 .GT. IPMAX) GO TO 84 IP = IP + 1 70 WRITE (6,72) 72 FORMAT (' MATCHING STRING: ', $) C CALL REPLY (IPTST(IP), L, IPTST(IP-1), *70, *70, *92, *92, 93) C IP = IP + (IPTST(IP-1) + 1)/2 GO TO 30 C C ERROR MESSAGE C 84 WRITE (6,86) 86 FORMAT (' *** FILE FULL. LAST TEST OMITTED.') 94 IP = IP - 1 96 IP = IP - 1 98 IP = IP - 1 GO TO 100 92 IP = IP - 4 GO TO 100 99 WRITE (6,101) 101 FORMAT (' *** FILE FULL. NO ROOM FOR MORE TESTS.') C C SEE TOTAL VECTOR LENGTH C 100 IPTST(1) = IP - 1 IPTST(77) = IPTST(77) - 1 WRITE (6,110) IPTST(77) 110 FORMAT ('0', I5, ' SELECTION TEST(S)') RETURN END HART (EXCLUDING THE DRAWING DIMENSIONS GIVEN BY 'SNIPS.IP') WILL BE EXPANDED (FACTORS > 1.0) OR SHRUNK (FACTORS < 1.0) BY THIS FACTOR PRIOR TO PLOTTING. davel/vms/CSNIPS.FOR;2 644 37 1770 5444 3515016137 7572 C.~* SYSTEM: SNIPS, PROGRAM: CSNIPS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PROGRAM TO CALCULATE THE SCHEDULES USING THE INPUT FILES C PREPARED BY 'ESNIPS'. C C COMMAND LINE: C CSNIPS/R /E/C/S C IS THE NAME OF THE SCHEDULE PREPARED C WITH 'ESNIPS'. THIS FILENAME WILL C BE REQUESTED IF IT WAS NOT ENTERED, C IS AN OPTIONAL FILE FOR LISTING THE C SCHEDULE ERRORS, CALENDAR, AND THE C CALCULATED SCHEDULE. IT MUST BE C FOLLOWED BY AT LEAST ONE SWITCH. C IF IT IS NOT PRESENT ERRORS ARE C DIRECTED TO THE CONSOLE AND NO CALENDAR C OR SCHEDULE CALCULATION RESULTS WILL C BE PRINTED. C GLOBAL SWITCHES; C /C SHOW DATES IN COMPANY INTERNAL FORM C /R CAUSES THE SCHEDULE CALCULATION TO BE C BASED ON THE REMAINING DURATIONS C AND THE DATA DATE RATHER THAN THE C ORIGINAL DURATION AND PROJECT START C DATE, C /N PUTS A NO CHARGE ENTRY INTO THE ITEMIZED C BILL FOR THIS RUN, C /((K OMITS ALL BILLING ENTRIES. C LOCAL SWITCHES; C /E DIRECT ERROR MESSAGES TO , C /C PRINT PROJECT CALENDAR ON , C /S PRINT THE RESULTS OF THE SCHEDULE C CALCULATION ON . (AS WELL AS C RECORDING THEM IN THE SCHEDULE FILES FOR C LATER REPORTING). C C REQUIRES THE FILES: C XXXXXX.M1 C XXXXXX.A2 C XXXXXX.D3 C WHERE XXXXXX IS THE NAME OF THE SCHEDULE. C C SUBROUTINES REQUIRED: FIL2P, FILRT, FILTB, PREP2 C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C************************************************************************* C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXPWI=3000 ! MAX. NO. OF P.W.I.'S PARAMETER MAXWKD=3276 ! MAX. NO. OF WORK DAYS C COMMON /CHANN/ FILEM1(9), FILEA2(9), FILED3(9), FILEBI(9) COMMON /SCH01/ IREV(4), FEXTN(12) C INTEGER*2 FILEM1, FILEA2, FILED3, FILEBI, FEXTN INTEGER*2 DT(6), IDEV(9), PWIC(2,MAXPWI), NCDATE(MAXWKD) C DATA IREV/'07','-1','0-','85'/ DATA FEXTN/'.M','1 ',' ','.A','2 ',' ','.D','3 ',' ', + '.B','I ',' '/ C C <> C C CALL PREPARATION ROUTINE TO EXAMINE COMMAND STRING C GET SCHEDULE FILE NAME AND OPEN ALL BUT LISTING FILE. C CALL PREP2 (NAC, NWID, NCDATE, NPEND, NDATAD, IPSTART, IDATAD, + PWIC, IDEV, DT, NEDEV, IREM, IPRNT, ICODTE, IRATE) C IF (IREM .NE. 0) GO TO 140 C C CALCULATE SCHEDULE BASED ON ORIGINAL DURATION C CALL FILTB (NAC, NPEND, PWIC, NEDEV, NCDATE) C GO TO 160 C C CALCULATE SCHEDULE BASED ON REMAINING DURATION C 140 CALL FILRT (NAC, NPEND, NDATAD, PWIC, NEDEV, NCDATE) C C OUTPUT CALENDAR/SCHEDULE IF REQUESTED C 160 CALL FIL2P (IPRNT, NPEND, IDEV, IDATAD, NDATAD, DT, + IREM, NEDEV, ICODTE, IRATE) C END ES. C AFTER A SUCCESSFUL INCLUDE MATCH THE TESTS WILL BE CONTINUED. C C ENTER VIA: C CALL CSFIL (IPTST, ISFILE) C C SUBROUTINES REQUIRED: REPLY C FUNCTIONS REQUIRED: INDEX C C AUTHOR: D. N. ANDERSON -- LAST MOD: MAdavel/vms/CSNIPS.HE;1 644 37 1770 2417 3515016142 7430 1THIS QUESTION SHOULD BE ANSWERED WITH THE NAME OF A SET OF SCHEDULE FILES AS PREPARED USING 'ESNIPS'. THIS PROGRAM MAY ALSO BE STARTED BY PLACING THE NECESSARY PARAMETERS IN THE COMMAND LINE: CSNIPS/R/C /E/C/S IS THE NAME OF THE SCHEDULE PREPARED WITH 'ESNIPS'. IS THE OPTIONAL FILE FOR LISTING; /E THE SCHEDULE ERRORS, /C THE SCHEDULE CALENDAR, /S THE RESULTS OF THE SCHEDULE CALCULATION, (IN ADDITION TO RECORDING THEM IN THE SCHEDULE FILES FOR FORMATTED REPORTING), IF /E IS NOT GIVEN ERRORS WILL BE ON THE TERMINAL, THE GLOBAL SWITCH /R IS USED TO REQUEST THE SCHEDULE CALCULATION BE PREPARED USING REMAINING DURATION AND DATA DATE RATHER THAN ORIGINAL DURATION AND PROJECT START DATE. THE GLOBAL SWITCH /C REQUESTS DATES IN COMPANY SPECIFIC FORM. IF THE COMMAND LINE IS NOT USED THE SCHEDULE NAME WILL BE REQUESTED (AS HAS BEEN DONE THIS RUN) AND THE CALCULATION WILL BE RUN AS IF THE COMMAND LINE WAS: CSNIPS 22 LE. C CALL PREP2 (NAC, NWID, NCDATE, NPEND, NDATAD, IPSTART, IDATAD, + PWIC, IDEV, DT, NEDEV, IREM, IPRNT, ICODTE, IRATE) C IF (IREM .NE. 0) GO TO 140 C C CALCULATE SCHEDULE BASED ON ORIGINAL DURATION C CALL FILTB (NAC, NPEND, PWIdavel/vms/CSNIPS.HP;2 644 37 1770 3236 3515016156 7451 THIS QUESTION SHOULD BE ANSWERED WITH THE NAME OF A SET OF SCHEDULE FILES AS PREPARED USING 'ESNIPS'. THIS PROGRAM MAY ALSO BE STARTED BY PLACING THE NECESSARY PARAMETERS IN THE COMMAND LINE: CSNIPS/R/C /E/C/S IS THE NAME OF THE SCHEDULE PREPARED WITH 'ESNIPS'. IS THE OPTIONAL FILE FOR LISTING; /E THE SCHEDULE ERRORS, /C THE SCHEDULE CALENDAR, /S THE RESULTS OF THE SCHEDULE CALCULATION, (IN ADDITION TO RECORDING THEM IN THE SCHEDULE FILES FOR FORMATTED REPORTING), IF /E IS NOT GIVEN ERRORS WILL BE ON THE TERMINAL, THE GLOBAL SWITCH /R IS USED TO REQUEST THE SCHEDULE CALCULATION BE PREPARED USING REMAINING DURATION AND DATA DATE RATHER THAN ORIGINAL DURATION AND PROJECT START DATE. THE GLOBAL SWITCH /C REQUESTS DATES IN COMPANY SPECIFIC FORM. IF THE COMMAND LINE IS NOT USED THE SCHEDULE NAME WILL BE REQUESTED (AS HAS BEEN DONE THIS RUN) AND THE CALCULATION WILL BE RUN AS IF THE COMMAND LINE WAS: CSNIPS  LENDAR/SCHEDULE IF REQUESTED C 160 CALL FIL2P (IPRNT, NPEND, IDEV, IDATAD, NDATAD, DT, + IREM, NEDEV, ICODTE, IRATE) C END ES. C AFTER A SUCCESSFUL INCLUDE MATCH THE TESTS WILL BE CONTINUED. C C ENTER VIA: C CALL CSFIL (IPTST, ISFILE) C C SUBROUTINES REQUIRED: REPLY C FUNCTIONS REQUIRED: INDEX C C AUTHOR: D. N. ANDERSON -- LAST MOD: MAdavel/vms/DASHP.FOR;1 644 37 1770 5052 3515016165 7425 C.~* SYSTEM: PLOTLIB, PROGRAM: DASHP ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C PLOT A DASHED LINE FROM THE CURRENT PEN POSITION TO A NEW SPECIFIED C POSITION. DASHES WILL BE THE LENGTH SPECIFIED UNLESS THE LINE LENGTH C IS LESS THAN THE SUM OF THE DASH AND THE SPACE. SPACES ARE 2/3 AS LONG C AS THE DASHES. FOR SHORT LINES THE DASH LENGTH IS ADJUSTED SO THAT 1 DASH C PLUS 1 SPACE EQUALS THE LINE LENGTH. BOTH ENDS OF THE LINE WILL BE C WITHIN A DASH. C C INPUT: C X, Y - NEW POSITION TO END THE LINE AT, C DASHL - LENGTH OF THE DASH (INCHES). SPACE BETWEEN DASHES WILL BE C 2/3 OF THIS. C C ENTER VIA: C CALL DASHP (X, Y, DASHL) C C SUBROUTINES REQUIRED: PLOTX, XWHERE C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: AUG 1984 C C**************************************************************************** C SUBROUTINE DASHP (X, Y, DASHL) C PARAMETER SPACEF = 1.666666 ! FACTOR TO GET LENGTH OF DASH + SPACE PARAMETER DEFAULTL = 0.1 ! DEFAULT DASH LENGTH C COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN C INTEGER*2 UP, DOWN ! PEN UP, DOWN COMMANDS C C <> C C SET DASH LENGTH FOR THIS CALL C DL = DASHL IF (DL .LT. 0.005) DL = DEFAULTL ! DEFAULT LENGTH IF TOO SHORT C CALL XWHERE (OLDX, OLDY, DF) ! CURRENT PEN POSITION C DELX = X - OLDX DELY = Y - OLDY TLINE = SQRT (DELX * DELX + DELY * DELY) ! TOTAL LENGTH OF LINE IF (TLINE .LT. SPACEF * DL) DL = TLINE / SPACEF C C FIND LENGTH OF INITIAL DASH C DLS = DL * SPACEF ! LENGTH OF DASH + SPACE DS = DLS - DL ! LENGTH OF SPACE NSEG = TLINE / DLS ! # OF FULL SPACES SEGI = (TLINE - NSEG * DLS + DL) / 2.0 ! LENGTH OF INITIAL DASH C C AXIAL COMPONENTS FOR EACH MOVEMENT C DSX = DELX / TLINE ! X AXIS RATIO DSY = DELY / TLINE ! Y AXIS RATIO DX1 = SEGI * DSX DY1 = SEGI * DSY ! INIT & FINAL SEGMENTS DX2 = DS * DSX DY2 = DS * DSY ! SPACE SEGMENT COMPONENTS DX3 = DL * DSX DY3 = DL * DSY ! FULL DASH COMPONENTS C C PLOT INITIAL SEGMENT C XX = OLDX + DX1 YY = OLDY + DY1 C CALL PLOTX (XX, YY, DOWN) C C INITIAL SPACE C XX = XX + DX2 YY = YY + DY2 C CALL PLOTX (XX, YY, UP) C C LOOP OVER ALL REMAINING PAIRS OF DASHES + SPACES C NSEG = NSEG - 1 IF (NSEG .LE. 0) GO TO 20 DO 10 I = 1, NSEG XX = XX + DX3 YY = YY + DY3 C CALL PLOTX (XX, YY, DOWN) ! PLOT A DASH C XX = XX + DX2 YY = YY + DY2 C CALL PLOTX (XX, YY, UP) ! PLOT A SPACE C 10 CONTINUE C C PLOT THE FINAL SEGMENT C 20 CALL PLOTX (X, Y, DOWN) C RETURN END + ' OF THE RULES'/ + ' THIS DIALOGUE WILL PRODUCE A FILE NAMED: ',9A2) C C GET A REPLACEMENT FOR THE LOWER TITLE C 12 WRITE (6,13) 13 FORMAT ('0ENTER A REPLACEMENT LOWER TITLE (IF DESIRED)', + ' FOR THIS SUB-REPORT?') C CALL REPLY (IPTST(2), L, 78, *12, *14, *14, *14, 0) C GO TO 16 C C DON'T REPLACE LOWER TITLE C 14 IPTST(2) = 0 C C--------------- SECTION TO ENTER SORT DIRECTIVES ----------------------- C C DESCRIBE BASIC SORT OPTIONS C((davel/vms/DATE.FOR;1 644 37 1770 1322 3515016170 7273 C.~* SYSTEM: LIBRARY, PROGRAM: DATE ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C VAX/VMS VERSION C C RETURNS THE SYSTEM DATE. C C OUTPUT: C MDY(3) - THE MONTH, DAY AND YEAR (EG. 12, 31, 83) AS 3 C INTEGER*2 VALUES C IER - DUMMY ARGUMENT TO MATCH D.G. VERSION. ALWAYS 1. C C ENTER VIA: C CALL DATE (MDY, IER) C C SUBROUTINES REQUIRED: IDATE C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1983 C C***************************************************************************** C SUBROUTINE DATE (MDY, IER) C IMPLICIT INTEGER*2 (I-N) INTEGER*2 MDY(3) INTEGER*4 MO, IDY, IYR C C <> C CALL IDATE (MO, IDY, IYR) MDY(1) = MO MDY(2) = IDY MDY(3) = IYR IER = 1 RETURN END C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: AUG 1984 C C**************************************************************************** C SUBROUTINE DASHP (X, Y, DASHL) C PARAMETER SPACEF = 1.666666 ! FACTOR Tdavel/vms/DATET.FOR;1 644 37 1770 4555 3515016173 7435 C.~* SYSTEM: SNIPS, PROGRAM: DATET ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C DATE CONVERSION AND TESTING ROUTINE. ERROR MESSAGES ARE C OUTPUT TO A SPECIFIED UNIT. C C PARAMETERS: C IANS - RESULTING DATE IN DAYS SINCE 1-1-68. C NOT CHANGED IF ERROR WAS DISCOVERED. C DSTR - DATE STRING TO BE CONVERTED. STRING MUST BE IN C FORM: 10 23 78 OR 10/23/78 OR 10-23-78 OR C 10:23:78. FOUR WORDS. C IPSTART - PROJECT START DATE. IF ZERO DO NOT CHECK THIS ONE. C ICSTART - CALENDAR START. ALWAYS CHECKED AGAINST THIS. C NWDPW - NO. OF WORK DAYS PER WEEK. IF THIS IS NOT SEVEN C ANY DATES DISCOVERED ON WEEKENDS WILL BE REJECTED. C IDATAD - DATA DATE. IF NON-ZERO THE DATE BEING TESTED MUST BE C LESS THAN OR EQUAL TO THIS DATE. C NUNIT - OUTPUT CHANNEL NUMBER. C *99 - RETURN IS MADE TO THIS STATEMENT IF ANY ERROR IS C FOUND. ERROR MESSAGES ARE OUTPUT PRIOR C TO THIS RETURN. C C ENTER VIA: C CALL DATET (IANS, DSTR, IPSTART, ICSTART, NWDPW, IDATAD, NUNIT, *99) C C SUBROUTINES REQUIRED: NDAY68 C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C************************************************************************* C SUBROUTINE DATET (IANS, DSTR, IPSTART, ICSTART, NWDPW, IDATAD, 1 NUNIT, *) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 DSTR(4) C C <> C C CONVERT STRING TO DAYS SINCE 1-1-68 CFUN IX = NDAY68 (DSTR, IERR) IF (IERR .NE. 0) GO TO 98 C C TEST AGAINST PROJECT START C IF (IX .LT. IPSTART) GO TO 96 C C TEST AGAINST CALENDAR START C IF (IX .LT. ICSTART) GO TO 94 C C TEST AGAINST WEEKENDS C IF (MOD (IX - ICSTART,7) .GE. NWDPW) GO TO 92 C C TEST AGAINST DATA DATE C IF (IDATAD .LE. 0) GO TO 50 C C ONLY CHECK AGAINST DATA DATE IF IT IS AFTER PROJECT START C IF (IDATAD .LE. IPSTART) GO TO 50 IF (IX .GT. IDATAD) GO TO 90 C C SURVIVED ALL TESTS C 50 IANS = IX RETURN C C ERROR MESSAGE SECTION C 90 WRITE (NUNIT, 91) 91 FORMAT (' *** DATE LATER THAN DATA DATE. REJECTED.') GO TO 100 92 WRITE (NUNIT, 93) 93 FORMAT (' *** DATE ON WEEKEND. REJECTED.') GO TO 100 94 WRITE (NUNIT, 95) 95 FORMAT (' *** DATE BEFORE CALENDAR START. REJECTED.') GO TO 100 96 WRITE (NUNIT, 97) 97 FORMAT (' *** DATE BEFORE PROJECT START. REJECTED.') GO TO 100 98 WRITE (NUNIT, 99) 99 FORMAT (' *** COULDN''T CONVERT DATE STRING.') 100 RETURN 1 ! IER END DOWN) ! PLOT A DASH C XX = XX + DX2 YY = YY + DY2 C CALL PLOTX (XX, YY, UP) ! PLOT A SPACE C 10 CONTINUE C C PLOT THE FINAL SEGMENT C davel/vms/DBAR.FOR;1 644 37 1770 11340 3515016205 7306 C.~* SYSTEM: SNIPS, PROGRAM: DBAR ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PLOT A DATE BAR ON THE CALCOMP PLOTTER C C INPUT: C X - X-COORDINATE OF LOWER LEFT CORNER OF DATE BAR. C Y - Y-COORDINATE C NDP - NUMBER OF DATES TO BE PLOTTED C IFREQ - NUMBER OF WORK DAYS PER PLOTTED DATE (1-7 DAYS) C EACH DATE TAKES UP 0.63" IN UNFACTORED FORM C NCDATE(1000)- WORK DAY TRANSLATION VECTOR. INDEXED BY THE C PROJECT WORK DAY IT CONTAINS THE DATE IN C DAYS SINCE 1-1-68. C EG: NCDATE(1) = DATE (IN DAYS SINCE 1-1-68) C OF THE PROJECTS START C NCDATE(N) = LAST DATE TO PLOT IN DATE C BAR. C NFDAY - NUMBER OF DAY BEFORE 1ST ACTUALLY USED IN THE SUBSET C TO BE PLOTTED C N - NUMBER OF THE LAST WORK DAY TO BE COVERED BY C THE DATE BAR. C ICSTART - CALENDAR START DATE (DAYS SINCE 1-1-68) C IFLIP - 0 TO PUT DAYS IN LOWER HALF OF DATE BAR, C 1 TO PUT DAYS IN UPPER HALF OF DATE BAR. C C ENTER VIA: C CALL DBAR (X, Y, NDP, IFREQ, NCDATE, NFDAY, N, ICSTART, IFLIP) C C SUBROUTINES REQUIRED: LDAY, PLOTX, SYMBLX C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: DEC 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: JUN 1984 C C********************************************************************** C SUBROUTINE DBAR (X, Y, NDP, IFREQ, NCDATE, NFDAY, N, ICSTART, + IFLIP) C IMPLICIT INTEGER*2 (I-N) C COMMON /BAR01/ WHPROP, BH, CH, DOT, DASH, UP, DOWN C INTEGER*2 NCDATE(1), UP, DOWN, STR(5), OLDSTR(5) C C <> C C FIELD WIDTH FOR EACH DATE PLOTTED C FW = 3.0 * CH C C TOTAL BAR HEIGHT C TH = 2.0 * BH C C TOTAL BAR LENGTH C TL = NDP * FW C C PLOT OUTLINE OF BAR C CALL PLOTX (X, Y, UP) C CALL PLOTX (X + TL, Y, DOWN) C CALL PLOTX (X + TL, Y + TH, DOWN) C CALL PLOTX (X, Y + TH, DOWN) C CALL PLOTX (X, Y, DOWN) C C CALC Y-COORD. OF LETTERING C TH2 = TH / 2.0 Y1 = Y + (TH2 - CH) / 2.0 Y2 = Y1 + TH2 Y3 = Y !TIC COORDINATE Y4 = Y - .35 * BH C C CHANGE IF MONTHS ON BOTTOM, DAYS ON TOP C IF (IFLIP .EQ. 0) GO TO 1 XX = Y2 Y2 = Y1 Y1 = XX Y4 = Y + TH Y3 = Y4 + .35 * BH C C SET UP MOVING DAY COORDINATE C 1 XX = X C C X-COORD. OF MONTH BEGINNING C XM1= X OLDSTR(2) = 0 C C WORK DAY COUNTER C ID = NFDAY + 1 C C DAY OFFSET C ADJ = 0.7 * CH C C COUNTER FOR PLOTTED DAYS C I = 1 2 IPT = 1 CALL LDAY (STR, 1, NCDATE(ID)) ID = ID + IFREQ DO 3 J = 2, 5 IF (OLDSTR(J) .NE. STR(J)) GO TO 5 3 CONTINUE C C MONTH AND YEAR STILL THE SAME C GO TO 16 C C CHANGE FOUND IN MONTH-YEAR C FIRST MONTH? C 5 IF (OLDSTR(2) .EQ. 0) GO TO 8 C C CHANGE OF MONTH PLOT MONTH SEPARATOR C 4 XM1=XX C CALL PLOTX (XM1, Y, UP) C CALL PLOTX (XM1, Y + TH, DOWN) C CALL PLOTX (XM1, Y + TH2, UP) C CALL PLOTX (XM, Y + TH2, DOWN) C C ENOUGH ROOM FOR MONTH & YEAR? C IF (XM1 - XM .LT. 7.0 * CH) GO TO 6 C C YES. FIND START POINT C X2 = (XM + XM1) / 2.0 - 4.0 * CH + 0.2 * CH CALL SYMBLX (X2, Y2, CH, OLDSTR(2), 0.0, 7) GO TO 8 C C IS THERE ENOUGH ROOM FOR MONTH ONLY? C 6 IF (XM1 - XM .LT. 4.0 * CH) GO TO 8 C C YES. GET START POINT C X2 = (XM + XM1) / 2.0 - 1.5 * CH + 0.2 * CH C C PLOT MONTH LABEL C CALL SYMBLX (X2, Y2, CH, OLDSTR(2), 0.0, 4) C C RESET TO START NEXT MONTH C 8 IF (I .GT. NDP) GO TO 50 XM = XM1 DO 12 J = 1, 5 12 OLDSTR(J) = STR(J) C C PLOT THE DAY C 16 CALL SYMBLX (XX + ADJ, Y1, CH, STR, 0.0, 2) C XX = XX + FW I = I + 1 IF (I .GT. NDP) GO TO 4 GO TO 2 C C PUT TIC MARKS ALONG DATE BAR AT WEEKLY INTERVALS C 50 XX = X ! LEFT EDGE OF DATE BAR IPDS = 8 ! INIT PREV DAY TO PREVENT IMMED E-O-W ID = NFDAY + 1 ! FIRST PLOTTABLE DAY 52 ICDS = IMOD (NCDATE(ID), 7) ID = ID + IFREQ IF (ICDS .GT. IPDS) GO TO 54 C C FIRST DAY OF A WEEK C C CALL PLOTX (XX, Y3, UP) C CALL PLOTX (XX, Y4, DOWN) C 54 IPDS = ICDS XX = XX + FW IF (ID .LE. N) GO TO 52 RETURN END .LT. 1 .OR. IANS .GT. 10) GO TO 239 IPTST (K) = IANS 241 WRITE (6,242) J 242 FORMAT (' END COLUMN FOR SUBFIELD',I2,'? ',$) C CALL REPLY (IANS, L, -1, *241, *246, *246, *246, 0) C IF (IANS .LT. IPTST(K) .OR. IANS .GT. 10) GO TO 241 IPTST (K+1) = IANS IPTST (46) = IPTST(46) + 1 ((davel/vms/DCLFIX.FOR;1 644 37 1770 1760 3515016210 7530 C.~SYSTEM: BSNIPS, PROGRAM: DCLFIX ****COPYRIGHT 1984 SOFTWARE NORTH******** C C ROUTINE TO FIX A MEMORY OVERWRITE PROBLEM IN SUBROUTINE C BCHART.FOR. C THE OVERWRITE ONLY OCCURS WHEN THE LEGEND BOX IS BEING C PRINTED. THE VARIABLE 'YY' IS EQUAL TO ZERO (0.0) C EVEN WHEN IT SHOULD HAVE A DIFFERENT VALUE. I PUT A C WRITE STATEMENT INTO BCHART.FOR TO WRITE OUT 'YY' AND C THEN THE VARIABLE WAS OK AND PLOTS CAME OUT FINE. C C INPUT: C AYY - A REAL NUMBER PASSED IN C OUTPUT: C BYY - RECEIVES THE VALUE OF AYY C WHICH WAS PASSED IN C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: DAVID C. LEE -- LAST MOD: OCT 1984 C C*************************************************************************** C SUBROUTINE DCLFIX ( AYY, BYY ) C REAL AYY, BYY C C <> C IF ( AYY .EQ. 0.0 ) STOP ' DCLFIX - MEMORY OVERWRITE PROBLEM ' BYY = AYY RETURN END TED C Ndavel/vms/DDNCOM.COM;2 644 37 1770 4473 3515016217 7527 ! $ IF .NOT. P1 .EQS. "" THEN GOTO NEXT $ SET VERIFY !=============================D D N C O M================================= != = != WRITTEN BY D. C. LEE -- OCTOBER 20, 1984 = != = != COMMAND FILE TO COMPILE A SNIPS DDN FORTRAN PLOT SUBROUTINE SOURCE = != FILE TO A FORTRAN OBJECT FILE .. = != ().DDN ---> ().OBJ = != = != ().OBJ STOWED IN PLOTDDN.OLB FOR LATER LINKAGE BY @DDNLIN = != = != = != ***** PRINTOUT ON LPA0 ***** = != = !========================================================================= $ SET NOVERIFY $ INQUIRE PNT "Do you want a compiler listing printed? (Y/N) ...." $ START: $ INQUIRE PROGRAM "Enter name of DDN plot subroutine source module ...." $ GOTO NEXTA $ NEXT: $ PNT = "N" $ PROGRAM = P1 $ NEXTA: $ IF PROGRAM .EQS. "" THEN GOTO L1 $ ON ERROR THEN GOTO L2 $ IF PNT .EQS. "N" THEN GOTO LAB1 $! FORTRAN 'PROGRAM'.DDN /LIST /CROSS_REFERENCE /NOI4- $! /CHECK /SHOW /NOSTANDARD $ FORTRAN 'PROGRAM'.DDN /LIST /CROSS_REFERENCE /NOI4- /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO LAB2 $ LAB1: $! FORTRAN 'PROGRAM'.DDN /NOLIST /DEBUG /CROSS_REFERENCE /NOI4- $! /CHECK /SHOW /NOSTANDARD $ FORTRAN 'PROGRAM'.DDN /NOLIST /DEBUG /CROSS_REFERENCE /NOI4- /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ LAB2: $ LIBRARY/REPLACE PLOTDDN 'PROGRAM' $ DELETE 'PROGRAM'.OBJ.* $ DIR 'PROGRAM'.* $ GOTO START $ L1: $ INQUIRE PNT "Do you want a library directory listing printed? (Y/N) ...." $ IF PNT .NES. "Y" THEN GOTO END $ LIBRARY PLOTDDN /LIST=PLOTDLIST $ PRINT PLOTDLIST /DEVICE=LPA0 /DELETE $ GOTO END $ L2: $ IF PNT .EQS. "N" THEN GOTO START $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO START $ END: $ EXIT !========================================================================= X (X, Y, DOWN) C C CALC Y-COORD. OF LETTERING C TH2 = TH / 2.0 Y1 = Y + (TH2 - CH) / 2.0 Y2 = Y1 + TH2 Y3 = Y !TIC COORDINATE Y4 = Y - .35 * BH C C davel/vms/DDNLIN.COM;1 644 37 1770 1547 3515016221 7524 !================================D D N L I N============================== != = != COMMAND FILE TO LINK THE BSNIPS MAIN OBJECT MODULE WITH THE SN = != LIBRARY AND THE TEKTRONIX DDN INTERFACE PLOT LIBRARY. = != = != AUTHOR: DAVID C. LEE ASA -- 10/18/84 = != = !========================================================================= ! $ LINK/NOMAP/EXECUTABLE=DDNBSNIPS.EXE BSNIPS.OBJ+SN/LIBRARY+- PLOTDDN/LIBRARY+SN/LIBRARY+PLOTDDN/LIBRARY $ DIR DDNBSNIPS.EXE $ SET PROT=(S:RE,W:RE,O:RWED,G:RE) DDNBSNIPS.EXE $ EXIT !========================================================================= = != ***** PRINTOUT ON LPA0 ***** = != davel/vms/DLPWI.FOR;1 644 37 1770 4154 3515016223 7442 C.~* SYSTEM: SNIPS, PROGRAM: DLPWI ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C DELETE ONE ENTRY FROM THE PWI CHAIN. C C PARAMETERS: C PWIC(2,-) - PWI CHAIN; C WORD 1, IF + IT IS THE NUMBER OF THE ACTIVITY C WHICH IS THE PWI, IF NEGATIVE IT IS C A 'DO NOT BEGIN EARLIER THAN' DATE, C IF THIS WORD IF THE TARGET OF A C NEGATIVE POINTER(SEE WORD 2) -- C NEGATIVE INDICATES A LAG FROM C THE START OF A PWI, C POSITIVE INDICATES A LAG FROM C THE END OF THE PWI, C WORD 2, IF POSITIVE IT POINTS TO THE NEXT PWI, C IF NEGATIVE IT POINTS TO AN ENTRY C REPRESENTING A LAG TIME, C IF ZERO IT ENDS THE CHAIN FOR THIS C WORK ITEM, C NPWID - NUMBER OF PWI'S DELETED INTERNAL TO THE MAIN CHAIN, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C IM12(15) - POINTER TO START OF PWI CHAIN FOR THIS WORK ITEM, C IFWD - POINTER TO CHAIN ITEM TO BE DELETED C (UPDATED IN THIS ROUTINE), C IBCK - POINTER TO PREVIOUS CHAIN ITEM(0 = NONE), C NCH12 - MARK TO INDICATE THAT IM12(15) HAS BEEN CHANGED. C C ENTER VIA: C CALL DLPWI (PWIC, NPWID, NPWICH, IM12(15), IFWD, IBCK, NCH12) C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: APR 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C C****************************************************************************** C SUBROUTINE DLPWI (PWIC, NPWID, NPWICH, IM12, IFWD, IBCK, NCH12) C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXPWI=3000 C INTEGER*2 PWIC (2,MAXPWI) C C <> C C COUNT THIS DELETION C NPWID = NPWID + 1 C C MARK ITEM AS DELETED C PWIC(1,IFWD) = 0 C C CHANGE POINTER TO NEXT ENTRY C IFWD = PWIC(2,IFWD) C C ANY LAG ENTRY? C IF (IFWD .GE. 0) GO TO 10 C C LAG FOLLOWS -- DELETE THAT ALSO C IFWD = -IFWD PWIC(1,IFWD) = 0 IFWD = PWIC(2,IFWD) NPWID = NPWID + 1 C C BRIDGE POINTERS AROUND DELETED ENTRY C 10 IF (IBCK .NE. 0) GO TO 16 IM12 = IFWD NCH12 = 0 GO TO 20 16 PWIC (2,IBCK) = IFWD C C ADJUST UPPER LIMIT ON CHAIN IF NECESSARY C 20 IF (PWIC(1,NPWICH) .NE. 0) RETURN NPWICH = NPWICH - 1 NPWID = NPWID - 1 IF (NPWICH .GT. 0) GO TO 20 RETURN END /DELETE $ GOTO END $ L2: $ IF PNT .EQS. "N" THEN GOTO START $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO START $ END: $ EXIT !========================================================================= X (X, Y, DOWN) C C CALC Y-COORD. OF LETTERING C TH2 = TH / 2.0 Y1 = Y + (TH2 - CH) / 2.0 Y2 = Y1 + TH2 Y3 = Y !TIC COORDINATE Y4 = Y - .35 * BH C C davel/vms/DTADTE.FOR;1 644 37 1770 2315 3515016231 7524 C.~* SYSTEM: SNIPS, PROGRAM: DTADTE ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C DISPLAY THE OLD DATA DATE AND ALLOW IT TOBE CHANGED. C C PARAMETERS: C NEW - 1 = NEW DATA SET, 0 = OLD C IDATAD - CURRENT DATA DATE C ICODTE - 0 TO USE REGULAR DATE DISPLAY C 3 TO USE COMPANY SPECIFIC DATE DISPLAY C *100 - RETURN IF 'EXIT' INPUT C C ENTER VIA: C CALL DTADTE (NEW, IDATAD, ICODTE, *100) C C SUBROUTINES REQUIRED: LDAY, REPLY C FUNCTIONS REQUIRED((: NDAY68 C C AUTHOR: D. N. ANDERSON -- LAST MOD: FEB 1980 C MODIFY: J. L.PUTMAN -- LAST MOD: JAN 1984 C C*************************************************************************** C SUBROUTINE DTADTE (NEW, IDATAD, ICODTE, *) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 DTE(5) C C <> C IF (NEW .GT. 0) GO TO 46 CALL LDAY (DTE, ICODTE, IDATAD) C WRITE (6,44) (DTE(I), I = 1, 4) 44 FORMAT (33X,'OLD DATA DATE: ',4A2) 46 WRITE (6,48) 48 FORMAT (' DATA DATE? ',$) C CALL REPLY (DTE, L, 8, *46, *60, *60, *100, 5) C IF (L .LE. 0) GO TO 60 CFUN IDATAD = NDAY68 (DTE, IERR) IF (IERR .NE. 0) GO TO 46 GO TO 70 60 IF (NEW .NE. 0) GO TO 46 70 RETURN 100 RETURN 1 ! IEXIT END NTERNAL TO THE MAIN CHAIN, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C IM12(15) - POINTER TO START OF PWI CHAIN FOR THIS WORK ITEM, C IFWD - POINTER TO CHAIN ITEM TO BE DELETED C (UPDATED IN THIS ROUTINE), C IBCK - POINTER TO PREVIOUS CHAIN ITEM(0 = NONE), C NCH12 - MARK TO INDICATE THAT IM12(davel/vms/ESNIPS.FOR;1 644 37 1770 12547 3515016236 7615 C.~* SYSTEM: SNIPS, PROGRAM: ESNIPS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PROGRAM TO PREPARE/CHANGE THE DATA FILES NECESSARY TO RUNNING C THE SCHEDULE CALCULATION PROGRAM 'CSNIPS'. C C COMMAND LINE: C ESNIPS /S/N/K /L/D C IS THE NAME OF THE SCHEDULE FILE. C UP TO 8 CHARACTERS MAY BE USED IN THE C NAME (NO EXTENSIONS). IF AN EXISTING C FILE OF THIS NAME IS NOT AVAILABLE C 'ESNIPS' WILL ASSUME THAT YOU WISH TO C CREATE A NEW SCHEDULE, C /L/D IS A FILE TO RECIEVE A PRINTED C LIST OF THE SCHEDULE FILES CONTENT. C DEFAULTS TO LPA0 WHEN THE PRINTOUT IS C REQUESTED FROM WITHIN THE PROGRAM. C IF THE /D SWITCH IS ALSO INCLUDED THE C RAW CONTENTS OF THE FILES WILL ALSO BE C DUMPED FOR RECOVERY PURPOSES ( THIS ONLY C OCCURES WHEN ACTIVITIES ARE CHANGED ), C GLOBAL SWITCHES; C /C USE COMPANY INTERNAL DATE FORM IN EDIT PROCESS C /S SUPPRESSES THE LONGER OPERATOR INFORMATION C MESSAGES WHICH APPEAR ON THE TERMINAL, C /N IF A RATE FILE (SNIPS.RT) EXISTS THIS C SWITCH WILL PUT A N/C ENTRY IN THE BILL C FILE FOR THIS SCHEDULE (FILENAME1.BI) C COVERING THE COSTS OF THIS EDITING SESSION, C /K PREVENTS ANY ENTRIES IN THE BILL FILE FOR C THIS SCHEDULE EVEN IF A RATE FILE EXISTS. C /B DUMP DATA IN ----.M1 ON UNIT 4 C C BILLING FILES ARE CREATED AND UPDATED BY DEFAULT ANY TIME A C PROPERLY FORMULATED RATE FILE IS AVAILABLE TO THE SYSTEM (NAMED: C SNIPS.RT). C C ALL ENTRIES ARE MADE IN ANSWER TO QUESTIONS POSED BY THIS C PROGRAM. C C SUBROUTINES REQUIRED: BILL, CHACT, CHCAL, CHEKL, CHPLT, CHTIT, C DTADTE, FILPR, PREP1, REPLY, WRM1 C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: SEP 1984 C C******************************************************************* C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXPWI=3000 ! MAX. NO. OF PREVIOUS WORK ITEMS PARAMETER MAXNAC=2000 ! MAX. NO. OF ACTIVITIES PARAMETER MAXHOL=100 ! MAX. NO. OF HOLIDAYS C COMMON /CHANN/ FILEM1(9), FILEA2(9), FILED3(9), FILEBI(9) C INTEGER*2 FILEM1, FILEA2, FILED3, FILEBI INTEGER*2 IDEV(9), LDEV(9), T1(39), T2(39) INTEGER*2 HOLID(MAXHOL), PWIC(2,MAXPWI) INTEGER*2 TAGLIST(5,MAXNAC), DT(10), MODCU(6) C C <> C C CALL PREPARATION ROUTINE TO EXAMINE COMMAND STRING C GET SCHEDULE FILE NAME AND OPEN ALL BUT LISTING FILE. C CALL PREP1 ( NEW, LSUPP, IDEV, LDEV, DT, ICODTE, IBUG, IRATE, + NAC, NWID, NPWICH, NPWID, PWIC, T1, T2, + IDAILY, ICSTART, IDATAD, NWDPW, NHOL, HOLID, + MODCU, IBARDD, BARFACT, NPHASE, IPSTART, + IPEND, NUPDTE ) C NWACH = 0 ! ZERO THE NO. OF WORK ITEM CHANGES C NUPDTE = NUPDTE + 1 C CALL DTADTE (NEW, IDATAD, ICODTE, *300) C IF (NEW .NE. 0) GO TO 90 80 WRITE (6,82) 82 FORMAT (' TITLE CHANGES(Y/N)? ', $) C CALL REPLY (IANS, L, 0, *80, *100, *300, *300, 9) C IF (IANS .EQ. 0) GO TO 100 C C CHANGE/CREATE TITLES C 90 CALL CHTIT (NEW, T1, T2, *300) C 100 IF (NEW .NE. 0) GO TO 114 102 WRITE (6,104) 104 FORMAT (' CALENDAR CHANGES(Y/N)? ', $) C CALL REPLY (IANS, L, 0, *102, *135, *300, *300, 12) C IF (IANS .EQ. 0) GO TO 135 C C CHANGE/CREATE CALENDAR INFORMATION C 114 CALL CHCAL (NEW, LSUPP, IDAILY, ICSTART, IPSTART, IPEND, NWDPW, 1 NHOL, HOLID, ICODTE, *300) C 135 IF (NEW .NE. 0) GO TO 139 136 WRITE (6,137) 137 FORMAT (' CHANGES TO PLOTTING PARAMETERS(Y/N)? ', $) C CALL REPLY (IANS, L, 0, *136, *140, *300, *300, 173) C IF (IANS .EQ. 0)GO TO 140 C C CHANGE PLOTTING PARAMETERS C 139 CALL CHPLT ( NEW, IBARDD, BARFACT, *300 ) C 140 IF (NEW .NE. 0) GO TO 160 142 WRITE (6,144) 144 FORMAT ('0CHANGES TO WORK ACTIVITIES(Y/N)? ', $) C CALL REPLY (IANS, L, 0, *142, *300, *300, *300, 46) C IF (IANS.EQ.0) GO TO 300 C C CHANGE ACTIVITIES / PRECEDENCE C 160 CALL CHACT (NEW, LSUPP, NAC, TAGLIST, NWID, IDAILY, 1 NPWICH, NPWID, PWIC, IPSTART, ICSTART, 2 NWDPW, IDATAD, IBUG, NWACH, ICODTE, *300) C C CHECK FOR LOGIC LOOPS C CALL CHEKL ( TAGLIST, NAC, PWIC, IERR ) C C RESTORE FILEM1 TO DISK C 300 CALL WRM1 (NAC, NWID, NPWICH, NPWID, PWIC, T1, T2, IDAILY, 1 ICSTART, IDATAD, NWDPW, NHOL, HOLID, 2 MODCU, IBARDD, BARFACT, 3 0, IPSTART, IPEND, NUPDTE) C REWIND 11 C C MARK FILE AS OLD AND ASK IF ANOTHER PASS IS DESIRED C NEW = 0 360 WRITE (6,364) 364 FORMAT ('0THRU EDIT AGAIN (Y/N)? ', $) C CALL REPLY (IANS, L, 0, *360, *380, *380, *380, 110) C IF (IANS .NE. 0) GO TO 80 C C PRINT FILE CONTENTS? C 380 IF (LDEV(1) .EQ. 0 .OR. LDEV(1) .EQ. 9999) GO TO 386 GO TO 389 386 WRITE (6,382) 382 FORMAT ('0PRINT FILE CONTENTS(Y/N)? ', $) C CALL REPLY (IANS, L, 0, *386, *390, *390, *390, 112) C IF (IANS .EQ. 0) GO TO 390 C C YES. PRINT IT. C OPEN (UNIT=4, STATUS='NEW', FILE='ESNIPSDMP.LIS', RECL=160, + DISPOSE='PRINT/DELETE', IOSTAT=IERR) 388 IF (IERR .NE. 0) GO TO 500 C 389 CALL FILPR (NAC, TAGLIST, NWID, NPWICH, NPWID, PWIC, T1, T2, 1 IDAILY, ICSTART, IPSTART, IPEND, IDATAD, NWDPW, NHOL, 2 HOLID, IDEV, DT, MODCU, ICODTE, IBARDD, 3 BARFACT, NUPDTE, NPLNS) C 390 IF (IRATE .EQ. 2) GO TO 500 C C CALL BILLING RECORDER C CALL BILL (1, IRATE, DT, NWACH, NPLNS, FILEBI) C C TERMINATE PROGRAM. 500 END = 1 IPTST (56) = 1 245 CONTINUE 246 IF (IPTST(56) .EQ. 0) GO TO 250 248 WRITE (6,249) 249 FORMAT (' SPECIAL COLLATING SEQUENCE REQUESTED IN', davel/vms/ESNIPS.HE;1 644 37 1770 20544 3515016244 7456 1SCHEDULE NAMES ARE USED TO IDENTIFY EACH SEPARATELY CREATED GROUP OF SCHEDULE INSTRUCTIONS. ENTER THE NAME OF A SCHEDULE YOU HAVE PREVIOUSLY CREATED IF YOU WISH TO CHANGE IT. TO START A NEW SCHEDULE PICK ANY PREVIOUSLY UNUSED NAME OF 9 OR FEWER CHARACTERS. 5THE DATA DATE IS USED TO INDICATE THAT ANY INFORMATION IN THIS FILE WAS CURRENT AS OF THE SPECIFIED DAY. IT IS USED TO ADJUST THE SCHEDULE TO REFLECT ACTUAL PROGRESS WHEN SUCH REPORTING IS REQUESTED. IT HAS NO EFFECT ON THE SCHEDULE IF IT IS BEFORE THE PROJECT START DATE. 9THESE 2 TITLE LINES ARE USED TO LABEL ALL PRINTED AND PLOTTED OUTPUT. EACH LINE MAY BE UP TO 78 CHARACTERS IN LENGTH AND WILL BE CENTERED ON THE REPORTS. 12THIS OPTION PERMITS CHANGES WHICH AFFECT: A) CHOICE OF WEEKS OR DAYS FOR DURATION INPUT, B) WORK DAYS/WEEK, C) CALENDAR START DATE E) PROJECT START DATE D) HOLIDAYS F) PROJECT FINISH DATE 17ACTIVITY DURATIONS AND REMAINING DURATIONS MAY BE ENTERED IN EITHER WEEKS (TO THE NEAREST 1/10 WEEK) OR IN DAYS (TO THE NEAREST 1/10 DAY). WEEKLY INPUT WILL BE CONVERTED TO DAYS FOR REPORTING AND PLOTTING. 20THIS SHOULD BE THE NUMBER OF WORKING DAYS IN THE LONGEST WORK WEEK CONTEMPLATED UNDER THIS PROJECT. MUST BE 7 OR LESS. CALENDAR WEEKS WHICH ARE SHORTER THAN THIS STANDARD ARE CREATED BY DEFINING SOME DAYS AS HOLIDAYS. 24THIS DATE DEFINES BOTH A DATE JUST PRIOR TO THE PROJECT'S START (SO A CALENDAR OF UP TO 1000 WORK DAYS CAN BE CONSTRUCTED), AND THE FIRST DAY OF A NORMAL WORK WEEK. ALL DATE ENTRIES MAY BE ENTERED IN THE FORM 12-31-86, 12 31 86, 12/31/86, 123186 OR 12:31:86. 28ANY DAY WITHIN THE EXPECTED PROJECT SPAN WHICH IS NOT A WEEKEND (AS DEFINED BY THE WORK DAYS/WEEK ENTRY) MAY BE DROPPED FROM THE WORK DAY CALENDAR BY DEFINING IT AS A HOLIDAY. DATE ENTRIES MAY BE OF THE FORMS: 12-31-72, 12/31/84, 1 29 76, 12976 OR 10:3:74. 32 46THIS OPTION PERMITS CHANGES WHICH AFFECT: A) WORK ACTIVITIES PRESENT IN THE SCHEDULE, B) THE TAG USED TO REFER TO EACH ACTIVITY, C) WHETHER AN ACTIVITY IS A BEGIN OR END ACTIVITY, D) EACH ACTIVITY'S DESCRIPTION, E) IT'S DURATION, F) IT'S REMAINING DURATION OR % COMPLETE, G) WHICH ACTIVITIES MUST PRECEED IT, . 55IF YOU SPECIFY THAT(( NO ACTIVITIES ARE TO BE ADDED OR DELETED THESE OPTIONS WILL BE PREVENTED, EVEN IF ERRONEOUS ENTRIES ARE MADE. 57IF YOU REFUSE THIS OPTION THE BEGIN ITEM/END ITEM FLAG AND THE WORK ITEM DESCRIPTIONS MAY NOT BE CHANGED. REQUESTS FOR THESE CHANGES ARE SUPPRESSED. 60REFUSING THIS OPTION PREVENTS DURATION PROMPTS FOR EACH WORK ACTIVITY. 61REMAINING DURATIONS ARE RELEVANT ONLY IF SCHEDULES ARE TO BE PRODUCED WHICH RECORD WORK PROGRESS. IF THIS SCHEDULE IS CURRENTLY A PLANNING SCHEDULE (WITHOUT A RECORDING OF ACTUAL PROGRESS) SELECT OPTION #1. 64REFUSE THIS OPTION IF NO PRECEDENCE CHANGES ARE ANTICIPATED ON THIS PASS SO THE PROMPTS FOR THIS FEATURE WILL BE SUPPRESSED. 66 68ACTIVITY TAGS ARE LIMITED TO 10 CHARACTERS. FOR LARGE SCHEDULES THEY SHOULD CONTAIN SOME UNIQUE CHARACTER(S) WHICH MAY BE USED TO SUBDIVIDE THE SCHEDULE INTO USEFUL SUB-SCHEDULES. SINCE REPORTS MAY BE PRINTED OR PLOTTED IN ALPHABETICAL TAG ORDER THAT SHOULD ALSO BE CONSIDERED IN SELECTING A TAG. TYPE "LIST" TO SEE ALL THE WORK ACTIVITY TAGS. 73A 'Y' ANSWER TO THIS QUESTION WILL MAKE IT POSSIBLE TO CHANGE WORK ACTIVITY TAGS ON EXISTING WORK ITEMS. 75THE NEW TAG WILL REPLACE THE PREVIOUS TAG BUT RETAIN ALL OF THE WORK ACTIVITIES FORMER ATTRIBUTES. 77ACTIVITY DESCRIPTIONS MAY BE UP TO 79 CHARACTERS IN LENGTH. THESE DESCRIPTIONS WILL BE SPLIT INTO LINES OF 28 CHARACTERS OR LESS FOR OUTPUT AND PLOTTING. SINCE MOST OUTPUT CAN BE LIMITED TO 1 OR 2 LINES THE MOST CRITICAL INFORMATION SHOULD OCCUR EARLY IN EACH DESCRIPTION. A [M] WILL CAUSE THIS ACTIVITY TO BE MARKED AS A MILESTONE. 82 17 83 83ENTERING A ZERO DURATION WILL DELETE THIS WORK ACTIVITY. 84VALUES LONGER THAN DURATION WILL BE REJECTED AND A NEW DUR. REQUESTED. 85PERCENT OF WORK ACTIVITY COMPLETE MAY BE ANY WHOLE NUMBER BETWEEN 0 AND 100. IT WILL BE USED TO FIND THE REMAINING DURATION OF A WORK ACTIVITY FOR USE IN SCHEDULE CALCULATION, UNLESS PROGRESS REPORTING IS SUPRESSED 88A 'Y' ANSWER TO THIS QUESTION WILL DELETE THE SPECIFIED ACTIVITY FROM THE CURRENT ACTIVITY'S LIST OF PREVIOUS WORK ACTIVITIES. A 'N' OR NUL ANSWER WILL CAUSE THIS ACTIVITY TO BE RETAINED AS A WORK ITEM WHOSE COMPLETION IS REQUIRED BEFORE THE CURRENT WORK ACTIVITY MAY START. AFTER ALL EXISTING P.W.A.'S HAVE BEEN REVIEWED A CHANCE TO ADD NEW ONES WILL BE OFFERED. 94PREVIOUS WORK ACTIVITIES (THOSE ITEMS WHICH MUST BE COMPLETED BEFORE THIS ACTIVITY CAN BE STARTED) ARE ENTERED BY GIVING THEIR WORK ACTIVITY TAGS. STOP ENTRIES FOR THIS WORK ITEM BY ENTERING 'END' OR NUL. NOT-EARLIER-THAN-START DATE AND LAGS ARE ALSO SUPPORTED. LAGS MAY BE FROM EITHER THE END OF A PREVIOUS WORK ACTIVITY OR FROM ITS START. SEE MANUAL FOR CAUTIONARY NOTE ON LAGS FROM AN ACTIVITIES START. EXAMPLES OF VALID ENTRIES ARE: TAG5 12-15-81 TAG3 + 3.2 (3.2 DAYS OF LAG FROM FINISH OF PWA) TAG4+5S (5 DAYS OF LAG FROM START OF TAG4) 105 110A 'Y' ANSWER WILL PERMIT FURTHER CHANGES TO THIS SCHEDULE BEFORE IT IS PRINTED AND BEFORE YOU LEAVE THE EDITING PROGRAM. 112A FORMATED LIST OF THIS SCHEDULE'S CONTENTS MAY BE PRINTED IF DESIRED. THIS LIST MAY THEN BE USED TO MARK REVISIONS FOR FURTHER RUNS. 114 164THIS DETERMINES THE WIDTH OF EACH PLOTTED CHART PAGE SINCE EACH PLOTTED DATE REQUIRES ABOUT 0.21" (WHEN FACTOR IS 1.0). 166ALL PLOT FEATURES CAN BE EXPANDED OR CONTRACTED AS THIS VALUE DIFFERS FROM 100%. RANGE IS LIMITED TO 50 T0 300 FOR LEGIBILITY. THIS FACTOR DOES NOT AFFECT MAX. PLOT LENGTH AND WIDTH ENTERED EARLIER, SINCE THEY DESCRIBE THE MAX. PHYSICAL DIMENSIONS OF THE FINISHED CHARTS. 170 173THIS OPTION PERMITS CHANGING A NUMBER OF PARAMETERS RELATED TO: 1) THE PHYSICAL SIZE OF THE PLOTS AND THEIR SCALE, 2) THE INFORMATION TO BE INCLUDED IN THE PRECEDENCE DIAGRAMS, 3) THE NUMBER OF PENS AVAILABLE ON THE PLOTTER AT ONE TIME, 4) THE LEVEL OF DETAIL TO BE SHOWN ON THE PLOTS. 178THE PROJECT START DATE (IN THE FORM MM-DD-YY) IS THE DAY ON WHICH THE FIRST ACTIVITIE(S) MAY BE STARTED. IT MUST FOLLOW THE CALENDAR START DATE. 181THE PROJECT COMPLETION DATE IS USED TO CALCULATE THE REQUIRED FINISH TIME FOR EACH ACTIVITY. IF LESS THAN THE TIME REQUIRED BY THE SCHEDULE IT WILL BE BUMPED UP TO THE MINIMUM REQUIRED TIME. IF IT IS LONGER THAN REQUIRED THE FLOAT TIMES AND THE LATE FINISH SCHEDULE WILL REFLECT THIS. ENTER ZERO IF THE SCHEDULE SHOULD BE CALCULATED FOR MINIMUM ELAPSED TIME. 187THE ACTUAL START DATE IS USED TO SCHEDULE ACTIVITIES ON WHICH WORK HAS BEEN STARTED RATHER THAN USE ONLY THE PRECEDENCE RELATIONSHIPS. THIS DATE IS USED ONLY WHEN SCHEDULE CALCULATIONS ARE BASED ON REMAINING DURATION. IT IS IGNORED FOR ALL SCHEDULES BASED ON ORIGINAL DURATION. FOR ACTIVITIES WHICH ALSO HAVE ACTUAL FINISH DATES, IT IS USED TO REPORT PROGRESS ON THE COMPLETED PORTION OF THE SCHEDULE. 193THE ACTUAL FINISH DATE IS USED TO REPORT PROGRESS ON THOSE WORK ACTIVITIES WHICH ARE CURRENTLY COMPLETE. IT IS USED ONLY WHEN A SCHEDULE BASED ON REMAINING DURATION IS BEING CALCULATED. 196 ERS :') C CALL REPLY (IPTST(57), L, 40, *248, *248, *248, *248, 0) C IPTST(56) = L 250 CONTINUE C C--------------- SECTION TO ENTER SELECTION CRITERIA -davel/vms/ESNIPS.HP;2 644 37 1770 35247 3515016256 7503 SCHEDULE NAMES ARE USED TO IDENTIFY EACH SEPARATELY CREATED GROUP OF SCHEDULE INSTRUCTIONS. ENTER THE NAME OF A SCHEDULE YOU HAVE PREVIOUSLY CREATED IF YOU WISH TO CHANGE IT. TO START A NEW SCHEDULE PICK ANY PREVIOUSLY UNUSED NAME OF 9 OR FEWER CHARACTERS. THE DATA DATE IS USED TO INDICATE THAT ANY INFORMATION IN THIS FILE WAS CURRENT AS OF THE SPECIFIED DAY. IT IS USED TO ADJUST THE SCHEDULE TO REFLECT ACTUAL PROGRESS WHEN SUCH REPORTING IS REQUESTED. IT HAS NO EFFECT ON THE SCHEDULE IF IT IS BEFORE THE PROJECT START DATE. THESE 2 TITLE LINES ARE USED TO LABEL ALL PRINTED AND PLOTTED OUTPUT. EACH LINE MAY BE UP TO 78 CHARACTERS IN LENGTH AND WILL BE CENTERED ON THE REPORTS. THIS OPTION PERMITS CHANGES WHICH AFFECT: A) CHOICE OF WEEKS OR DAYS FOR DURATION INPUT, B) WORK DAYS/WEEK, C) CALENDAR START DATE E) PROJECT START DATE D) HOLIDAYS F) PROJECT FINISH DATE ACTIVITY DURATIONS AND REMAINING DURATIONS MAY BE ENTERED IN EITHER WEEKS (TO THE NEAREST 1/10 WEEK) OR IN DAYS (TO THE NEAREST 1/10 DAY). WEEKLY INPUT WILL BE CONVERTED TO DAYS FOR REPORTING AND PLOTTING. THIS SHOULD BE THE NUMBER OF WORKING DAYS IN THE LONGEST WORK WEEK CONTEMPLATED UNDER THIS PROJECT. MUST BE 7 OR LESS. CALENDAR WEEKS WHICH ARE SHORTER THAN THIS STANDARD ARE CREATED BY DEFINING SOME DAYS AS HOLIDAYS. THIS DATE DEFINES BOTH A DATE JUST PRIOR TO THE PROJECT'S START (SO A CALENDAR OF UP TO 1000 WORK DAYS CAN BE CONSTRUCTED), AND THE FIRST DAY OF A NORMAL WORK WEEK. ALL DATE ENTRIES MAY BE ENTERED IN THE FORM 12-31-86, 12 31 86, 12/31/86, 123186 OR 12:31:86. ANY DAY WITHIN THE EXPECTED PROJECT SPAN WHICH IS NOT A WEEKEND (AS DEFINED BY THE WORK DAYS/WEEK ENTRY) MAY BE DROPPED FROM THE WORK DAY CALENDAR BY DEFINING IT AS A HOLIDAY. DATE ENTRIES MAY BE OF THE FORMS: 12-31-72, 12/31/84, 1 29 76, 12976 OR 10:3:74. .THIS OPTION PERMITS CHANGES WHICH AFFECT: A) WORK ACTIVITIES PRESENT IN THE S((CHEDULE, B) THE TAG USED TO REFER TO EACH ACTIVITY, C) WHETHER AN ACTIVITY IS A BEGIN OR END ACTIVITY, D) EACH ACTIVITY'S DESCRIPTION, E) IT'S DURATION, F) IT'S REMAINING DURATION OR % COMPLETE, G) WHICH ACTIVITIES MUST PRECEED IT, . 7IF YOU SPECIFY THAT NO ACTIVITIES ARE TO BE ADDED OR DELETED THESE OPTIONS WILL BE PREVENTED, EVEN IF ERRONEOUS ENTRIES ARE MADE. 9IF YOU REFUSE THIS OPTION THE BEGIN ITEM/END ITEM FLAG AND THE WORK ITEM DESCRIPTIONS MAY NOT BE CHANGED. REQUESTS FOR THESE CHANGES ARE SUPPRESSED. <REFUSING THIS OPTION PREVENTS DURATION PROMPTS FOR EACH WORK ACTIVITY. =REMAINING DURATIONS ARE RELEVANT ONLY IF SCHEDULES ARE TO BE PRODUCED WHICH RECORD WORK PROGRESS. IF THIS SCHEDULE IS CURRENTLY A PLANNING SCHEDULE (WITHOUT A RECORDING OF ACTUAL PROGRESS) SELECT OPTION #1. @REFUSE THIS OPTION IF NO PRECEDENCE CHANGES ARE ANTICIPATED ON THIS PASS SO THE PROMPTS FOR THIS FEATURE WILL BE SUPPRESSED. B DACTIVITY TAGS ARE LIMITED TO 10 CHARACTERS. FOR LARGE SCHEDULES THEY SHOULD CONTAIN SOME UNIQUE CHARACTER(S) WHICH MAY BE USED TO SUBDIVIDE THE SCHEDULE INTO USEFUL SUB-SCHEDULES. SINCE REPORTS MAY BE PRINTED OR PLOTTED IN ALPHABETICAL TAG ORDER THAT SHOULD ALSO BE CONSIDERED IN SELECTING A TAG. TYPE "LIST" TO SEE ALL THE WORK ACTIVITY TAGS. IA 'Y' ANSWER TO THIS QUESTION WILL MAKE IT POSSIBLE TO CHANGE WORK ACTIVITY TAGS ON EXISTING WORK ITEMS. KTHE NEW TAG WILL REPLACE THE PREVIOUS TAG BUT RETAIN ALL OF THE WORK ACTIVITIES FORMER ATTRIBUTES. MACTIVITY DESCRIPTIONS MAY BE UP TO 79 CHARACTERS IN LENGTH. THESE DESCRIPTIONS WILL BE SPLIT INTO LINES OF 28 CHARACTERS OR LESS FOR OUTPUT AND PLOTTING. SINCE MOST OUTPUT CAN BE LIMITED TO 1 OR 2 LINES THE MOST CRITICAL INFORMATION SHOULD OCCUR EARLY IN EACH DESCRIPTION. A [M] WILL CAUSE THIS ACTIVITY TO BE MARKED AS A MILESTONE. R 17 83 SENTERING A ZERO DURATION WILL DELETE THIS WORK ACTIVITY. TVALUES LONGER THAN DURATION WILL BE REJECTED AND A NEW DUR. REQUESTED. UPERCENT OF WORK ACTIVITY COMPLETE MAY BE ANY WHOLE NUMBER BETWEEN 0 AND 100. IT WILL BE USED TO FIND THE REMAINING DURATION OF A WORK ACTIVITY FOR USE IN SCHEDULE CALCULATION, UNLESS PROGRESS REPORTING IS SUPRESSED XA 'Y' ANSWER TO THIS QUESTION WILL DELETE THE SPECIFIED ACTIVITY FROM THE CURRENT ACTIVITY'S LIST OF PREVIOUS WORK ACTIVITIES. A 'N' OR NUL ANSWER WILL CAUSE THIS ACTIVITY TO BE RETAINED AS A WORK ITEM WHOSE COMPLETION IS REQUIRED BEFORE THE CURRENT WORK ACTIVITY MAY START. AFTER ALL EXISTING P.W.A.'S HAVE BEEN REVIEWED A CHANCE TO ADD NEW ONES WILL BE OFFERED. ^PREVIOUS WORK ACTIVITIES (THOSE ITEMS WHICH MUST BE COMPLETED BEFORE THIS ACTIVITY CAN BE STARTED) ARE ENTERED BY GIVING THEIR WORK ACTIVITY TAGS. STOP ENTRIES FOR THIS WORK ITEM BY ENTERING 'END' OR NUL. NOT-EARLIER-THAN-START DATE AND LAGS ARE ALSO SUPPORTED. LAGS MAY BE FROM EITHER THE END OF A PREVIOUS WORK ACTIVITY OR FROM ITS START. SEE MANUAL FOR CAUTIONARY NOTE ON LAGS FROM AN ACTIVITIES START. EXAMPLES OF VALID ENTRIES ARE: TAG5 12-15-81 TAG3 + 3.2 (3.2 DAYS OF LAG FROM FINISH OF PWA) TAG4+5S (5 DAYS OF LAG FROM START OF TAG4) i nA 'Y' ANSWER WILL PERMIT FURTHER CHANGES TO THIS SCHEDULE BEFORE IT IS PRINTED AND BEFORE YOU LEAVE THE EDITING PROGRAM. pA FORMATED LIST OF THIS SCHEDULE'S CONTENTS MAY BE PRINTED IF DESIRED. THIS LIST MAY THEN BE USED TO MARK REVISIONS FOR FURTHER RUNS. r THIS DETERMINES THE WIDTH OF EACH PLOTTED CHART PAGE SINCE EACH PLOTTED DATE REQUIRES ABOUT 0.21" (WHEN FACTOR IS 1.0). ALL PLOT FEATURES CAN BE EXPANDED OR CONTRACTED AS THIS VALUE DIFFERS FROM 100%. RANGE IS LIMITED TO 50 T0 300 FOR LEGIBILITY. THIS FACTOR DOES NOT AFFECT MAX. PLOT LENGTH AND WIDTH ENTERED EARLIER, SINCE THEY DESCRIBE THE MAX. PHYSICAL DIMENSIONS OF THE FINISHED CHARTS. THIS OPTION PERMITS CHANGING A NUMBER OF PARAMETERS RELATED TO: 1) THE PHYSICAL SIZE OF THE PLOTS AND THEIR SCALE, 2) THE INFORMATION TO BE INCLUDED IN THE PRECEDENCE DIAGRAMS, 3) THE NUMBER OF PENS AVAILABLE ON THE PLOTTER AT ONE TIME, 4) THE LEVEL OF DETAIL TO BE SHOWN ON THE PLOTS. THE PROJECT START DATE (IN THE FORM MM-DD-YY) IS THE DAY ON WHICH THE FIRST ACTIVITIE(S) MAY BE STARTED. IT MUST FOLLOW THE CALENDAR START DATE. THE PROJECT COMPLETION DATE IS USED TO ((CALCULATE THE REQUIRED FINISH TIME FOR EACH ACTIVITY. IF LESS THAN THE TIME REQUIRED BY THE SCHEDULE IT WILL BE BUMPED UP TO THE MINIMUM REQUIRED TIME. IF IT IS LONGER THAN REQUIRED THE FLOAT TIMES AND THE LATE FINISH SCHEDULE WILL REFLECT THIS. ENTER ZERO IF THE SCHEDULE SHOULD BE CALCULATED FOR MINIMUM ELAPSED TIME. THE ACTUAL START DATE IS USED TO SCHEDULE ACTIVITIES ON WHICH WORK HAS BEEN STARTED RATHER THAN USE ONLY THE PRECEDENCE RELATIONSHIPS. THIS DATE IS USED ONLY WHEN SCHEDULE CALCULATIONS ARE BASED ON REMAINING DURATION. IT IS IGNORED FOR ALL SCHEDULES BASED ON ORIGINAL DURATION. FOR ACTIVITIES WHICH ALSO HAVE ACTUAL FINISH DATES, IT IS USED TO REPORT PROGRESS ON THE COMPLETED PORTION OF THE SCHEDULE. THE ACTUAL FINISH DATE IS USED TO REPORT PROGRESS ON THOSE WORK ACTIVITIES WHICH ARE CURRENTLY COMPLETE. IT IS USED ONLY WHEN A SCHEDULE BASED ON REMAINING DURATION IS BEING CALCULATED. SCHEDULE (WITHOUT A RECORDING OF ACTUAL PROGRESS) SELECT OPTION #1. @REFUSE THIS OPTION IF NO PRECEDENCE CHANGES ARE ANTICIPATED ON THIS PASS SO THE PROMPTS FOR THIS FEATURE WILL BE SUPPRESSED. B davel/vms/EXLFS.FOR;2 644 37 1770 11772 3515016265 7477 C*** SYSTEM: SNIPS, PROGRAM: EXLFS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C EXPAND ANY LAGS-FROM-START THAT ARE CONTAINED IN THE P.W.A. CHAIN C INTO LAGS FROM THE END OF THE ACTIVITIES MENTIONED BY THE TARGET ACTIVITY C ACTIVITY AS P.W.A'S. C C INPUT: C NAC - NUMBER OF ACTIVITIES (COUNTING INCLUDED DELETIONS) C PWIC(2,-) - PWI CHAIN; C WORD 1, IF + IT IS THE NUMBER OF THE ACTIVITY C WHICH IS THE PWI, IF NEGATIVE IT IS C A "DO NOT BEGIN EARLIER THAN" DATE, C IF THIS WORD IF THE TARGET OF A C NEGATIVE POINTER(SEE WORD 2) -- C NEGATIVE INDICATES A LAG FROM C THE START OF A PWI, C POSITIVE INDICATES A LAG FROM C THE END OF THE PWI, C WORD 2, IF POSITIVE IT POINTS TO THE NEXT PWI, C IF NEGATIVE IT POINTS TO AN ENTRY C REPRESENTING A LAG TIME, C IF ZERO IT ENDS THE CHAIN FOR THIS C WORK ITEM, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C NPWID - NUMBER OF PWI'S DELETED INTERNAL TO THE MAIN CHAIN, C IPSTART - PROJECT START DATE C NCDATE - DATE TRANSLATION ARRAY, C MAXWKD - MAX. NUMBER OF DAYS IN 'NCDATE' C C OUTPUT: C PWIC(2,-) - (AS MODIFIED BY THIS ROUTINE) C NPWICH - ( " ) C NPWID - ( " ) C C ENTER VIA: C CALL EXLFS( NAC, PWIC, NPWICH, NPWID, IPSTART, NCDATE, MAXWKD ) C C C SUBROUTINES USED: INPWI C FUNCTIONS USED: (NONE) C C C AUTHOR: D. N. ANDERSON -- DECEMBER 1984 C MODIFY: D. C. LEE -- JANUARY 1985 VAX VMS/UNIX C C******************************************************************* C SUBROUTINE EXLFS( NAC, PWIC, NPWICH, NPWID, IPSTART, + NCDATE, MAXWKD ) C IMPLICIT INTEGER*2 (I-N) C PARAMETER (MAXNAC=2000) C MAX. NO. OF ACTIVITIES PARAMETER (MAXPWI=3000) C MAX. NO. OF PREV. WORK ITEMS C INTEGER*2 I15(MAXNAC), IM12(16), PWIC(2,MAXPWI) INTEGER*2 NCDATE(MAXWKD) C C <> C C READ POINTERS TO P.W.A. CHAIN FOR EVERY ACTIVITY C DO 10 I=1, NAC READ( 12, REC=I ) IM12 I15(I) = IM12(1) IF( I15(I) .EQ. 0 ) GOTO 10 C DELETED ACTIVITY I15(I) = IM12(15) C POINTER TO 1ST P.W.A. 10 CONTINUE C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C TRAVERSE EACH ACTIVITIES ENTRIES IN THE P.W.A. CHAIN C AND REPLACE ANY LAG-FROM START ENTRIES. C DO 50 I = 1, NAC 18 IFWD = I15(I) IBCK = 0 20 IF( IFWD .EQ. 0 ) GOTO 50 C NO CHAIN OR COMPLETE IF( IFWD .GT. 0 ) GOTO 22 WRITE(6,21) I 21 FORMAT(' ERROR IN PWI CHAIN FOR ACTIVITY:',I5) GOTO 50 22 NPWI = PWIC(1,IFWD) C PWI / NOT-EARLIER-THAN START IPTR = PWIC(2,IFWD) C POINTER TO NEXT PWI / LAG IF( IPTR .LT. 0 ) GOTO 26 C HAS A LAG. C C REGULAR P.W.A OR NOT-EARLIER-THAN START DATE (SKIP OVER) IBCK = IFWD IFWD = IPTR GOTO 20 C C LAG 26 IPTR = -IPTR IF( PWIC(1,IPTR) .LT. 0 ) GOTO 30 C C LAG FROM A P.W.A (SKIP IT) IBCK = IPTR IFWD = PWIC(2,IPTR) GOTO 20 C C LAG FROM START OF 'NPWI' (MUST BE DELETED AND REPLACED C BY 'NPWI'S P.W.A'S PLUS THE LAG) C 30 LAG = -PWIC(1,IPTR) C C MOVE ENTRIES DOWN TO DELETE LAG-FROM-START, AND C POSITION POINTERS TO END OF CHAIN FOR ADDITIONS C NPWID = NPWID + 2 IMID = PWIC(2,IPTR) PWIC(1,IPTR) = 0 PWIC(2,IPTR) = 0 IF( IMID .EQ. 0 ) GOTO 37 34 PWIC(1,IFWD) = PWIC(1,IMID) PWIC(2,IFWD) = IMID IF( PWIC(2,IMID) .LT. 0 ) PWIC(2,IFWD) = -IMID IBCK = IFWD IFWD = IMID IMID = PWIC(2,IFWD) IF( IMID ) 35, 36, 34 35 IMID = -IMID GOTO 34 C C DELETE FINAL FRAME 36 PWIC(2,IBCK) = 0 37 PWIC(1,IFWD) = 0 PWIC(2,IFWD) = 0 C C NOW COLLECT ENTRIES FROM THE REFERENCED P.W.A. C I1 = I15(NPWI) C DOES TARGET HAVE ANY P.W.A.'S AT ALL? IF( I1 .GT. 0 ) GOTO 40 C YES C CREATE A NOT-EARLIER-THAN START USING PROJECT START DATE IC1 = 1 + (LAG+5)/10 IC1 = -NCDATE( IC1 ) IC2 = 0 GOTO 48 C C LOOP OVER ALL OF THE TARGETS P.W.A.'S C 40 IF( I1 .LE. 0 ) GOTO 18 C REVIEW THIS ACTIVITY AGAIN C C ANOTHER P.W.A. - EXTRACT INFO AND PREPARE TO MOVE TO C ACTIVITY 'I' NP1 = PWIC(1,I1) IC1 = NP1 NP2 = PWIC(2,I1) I1 = NP2 IF( NP1 .GE. 0 ) GOTO 42 C C MOVE OVER A NOT-EARLIER-THAN START IC1 = N68WD( -NP1, NCDATE, MAXWKD ) IC1 = IC1 + (LAG+5)/10 IC1 = -NCDATE( IC1 ) IC2 = 0 GOTO 48 C C DOES IT HAVE A LAG? 42 IF( NP2 .LT. 0 ) GOTO 44 C C NO. MOVE OVER A REGULAR P.W.A. IC2 = LAG GOTO 48 C C IST A LAG. 44 NP2 = -NP2 L2 = PWIC(1,NP2) I1 = PWIC(2,NP2) C IS IT A LAG-FROM-START? IF( L2 .LT. 0 ) GOTO 46 C YES. C C MOVE ACROS A LAG FROM P.W.A. IC2 = L2 + LAG GOTO 48 C C MOVE ACROSS A LAG-FROM-START 46 IC2 = L2 - LAG C C INSERT THE NEW P.W.A. ENTRY IN ACTIVITY I'S CHAIN C 48 IF( IBCK .EQ. 0 ) GOTO 49 CALL INPWI( PWIC, NPWID, NPWICH, I15(I), IBCK, NCH12, IC1, IC2 ) GOTO 40 C MAKE SURE NO CHANGE IS NECESSARY IN ACTIVITIES PWI PTR 49 PWIC(1,IFWD) = IC1 PWIC(2,IFWD) = 0 NPWID = NPWID - 1 IF( IC2 .EQ. 0 ) GOTO 40 NPWID = NPWID - 1 PWIC(1,IPTR) = IC2 PWIC(2,IPTR) = 0 PWIC(2,IFWD) = -IPTR IBCK = IPTR GOTO 40 C 50 CONTINUE C RETURN END r C CSCALE = FCTR C RETURN END OINTER(SEE WORD 2) -- C NEGATIVE INDICATES A LAG FROM C THE START OF A PWI, C POSITIVE INDICATES A LAG FROM C THE END OF THE PWI, C WORD 2, IF POSITIVE IT POINTS TO THE NEXT PWI, C IF NEGATIVE IT POINTS TO AN ENTRY C REPRESENTING A LAG TIME, C IF ZERO IT ENDS THE CHAIN FOR THIS C WORK ITEM, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C NPWID - NUMBER OF PWI'S DELETED INTERNAL TO THE MAIN CHAIN, C IPSTART - PROJECT START DATE C NCDATE -davel/vms/FACTRX.PLO;1 644 37 1770 1247 3515016277 7567 ((C.~SYSTEM: BSNIPS, PROGRAM: FACTRX ****COPYRIGHT 1984 SOFTWARE NORTH****** C C SUBROUTINE TO INTERFACE THE INSTALLATIONS PLOT LIBRARY WITH SNIPS. C ENLARGES OR SHRINKS THE SIZE OF THE PLOT BY CHANGING THE RATIO OF THE C PLOT SIZES. C C PLOT LIBRARY - CALCOMP 32-BIT SOFTWARE C C INPUT: C FACT - RATIO OF THE DESIRED PLOT SIZE TO THE NORMAL PLOT SIZE. C C SUBROUTINES REQUIRED: FACTOR(CALCOMP) C C AUTHOR: DAVID C. LEE -- LAST MOD: JUN 1984 C C************************************************************************* C SUBROUTINE FACTRX ( FACT ) C REAL FACT C C <> C CALL FACTOR ( FACT ) RETURN END THE PWI, C WORD 2, IF POSITIVE IT POINTS TO THE NEXT PWI, C IF NEGATIVE IT POINTS TO AN ENTRY C REPRESENTING A LAG TIME, C IF ZERO IT ENDS THE CHAIN FOR THIS C WORK ITEM, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C NPWID - NUMBER OF PWI'S DELETED INTERNAL TO THE MAIN CHAIN, C IPSTART - PROJECT START DATE C NCDATE -davel/vms/FACTRX.SWN;1 644 37 1770 1510 3515016302 7562 C.~* SYSTEM: PLOTD, PROGRAM: FACTRX ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C PLOTD.OLB MEMBER. C C REPLACEMENT FOR THE STANDARD CALCOMP ROUTINE. C IT WRITES TO A DISK FILE. C C ENTER VIA: C CALL FACTRX (FCTR) C C 'FACTOR' WRITES A SINGLE RECORD TO THE PLOT FILE WHICH C RECORDS THE ARGUMENT USING: C FORMAT('F',F8.4) C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1983 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: SEP 1984 C C****************************************************************************** C SUBROUTINE FACTRX (FCTR) C IMPLICIT INTEGER*2 (I-N) C COMMON /PLOTXD/ CSCALE, XC, YC, NCHAN, NAMPLT(5) C C <> C CSCALE = FCTR WRITE (NCHAN,3) FCTR 3 FORMAT ('F', F8.4) RETURN END AIN FOR THIS C WORK ITEM, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C NPWID - NUMBER OF PWI'S DELETED INTERNAL TO THE MAIN CHAIN, C IPSTART - PROJECT START DATE C NCDATE -davel/vms/FACTRX.XRX;1 644 37 1770 1247 3515016313 7605 C.~SYSTEM: BSNIPS, PROGRAM: FACTRX ****COPYRIGHT 1984 SOFTWARE NORTH****** C C SUBROUTINE TO INTERFACE THE INSTALLATIONS PLOT LIBRARY WITH SNIPS. C ENLARGES OR SHRINKS THE SIZE OF THE PLOT BY CHANGING THE RATIO OF THE C PLOT SIZES. C C PLOT LIBRARY - CALCOMP 32-BIT SOFTWARE C C INPUT: C FACT - RATIO OF THE DESIRED PLOT SIZE TO THE NORMAL PLOT SIZE. C C SUBROUTINES REQUIRED: FACTOR(CALCOMP) C C AUTHOR: DAVID C. LEE -- LAST MOD: JUN 1984 C C************************************************************************* C SUBROUTINE FACTRX ( FACT ) C REAL FACT C C <> C CALL FACTOR ( FACT ) RETURN END PLICIT INTEGER*2 (I-N) C COMMON /PLOTXD/ CSCALE, XC, YC, NCHAN, NAMPLT(5) C C <> C CSCALE = FCTR WRITE (NCHAN,3) FCTR 3 FORMAT ('F', F8.4) RETURN END AIN FOR THIS C WORK ITEM, C NPWICH - NUMBER OF ENTRIES IN THE PWI CHAIN, C NPWID - NUMBER OF PWI'S DELETED INTERNAL TO THE MAIN CHAIN, C IPSTART - PROJECT START DATE C NCDATE -davel/vms/FATAL.FOR;2 644 37 1770 1670 3515016315 7415 C*** SYSTEM: SN2LB, PROGRAM: FATAL ***** COPYRIGHT 1985 SOFTWARE NORTH *** C C WRITE AN ERROR MESSAGE AND TERMINATE PROGRAM. C C INPUT: C NERROR - # ASSIGNED TO THE ERROR C MESSAGE - AN ERROR MESSAGE OF UP TO 60 CHARACTERS C IVAL1 - AN INTEGR VALUE TO BE DISPLAYED AFETE MESSAGE C IVAL2 - A SECOND VALUE TO BE DISPLAYED. C C ENTER VIA: C CALL FATAL( NERROR, MESSAGE, IVAL1, IVAL2 ) C C C SUBROUTINES USED: (NONE) C FUNCTIONS USED: LENGTH C C C AUTHOR: D. N. ANDERSON -- FEBRUARY 1985 C MODIFY: D. C. LEE -- MARCH 1985 C C************************************************************************** C SUBROUTINE FATAL ( NERROR, MESSAGE, IVAL1, IVAL2 ) C IMPLICIT INTEGER*2 (I-N) C CHARACTER*(*) MESSAGE C C <> C L = LENGTH( %REF(MESSAGE), 60 ) L = ( L+1 ) / 2 WRITE(6,1) NERROR, MESSAGE 1 FORMAT( ' *** Error', I6, 4X, A ) WRITE(6,3) IVAL1, IVAL2 3 FORMAT(19X,2I6) C STOP ' Fatal program error. ' C END INTERNAL TO THE MAIN CHAIN, C IPSTART - PROJECT START DATE C NCDATE -davel/vms/FIL2P.FOR;1 644 37 1770 13233 3515016323 7416 C.~* SYSTEM: SNIPS, PROGRAM: FIL2P ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C OUTPUT THE PROJECT CALENDAR AND AN IMAGE OF THE ACTIVITY C CALCULATION FILE IF REQUESTED. C C PARAMETERS: C C IPRNT - PRINT CODE; BIT 15 SET = ERRORS TO LISTING FILE, C BIT 14 SET = LIST CALENDAR, C BIT 13 SET = LIST RAW SCHEDULE CALC, C NPEND - LAST WORK DAY IN CALCULATED SCHEDULE. C IDEV(9) - NAME OF SCHEDULE FILE, C DT(6) - DATE ARRAY PASSED FROM 'PREP2' (M, D, Y, H, M, S) C IDATAD - CURRENT DATA DATE(DAYS SINCE 1-1-68), C NDATAD - DATA DATE IN PROJECT WORK DAYS, C IREM - 1 IF SCHEDULE IS BASED ON REMAINING DURATION, C NEDEV - OUTPUT UNIT FOR ERRORS, C IRATE - 0 IF A NORMAL ENTRY IS TO BE MADE IN THE C BILLING FILE FOR THIS SCHEDULE, C 1 IF A NO CHARGE ENTRY IS TO BE MADE, C 2 IF NO ENTRY IS TO BE MADE IN THE BILLING FILE. C ICODTE - 0 USE REGULAR DATES C 3 USE COMPANY SPECIFIC DATES C C ENTER VIA: C C CALL FIL2P (IPRNT, NPEND, IDEV, IDATAD, NDATAD, C DT, IREM, NEDEV, ICODTE, IRATE) C C SUBROUTINES REQUIRED: BILL, HHCMM, LDAY, RDM1, TIMEJLP, WRM1 C FUNCTIONS REQUIRED: MDYBN C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C**************************************************************************** C SUBROUTINE FIL2P (IPRNT, NPEND, IDEV, IDATAD, NDATAD, + DT, IREM, NEDEV, ICODTE, IRATE) C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXHOL=100 PARAMETER MAXWKD=3276 ! MAX. # OF WORKDAYS - LARGEST POSSIBLE PARAMETER MAXPWI=3000 C COMMON /CHANN/ FILEM1(9), FILEA2(9), FILED3(9), FILEBI(9) COMMON /SCH01/ IREV(4), FEXTN(12) C INTEGER*2 PWIC(2,MAXPWI), DT(6), IDEV(9), NCDATE(MAXWKD) INTEGER*2 FILEM1, FILEA2, FILED3, FILEBI, FEXTN INTEGER*2 T1(39), T2(39), I44(44), LNE(24), IM12(16) INTEGER*2 TAG(5), ICDSTR(7), IMDSTR(7), IRDSTR(7) INTEGER*2 PSTART(5), DATAD(5), MODCU(6), T(3) INTEGER*2 PFDATE(5), HOLID(MAXHOL) C C <> C C READ IN A FEW PARAMETERS FROM 'XXXXXX.M1' C CALL RDM1 (0, NAC, NWID, NPWICH, NPWID, PWIC, T1, T2, + IDAILY, ICSTART, IDATAD, NWDPW, NHOL, HOLID, + MODCU, IBARDD, BARFACT, NPHASE, + IPSTART, IPEND, NUPDTE, 1) C READ (11) NCDATE REWIND 11 C C CHANGE PHASE & ACCESS PARAMETERS AND REWRITE THE FILE C CONVERT & SAVE ACCESS TIME FOR PRINTOUT C CALL LDAY (IRDSTR, ICODTE, MODCU(5)) C CALL HHCMM (IRDSTR(5), MODCU(6)) C NPHASE = IREM + 1 MODCU(5) = MDYBN (NPHASE) C CALL TIMEJLP (T) C MODCU(6) = T(1) * 256 + T(2) C CALL WRM1 (NAC, NWID, NPWICH, NPWID, PWIC, T1, T2, + IDAILY, ICSTART, IDATAD, NWDPW, NHOL, HOLID, + MODCU, IBARDD, BARFACT, NPHASE, IPSTART, + IPEND, NUPDTE) C WRITE (11) NPEND, NCDATE C CALL LDAY (ICDSTR, ICODTE, MODCU(1)) C CALL HHCMM (ICDSTR(5), MODCU(2)) C CALL LDAY (IMDSTR, ICODTE, MODCU(3)) C CALL HHCMM (IMDSTR(5), MODCU(4)) C CALL LDAY (PSTART, ICODTE, IPSTART) C CALL LDAY (DATAD, ICODTE, IDATAD) C CALL LDAY (PFDATE, ICODTE, NCDATE(NPEND)) C IF (NEDEV .EQ. 4) GO TO 8 C C PUT TITLE ON CONSOLE C WRITE (6,7) IREV, IDEV, NUPDTE, ICDSTR, IMDSTR, IRDSTR 7 FORMAT ('1',///,15X,'SCHEDULE CALCULATION PROGRAM - REV. ', + 4A2/'0SCHEDULE: ',9A2,21X,'UPDATE NUMBER:',I9// + 10X,'FILE CREATED: ',4A2,1X,3A2,/ + 10X,' MODIFIED: ',4A2,1X,3A2,/ + 10X,' CALCULATED: ',4A2,1X,3A2/) WRITE (6,9) (PSTART(I), I = 1, 4), (DATAD(I), I = 1, 4), + NDATAD, (PFDATE(I), I = 1, 4), NPEND 9 FORMAT ('0PROJECT START DATE: ',4A2,' ( 1)',9X, 1 ' DATA DATE: ',4A2,' (',I3,')'/ 2 ' PROJECT FINISH DATE: ',4A2,' (',I4,')'/) IF (IREM .NE. 0) GO TO 14 WRITE (6,13) 13 FORMAT (' SCHEDULE BASED ON ORIGINAL DURATIONS.') GO TO 16 14 WRITE (6,15) 15 FORMAT (' SCHEDULE BASED ON REMAINING DURATIONS.') 16 IF (IPRNT .EQ. 0) GO TO 200 8 WRITE (4,7) IREV, IDEV, NUPDTE, ICDSTR, IMDSTR, IRDSTR WRITE (4,9) (PSTART(I), I = 1, 4), (DATAD(I), I = 1, 4), + NDATAD, (PFDATE(I), I = 1, 4), NPEND IF (IREM .NE. 0) GO TO 17 WRITE (4,13) GO TO 19 17 WRITE (4,1((5) 19 IF (MOD (IPRNT / 2, 2) .EQ. 0) GO TO 100 C C CALENDAR LISTING C WRITE (4,11) 11 FORMAT ('0',30X,'PROJECT CALENDAR'/) IB = 0 18 IL = 0 20 IA = IB + 1 IF (IA .GT. NPEND) GO TO 30 IB = IA 24 IF (NCDATE(IB) + 1 .NE. NCDATE(IB + 1)) GO TO 28 IF (IB .EQ. IA + 6) GO TO 28 IB = IB + 1 GO TO 24 28 IL = IL + 1 ICOD = ICODTE IF (ICOD .EQ. 0) ICOD = 1 CALL LDAY (LNE(IL), ICOD, NCDATE(IA)) IL = IL + 5 CALL LDAY (LNE(IL), ICOD, NCDATE(IB)) IL = IL + 5 LNE(IL) = IA IL = IL + 1 LNE(IL) = IB IF (IL .LT. 24) GO TO 20 30 WRITE (4,32) (LNE(I), I = 1, IL) 32 FORMAT (4X,5A2,'- ',5A2,'(',I3,'-',I3,')',6X,5A2,'- ',5A2, 1 '(',I3,'-',I3,')') IF (IB .LT. NPEND) GO TO 18 100 IF (MOD (IPRNT / 4, 2) .EQ. 0) GO TO 200 C C CALCULATION RESULTS LISTING C (RAW RESULTS FOR PROGRAM CHECKING) C WRITE (4,110) 110 FORMAT ('0',22X,'RAW CALCULATION RESULTS'/ 1 '0 NO. TAG DUR. R.D. START E.F.', 2 ' FFF L.F. A.S. A.F. EPC LPC') DO 120 I = 1, NAC READ (12'I) IM12 IF (IM12(1) .EQ. 0) GO TO 120 READ (13'I) I1, TAG, I44 IBE = '20040'O ! BLANK IF (IM12(4) .EQ. 1) IBE = '20102'O ! ' B' IF (IM12(4) .EQ. 3) IBE = '20105'O ! ' E' IF (IM12(6) .EQ. IM12(8)) 1 IBE = (IBE .AND. '177'O) + '41400'O ! 'C ' C WRITE (4,116) I, (TAG(J), J=1, 5), (IM12(J), J = 2, 3), 1 IBE, (IM12(J), J = 5, 8), (IM12(J), J = 11, 14) 116 FORMAT (1X,I4,1X,5A2,2I6,1X,A2,I5,3I6,4I5) 120 CONTINUE C C CALL ITEMIZED BILL WRITER C 200 CALL BILL (4, IRATE, DT, NAC-NWID, 0, FILEBI) C IF (IPRNT / 2 .GT. 0) WRITE (4,202) 202 FORMAT ('0CSNIPS -- COMPLETE') IF (NEDEV .NE. 4) WRITE (6,202) RETURN END EXTN(12) C INTEGER*2 PWIC(2,MAXPWI), DT(6), IDEV(9), NCDATE(MAXWKD) INTEGER*2 FILEM1, FILEA2, FILED3, FILEBI, FEXTN INTEGER*2 T1(39), T2(39), I44(44), LNE(24), IM12(16) INTEGER*2 TAG(5), ICDSTR(7), IMDSTR(7), IRDSTR(7) INTEGER*2 PSTART(5), DATAD(5), MODCU(6), T(3) INTEGER*2 PFDATE(5), HOLID(MAXHOL) C C <> C C READ IN A FEW PARAMETERS FROM 'XXXXXdavel/vms/FILFIX.FOR;2 644 37 1770 5273 3515016327 7555 C.~*SYSTEM: TOSNIPS, PROGRAM: FILFIX ****COPYRIGHT 1984 SOFTWARE NORTH********* C C CREATES A NEW FILE CONTAINING FIXED LENGTH RECORDS GIVEN AN INPUT FILE C CONTAINING VARIABLE LENGTH RECORDS, UNDER THE SAME FILE NAME (ie. a new C versiong of the file ). WHEN THE INPUT FILE DOES NOT EXIST OR ALREADY C CONTAINS FIXED LENGTH RECORDS NO ACTION IS TAKEN. THE FIXED LENGTH C RECORD SIZE ARGUMENT MUST BE SPECIFIED IN 16-BIT WORDS. C C THIS ROUTINE IS USED WITH TOSNIPS ONLY UNDER THE VAX/VMS SYSTEM. C C INPUT: C CFILE - NAME OF THE INPUT FILE C LEN - NUMBER OF TWO BYTE WORDS IN THE DESIRED FIXED LENGTH RECORDS C C OUTPUT: C CREATES A NEW FILE VERSION OF THE INPUT FILE WHICH CONSISTS OF C FIXED LENGTH RECORDS. C C SUBROUTINES REQUIRED: BLANK, SUBSTR C FUNCTIONS REQUIRED: LENGTH C C AUTHOR: DAVID C. LEE -- LAST MOD: OCT 1984 C C****************************************************************************** C SUBROUTINE FILFIX ( CFILE, LEN ) C IMPLICIT INTEGER*2 (I-N) C CHARACTER*20 CFILE CHARACTER*8 RCTYPE CHARACTER*132 LINE C INTEGER*2 NEWLN(66) C C <> C INQUIRE ( FILE=CFILE, IOSTAT=IERR, RECORDTYPE=RCTYPE ) C IF ( IERR .NE. 0 ) GO TO 500 C IF ( RCTYPE .EQ. 'FIXED ' ) GO TO 500 IF ( RCTYPE .EQ. 'VARIABLE' ) GO TO 100 WRITE (6,*) ' FILFIX -- RECORDS CONTAINED IN THE INPUT ' WRITE (6,*) ' FILE ARE NEITHER VARIABLE OR FIXED ' WRITE (6,*) ' LENGTH. EXECTUTION TERMINATED. ' STOP C C CONVERT THE FILE TO FIXED LENGTH RECORDS C 100 OPEN ( UNIT=2, FILE=CFILE, RECORDTYPE='VARIABLE', + STATUS='OLD', IOSTAT=IERR ) IF ( IERR .NE. 0 ) STOP ' FILFIX - COULDN''T OPEN FILE ' C REWIND (2) ISIZE = LEN * 2 OPEN ( UNIT=10, FILE=CFILE, RECORDTYPE='FIXED', + RECORDSIZE=ISIZE, STATUS='NEW', IOSTAT=IERR ) IF ( IERR .NE. 0 ) STOP ' FILFIX - COULDN''T CREATE FILE ' C 50 READ (2,51,END=400) LINE 51 FORMAT ( A ) L = LENGTH ( %REF(LINE), 132 ) CALL BLANK ( NEWLN, 1, 132 ) C TRIM OFF THE FIRST BYTE OF THE VAR. LENGTH RECORD C*** 2 --> 2 7-10-85 DCL - TO PREVENT TRIMMING RECORDS. CALL SUBSTR ( NEWLN, 1, %REF(LINE), 1, L ) WRITE (10,61) (NEWLN(I),I=1,LEN) C MAXIMUM OUTPUT LENGTH IS 132 COLUMNS 61 FORMAT ( 66A2 ) GO TO 50 C 400 CLOSE ( UNIT=2, IOSTAT=IERR ) CLOSE ( UNIT=10, IOSTAT=IERR ) C C RETURN TO CALLING PROGRAM C 500 RETURN END NCDATE C CALL LDAY (ICDSTR, ICODTE, MODCU(1)) C CALL HHCMM (ICDSTR(5), MODCU(2)) C CALL LDAY (IMDSTR, ICODTE, MODCU(3)) C CALL HHCMM (IMDSTR(5), MODCU(4)) C CALL LDAY (PSTART, ICODTE, IPSTART) C CALL LDAY (DATAD, ICODTE, IDATAD) C CALL LDAY (PFDATE, ICODTE, NCDATE(NPEND)) C IF (NEDEV .EQ. 4) GO TO 8 C C PUT TITLE davel/vms/FILL.MAR;1 644 37 1770 3133 3515016335 7302 ;.~* SYSTEM: LIBRARY, PROGRAM: FILL ***** COPYRIGHT 1983 SOFTWARE NORTH *** ; ; INSERT A SPECIFIED CHARACTER IN A SERIES OF CONSECUTIVE POSITIONS WITHIN ; A STRING. ; ; INPUT: ; ISTRING - INTEGER ARRAY WHICH IS THE TARGET OF THIS INSERTION. ; A SPECIFIED RANGE OF CHARACTERS WITHIN "ISTRING" WILL BE ; OVERLAID BY THE REQUESTED FILL CHARACTER ("IFILLC"), ; ISTART - NUMBER OF THE FIRST CHARACTER WITHIN "ISTRING" TO BE ; OVERLAID, ; IEND - NUMBER OF THE LAST CHARACTER IN "ISTRING" TO FILL, ; IFILLC - FILL CHARACTER IS CONTAINED IN LEFTMOST BYTE OF THIS WORD. ; ; OUTPUT: ; ISTRING - ARRAY AS MODIFIED BY THIS OPERATION. ; ; ENTER VIA: ; CALL FILL (ISTRING, ISTART, IEND, IFILLC) ; ; EXAMPLES: ; ISTRING = "1234567890ABC" ; ; THEN A CALL FILL (ISTRING, 4, 8, "E ") ; WILL CHANGE ISTRING = "123EEEEE90ABC" ; ; THEN A CALL FILL (ISTRING, 5, 5, "X ") ; WILL CHANGE ISTRING = "123EXEEE90ABC" ; ; THEN A CALL FILL (ISTRING, 7, 11, " ") ; WILL CHANGE ISTRING = "123EXE BC". ; ; SUBPROGRAMS REQUIRED: (NONE) ; FUNCTIONS REQUIRED: (NONE) ; ; AUTHOR: D. N. ANDERSON -- LAST MOD: SEP 1983 VAX/VMS ; ;*************************************************************************** ; .TITLE FILL .IDENT /01/ ; .ENTRY FILL,^M ; MOVL 4(AP),R4 ; A(ISTRING) MOVZWL @8(AP),R1 ; ISTART MOVZWL @12(AP),R3 ; IEND MOVB @16(AP),R2 ; IFILLC (FILL BYTE) DECL R1 ; ISTART - 1 ADDL R1,R4 ; R4 = A(ISTRING) + ISTART - 1 SUBL R1,R3 ; R3 = IEND - ISTART + 1 CLRW R0 ; INDICATE ZERO LENGTH SOURCE STRING MOVC5 R0,(R1),R2,R3,(R4) ; PROPIGATE FILL CHARACTER MOVL #SS$_NORMAL,R0 RET .END RMINATED. ' STOP C C CONVERT THE FILE TO FIXED LENGTH RECORDS C 100 OPEN ( UNIT=2, FILE=CFILE, RECORDTYPE='VARIABLE', + STATUS='OLD', IOSTAT=IERR ) IF ( IERR .NE. 0 ) STOP ' FILFIX - COULDN''T OPEN FILE ' C REWIND (2) ISIZE = LEN * 2 OPEN ( UNIT=10, FILE=CFILE, RECORDTYPE='FIXED', + RECORDSIZE=ISIZE, STATUS='NEW', IOSTATdavel/vms/FILLI.FOR;1 644 37 1770 2534 3515016340 7422 C.~* SYSTEM: SNIPS, PROGRAM: FILLI ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C ROUTINE TO PLACE TWO PWI LABELS IN AN OUTPUT LINE. C C PARAMETERS: C LNE - THE OUTPUT LINE IN WHICH TO STORE THE LABELS, C IPWI - CURRENT POINTER TO A PWI WITHIN 'PWIC' OR ZERO, C PWIC - PWI CHAIN, C TAGLIST - LIST OF ALL LABELS FOR WORK ITEMS, C ICODTE - 0 TO USE 12-31-83 FORM FOR DATES C 3 TO USE COMPANY SPECIFIC FORM FOR DATES C C ENTER VIA: C CALL FILLI (LNE, IPWI, PWIC, TAGLIST, ICODTE) C C SUBROUTINES REQUIRED: ASMPWI, SUBSTR C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: APR 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C C************************************************************************** C SUBROUTINE FILLI (LNE, IPWI, PWIC, TAGLIST, ICODTE) C IMPLICIT INTEGER*2 (I-N) C C PARAMETER MAXNAC=2000 PARAMETER MAXPWI=3000 C INTEGER*2 LNE(1), PWIC(2,MAXPWI), TAGLIST(5,MAXNAC), LN2(10) C C <> C IF (IPWI .EQ. 0) RETURN C CALL ASMPWI (PWIC, IPWI, TAGLIST, 1, 1, LNE, ITYP, ICODTE) C IPWI = PWIC(2,IPWI) IF (IPWI .LT. 0) IPWI = PWIC(2,-IPWI) IF (ITYP .GT. 1) GO TO 22 C C POSSIBLY ROOM FOR 2ND PWI C IF (IPWI .EQ. 0) RETURN C CALL ASMPWI (PWIC, IPWI, TAGLIST, 1, 1, LN2, ITYP, ICODTE) C IF (ITYP .GT. 1) GO TO 22 C CALL SUBSTR (LNE, 11, LN2, 1, 10) C IPWI = PWIC(2,IPWI) 22 RETURN END C (FILL BYTE) DECL R1 ; ISTART - 1 ADDL R1,R4 ; R4 = A(ISTRING) + ISTART - 1 SUBL R1,R3 ; R3 = IEND - ISTART + 1 CLRW R0 ; INDICATE ZERO LENGTH SOURCE S((davel/vms/FILPR.FOR;1 644 37 1770 17521 3515016346 7467 C.~* SYSTEM: SNIPS, PROGRAM: FILPR ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PRINT A FORMATTED LIST OF THE FILES FOR A PARTICULAR SCHEDULE. C C PARAMETERS: C NAC - NUMBER OF WORK ACTIVITIES, C TAGLIST - ARRAY TO HOLD A LIST OF ALL WORK ITEM TAGS, C NWID - NO. OF DELETED WORK ITEMS WITHIN FILES, C NPWICH - NUMBER OF PREVIOUS WORK ITEM ENTRIES, C NPWID - NO. OF DELETED ENTRIES WITHIN 'PWIC', C PWIC(2,NPWICH) C - CHAINED LIST OF PREV. WORK ACTIVITIES, C T1 - SCHEDULE TITLE (UPPER), C T2 - SCHEDULE TITLE (LOWER), C IDAILY - 1 = DURATIONS IN DAYS, 0 = DURATIONS IN WEEKS, C ICSTART - CALENDAR START DAY, C IPSTART - PROJECT START DATE, C IPEND - PROJECT COMPLETION DATE, C IDATAD - CURRENT DATA DATE, C NWDPW - NO. OF WORK DAYS PER WEEK, C NHOL - NUMBER OF HOLIDAYS, C HOLID(NHOL) C - LIST OF THE HOLIDAYS. C IDEV(9) - FILE NAME, C DT(10) - DATE & TIME INFORMATION; C 1) CURRENT MONTH 6) CURRENT SECOND C 2) CURRENT DAY 7) PREV EDIT DATE (BIN) C 3) CURRENT YEAR 8) PREV EDIT TIME (BIN) C 4) CURRENT HOUR 9) PREV CALC DATE (BIN) C 5) CURRENT MINUTE 10) PREV CALC TIME (BIN) C MODCU(6)- DATE-TIME INFO; C 1) SCHEDULE CREATION DATE C 2) SCHEDULE CREATION TIME C 3) LAST EDIT DATE C 4) LAST EDIT TIME C 5) LAST CALCULATION DATE C 6) LAST CALCULATION TIME C ICODTE - 0 TO DISPLAY DATES IN FORM 12-31-83 C 3 TO DISPLAY IN COMPANY SPECIFIC FORM C IBARDD - DAYS OF SCHEDULE PER PLOTTED DATE ON BARCHART C BARFACT - BARCHART PLOTTING FACTOR, C NUPDTE - NO. OF TIMES THIS SCHEDULE HAS BEEN UPDATED, C NPLNS - NO. OF PRINT LINES PRODUCED BY THIS PROGRAM. C C ENTER VIA: C CALL FILPR (NAC, TAGLIST, NWID, NPWICH, NPWID, PWIC, T1, C T2, IDAILY, ICSTART, IPSTART, IPEND, IDATAD, NWDPW, C NHOL, HOLID, IDEV, DT, MODCU, ICODTE, C IBARDD, BARFACT, NUPDTE, NPLNS) C C SUBROUTINES REQUIRED: ASMPWI, BLANK, HHCMM, LDAY, SUBSTR C FUNCTIONS REQUIRED: LENGTH, LNTEXT C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JAN 1984 C C************************************************************************ C SUBROUTINE FILPR (NAC, TAGLIST, NWID, NPWICH, NPWID, 1 PWIC, T1, T2, IDAILY, ICSTART, IPSTART, IPEND, 2 IDATAD, NWDPW, NHOL, HOLID, IDEV, DT, MODCU, ICODTE, 3 IBARDD, BARFACT, NUPDTE, NPLNS) C IMPLICIT INTEGER*2 (I-N) C PARAMETER MAXPWI=3000 ! MAX. NO. OF PREVIOUS WORK ITEMS PARAMETER MAXHOL=100 ! MAX. NO. HOLIDAYS PARAMETER MAXNAC=2000 ! MAX. NO. OF WORK ACTIVITY RECORDS C INTEGER*2 LBL(3,2) INTEGER*2 PWIC(2,MAXPWI), T1(39), T2(39), HOLID(MAXHOL), + IDEV(9), IDSTR(5), DTE(3), TME(3), IM(35), + IM12(16), IM13(50), TAGLIST(5,MAXNAC), + DT(10), ICDSTR(21), MODCU(6), ICURDTE(7) C DATA LBL /'WE','EK','S.','DA','YS','. '/ DATA IBLNK/' '/ C C <> C C FOR CURRENT DATE-TIME STRINGS C CALL LDAY (ICURDTE, ICODTE, MODCU(5)) CALL HHCMM (ICURDTE(5), MODCU(6)) C C FORM CREATION DATE STRING C CALL LDAY (ICDSTR, ICODTE, MODCU) CALL HHCMM (ICDSTR(5), MODCU(2)) C C FORM LAST EDIT DATE-TIME C CALL LDAY (ICDSTR(8), ICODTE, DT(7)) CALL HHCMM (ICDSTR(12), DT(8)) C C FORM LAST CALCULATED DATE-TIME STRING C CALL LDAY (ICDSTR(15), ICODTE, DT(9)) CALL HHCMM (ICDSTR(19), DT(10)) C C FORM DATA DATE STRING C CALL LDAY (IDSTR, ICODTE, IDATAD) C C OUTPUT THE FIRST FEW LINES OF THE FILE DUMP C NACR = NAC - NWID WRITE (4,12) IDEV, ICURDTE, ICDSTR, (IDSTR(J),J=1,4), NUPDTE, * NACR, T1, T2 12 FORMAT ('1CONTENTS OF SCHEDULE FILE: ',9A2,' ', + ' AS OF ',4A2,' AT ',3A2,/, + '0CREATED: ',4A2,1X,3A2, + ' MODIF: ',4A2,1X,3A2, + ' CALC: ',4A2,1X,3A2,/, + '0DATA DATE: ',4A2,I16, + ' UPDATES',I17, + ' ACTIVITIES',/, + '0UPPER TITLE: ',39A2,/, + ' LOWER TITLE: ',39A2) C CALL LDAY (IDSTR, ICODTE, ICSTART) C IDL = IDAILY + 1 WRITE (4,14) (LBL(J,IDL),J=1,3), NWDPW, (IDSTR(J),J=1,4) 14 FORMAT (' DURATIONS IN: ',3A2,5X,'WORK DAYS/WEEK:',I2, 1 5X,'CALENDAR START: ',4A2) C CALL LDAY (IDSTR, ICODTE, IPSTART) C IF (IPEND .NE. 0) GO TO 13 C CALL BLANK (ICDSTR, 1, 8) C ICDSTR(1) = '30040'O GO TO 15 C 13 CALL LDAY (ICDSTR, ICODTE, IPEND) C 15 WRITE (4,17) (IDSTR(J),J=1,4), (ICDSTR(J),J=1,4) 17 FORMAT (20X,'PROJECT START: ',4A2,5X,'PROJECT FINISH: ',4A2) C NPLNS = 8 ! PRINT LINES C C PRINT HOLIDAYS C IF (NHOL .LE. 0) GO TO 30 WRITE (4,16) 16 FORMAT (' HOLIDAYS:') NP = (NHOL-1) / 7 + 1 K = 1 DO 24 I=1, NP C CALL BLANK (IM, 1, 70) C J=2 18 IF (K .GT. NHOL) GO TO 20 C CALL LDAY (IM(J), ICODTE, HOLID(K)) C J = J + 5 K = K + 1 IF (J .LT. 35) GO TO 18 20 WRITE (4,22) IM 22 FORMAT (' ',35A2) 24 CONTINUE NPLNS = NPLNS + NP + 1 C C PRINT PLOTTING PARAMETERS C 30 IF (NPENS .EQ. 0) GO TO 50 WRITE (4,49) IBARDD, BARFACT 49 FORMAT (5X,'BARCHART PLOT PARAMETERS:'/ 2 I11,' DAYS PER PLOTTED DATE MARK'/ 3 10X,'FACTOR =',F5.2) NPLNS = NPLNS + 11 50 IF (NAC .LE. 0)GO TO 90 C C PICK UP TAG LIST C DO 54 I=1, NAC READ (13'I) IM13 IF (IM13(1) .NE. 0) GO TO 51 C CALL SUBSTR (TAGLIST(1,I), 1, %REF(' (DELETED)'), 1, 10) C GO TO 54 51 DO 52 J=1, 5 52 TAGLIST(J,I) = IM13(J+1) 54 CONTINUE C C PRINT ALL ACTIVITY INFORMATION C WRITE (4,55) 55 FORMAT ('0 ACTIVITY',46X,'PREV. WORK'/ 1 5X,'TAG ACTIVITY DESCRIPTION',7X, 2 'DUR R.D. ACTIVITY') NPAGE = 1 NPLNS = NPLNS + 2 C C LOOP OVER ALL ACTIVITIES C DO 88 I=1, NAC READ (12'I) IM12 READ (13'I) IM13 C C SKIP BLANK ENTRIES C IF (IM13(1) .EQ. 0) GO TO 88 C C TITLE NEW PAGE IF NECESSARY C IF (NPLNS .LT. 54) GO TO 59 NPAGE = NPAGE + 1 WRITE (4,61) NPAGE 61 FORMAT ('1',64X,'PAGE ',I4) WRITE (4,55) NPLNS = 0 C C BLANK TAG AREA OF LINE C 59 CALL BLANK (IM, 1, 10) CALL BLANK (IM, 41, 60) C C COPY TAG C LT = LENGTH (IM13(2), 10) C CALL SUBSTR (IM, 6-LT/2, IM13(2), 1, LT) C C GET FIRST DESCRIPTION LINE C C NB = LNTEXT (IM(6), 30, IM13(7), 1, 80, IERR) DU = IM12(2) / 10.0 RD = IM12(3) / 10.0 IF (IDAILY .NE. 0) GO TO 57 DU = DU / NWDPW RD = RD / NWDPW 57 IP = IM12(15) IF (IP .EQ. 0) GO TO 58 C C INSERT FIRST PWA LABEL IN LINE C CALL ASMPWI (PWIC, IP, TAGLIST, IDAILY, NWDPW, IM(21), ITYP, + ICODTE) C IP = PWIC(2,IP) IF (IP .LT. 0) IP = PWIC(2,-IP) 58 IACTD = 0 IACTD1 = 0 IF (IM13(47) .NE. 0) IACTD = IACTD + 1 ! INDIC. ACTUAL START DATE IF (IM13(48) .NE. 0) IACTD = IACTD + 2 ! INDIC. ACTUAL FINISH DATE C C WRITE FIRST LINE C WRITE (4,60) (IM(J),J=1,20), DU, RD,(IM(J),J=21,30) 60 FORMAT ('0',5A2,1X,15A2,F6.1,F6.1,3X,10A2) NPLNS = NPLNS + 2 C 63 NB = LNTEXT (IM, 30, IM13(7), NB, 80, IERR) IF (IERR .NE. 0) GO TO 64 IDSCR = 1 GO TO 66 C 64 CALL BLANK (IM, 1, 30) C IDSCR = 0 IACTD1 = 0 IF (IACTD .EQ. 0) GO TO 66 ! NO ACTUAL DATES IF (MOD (IACTD,2) .NE. 0) GO TO 65 C C INSERT ACTUAL FINISH DATE C CALL SUBSTR (IM(2), 1, %REF('ACTUAL FINISH:'),1, 14) C CALL LDAY (IM(10), ICODTE, IM13(48)) C IACTD1 = 1 IACTD = 0 GO TO 66 C C INSERT ACTUAL START DATE C 65 IACTD = IACTD - 1 C CALL SUBSTR (IM(2), 1,%REF('ACTUAL START: '), 1, 14) C CALL LDAY (IM(10), ICODTE, IM13(47)) C IACTD1 = 1 C C INSERT A PWA LABEL IN LINE C 66 CALL ASMPWI (PWIC, IP, TAGLIST, IDAILY, NWDPW, IM(16), ITYP, + ICODTE) C IF (IP .EQ. 0) GO TO 72 IP = PWIC(2,IP) IF (IP .LT. 0) IP = PWIC(2,-IP) 70 FORMAT (12X,15A2,15X,10A2) 72 IF (ITYP + 1 + IDSCR + IACTD1 .EQ. 0) GO TO 88 C C WRITE 2ND & FOLLOWING LINES C WRITE (4,70) (IM(J),J=1,25) NPLNS = NPLNS + 1 IF (IP+IDSCR+IACTD .GT. 0) GO TO 63 88 CONTINUE C C SUMMARIZE FILE STATISTICS C 90 IPP = MAXNAC IP = MAXPWI WRITE (4,92) NAC, IPP, NWID, NPWICH, IP, NPWID 92 FORMAT ('0FILE USE STATISTICS:'/ * 10X,'ACTIVITY RECORDS;',I6,' OUT OF ',I4, 1 ' (',I3,' INCL. BLANKS)'/ 2 10X,'PRECEDENCE RECORDS;',I4,' OUT OF ',I4, 3 ' (',I3,' INCL. BLANKS)') RETURN END davel/vms/FILRT.FOR;1 644 37 1770 3164 3515016350 7444 C.~* SYSTEM:SNIPS, PROGRAM: FILRT ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C LOAD CALCULATION TABLE, DIRECT CALCULATION AND RESTORE TABLE AFTER C CALCULATION OF SCHEDULE BASED ON REMAINING DURATION. C C PARAMETERS: C C NAC - NUMBER OF WORK ITEM ENTRIES IN FILES (INCLUDING C DELETED ITEMS) C NPEND - NUMBER OF WORK DAYS CORRESPONDING TO PROJECT END C DATE (OR ZERO IF AN END DATE WAS NOT GIVEN). C NDATAD - DATA DATE (IN SCHEDULE WORK DAYS), C PWIC(2,MAXPWI) C - CHAIN OF PREVIOUS WORK ITEMS C NEDEV - OUTPUT DEVICE NUMBER FOR ERROR. C NCDATE - DATE TRANSLATION ARRAY, C C ENTER VIA: C CALL FILRT (NAC, NPEND, NDATAD, PWIC, NEDEV, NCDATE) C C SUBROUTINES REQUIRED: RDCALC C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C****************************************************************** C SUBROUTINE FILRT (NAC, NPEND, NDATAD, PWIC, NEDEV, NCDATE) C IMPLICIT IN((TEGER*2 (I-N) C PARAMETER MAXNAC=2000 PARAMETER MAXPWI=3000 PARAMETER MAXWKD=3276 ! MAXIMUM POSSIBLE # OF WORK DAYS C COMMON /CALCB/ ACT(16,MAXNAC), TA(MAXNAC), TB(MAXNAC), TC(MAXNAC) C INTEGER*2 ACT, PWIC(2,MAXPWI), TA, TB, TC, NCDATE(MAXWKD) C C <> C C LOAD UP ACTIVITY TABLE DO 10 I = 1, NAC READ (12'I) (ACT(J,I), J = 1, 16) DO 8 J = 4, 9 8 ACT(J,I) = 0 ACT(13,I) = 0 ACT(14,I) = 0 10 CONTINUE C C PERFORM SCHEDULE CALCULATION C CALL RDCALC (NAC, NPEND, NDATAD, PWIC, NEDEV, NCDATE) C C OUTPUT ACTIVITY'S TO FILE C DO 50 I = 1, NAC WRITE (12'I) (ACT(J,I), J = 1, 16) 50 CONTINUE RETURN END , NDATAD, PWIC, NEDEV, NCDATE) C C SUBROUTINES REQUIRED: RDCALC C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C****************************************************************** C SUBROUTINE FILRT (NAC, NPEND, NDATAD, PWIC, NEDEV, NCDATE) C IMPLICIT INdavel/vms/FILTB.FOR;1 644 37 1770 3272 3515016353 7427 C.~* SYSTEM: SNIPS, PROGRAM: FILTB ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C VAX/VMS VERSION C C LOAD CALCULATION TABLE, DIRECT CALCULATION AND RESTORE TABLE AFTER C CALCULATION OF SCHEDULE BASED ON ORIGINAL DURATION. C C PARAMETERS: C C NAC - NUMBER OF WORK ITEM ENTRIES IN FILE (INCLUDING C DELETED ITEMS) C NPEND - NUMBER OF WORK DAYS CORRESPONDING TO PROJECT END C DATE (OR ZERO IF END DATE WAS NOT GIVEN). C PWIC(2,MAXPWI) C - CHAIN OF PREVIOUS WORK ITEMS. C NEDEV - OUTPUT DEVICE NUMBER FOR ERROR C NCDATE - DATE TRANSLATION ARRAY. C C ENTER VIA: C CALL FILTB (NAC, NPEND, PWIC, NEDEV, NCDATE) C C SUBROUTINES REQUIRED: SCALC C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1978 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: OCT 1984 C C************************************************************************** C SUBROUTINE FILTB (NAC, NPEND, PWIC, NEDEV, NCDATE) C PARAMETER MAXWKD=3276 ! MAX. NO. OF PROJECT DAYS PARAMETER MAXPWI=3000 ! MAX. ENTRIES IN PWI CHAIN PARAMETER MAXNAC=2000 ! MAX. NO. OF WORK ITEMS C IMPLICIT INTEGER*2 (I-N) C COMMON /CALCA/ ACT(16,MAXNAC), TA(MAXNAC), TB(MAXNAC), TC(MAXNAC) C INTEGER*2 ACT, PWIC(2,MAXPWI), TA, TB, TC, NCDATE(MAXWKD) C C <> C C LOAD UP ACTIVITY TABLE DO 10 I = 1, NAC READ (12'I) (ACT(J,I), J = 1, 16) DO 8 J = 4, 14 8 ACT(J,I) = 0 10 CONTINUE C C PERFORM SCHEDULE CALCULATION C CALL SCALC (NAC, NPEND, PWIC, NEDEV, NCDATE) C C OUTPUT ACTIVITY'S TO FILE C DO 50 I = 1, NAC WRITE (12'I) (ACT(J,I), J = 1, 16) 50 CONTINUE RETURN END C T2, IDAILY, ICSTART, IPSTART, IPEND, IDATAD, NWDPW, C NHOL, HOLID, IDEV, DT, MODCU, ICODTE, C IBARDD, BARFACT, NUPDTE, NPLNS) C C SUBROUTINES REQUIRED: ASMPWI, BLANK, HHCMM, LDAY, SUBSTR C FUNCTIONS REQUIRED: LENGTH, LNTEXT C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JANdavel/vms/FNUM.FOR;1 644 37 1770 3236 3515016356 7337 C.~* SYSTEM: LIBRARY, PROGRAM: FNUM ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C CONVERT A STRING TO A FLOATING POINT NUMBER. C (EXPONENENTS ARE NOT INTERPRETED). C C INPUT: C ISTRING - ARRAY CONTAINING THE ASCII STRING TO BE INTERPRETED C AS A FLOATING POINT NUMBER. IT MAY CONTAIN ONLY C BLANKS, A LEADING/TRAILING - SIGN, A LEADING/TRAILING C + SIGN (IGNORED), ONE DECIMAL POINT (AT MOST), C COMMA'S (IGNORED), AND NUMERIC DIGITS. CONVERSION C STOPS AT THE FIRST BLANK AFTER SOME DIGITS, C ISTART - THE FIRST CHARACTER IN ISTRING TO USE, C NBYTES - THE LAST CHARACTER TO CONSIDER WITHIN ISTRING C FOR THE DEVELOPMENT OF THE FLOATING-POINT NUMBER. C C OUTPUT: C F - RESULTING SINGLE PRECISION FLOATING-POINT NUMBER, C IERR - 0 UNLESS FIELD IS NOT INTERPRETERABLE AS A FLOATING C POINT NUMBER. IN THAT CASE 'IERR' POINTS TO THE C FIRST ERRONEOUS CHARACTER IN THE FIELD. C C ENTER VIA: C F = FNUM (ISTRING, ISTART, NBYTES, IERR) C C EXAMPLES: C FNUM ('1234.678', 1, 8, IERR) = 1234.678 C FNUM ('ACV98.7654BRT', 4, 4, IERR) = 98.7 C FNUM ('ACV98.7654BRT', 4, 6, IERR) = 98.765 C FNUM ('ACV98.7654BRT', 4, 8, IERR) ---------> IERR = 11 C C C SUBROUTINES REQUIRED: FNUM8 C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C C*************************************************************************** C FUNCTION FNUM (ISTRING, ISTART, NBYTES, IERR) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 ISTRING(1) C DOUBLE PRECISION DPFPN C C <> C C GET DOUBLE PRECISION VERSION C CALL FNUM8 ( DPFPN, ISTRING, ISTART, NBYTES, IERR ) C C TRUNCATE C FNUM = DPFPN RETURN END 50 CONTINUE RETURN END C T2, IDAILY, ICSTART, IPSTART, IPEND, IDATAD, NWDPW, C NHOL, HOLID, IDEV, DT, MODCU, ICODTE, C IBARDD, BARFACT, NUPDTE, NPLNS) C C SUBROUTINES REQUIRED: ASMPWI, BLANK, HHCMM, LDAY, SUBSTR C FUNCTIONS REQUIRED: LENGTH, LNTEXT C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: JANdavel/vms/FNUM8.FOR;1 644 37 1770 7626 3515016362 7433 C.~* SYSTEM: LIBRARY, PROGRAM: FNUM8 ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C VAX/VMS VERSION C C CONVERT AN ASCII STRING INTO A DOUBLE PRECISION FLOATING POINT NUMBER. C IF A DECIMAL POINT IS NOT FOUND IT IS ASSUMED TO BE IMMEDIATELY TO THE C RIGHT OF THE LAST DIGIT. C C INPUT: C IARRAY - ARRAY CONTAINING THE ASCII STRING TO BE INTERPRETED C AS A FLOATING POINT NUMBER. IT MAY CONTAIN ONLY C BLANKS, A LEADING/TRAILING - SIGN, A LEADING/TRAILING C + SIGN (IGNORED), ONE DECIMAL POINT (AT MOST), C COMMA'S (IGNORED), AND NUMERIC DIGITS. CONVERSION C STOPS AT THE FIRST BLANK AFTER SOME DIGITS, C ISTART - POINTER TO THE FIRST BYTE OF THE FIELD WHICH IS INCLUDED C IN THE CONVERSION (ISTART = 1 INDICATES THE FIRST BYTE C IN 'IARRAY', C NBYTES - NUMBER OF BYTES IN THE FIELD TO BE CONVERTED. C C OUTPUT: C DPFPN - THE DOUBLE PRECISION FLOATING-POINT NUMBER RETURNED BY C BY THIS ROUTINE. C IERR - ZERO UNLESS ERRONEOUS CHARACTERS ARE ENCOUNTERED. C IT POINTS TO THE FIRST BAD CHARACTER FOUND. C C ENTER VIA: C CALL FNUM8 (DPFPN, IARRAY, ISTART, NBYTES, IERR) C C EXAMPLES: C CALL FNUM8 (DPFPN, ' -684.9752 ', 1, 9, IERR), DPFPN = -684.975 C CALL FNUM8 (DPFPN, ' -684.9752 ', 4, 2, IERR), DPFPN = 84. C CALL FNUM8 (DPFPN, ' -684.9752 ', 6, 6, IERR), DPFPN = .9752 C CALL FNUM8 (DPFPN, '65,483,981.24',1,13,IERR), DPFPN = 65483981.24 C C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: INDEX, LENGTH C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1977 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C C**************************************************************************** C SUBROUTINE FNUM8 ( DPFPN, IARRAY, ISTART, NBYTES, IERR ) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C INTEGER*2 IARRAY(1), PERIOD C DOUBLE PRECISION DPFPN, EX C C <> C IERR = 0 DPFPN = 0.D0 C C POINTER TO LAST CHARACTER C IEND = LENGTH (IARRAY, ISTART + NBYTES - 1) IF (IEND .LT. ISTART) RETURN ! BLANK FIELD = 0 C C FIND FIRST NON-BLANK CHARACTER C KSTART = INDEX (IARRAY, ISTART, IEND, %REF(' '), 1, 0) C C CUT OFF TRAILING + SIGNS C IF (INDEX (IARRAY, IEND, IEND, %REF('+ '), 1, 1) .NE. 0) 1 IEND=IEND-1 C C CUT OFF LEADING + SIGNS C IF (INDEX (IARRAY, KSTART, KSTART, %REF('+ '), 1, 1) .NE. 0) + KSTART = KSTART + 1 C C LOOK FOR LEADING NEGATIVE SIGN C NEG = INDEX (IARRAY, KSTART, KSTART, %REF('- '), 1, 1) IF (NEG .EQ. 0) GO TO 2 KSTART = KSTART + 1 GO TO 4 C C LOOK FOR TRAILING NEGATIVE SIGNS C 2 NEG = INDEX (IARRAY, IEND, IEND, %REF('- '), 1, 1) IF (NEG .NE. 0) IEND = IEND - 1 C C LOOK FOR A DECIMAL POINT C 4 PERIOD = INDEX (IARRAY, KSTART, IEND, %REF('. '), 1, 1) C C ADJUST LENGTH FOR FIELD PRIOR TO DECIMAL POINT C IEND2 = IEND IF (PERIOD .GT. 0) IEND2 = PERIOD - 1 LEN = IEND2 - KSTART + 1 C C CONVERT INTEGER BEFORE DECIMAL POINT (IF ANY) C DO 50 I = 1, LEN K = (KSTART + I) / 2 IBYTE = IARRAY(K) .AND. '177'O IF (K + K .NE. KSTART + I) IBYTE = IARRAY(K) / '400'O C C STOP CONVERSION AT FIRST CODE =< BLANK C IF (IBYTE .LE. '40'O) GO TO 110 C C SKIP OVER COMMAS C IF (IBYTE .EQ. '54'O) GO TO 50 C C LEGITIMATE DIGIT? C IBYTE = IBYTE - '60'O IF (IBYTE .LT. 0 .OR. IBYTE .GT. 9) GO TO 120 C C ADD IN LATEST DIGIT C DPFPN = 10.0D0 * DPFPN + IBYTE 50 CONTINUE C IF (IEND2 .GE. IEND) GO TO 110 KSTART = PERIOD + 1 LEN = IEND - KSTART + 1 EX = 1.0D0 C C CONVERT THE DIGITS AFTER THE DECIMAL POINT C DO 100 I = 1, LEN K = (KSTART + I) / 2 IBYTE = IARRAY(K) .AND. '177'O IF(K + K .NE. KSTART + I) IBYTE = IARRAY(K) / '400'O C C STOP ((CONVERSION AT FIRST CODE <= BLANK C IF (IBYTE .LE. '40'O) GO TO 110 C C SKIP OVER COMMAS C IF (IBYTE .EQ. '54'O) GO TO 100 C C LEGITIMATE DIGIT? C IBYTE = IBYTE - '60'O IF (IBYTE .LT. 0 .OR. IBYTE .GT. 9) GO TO 120 EX = EX * 0.1D0 DPFPN = DPFPN + EX * IBYTE 100 CONTINUE C C APPLY SIGN C 110 IF (NEG .NE. 0) DPFPN = -DPFPN RETURN C C ERROR RETURNS C 120 IERR = KSTART + I - 1 RETURN END Y C BLANKS, A LEADING/TRAILING - SIGN, A LEADING/TRAILING C + SIGN (IGNORED), ONE DECIMAL POINT (AT davel/vms/FORCOM.COM;1 644 37 1770 4443 3515016365 7550 ! $ IF .NOT. P1 .EQS. "" THEN GOTO NEXT $ SET VERIFY !==============================F O R C O M================================ != = != WRITTEN BY J. L. PUTMAN - OCTOBER 3, 1983 = != MODIFIED BY D. C. LEE - OCTOBER 18, 1984 = != = != COMMAND FILE TO COMPILE A FORTRAN SUBROUTINE SOURCE FILE TO A = != FORTRAN OBJECT FILE .. = != ().FOR ---> ().OBJ = != = != ().OBJ STOWED IN SN.OLB FOR LATER LINKAGE BY @FORCOMLIN OR @FORLIN = != = != ***** PRINTOUT ON LPA0 ***** = != = !========================================================================= $ SET NOVERIFY $ INQUIRE PNT "Do you want a compiler listing printed ? (Y/N) ...." $ START: $ INQUIRE PROGRAM "Enter name of SUBROUTINE source module ...." $ GOTO NEXTA $ NEXT: $ PNT = "N" $ PROGRAM = P1 $ NEXTA: $ IF PROGRAM .EQS. "" THEN GOTO L1 $ ON ERROR THEN GOTO L2 $ IF PNT .EQS. "N" THEN GOTO LAB1 $! FORTRAN 'PROGRAM'.FOR /LIST /DEBUG /CROSS_REFERENCE /NOI4 - $! /CHECK /SHOW /NOSTANDARD $ FORTRAN 'PROGRAM'.FOR /LIST /CROSS_REFERENCE /NOI4 - /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO LAB2 $ LAB1: $! FORTRAN 'PROGRAM'.FOR /NOLIST /DEBUG /CROSS_REFERENCE /NOI4- $! /CHECK /SHOW /NOSTANDARD $ FORTRAN 'PROGRAM'.FOR /NOLIST /CROSS_REFERENCE /NOI4- /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ LAB2: $ LIBRARY/REPLACE SN 'PROGRAM' $ DELETE 'PROGRAM'.OBJ.* $ DIR 'PROGRAM'.* $ GOTO START $ L1: $ INQUIRE PNT "Do you want a library directory listing printed ? (Y/N) ...." $ IF PNT .NES. "Y" THEN GOTO END $ LIBRARY SN /LIST=SNLIST $ PRINT SNLIST /DEVICE=LPA0 /DELETE $ GOTO END $ L2: $ IF PNT .EQS. "N" THEN GOTO START $ PRINT 'PROGRAM'.LIS.* /DEVICE=LPA0 /DELETE $ GOTO START $ END: $ EXIT !========================================================================= GATIVE SIGN C NEG = INDEX (IARRAY, KSTART, KSTART, %REF('- '), 1, 1) IF (NEG .EQ. 0) GO TO 2 KSTART = KSTART + 1 GO TO 4 C C LOOK FOR TRAILING NEGATIVE SIGNS C 2 NEG = INDEX (IARRAY, IEND, IEND, %REF('- '), 1, 1)davel/vms/FORCOMLIN.COM;3 644 37 1770 4614 3515016367 10117 ! $ IF .NOT. P1 .EQS. "" THEN GOTO NEXT $ SET VERIFY !============================F O R C O M L I N============================ != = != WRITTEN BY J. L. PUTMAN - OCTOBER 3, 1983 = != MODIFY BY D. C. LEE - OCTOBER 18, 1984 = != = != COMMAND FILE TO COMPILE A FORTRAN MAIN SOURCE FILE TO A FORTRAN = != OBJECT FILE ... = != ().FOR ---> ().OBJ = != = != ().OBJ IS *NOT* STOWED IN SN.OLB - SINCE YOU MUST RECOMPILE = != EACH TIME THE UNDERLYING SUBROUTINES ARE CHANGED. = != = != ().OBJ IS STOWED IN DIRECTORY FOR ACCESS BY @FORLIN = != = != THEN TO LINK THIS FORTRAN OBJECT FILE WITH SUBROUTINES FROM = != SN.OLB TO CREATE AN EXECUTABLE MODULE ... --> ().EXE = != AND FORM THE EXECUTABLE PLOT MODULES WHEN NECESSARY. = != PLOT ROUTINES ARE ONLY USED WHEN BSNIPS IS BEING COMPILED AND = != LOADED. = != = != ().EXE IS STOWED IN DIRECTORY FOR ACCESS BY RUN COMMANDS = != = !========================================================================= $ SET NOVERIFY $ START: $ INQUIRE PROGRAM "Enter name of the FORTRAN MAIN program source module ...." $ GOTO NEXTA $ NEXT: $ PROGRAM = P1 $ NEXTA: $ IF PROGRAM .EQS. "" THEN GOTO END $ IF PROGRAM .EQS. "BSNIPS" THEN GOTO LAB2 $! $ FORTRAN 'PROGRAM'.FOR /NOLIST /CROSS_REFERENCE /NOI4 - /CHECK /SHOW /NOSTANDARD /NOOPTIMIZE $ LINK/NOMAP 'PROGRAM'.OBJ+SN/LIBRARY $! $ DIR 'PROGRAM'.* $ GOTO START $! $ LAB2: $ WRITE SYS$OUTPUT " " $ WRITE SYS$OUTPUT " USE SPECIFIC ROUTINE TO COMPILE & LINK " $!PLACE BSNIPS COMPILATION AND LINK PROCEDURE CALL HERE*************** $! $ END: $ EXIT !========================================================================= KSTART + 1 GO TO 4 C C LOOK FOR TRAILING NEGATIVE SIGNS C 2 NEG = INDEX (IARRAY, IEND, IEND, %REF('- '), 1, 1)davel/vms/FORLIN.COM;1 644 37 1770 7172 3515016373 7555 ! $ IF .NOT. P1 .EQS. "" THEN GOTO NEXT $ SET VERIFY !==============================F O R L I N================================ != = != WRITTEN BY J. L. PUTMAN - OCTOBER 3, 1983 = != MODIFIED BY D. C. LEE - OCTOBER 18, 1984 = != = != COMMAND FILE TO CREATE A FORTRAN EXECUTABLE FILE FROM A MAIN = != PROGRAM OBJECT MODULE AND OBJECT LIBRARY... = != = != ().OBJ ---> ().EXE = != = != THIS PROCEDURE IS FOR USE WITH THE FOLLOWING: = != ESNIPS = != CSNIPS = != RSNIPS = != TOSNIPS = != FRSNIPS = != = != BSNIPS MAY ALSO BE LINKED USING THIS PROCEDURE. SEVERAL = != PLOT INTERFACE LIBRARIES EXIST AND THE ACTUAL LIBRARY SHOULD BE = != REFERENCED IN A SPECIAL LINKING PROCEDURE. THE SPECIAL LINKING = != PROCEDURE CALL SHOULD BE ENTERED IN AND CALLED FROM THIS PROCEDURE. = != = != ().OBJ WAS STORED IN THE SNIPS DIRECTORY BY A PREVIOUS COMPILATION = != = != LINKING THE MAIN OBJECT MODULE WILL USE THE FOLLOWING LIBRARIES: = != = != SN -------- ().FOR AND ().MAR OBJECT LIBRARY = != = != AND OTHER PLOT-INTERFACE AND PLOT LIBRARIES AS = != REQUIRED. = != = != ().EXE IS STORED IN THE SNIPS DIRECTORY FOR ACCESS BY RUN COMMANDS = != = != ***** PRINTOUT ON LPA0 ***** = != = !========================================================================= $ SET NOVERIFY $ INQUIRE PNT "Do you want a loadmap listing printed ? (Y/N) ...." $ START: $ INQUIRE PROGRAM "Enter name of FORTRAN main program object module ...." $ GOTO NEXTA $ NEXT: $ PNT = "N" $ PROGRAM = P1 $ NEXTA: $ IF PROGRAM .EQS. "" THEN GOTO END $ IF PROGRAM .EQS. "BSNIPS" THEN GOTO LAB3 $ IF PNT .EQS.(( "N" THEN GOTO LAB1 $ LINK/MAP='PROGRAM'.MAP /FULL 'PROGRAM'.OBJ+SN/LIBRARY /CROSS_REFERENCE $ PRINT 'PROGRAM'.MAP /DEVICE=LPA0 /DELETE $ GOTO LAB2 $ LAB1: $ LINK/NOMAP 'PROGRAM'.OBJ+SN/LIBRARY $ LAB2: $ SET PROT=(S:RE,W:RE,G:RE,O:RWED) 'PROGRAM'.EXE $ DIR 'PROGRAM'.* $ GOTO START $ LAB3: $ @SWNLIN $ SET PROT=(S:RE,W:RE,O:RWED,G:RE) SWNBSNIPS.EXE $ @CALLIN $ SET PROT=(S:RE,W:RE,O:RWED,G:RE) CALBSNIPS.EXE $ @DDNLIN $ SET PROT=(S:RE,W:RE,O:RWED,G:RE) DDNBSNIPS.EXE $ ! @XRXLIN $ ! SET PROT=(S:RE,W:RE,O:RWED,G:RE) XRXBSNIPS.EXE $ GOTO START $ END: $ EXIT !========================================================================= = != ().OBJ ---> ().EXE = != = != THIS PROCEDURE IS FOR USE WITH THE FOLLOWING: = != ESNIPS = != CSNIPS davel/vms/FROMSNIPS.FOR;1 644 37 1770 17625 3515016404 10173 C*** SYSEM: SNIPS, PROGRAM: FRSNIPS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C VAX/VMS FORTRAN 77 VERSION. ( CREATES A .M5 FORMAT FILE ) C C -.M1 ---> C -.A2 ---> -.M5 C -.D3 ---> C C THE FILE DEFINITIONS MAY BE FOUND IN SECTIONS 3.3.1 THRU 3.3.6 C OF THE SNIPS USER'S MANUAL. C C C AUTHOR: D. N. ANDERSON -- JULY 1984 C UPDATED FOR .M5 FORMAT JANUARY 1985 C MODIFY: DAVID C. LEE -- MAY 1985 C C******************************************************************* C PROGRAM FRSNIPS C IMPLICIT INTEGER*2 (I-N) C C MAX LENGTH OF PWI CHAIN PARAMETER (MAXPWI=400) C MAX # OF HOLIDAYS PARAMETER (MAXHOL=50) C MAX NUMBER OF ITEM TAGS PARAMETER (MAXNAC=100) C COMMON /SCH00/ IREV(4), FEXTN(10) C INTEGER*2 IDTE1(5), IDTE1A(5), IDTE1B(5), IDTE1C(5) INTEGER*2 IDTE1D(5), IDTE1F(5) INTEGER*2 IDTE1G(5), IDTEH(36), IOUT(37) INTEGER*2 ITIMD(4), ITIMF(4), ITIMG(4) INTEGER*2 HOLID(MAXHOL), IPOUT(10), ITAGLST(5,MAXNAC) INTEGER*2 T1(39), T2(39), IM12(16), IM13(50) INTEGER*2 DT(8), CMD(10,2), NSW(2,2) INTEGER*2 MODCU(6), PWIC(2,MAXPWI) INTEGER*2 IDEV(9), JDEV(9), FEXTN, LDEV(9) C DATA IREV /'9-','19','-8','4 '/ DATA FEXTN /'.M','1.','A2','.D','3.','M5','.A','5.','D6',' '/ C C <> C I = MDYBN ( I ) CALL LDAY ( DT, 1, I ) *** CALL TIME ( DT(6), IER ) C C INITIALIZE DATE & TIME STRINGS CALL BLANK ( IDTE1, 1, 10 ) CALL BLANK ( IDTE1A, 1, 10 ) CALL BLANK ( IDTE1B, 1, 10 ) CALL BLANK ( IDTE1C, 1, 10 ) CALL BLANK ( IDTE1D, 1, 10 ) CALL BLANK ( IDTE1F, 1, 10 ) CALL BLANK ( IDTE1G, 1, 10 ) CALL BLANK ( ITIMD, 1, 8) CALL BLANK ( ITIMF, 1, 8) CALL BLANK ( ITIMG, 1, 8) CALL BLANK ( IPOUT, 1, 20) C C GO INTERR0GATE THE COMMAND LINE N = 2 IDEV(1) = 0 CALL COMFI (N, CMD, NSW) IF ( N-1 .EQ. 0 ) 10, 40, 20 10 STOP ERROR IN OPENING "COM.CM" C C POSSIBLE FILE NAMES IN COMMAND LINE. 20 CALL BLANK ( IDEV, 1, 18 ) DO 24 J=1, 9 24 IDEV(J) = CMD(J,2) C C OUTPUT THE GENERAL DIRECTIONS FOR THIS PROGRAM C 40 WRITE (6,44) IREV, DT 44 FORMAT (/' Program: FRSNIPS -- Rev. ',4A2, + ' Run: ',5A2,I5,":",I2,":",I2/ + /20X,'Convert a set of schedule files'/ + 33X,'from'/ + 26X,'unformatted binary'/ + 34X,'to'/ + 19X,'sequential formatted ASCII files.'/) C C DO WE ALREADY HAVE FILE NAME? IF ( IDEV(1) .EQ. 0 ) GO TO 56 C C GET NAME OF SCHEDULE AND SYNTHESIZE THE 1ST 2 FILE NAMES C WRITE (6,53) 53 FORMAT (' Name of Schedule? ', $ ) READ (5,55) IDEV 55 FORMAT (9A2) C CREATE THE FIRST 2 FILE NAMES. 56 L = LENGTH( IDEV, 18) J = INDEX ( IDEV, 1, L, '.', 1, 1 ) IF ( J .GT. 0 ) L = J - 1 IF ( L .LT. 1 ) GOTO 500 CALL BLANK ( IDEV, L+1, 18 ) CALL SUBSTR ( JDEV, 1, IDEV, 1, 18 ) C C SEE IF "FILEM1" EXISTS CALL SUBSTR ( IDEV, L+1, FEXTN, 1, 3 ) CALL SUBSTR ( JDEV, L+1, FEXTN, 10, 12 ) NEW = NEWFIL ( IDEV ) IF( NEW .EQ. 0 ) GOTO 58 WRITE (6,57) IDEV 57 FORMAT (/' FILE NOT FOUND: ',9A2,' - TRY AGAIN.'/) IDEV(1) = 0 GOTO 40 C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C C OPEN -.M1 FILE C*** 58 OPEN ( 1, IDEV, 1, IER ) IF ( IER .EQ. 1 ) GO TO 60 WRITE (3,59) IDEV, IER 59 FORMAT ("*** COULDN'T OPEN FILE: ",9A2," IER =",I6) GO TO 500 C C OPEN -.M5 FILE FOR OUTPUT C*** 60 CALL DFILW( JDEV, IER ) C*** CALL OPEN( 2, JDEV, 3, IER ) IF( IER .NE. 1 ) STOP 'COULDN''T OPEN -.M5' C C READ -.M1 FILE & LOAD VARIABLES C READ (1) NAC,NWID,NPWICH,NPWID, + IDAILY,ICSTART,IDATAD,NWDPW,NHOL,T1,T2, + MODCU,IBARDD,BARFACT, + NPHASE,IPSTART,IPEND,NUPDTE IF ( NHOL .LE .0 ) GOTO 62 READ (1) (HOLID(I),I=1,NHOL) 62 IF ( IPWICH .LE. 0 ) GOTO 64 READ (1) ((PWIC(J,I),J=1,2),I=1,NPWICH) C C C CONVERT DATES TO ALFA FORMAT 64 CALL LDAY ( IDTE1(2), 0, IDATAD ) CALL LDAY ( IDTE1A(2), 0, IPSTART ) CALL LDAY ( IDTE1B(2), 0, IPEND ) CALL LDAY ( IDTE1C(2), 0, ICSTART ) IJK = MODCU(1) CALL LDAY ( IDTE1D(2), 0, IJK ) IJK = MODCU(2) CALL HHCMM ( ITIMD ,IJK ) IJK = MODCU(3) CALL LDAY ( IDTE1F(2), 0, IJK ) IJK = MODCU(4) CALL HHCMM ( ITIMF ,IJK ) IJK = MODCU(5) CALL LDAY ( IDTE1G(2), 0, IJK ) IJK = MODCU(6) CALL HHCMM ( ITIMG, IJK ) C C C OUTPUT FILENAME ON COMMENT LINE C WRITE (2,100) IDEV 100 FORMAT (' C',5X,'************** SCHEDULE: ',9A2,' **************') C C OUTPUT 'F' FORMAT DATES & TIMES C WRITE (2,102) 102 FORMAT (/' C'6X,'CREATION DATE/TIME UPDATE DATE/TIME' + ' CALCULATION DATE/TIME') WRITE (2,105) IDTE1D,ITIMD,IDTE1F,ITIMF,IDTE1G,ITIMG 105 FORMAT (' F'4X,5A2,4X,4A2,4X,5A2,4X,4A2,4X,5A2,4X,4A2) C C OUTPUT 'G' FORMAT PLOTTING FACTORS C WRITE (2,106) 106 FORMAT (/' C',4X,' DAYS/PL. DATE PLOT FACTOR') WRITE (2,107) IBARDD, BARFACT 107 FORMAT (' G',7X,I6,10X,F7.3) C WRITE (2,109) 109 FORMAT ('') C C C OUTPUT 'H' FORMAT HOLIDAYS C NLNS = (NHOL+7)/8 IF ( NLNS .LT. 1 ) GOTO 71 K = 1 DO 70 I=1, NLNS CALL BLANK ( IDTEH, 1, 80 ) J = 1 66 IF ( K .GT. NHOL ) GOTO 68 CALL LDAY ( IDTEH(J), 0, HOLID(K) ) K = K + 1 J = J + 5 IF ( J .LT. 35 ) GOTO 66 68 IF ( J .LT. 5 ) GOTO 71 WRITE (2,69) IDTEH 69 FORMAT (' H',5X,36A2) 70 CONTINUE C C OUTPUT TITLES IN 'T' FORMAT C 71 WRITE (2,110) (T1(I),I=1,36) 110 FORMAT (' T',5X,36A2) WRITE (2,112) (T2(I),I=1,36) 112 FORMAT (' T',5X,36A2) C C OUTPUT 'S' FORMAT LINE C WRITE (2,115) 115 FORMAT(/' C',4X,' DATA DATE PROJ. START PROJ. END CALENDER' + ' WK DY/WK DY/WK # REV.') WRITE (2 ,120) IDTE1,IDTE1A,IDTE1B,IDTE1C,NWDPW,IDAILY,NUPDTE 120 FORMAT (' S',4X,5A2,3X,5A2,3X,5A2,3X,5A2,4X,I2,7X,I2,6X,I2) C C WRITE (2,121) 121 FORMAT ('') C C C OUTPUT 'A'FORMAT TAG DATA 'D' FORMAT DESCRIPTION C AND 'P' FORMAT PWA'S C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C READ -.A2 & D3 FILES C C PREPARE FILE NAMES AND OPEN .A2 FILES CALL SUBSTR ( IDEV, L+1, FEXTN, 4, 6 ) C*** CALL OPEN ( 3, IDEV, 1, IER, 32 ) IF ( IER .NE. 1 ) STOP 'COULDN''T OPEN -.A2' C C PREPARE FILE NAME & OPEN D3 FILE CALL SUBSTR ( IDEV, L+1, FEXTN, 7, 9 ) C*** CALL OPEN ( 4, IDEV, 1, IER, 100 ) IF ( IER .NE. 1 ) STOP 'COULDN''T OPEN -.D3' C C CREATE A TAGLIST C DO 122 I=1,NAC READ ( 4, REC=I ) IM13 DO 122 J=1, 5 122 ITAGLST(J,I) = IM13(J+1) C C NOW READ IN THE RECORDS DO 250 I=1, NAC C READ ( 3, REC=I ) IM12 READ ( 4, REC=I ) IM13 C C OUTPUT 'A' FORMAT LINE FOR THIS ACTIVITY C CALL BLANK ( IOUT, 1, 74 ) C C INSERT ACTUAL START DATE IF .NE. 0 C IF ( IM12(11) .EQ. 0 ) GOTO 123 ISTART = IM12(11) + IPSTART CALL LDAY ( IOUT(1), 0, ISTART ) C C IF REMAINING DURATION = 0 THEN INSERT ACTUAL STOP DATE C 123 IF ( IM12(3) .GT. 0 ) GOTO 125 ISTOP = IM12(12) + IPSTART CALL LDAY ( IOUT(12), 0, ISTOP ) C DUR = IM12(2) / 10 DURM = IM12(3) / 10 125 WRITE (2,130) (IM13(I),I=2,6), DUR, DURM, (IOUT(I),I=1,20) 130 FORMAT(' A'5X,5A2,4X,F5.1,4X,F5.1,4X,20A2) C C OUTPUT 'D' FORMAT LINE FOR THIS ACTIVITY C WRITE(2,135) (IM13(I),I=7,42) 135 FORMAT(' D',5X,36A2) C C C OUTPUT 'P' FORMAT LINE(S) FOR THIS ACTIVITY C C CALL BLANK ( IOUT, 1, 40 ) L = 1 IFWD = IM12(15) C C 136 IF ( IFWD .EQ. 0 ) GOTO 190 CALL ASMPWI(PWIC,IFWD,ITAGLST,IDAILY,NWDPW,IPOUT,ITYP,ICODTE) IF ( ITYP .EQ. -1 ) STOP ' PWA CHAIN ERROR' CALL SUBSTR ( IOUT, L, IPOUT, 1, 10 ) L=L+12 C IF ( L .LT. 73 ) GOTO 149 WRITE (2,195) IOUT CALL BLANK ( IOUT, 1, 74 ) L = 1 C C SKIP IF NOT A REGULAR PWA OR NOT EARLIER THAN START DATE C 149 IF ( ITYP .GT. 1 ) GOTO 150 IFWD = IABS(PWIC(2,IFWD)) GOTO 136 C C FURTHER DATA REGARDING THIS PWA C 150 IFWD= IABS (PWIC(2,(IABS(PWIC(2,IFWD))))) GOTO 136 C 190 IF ( L .EQ. 1 ) GOTO 239 WRITE(2,195) IOUT 195 FORMAT(' P',5X,37A2) C C INSERT A BLANK LINE C 239 WRITE (2,240) 240 FORMAT('') 250 CONTINUE C 500 STOP 'FRSNIPS' END davel/vms/FRSNIPS.FOR;1 644 37 1770 15530 3515016412 7727 ((C*** SYSTEM: SNIPS, PROGRAM: FRSNIPS ***** COPYRIGHT 1984 SOFTWARE NORTH *** C C CONVERT A SET OF BINARY SCHEDULE FILES TO FORMATTED C SEQUENTIAL ASCII FILES. THE FILES INCLUDED ARE: C -.M1 ---> -.M4 C -.A2 ---> -.A5 C -.D3 ---> -.D6 C C THE FILE DEFINITIONS MAY BE FOUND IN SECTIONS 3.3.1 THRU 3.3.6 C OF THE SNIPS USER'S MANUAL. C C SUBROUTINES REQUIRED: BLANK, COMFI, LDAY, SUBSTR, TIME C FUNCTIONS REQUIRED: INDEX, LENGTH, NEWFIL C C AUTHOR: D. N. ANDERSON -- JULY 1984 C MODIFY: D. C. LEE -- AUG 1984 C C******************************************************************* C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX, TIME C PARAMETER (MAXPWI=3000) C MAX LENGTH OF PWI CHAIN PARAMETER (MAXHOL=100) C INTEGER*2 IREV(4), FEXTN(10) INTEGER*2 IDTE1(5), IDTE1A(5), IDTE1B(5), IDTE1C(5) INTEGER*2 IDTE2(10), IDTE8(40), HOLID(MAXHOL) INTEGER*2 T1(39), T2(39), IM12(16), IM13(50) INTEGER*2 DT(8), CMD(10,2), NSW(2,2) INTEGER*2 MODCU(6), PWIC(2,MAXPWI) INTEGER*2 IDEV(9), JDEV(9), LDEV(9) C CHARACTER*20 CF1, CF2, CF3 C DATA IREV/'10','-1','8-','84'/ DATA FEXTN/'.M','1.','A2','.D','3.','M4','.A','5.','D6',' '/ C C <> C I = MDYBN(I) CALL LDAY( DT, 1, I ) CALL TIME( DT(6), IER ) C C INITIALIZE DATE STRINGS CALL BLANK( IDTE1, 1, 10 ) CALL BLANK( IDTE1A, 1, 10 ) CALL BLANK( IDTE1B, 1, 10 ) CALL BLANK( IDTE1C, 1, 10 ) CALL BLANK( IDTE2, 1, 20 ) CALL BLANK( IDTE8, 1, 80 ) C C GO INTERR0GATE THE COMMAND LINE N = 2 IDEV(1) = 0 CALL COMFI(N, CMD, NSW) IF(N-1)10, 40, 20 10 STOP ' ERROR IN COMMAND LINE ' C C POSSIBLE FILE NAMES IN COMMAND LINE. 20 CALL BLANK( IDEV, 1, 18 ) DO 24 J=1,9 24 IDEV(J) = CMD(J,2) C C OUTPUT THE GENERAL DIRECTIONS FOR THIS PROGRAM C 40 WRITE(6,44) IREV, DT 44 FORMAT(/' Program: FRSNIPS -- Rev. ',4A2, + ' Run: ',5A2,I5,':',I2,':',I2/ + /20X,'Convert a set of schedule files'/ + 33X,'from'/ + 26X,'unformatted binary'/ + 34X,'to'/ + 19X,'sequential formatted ASCII files.'/) C C DO WE ALREADY HAVE FILE NAME? IF( IDEV(1) .NE. 0 ) GO TO 56 C C GET NAME OF SCHEDULE AND SYNTHESIZE THE 1ST 2 FILE NAMES C WRITE(6,53) 53 FORMAT(' Name of Schedule? ',$) READ(5,55) IDEV 55 FORMAT(9A2) C CREATE THE FIRST 2 FILE NAMES. 56 L = LENGTH(IDEV, 18) J=INDEX(IDEV,1,L,%REF('.'),1,1) IF( J .GT. 0 ) L = J - 1 IF( L .LT. 1 ) GOTO 500 CALL BLANK( IDEV, L+1, 18 ) CALL SUBSTR( JDEV, 1, IDEV, 1, 18 ) C C SEE IF "FILEM1" EXISTS CALL SUBSTR( IDEV, L+1, FEXTN, 1, 3 ) CALL SUBSTR( JDEV, L+1, FEXTN, 10, 12 ) NEW = NEWFIL( IDEV ) IF( NEW .EQ. 0 ) GOTO 58 WRITE(6,57) IDEV 57 FORMAT(/' FILE NOT FOUND: ',9A2,' - TRY AGAIN.'/) IDEV(1) = 0 GOTO 40 C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C COPY FILE -.M1 ----> -.M4 C C OPEN -.M1 FILE C 58 IL = LENGTH( IDEV, 18 ) CALL SUBSTR ( %REF(CF1), 1, IDEV, 1, IL ) OPEN (UNIT=11, FILE=CF1, STATUS='OLD',FORM='UNFORMATTED', + IOSTAT=IER) IF( IER .EQ. 0 ) GO TO 60 WRITE(6,59) IDEV, IER 59 FORMAT(' *** COULD NOT OPEN FILE: ',9A2,' IER =',I6) GO TO 500 C C OPEN -.M4 FILE FOR OUTPUT 60 REWIND 11 CALL SUBSTR ( %REF(CF1), 1, JDEV, 1, IL ) OPEN (UNIT=2, FILE=CF1, STATUS='NEW',IOSTAT=IER, + RECORDTYPE='FIXED', RECL=80 ) IF( IER .NE. 0 ) STOP ' COULD NOT OPEN -.M4' C C READ -.M1 FILE C REWIND 2 READ (11) NAC, NWID, NPWICH, NPWID, + IDAILY, ICSTART, IDATAD, NWDPW, NHOL, T1, T2, + MODCU, IBARDD, BARFACT, + NPHASE, IPSTART, IPEND, NUPDTE IF(NHOL .LE. 0) GO TO 62 READ (11) (HOLID(I),I=1,NHOL) 62 IF(NPWICH .LE. 0) GO TO 64 READ (11) ((PWIC(J,I),J=1,2),I=1,NPWICH) C C WRITE -.M4 FILE C 64 CALL LDAY( IDTE2(2), 0, ICSTART ) CALL LDAY( IDTE2(7), 0, IDATAD ) CALL LDAY( IDTE1(2), 0, IPSTART ) CALL LDAY( IDTE1A(2), 0, MODCU(1) ) CALL LDAY( IDTE1B(2), 0, MODCU(3) ) CALL LDAY( IDTE1C(2), 0, MODCU(5) ) C WRITE(2,65) NAC, NWID, NPWICH, NPWID, IDAILY, IDTE2, NWDPW, + NHOL, IDTE1, IPEND, NUPDTE, T1, T2, + IDTE1A, MODCU(2), IDTE1B, MODCU(4), + IDTE1C, MODCU(6), IBARDD, BARFACT, NPHASE 65 FORMAT(5I5,10A2,2I5,5A2,2I5,' '/ + 39A2,' '/ + 39A2,' '/ + 5A2,I5,5A2,I5,5A2,2I5,F10.5,I5,' ') C C OUTPUT HOLIDAYS NLNS = (NHOL+7)/8 IF( NLNS .LT. 1 ) GOTO 72 K = 1 DO 70 I=1, NLNS CALL BLANK( IDTE8, 1, 80 ) J = 2 66 IF( K .GT. NHOL ) GOTO 68 CALL LDAY( IDTE8(J), 0, HOLID(K) ) K = K + 1 J = J + 5 IF( J .LT. 40 ) GOTO 66 68 WRITE(2,69) IDTE8 69 FORMAT(40A2) 70 CONTINUE C C OUTPUT PWI CHAIN 72 IF( NPWICH .LE. 0 ) GOTO 76 C PUT 5 CHAIN ELEMENTS PER LINE I1 = 1 I2 = 5 74 IF( I2 .GT. NPWICH ) I2 = NPWICH WRITE(2,73) ((PWIC(I,J),I=1,2),J=I1,I2) 73 FORMAT(5(I9,I7)) IF( I2 .EQ. NPWICH ) GOTO 76 I1 = I1 + 5 I2 = I2 + 5 GOTO 74 76 NLNS = 4 + NLNS + (NPWICH+4)/5 WRITE(6,75) IDEV, JDEV, NLNS 75 FORMAT(/5X,9A2,' ---> ',9A2,' -- completed.', + I6,' Records.'/) CALL CLOSE( 11, IER ) CALL CLOSE( 2, IER ) C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C COPY -.A2 ----> -.A5 C C PREPARE FILE NAMES AND OPEN FILES CALL SUBSTR( IDEV, L+1, FEXTN, 4, 6 ) CALL SUBSTR( JDEV, L+1, FEXTN, 13, 15 ) C CALL SUBSTR ( %REF(CF2), 1, IDEV, 1, IL ) OPEN (UNIT=12, FILE=CF2, STATUS='OLD', + FORM='UNFORMATTED', RECL=8, ACCESS='DIRECT', + ORGANIZATION='RELATIVE', RECORDTYPE='FIXED', + IOSTAT=IER) IF( IER .NE. 0 ) STOP ' COULD NOT OPEN -.A2 ' CALL SUBSTR ( %REF(CF2), 1, JDEV, 1, IL ) OPEN (UNIT=2, FILE=CF2, STATUS='NEW',IOSTAT=IER, + RECORDTYPE='FIXED', RECL=80 ) IF( IER .NE. 0 ) STOP ' COULD NOT OPEN -.A5 ' C C NOW COPY THE RECORDS REWIND 2 DO 90 I=1, NAC READ (12,REC=I) IM12 WRITE(2,85) IM12 85 FORMAT(16I5) 90 CONTINUE C WRITE(6,75) IDEV, JDEV, NAC CALL CLOSE( 12, IER ) CALL CLOSE( 2, IER ) C C . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . C C COPY -.D3 ----> -.D6 C C PREPARE FILENAMES AND OPEN FILES CALL SUBSTR( IDEV, L+1, FEXTN, 7, 9 ) CALL SUBSTR( JDEV, L+1, FEXTN, 16, 18 ) C CALL SUBSTR ( %REF(CF3), 1, IDEV, 1, IL ) OPEN (UNIT=13, FILE=CF3, STATUS='OLD', + FORM='UNFORMATTED', RECL=25, ACCESS='DIRECT', + ORGANIZATION='RELATIVE', RECORDTYPE='FIXED', + IOSTAT=IER) IF( IER .NE. 0 ) STOP ' COULD NOT OPEN -.D3 ' CALL SUBSTR ( %REF(CF3), 1, JDEV, 1, IL ) OPEN (UNIT=2, FILE=CF3, STATUS='NEW', IOSTAT=IER, + RECORDTYPE='FIXED', RECL=116 ) IF( IER .NE. 0 ) STOP ' COULD NOT OPEN -.D6' C C NOW COPY THE RECORDS C REWIND 2 DO 100 I=1, NAC READ (13,REC=I) IM13 WRITE(2,95) IM13 95 FORMAT(I5,45A2,4I5,' ') 100 CONTINUE C WRITE(6,75) IDEV, JDEV, NAC CALL CLOSE( 13, IER ) CALL CLOSE( 2, IER ) C C 500 STOP ' FRSNIPS' END WRITE (2,130) (IM13(I),I=2,6), DUR, DURM, (IOUT(I),I=1,20) 130 FORMAT(' A'5X,5A2,4X,F5.1,4X,F5.1,4X,20A2) C C OUTPUT 'D' FORMAT LINE FOR THIS ACTIVITY C WRIdavel/vms/GETIP.FOR;1 644 37 1770 17475 3515016417 7472 C.~* SYSYEM: SNIPS, PROGRAM: GETIP ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C OBTAIN THE PLOT AREA PARAMETERS FROM THE INSTALLATION PARAMETER FILE. C C PARAMETERS: C DRWG - DRAWING DESIGNATOR LETTER FOLLOWED BY A BLANK OR A NUMBER C TO INDICATE THE DRAWING SIZE AND BORDERS (IF ANY), C X, Y - COORDINATES OF THE LOWER LEFT CORNER OF THE PLOTTING C AREA (A RECTANGLE), C W, H - WIDTH AND HEIGHT OF THE PLOTTING AREA, C C DIRECTIONS FOR WRITING FILE 'SNIPS.IP': C THIS FILE WHICH IS CREATED BY THE EDITOR IS USED TO C DEFINE THE CHARACTERISTICS OF THE PLOTTING INSTALLATION, CERTAIN C STANDARD PLOT PARAMETERS AND THE DIMENSIONS AND LABELING FOR C CERTAIN INSTALLATION STANDARD DRAWINGS. C THE RECORDS MAY APPEAR IN ANY ORDER. THE FIELDS SHOWN ARE C SEPARATED FROM EACH OTHER WITH 1 OR MORE BLANKS OR TABS. C ALL DIMENSIONAL VALUES ARE IN INCHES. FIELDS SHOWN IN < > C ARE VARIABLE INFORMATION WHICH MAY BE FILLED IN AS DESCRIBED C IN THE FIELD DEFINITIONS AT THE END OF THE RECORD C DEFINITIONS. THE OTHER FIELDS MUST BE RECORDED EXACTLY C AS SHOWN. C C RECORD DEFINITIONS; C C PLOT SIZE RECORD(DEFAULTS TO THIS IF A SPECIFIC DRAWING C DEFINITION IS NOT USED): C S C EG: S 1.5 0.5 34. 23. C C PEN WARMUP AREA (DEFAULTS TO THIS AREA IF A A DRAWING SPECIFIC C WARMUP AREA IS NOT REQUESTED): C W C EG: W -2.0 3.0 1.5 12.0 C C PEN MOUNTING BLOCK DEFINITION: C H C EG: H 2 C C PEN DEFINITION(MAX. OF 6): C P 1 1 1 1 C EG: P 2 1 1 1 1 #4 RED C C DRAWING SIZE-LOCATION DEFINITION: C S C EG: D2 S 2.5 5.0 32. 18. C C DRAWING SPECIFIC PEN DEFINITION(MAX. OF 6): C P 1 1 1 1 C (REPLACES ALL GENERAL PEN DEFINITIONS IF PRESENT). C EG: E9 P 3 1 1 1 1 (BLACK #7) C DRAWING PEN WARMUP AREA: C W C EG: E9 W -1.0 1.0 1.0 8.0 C C DRAWING DEFINITION (DRAW A RECTANGLE): C R C EG: D2 R 1.5 0.5 34. 23. 1 C C DRAWING DEFINITION (DRAW A LINE): C L C EG: E9 L 4.5 1.0 20.5 1.0 2 C C DRAWING DEFINITION (PLOT LETTERING): C A C EG: D2 A 19.6 2.3 .2 0. 1 STRING TO PLOT C C DRAWING DEFINITION (INSERT SPECIAL VALUES IN LEGENDS): C D C EG: D2 D 9.5 14.6 .08 45. 1 PG C C FIELD DEFINITIONS; C C ARE THE X AND Y COORDINATES OF THE LOWER LEFT C CORNER OF THE FEATURE TO BE PLOT((TED. THE ORIGIN C OF THE COORDINATE SYSTEM IS ASSUMED TO BE THE RECORD C LOWER LEFT CORNER OF THE PAPER. C ARE THE COORDINATES TO THE SECOND END OF A LINE TO C BE DRAWN FROM X1,Y1 TO THIS POINT. C WIDTH OF THE FEATURE TO BE PLOTTED (EXTENT ALONG C THE X-AXIS). C HEIGHT OF THE FEATURE TO BE PLOTED (IT'S C EXTENT ALONG Y-AXIS) OF THE CHARACTER HEIGHT IF A C STRING IS TO BE PLOTTED. C NUMBER OF POSITIONS IN THE PLOTTER'S PEN BLOCK AT C WHICH PENS CAN BE MOUNTED. C NUMBER OF A SPECIFIC PEN. PENS WILL BE MOUNTED IN THE C PEN BLOCK MODULO 'HOLDERS'. C DESCRIPTION OF THE PEN TO WHICH A SPECIFIC NUMBER IS C ASSIGNED. MAX. OF 10 CHARACTERS. C 1 OR 2 LETTER DRAWING IDENTIFIER. THIS CORRESPONDS C TO THE IDENTIFIER USED IN THE PROGRAMS COMMAND C LINE. MUST NOT BEGIN WITH S, W, M, OR P. C ANGLE AT WHICH A STRING OF CHARACTERS IS TO BE C PLOTTED. GIVEN IN DEGREES COUNTER-CLOCKWISE FROM C THE POSITIVE X-AXIS. C STRING OF CHARACTERS TO BE PLOTTED WITH THE C LEFTMOST CHARACTER AT THE SPECIFIED COORDINATES. C MAX. OF 40 CHARACTERS. C A CODE CHOSEN FROM THE FOLLOWING LIST WHICH CAUSES C THE VARIABLE THUS IDENTIFIED TO BE DRAWN FROM THE C PROGRAM AND PLOTTED AT THE SPECIFIED LOCATION. C CODE VARIABLE DEFINITION C CD CURRENT DATE. C DD DATA DATE. C IF EITHER THE WORD 'INCLUDED' OR THE WORD 'OMITTED' C ACCORDING AS COMPLETED ACTIVITIES ARE C TO BE INCLUDED IN THE BARCHART OR OMITTED. C OF TOTAL NUMBER OF PAGES MAKING UP THIS PLOT. C OR 'ORIGINAL DURATION'/'REMAINING DURATION' TO DESCRIBE C THE BASIS ON WHICH THIS SCHEDULE WAS CALCULATED. C PG CURRENT PAGE (SHEET) NUMBER. C PF PROJECT FINISH DATE. C PS PROJECT START DATE. C SF SCHEDULE'S FILE NAME. C SL PLOT/PRINT SELECT FILE NUMBER OR 'NONE' C RN SCHEDULE FILE REVISION NUMBER. C T1 UPPER SCHEDULE TITLE C T2 LOWER SCHEDULE TITLE C C ENTER VIA: C CALL GETIP (DRWG, X, Y, W, H) C C SUBROUTINES REQUIRED: BLANK, INFREE C FUNCTIONS REQUIRED: INDEX, LENGTH C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: MAR 1985 C C**************************************************************************** C SUBROUTINE GETIP (DRWG, X, Y, W, H) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C COMMON /PENS/ NCP, ! NO. OF CURRENT PEN 1 NHOLD, ! NUMBER OF PEN HOLDERS 2 NPINH(5), ! NO. OF PEN IN EACH HOLDER 3 NPENS, ! NUMBER OF PENS TO USE 4 PDESCR(5,10), ! DESCRIPTIONS OF EACH PEN 5 WX, WY, ! COORDINATES OF WARMUP AREA 6 WW, WH, ! WIDTH & HEIGHT OF WARMUP AREA 7 NWUP, ! NO. OF WARMUPS DONE 8 IPFILE(9) ! NAME OF INSTALLATION PARAM. FILE C INTEGER*2 DRWG, ISTRING(20), PDESCR C REAL FP(5) C C <> C CALL BLANK (PDESCR, 1, 100) C OPEN (UNIT=8, FILE='SNIPS.IP', IOSTAT=IERR, STATUS='OLD', + RECL=80, FORM='FORMATTED', RECORDTYPE='VARIABLE') IF (IERR .NE. 0) GO TO 28 C C DEFAULT PARAMETERS C X = 999. WX = 999. Y = 0.0 H = 0.0 W = 0.0 WY = 0.0 WW = 0.0 WH = 0.0 ISPEN = 0 C C READ FILE AND SKIM OFF THE GENERAL PARAMETERS AND THE C LOCATION OF THE WARMUP AREA. C 10 CALL INFREE (8, FP, N, 5, LBL, NL, 2, ISTRING, LSTR, 40, *30) IF (LBL .NE. DRWG) GO TO 20 IF (INDEX (ISTRING, 1, 1, %REF('S'), 1, 1) .EQ. 0) GO TO 15 IF (N .LT. 4) GO TO 10 C C SPECIFIC DRAWING PLOT AREA DEFINITION C X = FP(1) Y = FP(2) W = FP(3) H = FP(4) GO TO 10 15 IF (INDEX (ISTRING, 1, 1, %REF('W'), 1, 1) .EQ. 0) GO TO 16 IF (N .LT. 4) GO TO 10 C C SPECIFIC DRAWING WARMUP AREA DEFINITION C WX = FP(1) WY = FP(2) WW = FP(3) WH = FP(4) GO TO 10 C C DRAWING SPECIFIC PEN DEFINITION C 16 IF (INDEX (ISTRING, 1, 1, %REF('P'), 1, 1) .EQ. 0) GO TO 10 IF (ISPEN .EQ. 0) CALL BLANK (PDESCR, 1, 100) ISPEN = 1 IF (N .LT. 5) GO TO 10 IF (LSTR .LT. 3) GO TO 10 NP = FP(1) + 0.1 IF (NP .LT. 1 .OR. NP .GT. 10) 1 CALL FATAL ( 31, 'BAD PEN # IN SNIPS.IP', NP, MAXPENS ) DO 18 I = 1, 5 18 PDESCR(I,NP) = ISTRING(I + 1) GO TO 10 C C SEARCH FOR GENERAL PLOT PARAMETERS C 20 IF (INDEX (LBL, 1, 1, %REF('H'), 1, 1) .EQ. 0) GO TO 22 IF (N .LT. 1) GO TO 10 IF (NHOLD .NE. 0) GO TO 10 C C FOUND HOLDER DEFINITION C NHOLD = FP(1) + 0.1 GO TO 10 22 IF (INDEX (LBL, 1, 1, %REF('W'), 1, 1) .EQ. 0) GO TO 24 IF (N .LT. 4) GO TO 10 IF (WX .NE. 999.) GO TO 10 C C TENTATIVELY USE THE GENERAL WARMUP AREA C WX = FP(1) WY = FP(2) WW = FP(3) WH = FP(4) GO TO 10 24 IF (INDEX (LBL, 1, 1, %REF('P'), 1, 1) .EQ. 0) GO TO 26 IF (ISPEN .NE. 0) GO TO 10 IF (N .LT. 5) GO TO 10 IF (LSTR .LT. 1) GO TO 10 NP = FP(1) + 0.1 IF (NP .LT. 1 .OR. NP .GT. 10) + CALL FATAL ( 32, 'BAD PEN # IN SNIPS.IP', NP, MAXPENS ) C C SAVE PEN DEFINITION C DO 25 I=1,5 25 PDESCR(I,NP) = ISTRING(I) GO TO 10 26 IF (INDEX(LBL, 1, 1, %REF('S'), 1, 1) .EQ. 0) GO TO 10 IF (N .LT. 4) GO TO 10 IF (X .NE. 999.) GO TO 10 C C TENTATIVE PLOT AREA DEFINITION C X = FP(1) Y = FP(2) W = FP(3) H = FP(4) GO TO 10 C C COULDN'T OPEN 'SNIPS.IP' C 28 WRITE (6,29) 29 FORMAT (' GETIP - NO INSTALLATION PARAMETER FILE. USE DEFAULTS.') RETURN C C END OF FILE C 30 IF (X .EQ. 999.) X = 0.0 IF (WX .EQ. 999.) WX = 0.0 IF (NPENS .GT. 0) GO TO 100 NPENS = (LENGTH (PDESCR,100) + 9) / 10 IF (NPENS .LT. 1) NPENS = 1 100 REWIND 8 RETURN END LD', + FORM='UNFORMATTED', RECL=8, ACCESS='DIRECT', + ORGANIZATION='RELATIVE', RECORDTYPE='FIXED', + IOSTAT=IER) IF( IER .NE. 0 ) STOP ' COULD NOT OPEN -.A2 davel/vms/HEDRS.FOR;1 644 37 1770 7224 3515016421 7431 C.~* SYSTEM: SNIPS, PROGRAM: HEDRS ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C VAX/VMS VERSION C C PAGE HEADER WRITING ROUTINE. C C PARAMETERS: C ITYPE - TYPE OF HEADER; C 0 = HEADER FOR SCHEDULE BASED ON REM. DUR. C 1 = HEADER FOR SCHEDULE BASED ON ORIG. DUR. REPORT, C 2 = HEADER FOR PRINT SELECTION FILE LISTING, C NLINE - CURRENT LINE NUMBER, C INCR - NUMBER OF LINES REQUESTED FOR THE CURRENT OUTPUT, C NPAGE - CURRENT PAGE NUMBER, C ORDER - ARRAY WHICH DESCRIBES THE SORT ORDER OF THE C OUTPUT. C C ENTER VIA: C CALL HEDRS (ITYPE, NLINE, INCR, NPAGE, ORDER) C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: OCT 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 C C****************************************************************** C SUBROUTINE HEDRS (ITYPE, NLINE, INCR, NPAGE, ORDER) C IMPLICIT INTEGER*2 (I-N) C COMMON /TITLE/ T1(39), ! UPPER TITLE LINE 1 T2(39), ! LOWER TITLE LINE 2 BASED(10), ! 'ORIGINAL/REMAINING DURATION' 3 DTETME(10), ! CURRENT DATE TIME STRING 4 STAR(5), ! PROJECT START DATE STRING 5 FIN(5), ! PROJECT FINISH DATE STRING 6 DD(5), ! DATA DATE STRING 7 IDEV(9), ! SCHEDULE NAME 8 NUPDTE, ! NO. OF FILE UPDATES 9 LPRTSL(2), ! NAME OF PRINT SELECT. FILE A INCLWD(4), ! INCL./OMIT WORK DAY NOS. B INCLAC(4), ! INCLUDE COMPLETED ACTIV.? C NLPPG ! MAX. NO. OF LINES PER PAGE C INTEGER*2 T1, T2, BASED, DTETME, STAR, FIN, DD, ORDER(46) C C <> C NLINE = NLINE + INCR IF (NLINE .LT. NLPPG) RETURN NLINE = INCR NPAGE = NPAGE + 1 IF (ITYPE .EQ. 2) GO TO 50 C C WRITE GENERAL PORTION OF THE HEADER C WRITE (4,7) DTETME, NPAGE, IDEV, DD, NUPDTE, T1, INCLWD, 1 LPRTSL, T2, INCLAC, BASED, STAR, ORDER, FIN 7 FORMAT ('1',10A2,33X,'PROJECT SCHEDULE REPORT',45X,'PAGE',I4/ 1 ' ..................................................', 2 '..................................................', 3 '..............................'/ 4 ' SCHEDULE: ',9A2,79X,'DATA DATE: ',5A2/ 5 ' UPDATE:',I6,13X,39A2,3X,'WORK DAYS: ',4A2/ 6 ' PRINT SELECT FILE: ',2A2,3X,39A2,3X,'COMPL. ACTIV: ',4A2/ 7 ' SCHEDULE BASED ON: ',10A2,68X,'START DATE: ',5A2/ 8 ' SORTED ON: ',46A2,4X,'FINISH DATE: ',5A2) IF (ITYPE .NE. 0) GO TO 20 C C HEADER FOR SCHEDULE REPORT BASED ON REMAINING DURATION C WRITE (4,13) 13 FORMAT('0',46X,'DURATION',5X,'ACTUAL',6X,'EARLY',7X,'ACTUAL', 3 6X,'EARLY',5X,'FREE-FLOAT LATE'/ 4 2X,'ITEM TAG DESCRIPTION',19X,'ORIG REM START', 5 7X,'START',7X,'FINISH',6X,'FINISH',5X,'FINISH', 6 7X,'FINISH') GO TO 100 C C HEADER FOR SCHED. REPORT BASED ON ORIGINAL DURATION C 20 WRITE (4,23) 23 FORMAT ('0',46X,'DURATION',5X,'EARLY',7X,'EARLY',5X, 1 'FREE-FLOAT LATE',9X,'PREVIOUS'/ 2 2X,'ITEM TAG DESCRIPTION',19X,'ORIG REM',4X, 3 'START',7X,'FINISH',5X,'FINISH',7X,'FINISH',5X,'WORK ACTIVITIES') GO TO 100 C C HEADER FOR PRINT SELECT FILE C 50 WRITE (4,53) DTETME, NPAGE, IDEV, T1, LPRTSL, T2 53 FORMAT ('1',10A2,27X,'LISTING OF PRINT SELECTION/SORT FILE',38X, 1 'PAGE',I4/' ........................................', 2 '..................................................', 3 '........................................'/ 4 ' SCHEDULE: ',9A2 / 27X,39A2/ 5 ' PRINT SELECT: ',2A2,3X,39A2// 6 ' TEST NO. INCL./EXCL. START CHAR. END CHAR.', 7 ' NO. OF CHAR. STRING') 100 WRITE (4,103) 103 FORMAT (' ..................................................', 1 '..................................................', 2 '..............................'/) RETURN END DRAWING SPECIFIC PEN DEFINITION C 16 IF (INDEX (ISTRING, 1, 1, %REF('P'), 1, 1) .EQ. 0) GO TO 10 IF (ISPEN .EQ. 0) CALL BLANK (PDESCR, 1, 100) ISPEN = 1 IF (N .LT. 5) GO TO 10 IF (LSTR .LT. 3) GO TO 10 NP = FP(1) + 0.1 IF (NP .LT. 1 .OR. NP .GT. 10) 1 CALL FATAL ( 31, 'BAD PEN # IN SNIPS.IP', NP, MAXPENS ) DO 18 I = 1, 5 18 PDESCR(I,NP) = I((davel/vms/HELP.FOR;1 644 37 1770 11207 3515016425 7334 C.~* SYSTEM: SNIPS , PROGRAM: HELP ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C WRITE OUT INFORMATIONAL MESSAGES WHICH ARE STORED ON A DISK FILE C WHEN THE REPLY ROUTINE DETECTS A REQUEST FOR 'HELP'. C C FILE FORMAT: C 1) DIRECT ACCESS DISK FILE WITH RECORDS 76 BYTES LONG, C 2) THE FIRST 4 BYTES OF EACH LINE IS AN INTEGER CONTAINING; C A) THE MESSAGE NUMBER (IT MUST EQUAL THE RECORD NUMBER), OR C B) A ZERO TO INDICATE THAT THIS LINE IS THE CONTINUATION C OF A MESSAGE (ALL LINES AFTER THE FIRST), C 3) THE REMAINING 72 BYTES OF THE MESSAGE MAY BE EITHER; C A) THE ACTUAL TEXT THAT IS TO BE PRINTED OUT, OR C B) A STRING OF 'I4' FIELDS CONTAINING THE NUMBERS OF A C SERIES OF MESSAGES WHICH ARE TO BE PRINTED AS A RESPONSE C TO THIS 'HELP' REQUEST. C C........................................................................ C C NOTE: FILE *.HP MUST BE OPENED TO THE MESSAGE FILE PRIOR TO THE C FIRST CALL TO THIS ROUTINE. USE FILE 15. C AN OUTPUT FILE MUST ALSO BE OPENED AND ITS CHANNEL NUMBER C IS DEFINED TO BE 6. C NHELPER IS NUMBER OF RECORDS PER HELP FILE. C C..................................................................... C C PARAMETERS: C NMSG - NUMBER OF THE MESSAGE RECORD TO BE WRITTEN (OR USED C TO SPECIFY WHICH RECORDS ARE TO BE ACCESSED) C C ENTER VIA: C CALL HELP (NMSG) C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: NGET C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTMAN -- LAST MOD: NOV 1983 VAX/VMS C C******************************************************************************* C SUBROUTINE HELP (NMSG) C IMPLICIT INTEGER*2 (I-N) C INTEGER*2 IM(36), IM2(36) C CHARACTER*40 JQUERY C C <> C C OUTPUT FILE = 6 C ICHAN = 6 C C FIND NUMBER OF RECORDS IN FILE C IFIL = 15 C C SET FILE LIMITS FOR EACH OF 4 TYPES C C *****************N O T E*********************** C * * C * THESE LIMITS M U S T BE RESET IF THE ***.HE * C * FILES ARE EVER ALTERED IN LENGTH * C * * C *****************N O T E*********************** C INQUIRE (UNIT = IFIL, NAME = JQUERY) IZJLP = 1+INDEX (JQUERY,']') IF (JQUERY(IZJLP:IZJLP) .EQ. 'B') NHELPER = 205 IF (JQUERY(IZJLP:IZJLP) .EQ. 'C') NHELPER = 22 IF (JQUERY(IZJLP:IZJLP) .EQ. 'E') NHELPER = 196 IF (JQUERY(IZJLP:IZJLP) .EQ. 'R') NHELPER = 96 C C VALID MESSAGE NUMBER? C IF (NMSG .LE. 0 .OR. NMSG .GT. NHELPER) GO TO 200 WRITE (ICHAN, 10) 10 FORMAT (' ') C C YES. PICK UP THE FIRST RECORD. C IAV = NMSG ICT = 1 READ (IFIL ' IAV) NREC, IM C C IS THIS RECORD NO. THE BEGINNING OF A MESSAGE? C IF (NREC .NE. NMSG) GO TO 200 C C YES. DOES IT CONTAIN TEXT OR THE NUMBERS OF OTHER MESSAGES? CFUN IR = NGET (IM, 1, 4, IERR) C IF (IERR .NE. 0) GO TO 30 IF (IR .GT. NHELPER) GO TO 30 IF (IR .LT. 1) GO TO 30 C C NUMBERS OF OTHER MESSAGES FOUND C I = 5 20 IAV = IR READ (IFIL 'IAV) NREC, IM2 IF (NREC .NE. IR) GO TO 200 WRITE (ICHAN, 40) IM2 22 IAV = IAV + 1 IF (IAV .GT. NHELPER) GO TO 50 READ (IFIL 'IAV) NREC, IM2 IF (NREC .NE. 0) GO TO 28 C C TEST LOOP TO KEEP HELP MESSAGES TO 20 LINES PER SCREEN C ICT = ICT + 1 IF (ICT .LT. 20) GO TO 500 ICT = 1 WRITE (ICHAN,501) 501 FORMAT ('O---PRESS RETURN TO CONTINUE WHEN DONE READING---',$) READ (ICHAN-1,502) ICTJ 502 FORMAT (A2) WRITE (ICHAN,503) 503 FORMAT (/////) 500 WRITE (ICHAN, 40) IM2 GO TO 22 C C FINISHED WITH NUMBERS OF ALL OTHER MESSAGES? C 28 IF (I .GT. 69) GO TO 50 CFUN IR = NGET (IM, I, 4, IERR) IF (IERR .NE. 0) GO TO 50 IF (IR .GT. NHELPER .OR. IR .LT. 1) GO TO 50 I = I + 4 GO TO 20 C C NORMAL - DIRECTLY REFERENCED MESSAGES C 30 WRITE (ICHAN, 40) IM 40 FORMAT (' ', 36A2) 42 IAV = IAV + 1 IF (IAV .GT. NHELPER) GO TO 50 READ (IFIL ' IAV) NREC, IM IF (NREC .NE. 0) GO TO 50 C C TEST LOOP TO KEEP HELP MESSAGES TO 20 LINES PER SCREEN C ICT = ICT + 1 IF (ICT .LT. 20) GO TO 600 ICT = 1 WRITE (ICHAN,601) 601 FORMAT ('O---PRESS RETURN TO CONTINUE WHEN DONE READING---',$) READ (ICHAN-1,602) ICTJ 602 FORMAT (A2) WRITE (ICHAN,603) 603 FORMAT (/////) 600 WRITE (ICHAN, 40) IM GO TO 42 200 WRITE (ICHAN, 204) 204 FORMAT (' NO HELP AVAILABLE FOR THIS QUESTION') 50 WRITE (ICHAN, 10) RETURN 300 WRITE (ICHAN, 301) 301 FORMAT (' HELP FILE IS NOT OPEN - ERROR') WRITE (ICHAN, 10) RETURN END 10) + CALL FATAL ( 32, 'BAD PEN # IN SNIPS.IP', NP, MAXPENS ) C C SAVE PEN DEFINITION C DO 25 I=1,5 25 PDESCR(I,NP) = ISTRING(I) GO TO 10 26 IF (INDEX(LBL, 1, 1, %REF('S'), 1, 1) .EQ. 0) GO TO 10 IF (N .LT. 4) GO TO 10 IF (X .NE. 999.) GO TO 10 C C TENTATIVE PLOT AREA DEFINITION C X = FP(1) Y = FP(2) W = FP(3) H = FP(4) GO TO 10 C C COULDN'T OPENdavel/vms/HHCMM.FOR;1 644 37 1770 1777 3515016432 7431 C.~* SYSTEM: LIBRARY, PROGRAM: HHCMM ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C VAX/VMS VERSION C C CONVERT A 16-BIT INTEGER VERSION OF THE TIME OF DAY (256*HR + MIN) C INTO A 3 WORD STRING OF THE FORM: 'HH:MM ' C C INPUT: C IBINTME - TIME OF DAY ( 256 * HR + MIN ) C C OUTPUT: C ITMSTR(3) - TIME STRING IN FORM; 'HH:MM ' C C ENTER VIA: C CALL HHCMM (ITMSTR, IBINTME) C C SUBROUTINES REQUIRED: SUBSTR C FUNCTIONS REQUIRED: NPUT C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1983 C MODIFY: J. L. PUTMAN -- LAST MOD: DEC 1983 C C***************************************************************************** C SUBROUTINE HHCMM (ITMSTR, IBINTME) C IMPLICIT INTEGER*2 (I-N) INTEGER*2 ITMSTR(3) C C <> C IHR = IBINTME / 256 MIN = IBINTME - 256 * IHR C C BLANK RESULT STRING AND INSERT COLON C CALL SUBSTR (ITMSTR, 1, %REF(' : '), 1, 6) C C CONVERT HOUR AND MINUTE INTO 2 CHARACTER STRINGS C IS = NPUT (ITMSTR, 1, 2, %REF('00'), IHR) IS = NPUT (ITMSTR, 4, 2, %REF('00'), MIN) RETURN END Rdavel/vms/HSNIPS.FOR;1 644 37 1770 6342 3515016442 7573 C.~* SYSTEM: SNIPS, PROGRAM: HSNIPS ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C PROGRAM TO SET UP THE DIRECT ACCESS 'HELP' FILE FOR C ANY PROGRAM. IT REQUIRES A SEQUENTIAL FILE IN THE CORRECT FORMAT C AS INPUT. ...HE -----> ...HP C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: CLOSE C C AUTHOR: J. L. PUTMAN -- LAST MOD: OCT 1983 C MODIFY: D. C. LEE -- LAST MOD: MAR 1985 C C ***** AFTER YOU RUN THIS PROGRAM, MAKE SURE THAT YOU C ALWAYS CHECK THE LENGTH OF THE 4 HELP FILES IN THE C PROGRAM HELP.FOR TO KEEP THE LIMIT OF EACH FILE CORRECT ***** C C********************************************************************* C IMPLICIT INTEGER*2 (I-N) C C ! 'BS'NIPS.HE 205 C ! 'CS'NIPS.HE 22 C ! 'ES'NIPS.HE 196 C ! 'RS'NIPS.HE 96 C INTEGER*2 IM(36) INTEGER*2 BS,CS,ES,RS,ST C DATA BS /'BS'/, CS /'CS'/, ES /'ES'/, RS /'RS'/, ST /'ST'/ C C <> C C OPEN LIST FILE ON UNIT 4 C OPEN (UNIT=4, STATUS='NEW', FILE='HSNIPSDMP.LIS', RECL=132, + DISPOSE='PRINT/DELETE', IOSTAT=IERR) 33 WRITE (6,4) 4 FORMAT ('0''HELP'' FILE SETUP. INPUT SEQUENTIAL FILE NAME? ', 1 '(BS, CS, ES, RS, OR STOP)',$) READ (5,5) IN 5 FORMAT (A2) C C OPEN FILES C IF (IN .EQ. BS) GO TO 100 IF (IN .EQ. CS) GO TO 110 IF (IN .EQ. ES) GO TO 120 IF (IN .EQ. RS) GO TO 130 IF (IN .EQ. ST) GO TO 989 WRITE (6,990) 990 FORMAT (' INVALID ENTRY - ONLY BS, CS, ES, RS OR STOP IS A ', 1 'VALID ENTRY') GO TO 33 100 OPEN (UNIT=2, FILE='BSNIPS.HE', STATUS='OLD', ERR=991) OPEN (UNIT=10, 1 STATUS='NEW', FILE='BSNIPS.HP', ACCESS='DIRECT', 2 BLOCKSIZE=40, INITIALSIZE=300, EXTENDSIZE=100, 3 ORGANIZATION='RELATIVE', RECL=19, ERR=992) GO TO 150 110 OPEN (UNIT=2, FILE='CSNIPS.HE', STATUS='OLD', ERR=991) OPEN (UNIT=10, 1 STATUS='NEW', FILE='CSNIPS.HP', ACCESS='DIRECT', 2 BLOCKSIZE=40, INITIALSIZE=300, EXTENDSIZE=100, 3 ORGANIZATION='RELATIVE', RECL=19, ERR=992) GO TO 150 120 OPEN (UNIT=2, FILE='ESNIPS.HE', STATUS='OLD', ERR=991) OPEN (UNIT=10, 1 STATUS='NEW', FILE='ESNIPS.HP', ACCESS='DIRECT', 2 BLOCKSIZE=40, INITIALSIZE=300, EXTENDSIZE=100, 3 ORGANIZATION='RELATIVE', RECL=19, ERR=992) GO TO 150 130 OPEN (UNIT=2, FILE='RSNIPS.HE', STATUS='OLD', ERR=991) OPEN (UNIT=10, 1 STATUS='NEW', FILE='RSNIPS.HP', ACCESS='DIRECT', 2 BLOCKSIZE=40, INITIALSI((ZE=300, EXTENDSIZE=100, 3 ORGANIZATION='RELATIVE', RECL=19, ERR=992) GO TO 150 C C MAKE THE TRANSFER C 150 N = 0 10 READ (2, 13, END = 20) IMM, IM 13 FORMAT (I4, 36A2) 1130 FORMAT (1X, I4, 36A2,/) 1131 FORMAT (1X, I4, 36A2) N = N + 1 WRITE (10'N) IMM, IM WRITE (6,1131) IMM, IM WRITE (4,1130) IMM, IM GO TO 10 20 WRITE (6, 23) N, IN WRITE (4, 23) N, IN 23 FORMAT (1X, I6, ' RECORDS TRANSFERED TO: ', A2, 'NIPS.HP') CALL CLOSE (2) CALL CLOSE (10) GO TO 33 989 CLOSE (4) STOP 'NORMAL END HSNIPS' 991 CALL FATAL ( 811, 'FAILED TO OPEN INPUT FILE', IERR, 0 ) 992 CALL FATAL ( 812, 'FAILED TO OPEN OUTPUT FILE', IERR, 0 ) END 'CS'NIPS.HE 22 C ! 'ES'NIPS.HE 196 C ! 'RS'NIPS.HE 96 C INTEGER*2 IM(36) INTEGER*2 BS,CS,ES,RS,ST C DATA BS /'BS'/, CS /'CS'/, ES /'ES'/, RS /'RS'/, ST /'ST'/ C C <> C C OPEN LIST FILE ON UNIT 4 C OPEN (UNIT=4, STATUS='NEW', FILE='HSNdavel/vms/IFIRST.FOR;1 644 37 1770 2347 3515016461 7571 C.~* SYSTEM: LIBRARY, PROGRAM: IFIRST ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C ROUTINE TO EXAMINE A STRING AND RETURN A POINTER TO THE C FIRST NON-BLANK CHARACTER. TAB CHARACTERS ARE TREATED AS BLANKS. C C INPUT: ISTRING - STRING (2 CHARACTERS/WORD) C ISTART - POINTER TO THE FIRST CHARACTER AT WHICH C EXAMINATION IS TO BEGIN C IEND - POINTER TO CHARACTER AT WHICH C SEARCH IS TO END. C C OUTPUT: IFIRST - BYTE POINTER TO FIRST NON-BLANK C CHARACTER AT OR AFTER 'ISTART' IN STRING. C ZERO IS RETURNED IF NO NON-BLANK CHARACTERS C WERE FOUND. C C ENTER VIA: C J = IFIRST (ISTRING, ISTART, IEND) C C C EXAMPLE: C 123456789012 C ISTRING = ' TEST X ' C THEN; C IFIRST (ISTRING, 1, 12) = 4 C IFIRST (ISTRING, 8, 12) = 9 C IFIRST (ISTRING, 10, 12) = 0 C C SUBROUTINES REQUIRED: INDEX C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: NOV 1975 C MODIFY: J. L. PUTMAN -- LAST MOD: OCT 1983 C C***************************************************************************** C FUNCTION IFIRST (ISTRING, ISTART, IEND) C IMPLICIT INTEGER*2 (I-N) C EXTERNAL INDEX C INTEGER*2 ISTRING(1) C C <> C IFIRST = INDEX (ISTRING, ISTART, IEND, %REF(' '), 1, 0) RETURN END RMAT (A2) C C OPEN FILES C IF (IN .EQ. BS) GO TO 100 IF (IN .EQ. CS) GO TO 110 IF (IN .EQ. ES) GO TO 120 IF (IN .EQ. RS) GO TO 130 IF (IN .EQ. ST) GO TO 989 WRITE (6,990) 990 FORMAT (' INVALID ENTRY - ONLY BS, CS, ES, RS OR STOPdavel/vms/INDEX.MAR;1 644 37 1770 5554 3515016463 7436 ;.~* SYSTEM: LIBRARY, PROGRAM: INDEX ***** COPYRIGHT 1983 SOFTWARE NORTH *** ; ; FUNCTION TO EXAMINE TWO STRINGS AND DETERMINE THE POINT AT WHICH THE ; SECOND BEGINS TO MATCH THE FIRST. IF THE SECOND STRING IS NOT ; COMPLETELY CONTAINED IN THE FIRST A ZERO RESULT IS RETURNED. ; OTHERWISE, THE BYTE NUMBER (STARTING WITH 1) IN THE FIRST STRING ; WHICH BEGINS THE MATCH WITH THE SECOND STRING IS RETURNED. ; IF THE SECOND STRING HAS ZERO LENGTH (OR NEGATIVE LENGTH) THE POINTER ; RETURNED IS TO THE FIRST NON-BLANK CHARACTER IN THE FIRST STRING. ; ; INPUT: ; STRING1 - FIRST STRING (2 CHAR/WORD) STARTING ON WORD BOUNDARY ; ISTART1 - NO. OF BYTE IN 'STRING1' AT WHICH SEARCH IS TO ; BEGIN (FIRST BYTE IS #1 & IS IN LEFT HALF OF WORD) ; IEND1 - NO. OF BYTE IN 'STRING1' AT WHICH SEARCH IS TO END. ; STRING2 - 2ND STRING, STARTING ON WORD BOUNDARY. ; ISTART2 - NUMBER OF THE BYTE IN 'STRING2' AT WHICH MATCH ; IS TO START, ; IEND2 - NUMBER OF BYTE AT WHICH MATCH IS TO END IN 'STRING2'. ; ; OUTPUT: ; INDEX - POINTER TO FIRST CHARACTER IN 'STRING1' WHERE ; A COMPLETE IMAGE OF THE SUBSTRING FOR 'STRING2' ; CAN BE FOUND. (ZERO IF NOT FOUND). ; ; ENTER VIA: ; J=INDEX (STRING1, START1, IEND1, STRING2, ISTART2, IEND2) ; ; EXAMPLES: ; ASSUME STRING1 = 'THIS IS A TARGET', ISTART1 = 1, IEND1 = 16, ; AND STRING2 = 'S A TR' ; ; IF ; ISTART2 = 1, IEND2 = 1 (WE ARE MATCHING 'S' ONLY) ; THEN ; INDEX = 4. ; IF ; ISTART2 = 1, IEND2 = 3 (WE ARE MATCHING 'S A') ; THEN ; INDEX = 7. ; IF ; ISTART2 = 4, IEND2 = 5 (WE ARE MATCHING ' T') ; THEN ; INDEX = 10. ; IF ; ISTART2 = 5, IEND2 = 6 (WE ARE ATTEMPTING TO MATCH 'TR') ; THEN ; INDEX = 0 (NO SUCH MATCH WAS FOUND). ; ; SUBROUTINES REQUIRED: (NONE) ; FUNCTIONS REQUIRED: (NONE) ; ; AUTHOR: D. N. ANDERSON - LAST MOD: SEP 1983 VAX/VMS ; ;**************************************************************************** ; .TITLE INDEX .IDENT /01/ ; .ENTRY INDEX,^M ; MOVL 4(AP),R4 ; A(STRING1) MOVZWL @8(AP),R3 ; START1 DECL R3 ; START1 - 1 MOVZWL @12(AP),R2 ; END1 SUBL R3,R2 ; LENGTH 1 = END1 - START1 + 1 ADDL R4,R3 ; START 1 = A(STRING1) + START1 - 1 MOVL 16(AP),R0 ; A(STRING2) MOVZWL @20(AP),R1 ; START2 DECL R1 ; START2 - 1 MOVZWL @24(AP),R5 ; END2 SUBL R1,R5 ; LENGTH 2 = END2 - START2 + 1 BLEQ FIRSTC ; LENGTH 2 <= 0 LOOK FOR 1ST NON-BLANK ADDL R0,R1 ; START 2 = A(STRING2) + START2 - 1 ; MATCHC R5,(R1),R2,(R3) ; MATCH SUBSTRING ; BEQLU MATCH CLEAR: CLRW R0 ; NO MATCH BRB DONE ; FIRSTC: SKPC #^X20,R2,(R3) ; LOOK FOR 1ST NON-BLANK IN STRING1 BEQLU CLEAR ; ALL BLANKS MOVL R1,R0 ; R0 --> 1ST NON-BLANK BRB MAT2 ; MATCH: MOVL R3,R0 ; MATCH. R3 --> CHAR FOLLOWING LOCATION SUBL R5,R0 ; R0 --> 1ST CHAR OF LOCATED SUBSTRING MAT2: SUBL R4,R0 ; R0 = # CHAR BEYOND 1ST IN 'STRING1' INCL R0 ; R0 = # OF CHAR AT WHICH SUBSTR STARTS DONE: RET .END HE NUMBERS OF OTHER MESSAGES? CFUN IR = NGET (IM, 1, 4, IERR) C IF (IERR .NE. 0) GO TO 30 IF (IR .GT. NHELPER) GO TO 30 IF (IR .LT. 1) GO TO 30 davel/vms/INFOR.FOR;2 644 37 1770 4160 3515016473 7445 C.~* SYSTEM: SNIPS, PROGRAM: INFOR ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C SELECT AND PRINT INFORMATIONAL MESSAGES FOR THE WORK ACTIVITY C EDITING ROUTINE. C C PARAMETERS: C ICHTAG - 1 IF ADDITIONS OR DELETIONS TO THE WORK ACTIVITY C LIST CAN BE EXPECTED, C ICHDES - 1 IF CHANGES TO THE BEGIN/END STATUS OR ACTIVITY C DESCRIPTION CAN BE EXPECTED, C ICHDRD - >0 IF EITHER DURATION OR REMAINING DURATION IS C TO BE CHANGED, C ICHPWI - 1 IF ANY P.W.I.'S ARE TO BE CHANGED, C IDAILY - 1 IF DURATIONS ARE IN DAYS, (WEEKS OTHERWISE), C C ENTER VIA: C CALL INFOR (ICHTAG, ICHDES, ICHDRD, ICHPWI, IDAILY) C C SUBROUTINES REQUIRED: (NONE) C FUNCTIONS REQUIRED: (NONE) C C AUTHOR: D. N. ANDERSON -- LAST MOD: AUG 1976 C MODIFY: J. L. PUTAMN -- LAST MOD: NOV 1983 C MODIFY: D. C. LEE -- LAST MOD: JUL 1985 C C******************************************************************* C SUBROUTINE INFOR (ICHTAG, ICHDES, ICHDRD, ICHPWI, IDAILY) C IMPLICIT INTEGER*2 (I-N) C COMMON /INF00/ LBL(3,2) C DATA LBL /'WE','EK','S.','DA','YS','. '/ C C <> C IF (ICHTAG .NE. 1) GO TO 20 WRITE (6,10) 10 FORMAT ('0Work activity identifiers hame a max. of 10 char.') C 20 WRITE (6,22) 22 FORMAT ('0An answer of "LIST" to a request for an', 1 ' activity tag will cause all tags'/ 2 ' to be displayed. "REMAIN" lists those', 3 ' unchanged in this edit session. '/ 4 ' The % and * wild cards may be used with these', 5 ' commands.') IF (ICHDES .NE. 1) GO TO 30 C WRITE (6,26) 26 FORMAT ('0Activity descriptions limited to 80 char. (28 char.', 1 ' per line on output).') C 30 IF (ICHDRD .EQ. 0) GO TO 40 ID1 = IDAILY + 1 WRITE (6,32) (LBL(J,ID1), J = 1, 3) 32 FORMAT ('0Durations are to be entered in ',3A2, 1 ' (To nearest tenth.)') C 40 IF (ICHTAG .NE. 1) GO TO 50 WRITE (6,42) 42 FORMAT ('0A zero duration will cause the work activity', 1 ' to be deleted.') C 50 WRITE (6,52) 52 FORMAT ('0An entry of "END" may be used to terminate', 1 ' entry of work activity tags.') C RETURN END TRING1) + START1 - 1 MOVL 16(AP),R0 ; A(STRING2) MOVZWL @20(AP),R1 ; START2 DECL R1 ; START2 - 1 MOVZWL @24(AP),R5 ; END2 SUBL R1,R5 ; LENGTH 2 = END2 - START2 + 1 BLEQ FIRSTC ; LENGTH 2 <= 0 LOOK FOR 1ST NON-BLANK ADDL R0,R1 ; START 2 = A(STRING2) + START2 - 1 ; MATCHC R5,(R1),R2,(R3) ; MATCH SUBSTRING ; BEQLU MATCH CLEAR: CLRW R0 ; NO MATCH BRB DONE ; FIRSTC: SKPC #^X20davel/vms/INFREE.FOR;1 644 37 1770 13377 3515016517 7570 ((C.~* SYSTEM: SNIPS, PROGRAM: INFREE ***** COPYRIGHT 1983 SOFTWARE NORTH *** C C ACCEPT AN 80 COLUMN INPUT OF THE GENERAL FORM: C C