!software is put into test mode with errror messages form fortran test
!subroutines SERROR (entry serror_) and TERROR (entry terror_) by
!setting constant integers STEST and DTEST to 1 respectively. 
!Zero values should be set for the release version.
!Only on value should be set to 1 at a time.

%constantinteger STEST= 0, DTEST= 0

%if STEST=1 %start
%externalroutinespec serror %alias "serror_"(%integername type)
%finish
%if DTEST=1 %start
%externalroutinespec terror %alias "terror_"(%integername type)
%finish
!*
%externalroutine MATHS ERROR ROUTINE %alias "f_mle" (%integer errornum)
    !
    !
%externalroutinespec fstop %alias "f_stop" (%integer i,j)
%externalroutinespec Ndiag %alias "s#ndiag"(%integer i,j,k,l)
%integer R10

%conststring(67) %array maths errors(1:47)=                %c
{dlogsmall    = 1}  "DLOG arg negative or zero",
{dsqrtneg     = 2}  "DSQRT arg negative",
{dexplarge    = 3}  "DEXP arg greater than 709.78",
{dexpsmall    = 4}  "DEXP arg less than -708.39, not used",
{dsinlarge    = 5}  "DSIN arg magnitude greater than 2.829D16",
{dasinlarge   = 6}  "DASIN arg magnitude greater than 1.0",
{dcoslarge    = 7}  "DCOS arg magnitude greater than 2.829D16   ",
{dacoslarge   = 8}  "DACOS arg magnitude greater than 1.0",
{dtanlarge    = 9}  "DTAN/DCOTAN arg magnitude greater than 3.521D15",
{dcotansmall  = 10} "DCOTAN arg small in magnitude",
{darcsinlarge = 11} "Not used",
{darccoslarge = 12} "Not used",
{darctan2zero = 13} "DATAN2 args zero",
{dsinhlarge   = 14} "DSINH arg magnitude greater than 710.47",
{dcoshlarge   = 15} "DCOSH arg magnitude greater than 710.47",
{dpowerneg    = 16} "Negative D.P. value raised to a non-integer power",
{dpowerzero   = 17} "D.P. zero raised to non-positive power   ",
{ sqrtneg     = 18} "SQRT arg negative",
{ explarge    = 19} "EXP arg greater than 88.722",
{ expsmall    = 20} "EXP arg less than -87.336, not used",
{ alogsmall   = 21} "ALOG arg negative or zero",
{ powerzero   = 22} "REAL zero raised to non-positive power   ",
{ powerneg    = 23} "Negative REAL value raised to a non-integer power",
{ powerbig    = 24} "REAL value raised to too large a REAL power ",
{ powersmall  = 25} "REAL value to REAL power underflows. not used",
{ sinlarge    = 26} "SIN arg magnitude greater than 5.274E7",
{ coslarge    = 27} "COS arg magnitude greater than 5.274E7",
{ tanlarge    = 28} "TAN/COTAN arg magnitude greater than 2.633E7",
{ asinlarge   = 29} "ASIN arg magnitude greater than 1.0",
{ acoslarge   = 30} "ACOS arg magnitude greater than 1.0",
{ arctan2zero = 31} "ATAN2 args zero",
{ sinhlarge   = 32} "SINH arg magnitude greater than 89.415",
{ coshlarge   = 33} "COSH arg magnitude greater than 89.415",
{dgamlarge    = 34} "DGAMMA arg magnitude greater than 171.0",
{dgamnegint   = 35} "DGAMMA arg near zero or negative integer",
{dlgamneg     = 36} "DLGAMA arg is negative",
{dlgamlarge   = 37} "DLGAMA arg is greater than 1.28D305",
{ipowexpneg   = 38} "Integer raised to negative integer power",
{ipowerzero   = 39} "Integer zero raised to non-positive power",
{ipowlarge    = 40} "Integer to integer power overflows",
{ cotansmall  = 41} "COTAN arg small in magnitude",
{ gamlarge    = 42} "GAMMA arg magnitude greater than 34.0",
{ gamnegint   = 43} "GAMMA arg near zero or negative integer",
{ lgamneg     = 44} "ALGAMA arg is negative",
{ lgamlarge   = 45} "ALGAMA arg is greater than 2.05E36",
{ dpowerlarge = 46} "D.P. value raised to too large a D.P. power",
{ cxpowzero   = 47} "COMPLEX zero raised to non-positive INTEGER power"


%if STEST=1 %start
  %if (errornum<=17) %or (34<=errornum<=37) %or (errornum=46) %c
      %then -> lab1 %else serror(errornum) %and ->exit
%finish

lab1:
%if DTEST=1 %start
  %if (errornum<=17) %or (34<=errornum<=37) %or (errornum=46) %c
      %then terror(errornum) %and -> exit
%finish


!Print the Error Message:
   !
   !
 print string ("
Maths Library Error"); write(errornum,3); print string (": ");

%if errornum>=  1 %and                                                %c
    errornum<= 47 %then print string (maths errors (errornum))    %c
                      %else print string ("no text")

newline

%if STEST=1 %or DTEST=1 %then -> exit
!
!Now Stop With Diagnostics:
!
      fstop (-255, {skip} 2 {stack frames})
!      *ST_10,R10
      Ndiag(0,integer(R10+40),0,0)
      %stop

exit:
%end; !of MATHS ERROR ROUTINE
!*
%externalroutine fmledum %alias"f_mledum"(%integer errornum)
!
!  dummy routine called from Maths functions which are generated in line
!  so that the number of stack frames are correct for the diagnostics
!
   MATHS ERROR ROUTINE(errornum)
%end
!*
%endoffile