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