Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0047/sorter.for
There is 1 other file named sorter.for in the archive. Click here to see a list.
C PROGRAM SORTER
C
C DESCRIPTION
C THIS PROGRAM TABULATES THE CODED RESPONSES TO EACH QUESTION OF
C A QUESTIONNAIRE BY FREQUENCIES OR PERCENTAGES OR BOTH.
C
C SOURCE
C NORMAN W. JOHNSON, DEPARTMENT OF MATHEMATICS, WHEATON COLLEGE,
C NORTON, MASS.
C
C INSTRUCTIONS
C THE CODED RESPONSES TO THE QUESTIONNAIRE SHOULD BE READ FROM
C CARDS AND WRITTEN INTO AN ASCII DATA FILE BY THE PROGRAM SURVEY.
C
C THE PROGRAM WILL REQUEST THREE PIECES OF INFORMATION TO BE
C ENTERED FROM THE TERMINAL. THE FIRST IS THE NAME OF THE DATA
C FILE. THE SECOND IS THE RANGE OF QUESTIONS TO BE TABULATED.
C THE USER SHOULD ENTER EITHER THE WORD "ALL", TWO NUMBERS JOINED
C BY A HYPHEN TO INDICATE A BLOCK OF CONSECUTIVE QUESTIONS, OR
C ONE NUMBER FOR A SINGLE QUESTION. THE LAST ITEM REQUIRED CON-
C SISTS OF ONE OR TWO OUTPUT OPTION NUMBERS SPECIFYING THE TABLES
C DESIRED, AS FOLLOWS:
C 0--DESCRIPTION ONLY
C 1--FREQUENCIES
C 2--PERCENTAGES
C
C CROSS-TABULATIONS MAY BE DONE AND VARIOUS STATISTICAL MEASURES
C COMPUTED BY RUNNING THE PROGRAM CROSS.
C
C THIS PROGRAM ASSUMES THAT INPUT IS FROM THE DISK AND OUTPUT IS
C TO THE USER TERMINAL. IF A DIFFERENT OUTPUT DEVICE, SUCH AS THE
C LINE PRINTER, IS TO BE USED, IT SHOULD BE ASSIGNED LOGICAL UNIT
C 5 PRIOR TO RUNTIME.
C
C ..................................................................
C
INTEGER A(48),TODAY(2),BLANK
INTEGER L(128),H(128),R(128),LSUB,HSUB
LOGICAL OPT(0/10)
DIMENSION NSUB(128,0/10),PSUB(128,0/10)
DIMENSION NTAB(128),PTAB(128)
BLANK = 17315143744
CALL TIME(NOW)
CALL DATE(TODAY)
TYPE 1, NOW,TODAY
1 FORMAT (' SORTER',8X,A5,9X,2A5//)
20 TYPE 2
2 FORMAT (/' NAME OF SURVEY? ',$)
C ENTER FILE NAME.
30 ACCEPT 3, DATA
3 FORMAT (A5)
IF (DATA.EQ.' ') GO TO 20
CALL IFILE(1,DATA)
C INPUT DESCRIPTION OF SURVEY.
50 READ (1,5) (A(I),I=1,48)
5 FORMAT (/48A1)
DO 60 I=48,1,-1
IF (A(I).NE.BLANK) GO TO 70
60 A(I) = 0
70 READ (1,10) M
GO TO 90
80 TYPE 8, M
8 FORMAT ('+INVALID ENTRY--NUMBERS RUN FROM 1 TO ',I3/)
90 TYPE 9
9 FORMAT (' WHICH QUESTIONS? ',$)
C ENTER RANGE OF QUESTIONS TO BE TABULATED.
100 ACCEPT 10, IA,IB
10 FORMAT (2I)
101 FORMAT (3A1)
IB = IABS(IB)
IF (IA.LT.0 .OR. IA.GT.M .OR. IB.GT.M) GO TO 80
IF (IB.EQ.0) IB = IA
IF (IA.EQ.0 .AND.IB.NE.0 .OR. IA.GT.IB) GO TO 80
IA = MAX0(IA,1)
IF (IB.EQ.0) IB = M
GO TO 120
110 TYPE 11
11 FORMAT (
1 ' ENTER (WITHOUT PUNCTUATION) ONE OR TWO OPTIONS FOR OUTPUT:'/
2 ' 0--DESCRIPTION ONLY'/
3 ' 1--FREQUENCIES'/
4 ' 2--PERCENTAGES'/)
120 TYPE 12
12 FORMAT (' OUTPUT OPTIONS? ',$)
ACCEPT 101, (R(I),I=1,3)
DO 125 I=1,3
J = JK(R(I))
IF (J.GT.10) GO TO 110
125 OPT(J) = .TRUE.
OPT(0) = .NOT.(OPT(1) .OR. OPT(2))
C INPUT LOWEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
130 READ (1,14) (L(I),I=1,M)
C COMPUTE LOWEST NUMBER USED AS CODED RESPONSE TO ANY QUESTION.
LSUB = 9
DO 135 I=IA,IB
IF (L(I).LT.LSUB) LSUB = L(I)
135 CONTINUE
C INPUT HIGHEST NUMBER USED AS CODED RESPONSE TO EACH QUESTION.
140 READ (1,14) (H(I),I=1,M)
14 FORMAT (5X,128I1)
C COMPUTE HIGHEST NUMBER USED AS CODED RESPONSE TO ANY QUESTION.
HSUB = 0
DO 145 I=IA,IB
IF (H(I).GT.HSUB) HSUB = H(I)
145 CONTINUE
READ (1,3) ID
C INPUT RESPONSES TO QUESTIONS BY EACH RESPONDENT.
160 READ (1,16) ID,(R(I),I=1,M)
16 FORMAT (A5,128A1)
IF (ID.NE.BLANK) GO TO 200
C INPUT NUMBER OF RESPONDENTS.
READ (1,10) LAST
TOTAL = LAST
180 WRITE (5,18) (A(I),I=1,48),LAST
18 FORMAT (///1X,48A1,' --',I4,' RESPONDENTS')
IF (OPT(0)) GO TO 500
GO TO 220
200 DO 210 I=IA,IB
J = JK(R(I))
210 NSUB(I,J) = NSUB(I,J)+1
GO TO 160
220 DO 240 I=IA,IB
DO 240 J=LSUB,HSUB
IF (J.LT.L(I) .OR. J.GT.H(I)) NSUB(I,J) = -1
240 CONTINUE
300 DO 310 I=IA,IB
DO 310 J=L(I),H(I)
310 NTAB(I) = NTAB(I)+NSUB(I,J)
IF (.NOT.OPT(1)) GO TO 400
320 WRITE (5,32)
32 FORMAT (///' FREQUENCY OF RESPONSES TO EACH QUESTION:')
330 WRITE (5,33) (J,J=LSUB,HSUB)
33 FORMAT (//6X,20(1X,I4,1X,$))
340 WRITE (5,34)
34 FORMAT ('+',3X,'TOT'/)
DO 390 I=IA,IB
350 WRITE (5,35) I
35 FORMAT (' ',I3,2X,$)
DO 380 J=LSUB,HSUB
IF (NSUB(I,J)) 360,370,370
360 WRITE (5,36)
36 FORMAT ('+ ....',$)
GO TO 380
370 WRITE (5,37) NSUB(I,J)
37 FORMAT ('+',1X,I4,1X,$)
380 CONTINUE
390 WRITE (5,39) NTAB(I)
39 FORMAT ('+',2X,I4)
IF (.NOT.OPT(2)) GO TO 500
400 DO 410 I=IA,IB
PTAB(I) = NTAB(I)/TOTAL+.0005
DO 410 J=LSUB,HSUB
410 PSUB(I,J) = NSUB(I,J)/TOTAL+.0005
420 WRITE (5,42)
42 FORMAT (///' PER CENT OF RESPONSES TO EACH QUESTION:')
430 WRITE (5,33) (J,J=LSUB,HSUB)
440 WRITE (5,34)
DO 490 I=IA,IB
450 WRITE (5,35) I
DO 480 J=LSUB,HSUB
IF (PSUB(I,J)) 460,470,470
460 WRITE (5,36)
GO TO 480
470 WRITE (5,47) PSUB(I,J)
47 FORMAT ('+',1X,2PF5.1,$)
480 CONTINUE
490 WRITE (5,49) PTAB(I)
49 FORMAT ('+',2X,2PF5.1)
500 WRITE (5,501)
501 FORMAT ('1')
STOP
END
C
FUNCTION JK(N)
JK = N/536870912-48
IF (JK.GE.0) RETURN
JK = 10
RETURN
END