SUBROUTINE PIE2(FNME, FMT, YARR, NAMDIV, DIVST, DIVINC, NUMDIV, IS *TAT) C C Take up to 25 values and put them in a PIE chart C C The first value goes in a seperate wedge, the rest are part C of a large circle. The values and their calculated C percentages of the whole are listed on the left side C of the plot. C C C called before this routine. Data is either read from a file (FNME) C or alternatively from an array (YARR). If FNME contains a zero in the C first byte, the assumption is made that the data is in YARR. C C Parameters: C C FNME Name of file containing data. 0 in byte 1 means no file. C FMT Character array containing the run time format C YARR If byte 1 of FNME is zero,or ' ', data is assumed to be in this C array. The last array element must be -999.. C NAMDIV A 25 element array containing names of the pie divisions C Each element must be 10 chars long - "BYTE NAMDIV(10,25)." C DIVST Starting value of divisions. C DIVINC The real division increment. C NUMDIV The number of divisions in the pie circle. C ISTAT On Input: C +ve Last plot of the program C -ve More plots to follow C 1 Data is raw - to be pied before plotting. C 2 Data already pied - just plot it. C C Returned status C 0 Success C -1 PIE1 was not called first FATAL. C -2 NUMDIV exceeds maximum (25) C -3 Error in Format parameter C -4 Less than 2 data divisions. C C LOGICAL PIEFLG, FILE, FINIT, KOLOR, DOPIE REAL YARR(1), LIMITS(25) INTEGER*4I4 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) C C IF (.NOT.(ISTAT.GT.0)) GOTO 2000 FINIT = .TRUE. IF (.NOT.(ISTAT.EQ.1)) GOTO 2020 DOPIE = .TRUE. GOTO 2030 2020 CONTINUE DOPIE = .FALSE. 2030 CONTINUE GOTO 2010 2000 CONTINUE FINIT = .FALSE. IF (.NOT.(ISTAT.EQ.1)) GOTO 2040 DOPIE = .TRUE. GOTO 2050 2040 CONTINUE DOPIE = .FALSE. 2050 CONTINUE 2010 CONTINUE CALL ERRSET(62, .TRUE., , , .FALSE.) IF (.NOT.(.NOT.PIEFLG)) GOTO 2060 ISTAT = - 1 RETURN 2060 CONTINUE IF (.NOT.(NUMDIV.GT.25)) GOTO 2080 ISTAT = - 2 RETURN 2080 CONTINUE PIEFLG = .FALSE. ISTAT = 0 C IF (.NOT.((FNME(1).NE.0).AND.(FNME(1).NE.' '))) GOTO 2100 FILE = .TRUE. OPEN(UNIT = 7, NAME = FNME, TYPE = 'OLD', READONLY) 2100 CONTINUE LIMITS(1) = XSTART VALUE(1) = DIVST DO 2120 I = 2, NUMDIV LIMITS(I) = LIMITS(I - 1) + DIVINC VALUE(I) = 0 C C Calculate distribution of data C 2120 CONTINUE I = 1 2140 CONTINUE IF (.NOT.(FILE)) GOTO 2170 READ(7, FMT, END=30, ERR=20) YVAL GOTO 2180 2170 CONTINUE YVAL = YARR(I) 2180 CONTINUE IF (.NOT.(YVAL.EQ.-999.)) GOTO 2190 GOTO 2160 2190 CONTINUE IF (.NOT.(DOPIE)) GOTO 2210 DO 2230 J = 1, NUMDIV YVAL = YVAL + .0001*YVAL IF (.NOT.(YVAL.GT.LIMITS(J))) GOTO 2250 IF (.NOT.(YVAL.LE.(LIMITS(J)+DIVINC))) GOTO 2270 VALUE(J) = VALUE(J) + 1 GOTO 2240 2270 CONTINUE 2250 CONTINUE 2230 CONTINUE 2240 CONTINUE GOTO 2220 2210 CONTINUE VALUE(I) = YVAL 2220 CONTINUE I = I + 1 2150 GOTO 2140 2160 CONTINUE 20 ISTAT = - 1 RETURN C C C The coordinates of the wedge, and increment for circumference. C 30 CONTINUE XC = 9. YC = 7. RX = XC + 1. RY = YC SCALE = 6.2831853E - 2 RAD = 5. N = NUMDIV C C A PIE chart with only two values doesn't look good C ICT = 0 DO 50 I=1,N IF (.NOT.(VALUE(I).EQ.0)) GOTO 2290 GOTO 50 2290 CONTINUE ICT = ICT + 1 50 CONTINUE IF (.NOT.((N.GE.2).OR.(ICT.GE.2))) GOTO 2310 GOTO 60 2310 CONTINUE ISTAT = - 4 RETURN C C Total up the values and get the percentage of each C 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 (.NOT.(KOLOR)) GOTO 2330 CALL COLOR(ICL) C C C Get the rotation for the first element C 2330 CONTINUE E = PER(1)/2.*SCALE ROT = E C C Each radial line starts in the center of the circle C X1 = XC Y1 = YC IF (.NOT.(KL.EQ.2)) GOTO 2350 CALL PLOT(X1, Y1, 3) C C First radial line C 2350 CONTINUE X2 = RAD*COS(ROT) + XC Y2 = RAD*SIN(ROT) + YC ROTL = ROT C C Plot first line C IF (.NOT.(KL.EQ.2)) GOTO 2370 CALL PLOT(X2, Y2, 2) 2370 CONTINUE SROT = 0. IF (.NOT.((KL.EQ.1).AND.(PER(1).GT.0))) GOTO 2390 CALL SYMBOL(RX + 2.5, RY - .1, .2, NAMDIV(1, 1), 0., 10) C C For each additional segment, plot line from center to circumference C 2390 CONTINUE DO 160 I = 2, N IF (.NOT.(PER(I).EQ.0.)) GOTO 2410 GOTO 160 2410 CONTINUE 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 (.NOT.((DEG.LT.90.).OR.(DEG.GT.270.))) GOTO 2430 GOTO 155 2430 CONTINUE 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 (.NOT.(DEG.GT.360.)) GOTO 2450 DEG = DEG - 360. 2450 CONTINUE IF (.NOT.(KL.EQ.1)) GOTO 2470 CALL SYMBOL(XS, YS, .2, NAMDIV(1, I), DEG, 10) 2470 CONTINUE CALL STJUST(NAMDIV(1, I), 10, - 1) X2 = RAD*COS(ROT) + XC Y2 = RAD*SIN(ROT) + YC IF (.NOT.(KL.EQ.2)) GOTO 2490 CALL PLOT(X1, Y1, 3) CALL PLOT(X2, Y2, 2) 2490 CONTINUE 160 CONTINUE 165 ICL = ICL - 1 C C Draw in circumference C 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 (.NOT.(I.EQ.1)) GOTO 2510 CALL PLOT(X2, Y2, 3) 2510 CONTINUE 170 CALL PLOT(X2, Y2, 2) CALL PLOT(Q, R, 2) C C Offset center of circle to right for seperate wedge C 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 C C Do cicumference of wedge C 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) C C C IF (.NOT.(KOLOR)) GOTO 2530 CALL COLOR(2) 2530 CONTINUE 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 (.NOT.(KOLOR)) GOTO 2550 CALL COLOR(1) 2550 CONTINUE IF (.NOT.(FINIT)) GOTO 2570 CALL PLOT(0., 0., 999) 2570 CONTINUE CLOSE(UNIT = 7) RETURN C END