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