Category : Miscellaneous Language Source Code
Archive   : FORTRN77.ZIP
Filename : GRAFIC.FOR

 
Output of file : GRAFIC.FOR contained in archive : FORTRN77.ZIP
SUBROUTINE GRAPHS (N,X,Y)
C
C THIS SUBROUTINE WILL PLOT A ONE PAGE GRAPH ON THE PRINTER.
C
DIMENSION K(105),X(1),Y(1),XWRD(11),YWRD(11)
CHARACTER *1 K,BLANK
CHARACTER *5 IDOT,IDSH
DATA BLANK /' '/,IDOT/' |'/,IDSH/' -'/
CALL SORT2 (X,Y,N)
XRNGE = X(N) - X(1)
YMAX = Y(1)
YMIN = Y(1)
DO 50 I = 2,N
IF (Y(I).LT.YMIN) YMIN = Y(I)
50 IF (Y(I).GT.YMAX) YMAX = Y(I)
YRNGE = YMAX - YMIN
XWRD(1) = X(1)
XWRD(11) = X(N)
YWRD(1) = YMIN
YWRD(11) = YMAX
AY = 0.1*YRNGE
AX = 0.1*XRNGE
DO 60 I = 2,10
XI = I-1
XWRD(I) = XWRD(1) + XI*AX
60 YWRD(I) = YWRD(1) + XI*AY
DO 65 I= 1,105
65 K(I)=BLANK
DO 70 I = 10,100,10
70 K(I) = '|'
C
C OPEN THE PRINTER AS FILE 3
OPEN(3,FILE='LPT1:')
C SET THE PRINTER TO COMPRESSED PRINT= 132 CHAR PER LINE
WRITE (3,75) CHAR(27),CHAR(15)
75 FORMAT('+',A1,A1)
WRITE (3,80) (YWRD(I),I=2,10,2),(YWRD(I),I = 1,11,2),
&(K(I),I=1,100),IDOT
80 FORMAT (1H1/19X,5(8X,E12.6)/9X,6(8X,E12.6)/14X,100A1,5X,A5)
J = 1
J1 = 0
JJ = 1
XL = 0.2*AX
90 XJ = J1
DO 100 I = 1,104
100 K(I) = BLANK
K(105)='-'
110 IF(J.GT.N) GO TO 200
IF((XWRD(1) + XJ*XL).LT.X(J)) GO TO 200
B = (Y(J) - YWRD(1))/AY*10.
JB = IFIX(B)
LOC = JB + 1
IF (LOC.GT.101) LOC = 101
J = J + 1
IF(K(LOC).NE.BLANK) GO TO 190
K(LOC) = '+'
GO TO 110
190 K(LOC) = '*'
GO TO 110
200 IF (J1.EQ.0) GO TO 250
210 MJ = J1
220 IF(MJ-5)270,240,230
230 MJ = MJ - 5
GO TO 220
240 JJ = JJ + 1
250 WRITE (3,260) XWRD(JJ),IDSH,(K(I),I=1,105)
260 FORMAT (E18.6,A5,105A1)
GO TO 290
270 WRITE (3,280) IDSH,(K(I),I=1,105)
280 FORMAT (18X,A5,105A1)
290 J1 = J1 + 1
IF (J.GT.N) GO TO 300
GO TO 90
300 IF (JJ.EQ.11) GO TO 320
305 DO 310 I = 1,104
310 K(I) = BLANK
GO TO 210
C
C SET THE PRINTER BACK TO NORMAL SPACING = 80 CHAR PER LINE
320 WRITE (3,330) CHAR(27),CHAR(18)
330 FORMAT(1X,A1,A1)
RETURN
END
C
C
SUBROUTINE HIST (X,N,NC)
C
C THIS SUBROUTINE WILL PRINT A ONE-PAGE HISTOGRAM AND
C ONE-PAGE CUMULATIVE HISTOGRAM WITH A MAXIMUM
C OF TWELVE INTERVALS.
C THE VERTICAL COORDINATE INDICATES THE PERCENTAGE OR
C CUMULATIVE PERCENTAGE OF VALUES WITHIN THE INTERVAL.
C
DIMENSION ZNDS(13),KOUNT(12),CUT(12),MUK(24)
DIMENSION X(1),ILIK(13)
CHARACTER *3 IBLANK,IFIL,ILIK,MUK
DATA IBLANK/' '/,IFIL/'***'/,ILIK/13*'| '/
C
NK = NC + 1
CALL SORT (X,N)
C OPEN THE PRINTER AS FILE 3
OPEN(3,FILE='LPT1:')
C SET THE PRINTER TO COMPRESSED PRINT= 132 CHAR PER LINE
WRITE (3,75) CHAR(27),CHAR(15)
75 FORMAT('+',A1,A1)
YINC = (X(N)-X(1))/FLOAT(NC)
ZNDS(1) = X(1)
DO 3000 I = 2,NC
ZNDS(I) = ZNDS(I-1)+YINC
3000 CONTINUE
ZNDS(NK) = X(N)
DO 3003 K = 1,NC
MAY = 0
RR = ZNDS(K)
SS = ZNDS(K+1)
DO 3002 L = 1,N
IF(X(L)-RR) 3002,3002,990
990 IF(X(L)-SS) 3001,3001,3002
3001 MAY = MAY + 1
3002 CONTINUE
IF (K.EQ.1) MAY = MAY + 1
KOUNT(K) = MAY
3003 CONTINUE
DO 250 LOR = 1,2
GO TO (601,602),LOR
601 WRITE (3,105)
GO TO 610
602 WRITE (3,106)
610 ZIP = FLOAT(N)
DO 3004 KS = 1,NC
CUT(KS) = (FLOAT(KOUNT(KS)) / ZIP) * 100.
3004 CONTINUE
DO 3005 KAP = 1,51
NDEC = (51 - KAP) * 2
SCLE = NDEC
DO 3006 II = 1,12
MUK(2*II-1) = IBLANK
MUK(2*II) = IBLANK
IF (II .GT.NC) GO TO 3006
IF (CUT(II) .LT.SCLE) GO TO 3006
MUK(2*II-1) = IFIL
MUK(2*II) = IFIL
3006 CONTINUE
IF(SCLE) 3008,46,3008
46 DO 61 II = 1,NC
IF (KOUNT(II) .NE.0) GO TO 61
MUK(2*II-1) = IBLANK
MUK(2*II) = IBLANK
61 CONTINUE
3008 IF (MOD(NDEC,10).EQ.0) GO TO 33
WRITE(3,101) (MUK(I),I=1,24)
GO TO 3005
33 WRITE (3,102) NDEC,(MUK(I),I=1,24),NDEC
3005 CONTINUE
WRITE (3,109) (ILIK(I),I = 1,NK)
WRITE (3,103) (ZNDS(I),I = 1,NK,2)
WRITE (3,104) (ZNDS(I),I = 2,NK,2)
WRITE (3,107) (KOUNT(I),I = 1,NC)
WRITE (3,108) (CUT(I),I = 1,NC)
GO TO (711,250),LOR
711 DO 261 I = 2,NC
KOUNT (I) = KOUNT (I) + KOUNT (I-1)
261 CONTINUE
250 CONTINUE
C
C SET THE PRINTER BACK TO NORMAL SPACING = 80 CHAR PER LINE
270 WRITE (3,280) CHAR(27),CHAR(18)
280 FORMAT(1X,A1,A1)
C
RETURN
C
101 FORMAT (10X,1H-,3X,12(2A3,3X),1H-)
102 FORMAT (6X,I4,1H=,3X,12(2A3,3X),1H=,I4)
103 FORMAT (7(6X,E12.6))
104 FORMAT (9X,6(6X,E12.6))
105 FORMAT (1H1,5X,7HPERCENT,39X,19HFREQUENCY HISTOGRAM)
106 FORMAT (1H1,5X,7HPERCENT,34X,30HCUMULATIVE FREQUENCY HISTOGRAM)
107 FORMAT ( /11H CELL COUNT,3X,I5,11(4X,I5))
108 FORMAT (11H PERCENTAGE,12(2X,F7.2))
109 FORMAT (4X,13(8X,A1))
END


  3 Responses to “Category : Miscellaneous Language Source Code
Archive   : FORTRN77.ZIP
Filename : GRAFIC.FOR

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/