      PROGRAM POLLS ! Bernd Berg, Sep 10, 2005.
C Purpose: Bootstrap confidence intervals of opinion polls.      
      include '../../ForLib/implicit.sta'
      include '../../ForLib/constants.par'
C US 1992 presidential elections:
      PARAMETER(NPOLL=10 000, NDAT=700, NCH=3, NCP1=NCH+1)
      PARAMETER(IUO=6,IUD=10,ISD1=1,ISD2=0,M1=-1,I1=1)
      DIMENSION PROB(NCH),CP(NCP1),SCORE(NCP1) 
      DIMENSION RESULT(NPOLL,NCP1)
      DATA PROB/0.42D0,0.38D0,0.16D0/ ! Bush, Clinton, Perot.
C German elections September 2005:
c     PARAMETER(NPOLL=10 000, NDAT=3 000, NCH=5, NCP1=NCH+1)
c     PARAMETER(IUO=6,IUD=10,ISD1=1,ISD2=0,M1=-1,I1=1)
c     DIMENSION PROB(NCH),CP(NCP1),SCORE(NCP1) 
c     DIMENSION RESULT(NPOLL,NCP1) ! CDU, SPD, LP, G, FDP:
c     DATA PROB/0.41D0,0.34D0,0.085D0,.07D0,0.065D0/ 
      LTEST=.FALSE.
      IF(LTEST) STOP "Polls: LTEST."
      LTEST=.TRUE.
C
      WRITE(IUO,'(/," Program POLLS:")')
      WRITE(IUO,'(/," Probabilities:",/)')
      WRITE(IUO,'(1X,5F10.3)') PROB
      WRITE(IUO,'(/," Cumulative probabilities:",/)')
      CP(1)=PROB(1)
      DO I=2,NCH
        CP(I)=CP(I-1)+PROB(I)
      ENDDO
      CP(NCP1)=ONE
      WRITE(IUO,'(1X,5F10.3)') CP
C
      CALL RMASET(M1,IUD,ISD1,ISD2,"not there")
      DO IPOLL=1,NPOLL
        CALL RAZERO(SCORE,I1,NCP1)
        DO IDAT=1,NDAT
          CALL RANMAR(XR)
          DO I=1,NCP1
            IF(XR.LT.CP(I)) THEN
              SCORE(I)=SCORE(I)+ONE
            GO TO 1
            ENDIf
          ENDDO
1         CONTINUE
        ENDDO
        DO I=1,NCP1
          RESULT(IPOLL,I)=SCORE(I)/NDAT
        ENDDO
      ENDDO  
C
      DO I=1,NCP1
        CALL HEAPSORT(NPOLL,RESULT(1,I))
        CALL QDF_GNU(IUD,NPOLL,RESULT(1,I))
      ENDDO
      WRITE(IUO,'(/," All done: qdf dat and plot files created.")')
C
      STOP
      END

      include '../../ForLib/heapsort.f'
      include '../../ForLib/qdf_gnu.f'
      include '../../ForLib/ranmar.f'
      include '../../ForLib/razero.f'
      include '../../ForLib/rmafun.f'
      include '../../ForLib/rmaset.f'
