EXODUS/packages/seacas/applications/blot/grapar.f

C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details

C=======================================================================
      SUBROUTINE GRAPAR (XYSAME, WVIEW, DVIEW,
     &   WXALAB, WYALAB, WXAEND, WYAEND, WXATIC, WYATIC)
C=======================================================================

C   --*** GRAPAR *** (GRPLIB) Determine axes parameters
C   --   Written by Amy Gilkey - revised 02/20/87
C   --
C   --GRAPAR sets up the axes parameters.  It determines "good" numbers
C   --for the axes numbers and sets the exponent and number of digits.
C   --It also sets the axis number and label number sizes.
C   --
C   --Parameters:
C   --   XYSAME - IN - true iff the X and Y axis have the same scale;
C   --      i.e., they are the same type although the values may differ
C   --   WVIEW - IN - the window corners (left, right, bottom, top)
C   --      in window (user) coordinates
C   --   DVIEW - IN - the window corners (left, right, bottom, top)
C   --      in device coordinates
C   --   WXALAB, WYALAB - OUT - the starting tick-mark of the X and Y axis
C   --   WXAEND, WXAEND - OUT - the ending tick-mark of the X and Y axis
C   --   WXATIC, WYATIC - IN/OUT - the X and Y axis tick-mark interval;
C   --      set only if equal zero or invalid

C   --Routines Called:
C   --   PLTGTG - (PLTLIB) Get graph parameter (see PLTSTG)
C   --   PLTSTG - (PLTLIB) Set graph parameter
C   --      1, 2 = (KXORIG, KYORIG) X, Y axis origin location
C   --      3, 4 = (KXLENG, KYLENG) X, Y axis length
C   --      11 = (KSCALE) axes parameters (see documentation)
C   --      22, 47 = (KXNUMS, KYNUMS) X, Y axis number size
C   --      23, 48 = (KXLABS, KYLABS) X, Y axis label size
C   --   PLTGTT - (PLTLIB) Get text parameter
C   --      2 = (KSCHSZ) software character size
C   --   GRAEXP - (GRPLIB) Set axis exponent

      PARAMETER (KLFT=1, KRGT=2, KBOT=3, KTOP=4)

      PARAMETER (KSCHSZ=2)
      PARAMETER (KXORIG=1, KYORIG=2, KXLENG=3, KYLENG=4, KSCALE=11)
      PARAMETER (KXNUMS=22, KXLABS=23, KYNUMS=47, KYLABS=48)

      LOGICAL XYSAME
      REAL WVIEW(KTOP), DVIEW(KTOP)
      REAL WXALAB, WYALAB
      REAL WXAEND, WYAEND
      REAL WXATIC, WYATIC

      LOGICAL LDUM, PLTGTG, PLTSTG, PLTGTT
      LOGICAL NUMBX, NUMBY
      CHARACTER*8 NSTR
      REAL BUF(4)

      WXAMIN = WVIEW(KLFT)
      WXAMAX = WVIEW(KRGT)
      WYAMIN = WVIEW(KBOT)
      WYAMAX = WVIEW(KTOP)

      DXALEN = DVIEW(KRGT) - DVIEW(KLFT)
      DYALEN = DVIEW(KTOP) - DVIEW(KBOT)
      WXALEN = ABS (WXAMAX - WXAMIN)
      WYALEN = ABS (WYAMAX - WYAMIN)

C   --Set tick-interval

      TICFAC = (1.00 / 12) * 2
C      --TICFAC is divided by the axis length to get the length of 2 times
C      --a "nice" tick interval (in device coordinates); a "nice" tick interval
C      --is 12 ticks across the screen (horizontally)

      IF (WXATIC .NE. 0.0) THEN
         XN = WXALEN / WXATIC
         IF ((XN .LT. 1) .OR. (XN .GT. 20)) WXATIC = 0.0
      END IF
      IF (WXATIC .EQ. 0.0) THEN
         XTIC = WXALEN * (TICFAC / DXALEN)
         WRITE (NSTR, 10000) XTIC
         READ (NSTR, 10000) WXATIC
         WXATIC = .5 * WXATIC
      END IF

      IF (WYATIC .NE. 0.0) THEN
         XN = WYALEN / WYATIC
         IF ((XN .LT. 1) .OR. (XN .GT. 20)) WYATIC = 0.0
      END IF
      IF (WYATIC .EQ. 0.0) THEN
         YTIC = WYALEN * (TICFAC / DYALEN)
         WRITE (NSTR, 10000) YTIC
         READ (NSTR, 10000) WYATIC
         WYATIC = .5 * WYATIC
      END IF

      IF (XYSAME) THEN
         IF (WXATIC .LT. WYATIC) THEN
            WXATIC = WYATIC
         ELSE
            WYATIC = WXATIC
         END IF
      END IF

C   --Set axes starting and ending tick-marks

      WXALAB = WXATIC * AINT (WXAMIN/WXATIC)
      IF (WXALAB .LT. WXAMIN) WXALAB = WXALAB + WXATIC
      WXAEND = WXALAB + WXATIC * AINT ((WXAMAX-WXAMIN) / WXATIC)
      IF (WXAEND .GT. WXAMAX) WXAEND = WXAEND - WXATIC

      WYALAB = WYATIC * AINT (WYAMIN/WYATIC)
      IF (WYALAB .LT. WYAMIN) WYALAB = WYALAB + WYATIC
      WYAEND = WYALAB + WYATIC * AINT ((WYAMAX-WYAMIN) / WYATIC)
      IF (WYAEND .GT. WYAMAX) WYAEND = WYAEND - WYATIC

C   --Set axis numbering (exponent and number of decimal digits)

      LDUM = PLTGTG (KXNUMS, SZXNUM)
      LDUM = PLTGTG (KYNUMS, SZYNUM)
      NUMBX = (SZXNUM .GT. 0.0)
      NUMBY = (SZYNUM .GT. 0.0)

      BUF(1) = WXALAB
      BUF(2) = WXAEND
      BUF(3) = WYALAB
      BUF(4) = WYAEND

      IF (XYSAME .AND. NUMBX .AND. NUMBY) THEN
         CALL GRAEXP (' ', 4, BUF, WXATIC)
      ELSE
         IF (NUMBX) THEN
            CALL GRAEXP ('X', 2, BUF(1), WXATIC)
         ELSE
            CALL GRAEXP ('X', 0, BUF(1), WXATIC)
         END IF
         IF (NUMBY) THEN
            CALL GRAEXP ('Y', 2, BUF(3), WYATIC)
         ELSE
            CALL GRAEXP ('Y', 0, BUF(3), WYATIC)
         END IF
      END IF

C   --Set up label/numbering size

      LDUM = PLTGTG (KXNUMS, SZNUM)
      IF (SZNUM .LE. 0.0) LDUM = PLTGTG (KYNUMS, SZNUM)
      LDUM = PLTGTG (KXLABS, SZLAB)
      IF (SZLAB .LE. 0.0) LDUM = PLTGTG (KYLABS, SZLAB)

      IF ((SZNUM .GT. 0.0) .OR. (SZLAB .GT. 0.0)) THEN
C      --The size of the label/numbering is determined by the character size
C      --and the axis lengths
         LDUM = PLTGTT (KSCHSZ, VCS)
         R = VCS * 50.0 / (0.5 * (DXALEN + DYALEN))
         SZNUM = SZNUM * R
         SZLAB = SZLAB * R*(4.0/5.0)
C         --Factor by 4/5 to make label and numbering the same size

         LDUM = PLTGTG (KXNUMS, X)
         IF (X .GT. 0.0) LDUM = PLTSTG (KXNUMS, SZNUM)
         LDUM = PLTGTG (KXLABS, X)
         IF (X .GT. 0.0) LDUM = PLTSTG (KXLABS, SZLAB)
         LDUM = PLTGTG (KYNUMS, X)
         IF (X .GT. 0.0) LDUM = PLTSTG (KYNUMS, SZNUM)
         LDUM = PLTGTG (KYLABS, X)
         IF (X .GT. 0.0) LDUM = PLTSTG (KYLABS, SZLAB)
      END IF

      RETURN
10000  FORMAT (E8.1)
      END