FTN4,L
C 
C 
C 
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: GCALC
C      SOURCE: 92840 - 18145
C      RELOC:  92840 - 16021
C 
C 
C 
CC*********************************************************** 
      SUBROUTINE GCALC(IGCB,XMTRX,INFO,BUFR,IUNIT)
     +,92840-16021 REV.2013 791109
C*************************************************************
C GCALC CALCULATES THE TRANSFORMATION MATRIX BY WHICH TO
C MULTIPLY X-Y PAIRS TO GET THE PROPER HEIGHT,WIDTH,SLANT,
C AND DIRECTION OF TEXT.
C 
C BASICALLY, GCALC CALCULATES AND RETURNS XMTRX, WHICH IS A 
C TRANSFORMATION MATRIX TO TRANSFORM THE CHARACTERS FROM
C THE CHARACTER COORDINATE SPACE INTO CURRENT UNITS (EITHER 
C WC OR NDC SPACE). 
C 
C IUNIT = 1 TO RETURN XMTRX AS A WC TRANSFORM.
C         ELSE XMTRX IS RETURNED AS AN NDC TRANSFORM. 
C 
C 
C H    =DESIRED CHARACTER HEIGHT. 
C H0  = NORMALIZED CHARACTER HEIGHT.
C HMU = DESIRED CHARACTER HEIGHT IN MACHINE UNITS.
C 
C W   = DESIRED CHARACTER WIDTH.
C W0  = NORMALIZED CHARACTER WIDTH. 
C WMU =DESIRED CHARACTER WIDTH IN MACHINE UNITS.
C 
C BUFR= UTILITY BUFR AT LEAST 8 WORDS LONG. 
C 
C SLANT= CHARACTER SLANT IN RADIANS (POSITIVE SLANT SLANTS
C        CHARACTERS TO THE RIGHT.)
C XLDIR = LABEL DIRECTION (POSITIVE XLDIR MOVES LINE ON WHICH 
C        CHARACTERS ARE DRAWN COUNTERCLOCKWISE.)
C 
C**************************************************************** 
C 
      INTEGER IGCB(1),INFO(1),ICODE(2)
      REAL XMTRX(2,2),H0,W0,BUFR(1) 
      REAL H,W,SLANT,XLDIR
      INTEGER IREAD 
      LOGICAL GWC 
      DATA IREAD/1/ 
C************************************************************** 
C GET THE LOGLU FOR DEBUG PURPOSES. 
C 
D     LU=LOGLU(IDUMY) 
C************************************************************** 
C GET  NORMALIZED WIDTH AND HEIGHT OF ENTIRE CHARACTER CELL FROM INFO.
C 
      H0=FLOAT(INFO(5)) 
      W0=FLOAT(INFO(4)) 
C***************************************************************
C GET SOFTWARE HEIGHT, WIDTH, AND SLANT. (IN WC OR NDC SPACE
C ACCORDING TO HOW THE USER SPECIFIED THEM IN HIS CSIZE CALL) 
C 
      ICODE(1)=33 
      ICODE(2)=34 
      CALL GCBIM(ICODE,2,BUFR,0,IREAD)
      WMU=BUFR(1) 
      HMU=BUFR(2) 
      ASLANT=BUFR(3)
      SLANT=ASLANT
C************************************************************ 
C TRANSFORM W AND H INTO MU'S.
C 
      IADP=11 
      IF (GWC(IGCB)) IADP = 12
      CALL GCBIM(IADP,1,BUFR,0,IREAD) 
      WMU=WMU*BUFR(1) 
      HMU=HMU*BUFR(3) 
C*********************************************************
C GET THE SOFTWARE LABEL DIRECTION(ALWAYS IN WC). 
C 
      CALL GCBIM(35,1,XLDIRW,0,IREAD) 
C*********************************************************
C TRANSFORM W AND H INTO THE REQUESTED UNITS. 
C 
      IADP=11 
      IF (IUNIT .EQ. 1) IADP = 12 
      CALL GCBIM(IADP,1,BUFR,0,IREAD) 
      W=WMU/BUFR(1) 
      H=HMU/BUFR(3) 
D     WRITE(LU,1305) H,W
D1305 FORMAT(/"GCALC: H AND W IN NDC = ",2F13.5)
C*************************************************************
C BRANCH TO THE PLACE TO CONVERT THE SLANT AND THE LDIR TO
C THE PROPER COORDINATE SPACE.
C 
      IF (IUNIT .EQ. 1) GO TO 2000
C*************************************************************
C CONVERT THE ANGLES INTO NDC SPACE.
C CONVERT LDIR FROM WC TO NDC.
C 
      CALL GANG3(IGCB,XLDIRW,XLDIR,BUFR)
C 
C DONT TRANSFORM THE SLANT IF ITS ALREADY IN NDC.
C 
      IF (.NOT. GWC(IGCB)) GO TO 3000 
      CALL GANG3(IGCB,ASLANT,SLANT,BUFR)
      GO TO 3000
C************************************************************** 
C RETURN XMTRX IN WC SPACE. CONVERT THE SLANT IF NECESSARY. 
C 
2000  CONTINUE
      XLDIR=XLDIRW
      IF (GWC(IGCB)) GO TO 3000 
      CALL GANG2(IGCB,ASLANT,SLANT,BUFR)
      GO TO 3000
C************************************************************ 
C SET UP SOME CONSTANTS.
C 
3000  COSPHI=COS(XLDIR) 
      SINPHI=SIN(XLDIR) 
      TANSLA=TAN(SLANT) 
      Q=W/W0
      P=H/H0
C 
C************************************************************** 
C BUILD UP XMTRX (SEE THE IMS FOR THESE CALCULATIONS) 
C MULTIPLY THE Y-MULTIPLIERS IN THE MATRIX BY AR TO CORRECT 
C FOR DISTORTIONS INTRODUCED BY DIFFERENT ASPECT RATIOS IN NDC
C SPACE.
C 
C 
      XMTRX(1,1)=Q*COSPHI 
      XMTRX(2,1)=Q*SINPHI 
      XMTRX(1,2)=P*(TANSLA*COSPHI-SINPHI) 
      XMTRX(2,2)=P*(TANSLA*SINPHI+COSPHI) 
C 
      RETURN
      END 
                                                        