C
C ***************************************************************************
C
C  NOLAN.FOR---READS [].CRR AND HOU[]KH.SRT AND CALCULATES AGREEMENT
C               SCORES AND GEOGRAPHIC DISTANCES                 
C                                      
C ***************************************************************************
C
      dimension ISTATE(461),IPARTY(461),X1(461),X2(461),
     C          KVOTE(461,1600),ID1(461),XX(461,2),
     C          XCENTER(461,2),
     C          SSS(1601),UUU(461,461),VVV(461,461)
      CHARACTER*1 KSTA(10),KA(20)
      integer*2 itim1,itim2,itim3,itim4,jtim1,jtim2,jtim3,jtim4
      open(1,file='96.CRR',status='old')
      OPEN(20,FILE='C:\HOUSERCS\HOU96KH.SRT',STATUS='OLD',RECL=1600)
      OPEN(21,FILE='ROTATE96.DAT')
      OPEN(23,FILE='NOLAN96.DAT')
  100 format(I3,1x,i5,1x,i5,1x,i2,1x,i2,1x,7a1,1x,i4,1x,i1,1x,i1,1x,
     c11a1,2f7.3,I2,I3,2I6,I3,2I6,I3,2I6)
  103 FORMAT(I4,F10.4)
  105 FORMAT(I5,4F7.3)
  200 FORMAT(2I6,1X,F7.2,I2,F12.3,2F8.3)
  201 FORMAT(4I4)
  206 FORMAT(A1,I1,I3,I2,I2,I4,I5,2I1,11A1,1600I1)
  307 FORMAT(' ID MISMATCH',2I4,2I6)
  308 FORMAT(' MISMATCHING',2I4,2I3,I5/20X,2I3,I5)
  309 FORMAT(' MISMATCH ON CONGRESS NUMBER',4I4)
  310 FORMAT(' NUMBER OF RECORDS READ',2I5)
  311 FORMAT(' WRONG NUMBER OF DOTS!',I4)
  312 FORMAT(' ZERO DOTS!!',I4)
  313 FORMAT(' NUMBER RECORDS WRITTEN',I8)
  314 FORMAT(' RANK OF COORDINATE MATRIX',2I4)
  315 FORMAT(' FIRST  ESTIMATE OF BETAS',4F7.3)
  316 FORMAT(' SECOND ESTIMATE OF BETAS',4F7.3,F10.4)
 1000 format(22x,4(i2.2,'.'))
 1001 format(' ELAPSED TIME OF JOB  ',4(i2.2,'.'))
      call gettim(itim1,itim2,itim3,itim4)
C      
      JJJJ=96
      NQ=1276
      II=0
      i=0
  500 read(1,100,end=400)ncong,id1(I+1),id2,istate(i+1),idist,
     c                   (ksta(j),j=1,7),iparty(i+1),iel1,iel2,
     c                   (ka(j),j=1,11),
     c                   x1(i+1),x2(i+1),NDOT,IDIST2,KX1,KY1,IDIST2,
     C                   KX2,KY2,IDIST2,KX3,KY3
      READ(20,206,END=400)AR,K1,JCONG,JSTATE,JDIST,JJPARTY,JD1,JEL1,
     C                   JEL2,(KA(J),J=1,11),(KVOTE(I+1,J),J=1,NQ)
      II=II+1
      IF(X1(I+1).EQ.0.0.AND.X2(I+1).EQ.0.0)GO TO 500
      i=i+1
      XCENTER(I,1)=X1(I)
      XCENTER(I,2)=X2(I)
C
C  ERROR CHECKS
C
      KSUM=ABS(ISTATE(I)-JSTATE)+ABS(IDIST-JDIST)+
     C     ABS(IPARTY(I)-JJPARTY)
      LSUM=ABS(JJJJ-NCONG)+ABS(JJJJ-JCONG)
      IF(ID1(I).NE.JD1)THEN
         WRITE(*,307)JJJJ,II,ID1(I),JD1
         STOP
      ENDIF
C
C  GET ICPSR ID COUNTS
C
C  
      IF(KSUM.NE.0)THEN
         WRITE(*,308)JJJJ,II,ISTATE(I),IDIST,IPARTY(I),
     C               JSTATE,JDIST,JJPARTY
         STOP
      ENDIF
      IF(LSUM.NE.0)THEN
         WRITE(*,309)JJJJ,II,NCONG,JCONG
         STOP
      ENDIF
C  
C  ASSEMBLE GEOGRAPHIC COORDINATE VECTOR
C
      IF(NDOT.EQ.0)THEN
         WRITE(*,312)I
         STOP
      ENDIF
      IF(NDOT.GT.0)THEN
         IF(NDOT.EQ.1)THEN
            XX(I,1)=FLOAT(KX1)
            XX(I,2)=FLOAT(KY1)
            GO TO 500
         ENDIF
         IF(NDOT.EQ.2)THEN
            XX(I,1)=FLOAT(KX1+KX2)/2.0
            XX(I,2)=FLOAT(KY1+KY2)/2.0
            GO TO 500
         ENDIF
         IF(NDOT.EQ.3)THEN
            XX(I,1)=FLOAT(KX1+KX2+KX3)/3.0
            XX(I,2)=FLOAT(KY1+KY2+KY3)/3.0
            GO TO 500
         ENDIF
         IF(NDOT.GT.3)THEN
            WRITE(*,311)II
            STOP
         ENDIF
      ENDIF
C BOSTON
      IF(NDOT.EQ.-1)THEN
         XX(I,1)=1590.0    
         XX(I,2)= 490.0
         GO TO 500
      ENDIF
C NEW YORK
      IF(NDOT.EQ.-2)THEN
         XX(I,1)=1440.0    
         XX(I,2)= 310.0
         GO TO 500
      ENDIF
C PHILADELPHIA
      IF(NDOT.EQ.-3)THEN
         XX(I,1)=1390.0
         XX(I,2)= 230.0
         GO TO 500
      ENDIF
C BALTIMORE
      IF(NDOT.EQ.-4)THEN
         XX(I,1)=1300.0
         XX(I,2)= 150.0
         GO TO 500
      ENDIF
C NEW ORLEANS
      IF(NDOT.EQ.-5)THEN
         XX(I,1)= 440.0
         XX(I,2)=-770.0
         GO TO 500
      ENDIF
C CHICAGO
      IF(NDOT.EQ.-6)THEN
         XX(I,1)= 520.0
         XX(I,2)= 250.0
         GO TO 500
      ENDIF
C PITTSBURGH
      IF(NDOT.EQ.-7)THEN
         XX(I,1)=1060.0
         XX(I,2)= 210.0
         GO TO 500
      ENDIF
C ST. LOUIS
      IF(NDOT.EQ.-8)THEN
         XX(I,1)= 380.0
         XX(I,2)= -10.0
         GO TO 500
      ENDIF
C
C LOS ANGELES
      IF(NDOT.EQ.-9.AND.ISTATE(I).EQ.71)THEN
         XX(I,1)=-1600.0
         XX(I,2)= -250.0
         GO TO 500
      ENDIF
C DETROIT
      IF(NDOT.EQ.-9.AND.ISTATE(I).EQ.23)THEN
         XX(I,1)=  800.0
         XX(I,2)=  310.0
         GO TO 500
      ENDIF
C HOUSTON
      IF(NDOT.EQ.-9.AND.ISTATE(I).EQ.49)THEN
         XX(I,1)=   40.0
         XX(I,2)= -810.0
         GO TO 500
      ENDIF
C CLEVELAND
      IF(NDOT.EQ.-9.AND.ISTATE(I).EQ.24)THEN
         XX(I,1)=  920.0
         XX(I,2)=  270.0
         GO TO 500
      ENDIF
      go to 500
  400 write(*,310)i,II
      NP=I
C
C  PERFORM SINGULAR VALUE DECOMPOSITION OF D-NOMINATE COORDINATES
C
      XTOL=.001
      CALL LSVRR(NP,2,XCENTER,461,21,XTOL,IRANK,SSS,UUU,
     C           461,VVV,461)
      WRITE(*,314)NP,IRANK
      DO 41 I=1,5
      WRITE(21,103)I,SSS(I)
      WRITE(* ,103)I,SSS(I)
  41  CONTINUE
C
C  PERFORM REGRESSION TO CALCULATE ROTATION WHICH ORTHOGONALIZES
C     POLITICAL PARTY
C
      SUM=0.0
      DO 42 I=1,NP
      SUM=SUM+FLOAT(IPARTY(I))/100.0
  42  CONTINUE
      SUM=SUM/FLOAT(NP)
      SUM1=0.0
      SUM2=0.0
      DO 43 I=1,NP
      YY=(FLOAT(IPARTY(I))/100.0) - SUM
      SUM1=SUM1+(1.0/SSS(1))*UUU(I,1)*YY
      SUM2=SUM2+(1.0/SSS(2))*UUU(I,2)*YY
  43  CONTINUE
      STOT=SQRT(SUM1**2 + SUM2**2)
      SUM11=SUM1/STOT
      SUM22=SUM2/STOT
      WRITE(21,315)SUM1,SUM2,SUM11,SUM22
      DO 44 I=1,NP
      X1(I)= UUU(I,1)*SSS(1)*SUM11 + UUU(I,2)*SSS(2)*SUM22
      X2(I)=-UUU(I,1)*SSS(1)*SUM22 + UUU(I,2)*SSS(2)*SUM11
      XCENTER(I,1)=X1(I)
      XCENTER(I,2)=X2(I)
  44  CONTINUE
      CALL LSVRR(NP,2,XCENTER,461,21,XTOL,IRANK,SSS,UUU,
     C           461,VVV,461)
      WRITE(*,314)NP,IRANK
      DO 46 I=1,5
      WRITE(21,103)I,SSS(I)
      WRITE(* ,103)I,SSS(I)
  46  CONTINUE
      SUM1=0.0
      SUM2=0.0
      SUME=0.0
      DO 45 I=1,NP
      YY=(FLOAT(IPARTY(I))/100.0) - SUM
      SUM1=SUM1+((VVV(1,1)/SSS(1))*UUU(I,1)+
     C           (VVV(1,2)/SSS(2))*UUU(I,2))*YY
      SUM2=SUM2+((VVV(2,1)/SSS(1))*UUU(I,1)+
     C           (VVV(2,2)/SSS(2))*UUU(I,2))*YY
      AA=UUU(I,1)*SSS(1)*VVV(1,1) + UUU(I,2)*SSS(2)*VVV(1,2)
      BB=UUU(I,1)*SSS(1)*VVV(2,1) + UUU(I,2)*SSS(2)*VVV(2,2)
      SUME=SUME+(XCENTER(I,1)-AA)**2
      SUME=SUME+(XCENTER(I,2)-BB)**2
  45  CONTINUE
      STOT=SQRT(SUM1**2 + SUM2**2)
      SUM11=SUM1/STOT
      SUM22=SUM2/STOT
      WRITE(21,316)SUM1,SUM2,SUM11,SUM22,SUME
      JOYBOY=98
C      IF(JOYBOY.EQ.98)STOP
C
C
C
C  LOOP TO CREATE ALL PAIRWISE VOTERS
C
      KJ=0
      DO 99 I=1,NP-1
      DO 98 J=I+1,NP
      KK=0
      KKK=0
      DO 97 K=1,NQ
      IVOTE=0
      IF(KVOTE(I,K).GE.1.AND.KVOTE(I,K).LE.3)IVOTE=1
      IF(KVOTE(I,K).GE.4.AND.KVOTE(I,K).LE.6)IVOTE=6
      JVOTE=0
      IF(KVOTE(J,K).GE.1.AND.KVOTE(J,K).LE.3)JVOTE=1
      IF(KVOTE(J,K).GE.4.AND.KVOTE(J,K).LE.6)JVOTE=6
      IF(IVOTE.EQ.0)GO TO 97
      IF(JVOTE.EQ.0)GO TO 97
      KK=KK+1
      IF(IVOTE.EQ.JVOTE)KKK=KKK+1
  97  CONTINUE
      IF(KK.LE.10)GO TO 98
C AGREEMENT SCORE
      XIJAGREE=(FLOAT(KKK)/FLOAT(KK))*100.0
C IDEOLOGICAL DISTANCE
      XIJD1=(X1(I)-X1(J))**2
      XIJD2=(X2(I)-X2(J))**2
C GEOGRAPHIC DISTANCE
      XIJDIST=(XX(I,1)-XX(J,1))**2 + (XX(I,2)-XX(J,2))**2
      XIJDIST=SQRT(XIJDIST)
C PARTY INDICATOR VARIABLE
      IJPARTY=0
      IF(IPARTY(I).EQ.IPARTY(J))IJPARTY=1
      WRITE(23,200)ID1(I),ID1(J),XIJAGREE,IJPARTY,XIJDIST,
     C             XIJD1,XIJD2
      KJ=KJ+1
  98  CONTINUE
  99  CONTINUE
      WRITE(*,313)KJ
      call gettim(jtim1,jtim2,jtim3,jtim4)
      write(*,1000)itim1,itim2,itim3,itim4
      write(*,1001)jtim1,jtim2,jtim3,jtim4
      stop
      end