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