SUBROUTINE PIE2(FNME,FMT,YARR,NAMDIV,DIVST,DIVINC,NUMDIV,ISTAT) # # Take up to 25 values and put them in a PIE chart # # The first value goes in a seperate wedge, the rest are part # of a large circle. The values and their calculated # percentages of the whole are listed on the left side # of the plot. # # # called before this routine. Data is either read from a file (FNME) # or alternatively from an array (YARR). If FNME contains a zero in the # first byte, the assumption is made that the data is in YARR. # # Parameters: # # FNME Name of file containing data. 0 in byte 1 means no file. # FMT Character array containing the run time format # YARR If byte 1 of FNME is zero,or ' ', data is assumed to be in this # array. The last array element must be -999.. # NAMDIV A 25 element array containing names of the pie divisions # Each element must be 10 chars long - "BYTE NAMDIV(10,25)." # DIVST Starting value of divisions. # DIVINC The real division increment. # NUMDIV The number of divisions in the pie circle. # ISTAT On Input: # +ve Last plot of the program # -ve More plots to follow # 1 Data is raw - to be pied before plotting. # 2 Data already pied - just plot it. # # Returned status # 0 Success # -1 PIE1 was not called first FATAL. # -2 NUMDIV exceeds maximum (25) # -3 Error in Format parameter # -4 Less than 2 data divisions. # # logical pieflg,file,finit,kolor,dopie real yarr(1),limits(25) integer*4 i4 byte fmt(20),fnme(30) REAL VALUE(25), X(101), Y(101), PER(25), TOTAL BYTE NAMDIV(10,25),PBUF(16) common /pie/ pieflg,kolor,xs,ys EQUIVALENCE (X(1), X1), (Y(1), Y1), (X(2), X2), (Y(2), Y2) # # if (istat.gt.0) { finit=.true. if (istat.eq.1) dopie=.true. else dopie=.false. } else { finit=.false. if (istat.eq.1) dopie=.true. else dopie=.false. } call errset(62,.true.,,,.false.) if (.not.pieflg) { istat=-1 return } if (numdiv.gt.25) { istat=-2 return } pieflg=.false. istat=0 # if ((fnme(1).ne.0).and.(fnme(1).ne.' ')) { file=.true. open (unit=7,name=fnme,type='OLD',readonly) } limits(1)=xstart value(1)=divst do i=2,numdiv { limits(i)=limits(i-1)+divinc value(i)=0 } # # Calculate distribution of data # i=1 repeat { if (file) read(7,fmt,end=30,err=20)yval else yval=yarr(i) if (yval.eq.-999.)break if (dopie) { do j=1,numdiv { yval=yval+.0001*yval if (yval.gt.limits(j)) { if (yval.le.(limits(j)+divinc)) { value(j)=value(j)+1 break } } } } else { value(i)=yval } i=i+1 } 20 istat=-1 return # # # The coordinates of the wedge, and increment for circumference. # 30 continue XC=9. YC=7. RX=XC+1. RY=YC SCALE=6.2831853E-2 RAD=5. N=NUMDIV # # A PIE chart with only two values doesn't look good # ICT=0 % DO 50 I=1,N IF (VALUE(I).EQ.0)GOTO 50 ICT=ICT+1 50 CONTINUE IF ((N .GE. 2).OR.(ICT.GE.2))GOTO 60 ISTAT=-4 RETURN # # Total up the values and get the percentage of each # 60 TOTAL=0. % DO 140 I = 1, N 140 TOTAL = VALUE(I) + TOTAL % DO 150 I = 1, N 150 PER(I) = VALUE(I) / TOTAL * 100. ICL=2 % DO 165 KL=1,2 IF(KOLOR) CALL COLOR(ICL) # # # Get the rotation for the first element # E = PER(1)/2. * SCALE ROT = E # # Each radial line starts in the center of the circle # X1 = xc Y1 = yc IF(KL.EQ.2) CALL PLOT(X1,Y1,3) # # First radial line # X2 = RAD * COS(ROT) + xc Y2 = RAD * SIN(ROT) + yc ROTL=ROT # # Plot first line # IF(KL.EQ.2) CALL PLOT( X2, Y2, 2) SROT = 0. if((KL.EQ.1).AND.(per(1).gt.0)) CALL SYMBOL(RX+2.5,RY-.1,.2,NAMDIV(1,1),0.,10) # # For each additional segment, plot line from center to circumference # % DO 160 I = 2, N IF(PER(I).EQ.0.)GOTO 160 ROT = (PER(I) * SCALE) + ROT SROT=ROTL-.02+(ROT-ROTL)/2 ROTL=ROT XS = 2.5 * COS(SROT)+xc YS = 2.5 * SIN(SROT)+yc DEG=SROT*57.3 IF((DEG.LT.90.).OR.(DEG.GT.270.))GOTO 155 CALL STJUST(NAMDIV(1,I),10,+1) SROT = SROT+.04 XS = 4.5 * COS(SROT)+xc YS = 4.5 * SIN(SROT)+yc DEG= 180+DEG 155 IF(DEG.GT.360.)DEG=DEG-360. IF(KL.EQ.1) CALL SYMBOL(XS,YS,.2,NAMDIV(1,I),DEG,10) CALL STJUST(NAMDIV(1,I),10,-1) X2 = RAD * COS(ROT) + xc Y2 = RAD * SIN(ROT) + yc IF(KL.EQ.2) { CALL PLOT( X1,Y1,3) CALL PLOT( X2,Y2,2) } 160 CONTINUE 165 ICL=ICL-1 # # Draw in circumference # Q = X2 R = Y2 I = 0 % DO 170 W = E, ROT, SCALE I = I + 1 X2 = RAD * COS(W) + xc Y2 = RAD * SIN(W) + yc IF(I.EQ.1)CALL PLOT(X2,Y2,3) 170 CALL PLOT( X2,Y2,2) CALL PLOT( Q,R,2) # # Offset center of circle to right for seperate wedge # CALL PLOT(RX,RY,3) X2 = RAD * COS(E) + RX Y2 = RAD * SIN(E) + RY CALL PLOT( X2, Y2, 2) CALL PLOT(RX,RY,3) Q = X2 R = Y2 X2 = RAD * COS(-E) + RX Y2 = RAD * SIN(-E) + RY CALL PLOT( X2, Y2, 2) I = 0 # # Do cicumference of wedge # % DO 180 ROT = -E, E, SCALE I = I + 1 X2 = RAD * COS(ROT) + RX Y2 = RAD * SIN(ROT) + RY 180 CALL PLOT (X2,Y2,2) CALL PLOT (Q,R,2) # # # IF(KOLOR) CALL COLOR(2) YS = yc+RAD-.2 PBUF(16)='%' % DO 300 I=1,N % DO 200 J=1,10 200 PBUF(J) = NAMDIV(J,I) ENCODE(5,222,PBUF(11))PER(I) 222 FORMAT(F5.1) CALL SYMBOL(0.,YS,.2,PBUF,0.,16) 300 YS=YS-.35 IF(KOLOR)CALL COLOR(1) IF(FINIT) CALL PLOT(0.,0.,999) CLOSE (UNIT=7) RETURN # END