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: GTEX2
C      SOURCE: 92840 - 18144
C      RELOC:  92840 - 16021
C 
C 
C 
CC*********************************************************** 
      SUBROUTINE GTEX2(IGCB,ITEXT,ISTRT,ITEXL)
     +,92840-16021 REV.2013 790904
C*************************************************************
C GTEX2 OUTPUTS HARDWARE CHARACTERS TO THE GRAPHICS LU OPEN 
C TO IGCB.
C 
C NOTE: IF THE ISTRT CHARACTER IS NOT ON A WORD BOUNDARY, GTEX2 
C SAVES THE FIRST CHARACTER AND THEN
C DOES A LEFT SHIFT ON ALL THE CHARACTERS IN ITEXT TO ALIGN THEM
C AT A WORD BOUNDARY. THEN THE LABON CALL IS MADE AND AN EXEC 
C CALL IS MADE TO OUTPUT THE CHARACTERS. (EXEC ONLY OUTPUTS 
C CHARACTERS ON A WORD BOUNDARY). AFTER ALL OF THIS, THE CHARACTER
C STRING IS THEN RIGHT-SHIFTED BACK TO ITS ORIGINAL POSITION. 
C 
C 
C ITEXT = THE CHARACTERS TO BE OUTPUT.
C ISTRT = INDEX OF THE FIRST CHARACTER TO BE OUTPUT.
C ISTRT = LOCAL VARIABLE THAT STARTS OUT = ISTRT, THEN GETS 
C         BUMPED AS YOU OUTPUT THE CHARACTERS IN THE SUBSRING.
C ITEXL = NUMBER OF CHARACTERS TO BE OUTPUT.
C FLAG  = .TRUE. IF STRING STARTS ON A WORD BOUNDARY, ELSE FALSE. 
C*************************************************************
      INTEGER IGCB(1),ITEXT(1),ITEXL
      LOGICAL FLAG
C*************************************************************
C IMPLEMENT A STUB. 
C 
D     LU=LOGLU(IDUMY) 
D     WRITE(LU,1000)
D1000 FORMAT("GTEX2 HIT A STUB.") 
C**************************************************************** 
C GET THE GRAPHICS LU OUT OF THE GCB. 
C 
      CALL GCBIM(2,1,LUG,0,1) 
C**************************************************************** 
C GET THE POSITIVE NUMBER OF CHARACTERS INTO NUMB.
C 
      IF ((ISTRT .LE. 0) .OR. (ITEXL .LE. 0)) GO TO 8500
      NUMB=ITEXL
      ISTRC=ISTRT 
C***************************************************************
C BRANCH TO BELOW IF ISTRC IS ON A WORD BOUNDARY. 
C NOTE: FLAG IS .TRUE. IFF FIRST CHARACTER IS ON A WORD BOUNDARY. 
C 
      FLAG=.TRUE. 
      IF (MOD(ISTRC,2) .EQ. 1) GO TO 100
C************************************************************** 
C ISTRC IS NOT ON A WORD BOUNDARY. SAVE THE CHARACTER AT
C POSITION (ISTRC-1) THEN LEFT SHIFT THE CHARACTER STRING 
C TO BE AT A WORD BOUNDARY. SET ISTRC TO POINT TO THE NEW 
C FIRST CHARACTER.
C 
      FLAG=.FALSE.
      CALL SGET(ITEXT,ISTRC-1,ITEMP)
C 
      DO 10 J=0,NUMB-1
      CALL SGET(ITEXT,ISTRC+J,ICHAR)
      CALL SPUT(ITEXT,ISTRC+J-1,ICHAR)
10    CONTINUE
      ISTRC=ISTRC-1 
C**************************************************************** 
C CALCULATE THE WORD BOUNDARY.
C 
100   IWORD=(ISTRC+1)/2 
C*******************************************************************
C JUST LET LABON AND LABOF HANDLE THE WHOLE TRANSACTION.
C 
      CALL LABON(IGCB)
      CALL REIO(2,LUG,ITEXT(IWORD),-NUMB) 
      CALL LABOF(IGCB)
C*****************************************************************
C RIGHT SHIFT IT BACK IF NECESSARY. 
C 
      IF (FLAG) RETURN
C 
      DO 20 J=NUMB-1,0,-1 
      CALL SGET(ITEXT,ISTRC+J,ICHAR)
      CALL SPUT(ITEXT,ISTRC+J+1,ICHAR)
20    CONTINUE
      CALL SPUT(ITEXT,ISTRC,ITEMP)
      RETURN
C****************************************************************** 
C ITEXL OR ISTRC .LE. 0 
C 
8500  CONTINUE
      CALL PLTER(31,IDUMY)
      RETURN
      END 
                                              