!* MODIFIED 23/03/82
!*
!*
%RECORDFORMAT COMFMT(%INTEGER CONTROL,OPTIONS,OPTIONS1,OPTIONS2,PTRACE,
      ADICT,ANAMES,ADOUTPUT,ADBLKDTAID,DICLEN,DPTR,
      MAXTRIADS,NEXTPLAB,ALABH,ADLHEAD,
      SUBPROGTYPE,SFPTR,EXTERNALS,CBNPTR,SCPTR,CHECKLIST,
      RESCOM1,RESCOM2,GLACA,FNO,FAULTY,LINEST,CMNIIN,SFMK,
      LISTL,LISTSTREAM,DIAGSTREAM,LISTPOINT,XREF,
      PACKCMN,ITSMODE,PATHANAL,CHARACTER CODE,SPACE CHAR,
      HEADINGS,ARRAYCHECKS,JBRMODE,MESSLEN,NAMESLEN,
      NEXTCH,FUNRESDISP,WARNCOUNT,INP,MAXINP,MESSCOUNT,
      UNASSPATTERN,LISTCODE,PI21INT,DOPTR,SUBPROGPTR,
      FNLST,LAB,NAMESFREE,ALGOLREF,FIRSTSTATNUM,CEXPDICT,
      COMMONBASE,FASTPROLOGUE,STATEMENT,IFPTR,
      CNSTCA,COMMENTCNT,ADIDENT,ADERRIDEN)
%EXTERNALROUTINE QCMESS
{dummy}
%END
!*
%EXTERNALROUTINE FAULTNUM(%INTEGER ER,COMAD,UPDATE)
%RECORD(COMFMT)%NAME COM
   %SWITCH MESS (100:320)
      COM==RECORD(COMAD)
      %IF ER < 100 %OR ER > 320 %THEN -> ERR
      -> MESS(ER)
!*
%ROUTINE E
      PRINTSTRING("Error ")
      WRITE(ER,1)
      SPACE
      %IF UPDATE#0 %THEN COM_FNO=COM_FNO+1
%END
!*
%ROUTINE W
      PRINTSTRING("Warning")
      WRITE(ER,1)
      SPACE
      %IF UPDATE#0 %THEN COM_WARNCOUNT=COM_WARNCOUNT+1
%END
!*
%ROUTINE C
      PRINTSTRING("Comment")
      WRITE(ER,1)
      SPACE
      %IF UPDATE#0 %THEN COM_COMMENTCNT=COM_COMMENTCNT+1
%END
!*
%ROUTINE ID
      PRINTSTRING(STRING(COM_ADIDENT))
%END
!*
%ROUTINE EID
      PRINTSTRING(STRING(COM_ADERRIDEN))
%END
!*
%ROUTINE NUM
      WRITE(COM_PI21INT,1)
%END
!*
   MESS(100): E;PRINTSTRING("Syntax error (at or before column ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(101): E;PRINTSTRING("First statement cannot be a continuation statement")     ; -> END
   MESS(102): E;PRINTSTRING("Columns 1 - 5 of a continuation statement must be blank")     ; -> END
   MESS(103): E;PRINTSTRING("Only 19 continuation statements allowed")     ; -> END
   MESS(104): E;PRINTSTRING("Statement incomplete")     ; -> END
   MESS(105): E;PRINTSTRING("Incomplete Hollerith constant")     ; -> END
   MESS(106): E;PRINTSTRING("Invalid character (at or before column ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(107): E;PRINTSTRING("Invalid (non-graphic) character")     ; -> END
   MESS(108): E;PRINTSTRING("Non-numeric label")     ; -> END
   MESS(109): E;PRINTSTRING("Brackets not matched")     ; -> END
   MESS(110): E;PRINTSTRING("Invalid statement label ")
               NUM; -> END
   MESS(111): E;PRINTSTRING("Label ")
               NUM;PRINTSTRING(" not set")     ; -> END
   MESS(112): E;PRINTSTRING("Evaluation of constant expression causes overflow")     ; -> END
   MESS(113): E;PRINTSTRING("Constant exponentiation must be to an integer power")     ; -> END
   MESS(114): E;PRINTSTRING("Invalid character length (must be 1 - 512)")     ; -> END
   MESS(115): E;PRINTSTRING("Invalid Hollerith constant length (must be 1 - 256)")     ; -> END
   MESS(116): E;PRINTSTRING("Invalid constant")     ; -> END
   MESS(117): E;PRINTSTRING("Invalid real constant")     ; -> END
   MESS(118): E;PRINTSTRING("Invalid complex constant")     ; -> END
   MESS(119): W;PRINTSTRING("Use of Q exponent is not standard FORTRAN77")     ; -> END
   MESS(120): E;PRINTSTRING("Constant is not in the permitted range")     ; -> END
   MESS(121): E;PRINTSTRING("Illegal common block identifier ")
                ID; -> END
   MESS(122): E; ID;PRINTSTRING(" is already in common")     ; -> END
   MESS(123): E; ID;PRINTSTRING(" is a parameter")     ; -> END
   MESS(124): E;PRINTSTRING("Invalid length specification")     ; -> END
   MESS(125): E;PRINTSTRING("Integer constant required")     ; -> END
   MESS(126): E; ID;PRINTSTRING(" is not a simple integer variable")     ; -> END
   MESS(127): E;PRINTSTRING("Illegal use of identifier ")
                ID; -> END
   MESS(128): E;PRINTSTRING("Invalid subprogram identifier ")
                ID; -> END
   MESS(129): E;PRINTSTRING("Invalid argument")     ; -> END
   MESS(130): E;PRINTSTRING("Invalid expression")     ; -> END
   MESS(131): E;PRINTSTRING("Expression must be of type integer")     ; -> END
   MESS(132): E;PRINTSTRING("Invalid combination of operands")     ; -> END
   MESS(133): E;PRINTSTRING("Invalid expression in a logical IF statement")     ; -> END
   MESS(134): E;PRINTSTRING("Invalid exponent")     ; -> END
   MESS(135): E;PRINTSTRING("Nested statement function reference")     ; -> END
   MESS(136): E;PRINTSTRING("Invalid subscript in implied-DO")     ; -> END
   MESS(137): E;PRINTSTRING("Invalid implied-DO index")     ; -> END
   MESS(138): E; -> END
   MESS(139): E;PRINTSTRING("Wrong number of parameters")     ; -> END
   MESS(140): E;PRINTSTRING("Recursive statement function definition")     ; -> END
   MESS(141): E;PRINTSTRING("Invalid ENTRY identifier")     ; -> END
   MESS(142): E; ID;PRINTSTRING(" is a subprogram identifier")     ; -> END
   MESS(143): E;PRINTSTRING("Parameter length or type is incorrect")     ; -> END
   MESS(144): E;PRINTSTRING("Variable name expected")     ; -> END
   MESS(145): E;PRINTSTRING("Invalid array dimension ")
               NUM; -> END
   MESS(146): E; ID;PRINTSTRING(" is not valid as an array dimension")     ; -> END
   MESS(147): E;PRINTSTRING("Nested use of a DO or implied-DO index")     ; -> END
   MESS(148): E;PRINTSTRING("Wrongly nested DO statements")     ; -> END
   MESS(149): E;PRINTSTRING("FORMAT statement label is missing")     ; -> END
   MESS(150): E; -> END
   MESS(151): E;PRINTSTRING("Missing left bracket")     ; -> END
   MESS(152): E;PRINTSTRING("Missing right bracket")     ; -> END
   MESS(153): E;PRINTSTRING("- is only valid with a P scale factor")     ; -> END
   MESS(154): E; ID;PRINTSTRING(" is an invalid format construction")     ; -> END
   MESS(155): E;PRINTSTRING("Decimal field is greater than width in item ")
                ID; -> END
   MESS(156): E;PRINTSTRING("Width of zero is invalid in item ")
                ID; -> END
   MESS(157): E;PRINTSTRING("Repetition factor is invalid in item ")
                ID; -> END
   MESS(158): E;PRINTSTRING("Null literal is not allowed")     ; -> END
   MESS(159): E;PRINTSTRING("Integer value is too large in item ")
                ID; -> END
   MESS(160): E;PRINTSTRING("No width field allowed in item ")
                ID; -> END
   MESS(161): E;PRINTSTRING("Input to a literal is not allowed")     ; -> END
   MESS(162): E;PRINTSTRING("Minimum digits field is greater than width in item ")
                ID; -> END
   MESS(163): E;PRINTSTRING("No format item preceding comma")     ; -> END
   MESS(164): E;PRINTSTRING("Non-repeatable edit desciptor ")
                ID; -> END
   MESS(165): E;PRINTSTRING("Comma required before item ")
                ID; -> END
   MESS(166): E;PRINTSTRING("Decimal point not allowed in item ")
                ID; -> END
   MESS(167): E; -> END
   MESS(168): E; -> END
   MESS(169): E; -> END
   MESS(170): E; -> END
   MESS(171): E; -> END
   MESS(172): E; -> END
   MESS(173): E; -> END
   MESS(174): E; -> END
   MESS(175): E; -> END
   MESS(176): E; -> END
   MESS(177): E; -> END
   MESS(178): C; ID;PRINTSTRING(" is not a FORTRAN77 intrinsic function")     ; -> END
   MESS(179): E; ID;PRINTSTRING(" has already appeared in an INTRINSIC statement")     ; -> END
   MESS(180): E; ID;PRINTSTRING(" is a constant identifier")     ; -> END
   MESS(181): E; ID;PRINTSTRING(" has already appeared in an EXTERNAL statement")     ; -> END
   MESS(182): E;PRINTSTRING("Attempt to equivalence char and non-char items (at line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(183): W; ID;PRINTSTRING(" contains char and non-char items - not standard FORTRAN77")     ; -> END
   MESS(184): E; ID;PRINTSTRING(" cannot be SAVEd (at line ")
               NUM;PRINTSTRING(") - it is an argument identifier")     ; -> END
   MESS(185): E; ID;PRINTSTRING(" cannot be SAVEd (at line ")
               NUM;PRINTSTRING(") - it is a procedure identifier")     ; -> END
   MESS(186): E; ID;PRINTSTRING(" cannot be SAVEd (at line ")
               NUM;PRINTSTRING(") - it is an item in common")     ; -> END
   MESS(187): E; ID;PRINTSTRING(" specified in SAVE is a common block")     ; -> END
   MESS(188): E; ID;PRINTSTRING(" specified in SAVE is not a common block")     ; -> END
   MESS(189): E; -> END
   MESS(190): E;PRINTSTRING("INTEGER*2 variable is not allowed in this context")     ; -> END
   MESS(191): W;PRINTSTRING("Format specifier is a non-char array - not standard FORTRAN77")     ; -> END
   MESS(192): E;PRINTSTRING("Expression is not logical")     ; -> END
   MESS(193): W;PRINTSTRING("Use of Hollerith is not standard FORTRAN77")     ; -> END
   MESS(194): W;PRINTSTRING("Char data in non-char item is not standard FORTRAN77")     ; -> END
   MESS(195): E;PRINTSTRING("Function has not been assigned a value")     ; -> END
   MESS(196): E;PRINTSTRING("Adjustable dimension ")
                EID;PRINTSTRING(" to array ")
                ID;PRINTSTRING(" is not of type integer")     ; -> END
   MESS(197): E;PRINTSTRING("Entry name cannot be of type character (as function is not)")     ; -> END
   MESS(198): E;PRINTSTRING("Entry name must be of type character (as function is)")     ; -> END
   MESS(199): E;PRINTSTRING("Intrinsic function ")
                ID;PRINTSTRING(" may not be used as an argument")     ; -> END
   MESS(200): W;PRINTSTRING("Nonstandard facility")     ; -> END
   MESS(201): W;PRINTSTRING("Identifier ")
                ID;PRINTSTRING(" contains >6 characters - not standard FORTRAN77")     ; -> END
   MESS(202): E;PRINTSTRING("RETURN not allowed in main program")     ; -> END
   MESS(203): E;PRINTSTRING("Illegal transfer into IF, ELSEIF or ELSE block (at line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(204): E;PRINTSTRING("Illegal transfer into IF, ELSEIF or ELSE block (from line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(205): E;PRINTSTRING("Illegal transfer into the range of a DO loop (at line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(206): E;PRINTSTRING("Illegal transfer into the range of a DO loop (from line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(207): E;PRINTSTRING("ELSE or ELSEIF statement may not follow an ELSE statement")     ; -> END
   MESS(208): E;PRINTSTRING("ENDIF statement missing")     ; -> END
   MESS(209): E;PRINTSTRING("Label on ELSE or ELSEIF statement illegally referenced at line ")
               NUM; -> END
   MESS(210): E;PRINTSTRING("Illegal reference to label on ELSE or ELSEIF statement at line ")
               NUM; -> END
   MESS(211): E; ID;PRINTSTRING(" specification already given")     ; -> END
   MESS(212): E; ID;PRINTSTRING(" specification not applicable")     ; -> END
   MESS(213): E;PRINTSTRING("Invalid unit or internal file identifier")     ; -> END
   MESS(214): E;PRINTSTRING("Invalid format identifier")     ; -> END
   MESS(215): E;PRINTSTRING("Assumed size CHARACTER operand not valid in format identifier")     ; -> END
   MESS(216): E;PRINTSTRING("REC= value must be an integer expression")     ; -> END
   MESS(217): E; ID;PRINTSTRING(" specifier is invalid")     ; -> END
   MESS(218): E;PRINTSTRING("Label already referenced as an executable statement (at line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(219): E;PRINTSTRING("END= specifier is not valid in a WRITE statement")     ; -> END
   MESS(220): E;PRINTSTRING("Invalid format specifier for an internal file")     ; -> END
   MESS(221): E;PRINTSTRING("A format specifier is required when accessing an internal file")     ; -> END
   MESS(222): E;PRINTSTRING("REC= specifier not valid for an internal file")     ; -> END
   MESS(223): E;PRINTSTRING("* is not valid as unit in ")
                ID;PRINTSTRING(" statement")     ; -> END
   MESS(224): E; ID;PRINTSTRING(" value must be a statement label")     ; -> END
   MESS(225): E;PRINTSTRING("Label ")
               NUM;PRINTSTRING(" refers to a non-executable statement")     ; -> END
   MESS(226): E;PRINTSTRING("IOSTAT= specifier invalid")     ; -> END
   MESS(227): E;PRINTSTRING("Label has already been set (at line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(228): E;PRINTSTRING("Label has been set or referenced as a FORMAT label (at line ")
               NUM;PRINTSTRING(")")     ; -> END
   MESS(229): E;PRINTSTRING("ELSE or ELSEIF does not follow a block IF or ELSEIF statement")     ; -> END
   MESS(230): E;PRINTSTRING("ENDIF does not follow a block IF,ELSEIF or ELSE statement")     ; -> END
   MESS(231): E;PRINTSTRING("Upper dimension bound is less than the lower bound")     ; -> END
   MESS(232): E;PRINTSTRING("Subscript to array ")
                ID;PRINTSTRING(" is outside the declared bounds")     ; -> END
   MESS(233): E;PRINTSTRING("Non-numeric or zero label")     ; -> END
   MESS(234): E;PRINTSTRING("Invalid nesting of a D0-loop and an IF-block")     ; -> END
   MESS(235): E;PRINTSTRING("ENTRY statement is not allowed within a DO-loop or an IF-block")     ; -> END
   MESS(236): E;PRINTSTRING("Misplaced specification statement")     ; -> END
   MESS(237): E;PRINTSTRING("Misplaced statement function statement")     ; -> END
   MESS(238): E;PRINTSTRING("IMPLICIT must precede all other specification except PARAMETER")     ; -> END
   MESS(239): E; ID;PRINTSTRING(" cannot be typed after it has appeared in a PARAMETER statement")     ; -> END
   MESS(240): E; ID;PRINTSTRING(" is already defined as a constant identifier")     ; -> END
   MESS(241): E; ID;PRINTSTRING(" has been defined and cannot be a constant identifier")     ; -> END
   MESS(242): W;PRINTSTRING("Specification of item length in bytes is not standard FORTRAN77")     ; -> END
   MESS(243): E;PRINTSTRING("Label parameter is not allowed in a function")     ; -> END
   MESS(244): E;PRINTSTRING("A subprogram is not allowed to call itself recursively")     ; -> END
   MESS(245): E; ID;PRINTSTRING(" is not an array identifier")     ; -> END
   MESS(246): E; ID;PRINTSTRING(" is invalid in a dimension expression")     ; -> END
   MESS(247): E;PRINTSTRING("An array is not allowed more than 7 dimensions")     ; -> END
   MESS(248): E;PRINTSTRING("Array ")
                ID;PRINTSTRING(" with adjustable dimensions is not a parameter array")     ; -> END
   MESS(249): E;PRINTSTRING("Array dimensions must be of type integer")     ; -> END
   MESS(250): E; ID;PRINTSTRING(" has adjustable dimension ")
                EID;PRINTSTRING(" not in COMMON or same argument list")     ; -> END
   MESS(251): E;PRINTSTRING("Array ")
                ID;PRINTSTRING(" cannot be in COMMON and have adjustable dimensions")     ; -> END
   MESS(252): E;PRINTSTRING("Array ")
                ID;PRINTSTRING(" has an assumed size but is not a parameter")     ; -> END
   MESS(253): E;PRINTSTRING("Subscript must be of type integer")     ; -> END
   MESS(254): E; ID;PRINTSTRING(" cannot be an array identifier")     ; -> END
   MESS(255): E;PRINTSTRING("Invalid reference to assumed size array ")
                ID; -> END
   MESS(256): E;PRINTSTRING("Substring position value must be of type integer")     ; -> END
   MESS(257): E;PRINTSTRING("Invalid substring position value")     ; -> END
   MESS(258): E;PRINTSTRING("Combination of DOUBLE PRECISION and COMPLEX operands not allowed")     ; -> END
   MESS(259): E;PRINTSTRING("Invalid concatenation (includes a scalar with (*) length)")     ; -> END
   MESS(260): E;PRINTSTRING("Invalid comparison between arithmetic and non-arithmetic values")     ; -> END
   MESS(261): E;PRINTSTRING("Complex operands not permitted for .LT.,.LE.,.GT. or .GE.")     ; -> END
   MESS(262): E; ID;PRINTSTRING(" has already been declared as an array")     ; -> END
   MESS(263): E;PRINTSTRING("Char items can only be equivalenced to other char items")     ; -> END
   MESS(264): E;PRINTSTRING("Wrong number of subscripts specified for ")
                ID; -> END
   MESS(265): E;PRINTSTRING("An EQUIVALENCE list must contain at least two items")     ; -> END
   MESS(266): E;PRINTSTRING("An EQUIVALENCE list can contain only one COMMON item")     ; -> END
   MESS(267): E;PRINTSTRING("Contradiction in EQUIVALENCE list at line ")
               NUM; -> END
   MESS(268): E;PRINTSTRING("EQUIVALENCE attempts to extend COMMON backwards")     ; -> END
   MESS(269): E; ID;PRINTSTRING(" has already been typed")     ; -> END
   MESS(270): E; ID;PRINTSTRING(" must not appear in a type statement")     ; -> END
   MESS(271): E;PRINTSTRING("Char length specification must be an integer constant expression")     ; -> END
   MESS(272): E; ID;PRINTSTRING(" is not permitted to have a length of (*)")     ; -> END
   MESS(273): E;PRINTSTRING("Invalid alphabetic sequence")     ; -> END
   MESS(274): E;PRINTSTRING("Implicit type for ")
                ID;PRINTSTRING(" already specified")     ; -> END
   MESS(275): E; ID;PRINTSTRING(" has not been defined as a symbolic constant identifier")     ; -> END
   MESS(276): E; ID;PRINTSTRING(" cannot be defined as a symbolic constant identifier")     ; -> END
   MESS(277): E;PRINTSTRING("Hollerith constant exceeds item size")     ; -> END
   MESS(278): E;PRINTSTRING("Constant expression is of the wrong type")     ; -> END
   MESS(279): E; ID;PRINTSTRING(" is not valid in an INTRINSIC statement")     ; -> END
   MESS(280): E; ID;PRINTSTRING(" is not a common block identifier")     ; -> END
   MESS(281): E; -> END
   MESS(282): E;PRINTSTRING("COMMON may only be initialised in a BLOCKDATA subprogram")     ; -> END
   MESS(283): E;PRINTSTRING("Items in blank common may not be initialised")     ; -> END
   MESS(284): E; ID;PRINTSTRING(" is not specified in a COMMON statement")     ; -> END
   MESS(285): E;PRINTSTRING("Constant not compatible with variable ")
                ID; -> END
   MESS(286): E;PRINTSTRING("Too many constants specified")     ; -> END
   MESS(287): E;PRINTSTRING("Not enough constants specified")     ; -> END
   MESS(288): E; ID;PRINTSTRING(" is not an integer const identifier or an implied-DO-variable")     ; -> END
   MESS(289): E;PRINTSTRING("Implied-DO-list may specify only array element names")     ; -> END
   MESS(290): E;PRINTSTRING("Iteration count for an implied-DO-list must be positive")     ; -> END
   MESS(291): E;PRINTSTRING("Label ")
               NUM;PRINTSTRING(" may not be ASSIGNed")     ; -> END
   MESS(292): E;PRINTSTRING("Statement invalid after a logical IF")     ; -> END
   MESS(293): E;PRINTSTRING("Type of DO-variable is invalid")     ; -> END
   MESS(294): E;PRINTSTRING("Statement not allowed to end a DO-loop")     ; -> END
   MESS(295): E;PRINTSTRING("Increment of DO-loop is zero")     ; -> END
   MESS(296): E;PRINTSTRING("Invalid type of expression for a DO parameter")     ; -> END
   MESS(297): E; ID;PRINTSTRING(" invalid in input/output list")     ; -> END
   MESS(298): E;PRINTSTRING("Invalid input list item")     ; -> END
   MESS(299): E;PRINTSTRING("Implied-DO-variable must not occur in the controlled input list")     ; -> END
   MESS(300): E;PRINTSTRING("Intrinsic function ")
                ID;PRINTSTRING(" must not be used as an actual argument")     ; -> END
   MESS(301): E; ID;PRINTSTRING(" cannot appear in a DATA or EQUIVALENCE list")     ; -> END
   MESS(302): E;PRINTSTRING("Label ")
               NUM;PRINTSTRING(" has already been used as a statement label")     ; -> END
   MESS(303): E;PRINTSTRING("END statement is missing")     ; -> END
   MESS(304): E;PRINTSTRING("Alignment error in common")     ; -> END
   MESS(305): E;PRINTSTRING("BLOCKDATA must not contain any executable statements")     ; -> END
   MESS(306): E; -> END
   MESS(307): E;PRINTSTRING("Statement too complex to compile")     ; -> END
   MESS(308): E;PRINTSTRING("Too many names in subprogram")     ; -> END
   MESS(309): E;PRINTSTRING("Too many faults in program")     ; -> END
   MESS(310): E;PRINTSTRING("Program too large")     ; -> END
   MESS(311): E;PRINTSTRING("OPEN, CLOSE and INQUIRE not yet available")     ; -> END
   MESS(312): E;PRINTSTRING("Initialised COMMON not yet available for FORTRAN77 in JOBBER")     ; -> END
   MESS(313): E;PRINTSTRING("A UNIT or FILE specifier must be provided")     ; -> END
   MESS(314): E;PRINTSTRING("UNIT and FILE specifiers may not both be provided")     ; -> END
   MESS(315): E;PRINTSTRING("A UNIT specifier is required")     ; -> END
   MESS(316): E; -> END
   MESS(317): E; -> END
   MESS(318): E; -> END
   MESS(319): E; -> END
   MESS(320): E;
END:  NEWLINE
      %RETURN
   ERR:
   MESS(*):
      E; PRINTSTRING("No error text provided")
      NEWLINE
%END
!*
%ENDOFFILE