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