File 4JOF.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

C      PROGRAM 4JOF    2/23/73
       COMMON KARRY,IARRY,NCOND,JDUR,ILET,NTRI,L
       DIMENSION KARRY(57),IARRY(19,3),NCOND(90),JDUR(18),ILET(18,3)
       DIMENSION I1RSP(90),I2RSP(90),IBUF(90),IQ(3),ICOND(90)
       DIMENSION ILPOS(18)
 99    PAUSE 1
       CALL OPEN
       CALL SETUP
       CALL SRAND
       READ(1,101)NRAN
101    FORMAT(I3)
       DO 1 I=1,NRAN
1      ITEMP=IRAND(DUM)
       DO 6 I=1,90
  6    NCOND(I)=I
       DO 2 I=1,10
  2    CALL SHUF1(NCOND,1,90,1)
       READ(2,108)IXQ1,IXQ2,IYQ,ITI,ITIM,ILI,IQ,ILET,ICOND
108    FORMAT(6I3,21A1/(I3))
       PAUSE 2
       CALL OPEN
       DO 38 L=1,90
       DO 7 I=1,18
  7    ILPOS(I)=I
       DO 220 I=1,18
        DO 219 J=1,3
219    KARRY(3*(I-1)+J)=ILET(I,J)
220    CONTINUE
       DO 4 I=1,5
       CALL SHUF1(KARRY,3,18,1)
       CALL SHUF1(ILPOS,1,18,1)
       DO 225 I=1,18
       DO 224 J=1,3
224    ILET(I,J)=KARRY(3*(I-1)+J)
225    CONTINUE
       DO 5 I=1,19
       DO 200 J=1,3
200    IARRY(I,J)=0
  5    CONTINUE
       CALL STRING
       CALL OPEN
       CALL BUFIL(0,IBUF,IQ(3),1,IX,IY)
       CALL RSPST(1)
       CALL STIME(1,0)
       CALL DSPLA1(IBUF)
       DO 136 I=1,18,1
       CALL BUFIL(0,IBUF,KARRY(I),3,IX,IY)
       CALL RSPST(1)
       ITS=JDUR(I)/1000
       ITM=IREM(0)
        CALL STIME(ITS,ITM)
       CALL DSPLA1(IBUF)
136    CALL WTIME(0,ILI)
       JSET=3
       CALL BUFIL(0,IBUF,KARRY(55),3,IX,IY)
       CALL BUFIL(1,IBUF,IQ(1),IXQ1,IYQ)
       CALL BUFIL(1,IBUF,IQ(2),1,IXQ2,IYQ)
142    CALL RSPST(JSET)
       CALL STIME(999,0)
       CALL DSPLA1(IBUF)
       IF(5-JSET)98,140,141
141    CALL RSPNS(IRA,IRB)
       IF(IRB)98,147,145
147    I1RSP(NTRI)=IRB
       I2RSP(NTRI)=1594
       GO TO 148
145    JSET=5
       GO TO 142
140    CALL RSPNS(IRC,IRD)
       I1RSP(NTRI)=IRB
       IF(IRD)98,151,151
151    IF(IRD-4)144,144,146
146    IRD=2*IRD-4
144    I2RSP(NTRI)=IRD
148    CALL WTIME(ITI,ITIM)
       CALL OPEN
 38    CONTINUE
       CALL OPEN
       NWRI=0
 22    DO 70 LOUT=1,2
       DO 10 M=1,6
 10    WRITE(LOUT,100)(I1RSP(I),I=M,30,6)
100    FORMAT(5I3/)
       WRITE(1,159)
       DO 69 MA=31,71,20
       MB=MA+19
       DO 68 MC=1,4
       MD=MA+MC-1
 68    WRITE(LOUT,100)(I1RSP(I),I=MD,MB,4)
       WRITE(1,159)
159    FORMAT(///)
 69    CONTINUE
 70    CONTINUE
       WRITE(1,160)
160    FORMAT(/////)
       IF(NWRI)98,23,74
 23    DO 76 I=1,90
 76    I1RSP(I)=I2RSP(I)
       NWRI=1
       GO TO 22
 74    WRITE(2,101)(NCOND(I),I=1,90)
       GO TO 99
 98    STOP
       END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search