%SYSTEMLONGREALFN READ1900
!***********************************************************************
!*       THIS ROUTINE IS THE 1900 IMPLICITLY SPECIFIED ROUTINE         *
!*                                                                     *
!*       THE METHOD USED IS SIMPLE REPEATED MULTIPLICATION USING LONG  *
!*       REAL VARIABLES. SOME ROUNDING ERRORS ARE INTRODUCED WHICH     *
!*       COULD BE AVOIDED BY USING PACKED DECIMAL INSTNS WITH NECESSARY*
!*       SCALING.                                                      *
!***********************************************************************
%INTEGERFNSPEC NEXT
%INTEGERFNSPEC CHECK EXP
%LONGREALFNSPEC GET(%INTEGER LEVEL)
%INTEGER CURSYM
      %RESULT=GET(1)
%LONGREALFN GET(%INTEGER LEVEL)
%INTEGER TYPE, IVALUE, FLAG
                                       ! FLAG= 0FOR'-',1 FOR '+'
%LONGREAL RWORK, SCALE
      FLAG=1;  TYPE=0
START:CURSYM=NEXT;                      ! CARE NOT TO READ TERMINATOR
                                        ! NOW IGNORE LEADING SPACES
      %UNLESS LEVEL>1 %START
         %CYCLE 
            %EXITIF '0'<=CURSYM<='9' %OR CURSYM='+' %OR CURSYM='-' %C
              %OR CURSYM='.' %OR CURSYM='@' %OR CURSYM='&' %C
            %OR CURSYM=''''
            CURSYM=NEXT
         %REPEAT 
      %FINISH %ELSE %START
         CURSYM = NEXT %WHILE CURSYM = NL %OR CURSYM = ' '
      %FINISH
                                       ! RECORD INITIAL MINUS
      %IF CURSYM='-' %THEN FLAG=0 %AND CURSYM='+'
                                       ! MOVE OVER SIGN ONCE IT HAS
                                       ! BEEN RECORDED IN FLAG
      %IF CURSYM='+' %THEN CURSYM=NEXT
      CURSYM=NEXT %WHILE CURSYM=' '
      %IF '0'<=CURSYM %AND CURSYM<='9' %THENSTART 
         RWORK=CURSYM-'0';             ! KEEP TOTAL IN RWORK
         TYPE=1;                       ! VALID DIGIT
         %CYCLE 
            CURSYM=NEXT
            %EXITUNLESS '0'<=CURSYM %AND CURSYM<='9'
            RWORK=10*RWORK+(CURSYM-'0')
                                       ! CONTINUE EVALUATING
         %REPEAT 
      %FINISHELSE RWORK=0
      %IF LEVEL>1 %THEN ->RETEXP
      %IF CURSYM='.' %THENSTART 
         SCALE=10
         %CYCLE 
            CURSYM=NEXT
            %EXITUNLESS '0'<=CURSYM %AND CURSYM<='9'
            TYPE=1
            RWORK=RWORK+(CURSYM-'0')/SCALE
            SCALE=10*SCALE
         %REPEAT 
      %FINISH 
                                       !
                                       ! THE VALUE HAS NOW BEEN READ
                                       ! INTO RWORK. THERE MIGHT BE
                                       ! AN EXPONENT
                                       ! E.G. '1.7@ 10'  IS VALID
                                       ! DATA FOR READ
                                       !
      %IF CHECKEXP#0 %THENSTART 
         %IF TYPE=0 %AND RWORK=0 %THEN RWORK=1
         IVALUE=INT(GET(2));                   ! CALL TO FIND EXPONENT
         %IF IVALUE = -99 %THEN RWORK = 0 %ELSE %C
         RWORK=RWORK*10.0**IVALUE
         TYPE=1
      %FINISH 
      %IF TYPE=0 %THEN ->START
RETEXP:
      %IF FLAG=0 %THEN RWORK=-RWORK
      %RESULT =RWORK
%END
%INTEGERFN NEXT
   %INTEGER S
         READ SYMBOL(S)
         %IF S=' ' %THEN READ SYMBOL(S)
         %RESULT =S
      %END 
%INTEGERFN CHECKEXP
   %INTEGER S
         %RESULT =1 %IF CURSYM='@' %OR CURSYM='&' %OR CURSYM='E'
         %RESULT =0 %UNLESS CURSYM='''' %AND NEXTSYMBOL='1'
         SKIP SYMBOL;  READ SYMBOL(S)
         %RESULT =0 %UNLESS S='0' %AND NEXT SYMBOL=''''
         SKIP SYMBOL
         %RESULT =1
      %END 
%END 
%ENDOFFILE