C******************** START FILE TGRF3D.FOR ; GROUP TGRF3D ******************
C============================================================
C  MOD DMC JUNE 1988
C  VARIABLE LENGTH LABELS.  CLEANUP.
C
C ** SG VERSION ** USES SG PACKAGE 3D ISOMETRIC ROUTINE
C  D. MC CUNE 15 MAR 1982
C
      SUBROUTINE TGRF3D(X,Z,Y,NX,NY,NZ1,
     >                  XLAB,YLAB,ZLAB,
     >                  XUN,YUN,ZUN,
     >                  ZTITLE,IPROC,
     >			ZRNLBL,IINT,ZINT,
     >                  NPAGE,ZLLAB,ZLLUN,ZX0,IRET)
C
C  INTERACTIVE ROUTINE TO CONTROL PRODUCTION OF
C  THREE DIMENSIONAL GRAPHS OF DATA FUNCTION OF TWO
C  INDEPENDANT VARIABLES.
C    3-D GRAPHS:  LABELING AND TITLEING CONTROLLED BY PASSED
C                 VARIABLES
C                 USER MAY SPECIFY SUBSET OF X-Y DOMAIN, AND
C                 # OF LINES OF CONSTANT X AND Y TO DRAW
C                 BY INTERACTIVE I/O.
C
C  INPUT VARIABLES:
C    X       1ST INDEPENDANT VARIABLE VALUES, IN ASCENDING ORDER
C            CORRESPONDS TO FIRST DIMENSION OF Z ARRAY
C    Z       2-D ARRAY OF DEPENDANT VARIABLE VALUES
C    Y       2ND INDEPENDANT VARIABLE VALUES, IN ASCENDING ORDER
C            CORRESNPONDS TO SECOND DIMENSION OF Z ARRAY.
C    Z(I,J) = Z AT (X(I),Y(J))
C
C    NX      # OF X VALUES
C    NY      # OF Y VALUES
C    NZ1     FIRST DIMENSION OF Z
C
C    XLAB    NAME OF FIRST INDEP. VARIABLE (E.G. 'RADIUS    ')
C            N CHARACTERS ASCII.
C    YLAB    NAME OF SECOND INDP. VARIABLE (E.G. 'TIME      ')
C            N CHARACTERS ASCII
C    ZLAB    NAME OF DEPENDANT VARIABLE
C            (E.G. 'ELECTRON TEMPERATURE')
C            N CHARACTERS ASCII
C    XUN     UNITS OF FIRST INDEP. VARIABLE (E.G. 'CM       $')
C            N CHARACTERS ASCII TERMINATED BY '$' REQUIRED BY
C            FS ROUTINES.
C    YUN     UNITS OF SECOND INDEP. VARIABLE (E.G. 'SECONDS  $')
C    ZUN     UNITS OF DEPENDANT VARIABLE (E.G. 'EV       $')
C
C    ZTITLE  N CHARACTER TITLE TO GO ON TOP OF 3-D GRAPH
C
C    IPROC   DATA PROCESSING FLAG FOR LABELING 1=AVG'D, 2=SMOOTH'D
C            ETC.
C
C    ZRNLBL  N CHARACTER PROGRAM LABEL
C
C     IINT - FLAG TO GENERATE INTEGRATION LABEL
C
C     ZINT - N CHARACTER INTEGRATION LABEL
C
C   NPAGE   PAGE # FOR GRAPHS; NPAGE= # ON LAST GRAPH DRAWN PRIOR
C       TO CALL TO THIS ROUTINE
C
C  ZLLAB-- CHAR INTEGRATION LOWER LIMIT LABEL
C  ZLLUN-- CHAR LOWER LIMIT UNITS
C
C----------------------------
C
C  AUTHOR:  D. MC CUNE    15-MAY-79
C
C  REVISIONS:
C
C    JUN-1988  DMC - ELASTIC LABELS ... REPLACE AGX WITH GRFLBL CALLS
C
C    APR-1980  D. MC CUNE-- USING AG ROUTINES TO LABEL 3D GRAPHS
C
C----------------------------
C
C   DECLARATIONS:
C
      DIMENSION X(NX),Y(NY),Z(NZ1,NY)
      CHARACTER*(*) ZLAB,ZTITLE,YLAB,XLAB,XUN,YUN,ZUN
      CHARACTER*(*) ZRNLBL
      CHARACTER*(*) ZINT
      CHARACTER*(*) ZLLAB,ZLLUN
C
      CHARACTER*80 ZBUFF
C
      CHARACTER*10 ZVIEWL(3)
C
      LOGICAL I3LOGX,I3LOGY,I3LOGZ,J3LOGX,J3LOGY,J3LOGZ,IHIDDN
      LOGICAL XSKIRT,YSKIRT,XSKIRT0,YSKIRT0
C
C *LISMAK* 12-APR-88  GENERATED LOGICAL DECLARATIONS
        LOGICAL LCHAR
        LOGICAL LYES
        LOGICAL LYESC
      LOGICAL LXOUT
C *LISMAK* END OF GENERATED LOGICAL DECLARATIONS
C
C => TGRF3D               BEGIN DATA BLOCK
C => LISMAK 12-APR-88  MOVED DATA STATEMENTS
C
      DATA XSKIRT0/.TRUE./
      DATA YSKIRT0/.TRUE./
      DATA ITBOT0/0/
      DATA IHIDDN/.TRUE./
      DATA J3LOGX/.FALSE./
      DATA J3LOGY/.FALSE./
      DATA J3LOGZ/.FALSE./
      DATA JSKIPX/-1/
      DATA JSKIPY/-1/
C
      DATA ZVIEWL/'BOTTOM    ','BOTH SIDES','TOP SIDE  '/
C
C => END DATA BLOCK
C ====================
C
C  START OF EXECUTABLE CODE
C
C  (1)  3-D GRAPH
C
      LUNTRM=LNOUT(0)
C
C  LABEL LENGTHS
C
      ILX=ILNURD(XLAB)
      ILY=ILNURD(YLAB)
      ILZ=ILNURD(ZLAB)
C
 100  CONTINUE
C
      I3LOGX=J3LOGX
      I3LOGY=J3LOGY
      I3LOGZ=J3LOGZ
C
      XSKIRT=XSKIRT0
      YSKIRT=YSKIRT0
C
      ITBOT=ITBOT0
C
      IX1=1
      IX2=NX
      NXL=NX
      IXL=NX-1
C
      IF(JSKIPX.GT.0) THEN
        ISKIPX=JSKIPX
      ELSE
        ISKIPX=MAX0(1,IFIX(FLOAT(NXL)/40.0 + 0.5))
      ENDIF
C
      IY1=1
      IY2=NY
      NYL=NY
      IYL=NY-1
C
      IF(JSKIPY.GT.0) THEN
        ISKIPY=JSKIPY
      ELSE
        ISKIPY=MAX0(1,IFIX(FLOAT(NYL)/40.0 + 0.5))
      ENDIF
C
      IZMMX=1
C
 110  CONTINUE
C
      CALL NEUPAG
 115  continue
      IF(LXOUT(0)) then
         WRITE(LUNTRM,1101)
     >        XLAB(1:ILX),I3LOGX,YLAB(1:ILY),I3LOGY,ZLAB(1:ILZ),I3LOGZ
 1101    FORMAT(
     >        ' SET AXIS TYPES FOR 3D ISOMETRIC PLOT (ONLY):'/
     >        '  X AXIS - INDEP VAR. "',A,'" LOG = ',L1,' (T/F)'/
     >        '  Y AXIS - INDEP VAR. "',A,'" LOG = ',L1/
     >        '  Z AXIS - FUNCTION "',A,'" LOG = ',L1/
     >        ' OPTIONS:'/
     >        '  C - CHANGE MISCELLANEOUS PLOT CONTROLS'/
     >        '  M - MODIFY (X,Y,Z) DOMAIN TO BE PLOTTED OVER'/
     >        '  S - SET SKIP COUNT ON DRAWING LINES OF CONST. X, Y'/
     >        '  X - CHANGE X AXIS TYPE (TOGGLE LOG/LINEAR)'/
     >        '  Y - CHANGE Y AXIS TYPE'/
     >        '  Z - CHANGE Z AXIS TYPE'/
     >        '  D - ESTABLISH CURRENT AXIS TYPES AS PERMANENT DEFAULT'/
     >        '  P - PROCEED TO MAKE PLOT'/
     >        '  N or Q - QUIT (RETURN TO GRAPHICS OPTIONS NODE)'/
     >        '  R - QUIT (EXIT GRAPHICS SUBROUTINE)'/)
      endif
      CALL UREAD(
     >     'GRF3SG:  SELECT 3D ISOMETRIC AXIS OPTION (X/Y/Z/D/P):$')
      IANS=IXUOPC('MSXYZDPQNRC$')
      CALL UCHKOP(IANS,0,1,100,-1,*115)
C
      GO TO (20,25,111,112,113,114,119,98,98,99,10) IANS
C
 10   CONTINUE
C-------------------------------------------------------------------
C  MISCELLANEOUS CONTROLS MENU
C
      CALL NEUPAG
      IV=ITBOT+2
      IF(LXOUT(0)) WRITE(LUNTRM,1110) ZVIEWL(IV),XSKIRT,YSKIRT
 1110 FORMAT(/
     >' AGISOM ISOMETRIC SURFACE PLOT MAY BE DRAWN WITH, TOP, BOTTOM,'/
     >' OR BOTH SIDES OF THE SURFACE VISIBLE, CURRENT SETTING = ',A//
     >' MISCELLANEOUS CONTROL OPTIONS:'/
     >'  A - SET AGISOM TO PLOT TOP SIDE ONLY'/
     >'  B - SET AGISOM TO PLOT BOTH SIDES (INITIAL DEFAULT)'/
     >'  C - SET AGISOM TO PLOT BOTTOM SIDE ONLY'/
     >'  D - MAKE CURRENT SETTING THE PERMANENT DEFAULT'//
     >'  X - TOGGLE OPTION TO DRAW "SKIRT" ON X LINES, CURRENTLY = ',L1/
     >'  Y - TOGGLE OPTION TO DRAW "SKIRT" ON Y LINES, CURRENTLY = ',L1/
     >'  Z - MAKE CURRENT SKIRT OPTIONS THE PERMANENT DEFAULT')
C
      CALL UREAD(
     >'TGRF3D:  SPECIFY MISCELLANY OPTION OR "Q" TO QUIT:$$')
C
      IF(LCHAR('A')) THEN
        ITBOT=1
      ELSE IF(LCHAR('B')) THEN
        ITBOT=0
      ELSE IF(LCHAR('C')) THEN
        ITBOT=-1
      ELSE IF(LCHAR('D')) THEN
        ITBOT0=ITBOT
      ELSE IF(LCHAR('X')) THEN
        XSKIRT=.NOT.XSKIRT
      ELSE IF(LCHAR('Y')) THEN
        YSKIRT=.NOT.YSKIRT
      ELSE IF(LCHAR('Z')) THEN
        XSKIRT0=XSKIRT
        YSKIRT0=YSKIRT
      ELSE IF(LCHAR('Q')) THEN
        GO TO 110
      ELSE
        CALL UERMSG('%TGRF3D -- ILLEGAL OPTION',' ',1)
      ENDIF
      GO TO 10
C-------------------------------------------------------------------
C
 98   CONTINUE
      IRET=0
      RETURN
C
 99   CONTINUE
      IRET=1
      RETURN
C
C  RESET DOMAIN
 20   CONTINUE
      CALL NEUPAG
      IF(LXOUT(0))
     >    WRITE(LUNTRM,1002) XLAB(1:ILX),X(1),X(NX),XUN,
     >    YLAB(1:ILY),Y(1),Y(NY),YUN
 1002 FORMAT(/' DATA AVAILABLE OVER THE DOMAIN:'/
     >          ' ',A,' = ',1PE11.4,' TO ',1PE11.4,' ',A/
     >          ' ',A,' = ',1PE11.4,' TO ',1PE11.4,' ',A/
     >          /' >>ENTER 1 TO GRAPH OVER SUBSET OF THIS DOMAIN')
C
 120  CONTINUE
      CALL UREAD('  GRF3SG: SELECT DOMAIN:$')
      X1=X(1)
      X2=X(NX)
      Y1=Y(1)
      Y2=Y(NY)
      	IF(LCHAR('Q')) GOTO 110
      IF(.NOT.LYESC('1')) GO TO 30
C
      IF(LXOUT(0)) WRITE(LUNTRM,1003) XLAB(1:ILX)
 1003 FORMAT(' ENTER "X" NOT TO CHANGE A VALUE'/
     >         ' ENTER NEW FIRST ',A,' (E FORMAT)')
C
      IERT=0
C
 101  CALL UREAD(' GRF3SG:  X(1):$')
        IF(LCHAR('Q')) GOTO 20
      IF(.NOT.LCHAR('X')) X1=FDCOD(IERT)
      IF(IERT.NE.0) GO TO 101
C
      IF(LXOUT(0)) WRITE(LUNTRM,1004) XLAB(1:ILX)
 1004 FORMAT(' ENTER NEW LAST ',A,' (E FORMAT)')
C
 102  CALL UREAD(' GRF3SG:  X(N):$')
      IF(LCHAR('Q')) GOTO 20
      IF(.NOT.LCHAR('X')) X2=FDCOD(IERT)
      IF(IERT.NE.0) GO TO 102
C
      IF(LXOUT(0)) WRITE(LUNTRM,1003) YLAB(1:ILY)
 103  CALL UREAD(' GRF3SG:  Y(1):$')
      IF(LCHAR('Q')) GOTO 20
      IF(.NOT.LCHAR('X')) Y1=FDCOD(IERT)
      IF(IERT.NE.0) GO TO 103
C
      IF(LXOUT(0)) WRITE(LUNTRM,1004) YLAB(1:ILY)
 104  CALL UREAD(' GRF3SG:  Y(N):$')
      IF(LCHAR('Q')) GOTO 20
      IF(.NOT.LCHAR('X')) Y2=FDCOD(IERT)
      IF(IERT.NE.0) GO TO 104
C
 30   CONTINUE
C
C  FIND INDEX LIMITS ON SUBDOMAIN TO BE GRAPHED
C
C  X AXIS
C
      IX1=1
      IX2=NX
      DO 32 I=1,NX
        IF(X(I).GE.X1) GO TO 33
 32   CONTINUE
      GO TO 95
C
 33   CONTINUE
      IX1=I
      DO 34 I=NX,1,-1
        IF(X(I).LE.X2) GO TO 35
 34   CONTINUE
      GO TO 95
C
 35   CONTINUE
      IX2=I
      IF(IX1.GT.IX2) GO TO 95
C
C  Y AXIS
C
      IY1=1
      IY2=NY
      DO 42 I=1,NY
        IF(Y(I).GE.Y1) GO TO 43
 42   CONTINUE
      GO TO 95
C
 43   CONTINUE
      IY1=I
      DO 44 I=NY,1,-1
        IF(Y(I).LE.Y2) GO TO 45
 44   CONTINUE
      GO TO 95
C
 45   CONTINUE
      IY2=I
      IF(IY1.GT.IY2) GO TO 95
C
      NXL=IX2-IX1+1
      IF(JSKIPX.GT.0) THEN
        ISKIPX=JSKIPX
      ELSE
        ISKIPX=MAX0(1,IFIX(FLOAT(NXL)/40.0 + 0.5))
      ENDIF
C
      NYL=IY2-IY1+1
      IF(JSKIPY.GT.0) THEN
        ISKIPY=JSKIPY
      ELSE
        ISKIPY=MAX0(1,IFIX(FLOAT(NYL)/40.0 + 0.5))
      ENDIF
C
      IXL=NXL-1
      IYL=NYL-1
      IF(IXL.LT.1) IXL=1
      IF(IYL.LT.1) IYL=1
C
 21   CONTINUE
C  Z AXIS
      CALL UREAD(
     >  'GRF3SG: ENTER "Y" TO SET Z AXIS MIN AND MAX$')
      IF(LCHAR('Q')) GOTO 110
      IF(.NOT.LYES(0)) GO TO 110
C
      IF(LXOUT(0)) WRITE(LUNTRM,1019)
 1019 FORMAT(' WARNING -- DATA MAY BE CLIPPED.')
C
 105  CALL UREAD('GRF3SG:  ENTER ZMIN:$')
      IF(LCHAR('Q')) GOTO 21
      ZZMIN=FDCOD(IERT)
      IF(IERT.NE.0) GO TO 105
C
 106  CALL UREAD('GRF3SG:  ENTER ZMAX:$')
      IF(LCHAR('Q')) GOTO 21
      ZZMAX=FDCOD(IERT)
      IF(IERT.NE.0) GO TO 106
C
      IF(ZZMAX.GT.ZZMIN) IZMMX=2
      GO TO 110
C
C  GET SKIP COUNT ON DRAWING LINES OF CONSTANT X OR Y
C
 25   CONTINUE
      CALL NEUPAG
C
      IF(LXOUT(0)) WRITE(LUNTRM,1010) NXL,XLAB(1:ILX),IXL
 1010 FORMAT(/' GRAFICS ROUTINE MAY DRAW UP TO ',I3,' LINES OF'/
     >         ' CONSTANT ',A,'.  ENTER SKIP FACTOR '/
     >         ' (BETWEEN 1 AND ',I3,')'/
     >         ' *ENTER "A" TO RESTORE AUTOMATIC SKIP COUNT SETTING')
C
 411  CALL UREAD(' GRF3SG:  ENTER SKIP COUNT:$')
      IF(LCHAR('Q')) GOTO 110
C
      IF(LCHAR('A')) THEN
        JSKIPX=-1
        JSKIPY=-1
        ISKIPX=MAX0(1,IFIX(FLOAT(NXL)/40.0 + 0.5))
        ISKIPY=MAX0(1,IFIX(FLOAT(NYL)/40.0 + 0.5))
        GO TO 110
      ENDIF
C
      ISKIPX=IDCOD(IERT)
      IF(IERT.NE.0) GO TO 411
      IF(ISKIPX.LT.1) ISKIPX=1
      IF(ISKIPX.GT.IXL) ISKIPX=IXL
C
      IF(LXOUT(0)) WRITE(LUNTRM,1010) NYL,YLAB(1:ILY),IYL
 421  CALL UREAD(' GRF3SG:  ENTER SKIP COUNT:$')
      IF(LCHAR('Q')) GOTO 25
      ISKIPY=IDCOD(IERT)
      IF(IERT.NE.0) GO TO 421
      IF(ISKIPY.LT.1) ISKIPY=1
      IF(ISKIPY.GT.IYL) ISKIPY=IYL
C
      CALL UREAD(
     >   'GRF3SG:  MAKE THESE SKIP COUNTS PERMANENT DEFAULTS (Y/N)?$')
      IF(.NOT.LYES(0)) GO TO 110
      IF(LCHAR('Q')) GOTO 25
      JSKIPX=ISKIPX
      JSKIPY=ISKIPY
      GO TO 110
C
C  SET AXES TYPES
C
C  X AXIS
 111  CONTINUE
      I3LOGX=.NOT.I3LOGX
      GO TO 110
C
C  Y AXIS
 112  CONTINUE
      I3LOGY=.NOT.I3LOGY
      GO TO 110
C
C  Z AXIS
 113  CONTINUE
      I3LOGZ=.NOT.I3LOGZ
      GO TO 110
C
C  DEFAULTS CHANGED
 114  CONTINUE
      J3LOGX=I3LOGX
      J3LOGY=I3LOGY
      J3LOGZ=I3LOGZ
      GO TO 110
C
C------------------------------------------
C  DRAW GRAPH
C
 119  CONTINUE
C  SET AXIS TYPES
      CALL UBINIT(0)
C  RESET AG 3D ISOMETRIC COMMON
C
      CALL AGINIT
C  SET ISOMETRIC PLOT WINDOW
      CALL AGISLX(110,510)
      CALL AGISLY(45.,550)
      CALL AGISLZ(95,355)
      INEAT=1
      CALL AGIXNT(INEAT)
      CALL AGIYNT(INEAT)
      CALL AGIZNT(INEAT)
C
      CALL AGISKT(XSKIRT,YSKIRT)
C
      CALL AGISID(ITBOT)
C
      IF(I3LOGX) THEN
        CALL AGIXTY(2)
      ELSE
        CALL AGIXTY(1)
      ENDIF
C
      IF(I3LOGY) THEN
        CALL AGIYTY(2)
      ELSE
        CALL AGIYTY(1)
      ENDIF
C
      IF(I3LOGZ) THEN
        CALL AGIZTY(2)
      ELSE
        CALL AGIZTY(1)
      ENDIF
C
C  HIDDEN LINES ONLY IF STRAIGHT LINEAR PLOT
      CALL AGIHID(IHIDDN)
C  SET INCREMENT BETWEEN X, Y=CONST. CURVES
      CALL AGISTX(ISKIPX)
      CALL AGISTY(ISKIPY)
C  SET Z AXIS LIMITS IF REQUESTED
      IF(IZMMX.EQ.2) CALL AGIDLZ(ZZMIN,ZZMAX)
C  DRAW THE GRAPH
      CALL AGISOM(X(IX1),Y(IY1),Z(IX1,IY1),NZ1,NXL,NYL,
     >     XUN,YUN,ZUN)
C  ADDL LABELS
C
      ILMRG=10
      ITOP=750
      IINC=23
      CALL GRFLBL(ILMRG,ITOP,ZTITLE,72,0,0)
      ITOP=ITOP-IINC
C
      CALL GRFLBL(ILMRG,ITOP,ZLAB,0,-1,0)
      ITOP=ITOP-IINC
C
      IF((IINT.GT.0).AND.(IINT.LE.12)) THEN
C  INTEGRATION LABEL WITH LOWER LIMIT
        CALL GRFLBL(ILMRG,ITOP,' '//ZINT//' FROM:',0,-1,0)
        ITOP=ITOP-IINC
C
        ZBUFF=' '
10221 FORMAT(1X,A,'=',1PE11.4,1X,A)
        WRITE(ZBUFF,10221) ZLLAB,ZX0,ZLLUN
        CALL GRFLBL(ILMRG,ITOP,ZBUFF,0,-1,0)
        ITOP=ITOP-IINC
C
      ELSE IF(IINT.NE.0) THEN
C  DIFFERENTIATION LABEL
        CALL GRFLBL(ILMRG,ITOP,ZINT,0,-1,0)
        ITOP=ITOP-IINC
      ENDIF
C
      CALL GRFLBL(ILMRG,ITOP,'VS. '//XLAB,0,-1,0)
      ITOP=ITOP-IINC
C
      CALL GRFLBL(ILMRG,ITOP,'AND '//YLAB,0,-1,0)
      ITOP=ITOP-IINC
C
      IF(IPROC.EQ.1) THEN
        CALL GRFLBL(ILMRG,ITOP,' AVERAGED DATA ',0,-1,0)
        ITOP=ITOP-IINC
      ELSE IF(IPROC.EQ.2) THEN
        CALL GRFLBL(ILMRG,ITOP,' SMOOTHED DATA ',0,-1,0)
        ITOP=ITOP-IINC
      ELSE IF(IPROC.EQ.3) THEN
        CALL GRFLBL(ILMRG,ITOP,' AVG''D AND SMOOTHED DATA ',0,-1,0)
        ITOP=ITOP-IINC
      ELSE IF(IPROC.EQ.4) THEN
        CALL GRFLBL(ILMRG,ITOP,' PROCESSED DATA ',0,-1,0)
        ITOP=ITOP-IINC
      ENDIF
C
      CALL GRFLBL(ILMRG,ITOP,ZRNLBL,0,-1,0)
      ITOP=ITOP-IINC
C
      NPAGE=NPAGE+1
      WRITE(ZBUFF,10341) NPAGE
10341 FORMAT('PAGE ',I4,'$')
      CALL GRFLBL(800,50,ZBUFF,0,-1,0)
C
      CALL UPAUST(2)
      go to 110
C
C  ERRORS IN SPECIFYING SUBDOMAIN---
C
 95   CONTINUE
      WRITE(LUNTRM,1095)
 1095 FORMAT(' INVALID DOMAIN *****  HIT ANY KEY TO CONTINUE')
      CALL UPAUST(1)
      GO TO 110
C
      END
C******************** END FILE TGRF3D.FOR ; GROUP TGRF3D ******************
