Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0137/bmd/bmd07s.for
There is 1 other file named bmd07s.for in the archive. Click here to see a list.
00100	CBD07S        GUTTMAN SCALES NO. 2 - PART 2        OCTOBER 22, 1965
00200	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
00300	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
00400	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
00500	     37),KONTER(25,7),DUMMY3(1),KSTEP(6), KDUMY6(2),REF(25),NN1(6),NN2(6
00600	     4),NN3(6)
00700	      COMMON JOBNMB
00800	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
00900	     1AR,INDRNK,INDKOL,ISCALE,LESTN,LEAVE,IERROR,KANEND,KOMPER,KORDER,IN
01000	     2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,DUMMY3,LASTRD,NDREDK,L,
01100	     3IFINAL,ILAST,IFIRST,IXTRA,KK,ICHNGE,NFIRST,L1,IEND,MCOMB,IPUNCH,NP
01200	     4ER,KDUMY6,INDEX3
01300	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
01400	      DOUBLE PRECISION DUM,QCTR
01500	C
01600	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
01700	     1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
01800	     2),(ERROR,KONTER),(YES,IYES)
01900	C
02000	      DATA QCTR/8H*       /
02100	      DATA DUM/8HFORCOM  /
02200	      DATA IYES/4HYES /
02300	      IT1=1
02400		CALL USAGEB('BMD07S')
02500	C
02600	C     BMD07S  USES THE FOLLOWING SUBROUTINES FOUND IN BMD04S,
02700	C        COMBIN         DECTER         FNDCMB         FRSTCM
02800	C        MOVE           MOVFOR         ORDER          ORQUES
02900	C                       REORDR
03000	C
03100	C     THIS PROGRAM REQUIRES THE TAPE UNIT DESIGNATED IT4 IN BMD06S.
03200	C     IT4 IS THE SAVE TAPE WITH ALL OF COMMON STORAGE WRITTEN ON IT.
03300	C
03400	C     IT1 IS THE TAPE WHICH CONTAINS THE ORIGINAL WEIGHTED RESPONSES.
03500	C
03600	      LOPE=0
03700	      IT4=4
03800	C
03900	 4515 FORMAT('1BMD07S - GUTTMAN SCALE NUMBER 2, PART 2 - REVISED ',
04000	     1'SEPTEMBER 23, 1968'/
04100	     23X,40HHEALTH SCIENCES COMPUTING FACILITY, UCLA)
04200	C
04300	      REWIND IT4
04400	      READ(IT4) J
04500	      READ(IT4) (REF(I),I=1,25)
04600		NPOINT=(J+127)/128
04700		IF (NPOINT.LE.1) GO TO 9991
04800		DO 9001 I=1,NPOINT-1
04900		NI=(I-1)*128+1
05000		NII=I*128
05100	9001	READ(IT4)(A(K),K=NI,NII)
05200	9991	NI=(NPOINT-1)*128+1
05300		READ(IT4)(A(K),K=NI,J)
05400		DO 9992 I=1,4
05500		NI=(I-1)*128+1
05600		NII=I*128
05700	9992	READ(IT4)(LVAR(K),K=NI,NII)
05800		READ(IT4)(LVAR(K),K=513,558),INDEX3
05900	      READ(IT4) JOBNMB,(DUMMY2(I),I=1,27),FRSTMO,SECMON,(KDUMY6(J)
06000	     1,J=1,2)
06100	      REWIND IT4
06200	C
06300	C
06400	      KDUMY6(1)=DUM
06500	C     DUMMY3(17) HAS THE SAME LOCATION AS KDUMY6(1). THUS WE CAN USE IT
06600	C     FOR THE FIXED POINT SUBTRACTION PRIOR TO FORTRAN STATEMENT NUMBER
06700	C     2029.
06800	C
06900	      FKEEP=0.0
07000	      IELIM=2
07100	      KTIMES=0
07200	      LAST=1
07300	      KONE=1
07400	      ASSIGN 445 TO INCKTM
07500	      ASSIGN 3876 TO KOFPR
07600	      ASSIGN 451 TO JTIMES
07700	      ASSIGN 2006 TO LTIMES
07800	      FLPTN2=LASTNO
07900	      FLPTN3=NCASE
08000	      KTEST=NVAR*5
08100	      LL=1
08200	      KSTEP(1)=3
08300	      WRITE (6,4515)
08400	 2019 NCARDS=(MCOMB+5)/6
08500	      MCARDS=NCARDS
08600	      IF(NCARDS)2018,2018,2021
08700	 2018 KTIMES=1
08800	      GO TO 2011
08900	C
09000	 2020 IF(NCARDS)2001,2001,2021
09100	 2021 NCARDS=NCARDS-1
09200	      READ (5,1000)KCHECK,(KSTEP(I),NN1(I),NN2(I),NN3(I),I=1,6)
09300	      IF(KCHECK.NE.KDUMY6(1)) GO TO 940
09400	 2029 ILL=1
09500	2022	LL=ILL
09600	20222      IF(KSTEP(LL))2030,2030,2122
09700	 2122 IF((KSTEP(LL)-KONE)-KTIMES)920,2023,2001
09800	 2023 DO 2025 I=1,NVAR
09900	      IF(NN1(LL)-LVAR(I))2025,2024,2025
10000	 2025 CONTINUE
10100	      GO TO 19
10200	 2024 M=LVAR(I)
10300	      IF(MCOMB)2127,2127,2128
10400	 2127 LL=6
10500	      GO TO 2124
10600	 2128 MCOMB=MCOMB-1
10700	      N1(M)=NN2(LL)
10800	      N2(M) =NN3(LL)
10900	      CALL CHECK(M)
11000	      NCOMB(M)=NCOMB(M)+1
11100	      CALL COMBIN(I,N1,N2(1))
11200	      IF(KOMPER)998,2124,998
11300	 2124 ITIMES=6
11400	      IF(LL-6)2125,2120,2120
11500	 2125 IF(KSTEP(LL+1)-1)2126,2026,2123
11600	 2120 IF(1-KSTEP(LL))2123,2126,2126
11700	 2123 CALL DECTER
11800	 2126 GO TO INCKTM,(445,450)
11900	C
12000	 2026 IF(M-NN1(LL+1))2030,2126,2030
12100	C
12200	   19 N=NVAR+1
12300	      DO 20 I=N,25
12400	      IF(NN1(LL)-LVAR(I))20,25,20
12500	   20 CONTINUE
12600	      GO TO 930
12700	   25 N=MCARDS-NCARDS
12800	      WRITE (6,4019)NN1(LL),N
12900	      MCOMB=MCOMB-1
13000	      GO TO 2124
13100	C
13200	 2027 IF(KTIMES-1)2028,2028,2030
13300	 2028 KTIMES=0
13400	2030	LL=LL+1
13500		IF(LL.LE.6)GO TO 20222
13600	      GO TO 2020
13700	C
13800	 2001 IF(MCOMB)2011,2011,2012
13900	 2011 ASSIGN 2031 TO KONTIN
14000	      LL=1
14100	      KSTEP(1)=KTEST
14200	      IF(IEND.EQ.IYES) GO TO 2014
14300	 2013 LAST=2
14400	      GO TO 2014
14500	C
14600	 2012 ASSIGN 202 TO KONTIN
14700	 2014 ILL=LL
14800	      GO TO LTIMES,(2006,2010,4655,4915,5207)
14900	C
15000	C     COMBINE THOSE RESPONSES WHICH HAVE LESS THAN NPER PERCENT
15100	C     OF THE TOTAL NUMBER OF RESPONDENTS, IF DESIRED.
15200	C
15300	 2006 CONTINUE
15400	 2135 ITIMES=5
15500	      KTIMES=1
15600	      ASSIGN 2010 TO LTIMES
15700	      IF(NFIRST.NE.IYES) GO TO 2003
15800	 2002 CALL FRSTCM(NPER)
15900	      IF(L-INDKOL)2003,2003,2005
16000	 2003 ITIMES=1
16100	      IF(KOMPER)998,2009,998
16200	 2009 IF((KSTEP(LL)-1)-KTIMES)920,2022,2010
16300	C
16400	 2005 ASSIGN 449  TO JTIMES
16500	      GO TO 450
16600	C
16700	 2010 CONTINUE
16800	 7005 ITIMES=1
16900	C
17000	C     RANK RESPONDENTS USING CORNELL TECHNIQUE
17100	C
17200	 201  INDEX2=0
17300	      GO TO KONTIN,(202,2022,2031)
17400	 202  ASSIGN 2022 TO KONTIN
17500	 2031 K=INDRNK+1
17600	      DO 204 JRNK=K,INDKOL
17700	      RANKSM(JRNK)=0.0
17800	      INDEX1=INDEX2+1
17900	      INDEX2=INDEX2+NVAR
18000	      DO 203 I=INDEX1,INDEX2
18100	      RANKSM(JRNK)=RANKSM(JRNK)+A(I)
18200	 203  CONTINUE
18300	 204  CONTINUE
18400	C
18500	C     ORDER ACCORDING TO HIGHEST RANK SCORE
18600	C
18700	 240  CALL ORDER
18800	C
18900	C     ORDER QUESTIONS IN INCREASING FREQUENCY OF SCORE 7
19000	C
19100	      CALL ORQUES(0)
19200	C
19300	C     REORDER THOSE INDIVIDUALS WITH THE SAME TOTAL SCORE
19400	C
19500	 275  CALL REORDR
19600	 7009 IF (KOMPER)998,3305,998
19700	C
19800	 3305 GO TO      (334,465,555),LAST
19900	C
20000	C     DETERMINE CUTTING POINTS AND ERRORS FOR EACH QUESTION
20100	C
20200	 334  KK=1
20300	 336  CALL DECTER
20400	 380  IF(IFINAL.NE.IYES) GO TO 384
20500	 325  MINPR=1
20600	      MAXPR=0
20700	      INDEX2=0
20800	      NDIFF=NCASE
20900	 5010 IF(NDIFF-50)5020,5020,5030
21000	 5020 MAXPR=NCASE
21100	      NDIFF=0
21200	      GO TO 5040
21300	C
21400	 5030 MAXPR=MAXPR+50
21500	      NDIFF=NDIFF-50
21600	 5040 NUMPGE=NUMPGE+1
21700	      WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
21800	 326  WRITE (6,4002)
21900	      WRITE (6,4008)
22000	 2662 WRITE (6,4504)NCASE,NVAR
22100	      WRITE (6,4506)KTIMES
22200	      WRITE (6,4505)
22300	      DO 2663 I=1,NVAR
22400	      M=LVAR(I)
22500	      HOLD(I)=REF(M)
22600	 2663 CONTINUE
22700	      WRITE (6,4508)(LVAR(J),HOLD(J),J=1,NVAR)
22800	 327  WRITE (6,4500)
22900	      DO 267 I=MINPR,MAXPR
23000	      INDEX1=INDEX2+1
23100	      INDEX2=INDEX2+NVAR
23200	      JRNK=I+INDRNK
23300	      INDIDV=I+LASTNO
23400	 2665 WRITE (6,4003)I,INDIVD(INDIDV),RANKSM(JRNK),(A(J),J=INDEX1,INDEX2)
23500	 267  CONTINUE
23600	      GO TO (268,5050),IELIM
23700	 268  WRITE (6,4030)
23800	 5050 MINPR=MINPR+50
23900	      IF(NDIFF) 384, 384,5010
24000	C
24100	C     PRINT OUT ERRORS, IF DESIRED
24200	C
24300	 384  FLPTN1=MAXERR
24400	      COFREP=1.0-(FLPTN1/FLPTN2)
24500	      KSUM=0
24600	      DO 3874 M=1,NVAR
24700	      I=LVAR(M)
24800	      KEST=0
24900	      DO 3873 J=1,7
25000	      IF(KEST-MFREQ(I,J))3871,3873,3873
25100	 3871 KEST=MFREQ(I,J)
25200	 3873 CONTINUE
25300	      KSUM=KSUM+KEST
25400	 3874 CONTINUE
25500	      SUM=KSUM
25600	      FMINMR=SUM/FLPTN2
25700	      IF(IERROR.NE.IYES) GO TO 390
25800	 385  NUMPGE=NUMPGE+1
25900	 386  WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
26000	      WRITE (6,4004)
26100	      WRITE (6,4504)NCASE,NVAR
26200	      WRITE (6,4506)KTIMES
26300	      WRITE (6,4500)
26400	      WRITE (6,4505)
26500	      DO 3861 I=1,NVAR
26600	      M=LVAR(I)
26700	      HOLD(I)=REF(M)
26800	 3861 CONTINUE
26900	      WRITE (6,4509)(LVAR(J),HOLD(J),J=1,NVAR)
27000	      ASSIGN 388 TO MTIMES
27100	 3862 WRITE (6,4500)
27200	      DO 387 I=1,7
27300	      DO 3865 J=1,NVAR
27400	      M=LVAR(J)
27500	      KOLHLD(J)=KONTER(M,I)
27600	 3865 CONTINUE
27700	      WRITE (6,4005)I,(KOLHLD(J),J=1,NVAR)
27800	 387  CONTINUE
27900	      K=0
28000	      DO 3877 I=1,NVAR
28100	      M=LVAR(I)
28200	      KOLHLD(I)=0
28300	      DO 3875 J=1,7
28400	      KOLHLD(I)=KOLHLD(I)+KONTER(M,J)
28500	 3875 CONTINUE
28600	      K=K+KOLHLD(I)
28700	 3877 CONTINUE
28800	      J=FLPTN2
28900	      WRITE (6,4024)(KOLHLD(I),I=1,NVAR)
29000	      WRITE (6,4025)K,J
29100	      GO TO KOFPR,(3876,3878)
29200	 3878 WRITE (6,4501)
29300	      WRITE (6,4018)COFREP
29400	      WRITE (6,4021)FMINMR
29500	      IF(COFREP-FKEEP)3872,3870,3870
29600	 3872 WRITE (6,4013)
29700	 3870 FKEEP=COFREP
29800	 3876 GO TO (3880,3879),IELIM
29900	 3880 WRITE (6,4030)
30000	 3879 GO TO MTIMES,(388,475)
30100	 388  WRITE (6,4502)
30200	      WRITE (6,4006)
30300	      WRITE (6,4500)
30400	      I=0
30500	      DO 389 JJ=1,NVAR
30600	      K=26
30700	      DO 3895 L=1,NVAR
30800	      M=LVAR(L)
30900	      IF(M-K)3891,3895,3895
31000	 3891 IF(I-M)3893,3895,3895
31100	 3893 K=M
31200	 3895 CONTINUE
31300	      I=K
31400	      WRITE (6,4007)I,REF(I),(MFREQ(I,J),J=1,8)
31500	 389  CONTINUE
31600	C
31700	C     DETERMINE COMBINATIONS OF RESPONSES IN EACH QUESTION
31800	C
31900	 390  GO TO (395,520,462,495,612,580),ITIMES
32000	 395  KK=2
32100	      CALL FNDCMB(FLPTN2)
32200	      IF(KOMPER)998,425,998
32300	 425  IF(L1)445,462,445
32400	 445  KTIMES=KTIMES+1
32500	 450  NUMPGE=NUMPGE+1
32600	      WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
32700	      WRITE (6,4009)
32800	      GO TO JTIMES,(449 ,451)
32900	 449  WRITE (6,4014)NPER
33000	      ASSIGN 451 TO JTIMES
33100	 451  WRITE (6,4504)NCASE,NVAR
33200	      WRITE (6,4506)KTIMES
33300	 452  WRITE (6,4510)
33400	      J=0
33500	      DO 457 JJ=1,NVAR
33600	      K=26
33700	      DO 4526 L=1,NVAR
33800	      M=LVAR(L)
33900	      IF(M-K)4522,4526,4526
34000	 4522 IF(J-M)4524,4526,4526
34100	 4524 K=M
34200	 4526 CONTINUE
34300	      J=K
34400	      IF(NCOMB(J))456,457,456
34500	456   WRITE(6,4010) J,REF(J),NCOMB(J),N1(J),N2(J),KVAR(J),MVAR(J)
34600	 4569 N1(J)=0
34700	      N2(J)=0
34800	 457  CONTINUE
34900	      GO TO(4573,4577),IELIM
35000	 4573 WRITE (6,4030)
35100	4577  CONTINUE
35200	 458  GO TO (459,674,675,551,2002,2027),ITIMES
35300	 459  IF(KTIMES-KTEST)201,990,990
35400	C
35500	C     DETERMINE ERROR FOR FINAL COMPUTATIONS
35600	C
35700	 462  IF(LEAVE.NE.IYES) GO TO 465
35800	 463  LAST=2
35900	 465  KK=3
36000	      KTIMES=KTIMES+1
36100	      IF((-MCOMB))4653,4654,4654
36200	 4653 KONE=0
36300	      ASSIGN 4655 TO LTIMES
36400	      ASSIGN 450 TO INCKTM
36500	      GO TO 2022
36600	C
36700	 4654 CALL DECTER
36800	 4655 NUMPGE=NUMPGE+1
36900	      WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
37000	      WRITE (6,4012)
37100	      WRITE (6,4504)NCASE,NVAR
37200	      WRITE (6,4506)KTIMES
37300	      WRITE (6,4505)
37400	      DO 466 I=1,NVAR
37500	      M=LVAR(I)
37600	      HOLD(I)=REF(M)
37700	 466  CONTINUE
37800	      WRITE (6,4509)(LVAR(J),HOLD(J),J=1,NVAR)
37900	      ASSIGN 475 TO MTIMES
38000	      GO TO 3862
38100	C
38200	C     CHECK TO SEE IF CHANGING RANK OF INDIVIDUALS REDUCES ERROR
38300	C
38400	 475  MAXERR=0
38500	      DO 480 I=1,NVAR
38600	      MAXERR=MAXERR+KOLHLD(I)
38700	 480  CONTINUE
38800	  485 CALL ORQUES(1)
38900	      CALL RKCHNG(MAXERR)
39000	      KK=3
39100	      IF(KOMPER)998,490,998
39200	 490  KTIMES=KTIMES+1
39300	      IF((-MCOMB))491,492,492
39400	 491  ASSIGN 4915 TO LTIMES
39500	      GO TO 2022
39600	C
39700	 4915 MAXERR =0
39800	      DO 494 M=1,NVAR
39900	      I=LVAR(M)
40000	      DO 493  J=1,7
40100	      MAXERR=MAXERR+KONTER(I,J)
40200	 493  CONTINUE
40300	 494  CONTINUE
40400	 492  ITIMES=4
40500	      ASSIGN 3878 TO KOFPR
40600	      GO TO 380
40700	C
40800	C     CHECK TO SEE IF FURTHER POSSIBLE COMBINATIONS MAY REDUCE THE ERROR
40900	C     TO GIVE A GOOD COEFFICIENT OF REPRODUCIBILITY.
41000	C
41100	 495  GO TO (496,    580),LAST
41200	 496  FLPTN1=MAXERR
41300	      REPERR=FLPTN1/FLPTN2
41400	      IF(0.1-REPERR)497,500,500
41500	 497  KING=1
41600	      GO TO 520
41700	C
41800	 500  IF(NDREDK)499,499,498
41900	 499  KING=3
42000	      GO TO 520
42100	C
42200	 498  IF(NDREDK-20)512,512,499
42300	 512  IF(LASTRD-1)499,510,499
42400	 510  KING=2
42500	 520  IF((-MCOMB))5205,525,525
42600	 5205 KONE=1
42700	      ASSIGN 445 TO INCKTM
42800	      ASSIGN 5207 TO LTIMES
42900	      GO TO 2022
43000	C
43100	 5207 MAXERR =0
43200	      DO 5209 I=1,NVAR
43300	      DO 5208 J=1,7
43400	      MAXERR=MAXERR+KONTER(I,J)
43500	 5208 CONTINUE
43600	 5209 CONTINUE
43700	 5206 IF((-MCOMB))521,525,525
43800	 521  CALL ENDCMB(NDREDK,KING,MAXERR,LASTRD)
43900	      IF(KOMPER-50)522,5595,522
44000	 522  IF(KOMPER-25)998,550,998
44100	 550  KOMPER=0
44200	      ITIMES=4
44300	      GO TO 445
44400	C
44500	 525  IF(IEND.EQ.IYES) GO TO 521
44600	      GO TO 614
44700	C
44800	 551  LAST=3
44900	      ITIMES=2
45000	      GO TO 201
45100	C
45200	 555  KK=3
45300	      CALL DECTER
45400	 556  MAXERR=0
45500	      DO 559 M=1,NVAR
45600	      I=LVAR(M)
45700	      DO 558 J=1,7
45800	      MAXERR=MAXERR+KONTER(I,J)
45900	 558  CONTINUE
46000	 559  CONTINUE
46100	      CALL ORQUES(I)
46200	      KK=3
46300	      CALL RKCHNG(MAXERR)
46400	      KTIMES=KTIMES+1
46500	      ICHNGE=ICHNGE+1
46600	      IF(ICHNGE-20)5591,5591,5592
46700	 5591 IF(KOMPER)998,380,998
46800	C
46900	 5592 ICHNGE=20
47000	      GO TO 5591
47100	C
47200	 5595 KOMPER=0
47300	      IF(ICHNGE-5)5599,5599,5597
47400	 5599 ICHNGE=10
47500	 5596 ITIMES=6
47600	      GO TO 555
47700	C
47800	 5597 ICHNGE=20
47900	      GO TO 5596
48000	C
48100	 560  KOMPER=0
48200	      K=INDTEM+25
48300	      DO 565 I=1,NVAR
48400	      J=K+I
48500	      IF(KOLSKR(J))565,565,567
48600	 565  CONTINUE
48700	      GO TO 575
48800	C
48900	 567  FLPTN1=MAXERR
49000	      COFREP=1.0-(FLPTN1/FLPTN2)
49100	      NUMPGE=NUMPGE+1
49200	      KTIMES=KTIMES+1
49300	      WRITE (6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
49400	      WRITE (6,4016)
49500	      WRITE (6,4504)NCASE,NVAR
49600	      WRITE (6,4506)KTIMES
49700	      WRITE (6,4018)COFREP
49800	      WRITE (6,4021)FMINMR
49900	      WRITE (6,4511)
50000	      DO 570 I=1,NVAR
50100	      M=LVAR(I)
50200	      INDEX1=K+I
50300	      IF(KOLSKR(INDEX1))570,570,563
50400	 563  N=KOLSKR(INDEX1)
50500	      N2(M)=KOLSKR(INDEX1-25)/8
50600	      N1(M)=KOLSKR(INDEX1-25)-(N2(M)*8)
50700	      WRITE (6,4017)M,REF(M),N1(M),N2(M),N,RANKSM(INDEX1+25)
50800	 570  CONTINUE
50900	  575 GO TO(600,576,600,700),LAST
51000	  576 LAST=4
51100	      CALL ORQUES(LAST)
51200	      KK=3
51300	      CALL RKCHNG(MAXERR)
51400	      ITIMES=6
51500	      KTIMES=KTIMES+1
51600	      GO TO 380
51700	C
51800	 580  KK=4
51900	      CALL FNDCMB(FLPTN2)
52000	 581  IF(KOMPER)998,560,998
52100	C
52200	C     ELIMINATE SOME QUESTIONS,IF DESIRED.
52300	C
52400	 600  IF(LESTN)700,610,610
52500	 610  LESTN=NVAR-LESTN
52600	      ASSIGN 685 TO KIND
52700	      IF(LESTN)910,614,615
52800	 612  IF(LESTN)910,614,615
52900	 614  LAST=2
53000	      GO TO 580
53100	C
53200	  615 DO 620 M=1,NVAR
53300	      I=LVAR(M)
53400	      IF(MVAR(I)-2)620,620,625
53500	 620  CONTINUE
53600	      GO TO 650
53700	C
53800	 625  KK=4
53900	      CALL FNDCMB(FLPTN2)
54000	 6255 IF(KOMPER)998,626,998
54100	 626  KTEST=0
54200	      K=0
54300	      INDEX2=INDTEM+25
54400	      DO 635 I=1,NVAR
54500	      M=LVAR(I)
54600	      INDEX1=INDEX2+I
54700	      IF(KOLSKR(INDEX1))627,628,630
54800	 627  KOLSKR(INDEX1)=0
54900	 628  IF(MVAR(M)-2)629,629,630
55000	 629  IF(MFREQ(M,1))630,630,6295
55100	 6295 KOLSKR(INDEX1)=KONTER(M,7)+KONTER(M,1)
55200	 630  IF(KTEST-KOLSKR(INDEX1))631,635,635
55300	 631  KTEST=KOLSKR(INDEX1)
55400	      K=I
55500	 635  CONTINUE
55600	      IF((-K))6355,680,680
55700	 6355 L=LVAR(K)
55800	      IF(MVAR(L)-2)661,661,636
55900	 636  INDEX1=INDTEM+K
56000	      N2(L)=KOLSKR(INDEX1)/8
56100	      N1(L)=KOLSKR(INDEX1)-(N2(L)*8)
56200	      NCOMB(L)=NCOMB(L)+1
56300	      CALL COMBIN(K,N1,N2(1))
56400	      IF(KOMPER)998,637,998
56500	 637  ITIMES=3
56600	      GO TO 445
56700	C
56800	 650  KK=3
56900	      CALL DECTER
57000	 651  KTEST=0
57100	      L=0
57200	      DO 660 I=1,NVAR
57300	      KOLHLD(I)=0
57400	      M=LVAR(I)
57500	      KOLHLD(I)=KOLHLD(I)+KONTER(M,7)+KONTER(M,1)
57600	      IF(KTEST-KOLHLD(I))656,660,660
57700	 656  KTEST=KOLHLD(I)
57800	      K=I
57900	      L=M
58000	 660  CONTINUE
58100	      IF((-L))661,690,690
58200	 661  MFREQ(L,7)=0
58300	      MFREQ(L,1)=0
58400	      MFREQ(L,8)=0
58500	      NCOMB(L)=NCOMB(L)+1
58600	      N1(L)=1
58700	      N2(L)=7
58800	      MVAR(L)=1
58900	      REF(L)=QCTR
59000	      IELIM=1
59100	      ITIMES=2
59200	 665  INDEX1=LASTNO-NVAR+K
59300	      DO 670 I=K,INDEX1,NVAR
59400	      A(I)=0.0
59500	 670  CONTINUE
59600	      I=L
59700	      GO TO 445
59800	C
59900	  674 MVAR(I)=2
60000	      FLPTN2=FLPTN2-FLPTN3
60100	      LESTN=LESTN-1
60200	 675  ITIMES=5
60300	      LAST=3
60400	16755 CONTINUE
60500	      GO TO 201
60600	C
60700	 680  GO TO KIND,(685,690)
60800	 685  ASSIGN 690 TO KIND
60900	      NDREDK=0
61000	      GO TO 615
61100	C
61200	 690  WRITE (6,4031)
61300	      GO TO 614
61400	C
61500	 700  WRITE(IT4) MAXERR,COFREP,FMINMR
61600	      WRITE(IT4) (REF(I),I=1,25)
61700		DO 9003 K=1,4
61800		NK=(K-1)*128+1
61900		NKK=K*128
62000	9003	WRITE(IT4)(LVAR(KKK),KKK=NK,NKK)
62100		WRITE(IT4)(LVAR(KKK),KKK=513,558),INDEX3
62200	      WRITE(IT4) JOBNMB,(DUMMY2(I),I=1,27),FRSTMO,SECMON,(KDUMY6(J)
62300	     1,J=1,2)
62400	      MAXPR=0
62500	      DO 725 I=1,NCASE
62600	      MINPR=MAXPR+1
62700	      MAXPR=MAXPR+NVAR
62800		NPOINT=(MAXPR-MINPR+128)/128
62900		NWED=MINPR-1
63000		IF (NPOINT.LE.1) GO TO 7726
63100		DO 7727 J=1,NPOINT-1
63200		NJ=(J-1)*128+NWED+1
63300		NJJ=J*128+NWED
63400	7727	WRITE(IT4)(A(JJJ),JJJ=NJ,NJJ)
63500	7726	NJ=(NPOINT-1)*128+NWED+1
63600		WRITE(IT4)(A(JJJ),JJJ=NJ,MAXPR)
63700	 725  CONTINUE
63800	      DO 750 I=1,4
63900	      MINPR=MAXPR+1
64000	      MAXPR=MAXPR+NCASE
64100		NPOINT=(MAXPR-MINPR+128)/128
64200		NWED=MINPR-1
64300		IF (NPOINT.LE.1) GO TO 7732
64400		DO 7731 J=1,NPOINT-1
64500		NJ=(J-1)*128+NWED+1
64600		NJJ=J*128+NWED
64700	7731	WRITE(IT4)(A(JJJ),JJJ=NJ, NJJ)
64800	7732	NJ=(NPOINT-1)*128+NWED+1
64900		WRITE(IT4)(A(JJJ),JJJ=NJ,MAXPR)
65000	750	CONTINUE
65100	      END FILE IT4
65200	      REWIND IT4
65300	998   STOP
65400	C
65500	 910  WRITE (6,4910)
65600	      GO TO 998
65700	C
65800	 920  KTIMES=KTIMES+1
65900	      WRITE (6,4029)KSTEP(LL),KTIMES
66000	      GO TO 998
66100	C
66200	 930  NCARDS=MCARDS-NCARDS
66300	      WRITE (6,4028)NN1(LL),NCARDS
66400	      GO TO 998
66500	C
66600	 940  WRITE (6,4940)
66700	      GO TO 998
66800	C
66900	 990  NUMPGE=NUMPGE+1
67000	      WRITE (6,4011)NUMPGE
67100	      ITIMES=3
67200	      GO TO 201
67300	C
67400	C
67500	 8000 FORMAT(20A4)
67600	 1000 FORMAT(A6,6(I4,3I2))
67700	C
67800	 4002 FORMAT(1H ,41X,28HRESPONDENTS AND SCALE SCORES/37X,37HRANKED ACCOR
67900	     1DING TO CORNELL TECHNIQUE)
68000	 4003 FORMAT(1H ,I4,I5,2F5.0,24F4.0)
68100	 4004 FORMAT(1H ,40X,30HERRORS AND NUMBER OF RESPONSES/42X,27HTO THE VAR
68200	     1IOUS SCALE SCORES)
68300	 4005 FORMAT(1H ,5X,I3,6X,25I4)
68400	 4006 FORMAT(1H0,3X,8HVARIABLE,19X,55HFREQUENCY OF OCCURRENCE OF SCORES
68500	     11 TO 7 AND SCORE ZERO/7X,2HOR,44X,5HSCORE/4X,8HQUESTION,13X,1H1,9X
68600	     2,1H2,9X,1H3,9X,1H4,9X,1H5,9X,1H6,9X,1H7,4X,11HNO RESPONSE)
68700	 4007 FORMAT(1H ,5X,I3,A1,6X,8I10)
68800	 4008 FORMAT(1H ,26X,57HWITH QUESTIONS ORDERED IN INCREASING FREQUENCY O
68900	     1F SCORE 7)
69000	 4009 FORMAT(1H ,45X,25HCOMBINATIONS IN QUESTIONS)
69100	 4010 FORMAT(1H0,I10,A1,I16,I17,5H  AND,I3,I14,I8)
69200	 4011 FORMAT(1H1,105X,4HPAGE,I4//117HAFTER COMBINING AS MANY OF THE RESP
69300	     1PONSES IN EACH QUESTION AS POSSIBLE, SOME QUESTIONS STILL HAVE RAT
69400	     2IOS OF ERRORS TO/39HNON-ERRORS WHICH ARE GREATER THAN 0.50./6X,112
69500	     3HIT SEEMS UNLIKELY THAT THE RESULTING SCALE WHICH THE PROGRAM WILL
69600	     4 NOW COMPUTE IS GOOD. PLEASE CHECK THE PREVIOUS/114HPAGES OF OUTPU
69700	     5T AND EITHER ELIMINATE SOME QUESTIONS AND/OR RESPONDENTS OR DETERM
69800	     6INE THOSE RESPONSES WHICH YOU FEEL/74HSHOULD BE COMBINED AND USE T
69900	     7HE FORCED COMBINATION FEATURE OF THIS PROGRAM.)
70000	 4012 FORMAT(1H ,42X,27HERRORS FOR EACH SCALE SCORE/50X,11HFINAL STEPS)
70100	 4013 FORMAT(1H0,16X,84HTHE COEFFICIENT OF REPRODUCIBILITY DECREASED IN 
70200	     1THIS LAST STEP. IT IS SUGGESTED THAT//15X,86HYOU MAKE A DIFFERENT 
70300	     2COMBINATION USING THE FORCED COMBINATION FEATURE OF THIS PROGRAM.)
70400	 4014 FORMAT(32X29HTHE FIRST SCORE HAS LESS THANI3,23H PERCENT OF RESPON
70500	     1DENTS)
70600	 4016 FORMAT(1H ,34X,41HPOSSIBLE COMBINATIONS WHICH WILL INCREASE/25X,61
70700	     1HTHE COEFFICIENT OF REPRODUCIBILITY AND THE AMOUNT OF INCREASE)
70800	 4017 FORMAT(1H016XI3,A1,16XI3,5H  AND,I3,19X,I4,20X,F5.4)
70900	 4018 FORMAT(1H ,36X,33HCOEFFICIENT OF REPRODUCIBILITY = ,F7.5)
71000	 4019 FORMAT(1H0,12X,8HQUESTIONI3,61H NO LONGER INCLUDED IN STUDY. FORCE
71100	     1D COMBINATION READ ON CARDI3,17H WILL BE IGNORED.)
71200	 4021 FORMAT(1H0,34X,35HMINIMAL MARGINAL REPRODUCIBILITY = ,F7.5)
71300	 4024 FORMAT(1H0,14HQUESTION ERROR,25I4)
71400	 4025 FORMAT(1H0,36X,11HTOTAL ERROR I6,5X,15HTOTAL RESPONSES I6)
71500	 4028 FORMAT(1H0,24X,37HTHERE IS NO QUESTION CORRESPONDING TO,I4,26H WHI
71600	     1CH WAS READ IN ON CARD,I4)
71700	 4029 FORMAT(1H0,18X,31HTHE COMBINATION DESIRED AT STEP,I4,20H WAS READ
71800	     1IN AT STEP,I4,21H TOO LATE TO BE DONE.)
71900	 4030 FORMAT(1H0,45H* INDICATES THIS QUESTION HAS BEEN ELIMINATED)
72000	 4031 FORMAT(1H0,6X,103HNO MORE COMBINATIONS OR ELIMINATIONS WILL REDUCE
72100	     1 THE ERROR. HENCE, NO MORE QUESTIONS WILL BE ELIMINATED)
72200	 4500 FORMAT(1H )
72300	 4501 FORMAT(1H0)
72400	 4502 FORMAT(1H0//)
72500	 4503 FORMAT(1H1,15H PROBLEM NUMBER,2X,A6,57X,2A6,I3,1H,,I5,3X,4HPAGE,
72600	     1I4)
72700	 4504 FORMAT(1H ,18X,23HNUMBER OF RESPONDENTS =,I5,22X,21HNUMBER OF VARI
72800	     1ABLES =,I3)
72900	 4505 FORMAT(1H ,44X,22HVARIABLES OR QUESTIONS)
73000	 4506 FORMAT(1H ,54X,4HSTEP,I4)
73100	 4508 FORMAT(1H ,15HRANK RESP SCOR ,25(I3,A1))
73200	 4509 FORMAT(1H ,3X,8HSCORE OF,4X,25(I3,A1))
73300	 4510 FORMAT(1H0,5X,8HQUESTION,6X,15HTOTAL NUMBER OF,6X,15HSCORES COMBIN
73400	     1ED,6X,15HNUMBER OF PARTS/18X,19HCOMBINATIONS SO FAR,7X,9HTHIS TIME
73500	     2,9X,15HORIGINAL    NOW)
73600	 4511 FORMAT(1H0,64X,8HDECREASE,15X,11HAPPROXIMATE/15X,8HQUESTION,15X,11
73700	     1HCOMBINATION,15X, 10HIN  NUMBER,14X,11HINCREASE IN/64X,10HOF  ERRO
73800	     2RS,12X,15HREPRODUCIBILITY)
73900	 4910 FORMAT(1H0,21X,70HTHE MINIMUM QUESTIONS DESIRED IS GREATER THAN TH
74000	     1E NUMBER OF QUESTIONS./26X,62HNO QUESTIONS WILL BE ELIMINATED BUT 
74100	     2SAVE TAPE WILL BE WRITTEN.)
74200	 4940 FORMAT(1H1,32X,52HCONTROL CARDS OUT OF ORDER. PROGRAM CANNOT CONTI
74300	     1NUE.)
74400	C
74500	      END
74600	CCHECK   SUBROUTINE CHECK FOR BMD07S             DECEMBER 13, 1963
74700	      SUBROUTINE CHECK(M)
74800	C
74900	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
75000	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
75100	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
75200	     37),KONTER(25,7),DUMMY3(8)
75300	      COMMON JOBNMB
75400	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
75500	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
75600	     2DTEM,IDAY,IYEAR,NUMPGE,JOYCEA,MAXLOC,N1,N2,DUMMY3,KK,ICHNGE
75700	C
75800	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
75900	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
76000	     1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
76100	     2),(ERROR,KONTER)
76200	C
76300	25000 THETA=0.0
76400	      MTIMES=MVAR(M)
76500	C
76600	      N=N1(M)
76700	      NN=N2(M)
76800	      IF(N)920,920,1
76900	 1    IF(NN)920,920,2
77000	 2    IF(N-7)3,3,920
77100	 3    IF(NN-7)4,4,920
77200	 4    IF(MTIMES)900,900,5
77300	 5    IF(MTIMES-7)10,10,900
77400	 10   GO TO (900,920,30,40,50,60,70),MTIMES
77500	C
77600	 30   GO TO (31,920,920,34,920,920,37),N
77700	C
77800	 31   GO TO (920,920,920,800,920,920,920),NN
77900	C
78000	 34   GO TO (800,920,920,920,920,920,800),NN
78100	C
78200	 37   GO TO (920,920,920,800,920,920,920),NN
78300	C
78400	 40   GO TO (41,920,43,920,45,920,47),N
78500	C
78600	 41   GO TO (920,920,800,920,920,920,920),NN
78700	C
78800	 43   GO TO (800,920,920,920,800,920,920),NN
78900	C
79000	 45   GO TO (920,920,800,920,920,920,800),NN
79100	C
79200	 47   GO TO (920,920,920,920,800,920,920),NN
79300	C
79400	 50   GO TO (51,52,920,54,920,56,57),N
79500	C
79600	 51   GO TO (920,800,920,920,920,920,920),NN
79700	C
79800	 52   GO TO (800,920,920,800,920,920,920),NN
79900	C
80000	 54   GO TO (920,800,920,920,920,800,920),NN
80100	C
80200	 56   GO TO (920,920,920,800,920,920,800),NN
80300	C
80400	 57   GO TO (920,920,920,920,920,800,920),NN
80500	C
80600	 60   GO TO (51,62,63,920,65,66,57),N
80700	C
80800	 62   GO TO (800,920,800,920,920,920,920),NN
80900	C
81000	 63   GO TO (920,800,920,920,800,920,920),NN
81100	C
81200	 65   GO TO (920,920,800,920,920,800,920),NN
81300	C
81400	 66   GO TO (920,920,920,920,800,920,800),NN
81500	C
81600	 70   GO TO (51,62,73,74,75,66,57),N
81700	C
81800	 73   GO TO (920,800,920,800,920,920,920),NN
81900	C
82000	 74   GO TO (920,920,800,920,800,920,920),NN
82100	C
82200	 75   GO TO (920,920,920,800,920,800,920),NN
82300	C
82400	 800  RETURN
82500	C
82600	 900  WRITE (6,4000)M,MTIMES
82700	      KOMPER=1
82800	      GO TO 800
82900	C
83000	 920  WRITE (6,4020)M,MTIMES,N1(M),N2(M)
83100	      KOMPER=1
83200	      GO TO 800
83300	C
83400	 4000 FORMAT(1H0,12X,31HTHE NUMBER OF PARTS TO QUESTION,I3,3H IS,I3,51H 
83500	     1A VALUE NOT PERMITTED. THIS OCCURRED IN SUB CHECK.)
83600	C
83700	 4020 FORMAT(1H0,6X,8HQUESTION,I3,4H HAS,I3,14H PARTS. SCORES,I3,4H AND,
83800	     1I3,63H WERE TO BE COMBINED BUT ONE OR BOTH OF THEM IS(ARE) INCORRE
83900	     2CT.)
84000	C
84100	      END
84200	CCOMBIN  SUBROUTINE COMBIN FOR BMD04S, 05S AND 07S    JUNE  3, 1963
84300	      SUBROUTINE COMBIN(I,N1,N2)
84400	C
84500	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
84600	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
84700	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
84800	      DIMENSION DUMMY2(27)
84900	      COMMON JOBNMB
85000	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
85100	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER
85200	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
85300	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
85400	      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
85500	25000 THETA=0.0
85600	      M=LVAR(I)
85700	C
85800	      INDEX1=I+LASTNO-NVAR
85900	      FLPTN1=N1(M)
86000	      FLPTN2=N2(M)
86100	      DO 25 J=I,INDEX1,NVAR
86200	      IF(A(J)-FLPTN1)25,10,25
86300	 10   A(J)=FLPTN2
86400	 25   CONTINUE
86500	      L1=N1(M)
86600	      L2=N2(M)
86700	      MFREQ(M,L2)=MFREQ(M,L2)+MFREQ(M,L1)
86800	      MFREQ(M,L1)=0
86900	      IF(MVAR(M)-6)27,60,70
87000	 27   IF(MVAR(M)-4)28,40,50
87100	 28   IF(MVAR(M)-2)900,900,30
87200	 30   IF(MFREQ(M,1))910,31,32
87300	 31   MFREQ(M,1)=MFREQ(M,4)
87400	      SCORE2=1.0
87500	 310  SCORE1=4.0
87600	      MFREQ(M,4)=0
87700	      LTIMES=1
87800	      GO TO 500
87900	 32   IF(MFREQ(M,4))910,600,33
88000	 33   MFREQ(M,7)=MFREQ(M,4)
88100	      SCORE2=7.0
88200	      GO TO 310
88300	 40   IF(MFREQ(M,1))910,41,43
88400	 41   LTIMES=2
88500	      SCORE1=3.0
88600	      MFREQ(M,1)=MFREQ(M,3)
88700	      MFREQ(M,3)=0
88800	 410  SCORE2=1.0
88900	      GO TO 500
89000	 42   SCORE1=5.0
89100	      MFREQ(M,4)=MFREQ(M,5)
89200	      MFREQ(M,5)=0
89300	 425  LTIMES=1
89400	      SCORE2=4.0
89500	      GO TO 500
89600	 43   IF(MFREQ(M,3))910,42,44
89700	 44   IF(MFREQ(M,5))910,45,46
89800	 45   SCORE1=3.0
89900	      MFREQ(M,4)=MFREQ(M,3)
90000	      MFREQ(M,3)=0
90100	      GO TO 425
90200	 46   LTIMES=3
90300	      SCORE1=5.0
90400	      MFREQ(M,7)=MFREQ(M,5)
90500	      MFREQ(M,5)=0
90600	 465  SCORE2=7.0
90700	      GO TO 500
90800	 50   IF(MFREQ(M,1))910,51,54
90900	 51   LTIMES=4
91000	 515  SCORE1=2.0
91100	      MFREQ(M,1)=MFREQ(M,2)
91200	      MFREQ(M,2)=0
91300	      GO TO 410
91400	 52   LTIMES=5
91500	 521  SCORE1=4.0
91600	      MFREQ(M,3)=MFREQ(M,4)
91700	      MFREQ(M,4)=0
91800	 525  SCORE2=3.0
91900	      GO TO 500
92000	 53   LTIMES=1
92100	      SCORE1=6.0
92200	      MFREQ(M,5)=MFREQ(M,6)
92300	      MFREQ(M,6)=0
92400	 535  SCORE2=5.0
92500	      GO TO 500
92600	 54   IF(MFREQ(M,2))910,52,55
92700	 55   IF(MFREQ(M,4))910,56,57
92800	 56   LTIMES=5
92900	 565  SCORE1=2.0
93000	      MFREQ(M,3)=MFREQ(M,2)
93100	      MFREQ(M,2)=0
93200	      GO TO 525
93300	 57   IF(MFREQ(M,6))910,58,590
93400	 58   LTIMES=6
93500	 581  SCORE1=4.0
93600	      MFREQ(M,5)=MFREQ(M,4)
93700	      MFREQ(M,4)=0
93800	      GO TO 535
93900	 59   LTIMES=1
94000	      GO TO 565
94100	 590  LTIMES=7
94200	 591  SCORE1=6.0
94300	      MFREQ(M,7)=MFREQ(M,6)
94400	      MFREQ(M,6)=0
94500	      GO TO 465
94600	 60   IF(MFREQ(M,1))910,61,63
94700	 61   LTIMES=8
94800	      GO TO 515
94900	 62   LTIMES=2
95000	 621  SCORE1=3.0
95100	      SCORE2=2.0
95200	      MFREQ(M,2)=MFREQ(M,3)
95300	      MFREQ(M,3)=0
95400	      GO TO 500
95500	 63   IF(MFREQ(M,2))910,62,64
95600	 64   IF(MFREQ(M,3))910,42,65
95700	 65   IF(MFREQ(M,5))910,45,66
95800	 66   IF(MFREQ(M,6))910,67,68
95900	 67   LTIMES=3
96000	 671  SCORE1=5.0
96100	      SCORE2=6.0
96200	      MFREQ(M,6)=MFREQ(M,5)
96300	      MFREQ(M,5)=0
96400	      GO TO 500
96500	 68   LTIMES=9
96600	      GO TO 591
96700	 70   IF(MFREQ(M,1))910,71,74
96800	 71   LTIMES=10
96900	      GO TO 515
97000	 72   LTIMES=11
97100	      GO TO 621
97200	 73   LTIMES=1
97300	      GO TO 521
97400	 74   IF(MFREQ(M,2))910,72,75
97500	 75   IF(MFREQ(M,3))910,73,76
97600	 76   IF(MFREQ(M,4))910,600,77
97700	 77   IF(MFREQ(M,5))910,78,79
97800	 78   LTIMES=1
97900	      GO TO 581
98000	 79   IF(MFREQ(M,6))910,80,81
98100	 80   LTIMES=12
98200	      GO TO 671
98300	 81   LTIMES=13
98400	      GO TO 591
98500	 500  DO 510 JJ=I,INDEX1,NVAR
98600	      IF(A(JJ)-SCORE1)510,505,510
98700	 505  A(JJ)=SCORE2
98800	 510  CONTINUE
98900	      GO TO (600,42,45,52,53,59,58,62,67,72,73,78,80),LTIMES
99000	 600  MVAR(M)=MVAR(M)-1
99100	 610  RETURN
99200	 900  L=2
99300	      WRITE (6,4000)I,N1(M),N2(M),M,L
99400	      KOMPER=1
99500	      GO TO 610
99600	 910  WRITE (6,4010)I,N1(M),N2(M),M
99700	      KOMPER=1
99800	      GO TO 610
99900	 4000 FORMAT(1H ,20X,54HMACHINE ERROR. UPON ENTRY TO SUBROUTINE COMBIN W
     
00100	     1ITH I=,I3,7H N1(M)=,I3,7H N2(M)=,I3/10X,9H QUESTION,I3,9H HAS ONLY
00200	     2,I2,77H PARTS, WHEREAS IT MUST HAVE AT LEAST 3 PARTS IN ORDER TO H
00300	     3AVE A COMBINATION.)
00400	 4010 FORMAT(1H ,20X,54HMACHINE ERROR. UPON ENTRY TO SUBROUTINE COMBIN W
00500	     1ITH I=,I3,7H N1(M)=,I3,7H N2(M)=,I3/22X,48H ONE OF THE FREQUENCIES
00600	     2 OF RESPONSES TO QUESTION,I3,14H WAS NEGATIVE.)
00700	      END
00800	CENDCMB  SUBROUTINE ENDCMB FOR BMD07S                 JUNE  3, 1963
00900	C
01000	      SUBROUTINE ENDCMB(NDREDK,K,MAXERR,LASTRD)
01100	C
01200	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
01300	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
01400	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
01500	     37),KONTER(25,7),DUMMY3(7)
01600	      COMMON JOBNMB
01700	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
01800	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
01900	     2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,I,DUMMY3,KK
02000	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
02100	C
02200	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
02300	     1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
02400	     2),(ERROR,KONTER)
02500	C
02600	      MINRED=((LASTNO+199)/200)*NDREDK
02700	C
02800	      FLPTN1=MAXERR
02900	      FLPTN2=LASTNO
03000	      REPERR=FLPTN1/FLPTN2
03100	      KK=4
03200	 10   CALL FNDCMB(FLPTN2)
03300	      IF(KOMPER)500,100,500
03400	 100  GO TO (150,155,490),K
03500	 150  IF(REPERR-0.1)151,151,155
03600	 151  K=2
03700	 155  INDEX1=INDTEM+1
03800	      INDEX2=INDTEM+NVAR
03900	      M=0
04000	      J=0
04100	      DO 170 L=INDEX1,INDEX2
04200	      N=KOLSKR(L+25)
04300	      IF(N)900,157,1565
04400	 1565 GO TO (159,156,490),K
04500	 156  IF(N-MINRED)157,159,159
04600	 157  KOLSKR(L)=0
04700	      KOLSKR(L+25)=0
04800	      N=0
04900	 159  IF(M-N)160,170,170
05000	 160  M=N
05100	      J=L
05200	 170  CONTINUE
05300	      IF(J)180,180,250
05400	 180  K=3
05500	      GO TO 10
05600	 250  N=M
05700	      L=J-INDTEM
05800	      M=LVAR(L)
05900	      N2(M)=KOLSKR(J)/8
06000	      N1(M)=KOLSKR(J)-(N2(M)*8)
06100	      NCOMB(M)=NCOMB(M)+1
06200	      CALL COMBIN(L,N1,N2(1))
06300	      IF(KOMPER)500,300,500
06400	 300  I=L
06500	      CALL DECTER
06600	      MAXERR=MAXERR-N
06700	 480  KOMPER=25
06800	      GO TO 500
06900	 490  KOMPER=50
07000	 500  RETURN
07100	 900  KOMPER=1
07200	      WRITE (6,4900)
07300	      GO TO 500
07400	 4900 FORMAT(1H0,9X,91H* MACHINE ERROR * THE REDUCTION IN ERROR DUE TO A
07500	     1 POSSIBLE COMBINATION IN SUBROUTINE ENDCMB/18X,74HIS NEGATIVE. THI
07600	     2S IS NOT POSSIBLE IN THIS PROGRAM. PROGRAM CANNOT PROCEED.)
07700	      END
07800	CFNDCMB  SUBROUTINE FNDCMB FOR BMD04S, 05S AND 07S    JUNE  3, 1963
07900	C
08000	      SUBROUTINE FNDCMB(FLPTN2)
08100	C
08200	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
08300	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
08400	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
08500	     37),KONTER(25,7),DUMMY3(7),DUMMY4(2)
08600	      COMMON JOBNMB
08700	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
08800	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
08900	     2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,I,DUMMY3,KK,DUMMY4,L1
09000	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
09100	C
09200	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
09300	     1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
09400	     2),(ERROR,KONTER)
09500	C
09600	25000 THETA=0.0
09700	 11   DO 300 II=1,NVAR
09800	C
09900	      INDEX2=INDTEM+II
10000	      INDEXK=LASTNO+II-NVAR
10100	      M=LVAR(II)
10200	      MTIMES=MVAR(M)
10300	      IF(MTIMES-2)200,200,12
10400	 12   GO TO (915,1250,915,14),KK
10500	 1250 IF(MTIMES-3)200,200,14
10600	 14   ITIMES=1
10700	      KOLHLD(24)=0
10800	      DO 15 J=1,7
10900	      KOLHLD(J)=KONTER(M,J)
11000	      KOLHLD(24)=KOLHLD(24)+KONTER(M,J)
11100	      KOLHLD(J+7)=MFREQ(M,J)
11200	 15   CONTINUE
11300	      K=INDKOL
11400	      DO 30 INDEX=II,INDEXK,NVAR
11500	      K=K+1
11600	      HOLDA(K)=A(INDEX)
11700	 30   CONTINUE
11800	      GO TO (915,31,915,32),KK
11900	 31   GO TO (295,295,295,60,90,125,155),MTIMES
12000	 32   GO TO (295,295,355,61,91,91,91),MTIMES
12100	 355  N1(M)=7
12200	 36   N2(M)=4
12300	 37   CALL COMBIN(II,N1,N2(1))
12400	      IF(KOMPER)360,38,360
12500	 38   I=II
12600	      CALL DECTER
12700	      MVAR(M)=MVAR(M)+1
12800	      KOLHLD(25)=0
12900	      DO 40 J=1,7
13000	      KOLHLD(25)=KOLHLD(25)+KONTER(M,J)
13100	      GO TO (915,387,915,384),KK
13200	 384  IF(MFREQ(M,J))387,387,385
13300	 385  IF(MFREQ(M,J)-(KONTER(M,J)+KONTER(M,J)))386,387,387
13400	 386  KOLHLD(25)=KOLHLD(24)
13500	 387  MFREQ(M,J)=KOLHLD(J+7)
13600	 40   CONTINUE
13700	 42   K=INDKOL
13800	      DO 45 INDEX=II,INDEXK,NVAR
13900	      K=K+1
14000	      A(INDEX)=HOLDA(K)
14100	 45   CONTINUE
14200	      GO TO (295,295,405,69,98,131,162),MTIMES
14300	 405  GO TO (41,47),ITIMES
14400	 41   N1(M)=1
14500	 455  ITIMES=2
14600	      N=KOLHLD(25)
14700	      GO TO (295,295,36,62,92,92,92),MTIMES
14800	 47   IF(KOLHLD(25))900,475,475
14900	 475  IF(N)900,477,477
15000	 477  IF(KOLHLD(25)-N)48,55,58
15100	 48   N=KOLHLD(24)-KOLHLD(25)
15200	      L=1
15300	 482  K=4
15400	 485  GO TO (915,486,915,1000),KK
15500	 486  IF(N)295,295,49
15600	 49   IF(KOLHLD(24)-10)51,51,50
15700	 50   IF(N-((KOLHLD(24)+9)/10))295,51,51
15800	 51   KOLSKR(INDEX2)=(K*8)+L
15900	      KOLSKR(INDEX2+25)=N
16000	      GO TO 296
16100	 55   GO TO (915,295,915,58),KK
16200	 58   N=KOLHLD(24)-N
16300	      L=7
16400	      GO TO 482
16500	 60   L=0
16600	      IF(MFREQ(M,7)-(2*KOLHLD(7)))61,63,63
16700	 61   N1(M)=7
16800	 62   N2(M)=5
16900	      GO TO 37
17000	 63   IF(MFREQ(M,5)-(2*KOLHLD(5)))61,65,65
17100	 65   IF(MFREQ(M,3)-(2*KOLHLD(3)))61,67,67
17200	 67   IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))85,295,295
17300	 69   GO TO (695,70,80),ITIMES
17400	 695  N1(M)=3
17500	      GO TO 455
17600	 70   IF(KOLHLD(25))900,71,71
17700	 71   IF(N)900,72,72
17800	 72   IF(KOLHLD(25)-N)73,73,745
17900	 73   L=2
18000	      N=KOLHLD(25)
18100	 74   ITIMES=3
18200	      N1(M)=1
18300	 742  N2(M)=3
18400	      GO TO 37
18500	 745  L=1
18600	      GO TO 74
18700	 80   IF(KOLHLD(25))900,81,81
18800	 81   IF(KOLHLD(25)-N)82,87,83
18900	 82   N=KOLHLD(24)-KOLHLD(25)
19000	      K=3
19100	 825  L=1
19200	      GO TO 485
19300	 83   N=KOLHLD(24)-N
19400	      IF(L-2)84,845,84
19500	 84   L=7
19600	 842  K=5
19700	      GO TO 485
19800	 845  L=3
19900	      GO TO 842
20000	 85   N=KOLHLD(24)
20100	      GO TO 74
20200	 87   GO TO (915,295,915,83),KK
20300	 90   N=1
20400	      GO TO 126
20500	 91   N1(M)=7
20600	 92   N2(M)=6
20700	      GO TO 37
20800	 96   IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))120,295,295
20900	 98   GO TO (99,100,106,111),ITIMES
21000	 99   N1(M)=4
21100	      GO TO 455
21200	 100  IF(KOLHLD(25))900,101,101
21300	 101  IF(N)900,102,102
21400	 102  IF(KOLHLD(25)-N)103,105,105
21500	 103  L=2
21600	      N=KOLHLD(25)
21700	 104  ITIMES=3
21800	      N1(M)=4
21900	 1045 N2(M)=2
22000	      GO TO 37
22100	 105  L=1
22200	      GO TO 104
22300	 106  IF(KOLHLD(25))900,107,107
22400	 107  IF(KOLHLD(25)-N)108,110,109
22500	 108  L=3
22600	      N=KOLHLD(25)
22700	 109  ITIMES=4
22800	 1090 N1(M)=1
22900	      GO TO 1045
23000	 110  IF(L-2)108,109,108
23100	 111  IF(KOLHLD(25))900,112,112
23200	 112  IF(KOLHLD(25)-N)113,114,114
23300	 113  N=KOLHLD(24)-KOLHLD(25)
23400	      K=2
23500	      GO TO 825
23600	 114  IF(L-2)115,118,119
23700	 115  K=7
23800	 116  L=6
23900	 117  N=KOLHLD(24)-N
24000	      GO TO 485
24100	 118  K=4
24200	      GO TO 116
24300	 119  L=2
24400	      K=4
24500	      GO TO 117
24600	 120  N=KOLHLD(24)
24700	      GO TO 109
24800	 125  N=2
24900	 126  L=0
25000	      DO 128 JJ=2,7
25100	      IF((KOLHLD(JJ)+KOLHLD(JJ))-MFREQ(M,JJ))128,128,91
25200	 128  CONTINUE
25300	 129  GO TO (96,130,161),N
25400	 130  IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))121,295,295
25500	 121  N=KOLHLD(24)
25600	      GO TO 146
25700	 131  GO TO(132,133,139,143,148),ITIMES
25800	 132  N1(M)=5
25900	      GO TO 455
26000	 133  IF(KOLHLD(25))900,134,134
26100	 134  IF(N)900,135,135
26200	 135  IF(KOLHLD(25)-N)136,138,138
26300	 136  L=2
26400	      N=KOLHLD(25)
26500	 137  ITIMES=3
26600	      N1(M)=5
26700	      GO TO 742
26800	 138  L=1
26900	      GO TO 137
27000	 139  IF(KOLHLD(25))900,140,140
27100	 140  IF(KOLHLD(25)-N)141,141,142
27200	 141  L=3
27300	      N=KOLHLD(25)
27400	 142  ITIMES=4
27500	      N1(M)=2
27600	      GO TO 742
27700	 143  IF(KOLHLD(25))900,144,144
27800	 144  IF(KOLHLD(25)-N)145,147,146
27900	 145  L=4
28000	      N=KOLHLD(25)
28100	 146  ITIMES=5
28200	      GO TO 1090
28300	 147  IF(L-2)146,145,146
28400	 148  IF(KOLHLD(25))900,149,149
28500	 149  IF(KOLHLD(25)-N)113,150,150
28600	 150  IF(L-4)151,154,154
28700	 151  IF(L-2)115,152,153
28800	 152  K=5
28900	      GO TO 116
29000	 153  K=5
29100	      GO TO 1545
29200	 154  K=2
29300	 1545 L=3
29400	      GO TO 117
29500	 155  N=3
29600	      GO TO 126
29700	 161  IF(MFREQ(M,1)-(KOLHLD(1)+KOLHLD(1)))189,295,295
29800	 162  GO TO(132,163,169,173,178,183),ITIMES
29900	 163  IF(KOLHLD(25))900,164,164
30000	 164  IF(N)900,165,165
30100	 165  IF(KOLHLD(25)-N)166,168,168
30200	 166  L=2
30300	      N=KOLHLD(25)
30400	 167  ITIMES=3
30500	      N1(M)=5
30600	 1675 N2(M)=4
30700	      GO TO 37
30800	 168  L=1
30900	      GO TO 167
31000	 169  IF(KOLHLD(25))900,170,170
31100	 170  IF(KOLHLD(25)-N)171,171,172
31200	 171  L=3
31300	      N=KOLHLD(25)
31400	 172  ITIMES=4
31500	      N1(M)=3
31600	      GO TO 1675
31700	 173  IF(KOLHLD(25))900,174,174
31800	 174  IF(KOLHLD(25)-N)175,177,176
31900	 175  L=4
32000	      N=KOLHLD(25)
32100	 176  ITIMES=5
32200	      N1(M)=3
32300	      GO TO 1045
32400	 177  IF(L-2)175,175,176
32500	 178  IF(KOLHLD(25))900,179,179
32600	 179  IF(KOLHLD(25)-N)180,182,181
32700	 180  L=5
32800	      N=KOLHLD(25)
32900	 181  ITIMES=6
33000	      GO TO 1090
33100	 182  IF(L-2)180,181,181
33200	 183  IF(KOLHLD(25))900,184,184
33300	 184  IF(KOLHLD(25)-N)113,185,185
33400	 185  IF(L-4)186,188,154
33500	 186  IF(L-2)115,152,187
33600	 187  L=4
33700	      K=5
33800	      GO TO 117
33900	 188  K=4
34000	      GO TO 1545
34100	 189  N=KOLHLD(24)
34200	      GO TO 181
34300	 1000 IF(N)295,295,1010
34400	 1010 SCORE1=N
34500	      KOLSKR(INDEX2)=L+(K*8)
34600	      KOLSKR(INDEX2+25)=N
34700	      RANKSM(INDEX2+50)=SCORE1/FLPTN2
34800	      GO TO 296
34900	 200  KOLSKR(INDEX2)=0
35000	      KOLSKR(INDEX2+25)=0
35100	      GO TO 300
35200	 295  KOLSKR(INDEX2)=0
35300	      KOLSKR(INDEX2+25)=0
35400	 296  DO 297 J=1,7
35500	      KONTER(M,J)=KOLHLD(J)
35600	 297  CONTINUE
35700	      N1(M)=0
35800	      N2(M)=0
35900	 300  CONTINUE
36000	      GO TO (915,301,915,360),KK
36100	 301  L1=0
36200	      DO 350 II=1,NVAR
36300	      INDEX2=INDTEM+II+25
36400	      IF(KOLSKR(INDEX2))910,350,310
36500	 310  IF(L1-KOLSKR(INDEX2))315,350,350
36600	 315  L1=KOLSKR(INDEX2)
36700	      J=II
36800	 350  CONTINUE
36900	      IF(L1)357,360,357
37000	 357  INDEX2=INDTEM+J
37100	      M=LVAR(J)
37200	      L2=KOLSKR(INDEX2)
37300	      N1(M)=L2/8
37400	      N2(M)=L2-(8*N1(M))
37500	      NCOMB(M)=NCOMB(M)+1
37600	      CALL COMBIN(J,N1,N2(1))
37700	      I=J
37800	      KK=2
37900	      CALL DECTER
38000	 360  RETURN
38100	 900  KOMPER=1
38200	      WRITE (6,4900)
38300	      GO TO 360
38400	 910  KOMPER=1
38500	      I=INDEX2-INDTEM
38600	      M=LVAR(I)
38700	      WRITE (6,4910)M
38800	      GO TO 360
38900	 915  KOMPER=1
39000	      WRITE (6,4915)
39100	      GO TO 360
39200	 4900 FORMAT(1H0,25X,56H* MACHINE ERROR * TOTAL ERROR IN SUB FNDCMB IS N
39300	     1EGATIVE.)
39400	 4910 FORMAT(1H0,18X,59H* MACHINE ERROR* THE ERROR DUE TO A COMBINATION
39500	     1IN QUESTION,I3,13H RESULTS IN A/41X,29HNEGATIVE ERROR IN SUB FNDCM
39600	     2B.)
39700	 4915 FORMAT(1H0,12X,86H* MACHINE ERROR * SUBROUTINE FNDCMB WAS ENTERED 
39800	     1WITH AN INCORRECT VALUE OF A CONSTANT.)
39900	      END
40000	CFRSTCM       SUBROUTINE FRSTCM FOR BMD07S         OCTOBER 1, 1964
40100	      SUBROUTINE FRSTCM(NPER)
40200	C
40300	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
40400	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
40500	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(5),DUMMYX(3)
40600	      DIMENSION DUMMY2(27)
40700	      COMMON JOBNMB
40800	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
40900	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
41000	     2DTEM,DUMMY1,N1,N2,DUMMYX,L
41100	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
41200	C
41300	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
41400	      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
41500	C
41600	      MINPR=(NPER*NCASE+99)/100
41700	C
41800	 10   L=INDKOL
41900	      DO 100 I=1,NVAR
42000	      M=LVAR(I)
42100	      IF(MVAR(M)-2)100,100,12
42200	 12   DO 75  J=1,7
42300	      IF(MFREQ(M,J))75,75,15
42400	   15 IF(MFREQ(M,J)-MINPR)25,75,75
42500	 25   L=L+1
42600	      KOLSKR(L)=M+(64*J)
42700	 75   CONTINUE
42800	 100  CONTINUE
42900	 125  IF(L-INDKOL)150,150,175
43000	 150  RETURN
43100	C
43200	 160  L=LL
43300	      GO TO 150
43400	C
43500	 175  K=INDKOL
43600	      MM=0
43700	      LL=L
43800	 176  K=K+1
43900	      IF(K-LL)177,177,160
44000	 177  J=KOLSKR(K)/64
44100	      I=KOLSKR(K)-(64*J)
44200	      IF(I-MM)178,160,178
44300	 178  MM=I
44400	      DO 179 I=1,NVAR
44500	      IF(LVAR(I)-MM)179,1795,179
44600	 179  CONTINUE
44700	 1795 MTIMES=MVAR(I)-2
44800	      GO TO (180,195,205,215,230),MTIMES
44900	 180  IF(J-4)185,190,191
45000	 185  N2(MM)=1
45100	 186  N1(MM)=4
45200	 187  NCOMB(MM)=NCOMB(MM)+1
45300	      CALL COMBIN(I,N1,N2(1))
45400	      GO TO 176
45500	C
45600	 190  IF(MFREQ(MM,7)-MFREQ(MM,1))191,191,185
45700	 191  N2(MM)=7
45800	      GO TO 186
45900	C
46000	 195  IF(J-5)196,199,200
46100	 196  IF(J-3)197,221,221
46200	 197  N1(MM)=1
46300	 198  N2(MM)=3
46400	      GO TO 187
46500	C
46600	 199  N1(MM)=5
46700	      GO TO 198
46800	C
46900	 200  N1(MM)=7
47000	      GO TO 222
47100	C
47200	 205  IF(J-6)206,211,213
47300	 206  IF(J-2)207,209,210
47400	 207  N1(MM)=1
47500	 208  N2(MM)=2
47600	      GO TO 187
47700	C
47800	 209  N1(MM)=2
47900	      GO TO 212
48000	C
48100	 210  IF(MFREQ(MM,2)-MFREQ(MM,6))2105,2105,2110
48200	 2105 N1(MM)=4
48300	      GO TO 208
48400	C
48500	 2110 N1(MM)=4
48600	      GO TO 214
48700	C
48800	 211  N1(MM)=6
48900	 212  N2(MM)=4
49000	      GO TO 187
49100	C
49200	 213  N1(MM)=7
49300	 214  N2(MM)=6
49400	      GO TO 187
49500	C
49600	 215  IF(J-6)216,225,213
49700	 216  IF(J-3)217,220,223
49800	 217  IF(J-2)207,218,220
49900	 218  IF(MFREQ(MM,1)-MFREQ(MM,3))2180,2180,2185
50000	 2180 N1(MM)=2
50100	 2181 N2(MM)=1
50200	      GO TO 187
50300	C
50400	 2185 N1(MM)=2
50500	      GO TO 198
50600	C
50700	 219  N1(MM)=3
50800	      GO TO 208
50900	C
51000	 220  IF(MFREQ(MM,2)-MFREQ(MM,5))219,219,221
51100	 221  N1(MM)=3
51200	 222  N2(MM)=5
51300	      GO TO 187
51400	C
51500	 223  IF(MFREQ(MM,3)-MFREQ(MM,6))199,199,2235
51600	 2235 N1(MM)=5
51700	      GO TO 214
51800	C
51900	 224  N1(MM)=6
52000	      GO TO 222
52100	C
52200	 225  IF(MFREQ(MM,5)-MFREQ(MM,7))224,224,2250
52300	 2250 N1(MM)=6
52400	      N2(MM)=7
52500	      GO TO 187
52600	C
52700	 230  IF(J-6)231,225,213
52800	 231  IF(J-4)232,236,238
52900	 232  IF(J-2)207,218,233
53000	 233  IF(MFREQ(MM,2)-MFREQ(MM,4))219,219,234
53100	 234  N1(MM)=3
53200	      GO TO 212
53300	C
53400	 236  IF(MFREQ(MM,3)-MFREQ(MM,5))2360,2360,2370
53500	 2360 N2(MM)=3
53600	      GO TO 186
53700	C
53800	 2370 N2(MM)=5
53900	      GO TO 186
54000	C
54100	 237  N1(MM)=5
54200	      GO TO 212
54300	C
54400	C
54500	238   IF(MFREQ(MM,4).LE.MFREQ(MM,6)) GO TO 237
54600	9000  GO TO 2235
54700	      END
54800	CORDER   SUBROUTINE ORDER FOR BMD04S, 05S AND 07S     JUNE  3, 1963
54900	      SUBROUTINE ORDER
55000	C
55100	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
55200	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
55300	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
55400	      DIMENSION DUMMY2(27)
55500	      COMMON JOBNMB
55600	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
55700	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
55800	     2DTEM,IDAY,IYEAR,NUMPGE,JOYDAC,MAXLOC,N1,N2
55900	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
56000	      EQUIVALENCE(A,INDIVD,KOLSKR,HOLDA,RANKSM),(INV,LVAR),(HOLD,KOLHLD)
56100	      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
56200	 211  I=0
56300	C
56400	      BIGY=176.0
56500	      IJJ=INDKOL+1
56600	      L=INDRNK+1
56700	 212  Y=0.0
56800	      M=INDKOL
56900	      J=L+I
57000	      DO 225 JRNK=J,INDKOL
57100	      IF(Y-RANKSM(JRNK))215,220,225
57200	 215  IF(RANKSM(JRNK)-BIGY)216,225,225
57300	 216  Y=RANKSM(JRNK)
57400	      M=INDKOL
57500	 220  M=M+1
57600	      KOLSKR(M)=JRNK
57700	 225  CONTINUE
57800	      BIGY=Y
57900	      DO 230 JJ=IJJ,M
58000	      I=I+1
58100	      MOVFRM=KOLSKR(JJ)-INDRNK
58200	      CALL MOVE(MOVFRM,I)
58300	 230  CONTINUE
58400	      IF(NCASE -I)235,235,212
58500	 235  RETURN
58600	      END
58700	CORQSCP       SUBROUTINE ORQUES FOR BMD07S        DECEMBER 16, 1964
58800	      SUBROUTINE ORQUES(L)
58900	C
59000	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
59100	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
59200	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(7)
59300	      DIMENSION DUMMY2(27)
59400	       DIMENSION DUMMZ(11)
59500	      COMMON JOBNMB
59600	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
59700	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
59800	     2DTEM,IDAY,IYEAR,NUMPGE,JOYDAC,MAXLOC,N1,N2,LL,DUMMY1,NN
59900	      COMMON DUMMZ,INDEX3
60000	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
60100	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
60200	      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
60300	25000 THETA=0.0
60400	      ASSIGN 218 TO KSKIP
60500	      KK=NVAR+1
60600	      JJ=INDKOL+1
60700	      IF(L)1,30,1
60800	    1 NN=4
60900	      INDEX1=INDTEM+75
61000	      ASSIGN 212 TO KSKIP
61100		LL=1
61200	1000      M=LVAR(LL)
61300	      KOLSKR(INDEX1+1)=0
61400	      IF(MFREQ(M,7))4,5,4
61500	    4 CALL DECTER
61600	    5 KOLHLD (LL)=KOLSKR(INDEX1+1)
61700		LL=LL+1
61800		IF(LL.LE.NVAR)GO TO 1000
61900	      INDEX=INDEX1
62000	      DO 10 J=1,25
62100	      INDEX=INDEX+1
62200	   10 KOLSKR(INDEX)=MFREQ(J,7)
62300	      K=0
62400	      MM=INDKOL
62500	      LGEN=0
62600	   11 N=NCASE+1
62700	      DO 15 J=1,NVAR
62800	      IF(KOLHLD (J)-N)12,14,15
62900	   12 IF(LGEN-KOLHLD (J))13,15,15
63000	   13 N=KOLHLD(J)
63100	      MM=INDKOL
63200	   14 MM=MM+1
63300	      KOLSKR(MM)=J
63400	   15 CONTINUE
63500	      LGEN=N
63600	      DO 20 J=JJ,MM
63700	      I=KOLSKR(J)
63800	      M=LVAR(I)
63900	      K=K+1
64000	   20 MFREQ(M,7)=K
64100	      IF(NVAR-K)30,30,11
64200	   30 LGEN=NCASE+1
64300	 40   N=0
64400	      MM=INDKOL
64500	      DO 150 I=1,NVAR
64600	      M=LVAR(I)
64700	      IF(N-MFREQ(M,7))50,220,150
64800	 50   IF(MFREQ(M,7)-LGEN)55,150,150
64900	 55   N=MFREQ(M,7)
65000	      MM=INDKOL
65100	 60   MM=MM+1
65200	      KOLSKR(MM)=I
65300	 150  CONTINUE
65400	      LGEN=N
65500	      DO 200 J=JJ,MM
65600	      KK=KK-1
65700	      I=KOLSKR(J)
65800	      IF(KK-I)175,200,175
65900	 175  IJJ=KK
66000	      KOLHLD(1)=LVAR(I)
66100	      LVAR(I)=LVAR(KK)
66200	      LVAR(KK)=KOLHLD(1)
66300	      K=LASTNO-NVAR+I
66400	      DO 190 INDEX=I,K,NVAR
66500	      HOLD(1)=A(INDEX)
66600	      A(INDEX)=A(IJJ)
66700	      A(IJJ)=HOLD(1)
66800	      IJJ=IJJ+NVAR
66900	 190  CONTINUE
67000	 200  CONTINUE
67100	      IF(KK-1)210,210,40
67200	  210 GO TO KSKIP,(212,218)
67300	  212 DO 215 J=1,25
67400	      INDEX1=INDEX1+1
67500	  215 MFREQ(J,7)=KOLSKR(INDEX1)
67600	218   RETURN
67700	C
67800	 220  IF(MM-(INDKOL+1))60,230,60
67900	 230  J=KOLSKR(MM)
68000	      IF(LVAR(J)-M)240,60,60
68100	 240  KOLSKR(MM+1)=J
68200	      KOLSKR(MM)=I
68300	      MM=MM+1
68400	      GO TO 150
68500	C
68600	      END
68700	CREORDR       SUBROUTINE REORDR FOR BMD07S            AUGUST 19, 1964
68800	      SUBROUTINE REORDR
68900	C
69000	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
69100	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
69200	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
69300	     37),KONTER(25,7)
69400	      COMMON JOBNMB
69500	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
69600	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
69700	     2DTEM,IDAY,IYEAR,NUMPGE,JOYCDA,MAXLOC,N1,N2,I
69800	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
69900	C
70000	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
70100	     1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
70200	     2),(ERROR,KONTER)
70300	C
70400	25000 THETA=0.0
70500	      IT2=2
70600	C
70700	C     TWO SCRATCH TAPES MAY BE CALLED IN THIS PROGRAM IF THE DATA
70800	C     REQUIRES MOST OF THE STORAGE LOCATIONS. THEY ARE DESIGNATED HERE
70900	C     BY IT2 AND IT3. IF THE NUMBER OF CASES=N AND THE NUMBER OF
71000	C     QUESTIONS  =P, THEN IT3 WILL BE USED IF NP+6N IS GREATER THAN
71100	C     20,000. IT2 AND IT3 WILL BOTH BE USED IF NP+5N IS GREATER THAN
71200	C     20,000.
71300	C
71400	      IT3=3
71500	C
71600	      ASSIGN 26 TO KOMPLT
71700	      IMEMRY=1
71800	      INDEX=INDTEM+NCASE+NCASE
71900	      INDEXK=INDEX+NCASE
72000	      IF(INDEXK-8000) 9,9,4
72100	 4    IF(INDEX-8000) 7,7,6
72200	 6    IMEMRY=3
72300	      REWIND IT2
72400	      GO TO 8
72500	C
72600	 7    IMEMRY=2
72700	 8    REWIND IT3
72800	 9    INDEXK=INDTEM+NCASE
72900	      JRNK=INDRNK+1
73000	      TOT=RANKSM(JRNK)
73100	      NVARHF=NVAR/2+1
73200	      M=0
73300	      L=INDKOL+1
73400	      K=INDKOL
73500	      DO 25 I=JRNK,K
73600	      IF(RANKSM(I)-TOT)10,20,900
73700	 10   TOT=RANKSM(I)
73800	 11   IF(1-M)21,25,25
73900	 21   J=I-INDRNK
74000	      KOLSKR(L)=J-M
74100	      KOLSKR(L+1)=J-1
74200	      L=L+2
74300	      M=0
74400	 20   M=M+1
74500	 25   CONTINUE
74600	      GO TO KOMPLT,(26,29)
74700	 26   ASSIGN 29 TO KOMPLT
74800	      I=K+1
74900	      GO TO 11
75000	 29   IF((INDKOL+1)-L)30,321,905
75100	 30   NUMPRS=(L-INDKOL-1)/2
75200	      L1=INDKOL-1
75300	      INDXT1=LASTNO+1
75400	      INDXT2=INDKOL
75500	      IREADT=1
75600	      GO TO (370,306,305),IMEMRY
75700	305	NPOINT=(INDRNK-INDXT1+128)/128
75800		NWED=INDXT1-1
75900		IF (NPOINT.LE.1) GO TO 3330
76000		DO 3331 J=1,NPOINT-1
76100		NJ=(J-1)*128+NWED+1
76200		NJJ=J*128+NWED
76300	3331	WRITE(IT2)(INDIVD(JJJ),JJJ=NJ,NJJ)
76400	3330	NJ=(NPOINT-1)*128+NWED+1
76500		WRITE(IT2)(INDIVD(JJJ),JJJ=NJ,INDRNK)
76600		ENDFILE IT2
76700	306	GO TO (307,308),IREADT
76800	307	NPOINT=(INDXT2-JRNK+128)/128
76900		NWED=JRNK-1
77000		IF (NPOINT.LE.1) GO TO 3337
77100		DO 3338 J=1,NPOINT-1
77200		NJ=(J-1)*128+NWED+1
77300		NJJ=J*128+NWED
77400	3338	WRITE(IT3)(RANKSM(JJJ),JJJ=NJ,NJJ)
77500	3337	NJ=(NPOINT-1)*128+NWED+1
77600		WRITE(IT3)(RANKSM(JJJ),JJJ=NJ,INDXT2)
77700	      END FILE IT3
77800	      REWIND IT3
77900	      GO TO (31,350,308),IMEMRY
78000	 308  REWIND IT2
78100	 31   L1=L1+2
78200	      K1=KOLSKR(L1)
78300	      K2=KOLSKR(L1+1)
78400	      MOVETO=K1-1
78500	      NUMSAM=K2-K1+1
78600	      INDEX2=K1*NVAR
78700	      INDEX3=K2*NVAR
78800	      L=INDRNK
78900	 35   DO 50 I=INDEX2,INDEX3,NVAR
79000	      L=L+1
79100	      RANKSM(L)=0.0
79200	      INDEX1=I-NVAR+NVARHF
79300	 40   DO 45 J=INDEX1,I
79400	      RANKSM(L)=RANKSM(L)+A(J)
79500	 45   CONTINUE
79600	 50   CONTINUE
79700	      BIGY=92.0
79800	      I=INDTEM
79900	      INDEX2=INDRNK+NUMSAM
80000	 51   Y=0.0
80100	      L=LASTNO
80200	      DO 55 J=JRNK,INDEX2
80300	      IF(Y-RANKSM(J))52,54,55
80400	 52   IF(RANKSM(J)-BIGY)53,55,55
80500	 53   Y=RANKSM(J)
80600	      L=LASTNO
80700	 54   L=L+1
80800	      INDIVD(L)=J-INDRNK
80900	 55   CONTINUE
81000	      BIGY=Y
81100	      DO 60 JJ=INDXT1,L
81200	      I=I+1
81300	      INDIVD(I)=INDIVD(JJ)
81400	 60   CONTINUE
81500	      IF((NUMSAM+INDTEM)-I)64,64,51
81600	 64   GO TO (390,390,65),IMEMRY
81700	65	NPOINT=(INDRNK-INDXT1+128)/128
81800		NWED=INDXT1-1
81900		IF (NPOINT.LE.1) GO TO 6665
82000		DO 6666 J=1,NPOINT-1
82100		NJ=(J-1)*128+NWED+1
82200		NJJ=J*128+NWED
82300	6666	READ(IT2)(INDIVD(JJJ),JJJ=NJ,NJJ)
82400	6665	NJ=(NPOINT-1)*128+NWED+1
82500		READ(IT2)(INDIVD(JJJ),JJJ=NJ,INDRNK)
82600	 66   REWIND IT2
82700	 67   DO 70 J=JRNK,INDEX2
82800	      INDIVD(J)=0
82900	 70   CONTINUE
83000	      INDEX1=INDTEM+1
83100	      INDEX2=INDTEM+NUMSAM
83200	      DO 75 JJ=INDEX1,INDEX2
83300	      L=INDIVD(JJ)
83400	      LL=L+INDRNK
83500	      MOVETO=MOVETO+1
83600	      MOVFRM=L+INDIVD(LL)+K1-1
83700	      IF(MOVFRM-MOVETO)71,75,71
83800	 71   KK=2
83900	      CALL MOVFOR(MOVFRM,MOVETO,KK)
84000	      JRNK=INDRNK+1
84100	      DO 74 I=JRNK,LL
84200	      INDIVD(I)=INDIVD(I)+1
84300	 74   CONTINUE
84400	 75   CONTINUE
84500	      NUMPRS=NUMPRS-1
84600	      IF(NUMPRS)905,100,80
84700	 80   IREADT=2
84800	      INDEXK=INDTEM+NCASE
84900	      GO TO (350,350,305),IMEMRY
85000	C
85100	 100  GO TO (400,105,105),IMEMRY
85200	105	NPOINT=(INDXT2-JRNK+128)/128
85300		NWED=JRNK-1
85400		IF (NPOINT.LE.1) GO TO 1115
85500		DO 1116 J=1,NPOINT-1
85600		NJ=(J-1)*128+NWED+1
85700		NJJ=J*128+NWED
85800	1116	READ(IT3)(RANKSM(JJJ),JJJ=NJ,NJJ)
85900	1115	NJ=(NPOINT-1)*128+NWED+1
86000		READ(IT3)(RANKSM(JJJ),JJJ=NJ,INDXT2)
86100	 200  REWIND IT3
86200	 321  RETURN
86300	C
86400	 350  MM=INDEXK
86500	      DO 360 J=INDXT1,INDRNK
86600	      MM=MM+1
86700	      INDIVD(MM)=INDIVD(J)
86800	 360  CONTINUE
86900	      GO TO 31
87000	C
87100	 370  MM=INDEX
87200	      DO 380 J=JRNK,INDXT2
87300	      MM=MM+1
87400	      HOLDA(MM)=RANKSM(J)
87500	 380  CONTINUE
87600	      GO TO 350
87700	C
87800	 390  MM=INDEXK
87900	      DO 395 J=INDXT1,INDRNK
88000	      MM=MM+1
88100	      INDIVD(J)=INDIVD(MM)
88200	 395  CONTINUE
88300	      GO TO 67
88400	C
88500	 400  MM=INDEX
88600	      DO 405 J=JRNK,INDXT2
88700	      MM=MM+1
88800	      RANKSM(J)=HOLDA(MM)
88900	 405  CONTINUE
89000	      GO TO 321
89100	C
89200	 900  KOMPER=1
89300	      J=LASTNO+I-INDRNK
89400	      I=INDIVD(J)
89500	      WRITE (6,4900)I
89600	      GO TO 321
89700	C
89800	 905  KOMPER=1
89900	      WRITE (6,4905)
90000	      GO TO 321
90100	C
90200	 8000 FORMAT(20A4)
90300	 4900 FORMAT(1H ,52X,13HMACHINE ERROR/30X,10HRESPONDENT,I5,39H WAS FOUND
90400	     1 OUT OF ORDER IN SUB REORDER.)
90500	 4905 FORMAT(1H ,52X,13HMACHINE ERROR/29X,60HA COUNT WHICH SHOULD BE POS
90600	     1ITIVE IN SUB REORDER IS NEGATIVE.)
90700	C
90800	      END
90900	CRKCHNG       SUBROUTINE RKCHNG FOR BMD07S         OCTOBER 22, 1965
91000	C
91100	      SUBROUTINE RKCHNG(MAXERR)
91200	C
91300	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
91400	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
91500	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
91600	     37),KONTER(25,7),DUMMY3(5),DUMMY4(1),DUMMY5(10)
91700	      COMMON JOBNMB
91800	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
91900	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
92000	     2DTEM,IDAY,IYEAR,NUMPGE,JOYCAE,MAXLOC,N1,N2,KK,DUMMY3,IFIRST,DUMMY4
92100	     3,NN,ICHNGE,DUMMY5,INDEX3
92200	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
92300	C
92400	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
92500	     1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
92600	     2),(ERROR,KONTER)
92700	C
92800	25000 THETA=0.0
92900	      IT1=4
93000	C
93100	C     IT1 IS THE TAPE WHICH CONTAINS THE ORIGINAL WEIGHTED RESPONSES.
93200	      L2=NVAR+1
93300	C
93400	      K=1
93500	      KIND=INDKOL
93600	      IF(NCASE-175)400,425,425
93700	 400  KIND=INDTEM+500
93800	425   MINERR=MAXERR-(((MAXERR+19)/20)*ICHNGE)
93900	      IF(MINERR)450,465,465
94000	450   MINERR=0
94100	 465  DO 550 N=1,NVAR
94200	      NN=4
94300	      KK=L2-N
94400	      CALL DECTER
94500	      INDEX2=LASTNO+KK
94600	      INDEX3=INDEX3+1
94700	      KOLSKR(INDEX3)=NCASE
94800	      L1=LVAR(KK)
94900	      IM=MVAR(L1)-1
95000	      IL=0
95100	      DO 530 JJ=1,7
95200	      MM=8-JJ
95300	      IF(KONTER(L1,MM))915,4655,466
95400	4655  NOUT=7
95500	      NIN=MFREQ(L1,MM)
95600	      IF(NIN)530,530,4665
95700	 466  NOUT=KONTER(L1,MM)
95800	      NIN=MFREQ(L1,MM)-NOUT
95900	      IF(-NIN) 4665,530,530
96000	 4665 FLPTN1=MM
96100	      IL=IL+1
96200	      IF(IL-1)4666,4666,4667
96300	4666  INDEX1=KK
96400	      GO TO 4677
96500	4667  I=INDTEM+74+IL
96600	4668  INDEX1=(KOLSKR(I)-1)*NVAR+KK
96700	467   INDEX1=INDEX1+NVAR
96800	4677  IF(INDEX1-INDEX2)468,530,530
96900	468   IF(FLPTN1-A(INDEX1))469,4681,469
97000	 4681 NIN=NIN-1
97100	      IF(NIN)4682,4682,467
97200	 4682 GO TO (4671,4684,4685,4686,4687,4688),IM
97300	 4684 GO TO (4674,4671,530),IL
97400	4685  GO TO (4675,4673,4671,530),IL
97500	4686  GO TO (4676,4674,4672,4671,530),IL
97600	 4687 GO TO (4676,4675,4673,4672,4671,530),IL
97700	 4688 GO TO (4676,4675,4674,4673,4672,4671,530),IL
97800	 4671 FLPTN1=1.0
97900	      GO TO 4678
98000	 4672 FLPTN1=2.0
98100	      GO TO 4678
98200	 4673 FLPTN1=3.0
98300	      GO TO 4678
98400	4674  FLPTN1=4.0
98500	      GO TO 4678
98600	 4675 FLPTN1=5.0
98700	      GO TO 4678
98800	 4676 FLPTN1=6.0
98900	 4678 II=FLPTN1
99000	      NIN=MFREQ(L1,II)-KONTER(L1,II)
99100	      GO TO 467
99200	 469  IF(-A(INDEX1))4692,467,467
99300	 4692 IK=A(INDEX1)
99400	      GO TO (200,250,300,350,600,700),IM
99500	 200  MOVETO=KOLSKR(INDTEM+76)+1
99600	 210  IF(MOVETO)900,900,473
99700	 250  GO TO (252,467,467,254,467,467,200),IK
99800	 252  MOVETO=KOLSKR(INDTEM+77)+1
99900	      GO TO 210
     
00100	 254  IF(MM-1)252,252,200
00200	 300  GO TO (301,467,301,467,252,467,200),IK
00300	301   MOVETO=KOLSKR(INDTEM+78)+1
00400	      GO TO 210
00500	350   GO TO (351,351,467,301,467,252,200),IK
00600	351   MOVETO=KOLSKR(INDTEM+79)+1
00700	      GO TO 210
00800	 600  GO TO (601,601,351,467,301,252,200),IK
00900	601   MOVETO=KOLSKR(INDTEM+80)+1
01000	      GO TO 210
01100	700   GO TO (701,701,601,351,301,252,200),IK
01200	 701  MOVETO=KOLSKR(INDTEM+81)+1
01300	      GO TO 210
01400	C
01500	 473  MOVFRM=(INDEX1-KK)/NVAR+1
01600	      IF(MOVFRM-NCASE)4735,4735,900
01700	 4735 IF(MOVETO-NCASE)4737,4737,467
01800	4737  IF(-MOVFRM)4738,900,900
01900	4738  CALL MOVFOR(MOVFRM,MOVETO,K)
02000	474   J=KIND
02100	      DO 478 II=1,NVAR
02200	      I=LVAR(II)
02300	      DO 477 L=1,7
02400	475   J=J+1
02500	      KOLSKR(J)=KONTER(I,L)
02600	477   CONTINUE
02700	478   CONTINUE
02800	C
02900	C     DETERMINE NEW ERROR
03000	 480  NN=3
03100	      CALL DECTER
03200	      NERROR=0
03300	      DO 485 II=1,NVAR
03400	      I=LVAR(II)
03500	      DO 484 J=1,7
03600	      NERROR=NERROR+KONTER(I,J)
03700	484   CONTINUE
03800	 485  CONTINUE
03900	      IF(MAXERR-NERROR)486,486,495
04000	 486  J=KIND
04100	      DO 490 II=1,NVAR
04200	      I=LVAR(II)
04300	      DO 488 L=1,7
04400	      J=J+1
04500	      KONTER(I,L)=KOLSKR(J)
04600	488   CONTINUE
04700	 490  CONTINUE
04800	      CALL MOVFOR(MOVETO,MOVFRM,K)
04900	      GO TO 496
05000	C
05100	495   MAXERR=NERROR
05200	 496  IF(MINERR-MAXERR)497,555,555
05300	 497  CONTINUE
05400	C
05500	4975  NN=4
05600	      KK=L2-N
05700	      CALL DECTER
05800	      INDEX3=INDEX3+1
05900	      KOLSKR(INDEX3)=NCASE
06000	      GO TO 467
06100	C
06200	C                                                                      0
06300	C                                                                      0
06400	 530  CONTINUE
06500	 550  CONTINUE
06600	 555  RETURN
06700	C
06800	 900  KOMPER=1
06900	      WRITE (6,4900)MOVFRM,MOVETO
07000	      GO TO 555
07100	C
07200	 915  KOMPER=1
07300	      WRITE (6,4915)L1,MM
07400	      GO TO 530
07500	C
07600	 4900 FORMAT(1H0,104HIN MOVING AN INDIVIDUAL AND HIS RESPONSES IN SUB RK
07700	     1CHNG, THE RANK MOVED FROM OR TO IS IN ERROR. THEY ARE,I5,4H ANDI5)
07800	 4915 FORMAT(1H ,52X,13HMACHINE ERROR/19X,27HNEGATIVE ERROR FOR QUESTION
07900	     1,I3,6H SCORE,I2,25H WAS FOUND IN SUB RKCHNG.)
08000	C
08100	      END
08200	CDECTER       SUBROUTINE DECTER FOR GUTTMAN SCALES        JUNE 15, 1967
08300	      SUBROUTINE DECTER
08400	C
08500	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
08600	     X(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
08700	     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),KONTER(2
08800	     X5,7),DUMMY3(5),DUMMY4(7),DUMMY5(11),DUMMY2(27)
08900	C
09000	      COMMON JOBNMB
09100	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
09200	     XAR,INDRNK,INDKOL,ISCALE,IRAMK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
09300	     XDTEM,DUMMY3,N1,N2,I,DUMMY4,KK,DUMMY5,INDEX3
09400	C
09500	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
09600	     1,(DUMMY1,MFREQ),(ERROR,KONTER),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),
09700	     2(DUMMY2(27),NVAR)
09800	C
09900	      DOUBLE PRECISION DUMMY2, FRSTMO, SECMON, JOBNMB, KDUMY6, REF, KCHECK
10000	      KTIMES=I
10100	      INDEX3=INDTEM+75
10200	 10   DO 200 I=1,NVAR
10300	      GO TO (12,11,12,11),KK
10400	 11   IF(KTIMES-I)210,12,200
10500	 12   INCHCK=LASTNO+I
10600	      M=LVAR(I)
10700	      DO 14 J=1,7
10800	      KONTER(M,J)=0
10900	 14   CONTINUE
11000	      MTIMES=MVAR(M)
11100	      J=7
11200	      INDEX=I
11300	      INDEX1=I
11400	      LTIMES=1
11500	 15   NERROR=MFREQ(M,J)
11600	      L1=0
11700	      K=0
11800	      LL=0
11900	      IJJ=NERROR
12000	      FLPTN1=J
12100	      KERROR=0
12200	      ITIMES=1
12300	      JTIMES=1
12400	 20   IF(A(INDEX))25,41,25
12500	 25   IF(A(INDEX)-FLPTN1)30,45,30
12600	 30   IF(NERROR-MFREQ(M,J))35,42,42
12700	 35   GO TO (36,39,48),ITIMES
12800	   36 INDEX=INDEX-NVAR
12900	      IF(-INDEX)37,38,38
13000	   37 IF(A(INDEX))375,375,38
13100	  375 K=K-1
13200	      LL=LL-1
13300	      GO TO 36
13400	   38 INDEX=INDEX+NVAR
13500	  385 IJJ=NERROR
13600	      L1=L1+K
13700	      K=0
13800	      LL=LL+KERROR
13900	      KERROR=0
14000	      ITIMES=2
14100	      JTIMES=1
14200	      GO TO 4935
14300	 39   KERROR=KERROR+1
14400	      IF(KERROR-IJJ)46,46,499
14500	 40   INDEX=INDEX+NVAR
14600	      IF(INDEX-INCHCK)20,55,55
14700	 41   K=K+1
14800	 42   LL=LL+1
14900	      GO TO 40
15000	 45   NERROR=NERROR-1
15100	      GO TO (46,47,475),ITIMES
15200	 46   IF(NERROR)52,52,40
15300	 47   ITIMES=3
15400	  475 IF(NERROR)477,477,40
15500	  477 IF(IJJ-KERROR)499,385,385
15600	 48   IF((IJJ-NERROR)-KERROR)49,36,36
15700	 49   GO TO (492,494,499),JTIMES
15800	 492  JTIMES=2
15900	 493  ITIMES=2
16000	 4935 IF(NERROR)499,499,39
16100	 494  JTIMES=3
16200	      GO TO 493
16300	  499 INDEX=(MFREQ(M,J)-IJJ+LL-K)*NVAR+INDEX1
16400	 50   INDEX1=INDEX
16500	 500  GO TO (5005,5005,555,555),KK
16600	 5005 KONTER(M,J)=IJJ+LL-L1-K
16700	 501  GO TO (509,509,502,502),KK
16800	 502  INDEX3=INDEX3+1
16900	      KOLSKR(INDEX3)=(INDEX-I)/NVAR
17000	 509  IF(INDEX-INCHCK)51,190,190
17100	 51   GO TO (1995, 59 ,57,65,70,75,80),MTIMES
17200	 52   IJJ=0
17300	      INDEX=INDEX+NVAR
17400	      GO TO 50
17500	 55   IF((IJJ-NERROR)-KERROR)499,56,56
17600	 555  KONTER(M,J)=IJJ
17700	      GO TO 501
17800	 56   IJJ=NERROR
17900	      LL=LL+KERROR
18000	      GO TO 500
18100	 57   GO TO (58,59),LTIMES
18200	 58   LTIMES=2
18300	 585  J=4
18400	      GO TO 15
18500	 59   K=0
18600	      LL=0
18700	      INDEX=INDEX-NVAR
18800	 60   INDEX=INDEX+NVAR
18900	      IF(INDEX-INCHCK)61,63,1995
19000	 61   IF(A(INDEX)-1.0)60,62,625
19100	 62   K=K+1
19200	      GO TO 60
19300	 625  LL=LL+1
19400	      GO TO 60
19500	 63   GO TO (635,635,64,64),KK
19600	 635  KONTER(M,1)=MFREQ(M,1)-K+LL
19700	      GO TO 1995
19800	 64   LL=0
19900	      GO TO 635
20000	 65   GO TO (67,68,59),LTIMES
20100	 67   LTIMES=2
20200	 675  J=5
20300	      GO TO 15
20400	 68   LTIMES=3
20500	 685  J=3
20600	      GO TO 15
20700	 70   GO TO (72,73,74,59),LTIMES
20800	 72   LTIMES=2
20900	 725  J=6
21000	      GO TO 15
21100	 73   LTIMES=3
21200	      GO TO 585
21300	 74   LTIMES=4
21400	 745  J=2
21500	      GO TO 15
21600	 75   GO TO (72,76,77,78,59),LTIMES
21700	 76   LTIMES=3
21800	      GO TO 675
21900	 77   LTIMES=4
22000	      GO TO 685
22100	 78   LTIMES=5
22200	      GO TO 745
22300	 80   GO TO (72,76,81,82,83,59),LTIMES
22400	 81   LTIMES=4
22500	      GO TO 585
22600	 82   LTIMES=5
22700	      GO TO 685
22800	 83   LTIMES=6
22900	      GO TO 745
23000	 190  GO TO (1995,193 ,191,194,198,1904,1908),MTIMES
23100	 191  GO TO (192,193),LTIMES
23200	 192  KONTER(M,4)=MFREQ(M,4)
23300	 193  KONTER(M,1)=MFREQ(M,1)
23400	      GO TO 1995
23500	 194  GO TO (195,196,193),LTIMES
23600	 195  KONTER(M,5)=MFREQ(M,5)
23700	 196  KONTER(M,3)=MFREQ(M,3)
23800	      GO TO 193
23900	 198  GO TO (199,1901,1902,193),LTIMES
24000	 199  KONTER(M,6)=MFREQ(M,6)
24100	 1901 KONTER(M,4)=MFREQ(M,4)
24200	 1902 KONTER(M,2)=MFREQ(M,2)
24300	      GO TO 193
24400	 1904 GO TO (1905,1906,1907,1902,193),LTIMES
24500	 1905 KONTER(M,6)=MFREQ(M,6)
24600	 1906 KONTER(M,5)=MFREQ(M,5)
24700	 1907 KONTER(M,3)=MFREQ(M,3)
24800	      GO TO 1902
24900	 1908 GO TO (1909,1910,1911,1907,1902,193),LTIMES
25000	 1909 KONTER(M,6)=MFREQ(M,6)
25100	 1910 KONTER(M,5)=MFREQ(M,5)
25200	 1911 KONTER(M,4)=MFREQ(M,4)
25300	      GO TO 1907
25400	 1995 GO TO (200,210,200,210),KK
25500	 200  CONTINUE
25600	 210  RETURN
25700	      END
25800	CMOVE    SUBROUTINE MOVE FOR GUTTMAN SCALES PROGRAMS
25900	CMOVE    SUBROUTINE MOVE FOR GUTTMAN SCALES  APRIL 15, 1967
26000	      SUBROUTINE MOVE(M1,M2)
26100	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
26200	     X(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
26300	     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
26400	     X7),KONTER(25,7),DUMMY3(5),DUMMY4(7),DUMMY5(11)
26500	C
26600	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
26700	     X,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
26800	     X),(ERROR,KONTER)
26900	C
27000	      COMMON JOBNMB
27100	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
27200	     XAR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
27300	     XDTEM,DUMMY3,N1,N2,I,DUMMY4,KK,DUMMY5
27400	      DOUBLE PRECISION DUMMY2,FRSTMO,SECMON,JOBNMB,KDUMY6,REF,KCHECK
27500	C
27600	25000 YHETA=0.0
27700	      IF(M1-M2)5,100,5
27800	C     EXCHANGE RESPONSES FOR RANKS M1 AND M2
27900	 5    INDEX1=(M1-1)*NVAR
28000	      INDEX2=((M2-1)*NVAR)+1
28100	      INDEX3=INDEX2+NVAR-1
28200	      DO 50 I=INDEX2,INDEX3
28300	      INDEX1=INDEX1+1
28400	      GSABE=A(INDEX1)
28500	      A(INDEX1)=A(I)
28600	      A(I)=GSABE
28700	 50   CONTINUE
28800	C     EXCHANGE IDENTIFICATION NUMBERS
28900	      INDEX1=M1+LASTNO
29000	      INDEX2=M2+LASTNO
29100	      KSAVE=INDIVD(INDEX1)
29200	      INDIVD(INDEX1)=INDIVD(INDEX2)
29300	      INDIVD(INDEX2)=KSAVE
29400	C     EXCHANGE RANK SUMS
29500	 75   INDEX1=M1+INDRNK
29600	      INDEX2=M2+INDRNK
29700	      FSAVE=RANKSM(INDEX1)
29800	      RANKSM(INDEX1)=RANKSM(INDEX2)
29900	      RANKSM(INDEX2)=FSAVE
30000	 100  RETURN
30100	      END
30200	CMVDATA       SUBROUTINE MVDATA FOR GUTTMAN SCALES       JUNE 15, 1967
30300	CMVDATA       SUBROUTINE MVDATA FOR GUTTMAN SCALES PROGRAMS
30400	      SUBROUTINE MVDATA(M1,M2)
30500	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
30600	     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
30700	     2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),KONTER(2
30800	     35,7),DUMMY3(5),DUMMY4(7),DUMMY5(9)
30900	      DIMENSION DUMMY2(27)
31000	C
31100	      COMMON JOBNMB
31200	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
31300	     1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
31400	     3DTEM,DUMMY3,N1,N2,I,DUMMY4,KK,DUMMY5
31500	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
31600	     1,(DUMMY1,MFREQ),(ERROR,KONTER)
31700	      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
31800	      DOUBLE PRECISION DUMMY2
31900	      DOUBLE PRECISION JB,JOBNMB,JBND,REF,REFLEK,SECMON,FRSTMO,BLANKS,
32000	     1BND
32100	25000 THETA=0.0
32200	      IF(M1-M2)5,100,5
32300	C     EXCHANGE RESPONSES FOR RANKS M1 AND M2
32400	 5    INDEX1=(M1-1)*NVAR
32500	      INDEX2=((M2-1)*NVAR)+1
32600	      INDEX3=INDEX2+NVAR-1
32700	      DO 50 I=INDEX2,INDEX3
32800	      INDEX1=INDEX1+1
32900	      GSAVE=A(INDEX1)
33000	      A(INDEX1)=A(I)
33100	      A(I)=GSAVE
33200	 50   CONTINUE
33300	C     EXCHANGE IDENTIFICATION NUMBERS
33400	      INDEX1=M1+LASTNO
33500	      INDEX2=M2+LASTNO
33600	      KSAVE=INDIVD(INDEX1)
33700	      INDIVD(INDEX1)=INDIVD(INDEX2)
33800	      INDIVD(INDEX2)=KSAVE
33900	 100  RETURN
34000	      END
34100	CMOVFOR       SUBROUTINE MOVFOR FOR GUTTMAN SCALE PROGRAMS
34200	      SUBROUTINE MOVFOR(M1,M2,KK)
34300	      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
34400	     X(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE
34500	     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
34600	     X7),KONTER(25,7),DUMMY3(5),DUMMY4(7),DUMMY5(9)
34700	C
34800	      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
34900	     X,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR
35000	     X),(ERROR,KONTER)
35100	C
35200	      COMMON JOBNMB
35300	      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
35400	     XAR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN
35500	     XDTEM,DUMMY3,N1,N2,I,DUMMY4,KKP,DUMMY5
35600	      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
35700	      DOUBLE PRECISION SECMON,FRSTMO
35800	      DOUBLE PRECISION DUMMY2
35900	      DOUBLE PRECISION REFLEK
36000	      DOUBLE PRECISION BLANKS,BND
36100	C
36200	25000 THETA=0.0
36300	      KK=KK
36400	      INDEX1=M2*NVAR
36500	      INDEXK=INDEX1-NVAR
36600	      INDEX2=M1*NVAR
36700	      M=INDEX2-NVAR+1
36800	      INDEX3=M-1
36900	      DO 25 I=1,NVAR
37000	      INDEX3=INDEX3+1
37100	      HOLD(I)=A(INDEX3)
37200	 25   CONTINUE
37300	      JRNK=M1+INDRNK
37400	      HOLD(NVAR+1)=RANKSM(JRNK)
37500	      INDIDV=M1+LASTNO
37600	      IJJ=INDIVD(INDIDV)
37700	      IF(M2-M1)50,500,300
37800	 50   NADD=-NVAR
37900	      NONE=-1
38000	 55   L=M
38100	      J=M-1+NADD
38200	      DO 60 I=L,INDEX2
38300	      J=J+1
38400	      A(I)=A(J)
38500	 60   CONTINUE
38600	      M=L+NADD
38700	      IND=INDIDV+NONE
38800	      INDIVD(INDIDV)=INDIVD(IND)
38900	      INDIDV=IND
39000	      GO TO (65,70),KK
39100	 65   IRNK=JRNK+NONE
39200	      RANKSM(JRNK)=RANKSM(IRNK)
39300	      JRNK=IRNK
39400	 70   INDEX2=INDEX2+NADD
39500	      IF(INDEX2-INDEX1)55,100,55
39600	 100  DO 125 I=1,NVAR
39700	      INDEXK=INDEXK+1
39800	      A(INDEXK)=HOLD(I)
39900	 125  CONTINUE
40000	      INDIVD(INDIDV)=IJJ
40100	      GO TO (140,500),KK
40200	 140  RANKSM(JRNK)=HOLD(NVAR+1)
40300	 500  RETURN
40400	 300  NADD=NVAR
40500	      NONE=1
40600	      GO TO 55
40700	      END
40800	      SUBROUTINE REMOVE(N)
40900	      REWIND N
41000	      RETURN
41100	      END
41200	
41300	
41400	
41500	
41600	
41700	
41800	
41900	
42000	
42100	
42200	
42300	
42400	
42500	
42600	
42700	
42800	
42900	
43000	
43100	
43200	
43300	
43400	
43500	
43600	
43700	
43800	
43900	
44000	
44100	
44200	
44300	
44400	
44500	
44600	
44700	
44800	
44900	
45000	
45100	
45200	
45300	
45400	
45500	
45600	
45700	
45800	
45900	
46000	
46100	
46200	
46300	
46400	
46500