program PMESS
c     .  Copyright (C) 1991, California Institute of Technology.
c     .  All rights reserved.  U. S. Government sponsorship under
c     .  NASA contract NAS7-918 is acknowledged.
c>  2008-01-08 PMESS Krogh  Fixed integer/parameter output.
c>> 2008-01-06 PMESS Krogh  Added output of comment at end.
c>> 2006-06-30 PMESS Krogh  Removed unused labels.
c>> 2002-05-12 PMESS Krogh  Fixed minor prob. with separator lines.
c>> 2001-12-28 PMESS Krogh  Fixed for new NSKIP feature in MESS.
c>> 1998-11-27 PMESS Krogh  Fixed bug in last extensive change.
c>> 1998-11-27 PMESS Krogh  Fixed bug in last extensive change.
c>> 1998-11-20 PMESS Krogh  Extensive changes for 1 item/data statement.
c>> 1998-11-18 PMESS Krogh  Improved diagnostics.
c>> 1995-12-01 PMESS Krogh  Big fix so char. data at col. 72 is not ' '.
c>> 1992-04-24 PMESS Krogh  Rewritten for new MESS.
c This program prepares data for message processors MESS, SMESS and
c DMESS.  Input is from standard input, output is to a file named tmess.
c Input consists of lines (max. length is 80 characters) which contain
c one or more entries of the form:
c "text"$c
c where "text" is arbitrary text c is a character defining the action in
c MESS, SMESS or DMESS.  See comments there
c for more details.  A $c anyplace, means for c=B,E,R, ...:
c B   Break in text, later text continues on the same line.
c E   End of the text, later text continues on next line.
c R   End of the text, later text repeats the same text.
c H   Used to separate columns in a heading.
c I   Print integer from IDAT.
c J   Print integer from IDAT using user format.
c F   Print floating point number from FDAT.
c G   Print floating point number from FDAT using user format.
c M   Print integer set from MACT.
c N   Start a new line in the message, the message continues.
c (   Define a user format.
c T   Gives a tab.
c #   Use to get a row or column number in matrix output.
c $   Treat the "$$" as an embedded "$$" in the input.  Messages
c     will output the "$$" as a single "$".
c -   Start a negative number for skipping
c 0-9 Digits for skipping
c other    Don't use.
c
c The following characters are used by this program.
c C        Continue the text, don't output the "$C".  This should only
c          be used at the end of a line.
c "blank"  This can be used to introduce additional options.  If the
c          rest of the line is blank, this ends the input for the
c          current array.  If the blank is followed by a D, then the
c          data statement made up for the data above makes up a separate
c          data statement for each array element, and a header comment
c          is output so that the conversion to C will work with a single
c          array. (Until the next line starting with "$ ".)
c          These are the only options currently defined.
c
c PMESS generates parameter names of the form LTXTxx, where xx takes
c values of AA, AB, \ldots .  These names are associated with individual
c messages that might be printed, and are identified by comments of the
c form cAA, cAB, \ldots generated by PMESS.  The values generated for
c these parameters are the character positions of the message in the
c particular character array in which that message is stored.  Messages
c are first stored in a character array named MTXTAA, but if a line
c consisting of a single `\$' in column 1 is encountered the last two
c letters of this name are advanced as for LTXTxx, and further text is
c stored in the new character array.  PMESS generates both the
c declarations and the data for these character arrays.
c
c The comments (and just the comments) generated by PMESS can be used as
c inputs to PMESS.  Thus we recommend including these comments in the
c code both as documentation for the messages, and to simplify
c generating the data if changes to messages are desired.  If these
c comments are passed as input to PMESS, then the reference to column~1
c above should be to column~5.
c
c When generating the data for character strings, PMESS replaces a blank
c in column 72 with a `\$', and starts the next line with a blank.  This
c is done because some editors delete trailing blanks, and some
c compilers require that the trailing blanks in continued character data
c be present.

c Recall that for error messages, the text must start with the
c subprogram name, this name should be terminated with "$B".  We
c suggest that after the subprogram name, one give the text for the
c error messages in order.  Then the text for error message i, can be
c located from an array referenced by the error index.
c
c ************************ Variables Used ******************************
c
c BUF    Array of buffers holding the input.
c CDAT   Used to hold subscript for data statments.
c CHEAD  Text as start of output lines that contain the input lines.
c DBUF   Array used to hold the output data statement.
c I      Last index used currently in BUF.  And temporary index.
c I1     Temporary index.
c I2     Temporary index.
c IN     Index for input buffer, BUF.
c IBEG   Beginning of real input in BUF.  = 1 if doesn't start with
c        "c *" on first line, else is 5.
c IFIRST First index to use next in BUF.
c IFMT   Character variable holding format for integer output.
c ILTEXT Last location used in the output string.
c IOUT   Integer value to be output.
c ISAVE  Array containing values to output for the parameters output.
c        This is < 0 when we are working on a continued line, or it is
c        the last of a group of entries in which case its absolute value
c        is where the next entry would have started.
c ISAVE1 Value of ISAVEI for first ISAVE location of current set.
c ISAVEI Last index for storing into ISAVE.
c J      Temporary index.
c JFIRST First index used currently in BUF.
c K      Temporary index.
c KBR     used to track where character strings break.
c KCDAT  Number of charcters in CDAT, 0 if no array is output.
c KK     Temporary storage.
c KLINE  number of lines to hold the data statments.
c KLINEI Value of KLINE for first data statement in the current set.
c KM     Index of character following a "$" in 'BER#CNIFJGHM(T$'.  If
c        = 5, (a "C") then skip last two characters and continue; if <7,
c        got something allowed at end of line; else got something that
c        shouldn't appear at the end of a line.
c KML    The last value of KM (-1 initially).  Used to decide if a line
c        is a continuation line.
c KONLIN Number of continuation lines in the current data statement.
c KTEXT  Count of characters in current output array.
c KV     Used as index into LCE and LCA.
c LBUF   Array giving index of last character to save in BUF().  If this
c        is not a continuation line, the negative of the index is saved.
c LCA    LCA(KV) gives number of elements in array for text.
c LCE    Array, LCE(KV) gives character length for array elements in the
c        KV-th text array.
c LDONE  Set = .true. if we are finished with a data output line.
c LEFT   Number of characters left before current character array entry
c        is filled.
c LEND   End of text in OBUF.
c LI     Absolute value of current location in LBUF.
c LINE   Number of lines in the current parameter statement.
c LLOC   Location of next character to be stored in current array.
c MAXP   Used in computing maximum value for a parameter.
c MORE   Logical variable set .true. until we hit an end of file.
c        Also set .true. if we have an extra comment line to output.
c OBUF   Buffer holding the output, and used for temporary storage.
c PARAM  Contains text (that is modified) for output of parameter data.
c
c ************************ Variable Declarations ***********************
c
      character BUF(200)*80,CDAT*8,IFMT*4,OBUF*160,DBUF(300)*72
      character PARAM*7, MTXT*6, CHEAD*4
      logical LDONE, MORE
      integer I, I1, I2, IBEG, IFIRST, ILTEXT, IN, ISAVE(1000),
     1   ISAVE1, ISAVEI, J, JFIRST, K, KBR, KCDAT, KK, KLINE,
     2   KLINEI, KM, KML, KONLIN, KTEXT, KV, LBUF(200), LCA(500),
     3   LCE(500), LEFT, LEND, LI, LINE, LLOC, MAXP
      data PARAM/ 'LTXTAA=' /
      data CHEAD/ 'cAA ' /
      data MTXT / 'MTXTAA' /
      data IFMT / '(Ix)' /
   10 format(' $$$$ Warning -- Have', I3, ' continuation lines.'/
     1  ' Use line starting with "$ " to correct.')
   20 format(1X, A/
     1  ' The above line is missing a "$"  and is ignored.')
   30 format(1X, A/
     1  ' Last line given above must end with $B, $E, $R, or $M.')
   40 format('Unrecognized option in line below'/ A)
   50 format(' Ignored line starting with'/ A)
   60 format(' Line below is too long, use "$C" to correct.'/ 1X,A)
   70 format('C End of storing data by elements.')
c
c ************************ Start of executable code ********************
c                                    Open files.
c debug      open (UNIT=9, FILE='TMP.ERR')
      open (UNIT=10, STATUS='SCRATCH')
      open (UNIT=11, STATUS='UNKNOWN', FILE='tmess')
      write(11, '(''c ********* Error message text ***************''/
     1''c[Last 2 letters of Param. name]  [Text generating message.]'')'
     2            )
      MAXP = 0
      IBEG = 0
      MORE = .true.
      KML = -1
      KLINE = 0
      ISAVEI = 0
      KV = 0
  100 KTEXT = 0
      KCDAT = 0
      IN = 0
c
  110 IN = IN + 1
  120 ILTEXT = 0
      BUF(IN) = ' '
c debug      read(9, '(A)', END=160) BUF(IN)
      read(*, '(A)', END=160) BUF(IN)
      if (IBEG .le. 0) then
c              Checks so we know where the real column 1 is.
         if (IBEG .eq. 0) then
            if (BUF(IN)(1:4) .eq. 'c **') then
               IBEG = -1
               go to 110
            end if
            IBEG = 1
         else
            if (BUF(IN)(1:2) .ne. 'c[') then
               print '(''Inconsistent use of "c" at start'')'
               go to 400
            end if
            IBEG = 5
            go to 110
         end if
      end if
      IFIRST = IBEG
c                 Check out individual lines.
      I = index(BUF(IN)(IFIRST:80), '$')
      JFIRST = IFIRST
      if (I .eq. 0) then
         if (BUF(IN) .eq. ' ') go to 120
         if (JFIRST .eq. 1) print 20, BUF(IN)
         go to 120
      else
  140    I = I + IFIRST
         IFIRST = I + 1
c                    123456789012345
         KM = index('BER#CNIFJGHM(T$', BUF(IN)(I:I))
  145    if (KM .eq. 0) then
c                          Check for '-' or a digit
            if (((BUF(IN)(I:I) .ge. '0') .and. (BUF(IN)(I:I) .le. '9'))
     1           .or. (BUF(IN)(I:I) .eq. '-')) then
               KM = 8
               go to 145
            end if
c                          No match
            if (I .eq. IBEG+1) then
c                          Check if this is a special separator line.
               if ((BUF(IN)(IBEG+1:IBEG+1) .le. ' ')) then
c                     Separator line, error if last line was continued
                  if (KML .ge. 5) print 30, BUF(IN-1)
                  KML = -1
                  J = IBEG
                  if (BUF(IN)(J+2:J+2) .ne. ' ') then
  150                J = J + 1
                     if (BUF(IN)(J+1:J+1) .ne. ' ') then
                        if (BUF(IN)(J+1:J+1) .eq. 'D') then
c                            Setup for output of array subscripts.
                           KCDAT = 5
                        else
c                           Flag for unrecognized option
                           IBEG = -IBEG
                        end if
                        go to 150
                     end if
                     if (IBEG .lt. 0) then
c                           Output message for unrecognized option.
                        print 40, BUF(IN)(1:J)
                        IBEG = -IBEG
                     end if
                  end if
                  write (11, '(''c   '',A)') BUF(IN)(IBEG:J)
                  go to 170
               end if
            end if
            print 50, BUF(IN)(1:I)
            go to 110
         else if (KM .ge. 6) then
            I = index(BUF(IN)(IFIRST:80), '$')
            if (I .ne. 0) go to 140
            I = IFIRST - 1
         end if
      end if
      ILTEXT = ILTEXT + (I - JFIRST)
      if (ILTEXT .gt. 67) print 60, BUF(IN)
      ILTEXT = ILTEXT + IBEG
      if (KML .ge. 5) then
c              Line is being continued.
         write (11, '(A,A)') 'c   ', BUF(IN)(IBEG:ILTEXT)
      else
c              This is a header line.
         write (11, '(A,A)') CHEAD, BUF(IN)(IBEG:ILTEXT)
c              Update characters in CHEAD for the next one.
         if (CHEAD(3:3) .eq. 'Z') then
            CHEAD(2:2) = char(ichar(CHEAD(2:2))+1)
            CHEAD(3:3) = 'A'
         else
            CHEAD(3:3) = char(ichar(CHEAD(3:3))+1)
         end if
      end if
      if (KM .eq. 5) ILTEXT = ILTEXT - 2
      KTEXT = KTEXT + ILTEXT
c         Store negative of the count if line is not a continuation.
      if (KML .lt. 5) ILTEXT = -ILTEXT
      KML = KM
      LBUF(IN) = ILTEXT
      go to 110
c
c At this point the header comments have been written, BUF(IN)
c contains the input lines, and LBUF(IN) contains the number
c of characters on each of these input lines.  It may be necessary
c to adjust this count later.
  160 MORE = .false.
      if (KML .ge. 5) print 30, BUF(IN-1)
c Make up the data statements for the lines seen so far.
  170 IN = IN - 1
      KTEXT = KTEXT - (IBEG-1) * IN
      if (KTEXT .eq. 0) go to 300
      KV = KV + 1
      KLINEI = KLINE
      ISAVE1 = ISAVEI

      LCA(KV) = 1 + (KTEXT-1) / 248
      KBR = (KTEXT-1) / LCA(KV)
c Below is the tricky part.  Make up the data statments, assuming
c a character array of length KBR.  Need to fill up the lines,
c inserting a $ if a line would end with a blank.  Also, need to
c change ' to ''.  If we need to much space, KBR must be increased.
  210 KBR = KBR + 1
      LEFT = KBR
      LCE(KV) = KBR
      if (KCDAT .ne. 0) then
         KCDAT = 5
         CDAT = '(1)/'''
      end if
      KLINE = KLINEI
      ISAVEI = ISAVE1
      LEND = 0
      LLOC = 1
      do 280 I = 1, IN
         LI = LBUF(I)
         if (LI .lt. 0) then
            LI = -LI
            ISAVEI = ISAVEI + 1
            ISAVE(ISAVEI) = LLOC
         end if
         J = IBEG
  220    if (LEND .eq. 0) then
            OBUF(1:19) = '      data ' // MTXT // '/'''
            LEND = 19
            if (KCDAT .ne. 0) then
               LEND = KCDAT + 17
               OBUF(18:LEND) = CDAT(1:KCDAT)
               do 230 K = KCDAT-3, 2, -1
                  I1 = ichar(CDAT(K:K))
                  if (I1 .lt. ichar('9')) then
                     CDAT(K:K) = char(I1 + 1)
                     go to 240
                  end if
                  CDAT(K:K) = '0'
                  if (K .eq. 2) then
                     CDAT(2:2) = '1'
                     KCDAT = KCDAT + 1
                     CDAT(KCDAT-3:KCDAT) = '0)/'''
                     go to 240
                  end if
  230          continue
  240          continue
            end if
         end if
c
  250    if (J .gt. LI) then
            if (I .lt. IN) go to 280
            J = 1
            LI = LEFT
            BUF(I)(1:LEFT) = ' '
         end if
  260    I1 = index(BUF(I)(J:LI), '''')
         if (I1 .eq. 0) I1 = LI - J + 1
         I2 = min(I1, LEFT)
         if (LEND + I2 .gt. 72) I2 = 72 - LEND
         OBUF(LEND+1:LEND+I2) = BUF(I)(J:J+I2-1)
         J = J + I2
         LLOC = LLOC + I2
         LEND = LEND + I2
         if (LEND .eq. 72) then
            if (OBUF(72:72) .eq. ' ') then
               if ((I .ne. IN) .or. (BUF(I)(1:LI) .ne. ' ')) then
c   Replace blank in col. 72 with $ and reread the blank later.
                  J = J  - 1
                  OBUF(72:72) = '$'
               end if
            end if
         end if
         if (OBUF(LEND:LEND) .eq. '''') then
c                           Double up on apostrophes.
            LEND = LEND + 1
            OBUF(LEND:LEND) = ''''
         end if
         LEFT = LEFT - I2
         LDONE = LEFT .eq. 0
         if (LDONE) then
            LEFT = KBR
            OBUF(LEND+1:LEND+2) = ''','
            LEND = LEND + 2
            LDONE = (I .eq. IN) .or. (KCDAT .ne. 0)
            if (LDONE) then
c  End of current data statement.
               if (I .eq. IN) then
c if (J .le LI) we didn't get all we should have, try again.
                  if (J .le. LI) go to 210
               end if
               OBUF(LEND:LEND) = '/'
            else
c  Start next array element.
               LEND = LEND + 1
               OBUF(LEND:LEND) = ''''
            end if
         end if
         if ((LEND .ge. 72) .or. LDONE) then
  270       KLINE = KLINE + 1
            DBUF(KLINE) = OBUF(1:min(LEND, 72))
            LEND = LEND - 72
            if (LEND .gt. 0) then
               OBUF(6:6+LEND) = '*' // OBUF(73:72+LEND)
               LEND = LEND + 6
               if (LDONE) go to 270
            end if
            if (LDONE) then
               if (I .eq. IN) go to 290
               LEND = 0
               go to 220
            else if (LEND .le. 0) then
               OBUF(6:6) = '*'
               LEND = 6
            end if
         end if
         if (J .le. LI) go to 260
         if (I .eq. IN) then
            if (LEFT .ne. 0) go to 250
         end if
  280 continue
c           Check here for too many continuation lines.
  290 if (KLINE .gt. KLINEI + 20) then
         if (KCDAT .eq. 0) print 10, KLINE - KLINEI - 1
      end if
      MAXP = max(MAXP, LLOC)
  300 if (MORE) then
         if (MTXT(6:6) .ne. 'Z') then
            MTXT(6:6) = char(ichar(MTXT(6:6))+1)
         else
            MTXT(5:6) = char(ichar(MTXT(5:5))+1) // 'A'
         end if
         go to 100
      end if

c                          Integer declarations for parameters
      LINE = 0
      do 320 I = 1, ISAVEI
 310    continue
        if (ISAVE(I) .gt. 0) then
          if (LINE .eq. 0) then
            LINE = 1
            OBUF(1:14) = '      integer '
            LEND = 14
          else if (LEND+7 .gt. 72) then
            write (11, '(A)') OBUF(1:LEND)
            LINE = LINE + 1
            if (LINE .gt. 19) then
              LINE = 0
              go to 310
            end if
            OBUF(1:7) = '     * '
            LEND = 7
          end if
          OBUF(LEND+1:LEND+6) = PARAM
          OBUF(LEND+7:LEND+7) = ','
          LEND = LEND + 7
        end if
        if (PARAM(6:6) .ne. 'Z') then
          PARAM(6:6) = char(ichar(PARAM(6:6))+1)
        else
          PARAM(5:6) = char(ichar(PARAM(5:5))+1) // 'A'
        end if
 320  continue
      if (LINE .ne. 0) write (11, '(A)') OBUF(1:LEND-1)
c
c                          Declare values for the parameters
      call PMESSI(MAXP-1, IFMT, K)
      K = K + 8
      KK = 18 - K
      if (LINE .ne. 0) then
        LINE = 0
        PARAM(5:6) = 'AA'
        do 350 I = 1, ISAVEI
          if (ISAVE(I) .gt. 0) then
 330        if (LINE .eq. 0) then
              LINE = 1
              OBUF(1:17) = '      parameter ('
              LEND = 17
            else if (LEND + K .gt. 72) then
              if (LINE .eq. 19) OBUF(LEND:LEND) = ')'
              write (11, '(A)') OBUF(1:LEND)
              LINE = LINE + 1
              if (LINE .gt. 19) then
                LINE = 0
                go to 330
              end if
              OBUF(1:KK) = '     * '
              LEND = KK
            end if
            OBUF(LEND+1:LEND+7) = PARAM
            write(OBUF(LEND+8:LEND+K), IFMT) ISAVE(I)
            LEND = LEND + K
            OBUF(LEND:LEND) = ','
          end if
          if (PARAM(6:6) .ne. 'Z') then
            PARAM(6:6) = char(ichar(PARAM(6:6))+1)
          else
            PARAM(5:6) = char(ichar(PARAM(5:5))+1) // 'A'
          end if
 350    continue
        OBUF(LEND:LEND) = ')'
        write(11, '(A)') OBUF(1:LEND)
      end if
c
c                          Declare the character variables
      KV = 0
      MTXT(5:6) = 'AA'
      do 360 I = 1, ISAVEI
        if (ISAVE(I) .eq. 1) then
          KV = KV + 1
          OBUF(1:23) = '      character ' // MTXT // '('
          call PMESSI(LCA(KV), IFMT, K)
          LEND = 23 + K
          write(OBUF(24:LEND), IFMT) LCA(KV)
          OBUF(LEND+1:LEND+5) = ') * ('
          call PMESSI(LCE(KV), IFMT, K)
          write(OBUF(LEND+6:LEND+5+K), IFMT) LCE(KV)
          LEND = LEND + 6 + K
          OBUF(LEND:LEND) = ')'
          write(11, '(A)') OBUF(1:LEND)
          if (MTXT(6:6) .ne. 'Z') then
            MTXT(6:6) = char(ichar(MTXT(6:6))+1)
          else
            MTXT(5:6) = char(ichar(MTXT(5:5))+1) // 'A'
          end if
        end if
  360 continue
c
c                          Write the data statements
      KONLIN = 0
      do 390 K = 1, KLINE
         if (DBUF(K)(6:6) .eq. ' ') then
            if (MORE) then
               if ((DBUF(K)(18:18).ne.'(').or.(DBUF(K)(19:20).eq.'1)'))
     1            then
                  MORE = .false.
                  write (11, 70)
               end if
            end if
            if (DBUF(K)(18:20) .eq. '(1)') then
               MORE = .true.
               write (11, '(''C++ Save data by elements if ~.C.'')')
            end if
         end if
         I = 72
         if (DBUF(K)(72:72) .eq. ' ') then
            do 370 I = 71, 7, -1
               if (DBUF(K)(I:I) .ne. ' ') go to 380
  370       continue
         end if
  380    write (11, '(A)') DBUF(K)(1:I)
  390 continue
      if (MORE) write (11, 70)
      write (11, '(''c **** End of automatically generated text'')')
      if (KONLIN .gt. 19) print 10, KONLIN
      print '('' tmess has been output.'')'
  400 close (10)
      close (11)
      stop
      end

      subroutine PMESSI(IOUT, IFMT, K)
c Sets IFMT to format for printing IOUT, and set K to number of digits
c that is printed by that format.
      integer IOUT, K, KK
      character*4 IFMT
c
      K = 1
      KK = 10
   10 if (KK .le. IOUT) then
         KK = 10 * KK
         K = K + 1
         go to 10
      end if
      IFMT(3:3) = char(ichar('0') + K)
      return
      end

.