*-----------------------------------------------------------------------
*     USPACK REAL TO CHARACTER                       S. Sakai  90/03/16
*-----------------------------------------------------------------------
*     Copyright (C) 2000 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE USCHVL(X, CHX)

      CHARACTER CHX*(*), CFMT*16, CVAL*16, CEXP*8, CEXP2*8, CSGI*1
      REAL X
      LOGICAL LEXP, LCNTL

      CALL SGLGET('LCNTL', LCNTL)
      CALL GLRGET('REPSL', PREC)
      NPREC = -LOG10(PREC)
      IF(NPREC.GT.8) NPREC = 8

      CFMT = '(E16.xE3)'
      WRITE(CFMT(6:6), '(I1)') NPREC
      WRITE(CVAL, CFMT) X

      CFMT = '(F11.x, TR1, I4)'
      WRITE(CFMT(6:6), '(I1)') NPREC
      READ (CVAL, CFMT) XX, NEXP

*------------------------ effective digits -----------------------------

      DO 10 N=11, 4, -1
        NDIG=N
        IF(CVAL(N:N).NE.'0') GOTO 20
   10 CONTINUE
   20 CONTINUE
      NDIG = NDIG - INDEX(CVAL, '.')

*----------------------------- mantissa --------------------------------

      NLOW = NEXP - NDIG + 1
      LEXP = NEXP.LE.-3 .OR. NLOW.GE.5

      IF(LEXP) THEN
        XX = XX*10
        NPREC = NDIG - 1
      ELSE
        XX = XX*1.D1**NEXP
        NPREC = -NLOW + 1
      ENDIF

      IF(NPREC.GE.1) THEN
        CFMT = '(SP, F16.x)'
        WRITE(CFMT(10:10), '(I1)')  NPREC
        WRITE(CVAL, CFMT) XX
      ELSE
        CFMT = '(SP, I16)'
        IX = NINT(XX)
        WRITE(CVAL, CFMT) IX
      ENDIF

      CALL CLADJ(CVAL)

*-------------------------- characteristic -----------------------------

      IF(LEXP) THEN
        NEXP = NEXP - 1
        WRITE(CEXP2, '(I3)') NEXP
        CALL CLADJ(CEXP2)
        IF(LCNTL) THEN
          CALL SGIGET('ISUP', ISUP)
          CALL SGIGET('IRST', IRST)
          CEXP = CSGI(194)//'10'//CHAR(ISUP)//CEXP2(1:LENC(CEXP2))
     +      //CHAR(IRST)
        ELSE
          CEXP = 'E'//CEXP2(1:LENC(CEXP2))
        ENDIF
      ELSE
        CEXP = ' '
      ENDIF

*-----------------------------------------------------------------------

      IF(LCNTL .AND. CVAL(2:3).EQ.'1 ' .AND. CEXP.NE.'  ') THEN
        CHX = CVAL(1:1) // CEXP(2:8)
      ELSE
        CHX = CVAL(1:LENC(CVAL)) // CEXP
      ENDIF

      RETURN
      END
*-----------------------------------------------------------------------
*     Copyright (C) 2000 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE ULXLOG ( CSIDE, NLBL, NTICKS )

*     CSIDE : 'T','B','U'
*     NLBL  : 1-4          ... Label buffer number used in the axis
*     NTICKS: 1-9          ... Number of small ticks in 10**N-10**(N+1)

      PARAMETER(MAXL=50,MAXS=200)
      DIMENSION BL(10),BS(10),UX1(MAXS),UX2(MAXL),UXT(MAXL)
      CHARACTER CH(MAXL)*16,CHR*8,CFMT*16,CSGI,CSIDE
      LOGICAL LRLT,LRGT,LABEL,LEPSL,LCNTL,LUXCHK,LOFF

      SAVE

      IF(.NOT.LUXCHK(CSIDE))
     #   CALL MSGDMP('E', 'ULXLOG', 'INVALID CSIDE.')
      IF(NLBL.LT.1 .OR. NLBL.GT.4)
     #   CALL MSGDMP('E', 'ULXLOG', 'INVALID NLBL.')
      IF(NTICKS.LT.1 .OR. NTICKS.GT.9)
     #   CALL MSGDMP('E', 'ULXLOG', 'INVALID NTICKS.')

      CALL SGQWND(UXMIN,UXMAX,UYMIN,UYMAX)

      CALL UZLGET('LOFFSET', LOFF)
      IF(LOFF) THEN
        CALL UZRGET('XFACT',   FACTOR)
        XMIN = UXMIN/FACTOR
        XMAX = UXMAX/FACTOR
        CALL SGSWND(XMIN,XMAX,UYMIN,UYMAX)
        CALL SGSTRF
      ELSE
        XMIN = UXMIN
        XMAX = UXMAX
      ENDIF

      IF(XMIN.GT.XMAX)THEN
        XXX=XMIN
        XMIN=XMAX
        XMAX=XXX
      END IF

      CALL ULIGET('IXTYPE', ITYPE)
      CALL ULIGET('IXCHR' , IXCHR)
      CALL ULXLBL( BL, NB , NLBL)

      CALL SGIGET('ISUP', ISUP)
      CALL SGIGET('IRST', IRST)

      CALL GLLGET('LEPSL',LEPSL)
      CALL SGLGET('LCNTL',LCNTL)
      CALL GLLSET('LEPSL',.TRUE.)
      CALL GNSAVE

*     SMALL TICKS

      CALL VRGNN(BS, 10, 1)
      BS(NTICKS+1)=10.
      CALL GNSBLK(BS,NTICKS+1)
      CALL GNLE(XMAX,BXMAX,IPMAX)
      CALL GNGE(XMIN,BXMIN,IPMIN)

      NBS=0
      DO 100 IP=IPMIN,IPMAX
      DO 100 IB=1,NTICKS
        IF(IP.EQ.IPMIN.AND.LRLT(BS(IB),BXMIN))GOTO 100
        IF(IP.EQ.IPMAX.AND.LRGT(BS(IB),BXMAX))GOTO 100
        NBS=NBS+1
        IF(NBS.GT.MAXS) CALL MSGDMP('E', 'ULXLOG', 'TOO MANY TICKS.')
        UX1(NBS)=BS(IB)*10.**IP
  100 CONTINUE

*     LARGE LABELS AND TICKS

      CALL GNSBLK(BL,NB+1)
      CALL GNLE(XMAX,BXMAX,IPMAX)
      CALL GNGE(XMIN,BXMIN,IPMIN)

      NBL=0
      NBT=0
      JTYPE = MOD(ITYPE, 2)

      DO 201 IP=IPMIN,IPMAX
      DO 201 IB=1,NB
        IF(IP.EQ.IPMIN.AND.LRLT(BL(IB),BXMIN))GOTO 201
        IF(IP.EQ.IPMAX.AND.LRGT(BL(IB),BXMAX))GOTO 201

        IF(IB.EQ.1)THEN
          NBT=NBT+1
          UXT(NBT)=10.**IP
        END IF

        NBL=NBL+1
        IF(NBL.GT.MAXL) CALL MSGDMP('E', 'ULXLOG', 'TOO MANY LABELS.')
        UX2(NBL)=BL(IB)*10.**IP

        IF(ITYPE.LE.2) THEN
          IF(JTYPE.EQ.0 .AND. IB.NE.1) THEN
            WRITE(CH(NBL),'(I1)') INT(BL(IB))
          ELSE
            IF(JTYPE.EQ.1 .AND. NB.NE.1) THEN
              WRITE(CH(NBL),'(I1,A1)') INT(BL(IB)), CSGI(IXCHR)
            ELSE
              CH(NBL)=' '
            ENDIF

            WRITE(CHR,'(I8)') IP
            CALL CLADJ(CHR)
            IF(LCNTL) THEN
              CH(NBL)(3:16)='10'//CSGI(ISUP)//CHR(1:LENZ(CHR))
     +          //CSGI(IRST)
            ELSE
              CH(NBL)(2:16)='E'//CHR
            ENDIF
            CALL CLADJ(CH(NBL))
          END IF

        ELSE
          IF(JTYPE.EQ.0 .AND. IB.NE.1) THEN
            WRITE(CH(NBL),'(I1)') INT(BL(IB))
          ELSE
            CALL UZCGET('CXFMT', CFMT)
            CALL CHVAL(CFMT, UX2(NBL), CH(NBL))
            CALL CLADJ(CH(NBL))
          ENDIF
        ENDIF
  201 CONTINUE

*     DRAW AXIS, TICKS, AND LABELS

      CALL UXPAXS(CSIDE,2)
      IF(NBS.NE.0) CALL UXPTMK(CSIDE,1,UX1,NBS)
      IF(NBT.NE.0) CALL UXPTMK(CSIDE,2,UXT,NBT)
      CALL UZLGET('LABELX'//CSIDE,LABEL)
      IF(LABEL) CALL UXPLBL(CSIDE,1,UX2,CH,16,NBL)

      CALL GLLSET('LEPSL',LEPSL)
      CALL GNRSET

      IF (LOFF) THEN
        CALL SGSWND(UXMIN,UXMAX,UYMIN,UYMAX)
        CALL SGSTRF
      ENDIF

      END
*-----------------------------------------------------------------------
*     Copyright (C) 2000 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE ULYLOG ( CSIDE, NLBL, NTICKS )

*     CSIDE : 'L','R','U'
*     NLBL  : 1-4          ... Label buffer number used in the axis
*     NTICKS: 1-9          ... Number of small ticks in 10**N-10**(N+1)

      PARAMETER(MAXL=50,MAXS=200)
      DIMENSION BL(10),BS(10),UY1(MAXS),UY2(MAXL),UYT(MAXL)
      CHARACTER CH(MAXL)*16,CHR*8,CFMT*16,CSGI,CSIDE
      LOGICAL LRLT,LRGT,LABEL,LEPSL,LCNTL,LUYCHK,LOFF

      SAVE

      IF(.NOT.LUYCHK(CSIDE))
     #   CALL MSGDMP('E', 'ULYLOG', 'INVALID CSIDE.')
      IF(NLBL.LT.1 .OR. NLBL.GT.4)
     #   CALL MSGDMP('E', 'ULYLOG', 'INVALID NLBL.')
      IF(NTICKS.LT.1 .OR. NTICKS.GT.9)
     #   CALL MSGDMP('E', 'ULYLOG', 'INVALID NTICKS.')

      CALL SGQWND(UXMIN,UXMAX,UYMIN,UYMAX)

      CALL UZLGET('LOFFSET', LOFF)
      IF(LOFF) THEN
        CALL UZRGET('YFACT',   FACTOR)
        YMIN = UYMIN/FACTOR
        YMAX = UYMAX/FACTOR
        CALL SGSWND(UXMIN, UXMAX , YMIN, YMAX)
        CALL SGSTRF
      ELSE
        YMIN = UYMIN
        YMAX = UYMAX
      ENDIF

      IF(YMIN.GT.YMAX)THEN
        YYY=YMIN
        YMIN=YMAX
        YMAX=YYY
      END IF

      CALL ULIGET('IYTYPE', ITYPE)
      CALL ULIGET('IYCHR' , IYCHR)
      CALL ULYLBL( BL, NB , NLBL)

      CALL GLLGET('LEPSL',LEPSL)
      CALL SGLGET('LCNTL',LCNTL)
      CALL SGIGET('ISUP', ISUP)
      CALL SGIGET('IRST', IRST)
      CALL GLLSET('LEPSL',.TRUE.)
      CALL GNSAVE

*     SMALL TICKS

      CALL VRGNN(BS, 10, 1)
      BS(NTICKS+1)=10.
      CALL GNSBLK(BS,NTICKS+1)
      CALL GNLE(YMAX,BYMAX,IPMAX)
      CALL GNGE(YMIN,BYMIN,IPMIN)

      NBS=0
      DO 100 IP=IPMIN,IPMAX
      DO 100 IB=1,NTICKS
        IF(IP.EQ.IPMIN.AND.LRLT(BS(IB),BYMIN))GOTO 100
        IF(IP.EQ.IPMAX.AND.LRGT(BS(IB),BYMAX))GOTO 100
        NBS=NBS+1
        IF(NBS.GT.MAXS) CALL MSGDMP('E', 'ULYLOG', 'TOO MANY TICKS.')
        UY1(NBS)=BS(IB)*10.**IP
  100 CONTINUE

*     LARGE LABELS AND TICKS

      CALL GNSBLK(BL,NB+1)
      CALL GNLE(YMAX,BYMAX,IPMAX)
      CALL GNGE(YMIN,BYMIN,IPMIN)

      NBL=0
      NBT=0
      JTYPE = MOD(ITYPE, 2)

      DO 201 IP=IPMIN,IPMAX
      DO 201 IB=1,NB
        IF(IP.EQ.IPMIN.AND.LRLT(BL(IB),BYMIN))GOTO 201
        IF(IP.EQ.IPMAX.AND.LRGT(BL(IB),BYMAX))GOTO 201

        IF(IB.EQ.1)THEN
          NBT=NBT+1
          UYT(NBT)=10.**IP
        END IF

        NBL=NBL+1
        IF(NBL.GT.MAXL) CALL MSGDMP('E', 'ULYLOG', 'TOO MANY LABELS.')
        UY2(NBL)=BL(IB)*10.**IP

        IF(ITYPE.LE.2) THEN
          IF(JTYPE.EQ.0 .AND. IB.NE.1) THEN
            WRITE(CH(NBL),'(I1)') INT(BL(IB))
          ELSE
            IF(JTYPE.EQ.1 .AND. NB.NE.1) THEN
              WRITE(CH(NBL),'(I1,A1)') INT(BL(IB)), CSGI(IYCHR)
            ELSE
              CH(NBL)=' '
            ENDIF

            WRITE(CHR,'(I8)') IP
            CALL CLADJ(CHR)
            IF(LCNTL) THEN
              CH(NBL)(3:16)='10'//CSGI(ISUP)//CHR(1:LENZ(CHR))
     +          //CSGI(IRST)
            ELSE
              CH(NBL)(2:16)='E'//CHR
            ENDIF
            CALL CLADJ(CH(NBL))
          ENDIF

        ELSE
          IF(JTYPE.EQ.0 .AND. IB.NE.1) THEN
            WRITE(CH(NBL),'(I1)') INT(BL(IB))
          ELSE
            CALL UZCGET('CYFMT', CFMT)
            CALL CHVAL(CFMT, UY2(NBL), CH(NBL))
            CALL CLADJ(CH(NBL))
          ENDIF
        ENDIF
  201 CONTINUE

*     DRAW AXIS, TICKS, AND LABELS

      CALL UYPAXS(CSIDE,2)
      IF(NBS.NE.0) CALL UYPTMK(CSIDE,1,UY1,NBS)
      IF(NBT.NE.0) CALL UYPTMK(CSIDE,2,UYT,NBT)
      CALL UZLGET('LABELY'//CSIDE,LABEL)
      IF(LABEL) CALL UYPLBL(CSIDE,1,UY2,CH,16,NBL)

      CALL GLLSET('LEPSL',LEPSL)
      CALL GNRSET

      IF(LOFF) THEN
        CALL SGSWND(UXMIN,UXMAX,UYMIN,UYMAX)
        CALL SGSTRF
      ENDIF

      END