SUBROUTINE PIE(Y,NPTS,IV,IP,ILEGND) C C SUBROUTINE TO GENERATE PIE CHARTS C C Y(REAL)=array containing the data for the pie segments C NPTS(INTEGER)=number of points in the array C IV(INTEGER)=array containing the number for the shading pattern C = 0 no fill C = 1 solid fill C IP(INTEGER)=array containing the pen number to use for each segment C ILEGND(BYTE)=array containing the descriptions for each segment C Current maximum number of segments = 20 C DIMENSION Y(1),IV(1),IP(1) BYTE SET(24),ILEGND(20,24) INTEGER I SUM=0.0 BANG=0.0 RADIUS=1.75 XCENTR=4.0 YCENTR=4.0 CALL PLOT(XCENTR,YCENTR,-3) DO 10 I=1,NPTS 10 SUM=SUM+Y(I) DO 20 I=1,NPTS 20 Y(I)=Y(I)*360./SUM !find the no. of equivalent degrees CALL CIRCLE(0.,0.,RADIUS) !draw a circle DO 30 I=1,NPTS IPEN=IP(I) !get the current pen number IFLTYP=IV(I) !and whether or not to fill DO 40 J=1,24 !and the description of each slice 40 SET(J)=ILEGND(I,J) !get the segment description CALL TRIM(SET) !remove trailing blanks NLEN=LEN(SET) !get the length (<= 15 characters) YPOS=Y(I) !dummy storage variable XPT=RADIUS*COS(BANG) !determine the x point on the circle YPT=RADIUS*SIN(BANG) !determine the y point on the circle IF(IFLTYP.NE.0.OR.LEN(IFLTYP).GT.0) + CALL PIEFIL(BANG,YPOS,RADIUS,IPEN) !fill the slice CALL LABEL(BANG,YPOS,RADIUS,SET,NLEN) !label the segment CALL PLOT(XPT,YPT,3) !move to the endpoint of the arc CALL PLOT(0.,0.,2) !move to the origin BANG=BANG+YPOS*0.01745329 !sum the angles (in radians) 30 CONTINUE CALL CIRCLE(0.,0.,RADIUS) !draw a circle again,just for looks CALL PLOT(-XCENTR,-YCENTR,-3) !redefine the old origin RETURN END C C ======================================================================= C SUBROUTINE LABEL(BANG,YPOS,RADIUS,SET,NLEN) C C This subroutine draws an arrow at the half way mark of each C pie segment and prints the percentage value adjacent to it. C C C BANG(REAL)=beginning angle of the pie segment in radians C YPOS(REAL)=number of degrees in the pie segment C RADIUS(REAL)=length of the radius (inches) C SET(BYTE)=array containing the description of the pie segment C NLEN(INTEGER)=number of characters in SET C DIMENSION SET(1) PI=3.14159 YV=YPOS/3.6 !convert from degrees to % FANG=BANG+YPOS*0.0174 !finish angle of the arc HANG=(BANG+FANG)/2. !half-way angle ARBEGX=(RADIUS+.2)*COS(HANG) !arrow shaft beginning points ARBEGY=(RADIUS+.2)*SIN(HANG) ARENDX=(RADIUS+.9)*COS(HANG) !arrow tail points ARENDY=(RADIUS+.9)*SIN(HANG) AHLX=(RADIUS+.4)*COS(HANG+.04) !left side of arrow head AHLY=(RADIUS+.4)*SIN(HANG+.04) AHRX=(RADIUS+.4)*COS(HANG-.04) !right side of arrow head AHRY=(RADIUS+.4)*SIN(HANG-.04) ADD=1.2 IF(HANG.GT.PI.AND.HANG.LT.2.*PI)ADD=1.4 XNUM=(RADIUS+ADD)*COS(HANG) !calculate the starting point YNUM=(RADIUS+ADD)*SIN(HANG) !for placing the number YNN=YNUM+.3 !move up for the label CALL PLOT(ARENDX,ARENDY,3) !now draw the arrow CALL PLOT(ARBEGX,ARBEGY,2) ! | CALL PLOT(AHLX,AHLY,1) ! | CALL PLOT(ARBEGX,ARBEGY,1) ! | CALL PLOT(AHRX,AHRY,1) ! V CALL NUMBER(XNUM,YNUM,-.18,YV,0.0,2) !print the value of the slice CALL SPMODE(1) !switch to relative plot mode CALL SYMBOL(0.,0.,.18,2H %,0.0,2) !print the percent sign CALL SPMODE(0) !switch back to absolute mode CALL SYMBOL(XNUM,YNN,-.18,SET,0.,NLEN) !print what it is RETURN END C C ============================================================================ C SUBROUTINE PIEFIL(BANG,YPOS,RADIUS,IPEN) C C This subroutine performs a solid fill of the pie segment C C BANG(REAL)=beginning angle of the pie segment in radians C YPOS(REAL)=number of degrees in the pie segment C RADIUS(REAL)=length of the radius (inches) C IPEN(INTEGER)=current pen number to use C PI=3.14159 RINC=0.03 !start slightly off the origin DANG=BANG*180./PI !starting angle in degrees FANGD=DANG+YPOS !finish angle in degrees FANGR=FANGD*PI/180. !finish angle in radians XI=RINC*COS(BANG) YI=RINC*SIN(BANG) CALL NEWPEN(IPEN) !change pens if wanted CALL PLOT(XI,YI,3) CALL PLOT(XI,YI,2) 10 IF(RINC.GE.RADIUS-.02)GOTO 20 CALL ARC6(RINC,DANG,YPOS) RINC=RINC+.01 !increase the radial sweep XLF=RINC*COS(FANGR) YLF=RINC*SIN(FANGR) CALL PLOT(XLF,YLF,2) !move along the line CALL ARC6(RINC,FANGD,-YPOS) RINC=RINC+.01 IF(RINC.GE.RADIUS-.02)GOTO 20 XLB=RINC*COS(BANG) YLB=RINC*SIN(BANG) CALL PLOT(XLB,YLB,1) !move along the line GOTO 10 20 CALL NEWPEN(1) !get pen #1 RETURN END