retsrc.f 557 Bytes
subroutine retsrc(irold)
c
c  this routine sets lrecov = irold.
c
c  if the current error becomes unrecoverable,
c  the message is printed and execution stops.
c
c  error states -
c
c    1 - illegal value of irold.
c
      external i8save
c
      if (irold.lt.1 .or. irold.gt.2)
     1  call seterr(31hretsrc - illegal value of irold,31,1,2)
c
      itemp=i8save(2,irold,.true.)
c
c  if the current error is now unrecoverable, print and stop.
c
      if (irold.eq.1 .or. i8save(1,0,.false.).eq.0) return
c
        call eprint
        stop
c
      end