subroutine aptnerr (nerr, nopt, ntty, nhsp, aptsub, aprog, aline,
& amsg, nw)
ccbeg.
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
c
c SUBROUTINE APTNERR
c
c call aptnerr (nerr, nopt, ntty, nhsp, aptsub, aprog, aline,
c & amsg, nw)
c
c Version: aptnerr Updated 1991 August 2 10:20.
c aptnerr Originated 1981 August 2 10:20.
c
c Author: Arthur L. Edwards, LLNL, L-298, Telephone (925) 422-4123.
c
c
c Purpose: To write an error message to IOC units ntty and nhsp,
c giving the error number nerr, the module "aptsub" that
c returned nerr, the module "aprog" that called "aptsub",
c the location "aline" in "aprog" where the call was made,
c and any general message "amsg" of arbitrary length nw,
c and then, depending on nopt, either return, or end with
c a call exit (0) or call exit (1).
c
c Input: nerr, nopt, ntty, nhsp, aptsub, aprog, aline, amsg, nw.
c
c Output: none.
c
c Glossary:
c
c aline Input ASCII word describing the location in aprog.
c
c amsg Input ASCII array containing a message to be written
c to IOC units ntty and nhsp, in addition to the
c words aptsub, aprog and aline. Size nw words.
c
c aprog Input ASCII name of the module which called this module.
c
c aptsub Input ASCII name of the module which generated nerr.
c
c nerr Input Integer error flag returned by module "aptsub".
c If 0, this module will immediately return to the
c calling module, without writing out any messages.
c
c nhsp Input IOC unit for writing a message to an ASCII output
c file. If none, nhsp = 0.
c
c nopt Input Option for action after writing out error messages:
c -1: return to the calling module "aprog".
c 0: call exit (0), destroying the drop file.
c 1: call exit (1), leaving the drop file on disk.
c
c ntty Input IOC unit for writing a message to the controller's
c terminal. If none, ntty = 0.
c
c nw Input Number of words in ASCII array amsg.
c
cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
ccend.
c.... Dimensioned arguments.
c---- An ASCII message of nw words.
dimension amsg(1)
c.... Local variables.
c---- Index in amsg.
common /laptnerr/ n
cbugc***DEBUG begins.
cbug 9901 format (/ 'aptnerr writing out an error message.' /
cbug & ' nerr=',i5,' nopt=',i3,' ntty=', i4,' nhsp=',i3 /
cbug & ' aptsub=',a8,' aprog=',a8,' aline=',a8 /
cbug & (10a8))
cbug write ( 3, 9901) nerr, nopt, ntty, nhsp, aptsub, aprog, aline,
cbug & (amsg(n), n = 1, nw)
cbugc***DEBUG ends.
c.... Return if nerr = 0.
if (nerr .eq. 0) go to 210
c.... Write out the error flag, source, sink, and location.
100 format (// 'aptnerr error message: nerr =',i5,
& ' returned by ',a8,',' /
& 'called by ',a8,' at location ',a8,'.')
if (ntty .gt. 0) then
write (ntty, 100) nerr, aptsub, aprog, aline
endif
if (nhsp .gt. 0) then
write (nhsp, 100) nerr, aptsub, aprog, aline
endif
c.... Write out the general error message.
110 format (10a8)
if (nw .gt. 0) then
if (ntty .gt. 0) then
write (ntty, 110) (amsg(n), n = 1, nw)
endif
if (nhsp .gt. 0) then
write (nhsp, 110) (amsg(n), n = 1, nw)
endif
endif
c.... Either return, or exit without or with a drop file left on disk.
120 format (/ 'Returning to ',a8,'.')
130 format (/ 'Exiting without a drop file.')
140 format (/ 'Exiting with a drop file.')
if (nopt .lt. 0) then
if (ntty .gt. 0) then
write (ntty, 120) aprog
endif
if (nhsp .gt. 0) then
write (nhsp, 120) aprog
endif
go to 210
elseif (nopt .eq. 0) then
if (ntty .gt. 0) then
write (ntty, 130)
endif
if (nhsp .gt. 0) then
write (nhsp, 130)
endif
cbugc***DEBUG begins.
cbug if (nerr .ne. 999) go to 210
cbugc***DEBUG ends.
call exit (0)
else
if (ntty .gt. 0) then
write (ntty, 140)
endif
if (nhsp .gt. 0) then
write (nhsp, 140)
endif
cbugc***DEBUG begins.
cbug if (nerr .ne. 999) go to 210
cbugc***DEBUG ends.
call exit (1)
endif
210 return
c.... End of subroutine aptnerr. (+1 line.)
end
UCRL-WEB-209832