program M888_1505  ! 709 FORTRAN-II parameters were FMS,DEBUG,3,3,200,000

! Program to produce state-by-state printout of all clusters.
! First data card contains TITLE, fortmat(A72).
! Second data card contains ITAPE, the block to process, I1.
! Third data card contains the format for the TPRIME data, starring
!   on card 8, read into a variable named FORMAT, format(A72)
! Next four data cards contain state names, format(4(12A6)).
! Deck of 1628 TPRIMES follows, format is FORMAT.

  implicit NONE

  real :: A, B, C
  real :: FILE ! Only used to read some unused data
  character(72) :: FORMAT
  integer :: I, IA, IALL, ICYCLE, INDEX, ITAPE, IX, IXYZ
  integer, parameter :: ISTATE(5) = [ 5, 9, 11, 12, 11 ]
  integer :: J, JA, K, KA, L, LQ, M
  integer :: N, NCLUS, NQ
  character, parameter :: NP = ACHAR(12) ! Ctrl-L = new page
  real :: P(60), PP(60,3), PSUM(48,60,3)
  real :: Q(60), QQ(60,3), QSUM(48,60,3)
  real :: R(60)
  character(6) :: STATE(48)
  real :: T(3), TSUM(48,60,3)
  character(72) :: TITLE
  
! Read parameters and print title

  read "(a)", title
  print 300, np, trim(title), np
  300 format (a, "SIMULMATICS Project, Program To Produce State-By-State ", &
     & "Printout of All Clusters, Now in Operation."//2a)
  read "(i1/a,4(/12a6))", itape, format, state

! Position input tape

  ! Skip ITAPE - 1 data sets
  do index = 2, itape
!   This was an unformatted READ statement in 709 fortran-II
!   read tape 9, file, nclus
!   Once the data are recovered, READ(9) should be replaced with a formatted
!   READ statement, so the data will be portable.
    read (9) file, nclus
    do ixyz = 1, 480
      read (9) i, j, k, l, ( r(ix), p(ix), q(ix), ix = 1, nclus )
    end do
  end do

! Initialize sums and counters

  psum = 0.0
  qsum = 0.0
  tsum = 0.0

! Begin cycle and read in data

! This was an unformatted READ statement in 709 fortran-II
! read tape 9, file, nclus
! Once the data are recovered, READ (9) should be replaced with a formatted
! READ statement, so the data will be portable.
  read (9) file, nclus
  do icycle = 1, 160
    do lq = 1, 3
      read (9) i, j, k, l, ( r(ix), pp(ix,lq), qq(ix,lq), ix = 1, nclus )
      if ( l /= lq ) then
        print 302, i, j, k, l, lq
    302 format ( /"For cell " 4i1, " on Cluster Summary Tape, LQ =", i2, &
               & ".  Run Terminated." )
        stop
      end if
    end do ! LQ

! Read in T-PRIMES

    do iall = 1, istate(i+1)
      read format, ia, ja, ka, m, t(:)
      if ( ia /= i .or. ja /= j .or. ka /= k ) then
        print 304, i, j, k, ia, ja, ka, m
    304 format ( /"Cell ", 3i2, " on the Cluster Summary Tape, and cell ", &
               & 4i1, " In the TPRIME deck encountered simultaneously."/   &
               & "Run Terminated." )
        stop
      end if

! Compute sums

      do nq = 1, nclus
        psum(m,nq,:) = pp(nq,:) * t(:) + psum(m,nq,:)
        qsum(m,nq,:) = qq(nq,:) * t(:) + qsum(m,nq,:)
        tsum(m,nq,:) = t(:) + tsum(m,nq,:)
      end do ! NQ
    end do ! IALL
  end do ! ICYCLE

! Compute final output

  do m = 1, 48
    do n = 1, nclus
      a = 0.0
      b = 0.0
      c = 0.0
      do l = 1, 3
        a = a + psum(m,n,l)
        b = b + qsum(m,n,l)
        c = c + tsum(m,n,l)
        if ( tsum(m,n,l) <= 0 ) then
          print 305, m, n, l, tsum(m,n,l)
    305   format ( /"TSUM(",i0, 2(",",i0), ") =", f8.5,        &
                 & ". The corresponding cluster percentages ", &
                 & "will be set equal to 0.0" )
          psum(m,n,l) = 0.0
          qsum(m,n,l) = 0.0
        else
          psum(m,n,l) = psum(m,n,l)/tsum(m,n,l)
          qsum(m,n,l) = qsum(m,n,l)/tsum(m,n,l)
        end if
      end do ! l
      if ( c <= 0 ) then
        print 305, m, n, 4, c
        tsum(m,n,1) = 0.0
        tsum(m,n,2) = 0.0
      else
        tsum(m,n,1) = a/c
        tsum(m,n,2) = b/c
      end if
    end do ! N
  end do ! M

! Write output two ways

  do m = 1, 48
    write (2, 310) np, trim(title), m, trim(state(m)),  &
      & ( n, (psum(m,n,l), qsum(m,n,l), l=1, 3 ),       &
      & ( tsum(m,n,l), l=1,2), n=1,nclus )
310 format ( a, 25x, a // 14x, &
           & "Pros and Antis for all Clusters, as Percentages of ", &
           & "Eligible Voting Population in This State." //         &
           & 56x, "State", i3, ".  ", a ///                         &
           & "Cluster", 6x, "Democrats", 14x, "Republicans", 13x,   &
           & "Independents", 27x, "Total"/                          &
           & "   NO.     ", 3("Pro        Anti",9x), "Pro        Anti" // &
           & ( i4, 6f12.5, 12x, 2f12.5 ) )
  end do ! M

  do n = 1, nclus
    write (2, 311) np, trim(title), n, (m,state(m),         &
      & ( psum(m,n,l), qsum(m,n,l),l=1,3), ( tsum(m,n,l),l=1,2), m=1,48 )
311 format ( a, 25x, a // 14x, &
           & "Pros and Antis for all Clusters, as Percentages of ", &
           & "Eligible Voting Population in All States." //         &
           & 55x, "Cluster", 14 ///                                 &
           & " State", 13x, "Democrats", 14x, "Republicans", 13x,   &
           & "Independents", 27x, "Total" //                        &
           & " State", 13x, 3("Pro", 8x, "Anti"), "Pro        Anti" // &
           & ( i3, 1x, a6, 6f12.5, 12x, 2f12.5) )
  end do ! N

  close ( 9 )
  print "(2a)", np, "End of Run."
  stop

  end program M888_1505
! File Name: box1batch10.bin, Fingerprint: 7e5c43-233f5d
