! ! *********************************************************************** ! ! SUPERED.FOR----SUPER EDITH -- THIS PROGRAM PERFORMS UNIDIMENSIONAL ! UNFOLDING OF BINARY CHOICE DATA -- IN THIS INSTANCE, ! ALL THE ROLL CALL VOTES CAST IN THE HOUSE AND SENATE ! FOR CONGRESSES 01 - 107. ! ! THIS PROGRAM PRODUCES THE STARTING COORDINATES FOR ! JUST THE UNIQUE LEGISLATORS ONLY ! ! 13 AUGUST 2002 ! ! FORTRAN 95: 19 MARCH 2011 ! ! ! *********************************************************************** ! IMPLICIT DOUBLE PRECISION(A-H,O-Z) dimension ISTATE(99001),IDIST(99001),IPARTY(99001),& ID1(99001),LVOTE(3600),OLDZ(33),OLDD(33),& XTRUE(31202,2),& ZMID(129001,2),XDATA(99001,2),DYN(129001,2),& RCVOTE1(129001,3600),RCVOTE9(129001,3600),& RCVOTET1(129001,460),RCVOTET9(129001,460),& RCBAD(129001),RID(129999,250),RIDH(129999),& RIDS(129999),IDR(129999),IDR2(129999),& NUMCONG(400),MCONG(400,6),ICONG(129001),& INUM(129001),WEIGHT(33),NUMCONGT(400),& NCONG(129001) LOGICAL*1 RCVOTE1,RCVOTE9,RCVOTET1,RCVOTET9,RCBAD,RID,RIDH,RIDS character*1 LNAME(99001,11),KSTA(99001,7),MNAME(20),LSTA(20) CHARACTER*9 MONTH(100) character*8 :: date character*10 :: time character*5 :: zone integer values(8) ! OPEN(1,FILE='\ATIME2013\HC01113B21.DAT',STATUS='OLD') OPEN(2,FILE='\ATIME2013\SC01113BB21.DAT',STATUS='OLD') OPEN(21,FILE='DWNOMRCC.DAT') OPEN(20,FILE='\ATIME2013\HL01113B21.DAT',STATUS='OLD') OPEN(30,FILE='\ATIME2013\SL01113BB21.DAT',STATUS='OLD') OPEN(22,FILE='\ATIME2013\NHOUSE3_BIG21.NUM',STATUS='OLD') OPEN(32,FILE='\ATIME2013\NSENATE3_BIG21.NUM',STATUS='OLD') OPEN(23,FILE='\ATIME2013\RCDATA\H01113_DECEMBER_2014.VT3',& STATUS='OLD') OPEN(34,FILE='STARTS2013.DAT') OPEN(33,FILE='\ATIME2013\RCDATA\S01113_DECEMBER_2014.VT3',& STATUS='OLD') OPEN(25,FILE='\ATIME2013\RCDATA\HT01113_DECEMBER_2014.VT3',& STATUS='OLD') OPEN(35,FILE='\ATIME2013\RCDATA\ST01113_DECEMBER_2014.VT3',& STATUS='OLD') 100 FORMAT(2X,I3,2I2,I4,I5,2I1,11A1,3600I1) ! 101 format(I3,1x,i5,1x,i5,1x,i2,1x,i2,1x,7a1,1x,i4,1x,i1,1x,i1,1x,& 11a1,4f7.3) 150 FORMAT(6X,I5,41X,2F7.3) 175 FORMAT(I3,I5,4F7.3) 180 FORMAT(I3,1X,2I4) 190 FORMAT(I4,I6,I3,I4,1X,11A1,2F7.3) 200 FORMAT(I4,I6,I3,I2,1X,7A1,1X,I4,1X,11A1,3600I1) 201 FORMAT(I4,I6,I3,I2,1X,7A1,1X,I4,1X,11A1,2F7.3) 205 FORMAT(4X,I6,I3,I2,1X,7A1,1X,I4,1X,11A1,2F7.3,2I4,2I6) 209 FORMAT(I5,2X,A9,I5,4I7) 240 FORMAT(I4,I5,1X,500I1) 250 FORMAT(I4,I5,11I4) 251 FORMAT(I4,I5,3I4,5F7.3) 252 FORMAT(17X,I4,5F7.3) 300 FORMAT(' TOTAL ROLL CALLS HOUSE 01-110 ',2I7) 301 FORMAT(' TOTAL LEGISLATORS HOUSE 01-110',I7) 302 FORMAT(' NUMBER OF CONGRESSES',3I6) 303 FORMAT(4I4,6F7.3) 304 FORMAT(' FATAL MISMATCH',I4,4I6) 305 FORMAT(' MISMATCH ON ROLL CALL NUMBERS',3I5) 306 FORMAT(' MISMATCH ON MISSING DATA',3I5) 307 FORMAT(' MISMATCH ON NON-MISSING DATA',3I5) 308 FORMAT(' TOTAL LEGISLATORS SENATE 01-110',I7) 309 FORMAT(' TOTAL ROLL CALLS SENATE 01-110 ',2I7) 314 FORMAT(' NUMBER READ ROLL CALL FILE',3I6) 315 FORMAT(' NUMBER RCs & CLASSIFICATION',5I10) 316 FORMAT(' NUMBER UNIQUE LEGS',9I7) 320 FORMAT(' ID CHECK ON HOUSE FILES',3I6) 321 FORMAT(' ID CHECK ON SENATE FILES',3I6) 392 FORMAT(1X,A8,2X,A8,2X,A8) 393 FORMAT(2I5,I6,I7,I7,I6,I7,I9) 394 FORMAT(' YEAR MONTH DAY UTCDIFF HOUR MINUTES SECONDS MILLISEC') 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 ! ! using keyword arguments ! `VALUE(1)': The year ! `VALUE(2)': The month ! `VALUE(3)': The day of the month ! `VAlUE(4)': Time difference with UTC in minutes ! `VALUE(5)': The hour of the day ! `VALUE(6)': The minutes of the hour ! `VALUE(7)': The seconds of the minute ! `VALUE(8)': The milliseconds of the second call date_and_time(date,time,zone,values) call date_and_time(DATE=date,ZONE=zone) Call date_and_time(TIME=time) call date_and_time(VALUES=values) write(*,392)date, time, zone WRITE(*,394) WRITE(*,393)(values(J),J=1,8) ! ! NS=2 NFIRST=1 NLAST=113 ! MONTH(1)= 'JANUARY ' MONTH(2)= 'FEBRUARY ' MONTH(3)= 'MARCH ' MONTH(4)= 'APRIL ' MONTH(5)= 'MAY ' MONTH(6)= 'JUNE ' MONTH(7)= 'JULY ' MONTH(8)= 'AUGUST ' MONTH(9)= 'SEPTEMBER' MONTH(10)='OCTOBER ' MONTH(11)='NOVEMBER ' MONTH(12)='DECEMBER ' ! IDAY=VALUES(3) IMONTH=VALUES(2) IYEAR=VALUES(1) WRITE(*,209)IDAY,MONTH(IMONTH),IYEAR,& VALUES(5),VALUES(6),VALUES(7),VALUES(8) WRITE(21,209)IDAY,MONTH(IMONTH),IYEAR,& VALUES(5),VALUES(6),VALUES(7),VALUES(8) ! ! DO 41 J=1,2*NLAST DO 41 I=1,99999 RID(I,J)=.FALSE. RIDH(I)=.FALSE. RIDS(I)=.FALSE. IDR(I)=0 IDR2(I)=0 41 CONTINUE ! DO 10 I=1,400 NUMCONG(I)=0 NUMCONGT(I)=0 10 CONTINUE ! ! READ NHOUSE.NUM -- GIVES NUMBER OF ROLL CALLS AND LEGISLATORS FOR ! EACH HOUSE NRCCHK=0 NLEGCHK=0 I=0 525 READ(22,180,END=425)(MCONG(I+1,J),J=1,3) I=I+1 IF(I.GE.NFIRST)THEN NRCCHK=NRCCHK+MCONG(I,2) NLEGCHK=NLEGCHK+MCONG(I,3) ENDIF GO TO 525 425 WRITE(*,302)I,NRCCHK,NLEGCHK WRITE(21,302)I,NRCCHK,NLEGCHK ! ! READ NSENATE.NUM -- GIVES NUMBER OF ROLL CALLS AND LEGISLATORS FOR ! EACH SENATE NRCCHK=0 NLEGCHK=0 I=0 530 READ(32,180,END=430)(MCONG(I+1,J+3),J=1,3) I=I+1 IF(I.GE.NFIRST)THEN NRCCHK=NRCCHK+MCONG(I,5) NLEGCHK=NLEGCHK+MCONG(I,6) ENDIF GO TO 530 430 WRITE(*,302)I,NRCCHK,NLEGCHK WRITE(21,302)I,NRCCHK,NLEGCHK ! ! READ HOUSE ROLL CALL STARTS -- HC01108.DAT ! II=0 I=0 575 READ(1,175,END=475)ICONG(I+1),INUM(I+1),DYN(I+1,1),& ZMID(I+1,1),DYN(I+1,2),ZMID(I+1,2) NP=MCONG(ICONG(I+1),3) ! READ(25,240,END=475)JJJJ,J,(LVOTE(JJ),JJ=1,NP) I=I+1 IF(DYN(I,1).EQ.0.0.AND.ZMID(I,1).EQ.0.0.AND.& DYN(I,2).EQ.0.0.AND.ZMID(I,2).EQ.0.0)II=II+1 ! DO 11 JJ=1,NP RCVOTET1(I,JJ)=.FALSE. RCVOTET9(I,JJ)=.FALSE. IF(LVOTE(JJ).GE.1.AND.LVOTE(JJ).LE.3)THEN RCVOTET1(I,JJ)=.TRUE. ENDIF IF(LVOTE(JJ).EQ.0.OR.LVOTE(JJ).GT.6)THEN RCVOTET9(I,JJ)=.TRUE. ENDIF 11 CONTINUE NUMCONGT(ICONG(I))=NUMCONGT(ICONG(I))+1 GO TO 575 475 WRITE(*,300)I,II WRITE(21,300)I,II NQTOTH=I ! ! READ SENATE ROLL CALL STARTS -- SC01108.DAT ! II=0 I=0 580 READ(2,175,END=480)ICONG(I+1+NQTOTH),INUM(I+1+NQTOTH),& DYN(I+1+NQTOTH,1),ZMID(I+1+NQTOTH,1),& DYN(I+1+NQTOTH,2),ZMID(I+1+NQTOTH,2) NP=MCONG(ICONG(I+1+NQTOTH),6) ! READ(35,240,END=480)JJJJ,J,(LVOTE(JJ),JJ=1,NP) I=I+1 IF(DYN(I+NQTOTH,1).EQ.0.0.AND.ZMID(I+NQTOTH,1).EQ.0.0.AND.& DYN(I+NQTOTH,2).EQ.0.0.AND.ZMID(I+NQTOTH,2).EQ.0.0)II=II+1 ! DO 21 JJ=1,NP RCVOTET1(I+NQTOTH,JJ)=.FALSE. RCVOTET9(I+NQTOTH,JJ)=.FALSE. IF(LVOTE(JJ).GE.1.AND.LVOTE(JJ).LE.3)THEN RCVOTET1(I+NQTOTH,JJ)=.TRUE. ENDIF IF(LVOTE(JJ).EQ.0.OR.LVOTE(JJ).GT.6)THEN RCVOTET9(I+NQTOTH,JJ)=.TRUE. ENDIF 21 CONTINUE NUMCONGT(NLAST+ICONG(I+NQTOTH))=NUMCONGT(NLAST+ICONG(I+NQTOTH))+1 GO TO 580 480 WRITE(*,309)I,II WRITE(21,309)I,II NQTOTS=I ! ! READ STARTS FOR HOUSE -- HLJ1.SRT ! I=0 550 READ(20,201,END=450)NCONG(I+1),ID1(I+1),ISTATE(I+1),IDIST(I+1),& (KSTA(I+1,JJ),JJ=1,7),IPARTY(I+1),& (LNAME(I+1,JJ),JJ=1,11),(XDATA(I+1,JJ),JJ=1,2) NQ=MCONG(NCONG(I+1),2) READ(23,200,END=450)JJJJ,JD1,JSTATE,JDIST,& (LSTA(JJ),JJ=1,7),JPARTY,& (MNAME(JJ),JJ=1,11),(LVOTE(JJ),JJ=1,NQ) I=I+1 IF(JD1.NE.ID1(I))THEN WRITE(*,320)JJJJ,ID1(I),JD1 STOP ENDIF RID(ID1(I),NCONG(I))=.TRUE. RIDH(ID1(I))=.TRUE. IDR2(ID1(I))=I IDR(ID1(I))=I 38 CONTINUE DO 1 JJ=1,NQ RCVOTE1(I,JJ)=.FALSE. RCVOTE9(I,JJ)=.FALSE. IF(LVOTE(JJ).GE.1.AND.LVOTE(JJ).LE.3)THEN RCVOTE1(I,JJ)=.TRUE. ENDIF IF(LVOTE(JJ).EQ.0.OR.LVOTE(JJ).GT.6)THEN RCVOTE9(I,JJ)=.TRUE. ENDIF 1 CONTINUE NUMCONG(NCONG(I))=NUMCONG(NCONG(I))+1 GO TO 550 450 WRITE(*,301)I WRITE(21,301)I NPTOTH=I ! ! ! READ STARTS FOR SENATE -- SLJ1.SRT ! I=0 560 READ(30,201,END=460)NCONG(I+1+NPTOTH),ID1(I+1+NPTOTH),& ISTATE(I+1+NPTOTH),IDIST(I+1+NPTOTH),& (KSTA(I+1+NPTOTH,JJ),JJ=1,7),IPARTY(I+1+NPTOTH),& (LNAME(I+1+NPTOTH,JJ),JJ=1,11),& (XDATA(I+1+NPTOTH,JJ),JJ=1,2) NQ=MCONG(NCONG(I+1+NPTOTH),5) READ(33,200,END=460)JJJJ,JD1,JSTATE,JDIST,& (LSTA(JJ),JJ=1,7),JPARTY,& (MNAME(JJ),JJ=1,11),(LVOTE(JJ),JJ=1,NQ) I=I+1 IF(JD1.NE.ID1(I+NPTOTH))THEN WRITE(*,321)JJJJ,ID1(I+NPTOTH),JD1 STOP ENDIF RID(ID1(I+NPTOTH),NCONG(I+NPTOTH)+NLAST)=.TRUE. RIDS(ID1(I+NPTOTH))=.TRUE. IDR2(ID1(I+NPTOTH))=I+NPTOTH IDR(ID1(I+NPTOTH))=I+NPTOTH 39 CONTINUE DO 9 JJ=1,NQ RCVOTE1(I+NPTOTH,JJ)=.FALSE. RCVOTE9(I+NPTOTH,JJ)=.FALSE. IF(LVOTE(JJ).GE.1.AND.LVOTE(JJ).LE.3)THEN RCVOTE1(I+NPTOTH,JJ)=.TRUE. ENDIF IF(LVOTE(JJ).EQ.0.OR.LVOTE(JJ).GT.6)THEN RCVOTE9(I+NPTOTH,JJ)=.TRUE. ENDIF 9 CONTINUE NUMCONG(NLAST+NCONG(I+NPTOTH))=NUMCONG(NLAST+NCONG(I+NPTOTH))+1 GO TO 560 460 WRITE(*,308)I WRITE(21,308)I NPTOTS=I ! ! COMPUTE CHECKS FOR HOUSE ! KTOTP=0 KTOTQ=0 KK=0 LATOT=0 LPRE=0 IF(NFIRST.GT.1)THEN DO 1111 II=1,NFIRST-1 NPC=NUMCONG(II) NQC=NUMCONGT(II) KTOTP=KTOTP+NPC KTOTQ=KTOTQ+NQC 1111 CONTINUE ENDIF DO 2 II=NFIRST,NLAST IICONG=II NPC=NUMCONG(II) NQC=NUMCONGT(II) NQ=MCONG(II,2) IF(NQ.NE.NQC)THEN WRITE(*,305)II,NQ,NQC STOP ENDIF DO 3 J=1,NQ NEQ=J KYES=0 KYESD=0 KYESND=0 KYESSD=0 KYESR=0 KNO=0 KNOD=0 KNOSD=0 KNOND=0 KNOR=0 KMISS=0 DO 4 I=1,NPC ISOUTH=0 IF(ISTATE(I+KTOTP).GE.40.AND.ISTATE(I+KTOTP).LE.49)ISOUTH=1 IF(ISTATE(I+KTOTP).EQ.51.OR.ISTATE(I+KTOTP).EQ.53.OR.& ISTATE(I+KTOTP).EQ.54)ISOUTH=1 IF(RCVOTE9(I+KTOTP,J).NEQV.RCVOTET9(J+KTOTQ,I))THEN WRITE(*,306)II,J,I STOP ENDIF IF(RCVOTE1(I+KTOTP,J).NEQV.RCVOTET1(J+KTOTQ,I))THEN WRITE(*,307)II,J,I STOP ENDIF IF(RCVOTE9(I+KTOTP,J).EQV..TRUE.)KMISS=KMISS+1 ! ! IF NOT MISSING DATA ! IF(RCVOTE9(I+KTOTP,J).EQV..FALSE.)THEN ! ! IF YES ! IF(RCVOTE1(I+KTOTP,J).EQV..TRUE.)THEN KYES=KYES+1 IF(IPARTY(I+KTOTP).EQ.100)THEN KYESD=KYESD+1 IF(ISOUTH.EQ.0)THEN KYESND=KYESND+1 ENDIF IF(ISOUTH.EQ.1)THEN KYESSD=KYESSD+1 ENDIF ENDIF IF(IPARTY(I+KTOTP).EQ.200)THEN KYESR=KYESR+1 ENDIF ENDIF ! ! IF NO ! IF(RCVOTE1(I+KTOTP,J).EQV..FALSE.)THEN KNO=KNO+1 IF(IPARTY(I+KTOTP).EQ.100)THEN KNOD=KNOD+1 IF(ISOUTH.EQ.0)THEN KNOND=KNOND+1 ENDIF IF(ISOUTH.EQ.1)THEN KNOSD=KNOSD+1 ENDIF ENDIF IF(IPARTY(I+KTOTP).EQ.200)THEN KNOR=KNOR+1 ENDIF ENDIF ENDIF 4 CONTINUE KK=KK+1 RCBAD(KK)=.FALSE. KRCTOT=KYES+KNO KRCMIN=MIN0(KYES,KNO) IF(KRCTOT.GT.0)THEN XMARG=FLOAT(KRCMIN)/FLOAT(KRCTOT) IF(XMARG.GE..025)THEN RCBAD(KK)=.TRUE. LPRE=LPRE+KRCMIN LATOT=LATOT+KYES+KNO ENDIF ENDIF ! WRITE(24,250)II,J,KMISS,KYES,KNO,KYESR,KNOR,& ! ! KYESD,KNOD,KYESND,KNOND,KYESSD,KNOSD 3 CONTINUE KTOTP=KTOTP+NPC KTOTQ=KTOTQ+NQC 2 CONTINUE WRITE(*,315)KK,LATOT,LPRE WRITE(21,315)KK,LATOT,LPRE ! ! COMPUTE CHECKS FOR SENATE ! KTOTP=0 KTOTQ=0 KK=0 LATOT=0 LPRE=0 IF(NFIRST.GT.1)THEN DO 2222 II=1,NFIRST-1 NPC=NUMCONG(II) NQC=NUMCONGT(II) KTOTP=KTOTP+NPC KTOTQ=KTOTQ+NQC 2222 CONTINUE ENDIF DO 22 II=NFIRST,NLAST IICONG=II NPC=NUMCONG(II+NLAST) NQC=NUMCONGT(II+NLAST) NQ=MCONG(II,5) IF(NQ.NE.NQC)THEN WRITE(*,305)II,NQ,NQC STOP ENDIF DO 33 J=1,NQ NEQ=J KYES=0 KYESD=0 KYESND=0 KYESSD=0 KYESR=0 KNO=0 KNOD=0 KNOSD=0 KNOND=0 KNOR=0 KMISS=0 DO 44 I=1,NPC ISOUTH=0 IF(ISTATE(I+KTOTP+NPTOTH).GE.40.AND.& ISTATE(I+KTOTP+NPTOTH).LE.49)ISOUTH=1 IF(ISTATE(I+KTOTP+NPTOTH).EQ.51.OR.& ISTATE(I+KTOTP+NPTOTH).EQ.53.OR.& ISTATE(I+KTOTP+NPTOTH).EQ.54)ISOUTH=1 IF(RCVOTE9(I+KTOTP+NPTOTH,J).NEQV.RCVOTET9(J+KTOTQ+NQTOTH,I))THEN WRITE(*,306)II,J,I STOP ENDIF IF(RCVOTE1(I+KTOTP+NPTOTH,J).NEQV.RCVOTET1(J+KTOTQ+NQTOTH,I))THEN WRITE(*,307)II,J,I STOP ENDIF IF(RCVOTE9(I+KTOTP+NPTOTH,J).EQV..TRUE.)KMISS=KMISS+1 ! ! IF NOT MISSING DATA ! IF(RCVOTE9(I+KTOTP+NPTOTH,J).EQV..FALSE.)THEN ! ! IF YES ! IF(RCVOTE1(I+KTOTP+NPTOTH,J).EQV..TRUE.)THEN KYES=KYES+1 IF(IPARTY(I+KTOTP+NPTOTH).EQ.100)THEN KYESD=KYESD+1 IF(ISOUTH.EQ.0)THEN KYESND=KYESND+1 ENDIF IF(ISOUTH.EQ.1)THEN KYESSD=KYESSD+1 ENDIF ENDIF IF(IPARTY(I+KTOTP+NPTOTH).EQ.200)THEN KYESR=KYESR+1 ENDIF ENDIF ! ! IF NO ! IF(RCVOTE1(I+KTOTP+NPTOTH,J).EQV..FALSE.)THEN KNO=KNO+1 IF(IPARTY(I+KTOTP+NPTOTH).EQ.100)THEN KNOD=KNOD+1 IF(ISOUTH.EQ.0)THEN KNOND=KNOND+1 ENDIF IF(ISOUTH.EQ.1)THEN KNOSD=KNOSD+1 ENDIF ENDIF IF(IPARTY(I+KTOTP+NPTOTH).EQ.200)THEN KNOR=KNOR+1 ENDIF ENDIF ENDIF 44 CONTINUE KK=KK+1 RCBAD(KK+NQTOTH)=.FALSE. KRCTOT=KYES+KNO KRCMIN=MIN0(KYES,KNO) IF(KRCTOT.GT.0)THEN XMARG=FLOAT(KRCMIN)/FLOAT(KRCTOT) IF(XMARG.GE..025)THEN RCBAD(KK+NQTOTH)=.TRUE. LPRE=LPRE+KRCMIN LATOT=LATOT+KYES+KNO ENDIF ENDIF ! WRITE(24,250)II,J,KMISS,KYES,KNO,KYESR,KNOR,& ! ! KYESD,KNOD,KYESND,KNOND,KYESSD,KNOSD 33 CONTINUE KTOTP=KTOTP+NPC KTOTQ=KTOTQ+NQC 22 CONTINUE WRITE(*,315)KK,LATOT,LPRE WRITE(21,315)KK,LATOT,LPRE ! ! FIND MEMBERS THAT ARE IN BOTH THE HOUSE AND THE SENATE ! NUNIQUE=0 NHOUSE=0 NSENATE=0 NBOTH=0 NBOTH1=0 NBOTH2=0 KK=0 KHLIN=0 KSLIN=0 DO 31 I=1,99999 IF(RIDH(I).EQV..TRUE.)THEN NHOUSE=NHOUSE+1 IF(RIDH(I).EQV.RIDS(I))THEN NBOTH1=NBOTH1+1 KK=KK+1 KHOU=0 KSEN=0 DO 32 J=NFIRST,NLAST IF(RID(I,J).EQV..TRUE.)KHOU=KHOU+1 IF(RID(I,J+NLAST).EQV..TRUE.)KSEN=KSEN+1 32 CONTINUE IF(IDR(I).NE.0)THEN XTRUE(KK,1)=XDATA(IDR(I),1) XTRUE(KK,2)=XDATA(IDR(I),2) WRITE(34,205)I,ISTATE(IDR(I)),IDIST(IDR(I)),& (KSTA(IDR(I),JJ),JJ=1,7),IPARTY(IDR(I)),& (LNAME(IDR(I),JJ),JJ=1,11),& XTRUE(KK,1),XTRUE(KK,2),KHOU,KSEN IF(KHOU.GE.5)KHLIN=KHLIN+1 IF(KSEN.GE.5)KSLIN=KSLIN+1 ENDIF IF(IDR(I).EQ.0)THEN XTRUE(KK,1)=XDATA(IDR2(I),1) XTRUE(KK,2)=XDATA(IDR2(I),2) WRITE(34,205)I,ISTATE(IDR2(I)),IDIST(IDR2(I)),& (KSTA(IDR2(I),JJ),JJ=1,7),IPARTY(IDR2(I)),& (LNAME(IDR2(I),JJ),JJ=1,11),& XTRUE(KK,1),XTRUE(KK,2),& KHOU,KSEN,& IDR(I),IDR2(I) ENDIF ENDIF ENDIF IF(RIDS(I).EQV..TRUE.)THEN NSENATE=NSENATE+1 IF(RIDS(I).EQV.RIDH(I))NBOTH2=NBOTH2+1 ENDIF IF(RIDH(I).NEQV.RIDS(I))THEN NBOTH=NBOTH+1 KK=KK+1 KHOU=0 KSEN=0 DO 34 J=NFIRST,NLAST IF(RID(I,J).EQV..TRUE.)KHOU=KHOU+1 IF(RID(I,J+NLAST).EQV..TRUE.)KSEN=KSEN+1 34 CONTINUE IF(IDR(I).NE.0)THEN XTRUE(KK,1)=XDATA(IDR(I),1) XTRUE(KK,2)=XDATA(IDR(I),2) WRITE(34,205)I,ISTATE(IDR(I)),IDIST(IDR(I)),& (KSTA(IDR(I),JJ),JJ=1,7),IPARTY(IDR(I)),& (LNAME(IDR(I),JJ),JJ=1,11),& XTRUE(KK,1),XTRUE(KK,2),KHOU,KSEN IF(KHOU.GE.5)KHLIN=KHLIN+1 IF(KSEN.GE.5)KSLIN=KSLIN+1 ENDIF IF(IDR(I).EQ.0)THEN XTRUE(KK,1)=XDATA(IDR2(I),1) XTRUE(KK,2)=XDATA(IDR2(I),2) WRITE(34,205)I,ISTATE(IDR2(I)),IDIST(IDR2(I)),& (KSTA(IDR2(I),JJ),JJ=1,7),IPARTY(IDR2(I)),& (LNAME(IDR2(I),JJ),JJ=1,11),& XTRUE(KK,1),XTRUE(KK,2),KHOU,KSEN,& IDR(I),IDR2(I) ENDIF ENDIF 31 CONTINUE WRITE(21,316)NHOUSE,NSENATE,NBOTH,NBOTH1,NBOTH2,KK,KHLIN,KSLIN WRITE(*,316)NHOUSE,NSENATE,NBOTH,NBOTH1,NBOTH2,KK,KHLIN,KSLIN ! ! CALL EDITH(KK,NV,NS,XTRUE,XPT,ZPT,XCLASS,KTOTC,& ! ! KCUTTER,LCUTTER) ! call cpu_time(result1) write(*,1001)result1 TOTALTIME=RESULT1-RESULT WRITE(*,1002)TOTALTIME ! stop end