CBMDO6S GUTTMAN SCALES NO. 2 - - PART 1 MAY 15,1967 DIMENSION A(8000),RANKSM(8000),INDIVD(8000),KOLSKR(8000),HOLDA 1(8000),KVAR(25),INV(25),LVAR(25),KOLHLD(25),N2 (25),HOLD(26),MFRE 2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2 37),KONTER(25,7),DUMMY3(1),KSTEP(6), KDUMY6(2),REF(25),NN1(6),NN2(6 4),NN3(6) COMMON JOBNMB COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV 1AR,INDRNK,INDKOL,ISCALE,LESTN,LEAVE,IERROR,KANEND,KOMPER,KORDER,IN 2DTEM,IDAY,IYEAR,NUMPGE,JOYDEC,MAXLOC,N1,N2,DUMMY3,LASTRD,NDREDK,L, 3IFINAL,ILAST,IFIRST,IXTRA,KK,ICHNGE,NFIRST,L1,IEND,MCOMB,IPUNCH,NP 4ER,KDUMY6,INDEX3 C EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD) 1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR 2),(ERROR,KONTER),(YES,IYES) C DOUBLE PRECISION DUMMY2,KDUMY6 DOUBLE PRECISION JOB,JOBNMB,JBND,REF,SECMON,FRSTMO,REFLEK,BLANKS, 1BND,JB DATA AYES/4HYES / C 4515 FORMAT(1H1,2X,65HBMD06S--GUTTMAN SCALE NUMBER 2, PART 1 - VERSION 1OF JULY 29, 1968 / 23X,40HHEALTH SCIENCES COMPUTING FACILITY, UCLA) C BMD06S USES THE SUBROUTINE -- CONFORM -- FOUND IN BMD04S C C IF PRINT OUT OF THE SCORED INPUT DATA IN THE SAME ORDER AS THE C FINAL SCALED DATA IS DESIRED, THEN AN ADDITIONAL TAPE UNIT, C DESIGNATED IT1 HERE, IS NEEDED IN SUBROUTINE READ06. C C THIS PROGRAM REQUIRES A SAVE TAPE TO WRITE THE RESULTS OF THE C PROGRAM UP TO THE POINT OF THE FIRST COMBINATIONS. THIS TAPE, C DESIGNATED IT4 HERE, IS THEN USED BY BMD07S TO PERFORM C ALL COMBINATIONS, DETERMINE THE GUTTMAN SCALE AND GIVE THE C DESIRED OUTPUT. C C IT4=4 CALL USAGEB('BMD06S') REWIND IT4 C YES=AYES 4 NUMPGE=0 KOMPER=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 WRITE (6,4515) 5 CALL READ06(REF(1)) IF(NVAR-25)165,165,900 165 IF(KOMPER)998,169,998 C C PRINT DATA PROPERLY SCORED, IF DESIRED C 169 IF (ISCALE.NE.IYES) GO TO 200 170 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 175 WRITE (6,4000) WRITE (6,4504)NCASE,NVAR WRITE (6,4505) DO 172 J=1,NVAR L=LVAR(J) 172 HOLD(J)=REF(L) WRITE (6,4507)(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 180 WRITE (6,4001)INDIVD(INDIDV),(A(J),J=INDEX1,INDEX2) 267 CONTINUE 5050 MINPR=MINPR+50 IF(NDIFF)200 ,200 ,5010 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,700 ,998 700 J=INDTEM+NCASE WRITE(IT4) J WRITE(IT4) (REF(I),I=1,25) NPOINT=(J+127)/128 IF (NPOINT.LE.1) GO TO 7772 DO 7771 JJ=1,NPOINT-1 NJ=(JJ-1)*128+1 NJJ=JJ*128 7771 WRITE(IT4)(A(JJJ),JJJ=NJ,NJJ) 7772 NJ=(NPOINT-1)*128+1 WRITE(IT4)(A(JJJ),JJJ=NJ,J) DO 7773 JJ=1,4 NJ=(JJ-1)*128+1 NJJ=JJ*128 7773 WRITE(IT4)(LVAR(K),K=NJ,NJJ) WRITE(IT4)(LVAR(K),K=513,558),INDEX3 WRITE(IT4) JOBNMB,(DUMMY2(I),I=1,27),FRSTMO,SECMON,(KDUMY6(J) 1,J=1,2) END FILE IT4 REWIND IT4 998 STOP C 900 WRITE (6,4015)NVAR C 4000 FORMAT(1H ,38X,40HINPUT DATA AFTER RECEIVING PROPER SCORES) 4001 FORMAT(1H ,I8,7X,25F4.0) 4015 FORMAT(1H0,4X,89HTHE MAXIMUM NUMBER OF VARIABLES OR QUESTIONS ALLO 1WED IN THIS PROGRAM IS 25. YOU HAVE USED,I4,9H AND THUS//43X,27HTH 2E PROGRAM WILL TERMINATE.) 4500 FORMAT(1H ) 4503 FORMAT(1H1,15H PROBLEM NUMBER,2X,A6,57X,2A6,I3,1H,,I5,3X,4HPAGE, 1I4) 4504 FORMAT(1H ,18X,23HNUMBER OF RESPONDENTS =,I5,22X,21HNUMBER OF VARI 1ABLES =,I3) 4505 FORMAT(1H ,44X,22HVARIABLES OR QUESTIONS) 4507 FORMAT(1H ,11H RESPONDENT,4X,25(I3,A1)) C GO TO 998 END CCOMFRM SUBROUTINE CONFRM , REVISED FOR SYSTEM 360 ON MAY 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 2Q(25,8),ERROR(25,7),MVAR(25),N1(25),NCOMB(25),DUMMY1(200),DUMMY2(2 37),KONTER(25,7) DOUBLE PRECISION JOB,JOBNMB,JBND,REF,SECMON,FRSTMO,REFLEK,BLANKS, 1BND,JB DOUBLE PRECISION DUMMY2,KDUMY6 COMMON JOBNMB COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV 1AR,INDRNK,INDKOL,ISCALE,IRANK,IQUES,IERROR,KANEND,KOMPER,KORDER,IN 2DTEM,IDAY,IYEAR,NUMPGE,JOYDEC,MAXLOC,N1,N2 C EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(INV,LVAR),(HOLD,KOLHLD) 1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR 2),(ERROR,KONTER) C KORDER=0 C M=INDKOL DO 210 II=1,NVAR I=LVAR(II) 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 1REI2,12H OF QUESTIONI3,37H IS NEGATIVE. PROGRAM CANNOT PROCEED.) 4910 FORMAT(1H04X52HMACHINE ERROR. THE TOTAL NUMBER OF PARTS TO QUESTIO 1NI3,54H IS GREATER THAN THAT READ IN. PROGRAM CANNOT PROCEED.) 4920 FORMAT(1H0,5X,52HMACHINE ERROR. AN INDEX WHICH SHOULD BE GREATER T 1HAN,I6,49H IS LESS THAN THIS VALUE. PROGRAM CANNOT PROCEED.) 4930 FORMAT(1H0,3X,36HTHE RESPONSES INDICATE THAT QUESTION,I3,9H HAS ON 1LY,I2,54H PARTS, WHEREAS THE CONTROL CARD INDICATES THAT IT HAS,I2 2,7H PARTS.//11X,98HTHE PROGRAM ASSUMES THE FORMER IS CORRECT AND P 3ROCEEDS FROM THERE. PLEASE CHECK THE RESPONSE CARD.) 4940 FORMAT(1H0, 50HMACHINE ERROR. THE NUMBER OF RESPONSES TO QUESTIO 1N,I3,58H SHOULD BE LESS THAN 7 BUT GREATER THAN 1. THE MACHINE HAS 2,I2,1H.) 4950 FORMAT(1H1,17H PROBLEM NUMBER ,A8,21X,19HCHANGE OF RESPONSES,15X, 12A6,I3,1H,,I5,3X,4HPAGE,I4/19X,23HNUMBER OF RESPONDENTS =,I5,22X,2 21HNUMBER 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) 1,LTIMES C GO TO 211 END CREADO6 SUBROUTINE READ06 , REVISED FOR SYSTEM 360 ON MAY 15,1967 C SUBROUTINE READ06(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 2Q(25,8),ERROR(25,7),MVAR(25),N1(25),N2(25),NCOMB(25),DUMMY1(200),D 3UMMY2(27),KONTER(25,7),DUMMY3(1),FMT(120) C COMMON JOBNMB COMMON DUMMY2,FRSTMO,SECMON,A,LVAR,MFREQ,ERROR,NCASE,HOLD,NCOMB,KV 1AR,INDRNK,INDKOL,ISCALE,LESTN,LEAVE,IERROR,KANEND,KOMPER,KORDER,IN 2DTEM,IDAY,IYEAR,NUMPGE,JOBDEX,MAXLOC,N1,N2,I,LASTRD,NDREDK,DUMMY3, 3IFINAL,ILAST,IFIRST,IXTRA,KK,ICHNGE,NFIRST,L1,IEND,MCOMB,IPUNCH,NP 4ER C EQUIVALENCE(A,RANKSM,INDIVD,KOLSKR,HOLDA),(MDM,LVAR),(HOLD,KOLHLD) 1,(DUMMY1,MFREQ),(DUMMY2,MVAR),(DUMMY2(26),LASTNO),(DUMMY2(27),NVAR 2),(ERROR,KONTER,FMT),(YES,IYES) C DOUBLE PRECISION JOB,JOBNMB,JBND,REF,SECMON,FRSTMO,REFLEK,BLANKS, 1BND,JB DOUBLE PRECISION DUMMY2,KDUMY6 DOUBLE PRECISION AJAN,UARY,FEBR,RUARY,AMAR,APR,AMAY,AJUNE,AJULY, 1AUGUST,SEPT DOUBLE PRECISION TEMB,OCT,OMBER,ANOV,AMBER,DEC,EMBER DOUBLE PRECISION DLTE DOUBLE PRECISION RFG,PROB,RESP,RELIC DOUBLE PRECISION DELET DOUBLE PRECISION PAN C C IF PRINT OUT OF THE SCORED INPUT DATA IN THE SAME ORDER AS THE C FINAL SCALED DATA IS DESIRED, THEN AN ADDITIONAL TAPE UNIT, C DESIGNATED IT1 HERE, IS NEEDED. DATA PROB/8HPROBLM / DATA RESP/8HRESPON / DATA RELIC/8HRFLECT / DATA DLTE/8HDELETE / DATA RFG/8HR / DATA BLANKS/8H / DATA AFFR/4HYES / 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/ REFLEK=RFG DUMMY2(1)=PROB DUMMY2(2)=RESP DUMMY2(3)=RELIC DUMMY2(4)=DLTE YES=AFFR IT1=1 C IT4=4 C 5 READ (5,1000)JB,JOBNMB,IMON,IDAY,IYEAR,NVAR,NCASE,INVERS,ISCALE,NF 1IRST,NPER,MCOMB,IEND,IFINAL,IERROR,LASTRD,NDREDK,ICHNGE,LEAVE ,LES 2TN,ILAST,IXTRA,IFIRST,IPUNCH,MATVAR,NTAPE,IDELET KOMPER=0 15 IF(JB.NE.PROB) GO TO 955 152 READ (5,1001)JB,(KVAR(J),J=1,NVAR) IF(JB.NE.RESP) GO TO 955 158 LASTNO=NVAR*NCASE MAXLOC=8000-NCASE-NCASE-NCASE-NCASE IF(LASTNO-MAXLOC)16,16,900 16 IF(NTAPE)18,18,184 18 NTAPE=5 GO TO 188 C 184 IF(NTAPE-5)185,188,185 C 185 IF(NTAPE-IT1)186,975,186 186 IF(NTAPE-IT4)187,975,187 187 REWIND NTAPE 188 INDRNK=LASTNO+NCASE INDKOL=INDRNK+NCASE INDTEM=INDKOL+NCASE INDIDV=LASTNO DELET=BLANKS IF(-IDELET)3,4,4 3 DELET=YES 4 WRITE (6,4980)JOBNMB,NVAR,LESTN,NCASE,INVERS,ISCALE,NFIRST,NPER,MC 1OMB,IEND WRITE (6,4985)IFINAL,IERROR,ICHNGE,LEAVE,ILAST,IXTRA,IFIRST,IPUNCH 1,DELET ASSIGN 153 TO KSKIP IF (IFIRST.EQ.IYES) GO TO 7 6 IFIRST=2 GO TO 8 C 7 REWIND IT1 IFIRST=1 8 IF(-IDELET)1581,1655,1655 1581 READ (5,1003)JB,N3,N1(1),(N2(M),M=1,20) IF(JB.NE.DLTE) GO TO 955 1582 ASSIGN 1525 TO ISKIP IF(-N3)1583,1586,1584 1586 N3=NVAR 1583 ASSIGN 151 TO KSKIP 1584 IDELET=N1(1) IF(-N1(1))1585,1655,1655 1585 ISAVE=IFIRST IFIRST=1 IT2=IT1 IT1=IT4 REWIND IT1 C C CONVERT DATE C 1655 GO TO(2010,2020,2030,2040,2050,2060,2070,2080,2090,2100,2110,2120) 1,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.NE.IYES) GO TO 26 25 READ (5,1001)JB,(INV(J),J=1,NVAR) IF(JB.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) DO 36 K=1,NVAR 36 LVAR(K)=K JB=NCASE WRITE (6,4002)NTAPE,(FMT(M),M=1,MATVAR) GO TO(37,40),IFIRST 37 WRITE(IT1) (LVAR(M),M=1,NVAR) 40 MIN=MAX+1 MAX=MAX+NVAR INDIDV=INDIDV+1 43 IF(MIN-LASTNO)45,45,165 45 READ (NTAPE,FMT)INDIVD(INDIDV),(A(M),M=MIN,MAX) K=0 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 110 L=8 K=K+1 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 LL=L MFREQ(J,LL)=MFREQ(J,LL)+1 150 CONTINUE GO TO KSKIP,(151,153) 151 IF(N3-K)154,154,153 154 GO TO ISKIP,(1525,1530) 1525 ASSIGN 1530 TO ISKIP WRITE (6,4000)N3,(LVAR(M),M=1,NVAR) 1530 WRITE (6,4001)INDIVD(INDIDV),(A(M),M=MIN,MAX) LASTNO=LASTNO-NVAR NCASE=NCASE-1 MM=MIN-1 DO 145 M=1,NVAR MM=MM+1 IF(A(MM))141,143,141 141 N=A(MM) GO TO 144 143 N=8 144 MN=LVAR(M) 145 MFREQ(MN,N)=MFREQ(MN,N)-1 GO TO 43 153 GO TO(155,40),IFIRST 155 NPOINT=MAX-MIN+1 IF (NPOINT.GT.127) GO TO 1555 WRITE(IT1)INDIVD(INDIDV),(A(M),M=MIN,MAX) GO TO 40 1555 WRITE(IT1)INDIVD(INDIDV),(A(M),M=MIN,MIN+126) NPOINT=(MAX-MIN+1)/128 NWED=MIN+126 IF (NPOINT.LE.1) GO TO 1556 DO 1557 M=1,NPOINT-1 NJ=(M-1)*128+NWED+1 NJJ=M*128+NWED 1557 WRITE(IT1)(A(JJJ),JJJ=NJ,NJJ) 1556 NJ=(NPOINT-1)*128+NWED+1 WRITE(IT1)(A(JJJ),JJJ=NJ,MAX) 160 GO TO 40 C 165 DO 168 L=1,NVAR IF(-(INV(L)))166,167,167 166 REF(L)=REFLEK GO TO 168 167 REF(L)=BLANKS 168 CONTINUE IF(-IDELET)1681, 169,169 C DELETE UNWANTED VARIABLES 1681 NVAR1=NVAR-1 DO 1690 J=1,IDELET L=N2(J) DO 1683 K=1,NVAR IF(LVAR(K)-L)1683,1684,1683 1683 CONTINUE GO TO 945 1684 DO 1685 II=K,NVAR1 1685 LVAR(II)=LVAR(II+1) LVAR(NVAR)=L REF(NVAR)=SAVE 1690 CONTINUE NVAR1=NVAR NVAR=NVAR-IDELET IF(-NVAR)169,945,945 169 II=INDRNK-IDINT(JB+.5D0) LASTNO=NVAR*NCASE INDRNK=LASTNO+NCASE INDKOL=INDRNK+NCASE INDTEM=INDKOL+NCASE INDIDV=LASTNO IF(NCASE-IDINT(JB+.5D0))1692,1691,1691 1692 INDEX=INDIDV DO 1695 M=1,NCASE INDEX=INDEX+1 II=II+1 1695 INDIVD(INDEX)=INDIVD(II) 1691 GO TO (170,171),IFIRST 170 END FILE IT1 REWIND IT1 1707 IF(IT1-IT4)171,1711,171 1711 IT1=IT2 IFIRST=ISAVE WRITE (6,4901)IDELET,NVAR,NVAR1,(N2(M),M=1,IDELET) INDEX=0 MAX=0 GO TO (1720,1723),IFIRST 1720 WRITE(IT1) (LVAR(M),M=1,NVAR) 1723 READ(IT4) (N1(M),M=1,NVAR1) DO 1750 J=1,NCASE INDIDV=INDIDV+1 READ(IT4) INDIVD(INDIDV),(HOLD(M),M=1,NVAR1) DO 1725 K=1,NVAR L=LVAR(K) INDEX=INDEX+1 1725 A(INDEX)=HOLD(L) GO TO(1730,1750),IFIRST 1730 MIN=MAX+1 MAX=MAX+NVAR NPOINT=MAX-MIN+1 IF (NPOINT.GT.127) GO TO 1770 WRITE(IT1)INDIVD(INDIDV),(A(M),M=MIN,MAX) GO TO 1750 1770 WRITE(IT1)INDIVD(INDIDV),(A(M),M=MIN,MIN+126) NPOINT=(MAX-MIN+1)/128 NWED=MIN+126 IF (NPOINT.LE.1) GO TO 1771 DO 1772 M=1,NPOINT-1 NJ=(M-1)*128+NWED+1 NJJ=M*128+NWED 1772 WRITE(IT1)(A(JJJ),JJJ=NJ,NJJ) 1771 NJ=(NPOINT-1)*128+NWED+1 WRITE(IT1)(A(JJJ),JJJ=NJ,MAX) 1750 CONTINUE GO TO(1760,1765),IFIRST 1760 END FILE IT1 REWIND IT1 1765 REWIND IT4 171 DO 1713 J=1,25 N1(J)=0 1713 N2(J)=0 IF(NCASE-JB)1705,1714,1705 1705 WRITE (6,4930)NCASE,JB 1714 IF(NTAPE-5)1715,173,172 1715 REWIND NTAPE GO TO 173 172 CALL REMOVE(NTAPE) 173 RETURN C 900 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) GO TO 150 C 945 WRITE (6,4945) GO TO 946 C 955 WRITE(6,4955)JB 946 KOMPER=1 GO TO 171 C 975 WRITE (6,4975)NTAPE GO TO 946 C 8000 FORMAT(20A4) 1000 FORMAT(2A6,4I2,I5,3A3,I2,I3,3A3,I1,2I2,A3,I2,4A3,3I2) 1001 FORMAT(A6,25I2) 1002 FORMAT(18A4) 1003 FORMAT(A6,22I3) C 4000 FORMAT(1H0,20X,22HTHESE RESPONDENTS HAVEI3,52H OR MORE NO RESPONSE 1S AND ARE DELETED FROM THE SCALE //2X,10HRESPONDENT,33X,9HRESPONSE 2S//14X,25I4//) 4001 FORMAT(1H ,3X,I6,5X,25F4.0) 4002 FORMAT(1H0,32X,26HDATA READ IN FROM BCD TAPEI3,27H UNDER THE FOLLO 1WING FORMAT,//(1X,30A4)) 4900 FORMAT(1H1,30X,57HMAXIMUM DATA STORAGE EXCEEDED. SCALE WILL BE COM 1PUTED FOR,I4,17H CASES INSTEAD OF,I4,7H CASES.) 4901 FORMAT(1H0,17X,I3,38H QUESTIONS WERE DELETED. THERE ARE NOW,I3,39H 1 QUESTIONS WHERE, INITIALLY, THERE WERE,I3,1H./ 26X,27HTHE QUESTIONS DELETED WERE 20I4) 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 1ION,I3) 4930 FORMAT(1H0,29X,13HTHERE ARE NOW,I6,33H CASES WHERE INITIALLY THERE 1 WERE,I6,1H.) 4935 FORMAT(1H0,9X,47HTHERE MUST BE AT LEAST 2 RESPONSES FOR QUESTION,I 13,52H BUT NO MORE THAN 7. PLEASE CHECK THE RESPONSE CARD.) 4945 FORMAT(1H0,36X,45HERROR ON DELETE CARD. PROGRAM CANNOT PROCEED.) 4955 FORMAT(1H1,32X,52HCONTROL CARDS OUT OF ORDER. PROGRAM CANNOT CONTI 1NUE.,2X,A6) 4975 FORMAT(32X19HLOGICAL TAPE NUMBERI3,32H VIOLATES RESTRICTION FOR IN 1PUT.) 4980 FORMAT(1H0,15X,26H* * * PROBLEM CARD * * *//19H JOB IDENTIFICATI 1ON 17(1H.1X),A6/21H NUMBER OF QUESTIONS 16(1H.1X),I6/43H LEAST NUM 2BER OF QUESTIONS TO BE CONSIDERED 5(1H.1X),I6/17H NUMBER OF CASES 318(1H.1X),I6/19H REFLECTION DESIRED 17(1H.1X),3X,A3/27H PRINT WEIG 4HTED INPUT DATA 13(1H.1X),3X,A3/43H COMBINE WHEN FREQUENCY LESS TH 5AN N PERCENT 5(1H.1X),3X,A3/37H N FOR COMBINATION ABOVE (IN PERCEN 6T) 8(1H.1X),I6/31H NUMBER OF FORCED COMBINATIONS 11(1H.1X),I6/37H 7PROGRAM TO MAKE FURTHER COMBINATIONS 8(1H.1X),3X,A3) 4985 FORMAT(35H PRINT OUT RANKED DATA AT EACH STEP 1 9(1H.1X),3X,A3/31H PRINT OUT ERRORS AT EACH STE 2P 11(1H.1X),3X,A3/17H Q FOR RERANKING 18(1H.1X),I6/53H TERMINATE W 3HEN QUESTIONS HAVE, AT MOST, 3 RESPONSES 3X,A3/21H PRINT FINAL RAN 4KING 16(1H.1X),3X,A3/43H PRINT ORDERED RESPONDENTS AND SCALE SCORE 5 5(1H.1X),3X,A3/39H PRINT INITIAL RESPONSES IN FINAL ORDER 7(1H.1X 6),3X,A3/23H PUNCHED CARDS DESIRED 15(1H.1X),3X,A3/21H READ IN DELE 7TE CARD 16(1H.1X),3X,A3//) END C SUBROUTINE REMOVE SUBROUTINE REMOVE(N) REWIND N RETURN C END 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 1IED, ASSUMED TO BE 1.) C 50 RETURN END