Directory of image this file is from
This file as a plain text file

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