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