FTN4,L C C C CC************************************************************ C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978. ALL RIGHTS * C RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * C PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * C OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * CC************************************************************ C C C C NAME: AXES AND LAXES, GRID AND LGRID C SOURCE: 92840 - 18019 C RELOC: 92840 - 16001 C C C CC*********************************************************** C SUBROUTINE AXELS(IND, IGCB,P1,P2,P3, 1P4,P5,P6,P7), 92840-16001 REV.2013 800127 C REAL NUMTC DIMENSION VAR(12),XYORG(2),XYNOW(2) EM1913 DIMENSION ICODE(3),IBUFR(7) INTEGER READ,WRITE,EFLG C C VARIABLE TO SAVE STATE OF LINESTYLE SELECTED BIT FROM STATUS WORD EM1901 INTEGER LNSET EM1901 C EM1901 EQUIVALENCE (VAR,A),(VAR(2),B),(VAR(3),C),(VAR(4),D) EQUIVALENCE (VAR(5),X1),(VAR(6),Y1) EQUIVALENCE (AP,VAR(9)),(BP,VAR(10)),(CP,VAR(11)),(DP,VAR(12)) EQUIVALENCE (VAR(7),XEND),(VAR(8),YEND) EQUIVALENCE (ICODE(2),ICD2),(ICODE(3),ICD3) EQUIVALENCE (IBUFR(5),THETA),(IBUFR(2),XLNTH),(IBUFR(4),LRG) EQUIVALENCE (IBUFR(7),IERCD) C DATA READ/1/ DATA WRITE/2/ EM1901 C C BIT 11 IN STATUS WORD CONTAINS STATE OF LINESTYLE CALL EM1901 DATA LNSTS/4000B/ EM1901 DATA LNTYP/23/ C C THIS IS THE AGL MODULE FOR AGL COMMANDS AXES,LAXES,GRID C AND LGRID. C THE PARAMETERS IN THE CALLING SEQUENCE HAVE THE FOLLOWING C MEANINGS: C PARAMETER MEANING DEFAULT C IND 1=AXES,2=LAXES NONE EM1913 C 3=GRID,4=LGRID EM1913 C P1 X-TIC SPACING 0-NO TICS C P2 " Y-TIC SPACING 0 C P3 " X-ORIGIN 0 C P4 " Y-ORIGIN 0. C P5 " X-MAJOR COUNT 1.0 C P6 " Y-MAJOR COUNT 1.0 C P7 " MINOR TIC SIZE 2GDUS C************************************************************* C C DETERMINE UNITS MODE AND WHICH TRANSFORMATION CONSTANTS TO C USE. C ICD2 = 10 DS2013 ICD3 = 11 CCCC C THIS CALL ESTABLISHES AN ADDRESS LINK BETWEEN THE GRAPGHICS C PACKAGE AND THE CURRENT GCB AND ALSO CHECKS FOR A SUSPENDED GCB. C ISUSP= 0 CALL GCBIM(99,1,IGCB,ISUSP) IF(ISUSP.NE.0)RETURN ICODE = IADCD(D) CALL GCBIM(ICODE,3,VAR,0,READ) C EM2013 C CONVERT MUS TO CURRENT UNITS MODE UDUS OR GDUS C XEND = (XEND - B)/A EM1913 YEND = (YEND - D)/C X1 = (X1 - B)/A Y1 = (Y1 - D)/C C EM1913 C BECAUSE OF TRUNCATION ERRORS IN FLOATING POINT ARITHMETIC, AND EM1913 C POSSIBLE ERRORS IN SOFTWARE FLOATING POINT ARITHMETIC ROUTINES, IT IS EM1913 C NECESSARY TO ADD AN EPSILON FACTOR TO SLIGHTLY ENLARGE THE WINDOW EM1913 C TO ENSURE NO ACCIDENTAL CLIPPING OF AXES AND LABELS EM1913 C EM1913 EPSIX = ABS(P1/1000.) EPSIY = ABS(P2/1000.) EM1913 X1 = X1-EPSIX EM1913 Y1 = Y1-EPSIY EM1913 XEND = XEND+EPSIX EM1913 YEND = YEND+EPSIY EM1913 C EM1913 C C ABSOLUTIZE NECESSARY PARAMETERS C DON'T ABSOLUTIZE TIC SPACING IF LABELS INVOLVED, SINCE THE SIGN EM1913 C INDICATES LABEL ORIENTATION. EM1913 C EM1913 IF (IND.EQ.1.OR.IND.EQ.3) GO TO 10 EM1913 XP1 = P1 EM1913 XP2 = P2 EM1913 GO TO 20 EM1913 10 XP1 = ABS(P1) XP2 = ABS(P2) C EM2013 C ZERO IS AN ILLEGAL VALUE FOR TIC SPACING. EM2013 C SET TIC SPACING = 1. IF ZERO IS SPECIFIED EM2013 C OTHERWISE TAKE ABSOLUTE VALUE. EM2013 C EM2013 20 IF (P5 .NE. 0.) GOTO 21 EM2013 XP5 = 1. EM2013 GOTO 22 EM2013 21 XP5 = ABS(P5) EM2013 22 IF (P6 .NE. 0.) GOTO 23 EM2013 XP6 = 1. EM2013 GOTO 24 EM2013 23 XP6 = ABS(P6) EM2013 24 XP7 = ABS(P7) EM2013 C EM1913 C C SAVE STATUS WORD BIT INDICATING WHETHER OR NOT LINESTYLE CALLED EM1901 C BY USER PROGRAM. THIS IS BIT 11 OF STATUS WORD. EM1901 C CALL GRSTS(READ,LNSTS,LNSET) EM1901 C C GET LINE TYPE, LDIR AND LORG AND SAVE FOR RESET WHEN DONE C ICODE = LNTYP ICD2 = 30 CALL GCBIM(ICODE,2,IBUFR,0,1) C EM1913 C C C C***********************************************************************EM1913 C* DO FOR X AXIS THEN Y AXIS *EM1913 C* SET THE LINESTYLE TO 0 FOR DRAWING OF AXIS *EM1913 C* DRAW AXIS *EM1913 C* CALL SUBROUTINE FOR TICS-GRIDS 'ABOVE' ORIGIN, UNLESS *EM1913 C* NO AXIS IS THERE *EM1913 C* CALL SUBROUTINE FOR TICS-GRIDS 'BELOW' ORIGIN, UNLESS *EM1913 C* NO AXIS IS THERE *EM1913 C* TURN CLIPPING OFF *EM1913 C* DRAW LABELS FOR AXIS - ORIGIN, RIGHT, LEFT *EM1913 C* TURN CLIPPING ON *EM1913 C***********************************************************************EM1913 C EM1913 C EM1913 C EM1913 C ******** X AXIS *** EM1913 C EM1913 CALL LINE(IGCB,0) EM1913 C EM1913 C DRAW AXIS UNLESS ALL CLIPPED BECAUSE ORIGIN OUT OF WINDOW EM1913 C EM1913 IF (P4.LT.Y1) GO TO 25 EM1913 IF (P4.GT.YEND) GO TO 25 EM1913 C EM1913 C EM1913 C NO, NOT ALL CLIPPED SO DRAW AXIS EM1913 C EM1913 CALL MOVE(IGCB,X1,P4) EM1913 CALL DRAW(IGCB,XEND,P4) EM1913 C EM1913 C EM1913 C IF THERE AREN'T ANY TICS OR GRIDS, WE ARE DONE WITH THIS AXIS EM1913 C EM1913 25 IF (XP1.EQ.0.) GO TO 30 EM1913 C EM1913 C EM1913 C SET UP ARRAY CONTAINING ORIGIN POINTS FOR SUBROUTINE CALLS EM1913 C EM1913 XYORG(1) = P3 EM1913 XYORG(2) = P4 EM1913 I = 1 EM1913 J = 2 EM1913 C EM1913 C EM1913 C SET UP SPACE BETWEEN TICS FOR THE UPPER DIRECTION EM1913 C EM1913 BETWN = ABS(P1) EM1913 C EM1913 C EM1913 C SET UP TIC MARK SIZE FOR MINOR TICS (SAME AS MAJOR TIC OFFSET EM1913 C TO ONE SIDE). THIS WILL BE 0 FOR CALLS WISHING GRID LINES AT EM1913 C MINOR TIC MARKS AS WELL AS MAJOR. EM1913 C EM1913 TICSZ = (XP7*CP)/C EM1913 C EM1913 C EM1913 C SEPARATE INTO GRIDS AND TICS EM1913 C EM1913 C EM1913 C CALL FOR TIC OR GRID MARKS ON UPPER AND LOWER HALVES, IF THERE EM1913 C IS ANY AXIS THERE, CHANGING DIRECTION OF SPACE BETWEEN TICS FOR EM1913 C LOWER HALF EM1913 C EM1913 IF(P3.LT.XEND)CALL G1TIC(IGCB,IND,Y1,YEND,X1,XEND,XYORG,I,J, EM1913 1 BETWN,TICSZ,XP5) EM1913 BETWN = -1. * BETWN EM1913 IF(P3.GT.X1)CALL G1TIC(IGCB,IND,Y1,YEND,XEND,X1,XYORG,I,J,BETWN, EM1913 1 TICSZ,XP5) EM1913 C EM1913 C EM1913 C****LABELS FOR X AXIS*************************************** EM1913 C EM1913 C CHECK TO SEE IF LABELS WANTED EM1913 C EM1913 IF (IND.EQ.1.OR.IND.EQ.3) GO TO 30 EM1913 C EM1913 C MOVE TO LOVER EDGE OF SURFACE, SO IF LABELS ARE OUTPUT OUTSIDE OF EM1913 C HARDCLIP LIMITS, THEY WON'T APPEAR SOMEPLACE VERY STRANGE ON 2608 EM1913 C WHICH DOESN'T DO ANY HARDCLIPPING EM1913 C EM1913 CALL MOVE(IGCB,X1,Y1) EM1913 C EM1913 C NOW CALL FOR LABELS. LABELS ARE OUTPUT EVEN IF CORRESPONDING TICS EM1913 C AREN'T VISIBLE. THE ORDER IS ORIGIN,RIGHT OF ORIGIN, LEFT OF ORIGIN. EM1913 C SHUT OFF CLIPPING BEFORE DOING THE LABELING EM1913 C EM1913 CALL CLPOF(IGCB) EM1913 C EM1913 C SET UP SPACE BETWEEN MAJOR TICS (AND THEREFORE LABELS). EM1913 C EM1913 BETWN = ABS(P1)*XP5 EM1913 C EM1913 C FIRST OUTPUT LABEL AT ORIGIN,(IF ORIGIN IS OUTPUT),THEN TO RIGHT. EM1913 C FIND THE FIRST PART OF THE UPPER X AXIS(INCLUDING ORIGIN) WITHIN EM1913 C THE CLIPPING BOUNDARIES EM1913 C EM1913 XYNOW = P3 EM1913 XYNOW(2) = P4 EM1913 26 IF (XYNOW.GE.X1) GO TO 27 EM1913 XYNOW = XYNOW + BETWN EM1913 GO TO 26 EM1913 C EM1913 C WE HAVE NOW GOTTEN ONTO THE BEGINNING OF THE AXIS AT LEAST SO EM1913 C NOW OUTPUT LABELS UNTIL WE ARE OFF UPPER END OF CLIPPED X AXIS EM1913 C EM1913 27 IF (XYNOW.GT.XEND) GO TO 28 EM1913 C EM1913 CALL LABAX(XP1,Y1,XYNOW,I,J,IGCB) EM1913 XYNOW = XYNOW + BETWN EM1913 GO TO 27 EM1913 C EM1913 C TO THE LEFT. FIND THE FIRST PART OF LOWER X AXIS WITHIN THE CLIPPING EM1913 C BOUNDARIES, GOING BACK TO ORIGIN EM1913 C EM1913 28 XYNOW = P3 EM1913 29 XYNOW = XYNOW - BETWN EM1913 IF (XYNOW.GT.XEND) GO TO 29 EM1913 C EM1913 C THEN KEEP OUTPUTTING LABELS UNTIL WE ARE OFF THE LOWER END OF THE EM1913 C CLIPPED LOWER X AXIS EM1913 C EM1913 31 IF (XYNOW.LT.X1) GO TO 32 EM1913 CALL LABAX(XP1,Y1,XYNOW,I,J,IGCB) EM1913 XYNOW = XYNOW - BETWN EM1913 GO TO 31 EM1913 C EM1913 C WE ARE FINISHED OUTPUTING LABELS FOR THE X AXIS, SO TURN CLIPPING EM1913 C BACK ON EM1913 C EM1913 32 CALL CLPON(IGCB) EM1913 C EM1913 C EM1913 C ********Y AXIS*** EM1913 C EM1913 CALL LINE(IGCB,0) EM1913 C EM1913 C DRAW AXIS UNLESS ALL CLIPPED BECAUSE THE ORIGIN IS OUT OF WINDOW. EM1913 C EM1913 30 IF (P3.LT.X1) GO TO 35 EM1913 IF (P3.GT.XEND) GO TO 35 EM1913 C EM1913 C EM1913 C NO, NOT ALL CLIPPED SO DRAW AXIS EM1913 C EM1913 CALL MOVE(IGCB,P3,Y1) EM1913 CALL DRAW(IGCB,P3,YEND) EM1913 C EM1913 C EM1913 C IF THERE AREN'T ANY TICS OR GRIDS, WE ARE DONE WITH THIS AXIS EM1913 C EM1913 35 IF (XP2.EQ.0.) GO TO 45 EM1913 C EM1913 C EM1913 C SET UP ARRAY CONTAINING ORIGIN POINTS FOR SUBROUTINE CALLS EM1913 C EM1913 XYORG(1) = P4 EM1913 XYORG(2) = P3 EM1913 I = 2 EM1913 J = 1 EM1913 C EM1913 C EM1913 C SET UP SPACE BETWEEN TICS FOR THE UPPER DIRECTION EM1913 C EM1913 BETWN = ABS(P2) EM1913 C EM1913 C EM1913 C SET UP TIC MARK SIZE FOR MINOR TICS (SAME AS MAJOR TIC OFFSET TO EM1913 C ONE SIDE.) THIS WILL BE 0 FOR GRID CALLS WISHING GRID LINES AT MINOR EM1913 C TIC MARKS AS WELL AS MAJOR EM1913 C EM1913 TICSZ = (XP7*AP)/A C EM1913 C EM1913 C SEPARATE INTO GRIDS AND TICS. EM1913 C EM1913 C CALL FOR TIC OR GRID MARKS ON UPPER AND LOWER HALVES, IF THERE EM1913 C IS ANY AXIS THERE CHANGING DIRECTION OF SPACE BETWEEN TICS FOR LOWER EM1913 C HALF. EM1913 C EM1913 IF(P4.LT.YEND)CALL G1TIC(IGCB,IND,X1,XEND,Y1,YEND,XYORG,I,J, EM1913 1 BETWN,TICSZ,XP6) EM1913 BETWN = -1. * BETWN EM1913 IF(P4.GT.Y1)CALL G1TIC(IGCB,IND,X1,XEND,YEND,Y1,XYORG,I,J,BETWN, EM1913 1 TICSZ,XP6) EM1913 C EM1913 C EM1913 C****LABELS FOR Y AXIS*************************************** EM1913 C EM1913 C CHECK TO SEE IF LABELS WANTED EM1913 C EM1913 IF (IND.EQ.1.OR.IND.EQ.3) GO TO 45 EM1913 C EM1913 C NOW MOVE TO EDGE OF SURFACE, SO IF LABELS ARE OUTPUT OUTSIDE OF HARD EM1913 C CLIP LIMITS, THEY WON'T APPEAR SOMEPLACE VERY STRANGE ON 2608 WHEN EM1913 C THE MOVES ARE SURPRESSED EM1913 C EM1913 CALL MOVE(IGCB,X1,Y1) EM1913 C EM1913 C NOW CALL FOR LABELS. LABELS ARE OUTPUT EVEN IF CORRESPONDING TICS EM1913 C AREN'T VISIBLE EM1913 C SHUT OFF CLIPPING BEFORE DOING THE LABELING EM1913 C EM1913 CALL CLPOF(IGCB) EM1913 C EM1913 C SET UP SPACE BETWEEN MAJOR TICS (AND THEREFORE LABELS). EM1913 C EM1913 BETWN = ABS(P2)*XP6 EM1913 C EM1913 C FIRST OUTPUT LABEL AT ORIGIN,(IF ORIGIN IS VISIBLE),THEN TO RIGHT. EM1913 C FIND THE FIRST PART OF THE UPPER Y AXIS (ORIGIN INCLUDED) WITHIN EM1913 C CLIPPING BOUNDARIES. EM1913 C EM1913 XYNOW = P4 EM1913 XYNOW(2) = P3 EM1913 126 IF (XYNOW.GE.Y1) GO TO 127 EM1913 XYNOW = XYNOW + BETWN EM1913 GO TO 126 EM1913 C EM1913 C WE HAVE GOTTEN ONTO THE BEGINNING OF THE AXIS AT LEAST,SO EM1913 C NOW OUTPUT LABELS UNTIL WE ARE OFF UPPER END OF CLIPPED Y AXIS EM1913 C EM1913 127 IF (XYNOW.GT.YEND) GO TO 128 EM1913 CALL LABAX(XP2,X1,XYNOW,I,J,IGCB) EM1913 XYNOW = XYNOW + BETWN EM1913 GO TO 127 EM1913 C EM1913 C TO THE LEFT. FIND THE FIRST PART OF LOWER Y AXIS WITHIN THE CLIPPING EM1913 C BOUNDARIES, GOING BACK TO ORIGIN EM1913 C EM1913 128 XYNOW = P4 EM1913 129 XYNOW = XYNOW - BETWN EM1913 IF (XYNOW.GT.YEND) GO TO 129 EM1913 C EM1913 C THEN KEEP OUTPUTTING LABELS UNTIL WE ARE OFF THE LOWER END OF THE EM1913 C CLIPPED LOWER Y AXIS EM1913 C EM1913 131 IF (XYNOW.LT.Y1) GO TO 132 EM1913 CALL LABAX(XP2,X1,XYNOW,I,J,IGCB) EM1913 XYNOW = XYNOW - BETWN EM1913 GO TO 131 EM1913 C EM1913 C WE ARE FINISHED OUTPUTING LABELS FOR THE Y AXIS, SO TURN CLIPPING EM1913 C BACK ON EM1913 C EM1913 132 CALL CLPON(IGCB) EM1913 C EM1913 C WE ARE DONE WITH OUTPUTTING THE AXES AND LABELS. EM1913 C EM1913 C EM1913 C RESET LINE TYPE AND LDIR C 45 CALL LINE(IGCB,IBUFR,XLNTH) CALL LDIR(IGCB,THETA) CALL LORG(IGCB,LRG) C C RESET STATUS WORD BIT INDICATING WHETHER OR NOT LINESTYLE CALLED EM1901 C BY USER PROGRAM EM1901 CALL GRSTS(WRITE,173777B,LNSET) EM1901 C CALL GCBIM(30,1,IERCD,0,2) RETURN END C C EM1913 C********************************************************************* EM1913 C EM1913 C EM1913 C EM1913 SUBROUTINE G1TIC(IGCB,LIND,BTTOM,TOP,ABEG,AEND,XYORG, EM1913 1I,J,TICSP,TICSZ,XP56), 92840-16001 REV.2013 800123 EM2013 C EM1913 C EM1913 C THE PARAMENTERS ARE AS FOLLOWS: EM1913 C EM1913 C IGCB - THE GRAPHICS CONTROL BLOCK EM1913 C LIND - CALL INDICATOR. 1=AXES 2=LAXES 3=GRID 4=LGRID EM1913 C 1 & 3 HAVE NO LABELS 2 & 4 HAVE LABELS EM1913 C BTTOM - THE BOTTOM OR BEGINNING OF THE OTHER AXIS. EM1913 C EM1913 C TOP - THE TOP OR END OF THE OTHER AXIS. GRIDS STRETCH FROM EM1913 C TOP TO BOTTOM. EM1913 C ABEG - THE BEGINNING OF THE AXIS ON WHICH TIC MARKS ARE MADE EM1913 C AEND - THE END OF THE AXIS WITH WHICH YOU ARE WORKING. EM1913 C XYORG - THE X AND Y VALUES AT THE 'ORIGIN' WHERE THE EM1913 C AXES CROSS. XYORG(1) IS THE VALUE FOR THE AXIS EM1913 C ON WHICH THE TIC MARKS ARE BEING MADE. EM1913 C I,J - INDICES FOR XYORG. I IS THE INDEX FOR THE X VALUE EM1913 C AND J IS THE Y VALUE INDEX. EM1913 C TICSP - SPACE BETWEEN TICS. IF LT 0 THEN WE ARE GOING LEFT, EM1913 C ELSE RIGHT. SHOULD NEVER BE CALLED WITH 0. EM2013 C TICSZ - MAJOR TIC OFFSET FROM AXIS, THEREFORE WHOLE LENGTH EM1913 C OF MINOR TIC. THIS WILL BE 0 FOR GRID CALLS WISHING EM1913 C GRID MARKS AT MINOR TIC MARKS. EM1913 C XP56 - THE NUMBER OF TICS PER MAJOR TIC MARK., EITHER P5 OR P6 EM2013 C FROM AXES-LAXES-GRID-LGRID CALL. SHOULD ALWAYS BE EM2013 C CALLED WITH VALUE > 0. EM2013 C EM1913 C EM1913 C EM1913 DIMENSION XYORG(2),XYNOW(2) EM1913 LOGICAL LCHNG EM1913 C EM1913 C WE ASSUME COMING IN THAT LINESTYLE = 0 EM1913 C EM1913 C WE ARE GOING TO CHANGE THE VALUE OF THESE PARAMETERS SO MAKE COPIES EM1913 C EM1913 TSPACE = TICSP EM1913 TNUMB = XP56 EM1913 C EM1913 C THE SIGN OF THE SPACING IS A FUNCTION OF WHETHER WE ARE EM1913 C GOING UP OR DOWN THE AXIS, SETTING DIR TO 1 FOR UP, -1 FOR DOWN. EM1913 C EM1913 DIR = 1. EM1913 IF (TSPACE.LT.0.) DIR = -1. EM1913 C EM1913 C NOW THAT DIR IS DETERMINED SET UP CONSTANTS EM2013 C EM2013 DABEG = DIR * ABEG EM2013 DAEND = DIR * AEND EM2013 EM2013 C EM1913 C HALVE TICSZ TO GET MINOR TIC OFFSET FROM AXIS EM1913 C EM1913 ITICS = 0 EM1913 SZMIN = TICSZ/2. EM1913 XYNOW = XYORG EM1913 XYNOW(2) = XYORG(2) EM1913 C EM1913 C EM1913 C NOW SEPARATE INTO GRIDS AND TICS (GRID-LGRID AND AXES-LAXES) EM1913 C EM1913 IF (LIND.GT.2) GO TO 101 EM1913 C EM1913 C*******AXES WITH TICS************************** EM1913 C EM1913 C PREPARE TO OUTPUT A TIC. FIRST SEE THAT THE TICS REACH INTO SEEN EM1913 C REGION AT LEAST PARTIALLY. IF NO TICS WILL BE SEEN, WE ARE FINISHED. EM1913 C EM1913 IF ((XYNOW(2)+TICSZ).LT.BTTOM) GO TO 1000 EM1913 IF ((XYNOW(2)-TICSZ).GT.TOP) GO TO 1000 EM1913 C EM2013 C IF THERE ARE ONLY MAJOR TICS, SKIP OVER MINOR TIC CODE EM2013 C EM2013 IF (TNUMB.EQ.1.) GO TO 5 EM1913 C EM1913 C EM1913 C SEE IF THE MINOR TICS WILL BE SEEN ( MAJOR WILL SINCE WE GOT TO EM1913 C THIS POINT ). IF NOT, ONLY OUTPUT MAJOR. EM1913 C EM1913 IF ((XYNOW(2)+SZMIN).LT.BTTOM) GO TO 2 EM1913 IF ((XYNOW(2)-SZMIN).GT.TOP) GO TO 2 EM1913 GO TO 5 EM1913 C EM1913 C EM1913 C ONLY MAJOR TICS, SO SET UP ITICS & SPACING. EM1913 C EM1913 2 TSPACE = TSPACE * TNUMB EM1913 TNUMB = 1. EM1913 C EM1913 C EM1913 C NEXT, SEE THAT WE'RE NOT OFF THE AXIS. IF WE ARE 'IN BACK OF' THE EM1913 C VISIBLE AXIS BECAUSE THE AXIS IS CLIPPED, KEEP MOVING UNTIL WE'RE EM1913 C ON, KEEPING TRACK OF MAJOR & MINOR COUNT. IF WE ARE OUT OFF THE END, EM1913 C RETURN BECAUSE WE ARE FINISHED. EM1913 C EM1913 5 XYNOW = XYNOW+ TSPACE EM1913 IF (DIR*XYNOW.GE.DABEG) GO TO 7 EM2013 C EM1913 ITICS = ITICS + 1 EM1913 IF (ITICS.EQ.TNUMB) ITICS = 0 EM1913 GO TO 5 EM1913 7 IF (DIR*XYNOW.GT.DAEND) GO TO 1000 EM2013 C EM1913 C EM1913 C INCREMENT TIC COUNT AND SEE IF MAJOR TIC. EM1913 C EM1913 ITICS = ITICS + 1 EM1913 IF (ITICS.NE.TNUMB) GO TO 10 EM1913 C EM1913 C EM1913 C SET UP A MAJOR TIC EM1913 C EM1913 SZTIC = TICSZ EM1913 ITICS = 0 EM1913 GO TO 20 EM1913 C EM1913 C EM1913 C SET UP A MINOR TIC EM1913 C EM1913 10 SZTIC = SZMIN EM1913 C EM1913 C EM1913 C OUTPUT A TIC, EITHER A MAJOR OR MINOR EM1913 C EM1913 20 XYNOW(2) = XYORG(2) + SZTIC EM1913 CALL MOVE(IGCB,XYNOW(I),XYNOW(J)) EM1913 XYNOW(2) = XYORG(2) - SZTIC EM1913 CALL DRAW(IGCB,XYNOW(I),XYNOW(J)) EM1913 C EM1913 C EM1913 C PREPARE FOR NEXT OUTPUTTING HERE SO CAN BYPASS CHECK ENSURING THAT EM1913 C WE ARE ON BEGINNING OF AXIS. EM1913 C EM1913 XYNOW = XYNOW + TSPACE EM1913 GO TO 7 EM1913 C EM1913 C C******GRIDS WITH GRIDLINES AND POSSIBLY MINOR TICS EM1913 C EM1913 C PREPARE TO OUTPUT A GRID. IF ALL GRID LINES EM1913 C ARE MAJOR, WE NEVER CHANGE LINESTYLE AND LCHNG=FALSE. EM1913 C EM1913 101 LCHNG = .FALSE. EM1913 IF (TNUMB.EQ.1.) GO TO 105 EM1913 C EM1913 C EM1913 C IF MINOR TICS EXIST BUT ARE REALLY GRID LINES, SET UP LINESTYLE EM1913 C AND LNCHNG=TRUE. EM1913 C EM1913 IF (TICSZ.EQ.0.) GO TO 104 EM1913 C EM1913 C EM1913 C NOW MINOR TICS EXIST AND ARE NOT GRID LINES, SO CHECK TO SEE THAT EM1913 C THEY WILL BE SEEN AND DELETE IF NOT. EM1913 C EM1913 IF ((XYNOW(2)+SZMIN).LT.BTTOM) GO TO 102 EM1913 IF ((XYNOW(2)-SZMIN).GT.TOP) GO TO 102 EM1913 GO TO 105 EM1913 C EM1913 102 TSPACE = TSPACE * TNUMB EM1913 TNUMB = 1. EM1913 GO TO 105 EM1913 C EM1913 104 LCHNG = .TRUE. EM1913 CALL LINE(IGCB,1) EM1913 C EM1913 C EM1913 C NEXT, SEE THAT WE'RE NOT OFF THE AXIS. IF WE ARE 'IN BACK OF' THE EM1913 C VISIBLE AXIS BECAUSE THE AXIS IS CLIPPED, KEEP MOVING UNTIL WE'RE ON, EM1913 C KEEPING TRACK OF MAJOR/MINOR COUNT. IF WE ARE OFF THE END, EM1913 C RETURN BECAUSE WE ARE FINISHED. EM1913 C EM1913 105 XYNOW = XYNOW+ TSPACE EM1913 IF (DIR*XYNOW.GE.DABEG) GO TO 107 EM2013 ITICS = ITICS + 1 EM1913 IF (ITICS.EQ.TNUMB) ITICS = 0 EM1913 GO TO 105 EM1913 107 IF (DIR*XYNOW.GT.DAEND) GO TO 999 EM2013 C EM1913 C EM1913 C INCREMENT GRID COUNT AND SEE IF MAJOR GRID. EM1913 C EM1913 ITICS = ITICS + 1 EM1913 IF (ITICS.NE.TNUMB) GO TO 110 EM1913 C EM1913 C EM1913 C OUTPUT A MAJOR GRID LINE EM1913 C EM1913 IF (LCHNG) CALL LINE(IGCB,0) EM1913 ITICS = 0 EM1913 XYNOW(2) = BTTOM EM1913 CALL MOVE(IGCB,XYNOW(I),XYNOW(J)) EM1913 XYNOW(2) = TOP EM1913 CALL DRAW(IGCB,XYNOW(I),XYNOW(J)) EM1913 IF (LCHNG) CALL LINE(IGCB,1) EM1913 XYNOW = XYNOW + TSPACE EM1913 GO TO 107 EM1913 C EM1913 C EM1913 C DECIDE BETWEEN A MINOR TIC OR MINOR GRIDLINE EM1913 C EM1913 110 IF (LCHNG) GO TO 120 EM1913 C EM1913 C WE WANT ACTUAL TICS FOR MINOR MARKS EM1913 C EM1913 XYNOW(2) = XYORG(2) + SZMIN EM1913 CALL MOVE(IGCB,XYNOW(I),XYNOW(J)) EM1913 XYNOW(2) = XYORG(2) - SZMIN EM1913 CALL DRAW(IGCB,XYNOW(I),XYNOW(J)) EM1913 XYNOW = XYNOW + TSPACE EM1913 GO TO 107 EM1913 C C C WE WANT GRID LINES IN LINESTYLE = 1 FOR MINOR MARKS EM1913 C EM1913 120 XYNOW(2) = BTTOM EM1913 CALL MOVE(IGCB,XYNOW(I),XYNOW(J)) EM1913 XYNOW(2) = TOP EM1913 CALL DRAW(IGCB,XYNOW(I),XYNOW(J)) EM1913 XYNOW = XYNOW + TSPACE EM1913 GO TO 107 EM1913 C EM1913 C EM1913 C PUT LINE BACK THE WAY WE FOUND IT EM1913 C EM1913 999 IF (LCHNG) CALL LINE(IGCB,0) EM1913 C EM1913 1000 RETURN EM1913 END EM1913 END$ EM1913