*DECK XERPRN

      IMPLICIT NONE

C***BEGIN PROLOGUE  XERPRN

C***SUBSIDIARY

C***PURPOSE  Print error messages processed by XERMSG.

C***LIBRARY   SLATEC (XERROR)

C***CATEGORY  R3C

C***TYPE      ALL (XERPRN-A)

C***KEYWORDS  ERROR MESSAGES, PRINTING, XERROR

C***AUTHOR  Fong, Kirby, (NMFECC at LLNL)

C***DESCRIPTION

C

C This routine sends one or more lines to each of the (up to five)

C logical units to which error messages are to be sent.  This routine

C is called several times by XERMSG, sometimes with a single line to

C print and sometimes with a (potentially very long) message that may

C wrap around into multiple lines.

C

C PREFIX  Input argument of type CHARACTER.  This argument contains

C         characters to be put at the beginning of each line before

C         the body of the message.  No more than 16 characters of

C         PREFIX will be used.

C

C NPREF   Input argument of type INTEGER.  This argument is the number

C         of characters to use from PREFIX.  If it is negative, the

C         intrinsic function LEN is used to determine its length.  If

C         it is zero, PREFIX is not used.  If it exceeds 16 or if

C         LEN(PREFIX) exceeds 16, only the first 16 characters will be

C         used.  If NPREF is positive and the length of PREFIX is less

C         than NPREF, a copy of PREFIX extended with blanks to length

C         NPREF will be used.

C

C MESSG   Input argument of type CHARACTER.  This is the text of a

C         message to be printed.  If it is a long message, it will be

C         broken into pieces for printing on multiple lines.  Each line

C         will start with the appropriate prefix and be followed by a

C         piece of the message.  NWRAP is the number of characters per

C         piece; that is, after each NWRAP characters, we break and

C         start a new line.  In addition the characters '$$' embedded

C         in MESSG are a sentinel for a new line.  The counting of

C         characters up to NWRAP starts over for each new line.  The

C         value of NWRAP typically used by XERMSG is 72 since many

C         older error messages in the SLATEC Library are laid out to

C         rely on wrap-around every 72 characters.

C

C NWRAP   Input argument of type INTEGER.  This gives the maximum size

C         piece into which to break MESSG for printing on multiple

C         lines.  An embedded '$$' ends a line, and the count restarts

C         at the following character.  If a line break does not occur

C         on a blank (it would split a word) that word is moved to the

C         next line.  Values of NWRAP less than 16 will be treated as

C         16.  Values of NWRAP greater than 132 will be treated as 132.

C         The actual line length will be NPREF + NWRAP after NPREF has

C         been adjusted to fall between 0 and 16 and NWRAP has been

C         adjusted to fall between 16 and 132.

C

C***REFERENCES  R. E. Jones and D. K. Kahaner, XERROR, the SLATEC

C                 Error-handling Package, SAND82-0800, Sandia

C                 Laboratories, 1982.

C***ROUTINES CALLED  I1MACH, XGETUA

C***REVISION HISTORY  (YYMMDD)

C   880621  DATE WRITTEN

C   880708  REVISED AFTER THE SLATEC CML SUBCOMMITTEE MEETING OF

C           JUNE 29 AND 30 TO CHANGE THE NAME TO XERPRN AND TO REWORK

C           THE HANDLING OF THE NEW LINE SENTINEL TO BEHAVE LIKE THE

C           SLASH CHARACTER IN FORMAT STATEMENTS.

C   890706  REVISED WITH THE HELP OF FRED FRITSCH AND REG CLEMENS TO

C           STREAMLINE THE CODING AND FIX A BUG THAT CAUSED EXTRA BLANK

C           LINES TO BE PRINTED.

C   890721  REVISED TO ADD A NEW FEATURE.  A NEGATIVE VALUE OF NPREF

C           CAUSES LEN(PREFIX) TO BE USED AS THE LENGTH.

C   891013  REVISED TO CORRECT ERROR IN CALCULATING PREFIX LENGTH.

C   891214  Prologue converted to Version 4.0 format.  (WRB)

C   900510  Added code to break messages between words.  (RWC)

C   920501  Reformatted the REFERENCES section.  (WRB)

C***END PROLOGUE  XERPRN

      CHARACTER*(*) PREFIX, MESSG

      INTEGER NPREF, NWRAP

      CHARACTER*148 CBUFF

      INTEGER IU(5), NUNIT

      CHARACTER*2 NEWLIN

      PARAMETER (NEWLIN = '$$')

      INTEGER N, I1MACH, I, LPREF, LWRAP, LENMSG, NEXTC

      INTEGER LPIECE, IDELTA

C***FIRST EXECUTABLE STATEMENT  XERPRN

C

C       A ZERO VALUE FOR A LOGICAL UNIT NUMBER MEANS TO USE THE STANDARD

C       ERROR MESSAGE UNIT INSTEAD.  I1MACH(4) RETRIEVES THE STANDARD

C       ERROR MESSAGE UNIT.

C

C

C       LPREF IS THE LENGTH OF THE PREFIX.  THE PREFIX IS PLACED AT THE

C       BEGINNING OF CBUFF, THE CHARACTER BUFFER, AND KEPT THERE DURING

C       THE REST OF THIS ROUTINE.

C

      ELSE

         LPREF = NPREF

      ENDIF

C

C       LWRAP IS THE MAXIMUM NUMBER OF CHARACTERS WE WANT TO TAKE AT ONE

C       TIME FROM MESSG TO PRINT ON ONE LINE.

C

C

C       SET LENMSG TO THE LENGTH OF MESSG, IGNORE ANY TRAILING BLANKS.

C

      N = LENMSG

   30 CONTINUE

C

C       IF THE MESSAGE IS ALL BLANKS, THEN PRINT ONE BLANK LINE.

C

         RETURN

      ENDIF

C

C       SET NEXTC TO THE POSITION IN MESSG WHERE THE NEXT SUBSTRING

C       STARTS.  FROM THIS POSITION WE SCAN FOR THE NEW LINE SENTINEL.

C       WHEN NEXTC EXCEEDS LENMSG, THERE IS NO MORE TO PRINT.

C       WE LOOP BACK TO LABEL 50 UNTIL ALL PIECES HAVE BEEN PRINTED.

C

C       WE LOOK FOR THE NEXT OCCURRENCE OF THE NEW LINE SENTINEL.  THE

C       INDEX INTRINSIC FUNCTION RETURNS ZERO IF THERE IS NO OCCURRENCE

C       OR IF THE LENGTH OF THE FIRST ARGUMENT IS LESS THAN THE LENGTH

C       OF THE SECOND ARGUMENT.

C

C       THERE ARE SEVERAL CASES WHICH SHOULD BE CHECKED FOR IN THE

C       FOLLOWING ORDER.  WE ARE ATTEMPTING TO SET LPIECE TO THE NUMBER

C       OF CHARACTERS THAT SHOULD BE TAKEN FROM MESSG STARTING AT

C       POSITION NEXTC.

C

C       LPIECE .EQ. 0   THE NEW LINE SENTINEL DOES NOT OCCUR IN THE

C                       REMAINDER OF THE CHARACTER STRING.  LPIECE

C                       SHOULD BE SET TO LWRAP OR LENMSG+1-NEXTC,

C                       WHICHEVER IS LESS.

C

C       LPIECE .EQ. 1   THE NEW LINE SENTINEL STARTS AT MESSG(NEXTC:

C                       NEXTC).  LPIECE IS EFFECTIVELY ZERO, AND WE

C                       PRINT NOTHING TO AVOID PRODUCING UNNECESSARY

C                       BLANK LINES.  THIS TAKES CARE OF THE SITUATION

C                       WHERE THE LIBRARY ROUTINE HAS A MESSAGE OF

C                       EXACTLY 72 CHARACTERS FOLLOWED BY A NEW LINE

C                       SENTINEL FOLLOWED BY MORE CHARACTERS.  NEXTC

C                       SHOULD BE INCREMENTED BY 2.

C

C       LPIECE .GT. LWRAP+1  REDUCE LPIECE TO LWRAP.

C

C       ELSE            THIS LAST CASE MEANS 2 .LE. LPIECE .LE. LWRAP+1

C                       RESET LPIECE = LPIECE-1.  NOTE THAT THIS

C                       PROPERLY HANDLES THE END CASE WHERE LPIECE .EQ.

C                       LWRAP+1.  THAT IS, THE SENTINEL FALLS EXACTLY

C                       AT THE END OF A LINE.

C

C

C       THERE WAS NO NEW LINE SENTINEL FOUND.

C

         IDELTA = 0

                  IDELTA = 1

               ENDIF

         ENDIF

C

C       WE HAVE A NEW LINE SENTINEL AT MESSG(NEXTC:NEXTC+1).

C       DON'T PRINT A BLANK LINE.

C

C

C       LPIECE SHOULD BE SET DOWN TO LWRAP.

C

         IDELTA = 0

         LPIECE = LWRAP

               IDELTA = 1

            ENDIF

      ELSE

C

C       IF WE ARRIVE HERE, IT MEANS 2 .LE. LPIECE .LE. LWRAP+1.

C       WE SHOULD DECREMENT LPIECE BY ONE.

C

      ENDIF

C

C       PRINT

C

C

      RETURN