CBMDO4S       REVISED FOR SYSTEM 360  ON   APRIL 15, 1967
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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
     X7),KONTER(25,7),DUMMY3(1),DUMMY5(2),DUMMY6(6) ,REF(25)
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),(YES,IYES),(BND,JBND)
C
      COMMON JOBNMB
      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
     XAR,INDRNK,INDKOL,ISCALE,LESTN,LEAVE,IERROR,KANEND,KOMPER,KORDER,IN
     XDTEM,IDAY,IYEAR,NUMPGE,JOYCEA,MAXLOC,N1,N2,DUMMY3,LASTRD,NDREDK,L,
     XIFINAL,ILAST,IFIRST,NPER,KK,DUMMY5,L1,DUMMY6,INDEX3
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION BLANKS,BND
      DOUBLE PRECISION FNSHE
      DOUBLE PRECISION ZERO
C
      DATA AP/4HANDP/
      DATA ZERO/6H      /
      DATA FNSHE/8HFINISH  /
      DATA IYES/4HYES /
C
      BP=AP
	CALL USAGEB('BMD04S')
      BND=FNSHE
      BLANKS=ZERO
      ILOV=0
 4515 FORMAT(1H1,2X,65HBMD04S--GUTTMAN SCALE PREPROCESSOR - VERSION OF
     XAPRIL  15,  1967              /
     X3X,40HHEALTH SCIENCES COMPUTING FACILITY, UCLA)
      IDAY=-25
 4    NUMPGE=0
      KOMPER=0
      ITIMES=1
      KTIMES=0
      DO 47 I=1,25
      DO 43 J=1,7
      MFREQ(I,J)=0
      ERROR(I,J)=0.0
 43   CONTINUE
      MFREQ(I,8)=0
      NCOMB(I)=0
      N1(I)=0
      N2(I)=0
      LVAR(I)=0
 47   CONTINUE
      KANEND=1
      CALL REDPRE(BLANKS,JBND,REF)
      KANEND=KANEND
      FLPTN2=LASTNO
      IF(NVAR-25)165,165,900
 165  IF(KOMPER-99)166,999,166
 166  IF(KOMPER)998,169,998
C
C     PRINT DATA PROPERLY SCORED, IF DESIRED
C
 169  WRITE(6,4515)
      IF(ISCALE.NE.IYES) GO TO 200
 170  NTIMES=1
      KTIMES=1
      GO TO 5000
C
 175  WRITE(6,4000)
      WRITE(6,4504)NCASE,NVAR
      WRITE(6,4505)
      WRITE(6,4506)KTIMES
      WRITE(6,4507)(LVAR(J),REF(J),J=1,NVAR)
      GO TO 327
 180  WRITE(6,4001)INDIVD(INDIDV),(A(J),J=INDEX1,INDEX2)
 190  GO TO 267
C
C     CHECK TO SEE THAT THE RESPONSES GIVEN DO CONFORM TO THE
C     KVAR(J), J=1,NVAR, WHICH WERE READ IN.
C
200   CALL CONFRM
      IF(KOMPER)998,201,998
 201  IF(IFIRST.EQ.IYES) GO TO 2100
2011  IF(IERROR.EQ.IYES) GO TO 2015
      GO TO 2009
 2100 CALL FRSTCM(NPER)
      IF(L-INDKOL) 2003,2003,430
2003  IF(KOMPER)998,2009,998
 2009 IF(ILAST.NE.IYES) GO TO 465
 2015 INDEX2=0
C
C     RANK RESPONDENTS USING CORNELL TECHNIQUE
C
      DO 204 J=1,NCASE
      JRNK=INDRNK+J
      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
C
C     REORDER THOSE INDIVIDUALS WITH THE SAME TOTAL SCORE
C
 275  CALL REORDR
      IF (KOMPER)998,276,998
 276  IF(IFINAL.NE.IYES) GO TO 465
 325  NTIMES=2
      KTIMES=KTIMES+1
      GO TO 5000
C
 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
      GO TO (180,2665),NTIMES
 2665 WRITE(6,4003)I,INDIVD(INDIDV),RANKSM(JRNK),(A(J),J=INDEX1,INDEX2)
 267  CONTINUE
      GO TO 5050
C
 430  KTIMES=KTIMES+1
 450  NUMPGE=NUMPGE+1
      WRITE(6,4503)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE
      WRITE(6,4009)
 449  WRITE(6,4014)NPER
 451  WRITE(6,4504)NCASE,NVAR
      WRITE(6,4506)KTIMES
 452  WRITE(6,4510)
      DO 457 J=1,NVAR
      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 2100
C
C     DETERMINE ERROR FOR FINAL COMPUTATIONS
C
 465  KK=3
      CALL DECTER
      IF(IERROR.NE.IYES) GO TO 505
 466  KTIMES=KTIMES+1
      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,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)
 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
      MAXERR=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
      MAXERR=MAXERR+KOLHLD(I)
 3877 CONTINUE
      WRITE(6,4024)(KOLHLD(I),I=1,NVAR)
 388  WRITE(6,4502)
      WRITE(6,4006)
      WRITE(6,4500)
      DO 389 I=1,NVAR
      WRITE(6,4007)I,(MFREQ(I,J),J=1,8)
 389  CONTINUE
C
 505  KK=4
      CALL FNDCMB(FLPTN2)
      IF(KOMPER)998,560,998
 560  K=INDTEM+25
      KSUM=0
      DO 3874 I=1,NVAR
      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
      FLPTN1=MAXERR
      COFREP=1.0-(FLPTN1/FLPTN2)
      DO 561 I=1,NVAR
      J=K+I
      IF(KOLSKR(J))561,561,562
 561  CONTINUE
      GO TO 998
C
 562  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,4500)
      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,N1(M),N2(M),N,RANKSM(INDEX1+25)
 570  CONTINUE
C
 998  GO TO (4,999),KANEND
 999  STOP
C
 900  WRITE(6,4015)NVAR
      IF(KOMPER-99)998,999,998
C
 4000 FORMAT(1H ,38X,40HINPUT DATA AFTER RECEIVING PROPER SCORES)
 4001 FORMAT(1H ,I8,7X,25F4.0)
 4002 FORMAT(1H ,41X,28HRESPONDENTS AND SCALE SCORES/37X,37HRANKED ACCOR
     XDING TO CORNELL TECHNIQUE)
 4003 FORMAT(1H ,I4,I5,2F5.0,24F4.0)
 4005 FORMAT(1H ,5X,I3,6X,25I4)
 4006 FORMAT(1H0,3X,8HVARIABLE,19X,55HFREQUENCY OF OCCURRENCE OF SCORES
     X1 TO 7 AND SCORE ZERO/7X,2HOR,44X,5HSCORE/4X,8HQUESTION,13X,1H1,9X
     X,1H2,9X,1H3,9X,1H4,9X,1H5,9X,1H6,9X,1H7,4X,11HNO RESPONSE)
 4007 FORMAT(1H ,5X,I3,7X,8I10)
 4008 FORMAT(1H ,26X,57HWITH QUESTIONS ORDERED IN INCREASING FREQUENCY O
     XF SCORE 7)
 4009 FORMAT(1H ,45X,25HCOMBINATIONS IN QUESTIONS)
 4010 FORMAT(1H0,I10,A1,I16,I17,5H  AND,I3,I14,I8)
 4012 FORMAT(1H ,42X,27HERRORS FOR EACH SCALE SCORE/50X,11HFINAL STEPS)
 4014 FORMAT(1H0,31X,29HTHE FIRST SCORE HAS LESS THAN,I3,23H PERCENT OF 
     XRESPONDENTS)
 4015 FORMAT(1H0,4X,89HTHE MAXIMUM NUMBER OF VARIABLES OR QUESTIONS ALLO
     XWED IN THIS PROGRAM IS 25. YOU HAVE USED,I4,9H AND THUS//30X,53HTH
     XE PROGRAM WILL GO TO THE NEXT PROBLEM OR TERMINATE.)
 4016 FORMAT(1H ,34X,41HPOSSIBLE COMBINATIONS WHICH WILL INCREASE/25X,61
     XHTHE COEFFICIENT OF REPRODUCIBILITY AND THE AMOUNT OF INCREASE)
 4017 FORMAT(1H0,16X,I3,17X,I3,5H  AND,I3,19X,I4,20X,F5.4)
 4018 FORMAT(1H ,36X,33HCOEFFICIENT OF REPRODUCIBILITY = ,F7.5)
 4021 FORMAT(1H0,34X,35HMINIMAL MARGINAL REPRODUCIBILITY = ,F7.5)
 4024 FORMAT(1H0,14H TOTAL ERROR  ,25I4)
 4500 FORMAT(1H )
 4502 FORMAT(1H0//)
 4503 FORMAT(1H1,15H PROBLEM NUMBER,2X,A8,57X,2A6,I3,1H,,I5,3X,4HPAGE,I4
     1)
 4504 FORMAT(1H ,18X,23HNUMBER OF RESPONDENTS =,I5,22X,21HNUMBER OF VARI
     XABLES =,I3)
 4505 FORMAT(1H ,44X,22HVARIABLES OR QUESTIONS)
 4506 FORMAT(1H ,54X,4HSTEP,I4)
 4507 FORMAT(1H ,11H RESPONDENT,4X,25(I3,A1))
 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
     XED,6X,15HNUMBER OF PARTS/18X,19HCOMBINATIONS SO FAR,7X,9HTHIS TIME
     X,9X,15HORIGINAL    NOW)
 4511 FORMAT(1H0,64X,8HDECREASE,15X,11HAPPROXIMATE/15X,8HQUESTION,15X,11
     XHCOMBINATION,15X, 10HIN  NUMBER,14X,11HINCREASE IN/64X,10HOF  ERRO
     XRS,12X,15HREPRODUCIBILITY)
C
 5000 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
      GO TO (175,326),NTIMES
C
 5050 MINPR=MINPR+50
      IF(NDIFF)5060,5060,5010
 5060 GO TO (200,465),NTIMES
      STOP
      END
CCOMBIN  SUBROUTINE COMBIN FOR BMDO4S,O5S ANDO7S   APRIL 15,  1967
      SUBROUTINE COMBIN(I,N1,N2)
C
      DIMENSION DUMMY2(27)
      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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
      COMMON JOBNMB
      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
     XAR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
C
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION BLANKS,BND
C
      M=LVAR(I)
      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
     XITH I=,I3,7H N1(M)=,I3,7H N2(M)=,I3/10X,9H QUESTION,I3,9H HAS ONLY
     X,I2,77H PARTS, WHEREAS IT MUST HAVE AT LEAST 3 PARTS IN ORDER TO H
     XAVE A COMBINATION.)
 4010 FORMAT(1H ,20X,54HMACHINE ERROR. UPON ENTRY TO SUBROUTINE COMBIN W
     XITH I=,I3,7H N1(M)=,I3,7H N2(M)=,I3/22X,48H ONE OF THE FREQUENCIES
     X OF RESPONSES TO QUESTION,I3,14H WAS NEGATIVE.)
      END
CCONFRM  SUBROUTINE CONFRM FOR  BMDO4S               APRIL 15,  1967
C
      SUBROUTINE CONFRM
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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
     X7),KONTER(25,7)
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,IDAY,IYEAR,NUMPGE,JYANML,MAXLOC,N1,N2
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION BLANKS,BND
      KORDER=0
      M=INDKOL
      DO 210 I=1,NVAR
      MVAR(I)=0
      DO 206 J=1,7
      IF(MFREQ(I,J))905,206,205
 205  MVAR(I)=MVAR(I)+1
 206  CONTINUE
      IF(MVAR(I)-KVAR(I))208,210,910
 208  M=M+1
      KOLSKR(M)=I
 210  CONTINUE
      IF(M-INDKOL)920,211,930
 2200 DO 2290 J=INDEX1,M
      I=KOLSKR(J)
      WRITE(6,4930)I,MVAR(I),KVAR(I)
      NCOMB(I)=KVAR(I)-MVAR(I)
      KTIMES=KVAR(I)
      NTIMES=NCOMB(I)
      JTIMES=NTIMES
      N=1
      IF(NTIMES-1)125,125,124
 124  NTIMES=2
 125  GO TO (950,2201,130,140,150,160,170,950),KTIMES
 130  IF(MFREQ(I,1))905,131,132
 131  N1(1)=1
 132  IF(MFREQ(I,4))905,133,135
 133  IF(N1(1))2201,134,2201
 134  N1(1)=4
 135  IF(MFREQ(I,7))905,136,138
 136  IF(N1(1))2201,137,2201
 137  N1(1)=7
 138  WRITE(6,4970)(N1(N),N=1,JTIMES)
      DO 139 N=1,JTIMES
      N1(N)=0
 139  CONTINUE
      GO TO 2201
 140  IF(MFREQ(I,1))905,141,142
 141  N1(N)=1
      GO TO (138,142),NTIMES
 142  IF(MFREQ(I,3))905,143,145
 143  IF(N1(N))2201,144,1435
 1435 N=N+1
 144  N1(N)=3
      GO TO (138,145),NTIMES
 145  IF(MFREQ(I,5))905,146,148
 146  IF(N1(N))2201,147,1465
 1465 N=N+1
 147  N1(N)=5
      GO TO (138,148),NTIMES
 148  IF(MFREQ(I,7))905,149,138
 149  IF(N1(N))2201,1495,1493
 1493 N=N+1
 1495 N1(N)=7
      GO TO 138
 150  IF(MFREQ(I,1))905,151,152
 151  N1(N)=1
      GO TO (138,152),NTIMES
 152  IF(MFREQ(I,2))905,153,155
 153  IF(N1(N))2201,154,1535
 1535 N=N+1
 154  N1(N)=2
      GO TO (138,155),NTIMES
 155  IF(MFREQ(I,4))905,1555,157
 1555 IF(N1(N))2201,156,1557
 1557 N=N+1
 156  N1(N)=4
      GO TO (138,157),NTIMES
 157  IF(MFREQ(I,6))905,1575,148
 1575 IF(N1(N))2201,1585,158
 158  N=N+1
 1585 N1(N)=6
      GO TO (138,148),NTIMES
 160  IF(JTIMES-5)1605,2201,2201
 1605 IF(MFREQ(I,1))905,161,1615
 161  N1(N)=1
      GO TO (138,1615),NTIMES
 1615 IF(MFREQ(I,2))905,162,163
 162  IF(N1(N))2201,1627,1625
 1625 N=N+1
 1627 N1(N)=2
      GO TO (138,163),NTIMES
 163  IF(MFREQ(I,3)) 905,1635,1645
 1635 IF(N1(N))2201,164,1637
 1637 N=N+1
 164  N1(N)=3
      GO TO (138,1645),NTIMES
 1645 IF(MFREQ(I,5))905,165,157
 165  IF(N1(N))2201,1657,1655
 1655 N=N+1
 1657 N1(N)=5
      GO TO(138,157),NTIMES
 170  IF(JTIMES-6)1705,2201,2201
 1705 IF(MFREQ(I,1))905,171,172
 171  N1(N)=1
      GO TO (138,172),NTIMES
 172  IF(MFREQ(I,2))905,173,175
 173  IF(N1(N))2201,174,1725
 1725 N=N+1
 174  N1(N)=2
      GO TO (138,175),NTIMES
 175  IF(MFREQ(I,3))905,1755,176
 1755 IF(N1(N))2201,1757,1756
 1756 N=N+1
 1757 N1(N)=3
      GO TO(138,176),NTIMES
 176  IF(MFREQ(I,4))905,1765,1645
 1765 IF(N1(N))2201,1769,1767
 1767 N=N+1
 1769 N1(N)=4
      GO TO(138,1645),NTIMES
 2201 K=0
      DO 2210 L=1,7
      KONTER(I,L)=MFREQ(I,L)
      IF(MFREQ(I,L))905,2210,2205
 2205 K=K+1
      KOLHLD(K)=L
      MFREQ(I,L)=0
 2210 CONTINUE
      INDEX2=I+LASTNO-NVAR
      MTIMES=MVAR(I)
      GO TO (940,2220,2230,2240,2250,2260,940),MTIMES
 2220 LTIMES=1
      L=KOLHLD(1)
      IF(L-1)2225,2224,2225
 2225 SCORE2=1.0
      JJ=I
      GO TO 5500
 2224 MFREQ(I,1)=KONTER(I,1)
 2226 L=KOLHLD(K)
      IF(L-7)2227,2280,2227
 2227 LTIMES=2
      SCORE2=7.0
      JJ=150+I
      GO TO 5500
 2230 LTIMES=3
      L=KOLHLD(1)
      IF(L-1)2225,2234,2225
 2234 MFREQ(I,1)=KONTER(I,1)
 2235 LTIMES=1
      L=KOLHLD(2)
      IF(L-4)2237,2238,2237
 2237 SCORE2=4.0
      JJ=75+I
      GO TO 5500
 2238 MFREQ(I,4)=KONTER(I,4)
      GO TO 2226
 2240 LTIMES=4
      L=KOLHLD(1)
      IF(L-1)2225,2244,2225
 2244 MFREQ(I,1)=KONTER(I,1)
 2245 LTIMES=5
      L=KOLHLD(2)
      IF(L-3)2246,2243,2246
 2246 SCORE2=3.0
      JJ=50+I
      GO TO 5500
 2243 MFREQ(I,3)=KONTER(I,3)
 2247 LTIMES=1
      L=KOLHLD(3)
      IF(L-5)2248,2249,2248
 2248 SCORE2=5.0
      JJ=100+I
      GO TO 5500
 2249 MFREQ(I,5)=KONTER(I,5)
      GO TO 2226
 2250 LTIMES=6
      L=KOLHLD(1)
      IF(L-1)2225,2252,2225
 2252 MFREQ(I,1)=KONTER(I,1)
 2255 LTIMES=7
      L=KOLHLD(2)
      IF(L-2)2256,2253,2256
 2256 SCORE2=2.0
      JJ=25+I
      GO TO 5500
 2253 MFREQ(I,2)=KONTER(I,2)
 2257 LTIMES=8
      L=KOLHLD(3)
      IF(L-4)2237,2254,2237
 2254 MFREQ(I,4)=KONTER(I,4)
 2258 L=KOLHLD(4)
 2269 LTIMES=1
      IF(L-6)2259,2251,2259
 2259 SCORE2=6.0
      JJ=125+I
      GO TO 5500
 2251 MFREQ(I,6)=KONTER(I,6)
      GO TO 2226
 2260 LTIMES=9
      L=KOLHLD(1)
      IF(L-1)2225,2261,2225
 2261 MFREQ(I,1)=KONTER(I,1)
 2265 LTIMES=10
      L=KOLHLD(2)
      IF(L-2)2256,2262,2256
 2262 MFREQ(I,2)=KONTER(I,2)
 2266 LTIMES=11
      L=KOLHLD(3)
      IF(L-3)2246,2263,2246
 2263 MFREQ(I,3)=KONTER(I,3)
 2267 LTIMES=12
      L=KOLHLD(4)
      IF(L-5)2248,2264,2248
 2264 MFREQ(I,5)=KONTER(I,5)
 2268 L=KOLHLD(5)
      GO TO 2269
 2280 MFREQ(I,7)=KONTER(I,7)
 2285 DO 2290 L=1,7
      KONTER(I,L)=0
 2290 CONTINUE
 211  RETURN
C
 905  KOMPER=1
      WRITE(6,4905)J,I
      GO TO 211
C
 910  KOMPER=1
      WRITE(6,4910)I
      GO TO 211
C
 920  KOMPER=1
      WRITE(6,4920)INDKOL
      GO TO 211
C
 930  INDEX1=INDKOL+1
      NUMPGE=NUMPGE+1
      WRITE(6,4950)JOBNMB,FRSTMO,SECMON,IDAY,IYEAR,NUMPGE,NCASE,NVAR
      GO TO 2200
C
 940  WRITE(6,4940)I,MVAR(I)
      KOMPER=1
      GO TO 211
C
 950  MVAR(I)=KVAR(I)
      GO TO 940
C
 4905 FORMAT(1H0,6X,51HMACHINE ERROR. THE FREQUENCY OF OCCURRENCE OF SCO
     XREI2,12H OF QUESTIONI3,37H IS NEGATIVE. PROGRAM CANNOT PROCEED.)
 4910 FORMAT(1H04X52HMACHINE ERROR. THE TOTAL NUMBER OF PARTS TO QUESTIO
     XNI3,54H IS GREATER THAN THAT READ IN. PROGRAM CANNOT PROCEED.)
 4920 FORMAT(1H0,5X,52HMACHINE ERROR. AN INDEX WHICH SHOULD BE GREATER T
     XHAN,I6,49H IS LESS THAN THIS VALUE. PROGRAM CANNOT PROCEED.)
 4930 FORMAT(1H0,3X,36HTHE RESPONSES INDICATE THAT QUESTION,I3,9H HAS ON
     XLY,I2,54H PARTS, WHEREAS THE CONTROL CARD INDICATES THAT IT HAS,I2
     X,7H PARTS.//11X,98HTHE PROGRAM ASSUMES THE FORMER IS CORRECT AND P
     XROCEEDS FROM THERE. PLEASE CHECK THE RESPONSE CARD.)
 4940 FORMAT(1H0,   50HMACHINE ERROR. THE NUMBER OF RESPONSES TO QUESTIO
     XN,I3,58H SHOULD BE LESS THAN 7 BUT GREATER THAN 1. THE MACHINE HAS
     X,I2,1H.)
 4950 FORMAT(1H1,15H PROBLEM NUMBER,A8,21X,20HCHANGE OF RESPONSES,15X,2A
     X6,I3,1H,,I5,3X,4HPAGE,I4/19X,23HNUMBER OF RESPONDENTS =,I5,22X,21H
     XNUMBER OF VARIABLES =,I3//52X,6HSTEP 1)
 4970 FORMAT(1H0,28X,32HTHE SCORE(S) NOT USED IS(ARE) --,5I4)
C
 5500 LL=(L-1)*25+I
      MFREQ(JJ,1)=KONTER(LL,1)
      SCORE1=L
      DO 5510 JJ=I,INDEX2,NVAR
      IF(A(JJ)-SCORE1)5510,5505,5510
 5505 A(JJ)=SCORE2
 5510 CONTINUE
      GO TO(2226,2285,2235,2245,2247,2255,2257,2258,2265,2266,2267,2268)
     X,LTIMES
C
      GO TO 211
      END
CDECTER       SUBROUTINE DECTER FOR GUTTMAN SCALES  APRIL 15, 1967
      SUBROUTINE DECTER
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
     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,KK,DUMMY5,INDEX3
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
      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
CFNDCMB       SUBROUTINE FNDCMB FOR BMDO4S,O5S AND O7S    APRIL 15, 1967
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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
     X7),KONTER(25,7),DUMMY3(7),DUMMY4(2)
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,IDAY,IYEAR,NUMPGE,JOECOR,MAXLOC,N1,N2,I,DUMMY3,KK,DUMMY4,L1
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
 11   DO 300 II=1,NVAR
      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)
      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)
      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
     XEGATIVE.)
 4910 FORMAT(1H0,18X,59H* MACHINE ERROR* THE ERROR DUE TO A COMBINATION
     XIN QUESTION,I3,13H RESULTS IN A/41X,29HNEGATIVE ERROR IN SUB FNDCM
     XB.)
 4915 FORMAT(1H0,12X,86H* MACHINE ERROR * SUBROUTINE FNDCMB WAS ENTERED 
     XWITH AN INCORRECT VALUE OF A CONSTANT.)
      END
CFRSTCM       SUBROUTINE FRSTCM FOR BMDO4S AND BMDO7S      APRIL 15, 196
      SUBROUTINE FRSTCM(NPER)
C
      DIMENSION DUMMY2(27)
      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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(5),DUMMYX(3)
C
      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
C
      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
      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,DUMMY1,N1,N2,DUMMYX,L
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
      MINPR=(NPER*NCASE+99)/100
 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(I,J))75,75,15
 15   IF(MFREQ(I,J)-MINPR)25,75,75
 25   L=L+1
      KOLSKR(L)=I+(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(MM)-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)
      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
 238  IF(MFREQ(MM,4)-MFREQ(MM,6))237,237,2235
C
 237  N1(MM)=5
      GO TO 212
C
      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
     1(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,KK,DUMMY5
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
C
      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
      SAVE=A(INDEX1)
      A(INDEX1)=A(I)
      A(I)=SAVE
 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
      SAVE=RANKSM(INDEX1)
      RANKSM(INDEX1)=RANKSM(INDEX2)
      RANKSM(INDEX2)=SAVE
 100  RETURN
      END
CORDER   SUBROUTINE ORDER FOR BMD04S, 05S AND 07S     APRIL 15,1967
      SUBROUTINE ORDER
C
      DIMENSION DUMMY2(27)
      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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
      EQUIVALENCE(A,INDIVD,KOLSKR,HOLDA,RANKSM),(INV,LVAR),(HOLD,KOLHLD)
      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
      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,IDAY,IYEAR,NUMPGE,JJLKMN,MAXLOC,N1,N2
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
 211  I=0
      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
CORQUES  SUB ORQUES FOR BMD04S, 05S, 07S AND 08S      APRIL 15,1967
      SUBROUTINE ORQUES
C
      DIMENSION DUMMY2(27)
      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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25)
      EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD)
      EQUIVALENCE(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR)
      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,IDAY,IYEAR,NUMPGE,JJLKMR,MAXLOC,N1,N2
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
      KK=NVAR+1
      JJ=INDKOL+1
      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  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
CREDPRE  SUBROUTINE REDPRE FOR BMD04S                 APRIL 15,1967
      SUBROUTINE REDPRE(BLANKS,JBND,REF)
C
      DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA
     1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),REF(25),HOLD(26),MFRE
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),N2(25),NCOMB(25),DUMMY1(200),D
     XUMMY2(27),KONTER(25,7),DUMMY3(1),FMT(120)
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,FMT),(YES,IYES)
C
      COMMON JOBNMB
      COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV
     XAR,INDRNK,INDKOL,ISCALE,LESTN,LEAVE,IERROR,KANEND,KOMPER,KORDER,IN
     XDTEM,IDAY,IYEAR,NUMPGE,JOYFOR,MAXLOC,N1,N2,I,LASTRD,NDREDK,DUMMY3,
     XIFINAL,ILAST,IFIRST,NPER,KK
C
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION RFG,PROB,RESP,RELIC
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
      DOUBLE PRECISION AJAN,UARY,FEBR,RUARY,AMAR,APR,AMAY,AJUNE,AJULY,
     1AUGUST,SEPT
      DOUBLE PRECISION TEMB,OCT,OMBER,ANOV,AMBER,DEC,EMBER
      DOUBLE PRECISION PAN
      DOUBLE PRECISION BAN
      DATA PAN/6HABCDEF/
      DATA AJAN,UARY,FEBR,RUARY/6H     J,6HANUARY,6H    FE,6HBRUARY/
      DATA AMAR,APR,AMAY,AJUNE/6H MARCH,6H APRIL,6H   MAY,6H  JUNE/
      DATA AJULY,AUGUST,SEPT,TEMB/6H  JULY,6HAUGUST,6H   SEP,6HTEMBER/
      DATAOCT,OMBER,ANOV,AMBER/6H     O,6HCTOBER,6H    NO,6HVEMBER/
      DATA DEC,EMBER/6H    DE,6HCEMBER/
      DATA PROB/8HPROBLM  /
      DATA RESP/8HRESPON  /
      DATA RELIC/8HRFLECT  /
      DATA RFG/8HR       /
      DATA AFFR/4HYES /
      BAN=PAN
      REFLEK=RFG
      DUMMY2(1)=PROB
      DUMMY2(2)=RESP
      DUMMY2(3)=RELIC
      YES=AFFR
      IF(IDAY)4,5,5
 4    NTAPE=5
 5    READ(5,1000)JOB,JOBNMB,IMON,IDAY,IYEAR,NVAR,NCASE,INVERS,ISCALE,
     XIFIRST,ILAST,IFINAL,IERROR,NPER,MTAPE,MATVAR
      KOMPER=0
	IF (JOB.EQ.JBND) GO TO 999
 10   IF(JOB.NE.PROB) GO TO 955
 15   READ(5,1001)JOB,(KVAR(J),J=1,NVAR)
      IF(JOB.NE.RESP) GO TO 955
 155  LASTNO=NVAR*NCASE
      MAXLOC=8000-NCASE-NCASE-NCASE-NCASE
      IF(LASTNO-MAXLOC)16,16,900
 16   INDRNK=LASTNO+NCASE
      INDKOL=INDRNK+NCASE
      INDTEM=INDKOL+NCASE
      INDIDV=LASTNO
      IF(MTAPE)18,18,184
 18   MTAPE=5
      GO TO 7
C
 184  IF(MTAPE-5)185,7,185
 185  IF(MTAPE-6)186,966,186
 186  REWIND MTAPE
 7    IF(MTAPE-NTAPE)187,8,187
 187  IF(NTAPE-5)188,189,188
 188  CALL REMOVE(NTAPE)
 189  NTAPE=MTAPE
C
C     CONVERT DATE
C
 8    GO TO(2010,2020,2030,2040,2050,2060,2070,2080,2090,2100,2110,2120)
     X,IMON
 2010 FRSTMO=AJAN
      SECMON=UARY
      GO TO 2130
C
2020  FRSTMO=FEBR
      SECMON=RUARY
      GO TO 2130
C
 2030 FRSTMO=BLANKS
      SECMON=AMAR
      GO TO 2130
C
 2040 FRSTMO=BLANKS
      SECMON=APR
      GO TO 2130
C
 2050 FRSTMO=BLANKS
      SECMON=AMAY
      GO TO 2130
C
 2060 FRSTMO=BLANKS
      SECMON=AJUNE
      GO TO 2130
C
 2070 FRSTMO=BLANKS
      SECMON=AJULY
      GO TO 2130
C
 2080 FRSTMO=BLANKS
      SECMON=AUGUST
      GO TO 2130
C
 2090 FRSTMO=SEPT
      SECMON=TEMB
      GO TO 2130
C
 2100 FRSTMO=OCT
      SECMON=OMBER
      GO TO 2130
C
 2110 FRSTMO=ANOV
      SECMON=AMBER
      GO TO 2130
C
 2120 FRSTMO=DEC
      SECMON=EMBER
 2130 IYEAR=IYEAR+1900
      NOIN=1
      DO 19 J=1,NVAR
      IF(KVAR(J)-1)935,935,17
 17   IF(KVAR(J)-7)19,19,935
 19   CONTINUE
 20   IF(INVERS-IYES)26,25,26
 25   READ(5,1001)JOB,(INV(J),J=1,NVAR)
      IF(JOB.NE.RELIC) GO TO 955
 255  NOIN=2
 26   MAX=0
 30   CALL VFCHCK(MATVAR)
 33   MATVAR=MATVAR*18
 35   READ(5,1002)(FMT(J),J=1,MATVAR)
 40   MIN=MAX+1
      MAX=MAX+NVAR
      INDIDV=INDIDV+1
 43   IF(MIN-LASTNO)45,45,165
 45   READ(NTAPE,FMT)INDIVD(INDIDV),(A(I),I=MIN,MAX)
 60   DO 150 J=1,NVAR
      INDEX=MIN+J-1
      GO TO (65,64),NOIN
 64   IF(INV(J))70,65,70
 65   NOINV=1
      GO TO 76
C
 70   NOINV=2
 76   IF(A(INDEX))925,110,77
 77   VAR=KVAR(J)
      IF(A(INDEX)-VAR)775,775,910
 775  GO TO (79,78),NOINV
 78   A(INDEX)=VAR+1.0-A(INDEX)
 79   NPARTS=KVAR(J)
      N1(1)=A(INDEX)
      N11=N1(1)
 791  GO TO(935,80,85,90,95,100,105),NPARTS
 80   GO TO (117,111),N11
C
 85   GO TO (117,114,111),N11
C
 90   GO TO (117,115,113,111),N11
C
 95   GO TO (117,116,114,112,111),N11
C
 100  GO TO (117,116,115,113,112,111),N11
C
 105  GO TO (117,116,115,114,113,112,111),N11
C
 110  L=8
      SCORE=0.0
      GO TO 120
C
 111  SCORE=1.0
      L=1
      GO TO 120
C
 112  SCORE =2.0
      L=2
      GO TO 120
C
 113  SCORE=3.0
      L=3
      GO TO 120
C
 114  SCORE=4.0
      L=4
      GO TO 120
C
 115  SCORE=5.0
      L=5
      GO TO 120
C
 116  SCORE=6.0
      L=6
      GO TO 120
C
 117  SCORE=7.0
      L=7
 120  A(INDEX)=SCORE
      MFREQ(J,L)=MFREQ(J,L)+1
 150  CONTINUE
 160  GO TO 40
C
 165  DO 168 L=1,NVAR
      IF(-(INV(L)))166,167,167
 166  REF(L)=REFLEK
      GO TO 1675
C
 167  REF(L)=BLANKS
 1675 LVAR(L)=L
 168  CONTINUE
 171   N1(1)=0
      IF(NTAPE-5)172,173,172
 172  REWIND NTAPE
 173  RETURN
C
 900  KANEND=2
      NEWKAS=NCASE
 901  NEWKAS=NEWKAS-1
      MAXLOC=MAXLOC+4
      LASTNO=LASTNO-NVAR
      IF(LASTNO-MAXLOC)902,902,901
 902  WRITE(6,4900)NEWKAS,NCASE
      NCASE=NEWKAS
      GO TO 16
C
 910  WRITE(6,4910)J,INDIVD(INDIDV)
      KOMPER=1
      GO TO 150
C
 925  I=(MAX-1)/NVAR
      WRITE(6,4925)I,J
      KOMPER=1
      GO TO 150
C
 935  KOMPER=1
      WRITE(6,4935)J,KVAR(J)
      KANEND=2
      GO TO 150
C
 946  KANEND=2
      GO TO 171
C
 955  WRITE(6,4955)
 956  KOMPER=1
      GO TO 946
C
 966  WRITE(6,4966)
      GO TO 956
C
 999  KOMPER=99
      GO TO 173
C
 1000 FORMAT(2A6,I3,2I2,I3,I5,6A3,I2,21X2I2)
 1001 FORMAT(A6,25I2)
 1002 FORMAT(18A4)
 4900 FORMAT(1H1,30X,57HMAXIMUM DATA STORAGE EXCEEDED. SCALE WILL BE COM
     XPUTED FOR,I4,17H CASES INSTEAD OF,I4,7H CASES.)
 4910 FORMAT(1H0,8HQUESTION,I3,14H OF RESPONDENT,I5,14H IS TOO LARGE.)
 4925 FORMAT(1H0,33X,37HNEGATIVE SCORE READ IN FOR RESPONDENT,I5,8HQUEST
     XION,I3)
 4935 FORMAT(1H0,9X,47HTHERE MUST BE AT LEAST 2 RESPONSES FOR QUESTION,I
     X3,52H BUT NO MORE THAN 7. PLEASE CHECK THE RESPONSE CARD.)
 4955 FORMAT(1H1,34X48HCONTROL CARDS OUT OF ORDER. JOB CANNOT CONTINUE.)
 4966 FORMAT(1H038X42HTAPE NUMBER IN ERROR. JOB CANNOT CONTINUE.)
C
      END
      SUBROUTINE REMOVE(N)
      REWIND N
      RETURN
      END
CREORDR       SUBROUTINE REORDR FOR BMDO4S            APRIL 15, 1967
      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
     XQ(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2
     X7),KONTER(25,7)
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,IDAY,IYEAR,NUMPGE,JBNMZR,MAXLOC,N1,N2,I
      DOUBLE PRECISION JOB,JOBNMB,JBND,REF
      DOUBLE PRECISION SECMON,FRSTMO
      DOUBLE PRECISION DUMMY2
      DOUBLE PRECISION REFLEK
      DOUBLE PRECISION BLANKS,BND
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
      IT2=2
      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	NMON=INDRNK-INDXT1+1
	IF (NMON.GT.128) GO TO 1000
	WRITE(IT2)(INDIVD(J),J=INDXT1,INDRNK)
	GO TO 1001
1000	NMON=(NMON+127)/128
	IF (NMON.LE.1) GO TO 1002
	DO 1003 J=1,NMON-1
	N430=(J-1)*128+INDXT1
	N431=J*128+INDXT1-1
1003	WRITE(IT2)(INDIVD(N432),N432=N430,N431)
1002	N430=(NMON-1)*128+INDXT1
	WRITE(IT2)(INDIVD(J),J=N430,INDRNK)
1001      END FILE IT2
 306  GO TO (307,308),IREADT
307	NMON=INDXT2-JRNK+1
	IF (NMON.GT.128) GO TO 2000
	WRITE(IT3)(RANKSM(J),J=JRNK,INDXT2)
	GO TO 2001
2000	NMON=(NMON+127)/128
	IF (NMON.LE.1) GO TO 2002
	DO 2003 J=1,NMON-1
	N430=(J-1)*128+JRNK
	N431=J*128+JRNK-1
2003	WRITE(IT3)(RANKSM(N432),N432=N430,N431)
2002	N430=(NMON-1)*128+JRNK
	WRITE(IT3)(RANKSM(J),J=N430,INDXT2)
2001      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	NMON=INDRNK-INDXT1+1
	IF (NMON.GT.128) GO TO 1060
	READ(IT2)(INDIVD(J),J=INDXT1,INDRNK)
	GO TO 66
1060	NMON=(NMON+127)/128
	IF (NMON.LE.1) GO TO 1061
	DO 1062 J=1,NMON-1
	N430=(J-1)*128+INDXT1
	N431=J*128+INDXT1-1
1062	READ(IT2)(INDIVD(N432),N432=N430,N431)
1061	N430=(NMON-1)*128+INDXT1
	READ(IT2)(INDIVD(J),J=N430,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	NMON=INDXT2-JRNK+1
	IF (NMON.GT.128) GO TO 1070
	READ(IT3)(RANKSM(J),J=JRNK,INDXT2)
	GO TO 200
1070	NMON=(NMON+127)/128
	IF (NMON.LE.1) GO TO 1071
	DO 1072 J=1,NMON-1
	N430=(J-1)*128+JRNK
	N431=J*128+JRNK-1
1072	READ(IT3)(RANKSM(N432),N432=N430,N431)
1071	N430=(NMON-1)*128+JRNK
	READ(IT3)(RANKSM(J),J=N430,INDXT2)
 9500 FORMAT(20A4)
 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
 4900 FORMAT(1H ,52X,13HMACHINE ERROR/30X,10HRESPONDENT,I5,39H WAS FOUND
     X OUT OF ORDER IN SUB REORDER.)
 4905 FORMAT(1H ,52X,13HMACHINE ERROR/29X,60HA COUNT WHICH SHOULD BE POS
     XITIVE IN SUB REORDER IS NEGATIVE.)
C
      END
CVFCHCK       SUBROUTINE VFCHCK FOR BMDO4S             APRIL 15, 1967
CVFCHCK    SUBROUTINE TO CHECK FOR PROPER NUMBER OF VARIABLE FORMAT CRDS
      SUBROUTINE VFCHCK(NVF)
      IF(NVF)10,10,20
 20   IF(NVF-10)50,50,10
 10   WRITE(6,4000)
      NVF=1
C
 4000 FORMAT(1H023X71HNUMBER OF VARIABLE FORMAT CARDS INCORRECTLY SPECIF
     XIED, ASSUMED TO BE 1.)
C
 50   RETURN
      END
CMOVFOR        SUBROUTINE MOVFOR FOR GUTTMAN SCALES    APRIL 15, 1967
CMOVFOR       SUBROUTINE MOVFOR FOR GUTTMAN SCALE PROGRAMS
      SUBROUTINE MOVFOR(M1,M2,KK)
      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
     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
      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
































