ASMB,R,L,C
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME: PART OF MATH LIBRARY
*   SOURCE:  24998-18XXX  SEE NAM FOR LAST THREE DIGITS 
*   RELOC: PART OF 24998-12001
*   PGMR: BG & JTS
* 
      HED "DSQRT" DOUBLE PRECISION SQUARE ROOT (DLB)
      NAM DSQRT,6 24998-1X145 REV.2001 750701 
      ENT DSQRT 
      EXT DBLE,SNGL,SQRT,.XDIV,.XADD,.XMPY
      EXT .ENTP,.ZRNT 
      SPC 1 
* 
*     CALCULATE Y = SQRT(X) IN EXTENDED PRECISION 
*     CALLING SEQUENCE: 
*     JSB DSQRT 
*         DEF *+3 
*         DEF Y 
*         DEF X 
*     NORMAL RETURN 
      SPC 1 
*     NOTE:  THERE ARE MUCH FASTER WAYS TO DO THIS IF HARDWARE
*            DOUBLE PRECISION IS NOT AVAILABLE. (DLB) 
      SPC 1 
TDB   NOP 
      DEC 11
      NOP 
X1    REP 3 
      NOP 
R     REP 3 
      NOP 
Y     NOP 
X     NOP 
      SPC 1 
DSQRT NOP 
      JSB .ZRNT 
      DEF LIBX
      JSB .ENTP 
      DEF Y 
      STA TDB+2 
      JSB SNGL      PACK ARGUMENT TO SINGLE 
      DEF *+2        PRECISION. 
      DEF X,I 
      JSB SQRT      FIND FIRST APPROX. TO SQRT
      JMP LIBX      ERROR RETURN Y<0
      STA R 
      STB R+1 
      STA R+2       SET FOR POSSIBLE ZERO 
      SZA,RSS       EQUAL 0?
      JMP PZERO     YES SET Y=0 
      JSB DBLE      EXTEND APPROXIMATION
      DEF *+3 
      DEF R         APPROX = R
      DEF R 
      JSB .XDIV      X1 = X/R 
      DEF X1
      DEF X,I 
      DEF R 
      NOP           GIVE THE INTERRUPTS A CHANCE
      JSB .XADD 
      DEF R         R = X1 + R
      DEF X1
      DEF R 
      NOP           GIVE THE INTERRUPTS A CHANCE
PZERO JSB .XMPY     DIVIDE BY 2 
      DEF Y,I       RETURN PRAM TO CALLER 
      DEF R         TEMP STORAGE
      DEF D.5       MULT BY .5
      ISZ TDB+2     RETURN P+4
LIBX  JMP TDB+2,I 
      DEF TDB 
      DEC 0 
      SPC 1 
D.5   DEX 0.5 
      END 
* 
                