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: CPLOT COMMAND
C      SOURCE: 92840 - 18064
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE CHPLT(IND,IGCB,XI,YI,
     1IPCTL), 92840-16001 REV.2040 800807 
C 
      LOGICAL GSOFT,GWC,WCFLAG                                          SY2013
      DIMENSION VAR(7),ICODE(3),IBUFR(8)
      EQUIVALENCE (VAR,CHRW),(VAR(2),CHRH),(VAR(3),THETA) 
      EQUIVALENCE(VAR(4),A),(VAR(6),C)
      EQUIVALENCE(ICODE,ICHR),(ICODE(2),LDIR),(ICODE(3),ICD3) 
      EQUIVALENCE (IBUFR,IB1),(IBUFR(2),IB2),(VAR(5),B) 
      EQUIVALENCE (VAR(7),D)
C 
C     THIS IS THE AGL MODULE FOR PROCESSING THE CHARACTER 
C  PLOT COMMAND. IX = # CHARACTERS IN X DIRECTIONS
C                IY = #     "      "  Y DIRECTION 
C 
      DATA ICHR/7/
      DATA IPXY/5003B/
      DATA LDIR/22/ 
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********************************************************************** 
C MOD BY SY2013. SET UP THE PROPER VALUES TO INQUIRE FOR ACCORDING
C TO WHETHER SOFTWARE OR HARDWARE TEXT IS ENABLED.
C 
      IUNIT=IADCD(IDUMY)
      IF (GSOFT(IGCB)) GO TO 100
C***********************************************************************
C HARDWARE TEXT IS ON. COMPUTE HTOT AND WTOT. 
C 
      ICODE=7 
      ICODE(2)=22 
      ICD3=IUNIT
      CALL GCBIM(ICODE,3,VAR,0,1) 
C 
      WTOT=(XI*CHRW)/A                                                  SY2040
      HTOT=(YI*CHRH)/C                                                  SY2040
      GO TO 2000
  
C***********************************************************************
C SOFTWARE TEXT IS ON. SET UP WC OR NDC SPACE ACCORDING TO HOW USER 
C ENTERED HIS CSIZE CALL. 
C 
100   CONTINUE
      WCFLAG=GWC(IGCB)
      IF (WCFLAG) CALL SETUU(IGCB)
      IF (.NOT. WCFLAG) CALL SETGU(IGCB)
C***********************************************************************
C RETRIEVE THE CHARACTER HEIGHT AND WIDTH IN UNITS SPECIFIED IN THE 
C CSIZE CALL. 
C GET LDIR IN WC. 
C 
      ICODE=33
      ICODE(2)=35 
      CALL GCBIM(ICODE,2,VAR,0,1) 
      WTOT=XI*VAR(1)
      HTOT=YI*VAR(2)
      THETA=VAR(3)
D     WRITE(1,105) THETA
D105  FORMAT(/"CHPLT: WC LDIR = ",F13.5)
C******************************************************************** 
C CONVERT LDIR TO NDC IF YOU WANT NDC PLOTTING. 
C 
      IF (WCFLAG) GO TO 2000
      CALL GANG3(IGCB,THETA,TEMP,IBUFR) 
D     WRITE(1,107) TEMP 
D107  FORMAT(/"CHPLT: MU LDIR = ",F13.5)
      CALL GANG4(IGCB,TEMP,THETA,IBUFR) 
D     WRITE(1,115) THETA
D115  FORMAT(/"CHPLT: NDC LDIR = ",F13.5) 
C*********************************************************************
C     COMPUTE VALUES FOR X AND Y IN CURRENT UNIT MODE 
C 
2000  CONTINUE
      THETX=COS(THETA)
      THETY=SIN(THETA)
C 
      X=WTOT*THETX-HTOT*THETY 
      Y=WTOT*THETY+HTOT*THETX 
C********************************************************************** 
C    CALL IPLOT TO DO THE PLOTTING
C 
  
      CALL IPLOT(IGCB,X,Y,IPCTL)
      IF (IUNIT .EQ. 12) CALL SETGU(IGCB) 
      IF (IUNIT .NE. 12) CALL SETUU(IGCB) 
      RETURN
      END 
                                                                          