mat_err Subroutine

subroutine mat_err(n)

! ident_4="@(#) M_matrix mat_err(3fp) given error number write associated error message and set G_ERR"

integer,intent(in)   :: n

integer              :: i
integer              :: k
integer              :: lb
integer              :: lt
character(len=255)   :: msg

   G_ERR = n
   select case(n)
    case(1);  msg='Improper multiple assignment'
    case(2);  msg='Improper factor'
    case(3);  msg='Expected right parenthesis'
    case(4);  msg='Undefined variable: '//ade2str(G_IDS(:,G_PT+1)) ! extract variable name into buffer
    case(5);  msg='Column lengths do not match'
    case(6);  msg='Row lengths do not match'
    case(7);  msg='Text too long'
    case(8);  msg='Incompatible for ADDITION'
    case(9);  msg='Incompatible for SUBTRACTION'
    case(10); msg='Incompatible for MULTIPLICATION'
    case(11); msg='Incompatible for RIGHT DIVISION'
    case(12); msg='Incompatible for LEFT DIVISION'
    case(13); msg='Improper assignment to PERMANENT VARIABLE'
    case(14); msg='EYE-dentity undefined by CONTEXT'
    case(15); msg='Improper assignment to submatrix'
    case(16); msg='Improper command'
    case(17)
      lb = GM_BIGMEM - G_VAR_DATALOC(G_TOP_OF_SAVED) + 1
      lt = g_err + G_VAR_DATALOC(G_TOP_OF_SAVED)
      call journal(' Too much memory required')
      write(msg,'(1X,I7,'' Variables,'',I7,'' Temporaries,'',I7,'' Available.'')') lb,lt,GM_BIGMEM
    case(18); msg='Too many names'
    case(19); msg='Matrix is singular to working precision'
    case(20); msg='Matrix must be square'
    case(21); msg='Subscript out of range'
    case(22); write(msg, '(1x,"Recursion difficulties",*(i4))') (G_RSTK(i),i=1,G_PT)
    case(23); msg='Only 1, 2 or INF norm of matrix'
    case(24); msg='No convergence'
    case(25); msg='Can not use function name as variable'
    case(26); msg='Too complicated (STACK OVERFLOW)'
    case(27); msg='Division by zero is a NO-NO'
    case(28); msg='Empty macro'
    case(29); msg='Not positive definite'
    case(30); msg='Improper exponent'
    case(31); msg='Improper string'
    case(32); msg='Singularity of LOG or ATAN'
    case(33); msg='Too many colons'
    case(34); msg='Improper FOR clause'
    case(35); msg='Improper WHILE or IF clause'
    case(36); msg='Argument out of range'
    case(37); msg='Improper MACROS'
    case(38); msg='Improper file name'
    case(39); msg='Incorrect number of arguments'
    case(40); msg='Expecting statement terminator'
    case default
       call journal('sc','*mat_err* internal error: unknown error code=',n)
       return
   end select

   k = max(1,G_LINE_POINTER(2) - G_LINE_POINTER(1)) ! number of spaces to shift arrow by
   call journal(' '//repeat(' ',k)//'/\--ERROR:'//msg)

end subroutine mat_err