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: CSIZE
C      SOURCE: 92840 - 18046
C      RELOC:  92840 - 16001
C 
C 
C 
CC*********************************************************** 
C 
      SUBROUTINE XSIZE(IND,IGCB,P1,P2,P3,IP4) 
     +,92840-16001 REV.2013 790925
C*********************************************************
C IBUFR INCREASED FROM 5 TO 7 WORDS. SY 4-24-79 
C P3A HOLDS THE USER REQUESTED CHARACTER SLANT. 
C 
C IP4 ADDED 9-25-79 TO INDICATE WHETHER THE CSIZE SPECIFICATION 
C IS IN NDC UNITS OR WC UNITS.
C IP4 = 0 TO INDICATE NDC SPECIFICATION.
C     = 1 TO INDICATE WC SPECIFICATION. 
C 
C************************************************************ 
      DIMENSION VAR(4),IBUFR(7),ICHBF(9)
      INTEGER ICODE(2)
      EQUIVALENCE (IBUFR(2),CHRW,SLANT),(IBUFR(4),CHRH) 
      EQUIVALENCE (IBUFR(6),P3A)
      EQUIVALENCE (ICHBF,CWMIN),(ICHBF(3),CHMIN)
      EQUIVALENCE (ICHBF(5),CWMAX),(ICHBF(7),CHMAX),(ICHBF(9),ICHB9)
      EQUIVALENCE (VAR,A),(VAR(3),C)
C 
      DATA ICHW/10404B/ 
      DATA ISLNT/7402B/ 
      DATA ICHMM/33011B/
      DATA ISLOF/10000B/
      DATA ICHR/4404B/
      DATA ICLSZ/4404B/ 
C 
C     THIS IS THE FUNCTIONAL MODULE FOR THE AGL COMMAND CSIZE.
C 
C     THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING 
C  MEANING
C     P1 = CHARACTER HEIGHT,P2= ASPECT RATIO,P3=SLANT 
C 
      XCH = P1
      IF(P1.EQ.0)XCH = 2.78 
      XCW  =XCH * P2
      IF(P2.EQ.0)XCW  = .7   * XCH
CCCC
C     THIS CALL ESTABLISHES AN ADDRESS LINK BETWEEN THE GRAPGHICS 
C  PACKAGE AND THE CURRENT GCB. 
C 
      ISUSP = 0 
      CALL GCBIM(99,1,IGCB,ISUSP) 
      IF(ISUSP.NE.0)RETURN
C 
C 
C     RETRIEV CHARACTER SIZE INFORMATION FROM THE DEVICE SUBROUTINE.
C 
      CALL OUTPT(1,ICHMM,1) 
      CALL GCBIM(16,1,ICHBF,9,1)
C 
C     TRANSFORM UNITS INTO MUS AND COMPUTE CHARACTER WIDTH
C  WHICH IS EQUAL TO ASPECT RATIO * CHAR HEIGHT *CONVERSION FACTOR. 
C 
      IADP=11 
      IF (IP4 .EQ. 1) IADP=12 
      CALL GCBIM(IADP,1,VAR,0,1)
      CHRH =XCH * C 
      CHRW = XCW  * A 
C*****************************************************************
C 
C     NOW CHECK ON MIN AND MAX CHARACTER SIZES DEVICE WILL TOLERATE 
C 
      IF(CHRH.LT.CHMIN)CHRH = CHMIN 
      IF(CHRH.GT.CHMAX)CHRH = CHMAX 
      IF(CHRW.LT.CWMIN)CHRW = CWMIN 
      IF(CHRW.GT.CWMAX)CHRW = CWMAX 
C 
C     CHECK TO MAKE SURE DEVICE CAN HANDLE NEGATIVE CSIZE 
C 
      IF(P1.LT.0.0.AND.ICHB9.EQ.0)CALL PLTER(22)
      IF(P2.LT.0.0.AND.ICHB9.EQ.0)CALL PLTER(22)
      IBUFR = ICHW
      CALL OUTPT(1,IBUFR,2) 
      CALL GCBIM(7,1,CHRW,0,2)
      CALL OUTPT(1,ICHR,1)
      CALL GCBIM(16,1,7,1,3)
C 
C     NOW FOR THE SLANT IF P3 = 0. SLANT OFF COMMAND IS EMITTED 
C 
      IBUFR = ISLNT 
      IF(P3.EQ.0.)IBUFR = ISLOF 
      SLANT = P3
C 
      IF (IADP .EQ. 12) CALL GANG3(IGCB,P3,SLANT,ICHBF) 
      SLANT=AMOD(SLANT,6.28)
C     IF(ABS(P3).GT.6.28)SLANT = AMOD(P3,6.28)
      CALL OUTPT(1,IBUFR,2) 
C*******************************************************************
C     NOW UPDATE GCB WITH NEW CHARACTER HEIGHT,WIDTH SLANT ETC. 
C     STORE IN SAME UNITS AS SPECIFIED BY THE USER. 
C 
      CHRH=P1 
      CHRW=P1*P2
      P3A=P3
      ICODE(1)=33 
      ICODE(2)=34 
      CALL GCBIM(ICODE,2,CHRW,0,2)
C 
C SET THE BIT IN THE STATUS WORD TO INDICATE WHETHER YOU WILL USE 
C WC OR NDC CHARACTER PLOTTING FROM NOW ON. 
C 
      IOR=0 
      IF (IP4 .EQ. 1) IOR=40000B
      CALL GRSTS(2,37777B,IOR)
      RETURN
      END 
      END$
                                                                                                                                                  