C C C +-----------------------------------------------------------------+ C | | C | Copyright (C) 1986 by UCAR | C | University Corporation for Atmospheric Research | C | All Rights Reserved | C | | C | NCARGRAPHICS Version 1.00 | C | | C +-----------------------------------------------------------------+ C C FUNCTION CFUX (RX) C C Given an x coordinate RX in the fractional system, CFUX(RX) is an x C coordinate in the user system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=1 IF (MI.GE.3) I=2 CFUX=WD(I)+(RX-VP(1))/(VP(2)-VP(1))*(WD(3-I)-WD(I)) IF (LL.GE.3) CFUX=10.**CFUX RETURN END FUNCTION CFUY (RY) C C Given a y coordinate RY in the fractional system, CFUY(RY) is a y C coordinate in the user system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 CFUY=WD(I)+(RY-VP(3))/(VP(4)-VP(3))*(WD(7-I)-WD(I)) IF (LL.EQ.2.OR.LL.GE.4) CFUY=10.**CFUY RETURN END FUNCTION CMFX (IX) C C Given an x coordinate IX in the metacode system, CMFX(IX) is an x C coordinate in the fractional system. C CMFX=FLOAT(IX)/32767. RETURN END FUNCTION CMFY (IY) C C Given a y coordinate IY in the metacode system, CMFY(IY) is a y C coordinate in the fractional system. C CMFY=FLOAT(IY)/32767. RETURN END FUNCTION CMUX (IX) C C Given an x coordinate IX in the metacode system, CMUX(IX) is an x C coordinate in the user system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=1 IF (MI.GE.3) I=2 CMUX=WD(I)+(FLOAT(IX)/32767.-VP(1))/(VP(2)-VP(1))*(WD(3-I)-WD(I)) IF (LL.GE.3) CMUX=10.**CMUX RETURN END FUNCTION CMUY (IY) C C Given a y coordinate IY in the metacode system, CMUY(IY) is a y C coordinate in the user system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 CMUY=WD(I)+(FLOAT(IY)/32767.-VP(3))/(VP(4)-VP(3))*(WD(7-I)-WD(I)) IF (LL.EQ.2.OR.LL.GE.4) CMUY=10.**CMUY RETURN END FUNCTION CPFX (IX) C C Given an x coordinate IX in the plotter system, CPFX(IX) is an x C coordinate in the fractional system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) CPFX=FLOAT(IX-1)/(2.**MX-1.) RETURN END FUNCTION CPFY (IY) C C Given a y coordinate IY in the plotter system, CPFY(IY) is a y C coordinate in the fractional system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) CPFY=FLOAT(IY-1)/(2.**MY-1.) RETURN END FUNCTION CPUX (IX) C C Given an x coordinate IX in the plotter system, CPUX(IX) is an x C coordinate in the user system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=1 IF (MI.GE.3) I=2 CPUX=WD(I)+(FLOAT(IX-1)/(2.**MX-1.)-VP(1))/(VP(2)-VP(1))* + (WD(3-I)-WD(I)) IF (LL.GE.3) CPUX=10.**CPUX RETURN END FUNCTION CPUY (IY) C C Given a y coordinate IY in the plotter system, CPUY(IY) is a y C coordinate in the user system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 CPUY=WD(I)+(FLOAT(IY-1)/(2.**MY-1.)-VP(3))/(VP(4)-VP(3))* + (WD(7-I)-WD(I)) IF (LL.EQ.2.OR.LL.GE.4) CPUY=10.**CPUY RETURN END FUNCTION CUFX (RX) C C Given an x coordinate RX in the user system, CUFX(RX) is an x C coordinate in the fractional system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=1 IF (MI.GE.3) I=2 IF (LL.LE.2) THEN CUFX=(RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1) ELSE CUFX=(ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1) ENDIF RETURN END FUNCTION CUFY (RY) C C Given a y coordinate RY in the user system, CUFY(RY) is a y C coordinate in the fractional system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 IF (LL.LE.1.OR.LL.EQ.3) THEN CUFY=(RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3) ELSE CUFY=(ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3) ENDIF RETURN END FUNCTION KFMX (RX) C C Given an x coordinate RX in the fractional system, KFMX(RX) is an x C coordinate in the metacode system. C KFMX=IFIX(RX*32767.) RETURN END FUNCTION KFMY (RY) C C Given a y coordinate RY in the fractional system, KFMY(RY) is a y C coordinate in the metacode system. C KFMY=IFIX(RY*32767.) RETURN END FUNCTION KFPX (RX) C C Given an x coordinate RX in the fractional system, KFPX(RX) is an x C coordinate in the plotter system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) KFPX=1+IFIX(RX*(2.**MX-1.)) RETURN END FUNCTION KFPY (RY) C C Given a y coordinate RY in the fractional system, KFPY(RY) is a y C coordinate in the plotter system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) KFPY=1+IFIX(RY*(2.**MX-1.)) RETURN END FUNCTION KMPX (IX) C C Given an x coordinate IX in the metacode system, KMPX(IX) is an x C coordinate in the plotter system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) KMPX=1+IFIX((2.**MX-1.)*FLOAT(IX)/32767.) RETURN END FUNCTION KMPY (IY) C C Given a y coordinate IY in the metacode system, KMPY(IY) is a y C coordinate in the plotter system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) KMPY=1+IFIX((2.**MY-1.)*FLOAT(IY)/32767.) RETURN END FUNCTION KPMX (IX) C C Given an x coordinate IX in the plotter system, KPMX(IX) is an x C coordinate in the metacode system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) KPMX=IFIX(32767.*FLOAT(IX-1)/(2.**MX-1.)) RETURN END FUNCTION KPMY (IY) C C Given a y coordinate IY in the plotter system, KPMY(IY) is a y C coordinate in the metacode system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) KPMY=IFIX(32767.*FLOAT(IY-1)/(2.**MY-1.)) RETURN END FUNCTION KUMX (RX) C C Given an x coordinate RX in the user system, KUMX(RX) is an x C coordinate in the metacode system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=1 IF (MI.GE.3) I=2 IF (LL.LE.2) THEN KUMX=IFIX(((RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))* + 32767.) ELSE KUMX=IFIX(((ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+ + VP(1))*32767.) ENDIF RETURN END FUNCTION KUMY (RY) C C Given a y coordinate RY in the user system, KUMY(RY) is a y C coordinate in the metacode system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 IF (LL.LE.1.OR.LL.EQ.3) THEN KUMY=IFIX(((RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))* + 32767.) ELSE KUMY=IFIX(((ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+ + VP(3))*32767.) ENDIF RETURN END FUNCTION KUPX (RX) C C Given an x coordinate RX in the user system, KUPX(RX) is an x C coordinate in the plotter system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=1 IF (MI.GE.3) I=2 IF (LL.LE.2) THEN KUPX=1+IFIX(((RX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))* + (2.**MX-1.)) ELSE KUPX=1+IFIX(((ALOG10(RX)-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+ + VP(1))*(2.**MX-1.)) ENDIF RETURN END FUNCTION KUPY (RY) C C Given a y coordinate RY in the user system, KUPY(RY) is a y C coordinate in the plotter system. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) DIMENSION WD(4),VP(4) CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 IF (LL.LE.1.OR.LL.EQ.3) THEN KUPY=1+IFIX(((RY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))* + (2.**MY-1.)) ELSE KUPY=1+IFIX(((ALOG10(RY)-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+ + VP(3))*(2.**MY-1.)) ENDIF RETURN END SUBROUTINE CLSGKS C C IU(6), in IUTLCM, is the current metacode unit number. C COMMON /IUTLCM/ IU(100) C C Deactivate the metacode workstation, close the workstation, and C close GKS. C CALL GDAWK (IU(6)) CALL GCLWK (IU(6)) CALL GCLKS C RETURN C END SUBROUTINE CURVE (PX,PY,NP) C DIMENSION PX(NP),PY(NP) C C CURVE draws the curve defined by the points (PX(I),PY(I)), for I = 1 C to NP. All coordinates are stated in the user coordinate system. C C Define arrays to hold converted point coordinates when it becomes C necessary to draw the curve piecewise. C DIMENSION QX(10),QY(10) C C If NP is less than or equal to zero, there's nothing to do. C IF (NP.LE.0) RETURN C C If NP is exactly equal to 1, just draw a point. C IF (NP.EQ.1) THEN CALL POINT (PX(1),PY(1)) C C Otherwise, draw the curve. C ELSE C C Flush the pen-move buffer. C CALL PLOTIF (0.,0.,2) C C Save the current SET parameters. C CALL GETSET (F1,F2,F3,F4,F5,F6,F7,F8,LL) C C If the mapping defined by the last SET call was non-reversed and C linear in both x and y, a single polyline will suffice. C IF (F5.LT.F6.AND.F7.LT.F8.AND.LL.EQ.1) THEN CALL GPL (NP,PX,PY) C C Otherwise, piece the line together out of smaller chunks, converting C the coordinates for each chunk as directed by the last SET call. C ELSE DO 102 IP=1,NP,9 NQ=MIN0(10,NP-IP+1) IF (NQ.GE.2) THEN DO 101 IQ=1,NQ QX(IQ)=CUFX(PX(IP+IQ-1)) QY(IQ)=CUFY(PY(IP+IQ-1)) 101 CONTINUE CALL SET (F1,F2,F3,F4,F1,F2,F3,F4,1) CALL GPL (NQ,QX,QY) CALL SET (F1,F2,F3,F4,F5,F6,F7,F8,LL) END IF 102 CONTINUE END IF C C Update the pen position. C CALL FRSTPT (PX(NP),PY(NP)) C END IF C C Done. C RETURN C END SUBROUTINE FL2INT (PX,PY,IX,IY) C C Given the user coordinates PX and PY of a point, FL2INT returns the C metacode coordinates IX and IY of that point. C C Declare the common block containing the user state variables LL, MI, C MX, and MY. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) C C Declare arrays in which to retrieve the variables defining the current C window and viewport. C DIMENSION WD(4),VP(4) C C Get the variables defining the current window and viewport. C CALL GQCNTN (IE,NT) CALL GQNT (NT,IE,WD,VP) C C Compute IX. C I=1 IF (MI.GE.3) I=2 IF (LL.LE.2) THEN IX=IFIX(((PX-WD(I))/(WD(3-I)-WD(I))*(VP(2)-VP(1))+VP(1))*32767.) ELSE IX=IFIX(((ALOG10(PX)-WD(I))/(WD(3-I)-WD(I))* + (VP(2)-VP(1))+VP(1))*32767.) ENDIF C C Compute IY. C I=3 IF (MI.EQ.2.OR.MI.GE.4) I=4 IF (LL.LE.1.OR.LL.EQ.3) THEN IY=IFIX(((PY-WD(I))/(WD(7-I)-WD(I))*(VP(4)-VP(3))+VP(3))*32767.) ELSE IY=IFIX(((ALOG10(PY)-WD(I))/(WD(7-I)-WD(I))* + (VP(4)-VP(3))+VP(3))*32767.) ENDIF C C Done. C RETURN C END C C +NOAO - name conflict C C SUBROUTINE FLUSH subroutine mcflsh C C - NOAO C C FLUSH currently does nothing except flush the pen-move buffer. C CALL PLOTIF (0.,0.,2) C C Done. C RETURN C END SUBROUTINE FRAME C C FRAME is intended to advance to a new frame. The GKS version clears C all open workstations. C C First, flush the pen-move buffer. C CALL PLOTIF (0.,0.,2) C C +NOAO - Initialize utilbd 'first' flag for next plot call initut C C - NOAO C Get the number of open workstations. If there are none, we're done. C CALL GQOPWK (0,IE,NO,ID) IF (NO.EQ.0) RETURN C C Otherwise, clear the open workstations. C DO 101 I=1,NO CALL GQOPWK (I,IE,NO,ID) CALL GCLRWK (ID,1) 101 CONTINUE C C Done. C RETURN C END SUBROUTINE FRSTPT (PX,PY) C C Given the user coordinates PX and PY of a point, FRSTPT generates a C pen-up move to that point. C CALL PLOTIF (CUFX(PX),CUFY(PY),0) C C Done. C RETURN C END SUBROUTINE GETSET (VL,VR,VB,VT,WL,WR,WB,WT,LF) C C GETSET returns to its caller the current values of the parameters C defining the mapping from the user system to the fractional system C (in GKS terminology, the mapping from world coordinates to normalized C device coordinates). C C VL, VR, VB, and VT define the viewport (in the fractional system), WL, C WR, WB, and WT the window (in the user system), and LF the nature of C the mapping, according to the following table: C C 1 - x linear, y linear C 2 - x linear, y logarithmic C 3 - x logarithmic, y linear C 4 - x logarithmic, y logarithmic C C Declare the common block containing the linear-log and mirror-imaging C flags. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) C C Define variables to receive the GKS viewport and window. C DIMENSION VP(4),WD(4) C C Retrieve the number of the current GKS normalization transformation. C CALL GQCNTN (IE,NT) C C Retrieve the definition of that normalization transformation. C CALL GQNT (NT,IE,WD,VP) C C Pass the viewport definition to the caller. C VL=VP(1) VR=VP(2) VB=VP(3) VT=VP(4) C C Pass the linear/log flag and a (possibly modified) window definition C to the caller. C LF=LL C IF (LL.EQ.1.OR.LL.EQ.2) THEN WL=WD(1) WR=WD(2) ELSE WL=10.**WD(1) WR=10.**WD(2) END IF C IF (MI.GE.3) THEN WW=WL WL=WR WR=WW END IF C IF (LL.EQ.1.OR.LL.EQ.3) THEN WB=WD(3) WT=WD(4) ELSE WB=10.**WD(3) WT=10.**WD(4) END IF C IF (MI.EQ.2.OR.MI.GE.4) THEN WW=WB WB=WT WT=WW END IF C RETURN C END SUBROUTINE GETSI (IX,IY) C C Return to the user the parameters which determine the assumed size of C the target plotter and therefore determine how user coordinates are C to be mapped into plotter coordinates. C C Declare the common block containing the scaling information. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) C C Set the user variables. IX=MX IY=MY C RETURN C END SUBROUTINE GETUSV (VN,IV) CHARACTER*(*) VN C C This subroutine retrieves the current values of the utility state C variables. VN is the character name of the variable and IV is C its value. C C The labelled common block IUTLCM contains all of the utility state C variables. C COMMON /IUTLCM/IU(100) C C Check for the linear-log scaling variable. C IF (VN(1:2).EQ.'LS') THEN IV=IU(1) C C Check for the variable specifying the mirror-imaging of the axes. C ELSE IF (VN(1:2).EQ.'MI') THEN IV=IU(2) C C Check for the variable specifying the resolution of the plotter in x. C ELSE IF (VN(1:2).EQ.'XF') THEN IV=IU(3) C C Check for the variable specifying the resolution of the plotter in x. C ELSE IF (VN(1:2).EQ.'YF') THEN IV=IU(4) C C Check for the variable specifying the size of the pen-move buffer. C ELSE IF (VN(1:2).EQ.'PB') THEN IV=IU(5) C C Check for the variable specifying the metacode unit. C ELSE IF (VN(1:2).EQ.'MU') THEN IV=IU(6) C C Check for one of the variables specifying color and intensity. C ELSE IF (VN(1:2).EQ.'IR') THEN IV=IU(7) C ELSE IF (VN(1:2).EQ.'IG') THEN IV=IU(8) C ELSE IF (VN(1:2).EQ.'IB') THEN IV=IU(9) C ELSE IF (VN(1:2).EQ.'IN') THEN IV=IU(10) C C Check for the variable specifying the current color index. C ELSE IF (VN(1:2).EQ.'II') THEN IV=IU(11) C C Check for the variable specifying the maximum color index. C ELSE IF (VN(1:2).EQ.'IM') THEN IV=IU(12) C C Check for the variable specifying the line width scale factor. C ELSE IF (VN(1:2).EQ.'LW') THEN IV=IU(13) C C Check for the variable specifying the marker size scale factor. C ELSE IF (VN(1:2).EQ.'MS') THEN IV=IU(14) C C Otherwise, the variable name is unknown. C ELSE CALL SETER ('GETUSV - UNKNOWN VARIABLE NAME IN CALL',1,2) C ENDIF C RETURN C END SUBROUTINE LINE (X1,Y1,X2,Y2) C C Draw a line connecting the point (X1,Y1) to the point (X2,Y2), in the C user coordinate system. C CALL PLOTIF (CUFX(X1),CUFY(Y1),0) CALL PLOTIF (CUFX(X2),CUFY(Y2),1) RETURN END SUBROUTINE MXMY (IX,IY) C C Return to the user the coordinates of the current pen position, in the C plotter coordinate system. C C In the common block PLTCM are recorded the coordinates of the last C pen position, in the metacode coordinate system. C COMMON /PLTCM/ JX,JY C C Declare the common block containing the user state variables LL, MI, C MX, and MY. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) C C Return to the user the plotter-system equivalents of the values in C the metacode system. C IX=1+IFIX((2.**MX-1.)*FLOAT(JX)/32767.) IY=1+IFIX((2.**MY-1.)*FLOAT(JY)/32767.) C C Done. C RETURN C END C C + NOAO - Following subroutine C SUBROUTINE OPNGKS C C IU(6), in IUTLCM, is the current metacode unit number. C C COMMON /IUTLCM/ IU(100) C C Force all required BLOCKDATA's to load. C C EXTERNAL GKSBD,G01BKD,UERRBD,UTILBD C C GKS buffer size (a dummy for NCAR GKS.) C C DATA ISZ /0/ C C Open GKS, define a workstation, and activate the workstation. C C CALL GOPKS (6,ISZ) C CALL GOPWK (IU(6),2,1) C CALL GACWK (IU(6)) C C RETURN C C + NOAO C C END SUBROUTINE PLOTIF (FX,FY,IP) C C Move the pen to the point (FX,FY), in the fractional cooordinate C system. If IP is zero, do a pen-up move. If IP is one, do a pen-down C move. If IP is two, flush the buffer. C C The variable IU(5), in the labelled common block IUTLCM, specifies C the size of the pen-move buffer (between 2 and 50). C COMMON /IUTLCM/ IU(100) C C The common block VCTSEQ contains variables implementing the buffering C of pen moves. C COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25) C C In the common block PLTCM are recorded the coordinates of the last C pen position, in the metacode coordinate system, for MXMY. C COMMON /PLTCM/ JX,JY C C Force loading of the block data routine which initializes the contents C of the common blocks. C C EXTERNAL UTILBD C C VP and WD hold viewport and window parameters obtained, when needed, C from GKS. C DIMENSION VP(4),WD(4) C C + NOAO - block data utilbd has been rewritten as a run time initialization C call utilbd C C - NOAO C Check for out-of-range values of the pen parameter. C IF (IP.LT.0.OR.IP.GT.2) THEN CALL SETER ('PLOTIF - ILLEGAL VALUE FOR IPEN',1,2) END IF C C If a buffer flush is requested, jump. C IF (IP.EQ.2) GO TO 101 C C Limit the given coordinates to the legal fractional range. C GX=AMAX1(0.,AMIN1(1.,FX)) GY=AMAX1(0.,AMIN1(1.,FY)) C C Set JX and JY for a possible call to MXMY. C JX=KFMX(GX) JY=KFMY(GY) C C If the current move is a pen-down move, or if the last one was, bump C the pointer into the coordinate arrays and, if the current move is C a pen-up move, make a new entry in the array IF, which records the C positions of the pen-up moves. Note that we never get two pen-up C moves in a row, which means that IF need be dimensioned only half as C large as QX and QY. C IF (IP.NE.0.OR.IF(NF).NE.NQ) THEN NQ=NQ+1 IF (IP.EQ.0) THEN NF=NF+1 IF(NF)=NQ END IF END IF C C Save the coordinates of the point, in the fractional coordinate C system. C QX(NQ)=GX QY(NQ)=GY C C If the point-coordinate buffer is full, dump the buffers; otherwise, C return. C IF (NQ.LT.IU(5)) RETURN C C Dump the buffers. If NQ is one, there's nothing to dump. All that's C there is a single pen-up move. C 101 IF (NQ.LE.1) RETURN C C Get NT, the number of the current transformation, and, if it is not C zero, modify the current transformation so that we can use fractional C coordinates (normalized device coordinates, in GKS terms). C CALL GQCNTN (IE,NT) IF (NT.NE.0) THEN CALL GQNT (NT,IE,WD,VP) CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4)) END IF C C Dump out a series of polylines, each one defined by a pen-up move and C a series of pen-down moves. C DO 102 I=1,NF-1 CALL GPL (IF(I+1)-IF(I),QX(IF(I)),QY(IF(I))) 102 CONTINUE IF (IF(NF).NE.NQ) CALL GPL (NQ-IF(NF)+1,QX(IF(I)),QY(IF(I))) C C Put the current transformation back the way it was. C IF (NT.NE.0) THEN CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4)) END IF C C Move the last pen position to the beginning of the buffer and pretend C there was a pen-up move to that position. C QX(1)=QX(NQ) QY(1)=QY(NQ) NQ=1 IF(1)=1 NF=1 C C Done. C RETURN C END SUBROUTINE PLOTIT (IX,IY,IP) C C Move the pen to the point (IX,IY), in the metacode coordinate system. C If IP is zero, do a pen-up move. If IP is one, do a pen-down move. C If IP is two, flush the buffer. (For the sake of efficiency, the C moves are buffered; "CALL PLOTIT (0,0,0)" will also flush the buffer.) C C The variable IU(5), in the labelled common block IUTLCM, specifies C the size of the pen-move buffer (between 2 and 50). C COMMON /IUTLCM/ IU(100) C C The common block VCTSEQ contains variables implementing the buffering C of pen moves. C COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25) C C In the common block PLTCM are recorded the coordinates of the last C pen position, in the metacode coordinate system, for MXMY. C COMMON /PLTCM/ JX,JY C C Force loading of the block data routine which initializes the contents C of the common blocks. C C EXTERNAL UTILBD C C VP and WD hold viewport and window parameters obtained, when needed, C from GKS. C DIMENSION VP(4),WD(4) C C + NOAO - Blockdata utilbd has been rewritten as a run time initialization C call utilbd C C - NOAO C Check for out-of-range values of the pen parameter. C IF (IP.LT.0.OR.IP.GT.2) THEN CALL SETER ('PLOTIT - ILLEGAL VALUE FOR IPEN',1,2) END IF C C If a buffer flush is requested, jump. C IF (IP.EQ.2) GO TO 101 C C Limit the given coordinates to the legal metacode range. C JX=MAX0(0,MIN0(32767,IX)) JY=MAX0(0,MIN0(32767,IY)) C C If the current move is a pen-down move, or if the last one was, bump C the pointer into the coordinate arrays and, if the current move is C a pen-up move, make a new entry in the array IF, which records the C positions of the pen-up moves. Note that we never get two pen-up C moves in a row, which means that IF need be dimensioned only half as C large as QX and QY. C IF (IP.NE.0.OR.IF(NF).NE.NQ) THEN NQ=NQ+1 IF (IP.EQ.0) THEN NF=NF+1 IF(NF)=NQ END IF END IF C C Save the coordinates of the point, in the fractional coordinate C system. C QX(NQ)=FLOAT(JX)/32767. QY(NQ)=FLOAT(JY)/32767. C C If all three arguments were zero, or if the point-coordinate buffer C is full, dump the buffers; otherwise, return. C IF (IX.EQ.0.AND.IY.EQ.0.AND.IP.EQ.0) GO TO 101 IF (NQ.LT.IU(5)) RETURN C C Dump the buffers. If NQ is one, there's nothing to dump. All that's C there is a single pen-up move. C 101 IF (NQ.LE.1) RETURN C C Get NT, the number of the current transformation, and, if it is not C zero, modify the current transformation so that we can use fractional C coordinates (normalized device coordinates, in GKS terms). C CALL GQCNTN (IE,NT) IF (NT.NE.0) THEN CALL GQNT (NT,IE,WD,VP) CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4)) END IF C C Dump out a series of polylines, each one defined by a pen-up move and C a series of pen-down moves. C DO 102 I=1,NF-1 CALL GPL (IF(I+1)-IF(I),QX(IF(I)),QY(IF(I))) 102 CONTINUE IF (IF(NF).NE.NQ) CALL GPL (NQ-IF(NF)+1,QX(IF(I)),QY(IF(I))) C C Put the current transformation back the way it was. C IF (NT.NE.0) THEN CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4)) END IF C C Move the last pen position to the beginning of the buffer and pretend C there was a pen-up move to that position. C QX(1)=QX(NQ) QY(1)=QY(NQ) NQ=1 IF(1)=1 NF=1 C C Done. C RETURN C END SUBROUTINE POINT (PX,PY) C C Draws a point at (PX,PY), defined in the user coordinate system. C CALL PLOTIF (CUFX(PX),CUFY(PY),0) CALL PLOTIF (CUFX(PX),CUFY(PY),1) RETURN END SUBROUTINE POINTS (PX,PY,NP,IC,IL) DIMENSION PX(NP),PY(NP) C C Marks the points at positions in the user coordinate system defined C by ((PX(I),PY(I)),I=1,NP). If IC is zero, each point is marked with C a simple point. If IC is positive, each point is marked with the C single character defined by the FORTRAN-77 function CHAR(IC). If IC C is negative, each point is marked with a GKS polymarker of type -IC. C If IL is non-zero, a curve is also drawn, connecting the points. C C Define arrays to hold converted point coordinates when it becomes C necessary to mark the points a few at a time. C DIMENSION QX(10),QY(10) C C Define an array to hold the aspect source flags which may need to be C retrieved from GKS. C DIMENSION LA(13) CHARACTER*1 CHRTMP C C If the number of points is zero or negative, there's nothing to do. C IF (NP.LE.0) RETURN C C Otherwise, flush the pen-move buffer. C CALL PLOTIF (0.,0.,2) C C Retrieve the parameters from the last SET call. C CALL GETSET (F1,F2,F3,F4,F5,F6,F7,F8,LL) C C If a linear-linear, non-mirror-imaged, mapping is being done and the C GKS polymarkers can be used, all the points can be marked with a C single polymarker call and joined, if requested, by a single polyline C call. C IF (F5.LT.F6.AND.F7.LT.F8.AND.LL.EQ.1.AND.IC.LE.0) THEN CALL GQASF (IE,LA) IF (LA(4).EQ.0) THEN CALL GQPMI (IE,IN) CALL GSPMI (MAX0(-IC,1)) CALL GPM (NP,PX,PY) CALL GSPMI (IN) ELSE CALL GQMK (IE,IN) CALL GSMK (MAX0(-IC,1)) CALL GPM (NP,PX,PY) CALL GSMK (IN) END IF IF (IL.NE.0.AND.NP.GE.2) CALL GPL (NP,PX,PY) C C Otherwise, things get complicated. We have to do batches of nine C points at a time. (Actually, we convert ten coordinates at a time, C so that the curve joining the points, if any, won't have gaps in it.) C ELSE C C Initially, we have to reset either the polymarker index or the text C alignment, depending on how we're marking the points. C IF (IC.LE.0) THEN CALL GQASF (IE,LA) IF (LA(4).EQ.0) THEN CALL GQPMI (IE,IN) CALL GSPMI (MAX0(-IC,1)) ELSE CALL GQMK (IE,IN) CALL GSMK (MAX0(-IC,1)) END IF ELSE CALL GQTXAL (IE,IH,IV) CALL GSTXAL (2,3) END IF C C Loop through the points by nines. C DO 104 IP=1,NP,9 C C Fill the little point coordinate arrays with up to ten values, C converting them from the user system to the fractional system. C NQ=MIN0(10,NP-IP+1) MQ=MIN0(9,NQ) DO 102 IQ=1,NQ QX(IQ)=CUFX(PX(IP+IQ-1)) QY(IQ)=CUFY(PY(IP+IQ-1)) 102 CONTINUE C C Change the SET call to allow the use of fractional coordinates. C CALL SET (F1,F2,F3,F4,F1,F2,F3,F4,1) C C Crank out either a polymarker or a set of characters. C IF (IC.LE.0) THEN CALL GPM (MQ,QX,QY) ELSE DO 103 IQ=1,MQ CHRTMP = CHAR(IC) CALL GTX (QX(IQ),QY(IQ),CHRTMP) 103 CONTINUE END IF IF (IL.NE.0.AND.NQ.GE.2) CALL GPL (NQ,QX,QY) C C Put the SET parameters back the way they were. C CALL SET (F1,F2,F3,F4,F5,F6,F7,F8,LL) C 104 CONTINUE C C Finally, we put either the polymarker index or the text alignment C back the way it was. C IF (IC.LE.0) THEN IF (LA(4).EQ.0) THEN CALL GSPMI (IN) ELSE CALL GSMK (IN) END IF ELSE CALL GSTXAL (IH,IV) END IF C END IF C C Update the pen position. C CALL FRSTPT (PX(NP),PY(NP)) C C Done. C RETURN C END SUBROUTINE PWRIT (PX,PY,CH,NC,IS,IO,IC) CHARACTER*(*) CH C C PWRIT is called to draw a character string in a specified position. C It is just like WTSTR, but has one extra argument. NC is the number C of characters to be written from the string CH. C CALL WTSTR (PX,PY,CH(1:NC),IS,IO,IC) C C Done. C RETURN C END SUBROUTINE SET (VL,VR,VB,VT,WL,WR,WB,WT,LF) C C SET allows the user to change the current values of the parameters C defining the mapping from the user system to the fractional system C (in GKS terminology, the mapping from world coordinates to normalized C device coordinates). C C VL, VR, VB, and VT define the viewport (in the fractional system), WL, C WR, WB, and WT the window (in the user system), and LF the nature of C the mapping, according to the following table: C C 1 - x linear, y linear C 2 - x linear, y logarithmic C 3 - x logarithmic, y linear C 4 - x logarithmic, y logarithmic C C Declare the common block containing the linear-log and mirror-imaging C flags. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) C C Flush the pen-move buffer. C CALL PLOTIF (0.,0.,2) C C Set the GKS viewport for transformation 1. C CALL GSVP (1,VL,VR,VB,VT) C C Set the utility state variable controlling linear-log mapping. C LL=MAX0(1,MIN0(4,LF)) C C Set the GKS window for transformation 1. C IF (WL.LT.WR) THEN MI=1 QL=WL QR=WR ELSE MI=3 QL=WR QR=WL END IF C IF (WB.LT.WT) THEN QB=WB QT=WT ELSE MI=MI+1 QB=WT QT=WB END IF C IF (LL.EQ.1) THEN CALL GSWN (1,QL,QR,QB,QT) ELSE IF (LL.EQ.2) THEN CALL GSWN (1,QL,QR,ALOG10(QB),ALOG10(QT)) ELSE IF (LL.EQ.3) THEN CALL GSWN (1,ALOG10(QL),ALOG10(QR),QB,QT) ELSE CALL GSWN (1,ALOG10(QL),ALOG10(QR),ALOG10(QB),ALOG10(QT)) END IF C C Select transformation 1 as the current one. C CALL GSELNT (1) C RETURN C END SUBROUTINE SETI (IX,IY) C C Allows the user to set the parameters which determine the assumed size C of the target plotter and therefore determine how user coordinates are C to be mapped into plotter coordinates. C C Declare the common block containing the scaling information. C COMMON /IUTLCM/ LL,MI,MX,MY,IU(96) C C Transfer the user's values into the common block. C MX=MAX0(1,MIN0(15,IX)) MY=MAX0(1,MIN0(15,IY)) C RETURN C END SUBROUTINE SETUSV (VN,IV) CHARACTER*(*) VN C C This subroutine sets the values of various utility state variables. C VN is the name of the variable and IV is its value. C C The labelled common block IUTLCM contains all of the utility state C variables. C COMMON /IUTLCM/ IU(100) C C Define an array in which to get the GKS aspect source flags. C DIMENSION LF(13) C C Check for the linear-log scaling variable, which can take on these C values: C C 1 = X linear, Y linear C 2 = X linear, Y log C 3 = X log , Y linear C 4 = X log , Y log C IF (VN(1:2).EQ.'LS') THEN IF (IV.LT.1.OR.IV.GT.4) THEN CALL SETER ('SETUSV - LOG SCALE VALUE OUT OF RANGE',2,2) END IF IU(1)=IV C C Check for the mirror-imaging variable, which can take on these C values: C C 1 = X normal , Y normal C 2 = X normal , Y reversed C 3 = X reversed, Y normal C 4 = X reversed, Y reversed C ELSE IF (VN(1:2).EQ.'MI') THEN IF (IV.LT.1.OR.IV.GT.4) THEN CALL SETER ('SETUSV - MIRROR-IMAGING VALUE OUT OF RANGE',3,2) END IF IU(2)=IV C C Check for the scale factor setting the resolution of the plotter in C the x direction. C ELSE IF (VN(1:2).EQ.'XF') THEN IF (IV.LT.1.OR.IV.GT.15) THEN CALL SETER ('SETUSV - X RESOLUTION OUT OF RANGE',4,2) END IF IU(3)=IV C C Check for the scale factor setting the resolution of the plotter in C the y direction. C ELSE IF (VN(1:2).EQ.'YF') THEN IF (IV.LT.1.OR.IV.GT.15) THEN CALL SETER ('SETUSV - Y RESOLUTION OUT OF RANGE',5,2) END IF IU(4)=IV C C Check for the variable specifying the size of the pen-move buffer. C ELSE IF (VN(1:2).EQ.'PB') THEN IF (IV.LT.2.OR.IV.GT.50) THEN CALL SETER ('SETUSV - PEN-MOVE BUFFER SIZE OUT OF RANGE',6,2) END IF CALL PLOTIF (0.,0.,2) IU(5)=IV C C Check for a metacode unit number. C ELSE IF (VN(1:2).EQ.'MU') THEN IF (IV.LE.0) THEN CALL SETER ('SETUSV - METACODE UNIT NUMBER ILLEGAL',7,2) END IF C C For the moment (1/11/85), we have to deactivate and close the old C workstation and open and activate a new one. This does allow the C user to break up his metacode output. It does not necessarily allow C for the resumption of output to a previously-written metacode file. C CALL GDAWK (IU(6)) CALL GCLWK (IU(6)) IU(6)=IV CALL GOPWK (IU(6),2,1) CALL GACWK (IU(6)) C C If, in the future, it becomes possible to have more than one metacode C workstation open at once, the following code can be used instead. C C CALL GDAWK (IU(6)) C IU(6)=IV C CALL GQOPWK (0,IE,NO,ID) C IF (NO.NE.0) THEN C DO 101 I=1,NO C CALL GQOPWK (I,IE,NO,ID) C IF (ID.EQ.IU(6)) GO TO 102 C 101 CONTINUE C END IF C CALL GOPWK (IU(6),2,1) C 102 CALL GAWK (IU(6)) C C Check for one of the variables setting color and intensity. C ELSE IF (VN(1:2).EQ.'IR') THEN IF (IV.LT.0) THEN CALL SETER ('SETUSV - ILLEGAL VALUE OF RED INTENSITY',8,2) END IF IU(7)=IV C ELSE IF (VN(1:2).EQ.'IG') THEN IF (IV.LT.0) THEN CALL SETER ('SETUSV - ILLEGAL VALUE OF GREEN INTENSITY',9,2) END IF IU(8)=IV C ELSE IF (VN(1:2).EQ.'IB') THEN IF (IV.LT.0) THEN CALL SETER ('SETUSV - ILLEGAL VALUE OF BLUE INTENSITY',10,2) END IF IU(9)=IV C ELSE IF (VN(1:2).EQ.'IN') THEN IF (IV.LT.0.OR.IV.GT.10000) THEN CALL SETER ('SETUSV - ILLEGAL VALUE OF INTENSITY',11,2) END IF IU(10)=IV C C Assign the intensity-controlling variables to local variables with C simple, meaningful names. C IR=IU(7) IG=IU(8) IB=IU(9) IN=IU(10) II=IU(11) IM=IU(12) C C Compute the floating-point red, green, and blue intensities. C FR=FLOAT(IR)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000. FG=FLOAT(IG)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000. FB=FLOAT(IB)/FLOAT(MAX0(IR,IG,IB,1))*FLOAT(IN)/10000. C C Dump the pen-move buffer before changing anything. C CALL PLOTIF (0.,0.,2) C C Set the aspect source flags for all the color indices to "individual". C CALL GQASF (IE,LF) LF( 3)=1 LF( 6)=1 LF(10)=1 LF(13)=1 CALL GSASF (LF) C C Pick a new color index and use it for polylines, polymarkers, text, C and areas. C II=MOD(II,IM)+1 IU(11)=II CALL GSPLCI (II) CALL GSPMCI (II) CALL GSTXCI (II) CALL GSFACI (II) C C Now, redefine the color for that color index on each open workstation. C CALL GQOPWK (0,IE,NO,ID) C DO 103 I=1,NO CALL GQOPWK (I,IE,NO,ID) CALL GSCR (ID,II,FR,FG,FB) 103 CONTINUE C C Check for variable resetting the color index. C ELSE IF (VN(1:2).EQ.'II') THEN IF (IV.LT.1.OR.IV.GT.IU(12)) THEN CALL SETER ('SETUSV - ILLEGAL COLOR INDEX',12,2) END IF IU(11)=IV C CALL PLOTIF (0.,0.,2) C CALL GQASF (IE,LF) LF( 3)=1 LF( 6)=1 LF(10)=1 LF(13)=1 CALL GSASF (LF) C CALL GSPLCI (IV) CALL GSPMCI (IV) CALL GSTXCI (IV) CALL GSFACI (IV) C C Check for the variable limiting the values of color index used. C ELSE IF (VN(1:2).EQ.'IM') THEN IF (IV.LT.1) THEN CALL SETER ('SETUSV - ILLEGAL MAXIMUM COLOR INDEX',13,2) END IF IU(12)=IV C C Check for the variable setting the current line width scale factor. C ELSE IF (VN(1:2).EQ.'LW') THEN IF (IV.LT.0) THEN CALL SETER ('SETUSV - ILLEGAL LINE WIDTH SCALE FACTOR',14,2) END IF IU(13)=IV C C Dump the pen-move buffer before changing anything. C CALL PLOTIF (0.,0.,2) C C Set the aspect source flag for linewidth scale factor to "individual". C CALL GQASF (IE,LF) LF(2)=1 CALL GSASF (LF) C C Redefine the line width scale factor. C CALL GSLWSC (FLOAT(IV)/1000.) C C Check for the variable setting the current marker size scale factor. C ELSE IF (VN(1:2).EQ.'MS') THEN IF (IV.LT.0) THEN CALL SETER ('SETUSV - ILLEGAL MARKER SIZE SCALE FACTOR',15,2) END IF IU(14)=IV C C Set aspect source flag for marker size scale factor to "individual". C CALL GQASF (IE,LF) LF(5)=1 CALL GSASF (LF) C C Redefine the marker size scale factor. C CALL GSMKSC (FLOAT(IV)/1000.) C C Otherwise, the variable name is unknown. C ELSE CALL SETER ('SETUSV - UNKNOWN VARIABLE NAME IN CALL',1,2) C ENDIF RETURN END SUBROUTINE VECTOR (PX,PY) C C Draw a vector (line segment) from the current pen position to the new C pen position (PX,PY), in the user coordinate system, and then make C (PX,PY) the current pen position. C CALL PLOTIF (CUFX(PX),CUFY(PY),1) RETURN END SUBROUTINE WTSTR (PX,PY,CH,IS,IO,IC) C C WTSTR is called to draw a character string in a specified position. C C PX and PY specify, in user coordinates, the position of a point C relative to which a character string is to be positioned. C C CH is the character string to be written. C C IS is the desired size of the characters to be used, stated as a C character width in the plotter coordinate system. The values 0, 1, C 2, and 3 mean 8, 12, 16, and 24, respectively. C C IO is the desired orientation angle, in degrees counterclockwise from C a horizontal vector pointing to the right. C C IC specifies the desired type of centering. A negative value puts C (PX,PY) in the center of the left end of the character string, a zero C puts (PX,PY) in the center of the whole string, and a positive value C puts (PX,PY) in the center of the right end of the character string. C CHARACTER*(*) CH C C Define arrays in which to save the current viewport and window. C DIMENSION VP(4),WD(4) C C Flush the pen-move buffer. C CALL PLOTIF (0.,0.,2) C C Compute the coordinates of (PX,PY) in the fractional coordinate C system (normalized device coordinates). C XN=CUFX(PX) YN=CUFY(PY) C C Save the current window and, if necessary, redefine it so that we can C use normalized device coordinates. C CALL GQCNTN (IE,NT) IF (NT.NE.0) THEN CALL GQNT (NT,IE,WD,VP) CALL GSWN (NT,VP(1),VP(2),VP(3),VP(4)) END IF C C Save current character height, text path, character up vector, and C text alignment. C CALL GQCHH (IE,OS) CALL GQTXP (IE,IP) CALL GQCHUP (IE,UX,UY) CALL GQTXAL (IE,IX,IY) C C Define the character height. (The final scale factor is derived from C the default font.) C CALL GETUSV ('YF',MY) YS=FLOAT(2**MY) IF (IS.GE.0.AND.IS.LE.3) THEN CS=FLOAT(8+4*IS+4*(IS/3))/YS ELSE CS=AMIN1(FLOAT(IS),YS)/YS ENDIF C CS=CS*25.5/27. C C + NOAO - make character size readable with IRAF font cs = cs * 2.0 C C - NOAO CALL GSCHH(CS) C C Define the text path. C CALL GSTXP (0) C C Define the character up vector. C JO=MOD(IO,360) IF (JO.EQ.0) THEN CALL GSCHUP (0.,1.) ELSE IF (JO.EQ.90) THEN CALL GSCHUP (-1.,0.) ELSE IF (JO.EQ.180) THEN CALL GSCHUP (0.,-1.) ELSE IF (JO.EQ.270) THEN CALL GSCHUP (1.,0.) ELSE IF (JO.GT.0.AND.JO.LT.180) THEN CALL GSCHUP (-1.,1./TAN(FLOAT(JO)*3.1415926/180.)) ELSE CALL GSCHUP (1.,-1./TAN(FLOAT(JO)*3.1415926/180.)) ENDIF C C Define the text alignment. C CALL GSTXAL (IC+2,3) C C Plot the characters. C CALL GTX (XN,YN,CH) C C Restore the original text attributes. C CALL GSCHH (OS) CALL GSTXP (IP) CALL GSCHUP (UX,UY) CALL GSTXAL (IX,IY) C C Restore the window definition. C IF (NT.NE.0) THEN CALL GSWN (NT,WD(1),WD(2),WD(3),WD(4)) END IF C C Update the pen position. C CALL FRSTPT (PX,PY) C C Done. C RETURN C END c + NOAO - blockdata utilbd changed to run time initialization subroutine utilbd c BLOCKDATA UTILBD C logical first C The common block IUTLCM contains integer utility variables which are C user-settable by the routine SETUSV and user-retrievable by the C routine GETUSV. C COMMON /IUTLCM/ IU(100) C C The common block VCTSEQ contains variables realizing the buffering C scheme used by PLOTIT/F for pen moves. The dimension of QX and QY must C be an even number greater than or equal to the value of IU(5). The C dimension of IF must be half that of QX and QY. C COMMON /VCTSEQ/ NQ,QX(50),QY(50),NF,IF(25) C C In the common block PLTCM are recorded the coordinates of the last C point to which a pen move was requested by a call to PLOTIT/F. C COMMON /PLTCM/ JX,JY C C IU(1) contains the log scaling parameter, which may take on the C following possible values: C C 1 = linear-linear C 2 = log-linear C 3 = linear-log C 4 = log-log C c DATA IU(1) / 1 / IU(1) = 1 C C IU(2) specifies the mirror-imaging of the x and y axes, as follows: C C 1 = x normal, y normal C 2 = x normal, y reversed C 3 = x reversed, y normal C 4 = x reversed, y reversed C c +NOAO - logical parameter first inserted to avoid clobbering initialization data first /.true./ if (.not. first) return first = .false. c -NOAO c DATA IU(2) / 1 / IU(2) = 1 C C IU(3) specifies the assumed resolution of the plotter in the x C direction. Plotter x coordinates are assumed to lie between 1 and C 2**IU(3), inclusive. C c DATA IU(3) / 10 / IU(3) = 10 C C IU(4) specifies the assumed resolution of the plotter in the y C direction. Plotter y coordinates are assumed to lie between 1 and C 2**IU(4), inclusive. C c DATA IU(4) / 10 / IU(4) = 10 C C IU(5) specifies the size of the buffers used by PLOTIT/F. Its value C must be greater than or equal to 2 and not greater than the dimension C of the variables QX and QY. Using the value 2 effectively turns off C the buffering. C c DATA IU(5) / 50 / IU(5) = 50 C C IU(6) specifies the current metacode unit, which is machine-dependent. C At NCAR, the value "1" currently (1/11/85) causes metacode to be C written on the file "GMETA". Eventually, it will cause output to be C written on unit number 1. At that point, the value, on the Cray at C least, should be changed to "4H$PLT", so that output will come out on C the old familiar dataset. C c DATA IU(6) / 1 / IU(6) = 1 C C IU(7), IU(8), IU(9), and IU(10) specify color and intensity, in the C following way (letting IR=IU(7), IG=IU(8), IB=IU(9), and IN=IU(10)): C C The red intensity is IR/(IR+IG+IB)*IN/10000. C The green intensity is IG/(IR+IG+IB)*IN/10000. C The blue intensity is IB/(IR+IG+IB)*IN/10000. C C The GKS calls to set these intensities are executed in response to a C "CALL SETUSV ('IN',IN)", using the existing values of IR, IG, and IB. C Thus, to completely determine the color and the intensity, the user C must execute four calls, as follows: C C CALL SETUSV ('IR',IR) C CALL SETUSV ('IG',IG) C CALL SETUSV ('IB',IB) C CALL SETUSV ('IN',IN) C C The default values create a white line at .8 x maximum intensity. C c DATA IU(7) / 1 / c DATA IU(8) / 1 / c DATA IU(9) / 1 / IU(7) = 1 IU(8) = 1 IU(9) = 1 C c DATA IU(10) / 8000 / IU(10) = 8000 C C IU(11) and IU(12) specify, respectively, the last color index used C and the maximum number of color indices it is permissible to use. C c DATA IU(11) / 0 / c DATA IU(12) / 1 / IU(11) = 0 IU(12) = 1 C C IU(13)/1000 specifies the current line width scale factor. C c DATA IU(13) / 1000 / IU(13) = 1000 C C IU(14)/1000 specifies the current marker size scale factor. C c DATA IU(14) / 1000 / IU(14) = 1000 C C IU(15) through IU(100) are currently undefined. C C Initialization for the routine PLOTIT/F: For values of I between 1 and C NQ, (QX(I),QY(I)) is a point to which a pen move has been requested C by a past call to PLOTIT/F. The coordinates are stated in the fractional C coordinate system. For values of I between 1 and NF, IF(I) is the C index, in QX and QY, of the coordinates of a point to which a pen-up C move was requested. NQ and NF are never allowed to be less than one. C c DATA NQ,QX(1),QY(1),NF,IF(1) / 1 , 0. , 0. , 1 , 1 / NQ = 1 QX(1) = 0. QY(1) = 0. NF = 1 IF(1) = 1 C C JX and JY are the coordinates, in the metacode system, of the last C point to which a pen move was requested by a call to PLOTIT/F. C c DATA JX,JY / 0 , 0 / JX = 0 JY = 0 C c -NOAO return c entry initut first = .true. END