c
      if (desire-incore) 3,1,4
 3    rewind fmts
      incore = 0
c calculate how many records to bypass before reading the desired record
 4    bypass = desire - incore - 1
      if (bypass .eq. 0) go to 5
      do 6 i=1,bypass
 6    read (fmts,101)
 5    read (fmts,100) (block(i), i=1,blksiz)
      incore = desire
c copy the desired card image into the format buffer
 1    first = 80*mod(number-1,prblok) + 1
      last = first + 79
      col = column
      do 2 i=first,last
      fmtbuf(col) = block(i)
 2    col = col + 1
      return
c
c
c
c the following card must be changed if the blocking factor is changed  ********
 100  format (22(160a1))
 101  format (1x)
      end
c random(min,max,seed) is a function which returns a random integer from
c min thru max inclusive.  min and max may be reversed, but the range
c (i.e. max-min+1) must not be greater than 401.  if max=min the value
c returned is min.  numbers are "computed" by skipping through a random-
c ly arranged table of numbers from 0 thru 400 in block data program
c called ranseq.  if the "seed" is not zero, the generator is restarted
c by setting the following as a function of seed: starting point, skip
c distance, and more - i.e. the number of times to use these values be-
c fore automatically reestablishing all three.  seed may be any represe-
c ntable non-negative integer.
c
c sampling is not biased by range: the range "fits" into 401 some
c integral number of times, n.  if the sample read from the table is
c greater than or equal to n*range, the generator tries again.
c
      integer function random(minin,maxin,seed)
      implicit integer (a-z)
c other normal declarations here***************************************
      integer start /251/, skip /37/, pmany /305/, more /0/
c
c start is starting point for this string of samples, skip is the skip
c distance minus one, pmany is a pointer to the entry to use to deter-
c mine how many samples to take before restarting automatically.  point
c is pointer to last sample used, more is how many more before restart,
c over is one more than largest valid sample.
c
      integer point,over,max,min,range,useed,sample
c
c
c
      if(minin.lt.maxin)go to 5
      if(minin.gt.maxin)go to 6
c range=1, no choice. set random and return
      random=minin
      return
c minin and maxin in order. set min and max.
  5   min=minin
      max=maxin
      go to 7
c minin and maxin reversed. set max and min.
  6   max=minin
      min=maxin
c compute and test range
  7   range=max-min+1
      if(range.le.401)go to 8
c range too large
      call qttyo(78)
      range=401
c determine over= one more than largest valid sample
  8   over=(401/range)*range
c branch on seed =0( dont restart) vs. non zero (restart)
      useed=seed
      if (seed) 10,25,20
c restart generator, using seed supplied.
  10  useed =-seed
  20  start=mod(useed,401)+1
      skip=mod(useed,400)
      pmany=mod(useed,397)+1
      go to 30
c dont restart. test if more from this sequence.
  25  if(more.gt.0)go to 35
      start=mod(start+2,401)+1
      skip=mod(skip+3,400)
      pmany=mod(pmany+5,397)+1
 30   more = mod(ranseq(pmany),137) + 1
      point=start
c continue sampling from this sequence.
  35  point=mod(point+skip,401)+1
      more=more-1
      sample=ranseq(point)
c if sample is greater than max fit of range in 401, try again.
      if(sample.ge.over)go to 25
c otherwise set random and return.
      random =min+mod(sample,range)
      return
      end
      subroutine $trace
      implicit integer (a-z)
      integer maxloc/50/
c   location identification numbers may range between 1 and 50
      integer table(50,12)/600*0/
c   history table, one entry for each identification number
c   each entry contains the following integer*4 fields:
c   1.  count of the number of consecutive calls of subroutine "nowat"
c       using this identification number.  this field is reset to 1 if
c       the previous call of "nowat" used a different identification
c       number.
c   2.  total number of calls of "nowat" using this identification
c       number.
c   3.  sequence number of the most recent call of "nowat" using this
c       identification number.
c   4,5,6,7.  values of 4 user-specified expressions at the most recent
c       call of "nowat" using this identification number.
c   8.  sequence number of the previous call of "nowat" using this
c       identification number.
c   9,10,11,12.  values of 4 user-specified expressions at the
c       previous call of "nowat" using this identification number.
c
c
c
c
c
c   subroutine "nowat" is called by the user to record the current
c   position where his code is executing, and to record the values of
c   relevant integer-valued expressions (4 expressions max.).
      entry nowat(loc,value1,value2,value3,value4)
c   "loc" is an integer between 1 and (maxloc), assigned arbitrarily by
c   the user.  its value is used to index into the history table.
      integer seqnce/0/
c   the sequence number is incremented by 1 for each call of "nowat",
c   no matter what parameters (legal or illegal) are supplied by the
c   user.
      integer oldloc/0/
c   (oldloc) = value of "loc" in preceding call of "nowat".
      seqnce=seqnce+1
      if (loc .lt. 1 .or. loc .gt. maxloc) go to 1
c   set consecutive call entry in table
      table(loc,1) = table(loc,1)+1
      if (loc .ne. oldloc) table(loc,1) = 1
      oldloc = loc
c   set total number of calls
      table(loc,2) = table(loc,2)+1
c   what previously was the most recent data now becomes the old data
      table(loc,8) = table(loc,3)
      table(loc,3) = seqnce
      table(loc,9) = table(loc,4)
      table(loc,4) = value1
      table(loc,10) = table(loc,5)
      table(loc,5) = value2
      table(loc,11) = table(loc,6)
      table(loc,6) = value3
      table(loc,12) = table(loc,7)
      table(loc,7) = value4
      return
 1    call qttyo(62)
      call getfmt(63,.false.)
      write (ttyo,fmtbuf) loc,value1,value2,value3,value4
c   execution continues in subroutine "histry"
c
c
c
c
c
c   subroutine "histry" prints the history stored in the table.
      entry histry
      call qttyo(64)
      call qttyo(66)
      do 2 i=1,maxloc
      if (table(i,2) .eq. 0) go to 2
      call getfmt(67,.false.)
      write (ttyo,fmtbuf) i,(table(i,j), j=1,12)
 2    continue
      return
      end
//lked exec pgm=iewl,cond=(8,le,sysprog),parm='list,xref,ncal'
//sysprint dd sysout=a
//syslin dd dsn=*.sysprog.syslin,disp=(old,delete)
//sysut1 dd unit=sysda,dcb=blksize=3200,space=(trk,(6,3))
//syslmod dd dsn=ics160.loadmod(sysprog),disp=(new,keep),unit=2311,
// vol=ref=*.scratch.itch,label=expdt=99365,space=(trk,(6,3,1),rlse),
// dcb=blksize=3200
