entsrc.f
751 Bytes
subroutine entsrc(irold,irnew)
c
c this routine returns irold = lrecov and sets lrecov = irnew.
c
c if there is an active error state, the message is printed
c and execution stops.
c
c irnew = 0 leaves lrecov unchanged, while
c irnew = 1 gives recovery and
c irnew = 2 turns recovery off.
c
c error states -
c
c 1 - illegal value of irnew.
c 2 - called while in an error state.
c
external i8save
c
if (irnew.lt.0 .or. irnew.gt.2)
1 call seterr(31hentsrc - illegal value of irnew,31,1,2)
c
irold=i8save(2,irnew,irnew.ne.0)
c
c if have an error state, stop execution.
c
if (i8save(1,0,.false.) .ne. 0) call seterr
1 (39hentsrc - called while in an error state,39,2,2)
c
return
c
end