Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
CBD07S GUTTMAN SCALES NO. 2 - PART 2 OCTOBER 22, 1965
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
37),KONTER(25,7),DUMMY3(1),KSTEP(6), KDUMY6(2),REF(25),NN1(6),NN2(6
4),NN3(6)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,LESTN,LEAVE,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,DUMMY3,LASTRD,NDREDK,L,
3IFINAL,ILAST,IFIRST,IXTRA,KK,ICHNGE,NFIRST,L1,IEND,MCOMB,IPUNCH,NP
4ER,KDUMY6,INDEX3
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
DOUBLE PRECISION DUM,QCTR
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
2),(ERROR,KONTER),(YES,IYES)
C
DATA QCTR/8H* /
DATA DUM/8HFORCOM /
DATA IYES/4HYES /
IT1=1
CALL USAGEB('BMD07S')
C
C BMD07S USES THE FOLLOWING SUBROUTINES FOUND IN BMD04S,
C COMBIN DECTER FNDCMB FRSTCM
C MOVE MOVFOR ORDER ORQUES
C REORDR
C
C THIS PROGRAM REQUIRES THE TAPE UNIT DESIGNATED IT4 IN BMD06S.
C IT4 IS THE SAVE TAPE WITH ALL OF COMMON STORAGE WRITTEN ON IT.
C
C IT1 IS THE TAPE WHICH CONTAINS THE ORIGINAL WEIGHTED RESPONSES.
C
LOPE=0
IT4=4
C
4515 FORMAT('1BMD07S - GUTTMAN SCALE NUMBER 2, PART 2 - REVISED ',
1'SEPTEMBER 23, 1968'/
23X,40HHEALTH SCIENCES COMPUTING FACILITY, UCLA)
C
REWIND IT4
READ(IT4) J
READ(IT4) (REF(I),I=1,25)
NPOINT=(J+127)/128
IF (NPOINT.LE.1) GO TO 9991
DO 9001 I=1,NPOINT-1
NI=(I-1)*128+1
NII=I*128
9001 READ(IT4)(A(K),K=NI,NII)
9991 NI=(NPOINT-1)*128+1
READ(IT4)(A(K),K=NI,J)
DO 9992 I=1,4
NI=(I-1)*128+1
NII=I*128
9992 READ(IT4)(LVAR(K),K=NI,NII)
READ(IT4)(LVAR(K),K=513,558),INDEX3
READ(IT4) JOBNMB,(DUMMY2(I),I=1,27),FRSTMO,SECMON,(KDUMY6(J)
1,J=1,2)
REWIND IT4
C
C
KDUMY6(1)=DUM
C DUMMY3(17) HAS THE SAME LOCATION AS KDUMY6(1). THUS WE CAN USE IT
C FOR THE FIXED POINT SUBTRACTION PRIOR TO FORTRAN STATEMENT NUMBER
C 2029.
C
FKEEP=0.0
IELIM=2
KTIMES=0
LAST=1
KONE=1
ASSIGN 445 TO INCKTM
ASSIGN 3876 TO KOFPR
ASSIGN 451 TO JTIMES
ASSIGN 2006 TO LTIMES
FLPTN2=LASTNO
FLPTN3=NCASE
KTEST=NVAR*5
LL=1
KSTEP(1)=3
WRITE (6,4515)
2019 NCARDS=(MCOMB+5)/6
MCARDS=NCARDS
IF(NCARDS)2018,2018,2021
2018 KTIMES=1
GO TO 2011
C
2020 IF(NCARDS)2001,2001,2021
2021 NCARDS=NCARDS-1
READ (5,1000)KCHECK,(KSTEP(I),NN1(I),NN2(I),NN3(I),I=1,6)
IF(KCHECK.NE.KDUMY6(1)) GO TO 940
2029 ILL=1
2022 LL=ILL
20222 IF(KSTEP(LL))2030,2030,2122
2122 IF((KSTEP(LL)-KONE)-KTIMES)920,2023,2001
2023 DO 2025 I=1,NVAR
IF(NN1(LL)-LVAR(I))2025,2024,2025
2025 CONTINUE
GO TO 19
2024 M=LVAR(I)
IF(MCOMB)2127,2127,2128
2127 LL=6
GO TO 2124
2128 MCOMB=MCOMB-1
N1(M)=NN2(LL)
N2(M) =NN3(LL)
CALL CHECK(M)
NCOMB(M)=NCOMB(M)+1
CALL COMBIN(I,N1,N2(1))
IF(KOMPER)998,2124,998
2124 ITIMES=6
IF(LL-6)2125,2120,2120
2125 IF(KSTEP(LL+1)-1)2126,2026,2123
2120 IF(1-KSTEP(LL))2123,2126,2126
2123 CALL DECTER
2126 GO TO INCKTM,(445,450)
C
2026 IF(M-NN1(LL+1))2030,2126,2030
C
19 N=NVAR+1
DO 20 I=N,25
IF(NN1(LL)-LVAR(I))20,25,20
20 CONTINUE
GO TO 930
25 N=MCARDS-NCARDS
WRITE (6,4019)NN1(LL),N
MCOMB=MCOMB-1
GO TO 2124
C
2027 IF(KTIMES-1)2028,2028,2030
2028 KTIMES=0
2030 LL=LL+1
IF(LL.LE.6)GO TO 20222
GO TO 2020
C
2001 IF(MCOMB)2011,2011,2012
2011 ASSIGN 2031 TO KONTIN
LL=1
KSTEP(1)=KTEST
IF(IEND.EQ.IYES) GO TO 2014
2013 LAST=2
GO TO 2014
C
2012 ASSIGN 202 TO KONTIN
2014 ILL=LL
GO TO LTIMES,(2006,2010,4655,4915,5207)
C
C COMBINE THOSE RESPONSES WHICH HAVE LESS THAN NPER PERCENT
C OF THE TOTAL NUMBER OF RESPONDENTS, IF DESIRED.
C
2006 CONTINUE
2135 ITIMES=5
KTIMES=1
ASSIGN 2010 TO LTIMES
IF(NFIRST.NE.IYES) GO TO 2003
2002 CALL FRSTCM(NPER)
IF(L-INDKOL)2003,2003,2005
2003 ITIMES=1
IF(KOMPER)998,2009,998
2009 IF((KSTEP(LL)-1)-KTIMES)920,2022,2010
C
2005 ASSIGN 449 TO JTIMES
GO TO 450
C
2010 CONTINUE
7005 ITIMES=1
C
C RANK RESPONDENTS USING CORNELL TECHNIQUE
C
201 INDEX2=0
GO TO KONTIN,(202,2022,2031)
202 ASSIGN 2022 TO KONTIN
2031 K=INDRNK+1
DO 204 JRNK=K,INDKOL
RANKSM(JRNK)=0.0
INDEX1=INDEX2+1
INDEX2=INDEX2+NVAR
DO 203 I=INDEX1,INDEX2
RANKSM(JRNK)=RANKSM(JRNK)+A(I)
203 CONTINUE
204 CONTINUE
C
C ORDER ACCORDING TO HIGHEST RANK SCORE
C
240 CALL ORDER
C
C ORDER QUESTIONS IN INCREASING FREQUENCY OF SCORE 7
C
CALL ORQUES(0)
C
C REORDER THOSE INDIVIDUALS WITH THE SAME TOTAL SCORE
C
275 CALL REORDR
7009 IF (KOMPER)998,3305,998
C
3305 GO TO (334,465,555),LAST
C
C DETERMINE CUTTING POINTS AND ERRORS FOR EACH QUESTION
C
334 KK=1
336 CALL DECTER
380 IF(IFINAL.NE.IYES) GO TO 384
325 MINPR=1
MAXPR=0
INDEX2=0
NDIFF=NCASE
5010 IF(NDIFF-50)5020,5020,5030
5020 MAXPR=NCASE
NDIFF=0
GO TO 5040
C
5030 MAXPR=MAXPR+50
NDIFF=NDIFF-50
5040 NUMPGE=NUMPGE+1
WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
326 WRITE (6,4002)
WRITE (6,4008)
2662 WRITE (6,4504)NCASE,NVAR
WRITE (6,4506)KTIMES
WRITE (6,4505)
DO 2663 I=1,NVAR
M=LVAR(I)
HOLD(I)=REF(M)
2663 CONTINUE
WRITE (6,4508)(LVAR(J),HOLD(J),J=1,NVAR)
327 WRITE (6,4500)
DO 267 I=MINPR,MAXPR
INDEX1=INDEX2+1
INDEX2=INDEX2+NVAR
JRNK=I+INDRNK
INDIDV=I+LASTNO
2665 WRITE (6,4003)I,INDIVD(INDIDV),RANKSM(JRNK),(A(J),J=INDEX1,INDEX2)
267 CONTINUE
GO TO (268,5050),IELIM
268 WRITE (6,4030)
5050 MINPR=MINPR+50
IF(NDIFF) 384, 384,5010
C
C PRINT OUT ERRORS, IF DESIRED
C
384 FLPTN1=MAXERR
COFREP=1.0-(FLPTN1/FLPTN2)
KSUM=0
DO 3874 M=1,NVAR
I=LVAR(M)
KEST=0
DO 3873 J=1,7
IF(KEST-MFREQ(I,J))3871,3873,3873
3871 KEST=MFREQ(I,J)
3873 CONTINUE
KSUM=KSUM+KEST
3874 CONTINUE
SUM=KSUM
FMINMR=SUM/FLPTN2
IF(IERROR.NE.IYES) GO TO 390
385 NUMPGE=NUMPGE+1
386 WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
WRITE (6,4004)
WRITE (6,4504)NCASE,NVAR
WRITE (6,4506)KTIMES
WRITE (6,4500)
WRITE (6,4505)
DO 3861 I=1,NVAR
M=LVAR(I)
HOLD(I)=REF(M)
3861 CONTINUE
WRITE (6,4509)(LVAR(J),HOLD(J),J=1,NVAR)
ASSIGN 388 TO MTIMES
3862 WRITE (6,4500)
DO 387 I=1,7
DO 3865 J=1,NVAR
M=LVAR(J)
KOLHLD(J)=KONTER(M,I)
3865 CONTINUE
WRITE (6,4005)I,(KOLHLD(J),J=1,NVAR)
387 CONTINUE
K=0
DO 3877 I=1,NVAR
M=LVAR(I)
KOLHLD(I)=0
DO 3875 J=1,7
KOLHLD(I)=KOLHLD(I)+KONTER(M,J)
3875 CONTINUE
K=K+KOLHLD(I)
3877 CONTINUE
J=FLPTN2
WRITE (6,4024)(KOLHLD(I),I=1,NVAR)
WRITE (6,4025)K,J
GO TO KOFPR,(3876,3878)
3878 WRITE (6,4501)
WRITE (6,4018)COFREP
WRITE (6,4021)FMINMR
IF(COFREP-FKEEP)3872,3870,3870
3872 WRITE (6,4013)
3870 FKEEP=COFREP
3876 GO TO (3880,3879),IELIM
3880 WRITE (6,4030)
3879 GO TO MTIMES,(388,475)
388 WRITE (6,4502)
WRITE (6,4006)
WRITE (6,4500)
I=0
DO 389 JJ=1,NVAR
K=26
DO 3895 L=1,NVAR
M=LVAR(L)
IF(M-K)3891,3895,3895
3891 IF(I-M)3893,3895,3895
3893 K=M
3895 CONTINUE
I=K
WRITE (6,4007)I,REF(I),(MFREQ(I,J),J=1,8)
389 CONTINUE
C
C DETERMINE COMBINATIONS OF RESPONSES IN EACH QUESTION
C
390 GO TO (395,520,462,495,612,580),ITIMES
395 KK=2
CALL FNDCMB(FLPTN2)
IF(KOMPER)998,425,998
425 IF(L1)445,462,445
445 KTIMES=KTIMES+1
450 NUMPGE=NUMPGE+1
WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
WRITE (6,4009)
GO TO JTIMES,(449 ,451)
449 WRITE (6,4014)NPER
ASSIGN 451 TO JTIMES
451 WRITE (6,4504)NCASE,NVAR
WRITE (6,4506)KTIMES
452 WRITE (6,4510)
J=0
DO 457 JJ=1,NVAR
K=26
DO 4526 L=1,NVAR
M=LVAR(L)
IF(M-K)4522,4526,4526
4522 IF(J-M)4524,4526,4526
4524 K=M
4526 CONTINUE
J=K
IF(NCOMB(J))456,457,456
456 WRITE(6,4010) J,REF(J),NCOMB(J),N1(J),N2(J),KVAR(J),MVAR(J)
4569 N1(J)=0
N2(J)=0
457 CONTINUE
GO TO(4573,4577),IELIM
4573 WRITE (6,4030)
4577 CONTINUE
458 GO TO (459,674,675,551,2002,2027),ITIMES
459 IF(KTIMES-KTEST)201,990,990
C
C DETERMINE ERROR FOR FINAL COMPUTATIONS
C
462 IF(LEAVE.NE.IYES) GO TO 465
463 LAST=2
465 KK=3
KTIMES=KTIMES+1
IF((-MCOMB))4653,4654,4654
4653 KONE=0
ASSIGN 4655 TO LTIMES
ASSIGN 450 TO INCKTM
GO TO 2022
C
4654 CALL DECTER
4655 NUMPGE=NUMPGE+1
WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
WRITE (6,4012)
WRITE (6,4504)NCASE,NVAR
WRITE (6,4506)KTIMES
WRITE (6,4505)
DO 466 I=1,NVAR
M=LVAR(I)
HOLD(I)=REF(M)
466 CONTINUE
WRITE (6,4509)(LVAR(J),HOLD(J),J=1,NVAR)
ASSIGN 475 TO MTIMES
GO TO 3862
C
C CHECK TO SEE IF CHANGING RANK OF INDIVIDUALS REDUCES ERROR
C
475 MAXERR=0
DO 480 I=1,NVAR
MAXERR=MAXERR+KOLHLD(I)
480 CONTINUE
485 CALL ORQUES(1)
CALL RKCHNG(MAXERR)
KK=3
IF(KOMPER)998,490,998
490 KTIMES=KTIMES+1
IF((-MCOMB))491,492,492
491 ASSIGN 4915 TO LTIMES
GO TO 2022
C
4915 MAXERR =0
DO 494 M=1,NVAR
I=LVAR(M)
DO 493 J=1,7
MAXERR=MAXERR+KONTER(I,J)
493 CONTINUE
494 CONTINUE
492 ITIMES=4
ASSIGN 3878 TO KOFPR
GO TO 380
C
C CHECK TO SEE IF FURTHER POSSIBLE COMBINATIONS MAY REDUCE THE ERROR
C TO GIVE A GOOD COEFFICIENT OF REPRODUCIBILITY.
C
495 GO TO (496, 580),LAST
496 FLPTN1=MAXERR
REPERR=FLPTN1/FLPTN2
IF(0.1-REPERR)497,500,500
497 KING=1
GO TO 520
C
500 IF(NDREDK)499,499,498
499 KING=3
GO TO 520
C
498 IF(NDREDK-20)512,512,499
512 IF(LASTRD-1)499,510,499
510 KING=2
520 IF((-MCOMB))5205,525,525
5205 KONE=1
ASSIGN 445 TO INCKTM
ASSIGN 5207 TO LTIMES
GO TO 2022
C
5207 MAXERR =0
DO 5209 I=1,NVAR
DO 5208 J=1,7
MAXERR=MAXERR+KONTER(I,J)
5208 CONTINUE
5209 CONTINUE
5206 IF((-MCOMB))521,525,525
521 CALL ENDCMB(NDREDK,KING,MAXERR,LASTRD)
IF(KOMPER-50)522,5595,522
522 IF(KOMPER-25)998,550,998
550 KOMPER=0
ITIMES=4
GO TO 445
C
525 IF(IEND.EQ.IYES) GO TO 521
GO TO 614
C
551 LAST=3
ITIMES=2
GO TO 201
C
555 KK=3
CALL DECTER
556 MAXERR=0
DO 559 M=1,NVAR
I=LVAR(M)
DO 558 J=1,7
MAXERR=MAXERR+KONTER(I,J)
558 CONTINUE
559 CONTINUE
CALL ORQUES(I)
KK=3
CALL RKCHNG(MAXERR)
KTIMES=KTIMES+1
ICHNGE=ICHNGE+1
IF(ICHNGE-20)5591,5591,5592
5591 IF(KOMPER)998,380,998
C
5592 ICHNGE=20
GO TO 5591
C
5595 KOMPER=0
IF(ICHNGE-5)5599,5599,5597
5599 ICHNGE=10
5596 ITIMES=6
GO TO 555
C
5597 ICHNGE=20
GO TO 5596
C
560 KOMPER=0
K=INDTEM+25
DO 565 I=1,NVAR
J=K+I
IF(KOLSKR(J))565,565,567
565 CONTINUE
GO TO 575
C
567 FLPTN1=MAXERR
COFREP=1.0-(FLPTN1/FLPTN2)
NUMPGE=NUMPGE+1
KTIMES=KTIMES+1
WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
WRITE (6,4016)
WRITE (6,4504)NCASE,NVAR
WRITE (6,4506)KTIMES
WRITE (6,4018)COFREP
WRITE (6,4021)FMINMR
WRITE (6,4511)
DO 570 I=1,NVAR
M=LVAR(I)
INDEX1=K+I
IF(KOLSKR(INDEX1))570,570,563
563 N=KOLSKR(INDEX1)
N2(M)=KOLSKR(INDEX1-25)/8
N1(M)=KOLSKR(INDEX1-25)-(N2(M)*8)
WRITE (6,4017)M,REF(M),N1(M),N2(M),N,RANKSM(INDEX1+25)
570 CONTINUE
575 GO TO(600,576,600,700),LAST
576 LAST=4
CALL ORQUES(LAST)
KK=3
CALL RKCHNG(MAXERR)
ITIMES=6
KTIMES=KTIMES+1
GO TO 380
C
580 KK=4
CALL FNDCMB(FLPTN2)
581 IF(KOMPER)998,560,998
C
C ELIMINATE SOME QUESTIONS,IF DESIRED.
C
600 IF(LESTN)700,610,610
610 LESTN=NVAR-LESTN
ASSIGN 685 TO KIND
IF(LESTN)910,614,615
612 IF(LESTN)910,614,615
614 LAST=2
GO TO 580
C
615 DO 620 M=1,NVAR
I=LVAR(M)
IF(MVAR(I)-2)620,620,625
620 CONTINUE
GO TO 650
C
625 KK=4
CALL FNDCMB(FLPTN2)
6255 IF(KOMPER)998,626,998
626 KTEST=0
K=0
INDEX2=INDTEM+25
DO 635 I=1,NVAR
M=LVAR(I)
INDEX1=INDEX2+I
IF(KOLSKR(INDEX1))627,628,630
627 KOLSKR(INDEX1)=0
628 IF(MVAR(M)-2)629,629,630
629 IF(MFREQ(M,1))630,630,6295
6295 KOLSKR(INDEX1)=KONTER(M,7)+KONTER(M,1)
630 IF(KTEST-KOLSKR(INDEX1))631,635,635
631 KTEST=KOLSKR(INDEX1)
K=I
635 CONTINUE
IF((-K))6355,680,680
6355 L=LVAR(K)
IF(MVAR(L)-2)661,661,636
636 INDEX1=INDTEM+K
N2(L)=KOLSKR(INDEX1)/8
N1(L)=KOLSKR(INDEX1)-(N2(L)*8)
NCOMB(L)=NCOMB(L)+1
CALL COMBIN(K,N1,N2(1))
IF(KOMPER)998,637,998
637 ITIMES=3
GO TO 445
C
650 KK=3
CALL DECTER
651 KTEST=0
L=0
DO 660 I=1,NVAR
KOLHLD(I)=0
M=LVAR(I)
KOLHLD(I)=KOLHLD(I)+KONTER(M,7)+KONTER(M,1)
IF(KTEST-KOLHLD(I))656,660,660
656 KTEST=KOLHLD(I)
K=I
L=M
660 CONTINUE
IF((-L))661,690,690
661 MFREQ(L,7)=0
MFREQ(L,1)=0
MFREQ(L,8)=0
NCOMB(L)=NCOMB(L)+1
N1(L)=1
N2(L)=7
MVAR(L)=1
REF(L)=QCTR
IELIM=1
ITIMES=2
665 INDEX1=LASTNO-NVAR+K
DO 670 I=K,INDEX1,NVAR
A(I)=0.0
670 CONTINUE
I=L
GO TO 445
C
674 MVAR(I)=2
FLPTN2=FLPTN2-FLPTN3
LESTN=LESTN-1
675 ITIMES=5
LAST=3
16755 CONTINUE
GO TO 201
C
680 GO TO KIND,(685,690)
685 ASSIGN 690 TO KIND
NDREDK=0
GO TO 615
C
690 WRITE (6,4031)
GO TO 614
C
700 WRITE(IT4) MAXERR,COFREP,FMINMR
WRITE(IT4) (REF(I),I=1,25)
DO 9003 K=1,4
NK=(K-1)*128+1
NKK=K*128
9003 WRITE(IT4)(LVAR(KKK),KKK=NK,NKK)
WRITE(IT4)(LVAR(KKK),KKK=513,558),INDEX3
WRITE(IT4) JOBNMB,(DUMMY2(I),I=1,27),FRSTMO,SECMON,(KDUMY6(J)
1,J=1,2)
MAXPR=0
DO 725 I=1,NCASE
MINPR=MAXPR+1
MAXPR=MAXPR+NVAR
NPOINT=(MAXPR-MINPR+128)/128
NWED=MINPR-1
IF (NPOINT.LE.1) GO TO 7726
DO 7727 J=1,NPOINT-1
NJ=(J-1)*128+NWED+1
NJJ=J*128+NWED
7727 WRITE(IT4)(A(JJJ),JJJ=NJ,NJJ)
7726 NJ=(NPOINT-1)*128+NWED+1
WRITE(IT4)(A(JJJ),JJJ=NJ,MAXPR)
725 CONTINUE
DO 750 I=1,4
MINPR=MAXPR+1
MAXPR=MAXPR+NCASE
NPOINT=(MAXPR-MINPR+128)/128
NWED=MINPR-1
IF (NPOINT.LE.1) GO TO 7732
DO 7731 J=1,NPOINT-1
NJ=(J-1)*128+NWED+1
NJJ=J*128+NWED
7731 WRITE(IT4)(A(JJJ),JJJ=NJ, NJJ)
7732 NJ=(NPOINT-1)*128+NWED+1
WRITE(IT4)(A(JJJ),JJJ=NJ,MAXPR)
750 CONTINUE
END FILE IT4
REWIND IT4
998 STOP
C
910 WRITE (6,4910)
GO TO 998
C
920 KTIMES=KTIMES+1
WRITE (6,4029)KSTEP(LL),KTIMES
GO TO 998
C
930 NCARDS=MCARDS-NCARDS
WRITE (6,4028)NN1(LL),NCARDS
GO TO 998
C
940 WRITE (6,4940)
GO TO 998
C
990 NUMPGE=NUMPGE+1
WRITE (6,4011)NUMPGE
ITIMES=3
GO TO 201
C
C
8000 FORMAT(20A4)
1000 FORMAT(A6,6(I4,3I2))
C
4002 FORMAT(1H ,41X,28HRESPONDENTS AND SCALE SCORES/37X,37HRANKED ACCOR
1DING TO CORNELL TECHNIQUE)
4003 FORMAT(1H ,I4,I5,2F5.0,24F4.0)
4004 FORMAT(1H ,40X,30HERRORS AND NUMBER OF RESPONSES/42X,27HTO THE VAR
1IOUS SCALE SCORES)
4005 FORMAT(1H ,5X,I3,6X,25I4)
4006 FORMAT(1H0,3X,8HVARIABLE,19X,55HFREQUENCY OF OCCURRENCE OF SCORES
11 TO 7 AND SCORE ZERO/7X,2HOR,44X,5HSCORE/4X,8HQUESTION,13X,1H1,9X
2,1H2,9X,1H3,9X,1H4,9X,1H5,9X,1H6,9X,1H7,4X,11HNO RESPONSE)
4007 FORMAT(1H ,5X,I3,A1,6X,8I10)
4008 FORMAT(1H ,26X,57HWITH QUESTIONS ORDERED IN INCREASING FREQUENCY O
1F SCORE 7)
4009 FORMAT(1H ,45X,25HCOMBINATIONS IN QUESTIONS)
4010 FORMAT(1H0,I10,A1,I16,I17,5H AND,I3,I14,I8)
4011 FORMAT(1H1,105X,4HPAGE,I4//117HAFTER COMBINING AS MANY OF THE RESP
1PONSES IN EACH QUESTION AS POSSIBLE, SOME QUESTIONS STILL HAVE RAT
2IOS OF ERRORS TO/39HNON-ERRORS WHICH ARE GREATER THAN 0.50./6X,112
3HIT SEEMS UNLIKELY THAT THE RESULTING SCALE WHICH THE PROGRAM WILL
4 NOW COMPUTE IS GOOD. PLEASE CHECK THE PREVIOUS/114HPAGES OF OUTPU
5T AND EITHER ELIMINATE SOME QUESTIONS AND/OR RESPONDENTS OR DETERM
6INE THOSE RESPONSES WHICH YOU FEEL/74HSHOULD BE COMBINED AND USE T
7HE FORCED COMBINATION FEATURE OF THIS PROGRAM.)
4012 FORMAT(1H ,42X,27HERRORS FOR EACH SCALE SCORE/50X,11HFINAL STEPS)
4013 FORMAT(1H0,16X,84HTHE COEFFICIENT OF REPRODUCIBILITY DECREASED IN
1THIS LAST STEP. IT IS SUGGESTED THAT//15X,86HYOU MAKE A DIFFERENT
2COMBINATION USING THE FORCED COMBINATION FEATURE OF THIS PROGRAM.)
4014 FORMAT(32X29HTHE FIRST SCORE HAS LESS THANI3,23H PERCENT OF RESPON
1DENTS)
4016 FORMAT(1H ,34X,41HPOSSIBLE COMBINATIONS WHICH WILL INCREASE/25X,61
1HTHE COEFFICIENT OF REPRODUCIBILITY AND THE AMOUNT OF INCREASE)
4017 FORMAT(1H016XI3,A1,16XI3,5H AND,I3,19X,I4,20X,F5.4)
4018 FORMAT(1H ,36X,33HCOEFFICIENT OF REPRODUCIBILITY = ,F7.5)
4019 FORMAT(1H0,12X,8HQUESTIONI3,61H NO LONGER INCLUDED IN STUDY. FORCE
1D COMBINATION READ ON CARDI3,17H WILL BE IGNORED.)
4021 FORMAT(1H0,34X,35HMINIMAL MARGINAL REPRODUCIBILITY = ,F7.5)
4024 FORMAT(1H0,14HQUESTION ERROR,25I4)
4025 FORMAT(1H0,36X,11HTOTAL ERROR I6,5X,15HTOTAL RESPONSES I6)
4028 FORMAT(1H0,24X,37HTHERE IS NO QUESTION CORRESPONDING TO,I4,26H WHI
1CH WAS READ IN ON CARD,I4)
4029 FORMAT(1H0,18X,31HTHE COMBINATION DESIRED AT STEP,I4,20H WAS READ
1IN AT STEP,I4,21H TOO LATE TO BE DONE.)
4030 FORMAT(1H0,45H* INDICATES THIS QUESTION HAS BEEN ELIMINATED)
4031 FORMAT(1H0,6X,103HNO MORE COMBINATIONS OR ELIMINATIONS WILL REDUCE
1 THE ERROR. HENCE, NO MORE QUESTIONS WILL BE ELIMINATED)
4500 FORMAT(1H )
4501 FORMAT(1H0)
4502 FORMAT(1H0//)
4503 FORMAT(1H1,15H PROBLEM NUMBER,2X,A6,57X,2A6,I3,1H,,I5,3X,4HPAGE,
1I4)
4504 FORMAT(1H ,18X,23HNUMBER OF RESPONDENTS =,I5,22X,21HNUMBER OF VARI
1ABLES =,I3)
4505 FORMAT(1H ,44X,22HVARIABLES OR QUESTIONS)
4506 FORMAT(1H ,54X,4HSTEP,I4)
4508 FORMAT(1H ,15HRANK RESP SCOR ,25(I3,A1))
4509 FORMAT(1H ,3X,8HSCORE OF,4X,25(I3,A1))
4510 FORMAT(1H0,5X,8HQUESTION,6X,15HTOTAL NUMBER OF,6X,15HSCORES COMBIN
1ED,6X,15HNUMBER OF PARTS/18X,19HCOMBINATIONS SO FAR,7X,9HTHIS TIME
2,9X,15HORIGINAL NOW)
4511 FORMAT(1H0,64X,8HDECREASE,15X,11HAPPROXIMATE/15X,8HQUESTION,15X,11
1HCOMBINATION,15X, 10HIN NUMBER,14X,11HINCREASE IN/64X,10HOF ERRO
2RS,12X,15HREPRODUCIBILITY)
4910 FORMAT(1H0,21X,70HTHE MINIMUM QUESTIONS DESIRED IS GREATER THAN TH
1E NUMBER OF QUESTIONS./26X,62HNO QUESTIONS WILL BE ELIMINATED BUT
2SAVE TAPE WILL BE WRITTEN.)
4940 FORMAT(1H1,32X,52HCONTROL CARDS OUT OF ORDER. PROGRAM CANNOT CONTI
1NUE.)
C
END
CCHECK SUBROUTINE CHECK FOR BMD07S DECEMBER 13, 1963
SUBROUTINE CHECK(M)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
37),KONTER(25,7),DUMMY3(8)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYCEA,MAXLOC,N1,N2,DUMMY3,KK,ICHNGE
C
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
2),(ERROR,KONTER)
C
25000 THETA=0.0
MTIMES=MVAR(M)
C
N=N1(M)
NN=N2(M)
IF(N)920,920,1
1 IF(NN)920,920,2
2 IF(N-7)3,3,920
3 IF(NN-7)4,4,920
4 IF(MTIMES)900,900,5
5 IF(MTIMES-7)10,10,900
10 GO TO (900,920,30,40,50,60,70),MTIMES
C
30 GO TO (31,920,920,34,920,920,37),N
C
31 GO TO (920,920,920,800,920,920,920),NN
C
34 GO TO (800,920,920,920,920,920,800),NN
C
37 GO TO (920,920,920,800,920,920,920),NN
C
40 GO TO (41,920,43,920,45,920,47),N
C
41 GO TO (920,920,800,920,920,920,920),NN
C
43 GO TO (800,920,920,920,800,920,920),NN
C
45 GO TO (920,920,800,920,920,920,800),NN
C
47 GO TO (920,920,920,920,800,920,920),NN
C
50 GO TO (51,52,920,54,920,56,57),N
C
51 GO TO (920,800,920,920,920,920,920),NN
C
52 GO TO (800,920,920,800,920,920,920),NN
C
54 GO TO (920,800,920,920,920,800,920),NN
C
56 GO TO (920,920,920,800,920,920,800),NN
C
57 GO TO (920,920,920,920,920,800,920),NN
C
60 GO TO (51,62,63,920,65,66,57),N
C
62 GO TO (800,920,800,920,920,920,920),NN
C
63 GO TO (920,800,920,920,800,920,920),NN
C
65 GO TO (920,920,800,920,920,800,920),NN
C
66 GO TO (920,920,920,920,800,920,800),NN
C
70 GO TO (51,62,73,74,75,66,57),N
C
73 GO TO (920,800,920,800,920,920,920),NN
C
74 GO TO (920,920,800,920,800,920,920),NN
C
75 GO TO (920,920,920,800,920,800,920),NN
C
800 RETURN
C
900 WRITE (6,4000)M,MTIMES
KOMPER=1
GO TO 800
C
920 WRITE (6,4020)M,MTIMES,N1(M),N2(M)
KOMPER=1
GO TO 800
C
4000 FORMAT(1H0,12X,31HTHE NUMBER OF PARTS TO QUESTION,I3,3H IS,I3,51H
1A VALUE NOT PERMITTED. THIS OCCURRED IN SUB CHECK.)
C
4020 FORMAT(1H0,6X,8HQUESTION,I3,4H HAS,I3,14H PARTS. SCORES,I3,4H AND,
1I3,63H WERE TO BE COMBINED BUT ONE OR BOTH OF THEM IS(ARE) INCORRE
2CT.)
C
END
CCOMBIN SUBROUTINE COMBIN FOR BMD04S, 05S AND 07S JUNE 3, 1963
SUBROUTINE COMBIN(I,N1,N2)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
DIMENSION DUMMY2(27)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
25000 THETA=0.0
M=LVAR(I)
C
INDEX1=I+LASTNO-NVAR
FLPTN1=N1(M)
FLPTN2=N2(M)
DO 25 J=I,INDEX1,NVAR
IF(A(J)-FLPTN1)25,10,25
10 A(J)=FLPTN2
25 CONTINUE
L1=N1(M)
L2=N2(M)
MFREQ(M,L2)=MFREQ(M,L2)+MFREQ(M,L1)
MFREQ(M,L1)=0
IF(MVAR(M)-6)27,60,70
27 IF(MVAR(M)-4)28,40,50
28 IF(MVAR(M)-2)900,900,30
30 IF(MFREQ(M,1))910,31,32
31 MFREQ(M,1)=MFREQ(M,4)
SCORE2=1.0
310 SCORE1=4.0
MFREQ(M,4)=0
LTIMES=1
GO TO 500
32 IF(MFREQ(M,4))910,600,33
33 MFREQ(M,7)=MFREQ(M,4)
SCORE2=7.0
GO TO 310
40 IF(MFREQ(M,1))910,41,43
41 LTIMES=2
SCORE1=3.0
MFREQ(M,1)=MFREQ(M,3)
MFREQ(M,3)=0
410 SCORE2=1.0
GO TO 500
42 SCORE1=5.0
MFREQ(M,4)=MFREQ(M,5)
MFREQ(M,5)=0
425 LTIMES=1
SCORE2=4.0
GO TO 500
43 IF(MFREQ(M,3))910,42,44
44 IF(MFREQ(M,5))910,45,46
45 SCORE1=3.0
MFREQ(M,4)=MFREQ(M,3)
MFREQ(M,3)=0
GO TO 425
46 LTIMES=3
SCORE1=5.0
MFREQ(M,7)=MFREQ(M,5)
MFREQ(M,5)=0
465 SCORE2=7.0
GO TO 500
50 IF(MFREQ(M,1))910,51,54
51 LTIMES=4
515 SCORE1=2.0
MFREQ(M,1)=MFREQ(M,2)
MFREQ(M,2)=0
GO TO 410
52 LTIMES=5
521 SCORE1=4.0
MFREQ(M,3)=MFREQ(M,4)
MFREQ(M,4)=0
525 SCORE2=3.0
GO TO 500
53 LTIMES=1
SCORE1=6.0
MFREQ(M,5)=MFREQ(M,6)
MFREQ(M,6)=0
535 SCORE2=5.0
GO TO 500
54 IF(MFREQ(M,2))910,52,55
55 IF(MFREQ(M,4))910,56,57
56 LTIMES=5
565 SCORE1=2.0
MFREQ(M,3)=MFREQ(M,2)
MFREQ(M,2)=0
GO TO 525
57 IF(MFREQ(M,6))910,58,590
58 LTIMES=6
581 SCORE1=4.0
MFREQ(M,5)=MFREQ(M,4)
MFREQ(M,4)=0
GO TO 535
59 LTIMES=1
GO TO 565
590 LTIMES=7
591 SCORE1=6.0
MFREQ(M,7)=MFREQ(M,6)
MFREQ(M,6)=0
GO TO 465
60 IF(MFREQ(M,1))910,61,63
61 LTIMES=8
GO TO 515
62 LTIMES=2
621 SCORE1=3.0
SCORE2=2.0
MFREQ(M,2)=MFREQ(M,3)
MFREQ(M,3)=0
GO TO 500
63 IF(MFREQ(M,2))910,62,64
64 IF(MFREQ(M,3))910,42,65
65 IF(MFREQ(M,5))910,45,66
66 IF(MFREQ(M,6))910,67,68
67 LTIMES=3
671 SCORE1=5.0
SCORE2=6.0
MFREQ(M,6)=MFREQ(M,5)
MFREQ(M,5)=0
GO TO 500
68 LTIMES=9
GO TO 591
70 IF(MFREQ(M,1))910,71,74
71 LTIMES=10
GO TO 515
72 LTIMES=11
GO TO 621
73 LTIMES=1
GO TO 521
74 IF(MFREQ(M,2))910,72,75
75 IF(MFREQ(M,3))910,73,76
76 IF(MFREQ(M,4))910,600,77
77 IF(MFREQ(M,5))910,78,79
78 LTIMES=1
GO TO 581
79 IF(MFREQ(M,6))910,80,81
80 LTIMES=12
GO TO 671
81 LTIMES=13
GO TO 591
500 DO 510 JJ=I,INDEX1,NVAR
IF(A(JJ)-SCORE1)510,505,510
505 A(JJ)=SCORE2
510 CONTINUE
GO TO (600,42,45,52,53,59,58,62,67,72,73,78,80),LTIMES
600 MVAR(M)=MVAR(M)-1
610 RETURN
900 L=2
WRITE (6,4000)I,N1(M),N2(M),M,L
KOMPER=1
GO TO 610
910 WRITE (6,4010)I,N1(M),N2(M),M
KOMPER=1
GO TO 610
4000 FORMAT(1H ,20X,54HMACHINE ERROR. UPON ENTRY TO SUBROUTINE COMBIN W
1ITH I=,I3,7H N1(M)=,I3,7H N2(M)=,I3/10X,9H QUESTION,I3,9H HAS ONLY
2,I2,77H PARTS, WHEREAS IT MUST HAVE AT LEAST 3 PARTS IN ORDER TO H
3AVE A COMBINATION.)
4010 FORMAT(1H ,20X,54HMACHINE ERROR. UPON ENTRY TO SUBROUTINE COMBIN W
1ITH I=,I3,7H N1(M)=,I3,7H N2(M)=,I3/22X,48H ONE OF THE FREQUENCIES
2 OF RESPONSES TO QUESTION,I3,14H WAS NEGATIVE.)
END
CENDCMB SUBROUTINE ENDCMB FOR BMD07S JUNE 3, 1963
C
SUBROUTINE ENDCMB(NDREDK,K,MAXERR,LASTRD)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
37),KONTER(25,7),DUMMY3(7)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,I,DUMMY3,KK
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
2),(ERROR,KONTER)
C
MINRED=((LASTNO+199)/200)*NDREDK
C
FLPTN1=MAXERR
FLPTN2=LASTNO
REPERR=FLPTN1/FLPTN2
KK=4
10 CALL FNDCMB(FLPTN2)
IF(KOMPER)500,100,500
100 GO TO (150,155,490),K
150 IF(REPERR-0.1)151,151,155
151 K=2
155 INDEX1=INDTEM+1
INDEX2=INDTEM+NVAR
M=0
J=0
DO 170 L=INDEX1,INDEX2
N=KOLSKR(L+25)
IF(N)900,157,1565
1565 GO TO (159,156,490),K
156 IF(N-MINRED)157,159,159
157 KOLSKR(L)=0
KOLSKR(L+25)=0
N=0
159 IF(M-N)160,170,170
160 M=N
J=L
170 CONTINUE
IF(J)180,180,250
180 K=3
GO TO 10
250 N=M
L=J-INDTEM
M=LVAR(L)
N2(M)=KOLSKR(J)/8
N1(M)=KOLSKR(J)-(N2(M)*8)
NCOMB(M)=NCOMB(M)+1
CALL COMBIN(L,N1,N2(1))
IF(KOMPER)500,300,500
300 I=L
CALL DECTER
MAXERR=MAXERR-N
480 KOMPER=25
GO TO 500
490 KOMPER=50
500 RETURN
900 KOMPER=1
WRITE (6,4900)
GO TO 500
4900 FORMAT(1H0,9X,91H* MACHINE ERROR * THE REDUCTION IN ERROR DUE TO A
1 POSSIBLE COMBINATION IN SUBROUTINE ENDCMB/18X,74HIS NEGATIVE. THI
2S IS NOT POSSIBLE IN THIS PROGRAM. PROGRAM CANNOT PROCEED.)
END
CFNDCMB SUBROUTINE FNDCMB FOR BMD04S, 05S AND 07S JUNE 3, 1963
C
SUBROUTINE FNDCMB(FLPTN2)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
37),KONTER(25,7),DUMMY3(7),DUMMY4(2)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,I,DUMMY3,KK,DUMMY4,L1
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
2),(ERROR,KONTER)
C
25000 THETA=0.0
11 DO 300 II=1,NVAR
C
INDEX2=INDTEM+II
INDEXK=LASTNO+II-NVAR
M=LVAR(II)
MTIMES=MVAR(M)
IF(MTIMES-2)200,200,12
12 GO TO (915,1250,915,14),KK
1250 IF(MTIMES-3)200,200,14
14 ITIMES=1
KOLHLD(24)=0
DO 15 J=1,7
KOLHLD(J)=KONTER(M,J)
KOLHLD(24)=KOLHLD(24)+KONTER(M,J)
KOLHLD(J+7)=MFREQ(M,J)
15 CONTINUE
K=INDKOL
DO 30 INDEX=II,INDEXK,NVAR
K=K+1
HOLDA(K)=A(INDEX)
30 CONTINUE
GO TO (915,31,915,32),KK
31 GO TO (295,295,295,60,90,125,155),MTIMES
32 GO TO (295,295,355,61,91,91,91),MTIMES
355 N1(M)=7
36 N2(M)=4
37 CALL COMBIN(II,N1,N2(1))
IF(KOMPER)360,38,360
38 I=II
CALL DECTER
MVAR(M)=MVAR(M)+1
KOLHLD(25)=0
DO 40 J=1,7
KOLHLD(25)=KOLHLD(25)+KONTER(M,J)
GO TO (915,387,915,384),KK
384 IF(MFREQ(M,J))387,387,385
385 IF(MFREQ(M,J)-(KONTER(M,J)+KONTER(M,J)))386,387,387
386 KOLHLD(25)=KOLHLD(24)
387 MFREQ(M,J)=KOLHLD(J+7)
40 CONTINUE
42 K=INDKOL
DO 45 INDEX=II,INDEXK,NVAR
K=K+1
A(INDEX)=HOLDA(K)
45 CONTINUE
GO TO (295,295,405,69,98,131,162),MTIMES
405 GO TO (41,47),ITIMES
41 N1(M)=1
455 ITIMES=2
N=KOLHLD(25)
GO TO (295,295,36,62,92,92,92),MTIMES
47 IF(KOLHLD(25))900,475,475
475 IF(N)900,477,477
477 IF(KOLHLD(25)-N)48,55,58
48 N=KOLHLD(24)-KOLHLD(25)
L=1
482 K=4
485 GO TO (915,486,915,1000),KK
486 IF(N)295,295,49
49 IF(KOLHLD(24)-10)51,51,50
50 IF(N-((KOLHLD(24)+9)/10))295,51,51
51 KOLSKR(INDEX2)=(K*8)+L
KOLSKR(INDEX2+25)=N
GO TO 296
55 GO TO (915,295,915,58),KK
58 N=KOLHLD(24)-N
L=7
GO TO 482
60 L=0
IF(MFREQ(M,7)-(2*KOLHLD(7)))61,63,63
61 N1(M)=7
62 N2(M)=5
GO TO 37
63 IF(MFREQ(M,5)-(2*KOLHLD(5)))61,65,65
65 IF(MFREQ(M,3)-(2*KOLHLD(3)))61,67,67
67 IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))85,295,295
69 GO TO (695,70,80),ITIMES
695 N1(M)=3
GO TO 455
70 IF(KOLHLD(25))900,71,71
71 IF(N)900,72,72
72 IF(KOLHLD(25)-N)73,73,745
73 L=2
N=KOLHLD(25)
74 ITIMES=3
N1(M)=1
742 N2(M)=3
GO TO 37
745 L=1
GO TO 74
80 IF(KOLHLD(25))900,81,81
81 IF(KOLHLD(25)-N)82,87,83
82 N=KOLHLD(24)-KOLHLD(25)
K=3
825 L=1
GO TO 485
83 N=KOLHLD(24)-N
IF(L-2)84,845,84
84 L=7
842 K=5
GO TO 485
845 L=3
GO TO 842
85 N=KOLHLD(24)
GO TO 74
87 GO TO (915,295,915,83),KK
90 N=1
GO TO 126
91 N1(M)=7
92 N2(M)=6
GO TO 37
96 IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))120,295,295
98 GO TO (99,100,106,111),ITIMES
99 N1(M)=4
GO TO 455
100 IF(KOLHLD(25))900,101,101
101 IF(N)900,102,102
102 IF(KOLHLD(25)-N)103,105,105
103 L=2
N=KOLHLD(25)
104 ITIMES=3
N1(M)=4
1045 N2(M)=2
GO TO 37
105 L=1
GO TO 104
106 IF(KOLHLD(25))900,107,107
107 IF(KOLHLD(25)-N)108,110,109
108 L=3
N=KOLHLD(25)
109 ITIMES=4
1090 N1(M)=1
GO TO 1045
110 IF(L-2)108,109,108
111 IF(KOLHLD(25))900,112,112
112 IF(KOLHLD(25)-N)113,114,114
113 N=KOLHLD(24)-KOLHLD(25)
K=2
GO TO 825
114 IF(L-2)115,118,119
115 K=7
116 L=6
117 N=KOLHLD(24)-N
GO TO 485
118 K=4
GO TO 116
119 L=2
K=4
GO TO 117
120 N=KOLHLD(24)
GO TO 109
125 N=2
126 L=0
DO 128 JJ=2,7
IF((KOLHLD(JJ)+KOLHLD(JJ))-MFREQ(M,JJ))128,128,91
128 CONTINUE
129 GO TO (96,130,161),N
130 IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))121,295,295
121 N=KOLHLD(24)
GO TO 146
131 GO TO(132,133,139,143,148),ITIMES
132 N1(M)=5
GO TO 455
133 IF(KOLHLD(25))900,134,134
134 IF(N)900,135,135
135 IF(KOLHLD(25)-N)136,138,138
136 L=2
N=KOLHLD(25)
137 ITIMES=3
N1(M)=5
GO TO 742
138 L=1
GO TO 137
139 IF(KOLHLD(25))900,140,140
140 IF(KOLHLD(25)-N)141,141,142
141 L=3
N=KOLHLD(25)
142 ITIMES=4
N1(M)=2
GO TO 742
143 IF(KOLHLD(25))900,144,144
144 IF(KOLHLD(25)-N)145,147,146
145 L=4
N=KOLHLD(25)
146 ITIMES=5
GO TO 1090
147 IF(L-2)146,145,146
148 IF(KOLHLD(25))900,149,149
149 IF(KOLHLD(25)-N)113,150,150
150 IF(L-4)151,154,154
151 IF(L-2)115,152,153
152 K=5
GO TO 116
153 K=5
GO TO 1545
154 K=2
1545 L=3
GO TO 117
155 N=3
GO TO 126
161 IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))189,295,295
162 GO TO(132,163,169,173,178,183),ITIMES
163 IF(KOLHLD(25))900,164,164
164 IF(N)900,165,165
165 IF(KOLHLD(25)-N)166,168,168
166 L=2
N=KOLHLD(25)
167 ITIMES=3
N1(M)=5
1675 N2(M)=4
GO TO 37
168 L=1
GO TO 167
169 IF(KOLHLD(25))900,170,170
170 IF(KOLHLD(25)-N)171,171,172
171 L=3
N=KOLHLD(25)
172 ITIMES=4
N1(M)=3
GO TO 1675
173 IF(KOLHLD(25))900,174,174
174 IF(KOLHLD(25)-N)175,177,176
175 L=4
N=KOLHLD(25)
176 ITIMES=5
N1(M)=3
GO TO 1045
177 IF(L-2)175,175,176
178 IF(KOLHLD(25))900,179,179
179 IF(KOLHLD(25)-N)180,182,181
180 L=5
N=KOLHLD(25)
181 ITIMES=6
GO TO 1090
182 IF(L-2)180,181,181
183 IF(KOLHLD(25))900,184,184
184 IF(KOLHLD(25)-N)113,185,185
185 IF(L-4)186,188,154
186 IF(L-2)115,152,187
187 L=4
K=5
GO TO 117
188 K=4
GO TO 1545
189 N=KOLHLD(24)
GO TO 181
1000 IF(N)295,295,1010
1010 SCORE1=N
KOLSKR(INDEX2)=L+(K*8)
KOLSKR(INDEX2+25)=N
RANKSM(INDEX2+50)=SCORE1/FLPTN2
GO TO 296
200 KOLSKR(INDEX2)=0
KOLSKR(INDEX2+25)=0
GO TO 300
295 KOLSKR(INDEX2)=0
KOLSKR(INDEX2+25)=0
296 DO 297 J=1,7
KONTER(M,J)=KOLHLD(J)
297 CONTINUE
N1(M)=0
N2(M)=0
300 CONTINUE
GO TO (915,301,915,360),KK
301 L1=0
DO 350 II=1,NVAR
INDEX2=INDTEM+II+25
IF(KOLSKR(INDEX2))910,350,310
310 IF(L1-KOLSKR(INDEX2))315,350,350
315 L1=KOLSKR(INDEX2)
J=II
350 CONTINUE
IF(L1)357,360,357
357 INDEX2=INDTEM+J
M=LVAR(J)
L2=KOLSKR(INDEX2)
N1(M)=L2/8
N2(M)=L2-(8*N1(M))
NCOMB(M)=NCOMB(M)+1
CALL COMBIN(J,N1,N2(1))
I=J
KK=2
CALL DECTER
360 RETURN
900 KOMPER=1
WRITE (6,4900)
GO TO 360
910 KOMPER=1
I=INDEX2-INDTEM
M=LVAR(I)
WRITE (6,4910)M
GO TO 360
915 KOMPER=1
WRITE (6,4915)
GO TO 360
4900 FORMAT(1H0,25X,56H* MACHINE ERROR * TOTAL ERROR IN SUB FNDCMB IS N
1EGATIVE.)
4910 FORMAT(1H0,18X,59H* MACHINE ERROR* THE ERROR DUE TO A COMBINATION
1IN QUESTION,I3,13H RESULTS IN A/41X,29HNEGATIVE ERROR IN SUB FNDCM
2B.)
4915 FORMAT(1H0,12X,86H* MACHINE ERROR * SUBROUTINE FNDCMB WAS ENTERED
1WITH AN INCORRECT VALUE OF A CONSTANT.)
END
CFRSTCM SUBROUTINE FRSTCM FOR BMD07S OCTOBER 1, 1964
SUBROUTINE FRSTCM(NPER)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(5),DUMMYX(3)
DIMENSION DUMMY2(27)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,DUMMY1,N1,N2,DUMMYX,L
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
C
MINPR=(NPER*NCASE+99)/100
C
10 L=INDKOL
DO 100 I=1,NVAR
M=LVAR(I)
IF(MVAR(M)-2)100,100,12
12 DO 75 J=1,7
IF(MFREQ(M,J))75,75,15
15 IF(MFREQ(M,J)-MINPR)25,75,75
25 L=L+1
KOLSKR(L)=M+(64*J)
75 CONTINUE
100 CONTINUE
125 IF(L-INDKOL)150,150,175
150 RETURN
C
160 L=LL
GO TO 150
C
175 K=INDKOL
MM=0
LL=L
176 K=K+1
IF(K-LL)177,177,160
177 J=KOLSKR(K)/64
I=KOLSKR(K)-(64*J)
IF(I-MM)178,160,178
178 MM=I
DO 179 I=1,NVAR
IF(LVAR(I)-MM)179,1795,179
179 CONTINUE
1795 MTIMES=MVAR(I)-2
GO TO (180,195,205,215,230),MTIMES
180 IF(J-4)185,190,191
185 N2(MM)=1
186 N1(MM)=4
187 NCOMB(MM)=NCOMB(MM)+1
CALL COMBIN(I,N1,N2(1))
GO TO 176
C
190 IF(MFREQ(MM,7)-MFREQ(MM,1))191,191,185
191 N2(MM)=7
GO TO 186
C
195 IF(J-5)196,199,200
196 IF(J-3)197,221,221
197 N1(MM)=1
198 N2(MM)=3
GO TO 187
C
199 N1(MM)=5
GO TO 198
C
200 N1(MM)=7
GO TO 222
C
205 IF(J-6)206,211,213
206 IF(J-2)207,209,210
207 N1(MM)=1
208 N2(MM)=2
GO TO 187
C
209 N1(MM)=2
GO TO 212
C
210 IF(MFREQ(MM,2)-MFREQ(MM,6))2105,2105,2110
2105 N1(MM)=4
GO TO 208
C
2110 N1(MM)=4
GO TO 214
C
211 N1(MM)=6
212 N2(MM)=4
GO TO 187
C
213 N1(MM)=7
214 N2(MM)=6
GO TO 187
C
215 IF(J-6)216,225,213
216 IF(J-3)217,220,223
217 IF(J-2)207,218,220
218 IF(MFREQ(MM,1)-MFREQ(MM,3))2180,2180,2185
2180 N1(MM)=2
2181 N2(MM)=1
GO TO 187
C
2185 N1(MM)=2
GO TO 198
C
219 N1(MM)=3
GO TO 208
C
220 IF(MFREQ(MM,2)-MFREQ(MM,5))219,219,221
221 N1(MM)=3
222 N2(MM)=5
GO TO 187
C
223 IF(MFREQ(MM,3)-MFREQ(MM,6))199,199,2235
2235 N1(MM)=5
GO TO 214
C
224 N1(MM)=6
GO TO 222
C
225 IF(MFREQ(MM,5)-MFREQ(MM,7))224,224,2250
2250 N1(MM)=6
N2(MM)=7
GO TO 187
C
230 IF(J-6)231,225,213
231 IF(J-4)232,236,238
232 IF(J-2)207,218,233
233 IF(MFREQ(MM,2)-MFREQ(MM,4))219,219,234
234 N1(MM)=3
GO TO 212
C
236 IF(MFREQ(MM,3)-MFREQ(MM,5))2360,2360,2370
2360 N2(MM)=3
GO TO 186
C
2370 N2(MM)=5
GO TO 186
C
237 N1(MM)=5
GO TO 212
C
C
238 IF(MFREQ(MM,4).LE.MFREQ(MM,6)) GO TO 237
9000 GO TO 2235
END
CORDER SUBROUTINE ORDER FOR BMD04S, 05S AND 07S JUNE 3, 1963
SUBROUTINE ORDER
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
DIMENSION DUMMY2(27)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYDAC,MAXLOC,N1,N2
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
EQUIVALENCE(A,INDIVD,KOLSKR,HOLDA,RANKSM),(INV,LVAR),(HOLD,KOLHLD)
EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
211 I=0
C
BIGY=176.0
IJJ=INDKOL+1
L=INDRNK+1
212 Y=0.0
M=INDKOL
J=L+I
DO 225 JRNK=J,INDKOL
IF(Y-RANKSM(JRNK))215,220,225
215 IF(RANKSM(JRNK)-BIGY)216,225,225
216 Y=RANKSM(JRNK)
M=INDKOL
220 M=M+1
KOLSKR(M)=JRNK
225 CONTINUE
BIGY=Y
DO 230 JJ=IJJ,M
I=I+1
MOVFRM=KOLSKR(JJ)-INDRNK
CALL MOVE(MOVFRM,I)
230 CONTINUE
IF(NCASE -I)235,235,212
235 RETURN
END
CORQSCP SUBROUTINE ORQUES FOR BMD07S DECEMBER 16, 1964
SUBROUTINE ORQUES(L)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(7)
DIMENSION DUMMY2(27)
DIMENSION DUMMZ(11)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYDAC,MAXLOC,N1,N2,LL,DUMMY1,NN
COMMON DUMMZ,INDEX3
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
25000 THETA=0.0
ASSIGN 218 TO KSKIP
KK=NVAR+1
JJ=INDKOL+1
IF(L)1,30,1
1 NN=4
INDEX1=INDTEM+75
ASSIGN 212 TO KSKIP
LL=1
1000 M=LVAR(LL)
KOLSKR(INDEX1+1)=0
IF(MFREQ(M,7))4,5,4
4 CALL DECTER
5 KOLHLD (LL)=KOLSKR(INDEX1+1)
LL=LL+1
IF(LL.LE.NVAR)GO TO 1000
0 INDEX=INDEX1
DO 10 J=1,25
INDEX=INDEX+1
10 KOLSKR(INDEX)=MFREQ(J,7)
K=0
MM=INDKOL
LGEN=0
11 N=NCASE+1
DO 15 J=1,NVAR
IF(KOLHLD (J)-N)12,14,15
12 IF(LGEN-KOLHLD (J))13,15,15
13 N=KOLHLD(J)
MM=INDKOL
14 MM=MM+1
KOLSKR(MM)=J
15 CONTINUE
LGEN=N
DO 20 J=JJ,MM
I=KOLSKR(J)
M=LVAR(I)
K=K+1
20 MFREQ(M,7)=K
IF(NVAR-K)30,30,11
30 LGEN=NCASE+1
40 N=0
MM=INDKOL
DO 150 I=1,NVAR
M=LVAR(I)
IF(N-MFREQ(M,7))50,220,150
50 IF(MFREQ(M,7)-LGEN)55,150,150
55 N=MFREQ(M,7)
MM=INDKOL
60 MM=MM+1
KOLSKR(MM)=I
150 CONTINUE
LGEN=N
DO 200 J=JJ,MM
KK=KK-1
I=KOLSKR(J)
IF(KK-I)175,200,175
175 IJJ=KK
KOLHLD(1)=LVAR(I)
LVAR(I)=LVAR(KK)
LVAR(KK)=KOLHLD(1)
K=LASTNO-NVAR+I
DO 190 INDEX=I,K,NVAR
HOLD(1)=A(INDEX)
A(INDEX)=A(IJJ)
A(IJJ)=HOLD(1)
IJJ=IJJ+NVAR
190 CONTINUE
200 CONTINUE
IF(KK-1)210,210,40
210 GO TO KSKIP,(212,218)
212 DO 215 J=1,25
INDEX1=INDEX1+1
215 MFREQ(J,7)=KOLSKR(INDEX1)
218 RETURN
C
220 IF(MM-(INDKOL+1))60,230,60
230 J=KOLSKR(MM)
IF(LVAR(J)-M)240,60,60
240 KOLSKR(MM+1)=J
KOLSKR(MM)=I
MM=MM+1
GO TO 150
C
END
CREORDR SUBROUTINE REORDR FOR BMD07S AUGUST 19, 1964
SUBROUTINE REORDR
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
37),KONTER(25,7)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYCDA,MAXLOC,N1,N2,I
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
2),(ERROR,KONTER)
C
25000 THETA=0.0
IT2=2
C
C TWO SCRATCH TAPES MAY BE CALLED IN THIS PROGRAM IF THE DATA
C REQUIRES MOST OF THE STORAGE LOCATIONS. THEY ARE DESIGNATED HERE
C BY IT2 AND IT3. IF THE NUMBER OF CASES=N AND THE NUMBER OF
C QUESTIONS =P, THEN IT3 WILL BE USED IF NP+6N IS GREATER THAN
C 20,000. IT2 AND IT3 WILL BOTH BE USED IF NP+5N IS GREATER THAN
C 20,000.
C
IT3=3
C
ASSIGN 26 TO KOMPLT
IMEMRY=1
INDEX=INDTEM+NCASE+NCASE
INDEXK=INDEX+NCASE
IF(INDEXK-8000) 9,9,4
4 IF(INDEX-8000) 7,7,6
6 IMEMRY=3
REWIND IT2
GO TO 8
C
7 IMEMRY=2
8 REWIND IT3
9 INDEXK=INDTEM+NCASE
JRNK=INDRNK+1
TOT=RANKSM(JRNK)
NVARHF=NVAR/2+1
M=0
L=INDKOL+1
K=INDKOL
DO 25 I=JRNK,K
IF(RANKSM(I)-TOT)10,20,900
10 TOT=RANKSM(I)
11 IF(1-M)21,25,25
21 J=I-INDRNK
KOLSKR(L)=J-M
KOLSKR(L+1)=J-1
L=L+2
M=0
20 M=M+1
25 CONTINUE
GO TO KOMPLT,(26,29)
26 ASSIGN 29 TO KOMPLT
I=K+1
GO TO 11
29 IF((INDKOL+1)-L)30,321,905
30 NUMPRS=(L-INDKOL-1)/2
L1=INDKOL-1
INDXT1=LASTNO+1
INDXT2=INDKOL
IREADT=1
GO TO (370,306,305),IMEMRY
305 NPOINT=(INDRNK-INDXT1+128)/128
NWED=INDXT1-1
IF (NPOINT.LE.1) GO TO 3330
DO 3331 J=1,NPOINT-1
NJ=(J-1)*128+NWED+1
NJJ=J*128+NWED
3331 WRITE(IT2)(INDIVD(JJJ),JJJ=NJ,NJJ)
3330 NJ=(NPOINT-1)*128+NWED+1
WRITE(IT2)(INDIVD(JJJ),JJJ=NJ,INDRNK)
ENDFILE IT2
306 GO TO (307,308),IREADT
307 NPOINT=(INDXT2-JRNK+128)/128
NWED=JRNK-1
IF (NPOINT.LE.1) GO TO 3337
DO 3338 J=1,NPOINT-1
NJ=(J-1)*128+NWED+1
NJJ=J*128+NWED
3338 WRITE(IT3)(RANKSM(JJJ),JJJ=NJ,NJJ)
3337 NJ=(NPOINT-1)*128+NWED+1
WRITE(IT3)(RANKSM(JJJ),JJJ=NJ,INDXT2)
END FILE IT3
REWIND IT3
GO TO (31,350,308),IMEMRY
308 REWIND IT2
31 L1=L1+2
K1=KOLSKR(L1)
K2=KOLSKR(L1+1)
MOVETO=K1-1
NUMSAM=K2-K1+1
INDEX2=K1*NVAR
INDEX3=K2*NVAR
L=INDRNK
35 DO 50 I=INDEX2,INDEX3,NVAR
L=L+1
RANKSM(L)=0.0
INDEX1=I-NVAR+NVARHF
40 DO 45 J=INDEX1,I
RANKSM(L)=RANKSM(L)+A(J)
45 CONTINUE
50 CONTINUE
BIGY=92.0
I=INDTEM
INDEX2=INDRNK+NUMSAM
51 Y=0.0
L=LASTNO
DO 55 J=JRNK,INDEX2
IF(Y-RANKSM(J))52,54,55
52 IF(RANKSM(J)-BIGY)53,55,55
53 Y=RANKSM(J)
L=LASTNO
54 L=L+1
INDIVD(L)=J-INDRNK
55 CONTINUE
BIGY=Y
DO 60 JJ=INDXT1,L
I=I+1
INDIVD(I)=INDIVD(JJ)
60 CONTINUE
IF((NUMSAM+INDTEM)-I)64,64,51
64 GO TO (390,390,65),IMEMRY
65 NPOINT=(INDRNK-INDXT1+128)/128
NWED=INDXT1-1
IF (NPOINT.LE.1) GO TO 6665
DO 6666 J=1,NPOINT-1
NJ=(J-1)*128+NWED+1
NJJ=J*128+NWED
6666 READ(IT2)(INDIVD(JJJ),JJJ=NJ,NJJ)
6665 NJ=(NPOINT-1)*128+NWED+1
READ(IT2)(INDIVD(JJJ),JJJ=NJ,INDRNK)
66 REWIND IT2
67 DO 70 J=JRNK,INDEX2
INDIVD(J)=0
70 CONTINUE
INDEX1=INDTEM+1
INDEX2=INDTEM+NUMSAM
DO 75 JJ=INDEX1,INDEX2
L=INDIVD(JJ)
LL=L+INDRNK
MOVETO=MOVETO+1
MOVFRM=L+INDIVD(LL)+K1-1
IF(MOVFRM-MOVETO)71,75,71
71 KK=2
CALL MOVFOR(MOVFRM,MOVETO,KK)
JRNK=INDRNK+1
DO 74 I=JRNK,LL
INDIVD(I)=INDIVD(I)+1
74 CONTINUE
75 CONTINUE
NUMPRS=NUMPRS-1
IF(NUMPRS)905,100,80
80 IREADT=2
INDEXK=INDTEM+NCASE
GO TO (350,350,305),IMEMRY
C
100 GO TO (400,105,105),IMEMRY
105 NPOINT=(INDXT2-JRNK+128)/128
NWED=JRNK-1
IF (NPOINT.LE.1) GO TO 1115
DO 1116 J=1,NPOINT-1
NJ=(J-1)*128+NWED+1
NJJ=J*128+NWED
1116 READ(IT3)(RANKSM(JJJ),JJJ=NJ,NJJ)
1115 NJ=(NPOINT-1)*128+NWED+1
READ(IT3)(RANKSM(JJJ),JJJ=NJ,INDXT2)
200 REWIND IT3
321 RETURN
C
350 MM=INDEXK
DO 360 J=INDXT1,INDRNK
MM=MM+1
INDIVD(MM)=INDIVD(J)
360 CONTINUE
GO TO 31
C
370 MM=INDEX
DO 380 J=JRNK,INDXT2
MM=MM+1
HOLDA(MM)=RANKSM(J)
380 CONTINUE
GO TO 350
C
390 MM=INDEXK
DO 395 J=INDXT1,INDRNK
MM=MM+1
INDIVD(J)=INDIVD(MM)
395 CONTINUE
GO TO 67
C
400 MM=INDEX
DO 405 J=JRNK,INDXT2
MM=MM+1
RANKSM(J)=HOLDA(MM)
405 CONTINUE
GO TO 321
C
900 KOMPER=1
J=LASTNO+I-INDRNK
I=INDIVD(J)
WRITE (6,4900)I
GO TO 321
C
905 KOMPER=1
WRITE (6,4905)
GO TO 321
C
8000 FORMAT(20A4)
4900 FORMAT(1H ,52X,13HMACHINE ERROR/30X,10HRESPONDENT,I5,39H WAS FOUND
1 OUT OF ORDER IN SUB REORDER.)
4905 FORMAT(1H ,52X,13HMACHINE ERROR/29X,60HA COUNT WHICH SHOULD BE POS
1ITIVE IN SUB REORDER IS NEGATIVE.)
C
END
CRKCHNG SUBROUTINE RKCHNG FOR BMD07S OCTOBER 22, 1965
C
SUBROUTINE RKCHNG(MAXERR)
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
37),KONTER(25,7),DUMMY3(5),DUMMY4(1),DUMMY5(10)
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,KK,DUMMY3,IFIRST,DUMMY4
3,NN,ICHNGE,DUMMY5,INDEX3
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
2),(ERROR,KONTER)
C
25000 THETA=0.0
IT1=4
C
C IT1 IS THE TAPE WHICH CONTAINS THE ORIGINAL WEIGHTED RESPONSES.
L2=NVAR+1
C
K=1
KIND=INDKOL
IF(NCASE-175)400,425,425
400 KIND=INDTEM+500
425 MINERR=MAXERR-(((MAXERR+19)/20)*ICHNGE)
IF(MINERR)450,465,465
450 MINERR=0
465 DO 550 N=1,NVAR
NN=4
KK=L2-N
CALL DECTER
INDEX2=LASTNO+KK
INDEX3=INDEX3+1
KOLSKR(INDEX3)=NCASE
L1=LVAR(KK)
IM=MVAR(L1)-1
IL=0
DO 530 JJ=1,7
MM=8-JJ
IF(KONTER(L1,MM))915,4655,466
4655 NOUT=7
NIN=MFREQ(L1,MM)
IF(NIN)530,530,4665
466 NOUT=KONTER(L1,MM)
NIN=MFREQ(L1,MM)-NOUT
IF(-NIN) 4665,530,530
4665 FLPTN1=MM
IL=IL+1
IF(IL-1)4666,4666,4667
4666 INDEX1=KK
GO TO 4677
4667 I=INDTEM+74+IL
4668 INDEX1=(KOLSKR(I)-1)*NVAR+KK
467 INDEX1=INDEX1+NVAR
4677 IF(INDEX1-INDEX2)468,530,530
468 IF(FLPTN1-A(INDEX1))469,4681,469
4681 NIN=NIN-1
IF(NIN)4682,4682,467
4682 GO TO (4671,4684,4685,4686,4687,4688),IM
4684 GO TO (4674,4671,530),IL
4685 GO TO (4675,4673,4671,530),IL
4686 GO TO (4676,4674,4672,4671,530),IL
4687 GO TO (4676,4675,4673,4672,4671,530),IL
4688 GO TO (4676,4675,4674,4673,4672,4671,530),IL
4671 FLPTN1=1.0
GO TO 4678
4672 FLPTN1=2.0
GO TO 4678
4673 FLPTN1=3.0
GO TO 4678
4674 FLPTN1=4.0
GO TO 4678
4675 FLPTN1=5.0
GO TO 4678
4676 FLPTN1=6.0
4678 II=FLPTN1
NIN=MFREQ(L1,II)-KONTER(L1,II)
GO TO 467
469 IF(-A(INDEX1))4692,467,467
4692 IK=A(INDEX1)
GO TO (200,250,300,350,600,700),IM
200 MOVETO=KOLSKR(INDTEM+76)+1
210 IF(MOVETO)900,900,473
250 GO TO (252,467,467,254,467,467,200),IK
252 MOVETO=KOLSKR(INDTEM+77)+1
GO TO 210
254 IF(MM-1)252,252,200
300 GO TO (301,467,301,467,252,467,200),IK
301 MOVETO=KOLSKR(INDTEM+78)+1
GO TO 210
350 GO TO (351,351,467,301,467,252,200),IK
351 MOVETO=KOLSKR(INDTEM+79)+1
GO TO 210
600 GO TO (601,601,351,467,301,252,200),IK
601 MOVETO=KOLSKR(INDTEM+80)+1
GO TO 210
700 GO TO (701,701,601,351,301,252,200),IK
701 MOVETO=KOLSKR(INDTEM+81)+1
GO TO 210
C
473 MOVFRM=(INDEX1-KK)/NVAR+1
IF(MOVFRM-NCASE)4735,4735,900
4735 IF(MOVETO-NCASE)4737,4737,467
4737 IF(-MOVFRM)4738,900,900
4738 CALL MOVFOR(MOVFRM,MOVETO,K)
474 J=KIND
DO 478 II=1,NVAR
I=LVAR(II)
DO 477 L=1,7
475 J=J+1
KOLSKR(J)=KONTER(I,L)
477 CONTINUE
478 CONTINUE
C
C DETERMINE NEW ERROR
480 NN=3
CALL DECTER
NERROR=0
DO 485 II=1,NVAR
I=LVAR(II)
DO 484 J=1,7
NERROR=NERROR+KONTER(I,J)
484 CONTINUE
485 CONTINUE
IF(MAXERR-NERROR)486,486,495
486 J=KIND
DO 490 II=1,NVAR
I=LVAR(II)
DO 488 L=1,7
J=J+1
KONTER(I,L)=KOLSKR(J)
488 CONTINUE
490 CONTINUE
CALL MOVFOR(MOVETO,MOVFRM,K)
GO TO 496
C
495 MAXERR=NERROR
496 IF(MINERR-MAXERR)497,555,555
497 CONTINUE
C
4975 NN=4
KK=L2-N
CALL DECTER
INDEX3=INDEX3+1
KOLSKR(INDEX3)=NCASE
GO TO 467
C
C 0
C 0
530 CONTINUE
550 CONTINUE
555 RETURN
C
900 KOMPER=1
WRITE (6,4900)MOVFRM,MOVETO
GO TO 555
C
915 KOMPER=1
WRITE (6,4915)L1,MM
GO TO 530
C
4900 FORMAT(1H0,104HIN MOVING AN INDIVIDUAL AND HIS RESPONSES IN SUB RK
1CHNG, THE RANK MOVED FROM OR TO IS IN ERROR. THEY ARE,I5,4H ANDI5)
4915 FORMAT(1H ,52X,13HMACHINE ERROR/19X,27HNEGATIVE ERROR FOR QUESTION
1,I3,6H SCORE,I2,25H WAS FOUND IN SUB RKCHNG.)
C
END
CDECTER SUBROUTINE DECTER FOR GUTTMAN SCALES JUNE 15, 1967
SUBROUTINE DECTER
C
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
X(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),KONTER(2
X5,7),DUMMY3(5),DUMMY4(7),DUMMY5(11),DUMMY2(27)
C
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
XAR,INDRNK,INDKOL,ISCALE,IRAMK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
XDTEM,DUMMY3,N1,N2,I,DUMMY4,KK,DUMMY5,INDEX3
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(ERROR,KONTER),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),
2(DUMMY2(27),NVAR)
C
DOUBLE PRECISION DUMMY2, FRSTMO, SECMON, JOBNMB, KDUMY6, REF, KCHECK
KTIMES=I
INDEX3=INDTEM+75
10 DO 200 I=1,NVAR
GO TO (12,11,12,11),KK
11 IF(KTIMES-I)210,12,200
12 INCHCK=LASTNO+I
M=LVAR(I)
DO 14 J=1,7
KONTER(M,J)=0
14 CONTINUE
MTIMES=MVAR(M)
J=7
INDEX=I
INDEX1=I
LTIMES=1
15 NERROR=MFREQ(M,J)
L1=0
K=0
LL=0
IJJ=NERROR
FLPTN1=J
KERROR=0
ITIMES=1
JTIMES=1
20 IF(A(INDEX))25,41,25
25 IF(A(INDEX)-FLPTN1)30,45,30
30 IF(NERROR-MFREQ(M,J))35,42,42
35 GO TO (36,39,48),ITIMES
36 INDEX=INDEX-NVAR
IF(-INDEX)37,38,38
37 IF(A(INDEX))375,375,38
375 K=K-1
LL=LL-1
GO TO 36
38 INDEX=INDEX+NVAR
385 IJJ=NERROR
L1=L1+K
K=0
LL=LL+KERROR
KERROR=0
ITIMES=2
JTIMES=1
GO TO 4935
39 KERROR=KERROR+1
IF(KERROR-IJJ)46,46,499
40 INDEX=INDEX+NVAR
IF(INDEX-INCHCK)20,55,55
41 K=K+1
42 LL=LL+1
GO TO 40
45 NERROR=NERROR-1
GO TO (46,47,475),ITIMES
46 IF(NERROR)52,52,40
47 ITIMES=3
475 IF(NERROR)477,477,40
477 IF(IJJ-KERROR)499,385,385
48 IF((IJJ-NERROR)-KERROR)49,36,36
49 GO TO (492,494,499),JTIMES
492 JTIMES=2
493 ITIMES=2
4935 IF(NERROR)499,499,39
494 JTIMES=3
GO TO 493
499 INDEX=(MFREQ(M,J)-IJJ+LL-K)*NVAR+INDEX1
50 INDEX1=INDEX
500 GO TO (5005,5005,555,555),KK
5005 KONTER(M,J)=IJJ+LL-L1-K
501 GO TO (509,509,502,502),KK
502 INDEX3=INDEX3+1
KOLSKR(INDEX3)=(INDEX-I)/NVAR
509 IF(INDEX-INCHCK)51,190,190
51 GO TO (1995, 59 ,57,65,70,75,80),MTIMES
52 IJJ=0
INDEX=INDEX+NVAR
GO TO 50
55 IF((IJJ-NERROR)-KERROR)499,56,56
555 KONTER(M,J)=IJJ
GO TO 501
56 IJJ=NERROR
LL=LL+KERROR
GO TO 500
57 GO TO (58,59),LTIMES
58 LTIMES=2
585 J=4
GO TO 15
59 K=0
LL=0
INDEX=INDEX-NVAR
60 INDEX=INDEX+NVAR
IF(INDEX-INCHCK)61,63,1995
61 IF(A(INDEX)-1.0)60,62,625
62 K=K+1
GO TO 60
625 LL=LL+1
GO TO 60
63 GO TO (635,635,64,64),KK
635 KONTER(M,1)=MFREQ(M,1)-K+LL
GO TO 1995
64 LL=0
GO TO 635
65 GO TO (67,68,59),LTIMES
67 LTIMES=2
675 J=5
GO TO 15
68 LTIMES=3
685 J=3
GO TO 15
70 GO TO (72,73,74,59),LTIMES
72 LTIMES=2
725 J=6
GO TO 15
73 LTIMES=3
GO TO 585
74 LTIMES=4
745 J=2
GO TO 15
75 GO TO (72,76,77,78,59),LTIMES
76 LTIMES=3
GO TO 675
77 LTIMES=4
GO TO 685
78 LTIMES=5
GO TO 745
80 GO TO (72,76,81,82,83,59),LTIMES
81 LTIMES=4
GO TO 585
82 LTIMES=5
GO TO 685
83 LTIMES=6
GO TO 745
190 GO TO (1995,193 ,191,194,198,1904,1908),MTIMES
191 GO TO (192,193),LTIMES
192 KONTER(M,4)=MFREQ(M,4)
193 KONTER(M,1)=MFREQ(M,1)
GO TO 1995
194 GO TO (195,196,193),LTIMES
195 KONTER(M,5)=MFREQ(M,5)
196 KONTER(M,3)=MFREQ(M,3)
GO TO 193
198 GO TO (199,1901,1902,193),LTIMES
199 KONTER(M,6)=MFREQ(M,6)
1901 KONTER(M,4)=MFREQ(M,4)
1902 KONTER(M,2)=MFREQ(M,2)
GO TO 193
1904 GO TO (1905,1906,1907,1902,193),LTIMES
1905 KONTER(M,6)=MFREQ(M,6)
1906 KONTER(M,5)=MFREQ(M,5)
1907 KONTER(M,3)=MFREQ(M,3)
GO TO 1902
1908 GO TO (1909,1910,1911,1907,1902,193),LTIMES
1909 KONTER(M,6)=MFREQ(M,6)
1910 KONTER(M,5)=MFREQ(M,5)
1911 KONTER(M,4)=MFREQ(M,4)
GO TO 1907
1995 GO TO (200,210,200,210),KK
200 CONTINUE
210 RETURN
END
CMOVE SUBROUTINE MOVE FOR GUTTMAN SCALES PROGRAMS
CMOVE SUBROUTINE MOVE FOR GUTTMAN SCALES APRIL 15, 1967
SUBROUTINE MOVE(M1,M2)
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
X(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
X7),KONTER(25,7),DUMMY3(5),DUMMY4(7),DUMMY5(11)
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
X,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
X),(ERROR,KONTER)
C
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
XAR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
XDTEM,DUMMY3,N1,N2,I,DUMMY4,KK,DUMMY5
DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
C
25000 YHETA=0.0
IF(M1-M2)5,100,5
C EXCHANGE RESPONSES FOR RANKS M1 AND M2
5 INDEX1=(M1-1)*NVAR
INDEX2=((M2-1)*NVAR)+1
INDEX3=INDEX2+NVAR-1
DO 50 I=INDEX2,INDEX3
INDEX1=INDEX1+1
GSABE=A(INDEX1)
A(INDEX1)=A(I)
A(I)=GSABE
50 CONTINUE
C EXCHANGE IDENTIFICATION NUMBERS
INDEX1=M1+LASTNO
INDEX2=M2+LASTNO
KSAVE=INDIVD(INDEX1)
INDIVD(INDEX1)=INDIVD(INDEX2)
INDIVD(INDEX2)=KSAVE
C EXCHANGE RANK SUMS
75 INDEX1=M1+INDRNK
INDEX2=M2+INDRNK
FSAVE=RANKSM(INDEX1)
RANKSM(INDEX1)=RANKSM(INDEX2)
RANKSM(INDEX2)=FSAVE
100 RETURN
END
CMVDATA SUBROUTINE MVDATA FOR GUTTMAN SCALES JUNE 15, 1967
CMVDATA SUBROUTINE MVDATA FOR GUTTMAN SCALES PROGRAMS
SUBROUTINE MVDATA(M1,M2)
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),KONTER(2
35,7),DUMMY3(5),DUMMY4(7),DUMMY5(9)
DIMENSION DUMMY2(27)
C
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
3DTEM,DUMMY3,N1,N2,I,DUMMY4,KK,DUMMY5
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
1,(DUMMY1,MFREQ),(ERROR,KONTER)
EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
DOUBLE PRECISION DUMMY2
DOUBLE PRECISION JB,JOBNMB,JBND,REF,REFLEK,SECMON,FRSTMO,BLANKS,
1BND
25000 THETA=0.0
IF(M1-M2)5,100,5
C EXCHANGE RESPONSES FOR RANKS M1 AND M2
5 INDEX1=(M1-1)*NVAR
INDEX2=((M2-1)*NVAR)+1
INDEX3=INDEX2+NVAR-1
DO 50 I=INDEX2,INDEX3
INDEX1=INDEX1+1
GSAVE=A(INDEX1)
A(INDEX1)=A(I)
A(I)=GSAVE
50 CONTINUE
C EXCHANGE IDENTIFICATION NUMBERS
INDEX1=M1+LASTNO
INDEX2=M2+LASTNO
KSAVE=INDIVD(INDEX1)
INDIVD(INDEX1)=INDIVD(INDEX2)
INDIVD(INDEX2)=KSAVE
100 RETURN
END
CMOVFOR SUBROUTINE MOVFOR FOR GUTTMAN SCALE PROGRAMS
SUBROUTINE MOVFOR(M1,M2,KK)
DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
X(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
X7),KONTER(25,7),DUMMY3(5),DUMMY4(7),DUMMY5(9)
C
EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
X,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
X),(ERROR,KONTER)
C
COMMON JOBNMB
COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
XAR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
XDTEM,DUMMY3,N1,N2,I,DUMMY4,KKP,DUMMY5
DOUBLE PRECISION JOB,JOBNMB,JBND,REF
DOUBLE PRECISION SECMON,FRSTMO
DOUBLE PRECISION DUMMY2
DOUBLE PRECISION REFLEK
DOUBLE PRECISION BLANKS,BND
C
25000 THETA=0.0
KK=KK
INDEX1=M2*NVAR
INDEXK=INDEX1-NVAR
INDEX2=M1*NVAR
M=INDEX2-NVAR+1
INDEX3=M-1
DO 25 I=1,NVAR
INDEX3=INDEX3+1
HOLD(I)=A(INDEX3)
25 CONTINUE
JRNK=M1+INDRNK
HOLD(NVAR+1)=RANKSM(JRNK)
INDIDV=M1+LASTNO
IJJ=INDIVD(INDIDV)
IF(M2-M1)50,500,300
50 NADD=-NVAR
NONE=-1
55 L=M
J=M-1+NADD
DO 60 I=L,INDEX2
J=J+1
A(I)=A(J)
60 CONTINUE
M=L+NADD
IND=INDIDV+NONE
INDIVD(INDIDV)=INDIVD(IND)
INDIDV=IND
GO TO (65,70),KK
65 IRNK=JRNK+NONE
RANKSM(JRNK)=RANKSM(IRNK)
JRNK=IRNK
70 INDEX2=INDEX2+NADD
IF(INDEX2-INDEX1)55,100,55
100 DO 125 I=1,NVAR
INDEXK=INDEXK+1
A(INDEXK)=HOLD(I)
125 CONTINUE
INDIVD(INDIDV)=IJJ
GO TO (140,500),KK
140 RANKSM(JRNK)=HOLD(NVAR+1)
500 RETURN
300 NADD=NVAR
NONE=1
GO TO 55
END
SUBROUTINE REMOVE(N)
REWIND N
RETURN
END