*----------------------------------------------------------------------- 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 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|'//CHR(1:LENZ(CHR))//'"' 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