FTN4,L,Y
C********************************************************************** 
C 
$EMA(AREA,1)
      PROGRAM TXPF4(3,89),91711-16105  REV 1926  791113 
C 
C     CHANGED 791113. MAKE CPU, M,E,OR F CHECK, AND IF M
C     THEN STOP WITH APPROPRIATE MESSAGE. 
C 
      COMMON / AREA / EV1(500)
      COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
      DIMENSION V1(600),V2(600),V3(600),V4(600) 
      DIMENSION IBUFF(5)
C 
      DOUBLE PRECISION DV1(300),DV2(300),DV3(300),DV4(300),DSUM 
      EQUIVALENCE (V1,DV1),(V2,DV2),(V3,DV3),(V4,DV4) 
C 
      CALL RMPAR(IBUFF) 
      LU = IBUFF(1) 
      IPASS = IBUFF(2)
      IPRIV = IBUFF(3)
      IF (LU.LE.0) LU = LOGLU(LU) 
      IF (IPASS.LE.0) IPASS = 1 
      CALL EXEC(2,LU,2H  ,-2) 
      CALL EXEC(2,LU,44H  TXPF4 - VECTOR INSTRUCTION SET DIAGNOSTIC., 
     +          -44)
C 
C*********************************************************************
C 
C     THE FOLLOWING BLOCK OF LINES ADDED 791113 
C 
C     FIND OUT IF THE COMPUTER IS AN M OR AN E/F MACHINE
C 
      CALL MORFE(ICODE) 
      IF (ICODE.EQ.1)GO TO 5
      CALL EXEC(2,LU,2H  ,-2) 
      CALL EXEC(2,LU, 
     *52H  TXPF4 - PROGRAM CAN ONLY RUN IN AN E OR F MACHINE.,-52)
      CALL EXEC(2,LU,2H  ,-2) 
      STOP 12 
    5 CONTINUE
C 
C*********************************************************************
C 
C     PERFORM SELF-TEST TO CHECK FIRMWARE INSTALLATION
C 
      CALL SELFT(IERR)
      IF (IERR.EQ.0) GOTO 10
      CALL EXEC(2,LU,2H  ,-2) 
      CALL EXEC(2,LU,28H  TXPF4 - SELF TEST FAILURE.,-28) 
      CALL EXEC(2,LU,2H  ,-2) 
      STOP 11 
C 
C********************************************************************** 
C 
C     MAJOR LOOP
C 
 10   DO 99 IDUMMY = 1,IPASS
         NMAX = 600 
         ITEST(1) = 2H
         ITEST(2) = 1 
C 
C     TEST FOR CASES N=0, N<0 
C 
      CALL INITV(V1,V2,V3,V4) 
      CALL  VADD(V1,1,V2,1,V3,1,0)
      CALL VCOMP(V3,V4) 
      CALL  VADD(V1,1,V2,1,V3,1,-1) 
      CALL VCOMP(V3,V4) 
C 
C*********************************************************************
C*********************************************************************
C 
C     TEST SINGLE PRECISION FIRMWARE WITH UNITY INCREMENTS
C 
      ITEST(2) = 0
      INCR1 = 1 
      INCR2 = 1 
      INCR3 = 1 
      N     = NMAX
      CALL INITV(V1,V2,V3,V4) 
      CALL VTEST(V1,V2,V3,V4) 
C 
C*********************************************************************
C 
C     TEST SINGLE PRECISION FIRMWARE WITH NON-UNITY INCREMENTS
C 
      ITEST(2) = 0
      INCR1 = 10
      INCR2 = 20
      INCR3 = 30
      N     = NMAX/30 
      CALL INITV(V1,V2,V3,V4) 
      CALL VTEST(V1,V2,V3,V4) 
C 
C 
C*********************************************************************
C 
C 
C     TEST DOUBLE PRECISION FIRMWARE WITH UNITY INCREMENTS
C 
      ITEST(1) = 2H D 
      ITEST(2) = 0
      INCR1    = 1
      INCR2    = 1
      INCR3    = 1
      NMAX     = NMAX / 2 
      N        = NMAX 
      CALL INITD(DV1,DV2,DV3,DV4) 
      CALL DVTST(DV1,DV2,DV3,DV4) 
C 
C 
C********************************************************************** 
C 
C 
C     TEST DOUBLE PRECISION FIRMWARE WITH NON-UNITY INCREMENTS
C 
      ITEST(2) = 0
      INCR1 = 10
      INCR2 = 20
      INCR3 = 30
      N     = NMAX/30 
      CALL INITD(DV1,DV2,DV3,DV4) 
      CALL DVTST(DV1,DV2,DV3,DV4) 
C 
C*********************************************************************
C*********************************************************************
C 
C 
C     TEST .ERES IN ASMB
C 
      ITEST(1) = 2H . 
      ITEST(2) = ITEST(2) + 1 
      CALL TERES(IERR)
      IF (IERR.NE.0) CALL ERROR 
C 
C 
C*********************************************************************
C 
C 
C     IF IPRIV FLAG NOT SET, SKIP PRIVILEGED SECTION
C 
      IF (IPRIV.EQ.0) GOTO 40 
C 
C 
C*********************************************************************
C 
C 
C     LOCK PROGRAM INTO MEMORY FOR NEXT TWO TESTS 
C 
      CALL EXEC(22,1) 
C 
C 
C********************************************************************** 
C 
C 
C     TEST .ESEG IN ASMB
C 
      ITEST(2) = ITEST(2) + 1 
      CALL TESEG(IERR)
      IF (IERR.NE.0) CALL ERROR 
C 
C 
C*********************************************************************
C 
C 
C     TEST .VSET IN ASMB
C 
      ITEST(2) = ITEST(2) + 1 
      CALL TVSET(IERR)
      IF (IERR.NE.0) CALL ERROR 
C 
C 
C*********************************************************************
C 
C     UNLOCK PROGRAM FROM MEMORY
C 
      CALL EXEC(22,0) 
C 
C 
C********************************************************************** 
C********************************************************************** 
C 
C     PERFORM AN EMA VECTOR INSTRUCTION TO SEE THAT IT ALL PLAYS
C 
      ITEST(1) = 2H 
      ITEST(2) = ITEST(2) + 1 
C 
      DO 20 I=1,500 
         EV1(I) = 100. * SIN(100. * SIN(FLOAT(I)))
 20   CONTINUE
C 
      CALL WSUM(SUM1,EV1(1),1,500)
      DSUM = 0.0D0
      DO 30 I=1,500 
         DSUM = DSUM + DBLE((EV1(I))) 
 30   CONTINUE
C 
      CALL TRUNC(DSUM,SUM2) 
      IF (SUM1.NE.SUM2) CALL ERROR
C 
C***********************************************************************
C 
C     PRINT COMPLETION MESSAGE
C 
 40   IF (NERR.NE.0) STOP 11
      CALL EXEC(2,LU,2H  ,-2) 
C 
      IF (IPRIV.EQ.0) CALL EXEC(2,LU, 
     +   52H  TXPF4 - WARNING, PRIVILEGED INSTRUCTIONS UNTESTED ,-52) 
      CALL EXEC(2,LU,2H  ,-2) 
      CALL EXEC(2,LU,44H  TXPF4 - VIS DIAGNOSTIC COMPLETE: NO ERRORS, 
     +          -44)
C 
C*********************************************************************
C 
C     TEST FOR OPERATOR BREAK 
C 
      IF (IFBRK(I).NE.0) STOP 77
C 
C*********************************************************************
C 
C     END OF MAJOR LOOP 
C 
 99   CONTINUE
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE VTEST(V1,V2,V3,V4) 
C 
      COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
      DIMENSION V1(1),V2(1),V3(1),V4(1) 
      DOUBLE PRECISION DSUM 
C 
      S = 3.14
C 
C*********************************************************************
C 
C 
      CALL VADD(V1,INCR1,V2,INCR2,V3,INCR3,N) 
C 
      CALL INITI
      DO 10 L=1,N 
         V4(I4) = V1(I1) + V2(I2) 
         CALL INCI
 10   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C 
C 
      CALL VSUB(V1,INCR1,V2,INCR2,V3,INCR3,N) 
C 
      CALL INITI
      DO 20 L=1,N 
         V4(I4) = V1(I1) - V2(I2) 
         CALL INCI
 20   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C 
C 
      CALL VMPY(V1,INCR1,V2,INCR2,V3,INCR3,N) 
C 
      CALL INITI
      DO 30 L=1,N 
         V4(I4) = V1(I1) * V2(I2) 
         CALL INCI
 30   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C*********************************************************************
C 
      CALL VDIV(V1,INCR1,V2,INCR2,V3,INCR3,N) 
C 
      CALL INITI
      DO 40 L=1,N 
         V4(I4) = V1(I1) / V2(I2) 
         CALL INCI
 40   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C*********************************************************************
C 
C 
      CALL VSAD(S,V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 50 L=1,N 
         V4(I4) = S + V1(I1)
         CALL INCI
 50   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C 
C 
      CALL VSSB(S,V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 60 L=1,N 
         V4(I4) = S - V1(I1)
         CALL INCI
 60   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C 
C 
      CALL VSMY(S,V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 70 L=1,N 
         V4(I4) = S * V1(I1)
         CALL INCI
 70   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C*********************************************************************
C 
C 
      CALL VSDV(S,V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 80 L=1,N 
         V4(I4) = S / V1(I1)
         CALL INCI
 80   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C 
C 
      CALL VPIV(S,V1,INCR1,V2,INCR2,V3,INCR3,N) 
C 
      CALL INITI
      DO 90 L=1,N 
         V4(I4) = S * V1(I1) + V2(I2) 
         CALL INCI
 90   CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C 
C*********************************************************************
C 
      CALL VABS(V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 100 L=1,N
         V4(I4) = ABS(V1(I1)) 
         CALL INCI
 100  CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C*********************************************************************
C 
      CALL VSUM(SUM1,V1,INCR1,N)
C 
      CALL INITI
      DSUM = 0.0D0
      DO 110 L=1,N
         DSUM = DSUM + DBLE(V1(I1)) 
         CALL INCI
 110  CONTINUE
C 
      CALL TRUNC(DSUM,SUM2) 
      IF (SUM1.NE.SUM2) CALL ERROR
C 
C*********************************************************************
C*********************************************************************
C 
C 
      CALL VNRM(SUM1,V1,INCR1,N)
C 
      CALL INITI
      DSUM = 0.0D0
C 
      DO 120 L=1,N
         DSUM = DSUM + DABS(DBLE(V1(I1))) 
         CALL INCI
 120  CONTINUE
C 
      CALL TRUNC(DSUM,SUM2) 
      IF(SUM1.NE.SUM2) CALL ERROR 
C 
C 
C*********************************************************************
C 
      CALL VDOT(SUM1,V1,INCR1,V2,INCR2,N) 
C 
      CALL INITI
      DSUM = 0.0D0
C 
      DO 130 L=1,N
         DSUM = DSUM + DBLE(V1(I1)) * DBLE(V2(I2))
         CALL INCI
 130  CONTINUE
C 
      CALL TRUNC(DSUM,SUM2) 
      IF (SUM1.NE.SUM2) CALL ERROR
C 
C*********************************************************************
C 
      CALL VMAX(IMAX1,V1,INCR1,N) 
C 
      CALL INITI
      IMAX2 = 1 
      AMAX  = V1(1) 
C 
      DO 140 L=1,N
         IF (AMAX.GE.V1(I1)) GOTO 145 
         IMAX2 = L
         AMAX  = V1(I1) 
 145     CALL INCI
 140  CONTINUE
C 
      IF (IMAX1.NE.IMAX2) CALL ERROR
C 
C*********************************************************************
C 
      CALL VMAX(IMAX1,V1,INCR1,1) 
      IF (IMAX1.NE.1) CALL ERROR
C 
C*********************************************************************
C*********************************************************************
C 
C 
      CALL VMAB(IMAB1,V1,INCR1,N) 
C 
      CALL INITI
      IMAB2 = 1 
      AMAB  = ABS(V1(1))
C 
      DO 150 L=1,N
         IF (AMAB.GE.ABS(V1(I1))) GOTO 155
         IMAB2 = L
         AMAB  = ABS(V1(I1))
 155     CALL INCI
 150  CONTINUE
C 
      IF (IMAB1.NE.IMAB2) CALL ERROR
C 
C 
C*********************************************************************
C 
C 
      CALL VMIN(IMIN1,V1,INCR1,N) 
C 
      CALL INITI
      IMIN2 = 1 
      AMIN  = V1(1) 
C 
      DO 160 L=1,N
         IF (AMIN.LE.V1(I1)) GOTO 165 
         IMIN2 = L
         AMIN  = V1(I1) 
 165     CALL INCI
 160  CONTINUE
C 
      IF (IMIN1.NE.IMIN2) CALL ERROR
C 
C 
C*********************************************************************
C 
      CALL VMIB(IMIB1,V1,INCR1,N) 
C 
      CALL INITI
      IMIB2 = 1 
      AMIB = ABS(V1(1)) 
      DO 170 L=1,N
         IF (AMIB.LE.ABS(V1(I1))) GOTO 175
         IMIB2 = L
         AMIB  = ABS(V1(I1))
 175     CALL INCI
 170  CONTINUE
C 
      IF (IMIB1.NE.IMIB2) CALL ERROR
C 
C********************************************************************** 
C********************************************************************** 
C 
      CALL VMOV(V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 180 L=1,N
         V4(I4) = V1(I1)
         CALL INCI
 180  CONTINUE
C 
      CALL VCOMP(V3,V4) 
C 
C********************************************************************** 
C 
      CALL INITV(V1,V1,V3,V4) 
      INCR2 = INCR1 
C 
      CALL VSWP(V1,INCR1,V3,INCR3,N)
C 
      CALL INITI
      DO 190 L=1,N
         T = V2(I2) 
         V2(I2) = V4(I4)
         V4(I4) = T 
         CALL INCI
 190  CONTINUE
C 
      CALL VCOMP(V1,V2) 
      CALL VCOMP(V3,V4) 
C 
C*********************************************************************
      RETURN
      END 
C*********************************************************************
C 
      SUBROUTINE DVTST(DV1,DV2,DV3,DV4) 
C 
      COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
      DOUBLE PRECISION DV1(1),DV2(1),DV3(1),DV4(1)
      DOUBLE PRECISION DS,DSUM1,DSUM2,DMAX,DMAB,DMIN,DMIB,DT
C 
      DS = 3.14D0 
C 
C*********************************************************************
C 
C 
      CALL DVADD(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) 
C 
      CALL INITI
      DO 10 L=1,N 
         DV4(I4) = DV1(I1) + DV2(I2)
         CALL INCI
 10   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C 
C 
      CALL DVSUB(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) 
C 
      CALL INITI
      DO 20 L=1,N 
         DV4(I4) = DV1(I1) - DV2(I2)
         CALL INCI
 20   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C 
C 
      CALL DVMPY(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) 
C 
      CALL INITI
      DO 30 L=1,N 
         DV4(I4) = DV1(I1) * DV2(I2)
         CALL INCI
 30   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C*********************************************************************
C 
      CALL DVDIV(DV1,INCR1,DV2,INCR2,DV3,INCR3,N) 
C 
      CALL INITI
      DO 40 L=1,N 
         DV4(I4) = DV1(I1) / DV2(I2)
         CALL INCI
 40   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C*********************************************************************
C 
C 
      CALL DVSAD(DS,DV1,INCR1,DV3,INCR3,N)
C 
      CALL INITI
      DO 50 L=1,N 
         DV4(I4) = DS + DV1(I1) 
         CALL INCI
 50   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C 
C 
      CALL DVSSB(DS,DV1,INCR1,DV3,INCR3,N)
C 
      CALL INITI
      DO 60 L=1,N 
         DV4(I4) = DS - DV1(I1) 
         CALL INCI
 60   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C 
C 
      CALL DVSMY(DS,DV1,INCR1,DV3,INCR3,N)
C 
      CALL INITI
      DO 70 L=1,N 
         DV4(I4) = DS * DV1(I1) 
         CALL INCI
 70   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C*********************************************************************
C 
C 
      CALL DVSDV(DS,DV1,INCR1,DV3,INCR3,N)
C 
      CALL INITI
      DO 80 L=1,N 
         DV4(I4) = DS / DV1(I1) 
         CALL INCI
 80   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C 
C 
      CALL DVPIV(DS,DV1,INCR1,DV2,INCR2,DV3,INCR3,N)
C 
      CALL INITI
      DO 90 L=1,N 
         DV4(I4) = DS * DV1(I1) + DV2(I2) 
         CALL INCI
 90   CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C 
C*********************************************************************
C 
      CALL DVABS(DV1,INCR1,DV3,INCR3,N) 
C 
      CALL INITI
      DO 100 L=1,N
         DV4(I4) = DABS(DV1(I1))
         CALL INCI
 100  CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C*********************************************************************
C 
      CALL DVSUM(DSUM1,DV1,INCR1,N) 
C 
      CALL INITI
      DSUM2 = 0.0D0 
      DO 110 L=1,N
         DSUM2 = DSUM2 + DV1(I1)
         CALL INCI
 110  CONTINUE
C 
      IF (DSUM1.NE.DSUM2) CALL ERROR
C 
C 
C*********************************************************************
C*********************************************************************
C 
C 
C 
      CALL DVNRM(DSUM1,DV1,INCR1,N) 
C 
      CALL INITI
      DSUM2 = 0.0D0 
C 
      DO 120 L=1,N
         DSUM2 = DSUM2 + DABS(DV1(I1))
         CALL INCI
 120  CONTINUE
C 
      IF(DSUM1.NE.DSUM2) CALL ERROR 
C 
C 
C*********************************************************************
C 
C 
      CALL DVDOT(DSUM1,DV1,INCR1,DV2,INCR2,N) 
C 
      CALL INITI
      DSUM2 = 0.0D0 
C 
      DO 130 L=1,N
         DSUM2 = DSUM2 + DV1(I1) * DV2(I2)
         CALL INCI
 130  CONTINUE
C 
      IF (DSUM1.NE.DSUM2) CALL ERROR
C 
C 
C*********************************************************************
C 
C 
C 
      CALL DVMAX(IMAX1,DV1,INCR1,N) 
C 
      CALL INITI
      IMAX2 = 1 
      DMAX  = DV1(1)
C 
      DO 140 L=1,N
         IF (DMAX.GE.DV1(I1)) GOTO 145
         IMAX2 = L
         DMAX  = DV1(I1)
 145     CALL INCI
 140  CONTINUE
C 
      IF (IMAX1.NE.IMAX2) CALL ERROR
C 
C 
C 
C*********************************************************************
C*********************************************************************
C 
C 
      CALL DVMAB(IMAB1,DV1,INCR1,N) 
C 
      CALL INITI
      IMAB2 = 1 
      DMAB  = DABS(DV1(1))
C 
      DO 150 L=1,N
         IF (DMAB.GE.DABS(DV1(I1))) GOTO 155
         IMAB2 = L
         DMAB  = DABS(DV1(I1))
 155     CALL INCI
 150  CONTINUE
C 
      IF (IMAB1.NE.IMAB2) CALL ERROR
C 
C 
C*********************************************************************
C 
C 
      CALL DVMIN(IMIN1,DV1,INCR1,N) 
C 
      CALL INITI
      IMIN2 = 1 
      DMIN  = DV1(1)
C 
      DO 160 L=1,N
         IF (DMIN.LE.DV1(I1)) GOTO 165
         IMIN2 = L
         DMIN  = DV1(I1)
 165     CALL INCI
 160  CONTINUE
C 
      IF (IMIN1.NE.IMIN2) CALL ERROR
C 
C 
C*********************************************************************
C 
      CALL DVMIB(IMIB1,DV1,INCR1,N) 
C 
      CALL INITI
      IMIB2 = 1 
      DMIB = DABS(DV1(1)) 
      DO 170 L=1,N
         IF (DMIB.LE.DABS(DV1(I1))) GOTO 175
         IMIB2 = L
         DMIB  = DABS(DV1(I1))
 175     CALL INCI
 170  CONTINUE
C 
      IF (IMIB1.NE.IMIB2) CALL ERROR
C 
C********************************************************************** 
C********************************************************************** 
C 
      CALL DVMOV(DV1,INCR1,DV3,INCR3,N) 
C 
      CALL INITI
      DO 180 L=1,N
         DV4(I4) = DV1(I1)
         CALL INCI
 180  CONTINUE
C 
      CALL DVCMP(DV3,DV4) 
C 
C********************************************************************** 
C 
      CALL INITD(DV1,DV1,DV3,DV4) 
      INCR2 = INCR1 
C 
      CALL DVSWP(DV1,INCR1,DV3,INCR3,N) 
C 
      CALL INITI
      DO 190 L=1,N
         DT = DV2(I2) 
         DV2(I2) = DV4(I4)
         DV4(I4) = DT 
         CALL INCI
 190  CONTINUE
C 
      CALL DVCMP(DV1,DV2) 
      CALL DVCMP(DV3,DV4) 
C 
C*********************************************************************
      RETURN
      END 
C*********************************************************************
C 
      SUBROUTINE INITV(V1,V2,V3,V4) 
C 
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
      DIMENSION V1(1),V2(1),V3(1),V4(1) 
C 
      DO 10 I=1,NMAX
         V1(I) = 100. * SIN(100. * SIN(FLOAT(I))) 
         V2(I) = 100. * COS(100. * COS(FLOAT(I))) 
         V3(I) = 0.0
         V4(I) = 0.0
 10   CONTINUE
C 
      RETURN
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE INITD(DV1,DV2,DV3,DV4) 
C 
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
      DOUBLE PRECISION DV1(1),DV2(1),DV3(1),DV4(1)
C 
      DO 10 I=1,NMAX
         DV1(I) = 100D0 * DSIN(100D0 * DSIN(DBLE(FLOAT(I))))
         DV2(I) = 100D0 * DCOS(100D0 * DCOS(DBLE(FLOAT(I))))
         DV3(I) = 0D0 
         DV4(I) = 0D0 
 10   CONTINUE
C 
      RETURN
C 
C***********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE INITI
C 
      COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
      I1 = 1
      I2 = 1
      I3 = 1
      I4 = 1
C 
      ITEST(2) = ITEST(2) + 1 
C 
      RETURN
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE INCI 
C 
      COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3
C 
      I1 = I1 + INCR1 
      I2 = I2 + INCR2 
      I3 = I3 + INCR3 
      I4 = I4 + INCR3 
C 
      RETURN
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE VCOMP(V3,V4) 
C 
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
      DIMENSION V1(1),V2(1),V3(1),V4(1) 
C 
      DO 10 I=1,NMAX
         IF (V3(I).NE.V4(I)) GOTO 20
 10   CONTINUE
C 
      RETURN
C 
C 
 20   CALL ERROR
      RETURN
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE DVCMP(DV3,DV4) 
C 
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
      DOUBLE PRECISION DV3(1),DV4(1)
C 
      DO 10 I=1,NMAX
         IF (DV3(I).NE.DV4(I)) GOTO 20
 10   CONTINUE
C 
      RETURN
C 
C 
 20   CALL ERROR
      RETURN
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE ERROR
C 
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
      REAL NAMES(23),BUFFR(9) 
      INTEGER IBUFF(2)
      EQUIVALENCE (IBUFF(1),BUFFR(8)) 
      DATA NAMES / 4HVADD,4HVSUB,4HVMPY,4HVDIV,4HVSAD,4HVSSB, 
     +             4HVSMY,4HVSDV,4HVPIV,4HVABS,4HVSUM,4HVNRM, 
     +             4HVDOT,4HVMAX,4HVMAB,4HVMIN,4HVMIB,4HVMOV, 
     +             4HVSWP,4HERES,4HESEG,4HVSET,4HWSUM / 
C 
      DATA BUFFR / 4H  TX,4HPF4 ,4H- ER,4HROR ,4HIN I,4HNSTR, 
     +             4HUCTI,4HON  / 
C 
      BUFFR(9) = NAMES(ITEST(2))
      IBUFF(2) = ITEST(1) 
      CALL EXEC(2,LU,2H  ,-2) 
      CALL EXEC(2,LU,BUFFR,-36) 
      NERR = NERR + 1 
      RETURN
C 
C*********************************************************************
      END 
C*********************************************************************
C 
      SUBROUTINE TRUNC(IDBLE,ISNGL) 
C 
      DIMENSION IDBLE(1),ISNGL(1) 
C 
      ISNGL(1) = IDBLE(1) 
      IDBLE(2) = IDBLE(2).AND.177400B 
      IDBLE(4) = IDBLE(4).AND.377B
      ISNGL(2) = IDBLE(2).OR.IDBLE(4) 
C 
      RETURN
C 
C***********************************************************************
      END 
C*********************************************************************
C 
      BLOCK DATA
C 
      COMMON/INDEX/I1,I2,I3,I4,INCR1,INCR2,INCR3
      COMMON/PARAM/LU,N,NMAX,ITEST(2),NERR
C 
C 
      DATA NERR / 0 / 
C 
C********************************************************************** 
      END