FTN,L 
C 
C 
C 
CC************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
CC************************************************************
C 
C 
C 
C      NAME: LDIR,PDIR
C      SOURCE: 92840 - 18029
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE LPDIR(IND,IGCB,P1,P2), 92840-16001 REV.2013 790904 
      DIMENSION IBUFR(5),VAR(4) 
      EQUIVALENCE (IBUFR(2),IB2,X),(IBUFR(4),Y) 
      EQUIVALENCE(VAR,A),(VAR(2),B),(VAR(3),C),(VAR(4),D) 
      DATA LDIR/7002B/
      DATA LDIRT/22/
      DATA IPDIR/19/
      XTEST =2.**14 
C 
C 4-24-79 NOTE FROM STEVE YOUNG: AS OF NOW, THE ONLY WAY THIS CALL
C IS USED IS TO PROCESS A CALL TO LDIR, WITH THE PARAMETER BEING AN 
C ANGLE. THEREFORE, IND = 3, P1 = AN ANGLE, AND P2 DOESN'T MATTER.
C 
C     THIS ROUTINE IS RESPONSIBLE FOR PROCESSING THE AGL COMMANDS 
C  LDIR (LABEL DIRECTION) AND PDIR (PLOT DIRECTION).
C  THE IND INDICATES WHETHER THE PARAMETER IS AN ANGLE(RADIANS) 
C  OR X AND Y COMPONENTS. 
C 
C       IND              P1       P2
C        1               THETA    -     PDIR
C        2               X COMP   Y COMP "
C        3               THETA    -        LDIR 
C       4                 X       Y        "
C 
CCCC
C     THIS CALL ESTABLISHES AN ADDRESS LINK BETWEEN THE GRAPGHICS 
C  PACKAGE AND THE CURRENT GCB AND ALSO CHECKS FOR A SUSPENDED GCB. 
C 
      ISUSP= 0
      CALL GCBIM(99,1,IGCB,ISUSP) 
      IF(ISUSP.NE.0)RETURN
C     CONVERT P1 P2 TO CURRENT UNITS
C 
      IBUFR = IADCD(D)
      CALL GCBIM(IBUFR,1,VAR,0,1) 
      GO TO(5,50,5,50),IND
50     X = P1 * A 
      Y = P2 * C
5     GO TO(10,20,30,40),IND
C 
C     CHECK FOR OVERFLOW
C 
10    XSC = P1/3.1414 
      XSIN = .5 * ABS(XSC + .5) 
      XCOS = .5 * ABS(XSC)
      IF(XSIN.GT.XTEST.OR.XCOS.GT.XTEST)GO TO 800 
      IF(P1.GT.6.28)CALL PLTER(30)
      X = COS(P1) 
      Y = SIN(P1) 
      GO TO 25
C 
C     USE GOOD OLD PYTHAGOREAN THEOREM TO COMPUTE SIN AND COSINE
C 
20    DENOM = SQRT(X**2 + Y**2) 
      IF(DENOM.EQ.0.)GO TO 25 
      X = X/DENOM 
      Y = Y/DENOM 
25    CALL GCBIM(IPDIR,1,X,0,2) 
      RETURN
C 
C     PROCESSING FOR LDIR 
C 
C     FIRST SEE IF X OR Y = 0 AND IF SO MUST DETERMINE
C  ANGLE BY SUREPTITIOUS MEANS. 
C 
C                   + Y=+ 
C                   + X=0 
C                   + 
C                   + 
C                   + 
C                   + 
C  X= -             + 
C  Y = 0            + 
C   +++++++++++++++++++++++++++++++++++++++ Y=0,X=+ 
C                   + 
C                   + 
C                   + 
C                   + 
C                   + 
C                   + 
C                   + 
C                   + Y = - 
C                   + X = 0 
C 
C 
40    IF(X.EQ.0.0.OR.Y.EQ.0.)GO TO 45 
      X = ATAN(Y/X) 
      GO TO 35
45    IF(X)60,75,70 
60    X = 3.14
      GO TO 35
70    X = 0.
      GO TO 35
75    X= 1.57 
      IF(Y.LT.0.)X = 4.71 
      GO TO 35
C 
C     AT THIS POINT THEANGLE HAS BEEN DETERMINED
C 
30    X = P1
35    IF(ABS(X).LE.6.28)GO TO 36
      CALL PLTER(30)
      X = AMOD(X,6.28)
36    IF(X.LT.0.)X= 6.28 - ABS(X) 
      IF(X.EQ.6.28)X = 0.0
C ***************************************************************** 
C OUTPUT A MESSAGE TO THE DEVICE TO SET THE PROPER LDIR, AND STORE
C THE HARDWARE AND THE SOFTWARE LDIR INTO THE GCB.
C 
      IBUFR = LDIR
      CALL OUTPT(1,IBUFR,2) 
      CALL GCBIM(LDIRT,1,X,0,2) 
      CALL GCBIM(35,1,X,0,2)
      RETURN
C 
800   CALL PLTER(36)
      RETURN
C 
      END 
      END$
                                                                                                                                                                                        