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