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: LABEL AXES OR GRID 
C      SOURCE: 92840 - 18033
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE LABAX(P12,STRT,BEGIN,I,J,
     1IGCB), 92840-16001 REV.1913 790129
      INTEGER FLTAX 
      DIMENSION USER(6),BEGIN(2),ICODE(2),IBUF(4) 
      DIMENSION IFBUF(3)
      EQUIVALENCE (USER(1),CHRW),(USER(2),CHRH) 
      EQUIVALENCE (USER(3 ),A),(USER(4 ),B),(USER(5 ),C),(USER(6 ),D) 
      EQUIVALENCE (IFBUF,FLTAX),(IFBUF(2),AXLAB)
      EQUIVALENCE (ICODE(2),ICD2),(ICODE,ICHR)
C 
      DATA IUXY,ICHR/27,7/
      DATA ICHR/7/
      DATA FLTAX/24402B/
      DATA LRGAB/31001B/
C 
C     THIS SUBROUTINE IS RESPONSIBLE FOR WRITING LABELS OUTSIDE 
C  THE CLIPPING BOUNDARY.  THE PARAMETERS IN THE CALLING
C  HAVE THE FOLLOWING MEANING:
C 
C     P12 = # X,Y TIC SPACING 
C     P56 = MAJOR TIC COUNT 
C     STRT2 = WINDOW BOUNDARY 
C     BEGIN = POINT TO BE LABELED                                       EM1913
C     I,J = USED TO INDICATE WHICH VALUE IN BEGIN IS X OR Y 
C     XP12 = ABSOLUTE VALUE OF P12
C     K = USED TO INDICATE WHETHER OR NOT WE ARE DRAWING A NEW AXES.
C 
C     CLIPPING IS TURNED OFF BY CALLING PROGRAM                         EM1913
C     SET LABEL DIRECTION TO 0. RADIANS AND RETRIEVE CODES FOR
C CURRENT CLIPPING LIMITS AND TRANSFORMATION CONSTANTS. 
C 
      CALL LDIR(IGCB,0.)
      ICD2 = IADCD(D) 
      CALL GCBIM(ICODE,2,USER,0,1)
      NBYTE = 0 
      N = 0 
      CALL GCBIM(26,1,N,0,1)
C 
C     PUT CHARACTER WIDTH AND HEIGHT INTO CURRENTS MODE 
C 
      CHRWX = CHRW/A
      CHRWY = CHRW/C
      CHRHX = CHRH/A
      CHRHY = CHRH/C
C 
      AXLAB = BEGIN 
C 
C  THERE DOESN'TSEEM TO BE ANY REAL NEED FOR THIS CODE (WHICH DOESN'T  EM1913 
C  WORK ANYWAY) WITH THE RE-WRITE OF AXES-LAXES-GRID-LGRID FOR 1913    EM1913 
C  SO COMMENT IT OUT                                                   EM1913 
C     CHECK FOR THE POSSIBLE EXISTENCE OF 0.
C 
C     XP = ABS(P12)                                                     EM1913
C     TESTX = ABS(BEGIN)                                                EM1913
C     PREX =  ABS( BEGIN - XP)                                          EM1913
C     POSTX = ABS( BEGIN + XP)                                          EM1913
C     IF(TESTX.LT.PREX.AND.TESTX.LT.POSTX)AXLAB = 0.                    EM1913
C END OF COMMENTED OUT CODE                                             EM1913
C 
C     CONVERT TO FLOATING PT. TO GET NUMBER OF BYTES
C 
2     CALL FLTAS(AXLAB,IBUF,NBYTE,N,0)
C 
C     FIND OUT LORGABILITY OF DEVICE
C 
5     CALL OUTPT(1,LRGAB,1) 
      CALL GCBIM(16,1,IBUF,1,1) 
      BYTE = NBYTE
      HFBYT = .5 * BYTE 
C 
C     MOVE PEN TO LABELLING POINT, AND SEE IF THIS IS X OR Y
C  AXIS LABELLING.
C 
C 
      CALL LORG(IGCB,8) 
      IF(I.EQ.2)GO TO 50
C 
C     X - AXIS
C 
C     IF P12 < 0 LABELLING IS PARALLEL TO AXIS, AND IS P12>0
C  LABELLING IS PERPINDICULAR TO AXIS.
C 
      IF(P12.LT.0)GO TO 25
      CALL LDIR(IGCB,1.57)
      YLAB =    (STRT - CHRWY)
      IF(IBUF.EQ.0)YLAB = STRT - (BYTE*CHRWY) 
      CALL MOVE(IGCB,BEGIN,YLAB)
      GO TO 40
C 
C     PARALLEL
C 
25    CALL LORG(IGCB,5) 
      XLAB = BEGIN
      YLAB =    (STRT - CHRHY)
      IF(IBUF.EQ.0)XLAB = XLAB - (HFBYT * CHRWX)
      CALL MOVE(IGCB,XLAB ,YLAB)
      GO TO 40
C 
C     Y - AXIS
C 
50    IF(P12.LT.0)GO TO 55
      XLAB =    (STRT - CHRWX)
      IF(IBUF.EQ.0)XLAB = STRT - (CHRWX * BYTE) 
      CALL MOVE(IGCB,XLAB,BEGIN)
      GO TO 40
55    CALL LDIR(IGCB,4.71)
      CALL LORG(IGCB,5) 
      YLAB = BEGIN
      XLAB =    (STRT - CHRHX)
      IF(IBUF.EQ.0)YLAB = YLAB + (HFBYT *CHRWY) 
      CALL MOVE( IGCB,XLAB,YLAB)
C 
C     OUTPUT LABEL
C 
40    CALL OUTPT(1,IFBUF,2) 
C 
C     DON'T NEED TO MOVE THE PEN BACK WHERE IT WAS FOR AXELS OR TICS    EM1913
C     OR TO TURN CLIPPING BACK ON                                       EM1913
      RETURN
      END 
      END$
                                                                                                                                      