Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/item/item.for
There are 2 other files named item.for in the archive. Click here to see a list.
C	WESTERN MICHIGAN UNIVERSITY
C	ITEM.FOR (FILE NAME ON LIBRARY DECTAPE)
C	ITEM, 1.1.7 (CALLING NAME, SUBLST NO.)
C	ITEM ANALYSIS PROGRAM
C	PROGRAMMED BY BERENICE HOUCHARD, JULY 1973.
C	STATISTICAL DESIGN BY DR. MICHAEL STOLINE, JULY 1973
C	LIBRARY DECTAPE PROGRAMS USED:  USAGE.MAC
C	FORWMU PROGS. USED:  TTYPTY, ALLCOR, DEVCHR, EXISTS, EXIST,
C	 GES, GETPPN, JOBNUM, PRINTS, RUNUUO
C	BNKLIB PROGS. USED:  GETFR1, IO, GETID
C	INTERNAL SUBR. USED:  MAINL, AUTO, CORLA, COMOPT, SUBJ,
C	 SPMBR, ITAN, ITCAL, SORT, DIFS1, DIFDS, DIFSUM, FREQ
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
	DIMENSION SPACE(1),IBLOCK(70)
	COMMON /INIO/ IFTR,IFTW,DEVN(30),FILNM(30),IPP(30),DEST(30)
	COMMON /IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	EQUIVALENCE (II,ICODE)
	INTEGER OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SGETFR/ISTD,ITYPE
	COMMON/FMT/NOTF(16)
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SITEM/NSAVE(8)
	DOUBLE PRECISION FILNM, DEVN
	DOUBLE PRECISION ODVNM,IDVNM,OFILNM,IFILNM
C
C	SCALAR DEFINITION
C
C	ITEM--NUMBER OF ITEMS
C	ISUB--NUMBER OF SUBJECTS
C	IDEM--DATA ENTRY METHOD
C	ISIDT--STUDENT ID ENTRY TYPE
C	ILEN----LENGTH OF ID FIELD
C	LENGTH--NUMBER OF WORDS ILEN WILL FIT IN, I.E.,
C	        LENGTH=(ILEN+4)/5
C
C
C	DEVICES
C
	IDLG=-1
	ICC=-4
	INP=2
	IOUT=3
	IPGCT = -1
C	CALL USAGE('ITEM')
C---------------TTYPTY RETURNS ZERO - TTY JOB, MINUS ONE - BATCH JOB
	CALL TTYPTY(ICODE)
C---------------1, IOUT ARE INPUT.  OTHER ARGS. ARE RETURNED.
C--------------- 1 MEANS OUTPUT? PRINTS.
	CALL IO(1,IOUT,ODVNM,IO3,OFILNM,IPG,IPJ,IBNK)
	DO 1 I=2,8
1	NSAVE(I)=1
10	IF (NSAVE(1).EQ.1) GOTO 11
	IF (NSAVE(2).NE.1) GO TO 2
C---------------O, INP ARE INPUT.  OTHER ARGS. ARE RETURNED.
C--------------- 0 MEANS INPUT? PRINTS.
11	CALL IO(0,INP,IDVNM,IO2,IFILNM,IPG,IPJ,IBNK)
	IO3=OUTDV
	IPGCT = -1
C
C
C
2	IF (NSAVE(3).NE.1) GO TO 30
	ITYPE=3
C---------------NOTF RETURNED, ITYPE=3 AND 0 MEANS ONLY A1
C--------------- FORMAT IS LEGAL.  16 MEANS NO. OF WORDS FOR USER
C--------------- SPEC. FORMAT.
	CALL GETFR1(0,16,NOTF)
	IF (ISTD.NE.1) GO TO 30
	DO 20 I=1,16
20	NOTF(I)=' '
30	IF (NSAVE(4).NE.1) GO TO 443
	WRITE(IDLG,31)
31	FORMAT('-ENTER PARAMETERS--TYPE HELP IF NEEDED'/)
	READ(ICC,32) IBLOCK
32	FORMAT(70A1)
	IF ((IBLOCK(1).EQ.'H').AND.(IBLOCK(2).EQ.'E').AND.(IBLOCK(3).
     1EQ.'L').AND.(IBLOCK(4).EQ.'P')) GO TO 350
	REREAD 33, ITEM,IDEM,ISIDT,ILEN
33	FORMAT(20I)
C
C	CHECK PARAMETER LIMITS
C
	IF (ITEM.GT.0) GO TO 36
	WRITE(IDLG,34) ITEM
34	FORMAT('-ERROR:  ',I4,' NUMBER OF ITEMS OUTSIDE ALLOWABLE RANGE,
     1 TRY AGAIN'/)
	GO TO 340
36	IF ((IDEM.GE.1).AND.(IDEM.LE.2)) GO TO 38
	WRITE(IDLG,37) IDEM
37	FORMAT('-ERROR:  DATA ENTRY METHOD ',I3,' DOES NOT EXIT,
     1 TRY AGAIN'/)
340	IF (ICODE)35,30,30
35	CALL EXIT
C
C	USER NEEDS HELP IN PARAMETER STATEMENT
C
350	WRITE(IDLG,351)
351	FORMAT('-THE PARAMETER STATEMENT CONSISTS OF 4 NUMBERS
     1 REPRESENTING; THE'/10X,'NUMBER OF ITEMS'/10X,'DATA ENTRY METHOD
     2 CODE'/10X,'SUBJECT ID TYPE CODE'/10X,'LENGTH OF SUBJECT ID'//
     3 ' THE ABOVE 4 NUMBERS ARE ENTERED IN A LINE SEPARATED BY COMMAS.'
     4 /'-THERE ARE TWO METHODS OF DATA ENTRY:'// 5X,' CODE  DESCRIPTION
     5'/7X,'1    FOR UNCORRECTED OR RAW TEST DATA CONSISTING OF
     6 INDIVIDUAL'/12X,'RESPONSES TO EACH ITEM OF THE TEST'/
     7 7X,'2    FOR CORRECTED TEST DATA CONSISTING OF 1''S AND 2''S'/
     8 12X,'WHERE 1= CORRECT ITEM RESPONSE'/18X,'2= INCORRECT ITEM
     9 RESPONSE'///' THERE ARE 4 TYPES OF SUBJECT ID ENTRY:'//
     1 5X,' CODE  DESCRIPTION'/
     2 7X,'1    SUBJECTS ARE NOT IDENTIFIED'/
     3 7X,'2    SUBJECTS ID ARE TO BE ENTERED SEPARATELY'/
     4 7X,'3    SUBJECTS ID ARE IN FIELDS BEFORE THE RESPONSES'/
     5 7X,'4    SUBJECTS ID ARE IN FIELDS AFTER THE RESPONSES'/
     6 '-SUBJECT ID LENGTH IS BETWEEN 1 AND 15.'/)
	GO TO 340
38	IF ((ISIDT.GE.1).AND.(ISIDT.LE.4)) GO TO 40
	WRITE(IDLG,39) ISIDT
39	FORMAT('-ERROR:  SUBJECT ID ENTRY TYPE',I3,' DOES NOT EXIST,
     1 TRY AGAIN'/)
	GO TO 340
40	IF (ISIDT.EQ.1) GO TO 43
	IF ((ILEN.GT.0).AND.(ILEN.LE.15)) GO TO 42
	WRITE(IDLG,41) ILEN
41	FORMAT('-ERROR:  SUBJECT ID FIELD LENGTH',I3,' OUTSIDE RANGE.'/
     1 9X,'IT SHOULD BE BETWEEN 1 AND 15.  TRY AGAIN'/)
	GO TO 340
42	LENGTH=(ILEN+4)/5
	GO TO 44
43	LENGTH=1
C
C	OBJECT TIME FORMAT USED, NO NEED TO ADJUST FORMAT
C
44	IF (ISTD.NE.1) GO TO 443
C
C	STANDARD FORMAT USED, ADJUSTMENT NECESSARY
C
	IF (ISIDT-3) 4421,4422,4423
4421	NOTF(1)='(20I)'
	GO TO 443
C
C	SUBJECT ID TYPE 3
C
4422	ENCODE(5,44220,IBLOCK(1)) ILEN
44220	FORMAT('(',I2,'A1')
	IBLOCK(2)=',1X,'
	IF (ITEM.GT.20) GO TO 44223
	IBLOCK(3)='20I)'
44221	ENCODE(13,44222, NOTF(1)) (IBLOCK(I),I=1,3)
44222	FORMAT(A5,2A4)
44223	IBLOCK(3)='20I/('
	IBLOCK(4)='20I))'
	ENCODE(19,44224,NOTF(1)) (IBLOCK(I),I=1,4)
44224	FORMAT(A5,A4,2A5)
	GO TO 443
C
C	SUBJECT ID TYPE 4
C
4423	IF (ITEM.GT.20) GO TO 4424
	ENCODE(8,44231,IBLOCK(1)) ITEM
44231	FORMAT('(',I2,'I,1X,')
	ENCODE(5,44232,IBLOCK(3)) ILEN
44232	FORMAT(I2,'A1)')
	ENCODE(13,44233,NOTF(1)) (IBLOCK(I),I=1,3)
44233	FORMAT(A5,A3,A5)
	GO TO 443
4424	IT=ITEM/20
	ENCODE(10,44240,IBLOCK(1)) IT
44240	FORMAT('(',I2,'(20I/),')
	IT=MOD(ITEM,20)
	IF (IT.GT.0) GO TO 4425
	ENCODE(5,44241,IBLOCK(3)) ILEN
44241	FORMAT(I2,'A1)')
	ENCODE(15,44242,NOTF(1)) (IBLOCK(I),I=1,3)
44242	FORMAT(16A5)
	GO TO 443
4425	ENCODE(9,44250,IBLOCK(3)) IT,ILEN
44250	FORMAT(I2,'I,',I2,'A1)')
	ENCODE(19,44251,NOTF(1)) (IBLOCK(I),I=1,4)
44251	FORMAT(3A5,A4)
C
C
C
443	IF (NSAVE(5).NE.1) GO TO 4440
	WRITE(IDLG,444)
444	FORMAT('-NUMBER OF SUBJECTS--',$)
	READ(ICC,33) ISUB
4440	IF ((NSAVE(4).NE.1).AND.(NSAVE(5).NE.1)) GO TO 460
	K0=ITEM
	K1=ITEM*ISUB
	K2=ISUB
	K3=((ITEM+1)*(ITEM+2))/2
	K4=ISUB*LENGTH
C
C	THE FOLLOWING STATEMENTS ARE SUBJECT TO CHANGE AS 
C	SUBROUTINES ARE ADDED OR DELETED
C
	MAX=2
	IF (IDEM.EQ.1) MAX=9
	I1=MAX+1
	I2=2*ITEM
	I3=2*ISUB
	K5=I1*ITEM
	IBLOCK(1)=I2+I3
	IBLOCK(2)=I2+3*I1
	IBLOCK(3)=I2+15
	IBLOCK(4)=I3+12
	DO 445 I=1,4
	IF (K5.LT.IBLOCK(I)) K5=IBLOCK(I)
445	CONTINUE
C
C
C
	NEED=K0+K1+K2+K3+K4+K5
	CALL ALLCOR(NEED,IERR,I1,SPACE)
	IF (IERR.EQ.0) GO TO 46
	WRITE(IDLG,45)
45	FORMAT('-ERROR:  NOT ENOUGH ROOM, TRY AGAIN'/)
	GO TO 340
46	K0=I1+K0
	K1=K0+K1
	K2=K1+K2
	K3=K2+K3
	K4=K3+K4
460	CALL MAINL(SPACE(I1),SPACE(K0),SPACE(K1),SPACE(K2),SPACE(K3),
     1 SPACE(K4))
	WRITE(IDLG,50)
50	FORMAT('-')
	GO TO 10
	END
C
C	SUBROUTINE MAINL
C
C	SUBROUTINES CALLED:
C
C	     GETID
C	     AUTO
C	     COMOPT
C	     SUBJ
C	     CORLA
C	     SPMBR
C	     ITAN
C	     SORT
C	     DIFS1
C	     DIFDS
C	     FREQ
C
C
C---------------CSCORE, CORR ARE INPUT.  OTHER ARGS. ARE RETURNED.
C--------------- INP, IOUT, IO2, IO3 ARE INPUT THRU COMMON /IOPMR/.
C--------------- IDLG, ICC, ARE INPUT THRU COMMON /IOB/.  ISTD IS INPUT
C--------------- THRU COMMON /SGETFR/.  NOTF IS INPUT THRU COMMON /FMT/.
C--------------- ITEM, ISUB, IDEM, ISIDT, ILEN, LENGTH ARE INPUT THRU
C--------------- COMMON /PAR/.  NSAVE IS INPUT THRU COMMON /SITEM/.
	SUBROUTINE MAINL(IKEY,IANS,CSCORE,CORR,SUB,VECTOR)
C
C	IANS------VECTOR CONTAINING INDIVIDUAL RESPONSES
C	CSCORE----NUMBER OF CORRECT SCORES PER SUBJECT
C	CORR------CORRELATION VECTOR
C	SUB-------SUBJECT ID
C	VECTOR----A WORKING AREA VECTOR
C
	DIMENSION IKEY(1),IANS(1),CSCORE(1),CORR(1),SUB(1),VECTOR(1)
	DIMENSION MOPT(6),ISAVE(5),IFMT(2),IBLOCK(15),IDATE(2)
	EQUIVALENCE (IBLOCK,ISAVE)
C
C	MOPT---VECTOR CONTAINING OPTIONS CHOSEN
C	NSAVE--VECTOR CONTAINING COMMANDS TO BE CHANGED
C
	COMMON/IOB/LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SGETFR/ISTD,ITYPE
	COMMON/FMT/NOTF(16)
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SITEM/NSAVE(8)
	COMMON/SAUTO/XB,SD
	COMMON/SITAN/U,V
	INTEGER SUB
C****** WMU AM: 1.7.1, #1, WG, 10-JAN-78
	CALL TTYPTY (ICODE)
C****** END = MAINL, STMT 1-4
	IDUM=LENGTH*ISUB
	IF (NSAVE(4).NE.1) GO TO 30
	DO 1 I=1,IDUM
1	SUB(I)=' '
	LEFT=MOD(ILEN,5)
	GO TO (20,16,30,30),ISIDT
C
C	SUBJECT ID TO BE ENTERED SEPARATELY
C
16	DO 160 I=1,2
160	IFMT(I)=' '
	IF (LENGTH.GT.1) GO TO 17
	ENCODE(4,161,IFMT(1)) ILEN
161	FORMAT('(A',I1,')')
	GO TO 192
17	IF (LEFT.GT.0) GO TO 18
	ENCODE(5,171,IFMT(1)) LENGTH
171	FORMAT('(',I1,'A5)')
	GO TO 192
18	LTH=LENGTH-1
	ENCODE(5,181,IBLOCK(1)) LTH
181	FORMAT('(',I1,'A5,')
	ENCODE(3,182,IBLOCK(2)) LEFT
182	FORMAT('A',I1,')')
	ENCODE(8,183,IFMT(1)) (IBLOCK(I),I=1,2)
183	FORMAT(A5,A3,A5)
192	WRITE(IDLG,194)
194	FORMAT('-ENTER SUBJECT ID, ONE PER LINE'/)
	DO 193 I=1,IDUM,LENGTH
	LAST=I*LENGTH
193	READ(ICC,IFMT)(SUB(J),J=I,LAST)
	GO TO 30
C
C	GENERATE SUBJECTS ID
C
20	DO 21 I=1,ISUB
	DO 22 J=1,5
22	ISAVE(J)=' '
	ENCODE(5,23,SUB(I))I
23	FORMAT(I5)
	DECODE(5,511,SUB(I)) ISAVE
25	IF (ISAVE(1).NE.' ') GO TO 27
	DO 26 K=1,4
26	ISAVE(K)=ISAVE(K+1)
	ISAVE(5)=' '
	GO TO 25
27	ENCODE(5,511,SUB(I)) ISAVE
21	CONTINUE
C
C
C
30	IF (NSAVE(6).NE.1) GO TO 44
	CALL GETID
	IF (IO3.EQ.'TTY')  GO TO 44
314	CALL DATE(IDATE)
	WRITE(IOUT,32) IDATE,ID,NOTF,ITEM,ISUB
32	FORMAT('1'/'3',29X,'WESTERN  MICHIGAN  UNIVERSITY'///30X,'ITEM
     1 ANALYSIS PROGRAM'//30X,'CALLING NAME:  ITEM'/30X,'DATE RUN    :
     2  ',2A5///30X,'TITLE  :  ',16A5/30X,'FORMAT :  ',16A5/'-',29X,
     3 'NUMBER OF ITEMS TO BE USED.........',I4/30X,'NUMBER OF SUBJECTS
     4 TO BE READ IN...',I4)
C
C	OBTAIN KEY OR GENERATE KEY
C
44	GO TO (442,440), IDEM
440	DO 441 I=1,ITEM
441	IKEY(I)=1
	GO TO 450
442	IF (NSAVE(7).NE.1) GO TO 450
	IF (IO2.NE.'TTY') GO TO (445,445,446,447),ISIDT
4430	WRITE(IDLG,443) ITEM
443	FORMAT(' ENTER KEY TO EACH OF THE',I5,' ITEMS'/' MAXIMUM OF
     1 20 NUMBERS PER LINE SEPARATED BY COMMAS'/)
	READ(ICC,444) (IKEY(I),I=1,ITEM)
444	FORMAT(20I)
	GO TO 448
445	READ(INP,NOTF)(IKEY(I),I=1,ITEM)
	GO TO 448
446	READ(INP,NOTF)(IBLOCK(J),J=1,ILEN),(IKEY(K),K=1,ITEM)
	GO TO 448
447	READ(INP,NOTF) (IKEY(K),K=1,ITEM),(IBLOCK(J),J=1,ILEN)
448	DO 449 I=1,ITEM
	IF ((IKEY(I).LE.9).AND.(IKEY(I).GE.1)) GO TO 449
	WRITE(IDLG,4490) IKEY(I),I
4490	FORMAT('-ERROR:',I5,' FOR ITEM',I5,' IS INVALID, TRY AGAIN'/)
	IF (ICODE.LT.0) CALL EXIT
	IF (IO2.EQ.'TTY') GO TO 4430
	CALL EXIT
449	CONTINUE
C
C
C
450	IF (IO2.NE.'TTY') GO TO 47
	WRITE(IDLG,45)
45	FORMAT(' ENTER DATA BY SUBJECTS'/)
	IF (ISTD.EQ.1) WRITE(IDLG,46)
46	FORMAT('+MAXIMUM OF 20 ITEMS PER LINE (SUBJECT) SEPARATED BY
     1 COMMAS'/)
	GO TO 471
47	WRITE(IDLG,470)
470	FORMAT(' PLEASE WAIT, YOUR DATA IS BEING PROCESSED'/)
471	NN=0
	IF (ISIDT.GE.3) GO TO 50
	J2=0
	DO 48 I=1,ISUB
	J1=J2+1
	J2=I*ITEM
	READ(INP,NOTF,END=60)(IANS(J),J=J1,J2)
48	NN=NN+1
	GO TO 60
50	DO 51 I=1,ISUB
	IST=(I-1)*LENGTH+1
	IRES=(I-1)*ITEM+1
	LLAST=I*ITEM
	GO TO (51,51,52,53), ISIDT
52	READ(INP,NOTF,END=60)(IBLOCK(J),J=1,ILEN),(IANS(K),K=IRES,LLAST)
	GO TO 510
53	READ(INP,NOTF,END=60)(IANS(K),K=IRES,LLAST),(IBLOCK(J),J=1,ILEN)
510	ENCODE(ILEN,511,SUB(IST))(IBLOCK(J),J=1,ILEN)
511	FORMAT(15A1)
51	NN=NN+1
C
C	AUTOMATIC OUTPUT AND CALCULATIONS FOR ALL OPTIONS
C
60	IF (NN.NE.ISUB) ISUB=NN
	IF (IDEM.EQ.2) GO TO 70
C
C	CREATE A TEMPORARY FILE:
C	FIRST RECORD IS IKEY, THUS FREE A VECTOR TO BE USED LATER,
C	FIND MAX OF THE ANSWER FOR SUBROUTINE AUTO
C
	MAX=1
	NL=0
	DO 62 I=1,ITEM*ISUB
	L=IANS(I)
	IF ((L.GE.0).AND.(L.LE.9)) GO TO 620
	IANS(I)=0
	NL=NL+1
	GO TO 62
620	IF (L.GT.MAX) MAX=L
62	CONTINUE
	WRITE(1) (IKEY(I),I=1,ITEM)
	DO 61 I=1,ISUB
	I1=(I-1)*ITEM+1
61	WRITE(1)(IANS(J),J=I1,I*ITEM)
	ENDFILE 1
	CALL RELEAS(1)
C
C	AUTOMATIC PART FOR ALL RUN
C
70	CALL AUTO(IKEY,IANS,CSCORE,CORR,SUB,VECTOR,MAX,NL)
C
C
71	IF (NSAVE(8).EQ.1) CALL COMOPT(MOPT,1)
	IF (MOPT(1).EQ.1) CALL SUBJ(SUB,CSCORE)
	IF (MOPT(2).EQ.1) CALL CORLA(CORR)
	IF (MOPT(3).EQ.1) CALL SPMBR(ITEM,ISUB,IANS,CSCORE,VECTOR,IKEY)
	IF (MOPT(4).EQ.1) CALL ITAN(MAX,IKEY,IANS,CSCORE,VECTOR,SUB)
	IF (MOPT(5).EQ.0) GO TO 74
	IF (MOPT(4).EQ.1) GO TO 730
	CALL SORT(CSCORE,IANS,SUB,VECTOR)
	GO TO 731
730	IF ((U.EQ.27).AND.(V.EQ.27)) GO TO 73
731	CALL DIFS1(IANS,VECTOR)
73	CALL DIFDS(VECTOR)
74	IF (MOPT(6).NE.1) GO TO 75
	IF ((MOPT(4).EQ.0).AND.(MOPT(5).EQ.0)) CALL SORT(CSCORE,
     1 IANS,SUB,VECTOR)
	CALL FREQ(CSCORE,VECTOR)
75	CONTINUE
C
C
C
8	IF (NSAVE(1).EQ.1) RETURN
	CALL COMOPT(NSAVE,2)
	DO 82 I=2,8
	IF (NSAVE(I).EQ.1) GO TO (83,84), IDEM
82	CONTINUE
C
C	FROM NOW ON LET NEW IO HANDLE ITS OWN PRINTING FROM LPT.
C
	RETURN
C81	IF (IO3.NE.'LPT') GO TO 80
C	CALL RELEAS(IOUT)
C	CALL PRINTS(NAMO,2,1,NCOPYS)
C80	CALL EXIT
83	READ(1)(IKEY(I),I=1,ITEM)
	CALL RELEAS (1)
	RETURN
84	DO 85 I=1,ITEM
85	IKEY(I)=1
	RETURN
	END
C
C	SUBROUTINE AUTO
C
C	THIS SUBROUTINE CALCULATES AND GENERATES AN AUTOMATIC ITEM
C	ANALYSIS SUMMARY ON DATA SETS.
C
C---------------SUB IS APPARENTLY NOT USED.  IKEY, IANS,
C--------------- MAX, NL ARE INPUT.  OTHER ARGS. ARE RETURNED.  IOUT, IO3
C--------------- ARE INPUT THRU COMMON /IOPMR/.
C---------------ISUB, IDEM, ITEM ARE INPUT THRU COMMON /PAR/.  ID
C--------------- IS INPUT THRU COMMON /SID/.
	SUBROUTINE AUTO(IKEY,IANS,CSCORE,CORR,SUB,VECTOR,MAX,NL)
	DIMENSION IKEY(1),IANS(1),CSCORE(1),CORR(1),SUB(1),VECTOR(1)
	COMMON/INIO/IFTR,IFTW,DEVN(30),FILNM(30),IPP(30),DEST(30)
	COMMON/IOB/LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	DOUBLE PRECISION DEVN, FILNM
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON /SID/ ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SAUTO/XB,SD
	INTEGER SUB
	DATA STAR/'*****'/
	WRITE(IOUT,1) ID,ITEM,ISUB
1	FORMAT('1ITEM ANALYSIS SUMMARY'/1X,16A5/'-NUMBER OF ITEMS
     1    =',I8/' NUMBER OF SUBJECTS =',I8/)
	IF (IDEM.GT.1) GO TO 2
	IF (NL.LE.0) GO TO 102
	IF (NL.EQ.1) WRITE(IOUT,100)
100	FORMAT('-NOTE:  THERE IS 1 ENTRY OUTSIDE THE ALLOWABLE RANGE OF
     1 0 AND 9.'/8X,'PROGRAM CONVERTS IT TO MISSING DATA SYMBOL 0.'/)
	IF (NL.GT.1) WRITE(IOUT,101) NL
101	FORMAT('-NOTE:  THERE ARE ',I4,' ENTRIES OUTSIDE THE ALLOWABLE
     1 RANGE OF 0 AND 9.'/8X,'PROGRAM CONVERTS THEM TO MISSING DATA
     2 SYMBOL 0.'/)
102	MUCH=(MAX+1)*ITEM
	DO 10 I=1,MUCH
10	VECTOR(I)=0
C
C	ADDITIONAL CALCULATION AND OUTPUT FOR DATA ENTRY METHOD 1
C
	ICORE=ISUB*ITEM
	DO 11 I=1,ICORE,ITEM
	I1=ITEM
	K=I-1
	DO 12 J=1,ITEM
	K=K+1
	IF (IANS(K).NE.0) GO TO 13
	VECTOR(J)=VECTOR(J)+1
	GO TO 14
13	K1=I1+IANS(K)
	VECTOR(K1)=VECTOR(K1)+1
14	I1=I1+MAX
12	CONTINUE
11	CONTINUE
	IST=1
	LAST=7
	IF (IO3.NE.'TTY') LAST=9
	IF (MAX.LE.LAST) LAST=MAX
16	I1=((LAST+1)*8+4)/5
	WRITE(IOUT,17) (STAR,I=1,I1)
17	FORMAT('-',4X,'*',3X,'P O S S I B L E',4X,'R E S P O N S E S'/
     1 ' ITEM*',16A5)
	WRITE(IOUT,18) (I,I=IST,LAST)
18	FORMAT('  NO * MISSING',9(I7,1X))
	WRITE(IOUT,19) (STAR,I=1,I1+1)
19	FORMAT(' ',17A5)
	WRITE(IOUT,193)
	I3=ITEM+IST
	L2=LAST-IST
	DO 190 I=1,ITEM
	L1=(I-1)*MAX+I3
	I2=L1+L2
190	WRITE(IOUT,191) I,VECTOR(I), (VECTOR(J),J=L1,I2)
191	FORMAT(1X,I4,'*',11F8.0)
	IF (LAST.EQ.MAX) GO TO 2
	IST=IST+LAST
	LAST=MAX
	I1=((LAST-IST+1)*8+4)/5
	WRITE(IOUT,17) (STAR,I=1,I1)
	WRITE(IOUT,192) (I,I=IST,LAST)
192	FORMAT('  NO *',10(I7,1X))
	WRITE(IOUT,19) (STAR,I=1,I1+1)
	WRITE(IOUT,193)
193	FORMAT(5X,'*')
	I3=ITEM+IST
	L2=LAST-IST
	DO 194 I=1,ITEM
	L1=(I-1)*MAX+I3
	I2=L1+L2
194	WRITE(IOUT,191) I,(VECTOR(J),J=L1,I2)
	WRITE(IOUT,195)
195	FORMAT('-')
C
C	START OF SUMMARY FOR ALL
C
2	DO 201 I=1,ISUB
201	CSCORE(I)=0
	N1=ITEM
	N2=N1+ITEM
	N3=N2+ITEM
	N4=N3+ITEM+1
	N5=N4+ITEM+1
	DO 202 I=1,N5
202	VECTOR(I)=0
C
C	CORRECT TEST AND ADD UP SCORES
C
20	DO 21 I=1,ISUB
	NPT=(I-1)*ITEM
	DO 22 J=1,ITEM
	J1=NPT+J
C
C	MISSING ANSWER
C
	IF (IANS(J1).NE.0) GO TO 30
	VECTOR(J)=VECTOR(J)+1
	IANS(J1)=2
	GO TO 23
C
C	CORRECT ANSWERS
C
30	IF (IANS(J1).NE.IKEY(J)) GO TO 40
	CSCORE(I)=CSCORE(I)+1
	IVEC=N2+J
	VECTOR(IVEC)=VECTOR(IVEC)+1
	IANS(J1)=1
	GO TO 23
C
C	WRONG ANSWERS
C
40	IVEC=N1+J
	VECTOR(IVEC)=VECTOR(IVEC)+1
	IANS(J1)=2
C
C	CALCULATE SUM AND SUM OF SQUARES ON ALL ITEMS
C
23	IX=N3+J
	IX2=N4+J
	VECTOR(IX)=VECTOR(IX)+IANS(J1)
	VECTOR(IX2)=VECTOR(IX2)+IANS(J1)**2
22	CONTINUE
21	CONTINUE
C
C	CALCULATE SUM AND SUM OF SQUARES FOR CORRECT SCORES
C
	DO 50 I=1,ISUB
	VECTOR(N4)=VECTOR(N4)+CSCORE(I)
50	VECTOR(N5)=VECTOR(N5)+CSCORE(I)**2
C
C	CALCULATE CORRELATION
C
	TEMP3=ISUB*VECTOR(N5)-VECTOR(N4)**2
	I1=0
	I2=(ITEM*(ITEM+1))/2
	I3=I2
	DO 51 I=1,ITEM
	X=VECTOR(N3+I)
	X2=VECTOR(N4+I)
	TEMP=ISUB*X2-X*X
	DO 52 J=1,I
	SUMXY=0
	Y=VECTOR(N3+J)
	Y2=VECTOR(N4+J)
	TEMP2=ISUB*Y2-Y*Y
	DO 53 K=1,ISUB
	IST=(K-1)*ITEM
	NPT=IST+I
	IPT=IST+J
53	SUMXY=SUMXY+IANS(NPT)*IANS(IPT)
	I1=I1+1
	TT=TEMP*TEMP2
	CORR(I1)=9.9E16
	IF (TT.NE.0) CORR(I1)=(ISUB*SUMXY-X*Y)/SQRT(TT)
52	CONTINUE
	SUMXY=0
	DO 54 K=1,ISUB
	NPT=(K-1)*ITEM+I
54	SUMXY=SUMXY+IANS(NPT)*CSCORE(K)
	I2=I2+1
	TT=TEMP*TEMP3
	CORR(I2)=9.9E16
	IF (TT.NE.0) CORR(I2)=-(ISUB*SUMXY-X*VECTOR(N4))/SQRT(TT)
51	CONTINUE
	CORR(I2+1)=1.0
C
C	MEAN & STANDARD DEVIATION
C
	IS1=ISUB*(ISUB-1)
	XB=VECTOR(N4)/ISUB
	SD=SQRT(TEMP3/IS1)
C
C	START OF REPORT
C
	WRITE(IOUT,62) (STAR,I=1,11)
62	FORMAT('-',4X,'*',30X,'PROPORTION'/5X,'*',34X,'OF'/' ITEM*',3X,
     1 'RIGHT',4X,'WRONG',3X,'MISSING',5X,'CORRECT',4X,'CORR  W/'/
     2 2X,'NO *',3(2X,'ANSWERS'),5X,'ANSWERS',6X,'TOTAL'/1X,'*',11A5/
     3 5X,'*')
	I1=I3
	DO 65 I=1,ITEM
	NPT=N1+I
	TEMP=VECTOR(N2+I)/ISUB
	I1=I1+1
	WRITE(IOUT,66) I,VECTOR(N2+I),VECTOR(N1+I),VECTOR(I),TEMP,
     1 CORR(I1)
66	FORMAT(1X,I4,'*',3F9.0,F12.3,2X,F8.3)
C
C	REPLACE VECTOR(N1+1) TO VECTOR(N2) BY P'S
C
65	VECTOR(NPT)=TEMP
C
C	CALCULATE ODD AND EVEN
C
C
C	CHANGE POINTERS
C
	N2=N1+ITEM
	N3=N2+ISUB
	N4=N3+ISUB
	DO 70 I=N2+1,N4
70	VECTOR(I)=0
	SUMX=0
	SUMY=0
	SUMX2=0
	SUMY2=0
	SUMXY=0
	DO 71 I=1,ISUB
	I1=(I-1)*ITEM
	NPT=N2+I
	IPT=N3+I
C
C	ODD ITEMS
C
	DO 72 J=1,ITEM,2
	IF (IANS(I1+J).EQ.1) VECTOR(NPT)=VECTOR(NPT)+1
72	CONTINUE
C
C	EVEN ITEMS
C
	DO 73 J=2,ITEM,2
	IF (IANS(I1+J).EQ.1) VECTOR(IPT)=VECTOR(IPT)+1
73	CONTINUE
71	CONTINUE
	DO 74 I=1,ISUB
	X=VECTOR(N2+I)
	Y=VECTOR(N3+I)
	SUMX=SUMX+X
	SUMX2=SUMX2+X*X
	SUMY=SUMY+Y
	SUMY2=SUMY2+Y*Y
74	SUMXY=SUMXY+X*Y
	XOB=SUMX/ISUB
	XEB=SUMY/ISUB
	SO=ISUB*SUMX2-SUMX*SUMX
	SE=ISUB*SUMY2-SUMY*SUMY
	TT=SO*SE
	ROE=9.9E16
	IF (TT.NE.0) ROE=(ISUB*SUMXY-SUMX*SUMY)/SQRT(TT)
	SO=SQRT(SO/IS1)
	SE=SQRT(SE/IS1)
C
C	SPEARMAN-BROWN ODD-EVEN RELIABILITY
C
	SPB=9.9E16
	IF (ROE.NE.-1) SPB=(2*ROE)/(1+ROE)
C
C	KUDER RICHARDSON #20 AND #21
C
	PB=0
	QB=0
	X=0
	Y=0
	SUMY2=0
	I1=0
	DO 80 J=1,ITEM-1
	J1=(J*J-J)/2+J
	IF (CORR(J1).GT.1) GO TO 80
	I1=I1+1
	SUMX=VECTOR(N1+J)
	SUMX2=1-SUMX
	SUMXY=SUMX*SUMX2
	X=X+SUMXY
	PB=PB+SUMX
	QB=QB+SUMX2
	DO 81 I=J+1,ITEM
	J1=(I*I-I)/2+J
	IF (CORR(J1).GT.1) GO TO 81
	SUMY=VECTOR(N1+I)
	T=2*CORR(J1)*SQRT(SUMXY*SUMY*(1-SUMY))
	SUMY2=SUMY2+T
81	CONTINUE
80	CONTINUE
	J1=(ITEM*ITEM-ITEM)/2+ITEM
	IF (CORR(J1).NE.1) GO TO 82
	I1=I1+1
	SUMX=VECTOR(N2)
	SUMX2=1-SUMX
	PB=PB+SUMX
	QB=QB+SUMX2
	X=X+SUMX*SUMX2
82	V=X+SUMY2
	PB=PB/I1
	QB=QB/I1
	T=(I1-1)*V
	R20=9.9E16
	R21=9.9E16
	IF (T.EQ.0) GO TO 90
	R20=(I1*SUMY2)/T
	R21=(I1*(V-I1*PB*QB))/T
	IF (I1.NE.ITEM) WRITE(IOUT,820) I1
820	FORMAT(//'-NOTE:  THE FOLLOWING KUDER-RICHARDSON FORMULA ARE
     1 BASED ON ',I5,' ITEMS.')
90	WRITE(IOUT,91) R20,R21,ROE,SPB,XB,SD,XOB,SO,XEB,SE
91	FORMAT('-RELIABILITY:  KUDER-RICHARDSON #20 =',F12.4/15X,
     2 'KUDER-RICHARDSON #21 =',F12.4/15X,'CORRELATION OF ODD-EVEN
     3 ITEMS       =',F12.4/15X,'SPEARMAN-BROWN ODD-EVEN RELIABILITY =',
     4 F12.4/'-',24X,'M E A N',6X,'ST.  DEV'/5X,'NUMBER CORRECT ',
     5 2(F12.3,2X)/' ODD  ITEMS CORRECT ',2(F12.3,2X)/' EVEN ITEMS
     6 CORRECT ',2(F12.3,2X))
	RETURN
	END
C
C	SUBROUTINE CORLA
C
C	THIS SUBROUTINE WRITES OUT THE LOWER TRIANGULAR ITEM
C	CORRELATION MATRIX.  CORRELATIONS ARE CALCULATED IN SUBROUTINE
C	AUTO.
C
C
C---------------CORR IS INPUT.  IOUT, IO3 ARE INPUT THRU COMMON
C--------------- /IOPMR/.  ITEM, ISUB ARE INPUT THRU COMMON /PAR/.
C--------------- ID IS INPUT THRU COMMON /SID/
	SUBROUTINE CORLA(CORR)
	DIMENSION CORR(1)
	COMMON/IOB/LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	DATA STAR/'*****'/
	WRITE(IOUT,10) ID,ITEM,ISUB
10	FORMAT('1THE ITEM CORRELATION MATRIX'/1X,16A5/'-NUMBER OF
     1 ITEMS    =',I7/' NUMBER OF SUBJECTS =',I7)
	IDUM=9
	IF (IO3.NE.'TTY') IDUM=17
	I2=IDUM-1
	NTIMES=(ITEM+I2)/IDUM
	DO 20 I=1,NTIMES
	NPT=(I-1)*IDUM+1
	LAST=I*IDUM
	IF (ITEM.LE.LAST) LAST=ITEM
	WRITE(IOUT,21)(J,J=NPT,LAST)
21	FORMAT('-ITEM ',17I7)
	INC=((LAST-NPT+1)*7+4)/5
	WRITE(IOUT,22) (STAR,J=1,INC)
22	FORMAT(5X,'*',25A5)
	INC=-1
	DO 23 J=NPT,ITEM
	INC=INC+1
	IF (INC.GE.IDUM) INC=I2
	J1=(J*J-J)/2+NPT
	J2=J1+INC
23	WRITE(IOUT,24) J, (CORR(K),K=J1,J2)
24	FORMAT(1X,I4,'*',17F7.3)
20	CONTINUE
	RETURN
	END
C
C	SUBROUTINE COMOPT
C
C	THIS SUBROUTINE DETERMINES WHICH COMMANDS ARE TO BE
C	CHANGED AND WHICH OPTIONS ARE SELECTED.
C
C---------------ISW INPUT.  MOPT OUTPUT IDLG, ICC, INPUT THRU
C---------------  COMMON /IOB/
	SUBROUTINE COMOPT(MOPT,ISW)
	DIMENSION IBLOCK(80),MOPT(1),MASTER(6),IN(4),ICOM(8)
	COMMON /IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	DOUBLE PRECISION SW(2)
	DATA SW/' OPTION','COMMAND'/
	DATA ICOM/'FINI','DATA','FORM','PARA','SUBJ','HEAD','KEY',
     1 'OPTS'/
	DATA MASTER/'SUBJ','CORR','SPBN','ITEM','DIFD','FREQ'/
C****** WMU AM: 1.7.1, #1, WG, 10-JAN-78
	CALL TTYPTY (ICODE)
C****** END = COMOPT, STMT 1-3
	NS=8
	IF (ISW.EQ.1) NS=6
1	WRITE(IDLG,10) SW(ISW)
10	FORMAT('-'A7,'S?--TYPE HELP IF NEEDED--'/)
	READ(ICC,11) IBLOCK
11	FORMAT(80A1)
	IF ((IBLOCK(1).EQ.'H').AND.(IBLOCK(2).EQ.'E').AND.(IBLOCK(3).
     1EQ.'L').AND.(IBLOCK(4).EQ.'P')) GO TO (90,900), ISW
	DO 20 I=1,NS
20	MOPT(I)=0
	GO TO (200,300),ISW
200	IF ((IBLOCK(1).EQ.'N').AND.(IBLOCK(2).EQ.'O').AND.(IBLOCK(3).EQ.
     1'N').AND.(IBLOCK(4).EQ.'E')) RETURN
300	IF ((IBLOCK(1).EQ.'A').AND.(IBLOCK(2).EQ.'L').AND.(IBLOCK(3).EQ.
     1'L')) GO TO 80
	IF ((IBLOCK(1).EQ.'F').AND.(IBLOCK(2).EQ.'I').AND.(IBLOCK(3).EQ.
     1'N').AND.(IBLOCK(4).EQ.'I')) GO TO 82
	DO 30 I=80,1,-1
	IF (IBLOCK(I).NE.' ') GO TO 40
30	CONTINUE
	RETURN
40	IST=0
	DO 41 J=1,I
	IDUM=IBLOCK(J)
	IF (IDUM.EQ.',') GO TO 44
	IST=IST+1
	IF (IST.GT.4) GO TO 42
	IN(IST)=IDUM
	GO TO 41
42	WRITE(IDLG,43) SW(ISW),IN,IDUM
43	FORMAT(' ERROR:  ',A7,'  CODE ',5A1,' TOO LONG, TRY AGAIN'/)
	IF (ICODE) 32,1,1
32	CALL EXIT
44	NDUM=' '
	ENCODE(4,11,NDUM) IN
	GO TO (452,450), ISW
450	DO 451 K=1,6
	IF (NDUM.NE.ICOM(K)) GO TO 451
	MOPT(K)=1
	IST=0
	GO TO 41
451	CONTINUE
	GO TO 460
452	DO 45 K=1,6
	IF (NDUM.NE.MASTER(K)) GO TO 45
	MOPT(K)=1
	IST=0
	GO TO 41
45	CONTINUE
460	WRITE(IDLG,46) SW(ISW),NDUM
46	FORMAT(' ERROR:  ',A7,' CODE ',A4,' DOES NOT EXIST, TRY AGAIN'/)
	IF (ICODE) 32,1,1
41	CONTINUE
	IF (IST.EQ.0) RETURN
	NDUM=' '
	ENCODE(4,11,NDUM) IN
	GO TO (470,471),ISW
471	DO 472 K=1,8
	IF (NDUM.NE.ICOM(K)) GO TO 472
	MOPT(K)=1
	RETURN
472	CONTINUE
	GO TO 473
470	DO 47 K=1,6
	IF (NDUM.NE.MASTER(K)) GO TO 47
	MOPT(K)=1
	RETURN
47	CONTINUE
473	WRITE(IDLG,46) SW(ISW),NDUM
	IF (ICODE) 32,1,1
80	DO 81 I=ISW,NS
81	MOPT(I)=1
	RETURN
82	MOPT(1)=1
	DO 83 I=2,8
83	MOPT(I)=0
	RETURN
90	WRITE(IDLG,91)
91	FORMAT('-ASIDE FROM THE ITEM ANALYSIS SUMMARY, THE FOLLOWING
     1 ARE ADDITIONAL'/' OPTIONS AVAILABLE.  ENTER THE SELECTED OPTION
     2 CODES SEPARATED BY COMMAS:'/6X,'CODE    DESCRIPTION'/
     3 6X,4('-'),4X,11('-')/
     4 6X,'NONE    DO NOT WANT ANY OF THE OPTIONS'/
     5 6X,'ALL     ALL THE OPTIONS MENTIONED BELOW'/
     6 6X,'SUBJ    INDIVIDUAL SUBJECT TEST TOTALS'/
     7 6X,'CORR    ITEM CORRELATION MATRIX'/
     8 6X,'SPBN    USER SPECIFIED SPEARMAN-BROWN BREAKDOWN'/
     9 6X,'ITEM    INDIVIDUAL ITEM ANALYSIS'/
     1 6X,'DIFD    DIFFICULTY AND DISCRIMINATION MATRIX'/
     2 6X,'FREQ    FREQUENCIES,Z-SCORES,T-SCORES,PERCENTILE AND
     3 HISTOGRAM'/)
	CALL RELEAS (IDLG)
	GO TO 1
900	WRITE(IDLG,901)
901	FORMAT('-AT PRESENT, ANALYSIS ON ONE DATA SET IS DONE.  THE
     1 PROGRAM IS WAITING'/' FOR USER''S INSTRUCTION(S) ON WHAT IS TO
     2 TO BE PERFORMED NEXT.'//' 8 COMMAND CODES ARE AVAILABLE, ENTER
     3 THE SELECTED CODES SEPARATED BY'/' COMMAS:'//
     4 6X,'CODE    DESCRIPTION'/6X,4('-'),4X,11('-')/
     5 6X,'FINI    TO TERMINATE THE PROGRAM'/
     6 6X,'ALL     ALL THE COMMANDS LISTED BELOW'/
     7 6X,'DATA    CHANGE INPUT DATA FILE'/
     8 6X,'FORM    CHANGE FORMAT STATEMENT'/
     9 6X,'PARA    CHANGE PARAMETER STATEMENT'/
     1 6X,'SUBJ    CHANGE SUBJECT STATEMENT'/
     2 6X,'HEAD    CHANGE HEADER STATEMENT'/
     3 6X,'KEY     CHANGE THE KEY'/
     4 6X,'OPTS    CHANGE OPTION STATEMENT'/
     5 '-NOTE:  IF OUTPUT IS ASSIGNED TO THE LPT:, IT IS NECESSARY
     6 TO USE'/8X,'THE FINI COMMAND AT THE END OF ALL ANALYSIS.  FAILURE
     7 TO DO'/8X,'SO MIGHT RESULT IN LOSING THE ENTIRE OUTPUT FILE.'/)
	CALL RELEAS (IDLG)
	GO TO 1
	END
C
C	SUBROUTINE SUBJ
C
C	THIS SUBROUTINE WRITES OUT INDIVIDUAL SUBJECT TEST TOTALS.
C	THESE TOTALS ARE CALCULATED IN SUBROUTINE AUTO.
C
C
C---------------BOTH ARGS. ARE INPUT.  ID IS INPUT THRU
C--------------- COMMON /SID/.  IOUT IS INPUT THRU COMMON 
C--------------- /IOPMR/.  ITEM, ISUB ARE INPUT THRU
C--------------- COMMON /PAR/.
	SUBROUTINE SUBJ(SUB,CSCORE)
	DIMENSION SUB(1),CSCORE(1)
	COMMON/IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	INTEGER SUB
	WRITE(IOUT,10) ID,ITEM,ISUB
10	FORMAT('1INDIVIDUAL SUBJECT TEST TOTALS'/1X,16A5/'-NUMBER OF
     1 ITEMS    =',I7/' NUMBER OF SUBJECTS =',I7//5X,'TOTAL',5X,
     2 'PROPORTION'/4X,'CORRECT',5X, 'CORRECT',4X,'SUBJECT ID')
	DO 20 I=1,ISUB
	I1=(I-1)*LENGTH+1
	PS=CSCORE(I)/ITEM
20	WRITE(IOUT,21) CSCORE(I),PS,(SUB(J),J=I1,I*LENGTH)
21	FORMAT(1X,F10.0,F12.3,6X,3A5)
	RETURN
	END
C
C	SUBROUTINE SPMBR
C
C
C	THIS SUBROUTINE CALCULATES AND WRITES OUT SPEARMAN-BROWN
C	RELIABILITY BASED ON USER'S SPECIFIED BREAKDOWN.
C
C
C---------------IANS, CSCORE APPARENTLY NOT USED.  ITEM,
C--------------- ISUB ARE INPUT.  VECTOR, ISET ARE RETURNED.. IDLG
C--------------- IS INPUT THRU COMMON /IOB/.  IOUT IS INPUT THRU
C--------------- COMMON /IOPMR/.  ID IS INPUT THRU COMMON /SID/.
	SUBROUTINE SPMBR(ITEM,ISUB,IANS,CSCORE,VECTOR,ISET)
	DIMENSION IANS(1),CSCORE(1),VECTOR(1),ISET(1)
	COMMON /IOB/LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
C****** WMU AM: 1.7.1, #1, WG, 10-JAN-78
	CALL TTYPTY (ICODE)
C****** END = SPMBR, STMT 10-5
	N1=ISUB
	N2=N1+ISUB
	N3=N2+ITEM
	DO 10 I=1,N3
10	VECTOR(I)=0
	DO 100 I=1,ITEM
100	ISET(I)=0
1	WRITE(IDLG,11)
11	FORMAT('-'/'-USER SPECIFIED SPEARMAN-BROWN BREAKDOWN'/
     1 ' NUMBER OF ITEMS IN THE FIRST GROUP--',$)
	READ(ICC,12) I1
12	FORMAT(20I)
	IF ((I1.GT.0).AND.(I1.LT.ITEM)) GO TO 20
	WRITE(IDLG,13) I1
13	FORMAT('-ERROR:  IMPOSSIBLE TO FORM GROUPS WITH ',I5,' ITEMS.'/)
	IF (ICODE) 14,1,1
14	CALL EXIT
20	WRITE(IDLG,21) I1
21	FORMAT(' SPECIFY THE',I4,' ITEMS BELONGING TO THE FIRST GROUP'/
     1 ' MAXIMUM OF 20 NUMBERS PER LINE, SEPARATED BY COMMAS'/)
	READ(ICC,12) (ISET(I),I=1,I1)
	DO 22 I=1,I1
	J=ISET(I)
	VECTOR(N2+J)=1
	IF ((J.GT.0).AND.(J.LE.ITEM)) GO TO 22
	WRITE(IDLG,23) J
23	FORMAT('-ERROR:  ITEM',I4,' DOES NOT EXIST, TRY AGAIN'/)
	IF (ICODE) 14,20,20
22	CONTINUE
C
C	ARRANGE ITEM NUMBERS IN ORDER
C
	IF (I1.LE.1) GO TO 40
	DO 30 I=1,I1-1
	DO 31 J=I+1,I1
	IF (ISET(I)-ISET(J)) 31,32,33
32	WRITE(IDLG,320) ISET(I)
320	FORMAT('-ERROR:  ITEM',I4,' APPEARED MORE THAN ONCE'/)
	IF (ICODE) 14,20,20
33	ISAV=ISET(J)
	ISET(J)=ISET(I)
	ISET(I)=ISAV
31	CONTINUE
30	CONTINUE
C
C
C
40	XSB1=0
	XSB2=0
	SUMXY=0
	SUMX2=0
	SUMY2=0
	DO 41 I=1,ISUB
	IST=(I-1)*ITEM
	DO 42 J=1,I1
	ISAV=IST+ISET(J)
	IF (IANS(ISAV).EQ.1) VECTOR(I)=VECTOR(I)+1
42	CONTINUE
	X=VECTOR(I)
	VECTOR(N1+I)=CSCORE(I)-X
	Y=VECTOR(N1+I)
	SUMXY=SUMXY+X*Y
	SUMX2=SUMX2+X*X
	SUMY2=SUMY2+Y*Y
	XSB1=XSB1+X
41	XSB2=XSB2+Y
	SB1=ISUB*SUMX2-XSB1**2
	SB2=ISUB*SUMY2-XSB2**2
	T=SB1*SB2
	SBR=9.9E16
	IF (T.NE.0) SBR=(ISUB*SUMXY-XSB1*XSB2)/SQRT(T)
	XSB1=XSB1/ISUB
	XSB2=XSB2/ISUB
	I2=ISUB*(ISUB-1)
	SB1=SQRT(SB1/I2)
	SB2=SQRT(SB2/I2)
	SBRR=9.9E16
	IF (SBR.NE.-1) SBRR=(2*SBR)/(1+SBR)
C
C
C
50	WRITE(IOUT,51) ID,ITEM,ISUB,XSB1,SB1,(ISET(I),I=1,I1)
51	FORMAT('1USER SPECIFIED SPEARMAN-BROWN BREAKDOWN'/1X,16A5/
     1 '-NUMBER OF ITEMS    =',I7/' NUMBER OF SUBJECTS =',I7/
     2 '-GRP',3X,'M E A N',3X,'ST. DEV',4X,'ITEMS IN THE GROUP'/
     3 '  1 ',2F10.3,4X,10I4/(28X,10I4))
	I2=0
	DO 52 I=1,ITEM
	IF (VECTOR(N2+I).EQ.1) GO TO 52
	I2=I2+1
	ISET(I2)=I
52	CONTINUE
	WRITE(IOUT,53) XSB2,SB2,(ISET(I),I=1,I2)
53	FORMAT('  2 ',2F10.3,4X,10I4/(28X,10I4))
	WRITE(IOUT,54) SBR,SBRR
54	FORMAT(///' CORRELATION OF GROUP 1 AND 2 ITEM TOTALS =',
     1 F12.3/' WITH SPEARMAN-BROWN FORMULA =',F12.3)
	RETURN
	END

C
C	SUBROUTINE ITAN
C
C
C	THIS SUBROUTINE CALCULATES AND WRITES OUT INDIVIDUAL ITEM
C	ANALYSIS.
C
C
C---------------MAX, IKEY, ISUB, CSCORE ARE INPUT.  CSCORE
C--------------- IS MODIFIED.  IANS, VECTOR RETURNED.  IDLG,
C--------------- ICC, ARE INPUT THRU COMMON /IOB/.  IOUT IS INPUT
C--------------- THRU COMMON /IOPR/.  ITEM, ISUB, IDEM ARE INPUT
C--------------- THRU COMMON /PAR/.  U, V ARE RETURNED THRU COMMON
C--------------- /SITAN/.  L1, L3, L4, N1, N2, N3, N4, N5, N6 ARE
C--------------- RETURNED THRU COMMON /SITCAL/.  ID IS INPUT THRU
C--------------- COMMON /SID/.
	SUBROUTINE ITAN(MAX,IKEY,IANS,CSCORE,VECTOR,SUB)
C
C	SUBROUTINES CALLED:
C	     SORT
C	     ITCAL
C	     DIFSUM
C
C
	INTEGER SUB
	DOUBLE PRECISION IGR(3)
	DIMENSION IKEY(1),IANS(1),CSCORE(1),VECTOR(1),SUB(1)
	COMMON/IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SITAN/U,V
	COMMON/SITCAL/L1,L3,L4,N1,N2,N3,N4,N5,N6
	DATA STARS/'*****'/
	DATA IGR/'LOWER ','MIDDLE','UPPER '/
C****** WMU AM: 1.7.1, #1, WG, 10-JAN-78
	CALL TTYPTY (ICODE)
C****** END = ITAN, STMT 10-7
	U=27
	V=27
	IF (IDEM.EQ.2) GO TO 20
C
C	READ BACK RAW DATA
C
	READ(1) (IKEY(I),I=1,ITEM)
	DO 10 I=1,ISUB
	I1=(I-1)*ITEM+1
10	READ(1)(IANS(J),J=I1,I*ITEM)
	CALL RELEAS(1)
20	CALL SORT(CSCORE,IANS,SUB,VECTOR)
21	WRITE(IDLG,22)
22	FORMAT('-INDIVIDUAL ITEM ANALYSIS'/' SPECIFY THE METHOD TO
     1 CONSTRUCT THE UPPER AND LOWER GROUPS'/' TYPE HELP IF NEEDED--',$)
	READ(ICC,23) VECTOR(1)
23	FORMAT(A4)
	IF (VECTOR(1).NE.'HELP') GO TO 25
	WRITE(IDLG,230)
230	FORMAT('-THERE ARE 3 METHODS IN SPECIFYING THE GROUPS'/
     1 ' ENTER THE CODE ASSOCIATING WITH THE METHOD DESIRED'/
     2 '-',5X,'CODE  DESCRIPTION'/
     3 8X,'1   UPPER GROUP CONSISTS OF THE UPPER 27%,'/
     4 12X,'LOWER GROUP CONSISTS OF THE LOWER 27%'/
     5 8X,'2   UPPER GROUPS CONSISTS OF THE UPPER 50%'/
     6 12X,'LOWER GROUP CONSISTS OF THE LOWER 50%'/
     7 8X,'3   OTHER METHOD TO BE SPECIFIED BY USER'/)
24	IF (ICODE) 240,21,21
240	CALL EXIT
25	REREAD 26, IMT
26	FORMAT(I)
	IF ((IMT.LE.3).AND.(IMT.GT.0)) GO TO 28
	WRITE(IDLG,27) IMT
27	FORMAT('-ERROR:  METHOD',I3,' DOES NOT EXIST'/)
	GO TO 24
28	IF (IMT-2) 35,31,32
31	U=50
	V=50
	GO TO 35
32	WRITE(IDLG,33)
33	FORMAT(' ENTER % OF UPPER AND LOWER GROUPS, SEPARATED BY
     1 COMMA--',$)
	READ(ICC,34) U,V
34	FORMAT(2F)
	IF ((U+V).LE.100) GO TO 35
	WRITE(IDLG,340)
340	FORMAT('-ERROR:  INCORRECT CHOICES OF UPPER AND LOWER GROUPS,
     1 TRY AGAIN'/)
	IF (ICODE) 240,32,32
C
C	L1--NUMBER OF SUBJECTS IN LOWER GROUP
C	L3--NUMBER OF SUBJECTS IN MIDDLE GROUP
C	L4--NMBER OF SUBJECTS IN UPPER GROUP
C
35	L1=(V*ISUB)/100
	L4=(U*ISUB)/100
	L3=ISUB-L1-L4
	V1=100-U-V
	IF (V1.NE.0) GO TO 360
	IF (L3.EQ.0) GO TO 360
	L4=(U*ISUB)/100+.5
	L3=0
360	WRITE(IOUT,36) ID,ITEM,ISUB,IGR(1),V,L1,IGR(2),V1,L3,IGR(3),U,L4
36	FORMAT('1INDIVIDUAL ITEM ANALYSIS'/1X,16A5/'-NUMBER OF ITEMS
     1    =',I7/' NUMBER OF SUBJECTS =',I7/'-GROUP * PERCENT * # OF
     2 SUBJECTS'/1X,32('*')/3(1X,A6,'*',F7.2,'% *',I6/))
C
C
C
	N1=ITEM
	N2=N1+ITEM
	IF (IDEM.EQ.2) GO TO 70
	N3=N2+MAX
	N4=N3+MAX
	N5=N4+MAX
	N6=N5+3
	N7=N6+MAX
C
C	FOR RAW DATA ONLY
C
	DO 40 I=1,ITEM
	CALL ITCAL(ITEM,I,IANS,VECTOR)
	WRITE(IOUT,41) I,ITEM,IKEY(I), (J,J=1,MAX)
41	FORMAT('-'/'-ITEM ANALYSIS FOR QUESTION',I4,' OF',I5/
     1 ' THE CORRECT ANSWER IS',I3/'-',6X,'* MISS-'/
     2 ' GROUP *   ING',9I6)
	NTIMES=((MAX+2)*6+4)/5
	WRITE(IOUT,42) (STARS, J=1,NTIMES)
42	FORMAT(' *',14A5)
C
C	LOWER GROUP
C
	IDUM=1
	NN=N2+1
	LAST=N3
	N=L1
	GO TO 50
C
C	MIDDLE GROUP
C
43	IF (L3.EQ.0) GO TO 44
	IDUM=2
	NN=N3+1
	LAST=N4
	N=L3
	GO TO 50
C
C	UPPER GROUP
C
44	IDUM=3
	NN=N4+1
	LAST=N5
	N=L4
C
C
C
50	T=VECTOR(N5+IDUM)
	WRITE(IOUT,51) IGR(IDUM),T,(VECTOR(J),J=NN,LAST)
51	FORMAT(7X,'*'/1X,A6,'*',10F6.0)
	PT=T/N*100
	J1=N6
	DO 52 J=NN,LAST
	J1=J1+1
52	VECTOR(J1)=VECTOR(J)/N*100
	WRITE(IOUT,53) PT, (VECTOR(J),J=N6+1,N7)
53	FORMAT(3X,'%   *',10F6.2)
	GO TO (43,44,54), IDUM
54	T=VECTOR(N5+1)+VECTOR(N5+2)+VECTOR(N5+3)
	DO 55 J=1,MAX
	VECTOR(N6+J)=VECTOR(N2+J)+VECTOR(N3+J)+VECTOR(N4+J)
55	VECTOR(N2+J)=VECTOR(N6+J)/ISUB*100
	WRITE(IOUT,56) T, (VECTOR(J),J=N6+1,N7)
56	FORMAT(7X,'*'/' TOTAL *',10F6.0)
	T=T/ISUB*100
	WRITE(IOUT,53) T, (VECTOR(J),J=N2+1,N3)
40	CONTINUE
	WRITE(IOUT,57)
57	FORMAT('1')
C
C	CORRECT TEST AND RE-STORE IANS SINCE THE ORDER HAS BEEN CHANGED

C
	WRITE(1) (IKEY(I),I=1,ITEM)
	DO 60 I=1,ISUB
	I1=(I-1)*ITEM
	WRITE(1) (IANS(J),J=I1+1,I1+ITEM)
	DO 61 J=1,ITEM
	K=I1+J
	LL1=IANS(K)
	IF (LL1.NE.0) GO TO 63
62	IANS(K)=2
	GO TO 61
63	IF (LL1.NE.IKEY(J)) GO TO 62
	IANS(K)=1
61	CONTINUE
60	CONTINUE
	CALL RELEAS(1)
C
C	CALCULATION FOR ALL
C
70	N3=N2+2
	N4=N3+2
	N5=N4+2
	N6=N5+2
	WRITE(IOUT,701)
701	FORMAT('-'/'-ITEM ANALYSIS ON CORRECTED SCORES')
	IF (L3.GT.0) GO TO 703
	WRITE(IOUT,702) IGR(1),V,IGR(3),U
702	FORMAT('-',4X,2('* ',A6,F7.2,'%'),'* T  O  T  A  L *'/5X,49('*')
     1 /' ITEM*',3('CORRECT  INCORR*')/1X,53('*')/5X,'*',3(15X,'*'))
	GO TO 710
703	WRITE(IOUT,704) IGR(1),V,IGR(2),V1,IGR(3),U
704	FORMAT('-',4X,3('*',A6,1X,F6.2,'% '),'* T  O  T  A  L *'/5X,65
     1('*')/' ITEM*',4('CORRECT  INCORR*')/1X,69('*')/5X,'*',4(15X,'*'))
710	DO 71 I=1,ITEM
	CALL ITCAL(ITEM,I,IANS,VECTOR)
	VECTOR(N5+1)=VECTOR(N2+1)+VECTOR(N3+1)+VECTOR(N4+1)
	VECTOR(N6)=VECTOR(N3)+VECTOR(N4)+VECTOR(N5)
	IF (L3.GT.0) GO TO 80
	WRITE(IOUT,72) I,(VECTOR(J),J=N2+1,N3),(VECTOR(J1),J1=N4+1,N6)
72	FORMAT(1X,I4,'*',4(F7.0,1X,F7.0,'*'))
	IDUM=L1
	NN=N2
	DO 73 J=1,3
	IF (J-2) 740,741,742
741	IDUM=L4
	NN=N4
	GO TO 740
742	IDUM=ISUB
	NN=N5
740	DO 74 K=NN+1,NN+2
74	VECTOR(K)=VECTOR(K)/IDUM*100
73	CONTINUE
	WRITE(IOUT,75) (VECTOR(J),J=N2+1,N3),(VECTOR(J1),J1=
     1 N4+1,N6)
75	FORMAT(5X,'*',4(F6.2,'% ',F6.2,'%*'))
	WRITE(IOUT,750)
750	FORMAT(5X,'*',3(15X,'*'))
	GO TO 82
80	NN=N2+1
	WRITE(IOUT,72) I, (VECTOR(J),J=NN,N6)
	IDUM=L1
	DO 81 J=NN,N6
	IF (J.EQ.N3+1) IDUM=L3
	IF (J.EQ.N4+1) IDUM=L4
	IF (J.EQ.N5+1) IDUM=ISUB
81	VECTOR(J)=VECTOR(J)/IDUM*100
	WRITE(IOUT,75) (VECTOR(J),J=NN,N6)
	WRITE(IOUT,810)
810	FORMAT(5X,'*',4(15X,'*'))
C
C	CALCULATE INDEX OF DIFFICULTY AND INDEX OF DISCRIMINATION
C
82	VECTOR(I)=IFIX(VECTOR(N5+2)+.5)
	VECTOR(N1+I)=IFIX(VECTOR(N4+1)-VECTOR(N2+1)+.5)
71	CONTINUE
	CALL DIFSUM(VECTOR)
	RETURN
	END
C
C	SUBROUTINE ITCAL
C
C	THIS SUBROUTINE COUNTS THE NUMBER OF SUBJECTS BELONGING TO
C	EACH OF THE 3 GROUPS.
C
C
C---------------I, ITEM, IANS, ARE INPUT.  VECTOR IS RETURNED.
C--------------- L1, L3, L4, N2, N3, N4, N5, N6 ARE INPUT THRU
C--------------- COMMON /SITCAL/.
	SUBROUTINE ITCAL(ITEM,I,IANS,VECTOR)
	DIMENSION IANS(1),VECTOR(1)
	COMMON/SITCAL/L1,L3,L4,N1,N2,N3,N4,N5,N6
C
C	VECTOR:
C
C	   1-N1  DIF VECTOR
C	N1+1-N2  DIS VECTOR
C	N2+1-N3  COUNTS FOR LOWER GROUP
C	N3+1-N4  COUNTS FOR MIDDLE GROUP
C	N4+1-N5  COUNTS FOR UPPER GROUP
C	N5+1-N6  MISSING COUNT FOR EACH 3 GROUPS
C
	DO 10 J=N2+1,N6
10	VECTOR(J)=0
C
C
	IDUM=1
	IST=1
	LAST=L1
	NDUM=N2
	GO TO 40
20	IF (L3.EQ.0) GO TO 30
	IDUM=2
	IST=L1+1
	LAST=L1+L3
	NDUM=N3
	GO TO 40
30	IDUM=3
	IST=LAST+1
	LAST=LAST+L4
	NDUM=N4
40	K2=N5+IDUM
	DO 41 J=IST,LAST
	K=(J-1)*ITEM+I
	IF (IANS(K).EQ.0) GO TO 42
	K1=NDUM+IANS(K)
	VECTOR(K1)=VECTOR(K1)+1
	GO TO 41
42	VECTOR(K2)=VECTOR(K2)+1
41	CONTINUE
	GO TO (20,30,50) , IDUM
50	RETURN
	END
C---------------CSCORE, IANS, SUB ARE INPUT.  CSCORE IS MODIFIED.
C--------------- IVEC IS RETURNED.  IDLG IS INPUT THRU COMMON /IOB/.
C---------------ITEM, ISUB, LENGTH ARE INPUT THRU COMMON /PAR/.
	SUBROUTINE SORT(CSCORE,IANS,SUB,IVEC)
C
C	THIS SUBROUTINE SORTS CSCORE IN ASCENDING ORDER CARRYING
C	SUBJECT RESPONSE VECTOR IANS AND ID VECTOR SUB ALONG
C
	DIMENSION CSCORE(1),IANS(1),SUB(1),IVEC(1),ISAV(3)
	INTEGER SUB
	COMMON/IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	IF (ISUB.LE.1) RETURN
	A=CSCORE(1)
	B=CSCORE(2)
	IF (A.LE.B) GO TO 11
	CSCORE(1)=B
	CSCORE(2)=A
	DO 1 I=1,ITEM
	IDUM=IANS(I)
	L1=ITEM+I
	IANS(I)=IANS(L1)
1	IANS(L1)=IDUM
	DO 10 I=1,LENGTH
	IDUM=SUB(I)
	L1=LENGTH+I
	SUB(I)=SUB(L1)
10	SUB(L1)=IDUM
11	IF (ISUB.LE.2) RETURN
	DO 20 I=3,ISUB
	A=CSCORE(I)
	J1=(I-1)*LENGTH
	DO 21 J=1,LENGTH
21	ISAV(J)=SUB(J1+J)
	M1=(I-1)*ITEM
	DO 210 J=1,ITEM
210	IVEC(J)=IANS(M1+J)
	IF (A.GT.CSCORE(1)) GO TO 30
	IST=1
22	L1=IST*LENGTH+1
	L2=I*LENGTH
	DO 23 J=I,IST+1,-1
23	CSCORE(J)=CSCORE(J-1)
	CSCORE(IST)=A
	DO 24 J=L2,L1,-1
24	SUB(J)=SUB(J-LENGTH)
	L1=L1-LENGTH
	DO 25 J=1,LENGTH
	SUB(L1)=ISAV(J)
25	L1=L1+1
	M1=IST*ITEM+1
	M2=I*ITEM
	DO 26 J=M2,M1,-1
26	IANS(J)=IANS(J-ITEM)
	M1=M1-ITEM
	DO 27 J=1,ITEM
	IANS(M1)=IVEC(J)
27	M1=M1+1
	GO TO 20
30	IF (A.GE.CSCORE(I-1)) GO TO 20
	DO 31 K=2,I-1
	IF (A.GT.CSCORE(K)) GO TO 31
	IST=K
	GO TO 22
31	CONTINUE
	WRITE(IDLG,32)
32	FORMAT('-ERROR IN SORT ROUTINE, CONTACT COMPUTER CENTER STAFF'/)
	CALL EXIT
20	CONTINUE
	RETURN
	END
C
C	SUBROUTINE DIFS1
C
C
C	THIS SUBROUTINE CALCULATES AND WRITES OUT (BY CALLING SUBROUTINE
C	DIFSUM) THE INDEX OF DISCRIMINATION AND INDEX OF DIFFICULTY.
C
C
C
C	SUBROUTINES CALLED:
C
C	     ITCAL
C	     DIFSUM
C
C---------------IANS IS INPUT. VECTOR IS RETURNED.  ITEM, 
C--------------- ISUB, ARE INPUT THRU COMMON /PAR/.  U, V ARE
C--------------- RETURNED THRU COMMON /SITAN/.  L1, L3, L4, N1, N2,
C--------------- N3, N4, N5, N6 ARE RETURNED THRU COMMON /SITCAL/.
	SUBROUTINE DIFS1(IANS,VECTOR)
	DIMENSION IANS(1),VECTOR(1)
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SITAN/U,V
	COMMON/SITCAL/L1,L3,L4,N1,N2,N3,N4,N5,N6
	U=27
	V=27
	N1=ITEM
	N2=N1+ITEM
	N3=N2+2
	N4=N3+2
	N5=N4+2
	N6=N5+2
	L1=(27*ISUB)/100
	L4=L1
	L3=ISUB-L1-L4
	DO 10 I=1,ITEM
	CALL ITCAL(ITEM,I,IANS,VECTOR)
	VECTOR(N1+I)=IFIX(VECTOR(N4+1)/L4*100-VECTOR(N2+1)/L1*100+.5)
10	VECTOR(I)=IFIX((VECTOR(N2+2)+VECTOR(N3+2)+VECTOR(N4+2))/
     1ISUB*100+.5)
	CALL DIFSUM(VECTOR)
	RETURN
	END
C
C	SUBROUTINE DIFDS
C
C	THIS SUBROUTINE CALCULATES AND WRITES DIFFICULTY AND
C	DISCRIMINATION MATRIX.
C
C
C---------------VECTOR IS RETURNED.  IOUT IS INPUT THRU COMMON
C--------------- /IOPMR/.  ITEM, ISUB ARE INPUT THRU COMMON /PAR/.
	SUBROUTINE DIFDS(VECTOR)
	DIMENSION VECTOR(1),NDD(11,6),LABEL(10)
	COMMON/IOB/LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	DATA LABEL/'D* (','I* (','S* (','C* (','R* (','I* (','M* (',
     1 'I* (','N* (','A* ('/
	N1=ITEM
	N2=N1+ITEM
	N3=N2+6
	N4=N3+11
	DO 10 I=N2+1,N4
10	VECTOR(I)=0
	DO 11 I=1,6
	DO 11 J=1,11
11	NDD(J,I)=0
	DF=0
	DI=0
	DO 21 I=1,ITEM
	TS=VECTOR(N1+I)
	TF=VECTOR(I)
C
C	CALCULATE SUM OF DIF AND DIS
C	CALCULATE NUMBER OF ITEMS WITHIN THE RANGES
C
	DI=DI+TS
	DF=DF+TF
	I1=(100+TS)/20+1
	I2=TF/20+1
	NDD(I1,I2)=NDD(I1,I2)+1
	VECTOR(N2+I2)=VECTOR(N2+I2)+1
21	VECTOR(N3+I1)=VECTOR(N3+I1)+1
	DF=DF/ITEM
	DI=DI/ITEM
	WRITE(IOUT,23) DI,DF,ISUB
23	FORMAT('-AVERAGE INDEX OF DISCRIMINATION =',F12.3/
     1 ' AVERAGE INDEX OF DIFFICULTY     =',F12.3/
     2 '-NOTE:  INDEX OF DISCRIMINATION = DIFFERENCES BETWEEN THE
     3 PROPORTION'/8X,'OF THE UPPER GROUP (27%) WHO GOT AN ITEM CORRECT
     4 AND THE'/8X,'PROPORTION OF THE LOWER GROUP (27%) WHO GOT THE
     5 ITEM CORRECT.'/26X,'RANGE = (-100,100)'//
     6 8X,'INDEX OF DIFFICULTY     = PROPORTION OF THE',I5,' SUBJECTS
     7 WHO'/8X,'ANSWERED THE ITEM INCORRECTLY.'/26X,'RANGE = (0,100)'/
     8 '-'/'-DIFFICULTY AND DISCRIMINATION MATRIX'/' (ENTRIES ARE
     9 NUMBERS OF ITEMS WITHIN RANGES)'/'- *',12X,'* D    I    F    F
     1    I    C    U    L    T    Y * # OF'/2X,'* R A N G E  *
     2  (0-19) (20-39) (40-59) (60-79) (80-99) (100- )* ITEMS'/
     3 1X,70('*'))
	J=-120
	DO 31 I=1,10
	J=J+20
	J1=J+19
31	WRITE(IOUT,32) LABEL(I),J,J1,(NDD(I,K),K=1,6),VECTOR(N3+I)
32	FORMAT(1X,A4,I4,',',I3,') * ',5(I6,2X),I6,' *',F5.0)
	WRITE(IOUT,33) (NDD(11,K),K=1,6),VECTOR(N4),(VECTOR(I),I=N2+1,
     1 N2+6), ITEM
33	FORMAT(' T* ( 100,   ) * ',5(I6,2X),I6,' *',F5.0/' I',69('*')/
     1 ' O* # OF ITEMS *',6F8.0,'*',I4/' N*',12X,'*',48X,'*')
	RETURN
	END
C
C	SUBROUTINE DIFSUM
C
C
C	THIS SUBROUTINE WRITES OUT THE ITEM DIFFICULTY AND
C	DISCRIMINATION SUMMARY.
C
C
C---------------VECTOR IS INPUT.  IOUT IS INPUT THRU COMMON
C--------------- /IOPMR/.  ID IS INPUT THRU COMMON /SID/.  ITEM,
C--------------- ISUB ARE INPUT THRU COMMON /PAR/.  V, U ARE
C--------------- INPUT THRU COMMON /SITAN/.
	SUBROUTINE DIFSUM(VECTOR)
	DIMENSION VECTOR(1)
	COMMON/IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SITAN/U,V
	WRITE(IOUT,10) ID,ITEM,ISUB,V,U
10	FORMAT('1ITEM DIFFICULTY AND DISCRIMINATION SUMMARY'/1X,16A5/
     1 '-NUMBER OF ITEMS    =',I7/' NUMBER OF SUBJECTS =',I7/
     2 '-LOWER GROUP:',F7.2,'%'/' UPPER GROUP:',F7.2,'%'/'-',5X,
     3 '*  I N D E X  *  I N D E X'/' ITEM *  OF   DIS-  *',5X,'OF'/6X,
     4'* CRIMINATION * DIFFICULTY'/1X,32('*')/6X,'*',13X,'*')
	DO 11 I=1,ITEM
11	WRITE(IOUT,12) I,VECTOR(ITEM+I),VECTOR(I)
12	FORMAT(1X,I4,' *',3X,F6.0,4X,'*',3X,F6.0)
	RETURN
	END
C
C	SUBROUTINE FREQ
C
C	THIS SUBROUTINE CALCULATES AND WRITES OUT FREQUENCIES,
C	Z-SCORES, T-SCORES, PERCENTILE AND HISTOGRAM.
C
C
C--------------- CSCORE IS INPUT.  VECTOR IS RETURNED.  IOUT
C--------------- IS INPUT THRU COMMON /IOPMR/.  ISUB IS INPUT
C--------------- THRU COMMON /PAR/.  XB, SD ARE INPUT THRU
C--------------- COMMON /SAUTO/.  ID IS INPUT THRU COMMON /SID/.
	SUBROUTINE FREQ(CSCORE,VECTOR)
C
C	THIS SUBROUTINE ASSUMES CSCORE IS IN ASCENDING ORDER
C
	DIMENSION CSCORE(1),VECTOR(1),LINE(120)
	COMMON /IOB/ LEF,IRT,IALT,MPG,IPG,IPGCT,IDLG,ICC,II,OUTDV
	COMMON/IOPMR/ INP,IOUT,IO2,IO3
	COMMON/SID/ID(16),ISTOP
	COMMON/PAR/ITEM,ISUB,IDEM,ISIDT,ILEN,LENGTH
	COMMON/SAUTO/XB,SD
	DOUBLE PRECISION ARROW,DOTS,BLANK
	DATA ARROW,DOTS,BLANK/'         ^','.........+','          '/
	N1=ISUB
	N2=N1+ISUB
	DO 10 I=1,N2
10	VECTOR(I)=0
	VECTOR(1)=CSCORE(1)
	VECTOR(N1+1)=1
	NFF=1
	NPT=N1+NFF
	DO 20 I=2,ISUB
	IF (CSCORE(I).EQ.VECTOR(NFF)) GO TO 21
	NFF=NFF+1
	NPT=NPT+1
	VECTOR(NFF)=CSCORE(I)
21	VECTOR(NPT)=VECTOR(NPT)+1
20	CONTINUE
C
C
C
	WRITE(IOUT,30) ID,ITEM,ISUB,XB,SD
30	FORMAT('1FREQUENCY  DISTRIBUTION'/1X,16A5/'-NUMBER OF ITEMS     
     1=',I7/' NUMBER OF  SUBJECTS =',I7/'-TEST MEAN     =',F12.3/
     2 ' TEST ST. DEV. =',F12.3)
	IF (SD.NE.0) GO TO 301
	WRITE(IOUT,300)
300	FORMAT('-NO CALCULATIONS DONE WITH STANDARD DEVIATION OF ZERO')
	GO TO 40
301	WRITE(IOUT,302)
302	FORMAT('-******',14X,'CUM -',2X,'C U M',4X,'CUM',4X,'STANDARD',
     1 3X,'NORMAL',2X,'STANDARD'/' SCORE* FREQ',4X,'%',5X,'FREQ',4X,
     2 '%',4X,'T-SCORE',4X,'SCORE',3X,'CUM',3X,'%',2X,'T-SCORE'/
     3 1X,70('*')/6X,'*')
C	MAXF--HIGHEST FREQUENCY
C
	MAXF=VECTOR(N1+1)
	NC=0
	DO 31 I=1,NFF
	I1=VECTOR(I)
	I2=VECTOR(N1+I)
	IF (I2.GT.MAXF) MAXF=I2
	ZF=(VECTOR(I)+.5-XB)/SD
	PF=FLOAT(I2)/ISUB*100
	ZT=50+10*ZF
	NC=NC+I2
	P=FLOAT(NC)/ISUB*100.
C
C	THE FOLLOWING CALCULATION IS TAKEN FROM IBM SCIENTIFIC
C	SUBROUTINE PACKAGE, SUBROUTINE NDTR
C
	AX=ABS(ZF)
	T=1.0/(1.0+.2316419*AX)
	D=0.3989423*EXP(-ZF*ZF/2.0)
	ZS=1.0-D*T*((((1.330274*T-1.821256)*T+1.781478)*T-0.3565638)*
     1 T+0.3193815)
	IF (ZF.LT.0) ZS=1-ZS
C
C
C
	PP=1-P/100.
	IF (PP.GT.0) GO TO 32
	ZS=ZS*100.
	WRITE(IOUT,320) I1,I2,PF,NC,P,ZF,ZS,ZT
320	FORMAT(1X,I5,'*',I5,F7.2,I7,F7.2,9X,F10.2,F9.2,F10.2)
	WRITE(IOUT,321)
321	FORMAT('-NOTE:  STANDARD T-SCORE IS BASED ON THE STANDARD
     1 NORMAL SCORE.'/8X,'CUMULATIVE T-SCORE IS BASED ON THE CUMULATIVE
     2 % SCORE.'/)
	GO TO 40
32	IF (PP.LE..5) TT=ALOG(1/(PP**2))
	IF (PP.GT..5) TT=ALOG(1/(1-PP)**2)
	TT=SQRT(TT)
33	T2=TT*TT
	XP=TT-((2.515517+.802853*TT+.010328*T2)/(1+1.432788*TT
     1+.189269*T2+.001308*T2*TT))
	IF (PP.GT..5) XP=-XP
	XP=50+10*XP
	ZS=100*ZS
31	WRITE(IOUT,34) I1,I2,PF,NC,P,XP,ZF,ZS,ZT
34	FORMAT(1X,I5,'*',I5,F7.2,I7,F7.2,2(F9.2,F10.2))
	WRITE(IOUT,35)
35	FORMAT('-STANDARD T-SCORE IS BASED ON THE STANDARD NORMAL
     1 SCORE.'/' CUMMULATIVE T-SCORE IS BASED ON THE CUMMULATIVE
     2 PERCENT SCORE.'/)
C
C	HISTOGRAM
C
40	IEND=60
	IF (IO3.NE.'TTY') IEND=120
	LHALF=IEND/2
	IF (MAXF.LT.LHALF) IEND=LHALF
	LAST=IEND
	IF (MAXF.GT.IEND) LAST=MAXF
	DELTA=FLOAT(LAST)/IEND
	NTIMES=LAST/10
	N3=N2+NTIMES
	DO 41 I=1,NTIMES
41	VECTOR(N2+I)=DELTA*I*10
	WRITE(IOUT,42) ID,DELTA,((BLANK,VECTOR(I)),I=N2+2,N3,2)
42	FORMAT('1HISTOGRAM'/1X,16A5/' GRAPH INTERVAL =',G12.4/
     1 '-',7X,'0',6(A10,F10.3))
	IF (LAST.NE.30) GO TO 430
	WRITE(IOUT,43) ((VECTOR(I),ARROW),I=N2+1,N3-2,2),VECTOR(N3)
43	FORMAT(8X,'^',6(F10.3,A10))
	GO TO 440
430	WRITE(IOUT,43) ((VECTOR(I),ARROW),I=N2+1,N3,2)
440	WRITE(IOUT,44) (ARROW,I=1,NTIMES)
44	FORMAT(8X,'^',12A10)
	WRITE(IOUT,45) (DOTS,I=1,NTIMES)
45	FORMAT(' SCORE  +',12A10)
	WRITE(IOUT,46)
46	FORMAT(8X,'+')
	ROUND=DELTA/2
	DO 50 I=1,NFF
	DO 51 J=1,IEND
51	LINE(J)=' '
	I2=VECTOR(I)
	I1=VECTOR(N1+I)/DELTA+ROUND
	IF (I1.LE.0) GO TO 50
	DO 52 J=1,I1
52	LINE(J)='X'
50	WRITE(IOUT,53) I2,(LINE(J),J=1,I1)
53	FORMAT(1X,I5,2X,'+',120A1)
	WRITE(IOUT,46)
	RETURN
	END