File: XFLT1.FT of Disk: Disks/PDP8-Net/disk2-fortran
(Source file text)
C
C PROGRAM XFLT1.FT
C P.C.O C.R.
C
C THIS PROGRAM FILTERS NON-INTEGER DATA
C FROM DATA FILES - PART 1 OF 2 FILTERS
C
CA UPDATED JAN/80 TAM
C
C FILE 7 IS THE RAW DATA - EX????.?? (?=WHATEVER)
C FILE 6 IS THE VALID ID'S THIS QRTR. - XTERN?.XX (?=QRTR,XX=YR)
CA ICOUNT IS THE NUMBER OF SHEETS THAT CHECK OUT O.K.
CA IP IS THE NUMBER OF SHEETS THAT ARE BAD
C
REWIND 6
REWIND 7
INTEGER STUD(160),EOF
DIMENSION ARR(50)
INTEGER ARR,NUM(10),ARR2(50)
DATA NUM/'0','1','2','3','4','5','6','7','8','9'/
DATA STUD/160*' '/,IBLNK/'000 '/
CA READ IN VALID 1ST QUARTER STUDENTS
READ(6,850)
DO 900 I=1,160
CALL CHKEOF(IEOF)
READ(6,850)STUD(I)
IF(IEOF.NE.0)GO TO 910
900 CONTINUE
850 FORMAT(A4)
CA NUMBR IS THE # OF VALID STUDENTS
910 NUMBR=I-1
IP=0
ICOUNT=0
CA READ IN DATA - ONE AT A TIME
10 CALL CHKEOF(EOF)
READ(7,100)(ARR(I),I=1,50)
IF(EOF.NE.0)GOTO 999
100 FORMAT(1X,50A1)
C CHECK FOR BAD DATA
DO 20 J=1,50
DO 15 K=1,10
IF(ARR(J)-NUM(K))15,20,15
15 CONTINUE
C UNIT 9 IS DECTAPE THIS IS STORAGE OF BAD DATA
35 WRITE(9,110)(ARR(LP),LP=1,50)
38 IP=IP+1
110 FORMAT(' ',50A1)
GO TO 10
20 CONTINUE
CA FAILS IF COL. 16 IS NOT ZERO
IF(ARR(16)-NUM(1))35,50,35
50 CONTINUE
CA FAILS OF COL. 32 IS NOT ZERO
IF(ARR(32)-NUM(1))35,55,35
CAPAGE
55 CONTINUE
CA CHK FOR MISSING STUD ID & LIST IF ABSENT ON UNIT 3
IF(ARR(8)-NUM(6))35,56,35
56 DO 30 J=1,4
IF(ARR(J)-NUM(1))40,30,40
30 CONTINUE
C LIST COUNT # ON 4 & ARRAY ON 3 IF BLANK SHEET FOUND
WRITE(3,200) ICOUNT
200 FORMAT(' BLANK STUD. ID# ',I6)
WRITE(3,110)(ARR(LP),LP=1,50)
GOTO 10
C THIS ROUTINE CHECKS IF A STUDENT ID IS VALID
C IF NOT IT RETURNS BACK TO THE MAIN PROG
C IF IT IS, IT CHECKS IF ANY OTHER PROBLEMS WITH
C SPACING OCCUR. IF SO IT RETURNS WITH AN
C ERROR FLAG.
C
40 DO 700 J1=1,6
ARR2(J1)=' '
700 CONTINUE
DO 710 J2=1,4
CALL CGET(ARR(J2),1,ICHAR)
CALL CPUT(ARR2(1),J2,ICHAR)
710 CONTINUE
DO 610 J6=1,NUMBR
IF(ARR2(1)-STUD(J6))610,611,610
610 CONTINUE
GO TO 35
611 DO 720 J3=1,3
CALL CGET(ARR(J3+16),1,ICHAR)
CALL CPUT(ARR2(2),J3,ICHAR)
CALL CGET(ARR(J3+19),1,ICHAR)
CALL CPUT(ARR2(3),J3,ICHAR)
CALL CGET(ARR(J3+32),1,ICHAR)
CALL CPUT(ARR2(4),J3,ICHAR)
CALL CGET(ARR(J3+35),1,ICHAR)
CALL CPUT(ARR2(5),J3,ICHAR)
CALL CGET(ARR(J3+38),1,ICHAR)
CALL CPUT(ARR2(6),J3,ICHAR)
720 CONTINUE
IERROR=0
620 IF(ARR2(2).EQ.IBLNK.AND.ARR2(3).NE.IBLNK) GO TO 630
IF(ARR2(4).EQ.IBLNK.AND.ARR2(5).NE.IBLNK) GO TO 630
IF(ARR2(4).EQ.IBLNK.AND.ARR2(6).NE.IBLNK)GO TO 630
CAPAGE
IF(ARR2(5).EQ.IBLNK.AND.ARR2(6).NE.IBLNK) GO TO 630
GO TO 640
630 IERROR=1
640 IF(IERROR.EQ.1)GO TO 35
CA FORM CHECKS OUT O.K. WRITE IT OUT
WRITE(8,110)(ARR(LP),LP=1,50)
ICOUNT=ICOUNT+1
GO TO 10
C TALLY THE NUMBER OF BAD SHEETS FOR PART I
999 WRITE(4,220)IP
220 FORMAT(' NUMBER OF BAD DIAG. = ',I5)
STOP
END