         MACRO                                                          
&ADDR    INCFX &R1,&R2,&R3,&R4,&SHIFT,&BRANCH                           
.*       ADJUST BASE ADDRESS OF ARRAYS IF INCREMENTS ARE NEGATIVE       
&ADDR    L     &R2,0(&R2)                                               
         SLA   &R2,&SHIFT                                               
         BP    &BRANCH                                                  
         LR    &R4,&R2                                                  
         MR    &R4-1,&R3                                                
         SR    &R1,&R4                                                  
         MEND                                                           
./  ADD  NAME=INCBR                                                     
         MACRO                                                          
&ADDR    INCBR &R1,&R2,&R3,&R4,&R5,&LABEL                               
.*       STANDARD INCREMENTING AND TESTING FOR LOOP END                 
&ADDR    AR    &R1,&R2                                                  
         AR    &R3,&R4                                                  
         BCT   &R5,&LABEL                                               
         MEND                                                           
./  ADD  NAME=NCHK                                                      
         MACRO                                                          
&ADDR    NCHK  &R1,&R2,&LABEL                                           
.*       TEST FOR N .GT. 0.  QUIT WHEN N .LE. 0                         
&ADDR    L     &R1,0(&R2)                                               
         LTR   &R2,&R1                                                  
         BNP   &LABEL                                                   
         BCTR  &R1,0                                                    
         MEND                                                           
./  ADD  NAME=EQUATE                                                    
         MACRO                                                          
         EQUATE                                                         
.*       DEFINE SYMBOLIC NAMES OF REGS., ETC.                           
R0       EQU   0                                                        
R1       EQU   1                                                        
R2       EQU   2                                                        
R3       EQU   3                                                        
R4       EQU   4                                                        
R5       EQU   5                                                        
R6       EQU   6                                                        
R7       EQU   7                                                        
R8       EQU   8                                                        
R9       EQU   9                                                        
R10      EQU   10                                                       
R11      EQU   11                                                       
R12      EQU   12                                                       
R13      EQU   13                                                       
R14      EQU   14                                                       
R15      EQU   15                                                       
F0       EQU   0                                                        
F2       EQU   2                                                        
F4       EQU   4                                                        
F6       EQU   6                                                        
RSTAR4   EQU   2                                                        
RSTAR8   EQU   3                                                        
CSTAR8   EQU   3                                                        
CSTAR16  EQU   4                                                        
         MEND                                                           
./    ADD  NAME=PROLOG                                                  
         MACRO                                                          
&NAME    PROLOG &MAXREG,&EPID=YES,&TRACE=YES                            
.*       VARIOUS INDIVIDUALS HAVE CONTRIBUTED TO THE 360 ASM.           
.*       EFFORT.  THESE INCLUDE                                         
.*       R.J.HANSON, TIM HARRINGTON, JOHN WISNIEWSKI, AND KAREN HASKELL 
.*       SPECIAL THANKS TO PROF. DAVE BENSON FOR HELP WITH IBM/360 ASM. 
.*       PROPERTIES.                                                    
         GBLB  &CALLQ                                                   
         GBLC  &REGNUM                                                  
         LCLA  &K                                                       
.*                                                                      
.*       THIS NEXT CARD STOPS MACRO EXPANSION ON THE PRINT.             
         PRINT NOGEN                                                    
&NAME    CSECT                                                          
         EQUATE                                                         
         AIF   ('&TRACE' NE 'YES').L1                                   
HSA      EQU   4 .             HIGHER SAVEAREA                          
LSA      EQU   8 .             LOWER SAVEAREA                           
.L1      ANOP                                                           
&CALLQ   SETB  ('&TRACE' EQ 'YES')                                      
&REGNUM  SETC  '&MAXREG'                                                
         AIF   ('&EPID' NE 'YES' AND '&TRACE' NE 'YES').L30             
         USING &NAME,15 .      TEMPORARY BASE REGISTER                  
         B     PRO&SYSNDX                                               
         AIF   ('&EPID' NE 'YES').L10                                   
&K       SETA  K'&NAME                                                  
         DC    AL1(&K) .       LENGTH OF EPID                           
         DC    CL&K'&NAME' .   ENTRY POINT INDICATOR                    
.L10     AIF   ('&TRACE' NE 'YES').L15                                  
SAVE&SYSNDX DS 18F .           SAVEAREA                                 
.L15     ANOP                                                           
PRO&SYSNDX  DS  0H                                                      
         DROP 15                                                        
.L20     AIF   ('&TRACE' NE 'YES').L30                                  
         STM   14,&MAXREG+1,12(13)                                      
         USING &NAME,15                                                 
         LA    14,SAVE&SYSNDX . MY SAVEAREA                             
         ST    14,LSA(13) .    SAVEAREA                                 
         ST    13,HSA(14) .    POINTERS                                 
         LR    13,14                                                    
         LR    &MAXREG+1,15                                             
         DROP  15                                                       
         USING &NAME,&MAXREG+1 . PROGRAM BASE REGISTER                  
         MEXIT                                                          
.L30     STM   14,&MAXREG,12(13)                                        
         USING &NAME,15 .      PROGRAM BASE REGISTER                    
         MEND                                                           
./  ADD  NAME=EPILOG                                                    
         MACRO                                                          
&LBL     EPILOG &RESULT                                                 
         GBLB  &CALLQ                                                   
         GBLC  &REGNUM                                                  
         AIF   (&CALLQ).L10                                             
         AIF   (T'&RESULT EQ 'O').L5                                    
&LBL     LM    14,15,12(13) .  RESULT IN R0.                            
         LM    1,&REGNUM,24(13)                                         
         AGO   .L50                                                     
.L5      ANOP                                                           
&LBL     LM    14,&REGNUM,12(13) .      RESULTS IN F0.                  
         AGO   .L50                                                     
.L10     AIF   (T'&RESULT EQ 'O').L15                                   
&LBL     L     13,HSA(13) .    RESTORE CALLER'S SAVEAREA.               
         LM    14,15,12(13) .  RESULT IN R0.                            
         LM    1,&REGNUM+1,24(13)                                       
         AGO   .L50                                                     
.L15     ANOP                                                           
&LBL     L     13,HSA(13) .    RESTORE CALLERS'S SAVEAREA.              
         LM    14,&REGNUM+1,12(13) .                                    
         AGO   .L50                                                     
.L50     BR    14 .            RETURN TO CALLING PROGRAM.               
         MEND                                                           
./  ADD NAME=FIXH                                                       
         MACRO                                                          
&LABEL   FIXH                                                           
&LABEL   LE    F6,SFLAG .              GET SFLAG                        
         LTER  F6,F6 .                 TEST SFLAG                       
         BM    FXHC&SYSNDX .           IF SFLAG<0 RETURN                
         BZ    FXHB&SYSNDX .           IF SFLAG=0 BRANCH TO B1          
         LE    F6,=E'1.0' .            SFLAG>0 CASE; PUT 1.0 INTO F6    
         STE   F6,H12 .                SET H12=1.0                      
         LCER  F6,F6 .                 SET F6=-1.0                      
         STE   F6,H21 .                SET H21=-1.0                     
         B     FXHA&SYSNDX                                              
FXHB&SYSNDX LE   F6,=E'1.0' .          PUT 1.0 INTO F6(B1 BRANCH)       
         STE   F6,H11 .                SET H11=1.0                      
         STE   F6,H22 .                SET H22=1.0                      
FXHA&SYSNDX  LNER  F6,F6 .             SET F6=-1.                       
         STE   F6,SFLAG .              SET SFLAG=-1.                    
FXHC&SYSNDX  DS    0H                                                   
         MEND                                                           
./  ADD NAME=DFIXH                                                      
         MACRO                                                          
&LABEL   DFIXH                                                          
&LABEL   LD    F6,DFLAG .              GET DFLAG                        
         LTDR  F6,F6 .                 TEST DFLAG                       
         BM    FXHC&SYSNDX .           IF DFLAG<0 RETURN                
         BZ    FXHB&SYSNDX .           IF DFLAG=0 BRANCH TO B1          
         LD    F6,=D'1.0' .            DFLAG>0 CASE; PUT 1.0 INTO F6    
         STD   F6,H12 .                SET H12=1.0                      
         LCDR  F6,F6 .                 SET F6=-1.0                      
         STD   F6,H21 .                                                 
         B     FXHA&SYSNDX                                              
FXHB&SYSNDX LD   F6,=D'1.0' .          PUT 1.0 INTO F6(B1 BRANCH)       
         STD   F6,H11 .                SET H11=1.0                      
         STD   F6,H22 .                SET H22=1.0                      
FXHA&SYSNDX  LNDR  F6,F6 .             SET F6=-1.0                      
        STD    F6,DFLAG .              SET DFLAG=-1.                    
FXHC&SYSNDX  DS    0H                                                   
         MEND                                                           
//ASM.SYSIN DD *                                                        
*********SINGLE PRECISION INNER PRODUCT, SDOT, IBM/360 ASM.************ 
*        USAGE STATEMENT                                14 AUGUST 1975* 
*             SW = SDOT (N,SX,INCX,SY,INCY)           WASH. ST. U./ANL* 
*        SW,SDOT,SX( ),SY( ),REAL*4  N,INCX,INCY,INTEGER*4            * 
*********************************************************************** 
SDOT     PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         SER   F0,F0                   SET SDOT = 0.0                   
         NCHK  R7,R2,DONE              GET N AND EXIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR4              MULTIPLY INCS * 4                
         BM    INCNE                   BRANCH TO GEN. LOOP IF NEG.      
         LR    R8,R11                  STORE INCX*4 IN UNOCCUPIED R8    
         MR    R10,R7                  COMPUTE INCX * 4 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F2,0(R6,R3)             GET SX( ) AND MULTIPLY           
         ME    F2,0(R6,R5)             BY SY( ) AND ACCUMULATE          
         AER   F0,F2                   INNER PRODUCT IN F0              
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R7,R9,RSTAR4,ICY    FIX SX( ) INCREMENT            
ICY      INCFX R5,R6,R7,R9,RSTAR4,LOOPNE FIX SY( ) INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F2,0(R3)                GET SX( ) AND MULTIPLY           
         ME    F2,0(R5)                BY SY( ) AND ACCUMULATE          
         AER   F0,F2                   INNER PRODUCT IN F0              
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE      
DONE     EPILOG                                                         
         END                                                            
*********DOUBLE PRECISION INNER PRODUCT, DSDOT, IBM/360 ASM.*********** 
*        USAGE STATEMENT                                   19 MAY 1974* 
*             DW = DSDOT(N,SX,INCX,SY,INCY)                WASH. ST. U* 
*        DW,DSDOT,REAL*8 SX( ),SY( ) REAL *4, N,INCX,INCY INTEGER * 4 * 
*********************************************************************** 
DSDOT    PROLOG R9                                                      
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         SDR   F0,F0                   SET DSDOT = 0                    
         NCHK  R7,R2,DONE              GET N AND QUIT IF N .LE. 0       
         INCFX R3,R4,R7,R9,RSTAR4,ICY  FIX SX( ) INCREMENT              
ICY      INCFX R5,R6,R7,R9,RSTAR4,LOOP FIX SY( ) INCREMENT              
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F2,0(R3)                GET SX( ) AND                    
         ME    F2,0(R5)                MULTIPLY BY SY( ) AND            
         ADR   F0,F2                   ACCUMULATE INNER PRODUCT         
         INCBR R3,R4,R5,R6,R2,LOOP     ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                                                         
         END                                                            
*********ACCUM. INNER. PROD. AND ADD SCALAR, SDSDOT, IBM/360 ASM.****** 
*        USAGE STATEMENT                                   19 MAY 1974* 
*             SW = SDSDOT(N,SB,SX,INCX,SY,INCY)            WASH. ST. U* 
*        SW,SDSDOT,SB,SX( ),SY( ), REAL * 4, N,INCX,INCY INTEGER * 4  * 
*********************************************************************** 
SDSDOT   PROLOG R11                                                     
         LM    R2,R7,0(R1)             GET POINTERS TO ARGUMENTS        
         SDR   F0,F0                   SET SDSDOT =0.D0                 
         LE    F0,0(R3)                LOAD DBLE(SB)                    
         NCHK  R9,R2,DONE              GET N AND QUIT IF N .LE. 0       
         L     R11,0(R5)               LOAD R11 WITH INCX               
         C     R11,0(R7)               COMPARE INCX WITH INCY           
         BNE   INCNEN                  IF INCX .NE. INCY, GEN. LOOP.    
         SLA   R11,RSTAR4              MULT. INCX*4                     
         BM    INCNEN                  IF BOTH INCX AND INCY NEG.,      
*                                      USE GEN. LOOP.                   
         LR    R8,R11                  SAVE INCX*4 AS INCREMENT.        
*        THE CONTENTS OF REG R11 (CONTAINING INCX*4) ARE MOVED TO       
*        R8 (UNOCCUPIED) BECAUSE THE 'MR' INSTRUCTION WHICH FOLLOWS     
*        PLACES THE RESULT IN R11 AND ZEROES R10.                       
         MR    R10,R9                  COMPUTE INCX*4*(N-1)             
         SR    R7,R7                   SET R7=0                         
         LR    R10,R8                  LOAD R10 WITH INCREMENT USED IN  
*        LOOP.  THE 'BXLE' INSTRUCTION (BELOW) ADDS THE CONTENTS OF REG 
*        R10 TO REG. R7 AND COMPARES WITH THE CONTENTS OF REG R11.      
*        THE BRANCH (TO LOOPE) IS TAKEN WHEN THE CONTENTS OF R7         
*        DO NOT EXCEED THE CONTENTS OF REG R11.                         
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPE    LE    F2,0(R7,R4)             SET SX( )                        
         ME    F2,0(R7,R6)             COMPUTE SX( )*SY( )              
         ADR   F0,F2                   ACCUMULATE INNER PRODUCT         
         BXLE  R7,R10,LOOPE                                             
         B     DONE                                                     
INCNEN   INCFX R4,R5,R9,R11,RSTAR4,ICY  FIX SX( ) INCREMENT             
ICY      INCFX R6,R7,R9,R11,RSTAR4,LOOP FIX SY( ) INCREMENT             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F2,0(R4)                GET SX( ) AND                    
         ME    F2,0(R6)                MULTIPLY BY SY( ) AND            
         ADR   F0,F2                   ACCUMULATE INNER PRODUCT         
         INCBR R4,R5,R6,R7,R2,LOOP     ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                        EXIT WITH SNGL(DBLE(SB)+DOT      
*                                      PRODUCT) IN F0 NOW.              
         END                                                            
*********DOUBLE PRECISION INNER PRODUCT, DDOT, IBM/360 ASM.************ 
*        USAGE STATEMENT                                  21 JULY 1975* 
*             DW = DDOT (N,DX,INCX,DY,INCY)            WASH. ST. U/ANL* 
*        DW,DDOT,DX( ),DY( ),REAL*8 N,INCX,INCY,INTEGER*4             * 
*********************************************************************** 
DDOT     PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         SDR   F0,F0                   SET DDOT = 0.0D0                 
         NCHK  R7,R2,DONE              GET N AND EXIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR8              MULTIPLY INCX * 8                
         BM    INCNE                   BRANCH TO GEN. LOOP IF NEG.      
         LR    R8,R11                  STORE INCX*8 IN UNOCCUPIED R8    
         MR    R10,R7                  COMPUTE INCX * 8 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LD    F2,0(R6,R3)             GET DX( ) AND MULTIPLY           
         MD    F2,0(R6,R5)             BY DY( ) AND ACCUMULATE          
         ADR   F0,F2                   INNER PRODUCTS IN F0             
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R7,R9,RSTAR8,ICY    FIX DX( ) INCREMENT            
ICY      INCFX R5,R6,R7,R9,RSTAR8,LOOPNE FIX DY( ) INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LD    F2,0(R3)                GET DX( ) AND MULTIPLY           
         MD    F2,0(R5)                BY DY( ) AND ACCUMULATE          
         ADR   F0,F2                   INNER PRODUCTS IN F0             
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE      
DONE     EPILOG                                                         
         END                                                            
*********EXTENDED PREC. DOT PRODUCT, DQDOTA, IBM/360 ASM.**********     
*        USAGE STATEMENT                                          *     
*             DW = DQDOTA (N,DB,QC,DX,INCX,DY,INCY)               *     
*        QC(5) REAL*4,DW,DQDOTA,DB,DX(),DY() REAL*8,              *     
*        N,INCX,INCY INTEGER*4                                    *     
*******************************************************************     
DQDOTA   PROLOG R11                                                     
         LM    R2,R8,0(R1)                                              
         SDR   F2,F2                   CLEAR REG. F2                    
         LD    F0,0(R3)                LOAD EXTENDED (DB)               
         LE    F4,0(R4)                GET QC( )                        
         STE   F4,TEMP                                                  
         LE    F4,4(R4)                                                 
         STE   F4,TEMP+4                                                
         LD    F4,TEMP                                                  
         LE    F6,8(R4)                                                 
         STE   F6,TEMP                                                  
         LE    F6,12(R4)                                                
         STE   F6,TEMP+4                                                
         LD    F6,TEMP                 END GET QC( )                    
*        AXR   F0,F4                   COMPUTE DB + QC( )               
*        WARNING: THE ABOVE INSTRUCTION MAY NOT BE PRESENT ON YOUR      
*        MACHINE. OPTIONS: REPLACE IT BY ADR  F0,F4 OR USE A SOFTWARE   
*        REPLACEMENT FOR THE OPERATION.                                 
         ADR   F0,F4                   COMPUTE DB + QC( )               
         NCHK  R9,R2,FIXQC                                              
         INCFX R5,R6,R9,R11,RSTAR8,INCY                                 
INCY     INCFX R7,R8,R9,R11,RSTAR8,LOOP                                 
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LD    F4,0(R5)                GET DX( )                        
*        MXD   F4,0(R7)                COMPUTE EXTEND. (DX()) * DY()    
*        WARNING: THE ABOVE INSTRUCTION MAY NOT BE PRESENT ON YOUR      
*        MACHINE. OPTIONS: REPLACE IT BY MD  F4,0(R7) OR USE A SOFTWARE 
*        REPLACEMENT FOR THE OPERATION.                                 
         MD    F4,0(R7)                COMPUTE EXTEND. (DX()) * DY()    
*                                                                       
*        AXR   F0,F4                   ACCUM. EXTEND. SUM               
*        WARNING: THE ABOVE INSTRUCTION MAY NOT BE PRESENT ON YOUR      
*        MACHINE. OPTIONS: REPLACE IT BY ADR  F0,F4 OR USE A SOFTWARE   
*        REPLACEMENT FOR THE OPERATION.                                 
         ADR   F0,F4                   ACCUM. EXTEND. SUM               
         INCBR R5,R6,R7,R8,R2,LOOP                                      
FIXQC    STD   F0,TEMP                 STORE RESULT IN                  
         LE    F4,TEMP                 EXTEND. QC( )                    
         STE   F4,0(R4)                THE REAL*4 OPS. ARE              
         LE    F4,TEMP+4               NEEDED BECAUSE                   
         STE   F4,4(R4)                QC( ) MAY NOT HAVE               
         STD   F2,TEMP                 REAL*8 ALIGNMENT.                
         LE    F4,TEMP                 NOTE THAT ONLY                   
         STE   F4,8(R4)                QC(I),I=1,4 ARE USED.            
         LE    F4,TEMP+4                                                
         STE   F4,12(R4)                                                
         EPILOG                                                         
         DS    0D                                                       
TEMP     DS    D                                                        
         END                                                            
*********EXTENDED PREC. DOT PRODUCT, DQDOTI, IBM/360 ASM.**********     
*        USAGE STATEMENT                                          *     
*             DW = DQDOTI (N,DB,QC,DX,INCX,DY,INCY)               *     
*        QC(5) REAL*4,DW,DQDOTI,DB,DX(),DY() REAL*8,              *     
*        N,INCX,INCY INTEGER*4                                    *     
*******************************************************************     
DQDOTI   PROLOG R11                                                     
         LM    R2,R8,0(R1)                                              
         SDR   F2,F2                   CLEAR REG. F2                    
         LD    F0,0(R3)                LOAD EXTENDED (DB)               
         NCHK  R9,R2,FIXQC                                              
         INCFX R5,R6,R9,R11,RSTAR8,INCY                                 
INCY     INCFX R7,R8,R9,R11,RSTAR8,LOOP                                 
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LD    F4,0(R5)                GET DX( )                        
*        MXD   F4,0(R7)                COMPUTE EXTEND. (DX()) * DY()    
*        WARNING: THE ABOVE INSTRUCTION MAY NOT BE PRESENT ON YOUR      
*        MACHINE. OPTIONS: REPLACE IT BY MD  F4,0(R7) OR USE A SOFTWARE 
*        REPLACEMENT FOR THE OPERATION.                                 
         MD    F4,0(R7)                COMPUTE EXTEND. (DX()) * DY()    
*                                                                       
*        AXR   F0,F4                   ACCUM. EXTEND. SUM               
*        WARNING: THE ABOVE INSTRUCTION MAY NOT BE PRESENT ON YOUR      
*        MACHINE. OPTIONS: REPLACE IT BY ADR  F0,F4 OR USE A SOFTWARE   
*        REPLACEMENT FOR THE OPERATION.                                 
         ADR   F0,F4                   ACCUM. EXTEND. SUM               
         INCBR R5,R6,R7,R8,R2,LOOP                                      
FIXQC    STD   F0,TEMP                 STORE RESULT IN                  
         LE    F4,TEMP                 EXTEND. QC( )                    
         STE   F4,0(R4)                THE REAL*4 OPS. ARE              
         LE    F4,TEMP+4               NEEDED BECAUSE                   
         STE   F4,4(R4)                QC( ) MAY NOT HAVE               
         STD   F2,TEMP                 REAL*8 ALIGNMENT.                
         LE    F4,TEMP                 NOTE THAT ONLY                   
         STE   F4,8(R4)                QC(I),I=1,4 ARE USED.            
         LE    F4,TEMP+4                                                
         STE   F4,12(R4)                                                
         EPILOG                                                         
         DS    0D                                                       
TEMP     DS    D                                                        
         END                                                            
*********COMPLEX (CONJUGATED) INNER PRODUCT, CDOTC,IBM/360 ASM.******** 
*        USAGE STATEMENT                              3 SEPTEMBER 1975* 
*              CW = CDOTC(N,CX,INCX,CY,INCY)          WASH. ST. U./ANL* 
*        CW,CDOTC,CX( ), CY( ) COMPLEX*8, N,INCX,INCY INTEGER*4       * 
*        (THE ARRAY CX( ) HAS ITS ELEMENTS CONJUGATED).               * 
*********************************************************************** 
CDOTC    PROLOG R11                                                     
         LM    R2,R6,0(R1)         GET POINTERS TO ARGUMENTS            
         SER   F0,F0               SET CDOT=(0.,0.).                    
         SER   F2,F2                                                    
         NCHK  R7,R2,DONE          GET N AND QUIT IF N .LE. 0.          
         L     R11,0(R4)           GET INCX                             
         C     R11,0(R6)           COMPARE INCY WITH INCX               
         BNE   INCNE               BRANCH TO GEN. LOOP IF NOT EQUAL     
         SLA   R11,CSTAR8          MULTIPLY INCX * 8                    
         BM    INCNE               GEN. LOOP IF INCX,INCY NEG.          
         LR    R8,R11              SAVE INCX*8 IN UNOCCUPIED R8         
         MR    R10,R7              MULTIPLY INCX * 8 * (N-1)            
         SR    R6,R6               SET R6 = 0                           
         LR    R10,R8              LOAD LOOPEQ INCREMENT INTO R10       
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F4,0(R6,R3)         GET CX( ) = (S,T)                    
         LE    F6,4(R6,R3)                                              
         ME    F4,0(R6,R5)         USE CY( ) = (U,V) TO FORM            
         ME    F6,4(R6,R5)         S*U AND T*V                          
         AER   F0,F4               ACCUMULATE REAL PART OF              
         AER   F0,F6               PRODUCT CONJG(CX( ))*CY( )=S*U+T*V   
         LE    F4,0(R6,R3)         GET CX( ) = (S,T)                    
         LE    F6,4(R6,R3)                                              
         ME    F4,4(R6,R5)         USE CY( ) = (U,V) TO FORM            
         ME    F6,0(R6,R5)         S*V AND T*U                          
         AER   F2,F4               ACCUMULATE IMAG. PART OF             
         SER   F2,F6               PRODUCT CONJG(CX( ))*CY( )=S*V-T*U   
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R7,R9,CSTAR8,ICY    FIX CX( ) INCREMENT            
ICY      INCFX R5,R6,R7,R9,CSTAR8,LOOPNE FIX CY( ) INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F4,0(R3)            GET CX( ) =(S,T)                     
         LE    F6,4(R3)                                                 
         ME    F4,0(R5)            USE CY( ) = (U,V) TO FORM            
         ME    F6,4(R5)            S*U AND T*V.                         
         AER   F0,F4               ACCUMULATE REAL PART OF              
         AER   F0,F6               PRODUCT CONJG(CX( ))*CY( ) =S*U+T*V  
         LE    F4,0(R3)            GET CX( ) = (S,T).                   
         LE    F6,4(R3)                                                 
         ME    F4,4(R5)            USE CY( ) = (U,V) TO FORM            
         ME    F6,0(R5)            S*V AND T*U                          
         AER   F2,F4               ACCUMULATE IMAG. PART OF             
         SER   F2,F6               PRODUCT CONJG(CX( ))*CY( )=S*V-T*U   
         INCBR R3,R4,R5,R6,R2,LOOPNE ADD INCREMENTS AND CONTINUE LOOP   
DONE     EPILOG                                                         
         END                                                            
*********COMPLEX INNER PRODUCT, CDOTU, IBM/360 ASM.******************** 
*        USAGE STATEMENT                              3 SEPTEMBER 1975* 
*              CW = CDOTU (N,CX,INCX,CY,INCY)         WASH. ST. U./ANL* 
*        CW,CDOTU,CX( ), CY( ) COMPLEX*8, N,INCX,INCY INTEGER*4       * 
*********************************************************************** 
CDOTU    PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS.       
         SER   F0,F0                   SET CDOTU = (0.,0.).             
         SER   F2,F2                                                    
         NCHK  R7,R2,DONE              GET N AND QUIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,CSTAR8              MULTIPLY INCX*8                  
         BM    INCNE                   INCX,INCY NEG., GEN. LOOP        
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R7                  COMPUTE INCX * 8 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD LOOPEQ INCREMENT INTO R10   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F4,0(R6,R3)             GET CX( ) = (S,T)                
         LE    F6,4(R6,R3)                                              
         ME    F4,0(R6,R5)             USE CY( ) = (U,V) TO FORM        
         ME    F6,4(R6,R5)             S*U AND T*V                      
         AER   F0,F4                   ACCUMULATE REAL PART OF          
         SER   F0,F6                   PRODUCT CX( )*CY( ) = S*U-T*V    
         LE    F4,0(R6,R3)             GET CX( ) = (S,T)                
         LE    F6,4(R6,R3)                                              
         ME    F4,4(R6,R5)             USE CY( ) = (U,V) TO FORM        
         ME    F6,0(R6,R5)             S*V AND T*U                      
         AER   F2,F4                   ACCUMULATE IMAG. PART OF         
         AER   F2,F6                   PRODUCT CX( )*CY( ) = S*V+T*U    
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R7,R9,CSTAR8,ICY    FIX CX( ) INCREMENT            
ICY      INCFX R5,R6,R7,R9,CSTAR8,LOOPNE FIX CY( ) INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F4,0(R3)                GET CX( ) = (S,T)                
         LE    F6,4(R3)                                                 
         ME    F4,0(R5)                USE CY( ) = (U,V) TO FORM        
         ME    F6,4(R5)                S*U AND T*V                      
         AER   F0,F4                   ACCUMULATE REAL PART OF          
         SER   F0,F6                   PRODUCT CX( )*CY( ) = S*U-T*V    
         LE    F4,0(R3)                GET CX( ) = (S,T)                
         LE    F6,4(R3)                                                 
         ME    F4,4(R5)                USE CY( ) = (U,V) TO FORM        
         ME    F6,0(R5)                S*V AND T*U                      
         AER   F2,F4                   ACCUMULATE IMAG. PART OF         
         AER   F2,F6                   PRODUCT CX( )*CY( ) = S*V+T*U    
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                                                         
         END                                                            
********SINGLE PREC. AFFINE TRANSFORMATION, SAXPY, IBM/360 ASM.******** 
*       USAGE STATEMENT                                 14 AUGUST 1975* 
*            CALL SAXPY (N,SA,SX,INCX,SY,INCY)         WASH. ST. U/ANL* 
*       SA,SX( ),SY( ),REAL*4  N,INCX,INCY,INTEGER*4                  * 
*********************************************************************** 
SAXPY    PROLOG R11                                                     
         LM    R2,R7,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND EXIT IF N .LE. 0       
         LE    F2,0(R3)                GET SCALAR SA FOR MULTIPLYING    
         L     R11,0(R5)               GET INCX                         
         C     R11,0(R7)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR4              MULTIPLY INCX * 4                
         BM    INCNE                   IF INCX, INCY NEG., GEN. LOOP    
         LR    R8,R11                  SAVE INCX * 4 IN UNOCCUPIED R8   
         MR    R10,R9                  COMPUTE INCX * 4 * (N-1)         
         SR    R7,R7                   SET R7 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F0,0(R7,R4)             GET SX( )                        
         MER   F0,F2                   COMPUTE SA * SX( )               
         AE    F0,0(R7,R6)             COMPUTE SA * SX( ) + SY( )       
         STE   F0,0(R7,R6)             AND STORE AT SY( )               
         BXLE  R7,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R4,R5,R9,R11,RSTAR4,ICY    FIX SX( ) INCREMENT           
ICY      INCFX R6,R7,R9,R11,RSTAR4,LOOPNE FIX SY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F0,0(R4)                GET SX(  )                       
         MER   F0,F2                   COMPUTE SA * SX( )               
         AE    F0,0(R6)                COMPUTE SA * SX( ) + SY( )       
         STE   F0,0(R6)                AND STORE AT SY( )               
         INCBR R4,R5,R6,R7,R2,LOOPNE   ADD INCREMENTS AND CONTINUE      
DONE     EPILOG                                                         
         END                                                            
*********DBL. PREC. AFFINE TRANSFORMATION, DAXPY, IBM/360 ASM.********* 
*        USAGE STATEMENT                                14 AUGUST 1975* 
*             CALL DAXPY (N,DA,DX,INCX,DY,INCY)        WASH. ST. U/ANL* 
*        DA,DX( ),DY( ) REAL*8, N,INCX,INCY INTEGER*4                 * 
*********************************************************************** 
DAXPY    PROLOG R11                                                     
         LM    R2,R7,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND QUIT IF N .LE. 0       
         LD    F2,0(R3)                GET SCALAR DA FOR MULTIPLYING    
         L     R11,0(R5)               GET INCX                         
         C     R11,0(R7)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR8              MULTIPLY INCX * 8                
         BM    INCNE                   IF INCX,INCY NEG., GEN. LOOP     
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 8 * (N-1)         
         SR    R7,R7                   SET R7 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LD    F0,0(R7,R4)             GET DX( )                        
         MDR   F0,F2                   COMPUTE DA * DX( )               
         AD    F0,0(R7,R6)             COMPUTE DA * DX( ) + DY( )       
         STD   F0,0(R7,R6)             AND STORE AT DY( )               
         BXLE  R7,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R4,R5,R9,R11,RSTAR8,ICY    FIX DX( ) INCREMENT           
ICY      INCFX R6,R7,R9,R11,RSTAR8,LOOPNE FIX DY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LD    F0,0(R4)                GET DX( )                        
         MDR   F0,F2                   COMPUTE DA * DX( )               
         AD    F0,0(R6)                COMPUTE DA * DX( ) + DY( )       
         STD   F0,0(R6)                AND STORE AT DY( )               
         INCBR R4,R5,R6,R7,R2,LOOPNE   ADD INCREMENTS AND CONTINUE      
DONE     EPILOG                                                         
         END                                                            
*********COMPLEX AFFINE TRANSFORMATION, CAXPY, IBM/360 ASM.************ 
*        USAGE STATEMENT                              3 SEPTEMBER 1975* 
*             CALL CAXPY (N,CA,CX,INCX,CY,INCY)        WASH. ST. U/ANL* 
*        CA,CX( ),CY( ) COMPLEX*8, N,INCX,INCY INTEGER*4              * 
*********************************************************************** 
CAXPY    PROLOG R11                                                     
         LM    R2,R7,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND QUIT IF N .LE. 0       
         LE    F4,0(R3)                GET REAL PART OF CA              
         STE   F4,AR                   STORE IT LOCALLY                 
         LE    F6,4(R3)                GET IMAG. PART OF CA             
         L     R11,0(R5)               GET INCX                         
         C     R11,0(R7)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,CSTAR8              MULTIPLY INCX * 8                
         BM    INCNE                   GEN. LOOP IF INCX,INCY NEG.      
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R9                  MULTIPLY INCX * 8 * (N-1)        
         SR    R7,R7                   SET R7 = 0                       
         LR    R10,R8                  LOAD LOOPEQ INCREMENT INTO R10   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F0,AR                   GET REAL PART OF CA              
         LER   F2,F6                   TRANSFER IMAG. PART OF CA TO F2  
         ME    F0,0(R7,R4)                                              
         ME    F2,4(R7,R4)                                              
         SER   F0,F2                   REAL PART OF CA * CX( )          
         AE    F0,0(R7,R6)             PLUS REAL PART OF CY( )          
         LE    F2,AR                                                    
         ME    F2,4(R7,R4)                                              
         LER   F4,F6                                                    
         ME    F4,0(R7,R4)                                              
         AER   F2,F4                   IMAG. PART OF CA * CX( )         
         AE    F2,4(R7,R6)             PLUS IMAG. PART OF CY( )         
         STE   F0,0(R7,R6)             STORE CY( ) + CA * CX( )         
         STE   F2,4(R7,R6)             AT CY( )                         
         BXLE  R7,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R4,R5,R9,R11,CSTAR8,ICY    FIX CX( ) INCREMENT           
ICY      INCFX R6,R7,R9,R11,CSTAR8,LOOPNE FIX CY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F0,AR                   GET REAL PART OF CA              
         LER   F2,F6                   TRANSFER IMAG. PART OF CA TO F2  
         ME    F0,0(R4)                                                 
         ME    F2,4(R4)                                                 
         SER   F0,F2                   REAL PART OF CA*CX( )            
         AE    F0,0(R6)                PLUS REAL PART OF CY( )          
         LE    F2,AR                                                    
         ME    F2,4(R4)                                                 
         LER   F4,F6                                                    
         ME    F4,0(R4)                                                 
         AER   F2,F4                   IMAG. PART OF CA*CX( )           
         AE    F2,4(R6)                PLUS IMAG. PART OF CY( )         
         STE   F0,0(R6)                                                 
         STE   F2,4(R6)                STORE CY( )+CA*CX( ) AT CY( )    
         INCBR R4,R5,R6,R7,R2,LOOPNE                                    
DONE     EPILOG                                                         
AR       DS    F                                                        
         END                                                            
*********CONSTRUCT GIVENS TRANS., SNGL PREC., SROTG, IBM/360 ASM.****** 
*        USAGE STATEMENT                                  10 JUNE 1977* 
*             CALL SROTG (SA,SB,SC,SS)                     WASH. ST. U* 
*        SA,SB,SC,SS REAL*4                                           * 
*********************************************************************** 
SROTG    PROLOG R5                                                      
         LM    R2,R5,0(R1)             GET POINTERS TO ARGUMENTS        
         LE    F2,0(R2)                GET SA IN F2                     
         LE    F0,0(R3)                GET SB IN F0                     
         LPER  F4,F0                   NOW  ABS(SB) IN F4               
         LPER  F6,F2                   AND  ABS(SA) IN F6               
         CER   F6,F4                   TEST FOR                         
         BNH   CASE2                   ABS(SA) .LE. ABS(SB)             
         AER   F2,F2                   COMPUTE 2*SA                     
         DER   F0,F2                   COMPUTE W = SB/(2*SA)            
         STE   F0,W                    SAVE W                           
         MER   F0,F0                   COMPUTE W**2                     
         AE    F0,=E'0.25'             COMPUTE 0.25E0+W**2              
         STE   F0,VALUE                PUT AWAY FOR SQRT( ) CALL        
         L     R15,=V(SQRT)            GET LOC. OF SQRT( )              
         CNOP  0,4                     ALIGN PROPERLY                   
         BAL   R1,SQRT1                                                 
         DC    X'80',AL3(VALUE)                                         
SQRT1    BALR  R14,R15                 GO TO SQRT( ) SUBPROGRAM         
         LE    F2,=E'1.0'              NOW Q=SQRT(0.25E0+W**2) IN F0    
         AER   F0,F0                   COMPUTE 2*Q                      
         DER   F2,F0                   COMPUTE 1.E0/(2*Q) = SC          
         ME    F0,0(R2)                COMPUTE R = SA*Q*2               
         STE   F0,0(R2)                STORE R ON SA                    
         STE   F2,0(R4)                STORE SC                         
         ME    F2,W                    COMPUTE SS = W*SC*2              
         AER   F2,F2                                                    
         STE   F2,0(R5)                STORE SS                         
         B     DONE                                                     
CASE2    LTER  F0,F0                   SET COND. FOR SB                 
         BNZ   CASE3                                                    
         LE    F2,=E'1.0'              GET 1.0 AND                      
         STE   F2,0(R4)                STORE SC                         
         STE   F0,0(R5)                STORE 0. IN SS                   
         B     DONE                                                     
CASE3    AER   F0,F0                   COMPUTE 2*SB                     
         DER   F2,F0                   COMPUTE W = SA/(2*SB)            
         STE   F2,W                    SAVE W                           
         MER   F2,F2                   COMPUTE W**2                     
         AE    F2,=E'0.25'             COMPUTE 0.25E0+W**2              
         STE   F2,VALUE                PUT AWAY FOR SQRT( )             
         L     R15,=V(SQRT)            GET LOC. OF SQRT( )              
         CNOP  0,4                     ALIGN PROPERLY                   
         BAL   R1,SQRT2                                                 
         DC    X'80',AL3(VALUE)                                         
SQRT2    BALR  R14,R15                 GO TO SQRT( ) SUBPROGRAM         
         LE    F2,=E'1.0'              NOW Q=SQRT(0.25E0+W**2) IN F0    
         AER   F0,F0                   COMPUTE 2*Q                      
         DER   F2,F0                   COMPUTE 1.E0/(2*Q) = SS          
         ME    F0,0(R3)                COMPUTE R = SB*Q*2               
         STE   F0,0(R2)                STORE R ON SA                    
         STE   F2,0(R5)                STORE SS                         
         ME    F2,W                    COMPUTE SC = W*SS*2              
         AER   F2,F2                                                    
         STE   F2,0(R4)                STORE SC                         
DONE     LE    F0,0(R4)                GET SC IN F0.                    
         LE    F2,0(R5)                GET SS IN F2.                    
         LPER  F4,F0                   SAVE ABS(SC) IN F4.              
         LPER  F6,F2                   SAVE ABS(SS) IN F6.              
         CER   F6,F4                   TEST FOR                         
         BNL   TESTSC                  ABS(SS).LT.ABS(SC)               
         STE   F2,0(R3)                STORE SS IN SB.                  
         B     OUT                                                      
TESTSC   LTER  F4,F4                   SET INDICATOR FOR SC.EQ.0.       
         BNZ   SAVERC                                                   
         LE    F0,=E'1.0'                                               
         STE   F0,0(R3)                STORE 1.0 IN SB IF SC.EQ.0.      
         B     OUT                                                      
SAVERC   LE    F2,=E'1.0'              COMPUTE 1./SC AND                
         DER   F2,F0                   STORE IN SB FOR LAST CASE.       
         STE   F2,0(R3)                                                 
OUT      EPILOG                                                         
W        DS    F                                                        
VALUE    DS    F'0'                                                     
         END                                                            
*********CONSTRUCT GIVENS TRANS., DOUB. PREC., DROTG, IBM/360 ASM.***** 
*        USAGE STATEMENT                                 10 JUNE 1977 * 
*             CALL DROTG (DA,DB,DC,DS)                     WASH. ST. U* 
*        DA,DB,DC,DS REAL*8                                           * 
*********************************************************************** 
DROTG    PROLOG R5                                                      
         LM    R2,R5,0(R1)             GET POINTERS TO ARGUMENTS        
         LD    F2,0(R2)                GET DA IN F2                     
         LD    F0,0(R3)                GET DB IN F0                     
         LPDR  F4,F0                   NOW DABS(DB) IN F4               
         LPDR  F6,F2                   AND DABS(DA) IN F6               
         CDR   F6,F4                   TEST FOR                         
         BNH   CASE2                   DABS(DA) .LE. DABS(DB)           
         ADR   F2,F2                   COMPUTE 2*DA                     
         DDR   F0,F2                   COMPUTE W= DB/(2*DA)             
         STD   F0,W                    SAVE W                           
         MDR   F0,F0                   COMPUTE W**2                     
         AD    F0,=D'0.25'             COMPUTE 0.25D0+W**2              
         STD   F0,VALUE                PUT AWAY FOR DSQRT( ) CALL       
         L     R15,=V(DSQRT)           GET LOC OF DSQRT( )              
         CNOP  0,4                     ALIGN PROPERLY                   
         BAL   R1,SQRT1                                                 
         DC    X'80',AL3(VALUE)                                         
SQRT1    BALR  R14,R15                 GO TO DSQRT( ) SUBPROGRAM        
         LD    F2,=D'1.0'              NOW Q=DSQRT(0.25D0+W**2) IN F0   
         ADR   F0,F0                   COMPUTE 2*Q                      
         DDR   F2,F0                   COMPUTE 1.D0/(2*Q) = DC          
         MD    F0,0(R2)                COMPUTE R = DA*Q*2               
STORE1   STD   F0,0(R2)                STORE R ON DA                    
         STD   F2,0(R4)                STORE DC                         
         MD    F2,W                    COMPUTE DS=W*DC*2                
         ADR   F2,F2                                                    
         STD   F2,0(R5)                STORE DS                         
         B     DONE                                                     
CASE2    LTDR  F0,F0                   SET COND. FOR DB                 
         BNZ   CASE3                                                    
         LD    F2,=D'1.0'              GET 1.0 AND                      
         STD   F2,0(R4)                STORE DC                         
         STD   F0,0(R5)                STORE 0.0 IN  DS                 
         B     DONE                                                     
CASE3    ADR   F0,F0                   COMPUTE 2*DB                     
         DDR   F2,F0                   COMPUTE  W=DA/(2*DB)             
         STD   F2,W                    SAVE W                           
         MDR   F2,F2                   COMPUTE W**2                     
         AD    F2,=D'0.25'             COMPUTE 0.25D0+W**2              
         STD   F2,VALUE                PUT AWAY FOR DSQRT( )            
         L     R15,=V(DSQRT)           GET LOC OF DSQRT( )              
         CNOP  0,4                     ALIGN PROPERLY                   
         BAL   1,SQRT2                                                  
         DC    X'80',AL3(VALUE)                                         
SQRT2    BALR  R14,R15                 GO TO DSQRT( ) SUBROUTINE        
         LD    F2,=D'1.0'              NOW Q=DSQRT(0.25D0+W**2) IN F0   
         ADR   F0,F0                   COMPUTE 2*Q                      
         DDR   F2,F0                   COMPUTE 1.D0/(2*Q) =DS           
         MD    F0,0(R3)                COMPUTE  R=DB*Q*2                
         STD   F0,0(R2)                STORE R ON DA                    
         STD   F2,0(R5)                STORE DS                         
         MD    F2,W                    COMPUTE DC=W*DS*2                
         ADR   F2,F2                                                    
         STD   F2,0(R4)                STORE DC                         
DONE     LD    F0,0(R4)                GET DC IN F0.                    
         LD    F2,0(R5)                GET DS IN F2.                    
         LPDR  F4,F0                   SAVE ABS(DC) IN F4.              
         LPDR  F6,F2                   SAVE ABS(DS) IN F6.              
         CDR   F6,F4                   TEST FOR                         
         BNL   TESTSC                  ABS(DS).LT.ABS(DC)               
         STD   F2,0(R3)                STORE DS IN DB.                  
         B     OUT                                                      
TESTSC   LTDR  F4,F4                   SET INDICATOR FOR DC.EQ.0.       
         BNZ   SAVERC                                                   
         LD    F0,=D'1.0'                                               
         STD   F0,0(R3)                STORE 1.0 IN DB IF DC.EQ.0.      
         B     OUT                                                      
SAVERC   LD    F2,=D'1.0'              COMPUTE 1./DC AND                
         DDR   F2,F0                   STORE IN DB FOR LAST CASE.       
         STD   F2,0(R3)                                                 
OUT      EPILOG                                                         
VALUE    DS    D'0'                                                     
W        DS    D                                                        
         END                                                            
*********APPLY SINGLE PREC. PLANE ROTATION, SROT, IBM/360 ASM.********* 
*       USAGE STATEMENT                               3 SEPTEMBER 1975* 
*              CALL SROT (N,SX,INCX,SY,INCY,SC,SS)    WASH. ST. U./ANL* 
*        SX( ),SY( ), SC,SS REAL*4, N,INCX,INCY INTEGER *4            * 
*********************************************************************** 
SROT     PROLOG R11                                                     
         LM    R2,R8,0(R1)         GET POINTERS TO ARGUMENTS            
         NCHK  R9,R2,DONE          GET N AND QUIT IF N .LE. 0           
         LE    F4,0(R7)            GET SC AND                           
         LE    F6,0(R8)            SS FOR MULTIPLYING                   
         LER   F0,F4                   IF SC .EQ. 1.0                   
         SE    F0,=E'1.0'              AND SS .EQ. 0.                   
         BNZ   UCASE                   NO TRANS.                        
         LTER  F6,F6                   IS                               
         BZ    DONE                    NECESSARY.                       
UCASE    L     R11,0(R4)           GET INCX                             
         C     R11,0(R6)           COMPARE INCY WITH INCX               
         BNE   INCNE               BRANCH TO GEN. LOOP IF NOT EQUAL     
         SLA   R11,RSTAR4          MULTIPLY INCX * 4                    
         BM    INCNE               GEN. LOOP IF INCX,INCY NEG.          
         LR    R8,R11              SAVE INCX*4 IN UNOCCUPIED R8         
         MR    R10,R9              MULTIPLY INCX * 4 * (N-1)            
         SR    R6,R6               SET R6 = 0                           
         LR    R10,R8              LOAD LOOPEQ INCREMENT INTO R10       
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F0,0(R6,R3)         GET SX( )                            
         LE    F2,0(R6,R5)         GET SY( )                            
         MER   F0,F4               COMPUTE SC * SX( )                   
         MER   F2,F6               COMPUTE SS * SY( )                   
         AER   F0,F2               COMPUTE SC*SX( ) + SS*SY( )          
         LE    F2,0(R6,R3)         GET SX( )                            
         STE   F0,0(R6,R3)         OVERWRITE SX( ) WITH PRODUCT         
         LE    F0,0(R6,R5)         GET SY( )                            
         MER   F0,F4               COMPUTE SC * SY( )                   
         MER   F2,F6               COMPUTE SS * SX( )                   
         SER   F0,F2               COMPUTE -SS*SX( ) + SC*SY( )         
         STE   F0,0(R6,R5)         OVERWRITE SY( ) WITH PRODUCT         
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R9,R11,RSTAR4,ICY    FIX SX( ) INCREMENT           
ICY      INCFX R5,R6,R9,R11,RSTAR4,LOOPNE FIX SY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F0,0(R3)            GET SX( )                            
         LE    F2,0(R5)            GET SY( )                            
         MER   F0,F4               COMPUTE SC*SX( )                     
         MER   F2,F6               COMPUTE SS*SY( )                     
         AER   F0,F2               COMPUTE SC*SX( )+SS*SY( )            
         LE    F2,0(R3)            GET SX( )                            
         STE   F0,0(R3)            OVERWRITE SX( ) WITH PRODUCT         
         LE    F0,0(R5)            GET SY( )                            
         MER   F0,F4               COMPUTE SC*SY( )                     
         MER   F2,F6               COMPUTE SS*SX( )                     
         SER   F0,F2               COMPUTE -SS*SX( )+SC*SY( )           
         STE   F0,0(R5)            OVERWRITE SY( ) WITH PRODUCT         
         INCBR R3,R4,R5,R6,R2,LOOPNE                                    
DONE     EPILOG                                                         
         END                                                            
*********APPLY DBLE PREC. PLANE ROTATION, DROT, IBM/360 ASM.*********** 
*        USAGE STATEMENT                              3 SEPTEMBER 1975* 
*              CALL DROT (N,DX,INCX,DY,INCY,DC,DS)    WASH. ST. U./ANL* 
*        DX( ),DY( ),DC,DS, REAL *8, N,INCX,INCY INTEGER *4           * 
*********************************************************************** 
DROT     PROLOG R11                                                     
         LM    R2,R8,0(R1)         GET POINTER TO ARGUMENTS.            
         NCHK  R9,R2,DONE          GET N AND QUIT IF N .LE. 0           
         LD    F4,0(R7)            GET DC AND                           
         LD    F6,0(R8)            DS FOR MULTIPLYING                   
         LDR   F0,F4                   IF DC .EQ. 1.0                   
         SD    F0,=D'1.0'              AND DS .EQ. 0.                   
         BNZ   UCASE                   NO TRANS.                        
         LTDR  F6,F6                                                    
         BZ    DONE                    NECESSARY.                       
UCASE    L     R11,0(R4)           GET INCX                             
         C     R11,0(R6)           COMPARE INCY WITH INCX               
         BNE   INCNE               BRANCH TO GEN. LOOP IF NOT EQUAL     
         SLA   R11,RSTAR8          MULTIPLY INCX * 8                    
         BM    INCNE               GEN. LOOP IF INCX, INCY NEG.         
         LR    R8,R11              SAVE INCX*8 IN UNOCCUPIED R8         
         MR    R10,R9              COMPUTE INCX * 8 * (N-1)             
         SR    R6,R6               SET R6 = 0                           
         LR    R10,R8              LOAD R10 WITH LOOPEQ INCREMENT       
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LD    F0,0(R6,R3)         GET DX( )                            
         LD    F2,0(R6,R5)         GET DY( )                            
         MDR   F0,F4               COMPUTE DC * DX( )                   
         MDR   F2,F6               COMPUTE DS * DY( )                   
         ADR   F0,F2               COMPUTE DC*DX( ) + DS*DY( )          
         LD    F2,0(R6,R3)         GET DX( )                            
         STD   F0,0(R6,R3)         OVERWRITE DX( ) WITH PRODUCT         
         LD    F0,0(R6,R5)         GET DY( )                            
         MDR   F0,F4               COMPUTE DC * DY( )                   
         MDR   F2,F6               COMPUTE DS * DX( )                   
         SDR   F0,F2               COMPUTE -DS*DX( ) + DC*DY( )         
         STD   F0,0(R6,R5)         OVERWRITE DY( ) WITH PRODUCT         
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R9,R11,RSTAR8,ICY    FIX DX( ) INCREMENT           
ICY      INCFX R5,R6,R9,R11,RSTAR8,LOOPNE FIX DY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LD    F0,0(R3)            GET DX( )                            
         LD    F2,0(R5)            GET DY( )                            
         MDR   F0,F4               COMPUTE DC*DX( )                     
         MDR   F2,F6               COMPUTE DS*DY( )                     
         ADR   F0,F2               COMPUTE DC*DX( )+DS*DY( )            
         LD    F2,0(R3)            GET DX( )                            
         STD   F0,0(R3)            OVERWRITE DX( ) WITH PRODUCT         
         LD    F0,0(R5)            GET DY( )                            
         MDR   F0,F4               COMPUTE DC*DY( )                     
         MDR   F2,F6               COMPUTE DS*DX( )                     
         SDR   F0,F2               COMPUTE -DS*DX( )+DC*DY( )           
         STD   F0,0(R5)            OVERWRITE DY( ) WITH PRODUCT         
         INCBR R3,R4,R5,R6,R2,LOOPNE                                    
DONE     EPILOG                                                         
         END                                                            
*********CONSTRUCT MOD. GIVENS TRANS., SNGL PREC., SROTMG, IBM/360 ASM. 
*              USAGE STATEMENT                              2 JUN 1975* 
*        CALL SROTMG (D1,D2,B1,B2,SPARAM)                  WASH. ST. U* 
*        REAL * 4 D1,D2,B1,B2,SPARAM(5)                               * 
*********************************************************************** 
SROTMG   PROLOG R6                                                      
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         USING SPARAM,R6               USE ADDRESS OF SPARAM(1) AS BASE 
         LE    F4,0(R4)                GET B1                           
         LE    F6,0(R5)                GET B2                           
         LER   F0,F4                   SAVE B1 IN F0                    
         LER   F2,F6                   SAVE B2 IN F2                    
         ME    F4,0(R2)                COMPUTE P1=D1*B1                 
         ME    F6,0(R3)                COMPUTE P2=D2*B2                 
         MER   F0,F4                   COMPUTE P1*B1                    
         MER   F2,F6                   COMPUTE P2*B2                    
         STE   F2,P2B2                 SAVE P2*B2                       
         LPER  F0,F0                   COMPUTE ABS(P1*B1)               
         LPER  F2,F2                   COMPUTE ABS(P2*B2)               
         CER   F0,F2                   SEE IF ABS(P1*B1) .GE.           
         BH    BR1                     ABS(P2*B2)                       
         LE    F2,P2B2                 SEE IF P2*B2 .GE. 0              
         LTER  F2,F2                                                    
         BZ    NOTRANS                 P2*B2=0 CASE, NO TRANSFORMATION  
         BM    BR2                     P2*B2<0, BRANCH TO BR2           
         LE    F0,=E'1.0'              P2*B2>0 CASE                     
         STE   F0,SFLAG                SET SFLAG=1.0                    
         DER   F4,F6                   COMPUTE P1/P2                    
         STE   F4,H11                  STORE H11=P1/P2                  
         LE    F0,0(R4)                GET B1                           
         LE    F2,0(R5)                GET B2                           
         DER   F0,F2                   COMPUTE B1/B2                    
         STE   F0,H22                  STORE H22=B1/B2                  
         MER   F0,F4                   COMPUTE H11*H22                  
         AE    F0,=E'1.0'              COMPUTE U=1.0+H11*H22            
         MER   F2,F0                   COMPUTE B2*U                     
         STE   F2,0(R4)                STORE B1=B2*U                    
         LE    F4,0(R3)                GET D2                           
         DER   F4,F0                   COMPUTE D2/U                     
         LE    F2,0(R2)                GET D1                           
         DER   F2,F0                   COMPUTE D1/U                     
         STE   F4,0(R2)                STORE D1=D2/U                    
         STE   F2,0(R3)                STORE D2=D1/U                    
         B     DWLP1                                                    
NOTRANS  LE    F0,=E'-2.0'             NO TRANSFORMATION CASE;          
         STE   F0,SFLAG                SET SFLAG=-2.0                   
         B     DONE                    RETURN                           
BR2      LE    F0,=E'-1.0'             P2*B2<0 CASE                     
         STE   F0,SFLAG                SET SFLAG=-1.0                   
         SER   F0,F0                                                    
         STE   F0,H11                  SET H11=0.                       
         STE   F0,H12                  SET H12=0.                       
         STE   F0,H21                  SET H21=0.                       
         STE   F0,H22                  SET H22=0.                       
         STE   F0,0(R2)                SET D1=0.                        
         STE   F0,0(R3)                SET D2=0.                        
         STE   F0,0(R4)                SET B1=0.                        
         B     DONE                    RETURN                           
BR1      DER   F6,F4                   COMPUTE P2/P1                    
         STE   F6,H12                  STORE H12=P2/P1                  
         LE    F2,0(R5)                GET B2                           
         LE    F0,0(R4)                GET B1                           
         DER   F2,F0                   COMPUTE B2/B1                    
         MER   F6,F2                   COMPUTE H12*B2/B1                
         AE    F6,=E'1.0'              COMPUTE U=1.0+H12*B2/B1          
         LCER  F2,F2                   COMPUTE H21=-B2/B1               
         STE   F2,H21                  STORE H21                        
         CE    F6,TOL                  SEE IF U .LE. TOL                
         BNH   BR2                                                      
         SER   F2,F2                                                    
         STE   F2,SFLAG                SET SFLAG=0.                     
         LE    F4,0(R2)                GET D1                           
         LE    F2,0(R3)                GET D2                           
         DER   F4,F6                   COMPUTE D1/U                     
         DER   F2,F6                   COMPUTE D2/U                     
         MER   F0,F6                   COMPUTE B1*U                     
         STE   F4,0(R2)                STORE D1=D1/U                    
         STE   F2,0(R3)                STORE D2=D2/U                    
         STE   F0,0(R4)                STORE B1=B1*U                    
DWLP1    LPER  F0,F4                   PUT ABS(D1) INTO F0              
         CE    F0,TWOM24               SEE IF ABS(D1) .GT. TWOM24       
         BH    DWLP2                                                    
         LTER  F4,F4                   SEE IF D1=0.                     
         BZ    DWLP3                   IF D1=0. BRANCH TO DWLP3         
         FIXH                                                           
         ME    F4,TWO12                MULTIPLY TWICE TO COMPUTE        
         ME    F4,TWO12                D1*(C**2)                        
         STE   F4,0(R2)                STORE D1=D1*(C**2)               
         LE    F6,0(R4)                GET B1                           
         DE    F6,TWO12                COMPUTE B1 C                     
         STE   F6,0(R4)                STORE B1=B1/C                    
         LE    F6,H11                  GET H11                          
         DE    F6,TWO12                COMPUTE H11/C                    
         STE   F6,H11                  STORE H11=H11/C                  
         LE    F6,H12                  GET H12                          
         DE    F6,TWO12                COMPUTE H12/C                    
         STE   F6,H12                  STORE H12=H12/C                  
         B     DWLP1                                                    
DWLP2    LPER  F0,F4                   PUT ABS(D1) INTO F0              
         CE    F0,TWO24                SEE IF ABS(D1) .LT. TWO24        
         BL    DWLP3                                                    
         FIXH                                                           
         DE    F4,TWO12                DIVIDE TWICE TO COMPUTE          
         DE    F4,TWO12                D1/C**2                          
         STE   F4,0(R2)                STORE D1=D1/C**2                 
         LE    F6,0(R4)                GET B1                           
         ME    F6,TWO12                COMPUTE B1*C                     
         STE   F6,0(R4)                STORE B1=B1*C                    
         LE    F6,H11                  GET H11                          
         ME    F6,TWO12                COMPUTE H11*C                    
         STE   F6,H11                  STORE H11=H11*C                  
         LE    F6,H12                  GET H12                          
         ME    F6,TWO12                COMPUTE H12*C                    
         STE   F6,H12                  STORE H12=H12*C                  
         B     DWLP2                                                    
DWLP3    LPER  F0,F2                   PUT ABS(D2) INTO F0              
         CE    F0,TWOM24               SEE IF ABS(D2) .GT. TWOM24       
         BH    DWLP4                                                    
         LTER  F2,F2                   SEE IF D2=0.                     
         BZ    DONE                    IF D2=0. RETURN                  
         FIXH                                                           
         ME    F2,TWO12                MULTIPLY TWICE TO COMPUTE        
         ME    F2,TWO12                D2*(C**2)                        
         STE   F2,0(R3)                STORE D2=D2*(C**2)               
         LE    F6,H21                  GET H21                          
         DE    F6,TWO12                COMPUTE H21/C                    
         STE   F6,H21                  STORE H21=H21/C                  
         LE    F6,H22                  GET H22                          
         DE    F6,TWO12                COMPUTE H22/C                    
         STE   F6,H22                  STORE H22=H22/C                  
         B     DWLP3                                                    
DWLP4    LPER  F0,F2                   PUT ABS(D2) INTO F0              
         CE    F0,TWO24                SEE IF ABS(D2) .LT. TWO24        
         BL    DONE                                                     
         FIXH                                                           
         DE    F2,TWO12                DIVIDE TWICE TO COMPUTE          
         DE    F2,TWO12                D2/C**2                          
         STE   F2,0(R3)                STORE D2=D2/C**2                 
         LE    F6,H21                  GET H21                          
         ME    F6,TWO12                COMPUTE H21*C                    
         STE   F6,H21                  STORE H21=H21*C                  
         LE    F6,H22                  GET H22                          
         ME    F6,TWO12                COMPUTE H22*C                    
         STE   F6,H22                  STORE H22=H22*C                  
         B     DWLP4                                                    
DONE     EPILOG                                                         
         LTORG                                                          
         DS    0F                                                       
P2B2     DS    F                                                        
TWO12    DC    E'4096.'                                                 
TWO24    DC    E'16777216.'                                             
TWOM24   DC    E'5.960E-08'                                             
TOL      DC    E'0.0'                                                   
SPARAM   DSECT                                                          
SFLAG    DS    F                                                        
H11      DS    F                                                        
H21      DS    F                                                        
H12      DS    F                                                        
H22      DS    F                                                        
         END                                                            
*********CONSTRUCT MOD. GIVENS TRANS., DBLE PREC., DROTMG, IBM/360 ASM. 
*              USAGE STATEMENT                              2 JUN 1975* 
*        CALL DROTMG (D1,D2,B1,B2,DPARAM)                  WASH. ST. U* 
*        REAL * 8 D1,D2,B1,B2,DPARAM(5)                               * 
*********************************************************************** 
DROTMG   PROLOG R6                                                      
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         USING DPARAM,R6               LOAD ADDRESS OF DPARAM           
         LD    F4,0(R4)                GET B1                           
         LD    F6,0(R5)                GET B2                           
         LDR   F0,F4                   SAVE B1 IN F0                    
         LDR   F2,F6                   SAVE B2 IN F2                    
         MD    F4,0(R2)                COMPUTE P1=D1*B1                 
         MD    F6,0(R3)                COMPUTE P2=D2*B2                 
         MDR   F0,F4                   COMPUTE P1*B1                    
         MDR   F2,F6                   COMPUTE P2*B2                    
         STD   F2,P2B2                 SAVE P2*B2                       
         LPDR  F0,F0                   COMPUTE DABS(P1*B1)              
         LPDR  F2,F2                   COMPUTE DABS(P2*B2)              
         CDR   F0,F2                   SEE IF DABS(P1*B1) .GT.          
         BH    BR1                     DABS(P2*B2)                      
         LD    F2,P2B2                 SEE IF P2*B2 .GE. 0              
         LTDR  F2,F2                                                    
         BZ    NOTRANS                 P2*B2=0 CASE, NO TRANSFORMATION  
         BM    BR2                     P2*B2<0, BRANCH TO BR2           
         LD    F0,=D'1.0'              P2*B2>0 CASE                     
         STD   F0,DFLAG                SET DFLAG=1.0                    
         DDR   F4,F6                   COMPUTE P1/P2                    
         STD   F4,H11                  STORE H11=P1/P2                  
         LD    F0,0(R4)                GET B1                           
         LD    F2,0(R5)                GET B2                           
         DDR   F0,F2                   COMPUTE B1/B2                    
         STD   F0,H22                  STORE H22=B1/B2                  
         MDR   F0,F4                   COMPUTE H11*H22                  
         AD    F0,=D'1.0'              COMPUTE U=1.0+H11*H22            
         MDR   F2,F0                   COMPUTE B2*U                     
         STD   F2,0(R4)                STORE B1=B2*U                    
         LD    F4,0(R3)                GET D2                           
         DDR   F4,F0                   COMPUTE D2/U                     
         LD    F2,0(R2)                GET D1                           
         DDR   F2,F0                   COMPUTE D1/U                     
         STD   F4,0(R2)                STORE D1=D2/U                    
         STD   F2,0(R3)                STORE D2=D1/U                    
         B     DWLP1                                                    
NOTRANS  LD    F0,=D'-2.0'             NO TRANSFORMATION CASE;          
         STD   F0,DFLAG                SET DFLAG=-2.0                   
         B     DONE                    RETURN                           
BR2      LD    F0,=D'-1.0'             P2*B2<0 CASE                     
         STD   F0,DFLAG                SET DFLAG=-1.0                   
         SDR   F0,F0                                                    
         STD   F0,H11                  SET H11=0.                       
         STD   F0,H12                  SET H12=0.                       
         STD   F0,H21                  SET H21=0.                       
         STD   F0,H22                  SET H22=0.                       
         STD   F0,0(R2)                SET D1=0.                        
         STD   F0,0(R3)                SET D2=0.                        
         STD   F0,0(R4)                SET B1=0.                        
         B     DONE                    RETURN                           
BR1      DDR   F6,F4                   COMPUTE P2/P1                    
         STD   F6,H12                  STORE H12=P2/P1                  
         LD    F2,0(R5)                GET B2                           
         LD    F0,0(R4)                GET B1                           
         DDR   F2,F0                   COMPUTE B2/B1                    
         MDR   F6,F2                   COMPUTE H12*B2/B1                
         AD    F6,=D'1.0'              COMPUTE U=1+H12*B2/B1            
         LCDR  F2,F2                   COMPUTE H21=-B2/B1               
         STD   F2,H21                  STORE H21                        
         CD    F6,TOL                  SEE IF U .LE. TOL                
         BNH   BR2                                                      
         SDR   F2,F2                                                    
         STD   F2,DFLAG                SET DFLAG=0.                     
         LD    F4,0(R2)                GET D1                           
         LD    F2,0(R3)                GET D2                           
         DDR   F4,F6                   COMPUTE D1/U                     
         DDR   F2,F6                   COMPUTE D2/U                     
         MDR   F0,F6                   COMPUTE B1*U                     
         STD   F4,0(R2)                STORE D1=D1/U                    
         STD   F2,0(R3)                STORE D2=D2/U                    
         STD   F0,0(R4)                STORE B1=B1*U                    
DWLP1    LPDR  F0,F4                   PUT DABS(D1) INTO F0             
         CD    F0,TWOM24               SEE IF DABS(D1) .GT. TWOM24      
         BH    DWLP2                                                    
         LTDR  F4,F4                   SEE IF D1=0.                     
         BZ    DWLP3                   IF D1=0. BRANCH TO DWLP3         
         DFIXH                                                          
         MD    F4,TWO12                MULTIPLY TWICE TO COMPUTE        
         MD    F4,TWO12                D1*(C**2)                        
         STD   F4,0(R2)                STORE D1=D1*(C**2)               
         LD    F6,0(R4)                GET B1                           
         DD    F6,TWO12                COMPUTE B1/C                     
         STD   F6,0(R4)                STORE B1=B1/C                    
         LD    F6,H11                  GET H11                          
         DD    F6,TWO12                COMPUTE H11/C                    
         STD   F6,H11                  STORE H11=H11/C                  
         LD    F6,H12                  GET H12                          
         DD    F6,TWO12                COMPUTE H12/C                    
         STD   F6,H12                  STORE H12=H12/C                  
         B     DWLP1                                                    
DWLP2    LPDR  F0,F4                   PUT DABS(D1) INTO F0             
         CD    F0,TWO24                SEE IF DABS(D1) .LT. TWO24       
         BL    DWLP3                                                    
         DFIXH                                                          
         DD    F4,TWO12                DIVIDE TWICE TO COMPUTE          
         DD    F4,TWO12                D1/C**2                          
         STD   F4,0(R2)                STORE D1=D1/C**2                 
         LD    F6,0(R4)                GET B1                           
         MD    F6,TWO12                COMPUTE B1*C                     
         STD   F6,0(R4)                STORE B1=B1*C                    
         LD    F6,H11                  GET H11                          
         MD    F6,TWO12                COMPUTE H11*C                    
         STD   F6,H11                  STORE H11=H11*C                  
         LD    F6,H12                  GET H12                          
         MD    F6,TWO12                COMPUTE H12*C                    
         STD   F6,H12                  STORE H12=H12*C                  
         B     DWLP2                                                    
DWLP3    LPDR  F0,F2                   PUT DABS(D2) INTO F0             
         CD    F0,TWOM24               SEE IF DABS(D2) .GT. TWOM24      
         BH    DWLP4                                                    
         LTDR  F2,F2                   SEE IF D2=0.                     
         BZ    DONE                    IF D2=0. RETURN                  
         DFIXH                                                          
         MD    F2,TWO12                MULTIPLY TWICE TO COMPUTE        
         MD    F2,TWO12                D2*(C**2)                        
         STD   F2,0(R3)                STORE D2=D2*(C**2)               
         LD    F6,H21                  GET H21                          
         DD    F6,TWO12                COMPUTE H21/C                    
         STD   F6,H21                  STORE H21=H21/C                  
         LD    F6,H22                  GET H22                          
         DD    F6,TWO12                COMPUTE H22/C                    
         STD   F6,H22                  STORE H22=H22/C                  
         B     DWLP3                                                    
DWLP4    LPDR  F0,F2                   PUT DABS(D2) INTO F0             
         CD    F0,TWO24                SEE IF DABS(D2) .LT. TWO24       
         BL    DONE                                                     
         DFIXH                                                          
         DD    F2,TWO12                DIVIDE TWICE TO COMPUTE          
         DD    F2,TWO12                D2/C**2                          
         STD   F2,0(R3)                STORE D2=D2/C**2                 
         LD    F6,H21                  GET H21                          
         MD    F6,TWO12                COMPUTE H21*C                    
         STD   F6,H21                  STORE H21=H21*C                  
         LD    F6,H22                  GET H22                          
         MD    F6,TWO12                COMPUTE H22*C                    
         STD   F6,H22                  STORE H22=H22*C                  
         B     DWLP4                                                    
DONE     EPILOG                                                         
         LTORG                                                          
         DS    0D                                                       
P2B2     DS    D                                                        
TWO12    DC    D'4096.'                                                 
TWO24    DC    D'16777216.'                                             
TWOM24   DC    D'5.960E-08'                                             
TOL      DC    D'0.0'                                                   
DPARAM   DSECT                                                          
DFLAG    DS    D                                                        
H11      DS    D                                                        
H21      DS    D                                                        
H12      DS    D                                                        
H22      DS    D                                                        
         END                                                            
*********APPLY MOD. GIVENS TRANS., SNGL PREC., SROTM, IBM/360 ASM.***** 
*        USAGE STATEMENT                                  30 SEPT 1975* 
*              CALL SROTM (N,SX,INCX,SY,INCY,SPARAM)       WASH. ST. U* 
*        REAL*4 SX( ),SY( ),SPARAM(5), INTEGER * 4 N,INCX,INCY        * 
*********************************************************************** 
SROTM    PROLOG R11                                                     
         LM    R2,R7,0(R1)             GET POINTERS TO ARGUMENTS        
         USING SPARAM,R7               LOAD ADDRESS OF SPARAM( )        
         NCHK  R9,R2,DONE              GET N AND QUIT IF N .LE. 0       
         LE    F0,FLAG                 GET FLAG TO SEE WHICH MODE       
         LTER  F0,F0                   THE TRANSFORMATION WILL HAVE     
         BZ    B1                      FLAG=0. CASE                     
         BP    B2                      FLAG=1. CASE                     
         AE    F0,=E'2.0'              CHECK FOR FLAG=-2. CASE          
         BZ    DONE                                                     
         B     C3                      BRANCH TO LOOP 3                 
B1       LE    F4,H12                  SAVE H12 AND H21 FOR MULTIPLYING 
         LE    F6,H21                  IN LOOP 1                        
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   C1                      BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR4              MULTIPLY INCX * 4                
         BM    C1                      GEN. LOOP IF INCX,INCY NEG.      
         LR    R8,R11                  SAVE INCX*4 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 4 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOP1E INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1E   LE    F0,0(R6,R3)             GET SX()                         
         LE    F2,0(R6,R5)             GET SY()                         
         MER   F2,F4                   COMPUTE H12*SY()                 
         MER   F0,F6                   COMPUTE H21*SX()                 
         AE    F2,0(R6,R3)             COMPUTE SX()+H12*SY()            
         AE    F0,0(R6,R5)             COMPUTE H21*SX()+SY()            
         STE   F2,0(R6,R3)             OVERWRITE SX()                   
         STE   F0,0(R6,R5)             OVERWRITE SY()                   
         BXLE  R6,R10,LOOP1E                                            
         B     DONE                                                     
C1       INCFX R3,R4,R9,R11,RSTAR4,ICY1  FIX SX() INCREMENT             
ICY1     INCFX R5,R6,R9,R11,RSTAR4,LOOP1N FIX SY() INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1N   LE    F0,0(R3)                GET SX()                         
         LE    F2,0(R5)                GET SY()                         
         MER   F2,F4                   COMPUTE H12*SY()                 
         MER   F0,F6                   COMPUTE H21*SX()                 
         AE    F2,0(R3)                COMPUTE SX()+H12*SY()            
         AE    F0,0(R5)                COMPUTE H21*SX()+SY()            
         STE   F2,0(R3)                OVERWRITE SX()                   
         STE   F0,0(R5)                OVERWRITE SY()                   
         INCBR R3,R4,R5,R6,R2,LOOP1N                                    
         B     DONE                                                     
B2       LE    F4,H11                  SAVE H11 AND H22 FOR MULTIPLYING 
         LE    F6,H22                  IN LOOP2                         
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   C2                      BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR4              MULTIPLY INCX * 4                
         BM    C2                      GEN. LOOP IF INCX,INCY NEG.      
         LR    R8,R11                  SAVE INCX*4 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 4 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOP2E INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2E   LE    F0,0(R6,R3)             GET SX()                         
         LE    F2,0(R6,R5)             GET SY()                         
         MER   F0,F4                   COMPUTE H11*SX()                 
         MER   F2,F6                   COMPUTE H22*SY()                 
         AE    F0,0(R6,R5)             COMPUTE H11*SX()+SY()            
         SE    F2,0(R6,R3)             COMPUTE -SX()+H22*SY()           
         STE   F0,0(R6,R3)             OVERWRITE SX()                   
         STE   F2,0(R6,R5)             OVERWRITE SY()                   
         BXLE  R6,R10,LOOP2E                                            
         B     DONE                                                     
C2       INCFX R3,R4,R9,R11,RSTAR4,ICY2  FIX SX() INCREMENT             
ICY2     INCFX R5,R6,R9,R11,RSTAR4,LOOP2N FIX SY() INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2N   LE    F0,0(R3)                GET SX()                         
         LE    F2,0(R5)                GET SY()                         
         MER   F0,F4                   COMPUTE H11*SX()                 
         MER   F2,F6                   COMPUTE H22*SY()                 
         AE    F0,0(R5)                COMPUTE H11*SX()+SY()            
         SE    F2,0(R3)                COMPUTE -SX()+H22*SY()           
         STE   F0,0(R3)                OVERWRITE SX()                   
         STE   F2,0(R5)                OVERWRITE SY()                   
         INCBR R3,R4,R5,R6,R2,LOOP2N                                    
         B     DONE                                                     
C3       INCFX R3,R4,R9,R11,RSTAR4,ICY3  FIX SX() INCREMENT             
ICY3     INCFX R5,R6,R9,R11,RSTAR4,LOOP3 FIX SY() INCREMENT             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP3    LE    F4,0(R3)                GET SX()                         
         LE    F6,0(R5)                GET SY()                         
         LE    F0,H11                  GET H11                          
         LE    F2,H12                  GET H12                          
         MER   F0,F4                   COMPUTE H11*SX()                 
         MER   F2,F6                   COMPUTE H12*SY()                 
         AER   F2,F0                   COMPUTE H11*SX()+H12*SY()        
         LE    F0,H21                  GET H21                          
         MER   F0,F4                   COMPUTE H21*SX()                 
         STE   F2,0(R3)                OVERWRITE SX()                   
         LE    F2,H22                  GET H22                          
         MER   F2,F6                   COMPUTE H22*SY()                 
         AER   F0,F2                   COMPUTE H21*SX()+H22*SY()        
         STE   F0,0(R5)                OVERWRITE SY()                   
         INCBR R3,R4,R5,R6,R2,LOOP3                                     
DONE     EPILOG                                                         
         LTORG                                                          
SPARAM   DSECT                                                          
FLAG     DS    F                                                        
H11      DS    F                                                        
H21      DS    F                                                        
H12      DS    F                                                        
H22      DS    F                                                        
         END                                                            
*********APPLY MOD. GIVENS TRANS., DBLE PREC., DROTM, IBM/360 ASM.***** 
*        USAGE STATEMENT                                  30 SEPT 1975* 
*              CALL DROTM (N,DX,INCX,DY,INCY,DPARAM)       WASH. ST. U* 
*        REAL*8 DX( ),DY( ),DPARAM(5), INTEGER * 4 N,INCX,INCY        * 
*********************************************************************** 
DROTM    PROLOG R11                                                     
         LM    R2,R7,0(R1)             GET POINTERS TO ARGUMENTS        
         USING DPARAM,R7               LOAD ADDRESS OF DPARAM( )        
         NCHK  R9,R2,DONE              GET N AND QUIT IF N .LE. 0       
         LD    F0,FLAG                 GET FLAG TO SEE WHICH MODE       
         LTDR  F0,F0                   THE TRANSFORMATION WILL HAVE     
         BZ    B1                      FLAG=0. CASE                     
         BP    B2                      FLAG=1. CASE                     
         AD    F0,=D'2.0'              CHECK FOR FLAG=-2. CASE          
         BZ    DONE                                                     
         B     C3                      BRANCH TO LOOP 3                 
B1       LD    F4,H12                  SAVE H12 AND H21 FOR MULTIPLYING 
         LD    F6,H21                  IN LOOP 1                        
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   C1                      BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR8              MULTIPLY INCX * 8                
         BM    C1                      GEN. LOOP IF INCX,INCY NEG.      
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 8 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOP1E INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1E   LD    F0,0(R6,R3)             GET DX()                         
         LD    F2,0(R6,R5)             GET DY()                         
         MDR   F2,F4                   COMPUTE H12*DY()                 
         MDR   F0,F6                   COMPUTE H21*DX()                 
         AD    F2,0(R6,R3)             COMPUTE DX()+H12*DY()            
         AD    F0,0(R6,R5)             COMPUTE H21*DX()+DY()            
         STD   F2,0(R6,R3)             OVERWRITE DX()                   
         STD   F0,0(R6,R5)             OVERWRITE DY()                   
         BXLE  R6,R10,LOOP1E                                            
         B     DONE                                                     
C1       INCFX R3,R4,R9,R11,RSTAR8,ICY1  FIX DX() INCREMENT             
ICY1     INCFX R5,R6,R9,R11,RSTAR8,LOOP1N FIX DY() INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1N   LD    F0,0(R3)                GET DX()                         
         LD    F2,0(R5)                GET DY()                         
         MDR   F2,F4                   COMPUTE H12*DY()                 
         MDR   F0,F6                   COMPUTE H21*DX()                 
         AD    F2,0(R3)                COMPUTE DX()+H12*DY()            
         AD    F0,0(R5)                COMPUTE H21*DX()+DY()            
         STD   F2,0(R3)                OVERWRITE DX()                   
         STD   F0,0(R5)                OVERWRITE DY()                   
         INCBR R3,R4,R5,R6,R2,LOOP1N                                    
         B     DONE                                                     
B2       LD    F4,H11                  SAVE H11 AND H22 FOR MULTIPLYING 
         LD    F6,H22                  IN LOOP2                         
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   C2                      BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR8              MULTIPLY INCX * 8                
         BM    C2                      GEN. LOOP IF INCX,INCY NEG.      
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 8 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOP2E INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2E   LD    F0,0(R6,R3)             GET DX()                         
         LD    F2,0(R6,R5)             GET DY()                         
         MDR   F0,F4                   COMPUTE H11*DX()                 
         MDR   F2,F6                   COMPUTE H22*DY()                 
         AD    F0,0(R6,R5)             COMPUTE H11*DX()+DY()            
         SD    F2,0(R6,R3)             COMPUTE -DX()+H22*DY()           
         STD   F0,0(R6,R3)             OVERWRITE DX()                   
         STD   F2,0(R6,R5)             OVERWRITE DY()                   
         BXLE  R6,R10,LOOP2E                                            
         B     DONE                                                     
C2       INCFX R3,R4,R9,R11,RSTAR8,ICY2  FIX DX() INCREMENT             
ICY2     INCFX R5,R6,R9,R11,RSTAR8,LOOP2N FIX DY() INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2N   LD    F0,0(R3)                GET DX()                         
         LD    F2,0(R5)                GET DY()                         
         MDR   F0,F4                   COMPUTE H11*DX()                 
         MDR   F2,F6                   COMPUTE H22*DY()                 
         AD    F0,0(R5)                COMPUTE H11*DX()+DY()            
         SD    F2,0(R3)                COMPUTE -DX()+H22*DY()           
         STD   F0,0(R3)                OVERWRITE DX()                   
         STD   F2,0(R5)                OVERWRITE DY()                   
         INCBR R3,R4,R5,R6,R2,LOOP2N                                    
         B     DONE                                                     
C3       INCFX R3,R4,R9,R11,RSTAR8,ICY3  FIX DX() INCREMENT             
ICY3     INCFX R5,R6,R9,R11,RSTAR8,LOOP3 FIX DY() INCREMENT             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP3    LD    F4,0(R3)                GET DX()                         
         LD    F6,0(R5)                GET DY()                         
         LD    F0,H11                  GET H11                          
         LD    F2,H12                  GET H12                          
         MDR   F0,F4                   COMPUTE H11*DX()                 
         MDR   F2,F6                   COMPUTE H12*DY()                 
         ADR   F2,F0                   COMPUTE H11*DX()+H12*DY()        
         LD    F0,H21                  GET H21                          
         MDR   F0,F4                   COMPUTE H21*DX()                 
         STD   F2,0(R3)                OVERWRITE DX()                   
         LD    F2,H22                  GET H22                          
         MDR   F2,F6                   COMPUTE H22*DY()                 
         ADR   F0,F2                   COMPUTE H21*DX()+H22*DY()        
         STD   F0,0(R5)                OVERWRITE DY()                   
         INCBR R3,R4,R5,R6,R2,LOOP3                                     
DONE     EPILOG                                                         
         LTORG                                                          
DPARAM   DSECT                                                          
FLAG     DS    2F                                                       
H11      DS    2F                                                       
H21      DS    2F                                                       
H12      DS    2F                                                       
H22      DS    2F                                                       
         END                                                            
*********SINGLE PRECISION COPY ROUTINE, SCOPY, IBM/360 ASM.************ 
*        USAGE STATEMENT                                14 AUGUST 1975* 
*             CALL SCOPY (N,SX,INCX,SY,INCY)           WASH. ST. U/ANL* 
*        SX( ),SY( ),REAL*4 N,INCX,INCY,INTEGER*4                     * 
*********************************************************************** 
SCOPY    PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND EXIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR4              MULTIPLY INCX * 4                
         BM    INCNE                   IF INCX,INCY NEG., GEN. LOOP     
         LR    R8,R11                  SAVE INCX*4 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 4 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F0,0(R6,R3)             GET SX( ) AND                    
         STE   F0,0(R6,R5)             STORE IN LOCATION SY( )          
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R9,R11,RSTAR4,INCYT  FIX SX( ) INCREMENT           
INCYT    INCFX R5,R6,R9,R11,RSTAR4,LOOPNE FIX SY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LE    F0,0(R3)                GET SX( ) AND                    
         STE   F0,0(R5)                STORE IN LOCATION SY( )          
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                                                         
         END                                                            
*********DOUBLE PRECISION COPY ROUTINE, DCOPY, IBM/360 ASM.************ 
*        USAGE STATEMENT                                14 AUGUST 1975* 
*             CALL COPY (N,DX,INCX,DY,INCY)            WASH. ST. U/ANL* 
*        DX( ),DY( ),REAL*8 N,INCX,INCY,INTEGER*4                     * 
*********************************************************************** 
DCOPY    PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND EXIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR8              MULTIPLY INCX * 8                
         BM    INCNE                   IF INCX,INCY NEG., GEN. LOOP     
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 8 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LD    F0,0(R6,R3)             GET DX( ) AND                    
         STD   F0,0(R6,R5)             STORE IN LOCATION DY( )          
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R9,R11,RSTAR8,INCYT  FIX DX( ) INCREMENT           
INCYT    INCFX R5,R6,R9,R11,RSTAR8,LOOPNE FIX DY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LD    F0,0(R3)                GET DX( ) AND                    
         STD   F0,0(R5)                STORE IN LOCATION DY( )          
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                                                         
         END                                                            
*********COMPLEX COPY ROUTINE,CCOPY, IBM/360 ASM.********************** 
*        USAGE STATEMENT                                   19 MAY 1974* 
*             CALL CCOPY(N,CX,INCX,CY,INCY)                WASH. ST. U* 
*        CX( ),CY( ),COMPLEX*8, N,INCX,INCY,INTEGER*4                 * 
*********************************************************************** 
CCOPY    PROLOG R10                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R10,R2,DONE             GET N AND QUIT IF N .LE. 0       
         INCFX R3,R4,R10,R9,CSTAR8,ICY   FIX CX( ) INCREMENT            
ICY      INCFX R5,R6,R10,R9,CSTAR8,LOOP  FIX CY( ) INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R3)                GET REAL AND IMAGINARY PARTS     
         LE    F2,4(R3)                OF CX( ) AND                     
         STE   F0,0(R5)                STORE THESE IN REAL AND          
         STE   F2,4(R5)                IMAGINARY PARTS OF CY( )         
         INCBR R3,R4,R5,R6,R2,LOOP     ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                                                         
         END                                                            
*********SINGLE PRECISION SWAP ROUTINE, SSWAP, IBM/360 ASM.************ 
*        USAGE STATEMENT                                14 AUGUST 1975* 
*             CALL SSWAP (N,SX,INCX,SY,INCY)           WASH. ST. U/ANL* 
*        SX( ),SY( ),REAL*4 N,INCX,INCY,INTEGER*4                     * 
*********************************************************************** 
SSWAP    PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND EXIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR4              MULTIPLY INCX * 4                
         BM    INCNE                   IF INCX,INCY NEG., GEN. LOOP     
         LR    R8,R11                  SAVE INCX*4 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 4 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LE    F0,0(R6,R3)             GET SX( )                        
         LE    F2,0(R6,R5)             GET SY( )                        
         STE   F0,0(R6,R5)             STORE SX( ) AT LOCATION SY( )    
         STE   F2,0(R6,R3)             STORE SY( ) AT LOCATION SX( )    
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
INCNE    INCFX R3,R4,R9,R11,RSTAR4,ICY    FIX SX( ) INCREMENT           
ICY      INCFX R5,R6,R9,R11,RSTAR4,LOOPNE FIX SY( ) INCREMENT           
LOOPNE   LE    F0,0(R3)                GET SX( )                        
         LE    F2,0(R5)                GET SY( )                        
         STE   F0,0(R5)                STORE SX( ) AT LOCATION SY( )    
         STE   F2,0(R3)                STORE SY( ) AT LOCATION SX( )    
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE      
DONE     EPILOG                                                         
         END                                                            
*********DOUBLE PRECISION SWAP ROUTINE, DSWAP, IBM/360 ASM.************ 
*        USAGE STATEMENT                                14 AUGUST 1975* 
*              CALL DSWAP (N,DX,INCX,DY,INCY)          WASH. ST. U/ANL* 
*        DX( ),DY( ),REAL*8  N,INCX,INCY,INTEGER*4                    * 
*********************************************************************** 
DSWAP    PROLOG R11                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R9,R2,DONE              GET N AND EXIT IF N .LE. 0       
         L     R11,0(R4)               GET INCX                         
         C     R11,0(R6)               COMPARE INCY WITH INCX           
         BNE   INCNE                   BRANCH TO GEN. LOOP IF NOT EQUAL 
         SLA   R11,RSTAR8              MULTIPLY INCX * 8                
         BM    INCNE                   IF INCX,INCY NEG., GEN. LOOP     
         LR    R8,R11                  SAVE INCX*8 IN UNOCCUPIED R8     
         MR    R10,R9                  COMPUTE INCX * 8 * (N-1)         
         SR    R6,R6                   SET R6 = 0                       
         LR    R10,R8                  LOAD R10 WITH LOOPEQ INCREMENT   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPEQ   LD    F0,0(R6,R3)             GET DX( )                        
         LD    F2,0(R6,R5)             GET DY( )                        
         STD   F0,0(R6,R5)             STORE DX( ) AT LOCATION DY( )    
         STD   F2,0(R6,R3)             STORE DY( ) AT LOCATION DX( )    
         BXLE  R6,R10,LOOPEQ                                            
         B     DONE                                                     
INCNE    INCFX R3,R4,R9,R11,RSTAR8,ICY    FIX DX( ) INCREMENT           
ICY      INCFX R5,R6,R9,R11,RSTAR8,LOOPNE FIX DY( ) INCREMENT           
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOPNE   LD    F0,0(R3)                GET DX( )                        
         LD    F2,0(R5)                GET DY( )                        
         STD   F0,0(R5)                STORE DX( ) AT LOCATION DY( )    
         STD   F2,0(R3)                STORE DY( ) AT LOCATION DX( )    
         INCBR R3,R4,R5,R6,R2,LOOPNE   ADD INCREMENTS AND CONTINUE      
DONE     EPILOG                                                         
         END                                                            
*********COMPLEX SWAPPING ROUTINE, CSWAP,     IBM/360 ASM.************* 
*        USAGE STATEMENT                                   19 MAY 1974* 
*             CALL CSWAP(N,CX,INCX,CY,INCY)                WASH. ST. U* 
*        CX( ),CY( ),COMPLEX*8, N,INCX,INCY,INTEGER*4                 * 
*********************************************************************** 
CSWAP    PROLOG R10                                                     
         LM    R2,R6,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R10,R2,DONE             GET N AND QUIT IF N .LE. 0       
         INCFX R3,R4,R10,R9,CSTAR8,ICY FIX DX( ) INCREMENT              
ICY      INCFX R5,R6,R10,R9,CSTAR8,LOOP  FIX CY( ) INCREMENT            
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R3)                GET REAL AND IMAGINARY           
         LE    F2,4(R3)                PART OF CX( )                    
         LE    F4,0(R5)                GET REAL AND IMAGINARY           
         LE    F6,4(R5)                PART OF CY( )                    
         STE   F0,0(R5)                STORE REAL AND IMAG.             
         STE   F2,4(R5)                PARTS OF CX( ) AT CY( )          
         STE   F4,0(R3)                STORE REAL AND IMAG.             
         STE   F6,4(R3)                PARTS OF CY( ) AT CX( )          
         INCBR R3,R4,R5,R6,R2,LOOP     ADD INCREMENTS AND CONTINUE LOOP 
DONE     EPILOG                                                         
         END                                                            
*********EUCLIDEAN NORM SINGLE PREC.,SNRM2, IBM/360 ASM.*************** 
*        USAGE STATEMENT                                   22 MAY 1974* 
*             SW = SNRM2(N,SX,INCX)                        WASH. ST. U* 
*        SW,SNRM2,SX( ) REAL *4, N,INCX INTEGER * 4                   * 
*********************************************************************** 
SNRM2    PROLOG R6                                                      
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         SER   F0,F0                   SET SNRM2 = 0.0                  
         L     R2,0(R2)                GET VALUE OF N                   
         LTR   R5,R2                   CHECK IF N .LE. 0 AND SAVE N     
         BNP   DONE                    IF YES RETURN                    
         LR    R6,R3                   SAVE BASE ADDRESS OF SX( )       
         L     R4,0(R4)                GET VALUE OF INCX.               
         SLA   R4,RSTAR4               COMPUTE INCX*4 AND SET CODES     
         BM    DONE                    IF INCX .LT. 0 RETURN            
         SER   F6,F6                   SET U = 0.0 (LEAVE IN REG. F6)   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1    LE    F4,0(R3)                GET SX( )                        
         LPER  F4,F4                   COMPUTE ABS(SX( ))               
         CE    F4,ALPHA                SET CODES FOR UNDERFLOW          
         BH    LOOP2                   BRANCH IF UNFL. DON'T HURT NUM.  
         CER   F6,F4                   FIND MAX. VALUE OF ABS(SX( ))    
         BNL   UBIG                    IF BRANCH OCCURS U(F6) IS LARGER 
         LER   F6,F4                   F6 CONTAINS MAX SO FAR           
UBIG     AR    R3,R4                   COMPUTE ADDRESS OF NEXT ELEMENT  
         BCT   R2,LOOP1                                                 
         CER   F0,F6                   SEE IF MAX. IS ZERO.             
         BE    DONE                    QUIT IF SO.                      
         LE    F2,=E'1.0'                                               
         DER   F2,F6                   COMPUTE SCALE FACTOR FOR UNFL    
         LR    R2,R5                   RESTORE VALUES OF N AND          
         LR    R3,R6                   BASE ADDRESS OF SX( )            
         B     LOOP3                                                    
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2    LE    F4,0(R3)                MAIN LOOP BEGINS HERE            
         LPER  F4,F4                   COMPUTE ABS(SX( ))               
         CE    F4,GAMMA                CHECK FOR OVERFLOW               
         BH    OVRFL                   BRANCH TO OTHER LOOP IF OVERFL.  
         MER   F4,F4                   SQUARE VALUE                     
         AER   F0,F4                   ACCUMULATE SUM IN F0             
         AR    R3,R4                   GET ADDRESS OF NEXT ELEMENT      
         BCT   R2,LOOP2                END OF MAIN LOOP                 
         LE    F6,=E'1.0'              FINAL SCALE FACTOR               
         B     CALSQ                   BRANCH AND COMPUTE SQRT( )       
OVRFL    LE    F6,U1                   SET OVERFLOW PARAMETER           
         LE    F2,U2                   RECIPROCAL OF SCALE FACTOR       
         MER   F0,F2                   USE TWO MULTIPLIES BY OVERFLOW   
         MER   F0,F2                   PARAMETER TO SCALE RESULT        
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP3    LE    F4,0(R3)                CONTINUE ACCUMULATION BY         
         MER   F4,F2                   MULTIPLYING EACH ELEMENT BY THE  
         MER   F4,F4                   SCALE FACTOR AND SQUARE RESULT   
         AER   F0,F4                   CONTINUE ACCUMULATION            
         AR    R3,R4                   GET ADDRESS OF NEXT ELEMENT      
         BCT   R2,LOOP3                END OF SCALED LOOP.              
CALSQ    STE   F0,VALUE                STORE VALUE FOR BRANCH           
         STE   F6,U                    SAVE FINAL RESCALING VALUE.      
         L     R15,=V(SQRT)            GET ADDRESS OF SQRT              
         CNOP  0,4                                                      
         BAL   R1,SQRTC                                                 
         DC    X'80',AL3(VALUE)                                         
SQRTC    BALR  R14,R15                                                  
         ME    F0,U                    MULTIPLY RESULT BY SCALE FACTOR  
DONE     EPILOG                                                         
ALPHA    DC    E'1.E-34'                                                
GAMMA    DC    E'1.E+35'                                                
U1       DC    E'1.E+36'                                                
U2       DC    E'1.E-36'                                                
VALUE    DC    E'0'                                                     
U        DS    F                                                        
         END                                                            
*********EUCLIDEAN NORM DOUBLE PREC., DNRM2, IBM/360 ASM.************** 
*        USAGE STATEMENT                                   22 MAY 1974* 
*             DW = DNRM2(N,DX,INCX)                        WASH. ST. U* 
*        DW,DNRM2,DX( ), REAL * 8, N,INCX REAL * 4                    * 
*********************************************************************** 
DNRM2    PROLOG R6                                                      
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         SDR   F0,F0                   SET DNRM2 = 0.0                  
         L     R2,0(R2)                GET VALUE OF N                   
         LTR   R5,R2                   CHECK IF N .LE. 0 AND SAVE N     
         BNP   DONE                    IF YES RETURN                    
         LR    R6,R3                   SAVE BASE ADDRESS OF DX( )       
         L     R4,0(R4)                GET VALUE OF INCX                
         SLA   R4,RSTAR8               COMPUTE INCX*8 AND SET CODES     
         BM    DONE                    IF INCX .LT. 0 RETURN            
         SDR   F6,F6                   SET U = 0.0 (LEAVE IN REG. F6)   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1    LD    F4,0(R3)                GET DX( )                        
         LPDR  F4,F4                   COMPUTE DABS(DX( ))              
         CD    F4,ALPHA                SET CODES FOR UNDERFLOW          
         BH    LOOP2                   BRANCH IF ELEMENT IS LARGER      
         CDR   F6,F4                   FIND MAX. VALUE OF DABS(DX( ))   
         BNL   UBIG                    TEST FOR MAX. ELEMENT.           
         LDR   F6,F4                   F6 CONTAINS MAX SO FAR           
UBIG     AR    R3,R4                   COMPUTE ADDRESS OF NEXT ELEMENT  
         BCT   R2,LOOP1                END OF FIRST LOOP                
         CDR   F6,F0                   CHECK IF MAX ELEMENT OF DX = 0.0 
         BE    DONE                    IF YES RETURN                    
         LD    F2,=D'1.0'                                               
         DDR   F2,F6                   COMPUTE SCALE FACTOR FOR UNDFLOW 
         LR    R2,R5                   RESTORE VALUES OF N AND          
         LR    R3,R6                   BASE ADDRESS OF DX( )            
         B     LOOP3                                                    
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2    LD    F4,0(R3)                MAIN LOOP BEGINS HERE            
         LPDR  F4,F4                   COMPUTE DABS(DX( ))              
         CD    F4,GAMMA                CHECK FOR OVERFLOW               
         BH    OVRFL                   IF YES BRANCH FOR FIXUP          
         MDR   F4,F4                   SQUARE VALUE                     
         ADR   F0,F4                   ACCUMULATE SUM IN F0             
         AR    R3,R4                   GET ADDRESS OF NEXT ELEMENT      
         BCT   R2,LOOP2                END OF MAIN LOOP                 
         LD    F6,=D'1.0'              SCALE FACTOR                     
         B     CALSQ                   BRANCH AND COMPUTE DSQRT( )      
OVRFL    LD    F6,U1                   SET OVERFLOW PARAMETER           
         LD    F2,U2                   RECIPROCAL OF SCALE FACTOR       
         MDR   F0,F2                   USE TWO MULTIPLIES BY OVERFLOW   
         MDR   F0,F2                   PARAMETER TO SCALE RESOLT        
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP3    LD    F4,0(R3)                CONTINUE ACCUMULATION BY         
         MDR   F4,F2                   MULTIPLYING EACH ELEMENT BY      
         MDR   F4,F4                   SCALE FACTOR AND SQUARE RESULT   
         ADR   F0,F4                   CONTINUE ACCUMULATION            
         AR    R3,R4                   GET ADDRESS OF NEXT ELEMENT      
         BCT   R2,LOOP3                END OF SCALED LOOP.              
CALSQ    STD   F0,VALUE                STORE VALUE FOR BRANCH           
         STD   F6,U                    SAVE FINAL RESCALING VALUE.      
         L     R15,=V(DSQRT)           GET ADDRESS OF DSQRT             
         CNOP  0,4                                                      
         BAL   1,SQRTC                                                  
         DC    X'80',AL3(VALUE)                                         
SQRTC    BALR  R14,R15                 BRANCH TO DSQRT                  
         MD    F0,U                    MULTIPLY RESULT BY SCALE FACTOR  
DONE     EPILOG                                                         
ALPHA    DC    D'1.0E-29'                                               
GAMMA    DC    D'1.0E+35'                                               
U1       DC    D'1.0E+36'                                               
U2       DC    D'1.0E-36'                                               
VALUE    DC    D'0'                                                     
U        DS    D                                                        
         END                                                            
***********EUCLIDEAN NORM, COMPLEX, SCNRM2, IBM/360 ASM.*************** 
*           USAGE STATEMENT                            30 OCTOBER 1975* 
*         SW = SCNRM2 (N,CX,INCX)                          WASH. ST. U* 
*    SW,SCNRM2 REAL*4, N,INCX INTEGER*4, CX( ) COMPLEX*8              * 
*********************************************************************** 
SCNRM2   PROLOG R6                                                      
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS.       
         SER   F0,F0                   SET SCNRM2 = 0.0                 
         L     R2,0(R2)                GET VALUE OF N.                  
         LTR   R5,R2                   CHECK IF N .LE. 0, SAVE N.       
         BNP   DONE                    IF YES RETURN.                   
         LR    R6,R3                   SAVE BASE ADDRESS OF CX( )       
         L     R4,0(R4)                GET VALUE OF INCX                
         SLA   R4,CSTAR8               COMPUTE INCX*8 AND SET CODES.    
         BM    DONE                    IF INCX .LT. 0 RETURN            
         SER   F6,F6                   SET U = 0.0 (LEAVE IN REG. F6)   
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP1    LE    F4,0(R3)                GET REAL (CX())                  
         LPER  F4,F4                   COMPUTE ABS REAL (CX())          
         CE    F4,ALPHA                SET CODES FOR UNDERFLOW.         
         BH    LOOP2                   BRANCH IF UNFL. DON'T HURT NUM.  
         CER   F6,F4                   FIND MAX VAL OF ABS REAL(CX())   
         BNL   IMGPRT                  IF BRANCH OCCURS U(F6) IS LARGER 
         LER   F6,F4                   F6 CONTAINS MAX SO FAR.          
IMGPRT   LE    F4,4(R3)                GET AIMAG (CX()).                
         LPER  F4,F4                   COMPUTE ABS(AIMAG(CX())).        
         CE    F4,ALPHA                SET CODES FOR UNDERFLOW.         
         BH    LOOP2                   BRANCH IF UNFL. DON'T HURT NUM.  
         CER   F6,F4                   FIND MAX ABS(REAL),ABS(AIMAG).   
         BNL   UBIG                    IF BRANCH OCCURS U(F6) IS LARGER 
         LER   F6,F4                   F6 CONTAINS MAX SO FAR.          
UBIG     AR    R3,R4                   COMPUTE ADDRESS OF NEXT ELEMENT. 
         BCT   R2,LOOP1                END OF FIRST LOOP                
         CER   F0,F6                   SEE IF MAX. IS ZERO.             
         BE    DONE                    QUIT IF SO.                      
         LE    F2,=E'1.0'                                               
         DER   F2,F6                   COMPUTE SCALE FACTOR FOR UNFL.   
         LR    R2,R5                   RESTORE VALUE OF N AND           
         LR    R3,R6                   BASE ADDRESS OF CX( ).           
         B     LOOP3                                                    
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP2    LE    F4,0(R3)                MAIN LOOP BEGINS HERE.           
         LPER  F4,F4                   COMPUTE ABS(REAL(CX())).         
         CE    F4,GAMMA                CHECK FOR OVERFLOW.              
         BH    OVRFL                   BRANCH TO OTHER LOOP IF OVERFL.  
         MER   F4,F4                   SQUARE VALUE.                    
         LE    F2,4(R3)                                                 
         LPER  F2,F2                   COMPUTE ABS(AIMAG(CX())).        
         CE    F2,GAMMA                CHECK FOR OVERFLOW.              
         BH    OVRFL                                                    
         MER   F2,F2                   SQUARE VALUE.                    
         AER   F0,F2                                                    
         AER   F0,F4                   ACCUMULATE SUM IN F0             
         AR    R3,R4                   GET ADDRESS OF NEXT ELEMENT.     
         BCT   R2,LOOP2                END OF MAIN LOOP.                
         LE    F6,=E'1.0'              FINAL SCALE FACTOR               
         B     CALSQ                   BRANCH AND COMPUTE SQRT( ).      
OVRFL    LE    F2,U2                   LOAD SCALE FACT, ALL COMPONENTS  
         LE    F6,U1                   GET FINAL SCALE FACTOR.          
         MER   F0,F2                   USE TWO MULTIPLIES BY OVERFLOW.  
         MER   F0,F2                   PARAMETER TO SCALE RESULT.       
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP3    LE    F4,0(R3)                CONTINUE ACCUMULATION BY         
         MER   F4,F2                   MULTIPLYING EACH ELEMENT BY THE  
         MER   F4,F4                   SCALE FACTOR AND SCALE RESULT.   
         AER   F0,F4                   CONTINUE ACCUMULATION.           
         LE    F4,4(R3)                                                 
         MER   F4,F2                                                    
         MER   F4,F4                                                    
         AER   F0,F4                                                    
         AR    R3,R4                   GET ADDRESS OF NEXT ELEMENT.     
         BCT   R2,LOOP3                END OF SCALED LOOP.              
CALSQ    STE   F0,VALUE                STORE VALUE FOR BRANCH           
         STE   F6,U                    SAVE FINAL RESCALING VALUE.      
         L     R15,=V(SQRT)            GET ADDRESS OF SQRT              
         CNOP  0,4                                                      
         BAL   R1,SQRTC                                                 
         DC    X'80',AL3(VALUE)                                         
SQRTC    BALR  R14,R15                                                  
         ME    F0,U                    MULTIPLY RESULT BY SCALE FACTOR. 
DONE     EPILOG                                                         
ALPHA    DC    E'1.E-34'                                                
GAMMA    DC    E'1.E+35'                                                
U1       DC    E'1.E+36'                                                
U2       DC    E'1.E-36'                                                
VALUE    DC    E'0'                                                     
U        DS    F                                                        
         END                                                            
*********SUM OF MAGS. OF VECTORS, SNGL PREC., SASUM, IBM/360 ASM.****** 
*        USAGE STATEMENT                                   24 MAY 1974* 
*             SW = SASUM(N,SX,INCX)                        WASH. ST. U* 
*        SW,SASUM,SX( ) REAL *4, N,INCX INTEGER * 4                   * 
*********************************************************************** 
SASUM    PROLOG R4                                                      
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         SER   F0,F0                   SET SASUM = 0.                   
         L     R2,0(R2)                GET N                            
         LTR   R2,R2                   SET COND. CODES                  
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R4,0(R4)                GET INCX                         
         SLA   R4,RSTAR4               COMPUTE INCX*4 AND SET COND.     
         BM    DONE                    EXIT IF INCX .LT. 0              
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F2,0(R3)                GET SX( ) IN F2                  
         LPER  F2,F2                   TAKE ABS. VALUE OF SX( )         
         AER   F0,F2                   ACCUMULATE SUM OF ABS. VALUES    
         AR    R3,R4                   UPDATE SX( ) ADDRESS             
         BCT   2,LOOP                                                   
DONE     EPILOG                                                         
         END                                                            
*********SUM OF MAGS. OF VECTOR, DBLE PREC., DASUM, IBM/360 ASM.******* 
*        USAGE STATEMENT                                   23 MAY 1974* 
*             DW = DASUM(N,DX,INCX)                        WASH. ST. U* 
*        DW,DASUM,DX( ) REAL * 8, N,INCX INTEGER * 4                  * 
*********************************************************************** 
DASUM    PROLOG R4                                                      
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         SDR   F0,F0                   SET DASUM = 0.                   
         L     R2,0(R2)                GET N                            
         LTR   R2,R2                   SET COND. CODES                  
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R4,0(R4)                GET INCX                         
         SLA   R4,RSTAR8               COMPUTE INCX*8 AND SET COMD.     
         BM    DONE                    EXIT IF INCX .LT. 0              
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LD    F2,0(R3)                GET DX( ) IN F2                  
         LPDR  F2,F2                   TAKE ABS. VALUE OF DX( )         
         ADR   F0,F2                   ACCUMULATE SUM OF ABS. VALUES    
         AR    R3,R4                   UPDATE DX( ) ADDRESS             
         BCT   2,LOOP                                                   
DONE     EPILOG                                                         
         END                                                            
*********SUM OF RE. AND IM. MAGS., CMPLX VECTOR, SCASUM, IBM/360 ASM.** 
*        USAGE STATEMENT                                   23 MAY 1974* 
*             SW = SCASUM(N,CX,INCX)                       WASH. ST. U* 
*        SW,SCASUM REAL * 4, CX( ) COMPLEX * 8, (,INCX INTEGER * 4    * 
*********************************************************************** 
SCASUM   PROLOG R4                                                      
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         SER   F0,F0                   SET SCASUM = 0.                  
         L     R2,0(R2)                GET N                            
         LTR   R2,R2                   SET COND. CODES                  
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R4,0(R4)                GET INCX                         
         SLA   R4,CSTAR8               COMPUTE INCX*8 AND SET COND.     
         BM    DONE                    EXIT IF INCX .LT. 0              
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F2,0(R3)                GET RE. AND IM. PARTS            
         LE    F4,4(R3)                OF CX( ) IN F2,F4                
         LPER  F2,F2                   TAKE ABS. VALUES OF              
         LPER  F4,F4                   BOTH PARTS OF CX( )              
         AER   F0,F2                                                    
         AER   F0,F4                   ACCUMULATE SUM OF ABS. VALUES    
         AR    R3,R4                   UPDATE CX( ) ADDRESS             
         BCT   R2,LOOP                                                  
DONE     EPILOG                                                         
         END                                                            
*********SNGL PREC. SCALING, SNGL PREC. VECTOR, SSCAL,  IBM/360 ASM.*** 
*        USAGE STATEMENT                                   22 MAY 1974* 
*             CALL SSCAL  (N,SA,SX,INCX)                   WASH. ST. U* 
*        SA,SX( ) REAL * 4, N,INCX INTEGER * 4                        * 
*********************************************************************** 
SSCAL    PROLOG R5                                                      
         LM    R2,R5,0(R1)             GET POINTERS TO ARGUMENTS        
         L     R2,0(R2)                GET N                            
         LTR   R2,R2                   SET COND. CODES                  
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R5,0(R5)                GET INCX                         
         SLA   R5,RSTAR4               COMPUTE INCX*4 AND SET COND.     
         BM    DONE                    EXIT IF INCX .LT. 0              
         LE    F4,0(R3)                GET SA IN F4                     
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R4)                GET SX( ) IN F0                  
         MER   F0,F4                   COMPUTE SA*SX( )                 
         STE   F0,0(R4)                STORE SA*SX( ) IN SX( )          
         AR    R4,R5                   UPDATE SX( ) ADDRESS             
         BCT   R2,LOOP                                                  
DONE     EPILOG                                                         
         END                                                            
*********DBLE PREC. SCALING, DBLE PREC. VECTOR, DSCAL,  IBM/360 ASM.*** 
*        USAGE STATEMENT                                   21 MAY 1974* 
*             CALL DSCAL  (N,DA,DX,INCX)                   WASH. ST. U* 
*        DA, DX( ) REAL * 8, N,INCX INTEGER * 4                       * 
*********************************************************************** 
DSCAL    PROLOG R5                                                      
         LM    R2,R5,0(R1)             GET POINTERS TO ARGUMENTS        
         L     R2,0(R2)                GET N                            
         LTR   R2,R2                   SET COND. CODES                  
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R5,0(R5)                GET INCX                         
         SLA   R5,RSTAR8               COMPUTE INCX*8 AND SET COND.     
         BM    DONE                    EXIT IF INCX .LT. 0              
         LD    F4,0(R3)                GET DA IN F4                     
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LD    F0,0(R4)                GET DX( ) IN F0                  
         MDR   F0,F4                   COMPUTE DA*DX( )                 
         STD   F0,0(R4)                STORE DA*DX( ) IN DX( )          
         AR    R4,R5                   UPDATE DX( ) ADDRESS             
         BCT   R2,LOOP                                                  
DONE     EPILOG                                                         
         END                                                            
*********COMPLEX SCALING, COMPLEX VECTOR, CSCAL,  IBM/360 ASM.********* 
*        USAGE STATEMENT                                   21 MAY 1974* 
*             CALL CSCAL  (N,CA,CX,INCX)                   WASH. ST. U* 
*        CA,CX( ) COMPLEX * 8, N,INCX INTEGER * 4                     * 
*********************************************************************** 
CSCAL    PROLOG R10                                                     
         LM    R2,R5,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R10,R2,DONE             EXIT IF N .LE. 0                 
         LE    F4,0(R3)                GET RE. PART OF CA IN F4         
         LE    F6,4(R3)                AND IM. PART OF CA IN F6         
         INCFX R4,R5,R10,R9,CSTAR8,LOOP FIX CX( ) INCREMENT             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R4)                GET RE. PART OF CX( ) IN F0      
         LE    F2,4(R4)                GET IM. PART OF CX( ) IN F2      
         MER   F0,F4                                                    
         MER   F2,F6                                                    
         SER   F0,F2                   NOW RE. PART OF CA*CX( ) IN F0   
         LE    F2,0(R4)                GET RE. PART OF CX( ) IN F2      
         STE   F0,0(R4)                STORE RE. PART OF CA*CX( )       
         LE    F0,4(R4)                GET IM. PART OF CX( ) IN F0      
         MER   F0,F4                                                    
         MER   F2,F6                                                    
         AER   F0,F2                   NOW IM. PART OF CA*CX( ) IN F0   
         STE   F0,4(R4)                STORE IM. PART OF CA*CX( )       
         AR    R4,R5                   UPDATE CX( ) ADDRESS             
         BCT   R2,LOOP                                                  
DONE     EPILOG                                                         
         END                                                            
*********REAL SCALING, COMPLEX VECTOR, CSSCAL, IBM/360 ASM.************ 
*        USAGE STATEMENT                                   21 MAY 1974* 
*             CALL CSSCAL (N,SA,CX,INCX)                   WASH. ST. U* 
*        SA REAL * 4, CX( ) COMPLEX * 8, N,INCX INTEGER * 4           * 
*********************************************************************** 
CSSCAL   PROLOG R10                                                     
         LM    R2,R5,0(R1)             GET POINTERS TO ARGUMENTS        
         NCHK  R10,R2,DONE                                              
         LE    F4,0(R3)                GET SA IN F.P.                   
         LER   F6,F4                   REGS. 4,6                        
         INCFX R4,R5,R10,R9,CSTAR8,LOOP FIX CX( ) INCREMENT             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R4)                GET RE. PART OF CX( ) IN F0      
         LE    F2,4(R4)                GET IM. PART OF CX( ) IN F2      
         MER   F0,F4                   SCALE                            
         MER   F2,F6                   COMPONENT                        
         STE   F0,0(R4)                STORE IN                         
         STE   F2,4(R4)                CX( )                            
         AR    R4,R5                   UPDATE CX( ) ADDRESS             
         BCT   R2,LOOP                                                  
DONE     EPILOG                                                         
         END                                                            
*********POINT TO MAX. ABS. VAL., SNGL PREC., ISAMAX, IBM/360 ASM****** 
*        USAGE STATEMENT                                   21 MAY 1974* 
*             IMAX = ISAMAX(N,SX,INCX)                     WASH. ST. U* 
*        IMAX,ISAMAX,N,INCX INTEGER*4,SX( ) REAL*4                    * 
*********************************************************************** 
ISAMAX   PROLOG R5                                                      
         L     R0,=F'0'                NOMINAL 0 IN REG. 0              
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         L     R2,0(R2)                GET N                            
         LTR   R5,R2                   SAVE N AND SET COND. CODES       
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R4,0(R4)                GET INCX                         
         SLA   R4,RSTAR4               COMPUTE INCX*4 AND SET COND.     
         BNP   DONE                    EXIT IF INCX .LE. 0              
         LR    R0,R2                   NOMINAL N IN REG. 0              
         SER   F4,F4                   SET MAX. KEY TO ZERO             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R3)                GET SX( )                        
         LPER  F0,F0                   TAKE ABS. VALUE                  
         CER   F0,F4                   COMPARE WITH CURRENT KEY         
         BNH   INCLOOP                                                  
         LR    R0,R2                   UPDATE POINTER AND               
         LER   F4,F0                   CURRENT KEY                      
INCLOOP  AR    R3,R4                   UPDATE SX( ) ADDRESS             
         BCT   R2,LOOP                                                  
         SR    R0,R5                   COMPUTE                          
         BCTR  R0,0                    CORRECT VALUE                    
         LPR   R0,R0                   OF POINTER                       
DONE     EPILOG (0)                                                     
         END                                                            
*********POINT TO MAX. ABS. VAL., DBLE  PREC., IDAMAX, IBM/360 ASM***** 
*        USAGE STATEMENT                                   21 MAY 1974* 
*             IMAX = IDAMAX(N,DX,INCX)                     WASH. ST. U* 
*        IMAX,IDAMAX,N,INCX INTEGER*4, DX( ) REAL*8                   * 
*********************************************************************** 
IDAMAX   PROLOG R5                                                      
         L     R0,=F'0'                NOMINAL 0 IN REG. 0              
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         L     R2,0(R2)                GET N                            
         LTR   R5,R2                   SAVE N AND SET COND. CODES       
         BNP   DONE                    EXIT IF N .LE. 0                 
         L     R4,0(R4)                GET INCX                         
         SLA   R4,RSTAR8               COMPUTE INCX*8 AND SET COND.     
         BNP   DONE                    EXIT IF INCX .LE. 0              
         LR    R0,R2                   NOMINAL N IN REG. 0              
         SDR   F4,F4                   SET MAX. KEY TO ZERO             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LD    F0,0(R3)                GET DX( )                        
         LPDR  F0,F0                   TAKE ABS. VALUE                  
         CDR   F0,F4                   COMPARE WITH CURRENT KEY         
         BNH   INCLOOP                                                  
         LR    R0,R2                   UPDATE POINTER AND               
         LDR   F4,F0                   CURRENT KEY                      
INCLOOP  AR    R3,R4                   UPDATE DX( ) ADDRESS             
         BCT   R2,LOOP                                                  
         SR    R0,R5                   COMPUTE                          
         BCTR  R0,0                    CORRECT VALUE                    
         LPR   R0,R0                   OF POINTER                       
DONE     EPILOG (0)                                                     
         END                                                            
*********POINT TO MAX. SUM OF ABS. VALS., COMPLEX, ICAMAX, IBM/360 ASM* 
*        USAGE STATEMENT                                  30 NOV. 1974* 
*             IMAX = ICAMAX(N,CX,INCX)                     WASH. ST. U* 
*        IMAX,ICAMAX,N,INCX INTEGER*4, CX( ) COMPLEX*8                * 
*********************************************************************** 
ICAMAX   PROLOG R10                                                     
         LM    R2,R4,0(R1)             GET POINTERS TO ARGUMENTS        
         SR    R0,R0                   NOMINAL 0 IN REG. R0             
         NCHK  R10,R2,DONE                                              
         LR    R5,R2                   SAVE N IN R5                     
         LR    R0,R5                   LOAD STARTING N IN REG. R0       
         SER   F4,F4                   SET MAX. KEY TO ZERO             
         INCFX R3,R4,R10,R9,CSTAR8,LOOP FIX CX( ) INCREMENT             
         CNOP  0,8                     ALIGN ON DOUBLE WORD.            
LOOP     LE    F0,0(R3)                GET REAL PART                    
         LPER  F0,F0                   TAKE ABS. VALUE                  
         LE    F2,4(R3)                GET IMAG. PART                   
         LPER  F2,F2                   TAKE ABS. VALUE                  
         AER   F0,F2                   ADD MAGNITUDES                   
         CER   F0,F4                   COMPARE WITH CURRENT KEY         
         BNH   INCLOOP                                                  
         LR    R0,R2                   UPDATE POINTER AND               
         LER   F4,F0                   CURRENT KEY                      
INCLOOP  AR    R3,R4                   UPDATE CX( ) ADDRESS             
         BCT   R2,LOOP                                                  
         SR    R0,R5                   COMPUTE (N-ICAMAX( )+1)-N        
         BCTR  R0,0                    CORRECT VALUE (-ICAMAX( ) )      
         LPR   R0,R0                   OF POINTER (ICAMAX( ) )          
DONE     EPILOG (0)                                                     
         END                                                            
*DECK,SYSTXT                                                            
          IDENT  SYSTEXT                                                
 SYSTEXT  TITLE  BLA LIBRARY SYSTEMS TEXT                               
          STEXT                                                         
 INFTN    SPACE  2,10                                                   
**        INFTN  NAME,NUM      PARAMETER CONVERSION                     
*                              FOR NON-RUN COMPILER                     
*         ENTRY:                                                        
*                NAME  =  ENTRY/EXIT NAME                               
*                NUM   =  NUMBER OF PARAMETERS                          
*                                                                       
*                *F = 0   -  COMPASS                                    
*                   = 1   -  RUN/MNF                                    
*                   = 2   -  FTN                                        
*                                                                       
 INFTN    MACRO  NAME,NUM      SET UP FOR NON-RUN COMPILER              
          LOCAL  M,RETURN                                               
 .1       IFEQ   *F,2                                                   
 .2       IFNE   NUM,0                                                  
 I        DECMIC 0                                                      
 M        MIN    6,NUM                                                  
 .D       DUP    M                                                      
 I        DECMIC 'I'+1                                                  
          SB'I'  X1                                                     
          SA1    A1+1                                                   
 .D       ENDD                                                          
 .2       IFGE   NUM,7                                                  
 .D       DUP    NUM-6                                                  
 I        DECMIC 'I'+1                                                  
          BX6    X1                                                     
          SA6    NAME-NUM-2+'I'                                         
 .D       ENDD                                                          
 .2       ENDIF                                                         
          SX6    A0                                                     
          SA6    SETA0                                                  
          EQ     RETURN                                                 
 SETA0    BSS    1                                                      
 RETURN   BSS    0                                                      
 .1       ENDIF                                                         
 INFTN    ENDM                                                          
 OUTFTN   SPACE  2,10                                                   
**        OUTFTN NAME          EXIT FOR NON-RUN COMPILER                
*                                                                       
*         ENTRY:                                                        
*                NAME  =  ENTRY/EXIT NAME                               
*                                                                       
 OUTFTN   MACRO  NAME          EXIT FOR NON RUN COMPILER                
 .1       IFEQ   *F,2                                                   
          SA1    SETA0                                                  
          SA0    X1                                                     
 .1       ENDIF                                                         
          EQ     NAME                                                   
 OUTFTN   ENDM                                                          
CALL      SPACE    2,10                                                 
**        CALL     SUBR,(ARG,...,ARG)  STANDARD RUN/FTN SUBROUTINE CALL.
*                                                                       
*         ENTRY:   *F = 2, GENERATE FTN CALLING SEQUENCE.               
*                     ' 2, GENERATE RUN CALLING SEQUENCE.               
*                  SUBR = NAME OF THE SUBROUTINE.                       
*                  ARG = (OPTIONAL), ADDRESS OF ARGUMENT TO BE PASSED.  
*                        <CONSTANT>, THE ADDRESS OF THE LITERAL VALUE   
*                        <CONSTANT> IS PASSED.                          
*                      = (OMITTED), IF *F' 2 IRUN  THE CORRESPONDING B  
*                        REGISTER OR ARGUMENT ADDRESS LOCATION IS NOT   
*                        SET AND IS ASSUMED TO BE PRESET BY THE USER.   
*                      = (OMITTED), IF *F = 2 IFTN  THE CORRESPONDING   
*                        ARGUMENT ADDRESS LOCATION IS SET TO:           
*                                  42/0LNULL,18/*+400000B.              
* RUN     USES:    X - 1,6,7.      (IF MORE THAN 6 ARGUMENTS SPECIFIED) 
*                  B - 1,..,N.     (IF N ARGUMENTS SPECIFIED AND N @ 7) 
*                  B - ALL.        (IF MORE THAN 6 ARGUMENTS SPECIFIED) 
*                  A - 1,6,7.      (IF MORE THAN 6 ARGUMENTS SPECIFIED) 
* FTN     USES:    X - 1.                                               
*                  X - 1,6,7.      (IF AN ARGUMENT EXPRESSION CONTAINS  
*                                   A REGISTER)                         
*                  B - NONE.                                            
*                  A - 0,1.                                             
*                  A - 0,1,6,7.    (IF AN ARGUMENT EXPRESSION CONTAINS  
*                                   A REGISTER)                         
*         CALLS:   SUBR.                                                
*         NOTE:    TRACE BACK INFORMATION IS NOT DEFINED UNLESS THE     
*                  MICRO 'ENTRY' IS DEFINED. THE MICRO 'ENTRY' IS       
*                  DEFINED WITHIN THE BEGIN MACRO. IF NO ARGUMENTS ARE  
*                  SPECIFIED THEN THE COMMA AND PARENTHESES MAY BE      
*                  OMITTED. BOTH RUN AND FTN STYLE SUBROUTINES DO NOT   
*                  PRESERVE REGISTER CONTENTS, EXCEPT FTN SYTLE         
*                  SUBROUTINES PRESERVE REGISTER A0. IN THE FTN CALLING 
*                  SEQUENCE THE CONTENTS OF THE CALLER/S REGISTER A1 IS 
*                  PRESERVED BY ENTERING IT INTO REGISTER A0 BEFORE THE 
*                  SUBROUTINE IS ENTERED AND RESETTING REGISTER A1 TO   
*                  THE PRESERVED REGISTER A0 ON RETURN FROM THE         
*                  SUBROUTINE.                                          
*                                                                       
CALL      MACRO    SUBR,ARGS                                            
.1        IFEQ     *F,2                                                 
          FTN=1    SUBR,(ARGS)                                          
.1        ELSE                                                          
          RUN=1    SUBR,(ARGS)                                          
.1        ENDIF                                                         
CALL      ENDM                                                          
FTN=1     SPACE    2,10                                                 
**        FTN=1    SUBR,ARGS       PROCESS FTN FORTRAN ARGUMENTS.       
*                                                                       
*         ENTRY:   SUBR = SUBROUTINE NAME.                              
*                  ARGS = ARGUMENT LIST.                                
*                                                                       
FTN=1     MACRO    SUBR,ARGS                                            
          LOCAL    E,I,J,P,ARGLIST                                      
I         DECMIC   0                                                    
          SA0      A1                                                   
.1        IFC      NE,$ARGS$$                                           
J         DECMIC   6                                                    
          USE      FTN.ARG                                              
ARGLIST   BSS      0                                                    
          IRP      ARGS                                                 
I         DECMIC   'I'+1                                                
P         ARG=2    (ARGS)                                               
.2        IF       -REG,'P'                                             
          IFC      EQ,$'P'$$,1                                          
P         MICRO    1,,$0LNULL+*+400000B$                                
          CON      'P'                                                  
.2        ELSE                                                          
          BSS      1                                                    
          USE      *                                                    
          R=       X'J','P'                                             
          SA'J'    ARGLIST+'I'-1                                        
          USE      FTN.ARG                                              
J         DECMIC   13D-'J'                                              
.2        ENDIF                                                         
          IRP                                                           
          CON      0                                                    
          USE      *                                                    
          SA1      ARGLIST                                              
.1        ENDIF                                                         
.1        IF       -MIC,ENTRY                                           
E         MICRO    1,,$0$                                               
.1        ELSE                                                          
E         MICRO    1,,$'ENTRY'-2$                                       
.1        ENDIF                                                         
+         RJ       =X#SUBR                                              
-         VFD      12/0,18/'E'                                          
          SA1      A0                                                   
FTN=1     ENDM                                                          
RUN=1     SPACE    2,10                                                 
**        RUN=1    SUBR,ARGS       PROCESS RUN FORTRAN ARGUMENTS.       
*                                                                       
*         ENTRY:   SUBR = NAME OF THE SUBROUTINE.                       
*                  ARGS = LIST OF ARGUMENTS.                            
*                                                                       
RUN=1     MACRO    SUBR,ARGS                                            
          LOCAL    E,I,J,P                                              
I         MICRO    1,,$0$                                               
.1        IFC      NE,$ARGS$$                                           
          IRP      ARGS                                                 
I         DECMIC   'I'+1                                                
P         ARG=2    (ARGS)                                               
.2        IFLE     'I',6                                                
          IFC      NE,$'P'$B'I'$,2                                      
          IFC      NE,$'P'$$,1                                          
          SB'I'    'P'                                                  
.2        ELSE                                                          
.3        IFEQ     'I',7                                                
          SA1      =X#SUBR-1                                            
          SB7      X1-6                                                 
          SB7      A1-B7                                                
.4        IFC      NE,$'P'$$                                            
.4        IFC      NE,$'P'$X6$                                          
          SX6      'P'                                                  
          SA6      B7                                                   
.4        ENDIF                                                         
J         DECMIC   6                                                    
.3        ELSE                                                          
.4        IFC      EQ,$'P'$$                                            
          SB7      B7+1                                                 
.4        ELSE                                                          
J         DECMIC   13D-'J'                                              
          SX'J'    'P'                                                  
          SA'J'    B7+1                                                 
          SB7      A'J'                                                 
.4        ENDIF                                                         
.3        ENDIF                                                         
.2        ENDIF                                                         
          IRP                                                           
.1        ENDIF                                                         
.1        IF       -MIC,ENTRY                                           
E         MICRO    1,,$0$                                               
.1        ELSE                                                          
E         MICRO    1,,$'ENTRY'-1$                                       
.1        ENDIF                                                         
+         RJ       =X#SUBR                                              
-         VFD      6/7,6/'I'D,18/'E'                                    
RUN=1     ENDM                                                          
ARG=2     SPACE    2,10                                                 
** MIC    ARG=2    ARG1            PROCESS CALL MACRO ARGUMENT.         
*                                                                       
*         ENTRY:   MIC = NAME OF THE MICRO TO BE SET TO THE ARGUMENT    
*                        STRING ADJUSTED FOR LITERAL VALUES.            
*                  ARG1 = ARGUMENT STRING.                              
*                                                                       
          MACRO    ARG=2,MIC,ARG1                                       
          LOCAL    C                                                    
C         MICRO    1,1,$ARG1$                                           
.1        IFC      NE,$'C'$=$                                           
.1        IFC      GE,$'C'$0$                                           
.2        IFC      LT,$'C'$+$                                           
MIC       MICRO    1,,$=ARG1$                                           
.2        ELSE                                                          
.1        IFC      LT,$'C'$*$                                           
C         MICRO    2,,$ARG1$                                            
C         ARG=2    'C'                                                  
C         MICRO    1,1,$'C'$                                            
.1        IFC      EQ,$'C'$=$                                           
MIC       MICRO    1,,$=ARG1$                                           
.1        ELSE                                                          
MIC       MICRO    1,,$ARG1$                                            
.2        ENDIF                                                         
.1        ENDIF                                                         
ARG=2     ENDM                                                          
          END                                                           
*DECK,SDOT                                                              
          IDENT  SDOT                                                   
*                                                                       
***       REAL FUNCTION  SDOT(N,SX,INCX,SY,INCY)                        
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  SXII *SYII                  
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  SDOT  IN          SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  CLEVE B. MOLER                                    
*                     UNIVERSITY OF NEW MEXICO                          
*                     ALBUQUERQUE, NEW MEXICO                           
C                                                                       
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SDOT                                                   
          VFD    42/4HSDOT,18/5                                         
*                                                                       
 SDOT     DATA   0                                                      
          INFTN  SDOT,5      PROPER LINKAGE (RUN,FTN) MACRO.            
*                                                                       
          MX6    0           (X6)=SDOT=0.                               
          SA1    B1          (X1)=N                                     
          SB7    1           (B7)=1                                     
*                                                                       
          SB1    X1          (B1)=N                                     
          SB1    B1-B7       (B1)=N-1                                   
          MI     B1,OUT      IF (N .LE. 0), QUIT                        
*                                                                       
          SA1    B2          (X1)=SX(1)                                 
          SA3    B3          (X3)=INCX                                  
*                                                                       
          SA2    B4          (X2)=SY(1)                                 
          SA4    B5          (X4)=INCY                                  
*                                                                       
          NZ     B1,NGT1     IF (N .GT. 1), LOOP NEEDED                 
          RX6    X1*X2       (X6)=SX(1)*SY(1)                           
          NX6    X6          (X7)=NORM.(X6)                             
          JP     OUT                                                    
 NGT1     SX0    -B1         (X0)=-(N-1)                                
*                                                                       
          SB3    X3          (B3)=INCX                                  
          SB4    X4          (B4)=INCY                                  
*                                                                       
          GE     B3,INCXNN   IF (INCX .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX3    X0*X3       (X3)=-(N-1)*INCX                           
          SB7    A1          (B7)=LOC(SX(1))                            
          SA1    B7+X3       (X1)=SX(1+(1-N)*INCX). (A1)=LOC(X(1))      
*                                                                       
 INCXNN   SA3    A1+B3       (X3)=SX(2)                                 
          GE     B4,INCYNN   IF (INCY .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX4    X0*X4       (X4)=-(N-1)*INCY                           
          SB7    A2          (B7)=LOC(SY(1))                            
          SA2    B7+X4       (X2)=SY(1+(1-N)*INCY). (A2)=LOC(Y(1))      
 INCYNN   SA4    A2+B4       (X4)=SY(2)                                 
          SB5    1           (B5)=I=1                                   
          SB6    4           (B6)=4                                     
          SB1    B1-B6       (B1)=N-5                                   
*                                                                       
          MX0    0           (X0)=0.                                    
          MX5    0           (X5)=0.                                    
          MX7    0           (X7)=0.                                    
          GT     B5,B1,CLEAN IF (I .GT. N-5) CLEAN-UP LOGIC             
 LOOP     RX6    X1*X2       (X6)=SX(I)*SY(I)                           
          SA1    A3+B3       (X1)=SX(I+2)                               
          SA2    A4+B4       (X2)=SY(I+2)                               
          NX5    X5          (X5)=NORM.(X5)                             
          RX0    X0+X7       (X0)=SUM1=SUM1+SX(I-1)*SY(I-1)             
*                                                                       
          RX7    X3*X4       (X7)=SX(I+1)*SY(I+1)                       
          SA3    A1+B3       (X3)=SX(I+3)                               
          SA4    A2+B4       (X4)=SX(I+3)                               
          NX0    X0          (X0)=NORM.(X0)                             
          RX5    X5+X6       (X5)=SUM2=SUM2+SX(I)*SY(I)                 
*                                                                       
          SB5    B5+B6       (B5)=I=I+4. INCREMENT I.                   
          RX6    X1*X2       (X6)=SX(I-2)*SY(I-2)                       
          SA1    A3+B3       (X1)=SX(I)                                 
          SA2    A4+B4       (X2)=SY(I)                                 
          NX5    X5          (X5)=NORM.(X5)                             
          RX0    X0+X7       (X0)=SUM1+SX(I-3)*SY(I-3)                  
*                                                                       
          RX7    X3*X4       (X7)=SX(I-1)*SY(I-1)                       
          SA3    A1+B3       (X3)=SX(I+1)                               
          SA4    A2+B4       (S4)=SY(I+1)                               
          NX0    X0          (X0)=NORM.(X0)                             
          RX5    X5+X6       (X5)=SUM2=SUM2+SX(I-2)*SY(I-2)             
*                                                                       
          LE     B5,B1,LOOP  IF (I .LE. N-5) CONTINUE LOOP              
 CLEAN    SB6    2           (B6)=2                                     
          SB1    B1+B6       (B1)=N-3                                   
          GT     B5,B1,SWAB  IF (I .GT. N-3) 3 OR LESS COMPS. REMAIN    
          RX6    X1*X2       (X6)=SX(I)*SY(I)                           
          SA1    A3+B3       (X1)=SX(I+2)                               
          SA2    A4+B4       (X2)=SY(I+2)                               
          NX5    X5          (X5)=NORM.(X5)                             
          RX0    X0+X7       (X0)=SUM1=SUM1+SX(I-1)*SY(I-1)             
*                                                                       
          RX7    X3*X4       (X7)=SX(I+1)*SY(I+1)                       
          SA3    A1+B3       (X3)=SX(I+3)                               
          SA4    A2+B4       (X4)=SY(I+3)                               
          RX5    X5+X6       (X5)=SUM2=SUM2+SX(I)*SY(I)                 
          NX0    X0          (X0)=NORM.(X0)                             
*                                                                       
          SB5    B5+B6       (B5)=I=I+2. INCREMENT I                    
 SWAB     SB1    B1+B6       (B1)=N-1                                   
          GT     B5,B1,MOP   IF (I .GT. N-1) AT MOST 1 COMP. REMAINS    
          RX6    X1*X2       (X6)=SX(I)*SY(I)                           
          NX5    X5          (X5)=NORM.(X5)                             
          RX0    X0+X7       (X0)=SUM1=SUM1+SX(I-1)*SY(I-1)             
*                                                                       
          RX7    X3*X4       (X7)=SX(I+1)*SY(I+1)                       
          RX5    X5+X6       (X5)=SUM2=SUM2+SX(I)*SY(I)                 
          NX0    X0          (X0)=NORM.(X0)                             
          SB5    B5+B6       (B5)=I=I+2. INCREMENT I.                   
*                                                                       
 MOP      SB1    B1+B6       (B1)=N+1                                   
          GE     B5,B1,WIPE  IF (I .GT. N) PUT ODD-EVEN PARTS TOGETHER  
          SA1    A3+B3       (X1)=SX(N)                                 
          SA2    A4+B4       (X2)=SY(N)                                 
          RX6    X1*X2       (X6)=SX(N)*SY(N)                           
          NX5    X5          (X5)=NORM.(X5)                             
          RX5    X5+X6       (X5)=SUM2=SUM2+SX(N)*SY(N)                 
 WIPE     RX0    X0+X7       SUM EVEN INDEXED PRODUCTS.                 
          RX6    X0+X5       (X6)=SUM(SX(I)*SY(I))                      
          NX6    X6          (X6)=NORM.(X6)                             
 OUT      OUTFTN SDOT        RETURN                                     
*         END    SDOT                                                   
          END                                                           
*DECK,DSDOT                                                             
          IDENT  DSDOT                                                  
*                                                                       
***       DOUBLE FUNCTION  DSDOT(N,SX,INCX,SY,INCY)                     
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  SXII *SYII                  
*                                                                       
*         SXII  = SX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = SX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  DSDOT  IN         DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DSDOT                                                  
          VFD    42/5HDSDOT,18/5                                        
*                                                                       
 DSDOT    DATA   0               ENTRY/EXIT                             
          INFTN  DSDOT,5                                                
          SA1    B1              (X1) = N                               
          SB7    -1              (B7) = -1                              
          MX6    0                                                      
          SB1    X1+B7           (B1) = N-1                             
          MX7    0               (X6,X7) = 0                            
*                                                                       
          SA3    B3              (X3) = INCX                            
          NG     B1,OUT          IF N .LE. 0 , GO TO OUT                
          SA5    B5              (X5) = INCY                            
          SX1    -B1             (X1) = -(N-1)                          
          SB3    X3              (B3) = INCX                            
          SB5    X5              (B5) = INCY                            
*                                                                       
          GT     B3,ONE          IF INCX .GT. 0 , GO TO ONE             
          DX3    X1*X3           LOC(SXI1 ) = LOC(SX) - (N-1)*INCX      
          SB2    X3+B2           (B2) = LOC(SXI1 )                      
*                                                                       
 ONE      GT     B5,TWO          IF INCY .GT. 0 , GO TO TWO             
          DX5    X1*X5           LOC(SYI1 ) = LOC(SY) - (N-1)*INCY      
          SB4    X5+B4           (B4) = LOC(SYI1 )                      
*                                                                       
*                                (I=1)                                  
 TWO      SA1    B2              (X1) = SXI1                            
          SA3    B4              (X3) = SYI1                            
*                                                                       
          FX0    X1*X3           (X0,X2) = SXI1 *SYI1                   
          DX2    X1*X3                                                  
*                                                                       
          ZR     B1,EXIT         IF I .EQ. N , GO TO EXIT               
*                                                                       
*                                (I = I+1)                              
 LOOP     SA1    A1+B3           (X1) = SXII                            
          SA3    A3+B5           (X3) = SYII                            
*                                                                       
          FX4    X6+X0           (X6,X7) = (X6,X7) + (X0,X2)            
          DX5    X6+X0                                                  
          FX0    X7+X2                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          FX0    X1*X3                                                  
          SB1    B1+B7           COUNT TERM                             
          DX2    X1*X3           (X0,X2) = SXII *SYII                   
*                                                                       
          NZ     B1,LOOP         IF I .NE. N , GO TO LOOP               
*                                                                       
*                                (I=N)                                  
 EXIT     FX4    X6+X0           (X6,X7) = (X6,X7) + (X0,X2)            
          DX5    X6+X0                                                  
          FX0    X7+X2                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
 OUT      OUTFTN DSDOT           RETURN                                 
          END                                                           
*DECK,SDSDOT                                                            
          IDENT  SDSDOT                                                 
*                                                                       
***       REAL FUNCTION  SDSDOT(N,SB,SX,INCX,SY,INCY)                   
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  SXII *SYII                  
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  SDSDOT IN         SINGLE PRECISION (ROUNDED)          
*                                                                       
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SDSDOT                                                 
          VFD    42/6HSDSDOT,18/6                                       
*                                                                       
 SDSDOT   DATA   0               ENTRY/EXIT                             
          INFTN  SDSDOT,6                                               
*                                                                       
          SX6    B2                                                     
          SA6    ADRSB         SAVE ADDRESS OF SB                       
*                                                                       
          CALL   DSDOT,(B1,B3,B4,B5,B6)                                 
*                                                                       
          SA4    ADRSB         (X4) = SB                                
          SA4    X4                                                     
          FX1    X4+X6                                                  
          DX2    X4+X6                                                  
          FX3    X2+X7                                                  
          FX2    X1+X3                                                  
          NX0    X2                                                     
          DX3    X1+X3                                                  
          NX1    X3                                                     
          FX2    X0+X1                                                  
          DX3    X0+X1                                                  
          RX2    X2+X3                                                  
          NX6    X2                                                     
*                                                                       
 OUT      OUTFTN SDSDOT          RETURN                                 
*                                                                       
 ADRSB    BSS    1             ADDRESS OF SB                            
*                                                                       
          END                                                           
*DECK,DDOT                                                              
          IDENT  DDOT                                                   
*                                                                       
***       DOUBLE FUNCTION  DDOT(N,DX,INCX,DY,INCY)                      
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  DXII *DYII                  
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR  DYII                                 
*                                                                       
*         DX( ),DY( )               DOUBLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  DDOT  IN          DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DDOT                                                   
          VFD    42/4HDDOT,18/5                                         
*                                                                       
 DDOT     DATA   0             ENTRY/EXIT                               
          INFTN  DDOT,5                                                 
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
          MX7    0             (X6,X7) = 0                              
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(DYI1 ) = LOC(DY) - (N-1)*INCY        
          SB4    X5+B4         (B4) = LOC(DYI1 )                        
*                                                                       
*                              (I=1)                                    
 TWO      SA1    B2                                                     
          SA3    B4                                                     
          SA2    B2-B7         (X1,X2) = DXI1                           
          SA4    B4-B7         (X3,X4) = DYI1                           
*                                                                       
          FX5    X2*X3         (X0,X2) = DXI1 *DYI1                     
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          ZR     B1,EXIT       IF I .EQ. N , GO TO EXIT                 
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    A1+B3                                                  
          SA3    A3+B5                                                  
*                                                                       
          FX4    X6+X0         (X6,X7) = (X6,X7) + (X0,X2)              
          DX5    X6+X0                                                  
          FX0    X7+X2                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SB1    B1+B7         COUNT TERM                               
          SA2    A1-B7         (X1,X2) = DXII                           
          SA4    A3-B7         (X3,X4) = DYII                           
*                                                                       
          FX5    X2*X3         (X0,X2) = DXII *DYII                     
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
*                              (I=N)                                    
 EXIT     FX4    X6+X0         (X6,X7) = (X6,X7) + (X0,X2)              
          DX5    X6+X0                                                  
          FX0    X7+X2                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
 OUT      OUTFTN DDOT          RETURN                                   
          END                                                           
*DECK,DQDOTI                                                            
          IDENT  DQDOTI                                                 
          ENTRY  DQDOTI                                                 
 ARG7     BSS    1                                                      
          VFD    42/6HDQDOTI,18/7                                       
 DQDOTI   DATA   0                                                      
          EQ     DQDOTI                                                 
          END                                                           
*DECK,DQDOTA                                                            
          IDENT  DQDOTA                                                 
          ENTRY  DQDOTA                                                 
 ARG7     BSS    1                                                      
          VFD    42/6HDQDOTA,18/7                                       
 DQDOTA   DATA   0                                                      
          EQ     DQDOTA                                                 
          END                                                           
*DECK,CDOTC                                                             
          IDENT  CDOTC                                                  
*                                                                       
***       COMPLEX FUNCTION  CDOTC(N,CX,INCX,CY,INCY)                    
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  CONJ(CXII )*CYII            
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR  CYII                                 
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  CDOTC IN          COMPLEX TYPE                        
*                                                                       
*         ROUNDED ARITHMETRIC INSTRUCTIONS ARE USED                     
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CDOTC                                                  
          VFD    42/5HCDOTC,18/5                                        
*                                                                       
 CDOTC    DATA   0             ENTRY/EXIT                               
          INFTN  CDOTC,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
          MX7    0             (X6,X7) = 0                              
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(CYI1 ) = LOC(CY) - (N-1)*INCY        
          SB4    X5+B4         (B4) = LOC(CYI1 )                        
*                                                                       
*                              (I=1)                                    
 TWO      SA1    B2            (X1) = REAL(CXI1 )                       
          SA2    B4            (X2) = REAL(CYI1 )                       
*                                                                       
          RX0    X1*X2         (X0) = REAL(CXI1 )*REAL(CYI1 )           
*                                                                       
          RX5    X6+X0         (X6) = (X6) + (X0)                       
          NX6    X5                                                     
*                                                                       
          SA4    A2-B7         (X4) = IMAG(CYI1 )                       
*                                                                       
          RX0    X1*X4         (X0) = REAL(CXI1 )*IMAG(CYI1 )           
*                                                                       
          RX5    X7+X0         (X7) = (X7) + (X0)                       
          NX7    X5                                                     
*                                                                       
          SA3    A1-B7         (X3) = IMAG(CXI1 )                       
*                                                                       
          RX0    X3*X4         (X0) = IMAG(CXI1 )*IMAG(CYI1 )           
*                                                                       
          RX5    X6+X0         (X6) = (X6) + (X0)                       
          NX6    X5                 = REAL(CONJ(CXI1 )*CYI1 )           
*                                                                       
          RX0    X3*X2         (X0) = IMAG(CXI1 )*REAL(CYI1 )           
*                                                                       
          RX5    X7-X0         (X7) = (X7) - (X0)                       
          NX7    X5                 = IMAG(CONJ(CXI1 )*CYI1 )           
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    A1+B3         (X1) = REAL(CXII )                       
          SA2    A2+B5         (X2) = REAL(CYII )                       
*                                                                       
          RX0    X1*X2         (X0) = REAL(CXII )*REAL(CYII )           
*                                                                       
          RX5    X6+X0         (X6) = (X6) + (X0)                       
          NX6    X5                                                     
*                                                                       
          SA4    A2-B7         (X4) = IMAG(CYII )                       
*                                                                       
          RX0    X1*X4         (X0) = REAL(CXII )*IMAG(CYII )           
*                                                                       
          RX5    X7+X0         (X7) = (X7) + (X0)                       
          NX7    X5                                                     
*                                                                       
          SA3    A1-B7         (X3) = IMAG(CXII )                       
*                                                                       
          RX0    X3*X4         (X0) = IMAG(CXII )*IMAG(CYII )           
*                                                                       
          RX5    X6+X0         (X6) = (X6) + (X0)                       
          NX6    X5                 = REAL(CONJ(CXII )*CYII )           
*                                                                       
          RX0    X3*X2         (X0) = IMAG(CXII )*REAL(CYII )           
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          RX5    X7-X0         (X7) = (X7) - (X0)                       
          NX7    X5                 = IMAG(CONJ(CXII )*CYII )           
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CDOTC         RETURN                                   
          END                                                           
*DECK,CDOTU                                                             
          IDENT  CDOTU                                                  
*                                                                       
***       COMPLEX FUNCTION  CDOTU(N,CX,INCX,CY,INCY)                    
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  CXII *CYII                  
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR  CYII                                 
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  CDOTU  IN         COMPLEX TYPE                        
*                                                                       
*         ROUNDED ARITHMETRIC INSTRUCTIONS ARE USED                     
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       15 OCT 1974                                                   
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CDOTU                                                  
          VFD    42/5HCDOTU,18/5                                        
*                                                                       
 CDOTU    DATA   0             ENTRY/EXIT                               
          INFTN  CDOTU,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
          MX7    0             (X6,X7) = 0                              
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(CYI1 ) = LOC(CY) - (N-1)*INCY        
          SB4    X5+B4         (B4) = LOC(CYI1 )                        
*                                                                       
*                              (I=1)                                    
 TWO      SA1    B2            (X1) = REAL(CXI1 )                       
          SA2    B4            (X2) = REAL(CYI1 )                       
*                                                                       
          RX0    X1*X2         (X0) = REAL(CXI1 )*REAL(CYI1 )           
*                                                                       
          RX5    X6+X0         (X6) = (X6) + (X0)                       
          NX6    X5                                                     
*                                                                       
          SA4    A2-B7         (X4) = IMAG(CYI1 )                       
*                                                                       
          RX0    X1*X4         (X0) = REAL(CXI1 )*IMAG(CYI1 )           
*                                                                       
          RX5    X7+X0         (X7) = (X7) + (X0)                       
          NX7    X5                                                     
*                                                                       
          SA3    A1-B7         (X3) = IMAG(CXI1 )                       
*                                                                       
          RX0    X3*X4         (X0) = IMAG(CXI1 )*IMAG(CYI1 )           
*                                                                       
          RX5    X6-X0         (X6) = (X6) - (X0)                       
          NX6    X5                 = REAL(CXI1 *CYI1 )                 
*                                                                       
          RX0    X3*X2         (X0) = IMAG(CXI1 )*REAL(CYI1 )           
*                                                                       
          RX5    X7+X0         (X7) = (X7) + (X0)                       
          NX7    X5                 = IMAG(CXI1 *CYI1 )                 
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    A1+B3         (X1) = REAL(CXII )                       
          SA2    A2+B5         (X2) = REAL(CYII )                       
*                                                                       
          RX0    X1*X2         (X0) = REAL(CXII )*REAL(CYII )           
*                                                                       
          RX5    X6+X0         (X6) = (X6) + (X0)                       
          NX6    X5                                                     
*                                                                       
          SA4    A2-B7         (X4) = IMAG(CYII )                       
*                                                                       
          RX0    X1*X4         (X0) = REAL(CXII )*IMAG(CYII )           
*                                                                       
          RX5    X7+X0         (X7) = (X7) + (X0)                       
          NX7    X5                                                     
*                                                                       
          SA3    A1-B7         (X3) = IMAG(CXII )                       
*                                                                       
          RX0    X3*X4         (X0) = IMAG(CXII )*IMAG(CYII )           
*                                                                       
          RX5    X6-X0         (X6) = (X6) - (X0)                       
          NX6    X5                 = REAL(CXII *CYII )                 
*                                                                       
          RX0    X3*X2         (X0) = IMAG(CXII )*REAL(CYII )           
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          RX5    X7+X0         (X7) = (X7) + (X0)                       
          NX7    X5                 = IMAG(CXII *CYII )                 
*                                                                       
          NZ     B1,LOOP       IF I .NE. 0 , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CDOTU         RETURN                                   
          END                                                           
*DECK,CZDOTC                                                            
          IDENT  CZDOTC                                                 
*                                                                       
***       COMPLEX FUNCTION  CZDOTC(N,CX,INCX,CY,INCY)                   
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  CONJ(CXII )*CYII            
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR  CYII                                 
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  CZDOTC IN         COMPLEX TYPE  (ROUNDED)             
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CZDOTC                                                 
          VFD    42/6HCZDOTC,18/6                                       
*                                                                       
 CZDOTC   DATA   0             ENTRY/EXIT                               
          INFTN  CZDOTC,6                                               
          SA1    B1            (X1) = N                                 
          MX4    0                                                      
          SB7    -1            (B7) = -1                                
          SB1    X1            (B1) = N    (I=0)                        
          MX5    0                                                      
          SB6    X1+B7         (B6) = N-1                               
          BX6    X4                                                     
          BX7    X5            (X7,X5) = (X6,X4) = (0,0)                
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B6,OUT        IF N .LE. 0 , GO TO OUT                  
          SA2    B5            (X2) = INCY                              
          SX1    -B6           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCY                            
          IX2    X2+X2         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X2            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B5,LOOP       IF INCY .GT. 0 , GO TO LOOP              
          DX2    X1*X2         LOC(CYI1 ) = LOC(CY) - (N-1)*INCY        
          SB4    X2+B4         (B4) = LOC(CXI1 )                        
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    B2            (X1) = REAL(CXII )                       
          SB2    B2+B3                                                  
          SA2    B4            (X2) = REAL(CYII )                       
          SB4    B4+B5                                                  
*                                                                       
          FX0    X1*X2         (X0,X1) = REAL(CXII )*REAL(CYII )        
          DX1    X1*X2                                                  
*                                                                       
          FX2    X6+X0         (X6,X4) = (X6,X4) + (X0,X1)              
          DX3    X6+X0                                                  
          FX0    X4+X1                                                  
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX6    X2+X3                                                  
          DX4    X2+X3                                                  
*                                                                       
          SA1    A1-B7         (X1) = IMAG(CXII )                       
          SA2    A2-B7         (X2) = IMAG(CYII )                       
*                                                                       
          FX0    X1*X2         (X0,X1) = IMAG(CXII )*IMAG(CYII )        
          DX1    X1*X2                                                  
*                                                                       
          FX2    X6+X0         (X6,X4) = (X6,X4) + (X0,X1)              
          DX3    X6+X0                                                  
          FX0    X4+X1                 = REAL(CONJ(CXII )*CYII )        
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX6    X2+X3                                                  
          DX4    X2+X3                                                  
*                                                                       
          SA1    A1            (X1) = IMAG(CXII )                       
          SA2    A2+B7         (X2) = REAL(CYII )                       
*                                                                       
          FX0    X1*X2         (X0,X1) = IMAG(CXII )*REAL(CYII )        
          DX1    X1*X2                                                  
*                                                                       
          FX2    X7-X0         (X7,X5) = (X7,X5) - (X0,X1)              
          DX3    X7-X0                                                  
          FX0    X5-X1                                                  
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX7    X2+X3                                                  
          DX5    X2+X3                                                  
*                                                                       
          SA1    A1+B7         (X1) = REAL(CXII )                       
          SA2    A2-B7         (X2) = IMAG(CYII )                       
*                                                                       
          FX0    X1*X2         (X0,X1) = REAL(CXII )*IMAG(CYII )        
          DX1    X1*X2                                                  
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          FX2    X7+X0         (X7,X5) = (X7,X5) + (X0,X1)              
          DX3    X7+X0                                                  
          FX0    X5+X1                 = IMAG(CONJ(CXII )*CYII )        
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX7    X2+X3                                                  
          DX5    X2+X3                                                  
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
          RX0    X6+X4         ROUNDED FINAL RESULT                     
          RX1    X7+X5                                                  
          NX6    X0                                                     
          NX7    X1                                                     
*                                                                       
 OUT      OUTFTN CZDOTC        RETURN                                   
          END                                                           
*DECK,CZDOTU                                                            
          IDENT  CZDOTU                                                 
*                                                                       
***       COMPLEX FUNCTION  CZDOTU(N,CX,INCX,CY,INCY)                   
*                                                                       
*         COMPUTED AS SUM FROM I=1 TO N OF  CXII *CYII                  
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR  CYII                                 
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  CZDOTU  IN        COMPLEX TYPE  (ROUNDED)             
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CZDOTU                                                 
          VFD    42/6HCZDOTU,18/5                                       
*                                                                       
 CZDOTU   DATA   0             ENTRY/EXIT                               
          INFTN  CZDOTU,5                                               
          SA1    B1            (X1) = N                                 
          MX4    0                                                      
          SB7    -1            (B7) = -1                                
          SB1    X1            (B1) = N    (I=0)                        
          MX5    0                                                      
          SB6    X1+B7         (B6) = N-1                               
          BX6    X4                                                     
          BX7    X5            (X7,X5) = (X6,X4) = (0,0)                
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B6,OUT        IF N .LE. 0 , GO TO OUT                  
          SA2    B5            (X2) = INCY                              
          SX1    -B6           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCY                            
          IX2    X2+X2         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X2            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B5,LOOP       IF INCY .GT. 0 , GO TO LOOP              
          DX2    X1*X2         LOC(CYI1 ) = LOC(CY) - (N-1)*INCY        
          SB4    X2+B4         (B4) = LOC(CXI1 )                        
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    B2            (X1) = REAL(CXII )                       
          SB2    B2+B3                                                  
          SA2    B4            (X2) = REAL(CYII )                       
          SB4    B4+B5                                                  
*                                                                       
          FX0    X1*X2         (X0,X1) = REAL(CXII )*REAL(CYII )        
          DX1    X1*X2                                                  
*                                                                       
          FX2    X6+X0         (X6,X4) = (X6,X4) + (X0,X1)              
          DX3    X6+X0                                                  
          FX0    X4+X1                                                  
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX6    X2+X3                                                  
          DX4    X2+X3                                                  
*                                                                       
          SA1    A1-B7         (X1) = IMAG(CXII )                       
          SA2    A2-B7         (X2) = IMAG(CYII )                       
*                                                                       
          FX0    X1*X2         (X0,X1) = IMAG(CXII )*IMAG(CYII )        
          DX1    X1*X2                                                  
*                                                                       
          FX2    X6-X0         (X6,X4) = (X6,X4) - (X0,X1)              
          DX3    X6-X0                                                  
          FX0    X4-X1                 = REAL(CXII *CYII )              
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX6    X2+X3                                                  
          DX4    X2+X3                                                  
*                                                                       
          SA1    A1            (X1) = IMAG(CXII )                       
          SA2    A2+B7         (X2) = REAL(CYII )                       
*                                                                       
          FX0    X1*X2         (X0,X1) = IMAG(CXII )*REAL(CYII )        
          DX1    X1*X2                                                  
*                                                                       
          FX2    X7+X0         (X7,X5) = (X7,X5) + (X0,X1)              
          DX3    X7+X0                                                  
          FX0    X5+X1                                                  
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX7    X2+X3                                                  
          DX5    X2+X3                                                  
*                                                                       
          SA1    A1+B7         (X1) = REAL(CXII )                       
          SA2    A2-B7         (X2) = IMAG(CYII )                       
*                                                                       
          FX0    X1*X2         (X0,X1) = REAL(CXII )*IMAG(CYII )        
          DX1    X1*X2                                                  
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          FX2    X7+X0         (X7,X5) = (X7,X5) + (X0,X1)              
          DX3    X7+X0                                                  
          FX0    X5+X1                 = IMAG(CXII *CYII )              
          NX2    X2                                                     
          FX1    X0+X3                                                  
          FX0    X1+X2                                                  
          NX3    X0                                                     
          DX1    X1+X2                                                  
          NX2    X1                                                     
          FX7    X2+X3                                                  
          DX5    X2+X3                                                  
*                                                                       
          NZ     B1,LOOP       IF I .NE. 0 , GO TO LOOP                 
*                                                                       
          RX0    X6+X4         ROUNDED FINAL RESULT                     
          RX1    X7+X5                                                  
          NX6    X0                                                     
          NX7    X1                                                     
*                                                                       
 OUT      OUTFTN CZDOTU         RETURN                                  
          END                                                           
*DECK,SAXPY                                                             
          IDENT  SAXPY                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SAXPY(N,SA,SX,INCX,SY,INCY)                              
*                                                                       
*         SA*SXII  + SYII   REPLACES  SYII   FOR I=1,N                  
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SA                        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  RICHARD J. HANSON                                 
*                     SANDIA LABORATORIES                               
*                     ALBUQUERQUE, NEW MEXICO                           
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SAXPY                                                  
          VFD    42/5HSAXPY,18/6                                        
*                                                                       
 SAXPY    DATA   0                                                      
          INFTN  SAXPY,6     PROPER LINKAGE (RUN,FTN) MACRO.            
          SA1    B1          (X1)=N                                     
          SB7    1           (B7)=1                                     
*                                                                       
          SB1    X1          (B1)=N                                     
          SB1    B1-B7       (B1)=N-1                                   
          MI     B1,OUT      IF(N .LE. 0), QUIT.                        
*                                                                       
          SA5    B2          (X5)=SA                                    
          ZR     X5,OUT      IF(SA .EQ. 0.), QUIT                       
*                                                                       
          SA1    B3          (X1)=SX(1)                                 
          SA2    B5          (X2)=SY(1)                                 
          SA3    B4          (X3)=INCX                                  
*                                                                       
          SA4    B6          (X4)=INCY                                  
*                                                                       
          NZ     B1,NGT1     IF (N .GT. 1), LOOP NEEDED                 
          RX6    X1*X5       (X6)=SA*SX(1)                              
          RX6    X2+X6       (X6)=SA*SX(1)+SY(1)                        
          NX6    X6          (X6)=NORM.(X6)                             
          SA6    A2          SY(1)=(X6)                                 
          JP     OUT         QUIT                                       
 NGT1     SX0    -B1         (X0)=-(N-1)                                
*                                                                       
          SB3    X3          (B3)=INCX                                  
          SB4    X4          (B4)=INCY                                  
*                                                                       
          GE     B3,INCXNN   IF (INCX .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX3    X0*X3       COMPUTE -(N-1)*INCX                        
          SB7    A1          (B7)=LOC(SX(1))                            
          SA1    B7+X3       (X1)=SX(1+(1-N)*INCX). (A1)=LOC(X(1))      
*                                                                       
 INCXNN   SA3    A1+B3       (X3)=SX(2)                                 
          GE     B4,INCYNN   IF (INCY .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX4    X0*X4       COMPUTE -(N-1)*INCY                        
          SB7    A2          (B7)=LOC(SY(1))                            
          SA2    B7+X4       (X2)=SY(1+(1-N)*INCY). (A2)=LOC(Y(1))      
*                                                                       
 INCYNN   SA4    A2+B4       (X4)=SY(2)                                 
          SB5    1           (B5)=I=1                                   
          SB6    4           (B6)=4                                     
          SA0    A2-B4       (A0)=LOC(Y(1))-INCY                        
          SB1    B1-B6       (B1)=N-5                                   
*                                                                       
          GT     B5,B1,CLEAN IF (I .GT. N-5) CLEAN-UP LOGIC             
 LOOP     RX6    X1*X5       (X6)=SA*SX(I)                              
          SA1    A3+B3       (X1)=SX(I+2)                               
          RX7    X3*X5       (X7)=SA*SX(I+1)                            
          NO     0           DEAD                                       
          SA3    A1+B3       (X3)=SX(I+3)                               
          NO     0           DEAD                                       
          RX6    X2+X6       (X6)=SA*SX(I)+SY(I)                        
          RX7    X4+X7       (X7)=SA*SX(I+1)+SY(I+1)                    
          SA2    A4+B4       (X2)=SY(I+2)                               
          RX0    X1*X5       (X0)=SA*SX(I+2)                            
          NX6    X6          (X6)=NORM.(X6)                             
          SA4    A2+B4       (X4)=SY(I+3)                               
          NX7    X7          (X7)=NORM.(X7)                             
          RX3    X3*X5       (X3)=SA*SX(I+3)                            
*                                                                       
          SA1    A3+B3       (X1)=SX(I+4). NEXT ITER.                   
          SA6    A0+B4       SY(I)=(X6)                                 
          RX6    X0+X2       (X6)=SA*SX(I+2)+SY(I+2)                    
          SA2    A4+B4       (X2)=SY(I+4). NEXT ITER.                   
          SA7    A6+B4       SY(I+1)=(X7)                               
          RX7    X3+X4       (X7)=SA*SX(I+3)+SY(I+3)                    
          SA3    A1+B3       (X3)=SX(I+5). NEXT ITER.                   
          NX6    X6          (X6)=NORM.(X6)                             
          SA4    A2+B4       (X4)=SY(I+5). NEXT ITER.                   
          NX7    X7          (X7)=NORM.(X7)                             
          SA6    A7+B4       SY(I+2)=(X6)                               
          SB5    B5+B6       I=I+4. INCREMENT I                         
          SA7    A6+B4       SY(I-1)=(X7)                               
          SA0    A7          ADVANCE ADDRESS OF SY(I+4) FOR NEXT ITER.  
          LE     B5,B1,LOOP  IF(I.LE.N-5) CONTINUE LOOP                 
*                                                                       
 CLEAN    SB6    2           (B6)=2                                     
          SB1    B1+B6       (B1)=N-3                                   
          GT     B5,B1,SWAB  IF (I .GT. N-3) 3 OR LESS COMPS. REMAIN    
          RX6    X1*X5       (X6)=SA*SX(I)                              
          SA1    A3+B3       (X1)=SX(I+2)                               
          RX7    X3*X5       (X7)=SA*SX(I+1)                            
          SA3    A1+B3       (X3)=SX(I+3)                               
          RX6    X2+X6       (X6)=SA*SX(I)+SY(I)                        
          RX7    X4+X7       (X7)=SA*SX(I+1)+SY(I+1)                    
          SA2    A4+B4       (X2)=SY(I+2)                               
          NX6    X6          (X6)=NORM.(X6)                             
          SA4    A2+B4       (X4)=SY(I+3)                               
          NX7    X7          (X7)=NORM.(X7)                             
*                                                                       
          SB5    B5+B6       I=I+2. INCREMENT I.                        
          SA6    A0+B4       SY(I-2)=(X6)                               
          SA7    A6+B4       SY(I-1)=(X7)                               
          SA0    A7          ADVANCE ADDRESS TO SY(I)                   
*                                                                       
 SWAB     SB1    B1+B6       (B1)=N-1                                   
          GT     B5,B1,MOP   IF (I .GT. N-1) AT MOST 1 COMP. REMAINS    
          RX6    X1*X5       (X6)=SA*SX(I)                              
          RX7    X3*X5       (X7)=SA*SX(I+1)                            
          SB5    B5+B6       I=I+2. INCREMENT I                         
          RX6    X2+X6       (X6)=SA*SX(I-2)+SY(I-2)                    
          RX7    X4+X7       (X7)=SA*SX(I-1)+SY(I-1)                    
          NX6    X6          (X6)=NORM.(X6)                             
          NX7    X7          (X7)=NORM.(X7)                             
          SA6    A0+B4       SY(I-2)=(X6)                               
          SA7    A6+B4       SY(I-1)=(X7)                               
          SA0    A7          ADVANCE ADDRESS TO SY(I)                   
*                                                                       
 MOP      SB1    B1+B6       (B1)=N+1                                   
          GE     B5,B1,OUT   IF (I .GT. N) RETURN                       
          SA1    A3+B3       (X1)=SX(N)                                 
          SA2    A4+B4       (X2)=SY(N)                                 
          RX6    X1*X5       (X6)=SA*SX(N)                              
          RX6    X2+X6       (X6)=SA*SX(N)+SY(N)                        
          NX6    X6          (X6)=NORM.(X6)                             
          SA6    A0+B4       SY(N)=(X6)                                 
*                                                                       
 OUT      OUTFTN SAXPY       RETURN                                     
*         END    SAXPY                                                  
          END                                                           
*DECK,DAXPY                                                             
          IDENT  DAXPY                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DAXPY(N,DA,DX,INCX,DY,INCY)                              
*                                                                       
*         DA*DXII  + DYII   REPLACES  DYII   FOR I=1,N                  
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR DYII                                  
*                                                                       
*         DX( ),DY( )               DOUBLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         DA                        DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DAXPY                                                  
          VFD    42/5HDAXPY,18/6                                        
*                                                                       
 DAXPY    DATA   0             ENTRY/EXIT                               
          INFTN  DAXPY,6                                                
          SA3    B1            (X3) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X3+B7         (B1) = N-1                               
          SA1    B2            (X1,X2) = DA                             
          SA2    B2-B7                                                  
          ZR     X1,OUT        IF(DA .EQ. 0) GO TO OUT                  
*                                                                       
          SA4    B4            (X4) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B6            (X5) = INCY                              
          SX3    -B1           (X3) = -(N-1)                            
          LX4    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB4    X4            (B4) = INCX                              
          SB6    X5            (B5) = INCY                              
*                                                                       
          GT     B4,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX4    X3*X4         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB3    X4+B3         (B3) = LOC(DXI1 )                        
*                                                                       
 ONE      GT     B6,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X3*X5         LOC(DYI1 ) = LOC(DY) - (N-1)*INCY        
          SB5    X5+B5         (B5) = LOC(DYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA3    B3            (X3,X4) = DXI1                           
          SA4    B3-B7                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DA*DXI1                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA5    B5            (X5,X4) = DYI1                           
          SA4    B5-B7                                                  
*                                                                       
          FX0    X6+X5         (X6,X7) = (X6,X7) + DYI1                 
          DX6    X6+X5                                                  
          FX5    X7+X4                                                  
          NX0    X0                                                     
          FX4    X5+X6                                                  
          FX5    X4+X0                                                  
          NX6    X5                                                     
          DX4    X4+X0                                                  
          NX0    X4                                                     
          FX6    X0+X6                                                  
          DX7    X0+X6                                                  
*                                                                       
          SA6    A5            DYI1  = (X6,X7)                          
          SA7    A4                                                     
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA3    A3+B4         (X3,X4) = DXII                           
          SA4    A3-B7                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DA*DXII                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA5    A5+B6         (X5,X4) = DYII                           
          SA4    A5-B7                                                  
*                                                                       
          FX0    X6+X5         (X6,X7) = (X6,X7) + DYII                 
          DX6    X6+X5                                                  
          FX5    X7+X4                                                  
          NX0    X0                                                     
          FX4    X5+X6                                                  
          FX5    X4+X0                                                  
          NX6    X5                                                     
          DX4    X4+X0                                                  
          NX0    X4                                                     
          FX6    X0+X6                                                  
          DX7    X0+X6                                                  
*                                                                       
          SB1    B1+B7         I = I+1                                  
*                                                                       
          SA6    A5            DYII  = (X6,X7)                          
          SA7    A4                                                     
*                                                                       
          NZ     B1,LOOP       IF I .EQ. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN DAXPY         RETURN                                   
          END                                                           
*DECK,CAXPY                                                             
          IDENT  CAXPY                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL CAXPY(N,CA,CX,INCX,CY,INCY)                              
*                                                                       
*         CA*CXII  + CYII   REPLACES  CYII   FOR I=1,N                  
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*                = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                 
*                                                                       
*         SIMILAR DEFINITIONS FOR CYII                                  
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*         CA                        COMPLEX TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CAXPY                                                  
          VFD    42/5HCAXPY,18/6                                        
*                                                                       
 CAXPY    DATA   0             ENTRY/EXIT                               
          INFTN  CAXPY,6                                                
          SA3    B1            (X3) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X3+B7         (B1) = N-1                               
*                                                                       
          SA4    B4            (X4) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B6            (X5) = INCY                              
          SX3    -B1           (X3) = -(N-1)                            
          LX4    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB4    X4            (B4) = INCX                              
          SB6    X5            (B6) = INCY                              
*                                                                       
          GT     B4,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX4    X3*X4         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB3    X4+B3         (B3) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B6,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X3*X5         LOC(CYI1 ) = LOC(CY) - (N-1)*INCY        
          SB5    X5+B5                                                  
*                                                                       
*                              (I = 1)                                  
 TWO      SA3    B3            (X3) = REAL(CXI1 )                       
          SA1    B2            (X1) = REAL(CA)                          
          SA2    B2-B7         (X2) = IMAG(CA)                          
*                                                                       
          BX5    X1                                                     
          AX5    59                                                     
          BX5    X1-X5         (X5) = ABS(REAL(CA))                     
          BX6    X2                                                     
          AX6    59                                                     
          BX6    X2-X6         (X6) = ABS(IMAG(CA))                     
          RX6    X5+X6                                                  
          NX6    X6                                                     
          ZR     X6,OUT        IF(ABS(REAL(CA))+ABS(IMAG(CCA))=0.0) GOTO
*                                                                       
          SA4    B3-B7         (X4) = IMAG(CXI1 )                       
*                              (X6,X7) = CA*CXI1                        
          FX0    X1*X3         (X0) = REAL(CA)*REAL(CXI1 )              
          FX5    X2*X4         (X5) = IMAG(CA)*IMAG(CXI1 )              
          FX6    X0-X5         (X6) = REAL(CA*CXI1 )                    
*                                                                       
          FX0    X1*X4         (X0) = REAL(CA)*IMAG(CXI1 )              
          FX5    X2*X3         (X5) = IMAG(CA)*REAL(CXI1 )              
          FX7    X0+X5         (X7) = IMAG(CA*CXI1 )                    
*                                                                       
*                                                                       
*                              (X6,X7) = (X6,X7) + CYI1                 
          SA5    B5            (X5) = REAL(CYI1 )                       
          SA4    B5-B7         (X4) = IMAG(CYI1 )                       
*                                                                       
          FX0    X6+X5         (X0) = REAL(CA*CXI1 ) + REAL(CYI1 )      
          FX3    X7+X4         (X3) = IMAG(CA*CXI1 ) + IMAG(CYI1 )      
          NX6    X0                                                     
          NX7    X3            NORMALIZE RESULT                         
*                                                                       
          SA6    A5            REAL(CYI1 ) = (X6)                       
          SA7    A4            IMAG(CYI1 ) = (X7)                       
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA3    A3+B4         (X3) = REAL(CXII )                       
          SA4    A3-B7         (X4) = IMAG(CXII )                       
*                                                                       
*                              (X6,X7) = CA*CXII                        
          FX0    X1*X3         (X0) = REAL(CA)*REAL(CXII )              
          FX5    X2*X4         (X5) = IMAG(CA)*IMAG(CXII )              
          FX6    X0-X5         (X6) = REAL(CA*CXII )                    
*                                                                       
          FX0    X1*X4         (X0) = REAL(CA)*IMAG(CXII )              
          FX5    X2*X3         (X5) = IMAG(CA)*REAL(CXII )              
          FX7    X0+X5         (X7) = IMAG(CA*CXII )                    
*                                                                       
*                              (X6,X7) = (X6,X7) + CYII                 
          SA5    A5+B6         (X5) = REAL(CYII )                       
          SA4    A5-B7         (X4) = IMAG(CYII )                       
*                                                                       
          FX0    X6+X5         (X0) = REAL(CA*CXII ) + REAL(CYII )      
          FX3    X7+X4         (X3) = IMAG(CA*CXII ) + IMAG(CYII )      
          SB1    B1+B7         I = I+1                                  
          NX6    X0                                                     
          NX7    X3            NORMALIZE RESULT                         
*                                                                       
          SA6    A5            REAL(CYII ) = (X6)                       
          SA7    A4            IMAG(CYII ) = (X7)                       
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CAXPY         RETURN                                   
          END                                                           
*DECK,SROTG                                                             
          IDENT  SROTG                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SROTG(SA,SB,SC,SS)                                       
*                                                                       
*         COMPUTE QUANTITIES :     R = SQRT( SA**2 + SB**2 )            
*                                  SC = SA/R  ,  SS = SB/R              
*                                  SA = R                               
*                                                                       
*         DEFINING THE GIVENS REFLECTION MATRIX   (SC   SS)             
*                                                 (-SS  SC)             
*                                                                       
*         SA,SB,SC,SS               SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETRIC INSTRUCTIONS ARE USED                     
*                                                                       
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SROTG                                                  
          VFD    42/5HSROTG,18/4                                        
*                                                                       
 SROTG    DATA   0             ENTRY/EXIT                               
          INFTN  SROTG,4                                                
*                                                                       
          SX6    B1                                                     
          SX7    B2                                                     
          SA6    ADRSA         SAVE ADDRESS OF SA AND SB                
          SA7    ADRSB                                                  
          SX6    B3                                                     
          SX7    B4                                                     
          SA6    ADRSC         SAVE ADDRESS OF SC AND SS                
          SA7    ADRSS                                                  
          SA2    B1            (X2) = SA                                
          SA3    B2            (X3) = SB                                
          SA5    UNIT          (X5) = 1.0                               
*                                                                       
          BX4    X3                                                     
          AX4    59                                                     
          BX7    X3-X4         (X7) = ABS(SB)                           
          ZR     X7,THIRTY     IF ABS(SB) .EQ. 0 , GO TO THIRTY         
          BX1    X2                                                     
          AX1    59                                                     
          BX6    X2-X1         (X6) = ABS(SA)                           
          ZR     X6,FORTY      IF ABS(SA) .EQ. 0 , GO TO FORTY          
*                                                                       
          RX6    X6-X7                                                  
          NX6    X6                                                     
          ZR     X6,TWENTY                                              
          NG     X6,TWENTY     IF ABS(SA) .LE. ABS(SB), GO TO TWENTY    
*                                                                       
          RX6    X3/X2         (X6) = SB/SA   (=XR)                     
          RX0    X6*X6         (X0) = XR**2                             
          SA6    XR            XR = (X6)                                
          RX0    X5+X0                                                  
          NX6    X0            (X6) = 1.+XR**2                          
          SA6    XR2P1         XR2P1 = (X6)                             
*                                                                       
          SB1    XR2P1                                                  
*                                                                       
          CALL   SQRT,(B1)     (X6) =   SQRT(1.+XR**2)  (=YR)           
*                                                                       
          SA1    ADRSA         RESTORE B REGISTERS                      
          SB1    X1                                                     
          SA2    ADRSB                                                  
          SB2    X2                                                     
          SA3    ADRSC                                                  
          SB3    X3                                                     
          SA4    ADRSS                                                  
          SB4    X4                                                     
*                                                                       
          SA2    B1            (X2)=SA                                  
          SA3    XR            (A3) = XR                                
*                                                                       
          RX7    X2*X6         (X7) = SA*YR                             
          SA5    UNIT                                                   
          RX6    X5/X6         (X6) = 1./YR                             
          SA7    B1            SA=(X7)                                  
          RX7    X6*X3         (X7) = SC*XR                             
          SA6    B3            SC=(X6)                                  
          SA7    B4            SS=(X7)                                  
*                                                                       
          EQ     FIFTY         GO TO FIFTY                              
*                                                                       
 TWENTY   RX7    X2/X3         (X7) = SA/SB  (= XR)                     
          RX0    X7*X7         (X0) = XR**2                             
          SA7    XR            XR = (X7)                                
          RX7    X5+X0                                                  
          NX6    X7            (X6) = 1.+XR**2                          
          SA6    XR2P1         XR2P1 = (X6)                             
*                                                                       
          SB1    XR2P1                                                  
*                                                                       
          CALL   SQRT,(B1)     (X6) =   SQRT(1.+XR**2)  (=YR)           
*                                                                       
          SA1    ADRSA         RESTORE B REGISTERS                      
          SB1    X1                                                     
          SA2    ADRSB                                                  
          SB2    X2                                                     
          SA3    ADRSC                                                  
          SB3    X3                                                     
          SA4    ADRSS                                                  
          SB4    X4                                                     
*                                                                       
          SA3    B2            (X3)=SB                                  
          SA1    XR            (X1) = XR                                
*                                                                       
          RX7    X3*X6         (X7) = SB*YR                             
          SA5    UNIT                                                   
          RX6    X5/X6         (X6) = 1./YR                             
          SA7    B1            SA=(X7)                                  
          RX7    X6*X1         (X7) = SS*XR                             
          SA6    B4            SS=(X6)                                  
          SA7    B3            SC=(X7)                                  
*                                                                       
          EQ     FIFTY         GO TO FIFTY                              
*                                                                       
 THIRTY   BX6    X5            (X6) = 1.                                
          MX7    0             (X7) = 0.                                
          SA6    B3            SC = (X6)                                
          SA7    B4            SS = (X7)                                
*                                                                       
          EQ     FIFTY         GO TO FIFTY                              
*                                                                       
 FORTY    BX6    X5            (X6) = 1.                                
          MX7    0             (X7) = 0.                                
          SA6    B4            SS = (X6)                                
          SA7    B3            SC = (X7)                                
*                                                                       
          BX6    X3            (X6) = SB                                
          SA6    B1            SA = (X1)                                
*                                                                       
 FIFTY    SA2    B4            (X2) = SS                                
          SA3    B3            (X3) = SC                                
          SA5    UNIT          (X5) = 1.0                               
          ZR     X3,SEVENTY    IF SC .EQ. 0 , TO GO SEVENTY             
*                                                                       
          BX1    X2                                                     
          AX1    59                                                     
          BX6    X2-X1         (X6) = ABS(SS)                           
          BX4    X3                                                     
          AX4    59                                                     
          BX7    X3-X4         (X7) = ABS(SC)                           
*                                                                       
          RX6    X6-X7                                                  
          NX6    X6                                                     
          NG     X6,SIXTY      IF ABS(SS) .LT. ABS(SC), GO TO SIXTY     
*                                                                       
          RX6    X5/X3         (X6) = 1./SC                             
          SA6    B2            SB = (X6)                                
          EQ     OUT           GO TO OUT                                
*                                                                       
 SIXTY    BX6    X2            (X6) = SC                                
          SA6    B2            SB = (X6)                                
          EQ     OUT           GO TO OUT                                
*                                                                       
 SEVENTY  BX6    X5            (X6) = 1.                                
          SA6    B2            SB = (X6)                                
          EQ     OUT           GO TO OUT                                
*                                                                       
 OUT      OUTFTN SROTG         RETURN                                   
*                                                                       
 ADRSA    BSS    1                                                      
 ADRSB    BSS    1                                                      
 ADRSC    BSS    1                                                      
 ADRSS    BSS    1                                                      
*                                                                       
 XR       BSS    1                                                      
 XR2P1    BSS    1                                                      
*                                                                       
 UNIT     DATA   1.0                                                    
*                                                                       
          END                                                           
*DECK,DROTG                                                             
          IDENT  DROTG                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DROTG(DA,DB,DC,DS)                                       
*                                                                       
*         COMPUTE QUANTITIES:   DR = DSQRT( DA**2 + DB**2 )             
*                               DC = DA/DR  ,  DS = DB/DR               
*                               DA = DR                                 
*                                                                       
*         DEFINES THE GIVENS REFLECTION MATRIX   (DC   DS)              
*                                                (-DS  DC)              
*                                                                       
*         DA,DB,DC,DS                DOUBLE PRECISION                   
*                                                                       
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND JAMES SULLIVAN               
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DROTG                                                  
          VFD    42/5HDROTG,18/4                                        
 DROTG    DATA   0             ENTRY/EXIT                               
          INFTN  DROTG,4                                                
*                                                                       
          SX6    B1                                                     
          SX7    B2                                                     
          SA6    ADRDA         SAVE ADDRESS OF DA AND DB                
          SA7    ADRDB                                                  
          SX6    B3                                                     
          SX7    B4                                                     
          SA6    ADRDC         SAVE ADDRESS OF DC AND DS                
          SA7    ADRDS                                                  
*                                                                       
          SB7    -1            (B7) = -1                                
*                                                                       
          SA3    B2            (X3,) = DB                               
          BX7    X3            (X7) = X3                                
          AX7    73B           FILL X7 WITH THE SIGN BIT OF DB.         
          BX4    X7-X3         (X4,) = DABS(DB)                         
          ZR     X4,THIRTY     IF(SNGL(ABS(DB)) = 0) GO TO THIRTY       
*                                                                       
          SA1    B1            (X1,) = DA                               
          BX2    X1            (X2) = X1                                
          BX6    X1            (X6) = X1                                
          AX6    73B           FILL X6 WITH THE SIGN BIT OF DA.         
          BX2    X6-X1         (X2,) = DABS(DA)                         
*                                                                       
          ZR     X2,FORTY      IF(SNGL(ABS(DA)) = 0) GO TO FORTY        
          FX5    X4-X2         COMPARE UPPER HALVES OF DABS(DA) AND DABS
          NX5    X5            MAKE SURE X5 DOES NOT CONTAIN A MINUS ZER
          NG     X5,TEN        IF (DABS(DA) > DABS(DB)) GO TO TEN.      
*                              ELSE IF (SNGL(DABS(DA)) @ SNGL(DABS(DB)))
*                              FOLLOWING....                            
          SA2    B1-B7         (X1,X2) = DA                             
          SA4    B2-B7         (X3,X4) = DB                             
*                                                                       
          FX5    X1/X3         (X6,X7) = DA / DB                        
          FX6    X3*X5                                                  
          FX7    X1-X6                                                  
          DX6    X1-X6                                                  
          NX7    X7                                                     
          FX6    X6+X7                                                  
          DX7    X3*X5                                                  
          FX0    X4*X5                                                  
          FX6    X2+X6                                                  
          FX6    X6-X7                                                  
          FX6    X6-X0                                                  
          FX0    X6/X3                                                  
          FX6    X0+X5                                                  
          DX7    X0+X5                                                  
          NX5    X6                                                     
          FX6    X5+X7                                                  
          DX7    X5+X7         (X6,X7) = (X1,X2) / (X3,X4)              
*                                                                       
          SA6    XR            (XR) = (X6,X7)                           
          SA7    XR+1          (XR) = DA / DB                           
*                                                                       
          FX4    X6*X7         (X0,X1) = XR**2                          
          DX5    X6*X6                                                  
          FX4    X4+X4                                                  
          FX1    X6*X6                                                  
          FX5    X4+X5                                                  
          FX0    X1+X5                                                  
          DX1    X1+X5         (X0,X1) = (X6,X7) * (X6,X7)              
*                                                                       
          SA4    ONE           (X4) = +1.                               
*                                                                       
          FX2    X0+X4         (X6,X7) = 1.D0 + (XR*XR)                 
          DX3    X0+X4                                                  
          NX2    X2                                                     
          FX5    X1+X3                                                  
          FX4    X2+X5                                                  
          NX3    X4                                                     
          DX5    X2+X5                                                  
          NX2    X5                                                     
          FX6    X2+X3                                                  
          DX7    X2+X3         (X6,X7) = (1.,0) + (X0,X1)               
*                                                                       
          SA6    XR2P1                                                  
          SA7    XR2P1+1                                                
*                              SET (XR2P1) = (X6,X7).                   
          SB1    XR2P1                                                  
          CALL   DSQRT,(B1)                                             
*                                                                       
          SA1    ADRDA                                                  
          SB1    X1            RESTORE B  REGISTERS                     
          SA2    ADRDB                                                  
          SB2    X2                                                     
          SA3    ADRDC                                                  
          SB3    X3                                                     
          SA4    ADRDS                                                  
          SB4    X4                                                     
          SB7    -1                                                     
*                              NO ERROR CHECKS ARE MADE UPON RETURN     
          SA6    YR                                                     
          SA7    YR+1          (YR) = SGN(B)*DSQRT(ONE+XR*XR)           
*                                                                       
          SA2    ONE           (X2) = +1.                               
*                                                                       
          FX1    X2/X6         (X6,X7) = 1.0D0 / YR                     
          FX4    X1*X6                                                  
          FX5    X2-X4                                                  
          DX4    X2-X4                                                  
          NX5    X5                                                     
          FX4    X4+X5                                                  
          DX5    X1*X6                                                  
          FX0    X1*X7                                                  
          FX4    X4-X5                                                  
          FX4    X4-X0                                                  
          FX0    X4/X6                                                  
          FX4    X0+X1                                                  
          DX5    X0+X1                                                  
          NX1    X4                                                     
          FX6    X1+X5                                                  
          DX7    X1+X5         (X6,X7) = (X2,) / (X6,X7)                
          SA6    B4            DS=(X6,X7)                               
          SA7    B4-B7                                                  
*                                                                       
          SA2    XR            (X2,X3) = XR                             
          SA3    XR+1                                                   
*                                                                       
          FX4    X2*X7         (X6,X7) = DS * XR                        
          FX5    X3*X6                                                  
          FX4    X4+X5                                                  
          FX7    X2*X6                                                  
          DX5    X2*X6                                                  
          FX5    X4+X5                                                  
          FX6    X5+X7                                                  
          DX7    X5+X7         (X6,X7) = (X6,X7) * (X2,X3)              
*                                                                       
          SA6    B3            DC=(X6,X7)                               
          SA7    B3-B7                                                  
*                                                                       
          SA2    B2            (X2,X3)=DB                               
          SA3    B2-B7                                                  
*                                                                       
          SA4    YR            (X4,X5) = YR                             
          SA5    YR+1                                                   
*                                                                       
          FX0    X3*X4         (X6,X7) = DB * YR                        
          FX1    X2*X5                                                  
          FX0    X0+X1                                                  
          FX3    X2*X4                                                  
          DX1    X2*X4                                                  
          FX1    X0+X1                                                  
          FX6    X1+X3                                                  
          DX7    X1+X3         (X6,X7) = (X2,X3) * (X4,X5)              
*                                                                       
          SA6    B1            DA=(X6,X7)                               
          SA7    B1-B7                                                  
*                                                                       
          EQ     FIFTY         GO TO FIFTY                              
*                                                                       
 TEN      SA2    B1-B7         (X1,X2) = DA                             
          SA4    B2-B7         (X3,X4) = DB                             
*                                                                       
          FX5    X3/X1         (X6,X7) = DB / DA                        
          FX6    X1*X5                                                  
          FX7    X3-X6                                                  
          DX6    X3-X6                                                  
          NX7    X7                                                     
          FX6    X6+X7                                                  
          DX7    X1*X5                                                  
          FX0    X2*X5                                                  
          FX6    X4+X6                                                  
          FX6    X6-X7                                                  
          FX6    X6-X0                                                  
          FX0    X6/X1                                                  
          FX6    X0+X5                                                  
          DX7    X0+X5                                                  
          NX5    X6                                                     
          FX6    X5+X7                                                  
          DX7    X5+X7         (X6,X7) = (X3,X4) / (X1,X2)              
*                                                                       
          SA6    XR            (XR) = (X6,X7)                           
          SA7    XR+1          (XR) = DB / DA                           
*                                                                       
          FX4    X6*X7         (X0,X1) = XR**2                          
          DX5    X6*X6                                                  
          FX4    X4+X4                                                  
          FX3    X6*X6                                                  
          FX5    X4+X5                                                  
          FX0    X3+X5                                                  
          DX1    X3+X5         (X0,X1) = (X6,X7) * (X6,X7)              
*                                                                       
          SA4    ONE           (X4) = +1.                               
*                                                                       
          FX2    X0+X4         (X6,X7) = 1.D0 + (XR*XR)                 
          DX3    X0+X4                                                  
          NX2    X2                                                     
          FX5    X1+X3                                                  
          FX4    X2+X5                                                  
          NX3    X4                                                     
          DX5    X2+X5                                                  
          NX2    X5                                                     
          FX6    X2+X3                                                  
          DX7    X2+X3         (X6,X7) = (1.,0) + (X0,X1)               
*                                                                       
*                                                                       
          SA6    XR2P1                                                  
          SA7    XR2P1+1                                                
*                              SET (XR2P1) = (X6,X7).                   
          SB1    XR2P1                                                  
          CALL   DSQRT,(B1)                                             
*                                                                       
          SA1    ADRDA         RESTORE B REGISTERS                      
          SB1    X1                                                     
          SA2    ADRDB                                                  
          SB2    X2                                                     
          SA3    ADRDC                                                  
          SB3    X3                                                     
          SA4    ADRDS                                                  
          SB4    X4                                                     
          SB7    -1                                                     
*                                                                       
*                              NO ERROR CHECKS ARE MADE UPON RETURN     
          SA6    YR                                                     
          SA7    YR+1          (YR) = SGN(A)*DSQRT(ONE+XR*XR)           
*                                                                       
*                                                                       
          SA2    ONE           (X2) = +1.                               
*                                                                       
          FX1    X2/X6         (X6/X7) = 1.D0 / YR                      
          FX4    X1*X6                                                  
          FX5    X2-X4                                                  
          DX4    X2-X4                                                  
          NX5    X5                                                     
          FX4    X4+X5                                                  
          DX5    X1*X6                                                  
          FX0    X1*X7                                                  
          FX4    X4-X5                                                  
          FX4    X4-X0                                                  
          FX0    X4/X6                                                  
          FX4    X0+X1                                                  
          DX5    X0+X1                                                  
          NX1    X4                                                     
          FX6    X1+X5                                                  
          DX7    X1+X5         (X6,X7) = (X2,) / (X6,X7)                
          SA6    B3            DC=(X6,X7)                               
          SA7    B3-B7                                                  
*                                                                       
          SA2    XR            (X2,X3) = XR                             
          SA3    XR+1                                                   
*                                                                       
          FX4    X2*X7         (X6,X7) = DC * XR                        
          FX5    X3*X6                                                  
          FX4    X4+X5                                                  
          FX7    X2*X6                                                  
          DX5    X2*X6                                                  
          FX5    X4+X5                                                  
          FX6    X5+X7                                                  
          DX7    X5+X7         (X6,X7) = (X6,X7) * (X2,X3)              
*                                                                       
          SA6    B4            DS=(X6,X7)                               
          SA7    B4-B7                                                  
*                                                                       
          SA2    B1                                                     
          SA3    B1-B7         (X2,X3)=DA                               
*                                                                       
          SA4    YR            (X4,X5) = YR                             
          SA5    YR+1                                                   
*                                                                       
          FX0    X3*X4         (X6,X7) = DA * YR                        
          FX1    X2*X5                                                  
          FX0    X0+X1                                                  
          FX3    X2*X4                                                  
          DX1    X2*X4                                                  
          FX1    X0+X1                                                  
          FX6    X1+X3                                                  
          DX7    X1+X3         (X6,X7) = (X2,X3) * (X4,X5)              
*                                                                       
          SA6    B1            DA=(X6,X7)                               
          SA7    B1-B7                                                  
*                                                                       
          EQ     FIFTY         GO TO FIFTY                              
*                                                                       
 THIRTY   MX6    0             (X6) = 0                                 
          SA1    ONE           (X1) = +1.                               
          MX7    0             (X7) = 0                                 
          SA6    B4            (DS) = (X6,X7)                           
          SA7    B4-B7         (DS) = (0.,0)                            
          BX6    X1            (X6) = X1                                
          SA7    B3-B7         DC = (X6,X7)                             
          SA6    B3                                                     
          EQ     FIFTY         GO TO FIFTY                              
*                                                                       
 FORTY    MX6    0             (X6) = 0                                 
          SA1    ONE           (X1) = +1.                               
          MX7    0             (X7) = 0                                 
          SA6    B3            DC = (X6,X7)                             
          SA7    B3-B7                                                  
          BX6    X1            (X6) = +1.                               
          SA6    B4                                                     
          SA7    B4-B7         DS = (X6,X7)                             
*                                                                       
          SA1    B2            (X1,X2) = DB                             
          SA2    B2-B7                                                  
          BX6    X1                                                     
          BX7    X2                                                     
          SA6    B1                                                     
          SA7    B1-B7         DA = (X1,X2)                             
*                                                                       
 FIFTY    SA1    B3            (X1,) = DC                               
          ZR     X1,SEVENTY    IF(SNGL(DC) = 0)  GO TO SEVENTY          
*                                                                       
          BX6    X1            (X6) = X1                                
          AX1    59                                                     
          BX2    X6-X1         (X2,) = DABS(DC)                         
          SA3    B4            (X3,) = DS                               
          BX7    X3            (X7) = X3                                
          AX3    59                                                     
          BX4    X7-X3         (X4,) = DABS(DS)                         
*                                                                       
          FX5    X4-X2         COMPARE UPPER HALVES:DABS(DC),DABS(DS)   
          NX5    X5            MAKE SURE X5 DOES NOT CONTAIN A MINUS 0  
          NG     X5,SIXTY      IF(DABS(DC) > ABS(DS)) GO TO SIXTY       
*                                                                       
          SA4    B3            (X4,X5) = DC                             
          SA5    B3-B7                                                  
          SA2    ONE           (X2) = +1.                               
          BX6    X4                                                     
          BX7    X5            (X6,X7) = DC                             
*                                                                       
          FX1    X2/X6         (X6,X7) = 1.D0 / DC                      
          FX4    X1*X6                                                  
          FX5    X2-X4                                                  
          DX4    X2-X4                                                  
          NX5    X5                                                     
          FX4    X4+X5                                                  
          DX5    X1*X6                                                  
          FX0    X1*X7                                                  
          FX4    X4-X5                                                  
          FX4    X4-X0                                                  
          FX0    X4/X6                                                  
          FX4    X0+X1                                                  
          DX5    X0+X1                                                  
          NX1    X4                                                     
          FX6    X1+X5                                                  
          DX7    X1+X5         (X6,X7) = (X2,)/(X6,X7)                  
*                                                                       
          SA6    B2            DB = 1.D0 / DC                           
          SA7    B2-B7                                                  
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
 SIXTY    SA4    B4            (X4,X5) = DS                             
          SA5    B4-B7                                                  
          BX6    X4                                                     
          BX7    X5            (X6,X7) = (X4,X5)                        
          SA6    B2                                                     
          SA7    B2-B7         DB = (X6,X7)                             
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
 SEVENTY  SA2    ONE           (X2) = +1.                               
          MX7    0             (X7) = 0.                                
          BX6    X2                                                     
          SA6    B2                                                     
          SA7    B2-B7         DB = (X6,X7)                             
*                                                                       
 OUT      OUTFTN DROTG         RETURN                                   
*                                                                       
 ONE      DATA   17204000000000000000B                                  
 XR       BSS    2                                                      
 XR2P1    BSS    2             TEMPORARY STORAGE FOR THE QUANTITY (1.+XR
 YR       BSS    2                                                      
 ADRDA    BSS    1                                                      
 ADRDB    BSS    1                                                      
 ADRDC    BSS    1                                                      
 ADRDS    BSS    1                                                      
*                                                                       
          END                                                           
*DECK,SROT                                                              
          IDENT  SROT                                                   
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SROT(N,SX,INCX,SY,INCY,SC,SS)                            
*                                                                       
*         APPLY GIVENS REFLECTION MATRIX                                
*                                                                       
*         APPLY 2X2 MATRIX  ( SC SS)  TO 2XN MATRIX  (SXI1  ... SXIN )  
*                           (-SS SC)                 (SYI1  ... SYIN )  
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SC,SS                     SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  RICHARD J. HANSON                                 
*                     SANDIA LABORATORIES                               
*                     ALBUQUERQUE, NEW MEXICO                           
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SROT                                                   
 SS       BSS    1                                                      
          VFD    42/4HSROT,18/7                                         
*                                                                       
 SROT     DATA   0                                                      
          INFTN  SROT,7      PROPER LINKAGE (RUN,FTN) MACRO.            
          SA1    B1          (X1)=N                                     
          SB7    1           (B7)=1                                     
*                                                                       
          SB1    X1          (B1)=N                                     
          SB1    B1-B7       (B1)=N-1                                   
*                                                                       
          MI     B1,OUT      IF (N .LE. 0), QUIT                        
*                                                                       
          SA5    SS          (X5)=LOC(SS)                               
          SA5    X5          (X5)=SS                                    
*                                                                       
          NZ     X5,APPLY    IF(SS.EQ.0..AND.SC.EQ.1.) QUIT.            
          SA2    B6          (X2)=SC                                    
          SA3    SONE        (X3)=1.                                    
          RX2    X2-X3       (X2)=SC-1.                                 
          NX2    X2          (X2)=NORM.(X2)                             
          ZR     X2,OUT      IF(SC.EQ.1.) QUIT.                         
 APPLY    SA1    B2          (X1)=SX(1)                                 
          SA2    B3          (X2)=INCX                                  
*                                                                       
          SA3    B4          (X3)=SY(1)                                 
          SA4    B5          (X4)=INCY                                  
*                                                                       
          ZR     B1,INCYNN   IF (N .EQ. 1) NO NEED TO TEST FOR NEG. INC.
          SX0    -B1         (X0)=-(N-1)                                
          SB2    X2          (B2)=INCX                                  
          SB3    X4          (B3)=INCY                                  
*                                                                       
          GE     B2,INCXNN   IF (INCX .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX2    X0*X2       (X2)=-(N-1)*INCX                           
          SB7    A1          (B7)=LOC(SX(1))                            
          SA1    B7+X2       (X1)=SX(1+(1-N)*INCX),(A1)=LOC(X(1))       
*                                                                       
 INCXNN   GE     B3,INCYNN   IF (INCY .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX4    X0*X4       (X4)=-(N-1)*INCY                           
          SB7    A3          (B7)=LOC(SY(1))                            
          SA3    B7+X4       (X3)=SY(1+(1-N)*INCY),(A3)=LOC(Y(1))       
*                                                                       
 INCYNN   SA2    B6          (X2)=SC                                    
          SB7    1           (B7)=1                                     
          SB6    B7          (B6)=I=1                                   
          BX0    X2          (X0)=SC                                    
*                                                                       
          SB1    B1-B7       (B1)=N-2                                   
          GT     B6,B1,FIX   IF (I .GT. N-2) CLEAN-UP LOGIC             
*                                                                       
 LOOP     SA2    A1+B2       (X2)=SX(I+1)                               
          SA4    A3+B3       (X4)=SY(I+1)                               
          RX6    X3*X5       (X6)=SS*SY(I)                              
          RX7    X0*X3       (X7)=SC*SY(I)                              
          RX3    X0*X1       (X3)=SC*SX(I)                              
          RX1    X1*X5       (X1)=SS*SX(I)                              
*                                                                       
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I                    
          RX6    X3+X6       (X6)=SC*SX(I-1)+SS*SY(I-1)                 
          RX3    X4*X5       (X3)=SS*SY(I)                              
          RX7    X7-X1       (X7)=-SS*SX(I-1)+SC*SY(I-1)                
          RX1    X0*X4       (X1)=SC*SY(I)                              
          RX4    X0*X2       (X4)=SC*SX(I)                              
          NX6    X6          (X6)=NORM.(X6)                             
          RX2    X2*X5       (X2)=SS*SX(I)                              
          NX7    X7          (X7)=NORM.(X7)                             
          NO     0           DEAD                                       
          SA6    A1          SX(I-1)=(X6)                               
          NO     0           DEAD                                       
          RX4    X3+X4       (X4)=SC*SX(I)+SS*SY(I)                     
          SA7    A3          SY(I-1)=(X7)                               
          SA3    A4+B3       (X3)=SY(I+1). NEXT ITERATION.              
          RX2    X1-X2       (X2)=-SS*SX(I)+SC*SY(I)                    
          SA1    A2+B2       (X1)=SX(I+1). NEXT ITERATION.              
          NX6    X4          (X6)=NORM.(X4)                             
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          NO     0           DEAD                                       
          NX7    X2          (X7)=NORM(X2)                              
          SA6    A2          SX(I-1)=(X6)                               
          NO     2           DEAD                                       
          SA7    A4          SY(I-1)=(X7)                               
          LE     B6,B1,LOOP  IF (I .LE. N-2) CONTINUE LOOP              
 FIX      SB1    B1+B7       (B1)=N-1                                   
          SB1    B1+B7       (B1)=N                                     
 CL       RX6    X3*X5       (X6)=SS*SY(I)                              
          RX7    X0*X3       (X7)=SC*SY(I)                              
          RX3    X0*X1       (X3)=SC*SX(I)                              
          RX1    X1*X5       (X1)=SS*SX(I)                              
*                                                                       
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          RX6    X3+X6       (X6)=SC*SX(I-1)+SS*SY(I-1)                 
          RX7    X7-X1       (X7)=-SS*SX(I-1)+SC*SY(I-1)                
*                                                                       
          NX6    X6          (X6)=NORM.(X6)                             
          NX7    X7          (X7)=NORM.(X7)                             
*                                                                       
          SA6    A1          SX(I-1)=(X6)                               
          SA7    A3          SY(I-1)=(X7)                               
*                                                                       
          GT     B6,B1,OUT   IF (I .GT. N), QUIT                        
          SA3    A3+B3       (X3)=SY(I)                                 
          SA1    A1+B2       (X1)=SX(I)                                 
          JP     CL          ONE COMP. REMAINS.                         
 OUT      OUTFTN SROT                                                   
 SONE     DATA   1.0                                                    
*         END    SROT                                                   
          END                                                           
*DECK,DROT                                                              
          IDENT  DROT                                                   
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DROT(N,DX,INCX,DY,INCY,DC,DS)                            
*                                                                       
*         APPLY GIVENS REFLECTION MATRIX                                
*                                                                       
*         APPLY 2X2 MATRIX  ( DC DS)  TO 2XN MATRIX  (DXI1  ... DXIN )  
*                           (-DS DC)                 (DYI1  ... DYIN )  
*                                                                       
*         DXII  = DX(1 + (I-N)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR DYII                                  
*                                                                       
*         DX( ),DY( )               DOUBLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         DC,DS                     DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DROT                                                   
 ARG7     BSS    1                                                      
          VFD    42/4HDROT,18/7                                         
*                                                                       
 DROT     DATA   0             ENTRY/EXIT                               
          INFTN  DROT,7                                                 
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA2    B3            (X2) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA3    ARG7          (X3) = LOC(DS)                           
          SA3    X3            (X3,) = DS                               
          NZ     X3,DROT5      IF DS.NE.0.0EE0, GO TO DROT5             
*                                                                       
          SA3    B6            (X3,X4) = DC                             
          SA4    B6-B7                                                  
          SA1    DONE          (X1,X5) = 1.0EE0                         
          SA5    A1-B7                                                  
*                                                                       
          FX4    X4-X5                                                  
          FX5    X3-X1                                                  
          DX3    X3-X1                                                  
          NX5    X5                                                     
          FX3    X3+X4                                                  
          NX3    X3                                                     
          FX5    X3+X5                                                  
          ZR     X5,OUT        IF DC.EQ.1.0EE0.AND.DS.EQ.0.0EE0, GOTO OU
*                                                                       
 DROT5    SA3    B5            (X3) = INCX                              
          SX1    -B1           (X1) = -(N-1)                            
          LX2    1             INCX = 2*INCX                            
          IX3    X3+X3         INCY = 2*INCY                            
          SB3    X2            (B3) = INCX                              
          SB5    X3            (B5) = INCY                              
*                                                                       
          GT     B3,DROT10     IF INCX .GT. 0 , GO TO DROT10            
          ZR     B3,OUT        IF INCX .EQ. 0 , GO TO OUT               
          DX0    X1*X2         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB2    X0+B2         (B2) = LOC(DXI1 )                        
*                                                                       
 DROT10   GT     B5,DROT20     IF INCY .GT. 0, GO TO DROT20             
          ZR     B5,OUT        IF INCY .EQ. 0 , GO TO OUT               
          DX0    X1*X3         LOC(DYI1 ) = LOC(DY) - (N-1)*INCY        
          SB4    X0+B4         (B4) = LOC(DYI1 )                        
*                                                                       
 DROT20   SA5    ARG7                                                   
          SA0    X5            (A0) = LOC(DS)                           
          SB1    B1-B7         (B1) = N                                 
*                                                                       
 LOOP     SA1    A0            (X1,X2) = DS                             
          SA2    A0-B7                                                  
*                                                                       
          SA3    B4            (X3,X4) = DYII                           
          SA4    B4-B7                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DS*DYII                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA1    B2            (X1,X2) = DXII                           
          SA2    B2-B7                                                  
*                                                                       
          SA3    B6            (X3,X4) = DC                             
          SA4    B6-B7                                                  
*                                                                       
          FX5    X2*X3         (X0,X3) = DC*DXII                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX3    X4+X5                                                  
*                                                                       
          FX4    X6+X0         (X6,X7) = (X6,X7)+(X0,X3)                
          DX5    X6+X0                                                  
          FX0    X7+X3                                                  
          NX4    X4                                                     
          FX3    X0+X5                                                  
          FX0    X3+X4                                                  
          NX5    X0                                                     
          DX3    X3+X4                                                  
          NX4    X3                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    DW              DW = (X6,X7)                           
          SA7    DW+1                                                   
*                                                                       
          SA3    A0            (X3,X4) = DS                             
          SA4    A0-B7                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DS*DXII                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA1    B6            (X1,X2) = DC                             
          SA2    B6-B7                                                  
          SA3    B4            (X3,X4) = DYII                           
          SA4    B4-B7                                                  
*                                                                       
          FX5    X2*X3         (X0,X2) = DC*DYII                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          FX4    X0-X6         (X6,X7) = (X0,X2)-(X6,X7)                
          DX5    X0-X6                                                  
          FX0    X2-X7                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    B4            DYII  = (X6,X7)                          
          SA7    B4-B7                                                  
*                                                                       
          SB1    B1+B7         COUNT TERM                               
          SA1    DW                                                     
          SA2    DW+1                                                   
          BX6    X1                                                     
          BX7    X2                                                     
          SA6    B2                                                     
          SA7    B2-B7         DXII  = DW                               
*                                                                       
          SB2    B2+B3         (B2) = LOC(DXII+1 )                      
          SB4    B4+B5         (B4) = LOC(DYII+1 )                      
*                                                                       
          NZ     B1,LOOP       IF I .NE. N, LOOP                        
*                                                                       
 OUT      OUTFTN DROT          RETURN                                   
*                                                                       
 DONE     DATA   1.0EE0                                                 
 DW       BSS    2                                                      
*                                                                       
          END                                                           
*DECK,SROTMG                                                            
          IDENT  SROTMG                                                 
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SROTMG(SD1,SD2,SB1,SB2,SPARAM)                           
*                                                                       
*         CONSTRUCT THE TWO-MULTIPLY,TWO-ADD,NO-SQUARE-RO0T             
*         GIVENS ROTATION                                               
*                                                                       
*                                                                       
*         THIS SUBROUTINE STORES VALUES IN SPARAM( )                    
*         DEFINING THE MATRIX H                                         
*                                                                       
*         SPARAM(1) = FLAG , INDICATES THE FORM OF THE MATRIX H         
*         SPARAM(2) = H11                                               
*         SPARAM(3) = H21                                               
*         SPARAM(4) = H12                                               
*         SPARAM(5) = H22                                               
*                                                                       
*         THE FLAG VALUES AND THE CORRESPONDING FORMS OF THE MATRIX H   
*         -2. (1 0)   -1. (H11 H12)   0. ( 1 H12)   1. (H11 1 )         
*             (0 1)       (H21 H22)      (H21 1 )      (-1 H22)         
*                                                                       
*         SD1,SD2,SB1,SB2           SINGLE PRECISION                    
*         SPARAM( )                 SINGLE PRECISION                    
*                                                                       
*         THIS ALGORITHM ASSUMES THAT THE INPUT VALUE OF SD1 IS         
*         POSITIVE OR ZERO BUT NON-NEGATIVE. THE VALUE OF SD2 IS        
*         UNRESTRICTED.                                                 
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND JAMES SULLIVAN               
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SROTMG                                                 
          VFD    42/6HSROTMG,18/5                                       
*                                                                       
 SROTMG   DATA   0             ENTRY/EXIT                               
          INFTN  SROTMG,5                                               
          SA1    B1            (X1) = SD1                               
          SA3    B3            (X3) = SB1                               
          RX0    X1*X3         (X0) = P1 = SD1*SB1                      
          SA2    B2            (X2) = SD2                               
          SA4    B4            (X4) = SB2                               
          RX5    X2*X4         (X5) = P2 = SD2*SB2                      
          RX6    X0*X3         (X6) = P1*SB1                            
          RX7    X5*X4         (X7) = P2*SB2                            
*                                                                       
          BX1    X6                                                     
          AX6    59                                                     
          BX6    X6-X1         (X6) = ABS(P1*SB1)                       
*                                                                       
          BX2    X7                                                     
          AX7    59                                                     
          BX7    X7-X2         (X7) = ABS(P2*SB2)                       
*                                                                       
          RX6    X7-X6                                                  
          NX6    X6                                                     
          NG     X6,TWELVE     IF( ABS(P1*SB1) .GT. ABS(P2*SB2) )       
*                                     GO TO 12                          
*                                                                       
          ZR     X2,FOUR                                                
          NG     X2,SIXTN      IF( P2*SB2 ) 16,4,10                     
*                                                                       
*                                                                       
          RX7    X3/X4         (X7) = SB1/SB2      ITEN                 
          SA1    B1            (X1) = SD1                               
          SA2    B2            (X2) = SD2                               
          RX6    X0/X5         (X6) = P1/P2                             
          SA7    B5+4          SPARAM(5) = (X7)                         
          SA6    B5+1          SPARAM(2) = (X6)                         
          RX0    X6*X7         (X0) = SPARAM(2)*SPARAM(5)               
          SA5    UNIT          (X5) = 1.0                               
          RX0    X5+X0         (X0) = 1.0 + SPARAM(2)*SPARAM(5) = U     
          NX0    X0                                                     
          BX7    X5            (X7) = X5                                
          RX5    X5/X0         (X5) = 1./U                              
          SA7    B5            SPARAM(1) = 1.0                          
          RX7    X4*X0         (X7) = SB2*(X0)                          
          SA7    B3            SB1 = (X7)                               
          BX3    X7            (X3) = SB1                               
          RX6    X2*X5         (X6) = SD2*(X5)                          
          RX7    X1*X5         (X7) = SD1*(X5)                          
          SA6    B1            SD1 = (X6)                               
          SA7    B2            SD2 = (X7)                               
          BX1    X6            (X1) = SD1                               
          BX2    X7            (X2) = SD2                               
          EQ     TWENTY4       GO TO 24                                 
*                                                                       
FOUR      SA5    RTWO                                                   
          BX6    -X5                                                    
          SA6    B5            SPARAM(1) = -2.0                         
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
*                                                                       
 TWELVE   RX7    X4/X3         (X7) = SB2/SB1                           
          SA1    B1            (X1) = SD1                               
          SA2    B2            (X2) = SD2                               
          RX6    X5/X0         (X6) = P2/P1                             
          BX7    -X7           (X7) = -SB2/SB1                          
          SA7    B5+2          SPARAM(3) = (X7)                         
          SA6    B5+3          SPARAM(4) = (X6)                         
          RX0    X6*X7         (X0) = SPARAM(4)*SPARAM(3)               
          SA5    UNIT          (X5) = 1.0                               
          RX5    X5-X0         (X0) = 1.0 - SPARAM(4)*SPARAM(3) = U     
          NX0    X5                                                     
*                                                                       
          SA5    TOL           (X5) = TOL                               
          RX5    X5-X0                                                  
          NX5    X5                                                     
          PL     X5,SIXTN     IF( U .LE. TOL ) GO TO 16                 
*                                                                       
*                              HERE WHEN U IS ZERO OR NEARLY ZERO.      
*                              ALSO WHEN SD1 IS NEGATIVE AND            
*                              ABS(SD1*SB1**1) .LE. ABS(SD2*SB2**2)     
*                              SINCE IN SUCH A CASE U SHOULD BE SMALL.  
*                                                                       
          SA5    UNIT          (X5) = 1.0                               
          RX5    X5/X0         (X5) = 1./U                              
          RX7    X3*X0         (X7) = SB1*U                             
          SA7    B3            SB1 = (X7)                               
          MX6    0             (X6) = 0.0                               
          SA6    B5            SPARAM(1) = 0.0                          
          BX3    X7            (X3) = SB1                               
          RX6    X1*X5         (X6) = SD1*(X5)                          
          RX7    X2*X5         (X7) = SD2*(X5)                          
          SA6    A1            SD1 = (X6)                               
          SA7    A2            SD2 = (X7)                               
          BX1    X6            (X1) = SD1                               
          BX2    X7            (X2) = SD2                               
*                                                                       
          EQ     TWENTY4       RETURN                                   
*                                                                       
 SIXTN    MX7    0             (X7) = 0.0                               
          SA5    UNIT          (X5) = -1.0                              
          BX6    -X5                                                    
          SA6    B5            SPARAM(1) = -1.0                         
          SA7    B5+1          SPARAM(2) = 0.0                          
          MX6    0             (X6) = 0.0                               
          SA6    B5+2          SPARAM(3) = 0.0                          
          SA7    B5+3          SPARAM(4) = 0.0                          
          SA6    B5+4          SPARAM(5) = 0.0                          
          SA7    B1            SD1 = 0.0                                
          SA6    B2            SD2 = 0.0                                
          SA7    B3            SB1 = 0.0                                
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
 TWENTY4  BX6    X1                                                     
          SA5    BIGINV                                                 
          AX6    59                                                     
          BX6    X6-X1                                                  
          RX5    X5-X6                                                  
          NX5    X5                                                     
          NG     X5,THIRTY6                                             
          ZR     X1,FOURTY8                                             
          SA5    B5                                                     
          ZR     X5,A84                                                 
          NG     X5,A32                                                 
          SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    -X5                                                    
          SA6    B5+3                                                   
          SA7    B5+2                                                   
          EQ     A92                                                    
 A84      SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    X5                                                     
          SA6    B5+1                                                   
          SA7    B5+4                                                   
          BX7    -X5                                                    
 A92      SA7    B5                                                     
 A32      SA5    SQRBIG2                                                
          RX6    X1*X5                                                  
          SA5    SQRBIGI                                                
          BX1    X6                                                     
          SA6    B1                                                     
          SA4    B5+1                                                   
          RX6    X3*X5                                                  
          RX7    X4*X5                                                  
          SA6    B3                                                     
          SA7    B5+1                                                   
          BX3    X6                                                     
          SA4    B5+3                                                   
          RX6    X4*X5                                                  
          SA6    B5+3                                                   
          EQ     TWENTY4                                                
 THIRTY6  BX6    X1                                                     
          SA5    BIG                                                    
          AX6    59                                                     
          BX6    X6-X1                                                  
          RX5    X6-X5                                                  
          NX5    X5                                                     
          NG     X5,FOURTY8                                             
          SA5    B5                                                     
          ZR     X5,B84                                                 
          NG     X5,B32                                                 
          SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    -X5                                                    
          SA6    B5+3                                                   
          SA7    B5+2                                                   
          EQ     B92                                                    
 B84      SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    X5                                                     
          SA6    B5+1                                                   
          SA7    B5+4                                                   
          BX7    -X5                                                    
 B92      SA7    B5                                                     
 B32      SA5    SQRBI2I                                                
          RX6    X1*X5                                                  
          SA5    SQRBIG                                                 
          BX1    X6                                                     
          SA6    B1                                                     
          SA4    B5+1                                                   
          RX6    X3*X5                                                  
          RX7    X4*X5                                                  
          SA6    B3                                                     
          SA7    B5+1                                                   
          BX3    X6                                                     
          SA4    B5+3                                                   
          RX6    X4*X5                                                  
          SA6    B5+3                                                   
          EQ     THIRTY6                                                
 FOURTY8  BX4    X2                                                     
          SA5    BIGINV                                                 
          AX4    59                                                     
          BX4    X4-X2                                                  
          RX5    X5-X4                                                  
          NX5    X5                                                     
          NG     X5,SIXTY                                               
          ZR     X2,OUT                                                 
          SA5    B5                                                     
          ZR     X5,C84                                                 
          NG     X5,C32                                                 
          SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    -X5                                                    
          SA6    B5+3                                                   
          SA7    B5+2                                                   
          EQ     C92                                                    
 C84      SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    X5                                                     
          SA6    B5+1                                                   
          SA7    B5+4                                                   
          BX7    -X5                                                    
 C92      SA7    B5                                                     
 C32      SA5    SQRBIG2                                                
          RX6    X2*X5                                                  
          SA5    SQRBIGI                                                
          BX2    X6                                                     
          SA6    B2                                                     
          SA4    B5+2                                                   
          RX7    X4*X5                                                  
          SA7    B5+2                                                   
          SA4    B5+4                                                   
          RX6    X4*X5                                                  
          SA6    B5+4                                                   
          EQ     FOURTY8                                                
 SIXTY    BX4    X2                                                     
          SA5    BIG                                                    
          AX4    59                                                     
          BX4    X4-X2                                                  
          RX5    X4-X5                                                  
          NX5    X5                                                     
          NG     X5,OUT                                                 
          SA5    B5                                                     
          ZR     X5,D84                                                 
          NG     X5,D32                                                 
          SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    -X5                                                    
          SA6    B5+3                                                   
          SA7    B5+2                                                   
          EQ     D92                                                    
 D84      SA5    UNIT                                                   
          BX6    X5                                                     
          BX7    X5                                                     
          SA6    B5+1                                                   
          SA7    B5+4                                                   
          BX7    -X5                                                    
 D92      SA7    B5                                                     
 D32      SA5    SQRBI2I                                                
          RX6    X2*X5                                                  
          SA5    SQRBIG                                                 
          BX2    X6                                                     
          SA6    B2                                                     
          SA4    B5+2                                                   
          RX7    X4*X5                                                  
          SA7    B5+2                                                   
          SA4    B5+4                                                   
          RX6    X4*X5                                                  
          SA6    B5+4                                                   
          EQ     SIXTY                                                  
 OUT      OUTFTN SROTMG        RETURN                                   
*                                                                       
 BIG      DATA   1.67772E7                                              
 BIGINV   DATA   5.96046E-8                                             
 RTWO     DATA   2.0                                                    
 SQRBIG   DATA   4096.0                                                 
 SQRBIGI  DATA   17044000000000000000B                                  
 SQRBIG2  DATA   17504000000000000000B                                  
 SQRBI2I  DATA   16704000000000000000B                                  
 TOL      DATA   0.0                                                    
 UNIT     DATA   1.0                                                    
*                                                                       
          END                                                           
*DECK,DROTMG                                                            
          IDENT  DROTMG                                                 
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DROTMG(DD1,DD2,DB1,DB2,DPARAM)                           
*                                                                       
*         CONSTRUCT THE TWO-MULTIPLY,TWO-ADD,NO-SQUARE-RO0T             
*         GIVENS ROTATION                                               
*                                                                       
*                                                                       
*         THIS SUBROUTINE STORES VALUES IN DPARAM( )                    
*         DEFINING THE MATRIX H                                         
*                                                                       
*         DPARAM(1) = FLAG , INDICATES THE FORM OF THE MATRIX H         
*         DPARAM(2) = H11                                               
*         DPARAM(3) = H21                                               
*         DPARAM(4) = H12                                               
*         DPARAM(5) = H22                                               
*                                                                       
*         THE FLAG VALUES AND THE CORRESPONDING FORMS OF THE MATRIX H   
*         -2. (1 0)   -1. (H11 H12)   0. ( 1 H12)   1. (H11 1 )         
*             (0 1)       (H21 H22)      (H21 1 )      (-1 H22)         
*                                                                       
*         DD1,DD2,DB1,DB2           DOUBLE PRECISION                    
*         DPARAM( )                 DOUBLE PRECISION                    
*                                                                       
*         THIS ALGORITHM ASSUMES THAT THE INPUT VALUE OF DD1 IS         
*         POSITIVE OR ZERO BUT NON-NEGATIVE. THE VALUE OF DD2 IS        
*         UNRESTRICTED.                                                 
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND JAMES SULLIVAN               
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DROTMG                                                 
          VFD    42/6HDROTMG,18/5                                       
*                                                                       
 DROTMG   DATA   0             ENTRY/EXIT                               
          INFTN  DROTMG,5                                               
          SA1    B1            (X1,X2) = DD1                            
          SA2    B1+1                                                   
          SA3    B3            (X3,X4) = DB1                            
          SA4    B3+1                                                   
*                                                                       
          FX7    X2*X3         (X6,X7) = DD1 * DB1                      
          FX6    X1*X4                                                  
          FX7    X6+X7                                                  
          DX6    X1*X3                                                  
          FX0    X1*X3                                                  
          FX7    X6+X7                                                  
          FX6    X0+X7                                                  
          DX7    X0+X7         (X6,X7) = (X1,X2) * (X3,X4)              
*                                                                       
          SA6    P1           (P1) = (X6,X7)                            
          SA7    P1+1         (P1) = DD1 * DB1                          
*                                                                       
          FX1    X4*X6         (X0,X1) = P1 * DB1                       
          FX2    X3*X7                                                  
          FX1    X1+X2                                                  
          DX0    X3*X6                                                  
          FX2    X3*X6                                                  
          FX1    X0+X1                                                  
          FX0    X1+X2                                                  
          DX1    X1+X2         (X0,X1) = (X3,X4) * (X6,X7)              
*                                                                       
          BX2    X0                                                     
          AX2    59                                                     
          BX0    X2-X0                                                  
          BX1    X2-X1         (X0,X1) = DABS( P1*DB1 )                 
*                                                                       
          SA2    B2            (X2,X3) = DD2                            
          SA3    B2+1                                                   
          SA4    B4            (X4,X5) = DB2                            
          SA5    B4+1                                                   
*                                                                       
          FX7    X3*X4         (X6,X7) = DD2 * DB2                      
          FX6    X2*X5                                                  
          FX7    X6+X7                                                  
          FX3    X2*X4                                                  
          DX6    X2*X4                                                  
          FX7    X6+X7                                                  
          FX6    X3+X7                                                  
          DX7    X3+X7         (X6,X7) = (X2,X3) * (X4,X5)              
*                                                                       
          SA6    P2           (P2) = (X6,X7)                            
          SA7    P2+1         (P2) = DD2 * DB2                          
*                                                                       
          FX2    X5*X6         (X2,X3) = P2 * DB2                       
          FX3    X4*X7                                                  
          FX2    X2+X3                                                  
          FX7    X4*X6                                                  
          DX3    X4*X6                                                  
          FX3    X2+X3                                                  
          FX2    X3+X7                                                  
          DX3    X3+X7         (X2,X3) = (X4,X5) * (X6,X7)              
*                                                                       
          BX6    X2                                                     
          BX7    X3                                                     
          SA6    TEMP                                                   
          SA7    TEMP+1        TEMP = P2*DB2                            
*                                                                       
          AX6    59                                                     
          BX2    X6-X2                                                  
          BX3    X6-X3         (X2,X3) = DABS( P2*DB2 )                 
*                                                                       
          FX6    X2-X0         COMPUTE DABS(P2*DB2) - DABS(P1*DB1).     
          DX7    X2-X0                                                  
          FX2    X3-X1                                                  
          NX6    X6                                                     
          FX0    X2+X7                                                  
          FX2    X0+X6                                                  
          NX7    X2                                                     
          DX0    X0+X6                                                  
          NX6    X0                                                     
          FX2    X6+X7                                                  
          DX3    X6+X7         (X2,X3) = (X2,X3) - (X0,X1)              
*                                                                       
*                                                                       
          NG     X2,TWELVE     IF( DABS(P1*DB1) .GT. DABS(P2*DB2) )     
*                                    GO TO TWELVE                       
*                                                                       
          SA2    TEMP          (X2,X3) = P2*DB2                         
          SA3    TEMP+1                                                 
          ZR     X2,FOUR                                                
          NG     X2,SIXTN      IF( P2*DB2 ) SIXTN,FOUR,TEN              
*                                                                       
          SA2    B3            (X2,X3) = DB1      ITEN                  
          SA3    B3+1                                                   
          SA4    B4            (X4,X5) = DB2                            
          SA5    B4+1                                                   
*                                                                       
          FX1    X2/X4         (X6,X7) = DB1 / DB2                      
          FX6    X1*X4                                                  
          FX7    X2-X6                                                  
          DX6    X2-X6                                                  
          NX7    X7                                                     
          FX6    X6+X7                                                  
          DX7    X1*X4                                                  
          FX0    X1*X5                                                  
          FX6    X3+X6                                                  
          FX6    X6-X7                                                  
          FX6    X6-X0                                                  
          FX0    X6/X4                                                  
          FX6    X0+X1                                                  
          DX7    X0+X1                                                  
          NX1    X6                                                     
          FX6    X1+X7                                                  
          DX7    X1+X7         (X6,X7) = (X2,X3) / (X4,X5)              
*                                                                       
          SA6    B5+8           (DPARAM(5)) = (X6,X7)                   
          SA7    B5+9           (DPARAM(5)) = DB1 / DB2                 
*                                                                       
          SA2    P1           (X2,X3) = P1                              
          SA3    P1+1                                                   
          SA4    P2           (X4,X5) = P2                              
          SA5    P2+1                                                   
*                                                                       
          FX1    X2/X4         (X6,X7) = P1 / P2                        
          FX6    X1*X4                                                  
          FX7    X2-X6                                                  
          DX6    X2-X6                                                  
          NX7    X7                                                     
          FX6    X6+X7                                                  
          DX7    X1*X4                                                  
          FX0    X1*X5                                                  
          FX6    X3+X6                                                  
          FX6    X6-X7                                                  
          FX6    X6-X0                                                  
          FX0    X6/X4                                                  
          FX6    X0+X1                                                  
          DX7    X0+X1                                                  
          NX1    X6                                                     
          FX6    X1+X7                                                  
          DX7    X1+X7         (X6,X7) = (X2,X3) / (X4,X5)              
*                                                                       
          SA6    B5+2         (DPARAM(2)) = (X6,X7)                     
          SA7    B5+3         (DPARAM(2)) = P1 / P2                     
*                                                                       
          SA4    B5+8                (X4,X5) = B5+8                     
          SA5    B5+9                                                   
*                                                                       
          FX1    X4*X7         (X1,X2) = DPARAM(2) * DPARAM(5)          
          FX2    X5*X6                                                  
          FX1    X1+X2                                                  
          DX2    X4*X6                                                  
          FX0    X4*X6                                                  
          FX1    X1+X2                                                  
          DX2    X0+X1                                                  
          FX1    X0+X1         (X1,X2) = (X4,X5) * (X6,X7)              
*                                                                       
          SA3    UNIT          (X3) = +1.                               
*                                                                       
          FX6    X1+X3         (X4,X5) = 1.D0 + (DPARAM(2)*DPARAM(5))   
          DX7    X1+X3                                                  
          NX6    X6                                                     
          FX5    X2+X7                                                  
          FX4    X5+X6                                                  
          NX7    X4                                                     
          DX5    X5+X6                                                  
          NX6    X5                                                     
          FX4    X6+X7                                                  
          DX5    X6+X7         (X4,X5) = (X3,0) + (X1,X2)    IU         
*                                                                       
          SA1    B4            (X1,X2) = DB2                            
          SA2    B4+1                                                   
*                                                                       
          FX6    X1*X5         (X6,X7) = DB2 * U                        
          FX7    X2*X4                                                  
          FX6    X6+X7                                                  
          DX7    X1*X4                                                  
          FX0    X1*X4                                                  
          FX7    X6+X7                                                  
          FX6    X0+X7                                                  
          DX7    X0+X7         (X6,X7) = (X1,X2) * (X4,X5)              
*                                                                       
          SA6    B3            (DB1) = (X6,X7)                          
          SA7    B3+1          (DB1) = DB2 * U                          
*                                                                       
          FX7    X3/X4         (X0,X1) = 1.D0 / U                       
          FX0    X4*X7                                                  
          FX1    X3-X0                                                  
          DX0    X3-X0                                                  
          NX1    X1                                                     
          FX0    X0+X1                                                  
          DX1    X4*X7                                                  
          FX6    X5*X7                                                  
          FX0    X0-X1                                                  
          FX0    X0-X6                                                  
          FX6    X0/X4                                                  
          FX0    X6+X7                                                  
          DX1    X6+X7                                                  
          NX7    X0                                                     
          FX0    X1+X7                                                  
          DX1    X1+X7         (X0,X1) = (X3,0) / (X4,X5)               
*                                                                       
          SA2    B2            (X2,X3) = DD2                            
          SA3    B2+1                                                   
*                                                                       
          FX6    X1*X2         (X6,X7) = DD2 * (1.D0/U)                 
          FX7    X0*X3                                                  
          FX6    X6+X7                                                  
          DX7    X0*X2                                                  
          FX4    X0*X2                                                  
          FX7    X6+X7                                                  
          FX6    X4+X7                                                  
          DX7    X4+X7         (X6,X7) = (X0,X1) * (X2,X3)   IZ         
*                                                                       
          SA4    B1            (X4,X5) = DD1                            
          SA5    B1+1                                                   
*                                                                       
          SA6    A4            (DD1) = (X6,X7)                          
          SA7    A5            (DD1) = DD2 * (1.D0/U) = Z               
*                                                                       
          FX2    X1*X4         (X6,X7) = DD1 * (1.D0/U)                 
          FX3    X0*X5                                                  
          FX2    X2+X3                                                  
          DX3    X0*X4                                                  
          FX7    X0*X4                                                  
          FX3    X2+X3                                                  
          FX6    X3+X7                                                  
          DX7    X3+X7         (X6,X7) = (X0,X1) * (X4,X5)              
*                                                                       
          SA6    A2            (DD2) = (X6,X7)                          
          SA7    A3            (DD2) = DD1 * (1.D0/U)                   
          SA1    UNIT                                                   
          MX7    0                                                      
          BX6    X1                                                     
          SA7    B5+1                                                   
          SA6    B5                                                     
*                                                                       
          EQ     TWENTY4       GO TO TWENTY4                            
 FOUR     SA1    RTWO          (X1) = 2.0                               
          MX7    0             (X7) = 0.0                               
          BX6    -X1           (X6) = -(X1)                             
          SA7    B5+1                                                   
          SA6    B5            DPARAM(1) = -2.0                         
          EQ     OUT           GO TO OUT                                
*                                                                       
*                                                                       
 TWELVE   SA2    B3            (X2,X3) = DB1                            
          SA3    B3+1                                                   
          SA4    B4            (X4,X5) = DB2                            
          SA5    B4+1                                                   
*                                                                       
          FX1    X4/X2         (X6,X7) = DB2 / DB1                      
          FX6    X1*X2                                                  
          FX7    X4-X6                                                  
          DX6    X4-X6                                                  
          NX7    X7                                                     
          FX6    X6+X7                                                  
          DX7    X1*X2                                                  
          FX0    X1*X3                                                  
          FX6    X5+X6                                                  
          FX6    X6-X7                                                  
          FX6    X6-X0                                                  
          FX0    X6/X2                                                  
          FX6    X0+X1                                                  
          DX7    X0+X1                                                  
          NX1    X6                                                     
          FX6    X1+X7                                                  
          DX7    X1+X7         (X6,X7) = (X4,X5) / (X2,X3)              
*                                                                       
          BX6    -X6           (X6,X7) = -DB2/DB1                       
          BX7    -X7                                                    
*                                                                       
          SA6    B5+4     (DPARAM(3)) = (X6,X7)                         
          SA7    B5+5                 = - DB2 / DB1                     
*                                                                       
          SA2    P2           (X2,X3) = P2                              
          SA3    P2+1                                                   
          SA4    P1           (X4,X5) = P1                              
          SA5    P1+1                                                   
*                                                                       
          FX1    X2/X4         (X6,X7) = P2 / P1                        
          FX6    X1*X4                                                  
          FX7    X2-X6                                                  
          DX6    X2-X6                                                  
          NX7    X7                                                     
          FX6    X6+X7                                                  
          DX7    X1*X4                                                  
          FX0    X1*X5                                                  
          FX6    X3+X6                                                  
          FX6    X6-X7                                                  
          FX6    X6-X0                                                  
          FX0    X6/X4                                                  
          FX6    X0+X1                                                  
          DX7    X0+X1                                                  
          NX1    X6                                                     
          FX6    X1+X7                                                  
          DX7    X1+X7         (X6,X7) = (X2,X3) / (X4,X5)              
*                                                                       
          SA6    B5+6     (DPARAM(4) = (X6,X7)                          
          SA7    B5+7     (DPARAM(4) = P2 / P1                          
*                                                                       
          SA4    B5+4     (X4,X5) = DPARAM(3)                           
          SA5    B5+5                                                   
*                                                                       
          FX1    X4*X7         (X1,X2) = DPARAM(4) * DPARAM(3)          
          FX2    X5*X6                                                  
          FX1    X1+X2                                                  
          DX2    X4*X6                                                  
          FX0    X4*X6                                                  
          FX1    X1+X2                                                  
          DX2    X0+X1                                                  
          FX1    X0+X1         (X1,X2) = (X4,X5) * (X6,X7)              
*                                                                       
          SA3    UNIT          (X3) = +1.                               
*                                                                       
          FX6    X3-X1         (X4,X5) = 1.D0 - (DPARAM(4)*DPARAM(3))   
          DX7    X3-X1                                                  
          NX6    X6                                                     
          FX5    X7-X2                                                  
          FX4    X5+X6                                                  
          NX7    X4                                                     
          DX5    X5+X6                                                  
          NX6    X5                                                     
          FX4    X6+X7                                                  
          DX5    X6+X7         (X4,X5) = (X3,0) - (X1,X2)    IU         
*                                                                       
* INSERT IF(U .LE. TOL) GO TO 16  HERE                                  
          ZR     X4,SIXTN                                               
          SA1    B3            (X1,X2) = DB1                            
          SA2    B3+1                                                   
*                                                                       
          FX6    X1*X5         (X6,X7) = DB1 * U                        
          FX7    X2*X4                                                  
          FX6    X6+X7                                                  
          DX7    X1*X4                                                  
          FX0    X1*X4                                                  
          FX7    X6+X7                                                  
          FX6    X0+X7                                                  
          DX7    X0+X7         (X6,X7) = (X1,X2) * (X4,X5)              
*                                                                       
          SA6    A1            (DB1) = (X6,X7)                          
          SA7    A2            (DB1) = DB1 * U                          
*                                                                       
          FX7    X3/X4         (X0,X1) = 1.D0 / U                       
          FX0    X4*X7                                                  
          FX1    X3-X0                                                  
          DX0    X3-X0                                                  
          NX1    X1                                                     
          FX0    X0+X1                                                  
          DX1    X4*X7                                                  
          FX6    X5*X7                                                  
          FX0    X0-X1                                                  
          FX0    X0-X6                                                  
          FX6    X0/X4                                                  
          FX0    X6+X7                                                  
          DX1    X6+X7                                                  
          NX7    X0                                                     
          FX0    X1+X7                                                  
          DX1    X1+X7         (X0,X1) = (X3,0) / (X4,X5)               
*                                                                       
          SA2    B1            (X2,X3) = DD1                            
          SA3    B1+1                                                   
*                                                                       
          FX6    X1*X2         (X6,X7) = DD1 * (1.D0/U)                 
          FX7    X0*X3                                                  
          FX6    X6+X7                                                  
          DX7    X0*X2                                                  
          FX4    X0*X2                                                  
          FX7    X6+X7                                                  
          FX6    X4+X7                                                  
          DX7    X4+X7         (X6,X7) = (X0,X1) * (X2,X3)              
*                                                                       
          SA6    A2            (DD1) = (X6,X7)                          
          SA7    A3            (DD1) = DD1 / U                          
*                                                                       
          SA4    B2            (X4,X5) = DD2                            
          SA5    B2+1                                                   
*                                                                       
          FX6    X1*X4         (X6,X7) = DD2 * (1.D0/U)                 
          FX7    X0*X5                                                  
          FX6    X6+X7                                                  
          DX7    X0*X4                                                  
          FX2    X0*X4                                                  
          FX7    X6+X7                                                  
          FX6    X2+X7                                                  
          DX7    X2+X7         (X6,X7) = (X0,X1) * (X4,X5)              
*                                                                       
          SA6    A4            (DD2) = (X6,X7)                          
          SA7    A5            (DD2) = DD2 / U                          
          MX6    0                                                      
          BX7    X6                                                     
          SA6    B5                                                     
          SA7    B5+1                                                   
*                                                                       
          EQ     TWENTY4                                                
*                                                                       
*                                                                       
*                                                                       
*                              HERE WHEN U IS ZERO OR NEARLY ZERO.      
*                              ALSO WHEN D1 IS NEGATIVE AND             
*                              DABS(D1*B1**2) .LE. DABS(D2*B2**2)       
*                              SINCE IN SUCH A CASE U SHOULD BE SMALL.  
*                                                                       
*                                                                       
 SIXTN    SA5    UNIT          (X5) = +1.0                              
          MX4    0             (X4) = 0.0                               
          BX7    X4            (X7) = 0.0                               
          BX6    -X5           (X6) = -X5                               
          SA6    B5            (SPARAM(1)) = (X6,X7) = -1.0D            
          SA7    B5+1                                                   
          BX6    X7            (X6,X7) = 0.0D                           
          SA6    B5+2          (SPARAM(2)) = 0.0D                       
          SA7    B5+3                                                   
          SA6    B5+4          (SPARAM(3)) = 0.0D                       
          SA7    B5+5                                                   
          SA6    B5+6          (SPARAM(4)) = 0.0D                       
          SA7    B5+7                                                   
          SA6    B5+8          (SPARAM(5)) = 0.0D                       
          SA7    B5+9                                                   
*                                                                       
          SA6    B1            DD1 = 0.0D                               
          SA7    B1+1                                                   
          SA6    B2            DD2 = 0.0D                               
          SA7    B2+1                                                   
          SA6    B3            DB1 = 0.0D                               
          SA7    B3+1                                                   
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
*                                                                       
*                              HERE TO RESCALE IF NECESSARY TO KEEP     
*                              DD1 AND DD2 BETWEEN  BIG AND 1/BIG       
*                              IF NONZERO                               
*                                                                       
*                                                                       
 TWENTY4  SA3    B1            (X3,X4) = DD1                            
          SA4    B1+1                                                   
          SA5    BIGINV        (X5,) = BIGINV                           
          BX0    X3                                                     
          AX0    59                                                     
          BX0    X0-X3         (X0,) = DABS(DD1)                        
          FX0    X5-X0         IF ( DABS(DD1) .GT. BIGINV ) GO TO 36    
          NX0    X0                                                     
          NG     X0,THIRTY6                                             
          ZR     X3,FOURTY8    IF (DD1) 28,48,28                        
          SA1    B5            (X1,) = DPARAM(1)          I28           
          SA2    UNIT                                                   
          ZR     X1,A84        IF (DPARAM(1)) 96,84,88(A)               
          NG     X1,A96                                                 
          BX6    X2                                        IA88         
          MX7    0                                                      
          SA6    B5+6          DPARAM(4) = 1.0                          
          SA7    B5+7                                                   
          BX6    -X6                                                    
          SA6    B5+4          DPARAM(3) = -1.0                         
          SA7    B5+5                                                   
          EQ     A92           GO TO 92(A)                              
 A84      BX6    X2                                                     
          MX7    0                                                      
          SA6    B5+2          DPARAM(2) = 1.0                          
          SA7    B5+3                                                   
          SA6    B5+8          DPARAM(5) = 1.0                          
          SA7    B5+9                                                   
          BX6    -X6                                                    
 A92      SA7    B5+1          DPARAM(1) = -1.0                         
          SA6    B5                                                     
 A96      SA5    BIG           (X5,) = BIG                              
          FX1    X4*X5         DD1 = DD1 * (SQRBIG*SQRBIG)              
          DX7    X3*X5                                                  
          FX6    X3*X5                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X3,X4) * (X5,0)               
          SA7    B1+1          DD1 = (X6,X7)                            
          SA6    B1                                                     
          SA2    B3            (X2,X3) = DB1                            
          SA3    B3+1                                                   
          SA4    SQRBIGI       (X4,) = SQRBIGI                          
          FX1    X3*X4         (X6,X7) = DB1/SQRBIG                     
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B3+1          DB1 = (X6,X7)                            
          SA6    B3                                                     
          SA2    B5+2          (X2,X3) = DPARAM(2)                      
          SA3    B5+3                                                   
          FX1    X3*X4         (X6,X7) = DPARAM(2)/SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+3          DPARAM(2) = (X6,X7)                      
          SA6    B5+2                                                   
          SA2    B5+6          (X2,X3) = DPARAM(4)                      
          SA3    B5+7                                                   
          FX1    X3*X4         (X6,X7) = DPARAM(4)/SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+7          DPARAM(4) = (X6,X7)                      
          SA6    B5+6                                                   
          EQ     TWENTY4       GO TO 24                                 
 THIRTY6  SA3    B1            (X3,X4) = DD1                            
          SA4    B1+1                                                   
          SA5    BIG           (X5,) = BIG                              
          BX0    X3                                                     
          AX0    59                                                     
          BX0    X0-X3         (X0,) = DABS(DD1)                        
          FX0    X0-X5         IF ( DABS(DD1) .LT. BIG ) GO TO 48       
          NX0    X0                                                     
          NG     X0,FOURTY8                                             
          SA1    B5            (X1,) = DPARAM(1)                        
          SA2    UNIT                                                   
          ZR     X1,B84        IF (DPARAM(1)) 96,84,88(B)               
          NG     X1,B96                                                 
          BX6    X2                                        IB88         
          MX7    0                                                      
          SA6    B5+6          DPARAM(4) = 1.0                          
          SA7    B5+7                                                   
          BX6    -X6                                                    
          SA6    B5+4          DPARAM(3) = -1.0                         
          SA7    B5+5                                                   
          EQ     B92           GO TO 92(B)                              
 B84      BX6    X2                                                     
          MX7    0                                                      
          SA6    B5+2          DPARAM(2) = 1.0                          
          SA7    B5+3                                                   
          SA6    B5+8          DPARAM(5) = 1.0                          
          SA7    B5+9                                                   
          BX6    -X6                                                    
 B92      SA7    B5+1          DPARAM(1) = -1.0                         
          SA6    B5                                                     
 B96      SA5    BIGINV        (X5,) = BIGINV                           
          FX1    X4*X5         DD1 = DD1 / (SQRBIG*SQRBIG)              
          DX7    X3*X5                                                  
          FX6    X3*X5                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X3,X4) * (X5,0)               
          SA7    B1+1          DD1 = (X6,X7)                            
          SA6    B1                                                     
          SA2    B3            (X2,X3) = DB1                            
          SA3    B3+1                                                   
          SA4    SQRBIG        (X4,) = SQRBIG                           
          FX1    X3*X4         (X6,X7) = DB1*SQRBIG                     
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B3+1          DB1 = (X6,X7)                            
          SA6    B3                                                     
          SA2    B5+2          (X2,X3) = DPARAM(2)                      
          SA3    B5+3                                                   
          FX1    X3*X4         (X6,X7) = DPARAM(2)*SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+3          DPARAM(2) = (X6,X7)                      
          SA6    B5+2                                                   
          SA2    B5+6          (X2,X3) = DPARAM(4)                      
          SA3    B5+7                                                   
          FX1    X3*X4         (X6,X7) = DPARAM(4)*SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+7          DPARAM(4) = (X6,X7)                      
          SA6    B5+6                                                   
          EQ     THIRTY6       GO TO 36                                 
 FOURTY8  SA3    B2            (X3,X4) = DD2                            
          SA4    B2+1                                                   
          SA5    BIGINV        (X5,) = BIGINV                           
          BX0    X3                                                     
          AX0    59                                                     
          BX0    X0-X3         (X0,) = DABS(DD2)                        
          FX0    X5-X0         IF ( DABS(DD2) .GT. BIGINV ) GO TO 60    
          NX0    X0                                                     
          NG     X0,SIXTY                                               
          ZR     X3,OUT        IF(DD2 .EQ. 0.0) GO TO OUT               
          SA1    B5            (X1,) = DPARAM(1)                        
          SA2    UNIT                                                   
          ZR     X1,C84        IF (DPARAM(1)) 96,84,88(C)               
          NG     X1,C96                                                 
          BX6    X2                                        IC88         
          MX7    0                                                      
          SA6    B5+6          DPARAM(4) = 1.0                          
          SA7    B5+7                                                   
          BX6    -X6                                                    
          SA6    B5+4          DPARAM(3) = -1.0                         
          SA7    B5+5                                                   
          EQ     C92           GO TO 92(C)                              
 C84      BX6    X2                                                     
          MX7    0                                                      
          SA6    B5+2          DPARAM(2) = 1.0                          
          SA7    B5+3                                                   
          SA6    B5+8          DPARAM(5) = 1.0                          
          SA7    B5+9                                                   
          BX6    -X6                                                    
 C92      SA7    B5+1          DPARAM(1) = -1.0                         
          SA6    B5                                                     
 C96      SA5    BIG           (X5,) = BIG                              
          FX1    X4*X5         DD2 = DD2 * (SQRBIG*SQRBIG)              
          DX7    X3*X5                                                  
          FX6    X3*X5                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X3,X4) * (X5,0)               
          SA7    B2+1          DD2 = (X6,X7)                            
          SA6    B2                                                     
          SA2    B5+4          (X2,X3) = DPARAM(3)                      
          SA3    B5+5                                                   
          SA4    SQRBIGI       (X4,) = SQRBIGI                          
          FX1    X3*X4         (X6,X7) = DPARAM(3)/SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+5          DPARAM(3) = (X6,X7)                      
          SA6    B5+4                                                   
          SA2    B5+8          (X2,X3) = DPARAM(5)                      
          SA3    B5+9                                                   
          FX1    X3*X4         (X6,X7) = DPARAM(5)/SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+9          DPARAM(5) = (X6,X7)                      
          SA6    B5+8                                                   
          EQ     FOURTY8       GO TO 48                                 
 SIXTY    SA3    B2            (X3,X4) = DD2                            
          SA4    B2+1                                                   
          SA5    BIG           (X5,) = BIG                              
          BX0    X3                                                     
          AX0    59                                                     
          BX0    X0-X3         (X0,) = DABS(DD2)                        
          FX0    X0-X5         IF ( DABS(DD2) .LT. BIG ) RETURN         
          NX0    X0                                                     
          NG     X0,OUT        GO TO OUT                                
          SA1    B5            (X1,) = DPARAM(1)                        
          SA2    UNIT                                                   
          ZR     X1,D84        IF (DPARAM(1)) 96,84,88(D)               
          NG     X1,D96                                                 
          BX6    X2                                        ID88         
          MX7    0                                                      
          SA6    B5+6          DPARAM(4) = 1.0                          
          SA7    B5+7                                                   
          BX6    -X6                                                    
          SA6    B5+4          DPARAM(3) = -1.0                         
          SA7    B5+5                                                   
          EQ     D92           GO TO 92(D)                              
 D84      BX6    X2                                                     
          MX7    0                                                      
          SA6    B5+2          DPARAM(2) = 1.0                          
          SA7    B5+3                                                   
          SA6    B5+8          DPARAM(5) = 1.0                          
          SA7    B5+9                                                   
          BX6    -X6                                                    
 D92      SA7    B5+1          DPARAM(1) = -1.0                         
          SA6    B5                                                     
 D96      SA5    BIGINV        (X5,) = BIGINV                           
          FX1    X4*X5         DD2 = DD2 / (SQRBIG*SQRBIG)              
          DX7    X3*X5                                                  
          FX6    X3*X5                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X3,X4) * (X5,0)               
          SA7    B2+1          DD2 = (X6,X7)                            
          SA6    B2                                                     
          SA2    B5+4          (X2,X3) = DPARAM(3)                      
          SA3    B5+5                                                   
          SA4    SQRBIG        (X4,) = SQRBIG                           
          FX1    X3*X4         (X6,X7) = DPARAM(3)*SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+5          DPARAM(3) = (X6,X7)                      
          SA6    B5+4                                                   
          SA2    B5+8          (X2,X3) = DPARAM(5)                      
          SA3    B5+9                                                   
          FX1    X3*X4         (X6,X7) = DPARAM(5)*SQRBIG               
          DX7    X2*X4                                                  
          FX6    X2*X4                                                  
          FX1    X1+X7                                                  
          DX7    X1+X6                                                  
          FX6    X1+X6         (X6,X7) = (X2,X3) * (X4,0)               
          SA7    B5+9          DPARAM(5) = (X6,X7)                      
          SA6    B5+8                                                   
          EQ     SIXTY         GO TO 60                                 
 OUT      OUTFTN DROTMG        RETURN                                   
*                                                                       
 P1       BSS    2                                                      
 P2       BSS    2                                                      
 TEMP     BSS    2                                                      
 BIG      DATA   17504000000000000000B                                  
 BIGINV   DATA   16704000000000000000B                                  
 RTWO     DATA   17214000000000000000B                                  
 SQRBIG   DATA   17344000000000000000B                                  
 SQRBIGI  DATA   17044000000000000000B                                  
 TOL      DATA   0.0                                                    
 UNIT     DATA   17204000000000000000B                                  
*                                                                       
          END                                                           
*DECK,SROTM                                                             
          IDENT  SROTM                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SROTM(N,SX,INCX,SY,INCY,SPARAM)                          
*                                                                       
*         APPLY THE TWO-MULTIPLY,TWO-ADD,GIVENS TRANSFORMATION          
*                                                                       
*         TO 2XN MATRIX  (SXI1  ... SXIN )                              
*                        (SYI1  ... SYIN )                              
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         CONTENTS OF SPARAM( ) MUST BE PREVIOUSLY DEFINED BY           
*         SROTMG                                                        
*                                                                       
*         SPARAM(1) = FLAG , INDICATES THE FORM OF THE MATRIX H         
*         SPARAM(2) = H11                                               
*         SPARAM(3) = H21                                               
*         SPARAM(4) = H12                                               
*         SPARAM(5) = H22                                               
*                                                                       
*         THE FLAG VALUES AND THE CORRESPONDING FORMS OF THE MATRIX H   
*         -2. (1 0)   -1. (H11 H12)   0. ( 1 H12)   1. (H11 1 )         
*             (0 1)       (H21 H22)      (H21 1 )      (-1 H22)         
*                                                                       
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         SPARAM( )                 SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  RICHARD J. HANSON                                 
*                     SANDIA LABORATORIES                               
*                     ALBUQUERQUE, NEW MEXICO                           
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SROTM                                                  
          VFD    42/5HSROTM,18/6                                        
*                                                                       
 SROTM    DATA   0                                                      
          INFTN  SROTM,6     PROPER LINKAGE (RUN,FTN) MACRO             
*                                                                       
          SA1    B1          (X1)=N                                     
          SB7    1           (B7)=1                                     
*                                                                       
          SB1    X1          (B1)=N                                     
          SB1    B1-B7       (B1)=N-1                                   
*                                                                       
          MI     B1,OUT      IF (N .LE. 0), QUIT                        
*                                                                       
*                                                                       
          SA1    B2          (X1)=SX(1)                                 
          SA2    B3          (X2)=INCX                                  
*                                                                       
          SA3    B4          (X3)=SY(1)                                 
          SA4    B5          (X4)=INCY                                  
          SA5    B6          (X5)=SPARAM(1), (A5)=LOC(SPARAM(1))        
*                                                                       
          ZR     B1,INCYNN   IF (N .EQ. 1) NO NEED TO TEST FOR NEG. INC.
          SX0    -B1         (X0)=-(N-1)                                
*                                                                       
*                                                                       
          SB2    X2          (B2)=INCX                                  
          SB3    X4          (B3)=INCY                                  
*                                                                       
          GE     B2,INCXNN   IF (INCX .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX2    X0*X2       COMPUTE -(N-1)*INCX                        
          SB7    A1          (B7)=LOC(SX(1))                            
          SA1    B7+X2       (X1)=SX(1+(1-N)*INCX),(A1)=LOC(X(1))       
*                                                                       
 INCXNN   GE     B3,INCYNN   IF (INCY .GE. 0) NO ADDRESS FIXUP NEEDED   
          DX4    X0*X4       COMPUTE -(N-1)*INCY                        
          SB7    A3          (B7)=LOC(SY(1))                            
          SA3    B7+X4       (X3)=SY(1+(1-N)*INCY),(A3)=LOC(Y(1))       
*                                                                       
 INCYNN   SB7    1           (B7)=1                                     
          SB6    B7          (B6)=I=1                                   
          ZR     X5,SP1E0    IF (SPARAM(1) .EQ. 0.0)                    
          PL     X5,SP1E1    IF (SPARAM(1) .EQ. 1.0)                    
          SA4    STWO        (X4)=2.0                                   
*                                                                       
          RX4    X4+X5       (X4)=SPARAM(1)+2.0                         
          NX4    X4          (X4)=NORM.(X4)                             
          ZR     X4,OUT      IF (SPARAM(1) .EQ. -2.0), QUIT             
*                                                                       
*    HERE SPARAM(1)=-1.0.  PERFORM (RARELY USED) RESCALING LOOP         
          SA2    A5+1        (X2)=SPARAM(2)=H11                         
          SA4    A5+3        (X4)=SPARAM(4)=H12                         
          BX0    X2          (X0)=H11                                   
          SA2    A5+2        (X2)=SPARAM(3)=H21                         
          SA5    A5+4        (X5)=SPARAM(5)=H22                         
*                                                                       
*    APPLY  (H11   H12)  TO (SX(1) ... SX(N))                           
*           (         )     (               )                           
*           (H21   H22)     (SY(1) ... SY(N))                           
          GT     B6,B1,CLR   IF (I .GT. N-1) CLEAN-UP LOGIC             
 LOOP     RX6    X0*X1       (X6)=H11*SX(I)                             
          RX7    X1*X2       (X7)=H21*SX(I)                             
          RX1    X3*X4       (X1)=H12*SY(I)                             
          RX3    X3*X5       (X3)=H22*SY(I)                             
          RX6    X1+X6       (X6)=H11*SX(I)+H12*SY(I)                   
*                                                                       
          SA1    A1+B2       (X1)=SX(I+1). NEXT ITER.                   
          NX6    X6          (X6)=NORM.(X6)                             
          RX7    X3+X7       (X7)=H21*SX(I)+H22*SY(I)                   
          SA3    A3+B3       (X3)=SY(I+1). NEXT ITER.                   
          SA6    A1-B2       SX(I)=(X6)                                 
          NX7    X7          (X7)=NORM.(X7)                             
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          SA7    A3-B3       SY(I-1)=(X7)                               
*                                                                       
          LE     B6,B1,LOOP  IF (I .LE. N-1) CONTINUE LOOP              
 CLR      RX6    X0*X1       (X6)=H11*SX(N)                             
          RX7    X1*X2       (X7)=H21*SX(N)                             
          RX1    X3*X4       (X1)=H12*SY(N)                             
          RX3    X3*X5       (X3)=H22*SY(N)                             
          RX6    X1+X6       (X6)=H11*SX(N)+H12*SY(N)                   
          RX7    X3+X7       (X7)=H21*SX(N)+H22*SY(N)                   
          NX6    X6          (X6)=NORM.(X6)                             
          NX7    X7          (X7)=NORM.(X7)                             
          SA6    A1          SX(N)=(X6)                                 
          SA7    A3          SY(N)=(X7)                                 
          JP     OUT         QUIT                                       
*                                                                       
*    APPLY  ( 1    H12)  TO (SX(1) ... SX(N))                           
*           (         )     (               )                           
*           (H21    1 )     (SY(1) ... SY(N))                           
 SP1E0    SA2    A5+2        (X2)=SPARAM(3)=H21                         
          SA5    A5+3        (X5)=SPARAM(4)=H12                         
          BX0    X2          (X0)=H21                                   
          SB1    B1-B7       (B1)=N-2                                   
          GT     B6,B1,FIXN0 IF (I .GT. N-2) CLEAN-UP LOGIC             
*                                                                       
 LOOP0    SA2    A1+B2       (X2)=SX(I+1)                               
          SA4    A3+B3       (X4)=SY(I+1)                               
          RX7    X0*X1       (X7)=H21*SX(I)                             
          RX6    X3*X5       (X6)=H12*SY(I)                             
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          NO     3           DEAD                                       
*                                                                       
          RX7    X3+X7       (X7)=SY(I-1)+H21*SX(I-1)                   
          RX3    X0*X2       (X3)=H21*SX(I)                             
          RX6    X1+X6       (X6)=SX(I-1)+H12*SY(I-1)                   
          RX1    X4*X5       (X1)=H12*SY(I)                             
          NO     0           DEAD                                       
          NX7    X7          (X7)=NORM.(X7)                             
          RX4    X4+X3       (X2)=SY(I)+H21*SX(I)                       
          NX6    X6          (X6)=NORM.(X6)                             
*                                                                       
          SA3    A4+B3       (X3)=SY(I+1) NEXT ITERATION                
          SA7    A4-B3       SY(I-1)=(X7)                               
          RX2    X1+X2       (X4)=SX(I)+H12*SY(I)                       
          SA6    A2-B2       SX(I-1)=(X6)                               
          NX7    X4          (X7)=NORM.(X4)                             
          SA1    A2+B2       (X1)=SX(I+1) NEXT ITERATION                
          NX6    X2          (X6)=NORM.(X2)                             
          NO     0           DEAD                                       
          SA7    A4          SY(I)=(X7)                                 
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          NO     0           DEAD                                       
          SA6    A2          SX(I-1)=(X6)                               
          LE     B6,B1,LOOP0 IF (I .LE. N-2) CONTINUE LOOP              
 FIXN0    SB1    B1+B7       (B1)=N-1                                   
          SB1    B1+B7       (B1)=N                                     
*    HERE ONE VECTOR IS PRE-FETCHED. AT MOST TWO COMPS. REMAIN          
 CL0      RX7    X0*X1       (X7)=H21*SX(I)                             
          RX6    X3*X5       (X6)=H12*SY(I)                             
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          RX7    X3+X7       (X7)=SY(I-1)+H21*SX(I-1)                   
          RX6    X1+X6       (X6)=SX(I-1)+H12*SY(I-1)                   
          NX7    X7          (X7)=NORM.(X7)                             
          NX6    X6          (X6)=NORM.(X6)                             
          SA7    A3          SY(I-1)=(X7)                               
          SA6    A1          SX(I-1)=(X6)                               
          GT     B6,B1,OUT   IF (I .GT. N) QUIT                         
          SA1    A1+B2       (X1)=SX(I)                                 
          SA3    A3+B3       (X3)=SY(I)                                 
          JP     CL0                                                    
*                                                                       
*    APPLY  (H11    1 )  TO (SX(1) ... SX(N))                           
*           (         )     (               )                           
*           (-1    H22)     (SY(1) ... SY(N))                           
 SP1E1    SA2    A5+1        (X2)=SPARAM(2)=H11                         
          SA5    A5+4        (X5)=SPARAM(5)=H22                         
          BX0    X2          (X0)=H11                                   
          SB1    B1-B7       (B1)=N-2                                   
          GT     B6,B1,FIXN1 IF (I .GT. N-2) CLEAN-UP LOGIC             
*                                                                       
 LOOP1    SA2    A1+B2       (X2)=SX(I+1)                               
          SA4    A3+B3       (X4)=SY(I+1)                               
          RX7    X3*X5       (X7)=H22*SY(I)                             
          RX6    X0*X1       (X6)=H11*SX(I)                             
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          NO     3           DEAD                                       
*                                                                       
          RX7    X7-X1       (X7)=-SX(I-1)+H22*SY(I-1)                  
          RX1    X0*X2       (X1)=H11*SX(I)                             
          RX6    X3+X6       (X6)=SY(I-1)+H11*SX(I-1)                   
          RX3    X4*X5       (X3)=H22*SY(I)                             
          NO     0           DEAD                                       
          NX7    X7          (X7)=NORM.(X7)                             
          RX4    X1+X4       (X4)=SY(I)+H11*SX(I)                       
          NX6    X6          (X6)=NORM.(X6)                             
*                                                                       
          SA7    A4-B3       SY(I-1)=(X7)                               
          RX2    X3-X2       (X2)=-SX(I)+H22*SY(I)                      
          SA3    A4+B3       (X3)=SY(I+1) NEXT ITERATION                
          SA6    A2-B2       SX(I-1)=(X6)                               
          NX6    X4          (X6)=NORM.(X4)                             
          SA1    A2+B2       (X1)=SX(I+1) NEXT ITERATION                
          NO     0           DEAD                                       
          NX7    X2          (X7)=NORM.(X2)                             
          SA6    A2          SX(I)=(X6)                                 
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          NO     0           DEAD                                       
          SA7    A4          SY(I-1)=(X7)                               
          LE     B6,B1,LOOP1 IF (I .LE. N-2) CONTINUE LOOP              
 FIXN1    SB1    B1+B7       (B1)=N-1                                   
          SB1    B1+B7       (B1)=N                                     
*    HERE ONE VECTOR IS PRE-FETCHED. AT MOST TWO COMPS. REMAIN          
 CL1      RX7    X0*X1       (X7)=H11*SX(I)                             
          RX6    X3*X5       (X6)=H22*SY(I)                             
          SB6    B6+B7       (B6)=I=I+1. INCREMENT I.                   
          RX7    X3+X7       (X7)=SY(I-1)+H11*SX(I-1)                   
          RX6    X6-X1       (X6)=-SX(I-1)+H22*SY(I-1)                  
          NX7    X7          (X7)=NORM.(X7)                             
          NX6    X6          (X6)=NORM.(X6)                             
          SA7    A1          SX(I-1)=(X7)                               
          SA6    A3          SY(I-1)=(X6)                               
          GT     B6,B1,OUT   IF (I .GT. N), QUIT                        
          SA1    A1+B2       (X1)=SX(I)                                 
          SA3    A3+B3       (X3)=SY(I)                                 
          JP     CL1                                                    
*                                                                       
 OUT      OUTFTN SROTM                                                  
 STWO     DATA   2.0                                                    
*         END    SROTM                                                  
          END                                                           
*DECK,DROTM                                                             
          IDENT  DROTM                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DROTM(N,DX,INCX,DY,INCY,DPARAM)                          
*                                                                       
*         APPLY THE TWO-MULTIPLY,TWO-ADD,GIVENS TRANSFORMATION          
*                                                                       
*         TO 2XN MATRIX  (DXI1  ... DXIN )                              
*                        (DYI1  ... DYIN )                              
*                                                                       
*         DXII  = DX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = DX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR DYII                                  
*                                                                       
*         CONTENTS OF DPARAM( ) MUST BE PREVIOUSLY DEFINED BY           
*         DROTMG                                                        
*                                                                       
*         DPARAM(1) = FLAG , INDICATES THE FORM OF THE MATRIX H         
*         DPARAM(2) = H11                                               
*         DPARAM(3) = H21                                               
*         DPARAM(4) = H12                                               
*         DPARAM(5) = H22                                               
*                                                                       
*         THE FLAG VALUES AND THE CORRESPONDING FORMS OF THE MATRIX H   
*         -2. (1 0)   -1. (H11 H12)   0. ( 1 H12)   1. (H11 1 )         
*             (0 1)       (H21 H22)      (H21 1 )      (-1 H22)         
*                                                                       
*                                                                       
*         DX( ),DY( )               DOUBLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*         DPARAM( )                 DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DROTM                                                  
          VFD    42/5HDROTM,18/6                                        
*                                                                       
 DROTM    DATA   0             ENTRY/EXIT                               
          INFTN  DROTM,6                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCY                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(DXI1 ) = LOC(DX)-(N-1)*INCX          
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 ,GO TO TWO                
          DX5    X1*X5         LOC(DYI1 ) = LOC(DY)-(N-1)*INCY          
          SB4    X5+B4         (B4) = LOC(DYI1 )                        
*                                                                       
 TWO      SA3    B6            (X3) = DPARAM(1)   IFLAG                 
          SA2    RTWO          (X2) = 2.0                               
          RX2    X3+X2                                                  
          NX2    X2                                                     
          ZR     X2,OUT        IF FLAG .EQ. -2.0 , GO TO OUT            
*                                                                       
          SA1    A3+2          (X1,X2) = DPARAM(2)                      
          SA2    A3+3                                                   
          BX6    X1            (X6,X7) = (X1,X2)                        
          BX7    X2                                                     
          SA6    H11           H11 = (X6,X7)                            
          SA7    H11+1                                                  
*                                                                       
          SA1    A2+1          (X1,X2) = DPARAM(3)                      
          SA2    A2+2                                                   
          BX6    X1            (X6,X7) = (X1,X2)                        
          BX7    X2                                                     
          SA6    H21           H21 = (X6,X7)                            
          SA7    H21+1                                                  
*                                                                       
          SA1    A2+1          (X1,X2) = DPARAM(4)                      
          SA2    A2+2                                                   
          BX6    X1            (X6,X7) = (X1,X2)                        
          BX7    X2                                                     
          SA6    H12           H12 = (X6,X7)                            
          SA7    H12+1                                                  
*                                                                       
          SA1    A2+1          (X1,X2) = DPARAM(5)                      
          SA2    A2+2                                                   
          BX6    X1            (X6,X7) = (X1,X2)                        
          BX7    X2                                                     
          SA6    H22           H22 = (X6,X7)                            
          SA7    H22+1                                                  
*                                                                       
          SB1    B1-B7         (B1) = N                                 
          ZR     X3,LOOP1      IF FLAG .EQ. 0.0, GO TO LOOP1            
          NG     X3,LOOP3      IF FLAG .EQ.-1.0, GO TO LOOP3            
          EQ     LOOP2         IF FLAG .EQ. 1.0, GO TO LOOP2            
*                                                                       
*                                                                       
 LOOP1    SA1    H12           (X1,X2) = H12      ITEN                  
          SA2    H12+1                                                  
          SA3    B4            (X3,X4) = DYII                           
          SA4    B4-B7                                                  
*                                                                       
          FX5    X2*X3         (X0,X3) = H12*DYII                       
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX3    X4+X5                                                  
*                                                                       
          SA1    B2            (X1,X2) = DXII                           
          SA2    B2-B7                                                  
          BX6    X1            (X6,X7) = DXII                           
          BX7    X2                                                     
*                                                                       
          FX4    X6+X0         (X6,X7) = (X6,X7)+(X0,X3)                
          DX5    X6+X0                                                  
          FX0    X7+X3                                                  
          NX4    X4                                                     
          FX3    X0+X5                                                  
          FX0    X3+X4                                                  
          NX5    X0                                                     
          DX3    X3+X4                                                  
          NX4    X3                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    A1            DXII  = (X6,X7)                          
          SA7    A2                                                     
*                                                                       
          SA3    H21           (X3,X4) = H21                            
          SA4    H21+1                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = H21*(X1,X2)                    
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA1    B4            (X1,X2) = DYII                           
          SA2    B4-B7                                                  
*                                                                       
          FX4    X6+X1         (X6,X7) = (X6,X7)+(X1,X2)                
          DX5    X6+X1                                                  
          FX1    X7+X2                                                  
          NX4    X4                                                     
          FX2    X1+X5                                                  
          FX1    X2+X4                                                  
          NX5    X1                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    A1            DYII  = (X6,X7)                          
          SA7    A2                                                     
*                                                                       
          SB2    B2+B3         (B2) = LOC(DXII+1 )                      
          SB4    B4+B5         (B4) = LOC(DYII+1 )                      
*                                                                       
          SB1    B1+B7         COUNT TERM                               
          NZ     B1,LOOP1      IF I .NE. N , LOOP1                      
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
*                                                                       
*                                                                       
 LOOP2    SA1    B2            (X1,X2) = DXII      ITHIRTY              
          SA2    B2-B7                                                  
          SA3    H11           (X3,X4) = H11                            
          SA4    H11+1                                                  
*                                                                       
          FX5    X2*X3         (X0,X3) = H11*DXII                       
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX3    X4+X5                                                  
*                                                                       
          SA4    B4            (X4,X5) = DYII                           
          SA5    B4-B7                                                  
          BX6    X4                                                     
          BX7    X5            (X6,X7) = DYII                           
*                                                                       
          FX4    X6+X0         (X6,X7) = (X6,X7)+(X0,X3)                
          DX5    X6+X0                                                  
          FX0    X7+X3                                                  
          NX4    X4                                                     
          FX3    X0+X5                                                  
          FX0    X3+X4                                                  
          NX5    X0                                                     
          DX3    X3+X4                                                  
          NX4    X3                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    A1            DXII  = (X6,X7)                          
          SA7    A2                                                     
*                                                                       
          SA3    H22           (X3,X4) = H22                            
          SA4    H22+1                                                  
*                                                                       
          BX6    X1            (X6,X7) = (X1,X2)    ISAVE OLD DX        
          BX7    X2                                                     
*                                                                       
          SA1    B4            (X1,X2) = DYII                           
          SA2    B4-B7                                                  
*                                                                       
          FX5    X2*X3         (X1,X2) = H22*DYII                       
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX1    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          FX4    X1-X6         (X6,X7) = -(X6,X7)+(X1,X2)               
          DX5    X1-X6                                                  
          FX1    X2-X7                                                  
          NX4    X4                                                     
          FX2    X1+X5                                                  
          FX1    X2+X4                                                  
          NX5    X1                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    A1            DYII  = (X6,X7)                          
          SA7    A2                                                     
*                                                                       
          SB2    B2+B3         (B2) = LOC(DXII+1 )                      
          SB4    B4+B5         (B4) = LOC(DYII+1 )                      
*                                                                       
          SB1    B1+B7         COUNT TERM                               
          NZ     B1,LOOP2      IF I .NE. N , LOOP2                      
*                                                                       
          EQ     OUT           GO TO OUT                                
*                                                                       
*                                                                       
*                                                                       
 LOOP3    SA1    B2            (X1,X2) = DXII     IFIFTY                
          SA2    B2-B7                                                  
          SA3    H11           (X3,X4) = H11                            
          SA4    H11+1                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DXII *H11                      
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA1    B4            (X1,X2) = DYII                           
          SA2    B4-B7                                                  
          SA3    H12           (X3,X4) = H12                            
          SA4    H12+1                                                  
*                                                                       
          FX5    X2*X3         (X1,X2) = DYII *H12                      
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX1    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          FX4    X6+X1         (X6,X7) = (X6,X7)+(X1,X2)                
          DX5    X6+X1                                                  
          FX1    X7+X2                                                  
          NX4    X4                                                     
          FX2    X1+X5                                                  
          FX1    X2+X4                                                  
          NX5    X1                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    DW            DW = (X6,X7)                             
          SA7    DW+1                                                   
*                                                                       
          SA1    B2            (X1,X2) = DXII                           
          SA2    B2-B7                                                  
*                                                                       
          SA3    H21           (X3,X4) = H21                            
          SA4    H21+1                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DXII *H21                      
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA1    B4            (X1,X2) = DYII                           
          SA2    B4-B7                                                  
          SA3    H22           (X3,X4) = H22                            
          SA4    H22+1                                                  
*                                                                       
          FX5    X2*X3         (X1,X2) = DYII *H22                      
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX1    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
*                                                                       
          FX4    X6+X1         (X6,X7) = (X6,X7)+(X1,X2)                
          DX5    X6+X1                                                  
          FX1    X7+X2                                                  
          NX4    X4                                                     
          FX2    X1+X5                                                  
          FX1    X2+X4                                                  
          NX5    X1                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    A1            DYII  = (X6,X7)                          
          SA7    A2                                                     
*                                                                       
          SA3    DW            (X3,X4) = DW                             
          SA4    DW+1                                                   
          BX6    X3            (X6,X7) = (X3,X4)                        
          BX7    X4                                                     
          SA6    B2            DXII  = (X6,X7)                          
          SA7    B2+1                                                   
*                                                                       
          SB1    B1+B7         COUNT TERM                               
          SB2    B2+B3         (B2) = LOC(DXII+1 )                      
          SB4    B4+B5         (B4) = LOC(DYII+1 )                      
*                                                                       
          NZ     B1,LOOP3      IF I .NE. N ,LOOP3                       
*                                                                       
 OUT      OUTFTN DROTM         RETURN                                   
*                                                                       
 DW       BSS    2                                                      
 H11      BSS    2                                                      
 H21      BSS    2                                                      
 H12      BSS    2                                                      
 H22      BSS    2                                                      
*                                                                       
 RTWO     DATA   2.0                                                    
*                                                                       
          END                                                           
*DECK,SCOPY                                                             
          IDENT  SCOPY                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SCOPY(N,SX,INCX,SY,INCY)                                 
*                                                                       
*         COPY VECTOR ELEMENT SXII  INTO SYII  FOR I=1 TO N             
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SCOPY                                                  
          VFD    42/5HSCOPY,18/5                                        
*                                                                       
 SCOPY    DATA   0             ENTRY/EXIT                               
          INFTN  SCOPY,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. O , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(SXI1 ) = LOC(SX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(SXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(SYI1 ) = LOC(SY) - (N-1)*INCY        
          SB4    X5+B4         (B4) = LOC(SYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA2    B2            (X2) = SXI1                              
          SA4    B4            (A4) = LOC(SYI1 )                        
          BX6    X2                                                     
          SA6    B4            SXI1  TO SYI1                            
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = SXII                              
          SA4    A4+B5         (A4) = LOC(SYII )                        
          BX6    X2                                                     
          SB1    B1+B7         COUNT TERM                               
          SA6    A4            SXII  TO SYII                            
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN SCOPY         RETURN                                   
          END                                                           
*DECK,DCOPY                                                             
          IDENT  DCOPY                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DCOPY(N,DX,INCX,DY,INCY)                                 
*                                                                       
*         COPY VECTOR ELEMENT DXII  INTO DYII  FOR I=1 TO N             
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR DYII                                  
*                                                                       
*         DX( ),DY( )               DOUBLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R.KINCAID                                   
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DCOPY                                                  
          VFD    42/5HDCOPY,18/5                                        
*                                                                       
 DCOPY    DATA   0             ENTRY/EXIT                               
          INFTN  DCOPY,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(DYI1 ) = LOC(DY) - (N-1)*INCY        
          SB4    X5+B4         (B4) = LOC(DYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA2    B2            (X2) = DXI1                              
          SA4    B4            (A4) = LOC(DYI1 )                        
          BX6    X2                                                     
          SA5    B2-B7         (X4,X5) = DXI1                           
          SA6    B4                                                     
          BX7    X5                                                     
          SA7    B4-B7         DXI1  TO DYI1                            
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = DXII                              
          SA4    A4+B5         (A4) = LOC(DYII )                        
          BX6    X2                                                     
          SA5    A2-B7         (X4,X5) = DXII                           
          SA6    A4                                                     
          BX7    X5                                                     
          SB1    B1+B7         COUNT TERM                               
          SA7    A4-B7         DXII  TO DYII                            
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN DCOPY         RETURN                                   
          END                                                           
*DECK,CCOPY                                                             
          IDENT  CCOPY                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL CCOPY(N,CX,INCX,CY,INCY)                                 
*                                                                       
*         COPY VECTOR ELEMENT CXII  INTO CYII  FOR I=1 TO N             
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR CYII                                  
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R.KINCAID                                   
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CCOPY                                                  
          VFD    42/5HCCOPY,18/5                                        
*                                                                       
 CCOPY    DATA   0             ENTRY/EXIT                               
          INFTN  CCOPY,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(CYI1 ) = LOC(CY) - (N-1)*INCY        
          SB4    X5+B4         (B4) = LOC(CYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA2    B2            (X2) = CXI1                              
          SA4    B4            (A4) = LOC(CYI1 )                        
          BX6    X2                                                     
          SA5    B2-B7         (X4,X5) = CXI1                           
          SA6    B4                                                     
          BX7    X5                                                     
          SA7    B4-B7         CXI1  TO CYII                            
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = CXII                              
          SA4    A4+B5         (A4) = LOC(CYII )                        
          BX6    X2                                                     
          SA5    A2-B7         (X4,X5) = CXII                           
          SA6    A4                                                     
          BX7    X5                                                     
          SB1    B1+B7         COUNT TERM                               
          SA7    A4-B7         CXII  TO CYII                            
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CCOPY         RETURN                                   
          END                                                           
*DECK,SSWAP                                                             
          IDENT  SSWAP                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SSWAP(N,SX,INCX,SY,INCY)                                 
*                                                                       
*         INTERCHANGE VECTOR ELEMENTS SXII  AND SYII  FOR I=1 TO N      
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SIMILAR DEFINITIONS FOR SYII                                  
*                                                                       
*         SX( ),SY( )               SINGLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SSWAP                                                  
          VFD    42/5HSSWAP,18/5                                        
*                                                                       
 SSWAP    DATA   0             ENTRY/EXIT                               
          INFTN  SSWAP,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(XI1 ) = LOC(SX) - (N-1)*INCX         
          SB2    X3+B2         (B2) = LOC(SXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(YI1 ) = LOC(SY) - (N-1)*INCY         
          SB4    X5+B4         (B4) = LOC(SYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA2    B2            (X2) = SXI1                              
          SA4    B4            (X4) = SYI1                              
          BX6    X2            (X6) = (X2)                              
          BX7    X4            (X7) = (X4)                              
          SA6    B4            SXI1  TO SYI1                            
          SA7    B2            SYI1  TO SXI1                            
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = SXII                              
          SA4    A4+B5         (X4) = SYII                              
          BX6    X2            (X6) = (X2)                              
          BX7    X4            (X7) = (X4)                              
          SB1    B1+B7         COUNT TERM                               
          SA6    A4            SXII  TO SYII                            
          SA7    A2            SYII  TO SXII                            
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN SSWAP         RETURN                                   
          END                                                           
*DECK,DSWAP                                                             
          IDENT  DSWAP                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DSWAP(N,DX,INCX,DY,INCY)                                 
*                                                                       
*         INTERCHANGE VECTOR ELEMENTS DXII  AND DYII  FOR I=1 TO N      
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR DYII                                  
*                                                                       
*         DX( ),DY( )               DOUBLE PRECISION                    
*         N,INCX,INCY               INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DSWAP                                                  
          VFD    42/5HDSWAP,18/5                                        
*                                                                       
 DSWAP    DATA   0             ENTRY/EXIT                               
          INFTN  DSWAP,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE.0 , GO TO OUT                   
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(XI1 ) = LOC(DX) - (N-1)*INCX         
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(YI1 ) = LOC(DY) - (N-1)*INCY         
          SB4    X5+B4         (B4) = LOC(DYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA2    B2                                                     
          SA4    B4                                                     
          BX6    X2                                                     
          BX7    X4                                                     
          SA6    B4                                                     
          SA7    B2                                                     
*                                                                       
          SA3    A2-B7         (X2,X3) = DXI1                           
          SA5    A4-B7         (X4,X5) = DYI1                           
          BX6    X3                                                     
          BX7    X5                                                     
          SA6    A5            DXI1  = DYI1                             
          SA7    A3            DYI1  = DXI1                             
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3                                                  
          SA4    A4+B5                                                  
          BX6    X2                                                     
          BX7    X4                                                     
          SA6    A4                                                     
          SA7    A2                                                     
*                                                                       
          SA3    A2-B7         (X2,X3) = DXII                           
          SA5    A4-B7         (X4,X5) = DYII                           
          BX6    X3                                                     
          BX7    X5                                                     
          SB1    B1+B7         COUNT TERM                               
          SA6    A5            DXII  = DYII                             
          SA7    A3            DYII  = DXII                             
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN DSWAP         RETURN                                   
          END                                                           
*DECK,CSWAP                                                             
          IDENT  CSWAP                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL CSWAP(N,CX,INCX,CY,INCY)                                 
*                                                                       
*         INTERCHANGE VECTOR ELEMENTS CXII  AND CYII  FOR I=1 TO N      
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         SIMILAR DEFINITIONS FOR CYII                                  
*                                                                       
*         CX( ),CY( )               COMPLEX TYPE                        
*         N,INCX,INCY               INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CSWAP                                                  
          VFD    42/5HCSWAP,18/5                                        
*                                                                       
 CSWAP    DATA   0             ENTRY/EXIT                               
          INFTN  CSWAP,5                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. N , GO TO OUT                  
          SA5    B5            (X5) = INCY                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          IX5    X5+X5         INCY = 2*INCY                            
          SB3    X3            (B3) = INCX                              
          SB5    X5            (B5) = INCY                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(XI1 ) = LOC(CX) - (N-1)*INCX         
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
 ONE      GT     B5,TWO        IF INCY .GT. 0 , GO TO TWO               
          DX5    X1*X5         LOC(YI1 ) = LOC(CY) - (N-1)*INCY         
          SB4    X5+B4         (B4) = LOC(CYI1 )                        
*                                                                       
*                              (I = 1)                                  
 TWO      SA2    B2                                                     
          SA4    B4                                                     
          BX6    X2                                                     
          BX7    X4                                                     
          SA6    B4                                                     
          SA7    B2                                                     
*                                                                       
          SA3    A2-B7         (X2,X3) = CXI1                           
          SA5    A4-B7         (X4,X5) = CYI1                           
          BX6    X3                                                     
          BX7    X5                                                     
          SA6    A5            CXI1  = CYI1                             
          SA7    A3            CYI1  = CXI1                             
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3                                                  
          SA4    A4+B5                                                  
          BX6    X2                                                     
          BX7    X4                                                     
          SA6    A4                                                     
          SA7    A2                                                     
*                                                                       
          SA3    A2-B7         (X2,X3) = CXII                           
          SA5    A4-B7         (X4,X5) = CYII                           
          BX6    X3                                                     
          BX7    X5                                                     
          SB1    B1+B7         COUNT TERM                               
          SA6    A5            CXII  = CYII                             
          SA7    A3            CYII  = CXII                             
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CSWAP         RETURN                                   
          END                                                           
*DECK,SNRM2                                                             
          IDENT  SNRM2                                                  
*                                                                       
***       REAL FUNCTION  SNRM2(N,SX,INCX)                               
*                                                                       
*         COMPUTES 2-VECTOR NORM (EUCLIDEAN NORM)                       
*                                                                       
*         COMPUTED AS THE SQUARE ROOT OF THE SUM FROM I=1 TO N OF SXII *
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SX( )                     SINGLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  SNRM2   IN        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SNRM2                                                  
          VFD    42/5HSNRM2,18/3                                        
*                                                                       
 SNRM2    DATA   0             ENTRY/EXIT                               
          INFTN  SNRM2,3                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0             (X6) = 0                                 
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(SXI1 ) = LOC(SX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(SXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA2    B2            (X2) = SXI1                              
          RX1    X2*X2         (X2) = SXI1 *SXI1                        
*                                                                       
          ZR     B1,EXIT       IF I .EQ. N , GO TO EXIT                 
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = SXII                              
          RX0    X1+X6         (X6) = (X6) + (X1)                       
          SB1    B1+B7         I = I+1                                  
          NX6    X0                                                     
          RX1    X2*X2         (X1) = SXII *SXII                        
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
*                              (I = N)                                  
 EXIT     RX0    X1+X6         (X6) = (X6) + (X1)                       
          NX6    X0                                                     
          SB1    RES           (B1) = LOC(RES)                          
          SA6    B1            RES  = (X6)                              
          CALL   SQRT,(B1)      (X6) =   SQRT(RES)                      
*                                                                       
 OUT      OUTFTN SNRM2         RETURN                                   
*                                                                       
 RES      BSS    1                                                      
          END                                                           
*DECK,DNRM2                                                             
          IDENT  DNRM2                                                  
*                                                                       
***       REAL FUNCTION  DNRM2(N,DX,INCX)                               
*                                                                       
*         COMPUTES 2-VECTOR NORM (EUCLIDEAN NORM)                       
*                                                                       
*         COMPUTED AS THE SQUARE ROOT OF THE SUM FROM I=1 TO N OF DXII *
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         DX( )                     DOUBLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  DNRM2   IN        DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DNRM2                                                  
          VFD    42/5HDNRM2,18/3                                        
*                                                                       
 DNRM2    DATA   0             ENTRY/EXIT                               
          INFTN  DNRM2,3                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
          MX7    0             (X6,X7) = 0                              
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                                                                       
*                                                                       
 ONE      SA1    B2            (X1,X2) = DXI1                           
          SA2    B2-B7                                                  
*                                                                       
          FX0    X1*X2         (X0,X2) = DXI1 *DXI1                     
          FX5    X0+X0                                                  
          FX4    X1*X1                                                  
          DX0    X1*X1                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          ZR     B1,EXIT       IF I .EQ. N , GO TO EXIT                 
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    A1+B3                                                  
*                                                                       
          FX4    X6+X0         (X6,X7) = (X6,X7) + (X0,X2)              
          DX5    X6+X0                                                  
          FX0    X7+X2                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA2    A1-B7         (X1,X2) = DXII                           
          SB1    B1+B7         I = I+1                                  
*                                                                       
          FX0    X1*X2         (X0,X2) = DXII *DXII                     
          FX5    X0+X0                                                  
          FX4    X1*X1                                                  
          DX0    X1*X1                                                  
          FX5    X0+X5                                                  
          FX0    X4+X5                                                  
          DX2    X4+X5                                                  
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
*                              (I = N)                                  
 EXIT     FX4    X6+X0         (X6,X7) = (X6,X7) + (X0,X2)              
          DX5    X6+X0                                                  
          FX0    X7+X2                                                  
          NX4    X4                                                     
          FX2    X0+X5                                                  
          FX0    X2+X4                                                  
          NX5    X0                                                     
          DX2    X2+X4                                                  
          NX4    X2                                                     
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SB1    RES           (B1) = RES                               
          SA6    B1            (RES) = (X6,X7)                          
          SA7    B1-B7                                                  
*                                                                       
          CALL   DSQRT,(B1)     (X6,X7) =   SQRT(RES)                   
*                                                                       
 OUT      OUTFTN DNRM2         RETURN                                   
*                                                                       
 RES      BSS    2                                                      
          END                                                           
*DECK,SCNRM2                                                            
          IDENT  SCNRM2                                                 
*                                                                       
***       REAL FUNCTION  SCNRM2(N,CX,INCX)                              
*                                                                       
*         COMPUTES 2-VECTOR NORM (EUCLIDEAN NORM)                       
*                                                                       
*         COMPUTED AS THE SQUARE ROOT OF THE SUM                        
*         FROM I=1 TO N OF CONJ(CXII ) * CXII                           
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         CX( )                     COMPLEX TYPE                        
*         N,INCX                    INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  SCNRM2  IN        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SCNRM2                                                 
          VFD    42/6HSCNRM2,18/3                                       
*                                                                       
 SCNRM2   DATA   0             ENTRY/EXIT                               
          INFTN  SCNRM2,3                                               
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          ZR     B3,OUT        IF INCX .EQ. 0 ,GO TO OUT                
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA1    B2            (X1) = REAL(CXI1 )                       
          SA2    B2-B7         (X2) = IMAG(CXI1 )                       
*                                                                       
          RX0    X1*X1         (X0) = (REAL(CXI1 )**2                   
          RX5    X2*X2         (X5) = (IMAG(CXI1 )**2                   
          RX4    X0+X5         (X4) = (X0) + (X5)                       
          NX4    X4                                                     
*                                                                       
          ZR     B1,EXIT       IF I .EQ. N , GO TO EXIT                 
*                                                                       
*                              (I = I+1)                                
 LOOP     SA1    A1+B3         (X1) = REAL(CXII )                       
*                                                                       
          RX5    X6+X4         (X6) = (X6) + (X4)                       
          SA2    A1-B7         (X2) = IMAG(CXII )                       
          NX6    X5                                                     
          RX0    X1*X1         (X0) = (REAL(CXII )**2                   
          RX5    X2*X2         (X5) = (IMAG(CXII )**2                   
          SB1    B1+B7         I = I+1                                  
          RX4    X0+X5         (X4) = (X0) + (X5)                       
          NX4    X4                                                     
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
*                              (I = N)                                  
 EXIT     RX5    X6+X4         (X6) = (X6) + (X4)                       
          NX6    X5                                                     
*                                                                       
          SB1    RES           (B1) = RES                               
          SA6    B1            (RES) = (X6)                             
*                                                                       
          CALL   SQRT,(B1)      (X6) =   SQRT(RES)                      
*                                                                       
 OUT      OUTFTN SCNRM2        RETURN                                   
*                                                                       
 RES      BSS    1                                                      
          END                                                           
*DECK,SASUM                                                             
          IDENT  SASUM                                                  
*                                                                       
***       REAL FUNCTION  SASUM(N,SX,INCX)                               
*                                                                       
*         COMPUTES 1-VECTOR NORM                                        
*                                                                       
*         COMPUTED AS THE SUM FROM I=1 TO N OF THE ABSOLUTE VALUE OF SXI
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SX( )                     SINGLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  SASUM   IN        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SASUM                                                  
          VFD    42/5HSASUM,18/3                                        
*                                                                       
 SASUM    DATA   0             ENTRY/EXIT                               
          INFTN  SASUM,3                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0             (X6) = 0                                 
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(RXI1 ) = LOC(RX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(RXI1 )                        
*                                                                       
*                              (I=1)                                    
 ONE      SA2    B2            (X2) = RXI1                              
          BX4    X2                                                     
          AX2    59                                                     
          BX5    X2-X4         (X5) = ABS(RXI1 )                        
*                                                                       
          FX3    X6+X5         (X6) = (X6) + (X5)                       
          NX6    X3                                                     
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = RXII                              
          BX4    X2                                                     
          AX2    59                                                     
          BX5    X2-X4         (X5) = ABS(RXII )                        
*                                                                       
          FX3    X6+X5         (X6) = (X6) + (X5)                       
          SB1    B1+B7         COUNT TERM                               
          NX6    X3                                                     
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN SASUM         RETURN                                   
          END                                                           
*DECK,DASUM                                                             
          IDENT  DASUM                                                  
*                                                                       
***       REAL FUNCTION  DASUM(N,DX,INCX)                               
*                                                                       
*         COMPUTES 1-VECTOR NORM                                        
*                                                                       
*         COMPUTED AS THE SUM FROM I=1 TO N OF THE ABSOLUTE VALUE OF DXI
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         DX( )                     DOUBLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         SUM ACCUMULATED IN        DOUBLE PRECISION                    
*         RESULT  DASUM   IN        DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DASUM                                                  
          VFD    42/5HDASUM,18/3                                        
*                                                                       
 DASUM    DATA   0             ENTRY/EXIT                               
          INFTN  DASUM,3                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
          MX7    0             (X6,X7) = 0                              
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          LX3    1             INCX = 2*INCX                            
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                              (I=1)                                    
 ONE      SA2    B2                                                     
          SA3    B2-B7         (X2,X3) = DXI1                           
          BX0    X2                                                     
          BX1    X3                                                     
          AX2    59                                                     
          AX3    59                                                     
          BX4    X2-X0                                                  
          BX5    X3-X1         (X4,X5) = DABS(DXI1 )                    
*                                                                       
          FX0    X6+X4         (X6,X7) = (X6,X7) + (X4,X5)              
          DX1    X6+X4                                                  
          FX4    X7+X5                                                  
          NX0    X0                                                     
          FX5    X4+X1                                                  
          FX4    X5+X0                                                  
          NX1    X4                                                     
          DX5    X5+X0                                                  
          NX0    X5                                                     
          FX6    X0+X1                                                  
          DX7    X0+X1                                                  
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3                                                  
          SA3    A2-B7         (X2,X3) = DXII                           
          BX0    X2                                                     
          BX1    X3                                                     
          AX2    59                                                     
          AX3    59                                                     
          BX4    X2-X0                                                  
          BX5    X3-X1         (X4,X5) = DABS(DXII )                    
*                                                                       
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          FX0    X6+X4         (X6,X7) = (X6,X7) + (X4,X5)              
          DX1    X6+X4                                                  
          FX4    X7+X5                                                  
          NX0    X0                                                     
          FX5    X4+X1                                                  
          FX4    X5+X0                                                  
          NX1    X4                                                     
          DX5    X5+X0                                                  
          NX0    X5                                                     
          FX6    X0+X1                                                  
          DX7    X0+X1                                                  
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN DASUM         RETURN                                   
          END                                                           
*DECK,SCASUM                                                            
          IDENT  SCASUM                                                 
*                                                                       
***       REAL FUNCTION  SCASUM(N,CX,INCX)                              
*                                                                       
*         COMPUTED AS THE SUM FROM I=1 TO N OF THE ABSOLUTE VALUE       
*         OF REAL(CXII ) AND THE ABSOLUTE VALUE OF IMAG(CXII )          
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         CX( )                     COMPLEX TYPE                        
*         N,INCX                    INTEGER TYPE                        
*         SUM ACCUMULATED IN        SINGLE PRECISION                    
*         RESULT  SCASUM  IN        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SCASUM                                                 
          VFD    42/6HSCASUM,18/3                                       
*                                                                       
 SCASUM   DATA   0             ENTRY/EXIT                               
          INFTN  SCASUM,3                                               
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          MX6    0                                                      
          SB1    X1+B7         (B1) = N-1                               
*                                                                       
          SA3    B3            (X3) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          LX3    1             INCX = 2*INCX                            
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                              (I=1)                                    
 ONE      SA2    B2            (X2) = REAL(CXI1 )                       
          SA3    B2-B7         (X3) = IMAG(CXI1 )                       
          BX0    X2                                                     
          BX1    X3                                                     
          AX2    59                                                     
          AX3    59                                                     
          BX4    X2-X0         (X4) = ABS(REAL(CXI1 ))                  
          BX5    X3-X1         (X5) = ABS(IMAG(CXI1 ))                  
*                                                                       
          RX0    X6+X4                                                  
          NX0    X0                                                     
          RX1    X0+X5         (X6) = (X6) + (X5) + (X4)                
          NX6    X1                                                     
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = REAL(CXII )                       
          SA3    A2-B7         (X3) = IMAG(CXII )                       
          BX0    X2                                                     
          BX1    X3                                                     
          AX2    59                                                     
          AX3    59                                                     
          BX4    X2-X0         (X4) = ABS(REAL(CXII ))                  
          BX5    X3-X1         (X5) = ABS(IMAG(CXII ))                  
*                                                                       
          RX0    X6+X4         (X6) = (X6) + (X5) + (X4)                
          NX0    X0                                                     
          RX1    X0+X5                                                  
          SB1    B1+B7         COUNT TERM                               
          NX6    X1                                                     
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN SCASUM        RETURN                                   
          END                                                           
*DECK,SSCAL                                                             
          IDENT  SSCAL                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL SSCAL(N,SA,SX,INCX)                                      
*                                                                       
*         SA*SXII   REPLACES SXII   FOR I=1,N                           
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SX( )                     SINGLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         SA                        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  SSCAL                                                  
          VFD    42/5HSSCAL,18/4                                        
*                                                                       
 SSCAL    DATA   0             ENTRY/EXIT                               
          INFTN  SSCAL,4                                                
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X1+B7         (B1) = N-1                               
          SA2    B2            (X2) = SA                                
*                                                                       
          SA4    B4            (X4) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SX1    -B1           (X1) = -(N-1)                            
          SB4    X4            (B4) = INCX                              
*                                                                       
          GT     B4,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX4    X1*X4         LOC(SXI1 ) = LOC(SX) - (N-1)*INCX        
          SB3    X4+B3         (B3) = LOC(SXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA3    B3            (X3) = SXI1                              
          FX6    X2*X3         (X6) = SA*SXI1                           
          SA6    B3                                                     
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA3    A3+B4         (X3) = SXII                              
          FX6    X2*X3         (X6) = SA*SXII                           
          SB1    B1+B7         I = I+1                                  
          SA6    A3            SXII  = (X6)                             
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN SSCAL         RETURN                                   
          END                                                           
*DECK,DSCAL                                                             
          IDENT  DSCAL                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL DSCAL(N,DA,DX,INCX)                                      
*                                                                       
*         DA*DXII   REPLACES DXII   FOR I=1,N                           
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         DX( )                     DOUBLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         DA                        DOUBLE PRECISION                    
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  DSCAL                                                  
          VFD    42/5HDSCAL,18/4                                        
*                                                                       
 DSCAL    DATA   0             ENTRY/EXIT                               
          INFTN  DSCAL,4                                                
          SA3    B1            (X3) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X3+B7         (B1) = N-1                               
          SA1    B2            (X1,X2) = DA                             
          SA2    B2-B7                                                  
*                                                                       
          SA4    B4            (X4) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          LX4    1             INCX = 2*INCX                            
          SX3    -B1           (X3) = -(N-1)                            
          SB4    X4            (B4) = INCX                              
*                                                                       
          GT     B4,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX4    X3*X4         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB3    X4+B3                                                  
*                                                                       
*                              (I = 1)                                  
 ONE      SA3    B3            (X3,X4) = DXI1                           
          SA4    B3-B7                                                  
*                                                                       
          FX5    X2*X3         (X6,X7) = DA*DXI1                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SA6    A3            DXI1  = (X6,X7)                          
          SA7    A4                                                     
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA3    A3+B4         (X3,X4) = DXII                           
          SA4    A3-B7                                                  
*                                                                       
*                                                                       
          FX5    X2*X3         (X6,X7) = DA*DXII                        
          FX0    X1*X4                                                  
          FX5    X0+X5                                                  
          FX4    X1*X3                                                  
          DX0    X1*X3                                                  
          FX5    X0+X5                                                  
          FX6    X4+X5                                                  
          DX7    X4+X5                                                  
*                                                                       
          SB1    B1+B7         I = I+1                                  
*                                                                       
          SA6    A3            DXII  = (X6,X7)                          
          SA7    A4                                                     
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN DSCAL         RETURN                                   
          END                                                           
*DECK,CSCAL                                                             
          IDENT  CSCAL                                                  
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL CSCAL(N,CA,CX,INCX)                                      
*                                                                       
*         CA*CXII   REPLACES CXII   FOR I=1,N                           
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         CX( )                     COMPLEX TYPE                        
*         N,INCX                    INTEGER TYPE                        
*         CA                        COMPLEX TYPE                        
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CSCAL                                                  
          VFD    42/5HCSCAL,18/4                                        
*                                                                       
 CSCAL    DATA   0             ENTRY/EXIT                               
          INFTN  CSCAL,4                                                
          SA3    B1            (X3) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X3+B7         (B1) = N-1                               
          SA1    B2            (X1) = REAL(CA)                          
          SA2    B2-B7         (X2) = IMAG(CA)                          
*                                                                       
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          SA4    B4            (X4) = INCX                              
          LX4    1             INCX = 2*INCX                            
          SX3    -B1           (X3) = -(N-1)                            
          SB4    X4            (B4) = INCX                              
*                                                                       
          GT     B4,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX4    X3*X4         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB3    X4+B3         (B3) = LOC(CXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA3    B3            (X3) = REAL(CXI1 )                       
          SA4    B3-B7         (X4) = IMAG(CXI1 )                       
*                                                                       
*                              (X6,X7) = CA*CXI1                        
          RX6    X1*X3         (X6) = REAL(CA)*REAL(CXI1 )              
          RX5    X2*X4         (X5) = IMAG(CA)*IMAG(CXI1 )              
          RX0    X6-X5         (X0) = REAL(CA*CXI1 )                    
          NX6    X0                                                     
*                                                                       
          RX7    X1*X4         (X7) = REAL(CA)*IMAG(CXI1 )              
          RX5    X2*X3         (X5) = IMAG(CA)*REAL(CXI1 )              
          RX0    X7+X5         (X0) = IMAG(CA*CXI1 )                    
          NX7    X0                                                     
*                                                                       
          SA6    A3            REAL(CXI1 ) = (X6)                       
          SA7    A4            IMAG(CXI1 ) = (X7)                       
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA3    A3+B4         (X3) = REAL(CXII )                       
          SA4    A3-B7         (X4) = IMAG(CXII )                       
*                                                                       
          RX6    X1*X3         (X6) = REAL(CA)*REAL(CXII )              
          RX5    X2*X4         (X5) = IMAG(CA)*IMAG(CXII )              
          RX0    X6-X5         (X0) = REAL(CA*CXII )                    
          NX6    X0                                                     
*                                                                       
          RX7    X1*X4         (X7) = REAL(CA)*IMAG(CXII )              
          RX5    X2*X3         (X5) = IMAG(CA)*REAL(CXII )              
          RX0    X7+X5         (X0) = IMAG(CA*CXII )                    
          SB1    B1+B7         I = I+1                                  
          NX7    X0                                                     
*                                                                       
          SA6    A3            REAL(CXII ) = (X6)                       
          SA7    A4            IMAG(CXII ) = (X7)                       
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CSCAL         RETURN                                   
          END                                                           
*DECK,CSSCAL                                                            
          IDENT  CSSCAL                                                 
*                                                                       
***       USE WITH FORTRAN STATEMENT                                    
*                                                                       
*         CALL CSSCAL(N,SA,CX,INCX)                                     
*                                                                       
*         SA*CXII   REPLACES CXII   FOR I=1,N                           
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         CX( )                     COMPLEX TYPE                        
*         N,INCX                    INTEGER TYPE                        
*         SA                        SINGLE PRECISION                    
*                                                                       
*         ROUNDED ARITHMETIC INSTRUCTIONS ARE USED                      
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID AND ELIZABETH WILLIAMS           
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  CSSCAL                                                 
          VFD    42/6HCSSCAL,18/4                                       
*                                                                       
 CSSCAL   DATA   0             ENTRY/EXIT                               
          INFTN  CSSCAL,4                                               
          SA3    B1            (X3) = N                                 
          SB7    -1            (B7) = -1                                
          SB1    X3+B7         (B1) = N-1                               
          SA2    B2            (X2) = SA                                
*                                                                       
          SA4    B4            (X4) = INCX                              
          NG     B1,OUT        IF N .LE. 0 , GO TO OUT                  
          LX4    1             INCX = 2*INCX                            
          SX3    -B1           (X3) = -(N-1)                            
          SB4    X4            (B4) = INCX                              
*                                                                       
          GT     B4,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX4    X3*X4         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB3    X4+B3         (B3) = LOC(CXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA3    B3            (X3) = REAL(CXI1 )                       
          SA4    B3-B7         (X4) = IMAG(CXI1 )                       
*                                                                       
*                              (X6,X7) = SA*CXI1                        
          RX6    X2*X3         (X6) = SA*REAL(CXI1 )                    
          RX7    X2*X4         (X7) = SA*IMAG(CXI1 )                    
*                                                                       
          SA6    A3            REAL(CXI1 ) = (X6)                       
          SA7    A4            IMAG(CXI1 ) = (X7)                       
*                                                                       
          ZR     B1,OUT        IF I .EQ. N , GO TO OUT                  
*                                                                       
*                              (I = I+1)                                
 LOOP     SA3    A3+B4         (X3) = REAL(CXII )                       
          SB1    B1+B7         I = I+1                                  
          SA4    A3-B7         (X4) = IMAG(CXII )                       
*                                                                       
*                              (X6,X7) = SA*CXII                        
          RX6    X2*X3         (X6) = SA*REAL(CXII )                    
          RX7    X2*X4         (X7) = SA*IMAG(CXII )                    
*                                                                       
          SA6    A3            REAL(CXII ) = (X6)                       
          SA7    A4            IMAG(CXII ) = (X7)                       
*                                                                       
          NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN CSSCAL        RETURN                                   
          END                                                           
*DECK,ISAMAX                                                            
          IDENT  ISAMAX                                                 
*                                                                       
***       INTEGER FUNCTION ISAMAX(N,SX,INCX)                            
*                                                                       
*         FIND AN INDEX  I(MAX)  CORRESPONDING TO THE MAXIMUM ABSOLUTE V
*         COMPONENTS  SXII   OF THE VECTOR SX.                          
*                                                                       
*         SXII  = SX(1 + (I-1)*INCX)  IF INCX .GE. 0                    
*               = SX(1 + (I-N)*INCX)  IF INCX .LT. 0                    
*                                                                       
*         SX( )                     SINGLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         RESULT ISAMAX             INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  ISAMAX                                                 
          VFD    42/6HISAMAX,18/3                                       
*                                                                       
 ISAMAX   DATA   0             ENTRY/EXIT                               
          INFTN  ISAMAX,3                                               
          MX6    0             (X6)=ISAMAX=0                            
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB4    X1            (B4) = N                                 
          SB1    X1+B7         (B1) = N-1                               
          NG     B1,OUT        IF(N .LE. 0) GO TO OUT                   
*                                                                       
          SX6    -B7           (X6) = 1             (ISAMAX)            
          LE     B1,OUT        IF N .LE. 1 , GO TO OUT                  
*                                                                       
          SA3    B3            (X3) = INCX                              
          SX1    -B1           (X1) = -(N-1)                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(XI1 ) = LOC(SX) - (N-1)*INCX         
          SB2    X3+B2         (B2) = LOC(SXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA2    B2            (X2) = SXI1                              
          BX3    X2                                                     
          AX2    59                                                     
          BX5    X2-X3         (X5) = ABS(SXI1 )    (SAMAX)             
*                                                                       
*                                                                       
*                              (I=I+1)                                  
 LOOP     SA2    A2+B3         (X2) = SXII                              
          BX3    X2                                                     
          AX2    59                                                     
          BX2    X2-X3         (X2) = ABS(SXII )                        
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          NX5    X5                                                     
          FX0    X5-X2                                                  
          PL     X0,TEST       IF ABS(SXII ) .LE. SAMAX , GO TO TEST    
*                                                                       
          BX5    X2            (X5) = ABS(SXII )    (SAMAX)             
          SX6    B4-B1         (X6) = I             (ISAMAX)            
*                                                                       
 TEST     NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN ISAMAX        RETURN                                   
          END                                                           
*DECK,IDAMAX                                                            
          IDENT  IDAMAX                                                 
*                                                                       
***       INTEGER FUNCTION IDAMAX(N,DX,INCX)                            
*                                                                       
*         FIND AN INDEX  I(MAX)  CORRESPONDING TO THE MAXIMUM ABSOLUTE V
*         COMPONENTS  DXII   OF THE VECTOR   DX                         
*                                                                       
*         DXII  = DX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = DX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         DX( )                     DOUBLE PRECISION                    
*         N,INCX                    INTEGER TYPE                        
*         RESULT IDAMAX             INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  IDAMAX                                                 
          VFD    42/6HIDAMAX,18/3                                       
*                                                                       
 IDAMAX   DATA   0             ENTRY/EXIT                               
          INFTN  IDAMAX,3                                               
          MX6    0             (X6)=IDAMAX=0                            
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB4    X1            (B4) = N                                 
          SB1    X1+B7         (B1) = N-1                               
          NG     B1,OUT        IF(N .LE. 0) GO TO OUT                   
*                                                                       
          SX6    -B7           (X6) = 1                                 
          LE     B1,OUT        IF N .LE. 1 , GO TO OUT                  
*                                                                       
          SA3    B3            (X3) = INCX                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             INCX = 2*INCX                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(DXI1 ) = LOC(DX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(DXI1 )                        
*                                                                       
*                              (I=1)                                    
 ONE      SA2    B2                                                     
          SA3    B2-B7         (X2,X3) = DXI1                           
          BX0    X2                                                     
          AX0    59                                                     
          BX4    X0-X2                                                  
          BX5    X0-X3         (X4,X5) = DABS(DXI1 )                    
*                                                                       
*                              (I=I+1)                                  
 LOOP     SA2    A2+B3                                                  
          SA3    A3+B3         (X2,X3) = DXII                           
          BX0    X2                                                     
          AX0    59                                                     
          BX2    X0-X2                                                  
          BX3    X0-X3         (X2,X3) = DABS(DXII )                    
          SB1    B1+B7         COUNT TERM                               
*                                                                       
          FX1    X4-X2         IF DABS(DXII ) .LE. DAMAX , GO TO TEST   
          FX5    X5-X3                                                  
          DX4    X4-X2                                                  
          NX1    X1                                                     
          FX4    X4+X5                                                  
          NX5    X4                                                     
          FX4    X1+X5                                                  
          PL     X4,TEST                                                
*                                                                       
          SX6    B4-B1         (X6) = I                (IDAMAX)         
          BX4    X2            (X4,X5) = DABX(DXII )   (DAMAX)          
          BX5    X3                                                     
*                                                                       
 TEST     NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN IDAMAX        RETURN                                   
          END                                                           
*DECK,ICAMAX                                                            
          IDENT  ICAMAX                                                 
*                                                                       
***       INTEGER FUNCTION ICAMAX(N,CX,INCX)                            
*                                                                       
*         FIND AN INDEX  I(MAX)  CORRESPONDING TO THE MAXIMUM SUM OF THE
*         ABSOLUTE VALUE OF THE REAL PART AND THE ABSOLUTE VALUE OF THE 
*         IMAGINARY PART OF THE COMPONENTS  CXII   OF THE VECTOR CX     
*                                                                       
*         CXII  = CX(1 + (I-1)*2*INCX)  IF INCX .GE. 0                  
*               = CX(1 + (I-N)*2*INCX)  IF INCX .LT. 0                  
*                                                                       
*         CX( )                     COMPLEX TYPE                        
*         N,INCX                    INTEGER TYPE                        
*         RESULT ICAMAX             INTEGER TYPE                        
*                                                                       
*         WRITTEN BY  DAVID R. KINCAID                                  
*                     CENTER FOR NUMERICAL ANALYSIS/COMPUTATION CENTER  
*                     THE UNIVERSITY OF TEXAS AT AUSTIN                 
***       1 JUNE 77                                                     
*                                                                       
          ENTRY  ICAMAX                                                 
          VFD    42/6HICAMAX,18/3                                       
*                                                                       
 ICAMAX   DATA   0             ENTRY/EXIT                               
          INFTN  ICAMAX,3                                               
          MX6    0             (X6)=ICAMAX=0                            
          SA1    B1            (X1) = N                                 
          SB7    -1            (B7) = -1                                
          SB4    X1            (B4) = N                                 
          SB1    X1+B7         (B1) = N-1                               
          NG     B1,OUT        IF(N .LE. 0) GO TO OUT                   
*                                                                       
          SX6    -B7           (X6) = 1                                 
          LE     B1,OUT        IF N .LE. 1 , GO TO OUT                  
*                                                                       
          SA3    B3            (X3) = INCX                              
          SX1    -B1           (X1) = -(N-1)                            
          LX3    1             (X3) = 2*INCX                            
          SB3    X3            (B3) = INCX                              
*                                                                       
          GT     B3,ONE        IF INCX .GT. 0 , GO TO ONE               
          DX3    X1*X3         LOC(CXI1 ) = LOC(CX) - (N-1)*INCX        
          SB2    X3+B2         (B2) = LOC(CXI1 )                        
*                                                                       
*                              (I = 1)                                  
 ONE      SA2    B2            (X2) = REAL(CXI1 )                       
          BX3    X2                                                     
          AX2    59                                                     
          BX5    X2-X3         (X5) = ABS(REAL(CXI1 ))                  
          SA3    B2-B7         (X3) = IMAG(CXI1 )                       
          BX2    X3                                                     
          AX3    59                                                     
          BX4    X3-X2         (X4) = ABS(IMAG(CXI1 )                   
*                                                                       
          RX5    X4+X5                                                  
          NX5    X5            (X5) = (X4) + (X5)    (AMAX)             
*                                                                       
*                              (I = I+1)                                
 LOOP     SA2    A2+B3         (X2) = REAL(CXII )                       
          BX3    X2                                                     
          AX2    59                                                     
          BX2    X2-X3         (X2) = ABS(REAL(CXII ))                  
          SA3    A2-B7         (X3) = IMAG(CXII )                       
          BX7    X3                                                     
          AX3    59                                                     
          BX3    X3-X7         (X3) = ABS(IMAG(CXII )                   
*                                                                       
          RX2    X2+X3                                                  
          SB1    B1+B7         COUNT TERM                               
          NX2    X2            (X2) = (X2) + (X3)                       
*                                                                       
          FX0    X5-X2                                                  
          PL     X0,TEST       IF  ABS(REAL(CXII )) + ABS(IMAG(CXII )) .
*                                                                       
          BX5    X2            (X5) = ABS(REAL(CXII ))    (AMAX)        
          SX6    B4-B1         (X6) = I    (ICAMAX)                     
*                                                                       
 TEST     NZ     B1,LOOP       IF I .NE. N , GO TO LOOP                 
*                                                                       
 OUT      OUTFTN ICAMAX        RETURN                                   
          END                                                           
          AXR$                                                          
$(1).                                                                   
.                                                                       
.   SINGLE PRECISION INNER PRODUCT                                      
.                                                                       
. TO BE USED AS FORTRAN FUNCTION  SDOT(N,X,INCX,Y,INCY)                 
. WHERE SDOT, X, AND Y ARE OF TYPE REAL                                 
. AND    SDOT= SUM FROM I=1 TO N OF A(I)*B(I)  WHERE                    
. A(I) = X(1-INCX+I*INCX)    IF  INCX.GE.0                              
. A(I) = X(1-N*INCX+I*INCX)  IF  INCX.LT.0                              
. B(I)   DEFINED SIMILARLY, WITH X AND INCX REPLACED BY Y AND INCY      
.                                                                       
SDOT*     SZ        A0               . STORE 0 IN A0                    
          SZ        A3               . 0 A3 FOR INDIRECT ADDRESS. OPT.  
          LR        R3,*0,X11        . STORE N IN R3                    
          JGD       R3,NPOS          . STORE N-1 IN R3 AND TEST N       
          J         6,X11            . EXIT IF N.LE.0                   
NPOS      LA,U      A2,*1,X11        . LOAD ADDRESS OF X                
          LXI       A2,*2,X11        . LOAD INCREMENT ON X              
          LXI       A3,*4,X11        . LOAD INCREMENT ON Y              
          LXM,U     A3,*3,X11        . LOAD ADDRESS OF Y                
          JP        A2,TINCY         . TEST IF INCX.GE.0                
          LNA       A4,A2            . ADD -INCX*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A2,A4            .    FOR X                         
TINCY     JP        A3,LOOP          . TEST IF INCY.GE.0                
          LNA       A4,A3            . ADD -INCY*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A3,A4            .    FOR Y                         
.                               BEGIN LOOP TO FORM INNER PRODUCT        
LOOP      LA        A4,0,*A2         . LOAD X AND INCREMENT INDEX       
          FM        A4,0,*A3         . MULTIPLY BY Y AND INCREMENT INDEX
          FA        A0,A4            . ACCUMULATE INNER PRODUCT         
          JGD       R3,LOOP          . END OF INNER PRODUCT LOOP        
          J         6,X11            . RETURN FOR N.GT.0                
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.   DOUBLE PRECISION ACCUMULATION INNER PRODUCT                         
.                                                                       
. TO BE USED AS FORTRAN FUNCTION  DSDOT(N,X,INCX,Y,INCY)                
. WHERE DSDOT IS OF TYPE DOUBLE PRECISION, X AND Y ARE OF TYPE REAL,    
. AND   DSDOT= SUM FROM I=1 TO N OF A(I)*B(I)  WHERE                    
. A(I) = X(1-INCX+I*INCX)    IF  INCX.GE.0                              
. A(I) = X(1-N*INCX+I*INCX)  IF  INCX.LT.0                              
. B(I)   DEFINED SIMILARLY, WITH X AND INCX REPLACED BY Y AND INCY      
.                                                                       
DSDOT*    DSL       A0,72            . STORE 0 IN A0 AND A1             
          SZ        A3               . 0 A3 FOR INDIRECT ADDRESS. OPT.  
          LR        R3,*0,X11        . STORE N IN R3                    
          JGD       R3,NPOS          . STORE N-1 IN R3 AND TEST N       
          J         6,X11            . EXIT IF N.LE.0                   
NPOS      DS        A6,SAVE          . SAVE REGISTERS A6 AND A7         
          LA,U      A2,*1,X11        . LOAD ADDRESS OF X                
          LXI       A2,*2,X11        . LOAD INCREMENT ON X              
          LXI       A3,*4,X11        . LOAD INCREMENT ON Y              
          LXM,U     A3,*3,X11        . LOAD ADDRESS OF Y                
          JP        A2,TINCY         . TEST IF INCX.GE.0                
          LNA       A4,A2            . ADD -INCX*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A2,A4            .    FOR X                         
TINCY     JP        A3,LOOP          . TEST IF INCY.GE.0                
          LNA       A4,A3            . ADD -INCY*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A3,A4            .    FOR Y                         
.                               BEGIN LOOP TO FORM INNER PRODUCT        
LOOP      FEL       A4,0,*A2         . LOAD X, CONVERT TO DOUBLE, AND IN
          FEL       A6,0,*A3         . LOAD Y, CONVERT TO DOUBLE, AND IN
          DFM       A4,A6            . MULTIPLY X TIMES Y               
          DFA       A0,A4            . ACCUMULATE INNER PRODUCT         
          JGD       R3,LOOP          . END OF INNER PRODUCT LOOP        
          DL        A6,SAVE          . RESTORE REGISTERS A6 AND A7      
          J         6,X11            . RETURN FOR N.GT.0                
.                                                                       
$(0)                                                                    
SAVE      +         0D               . PLACE TO SAVE A6 AND A7          
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.  DOUBLE PRECISION INNER PRODUCT                                       
.                                                                       
. TO BE USED AS FORTRAN FUNCTION  DDOT(N,X,INCX,Y,INCY)                 
. WHERE DDOT, X, AND Y ARE OF TYPE DOUBLE PRECISION                     
. AND DDOT= SUM FROM I=1 TO N OF A(I)*B(I)  WHERE                       
. A(I) = X(1-INCX+I*INCX)    IF  INCX.GE.0                              
. A(I) = X(1-N*INCX+I*INCX)  IF  INCX.LT.0                              
. B(I)   DEFINED SIMILARLY, WITH X AND INCX REPLACED BY Y AND INCY      
.                                                                       
DDOT*     DSL       A0,72            . STORE 0 IN A0 AND A1             
          SZ        A3               . 0 A3 FOR INDIRECT ADDRESS. OPT.  
          LR        R3,*0,X11        . STORE N IN R3                    
          JGD       R3,NPOS          . STORE N-1 IN R3 AND TEST N       
          J         6,X11            . EXIT IF N.LE.0                   
NPOS      LA,XH2    A2,*2,X11        . LOAD INCREMENT ON X              
          LA,XH2    A3,*4,X11        . LOAD INCREMENT ON Y              
          LSSC      A2,19            . DOUBLE INCREMENTS FOR            
          LSSC      A3,19            .   DOUBLE PRECISION               
          LXM,U     A2,*1,X11        . LOAD ADDRESS OF X                
          LXM,U     A3,*3,X11        . LOAD ADDRESS OF Y                
          JP        A2,TINCY         . TEST IF INCX.GE.0                
          LNA       A4,A2            . ADD -INCX*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A2,A4            .    FOR X                         
TINCY     JP        A3,LOOP          . TEST IF INCY.GE.0                
          LNA       A4,A3            . ADD -INCY*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A3,A4            .    FOR Y                         
.                               BEGIN LOOP TO FORM INNER PRODUCT        
LOOP      DL        A4,0,*A2         . LOAD X AND INCREMENT INDEX       
          DFM       A4,0,*A3         . MULTIPLY BY Y AND INCREMENT INDEX
          DFA       A0,A4            . ACCUMULATE INNER PRODUCT         
          JGD       R3,LOOP          . END OF INNER PRODUCT LOOP        
          J         6,X11            . RETURN FOR N.GT.0                
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         COMPLEX ACCUMULATION INNER PRODUCT                            
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION CDOTC(N,X,INCX,Y,INCY)              
.    WHERE CDOTC, X AND Y ARE OF TYPE COMPLEX                           
.    AND CDOTC = SUM FROM 1 TO N OF B(I) * COMPLEX CONJUGATE OF A(I)    
.    WHERE A(I)=X(1-INCX+I*INCX)    IF INCX.GE.0                        
.    AND   A(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0                        
.    AND   B(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED          
.          BY Y AND INCY                                                
.                                                                       
CDOTC*    DSL       A0,72 .        STORE ZERO IN A4 AND A5              
          SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         6,X11 .        IF N.LE.0 RETURN                     
NPOS      SR        R3,A5 .        STORE N-1 IN A5                      
          DS        A6,A6A7 .      SAVE CONTENTS OF A6 AND A7 REGISTERS 
          DS        A8,A8A9 .      SAVE CONTENTS OF A8 AND A9 REGISTERS 
          SZ        A8 .           STORE ZERO IN A8                     
          LA,XH2    A2,*2,X11 .    LOAD 2*INCX AND 2*INCY               
          LA,XH2    A3,*4,X11 .    IN THE LEFT HALVES                   
          LSSC      A2,19 .        OF A2 AND A3,                        
          LSSC      A3,19 .        RESPECTIVELY                         
          LXM,U     A2,*1,X11 .    LOAD ADDRESS OF X                    
          LXM,U     A3,*3,X11 .    LOAD ADDRESS OF Y                    
          LSSC      A5,1 .         FORM 2*(N-1) IN A5                   
          JP        A2,TINCY .     IF INCX IS NEGATIVE                  
          LNA       A4,*2,X11 .    ADD -2*INCX*(N-1)                    
          MSI       A4,A5 .        TO THE BASE                          
          AH        A2,A4 .        ADDRESS FOR X                        
TINCY     JP        A3,LOOP .      IF INCY IS NEGATIVE                  
          MSI       A5,*4,X11 .    ADD -2*INCY*(N-1)                    
          ANH       A3,A5 .        TO THE BASE ADDRESS FOR Y            
.                                  BEGIN LOOP                           
LOOP      LA        A5,0,A2 .      LOAD REAL PART OF X                  
          FM        A5,0,A3 .      FORM REAL X * REAL Y                 
LOAD      LNA       A4,1,A2 .      LOAD IMAG. PART OF X                 
          SA        A4,A6 .        STORE IMAG. X IN A6                  
          FM        A6,1,A3 .      FORM IMAG. X * IMAG. Y               
          FAN       A5,A6 .        FORM REAL X*Y AND                    
          FA        A0,A5 .        ACCUMULATE IN A0                     
          FM        A4,0,A3 .      FORM IMAG. X * REAL Y                
          LA        A5,0,*A2 .     LOAD REAL X AND INCREMENT X INDEX    
          FM        A5,1,*A3 .     FORM REAL X * IMAG. Y, INCREMENT Y IN
          FA        A4,A5 .        FORM IMAG. X*Y AND                   
          FA        A8,A4 .        ACCUMULATE IN A8                     
          JGD       R3,LOOP .      END OF LOOP                          
          SA        A8,A1 .        STORE SUM OF IMAG X*Y IN A1          
          DL        A6,A6A7 .      RESTORE A6 AND A7 REGISTERS          
          DL        A8,A8A9 .      RESTORE A8 AND A9 REGISTERS          
          J         6,X11 .        RETURN                               
$(0).                                                                   
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 REGISTERS    
A8A9      +         0D .           PLACE TO SAVE A8 AND A9 REGISTERS    
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         COMPLEX ACCUMULATION INNER PRODUCT                            
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION CDOTU(N,X,INCX,Y,INCY)              
.    WHERE CDOTU, X AND Y ARE OF TYPE COMPLEX                           
.    AND CDOTU = SUM FROM 1 TO N OF A(I)*B(I)                           
.    WHERE A(I)=X(1-INCX+I*INCX)    IF INCX.GE.0                        
.    AND   A(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0                        
.    AND   B(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED          
.          BY Y AND INCY                                                
.                                                                       
CDOTU*    DSL       A0,72 .        STORE ZERO IN A4 AND A5              
          SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         6,X11 .        IF N.LE.0 RETURN                     
NPOS      SR        R3,A5 .        STORE N-1 IN A5                      
          DS        A6,A6A7 .      SAVE CONTENTS OF A6 AND A7 REGISTERS 
          DS        A8,A8A9 .      SAVE CONTENTS OF A8 AND A9 REGISTERS 
          SZ        A8 .           STORE ZERO IN A8                     
          LA,XH2    A2,*2,X11 .    LOAD 2*INCX AND 2*INCY               
          LA,XH2    A3,*4,X11 .    IN THE LEFT HALVES                   
          LSSC      A2,19 .        OF A2 AND A3,                        
          LSSC      A3,19 .        RESPECTIVELY                         
          LXM,U     A2,*1,X11 .    LOAD ADDRESS OF X                    
          LXM,U     A3,*3,X11 .    LOAD ADDRESS OF Y                    
          LSSC      A5,1 .         FORM 2*(N-1) IN A5                   
          JP        A2,TINCY .     IF INCX IS NEGATIVE                  
          LNA       A4,*2,X11 .    ADD -2*INCX*(N-1)                    
          MSI       A4,A5 .        TO THE BASE                          
          AH        A2,A4 .        ADDRESS FOR X                        
TINCY     JP        A3,LOOP .      IF INCY IS NEGATIVE                  
          MSI       A5,*4,X11 .    ADD -2*INCY*(N-1)                    
          ANH       A3,A5 .        TO THE BASE ADDRESS FOR Y            
.                                  BEGIN LOOP                           
LOOP      LA        A5,0,A2 .      LOAD REAL PART OF X                  
          FM        A5,0,A3 .      FORM REAL X * REAL Y                 
LOAD      LA        A4,1,A2 .      LOAD IMAG. PART OF X                 
          SA        A4,A6 .        STORE IMAG. X IN A6                  
          FM        A6,1,A3 .      FORM IMAG. X * IMAG. Y               
          FAN       A5,A6 .        FORM REAL X*Y AND                    
          FA        A0,A5 .        ACCUMULATE IN A0                     
          FM        A4,0,A3 .      FORM IMAG. X * REAL Y                
          LA        A5,0,*A2 .     LOAD REAL X AND INCREMENT X INDEX    
          FM        A5,1,*A3 .     FORM REAL X * IMAG. Y, INCREMENT Y IN
          FA        A4,A5 .        FORM IMAG. X*Y AND                   
          FA        A8,A4 .        ACCUMULATE IN A8                     
          JGD       R3,LOOP .      END OF LOOP                          
          SA        A8,A1 .        STORE SUM OF IMAG X*Y IN A1          
          DL        A6,A6A7 .      RESTORE A6 AND A7 REGISTERS          
          DL        A8,A8A9 .      RESTORE A8 AND A9 REGISTERS          
          J         6,X11 .        RETURN                               
$(0).                                                                   
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 REGISTERS    
A8A9      +         0D .           PLACE TO SAVE A8 AND A9 REGISTERS    
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         SINGLE PRECISION ELEMENTARY VECTOR OPERATION                  
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE SAXPY(N,A,X,INCX,Y,INCY)          
.    A, X, AND Y ARE TYPE SINGLE PRECISION                              
.    YY(I) IS REPLACED BY A*XX(I) + YY(I), I = 1,N                      
.    WHERE XX(I)=X(1-INCX+I*INCX) IF INCX.GE.0                          
.    AND   XX(I)=X(1-N*INCX+I*INCX) IF INCX.LT.0                        
.    AND YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED BY        
.             Y AND INCY                                                
.                                                                       
SAXPY*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         7,X11 .        IF N.LE.0 RETURN                     
NPOS      LA        A0,*1,X11 .    STORE A IN A0                        
          JZ        A0,EXIT .      FAST EXIT IF A=0                     
          LA,U      A2,*2,X11 .    LOAD THE ADDRESS OF X AND            
          LXI       A2,*3,X11 .    INCX                                 
          LXI       A3,*5,X11 .    LOAD INCY AND                        
          LXM,U     A3,*4,X11 .    THE ADDRESS OF Y                     
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A2 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A3 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A3,A4 .           FOR Y                             
.                                  BEGIN LOOP TO                        
LOOP      LA        A4,0,*A2 .     LOAD X AND INCREMENT INDEX           
          FM        A4,A0 .        FORM A*X                             
          FA        A4,0,A3 .      FORM A*X+Y AND                       
          SA        A4,0,*A3 .     STORE RESULT IN Y AND INCREMENT INDEX
          JGD       R3,LOOP .      END OF LOOP                          
EXIT      J         7,X11 .        RETURN                               
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         DOUBLE PRECISION ELEMENTARY VECTOR OPERATION                  
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DAXPY(N,A,X,INCX,Y,INCY)          
.    A, X, AND Y ARE TYPE DOUBLE PRECISION                              
.    YY(I) IS REPLACED BY A*XX(I) + YY(I), I = 1,N                      
.    WHERE XX(I)=X(1-INCX+I*INCX) IF INCX.GE.0  (I=1,N)                 
.    AND   XX(I)=X(1-N*INCX+INCX*I) IF INCX.LT.0  (I=1,N)               
.    AND YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED           
.             BY Y AND INCY                                             
.                                                                       
DAXPY*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         7,X11 .        IF N.LE.0 RETURN                     
NPOS      DL        A0,*1,X11 .    STORE A IN A0 AND A1                 
          JZ        A0,EXIT .      FAST EXIT IF A=0                     
          LA,XH2    A2,*3,X11 .    STORE 2*INCX IN                      
          LSSC      A2,19 .        THE LEFT HALF OF A2                  
          LA,XH2    A3,*5,X11 .    STORE 2*INCY IN                      
          LSSC      A3,19 .        THE LEFT HALF OF A3                  
          LXM,U     A2,*2,X11 .    LOAD THE ADDRESS OF X                
          LXM,U     A3,*4,X11 .    LOAD THE ADDRESS OF Y                
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A2 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A3 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A3,A4 .           FOR V                             
LOOP      DL        A4,0,*A2 .     LOAD X AND INCREMENT INDEX           
          DFM       A4,A0 .        FORM A*X                             
          DFA       A4,0,A3 .      FORM A*X+Y AND                       
          DS        A4,0,*A3 .     STORE IN Y, INCREMENT Y INDEX        
          JGD       R3,LOOP .      END OF LOOP                          
EXIT      J         7,X11 .        RETURN                               
.                                                                       
          END .                                                         
$(1).                                                                   
          AXR$ .                                                        
.                                                                       
.         APPLY MODIFIED GIVENS TRANSFORMATION TO (XX(1) ... XX(N))     
.                                                 (YY(1) ... YY(N))     
.    TO BE USED AS FORTRAN SUBROUTINE SROT(N,X,INCX,Y,INCY,PARAM)       
.    X,Y, AND PARAM ARE SINGLE PRECISION -- SEE SROTMG FOR DEF. OF PARAM
.                                                                       
.         XX(I)=X(1-INCX+I*INCX)    IF INCX .GE. 0                      
.         XX(I)=X(1-N*INCX+I*INCX)  IF INCY .LT. 0                      
.         YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED          
.               BY Y AND INCY.                                          
.                                                                       
SROTM*      SZ        A3           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         7,X11 .        IF N .LE. 0 RETURN                   
.                                                                       
NPOS      LA,U      A1,*1,X11 .    LOAD X ADDRESS                       
          LA,U      A2,*3,X11 .    LOAD Y ADDRESS                       
          LXI       A1,*2,X11 .    LOAD INCX                            
          LXI       A2,*4,X11 .    LOAD INCY                            
          JP        A1,TINCY .     IF INCX IS NEGATIVE                  
          LNA       A5,*2,X11 .    ADD -INCX*(N-1)                      
          MSI       A5,R3 .        TO THE BASE                          
          AH        A1,A5 .        ADDRESS FOR X                        
TINCY     JP        A2,LOOP .      IF INCY IS NEGATIVE                  
          LNA       A4,*4,X11 .    ADD -INCY*(N-1)                      
          MSI       A4,R3 .        TO THE BASE                          
          AH        A2,A4 .        ADDRESS FOR Y                        
.                                                                       
LOOP      LA,U      A0,*5,X11 .    LOAD PARAM STARTING ADDRESS          
          LA        A3,0,A0 .      LOAD FLAG                            
          JZ        A3,ZERO .      IF FLAG=0, TAKE ROUTE ZERO           
          JN        A3,NEG .       IF FLAG .LT. 0, TAKE ROUTE NEG       
.                                  FLAG IS POSITIVE                     
POS       LA        A3,0,A1 .      LOAD X                               
          FM        A3,1,A0 .      FORM H11 * X                         
          FA        A3,0,A2 .      ADD Y TO IT                          
          LA        A4,0,A2 .      LOAD Y                               
          FM        A4,4,A0 .      FORM H22 * 4                         
          FAN       A4,0,A1 .      ADD -X TO IT                         
          SA        A3,0,*A1 .     STORE NEW X, INCREMENT INDEX         
          SA        A4,0,*A2 .     STORE NEW Y, INCREMENT INDEX         
          JGD       R3,POS .       BOTTOM OF LOOP                       
          J         7,X11 .        RETURN                               
.                                  FLAG IS ZERO                         
ZERO      LA        A3,0,A2 .      LOAD Y                               
          FM        A3,3,A0 .      FORM H12 * Y                         
          FA        A3,0,A1 .      ADD X TO IT                          
          LA        A4,0,A1 .      LOAD X                               
          FM        A4,2,A0 .      FORM H21 * X                         
          FA        A4,0,A2 .      ADD Y TO IT                          
          SA        A3,0,*A1 .     STORE NEW X, INCREMENT INDEX         
          SA        A4,0,*A2 .     STORE NEW Y, INCREMENT INDEX         
          JGD       R3,ZERO .      BOTTOM OF LOOP                       
          J         7,X11 .        RETURN                               
.                                  FLAG IS NEGATIVE                     
NEG       TNE       A3,(-2.0) .    TEST FOR FLAG = -2                   
          J         7,X11 .        IF FLAG = -2, RETURN                 
          SA        A6,SAVE .      SAVE A6 CONTENTS                     
NEGL      LA        A3,0,A1 .      LOAD X                               
          FM        A3,1,A0 .      FORM H11 * X                         
          LA        A4,0,A2 .      LOAD Y                               
          FM        A4,3,A0 .      FORM H12 * Y AND                     
          FA        A3,A4 .        ADD TO H11 * X                       
          LA        A4,0,A1 .      LOAD X                               
          FM        A4,2,A0 .      FORM H21 * X                         
          LA        A5,0,A2 .      LOAD Y                               
          FM        A5,4,A0 .      FORM H22 * Y AND                     
          FA        A4,A5 .        ADD TO H21 * X                       
          SA        A3,0,*A1 .     STORE NEW X, INCREMENT INDEX         
          SA        A4,0,*A2 .     STORE NEW Y, INCREMENT INDEX         
          JGD       R3,NEGL .      BOTTOM OF LOOP                       
          LA        A6,SAVE .      RESTORE A6                           
          J         7,X11 .        RETURN                               
.                                                                       
$(0).                                                                   
SAVE      +         0 .            PLACE TO SAVE A6                     
          END                                                           
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         SINGLE PRECISION COPY X INTO Y                                
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE SCOPY(N,X,INCX,Y,INCY)            
.    WHERE X AND Y ARE OF TYPE SINGLE PRECISION.                        
.    XX(I) IS COPIED INTO YY(I), I=1,N  WHERE                           
.    XX(I)=X(1-INCX+I*INCX)    IF INCX.GE.0   AND                       
.    XX(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0   AND                       
.    YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED BY Y AND INCY 
.                                                                       
SCOPY*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R1,*0,X11 .    LOAD N IN R1                         
          LA        A4,R1 .        LOAD N IN A4                         
          JGD       A4,NPOS .      STORE N-1 IN A4, TEST N              
          J         6,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,U      A0,*1,X11 .    LOAD ADDRESS OF X                    
          LA,U      A1,*3,X11 .    LOAD ADDRESS OF Y                    
          LXI       A0,*2,X11 .    LOAD INCX                            
          LXI       A1,*4,X11 .    LOAD INCY                            
          JP        A0,TINCY .     IF INCX IS NEGATIVE,                 
          LNA       A2,*2,X11 .    ADD -INCX*(N-1)                      
          MSI       A2,A4 .        TO THE BASE                          
          AH        A0,A2 .        ADDRESS FOR X                        
TINCY     JP        A1,LOOP .      IF INCY IS NEGATIVE,                 
          MSI       A4,*4,X11 .    ADD -INCY*(N-1)                      
          ANH       A1,A4 .        TO THE BASE ADDRESS FOR Y            
.                                                                       
LOOP      BT        A1,0,*A0 .     COPY X INTO Y                        
          J         6,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         DOUBLE PRECISION COPY X INTO Y AND COMPLEX COPY X INTO Y      
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DCOPY(N,X,INCX,Y,INCY)            
.                                  OR CCOPY(N,X,INCX,Y,INCY)            
.    WHERE X AND Y ARE OF TYPE DOUBLE PRECISION FOR DCOPY               
.    AND TYPE COMPLEX FOR CCOPY.                                        
.    XX(I) IS COPIED INTO YY(I), I=1,N  WHERE                           
.    XX(I)=X(1-INCX+I*INCX)    IF INCX.GE.0   AND                       
.    XX(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0   AND                       
.    YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED BY Y AND INCY 
CCOPY*                                                                  
DCOPY*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R1,*0,X11 .    STORE N IN R1                        
          LA        A4,R1 .        LOAD N INTO A4                       
          JGD       A4,NPOS .      TEST N, STORE N-1 IN A4              
          J         6,X11 .        IF N.LE.0 RETURN                     
NPOS      SR        R1,R3 .        STORE N IN R3                        
          LA,XH2    A0,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A0,19 .        LEFT HALF OF A0                      
          LA,XH2    A1,*4,X11 .    LOAD 2*INCY IN THE                   
          LSSC      A1,19 .        LEFT HALF OF A1                      
          LXM,U     A0,*1,X11 .    LOAD THE ADDRESS OF X                
          LXM,U     A1,*3,X11 .    LOAD THE ADDRESS OF Y                
          LSSC      A4,1 .         FORM 2*(N-1)                         
          JP        A0,TINCY .     IF INCX IS NEGATIVE                  
          LNA       A2,*2,X11 .    ADD -2*INCX*(N-1)                    
          MSI       A2,A4 .        TO THE BASE                          
          AH        A0,A2 .        ADDRESS FOR X                        
TINCY     JP        A1,SAVE .      IF INCY IS NEGATIVE,                 
          MSI       A4,*4,X11 .    ADD -2*INCY*(N-1)                    
          ANH       A1,A4 .        TO THE BASE ADDRESS FOR Y            
SAVE      DS        A0,A2 .        STORE X AND Y INDEXES                
          BT        A1,0,*A0 .     BLOCK TRANSFER FIRST HALF OF EACH NO.
          SR        R3,R1 .        RELOAD R1 WITH N                     
          AH        A2,(1) .       ADD 1 TO THE BASE ADDRESS FOR X      
          AH        A3,(1) .       ADD 1 TO THE BASE ADDRESS FOR Y      
          BT        A3,0,*A2 .     BLOCK TRANS. SECOND HALF OF EACH NO. 
          J         6,X11 .        RETURN                               
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         INTERCHANGE INCREMENTED X AND Y COMPONENTS                    
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DSWAP(N,X,INCX,Y,INCY)            
.           AND AS FORTRAN SUBROUTINE CSWAP(N,X,INCX,Y,INCY)            
.    WHERE X AND Y ARE OF TYPE DOUBLE PRECISION FOR DSWAP               
.    AND TYPE COMPLEX FOR CSWAP                                         
.    XX(I) IS INTERCHANGED WITH YY(I), I=1,N WHERE                      
.    XX(I)=X(1-INCX+I*INCX)    IF INCX.GE.0 AND                         
.    XX(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0 AND                         
.    YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED BY Y AND INCY 
.                                                                       
CSWAP*                                                                  
DSWAP*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         6,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,XH2    A2,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A2,19 .        LEFT HALF OF A2                      
          LA,XH2    A3,*4,X11 .    LOAD 2*INCY IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A2,*1,X11 .    LOAD THE ADDRESS OF X                
          LXM,U     A3,*3,X11 .    LOAD THE ADDRESS OF Y                
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A2 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A3 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A3,A4 .           FOR Y                             
LOOP      DL        A0,0,A2 .      LOAD X                               
          DL        A4,0,A3 .      LOAD Y                               
          DS        A4,0,*A2 .     STORE Y IN X AND INCREMENT X INDEX   
          DS        A0,0,*A3 .     STORE X IN Y AND INCREMENT Y INDEX   
          JGD       R3,LOOP .      END OF LOOP                          
          J         6,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         SQRT OF SUM OF SQUARES OF COMPONENTS OF X                     
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION  SNRM2(N,X,INCX)                    
.    WHERE SNRM2 IS THE SQUARE ROOT OF THE SUM FROM I=1 TO N OF         
.                X(1-INCX+I*INCX)                                       
.    SNRM2 AND X ARE OF TYPE REAL                                       
.                                                                       
.    THIS VERSION OF SNRM2 USES MACHINE-DEPENDENT CONSTANTS TO          
.    AVOID UNDERFLOW AND OVERFLOW.                                      
.    THE CONSTANTS FOR THE UNIVAC 1108 ARE...                           
.    UNDERFLOW -- 1.E-15                                                
.    OVERFLOW--  1.E17   OVERFLOW PROTECTION--  1.E21                   
.                                                                       
SNRM2*    SZ        A0 .           STORE ZERO IN A0                     
          SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,U      A2,*1,X11 .    LOAD X ADDRESS AND                   
          LXI       A2,*2,X11 .    INCX IN A2                           
          SA        A2,A3 .        AND A3                               
          SZ        A5 .           STORE ZERO IN A5                     
          DS        A6,A6A7 .      SAVE THE CONTENTS OF A6 AND A7 REGIST
          SR        R3,R1 .        STORE N-1 IN R1                      
.                                  BEGIN UNDERFLOW LOOP                 
UNDER     LMA       A4,0,*A3 .     LOAD ABS X AND INCREMENT X INDEX     
          TG        A4,MIN .       IF ABS X .GT. MACHINE MIN,           
          J         OVER .         GO TO TEST FOR OVERFLOW. OTHERWISE   
          TLE       A5,A4 .        IF U .LT. ABS X,                     
          SA        A4,A5 .        U= ABS X THAT WAS .GT. U             
          JGD       R3,UNDER .     END OF UNDERFLOW LOOP                
          JZ        A5,4,X11 .     IF U=0, RETURN. OTHERWISE            
          AND       A5,MASK .      STORE A5 EXPONENT IN A6              
          J         EXP+1 .        GO COMPUTE SNRM2                     
.                                  BEGIN OVERFLOW LOOP                  
OVER      LMA       A4,0,*A2 .     LOAD ABS X AND INCREMENT X INDEX     
          TG        A4,MAX .       IF ABS X IS TOO LARGE,               
          J         EXP .          GO PROTECT FROM OVERFLOW. OTHERWISE  
          FM        A4,A4 .        SQUARE X                             
          FA        A0,A4 .        ACCUMULATE SUM OF SQUARES            
          JGD       R1,OVER .      END OF OVERFLOW LOOP                 
          LA        A7,(1.0) .     STORE 1.E0 IN A7                     
ROOT      SX        X11,WB+1 .     SAVE X11 CONTENTS                    
          SA        A0,SUM .       STORE SUM OF SQUARES IN SUM          
          LMJ       X11,SQRT .     GO COMPUTE SQUARE ROOT OF SUM        
          +         SUM .                                               
          +         $-SNRM2,WB .                                        
          FM        A0,A7 .        COMPUTE THE TRUE VALUE OF SNRM2      
          LX        X11,WB+1 .     RESTORE X11                          
          DL        A6,A6A7 .      RESTORE A6 AND A7                    
          J         4,X11 .        RETURN                               
EXP       LA        A6,COMP .      STORE 1.E22 EXPONENT IN A6           
          AU        A6,FRAC .      STORE 1.E22 IN A7                    
          ANA       A6,BIAS .      COMPUTE BIASED EXPONENT              
          JZ        A0,MOD+1 .     IF SNRM2=0, GO COMPUTE SNRM2. OTHERWI
          ANA       A0,A6 .        COMPUTE SNRM2/U                      
          ANA       A0,A6 .                       /U                    
          JP        A0,MOD+1 .     IF SNRM2 .GT.0 GO COMPUTE THE REST OF
          SZ        A0 .           OTHERWISE ZERO IT OUT, THEN          
          J         MOD+1 .        GO FINISH THE COMPUTATIONS           
MOD       LMA       A4,0,*A2 .     LOAD ABS X AND INCREMENT X INDEX     
          ANA       A4,A6 .        MODIFY EXPONENT OF X                 
          FM        A4,A4 .        SQUARE X                             
          FA        A0,A4 .        ACCUMULATE SUM OF SQUARES            
          JGD       R1,MOD .       END OF LOOP TO ACCUMULATE SQUARES    
          J         ROOT .         GO COMPUTE SQUARE ROOT               
$(0) .                                                                  
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 CONTENTS     
SUM       +         0 .            PLACE TO SAVE SUM OF SQUARES         
WB        +         'SNRM2' .      WALKBACK WORD                        
          +         0 .            PLACE TO STORE X11                   
MIN       +         (01150,0,0)    MACHINE MINIMUM EXPONENT             
MAX       +         (02700,0,0)    MACHINE MAXIMUM EXPONENT             
COMP      +         (03130,0,0)    VALUE TO COMPENSATE FOR OVERFLOW (EXP
BIAS      +         (02000,0,0)    BIAS ON THE EXPONENT                 
MASK      +         (07770,0,0)    MASK FOR 1.E-15 EXPONENT             
FRAC      +         (00014,0,0)    MANTISSA FOR 1.E-15 AND 1.E22        
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         DOUBLE PRECISION SQRT OF SUM OF SQUARES OF X COMPONENTS       
.    TO BE USED AS FORTRAN SUBROUTINE DNRM2(N,X,INCX)                   
.    WHERE DNRM2 IS THE SQUARE ROOT OF THE SUM FROM I=1 TO N OF         
.                X(1-INCX+I*INCX)                                       
.    DNRM2 AND X ARE OF TYPE DOUBLE PRECISION                           
.                                                                       
.    THIS VERSION OF DNRM2 USES MACHINE-DEPENDENT CONSTANTS TO          
.    AVOID OVERFLOW AND UNDERFLOW                                       
.    THE CONSTANTS FOR THE UNIVAC 1108 ARE ...                          
.    UNDERFLOW-- 1.D-149                                                
.    OVERFLOW--  1.D+149      OVERFLOW PROTECTION-- 1.D+157             
DNRM2*    DSL       A0,72 .        STORE ZERO IN A0 AND A1              
          SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0, RETURN                    
NPOS      LA,XH2    A3,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*1,X11 .    LOAD THE ADDRESS OF X                
          SA        A3,A2 .        STORE X INDEX IN A2                  
          DS        A6,A6A7 .      SAVE CONTENTS OF A6 AND A7 REGISTERS 
          SA        A8,SAVE .      SAVE CONTENTS OF A8 REGISTER         
          SZ        A5 .           STORE ZERO IN A5                     
          SZ        A8 .           STORE ZERO IN A8                     
          SR        R3,R1 .        STORE N-1 IN R1                      
.                                  BEGIN UNDERFLOW LOOP                 
UNDER     LMA       A4,0,*A3 .     LOAD TOP HALF OF ABS X, INCREMENT X I
          TG        A4,MIN .       IF ABS X .GT. MACHINE MIN,           
          J         OVER .         GO TO TEST FOR OVERFLOW. OTHERWISE   
          TLE       A5,A4 .        IF U .LT. ABS X                      
          SA        A4,A5 .        U= ABS X THAT WAS .GT. U             
          JGD       R3,UNDER .     END OF UNDERFLOW LOOP                
          JZ        A5,4,X11 .     IF U=0, RETURN.  OTHERWISE           
          AND       A5,MASK .      STORE AS EXPONENT IN A6              
.                                  BEGIN OVERFLOW LOOP (USUAL CASE)     
          AU        A6,FRAC .      STORE U IN A7                        
          ANA       A6,BIAS .      COMPUTE BIASED EXPONENT              
         J          MOD .          GO COMPUTE DNRM2                     
OVER      DLM       A4,0,*A2 .     LOAD ABS X                           
          TG        A4,MAX .       IF ABS X IS TOO LARGE,               
          J         EXP .          GO PROTECT FROM OVERFLOW. OTHERWISE  
          DFM       A4,A4 .        SQUARE X                             
          DFA       A0,A4 .        ACCUMULATE SUM OF SQUARES            
          JGD       R1,OVER .      END OF OVERFLOW LOOP                 
          LA        A7,ONE .       STORE 1.DO IN A7 (A8 ALREADY = ZERO) 
ROOT      SX        X11,WB+1 .     SAVE X11 CONTENTS                    
          DS        A0,SUM .       STORE SUM OF SQUARES IN SUM          
          LMJ       X11,DSQRT .    GO COMPUTE SQUARE ROOT OF SUM        
          +         SUM .                                               
          +         $-DNRM2,WB .                                        
          DFM       A0,A7 .        COMPUTE THE TRUE VALUE OF DNRM2      
          LX        X11,WB+1 .     RESTORE X11                          
          DL        A6,A6A7 .      RESTORE A6 AND A7                    
          LA        A8,SAVE .      RESTORE A8                           
          J         4,X11 .        RETURN                               
EXP       LA        A6,COMP .      STORE 1.D157 EXPONENT IN A6          
          AU        A6,FRAC .      STORE U IN A7                        
          ANA       A6,BIAS .      COMPUTE BIASED EXPONENT              
          ANA       A0,A6 .        COMPUTE DNRM2/U                      
          ANA       A0,A6 .                       /U                    
          JP        A0,MOD+1 .     IF DNRM2 .GE.0 GO COMPUTE THE REST OF
          DSL       A0,72 .        OTHERWISE ZERO IT OUT, THEN          
          J         MOD+1 .        GO FINISH THE COMPUTATIONS           
MOD       DLM       A4,0,*A2 .     LOAD ABS X AND INCREMENT X INDEX     
          ANA       A4,A6 .        MODIFY EXPONENT OF X                 
          DFM       A4,A4 .        SQUARE X                             
          DFA       A0,A4 .        ACCUMULATE SUM OF SQUARES            
          JGD       R1,MOD .       END OF LOOP TO ACCUMULATE SQUARES    
          J         ROOT .         GO COMPUTE SQUARE ROOT               
$(0).                                                                   
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 CONTENTS     
SAVE      +         0 .            PLACE TO SAVE A8 CONTENTS            
SUM       +         0D .           PLACE TO SAVE SUM OF SQUARES         
WB        +         'DNRM2' .      WALKBACK WORD                        
          +         0 .            PLACE TO STORE X11                   
MIN       +         (01036,0,0) .       MIN EXPONEN,2**-482, APPROX 1.D-
MAX       +         (02761,0,0) .       MAX EXPONENT=2**497, APPROX 1.D1
COMP      +         (03016,0,0) .       OVERFLOW PROTECTION EXPONENT    
BIAS      +         (02000,0,0) .       BIAS ON THE EXPONENT            
MASK      +         (03777,0,0) .       MASK FOR MIN EXPONENT           
FRAC      +         (00001,04000,0) .    CONVERTS EXPONENT TO EXPONENT W
.                                       FRACTION OF .5                  
ONE       +         (02001,04000,0) .    TOP PART OF 1.D0               
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         SQRT OF SUM OF SQUARES OF COMPONENTS OF X                     
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION  SCNRM2(N,X,INCX)                   
.    WHERE SCNRM2 IS THE SQUARE ROOT OF THE SUM FROM I=1 TO N OF        
.                (ABS(X(1-INCX+I*INCX)))**2                             
.    SCNRM2 IS OF TYPE REAL AND X IS OF TYPE COMPLEX                    
.                                                                       
.    THIS VERSION OF SCNRM2 USES MACHINE DEPENDENT CONSTANTS TO         
.    AVOID UNDERFLOW AND OVERFLOW                                       
.    THE CONSTANTS FOR THE UNIVAC 1108 ARE ...                          
.    UNDERFLOW -- 1.E-15                                                
.    OVERFLOW  -- 1.E+17      OVERFLOW PROTECTION -- 1.E+22             
.                                                                       
SCNRM2*   SZ        A0 .           STORE ZERO IN A0                     
          SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IN N.LE.0 RETURN                     
NPOS      SR        R3,R1 .        STORE N-1 IN R1                      
          DS        A6,A6A7 .      SAVE THE CONTENTS OF A6 AND A7 REGIST
          SZ        A6 .           STORE ZERO IN A6                     
          LA,XH2    A3,*2,X11 .    LOAD 2* INCX IN THE                  
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*1,X11 .    LOAD THE ADDRESS OF X                
          SA        A3,A2 .        STORE X INDEX IN A2                  
.                                  TOP OF UNDERFLOW LOOP                
UNDER     LMA       A4,0,A3 .      LOAD ABS REAL X                      
          LMA       A5,1,*A3 .     LOAD ABS IMAG X AND INCREMENT INDEX  
          FA        A4,A5 .        ADD THE TWO PARTS OF X               
          TG        A4,MIN .       IF ABS X .GT. MACHINE MIN            
          J         OVER .         GO TO TEST FOR OVERFLOW.  OTHERWISE  
          TLE       A6,A4 .        IF U .LT. ABS X                      
          SA        A4,A6 .        STORE ABS X IN U                     
          JGD       R3,UNDER .     BOTTOM OF UNDERFLOW LOOP             
          JZ        A6,4,X11 .     IF U=0, RETURN.  OTHERWISE           
          SA        A6,A5 .        STORE U IN A5                        
          AND       A5,MASK .      STORE EXPONENT OF U IN A6            
          AU        A6,FRAC .      STORE U IN A7                        
          ANA       A6,BIAS .      COMPUTE BIASED EXPONENT AND          
          SA        A6,BIAS .      STORE IN BIAS                        
          J         MOD .          GO COMPUTE SCNRM2                    
.                                  TOP OF OVERFLOW LOOP                 
OVER      LMA       A3,0,A2 .      LOAD ABS REAL X                      
          LMA       A5,1,*A2 .     LOAD ABS IMAG X AND INCREMENT INDEX  
          TLE       A3,MAX .       TEST OT SEE IF EITHER PART OF X      
          TG        A5,MAX .       WILL CAUSE AN OVERFLOW               
          J         EXP .          IF YES, GO PROTECT FROM OVERFLOW.  EL
          FM        A3,A3 .        SQUARE REAL X                        
          FM        A5,A5 .        SQUARE IMAG X AND                    
          FA        A3,A5 .        ADD TO REAL PART, THEN               
          FA        A0,A3 .        ACCUMULATE THE SUM OF SQUARES        
          JGD       R1,OVER .      BOTTOM OF OVERFLOW LOOP              
          LA        A7,ONE .       STORE 1.E0 IN A7                     
ROOT      SX        X11,WB+1 .     SAVE X11 CONTENTS                    
          SA        A0,SUM .       STORE SUM OF SQUARES IN SUM          
          LMJ       X11,SQRT .     GO COMPUTE SQUARE ROOT OF SUM        
          +         SUM .                                               
          +         $-SCNRM2,WB .                                       
          FM        A0,A7 .        COMPUTE THE TRUE VALUE OF SCNRM2     
          LX        X11,WB+1 .     RESTORE X11                          
          DL        A6,A6A7 .      RESTORE A6 AND A7                    
          J         4,X11 .                                             
EXP       LA        A6,COMP .      STORE 1.E22 EXPONENT IN A6           
          AU        A6,FRAC .      STORE U IN A7                        
          ANA       A6,BIAS .      COMPUTE BIASED EXPONENT              
          SA        A6,BIAS .      AND STORE IN BIAS                    
          ANA       A0,BIAS .      COMPUTE SCNRM2/U                     
          ANA       A0,BIAS .                      /U                   
          JP        A0,MOD+2 .     IF SCNRM2.GT.0, GO COMPUTE THE REST O
          SZ        A0 .           OTHERWISE ZERO IT OUT, THEN          
          J         MOD+2 .        GO FINISH THE COMPUTATIONS           
.                                  TOP OF LOOP WITH MODIFIED EXPONENT   
MOD       LMA       A3,0,A2 .      LOAD ABS REAL X                      
          LMA       A5,1,*A2 .     LOAD ABS IMAG X AND INCREMENT INDEX  
          ANA       A3,BIAS .      MODIFY EXPONENT OF REAL X            
          ANA       A5,BIAS .      AND IMAG X                           
          FM        A3,A3 .        SQUARE REAL X                        
          FM        A5,A5 .        SQUARE IMAG X AND                    
          FA        A3,A5 .        ADD TO REAL PART, THEN               
          FA        A0,A3 .        ACCUMULATE THE SUM IN A0             
          JGD       R1,MOD .       BOTTOM OF LOOP WITH MODIFIED EXPONENT
          J         ROOT .         GO COMPUTE SQUARE ROOT               
$(0).                                                                   
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 CONTENTS     
SUM       +         0 .            PLACE TO SAVE SUM OF SQUARES         
WB        +         'SCNRM2' .     WALKBACK WORD                        
          +         0 .            PLACE TO STORE X11                   
MIN       +         (01150,0,0) .  MACHINE MINIMUM EXPONENT             
MAX       +         (02700,0,0) .  MACHINE MAXIMUM EXPONENT             
COMP      +         (03130,0,0) .  EXPONENT OF VALUE TO COMPENSATE FOR O
BIAS      +         (02000,0,0) .  BIAS ON THE EXPONENT                 
MASK      +         (07770,0,0) .  MASK FOR MINIMUM EXPONENT            
FRAC      +         (00014,0,0) .  MANTISSA FOR U                       
ONE       +         (02014,0,0) .  1.E0                                 
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.         SINGLE PRECISION                                              
.         SUM OF ABSOLUTE VALUES OF INCREMENTED X COMPONENTS            
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION SASUM(N,X,INCX)                     
.    WHERE SASUM IS THE SUM FROM 1 TO N OF ABS(X(I*INCX-INCX+1))        
.    AND SASUM AND X ARE OF TYPE SINGLE PRECISION                       
.                                                                       
SASUM*    SZ        A0 .           STORE ZERO IN A0                     
          SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,U      A2,*1,X11 .    LOAD ADDRESS OF X                    
          LXI       A2,*2,X11 .    LOAD INCX                            
.                                  BEGIN LOOP TO                        
LOOP      LMA       A3,0,*A2 .     LOAD ABS X  AND                      
          FA        A0,A3 .        ACCUMULATE SUM OF ABS X IN A0        
          JGD       R3,LOOP .      END LOOP                             
          J         4,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.         DOUBLE PRECISION                                              
.         SUM OF ABSOLUTE VALUES OF INCREMENTED X COMPONENTS            
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION DASUM(N,X,INCX)                     
.    WHERE DASUM IS THE SUM FROM 1 TO N OF ABS(X(I*INCX-INCX+1))        
.    AND DASUM AND X ARE OF TYPE DOUBLE PRECISION                       
.                                                                       
DASUM*    DSL       A0,72 .        STORE ZERO IN A0 AND A1              
          SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,XH2    A2,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A2,19 .        LEFT HALF OF A2                      
          LXM,U     A2,*1,X11 .    LOAD THE ADDRESS OF X                
.                                  BEGIN LOOP TO                        
LOOP      DLM       A3,0,*A2 .     LOAD ABS X  AND                      
          DFA       A0,A3 .        ACCUMULATE SUM OF ABS X              
          JGD       R3,LOOP .      END LOOP                             
          J         4,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         SUM OF ABSOLUTE VALUES OF REAL AND IMAGINARY PARTS OF X       
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION SCASUM(N,X,INCX)                    
.    WHERE SCASUM IS THE SUM FROM I=1 TO N OF REAL X(I) + IMAG. X(I),   
.    X IS OF TYPE COMPLEX AND SCASUM IS OF TYPE REAL                    
.                                                                       
SCASUM*   SZ        A0 .           STORE ZERO IN A0                     
          SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,XH2    A3,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*1,X11 .    LOAD THE ADDRESS OF X                
LOOP      LMA       A4,0,A3 .      LOAD ABS REAL X                      
          LMA       A5,1,*A3 .     LOAD ABS IMAG. X                     
          FA        A4,A5 .        ADD THE TWO PARTS OF X AND           
          FA        A0,A4 .        ACCUMULATE THE SUM IN A0             
          JGD       R3,LOOP .      END OF LOOP                          
          J         4,X11 .        RETURN                               
          END .                                                         
         AXR$                                                           
$(1).                                                                   
.                                                                       
.        SINGLE PRECISION SCALING                                       
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE SSCAL(N,A,X,INCX).                
.    REPLACES X(I*INCX-INCX+1) WITH A*X(I*INCX-INCX+1), I=1,N           
.                                                                       
SSCAL*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         5,X11 .        IF N.LE.0 RETURN                     
NPOS      LA        A0,*1,X11 .    LOAD A IN A0                         
          LA,U      A2,*2,X11 .    LOAD ADDRESS OF X, AND               
          LXI       A2,*3,X11 .    INCX IN A2                           
.                                  BEGIN LOOP TO                        
LOOP      LA        A4,0,A2 .      LOAD X                               
          FM        A4,A0          FORM  A*X AND                        
          SA        A4,0,*A2 .     STORE IN X, INCREMENT X INDEX        
          JGD       R3,LOOP .      END OF LOOP                          
          J         5,X11 .        RETURN                               
.                                                                       
          END .                                                         
         AXR$                                                           
$(1).                                                                   
.                                                                       
.        DOUBLE PRECISION SCALING                                       
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DSCAL(N,A,X,INCX).                
.    REPLACES X(I*INCX-INCX+1) WITH A*X(I*INCX-INCX+1), I=1,N.          
.    A AND X ARE TYPE DOUBLE PRECISION                                  
.                                                                       
DSCAL*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         5,X11 .        IF N.LE.0 RETURN                     
NPOS      DL        A0,*1,X11 .    LOAD A IN A0 AND A1                  
          LA,XH2    A3,*3,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*2,X11 .    LOAD THE ADDRESS OF X                
.                                  BEGIN LOOP TO                        
LOOP      DL        A4,0,A3 .      LOAD X IN A4 AND A5                  
          DFM       A4,A0 .        FORM A*X AND                         
          DS        A4,0,*A3 .     STORE IN X, INCREMENT X INDEX        
          JGD       R3,LOOP .      END OF LOOP                          
          J         5,X11 .        RETURN                               
.                                                                       
          END .                                                         
         AXR$                                                           
$(1).                                                                   
.                                                                       
.        COMPLEX SCALING                                                
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE CSCAL(N,A,X,INCX).                
.    REPLACES X(I*INCX-INCX+1) WITH A*X(I*INCX-INCX+1), I=1,N.          
.    A AND X ARE TYPE COMPLEX                                           
.                                                                       
CSCAL*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         5,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,U      A1,*1,X11 .    LOAD THE ADDRESS OF A                
          LR        R1,0,A1 .      LOAD REAL A IN R1                    
          LR        R2,1,A1 .      LOAD IMAG. A IN R2                   
          SA        A6,SAVE .      SAVE THE CONTENTS OF A6 REGISTER     
          LA,XH2    A3,*3,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*2,X11 .    LOAD THE ADDRESS OF X                
LOOP      LA        A0,0,A3 .      LOAD REAL X IN A0                    
          SA        A0,A1 .        AND A1                               
          FM        A1,R1 .        FORM REAL A * REAL X                 
          LA        A4,1,A3 .      LOAD IMAG. X IN A4                   
          LNA       A5,A4 .        STORE -IMAG. X IN A5                 
          FM        A5,R2 .        FORM IMAG. A * -IMAG. X              
          FA        A5,A1 .        FORM REAL A*X AND                    
          SA        A5,0,A3 .      STORE IN REAL X                      
          FM        A0,R2 .        FORM IMAG. A * REAL X                
          FM        A4,R1 .        FORM REAL A * IMAG. X                
          FA        A0,A4 .        FORM IMAG. A*X AND STORE             
          SA        A0,1,*A3 .     IN IMAG. X, INCREMENT X INDEX        
          JGD       R3,LOOP .      END OF LOOP                          
          LA        A6,SAVE .      RESTORE A6                           
          J         5,X11 .        RETURN                               
$(0).                                                                   
SAVE      +         0.                                                  
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         REAL SCALING ON COMPLEX VECTORS                               
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE CSSCAL(N,A,X,INCX)                
.    WHERE A IS OF TYPE SINGLE PRECISION AND X IS OF TYPE COMPLEX.      
.    X(REAL)+X(IMAGINARY) IS REPLACED BY A*X(REAL)+A*X(IMAGINARY)       
.    X=X(I*INCX-INCX+1), I=1,N                                          
.                                                                       
CSSCAL*   SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         5,X11 .        IF N.LE.0 RETURN                     
NPOS      LA        A0,*1,X11 .    LOAD A IN A0                         
          LA,XH2    A3,*3,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A1                      
          LXM,U     A3,*2,X11 .    LOAD THE ADDRESS OF X                
.                                  BEGIN LOOP TO                        
LOOP      LA        A1,0,A3 .      LOAD REAL X IN A1                    
          FM        A1,A0 .        FORM A*REAL X                        
          SA        A1,0,A3 .      STORE A*REAL X                       
          LA        A1,1,A3 .      LOAD IMAG. X IN A1                   
          FM        A1,A0 .        FORM A*IMAG. X                       
          SA        A1,1,*A3       STORE A*IMAG. X AND INCREMENT X INDEX
          JGD       R3,LOOP .      END OF LOOP                          
          J         5,X11 .        RETURN                               
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         FIND THE INDEX OF MAX. ABSOLUTE VALUE OF X COMPONENTS         
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION ISAMAX(N,X,INCX)                    
.    WHERE X IS OF TYPE REAL AND ISAMAX IS THE INDEX OF THE MAXIMUM     
.    ABSOLUTE VALUE OF X(I), I=1,N. X(I)=X(1-INCX+I*INCX)               
.                                                                       
ISAMAX*   SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          LA        A0,R3 .        AND A0                               
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LXI       A3,*2,X11 .    LOAD INCX IN LEFT OF A3              
          LXM,U     A3,*1,X11 .    LOAD THE ADDRESS OF X                
          LA,XU     A2,-1 .        LOAD -1 IN A2                        
LOOP      LMA       A4,0,*A3 .     LOAD ABS X, INCREMENT INDEX          
          TG        A2,A4 .        TEST IF X IS OUT OF BOUNDS           
          J         END .          IF NO, GO TO BOTTOM OF LOOP          
          LA        A2,A4 .        IF YES, RESET MAXIMUJM VALUE AND     
MOVEI     LA        A1,R3 .        STORE THE INDEX OF X                 
END       JGD       R3,LOOP .      BOTTOM OF LOOP                       
          ANA       A0,A1 .        GET THE CORRECT INDEX FOR MAX X      
          J         4,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         DOUBLE PRECISION                                              
.         FIND THE INDEX OF MAX. ABSOLUTE VALUE OF X COMPONENTS         
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION IDAMAX(N,X,INCX)                    
.    WHERE X IS OF TYPE DOUBLE PRECISION AND IDAMAX IS THE INDEX OF     
.    THE MAXIMUM ABSOLUTE VALUE OF X(I), I=1,N. X(I)=X(1-INCX+I*INCX)   
.                                                                       
IDAMAX*   SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          LA        A0,R3 .        AND A0                               
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,XH2    A3,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*1,X11 .    LOAD THE ADDRESS OF X                
          DL        A1,(-1D) .     LOAD -1 IN A1 AND A2                 
LOOP      DLM       A4,0,*A3 .     LOAD ABS X, INCREMENT INDEX          
          TLE       A1,A4 .        TEST IF 1ST HALF OF X IS OUT OF BOUND
          J         MOVEX .        IF YES, GO STORE NEW MAX             
          TNE       A4,A1 .        TEST IF IT IS EQUAL TO LAST MAX      
          TG        A2,A5 .        IF YES, TEST IF 2ND HALF OF X EXCEEDS
          J         END .          IF NO, GO TO BOTTOM OF LOOP          
MOVEX     DL        A1,A4 .        IF YES, RESET MAXIMUM VAUE AND       
MOVEI     LR        R1,R3 .        STORE THE INDEX OF X                 
END       JGD       R3,LOOP .      BOTTOM OF LOOP                       
          ANA       A0,R1 .        GET THE CORRECT INDEX FOR MAX X      
          J         4,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         FIND THE INDEX OF COMPLEX X COMPONENT HAVING MAXIMUM SUM OF   
.         MAGNITUDES OF REAL AND IMAGINARY PARTS                        
.                                                                       
.    TO BE USED AS FORTRAN FUNCTION ICAMAX(N,X,INCX)                    
.    WHERE X IS OF TYPE COMPLEX AND ICAMAX IS THE INDEX OF THE MAXIMUM  
.    VALUE OF ABS(REAL X(I)) + ABS(IMAG. X(I)), I=1,N.                  
.    X(I)=X(1-INCX+I*INCX)                                              
.                                                                       
ICAMAX*   SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          LA        A0,R3 .        AND A0                               
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         4,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,XH2    A3,*2,X11 .    LOAD 2*INCX IN THE                   
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A3,*1,X11 .    LOAD THE ADDRESS OF X                
          LA,XU     A2,-1 .        LOAD -1 IN A2                        
LOOP      LMA       A4,0,A3 .      LOAD ABS REAL X                      
          LMA       A5,1,*A3 .     LOAD ABS IMAG X                      
          FA        A4,A5 .        ADD THE TWO PARTS OF X               
          TG        A2,A4 .        TEST IF X IS OUT OF BOUNDS           
          J         END .          IF NO, GO TO BOTTOM OF LOOP          
          LA        A2,A4 .        IF YES, RESET MAXIMUM VALUE AND      
MOVEI     LA        A1,R3 .        STORE THE INDEX OF X                 
END       JGD       R3,LOOP .      BOTTOM OF LOOP                       
          ANA       A0,A1 .        GET THE CORRECT INDEX FOR MAX X      
          J         4,X11 .        RETURN                               
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         COMPLEX TYPE ELEMENTARY VECTOR OPERATION                      
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE CAXPY(N,A,X,INCX,Y,INCY)          
.    A, X, AND Y ARE TYPE COMPLEX                                       
.    YY(I) IS REPLACED BY A*XX(I) + YY(I), I = 1,N                      
.    WHERE XX(I)=X(1-INCX+I*INCX)    IF INCX.GE.0                       
.    AND   XX(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0                       
.    AND YY(I) IS SIMILARLY DEFINED, WITH X AND INCY REPLACED           
.             BY Y AND INCY                                             
.                                                                       
CAXPY*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11      LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         7,X11 .        IF N.LE.0 RETURN                     
NPOS      DL        A4,*1,X11 .    LOAD A IN A4 AND A5                  
          JNZ       A4,$+2 .       FAST EXIT                            
          JZ        A5,EXIT .      IF A = 0                             
          DS        A6,A6A7 .      SAVE A6 AND A7                       
          DS        A4,R1 .        STORE A IN R1 AND R2                 
          LA,XH2    A2,*3,X11 .    STORE 2*INCX IN THE                  
          LSSC      A2,19 .        LEFT HALF OF A2                      
          LA,XH2    A3,*5,X11 .    STORE 2*INCY IN THE                  
          LSSC      A3,19 .        LEFT HALF OF A3                      
          LXM,U     A2,*2,X11 .    LOAD THE ADDRESS OF X                
          LXM,U     A3,*4,X11 .    LOAD THE ADDRESS OF Y                
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A2 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A3 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .          TO THE BASE                        
          MSI       A4,R3 .           ADDRESS                           
          AH        A3,A4 .           FOR Y                             
LOOP      LA        A4,0,A2 .      LOAD THE REAL PART OF X IN A4        
          SA        A4,A0 .        AND A0                               
          FM        A4,R1 .        FORM REAL A * REAL X                 
          LA        A5,1,*A2 .     LOAD IMAG. X IN A5 AND               
          LNA       A6,A5 .        STORE -IMAG. X IN A6                 
          FM        A6,R2 .        FORM IMAG A * -IMAG. X               
          FA        A6,A4 .        FORM REAL A*X                        
          FA        A6,0,A3 .      FORM REAL A*X+Y AND                  
          SA        A6,0,A3 .      STORE IN REAL Y                      
          FM        A0,R2 .        FORM IMAG. A * REAL X                
          FM        A5,R1 .        FORM REAL A * IMAG. X                
          FA        A0,A5 .        FORM IMAG. A*X                       
          FA        A0,1,A3 .      FORM IMAG. A*X+Y AND                 
          SA        A0,1,*A3 .     STORE IN IMAG. Y, INCREMENT Y INDEX  
          JGD       R3,LOOP .      END OF LOOP                          
          DL        A6,A6A7 .      RESTORE A6 AND A7 REGISTERS          
EXIT      J         7,X11 .        RETURN                               
$(0).                                                                   
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 REGISTERS    
.                                                                       
          END .                                                         
$(1).                                                                   
          AXR$ .                                                        
.                                                                       
.         APPLY MODIFIED GIVENS TRANSFORMATION TO (XX(1) ... XX(N))     
.                                                 (YY(1) ... YY(N))     
.    TO BE USED AS FORTRAN SUBROUTINE DROT(N,X,INCX,Y,INCY,PARAM)       
.    X,Y, AND PARAM ARE DOUBLE PRECISION -- SEE DROTMG FOR DEF. OF PARAM
.                                                                       
.         XX(I)=X(1-INCX+I*INCX)    IF INCX .GE. 0                      
.         XX(I)=X(1-N*INCX+I*INCX)  IF INCY .LT. 0                      
.         YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED          
.               BY Y AND INCY.                                          
.                                                                       
DROTM*    SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         7,X11 .        IF N.LE.0 RETURN                     
NPOS                                                                    
          SA        A6,SAVE .      SAVE A6 CONTENTS                     
          LA,XH2    A1,*2,X11 .    LOAD 2*INCX                          
          LA,XH2    A2,*4,X11 .    AND                                  
          LSSC      A1,19 .        2*INCY                               
          LSSC      A2,19 .        IN A1 AND A2                         
          LXM,U     A1,*1,X11 .    LOAD X ADDRESS                       
          LXM,U     A2,*3,X11 .    LOAD Y ADDRESS                       
          JP        A1,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A1 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A1,A4 .           FOR X                             
TINCY     JP        A2,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A2 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR Y                             
LOOP                                                                    
          LA,U      A0,*5,X11 .    LOAD SPARAM STARTING ADDRESS         
          LA        A3,0,A0 .      LOAD FLAG                            
          JZ        A3,ZERO .      IF FLAG = 0, TAKE ROUTE ZERO         
          JN        A3,NEG .       IF FLAG.LT.0, TAKE ROUTE NEG         
.                        FLAG IS POSITIVE                               
POS       DL        A3,0,A1 .      LOAD X                               
          DFM       A3,2,A0 .      FORM H11 * X                         
          DFA       A3,0,A2 .      ADD Y TO IT                          
          DL        A5,0,A2 .      LOAD Y                               
          DFM       A5,8,A0 .      FORM H22 * Y                         
          DFAN      A5,0,A1 .      ADD -X TO IT                         
          DS        A3,0,*A1 .     STORE NEW X, INCREMENT INDEX         
          DS        A5,0,*A2 .     STORE NEW Y, INCREMENT INDEX         
          JGD       R3,POS .       BOTTOM OF LOOP                       
RETN                                                                    
          LA        A6,SAVE .      RESTORE A6                           
          J         7,X11 .        RETURN                               
.                        FLAG IS ZERO                                   
ZERO      DL        A3,0,A2 .      LOAD Y                               
          DFM       A3,6,A0 .      FORM H12 * Y                         
          DFA       A3,0,A1 .      ADD X TO IT                          
          DL        A5,0,A1 .      LOAD X                               
          DFM       A5,4,A0 .      FORM H21 * X                         
          DFA       A5,0,A2 .      ADD Y TO IT                          
          DS        A3,0,*A1 .     STORE NEW X, INCREMENT INDEX         
          DS        A5,0,*A2 .     STORE NEW Y, INCREMENT INDEX         
          JGD       R3,ZERO .      BOTTOM OF LOOP                       
          J         RETN .         RETURN                               
.                        FLAG IS NEGATIVE                               
NEG       TNE       A3,MTWO .      TEST FOR FLAG = -2.D0                
          J         RETN .         IF FLAG = -2, RETURN                 
          DS        A7,A7A8 .      SAVE A7 AND A8 CONTENTS              
NEGL      DL        A3,0,A1 .      LOAD X                               
          DFM       A3,2,A0 .      FORM H11 * X                         
          DL        A5,0,A2 .      LOAD Y                               
          DFM       A5,6,A0 .      FORM H12 * Y AND                     
          DFA       A3,A5 .        ADD TO H11 * X                       
          DL        A5,0,A1 .      LOAD X                               
          DFM       A5,4,A0 .      FORM H21 * X                         
          DL        A7,0,A2 .      LOAD Y                               
          DFM       A7,8,A0 .      FORM H22 * Y AND                     
          DFA       A5,A7 .        ADD TO H21 * X                       
          DS        A3,0,*A1 .     STORE NEW X, INCREMENT INDEX         
          DS        A5,0,*A2 .     STORE NEW Y, INCREMENT INDEX         
          JGD       R3,NEGL .      BOTTOM OF LOOP                       
          DL        A7,A7A8 .      RESTORE A7 AND A8                    
          J         RETN .         RETURN                               
$(0).                                                                   
SAVE      +         0 .                                                 
A7A8      +         0D .                                                
MTWO      -         2.0D .                                              
          END                                                           
$(1) .                                                                  
          AXR$ .                                                        
.                                                                       
.         COMPUTE CONSTANTS FOR MODIFIED GIVENS TRANSFORMATION          
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DROTMG(D1,D2,B1,B2,PARAM)         
.    ALL VARIABLES ARE DOUBLE PRECISION                                 
.    THE MATRIX H IS DETERMINED SUCH THAT                               
.                                                                       
.     (H11 H12) * (SQRT(D1)    0    ) * (B1) = (SQRT(ND1)    0     ) = (
.     (H21 H22)   (   0     SQRT(D2))   (B2)   (   0      SQRT(ND2))   (
.                                                                       
.    WHERE ND1, ND2, NB1 ARE NEW VALUES STORED IN D1,D2, AND B1. THE    
.    MATRIX H IS STORED IN PARAM, WITH PARAM(2)=H11, PARAM(3)=H12,      
.    PARAM(4)=H21, PARAM(5)=H22, AS FOLLOWS                             
.                                                                       
.     PARAM(1)=1   PARAM(1)=0   PARAM(1)=-1  PARAM(1)=-2                
.                                                                       
.  H=  (H11  1.)    (1.  H12)    (H11 H12)    ( 1.  0.)                 
.      (-1. H22)    (H21  1.)    (H21 H22)    ( 0.  1.)                 
.                                                                       
.    VALUE OF + OR - 1 ARE NOT STORED, PARAM(1) IS SET BY THE SUBROUTINE
.                                                                       
DROTMG*   SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LA,U      A0,*4,X11 .    LOAD PARAM STARTING ADDRESS          
          DS        A6,A6A7 .      SAVE                                 
          DS        A8,A8A9 .      CONTENTS                             
          DS        A10,A10A11 .   OF                                   
          DS        A12,A12A13 .   'A'                                  
          DS        A14,A14A15 .   REGISTERS                            
          DL        A6,*0,X11 .    LOAD D1                              
          DL        A8,*1,X11 .    LOAD D2                              
          DL        A10,*2,X11 .   LOAD B1                              
          DL        A12,*3,X11 .   LOAD B2                              
          DL        A14,A6 .       FORM P1 =                            
          DFM       A14,A10 .      D1 * B1                              
          DL        A4,A8 .        FORM P2 =                            
          DFM       A4,A12 .       D2 * B2                              
          DL        A2,A14 .       STORE ABS(P1*B1)                     
          DFM       A2,A10 .       INTO                                 
          DLM       A2,A2 .                                             
          DS        A2,R1 .        R1 .                                 
          DL        A2,A4 .        STORE P2*B2 INTO                     
          DFM       A2,A12 .       TEMP                                 
          DS        A2,TEMP .      AND                                  
          DLM       A2,A2 .        ABS(P2*B2) INTO A2                   
          DFAN      A2,R1 .        GET ABS(P2*B2)-ABS(P1*B1)            
          JP        A2,LESS .      GO TO LESS IF RESULT.GT.0            
          DFD       A4,A14 .       STORE P2/P1                          
          DS        A4,6,A0 .      INTO H12                             
          DFD       A12,A10 .      STORE -B2/B1                         
          SNA       A12,4,A0 .     INTO H21                             
          SNA       A13,5,A0 .     (A12 = -H21)                         
          DFM       A4,A12 .       FORM U=1-H12*H21                     
          DFA       A4,ONE .       AND STORE IN A4                      
          DL        A2,A4          IF U                                 
          DFAN      A2,TOL .       .LT. TOL                             
          JN        A2,FALSE .     JUMP TO FALSE                        
          DFD       A6,A4 .        DIVIDE D1 AND                        
          DFD       A8,A4 .        D2 BY U                              
          DFM       A10,A4 .       MULTIPLY B1 BY U                     
          DSL       A14,72 .       STORE 0 IN FLAG                      
          J         SCALE .        GO TEST FOR SCALING PROBLEMS         
LESS                                                                    
          DL        A2,TEMP .                                           
          JZ        A2,ZEROP .     IF P2*B2 = 0 JUMP TO ZEROP           
          JN        A2,FALSE .     IF P2*B2.LT.0 JUMP TO FALSE          
          DFD       A14,A4 .       STORE P1/P2                          
          DS        A14,2,A0 .     INTO H11                             
          DFD       A10,A12 .      STORE B1/B2                          
          DS        A10,8,A0 .     INTO H22                             
          DFM       A10,A14 .      FORM U=1+H11*H22                     
          DFA       A10,ONE .      AND STORE IN A10                     
          DFD       A6,A10 .       SET                                  
          DL        A4,A6 .        D2=                                  
          DFD       A8,A10 .       D1/U                                 
          DL        A6,A8 .        AND D1=                              
          DL        A8,A4 .        D2/U.                                
          DFM       A10,A12 .      SET B1=U*B2                          
          DL        A14,ONE .      STORE 1.D0 IN FLAG                   
          J         SCALE .        GO TEST FOR SCALING PROBLEMS         
ZEROP                                                                   
          DLN       A14,TWO .      STORE -2.0D IN FLAG                  
          J         EXIT .         JUMP TO EXIT CODE                    
FALSE                                                                   
          DLN       A14,ONE .      STORE -1.0D IN FLAG                  
          DL        A2,(0D) .      0 A2 AND A3 (NOTE A3=0 FOR IND. ADD.)
          DS        A2,2,A0 .      STORE ZERO IN                        
          DS        A2,4,A0 .      THE                                  
          DS        A2,6,A0 .      MATRIX H,                            
          DS        A2,8,A0 .      AND IN                               
          DS        A2,*0,X11 .    D1,                                  
          DS        A2,*1,X11 .    D2,                                  
          DS        A2,*2,X11 .    AND B1                               
          J         EXIT           JUMP TO EXIT CODE                    
SCALE     DLM       A12,A6 .       LOAD ABS(D1)                         
          DFAN      A12,CSQINV .   IF ABS(D1) .LT.                      
          JP        A12,$+2 .      C**-2                                
          LMJ       A3,CASE1 .     JUMP TO CASE1                        
          DLM       A12,A6 .       IF ABS(D1)                           
          DFAN      A12,CSQ .      .GT.                                 
          JN        A12,$+2 .      C**2                                 
          LMJ       A3,CASE2 .     JUMP TO CASE2                        
STD1B1    SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          DS        A6,*0,X11 .    STORE D1                             
          DS        A10,*2,X11 .   STORE B1                             
          DL        A6,A8 .        STORE D2 IN A6                       
          DLM       A12,A6 .       LOAD ABS(D2)                         
          DFAN      A12,CSQINV .   IF ABS(D2)                           
          JP        A12,$+2 .      .LT. C**-2                           
          LMJ       A3,CASE3 .     JUMP TO CASE3                        
          DLM       A12,A6 .       IF ABS(D2)                           
          DFAN      A12,CSQ .      .GT.                                 
          JN        A12,$+2 .      C**2                                 
          LMJ       A3,CASE4 .     JUMP TO CASE4                        
STD2      SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          DS        A6,*1,X11 .    STORE D2                             
EXIT                                                                    
          DS        A14,0,A0 .     STORE FLAG                           
          DL        A6,A6A7 .      RESTORE REGISTER CONTENTS            
          DL        A8,A8A9 .                                           
          DL        A10,A10A11 .                                        
          DL        A12,A12A13 .                                        
          DL        A14,A14A15 .                                        
          J         6,X11 .        RETURN                               
CASE1                                                                   
          JZ        A6,STD1B1      IF D1=0, JUMP TO STD1B1              
          LA,XU     A2,4 .         LOAD C INDEX OF 2                    
          J         CASE2+1 .                                           
CASE2                                                                   
          LA,XU     A2,0 .         LOAD C INDEX OF 0                    
          DFM       A10,C,A2 .     COMPUTE NEW B1                       
          AU,U      A0,2 .         STORE FIRST H INDEX IN A1            
          J         TFLAG .                                             
CASE3                                                                   
          JZ        A6,STD2 .      IF D2=0, JUMP TO STD2                
          LA,XU     A2,4 .         LOAD C INDEX OF 2                    
          J         CASE4+1 .                                           
CASE4                                                                   
          LA,XU     A2,0 .         LOAD C INDEX OF 0                    
          AU,U      A0,4 .         STORE SECOND H INDEX IN A1           
TFLAG                                                                   
          DL        A4,ONE .       LOAD 1.D0 IN A4                      
          JZ        A14,FLAG0 .    IF FLAG=0, JUMP TO FLAG0             
          JN        A14,CONT .     IF FLAG.LT.0, JUMP TO CONT           
          DS        A4,6,A0 .      H12 = 1.D0                           
          SNA       A4,4,A0 .      H21 =                                
          SNA       A5,5,A0 .      -1.D0                                
          J         FLAG0+2 .                                           
FLAG0                                                                   
          DS        A4,2,A0 .      H11 = 1.D0                           
          DS        A4,8,A0 .      H22 = 1.D0                           
          DLN       A14,ONE .      FLAG =                               
CONT                                                                    
          DFM       A6,C+2,A2 .    (D1 OR D2) * (C**2 OR C**-2)         
          DLM       A12,A6 .       A12 = ABS(NEW D1 OR D2)              
          DL        A4,0,A1 .      (H11 OR H12) *                       
          DFM       A4,C,A2 .      (C OR C**-1)                         
          DS        A4,0,A1 .      IS STORED IN (H11 OR H12)            
          DL        A4,4,A1 .      (H21 OR H22) *                       
          DFM       A4,C,A2 .      (C OR C**-1)                         
          DS        A4,4,A1 .      IS STORED IN (H21 OR H22)            
          AN,XU     A3,3 .         SUBTRACT 3 FROM RETURN ADDRESS       
          J         0,A3 .         JUMP TO REPEAT TEST ON ABS(D1 OR D2) 
$(0).                                                                   
C         +         4096.0D .                                           
CSQINV    +         5.9604644775390625D*-8  .                           
CINV      +         2.44140625D*-4 .                                    
CSQ       +         16777216.0D .                                       
TOL       +         0D .                                                
ONE       +         1.0D .                                              
TWO       +         2.0D .                                              
TEMP      +         0D .                                                
A6A7      +         0D .                                                
A8A9      +         0D .                                                
A10A11    +         0D .                                                
A12A13    +         0D .                                                
A14A15    +         0D .                                                
          END .                                                         
         AXR$ .                                                         
$(1).                                                                   
 .                                                                      
.         COMPUTE CONSTANTS FOR MODIFIED GIVENS TRANSFORMATION          
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE SROTMG(D1,D2,B1,B2,PARAM)         
.    ALL VARIABLES ARE SINGLE PRECISION                                 
.    THE MATRIX H IS DETERMINED SUCH THAT                               
.                                                                       
.     (H11 H12) * (SQRT(D1)    0    ) * (B1) = (SQRT(ND1)    0     ) = (
.     (H21 H22)   (   0     SQRT(D2))   (B2)   (   0      SQRT(ND2))   (
.                                                                       
.    WHERE ND1, ND2, NB1 ARE NEW VALUES STORED IN D1,D2, AND B1. THE    
.    MATRIX H IS STORED IN PARAM, WITH PARAM(2)=H11, PARAM(3)=H12,      
.    PARAM(4)=H21, PARAM(5)=H22, AS FOLLOWS                             
.                                                                       
.     PARAM(1)=1   PARAM(1)=0   PARAM(1)=-1  PARAM(1)=-2                
.                                                                       
.  H=  (H11  1.)    (1.  H12)    (H11 H12)    ( 1.  0.)                 
.      (-1. H22)    (H21  1.)    (H21 H22)    ( 0.  1.)                 
.                                                                       
.    VALUE OF + OR - 1 ARE NOT STORED, PARAM(1) IS SET BY THE SUBROUTINE
.                                                                       
 . REGISTER ALLOCATION   (SOME USE AS TEMPOARY STORAGE IS NOT MENTIONED)
 .    A0  SPARAM STARTING ADDRESS.                                      
 .    A1  USED FOR FIRST H ADDRESS WHEN SCALING.                        
 .    A2  TEMP. STORAGE OF P1*B1, P2*B2, ABS(P2*B2)    ALSO USED        
 .        FOR C INDEX WHEN SCALING                                      
 .    A3  USED TO STORE RETURN ADDRESS + 2  WHEN SCALING                
 .    A4  P2=D2*B2 AND P2/P1 U  AND  TEMP. STORAGE WHEN SCALING         
 .    A6  D1   ALSO USED FOR D2 WHEN SCALING                            
 .    A8  D2                                                            
 .    A10 B1                                                            
 .    A12 B2   ALSO USED FOR ABS(D1 OR D2) WHEN SCALING                 
 .    A14 P1=D1*B1      ALSO USED TO STORE VALUE OF FLAG (= SPARAM(1))  
 .                                                                      
SROTMG*   SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LA,U      A0,*4,X11 .    LOAD PARAM STARTING ADDRESS.         
          DS        A6,A6A7 .      SAVE CONTENTS OF A REGISTERS.        
          DS        A8,A8A9 .                                           
          DS        A10,A10A11 .                                        
          DS        A12,A12A13 .                                        
          DS        A14,A14A15 .                                        
          LA        A6,*0,X11 .    LOAD D1.                             
          LA        A8,*1,X11 .    LOAD D2.                             
          LA        A10,*2,X11 .   LOAD B1.                             
          LA        A12,*3,X11 .   LOAD B2.                             
          LA        A14,A6 .       FORM P1 =                            
          FM        A14,A10 .      D1 * B1.                             
          LA        A4,A8 .        FORM P2 =                            
          FM        A4,A12 .       D2 * B2.                             
          LA        A2,A14 .       STORE ABS(P1*B1)                     
          FM        A2,A10 .       INTO                                 
          SMA       A2,R1 .        R1.                                  
          LA        A2,A4 .        STORE  P2 * B2 INTO                  
          FM        A2,A12 .       TEMP                                 
          SA        A2,TEMP .      AND  ABS(P2*B2) INTO                 
          SMA       A2,A2 .        A2.                                  
          TG        A2,R1 .        JUMP TO LESS IF                      
          J         LESS .         ABS(P2*B2) .GE. ABS(P1*B1).          
          FD        A4,A14 .       STORE  P2/P1                         
          SA        A4,3,A0 .      INTO H12.                            
          FD        A12,A10 .      STORE -B2/B1                         
          SNA       A12,2,A0 .     INTO H21. (A12 = -H21.)              
          FM        A4,A12 .       FORM U = 1 - H12 * H21               
          FA        A4,ONE .       AND STORE IN A4.                     
          TLE       A4,TOL .       IF  U .LT. TOL                       
          J         FALSE .        JUMP TO FALSE.                       
          FD        A6,A4 .        DIVIDE D1 AND                        
          FD        A8,A4 .        D2 BY U.                             
          FM        A10,A4 .       MULTIPLY B1 BY U.                    
          SZ        A14 .          STORE 0 IN A14 (FLAG)                
          J         SCALE .        GO TEST FOR SCALING PROBLEMS.        
LESS      JZ        A2,ZEROP       IF P2 * B2 = 0  JUMP TO ZEROP        
          LA        A2,TEMP .      IF P2 * B2 .LT. 0                    
          JN        A2,FALSE .     THEN JUMP TO FALSE                   
          FD        A14,A4 .       STORE P1/P2                          
          SA        A14,1,A0 .     INTO H11                             
          FD        A10,A12 .      STORE B1/B2                          
          SA        A10,4,A0 .     INTO H22.                            
          FM        A10,A14 .      FORM U = 1 + H11 * H22               
          FA        A10,ONE .      AND STORE IN A10.                    
          FD        A6,A10 .       SET                                  
          LA        A4,A6 .        D2 =                                 
          FD        A8,A10 .       D1 / U                               
          LA        A6,A8 .        AND D1 =                             
          LA        A8,A4 .        D2 / U.                              
          FM        A10,A12 .      SET B1 = U * B2                      
          LA        A14,ONE .      STORE 1.0 IN A14 (FLAG)              
          J         SCALE .        GO TEST FOR SCALING PROBLEMS.        
ZEROP     LNA       A14,TWO .      STORE -2.0 IN A14 (FLAG)             
          J         EXIT .         JUMP TO EXIT CODE.                   
FALSE     LNA       A14,ONE .      STORE -1.0 IN A14 (FLAG).            
          SZ        1,A0 .         STORE ZERO IN                        
          SZ        2,A0 .         IN                                   
          SZ        3,A0 .         THE                                  
          SZ        4,A0 .         MATRIX H, AND IN                     
          SZ        *0,X11 .       D1,                                  
          SZ        *1,X11 .       D2,                                  
          SZ        *2,X11 .       AND B1.                              
          J         EXIT .         JUMP TO EXIT CODE                    
SCALE     LMA       A12,A6 .       LOAD ABS(D1).                        
          TLE       A12,CSQINV .   IF ABS(D1) .LT. C ** -2              
          LMJ       A3,CASE1 .     JUMP TO CASE1.                       
          TG        A12,CSQ .      IF ABS(D1) .GE. C ** 2               
          LMJ       A3,CASE2 .     JUMP TO CASE2.                       
          SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
STD1B1    SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          SA        A6,*0,X11 .    STORE D1.                            
          SA        A10,*2,X11 .   STORE B1.                            
          LA        A6,A8 .        STORE D2 IN A6.                      
          LMA       A12,A6 .       LOAD ABS(D2).                        
          TLE       A12,CSQINV .   IF  ABS(D2) .LT. C ** -2             
          LMJ       A3,CASE3 .     JUMP TO CASE3.                       
          TG        A12,CSQ .      IF  ABS(D2) .GE. C ** 2              
          LMJ       A3,CASE4 .     JUMP TO CASE4.                       
STD2      SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          SA        A6,*1,X11 .    STORE D2.                            
EXIT      SA        A14,0,A0 .     STORE FLAG                           
          DL        A6,A6A7 .      RESTORE REGISTER CONTENTS.           
          DL        A8,A8A9 .                                           
          DL        A10,A10A11 .                                        
          DL        A12,A12A13 .                                        
          DL        A14,A14A15 .                                        
          J         6,X11 .        RETURN.                              
CASE1     JZ        A12,STD1B1 .   IF D1 = 0  JUMP TO STD1B1.           
          LA,XU     A2,2 .         LOAD C INDEX OF 2.                   
          J         CASE2+1 .                                           
CASE2     LA,XU     A2,0 .         LOAD C INDEX OF 0.                   
          FM        A10,C,A2 .     COMPUTE NEW B1.                      
          AU,U      A0,1 .         STORE FIRST H INDEX IN A1.           
          J         TFLAG                                               
CASE3     JZ        A12,STD2 .     IF D2 = 0  JUMP TO STD2.             
          LA,XU     A2,2 .         LOAD C INDEX OF 2                    
          J         CASE4+1 .                                           
CASE4     LA,XU     A2,0 .         LOAD C INDEX OF 0.                   
          AU,U      A0,2 .         STORE FIRST H INDEX IN A1.           
TFLAG     LA        A4,ONE .       LOAD 1.0 IN A4.                      
          JZ        A14,FLAG0 .    IF FLAG=0, JUMP TO FLAG0.            
          JN        A14,CONT .     IF FLAG .LT. 0, JUMP TO CONT.        
          SA        A4,3,A0 .      H12 = 1.0                            
          SNA       A4,2,A0 .      H21 = -1.0                           
          J         FLAG0+2 .                                           
FLAG0     SA        A4,1,A0 .      H11 = 1.0                            
          SA        A4,4,A0 .      H22 = 1.0                            
          LNA       A14,A4         FLAG = -1.0                          
CONT      FM        A6,C+1,A2 .    (D1 OR D2) * (C**2 OR C**-2).        
          SMA       A6,A12 .       A12 = ABS(NEW(D1 OR D2)).            
          LA        A4,0,A1 .      (H11 OR H12) * (C OR C**-1)          
          FM        A4,C,A2 .      IS STORED IN                         
          SA        A4,0,A1 .      (H11 OR H12).                        
          LA        A4,2,A1 .      (H21 OR H22) * (C OR C**-1)          
          FM        A4,C,A2 .      IS STORED IN                         
          SA        A4,2,A1 .      (H21 OR H22)                         
         AN,XU      A3,2 .         SUBTRACT 2 FROM RETURN ADDRESS       
          J         0,A3 .         JUMP TO REPEAT TEST ON ABS(D1 OR D2) 
$(0).                                                                   
C         +         4096.0 .        2**12                               
CSQINV    +         5.96046448*-8 . 2**-24                              
CINV      +         2.44140625*-4 . 2**-12                              
CSQ       +         16777216.0 .    2**24                               
TOL       +         0 .                                                 
ONE       +         1.0 .                                               
TWO       +         2.0 .                                               
TEMP      +         0 .                                                 
A6A7      +         0D .                                                
A8A9      +         0D .                                                
A10A11    +         0D .                                                
A12A13    +         0D .                                                
A14A15    +         0D .                                                
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         INTERCHANGE INCREMENTED X AND Y COMPONENTS                    
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE SSWAP(N,X,INCX,Y,INCY)            
.    WHERE X AND Y ARE OF TYPE REAL                                     
.    XX(I) IS INTERCHANGED WITH YY(I), I=1,N WHERE                      
.    XX(I)=X(1-INCX+I*INCX)    IF INCX.GE.0 AND                         
.    XX(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0 AND                         
.    YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED BY Y AND INCY 
.                                                                       
SSWAP*    SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    LOAD N IN R3                         
          JGD       R3,NPOS .      STORE N-1 IN R3, TEST N              
          J         6,X11 .        IF N.LE.0 RETURN                     
NPOS      LA,U      A2,*1,X11 .    LOAD ADDRESS OF X AND                
          LXI       A2,*2,X11 .    INCX                                 
          LXI       A3,*4,X11 .    LOAD INCY AND                        
          LXM,U     A3,*3,X11 .    ADDRESS OF Y                         
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A2 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A3 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A3,A4 .           FOR Y                             
LOOP      LA        A0,0,A2 .      LOAD X                               
          LA        A1,0,A3 .      LOAD Y                               
          SA        A1,0,*A2 .     STORE Y IN X AND INCREMENT X INDEX   
          SA        A0,0,*A3 .     STORE X IN Y AND INCREMENT Y INDEX   
          JGD       R3,LOOP .      END OF LOOP                          
          J         6,X11 .        RETURN                               
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         EXTENDED PRECISION ACCUMULATION INNER PRODUCT                 
.                                                                       
.    TO BE USED AS FORTRAN FUNCTIONS                                    
.              DQDOTI(N,B,C,X,INCX,Y,INCY)                              
.              DQDOTA(N,B,C,X,INCX,Y,INCY)                              
.    WHERE  DQDOTI, DQDOTA, B, X, AND Y ARE ALL OF TYPE DOUBLE PRECISION
.    C IS AN EXTENDED PRECISION RESULT REPRESENTED IN A REAL ARRAY OF   
.    LENGTH 5. FOR THE TWO CALLS,                                       
.        DQDOTI  AND C  ARE REPLACED BY B + XX(I)*YY(I), I = 1,N        
.        DQDOTA  AND C  ARE REPLACED BY B + C + XX(I)*YY(I), I = 1,N    
.    WHERE FOR DQDOTA, C HAS BEEN COMPUTED BY AN EARLIER CALL TO EITHER 
.    DQDOTI OR DQDOTA. XX(I) IS DEFINED BY                              
.        XX(I) = X(1-INCX+I*INCX)      FOR  INCX .GE. 0                 
.        XX(I) = X(1-N*INCX+I*INCX     FOR  INCX .LT. 0                 
.    AND YY(I) IS DEFINED SIMILARLY, WITH X, INCX REPLACED BY Y, INCY.  
.    EXTENDED PRECISION ARITHMETIC IS USED INTERNALLY.                  
.                                                                       
DQDOTA*   LA,U      A2,MODEA          . SET UP TO INCLUDE C             
          J         START                                               
DQDOTI*   LA,U      A2,MODEI          . SET UP TO EXCLUDE C             
START     SZ        A3                . 0 A3 FOR INDIRECT ADDRESS. OPT. 
          DS        A6,A6A7           . STORE A REGISTERS               
          DS        A8,A8A9           .                                 
          DS        A10,A10A11        .                                 
          DS        A12,A12A13        .                                 
          DS        A14,A14A15        .                                 
          LR,U      R1,*2,X11         . R1 = ADDRESS OF SAVED VALUE     
          J         0,A2              . JUMP TO MODEA OR MODEI          
MODEA     LA        A0,R1             . LOAD SAVED VALUE (5 CELLS)      
          LA        A11,0,A0          . EXPONENT IN A11                 
          DL        A12,1,A0          . S...  ...   IN A12 AND A13      
          DL        A14,3,A0          . S...  ...   IN A14 AND A15      
                                      . WHERE S IS A SIGN BIT, AND      
                                      . ... ARE BINARY BITS             
          J         $+2                                                 
MODEI     LNA,XU    A11,32768         . EFFECTIVELY SETS SAVED VALUE =0 
          LR        R3,*0,X11         . R3=N                            
          DFU       A6,*1,X11         . GET B -- A6=EXPONENT, A7,A8 = FR
          LA        A2,*4,X11         . INCX IN LEFT OF                 
          LSSC      A2,19             . A2 AND X ADDRESS                
          LXM,U     A2,*3,X11         . IN RIGHT OF A2 .                
          LA        A3,*6,X11         . STORE INCY IN LEFT OF A3 AND    
          LSSC      A3,19             . 0 IN RIGHT OF A3                
          LXM,U     A3,*5,X11         . Y ADDRESS IN RIGHT OF A3.       
          LA        A5,R3             . STORE                           
          AN,XU     A5,1              . N - 1 IN A5                     
          JP        A2,TINCY          . TEST IF INCX.GE.0               
          LNA       A4,A2             . ADD -INCX*(N-1)                 
          SSA       A4,18             .    TO THE BASE                  
          MSI       A4,A5             .    ADDRESS                      
          AH        A2,A4             .    FOR X                        
TINCY     JP        A3,BSET           . TEST IF INCY.GE.0               
          LNA       A4,A3             . ADD -INCY*(N-1)                 
          SSA       A4,18             .    TO THE BASE                  
          MSI       A4,A5             .    ADDRESS                      
          AH        A3,A4             .    FOR Y                        
.                              TAKE CARE OF B                           
BSET      SA        A7,A9             . LOAD SIGNS IN                   
          DSA       A9,71             . A9 AND A10                      
          SA        A6,A4             . STORE EXPONENT IN A4            
          JNZ       A4,GETDIF         . ADD TO C IF B IS NON-ZERO       
.                              START OF LOOP                            
.   BEGIN BY FORMING X(I)*Y(I)                                          
LOOP      DFU       A4,0,*A2          . GET X(I), A4 = BIASED EXPONENT  
          LDSC      A5,6              . A5 = FIRST PART OF FRACTION = X1
          SSC       A6,1              . A6 = 2-ND  PART OF FRACTION = X2
          SA        A5,X1F            . SAVE X1F                        
          DFU       A7,0,*A3          . GET Y(I), A7 = BIASED EXPONENT  
          LDSC      A8,6              . A8 = FIRST PART OF FRACTION = Y1
          SSC       A9,1              . A9 = 2-ND  PART OF FRACTION =Y2F
          SA        A8,Y1F            . SAVE Y1F                        
          A         A4,A7             . ADD EXPONENTS                   
          ANA,U     A4,0002000        . ACCOUNT FOR BIAS AND SHIFTING   
          SA        A6,A7             . A7 = X2F                        
          MF        A5,A9             . A5-A6 = X1F*Y2F                 
          MF        A9,A7             . A9-A10= X2F*Y2F                 
          MF        A7,A8             . A7-A8 = X2F*Y1F                 
          DA        A7,A5             . A7-A8 = X2F*Y1F + X1F*Y2F =MID  
                                      . LEFTMOST BIT NOT USED FOR SIGN  
          SSC       A8,1              . GET SIGN BIT FOR A8             
          AA        A9,A8             . ADD RIGHT OF MID TO X2F*Y2F     
          SA        A7,A8             . LEFT OF MID MOVED TO A8         
          JNO       $+5               . JUMP IF NO OVERFLOW             
          JP        A9,$+3            . COMPENSATE FOR OVERFLOW ****    
          DAN       A8,DBIGM          . RESULT SHOULD BE .GE. 0    *    
          J         $+2               .                            *    
          DA        A8,DBIGM          . RESULT SHOULD BE .LE. 0 ****    
          LA        A5,X1F            . A5-A6 =                         
          MI        A5,Y1F            .  X1F*Y1F                        
          SA        A5,A7             . STORE SIGN BITS                 
          SSA       A7,35             . IN A7.                          
          DA        A7,A5             . ADD IN MOST SIG. PART OF FRAC.  
 .  END OF CODE FOR FORMING X(I)*Y(I)                                   
.   END OF CODE FOR FORMING X(I)*Y(I)                                   
 .  SHIFT  A7-A10  OR  A12-A15  TO RIGHT IF NECESSARY                   
GETDIF    ANU       A4,A11            . A5 = DIFFERENCE IN EXPONENTS    
          LMA       A0,A5             . A0 = SHIFT COUNT                
          JZ        A5,DONESH         . IF A5=0  NO SHIFTING IS REQUIRED
          ANU,U     A0,35             . A1= A0 - 35                     
          JN        A1,TESTSH                                           
          LA,U      A0,35             . SET A0=35                       
          TLE,U     A1,86             .                                 
          J         TESTSH            .                                 
          JN        A5,ELOOP          . NO ADD NECESSARY, IF A4.GT.A11  
          DS        A7,A12            . MOVE A7-A10 TO A12-A15,         
          DS        A9,A14            .                                 
          SA        A4,A11            . AND MOVE A4 TO A11              
          J         TEST0             . BEFORE GOING TO END OF LOOP     
TESTSH    JN        A5,SA7A10         . TEST WHICH TO SHIFT             
          SA        A4,A11            . MOVE A4 TO A11 (A4.GT.A11)      
          DSA       A14,0,A0          . SHIFT  A12-A15 TO THE RIGHT     
          LSSC      A14,1,A0          . A0 POSITIONS (A0.LE.35)         
          DSA       A13,0,A0          .                                 
          SSC       A14,1             .                                 
          LSSC      A13,0,A0          .                                 
          DSA       A12,0,A0          . END OF SHIFT   (A12-A15)        
          JN        A1,DONESH         . JUMP IF DONE SHIFTING           
          JZ        A5,ELOOP          . JUMP IF SHIFT DUE TO LARGE FRAC.
CONTSH    JZ        A1,DONESH         . JUMP IF DONE SHIFTING           
          LA        A0,A1             . GET NEXT                        
          ANU,U     A0,35             . SHIFT                           
          JN        A1,TESTSH         . INDEX AND                       
          LA,U      A0,35             . CONTINUE                        
          JP        A5,TESTSH+2       . SHIFTING                        
SA7A10    DSA       A9,0,A0           . SHIFT  A7-A10 TO THE RIGHT      
          LSSC      A9,1,A0           . A0 POSITIONS (A0.LE.35)         
          DSA       A8,0,A0           .                                 
          SSC       A9,1              .                                 
          LSSC      A8,0,A0           .                                 
          DSA       A7,0,A0           . END OF SHIFT   (A7-A10)         
          JP        A1,CONTSH                                           
.   END OF CODE FOR SHIFTING TO THE RIGHT                               
.   ADD   A7-A10  TO  A12-A15                                           
DONESH    DA        A14,A9            . ADD LEAST SIGNIFICANT PARTS     
          JNO       NOOVER            . JUMP IF NO OVERFLOW             
          DA        A12,A7            . ADD MOST SIGNIFICANT PARTS      
          JP        A14,POSA14        . COMPENSATE FOR OVERFLOW ****    
          DA        A12,(1D)          . RESULT SHOULD BE .GE.0     *    
          AA        A14,DBIG          .                            *    
          JP        A14,BIGTST        .                            *    
A14ZER    LNA       A14,A14           . A14 = 0 AND HAD WRONG SIGN *    
          J         BIGTST            .                            *    
POSA14    DAN       A12,(1D)          . RESULT SHOULD BE .LE.0     *    
          ANA       A14,DBIG          .                            *    
          JP        A14,A14ZER        .                            *    
          J         BIGTST            .                         ****    
NOOVER    DA        A12,A7            . ADD MOST SIGNIFICANT PARTS      
          JP        A12,A12POS        . TEST IF LEAST AND MOST SIGNIF.  
          JN        A14,TEST0         . PARTS HAVE THE SAME SIGN        
          DJZ       A14,ZERA14        .                                 
          DJZ       A12,ZERA12        .                                 
          DA        A12,(1D)          . A14-A15 SHOULD BE .LT.0         
          DA        A14,DBIG          .                                 
          J         TEST0                                               
A12POS    JP        A14,TEST0         .                                 
          DJZ       A14,ZERA14        .                                 
          DJZ       A12,ZERA12        .                                 
          DAN       A12,(1D)          .  A14-A15 SHOULD BE .GT.0        
          DAN       A14,DBIG          .                                 
          J         TEST0             .                                 
ZERA14    DLN       A14,A14           . A14 WAS =0 AND OF WRONG SIGN    
          J         TEST0             .                                 
ZERA12    DLN       A12,A12           . A12 WAS =0 AND OF WRONG SIGN    
 .  A12 IS ZERO, SHIFT A12-A15 LEFT 35 PLACES                           
          LDSC      A12,35            .                                 
          SSC       A13,35            .                                 
          LSSC      A14,1             .                                 
          LDSC      A13,35            .                                 
          LDSC      A14,35            . END OF SHIFT                    
          ANA,U     A11,35            . ADJUST EXPONENT FOR THE SHIFT   
TEST0     JNZ       A12,BIGTST        . IF A12 IS 0, EITHER A SHIFT     
          JNZ       A13,ZERA12+1      . TO THE LEFT IS MADE, OR IF      
          JNZ       A14,ZERA12+1      .                                 
          JNZ       A15,ZERA12+1      .                                 
          LNA,XU    A11,32768         . RESULT=0, SET EXPONENT SMALL    
          J         ELOOP             . AND GO TO END OF LOOP           
BIGTST    LSC       A4,A12            . SET A5=NO. OF BITS=TO SIGN BIT-1
          JNZ       A5,ELOOP          . IF A5=0,A12-15 IS SHIFTED TO THE
          LA,U      A0,10             . RIGHT 10 PLACES TO ELIMINATE    
          SZ        A1                . DANGER OF OVERFLOW.             
          AA        A11,A0            . INCREASE EXPONENT, AND GO SHIFT 
          J         TESTSH+2          . A12-A15 TO RIGHT 10 PLACES      
ELOOP     JGD       R3,LOOP           . END OF LOOP                     
 .  END OF LOOP -- STORE RESULTS                                        
          LA        A0,R1             . SAVE THE RESULT                 
          SA        A11,0,A0          .                                 
          DS        A12,1,A0          .                                 
          DS        A14,3,A0          .                                 
          LSC       A0,A12             . GET FINAL EXPONENT             
          ANU,U     A1,11              .                                
          ANA       A11,A2             .                                
          JP        A11,$+3            . IF BIASED EXPONENT IS NEGATIVE 
          DSL       A0,72              . STORE ZERO FOR RESULT AND      
          J         SAVE               . GET READY TO RETURN            
          LDSC      A12,0,A1           . SHIFT A12 - A14 TO THE         
          SSC       A13,0,A1           . LEFT    A1                     
          LSSC      A14,1              . POSITIONS                      
          LDSC      A13,0,A1           .                                
          DSA       A12,11             . SHIFT A12 - A13 BACK 11 POSITIO
          DLCF      A11,A12            . STORE RESULT AS D.P. NUMBER    
          DS        A12,A0             . IN A0 - A1                     
SAVE      DL        A6,A6A7           . RESTORE A REGISTERS             
          DL        A8,A8A9           .                                 
          DL        A10,A10A11        .                                 
          DL        A12,A12A13        .                                 
          DL        A14,A14A15        .                                 
          J         8,X11             .                                 
$(0).                                                                   
X1F       +         0 .                                                 
Y1F       +         0 .                                                 
A6A7      +         0D .                                                
A8A9      +         0D .                                                
A10A11    +         0D .                                                
A12A13    +         0D .                                                
A14A15    +         0D .                                                
DBIGM     +         0777777777777     .                                 
DBIG      +         0377777777777     .                                 
          +         0777777777777     .                                 
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.   DOUBLE PRECISION ACCUMULATION INNER PRODUCT                         
.                                                                       
. TO BE USED AS FORTRAN FUNCTION  SDSDOT(N,SB,X,INCX,Y,INCY)            
. AND   SDSDOT= SB + SUM FROM I=1 TO N OF A(I)*B(I)  WHERE              
. WHERE SDSDOT, SB, X, AND Y ARE ALL OF TYPE REAL,                      
. A(I) = X(1-INCX+I*INCX)    IF  INCX.GE.0                              
. A(I) = X(1-N*INCX+I*INCX)  IF  INCX.LT.0                              
. B(I)   DEFINED SIMILARLY, WITH X AND INCX REPLACED BY Y AND INCY      
.                                                                       
SDSDOT*   SZ        A3               . 0 A3 FOR INDIRECT ADDRESS. OPT.  
          FEL       A0,*1,X11        . LOAD SB IN A0                    
          LR        R3,*0,X11        . STORE N IN R3                    
          JGD       R3,NPOS          . STORE N-1 IN R3 AND TEST N       
          J         END              . EXIT IF N.LE.0                   
NPOS      DS        A6,SAVE          . SAVE REGISTERS A6 AND A7         
          LA,U      A2,*2,X11        . LOAD ADDRESS OF X                
          LXI       A2,*3,X11        . LOAD INCREMENT ON X              
          LXI       A3,*5,X11        . LOAD INCREMENT ON Y              
          LXM,U     A3,*4,X11        . LOAD ADDRESS OF Y                
          JP        A2,TINCY         . TEST IF INCX.GE.0                
          LNA       A4,A2            . ADD -INCX*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A2,A4            .    FOR X                         
TINCY     JP        A3,LOOP          . TEST IF INCY.GE.0                
          LNA       A4,A3            . ADD -INCY*(N-1)                  
          SSA       A4,18            .    TO THE BASE                   
          MSI       A4,R3            .    ADDRESS                       
          AH        A3,A4            .    FOR Y                         
.                               BEGIN LOOP TO FORM INNER PRODUCT        
LOOP      FEL       A4,0,*A2         . LOAD X, CONVERT TO DOUBLE, AND IN
          FEL       A6,0,*A3         . LOAD Y, CONVERT TO DOUBLE, AND IN
          DFM       A4,A6            . MULTIPLY X TIMES Y               
          DFA       A0,A4            . ACCUMULATE INNER PRODUCT         
          JGD       R3,LOOP          . END OF INNER PRODUCT LOOP        
          DL        A6,SAVE          . RESTORE REGISTERS A6 AND A7      
END       FCL       A0,A0            . ANSWER = SNGL(ANSWER)            
          J         7,X11            . RETURN FOR N.GT.0                
.                                                                       
$(0)                                                                    
SAVE      +         0D               . PLACE TO SAVE A6 AND A7          
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         DOUBLE PRECISION APPLICATION OF A GIVENS TRANSFORMATION       
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DROT(N,X,INCX,Y,INCY,C,S)         
.    APPLY  ( C  S)  TO A 2 BY N MATRIXX (XX(1) ... XX(N))              
.           (-S  C)                      (YY(1) ... YY(N))              
.    WHERE XX(I)=X(1-INCX+I*INCX)    IF INCX.GE.0                       
.    AND   XX(I)=X(1-N*INCX+I*INCX)  IF INCX.LT.0                       
.    AND YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED           
.             BY Y AND INCY                                             
.                                                                       
DROT*     SZ        A3             0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    STORE N IN R3                        
          DL        A0,*5,X11 .    STORE C IN A0 AND A1                 
          DL        A4,*6,X11 .    STORE S IN A4 AND A5                 
          JNZ       A4,$+2 .       TEST FOR RETURN  S=0                 
          DTE       A0,ONE .           AND           C=1                
          JGD       R3,NPOS .          OR           N.LE.0              
          J         8,X11 .        RETURN                               
NPOS      DS        A6,A6A7 .      SAVE CONTENTS OF A6 AND A7 REGISTERS 
          DS        A8,A8A9 .      SAVE CONTENTS OF A8 AND A9 REGISTERS 
          LA,XH2    A2,*2,X11 .    LOAD INCREMENT ON X                  
          LA,XH2    A3,*4,X11 .    LOAD INCREMENT ON Y                  
          LSSC      A2,19 .        DOUBLE INCREMENTS FOR                
          LSSC      A3,19 .           DOUBLE PRECISION                  
          LXM,U     A2,*1,X11 .    LOAD ADDRESS OF X                    
          LXM,U     A3,*3,X11 .    LOAD ADDRESS OF Y                    
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A6,A2 .        ADD -INCX*(N-1)                      
          SSA       A6,18 .           TO THE BASE                       
          MSI       A6,R3 .           ADDRESS                           
          AH        A2,A6 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A6,A3 .        ADD -INCY*(N-1)                      
          SSA       A6,18 .           TO THE BASE                       
          MSI       A6,R3 .           ADDRESS                           
          AH        A3,A6 .           FOR Y                             
LOOP      DL        A6,0,A2 .      LOAD X                               
          DL        A8,0,A3 .      LOAD Y                               
XPART     DFM       A6,A0 .        FORM C*X                             
          DFM       A8,A4 .        FORM S*Y                             
          DFA       A8,A6 .        FORM C*X+S*Y                         
          DL        A6,0,A2 .      LOAD X                               
          DS        A8,0,*A2 .     STORE NEW X, AND INCREMENT INDEX     
          DL        A8,0,A3 .      LOAD Y                               
          DFM       A6,A4 .        FORM S*X                             
          DFM       A8,A0 .        FORM C*Y                             
          DFAN       A8,A6 .       FORM C*Y-S*X                         
          DS        A8,0,*A3 .     STORE NEW Y, AND INCREMENT INDEX     
ENDLOOP   JGD       R3,LOOP .      END OF LOOP                          
          DL        A6,A6A7 .      RESTORE A6 AND A7 REGISTERS          
          DL        A8,A8A9 .      RESTORE A8 AND A9 REGISTERS          
          J         8,X11 .        RETURN                               
.                                                                       
$(0).                                                                   
ONE       +         1.0D           1.0D0                                
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 CONTENTS     
A8A9      +         0D .           PLACE TO SAVE A8 AND A9 CONTENTS     
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         COMPUTE CONSTANTS FOR GIVENS TRANSFORMATION                   
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE  SROTG(A,B,C,S)                   
.    TO COMPUTE (ALL VARIABLES OF TYPE REAL)                            
.               C = A/R,   S = B/R, WHERE  R = (+ OR -) SQRT(A*A + B*B) 
.               (R HAS THE SAME SIGN AS A IF ABS(A) .GT. ABS(B) AND     
.               OTHERWISE HAS THE SIGN OF B.)                           
.               R IS STORED IN A AND S (IF ABS(C) .GT. ABS(S)) OR  1/C  
.               (IF (ABS(C) .LE. ABS(S)) IS STORED IN B. (IF C = 0, 1   
.               IS STORED IN B.)                                        
.    THE GIVENS ROTATION MATRIX IS GIVEN BY     (C  S)                  
.                                               (-S C)                  
.                                                                       
SROTG*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LMA       A0,*0,X11 .    LOAD ABS A                           
          LMA       A1,*1,X11 .    LOAD ABS B                           
          TG        A1,A0 .        TEST IF ABS A .LE. ABS B             
          J         BFIRST .       IF YES GO TO BFIRST                  
AFIRST    SNA       A3,CASE .      STORE -0 IN CASE IF ABS A .GT. ABS B 
          LA        A0,*0,X11 .    LOAD A IN A0                         
          LA        A2,*1,X11 .    LOAD B IN A2                         
          J         STORE .        GO STORE VARIABLE VALUES             
BFIRST    LA        A0,*1,X11 .    LOAD B IN A0                         
          LA        A2,*0,X11 .    LOAD A IN A2                         
          JZ        A2,ZIP .       ZIP IS SPECIAL CASE FOR A=0          
          SZ        CASE .         STORE 0 IN CASE IF ABS A .LT. ABS B  
STORE     SA        A0,RMULT .     STORE CONTENTS OF A0 IN RMULT        
          FD        A2,A0 .        FORM A/B (OR B/A) AND                
          SA        A2,SMULT .     STORE IN SMULT                       
          FM        A2,A2 .        SQUARE A/B (OR B/A) AND              
          FA        A2,ONE .       ADD 1.E0 AND                         
          SA        A2,YR .        STORE RESULT IN YR                   
          SX        X11,WB+1 .     SAVE X11 CONTENTS                    
          LMJ       X11,SQRT .     GET THE SQUARE ROOT OF YR            
          +         YR .                                                
          +         $-SROTG,WB .                                        
          LX        X11,WB+1 .     RESTORE X11                          
          LA        A4,ONE .       PUT 1.E0 IN A4                       
          FD        A4,A0 .        GET THE INVERSE OF SQRT(YR)          
          FM        A0,RMULT .     GET R WITH APPROPRIATE SIGN          
          SA        A0,*0,X11 .    STORE R IN A                         
          TN        CASE .         JUMP TO BIGA                         
          J         BIGA .         IF ABS A .LE. ABS B                  
          SA        A4,*2,X11 .    STORE C  = 1 / SQRT(1 + (B/A)**2)    
          FM        A4,SMULT .     MULTIPLY BY B/A                      
          SA        A4,*3,X11 .    STORE S                              
          SA        A4,*1,X11 .    STORE S IN B                         
          J         5,X11 .        RETURN                               
BIGA      SA        A4,*3,X11 .    STORE S  = 1 / SQRT(1 + (A/B)**2)    
          FM        A4,SMULT .     MULTIPLY BY A/B                      
          SA        A4,*2,X11 .    STORE C                              
          LA        A0,ONE .       STORE                                
          FD        A0,A4 .        1 / C  IN                            
          SA        A0,*1,X11 .    B.                                   
          J         5,X11 .        RETURN                               
ZIP       LA        A4,ONE .       LOAD A 1.                            
          JZ        A0,BZERO .     JUMP IF B=0 (A IS ALSO 0)            
          SA        A0,*0,X11 .    STORE B IN A,                        
          SA        A4,*1,X11 .    1 IN B  (CASE OF C=0),               
          SA        A4,*3,X11 .    1 IN S, AND                          
          SZ        *2,X11.        0 IN C.                              
          J         5,X11 .        RETURN                               
BZERO     SZ        *3,X11 .       STORE 0 IN S AND                     
          SA        A4,*2,X11 .    1 IN C.                              
          J         5,X11 .        RETURN                               
$(0).                                                                   
ONE       +         1.0 .          1.E0                                 
CASE      +         0 .            PLACE TO SAVE CASE                   
RMULT     +         0 .            PLACE TO STORE A (OR B)              
SMULT     +         0 .            PLACE TO STORE A/B (OR B/A)          
YR        +         0 .                                                 
WB        +         'SROTG' .        WALKBACK WORD                      
          +         0 .            PLACE TO SAVE X11                    
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.                                                                       
.         COMPUTE CONSTANTS FOR GIVENS TRANSFORMATION                   
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE DROTG(A,B,C,C)                    
.    TO COMPUTE (ALL VARIABLES OF TYPE DOUBLE PRECISION)                
.               C = A/R,   S = B/R, WHERE  R = (+ OR -) SQRT(A*A + B*B) 
.               (R HAS THE SAME SIGN AS A IF ABS(A) .GT. ABS(B) AND     
.               OTHERWISE HAS THE SIGN OF B.)                           
.               R IS STORED IN A AND S (IF ABS(C) .GT. ABS(S)) OR  1/C  
.               (IF (ABS(C) .LE. ABS(S)) IS STORED IN B. (IF C = 0, 1   
.               IS STORED IN B.)                                        
.    THE GIVENS ROTATION MATRIX IS GIVEN BY     (C  S)                  
.                                               (-S C)                  
.                                                                       
DROTG*    SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LMA       A0,*0,X11 .    LOAD ABS A                           
          LMA       A1,*1,X11 .    LOAD ABS B                           
          TG        A1,A0 .        TEST IF ABS A .LE. ABS B             
          J         BFIRST .       IF YES GO TO BFIRST                  
AFIRST    SNA       A3,CASE .      STORE -0 IN CASE IF ABS A .GT. ABS B 
          DL        A0,*0,X11 .    LOAD A IN A0                         
          DL        A2,*1,X11 .    LOAD B IN A2                         
          J         STORE .        GO STORE VARIABLE VALUES             
BFIRST    DL        A0,*1,X11 .    LOAD B IN A0                         
          DL        A2,*0,X11 .    LOAD A IN A2                         
          JZ        A2,ZIP .       ZIP IS SPECIAL CASE FOR A=0          
          SZ        CASE .         STORE 0 IN CASE IF ABS A .LT. ABS B  
STORE     DS        A0,RMULT .     STORE CONTENTS OF A0 IN RMULT        
          DFD       A2,A0 .        FORM A/B (OR B/A) AND                
          DS        A2,SMULT .     STORE IN SMULT                       
          DFM       A2,A2 .        SQUARE A/B (OR B/A) AND              
          DFA       A2,ONE .       ADD 1.D0 AND                         
          DS        A2,YR .        STORE RESULT IN YR                   
          SX        X11,WB+1 .     SAVE X11 CONTENTS                    
          LMJ       X11,DSQRT .    GET THE SQUARE ROOT OF YR            
          +         YR .                                                
          +         $-DROTG,WB .                                        
          LX        X11,WB+1 .     RESTORE X11                          
          DL        A4,ONE .       PUT 1.D0 IN A4                       
          DFD       A4,A0 .        GET THE INVERSE OF SQRT(YR)          
          DFM       A0,RMULT .     GET R WITH APPROPRIATE SIGN          
          DS        A0,*0,X11 .    STORE R IN A                         
          TN        CASE .         JUMP TO BIGA IF                      
          J         BIGA .         ABS A .LE. ABS B                     
          DS        A4,*2,X11 .    STORE C = 1 / SQRT(1 + (B/A)**2)     
          DFM       A4,SMULT .     MULTIPLY BY B/A                      
          DS        A4,*3,X11 .    STORE S                              
          DS        A4,*1,X11 .    STORE S IN B                         
          J         5,X11 .        RETURN                               
BIGA      DS        A4,*3,X11 .    STORE S = 1 / SQRT(1 + (A/B)**2)     
          DFM       A4,SMULT .     MULTIPLY BY A/B                      
          DS   A4,*2,X11 .         STORE C                              
          DL        A0,ONE .       STORE                                
          DFD       A0,A4 .        1 / C IN                             
          DS        A0,*1,X11 .    B.                                   
          J         5,X11 .        RETURN                               
ZIP       DL        A4,ONE .       LOAD A4,A5 WITH A 1.                 
          JZ        A0,BZERO .     JUMP IF B=0 (A IS ALSO 0)            
          DS        A0,*0,X11 .    STORE B IN A,                        
          DS        A4,*1,X11 .    1 IN B.(CASE OF C=0),                
          DS        A4,*3,X11 .    1 IN S,                              
          SZ        *2,X11 .       0 IN                                 
          SZ        *2,X11 .       C.                                   
          J         5,X11 .        RETURN                               
BZERO     SZ        *3,X11 .       STORE 0 IN                           
          SZ        *3,X11 .       S AND                                
          DS        A4,*2,X11 .    1 IN C.                              
          J         5,X11 .        RETURN                               
$(0).                                                                   
ONE       +         1.0D .         1.D0                                 
CASE      +         0 .            PLACE TO STORE CASE                  
ZERO      +         0D .           0.0D                                 
RMULT     +         0D .           PLACE TO STORE A (OR B)              
SMULT     +         0D .           PLACE TO STORE A/B (OR B/A)          
YR        +         0D .                                                
WB        +         'DROTG' .      WALKBACK WORD                        
          +         0 .            PLACE TO SAVE X11                    
.                                                                       
          END .                                                         
          AXR$                                                          
$(1).                                                                   
.         SINGLE PRECISION APPLICATION OF A GIVENS TRANSFORMATION       
.                                                                       
.    TO BE USED AS FORTRAN SUBROUTINE SROT(N,X,INCX,Y,INCY,C,S)         
.    APPLY (C  S)  TO A 2 BY N MATRIX  (XX(1) ... XX(N))                
.          (-S C)                      (YY(1) ... YY(N))                
.    WHERE XX(I)=X(1-INCX+I*INCX)    IF INCX .GE. 0                     
.    AND   XX(I)=X(1-N*INCX+I*INCX)  IF INCX .LT. 0                     
.    AND YY(I) IS SIMILARLY DEFINED, WITH X AND INCX REPLACED           
.             BY Y AND INCY.                                            
.                                                                       
SROT*     SZ        A3 .           0 A3 FOR INDIRECT ADDRESSING OPTION  
          LR        R3,*0,X11 .    STORE N IN R3                        
          LA        A0,*5,X11 .    STORE C IN A0                        
          LA        A1,*6,X11 .    STORE S IN A1                        
          JNZ       A1,$+2 .       TEST FOR RETURN  S=0                 
          TE        A0,ONE .           AND          C=1                 
          JGD       R3,NPOS .          OR           N.LE.0              
          J         8,X11 .        RETURN                               
NPOS      DS        A6,A6A7 .      SAVE CONTENTS OF A6 AND A7 REGISTERS 
          LA,U      A2,*1,X11 .    LOAD ADDRESS OF X                    
          LXI       A2,*2,X11 .    LOAD INCREMENT ON X                  
          LXI       A3,*4,X11 .    LOAD INCREMENT ON Y                  
          LXM,U     A3,*3,X11 .    LOAD ADDRESS OF Y                    
          JP        A2,TINCY .     TEST IF INCX .GE. 0                  
          LNA       A4,A2 .        ADD -INCX*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A2,A4 .           FOR X                             
TINCY     JP        A3,LOOP .      TEST IF INCY .GE. 0                  
          LNA       A4,A3 .        ADD -INCY*(N-1)                      
          SSA       A4,18 .           TO THE BASE                       
          MSI       A4,R3 .           ADDRESS                           
          AH        A3,A4 .            FOR Y                            
LOOP      LA        A4,0,A2 .      LOAD X                               
          LA        A6,0,A3 .      LOAD Y                               
          FM        A4,A0 .        FORM C*X                             
          FM        A6,A1 .        FORM S*Y                             
          FA        A6,A4 .        FORM C*X + S*Y                       
          LA        A4,0,A2 .      LOAD X                               
          SA        A6,0,*A2 .     STORE NEW X                          
          FM        A4,A1 .        FORM S*X                             
          LA        A6,0,A3 .      LOAD Y                               
          FM        A6,A0 .        FORM C*Y                             
          FAN       A6,A4 .        FORM C*Y - S*X                       
          SA        A6,0,*A3 .     STORE NEW Y                          
          JGD       R3,LOOP .      END OF LOOP                          
          DL        A6,A6A7 .      RESTORE A6 AND A7 REGISTERS          
          J         8,X11 .        RETURN                               
.                                                                       
$(0).                                                                   
ONE       +         1.0 .          1.0                                  
A6A7      +         0D .           PLACE TO SAVE A6 AND A7 REGISTERS    
.                                                                       
          END .                                                         
