SPL,L,O, "<F2A>"
! 
   NAME F2A(7) "92425-16024 REV.1841 780927"
! 
! 
!-------------------------------------------------------------
! 
! 
!     W. FINCH          17MAY76    REV. A 
!     MODIFIED BY F.WARREN TO BE FORTRAN CALLABLE 
! 
!     "C" COPYRIGHT HEWLETT-PACKARD COMPANY 1976. 
!     ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM 
!     MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED
!     TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR 
!     WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY. 
! 
!-------------------------------------------------------------
! 
! 
! 
!  EXTERNAL PROCEDURES: 
! 
      LET %FIX  BE FUNCTION,EXTERNAL   ! REAL TO INTEGER CONVERSION 
      LET %LOAT BE FUNCTION,EXTERNAL,REAL ! REAL TO INTEGER CONV. 
      LET .IENT BE PSEUDO,REAL   ,DIRECT,EXTERNAL ! M.S.DIGIT GET 
      LET PAK   BE PSEUDO,INTEGER,DIRECT,EXTERNAL ! CHAR OUTPUTET 
! 
!  EXTERNAL DATA: 
! 
      LET BUFP  BE INTEGER,EXTERNAL    !POINTER FOR PAK 
! 
!  LOCAL PROCEDURES:
! 
      LET PUT   BE SUBROUTINE,DIRECT   ! CHAR PUT,INCREMENT 
! 
!  LOCAL VARIABLES: 
! 
      LET R1    BE REAL                ! LOCAL "VALUE"
      LET W1    BE INTEGER             ! PTR TO WD1 OF R1 
                INITIALIZE W1 TO @R1
      LET W2    BE INTEGER             ! PTR TO WD2 OF R1 
      LET EXPNT BE INTEGER             ! EXPONENT AFTER NORM
      LET I1    BE INTEGER             ! INTEGER EQUIV. OF R1 
      LET DIGIT BE INTEGER             ! DIGIT (BINARY) 
      LET I     BE INTEGER             ! LOOP INDEX 
      LET MYBUF BE INTEGER(12)         ! FOR FIRST PAK
      LET RNUMS BE INTEGER(12)         ! TERMINATING VALUES 
                INITIALIZE RNUMS TO    \
          0.0001, 0.001, 0.01, 0.1, 1.0, 10.0 
! 
   F2A:  SUBROUTINE(VALUE,ARRAY)GLOBAL
! 
      LET VALUE BE REAL                ! REAL NUM TO BE CONVERTED 
      LET ARRAY BE INTEGER             ! OUTPUT BUFFER
! 
      FOR I_1 TO 12 DO                 \
         MYBUF(I)_"0" 
      BUFP_@MYBUF                      ! SET PAK POINTER
      W2_W1+1                          ! SET WD2 POINTER
      EXPNT,ARRAY_0                    ! INIT EXPONENT,CHAR COUNT_0 
      IF [R1_VALUE]<0 THEN[            \ IF - 
         R1_ -R1;                      \    COMPLEMENT IT 
         PUT("-")]                     !    OUTPUT SIGN 
      IF($W1 OR($W2 AND 177400K))=0 THEN\CHECK FOR 0 MANTISSA 
         GOTO PART2 
      IF %LOAT([I1_%FIX(R1)])=R1 THEN[ \ IF INTEGER 
         I_ARRAY;                      \
         DVSR_10000;                   \
         WHILE DVSR DO[                \
            DIGIT_I1/DVSR;             \
            I1_.B.;                    \
            IF DIGIT=0 THEN[           \
               IF I=ARRAY THEN         \
                  GOTO K1              \
               ];                      \
            PUT(DIGIT);                \
            K1: DVSR_DVSR/10];         \
         GOTO PAK2] 
      IF (($W2 AND 377K)->1) >0 THEN[  \ EXPONENT > 0?
         UNTIL R1 < 10.0 DO[           \    YES 
            R1_R1/10.0;                \
            EXPNT_EXPNT+1]             \
         ],                            \
      ELSE[                            \
         UNTIL [R1_R1*10.0]>=1.0 DO[   \    EXPONENT =< 0 
            EXPNT_EXPNT-1];            \
         EXPNT_EXPNT-1] 
PART2:
      FOR I_0 TO 10 BY 2 DO THRU END2 
         .IENT()_R1                    ! DIGIT_WHOLE PART(R1) 
         DIGIT_"?"                     !(DIGIT_"?" ON FAIL)SEE ASMB CODE
         IF DIGIT>9 THEN[              \ CHECK FOR CARRY
            IF DIGIT#"?" THEN[         \
               J_[IF MYBUF(ARRAY)="." THEN ARRAY-1, \ 
                                      ELSE ARRAY]; \
               IF MYBUF(J)="9" THEN[   \ CARRY TO A NINE? 
                  MYBUF(J)_"1";        \ YES (FIRST DIGIT ONLY) 
                  IF J#ARRAY THEN[     \    OVER A "."? 
                     MYBUF(ARRAY)_"0"; \       YES,MOVE THE "." 
                     PUT(".")],        \
                  ELSE[                \
                     PUT("0")]         \       NO 
                  ],                   \
               ELSE[                   \
                  MYBUF(J)_MYBUF(J)+1];\ CARRY TO 0 THRU 8
               PUT(DIGIT-10);          \
               GOTO K2]                \
            ] 
         PUT(DIGIT) 
         K2:
         IF I=0 THEN                   \ FIRST TIME?
            PUT(".")
         R1_(10.0*(R1-%LOAT(DIGIT)))+0.00005
         IF R1 < $[REAL](@RNUMS+I) THEN[\ DONE IF NO MORE SIGNIF. 
            GOTO PART3                 \
         ]
      END2: 
PART3:
      .A._(EXPNT+60)/3                 ! COMPUTE EXPONENT MOD 3 
      XMOD3_.B. 
      IF XMOD3 = 0 THEN                \ LEAVE AS IS IF XMOD3=0 
         GOTO CHOP
      FOR POINT_1 BY 1 DO[             \ FIND THE "." 
         IF MYBUF(POINT) = "." THEN[   \
            GOTO K3]                   \
         ]
      K3: 
      IF EXPNT= -1 THEN[               \ -1 SPECIAL CASE
         MYBUF(POINT)_MYBUF(POINT-1);  \
         MYBUF(POINT-1)_".";           \
         EXPNT_0;                      \
         GOTO CHOP] 
      REPEAT XMOD3 TIMES DO[           \ MOVE "." ONCE OR TWICE 
         MYBUF(POINT)_MYBUF(POINT+1);  \
         MYBUF([POINT_POINT+1])_".";   \
         EXPNT_EXPNT-1] 
CHOP: 
      FOR ARRAY_12 BY -1 DO[           \ TRIM TRAILING "0"'S
         IF [I_MYBUF(ARRAY)]#"0" THEN[ \
            IF I = "." THEN[           \
               ARRAY_ARRAY-1];         \
            GOTO PAK2]                 \
         ]
PAK2: 
      BUFP_@ARRAY+1                    ! POINT PAK AT USER BUFFER 
      FOR I_1 TO ARRAY DO              \ MOVE AND PACK
         PAK()_MYBUF(I) 
      IF EXPNT=0 THEN                  \
         RETURN 
      PAK()_"E" 
      ARRAY_ARRAY+2                    ! ATLEAST 2 DIGITS IN EXPONENT 
      IF EXPNT<0 THEN[                 \
         EXPNT_ -EXPNT;                \
         PAK()_"-";                    \
         ARRAY_ARRAY+1] 
      IF EXPNT>9 THEN[                 \
         DIGIT_EXPNT/10;               \
         EXPNT_.B.;                    \
         PAK()_DIGIT OR "0";           \
         ARRAY_ARRAY+1] 
      PAK()_EXPNT OR "0"
      RETURN
   END F2A
! 
   PUT:  SUBROUTINE(PUTEE)DIRECT
! 
      PAK()_0                          ! ZERO FILL LEFT PART
      PAK()_[IF PUTEE<10 THEN PUTEE OR "0", \ 
                         ELSE PUTEE]
      ARRAY_ARRAY+1 
      RETURN
   END PUT
! 
   END S1685
! 
END$
  