SUBROUTINE WORKS C < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C < > C < This is the LTCC PROM Array Generator(Mark IV) Program. > C < It's purpose is to generate the values to be stored in > C < the 2048 address locations of a CY7C291A PROM to be > C < used either in the LTCC Tier 2 OR LTCC tier 3. > C < Added to the Array Generator is a Binary File Output > C < Program used to write the Array to a PROM-usable file. > C < > C < Kelly A Page, D0 L1 TRIG, HEPE, MSU 18-JUN-1993 > C < > C < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > IMPLICIT NONE C < < < < < < < < < < < < < < < > > > > > > > > > > > > > > > INTEGER*2 tier_2(0:8),tier_3(0:15),i,j,k,x,y,xx,yy,kk,a, & lt_array(0:2047) CHARACTER*96 Binary_Output_Filename INTEGER*4 Pointer INTEGER*2 IOSTATUS BYTE PROM_Array(0:3000) C < < < < < Initializing new variables > > > > > DATA PROM_Array/3001*0/ DATA lt_array/2048*0/ C < < < This Subroutine Automatically writes to LT_ARRAY.DAT > > > OPEN ( UNIT=45,file='LT_ARRAY.DAT', STATUS='NEW') C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C Get the name of the Binary Output file. C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > 40 WRITE ( 6, 50 ) 50 FORMAT ( /// & ' Should a binary file be written for use by the PROM ', / & ' programmed? To creat such a file enter a file name ', / & ' for this binary output file or else enter just a ', / & ' carridge return to skip writing a binary output file.', / & ' DEVC:[DIR]NAME.EXT;VER: ', $ ) READ ( 5, 55 ) Binary_Output_Filename 55 FORMAT ( A ) IF ( Binary_Output_Filename .EQ. ' ' ) THEN WRITE ( 6, 57 ) 57 FORMAT ( /, ' No binary file will be written ', / & ' for the PROM programmer. ', / ) RETURN END IF WRITE ( 6, 60 ) Binary_Output_Filename 60 FORMAT ( // & ' The Binary Output file name for ' / & ' use by the PROM programmer is: ', A & / ) C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C Open the Binary Output file for the PROM programmer. C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > OPEN ( UNIT=20, FILE=Binary_Output_Filename, STATUS='NEW', & FORM='UNFORMATTED', ACCESS='SEQUENTIAL', & RecordType='Variable', CarriageControl='None', & ERR=950, IOSTAT=IOSTATUS ) WRITE ( 6, 80 ) 80 FORMAT ( /, & ' The Binary Output file for the ', /, & ' PROM programmer has been opened. ', / ) C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C < This part of the program generates the necessary > C < array to be used in the PROMs. > C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C < < < Define possible output values for Tier 2 and Tier 3> > > tier_2(0) = 0 tier_2(1) = 81 tier_2(2) = 162 tier_2(3) = 243 tier_2(4) = 244 tier_2(5) = 245 tier_2(6) = 246 tier_2(7) = 247 tier_2(8) = 248 tier_3(0) = 0 tier_3(1) = 17 tier_3(2) = 35 tier_3(3) = 55 tier_3(4) = 71 tier_3(5) = 87 tier_3(6) = 103 tier_3(7) = 119 tier_3(8) = 135 tier_3(9) = 151 tier_3(10) = 167 tier_3(11) = 183 tier_3(12) = 199 tier_3(13) = 215 tier_3(14) = 231 tier_3(15) = 247 C < < < Begin inserting values into array locations > > > do i = 0, 2047 C < < < Insert Tier 2 values into array locations > > > if (i .lt. 256) then y = 0 do j = 0, 7 x = IBITS(i,j,1) y = y + x end do lt_array(i) = tier_2(y) a = lt_array(i) write (45,100) i,IBITS(i,10,1),IBITS(i,9,1),IBITS(i,8,1), & IBITS(i,7,1),IBITS(i,6,1),IBITS(i,5,1),IBITS(i,4,1), & IBITS(i,3,1),IBITS(i,2,1),IBITS(i,1,1),IBITS(i,0,1), & lt_array(i), & IBITS(a,7,1),IBITS(a,6,1),IBITS(a,5,1),IBITS(a,4,1), & IBITS(a,3,1),IBITS(a,2,1),IBITS(a,1,1),IBITS(a,0,1) 100 format (' Tier2 : in = ',I4,5X,11I1,10X,': out = ', & I3,5X,8I1) end if C < < < Insert Tier 3 values into array locations > > > if (i .gt. 1023) then yy = 0 do k = 0,4 kk=2*k xx = IBITS(i,kk,2) yy = yy + xx end do lt_array(i) = tier_3(yy) a = lt_array(i) write (45,101) i,IBITS(i,10,1),IBITS(i,9,1),IBITS(i,8,1), & IBITS(i,7,1),IBITS(i,6,1),IBITS(i,5,1),IBITS(i,4,1), & IBITS(i,3,1),IBITS(i,2,1),IBITS(i,1,1),IBITS(i,0,1), & lt_array(i), & IBITS(a,7,1),IBITS(a,6,1),IBITS(a,5,1),IBITS(a,4,1), & IBITS(a,3,1),IBITS(a,2,1),IBITS(a,1,1),IBITS(a,0,1) 101 format (' Tier3 : in = ',I4,5X,11I1,10X,': out = ', & I3,5X,8I1) end if end do WRITE (*,102) 102 FORMAT (/,' A list of the values in the array has ',/, & ' been written to LT_ARRAY.DAT. ',/,/) C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C < This part of the program write the array generated > C < into a PROM-usable file. > C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > Do pointer =0,2047,1 IF (lt_array(pointer) .le. 127) then PROM_Array(pointer) = lt_array(pointer) ELSE IF (lt_array(pointer) .gt. 127) then PROM_Array(pointer) = lt_array(pointer) - 256 End If End Do WRITE (Unit=20) (PROM_array(Pointer), Pointer=0,509) IF ( IOSTATUS .NE. 0 ) GOTO 970 PRINT*, ' 1st Register written.' WRITE (Unit=20) (PROM_array(Pointer), Pointer=510,1019) IF ( IOSTATUS .NE. 0 ) GOTO 970 PRINT*, ' 2nd Register written..' WRITE (Unit=20) (PROM_array(Pointer), Pointer=1020,1529) IF ( IOSTATUS .NE. 0 ) GOTO 970 PRINT*, ' 3rd Register written...' WRITE (Unit=20) (PROM_array(Pointer), Pointer=1530,2039) IF ( IOSTATUS .NE. 0 ) GOTO 970 PRINT*, ' 4th Register written....' WRITE (Unit=20) (PROM_array(Pointer), Pointer=2040,2049) IF ( IOSTATUS .NE. 0 ) GOTO 970 PRINT*, ' 5th Register written.....' CLOSE (Unit=20) WRITE ( 6, 250 ) 250 FORMAT ( /, & ' The Binary Output file has been Written and Closed. ', /) RETURN C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > C This is the section for handling IO Errors and all Exits C < < < < < < < < < < < < < < > > > > > > > > > > > > > > > 950 WRITE ( 6, 951 ) IOSTATUS 951 FORMAT ( /, & ' There has been an IO System Error trying ', / & ' to Open the Binary Output File. ', // & ' Fortran Open IOSTAT = ', I3, // & ' You will need to restart the program. ', / ) GOTO 998 970 WRITE ( 6, 971 ) IOSTATUS 971 FORMAT ( /, & ' There has been an IO System Error trying ', / & ' to Write to the Binary Output file. ', // & ' Fortran Read IOSTAT = ', I3, // & ' You will need to restart the program. ' , // ) CLOSE ( UNIT=20 ) 998 WRITE ( 6, 999 ) 999 FORMAT ( / ' LTCC PROM Program will now exit. ', // ) STOP ' ' END