1*-----------------------------------------------------------------------
2*     Copyright (C) 2000-2004 GFD Dennou Club. All rights reserved.
3*-----------------------------------------------------------------------
4      SUBROUTINE ULXLOG ( CSIDE, NLBL, NTICKS )
5
6*     CSIDE : 'T','B','U'
7*     NLBL  : 1-4          ... Label buffer number used in the axis
8*     NTICKS: 1-9          ... Number of small ticks in 10**N-10**(N+1)
9
10      PARAMETER(MAXL=50,MAXS=200)
11      DIMENSION BL(10),BS(10),UX1(MAXS),UX2(MAXL),UXT(MAXL)
12      CHARACTER CH(MAXL)*16,CHR*8,CFMT*16,CSGI,CSIDE,CHW*16
13      LOGICAL LRLT,LRGT,LABEL,LEPSL,LCNTL,LUXCHK,LOFF
14
15      SAVE
16
17      IF(.NOT.LUXCHK(CSIDE))
18     #   CALL MSGDMP('E', 'ULXLOG', 'INVALID CSIDE.')
19      IF(NLBL.LT.1 .OR. NLBL.GT.4)
20     #   CALL MSGDMP('E', 'ULXLOG', 'INVALID NLBL.')
21      IF(NTICKS.LT.1 .OR. NTICKS.GT.9)
22     #   CALL MSGDMP('E', 'ULXLOG', 'INVALID NTICKS.')
23
24      CALL SGQWND(UXMIN,UXMAX,UYMIN,UYMAX)
25
26      CALL UZLGET('LOFFSET', LOFF)
27      IF(LOFF) THEN
28        CALL UZRGET('XFACT',   FACTOR)
29        XMIN = UXMIN/FACTOR
30        XMAX = UXMAX/FACTOR
31        CALL SGSWND(XMIN,XMAX,UYMIN,UYMAX)
32        CALL SGSTRF
33      ELSE
34        XMIN = UXMIN
35        XMAX = UXMAX
36      ENDIF
37
38      SGN = SIGN(1.0,XMIN)
39
40      IF(SGN*XMIN.GT.SGN*XMAX)THEN
41        XXX=XMIN
42        XMIN=XMAX
43        XMAX=XXX
44      END IF
45
46      CALL ULIGET('IXTYPE', ITYPE)
47      CALL ULIGET('IXCHR' , IXCHR)
48      CALL ULXLBL( BL, NB , NLBL)
49
50      CALL SGIGET('ISUP', ISUP)
51      CALL SGIGET('IRST', IRST)
52
53      CALL GLLGET('LEPSL',LEPSL)
54      CALL SGLGET('LCNTL',LCNTL)
55      CALL GLLSET('LEPSL',.TRUE.)
56      CALL GNSAVE
57
58*     SMALL TICKS
59
60      CALL VRGNN(BS, 10, 1)
61      BS(NTICKS+1)=10.
62      CALL GNSBLK(BS,NTICKS+1)
63      CALL GNLE(ABS(XMAX),BXMAX,IPMAX)
64      CALL GNGE(ABS(XMIN),BXMIN,IPMIN)
65
66      NBS=0
67      DO 100 IP=IPMIN,IPMAX
68      DO 100 IB=1,NTICKS
69        IF(IP.EQ.IPMIN.AND.LRLT(BS(IB),BXMIN))GOTO 100
70        IF(IP.EQ.IPMAX.AND.LRGT(BS(IB),BXMAX))GOTO 100
71        NBS=NBS+1
72        IF(NBS.GT.MAXS) CALL MSGDMP('E', 'ULXLOG', 'TOO MANY TICKS.')
73        UX1(NBS)=SGN*BS(IB)*10.**IP
74  100 CONTINUE
75
76*     LARGE LABELS AND TICKS
77
78      CALL GNSBLK(BL,NB+1)
79      CALL GNLE(ABS(XMAX),BXMAX,IPMAX)
80      CALL GNGE(ABS(XMIN),BXMIN,IPMIN)
81
82      NBL=0
83      NBT=0
84      JTYPE = MOD(ITYPE, 2)
85
86      DO 201 IP=IPMIN,IPMAX
87      DO 201 IB=1,NB
88        IF(IP.EQ.IPMIN.AND.LRLT(BL(IB),BXMIN))GOTO 201
89        IF(IP.EQ.IPMAX.AND.LRGT(BL(IB),BXMAX))GOTO 201
90
91        IF(IB.EQ.1)THEN
92          NBT=NBT+1
93          UXT(NBT)=SGN*10.**IP
94        END IF
95
96        NBL=NBL+1
97        IF(NBL.GT.MAXL) CALL MSGDMP('E', 'ULXLOG', 'TOO MANY LABELS.')
98        UX2(NBL)=SGN*BL(IB)*10.**IP
99
100        IF(ITYPE.LE.2) THEN
101          IF(JTYPE.EQ.0 .AND. IB.NE.1) THEN
102            WRITE(CH(NBL),'(I1)') INT(BL(IB))
103          ELSE
104            IF(JTYPE.EQ.1 .AND. NB.NE.1) THEN
105              WRITE(CH(NBL),'(I1,A1)') INT(BL(IB)), CSGI(IXCHR)
106            ELSE
107              CH(NBL)=' '
108            ENDIF
109
110            WRITE(CHR,'(I8)') IP
111            CALL CLADJ(CHR)
112            IF(LCNTL) THEN
113              CH(NBL)(3:16)='10'//CSGI(ISUP)//CHR(1:LENZ(CHR))
114     +          //CSGI(IRST)
115            ELSE
116              CH(NBL)(2:16)='E'//CHR
117            ENDIF
118            CALL CLADJ(CH(NBL))
119          END IF
120
121        ELSE
122          IF(JTYPE.EQ.0 .AND. IB.NE.1) THEN
123            WRITE(CH(NBL),'(I1)') INT(BL(IB))
124          ELSE
125            CALL UZCGET('CXFMT', CFMT)
126            CALL CHVAL(CFMT, ABS(UX2(NBL)), CH(NBL))
127            CALL CLADJ(CH(NBL))
128          ENDIF
129        ENDIF
130  201 CONTINUE
131
132      IF(SGN.LT.0) THEN
133         DO 301 IB=1,NBL
134            CHW='-'//CH(IB)
135            CH(IB)=CHW
136  301    CONTINUE
137      ENDIF
138
139*     DRAW AXIS, TICKS, AND LABELS
140
141      CALL UXPAXS(CSIDE,2)
142      IF(NBS.NE.0) CALL UXPTMK(CSIDE,1,UX1,NBS)
143      IF(NBT.NE.0) CALL UXPTMK(CSIDE,2,UXT,NBT)
144      CALL UZLGET('LABELX'//CSIDE,LABEL)
145      IF(LABEL) CALL UXPLBL(CSIDE,1,UX2,CH,16,NBL)
146
147      CALL GLLSET('LEPSL',LEPSL)
148      CALL GNRSET
149
150      IF (LOFF) THEN
151        CALL SGSWND(UXMIN,UXMAX,UYMIN,UYMAX)
152        CALL SGSTRF
153      ENDIF
154
155      END
156