Trailing-Edge
-
PDP-10 Archives
-
decuslib10-10
-
43,50520/stp17.stp
There are no other files named stp17.stp in the archive.
SUBROUTINE ITEMA(NV,NC,MV,MC,DATA,COR,SCORE,IGROUP,CO,VMN,STD
1,NAMES)
DIMENSION ANS(3,200),SCORE(1),INPUT(15),OPT(8),LOPT(8)
DIMENSION IV(200),LIN(64),NANS(200),EXTRA(3),NMISS(200)
DIMENSION NRIGHT(200),XSUM(200),YSUM(200),SUMN(200)
DIMENSION XYSUM(200),IGROUP(1),MAX(4),MIN(4),XMEAN(4)
DIMENSION NT(4),MM(10,5),IU(16),IL(16),NAMES(1),PCENT(3)
DIMENSION IVAL(3),CO(1),STD(1),VMN(1),COR(MV,MV),DATA(MC,MV)
COMMON /EXTRA/ HEDR(70),NSZ
COMMON /DEV/ ICC,IDATA,IOUT,IDLG,IDSK
COMMON /PRNT/ LINPP
EQUIVALENCE (XSUM,NMISS),(YSUM,NRIGHT)
DATA LOPT/'SPLIT','USPEC','ANSWR','SSCOR','NODDM',
1'NOCOR','MISSA',' '/
NOUT=6
IF(IOUT.EQ.21) NOUT=13
1 DO 4 I=1,8
4 OPT(I)=0
WRITE(IDLG,2)
2 FORMAT(' ENTER OPTIONS SEPARATED BY COMMAS')
READ(ICC,3,END=1) INPUT
3 FORMAT(15(A5,1X))
IF(INPUT(1).EQ.'!') RETURN
DO 5 I=1,10
IF(INPUT(I).EQ.' ') GO TO 20
IF(INPUT(I).EQ.'HELP') GO TO 6
IF(INPUT(I).NE.'HELP,') GO TO 8
6 WRITE(IDLG,7)
7 FORMAT('0THE PROGRAM ASSUMES DATA TO BE UNCORRECTED WITH ONE'/
1' OBSERVATION IN THE DATA CONTAINING THE CORRECT ANSWERS.'/
1' GROUPING FOR THE INDEX OF DISCRIMINATION ARE ASSUMED'/
1' TO BE 27%, 46%, 27%. NO MATTER THE GROUPINGS USED THE'/
1' PERCENTAGES WILL BE ALTERED SO THAT THE BREAKS WILL OCCUR'/
1' BETWEEN DIFFERENT VALUES. NEGATIVE AND ZERO VALUES ARE'/
1' TREATED AS MISSING DATA.'/
1'0 OPTIONS AVAILABLE:'/
1' SPLIT - 50%, 50% GROUPING FOR INDEX OF DISCRIMINATION'/
1' USPEC - USER SPECIFIED GROUPING FOR INDEX OF DISCRIMINATION'/
1' ANSWR - ANSWERS ENTERED BY USER, NOT IN AN OBSERVATION'/
1' SSCOR - SAVE INDIVIDUAL SCORES AS A VARIABLE'/
1' NOCOR - DO NOT OUTPUT ITEM CORRELATION MATRIX'/
1' NODDM - DO NOT OUTPUT MATRIX OF DISCRIMANATE VS DIFFICULTY'/
1 ' INDICIES'/
1' MISSA - MISSING ANSWERS ARE TREATED AS INCORRECT'/
1' RESPONSES.')
GO TO 1
8 DO 9 J=1,8
IF(INPUT(I).NE.LOPT(J)) GO TO 9
OPT(J)=1
GO TO 5
9 CONTINUE
WRITE(IDLG,10) INPUT(I)
10 FORMAT(' OPTION "',A5,'" DOES NOT EXIST')
GO TO 1
5 CONTINUE
20 WRITE(IDLG,21)
21 FORMAT(' WHICH VARIABLES? ',$)
CALL ALPHA(IV,200,NN,IRET,IHELP,IERR,NAMES,NV)
IF(IRET.EQ.1) RETURN
IF(IERR.EQ.1) GO TO 20
IF(IHELP.NE.1) GO TO 23
WRITE(IDLG,22)
22 FORMAT(' ENTER THE VARIABLES TO BE USES AS ITEMS IN THE'/
1' ITEM ANALYSIS. UP TO 200 ITEMS MAY BE ANALYSED IN ONE'/
1' PASS. ITEMS MAY BE ENTERED BY THE NUMBER OF THE VARIABLE, OR'/
1' THE NAME OF THE VARIABLE. RANGES OF VARIABLES MAY BE ENTERED'/
1' BY TYPING THE EXTREMES OF THE RANGE SEPARATED BY A MINUS'/
1' "-". IF THERE ARE 200 OR FEWER VARIABLES, AND ALL OF THEM'/
1' ARE TO BE USED AS ITEMS, "ALL" OR "*" MAY BE ENTERED.')
GO TO 20
23 DO 24 I=1,NN
IF(IV(I).GT.0) GO TO 24
IF(NV.LE.200) GO TO 26
WRITE(IDLG,25)
25 FORMAT(' TOO MANY ITEMS - MAXIMUM OF 200 ALLOWED.')
GO TO 20
24 CONTINUE
GO TO 30
26 DO 27 I=1,NV
27 IV(I)=I
NN=NV
30 IF(OPT(3).EQ.1) GO TO 50
C
C ANSWERS IN ONE OF THE OBSERVATIONS
C
31 WRITE(IDLG,32)
32 FORMAT(' WHICH OBSERVATION IS THE ANSWERS? ',$)
READ(ICC,33,END=31) INPUT
33 FORMAT(80A1)
IF(INPUT(1).EQ.'!') RETURN
IF(INPUT(1).NE.' ') GO TO 35
IOBS=1
WRITE(IDLG,34)
34 FORMAT(' FIRST OBSERVATION ASSUMED')
GO TO 46
35 IF((INPUT(1).EQ.'H').OR.(INPUT(2).EQ.'E').OR.(INPUT(3).EQ.'L')
1.OR.(INPUT(4).NE.'P')) GO TO 37
WRITE(IDLG,36)
36 FORMAT('0 ENTER THE OBSERVATION NUMBER WHICH CONTAINS THE'/
1' ANSWERS FOR EACH ITEM. "FIRST" WILL BE TRANSLATED AS 1,'/
1' AND "LAST" WILL BE INTERPRETED TO BE THE LAST OBSERVATION.'/
1' THE OBSERVATION INDICATED WILL NOT BE INCLUDED IN THE'/
1' ANALYSIS. TO ENTER CORRECT ANSWERS BY TERMINAL FOR EACH ITEM'/
1' RESPOND WITH "CORRT".')
GO TO 31
37 IF((INPUT(1).NE.'C').OR.(INPUT(2).NE.'O').OR.(INPUT(3).NE.'R')
1.OR.(INPUT(4).NE.'R').OR.(INPUT(5).NE.'T')) GO TO 38
OPT(3)=1
GO TO 50
38 IF((INPUT(1).NE.'F').OR.(INPUT(2).NE.'I').OR.(INPUT(3).NE.'R')
1.OR.(INPUT(4).NE.'S').OR.(INPUT(5).NE.'T')) GO TO 39
IOBS=1
GO TO 46
39 IF((INPUT(1).NE.'L').OR.(INPUT(2).NE.'A').OR.(INPUT(3).NE.'S')
1.OR.(INPUT(4).NE.'T')) GO TO 40
IOBS=NC
GO TO 46
40 DO 41 I=1,15
IF(INPUT(I).EQ.' ') GO TO 43
IF((INPUT(I).GE.'0').AND.(INPUT(I).LE.'9')) GO TO 41
WRITE(IDLG,42) INPUT(I)
42 FORMAT(' ILLEGAL CHARACTER "',A1,'" IN OBSERVATION NUMBER')
GO TO 31
41 CONTINUE
43 IF(INPUT(15).NE.' ') GO TO 49
DO 48 I=15,2,-1
48 INPUT(I)=INPUT(I-1)
INPUT(1)=' '
GO TO 43
49 ENCODE(15,33,EXTRA) INPUT
DECODE(15,44,EXTRA) IOBS
44 FORMAT(I15)
IF((IOBS.GT.0).AND.(IOBS.LE.NC)) GO TO 46
WRITE(IDLG,45)
45 FORMAT(' ILLEGAL OBSERVATION NUBER')
GO TO 31
46 DO 47 I=1,NN
NANS(I)=1
47 ANS(1,I)=DATA(IOBS,IV(I))
GO TO 79
C
C ANSERES TO BE SUPPLIED FROM THE TERMINAL
C
50 WRITE(IDLG,51)
51 FORMAT(' ENTER ANSWERS AFTER VARIABLES'/)
DO 52 I=1,NN
55 WRITE(IDLG,53) NAMES(IV(I))
53 FORMAT('+',A5,'? ',$)
READ(ICC,33,END=55) LIN
IF(LIN(1).EQ.'!') RETURN
IF(LIN(1).NE.' ') GO TO 57
IF(I.EQ.1) GO TO 55
DO 56 J=1,3
56 ANS(J,I)=ANS(J,I-1)
NANS(I)=NANS(I-1)
GO TO 52
57 IF((LIN(1).NE.'H').OR.(LIN(2).NE.'E').OR.(LIN(3).NE.'L').
1OR.(LIN(4).NE.'P')) GO TO 60
WRITE(IDLG,58)
58 FORMAT(' ENTER UP TO 3 ANSWERS PER QUESTION SEPARATED BY'/
1' COMMAS. IF A SPACE IS USED IT IS ASSUMED TO BE THE SAME'/
2' ANSERES AS THE PREVIOUS QUESTION.'/)
GO TO 55
60 K=1
J=1
61 DO 62 L=1,15
62 INPUT(L)=' '
L=1
67 IF(LIN(J).EQ.',') GO TO 68
IF(LIN(J).EQ.' ') GO TO 68
IF(LIN(J).EQ.'-') GO TO 64
IF(LIN(J).EQ.'E') GO TO 64
IF(LIN(J).EQ.'.') GO TO 64
IF((LIN(J).LE.'9').AND.(LIN(J).GE.'0')) GO TO 64
WRITE(IDLG,63) LIN(J)
63 FORMAT(' ILLEGAL CHARACTER "',A1,'"')
GO TO 55
64 IF(L.LT.15) GO TO 66
WRITE(IDLG,65)
65 FORMAT(' COMMA MISSING')
GO TO 55
66 INPUT(L)=LIN(J)
L=L+1
J=J+1
GO TO 67
68 ENCODE(15,33,EXTRA) INPUT
DECODE(15,69,EXTRA) ANS(K,I)
69 FORMAT(G)
K=K+1
IF(K.GT.3) GO TO 70
IF(LIN(J).EQ.' ') GO TO 70
J=J+1
GO TO 61
70 NANS(I)=K-1
52 CONTINUE
C
C PERCENTAGES
C
79 PCENT(1)=27
PCENT(2)=46
PCENT(3)=27
IF(OPT(1).NE.1) GO TO 80
PCENT(1)=50
PCENT(2)=0
PCENT(3)=50
80 IF(OPT(2).NE.1) GO TO 100
82 WRITE(IDLG,81)
81 FORMAT(' ENTER PERCENTAGE TO BE PLACED IN LOWER AND UPPER'/
1' GROUPS SEPARATED BY A COMMA? ',$)
READ(ICC,33,END=82) LIN
IF(LIN(1).EQ.'!') RETURN
IF((LIN(1).NE.'H').OR.(LIN(2).NE.'E').OR.(LIN(3).NE.'L')
1.OR.(LIN(4).NE.'P')) GO TO 84
WRITE(IDLG,83)
83 FORMAT('0ENTER PERCENTAES AS WHOLE NUMBERS SEPATATED BY'/
1' A COMMA. NO "%" IS REQUIRED. THAT PART OF THE 100% NOT'/
1' ALLOCATED TO THE UPPER OR LOWER GROUP WILL BE USED AS THE'/
1' MIDDLE GROUP.')
GO TO 82
84 K=1
J=1
85 DO 86 L=1,15
86 INPUT(L)=' '
L=1
91 IF(LIN(J).EQ.',') GO TO 90
IF(LIN(J).EQ.' ') GO TO 90
IF(LIN(J).EQ.'.') GO TO 87
IF((LIN(J).LE.'9').AND.(LIN(J).GE.'0')) GO TO 87
WRITE(IDLG,63) LIN(J)
GO TO 82
87 IF(L.LT.15) GO TO 89
88 WRITE(IDLG,65)
GO TO 82
89 INPUT(L)=LIN(J)
L=L+1
J=J+1
GO TO 91
90 IF((K.EQ.1).AND.(LIN(J).EQ.' ')) GO TO 88
ENCODE(15,33,EXTRA) INPUT
DECODE(15,69,EXTRA) PCENT(K)
IF(PCENT(K).LT.100) GO TO 92
WRITE(IDLG,93)
93 FORMAT(' EACH PERCENTAGE POINT MUST BE LESS THAN 100')
GO TO 82
92 IF(K.EQ.3) GO TO 95
K=3
J=J+1
GO TO 85
95 PCENT(2)=100.-PCENT(1)-PCENT(3)
IF(PCENT(2).GE.0) GO TO 100
WRITE(IDLG,96)
96 FORMAT(' TOTAL OF PERCENTAGES MUST BE EQUAL TO 100 WITH NO'/
1' NEGATIVE PERCENTAGES.')
GO TO 82
C
C BEGIN ANALYSIS (FIRST CORRECT TESTS)
C
100 DO 101 I=1,NN
NMISS(I)=0
101 NRIGHT(I)=0
PQ=0
PQN=0
OEXY=0
OEX=0
OEX2=0
OEY=0
OEY2=0
OEN=0
PCTOT=0
TOTN=NC
IF(OPT(3).EQ.0)TOTN=TOTN-1.
DO 102 I=1,NC
IF((OPT(3).EQ.0).AND.(IOBS.EQ.I)) GO TO 102
SCORE(I)=0
MISS=0
OI=0
EI=0
DO 103 J=1,NN
L=IV(J)
IF(DATA(I,L).GT.0) GO TO 104
NMISS(J)=NMISS(J)+1
MISS=1
GO TO 103
104 DO 105 K=1,NANS(J)
IF(DATA(I,L).EQ.ANS(K,J)) GO TO 106
105 CONTINUE
GO TO 103
106 NRIGHT(J)=NRIGHT(J)+1
SCORE(I)=SCORE(I)+1
C DETERMINE IF ODD OR EVEN
K=J.AND.1
IF(K.EQ.1) GO TO 107
EI=EI+1
GO TO 103
107 OI=OI+1
103 CONTINUE
IF((MISS.EQ.1).AND.(OPT(7).NE.1)) GO TO 102
OEN=OEN+1
OEXY=OEXY+OI*EI
OEX=OEX+OI
OEX2=OEX2+OI**2
OEY=OEY+EI
OEY2=OEY2+EI**2
102 CONTINUE
C
C N0W OUTPUT FIRST PART
C
IF(IOUT.NE.21) WRITE(IOUT,5566)(HEDR(I),I=1,NSZ)
5566 FORMAT('1',70A1)
IF(IOUT.EQ.21) CALL PRNTHD
WRITE(IOUT,120)
120 FORMAT('0',10X,'***** ITEM ANALYSIS ****')
IF(OPT(7).EQ.1) WRITE(IOUT,122)
122 FORMAT(5X,'MISSING ANSWERS TREATED AS INCORRECT')
WRITE(IOUT,121)
121 FORMAT('0',9X,'NUMBER',3X,'NUMBER',3X,'NUMBER',3X,'PROPORTION'/
111X,'OF',7X,'OF',7X,'OF',10X,'OF',7X,'CORRELATION'/
110X,'RIGHT',4X,'WRONG',3X,'MISSING',4X,'CORRECT',8X,'WITH'/
12X,'ITEM',3X,'ANSWERS',2X,'ANSWERS',2X,'ANSWERS',4X,
1'ANSWERS',8X,'TOTAL'/1X,5('='),3X,7('='),2X,7('='),2X,7('='),
14X,7('='),8X,6('='))
LINES=10
IF(OPT(7).EQ.1) LINES=LINES+1
PQSUM=0
DO 130 J=1,NN
P=0
PQ=0
IF(IOUT.NE.21) GO TO 131
LINES=LINES+1
IF(LINES.LE.LINPP) GO TO 131
CALL PRNTHD
WRITE(IOUT,121)
LINES=9
131 XN=0
SUMX=0
SUMX2=0
SUMY=0
SUMXY=0
DO 132 I=1,NC
IF((OPT(3).EQ.0).AND.(IOBS.EQ.I)) GO TO 132
L=IV(J)
IF(DATA(I,L).GT.0) GO TO 133
IF(OPT(7).NE.1) GO TO 132
GO TO 135
133 DO 134 K=1,NANS(J)
IF(DATA(I,L).EQ.ANS(K,J)) GO TO 136
134 CONTINUE
GO TO 135
136 SUMY=SUMY+1.
SUMXY=SUMXY+SCORE(I)
135 SUMX=SUMX+SCORE(I)
SUMX2=SUMX2+SCORE(I)**2
XN=XN+1.
132 CONTINUE
IF(OPT(7).NE.1) GO TO 140
P=NRIGHT(J)/TOTN
GO TO 141
140 IF(TOTN.EQ.NMISS(J))GO TO 142
P=NRIGHT(J)/(TOTN-NMISS(J))
141 PQ=P*(1.-P)
PQSUM=PQSUM+PQ
142 CORR=0
BOTT=SQRT((XN*SUMY-SUMY**2)*(XN*SUMX2-SUMX**2))
IF(BOTT.GT.0) CORR=(XN*SUMXY-SUMX*SUMY)/BOTT
NWRONG=TOTN-NRIGHT(J)-NMISS(J)
WRITE (IOUT,143) NAMES(IV(J)),NRIGHT(J),NWRONG,NMISS(J),P,CORR
143 FORMAT(1X,A5,4X,I4,5X,I4,5X,I4,6X,F7.4,7X,F7.4)
130 CONTINUE
C
C KUDER-RICHARDSON, SPLIT HALF, AND SPEARMAN BROWN
C
SUMX=0
SUMX2=0
DO 150 I=1,NC
IF((OPT(3).EQ.0).AND.(IOBS.EQ.I)) GO TO 150
SUMX=SUMX+SCORE(I)
SUMX2=SUMX2+SCORE(I)**2
150 CONTINUE
IF(IOUT.NE.21) GO TO 151
LINES=LINES+4
IF(LINES.LE.LINPP) GO TO 151
CALL PRNTHD
LINES=6
151 IF(TOTN.LE.1) GO TO 152
VARNC=(TOTN*SUMX2-SUMX**2)/TOTN**2
IF(VARNC.EQ.0) GO TO 152
RICHSN=(NN/(NN-1.))*(1.-PQSUM/VARNC)
WRITE(IOUT,153) RICHSN
153 FORMAT('0KUDER-RICHARDSON #20 =',F10.4)
GO TO 155
152 WRITE(IOUT,154)
154 FORMAT('0NO KUDER-RICHARDSON CALCULATED (VARIANCE OF',
1' SCORES = 0)')
155 BOTT=SQRT((OEN*OEX2-OEX**2)*(OEN*OEY2-OEY**2))
IF(BOTT.EQ.0) GO TO 157
CORR=(OEN*OEXY-OEX*OEY)/BOTT
WRITE(IOUT,156) CORR
156 FORMAT(' CORRELATION OF ODD-EVEN ITEMS =',F10.4)
GO TO 159
157 WRITE(IOUT,158)
158 FORMAT(' NO ODD-EVEN ITEM CORRELATION (BOTTOM GOES TO',
1' ZERO)'/)
GO TO 170
159 SPEAR=(2.*CORR)/(1.+CORR)
WRITE(IOUT,160) SPEAR
160 FORMAT(' SPEARMAN-BROWN ODD-EVEN RELIABILITY =',F10.4)
C
C ITEM CORRELATION MATRIX
C
170 IF(OPT(6).EQ.1) GO TO 200
IF(IOUT.NE.21) GO TO 169
LINES=LINES+5
IF(LINES.LE.(LINPP-10)) GO TO 169
CALL PRNTHD
LINES=7
169 WRITE(IOUT,168)
168 FORMAT(//'0ITEM CORRELATION MATRIX'/)
DO 172 J=1,NN
DO 173 K=1,J
XYSUM(K)=0
XSUM(K)=0
YSUM(K)=0
SUMN(K)=0
IF(K.EQ.J) GO TO 173
DO 174 I=1,NC
IF((OPT(3).EQ.0).AND.(IOBS.EQ.I)) GO TO 174
IF(OPT(7).EQ.1) GO TO 176
IF((DATA(I,IV(K)).LE.0).OR.(DATA(I,IV(J)).LE.0)) GO TO 174
176 X=0
Y=0
DO 175 L=1,NANS(J)
IF(DATA(I,IV(J)).NE.ANS(L,J)) GO TO 175
X=1
GO TO 177
175 CONTINUE
177 DO 178 L=1,NANS(K)
IF(DATA(I,IV(K)).NE.ANS(L,K)) GO TO 178
Y=1
GO TO 179
178 CONTINUE
179 XSUM(K)=XSUM(K)+X
YSUM(K)=YSUM(K)+Y
XYSUM(K)=XYSUM(K)+X*Y
SUMN(K)=SUMN(K)+1.
174 CONTINUE
173 CONTINUE
IF(J.EQ.1) GO TO 188
DO 180 K=1,J-1
CORR=0
BOTT=SQRT((SUMN(K)*XSUM(K)-XSUM(K)**2)*(SUMN(K)*YSUM(K)-
1YSUM(K)**2))
IF(BOTT.NE.0) CORR=(SUMN(K)*XYSUM(K)-XSUM(K)*YSUM(K))/BOTT
180 SUMN(K)=CORR
188 SUMN(J)=1.
IF(IOUT.NE.21) GO TO 183
NLINES=(J-1)/NOUT+2
LINES=LINES+NLINES
IF(LINES.LE.(LINPP-NLINES)) GO TO 183
WRITE(IOUT,189)
189 FORMAT(1X)
DO 181 I=1,J-1,NOUT
L=I+NOUT-1
IF(L.GE.J) L=J-1
181 WRITE(IOUT,182)(NAMES(IV(K)),K=I,L)
182 FORMAT(11X,15(4X,A5))
CALL PRNTHD
LINES=NLINES+2
183 DO 184 I=1,J,NOUT
L=I+NOUT-1
IF(L.GT.J) L=J
IF(I.EQ.1) WRITE(IOUT,186) NAMES(IV(J)),(SUMN(K),K=I,L)
186 FORMAT('0',A5,4X,15(F9.4))
IF(I.NE.1) WRITE(IOUT,187) (SUMN(K),K=I,L)
187 FORMAT(10X,15(F9.4))
184 CONTINUE
172 CONTINUE
LINES=LINES+NLINES
WRITE(IOUT,189)
DO 190 I=1,J,NOUT
L=I+NOUT-1
IF(L.GE.J) L=J
190 WRITE(IOUT,182)(NAMES(IV(K)),K=I,L)
C
C GROUP ITEMS NOW
C 1. STORE SCORES IN IGROUP
C 2. SORT SCORES
C 3. DETERMINE RANGES FOR SCORES FOR GROUPINGS
C 4. STORE VALUE OF GROUP INTO IGROUP VBASED ON RANGES
C CALCULATED IN 3.
C 5. DO REMAINDER OF ANALYSIS
C
C A FURTHUR NOTE ON 3: RANGES WILL BE CALCULATED SO THAT A BREAK
C DOES NOT OCCURR IN THE MIDDLE OF A RANGE OF SCORES WHICH ARE
C ALL THE SAME. WHEN THIS OCCURS THE ANALYSIS IS SOMETIMES
C AT THE MERCY OF THE ORDER IN WHICH THE DATA IS ENTERED. THUS
C ALL BREAKS WILL BE AT THE CLOSEST CHANGE OF SCORES TO THE
C PERCENTAGES CHOSEN BY THE USER.
C
C
200 J=1
DO 201 I=1,NC
IF((OPT(3).EQ.0).AND.(IOBS.EQ.I)) GO TO 201
IGROUP(J)=SCORE(I)
J=J+1
201 CONTINUE
C
C SORT NOW THE VARIABLE IGROUP INTO ORDER (SINGLETON SORT)
C
M=1
II=1
J=TOTN
221 IF(II.GE.J) GO TO 228
222 K=II
IJ=(J+II)/2
IT=IGROUP(IJ)
IF(IGROUP(II).LE.IT) GO TO 223
IGROUP(IJ)=IGROUP(II)
IGROUP(II)=IT
IT=IGROUP(IJ)
223 LL=J
IF(IGROUP(J).GE.IT) GO TO 225
IGROUP(IJ)=IGROUP(J)
IGROUP(J)=IT
IT=IGROUP(IJ)
IF(IGROUP(II).LE.IT) GO TO 225
IGROUP(IJ)=IGROUP(II)
IGROUP(II)=IT
IT=IGROUP(IJ)
GO TO 225
224 IGROUP(LL)=IGROUP(K)
IGROUP(K)=ITT
225 LL=LL-1
IF(IGROUP(LL).GT.IT) GO TO 225
ITT=IGROUP(LL)
226 K=K+1
IF(IGROUP(K).LT.IT) GO TO 226
IF(K.LE.LL) GO TO 224
IF((LL-II).LE.(J-K)) GO TO 227
IL(M)=II
IU(M)=LL
II=K
M=M+1
GO TO 229
227 IL(M)=K
IU(M)=J
J=LL
M=M+1
GO TO 229
228 M=M-1
IF(M.EQ.0) GO TO 240
II=IL(M)
J=IU(M)
229 IF((J-II).GE.11) GO TO 222
IF(II.EQ.1) GO TO 221
II=II-1
230 II=II+1
IF(II.EQ.J) GO TO 228
IT=IGROUP(II+1)
IF(IGROUP(II).LE.IT) GO TO 230
K=II
231 IGROUP(K+1)=IGROUP(K)
K=K-1
IF(IT.LT.IGROUP(K)) GO TO 231
IGROUP(K+1)=IT
GO TO 230
C
C DONE WITH SORT - NOW FORM GROUPINGS
C
C
C FIND LOWER BREAK POINT
C
240 I=TOTN*(PCENT(1)/100.)+.5
J=1
ISATS=0
241 IF((I+J).LE.TOTN) GO TO 243
IF((I-J).GE.1) GO TO 243
WRITE(IDLG,242)
242 FORMAT(' ALL SCORES WERE THE SAME - NO INDEX OF DISCRMINATION',
1'CALCULATED')
ISATS=1
PCENT(1)=0
PCENT(2)=0
PCENT(3)=0
GO TO 300
243 IF(IGROUP(I).EQ.IGROUP(I+J)) GO TO 244
NL=I+J-1
GO TO 250
244 IF((I-J).LT.1) GO TO 245
IF(IGROUP(I).EQ.IGROUP(I-J)) GO TO 245
NL=I-J
GO TO 250
245 J=J+1
GO TO 241
C
C NOW FIND UPPER BREAKPONT
C
250 I=TOTN*((PCENT(1)+PCENT(2))/100.)+.5
J=1
251 IF((I-J).LT.1) GO TO 252
IF(IGROUP(I).EQ.IGROUP(I-J)) GO TO 252
NU=I-J+1
GO TO 254
252 IF((I+J).GT.TOTN) GO TO 253
IF(IGROUP(I).EQ.IGROUP(I+J)) GO TO 253
NU=I+J
GO TO 254
253 J=J+1
GO TO 251
C FIND CLOSEST TO CORRECT PERCENTAGE FOR A BREAK WITH NO MIDDLE
254 IF(PCENT(2).NE.0) GO TO 255
IF(ABS(PCENT(1)-((NL*100.)/TOTN)).LT.ABS(PCENT(3)-(((TOTN-NU+1)
1*100.)/TOTN))) GO TO 256
NL=NU-1
GO TO 255
256 NU=NL+1
255 NT(1)=NL
NT(3)=TOTN-NU+1
NT(2)=TOTN-NT(1)-NT(3)
PCENT(1)=(NT(1)*100.)/TOTN
PCENT(2)=(NT(2)*100.)/TOTN
PCENT(3)=(NT(3)*100.)/TOTN
MIN(2)=0
MAX(2)=0
MIN(1)=IGROUP(1)
MIN(3)=IGROUP(NU)
IF(PCENT(2).NE.0) MIN(2)=IGROUP(NL+1)
MAX(1)=IGROUP(NL)
NTOT=TOTN
MAX(3)=IGROUP(NTOT)
IF(PCENT(2).NE.0) MAX(2)=IGROUP(NU-1)
NT(4)=TOTN
263 MIN(4)=IGROUP(1)
NTOT=TOTN
MAX(4)=IGROUP(NTOT)
XMEAN(1)=0
XMEAN(2)=0
XMEAN(3)=0
XMEAN(4)=0
260 DO 261 I=1,NC
IF(ISATS.EQ.1) GO TO 264
IGROUP(I)=2
IF((OPT(3).EQ.0).AND.(IOBS.EQ.I)) GO TO 262
IF(SCORE(I).LE.MAX(1)) IGROUP(I)=1
IF(SCORE(I).GE.MIN(3)) IGROUP(I)=3
XMEAN(IGROUP(I))=XMEAN(IGROUP(I))+SCORE(I)
264 XMEAN(4)=XMEAN(4)+SCORE(I)
GO TO 261
262 IGROUP(I)=-1
261 CONTINUE
C
C PROCEDE WITH REMAINDER OF ANALYSIS AND REPORT
C
300 IF(IOUT.NE.21) GO TO 306
LINES=LINES+7
IF(LINES.LE.(LINPP-4)) GO TO 306
CALL PRNTHD
LINES=9
306 WRITE(IOUT,308)(PCENT(I),I=1,3)
308 FORMAT(/'0',10X,'NUMBER OF CORRECT ANSWERS'/
19X,29(1H-),3X,'INDEX',4X,'INDEX'/
19X,'LOWER MIDDLE UPPER',12X,'OF',7X,'OF'/
11X,'ITEM',3X,3(F5.1,'%',2X),1X,'TOTAL',3X,'DIFF.',4X,
1'DISCR.'/1X,5('='),3X,5('='),3X,5('='),3X,5('='),3X,
15('='),3X,4('='),5X,5('='))
DO 310 I=1,5
DO 310 J=1,10
310 MM(J,I)=0
IDIS=0
IDIFF=0
ADIS=0
ADIFF=0
DO 302 I=1,NN
L=IV(I)
DO 303 J=1,3
303 IVAL(J)=0
DO 304 J=1,NC
IF(IGROUP(J).EQ.-1) GO TO 304
IF(DATA(J,L).LE.0) GO TO 304
DO 305 K=1,NANS(I)
IF(DATA(J,L).NE.ANS(K,I)) GO TO 305
IVAL(IGROUP(J))=IVAL(IGROUP(J))+1
GO TO 304
305 CONTINUE
304 CONTINUE
ITOTAL=IVAL(1)+IVAL(2)+IVAL(3)
IDIFF=((TOTN-ITOTAL)*100.)/NT(4)
IF(ISATS.NE.1) IDIS=(IVAL(3)*100.)/NT(3)-(IVAL(1)*100.)/NT(1)
LDIFF=IDIFF/20
IF(LDIFF.LT.5) LDIFF=LDIFF+1
LDIS=(IDIS+100)/20
IF(LDIS.LT.10) LDIS=LDIS+1
MM(LDIS,LDIFF)=MM(LDIS,LDIFF)+1
ADIS=ADIS+IDIS
ADIFF=ADIFF+IDIFF
IF(IOUT.NE.21) GO TO 320
LINES=LINES+1
IF(LINES.LE.LINPP) GO TO 320
CALL PRNTHD
WRITE(IOUT,308)(PCENT(J),J=1,3)
LINES=9
320 IF(ISATS.NE.1) WRITE(IOUT,321) NAMES(IV(I)),IVAL
1,ITOTAL,IDIFF,IDIS
321 FORMAT(1X,A5,3X,I5,3X,I5,3X,I5,3X,I5,4X,I3,6X,I3)
IF(ISATS.EQ.1) WRITE(IOUT,322) NAMES(IV(I)),ITOTAL,IDIFF
322 FORMAT(1X,A5,27X,I5,4X,I3)
302 CONTINUE
IF(ISATS.EQ.1) GO TO 312
DO 311 J=1,3
IF(NT(J).NE.0) XMEAN(J)=XMEAN(J)/NT(J)
311 CONTINUE
312 XMEAN(4)=XMEAN(4)/TOTN
IF(IOUT.NE.21) GO TO 325
LINES=LINES+16
IF(LINES.LE.LINPP) GO TO 325
CALL PRNTHD
WRITE(IOUT,308) (PCENT(J),J=1,3)
LINES=25
325 IF(ISATS.NE.1) WRITE(IOUT,326) NT,MAX,MIN,XMEAN
326 FORMAT('0SAMPLE',2X,3(I5,3X),I5/' SIZE',/'0MAXIMUM',1X,
13(I5,3X),I5/' SCORE'/'0MINIMUM',1X,3(I5,3X),I5/
1' SCORE'/'0MEAN'/2X,'OF',5X,3(F7.1,1X),F7.1/' SCORES')
IF(ISATS.EQ.1) WRITE(IOUT,327) NT(4),MAX(4),MIN(4),XMEAN(4)
327 FORMAT('0SAMPLE',26X,I5/' SIZE'/'0MAXIMUM',225X,I5/
1' SCORE'/'0MINIMUM',25X,I5/' SCORE'/'0MEAN'/2X,'OF',24X,F7.1/
1' SCORES')
ADIS=ADIS/NN
ADIFF=ADIFF/NN
WRITE(IOUT,328) ADIFF
328 FORMAT('0AVERAGE INDEX OF DIFFICULTY= ',F8.2)
IF(ISATS.NE.1) WRITE(IOUT,329) ADIS
329 FORMAT('0AVERAGE INDEX OF DISCRIMINATION =',F8.2)
IF(OPT(5).EQ.1) GO TO 350
IF(ISATS.EQ.1) GO TO 350
IF(IOUT.NE.21) GO TO 340
LINES=LINES+15
IF(LINES.LE.LINPP) GO TO 340
CALL PRNTHD
340 DO 342 I=1,5
DO 342 J=1,10
L=' '
IF(MM(J,I).EQ.0) GO TO 342
ENCODE(5,343,L) MM(J,I)
343 FORMAT(I3,2X)
342 MM(J,I)=L
WRITE(IOUT,341)((MM(J,I),I=1,5),J=1,10)
341 FORMAT(/'0',28X,'DIFFICULTY'/' DISCRIM.',7X,'(0-19)',2X,
1'(20-39)',2X,'(40-59)',2X,'(60-79)',2X,
1'(80-100)'/12X,47(1H-)/1X,'(-100,-81)',1X,'I',3X,4(A5,4X),A5/
11X,'(-80,-61)',2X,'I',3X,4(A5,4X),A5/
11X,'(-60,-41)',2X,'I',3X,4(A5,4X),A5/
11X,'(-40,-21)',2X,'I',3X,4(A5,4X),A5/
11X,'(-20,0)',4X,'I',3X,4(A5,4X),A5/
11X,'(1,20)',5X,'I',3X,4(A5,4X),A5/
11X,'(21,40)',4X,'I',3X,4(A5,4X),A5/
11X,'(41,60)',4X,'I',3X,4(A5,4X),A5/
11X,'(61,80)',4X,'I',3X,4(A5,4X),A5/
11X,'(81,100)',3X,'I',3X,4(A5,4X),A5)
350 IF(OPT(4).NE.1) GO TO 370
J=NV
IF((NV+1).LE.MV) GO TO 352
WRITE(IDLG,351)
351 FORMAT(' NO ROOM LEFT TO STORE SCORES')
GO TO 370
352 J=J+1
ENCODE(5,353,NAMES(NV+1)) J
353 FORMAT('TS',I3)
DECODE(5,354,NAMES(NV+1)) (INPUT(I),I=1,5)
354 FORMAT(5A1)
355 IF(INPUT(3).NE.' ') GO TO 357
DO 356 K=4,5
356 INPUT(K-1)=INPUT(K)
INPUT(5)=' '
GO TO 355
357 ENCODE(5,354,NAMES(NV+1))(INPUT(I),I=1,5)
DO 358 I=1,NV
IF(NAMES(I).EQ.NAMES(NV+1)) GO TO 352
358 CONTINUE
NV=NV+1
WRITE(IDLG,359) NAMES(NV)
359 FORMAT(' TEST SCORES SAVED AS VARIABLE ',A5)
SUM=0
SUM2=0
DO 360 L=1,NV
360 CO(L)=0
DO 361 J=1,NC
CO(L)=DATA(J,L)*SCORE(J)+CO(L)
SUM=SUM+SCORE(J)
361 SUM2=SUM2+SCORE(J)**2
VMN(NV)=SUM/NC
STD(NV)=SQRT((NC*SUM2-SUM**2)/(NC*(NC-1.)))
DO 362 L=1,NV-1
IF((STD(L)*STD(NV)).EQ.0) GO TO 363
COR(L,NV)=(CO(L)/((NC-1.)*STD(L)*STD(NV)))
GO TO 362
363 COR(L,NV)=0
362 COR(NV,L)=COR(L,NV)
COR(NV,NV)=1.0
370 RETURN
END