FTN4,L
      SUBROUTINE GRTST(IUNIT,ANGLE,VEL),09580-16010 REV.2001
     +791005
C 
C**************************************** 
C 
C  RELOCATABLE   09580-16010
C  SOURCE        09580-18010
C 
C  V.POVIO   10-4-76
C  BOB RICHARDS 791005
C 
C*********************************************************************
C 
C      HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY
C      MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND
C      DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT.
C 
C      (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.
C      ALL RIGHTS RESERVED.  NO PART OF THIS PROGRAM
C      MAY BE PHOTOCOPIED, REPRODUCED OR TRANSLATED 
C      TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C      WRITTEN CONSENT OF THE HEWLETT-PACKARD COMPANY.
C 
C*********************************************************************
C 
C 
C***************************************
C 
C  GERTSH PSS-2613R 
C  ---------------- 
C 
C  GENERAL: 
C  -------
C 
C   THE FOLLOWING TWO DEVICE SUBROUTINES ARE USED 
C   TO PROGRAM THE GERTSCH PSS-2613R DIGITAL TO 
C   SYNCHRO CONVERTER.
C 
C  HARDWARE CONFIGURATION:
C  ---------------------- 
C 
C   HP 21MX SERIES COMPUTER 
C 
C   GERTSCH PSS-2613R DIGITAL TO SYNCHRO CONVERTER
C 
C   HP 09200-60006  CONTROL CABLE 
C 
C   HP 12566-60024  MICROCIRCUIT CARD 
C      JUMPERED AS FOLLOWS
C 
C      W1-A 
C      W2-C 
C      W3-A 
C      W4-B 
C      W5 THRU W8-OUT 
C      W9-A 
C 
C 
C  DATA WORD FORMAT:
C  ---------------- 
C 
C   OUTPUT/INPUT WORD #1
C 
C     !15 14 13 12!11 10  9  8! 7  6  5  4! 3  2  1  0! 
C     ------------------------------------------------- 
C     !  10^2     !  10^1     !  10^0     !  10^-1    ! 
C     ------------------------------------------------- 
C 
C     ALL SECTIONS ARE BCD
C 
C   OUTPUT WORD #2
C 
C     !15!14!13 12 11 10  9  8  7  6  5  4  3! 2! 1  0! 
C     ------------------------------------------------- 
C     !SB!MB!--------NOT USED----------------!D ! VEL ! 
C     ------------------------------------------------- 
C 
C     SB=STOP BIT 
C       =0 NORMAL OPERATION 
C       =1 STOP 
C 
C     MB=MODE BIT 
C       =0 STATIC MODE
C       =1 DYNAMIC MODE 
C 
C     D=DIRECTION 
C      =0 DECREASING ANGLE (CLOCK-WISE) 
C      =1 INCREASING ANGLE )COUNTER-CLOCK-WISE) 
C 
C     VEL=VELOCITY
C        =00 1.5 DEGREES/SEC. 
C        =01 5.0 DEGREES/SEC. 
C        =10 30.0 DEGREES/SEC.
C        =11 200.0 DEGREES/SEC. 
C 
C  BRANCH AND MNEMONIC TABLE ENTRIES
C  ---------------------------------
C 
C   GRTST(I,R,R),  OV=X,  ENT=GRTST,  FIL=%GRTST
C   GRTSP(I),      OV=X,  ENT=GRTSP,  FIL=%GRTST
C 
C**************************************** 
C 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HGR,2HTS,2HT / 
      DATA IDTN/39/ 
C 
C  FIND STATION # AND LU #
C 
      IERMS=10
      ISTN=ISN(DUMMY) 
      ILU1=LUDV(ISTN,IDTN)
      IF(ILU1 .EQ. 0)GOTO 800 
C 
C  JUMP TO DEVICE SUBROUTINE
C 
      CALL XRTST(ILU1,IERMS,IUNIT,ANGLE,VEL)
      IF(IERMS)800,20,800 
20    RETURN
C 
C  ERROR EXIT 
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C**************************************** 
C 
      SUBROUTINE XRTST(ILU1,IERMS,IUNIT,ANGLE,VEL),09580-16010
     +REV.2001 791005 
      DIMENSION IBUF(3),IDATA(2),IREG(2),IERMS(5) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C**************************************** 
C 
C  GRTST(U,A,V) 
C 
C    WHERE
C 
C    U=UNIT NUMBER
C 
C         0=ALL UNITS 
C         1=FIRST UNIT
C         2=SECOND UNIT,ETC 
C 
C    A=ANGLE 0.0-359.9 DEG. WITH .1 DEG. RESOLUTION 
C 
C    V=VELOCITY DYNAMIC 
C 
C         +/- 1.5 DEG./SEC. 
C         +/- 5.0 DEG./SEC. 
C         +/- 30.0 DEG./SEC.
C         +/- 200.0 DEG./SEC. 
C         0.0=STATIC
C 
C**************************************** 
C 
C  INITILIZE
C 
      IDTN=39 
      IERMS=1 
      IU=1
      IF(IUNIT .EQ. 0)IU=0
      IF(IUNIT .EQ. 0)IUNIT=1 
C 
C  RETRIEVE DATA FROM CONFIGURATION FILE
C 
      CALL TIM(IDTN,1,1,IBUF,1,N) 
      IF(N .LT. 0)RETURN
      IF(IUNIT .GT. IBUF(1)) GOTO 8001
C 
C  CHECK PARAMETERS 
C 
      IF((ANGLE .LT. 0.0) .OR. (ANGLE .GT. 359.9))GOTO 8001 
      TVEL=ABS(VEL) 
      IF((TVEL .EQ. 1.5) .OR. (TVEL .EQ. 5.0) .OR. (TVEL .EQ. 30.0) 
     1.OR. (TVEL .EQ. 200.0) .OR. (TVEL .EQ. 0.0))GOTO 20 
      GOTO 8001 
20    IERMS=2 
C 
C  MAKE ANGLE A BCD NUMBER
C 
      IX1=(ANGLE/100.0) 
      IAX1=IX1*2**12
C 
      IX2=(ANGLE-(IX1*100))/10.0
      IAX2=IX2*2**8 
C 
      IX3=ANGLE-((IX1*100)+(IX2*10))
      IAX3=IX3*2**4 
C 
      IX4=(ANGLE*10.0)-((IX1*1000)+(IX2*100)+(IX3*10))
C 
      IDATA(1)=IAX1+IAX2+IAX3+IX4 
C 
C  OUTPUT TO D/S
C 
10    IF(IUNIT .GT. IBUF(1))GOTO 500
      ICNWD=100B+ILU1 
100   CALL EXEC(100002B,ICNWD,IDATA,1,IDUMY,0)
      GOTO 8002 
C 
C  WAIT 10 MSEC 
C 
8900  CALL EXEC(12+100000B,0,1,0,-1)
      GOTO 8002 
C 
C  READ BACK DATA 
C 
8910  ICNWD=300B+ILU1 
      CALL EXEC(100001B,ICNWD,IDATA(2),1,IDUMY,0) 
      GOTO 8002 
C 
C  CHECK IF DATA READ BACK IS OK
C 
8901  IF(IDATA(1) .NE. IDATA(2))GOTO 8002 
C 
C  IF VELOCITY >0 OUTPUT VELOCITY WORD TO D/S 
C 
      IF(VEL .EQ. 0)GOTO 200
      IF(VEL .LT. 0)IX1=0 
      IF(VEL .GT. 0)IX1=4B
      IF(TVEL .EQ. 1.5)IX2=40000B 
      IF(TVEL .EQ. 5.0)IX2=40001B 
      IF(TVEL .EQ. 30.0)IX2=40002B
      IF(TVEL .EQ. 200.0)IX2=40003B 
      IDATA(2)=IX2+IX1
C 
      ICNWD=100B+ILU1 
      CALL EXEC(100002B,ICNWD,IDATA(2),1,IDUMY,0) 
      GOTO 8002 
C 
C  CHECK IF ANOTHER UNIT
C 
200   IF(IU .EQ. 1)GOTO 500 
      IUNIT=IUNIT+1 
      GOTO 10 
C 
C  EXIT 
C 
500   IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8002  IERMS=9 
8001  IERMS(2)=5
      IERMS(3)=2HGR 
      IERMS(4)=2HTS 
      IERMS(5)=2HT
      RETURN
      END 
C 
C**************************************** 
C 
      SUBROUTINE GRTSP(IUNIT),09580-16010 REV.2001 791005 
      DIMENSION IERMS(5)
      DATA IERMS/10,5,2HGR,2HTS,2HP / 
      DATA IDTN/39/ 
C 
C  FIND STATION # AND LU #
C 
      IERMS=10
      ISTN=ISN(DUMMY) 
      ILU1=LUDV(ISTN,IDTN)
      IF(ILU1 .EQ. 0)GOTO 800 
C 
C  JUMP TO DEVICE SUBROUTINE
C 
      CALL XRTSP(ILU1,IERMS,IUNIT)
      IF(IERMS)800,20,800 
20    RETURN
C 
C  ERROR ROUTINE
C 
800   CALL ERROR(IERMS,IERMS(2))
      RETURN
      END 
C 
C**************************************** 
C 
      SUBROUTINE XRTSP(ILU1,IERMS,IUNIT),09580-16010 REV.2001 
     +791005
      DIMENSION IBUF(3),IDATA(2),IREG(2),IERMS(5) 
      EQUIVALENCE (REG,IREG,IA),(IREG(2),IB)
C 
C**************************************** 
C 
C  GRTSP(U) 
C 
C    WHERE
C 
C    U=UNIT NUMBER
C 
C         0=ALL UNITS 
C         1=FIRST UNIT
C         2=SECOND UNIT,ETC 
C 
C**************************************** 
C 
C  INITILIZE
C 
      IDTN=39 
      IERMS=1 
      IU=1
      IDATA(1)=100000B
      IF(IUNIT .EQ. 0)IU=0
      IF(IUNIT .EQ. 0)IUNIT=1 
C 
C  RETRIEVE DATA FROM CONFIGURATION FILE
C 
      CALL TIM(IDTN,1,1,IBUF,1,N) 
      IF(N .LT. 0)RETURN
      IERMS=2 
C 
C  OUTPUT TO D/S
C 
10    IF(IUNIT .GT. IBUF(1))GOTO 500
      ICNWD=100B+ILU1 
100   CALL EXEC(100002B,ICNWD,IDATA,1,IDUMY,0)
      GOTO 8002 
C 
C  CHECK IF ANOTHER UNIT
C 
200   IF(IU .EQ. 1)GOTO 500 
      IUNIT=IUNIT+1 
      GOTO 10 
C 
C  EXIT 
C 
500   IERMS=0 
      RETURN
C 
C  ERROR EXIT 
C 
8002  IERMS=9 
8001  IERMS(2)=5
      IERMS(3)=2HGR 
      IERMS(4)=2HTS 
      IERMS(5)=2HP
      RETURN
      END 
                                                