!
!  *************************************************************************
!    HOUSYM3.FOR -- CREATES SYMMETRIC MATRIX OF AGREEMENT SCORES
!
!                      (THIS IS AN OLD PROGRAM -- C. 1979-82)
!
!                               7 MARCH 2003 (F95 27 JUNE 2010)
!                
!  *************************************************************************
! 
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION ROWMEAN(1535),XLDATA(1535,1535),&
                 KDATA(1601,1535),LDATA(1535,1601),AMAT(1535,1535),&
                 WWW(1535),ZZZ(1535,1535),FV1(4605),&
                 YCENTER(1535,1535),&
                 KAV(1601),KAY(1601),KAN(1601),LCOUNT(1535)
      CHARACTER*1 KNAME(1535,101)
      CHARACTER*64 FNAME,FNAME2,FMT
!
      OPEN(4,FILE='SYMSTRT3.DAT',STATUS='OLD')
      OPEN(21,FILE='HOUSYM3.DAT')
!
  100 FORMAT(36A1,2600I1)
  182 FORMAT(A64)
  183 FORMAT(3I4,F6.3)
  201 FORMAT(36A1,1535I4)
!  201 FORMAT(36A1,1535f6.3)
  202 FORMAT(36A1,36A1,4I5)
  203 FORMAT(' COUNTS 0 - 9',10I7)
  204 FORMAT(36A1,1535f10.4)
  300 FORMAT(' NUMBER OF RECORDS READ',6I6)
  360 FORMAT(' EIGENVALUES OF DECOMPOSITION')
  370 FORMAT(1X,I5,5F12.5)
  371 FORMAT(' MISSING ELEMENTS',1X,2I10,F10.4)
  380 FORMAT(' ERROR PARAMETER EIGENVALUE-EIGENVECTOR ROUTINE=',I5)
 1000 FORMAT(' START TIME OF JOB    ',3F12.7)
 1001 FORMAT(' END TIME OF JOB      ',3F12.7)
 1002 FORMAT(' ELAPSED TIME OF JOB  ',3F12.7)
!
      call cpu_time(result)
      write(*,1000)result
!
      READ(4,182)FNAME 
      WRITE(21,182)FNAME
      WRITE(*,182)FNAME
      OPEN(1,FILE=FNAME,STATUS='OLD')
      READ(4,182)FNAME2
      WRITE(21,182)FNAME2
      WRITE(*,182)FNAME2
      OPEN(UNIT=20,FILE=FNAME2)
      READ(4,182)FMT
      WRITE(21,182)FMT
      WRITE(*,182)FMT
      READ(4,183)NVOTE,JNE,KVMIN,XVMIN
      WRITE(21,183)NVOTE,JNE,KVMIN,XVMIN
      WRITE(*,183)NVOTE,JNE,KVMIN,XVMIN
!
      I=0
  500 READ(1,FMT,END=400)(KNAME(I+1,J),J=1,JNE),&
                          (LDATA(I+1,J),J=1,NVOTE)
      I=I+1
      LCOUNT(I)=0
      ROWMEAN(I)=0.0
      GO TO 500
  400 WRITE(*,300)I
      WRITE(21,300)I
      NP=I
!
!  CALL CLEAN TO ELIMINATE LOPSIDED ROLL CALLS AND MEMBERS
!    WHO DID NOT VOTE ENOUGH
!
!
      DO 46 J=1,NVOTE
      DO 45 I=1,NP
      LCOUNT(LDATA(I,J)+1)=LCOUNT(LDATA(I,J)+1)+1
  45  CONTINUE
  46  CONTINUE
!
!  WRITE OUT COUNTS OF ROLL CALL CATEGORIES
!
      WRITE(21,203)(LCOUNT(J),J=1,10)
      WRITE(*,203)(LCOUNT(J),J=1,10)
!
      CALL CLEAN(NP,NVOTE,XVMIN,KVMIN,JNE,KPTSUM,KAV,KAY,KAN,&
                  KNAME,LDATA)
!
!  TRANSFER INTO TRANSPOSED MATRIX
!
      DO 47 I=1,10
      LCOUNT(I)=0
  47  CONTINUE
      DO 40 I=1,NP
      DO 41 J=1,NVOTE
      KDATA(J,I)=LDATA(I,J)
      LCOUNT(LDATA(I,J)+1)=LCOUNT(LDATA(I,J)+1)+1
  41  CONTINUE
  40  CONTINUE
!
!  WRITE OUT COUNTS OF ROLL CALL CATEGORIES
!
      WRITE(21,203)(LCOUNT(J),J=1,10)
      WRITE(*,203)(LCOUNT(J),J=1,10)
!
      KMISS=0
      DO 1 I=1,NP
      DO 1 J=1,NP
      KNUM=0
      KNUMY=0
      KNUMN=0
      KDEM=0
      DO 2 K=1,NVOTE
      K1=KDATA(K,I)
      K2=KDATA(K,J)
      IF(K1.EQ.0.OR.K1.EQ.7.OR.K1.EQ.8.OR.K1.EQ.9)GO TO 2
      IF(K2.EQ.0.OR.K2.EQ.7.OR.K2.EQ.8.OR.K2.EQ.9)GO TO 2
      IF(K1.EQ.1.OR.K1.EQ.2.OR.K1.EQ.3)K1=1
      IF(K1.EQ.4.OR.K1.EQ.5.OR.K1.EQ.6)K1=6
      IF(K2.EQ.1.OR.K2.EQ.2.OR.K2.EQ.3)K2=1
      IF(K2.EQ.4.OR.K2.EQ.5.OR.K2.EQ.6)K2=6
      KDEM=KDEM+1
      IF(K1.EQ.K2)KNUM=KNUM+1
      IF(K1.EQ.K2.AND.K1.EQ.1)KNUMY=KNUMY+1
      IF(K1.EQ.K2.AND.K1.EQ.6)KNUMN=KNUMN+1
  2   CONTINUE
      LDATA(I,J)=-99
      IF(KDEM.GT.0)LDATA(I,J)=(KNUM*100)/KDEM
      IF(KDEM.GT.0)XLDATA(I,J)=FLOAT(KNUM)/FLOAT(KDEM)
      IF(KDEM.EQ.0)XLDATA(I,J)=.5
!
      AMAT(I,J)=0.0
!      IF(KDEM.GT.0)AMAT(I,J)=(2.0*(1.0-FLOAT(KNUM)/FLOAT(KDEM)))**2
      IF(KDEM.GT.0)AMAT(I,J)=(1.0*(1.0-FLOAT(KNUM)/FLOAT(KDEM)))**2
!      IF(KDEM.GT.0)AMAT(I,J)=((100.0-FLOAT(LDATA(I,J)))/50.0)**2
!      IF(KDEM.EQ.0)AMAT(I,J)=1.0
      IF(KDEM.EQ.0)AMAT(I,J)=.25
      IF(KDEM.EQ.0)KMISS=KMISS+1
!
      WRITE(29,202)(KNAME(I,JJ),JJ=1,JNE),(KNAME(J,JJ),JJ=1,JNE),&
                    KNUMY,KNUMN,KNUM,KDEM
  1   CONTINUE
!
!  DOUBLE-CENTER THE AGREEMENT SCORE MATRIX
!
      XMISS=100.0*(FLOAT(KMISS)/FLOAT(NP*NP))
      WRITE(21,371)NP,KMISS,XMISS
      WRITE(*,371)NP,KMISS,XMISS
!
      ALLMEAN=0.0
      DO 7 I=1,NP
      RSUM=0.0
      DO 8 J=1,NP
      RSUM=RSUM+AMAT(I,J)
  8   CONTINUE
      ROWMEAN(I)=RSUM/FLOAT(NP)
      ALLMEAN=ALLMEAN+ROWMEAN(I)
  7   CONTINUE
      ALLMEAN=ALLMEAN/FLOAT(NP)
!
!  SETUP DOUBLE-CENTERED AGREEMENT SCORE MATRIX
!
      DIAGSQ=0.0
      SUMTOT=0.0
      DO 33 I=1,NP
      DO 34 J=1,NP
      YCENTER(I,J)=(AMAT(I,J)-ROWMEAN(I)-ROWMEAN(J)+ALLMEAN)/(-2.0)
      IF(I.EQ.J)DIAGSQ=DIAGSQ+YCENTER(I,J)
      SUMTOT=SUMTOT+YCENTER(I,J)**2
  34  CONTINUE
      WRITE(20,204)(KNAME(I,JJ),JJ=1,JNE),(YCENTER(I,JJ),JJ=1,NP)
  33  CONTINUE
!      
      LWORK=4605
      CALL DSYEV('V','L',NP,YCENTER,1535,WWW,FV1,LWORK,INFO)
!      CALL RS(1535,NP,YCENTER,WWW,1,ZZZ,FV1,FV2,IERR)
      WRITE(*,380)INFO
      WRITE(*,360)
      WRITE(21,380)INFO
      WRITE(21,360)
      SUMEIG=0.0
      DO 30 I=1,NP
      SUMEIG=SUMEIG+WWW(NP+1-I)**2
  30  CONTINUE
!
!      DO 4 I=1,20
      DO 4 I=1,NP
      AAA=WWW(NP+1-I)/SQRT(SUMEIG)
      IF(I.EQ.1)THEN
         WRITE(21,370)I,WWW(NP+1-I),AAA,DIAGSQ,SUMTOT,SUMEIG
         WRITE(*,370)I,WWW(NP+1-I),AAA,DIAGSQ,SUMTOT,SUMEIG
      ENDIF
      IF(I.GT.1)THEN
         WRITE(21,370)I,WWW(NP+1-I),AAA
         WRITE(*,370)I,WWW(NP+1-I),AAA
      ENDIF
  4   CONTINUE
      DO 3 I=1,NP
!      write(21,1400)i,rowmean(i)
 1400 format(i4,f12.5)
!      write(33,1401)(KNAME(I,J),J=1,JNE),zzz(i,np),zzz(i,np-1)
 1401 format(36a1,122f12.5)
!
      WRITE(20,201)(KNAME(I,J),J=1,JNE),&
                     (LDATA(I,J),J=1,NP)
!                     (XLDATA(I,J),J=1,NP)
  3   CONTINUE
!
!      write(*,1776)allmean
 1776 format(' matrix mean fartnocker!',f12.5)
!
      call cpu_time(result1)
      write(*,1001)result1
      write(21,1001)result1
      TOTALTIME=RESULT1-RESULT
      WRITE(*,1002)TOTALTIME
      WRITE(21,1002)TOTALTIME
!
      STOP
      END
!
! ****************************************************************************
!  SUBROUTINE CLEAN----CALLED BY MAIN.  THROWS OUT ALL ROLLCALLS BELOW A
!     CUTOFF POINT (XVMIN)--USUALLY .05 OR .025.  THROWS OUT ALL LEGISLATORS
!     WHO HAVE VOTED KVMIN TIMES OR LESS (KVMIN=10 USUALLY).  KNAME(,)--
!     CHARACTER ARRAY HOLDING INFORMATION ON LEGISLATORS IS REARRANGED TO
!     HOLD ONLY INCLUDED LEGISLATORS.  LDATA( , ) IS THEN FILLED WITH THE
!     INCLUDED ROLL CALL VOTES.
! ****************************************************************************
!
      SUBROUTINE CLEAN(NOBS,NRCALL,XVMIN,KVMIN,JNE,KPTSUM,&
                        KAV,KAY,KAN,KNAME,LDATA)
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      DIMENSION KKSUM(1601),LLSUM(1601),MMSUM(1535),NNSUM(1535),&
                KD(1601),KMARG(50),LDATA(1535,1601),&
                KAV(1601),KAY(1601),KAN(1601),KNAME(1535,101)
      CHARACTER*1 KNAME
      CHARACTER*10 LMARG(10)
!
      DATA KKSUM,LLSUM,KMARG/1601*0,1601*0,50*0/
!
      LMARG(1)= '50 - 55   '
      LMARG(2)= '56 - 60   '
      LMARG(3)= '61 - 65   '
      LMARG(4)= '66 - 70   '
      LMARG(5)= '71 - 75   '
      LMARG(6)= '76 - 80   '
      LMARG(7)= '81 - 85   '
      LMARG(8)= '86 - 90   '
      LMARG(9)= '91 - 95   '
      LMARG(10)='96 - 99.5 '
      KPTSUM=0
      NAS=0
      NRS=0
      NOB=0
      NMOB=0
      DO 1 I=1,NOBS
      ISUM=0
      JSUM=0
      DO 2 J=1,NRCALL
      KD(J)=LDATA(I,J)
      IF(KD(J).EQ.1.OR.KD(J).EQ.2.OR.KD(J).EQ.3)KKSUM(J)=KKSUM(J)+1
      IF(KD(J).EQ.1.OR.KD(J).EQ.2.OR.KD(J).EQ.3)ISUM=ISUM+1
      IF(KD(J).EQ.4.OR.KD(J).EQ.5.OR.KD(J).EQ.6)LLSUM(J)=LLSUM(J)+1
  2   IF(KD(J).EQ.4.OR.KD(J).EQ.5.OR.KD(J).EQ.6)JSUM=JSUM+1
      MMSUM(I)=ISUM
  1   NNSUM(I)=JSUM
      DO 3 I=1,NOBS
      LL=MMSUM(I)+NNSUM(I)
      IF(LL.GT.KVMIN)NOB=NOB+1
      IF(LL.LE.KVMIN)NMOB=NMOB+1
      IF(LL.LE.KVMIN)GO TO 3
      DO 333 IJ=1,JNE
  333 KNAME(NOB,IJ)=KNAME(I,IJ)
      NAS=0
      NRS=0
      DO 33 J=1,NRCALL
      KD(J)=LDATA(I,J)
      KK=KKSUM(J)+LLSUM(J)
      LL=MIN0(KKSUM(J),LLSUM(J))
      AA=0.0
      IF(KK.GT.0)AA=FLOAT(LL)/FLOAT(KK)
      IF(AA.GT.XVMIN)NAS=NAS+1
      IF(AA.LE.XVMIN)NRS=NRS+1
      IF(AA.GT.XVMIN)KAV(NAS)=J
      IF(AA.GT.XVMIN)KAY(NAS)=KKSUM(J)
      IF(AA.GT.XVMIN)KAN(NAS)=LLSUM(J)
      IF(AA.LE.XVMIN)GO TO 33
      IF(KD(J).EQ.2.OR.KD(J).EQ.3)KD(J)=1
      IF(KD(J).EQ.4.OR.KD(J).EQ.5)KD(J)=6
      IF(KD(J).EQ.7.OR.KD(J).EQ.8.OR.KD(J).EQ.9)KD(J)=0
      LDATA(NOB,NAS)=KD(J)
      IF(KD(J).NE.0)KPTSUM=KPTSUM+1
 33   CONTINUE
  3   CONTINUE
      WRITE(21,1000)NRCALL,NRS,NAS,XVMIN
 1000 FORMAT(' ROLL-CALLS READ=',I4,2X,'NUMBER REJECTED=',I4,2X,&
      'NUMBER ACCEPTED=',I4,2X,'CUTOFF=',F6.3)
      WRITE(21,1001)NOBS,NMOB,NOB,KVMIN
 1001 FORMAT(' LEGISLATORS READ=',I4,2X,'NUMBER REJECTED=',I4,2X,&
      'NUMBER ACCEPTED=',I4,2X,'CUTOFF=',I4)
      NRCALL=NAS
      NOBS=NOB
!
!   CALCULATE DISTRIBUTION OF ROLL CALL MARGINS
!
      DO 40 J=1,NRCALL
      KAY(J)=0
      KAN(J)=0
      DO 41 I=1,NOBS
      IF(LDATA(I,J).EQ.1)KAY(J)=KAY(J)+1
      IF(LDATA(I,J).EQ.6)KAN(J)=KAN(J)+1
  41  CONTINUE
  40  CONTINUE
      LLTOT=0
      LLALL=0
      DO 4 J=1,NRCALL
      LL=MAX0(KAY(J),KAN(J))
      LLTOT=LLTOT+LL
      AA=FLOAT(LL)/FLOAT(KAY(J)+KAN(J))
      LLALL=LLALL+KAY(J)+KAN(J)
      IF(AA.GE..50.AND.AA.LE..55)KMARG(1)=KMARG(1)+1
      IF(AA.GT..55.AND.AA.LE..60)KMARG(2)=KMARG(2)+1
      IF(AA.GT..60.AND.AA.LE..65)KMARG(3)=KMARG(3)+1
      IF(AA.GT..65.AND.AA.LE..70)KMARG(4)=KMARG(4)+1
      IF(AA.GT..70.AND.AA.LE..75)KMARG(5)=KMARG(5)+1
      IF(AA.GT..75.AND.AA.LE..80)KMARG(6)=KMARG(6)+1
      IF(AA.GT..80.AND.AA.LE..85)KMARG(7)=KMARG(7)+1
      IF(AA.GT..85.AND.AA.LE..90)KMARG(8)=KMARG(8)+1
      IF(AA.GT..90.AND.AA.LE..95)KMARG(9)=KMARG(9)+1
      IF(AA.GT..95.AND.AA.LE..995)KMARG(10)=KMARG(10)+1
  4   CONTINUE
      WRITE(21,1003)
 1003 FORMAT('  DISTRIBUTION OF SCALABLE ROLL CALLS')
      DO 5 I=1,10
      AA=FLOAT(KMARG(I))/FLOAT(NRCALL)
      WRITE(21,1002)I,LMARG(I),KMARG(I),AA
  5   CONTINUE
 1002 FORMAT(I4,1X,A10,I5,F7.3)
      XSUM=FLOAT(LLTOT)/FLOAT(LLALL)
      WRITE(21,1004)LLTOT,LLALL,XSUM
      WRITE(*,1004)LLTOT,LLALL,XSUM
 1004 FORMAT(' AVERAGE MAJORITY MARGIN= ',2I8,F9.5)
      RETURN
      END
