SUBROUTINE LB_AXIS(XY,ARG2,ARG3,LINLOG,ARG5,ARG6,ARG7, . ARGX ,NTIC) C C---------------------------------------------------------------------- C.IDENTIFICATION: Subroutine LB_AXIS C.LIBRARY: XASGRAPH C.AUTHOR: L.Chiappetti - IFCTR Milano C.VERSIONS: 0.0 - 13 Oct 93 - Prototype C.PURPOSE: LaBeller AXIS setup C.SYNTAX: CALL DF_AXIS(arguments) C.PARAMETERS: refer to the Labeller documentation C INTEGER NTIC is the wished number of tics C---------------------------------------------------------------------- C C C routine for axis setup C based on the "Labeller" program (L.Chiappetti, 1986, 1989) C IMPLICIT INTEGER (A-Z) REAL ARG2,ARG3,ARG5,ARG6,ARG7 CHARACTER ARGX*(*) INCLUDE 'labco.inc' INCLUDE 'labc1.inc' INCLUDE 'voscommon.inc' C CHARACTER XY*1, WORK*15, LINLOG*3, LOGSCALE*7 CV1 REAL STEPA,OTHER,DECSIZE, START,STEP,LOGS(9) REAL STEPA,OTHER,DECSIZE, START,STEP CV1 REAL X0,XEND,STARTEXP,NTRUEDEC,FRAC REAL XEND,NTRUEDEC REAL*8 FRUC,MTRUEDEC,LOGS(9),FRAC,STARTEXP,X0 DATA LOGS/0.D0,0.301029996D0,0.477121255D0,0.602059991D0, . 0.698970004D0,0.778151250D0,0.845098040D0,0.903089987D0, . 0.954242509D0/ C reset offset for labels to default LABOFFSET=3.0 IF(XY.NE.'X'.AND.XY.NE.'Y')THEN IERR=905 !AXIS IS NOT X NOR Y GOTO 9999 ENDIF XAXIS=XY.EQ.'X' C???? by definition both in NDC, ie. identical to 0.0 or 1.0 XORIG=ARG2 YORIG=ARG3 IF(LINLOG.NE.'LIN'.AND.LINLOG.NE.'LOG')THEN IERR=907 !AXIS NOT LIN OR LOG GOTO 9999 ENDIF LIN=LINLOG.EQ.'LIN' C???? by definition in NDC, ie. identical to 1.0 AXLEN=ARG5 C C New handling of log scales (default is OLD C LOGSCALE=ARGX * LOGSCALE=' ' !clear in case of LIN scales IF(.NOT.LIN)THEN IF( LOGSCALE(1:1).EQ.'O')LOGSCALE='OLD' IF( LOGSCALE(1:1).EQ.'E')LOGSCALE='EXACT' IF( LOGSCALE(1:1).EQ.'D')LOGSCALE='DECADES' IL=INDEX('OED',LOGSCALE(1:1)) IF(IL.EQ.0)THEN IERR=917 !illegal type of logscale GOTO 9999 ENDIF else logscale=' ' ENDIF C C--> IF(LIN)THEN IF(LIN.OR.LOGSCALE.NE.'OLD')THEN START=ARG6 ELSE NEXY=ARG6 X0=10.**NEXY ENDIF C C new modes for log scales C--> probably the modes .ne. EXACT won't work C--> they expect the starting decade and we always pass C--> the actual start value C--> the same is true for "step" C IF(LOGSCALE.EQ.'EXACT')X0=START IF(LOGSCALE.EQ.'DECADES')X0=10.**START IF(.NOT.LIN)STARTEXP=LOG10(X0) C C--> IF(LIN)THEN IF(LIN.OR.LOGSCALE.NE.'OLD')THEN STEP=ARG7 C arg7 is the end of the axis, in case of linear C axes compute STEP for backward compatibility C--> in case of log EXACT axis this routine should be C--> already OK (The Labeller Handbook rel 2, pag. 10) C--> but the "DECADES" and "OLD" modes won't work IF(LIN)STEP=(ARG7-START)/NTIC ELSE NDXY=ARG7 IF(NDXY.GT.20)THEN IERR=909 !too many decades or divisions for OLD log mode GOTO 9999 ENDIF NTRUEDEC=NDXY ENDIF C C new modes for log scale C IF(LOGSCALE.EQ.'EXACT')NTRUEDEC=LOG10(STEP)-LOG10(X0) IF(LOGSCALE.EQ.'DECADES')NTRUEDEC=STEP C scale=1 ! tentative, was HP cm to device units XORIG=XORIG*SCALE YORIG=YORIG*SCALE ! +250 was an HPism AXLEN=AXLEN*SCALE steps=1.0/NTIC ! was set in a separate routine STEPA=STEPS*SCALE IF(XAXIS)THEN ORIGIN=YORIG OTHER =XORIG ELSE ORIGIN=XORIG OTHER =YORIG ENDIF C C......LINEAR AXIS........................................................ C IF(LIN)THEN NSTEP=IFIX(ABS(AXLEN/STEPA))+1 IF(NSTEP.GT.200)THEN IERR=909 !too many divisions for linear scale GOTO 9999 ENDIF DO 10 I=1,NSTEP COORD(I)=OTHER+(I-1)*STEPA VALUES(I)=START+(I-1)*STEP 10 CONTINUE C C......LOG AXIS............................................................ C ELSE C--> NSTEP=NDXY*9 +1 C--> DECSIZE=(AXLEN/(NDXY+0.30103)) !FROM PBLIB NSTEP=NINT(NTRUEDEC*9. + 1.) IF(LOGSCALE.NE.'EXACT')THEN NSTEP=NSTEP+1 !TENTATIVELY ADDED DECSIZE=(AXLEN/(NTRUEDEC+0.30103)) !FROM PBLIB MTRUEDEC=NTRUEDEC+0.30103 ELSE DECSIZE=(AXLEN/ NTRUEDEC ) MTRUEDEC=NTRUEDEC ENDIF I=0 NDXY=NTRUEDEC+1.01 !closest integer highest than NTRUEDEC C also find integer closest to start value NEXY=STARTEXP FRAC=STARTEXP-NEXY IF(ABS(FRAC).LT.1.D-5)FRAC=0.0 C that is protect for non significant values C in order to test correctly logs of numbers less than 1 add 1 below FRUC=FRAC IF(FRUC.LT.0)FRUC=1.+FRUC DO 19 K=1,9 CV1 IF (FRUC.LE.LOGS(K)) THEN IF (FRUC-LOGS(K).LT.1.D-5) THEN KI=K GOTO 191 ENDIF 19 CONTINUE 191 CONTINUE OTHER=OTHER+(LOGS(KI)-FRUC)*DECSIZE DO 20 J=1,NDXY +1 IF(J.EQ.1)THEN KSTART=KI ELSE KSTART=1 ENDIF DO 30 K=KSTART,9 IF(LOGS(K)+J-1-LOGS(KI).GT.MTRUEDEC)THEN C if end of range is beyond as expected mark last expected C point as not to be labelled (if instead is before do nothing) IF(I.GT.NSTEP)VALUES(NSTEP)=-1.0 NSTEP=I GOTO 201 ENDIF CMOVE I=I+1 IF(NTRUEDEC.GT.10.AND.K.NE.1)GOTO 30 I=I+1 C i.e. if more than 10 decades save only integral decades COORD(I)=OTHER+(J-1)*DECSIZE+DECSIZE*(LOGS(K)-LOGS(KI)) C IF(K.EQ.1)THEN C VALUES(I)=10.**(NEXY+J-1) IF(NTRUEDEC.LT.1.0.OR.(NTRUEDEC.LT.2.0.AND.I.EQ.1).OR. . (NTRUEDEC.LT.2.0.AND.I.EQ.NSTEP).OR.K.EQ.1)THEN VALUES(I)=10.**(STARTEXP+LOGS(K)+J-1-FRUC) ELSE VALUES(I)= -1. !NOT USED ENDIF 30 CONTINUE 20 CONTINUE COORD(NSTEP)=OTHER + NDXY*DECSIZE-LOGS(KI) VALUES(NSTEP)=10.**(NEXY+NDXY-FRUC) CV1 ENDIF 201 CONTINUE C C The log scale is annotated at decades only if OLD or anyhow C excepted the following cases C it is only one decade (annotated every tic) C it is less than two decades and the last tic has a label C it is less than two decades and the first tic is not a decade FEWDECADES=.FALSE. IF(LOGSCALE.NE.'OLD')THEN IF(NTRUEDEC.LT.1.0)FEWDECADES=.TRUE. IF(NTRUEDEC.LT.2.0.AND.VALUES(NSTEP).NE.-1.)FEWDECADES=.TRUE. IF(NTRUEDEC.LT.2.0.AND..NOT.FEWDECADES)THEN NTEST=LOG10(VALUES(1)) FRAC=LOG10(VALUES(1))-NTEST IF(ABS(FRAC).GT.1.D-5)FEWDECADES=.TRUE. ENDIF ENDIF ENDIF DEFINED=.TRUE. RETURN C C--> tentatively store "labler" error code in VOS common 9999 VOSCOMMON_ERROR=9999 VOSCOMMON_SYSTEMERROR=IERR write(*,*)' debug LB_AXIS exiting with ',ierr RETURN END