2 SUBROUTINE xerprn (PREFIX, NPREF, MESSG, NWRAP)
77 CHARACTER*(*) PREFIX, MESSG
82 parameter(newlin =
'$$')
92 IF (iu(i) .EQ. 0) iu(i) = n
99 IF ( npref .LT. 0 )
THEN
104 lpref =
min(16, lpref)
105 IF (lpref .NE. 0) cbuff(1:lpref) = prefix
110 lwrap =
max(16,
min(132, nwrap))
117 IF (messg(lenmsg:lenmsg) .NE.
' ') go
to 30
124 IF (lenmsg .EQ. 0)
THEN
125 cbuff(lpref+1:lpref+1) =
' '
127 WRITE(iu(i),
'(A)') cbuff(1:lpref+1)
170 50 lpiece =
index(messg(nextc:lenmsg), newlin)
171 IF (lpiece .EQ. 0)
THEN
176 lpiece =
min(lwrap, lenmsg+1-nextc)
177 IF (lpiece .LT. lenmsg+1-nextc)
THEN
178 DO 52 i=lpiece+1,2,-1
179 IF (messg(nextc+i-1:nextc+i-1) .EQ.
' ')
THEN
186 54 cbuff(lpref+1:lpref+lpiece) = messg(nextc:nextc+lpiece-1)
187 nextc = nextc + lpiece + idelta
188 ELSEIF (lpiece .EQ. 1)
THEN
195 ELSEIF (lpiece .GT. lwrap+1)
THEN
201 DO 56 i=lpiece+1,2,-1
202 IF (messg(nextc+i-1:nextc+i-1) .EQ.
' ')
THEN
208 58 cbuff(lpref+1:lpref+lpiece) = messg(nextc:nextc+lpiece-1)
209 nextc = nextc + lpiece + idelta
216 cbuff(lpref+1:lpref+lpiece) = messg(nextc:nextc+lpiece-1)
217 nextc = nextc + lpiece + 2
223 WRITE(iu(i),
'(A)') cbuff(1:lpref+lpiece)
226 IF (nextc .LE. lenmsg) go
to 50
subroutine xerprn(PREFIX, NPREF, MESSG, NWRAP)
may be zero for pure relative error test tem the relative tolerance must be greater than or equal to
charNDArray max(char d, const charNDArray &m)
void index(const T *src, T *dest) const
subroutine xgetua(IUNITA, N)
charNDArray min(char d, const charNDArray &m)