C C C THIS SCHEDULE PROGRAM IS PROVIED COMPLENTS OF: C C MOORE SYSTEMS INC. C A LANDIS & GYR COMPANY C 1730 TECHNOLOGY DRIVE C SAN JOSE, CALIFORNIA 95110 C 408-297-9920 C C C INFRMATION CONTACT IS: BILL CARROLL C C C NO WARRANTY AS TO THE USABILITY OR RELIABILTY OF THIS SOFTWARE IS C MADE EITHER IMPLICITLY OR EXPLICITLY. C C THIS SOFTWARE WAS INTENDED PRIMARLY FOR INHOUSE USE AT MOORE SYSTEMS. C IT IS BEING MADE AVAILABLE FOR USE ON A USER ACCEPT ALL RISK BASES. C C C THIS SOFTEARE MAY OR MAYNOT BE MAINTAINED. ANY MAINTENANCE UPDATES TO C THIS SOFTWARE BY MOORE SYSTEMS MAY OR MAYNOT BE MADE AVAILABLE. C C IMPLICIT INTEGER (A-Z) PARAMETER SIZE=300 C CHANGE BUFFER SIZE TO 110 WAS 200 PARAMETER LINE=110 BYTE CHAR INTEGER*2 COLCNT INTEGER*2 END INTEGER*2 FIRST INTEGER*2 HOLICT INTEGER*2 HOLIEN (10) INTEGER*2 HOLIST (10) INTEGER IDAY (10) BYTE INTEXT (4,20) INTEGER JDAY (10) INTEGER*2 OLENTH INTEGER*2 PART BYTE PDATE(9) INTEGER*2 PERSCT BYTE PERSON (30,20) INTEGER*2 PERNXT (30) INTEGER*2 PERPEV (30) INTEGER*2 PREFLG INTEGER*2 PREQCT INTEGER*2 PREV INTEGER*2 PRNTSW BYTE PTIME(8) BYTE STAR (LINE) INTEGER*2 START BYTE TART (SIZE) BYTE TASK (SIZE,20) INTEGER*2 TASKCT BYTE TCHAR (SIZE) INTEGER*2 TEND (SIZE,2) BYTE TEXT (21) BYTE TITL (110) BYTE TITLK (110,4) BYTE TPERS (SIZE) BYTE TPRER (SIZE,3) INTEGER*2 TSTART (SIZE,2) INTEGER*2 TWORK (SIZE,2) INTEGER*2 UNAVEN (30,10) INTEGER*2 UNAVST (30,10) BYTE USED (10) 9000 FORMAT (1H1, 9A1,1X,8A1) 9001 FORMAT (55A1) 9010 FORMAT (1H ,21X,110A1) 9020 FORMAT (20I3) 9021 FORMAT (1H ,'*** ERROR IN HOLIDAY CARD FIELD',I3, - 20(1X,I3),'***') 9030 FORMAT (21A1,I1,2I3,A1) 9035 FORMAT (1H ,'*** ERROR IN VACATION CARD',20(I3,1X),21A1,'***') 9051 FORMAT (4(20A1)) 9054 FORMAT (1H ,'*** INVALID TASK NAME '80A1,'***') 9057 FORMAT (1H ,'*** INVALID PREREQUISITE NAME FIELD',I3, - 4(1X,20A1),'***') 9101 FORMAT (1H0,20A1,1X,110A1 ) 9111 FORMAT (1H ,17A1,1X,'.',I1,1X,110A1 ) 9120 FORMAT (1H ,20A1,1X, 110A1 ) C C * * * INPUT PROCESSING SECTION * * * C C C INITIALIZE VARIABLES AND CONSTANTS. C CALL DATE(PDATE) CALL TIME(PTIME) HOLICT = 0 PERSCT = 0 PREQCT = 0 PRNTSW = 0 TASKCT = 0 DO 10 I = 1,10 USED (I) = 0 10 CONTINUE DO 40 I = 1,SIZE TART (I) = 0 TCHAR (I) = ' ' TPERS (I) = 0 DO 20 J = 1,2 TEND (I,J) = 0 TSTART (I,J) = 0 TWORK (I,J) = 0 20 CONTINUE DO 30 J = 1,3 TPRER (I,J) = 0 30 CONTINUE 40 CONTINUE WRITE (5,9000) PDATE,PTIME C C READ AND PROCESS HEADER DATA. C DO 100 I = 1,4 READ (4,9001) (TITL (J) , J = 1,55) READ (4,9001) (TITL (J) , J = 56,110) WRITE (5,9010) TITL DO 90 K = 1,110 TITLK (K,I) = TITL (K) 90 CONTINUE 100 CONTINUE C C READ AND PROCESS HOLIDAY DATA. C READ (4,9020) (HOLIST (I) , HOLIEN (I) , I = 1,10) C C C MODIFICATIONS TO ALLOW NULL HOLIDAYS WITHOUT ERRORS RPK. C C* IF (HOLIST (1) .EQ. 0) GO TO 300 200 DO 220 I = 1,10 C* PART OF MOD IS NEXT LINE IF(HOLIST(I).EQ.0)GO TO 220 IF (HOLIST (I) .GT. HOLIEN (I)) GOTO 210 HOLICT = HOLICT + 1 IF (I .EQ. 1) GOTO 220 C* IF (HOLIST (I) .GE. HOLIEN (I-1)) GOTO 220 HOLICT = HOLICT - 1 210 WRITE (5,9021) I , (HOLIST (J) , HOLIEN (J) , J = 1,10) GOTO 300 220 CONTINUE C C PROCESS TASK TRANSACTION CARDS. C 300 READ (4,9030,END=700) TEXT,JPART,OLENTH,NLENTH,CHAR IF (TEXT (1) .EQ. 'E' .AND. TEXT (2) .EQ. 'N' - .AND. TEXT (3) .EQ. 'D') GOTO 500 IPART = JPART IF (IPART .EQ. 0) IPART = 10 IF (TEXT (1) .EQ. ' ') GOTO 400 C C PERSON NAME CARD. C PERSCT = PERSCT + 1 IF (PERSCT .NE. 1) GOTO 310 PERNXT (1) = 1 GOTO 320 310 PERPEV (PERSCT-1) = TASKCT PERNXT (PERSCT) = TASKCT + 1 320 DO 330 I = 1,20 PERSON (PERSCT,I) = TEXT (I) 330 CONTINUE C******** TRACE D WRITE (5,9933) PERSCT,PERNXT(PERSCT),PERPEV(PERSCT) 9933 FORMAT (1H ,'330 ',3I4) C C PROCESS VACATION SCHEDULE. C READ (4,9020) (UNAVST (PERSCT,I) , - UNAVEN (PERSCT,I) , I = 1,10) DO 340 I = 1,10 IF (UNAVST (PERSCT,I) .EQ. 0) GOTO 370 IF (UNAVST (PERSCT,I) .GT. UNAVEN (PERSCT,I)) GOTO 350 IF (I .EQ. 1) GOTO 340 IF (UNAVST (PERSCT,I) .LT. UNAVEN (PERSCT,I-1)) GOTO 350 340 CONTINUE GOTO 370 350 WRITE (5,9035) (UNAVST (PERSCT,J) , - UNAVEN (PERSCT,J) , J = 1,10) , TEXT K = I DO 360 J = K,10 UNAVST (PERSCT,J) = 0 UNAVEN (PERSCT,J) = 0 360 CONTINUE 370 GOTO 300 C C PROCESS TASK ACTIVITY CARD. C 400 TASKCT = TASKCT + 1 DO 410 J = 1,20 TASK (TASKCT,J) = TEXT (J+1) 410 CONTINUE IF (CHAR .NE. ' ') TCHAR (TASKCT) = CHAR TPERS (TASKCT) = PERSCT TWORK (TASKCT,1) = OLENTH IF (NLENTH .GT. 0) GOTO 420 TWORK (TASKCT,2) = OLENTH GOTO 430 420 TWORK (TASKCT,2) = NLENTH 430 TART (TASKCT) = IPART C******TRACE D WRITE (5,9943) TASKCT,TWORK (TASKCT,1), TWORK(TASKCT,2), D - TART (TASKCT) 9943 FORMAT (1H0,'430 ',4I4) GOTO 300 C C PROCESS TASK PREREQUISITE CARDS. C 500 PERPEV (PERSCT) = TASKCT 510 READ (4,9051,END=700) ((INTEXT (I,J) , J = 1,20) , I = 1,4) DO 530 I = 1,TASKCT DO 520 J = 1,20 IF (TASK (I,J) .NE. INTEXT (1,J)) GOTO 530 520 CONTINUE GOTO 540 530 CONTINUE WRITE (5,9054) ((INTEXT (L,M) , M = 1,20) , L = 1,4) GOTO 580 540 KINDEX = I COLCNT = 1 DO 570 I = 2,4 IF (INTEXT (I,1) .EQ. ' ') GO TO 580 DO 560 J = 1,TASKCT DO 550 K = 1,20 IF (TASK (J,K) .NE. INTEXT (I,K)) GOTO 560 550 CONTINUE PREQCT = PREQCT + 1 TPRER (KINDEX,COLCNT) = J COLCNT = COLCNT + 1 GOTO 570 560 CONTINUE WRITE (5,9057) I , ((INTEXT (L,M) , M = 1,20) , L = 1,4) 570 CONTINUE 580 GOTO 500 C C BUILD TABLES SECTION. C 700 PERPEV (PERSCT) = TASKCT 710 PREFLG = 0 DO 930 LOOP1 = 1,PERSCT START = PERNXT (LOOP1) END = PERPEV (LOOP1) DO 810 I = 1,10 IDAY (I) = 0 JDAY (I) = 0 810 CONTINUE IEND = 0 JEND = 0 PART = 10 DO 920 LOOP2 = START,END C C PRE-REQUISITE LOGIC. C IF (TPRER (LOOP2,1) .EQ. 0 .AND. TPRER (LOOP2,2) .EQ. 0 - .AND. TPRER (LOOP2,3) .EQ. 0) GOTO 819 DO 816 I = 1,3 D IF (LOOP2.GT.SIZE.OR.I.GT.3 ) WRITE (5,*) LOOP2,I IF (TPRER (LOOP2,I) .EQ. 0) GOTO 816 JINDEX = TPRER (LOOP2,I) IF (TEND (JINDEX,1) .EQ. 0) GOTO 818 IF (TEND (JINDEX,1) .LT. IEND) GOTO 812 IEND = TEND (JINDEX,1) 812 IF (TEND (JINDEX,2) .LT. JEND) GOTO 816 JEND = TEND (JINDEX,2) 816 CONTINUE DO 817 I = 1,PART IDAY (I) = IEND JDAY (I) = JEND 817 CONTINUE GOTO 819 818 PREFLG = 1 GOTO 930 C C SORT DAY MATRICES. C 819 DO 830 I = 1,10 DO 820 J = 1,9 IF (IDAY (J) .LE. IDAY (J+1)) GOTO 820 ITEMP = IDAY (J) IDAY (J) = IDAY (J + 1) IDAY (J + 1) = ITEMP 820 CONTINUE 830 CONTINUE DO 850 I = 1,10 DO 840 J = 1,9 IF (JDAY (J) .LE. JDAY (J+1)) GOTO 840 ITEMP = JDAY (J) JDAY (J) = JDAY (J+1) JDAY (J+1) = ITEMP 840 CONTINUE 850 CONTINUE 860 TSTART (LOOP2,1) = IDAY (PART) + 1 TSTART (LOOP2,2) = JDAY (PART) + 1 PART = TART (LOOP2) 870 IEND = TWORK (LOOP2,1) * 10 / PART - + IDAY (PART) JEND = TWORK (LOOP2,2) * 10 / PART - + JDAY (PART) C*****TRACE D WRITE (5,9879) PART,IEND,JEND 9879 FORMAT(1H0,'879 ',3I4) IF (HOLICT .EQ. 0) GO TO 885 DO 880 I = 1,HOLICT IF (HOLIST (I) .GE. IDAY (PART) .AND. HOLIST (I) .LE. IEND) - IEND = IEND + HOLIEN (I) - HOLIST (I) + 1 IF (HOLIST (I) .GE. JDAY (PART) .AND. HOLIST (I) .LE. JEND) - JEND = JEND + HOLIEN (I) - HOLIST (I) + 1 880 CONTINUE C******TRACE D WRITE (5,9879) PART,IEND,JEND 885 DO 890 I = 1,10 IF (UNAVST (LOOP1,I) .EQ. 0) GOTO 900 IF (UNAVST (LOOP1,I) .GE. IDAY (PART) .AND. - UNAVST (LOOP1,I) .LE. IEND) IEND = IEND + UNAVEN (LOOP1,I) - - UNAVST (LOOP1,I) + 1 IF (UNAVST (LOOP1,I) .GE. JDAY (PART) .AND. - UNAVST (LOOP1,I) .LE. JEND) JEND = JEND + UNAVEN (LOOP1,I) - - UNAVST (LOOP1,I) + 1 890 CONTINUE C********TRACE D WRITE (5,9879) PART,IEND,JEND 900 TEND (LOOP2,1) = IEND TEND (LOOP2,2) = JEND DO 910 I = 1,PART IDAY (I) = IEND JDAY (I) = JEND 910 CONTINUE C******TRACE D WRITE (5,9992) TSTART(LOOP2,1),TEND(LOOP2,1),TSTART(LOOP2,2), D - TEND(LOOP2,2) 9992 FORMAT (1H0,'920 '4I4) 920 CONTINUE 930 CONTINUE IF (PREFLG .GT. 0) GOTO 710 C C OUTPUT REPORT SECTION. C 1000 PRNTSW = PRNTSW + 1 DO 1140 I = 1,PERSCT START = PERNXT (I) END = PERPEV (I) GOTO (1002,1004,1006) , PRNTSW 1002 IF (PERSON (I,1) .EQ. '+') GOTO 1003 IF (PERSON (I,1) .EQ. '-') GOTO 1140 GOTO 1008 1003 WRITE (5,9000) DO 1001 K = 1,4 1001 WRITE (5,9010) (TITLK (J,K) , J = 1,110) GOTO 1008 1004 IF (PERSON (I,1) .NE. '-') GOTO 1140 PRNTSW = PRNTSW + 1 WRITE (5,9000) DO 1005 K = 1,4 WRITE (5,9010) (TITLK (J,K) , J = 1,110) 1005 CONTINUE GOTO 1008 1006 IF (PERSON (I,1) .NE. '-') GOTO 1140 1008 WRITE (5,9101) (PERSON (I,J) , J = 1,20) , TITL DO 1130 J = START,END DO 1010 K = 1,LINE STAR (K) = ' ' 1010 CONTINUE FIRST = TSTART (J,1) LAST = TEND (J,1) IF (LAST .GT. LINE) LAST = LINE IF (J .EQ. START) GOTO 1015 PREV = TEND (J-1,1) GOTO 1016 1015 PREV = 0 1016 IF (FIRST .EQ. (PREV + 1)) GOTO 1030 IF (FIRST .LT. PREV) GOTO 1030 DO 1020 K = PREV + 1,FIRST STAR (K) = '$' 1020 CONTINUE 1030 DO 1040 K = FIRST,LAST STAR (K) = '+' 1040 CONTINUE FIRST = TSTART (J,2) LAST = TEND (J,2) IF (LAST .GT. LINE) LAST = LINE IF (J .EQ. START) GOTO 1045 PREV = TEND (J-1,2) GOTO 1046 1045 PREV = 0 1046 IF (FIRST .EQ. (PREV + 1)) GOTO 1060 IF (FIRST .LT. PREV) GOTO 1060 DO 1050 K = PREV + 1,FIRST - 1 IF (STAR (K) .EQ. '+') GOTO 1050 STAR (K) = '$' 1050 CONTINUE 1060 DO 1070 K = FIRST,LAST IF (TCHAR (J) .NE. ' ') GOTO 1065 STAR (K) = '*' GOTO 1070 1065 STAR (K) = TCHAR (J) 1070 CONTINUE 1080 DO 1110 K = 1,110 IF (HOLICT .EQ. 0) GO TO 1095 DO 1090 L = 1,HOLICT IF (K .GE. HOLIST (L) .AND. K .LE. HOLIEN (L)) STAR (K) = 'H' 1090 CONTINUE 1095 DO 1100 L = 1,10 IF (STAR (K) .EQ. 'H') GOTO 1100 IF (K .GE. UNAVST (I,L) .AND. K .LE. UNAVEN (I,L)) STAR (K) = 'U' 1100 CONTINUE 1110 CONTINUE IF (TART (J) .EQ. 10) GOTO 1120 WRITE (5,9111) (TASK (J,K) , K = 1,17) , TART (J) , STAR GOTO 1130 1120 WRITE (5,9120) (TASK (J,K) , K = 1,20) , STAR 1130 CONTINUE 1140 CONTINUE IF (PRNTSW .EQ. 1) GOTO 1000 END