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: GRID,LGRID 
C      SOURCE: 92840 - 18021
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE GRIDS(IND,IGCB ,P1,P2,P3,
     1P4,P5,P6,P7), 92840-16001 REV.1901 781020 
      DIMENSION VAR(15),BEGIN(2),IBUFR(6) 
      DIMENSION ICODE(4)
      INTEGER READ,WRITE,EFLG 
      EQUIVALENCE (VAR,A),(VAR(2),B),(VAR(3),C),(VAR(4),D)
      EQUIVALENCE (VAR(5),X1),(VAR(6),Y1) 
      EQUIVALENCE (AP,VAR(9)),(BP,VAR(10)),(CP,VAR(11)),(DP,VAR(12))
      EQUIVALENCE (VAR(7),XEND),(VAR(8),YEND) 
      EQUIVALENCE (BEGIN(2),BEG2) 
      EQUIVALENCE (ICODE(2),ICD2),(ICODE(3),ICD3) 
      EQUIVALENCE (IBUFR(5),THETA),(XLNTH,IBUFR(2)) 
      EQUIVALENCE (IBUFR(4),LRG),(ICODE(4),LNTYP) 
C 
      DATA READ/1/
      DATA WRITE/2/                                                     EM1901
      DATA LNTYP/23/
C 
C     THIS IS THE AGL MODULE FOR AGL COMMANDS GRID AND LGRID. 
C     THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING 
C  MEANINGS FOR EACH AGL COMMAND: 
C 
C  PARAMETER       AGL COMMAND      MEANING          DEFAULT
C    P1                             X-TIC SPACING     0-NO TICS 
C    P2              "              Y-TIC SPACING     0 
C    P3              "              X-ORIGIN          0 
C    P4              "              Y-ORIGIN          0.
C    P5              "              X-MAJOR COUNT     1.0 
C    P6              "              Y-MAJOR COUNT     1.0 
C    P7                             CROSS SIZE        0(NO CROSS) 
C*************************************************************
C 
C     DETERMINE UNITS MODE AND WHICH TRANSFORMATION CONSTANTS TO
C  USE. 
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
      ICODE = IADCD(D)
      ICD2     = 9
      ICD3     = 11 
      CALL GCBIM(ICODE,4,VAR,0,READ)
      CALL GCBIM(LNTYP,1,IBUFR,0,1) 
C 
C WE ARE PROBABLY GOING TO CALL SUBROUTINE 'LINE' IN THIS PROCEDURE     EM1901
C WHICH WILL ALTER BIT 11 IN THE STATUS WORD. SAVE STATE OF THIS BIT    EM1901
C FOR RESETTING, SO IT DOESN'T FALSELY INDICATE USER CALL TO 'LINE'     EM1901
      CALL GRSTS(READ,4000B,LNSET)                                      EM1901
C 
C     CONVERT MU TO GDUS FOR LABELLING
C 
C 
C     CLIP X(ORIGIN),Y(ORIGIN) USING EITHER S1,S2 OR V1,V2 AS LIMITS. 
C 
      XEND = (XEND - B)/A 
      YEND = (YEND - D)/C 
      X1 = (X1 - B)/A 
      Y1 = (Y1 - D)/C 
C 
C     ABSOLUTIZE PARAMETERS 
C 
      XP1 = P1
      XP2 = P2
      GO TO(10,20),IND
10    XP1 = ABS(P1) 
      XP2 = ABS(P2) 
20    XP5 = ABS(P5) 
      XP6 = ABS(P6) 
      XP7 = ABS(P7) 
C 
C     NOW BEGIN TO DRAW THE AXES, FIRST THE X AXES AND TIC MARKS
C  THEN THE Y AXES AND TIC MARKS. 
C 
      CALL MOVE(IGCB,X1,Y1) 
      BEGIN = X1
      BEG2 = Y1 
      TICSZ =(XP7 * CP)/C 
      IF(XP1.NE.0.)GO TO 25 
      CALL LINE(IGCB,0) 
      CALL DRAW(IGCB,XEND,Y1) 
      GO TO 110 
C 
C     INVOKE SUBROUTINE TO DRAW AXES FIRST THE X AXIS 
C  AND THEN THE Y AXIS. 
C 
25    CALL SUBGD(IND,BEGIN,Y1,YEND,XEND,TICSZ,P3,XP1,XP5,1,2,IGCB)
110   BEGIN = Y1
      BEG2 = X1 
      TICSZ =(XP7 * AP)/A 
      CALL MOVE(IGCB,X1,Y1) 
      IF(XP2.NE.0.)GO TO 35 
      CALL LINE(IGCB,0) 
      CALL DRAW(IGCB,X1,YEND) 
      GO TO 45
35    CALL SUBGD(IND,BEGIN,X1,XEND,YEND,TICSZ,P4,XP2,XP6,2,1,IGCB)
C 
C     RESET LDIR AND LINE TYPE
C 
45    CALL LINE (IGCB,IBUFR,XLNTH)
      CALL LORG(IGCB,LRG) 
      CALL LDIR(IGCB,THETA) 
C 
C RESET STATUS OF 'LINE CALLED' BIT                                     EM1901
      CALL GRSTS(WRITE,173777B,LNSET)                                   EM1901
C 
      RETURN
      END 
      SUBROUTINE SUBGD(IND,BEGIN,ST1,ST2,ENDPT,TCSZ,ORG,P12,P56,
     1I,J,IB), 92840-16001 REV.1901 781020
C 
C NOTE - THIS SUBROUTINE DOES NOT PRESERVE THE STATUS OF THE            EM1901
C        'LINE CALLED' BIT, BIT 11 OF THE STATUS WORD. THIS IS DONE     EM1901
C        BY SUBROUTINE GRIDS WHICH IS THE ONLY CALLER OF SUBGD AT THIS  EM1901
C        TIME.  IF SUBGD IS CALLED BY ANY OTHER ROUTINE, PRESERVING     EM1901
C        MUST BE DONE                                                   EM1901
C 
      DIMENSION BEGIN(2)
      INTEGER READ,WRITE,GRIFX
C 
C 
C     ST1 = Y1 OR X1
C     ST2 = YEND,OR XEND
C     THIS SUBROUTINE IS RESPONSIBLE FOR DRAWING THE GRIDS FOR THE
C  GRID AND LGRID COMMANDS. 
C 
      BEG1 = BEGIN
      IORG = 0
      IFLG = 1
C 
      K = 0 
      XP12 = ABS(P12) 
      EPSI = .1 * XP12
      TCNT = 0. 
      BEG2 = BEGIN(2) 
C 
C     SEE IF MINOR TICS NOT DESIRED AND IF SO DRAW A MAJOR TIC MARK 
C 
C 
C 
C     THIS PORTION OF THE ROUTINE IS RESPONSIBLE FOR DRAWING THE
C MAJOR AND MINOR TIC MARKS. IF THIS IS A LABELED AXES (LAXES)
C CALL THE LABEL DRAWING SUBROUTINE (LABL) IS INVOKED.
C 
100   LIN = 1 
      IF(TCNT.EQ.P56.OR.BEGIN.EQ.ORG.OR.P56.EQ.1.0.OR.TCNT.EQ.0.0)
     1LIN = 0 
      CALL LINE(IB,LIN) 
C 
C     SEE IF LIGHT LINES OR TIC MARKS ARE DESIRED.
C 
      IF(TCSZ.EQ.0.AND.LIN.EQ.1)GO TO 50
      IF(LIN.EQ.0)GO TO 50
      CALL LINE(IB,0) 
      TIC1 = BEG2 + TCSZ
      TIC2 = BEG2 - TCSZ
      IF(I.EQ.2)GO TO 52
      CALL MOVE(IB,BEGIN,TIC2)
      GRIDX = BEGIN 
      GRIDY = TIC1
      GO TO 55
C 
C     Y AXIS
52    CALL MOVE(IB,TIC2,BEGIN)
      GRIDX = TIC1
      GRIDY = BEGIN 
      GO TO 55
C 
C     DETERMINE WHICH AXES IS BEING DRAWN I= 1 FOR X AXIS, =2 FOR Y AXIS
C 
50    GRIDX = BEGIN 
      GRIDY = ST2 
      IF(I.EQ.1)GO TO 55
      GRIDX = ST2 
      GRIDY = BEGIN 
C 
C     AVOID DRAWING OVER PREVIOUS X AXIS
C 
55    IF(K.EQ.0)GO TO 57
      CALL DRAW(IB,GRIDX,GRIDY) 
57    CALL MOVE(IB,BEGIN(I),BEGIN(J)) 
      TCNT = TCNT + 1.0 
C 
      K = 1 
C     NOW SEE IF WE SHOULD DRAW A LABEL 
C 
      IF(LIN.EQ.1)GO TO 200 
      IF(IORG.GE.0)TCNT = 1.
      IF(IND.NE.2)GO TO 200 
      CALL LABAX(P12,ST1,BEGIN,I,J,IB)
C 
C 
C 
C     COMPUTE  X OR Y + (TIC SPACING) 
C 
200   BEGIN = BEGIN + XP12
C 
C 
C     DRAW LINE TO NEXT TIC MARK. 
C 
205   CALL LINE(IB,0) 
      IF(IORG.LT.0)GO TO 350
      IF(BEGIN.GE.ORG .AND.ORG.GE.BEG1.AND.IORG.EQ.0)GO TO 300
250   CALL DRAW  (IB, BEGIN(I),BEGIN(J))
      IFLG = 2
      IF(BEGIN.LE.ENDPT)GO TO 100 
      IF(ABS(BEGIN - ENDPT).GT.EPSI)RETURN
C 
      GO TO 100 
C 
C  FIRST SEE IF IFLG =1 FOR BEGINNING 
C 
300   IF(IFLG.EQ.2)GO TO 310
      IORG = 1
      GO TO 250 
C 
C     CHECK TO SEE IF MAJOR TIC HAS ALREADY BEEN DONE 
C 
310   SAVBG = BEGIN 
      IORG = -1 
      BEGIN = ORG 
      GO TO 250 
C 
C 
C 
350   BEGIN = SAVBG 
      IT1 = GRIFX(BEGIN)
      IT2 = GRIFX(ORG)
      IF(TCNT.GT.P56.OR.IT1.GT.IT2)TCNT = TCNT - 1.0
      IF(TCNT.EQ.P56.AND.IT1.LE.IT2)TCNT = 1.0
      IF(IT1.EQ.IT2)  BEGIN = BEGIN + XP12
      IORG = 1
      GO TO 250 
C 
C 
      END 
                                                                                                                        