SUBROUTINE HISTOG(A, B, KPTS) DOUBLE PRECISION A, B, X, FOX, DTM, DELX, 1 XLOW, XHIGH, FLOW, FHIGH,DMIN,DMAX,RHSTMN,RHSTMX, 1 XMIN, FXMIN, XMAX, FXMAX, XHSTMN, FHSTMN, 1 XHSTMX, FHSTMX, TEM, TOTEM, FC,AVG,VAR,FNOP, 1 HSTMIN, HSTMAX, ERMIN, ERMAX INTEGER N(100),IO(36) REAL FMT(6) COMMON/HIST/ N, X, FOX, DTM, DELX, TEM, 1 TOTEM, HSTMIN, HSTMAX, ERMIN, ERMAX EQUIVALENCE (TEM,ITEM), (DTM,IDTM), (FOX,IFOX), 1 (XLOW,IO(1)), (XHIGH,IO(4)), (FLOW,IO(7)), (FHIGH,IO(10)), 1 (XMIN,IO(13)), (XMAX,IO(16)), (FXMIN,IO(19)), (FXMAX,IO(22)), 1 (XHSTMN,IO(25)), (XHSTMX,IO(28)), (FHSTMN,IO(31)),(FHSTMX,IO(34)) EXTERNAL NADD, ST DATA FMT(1), FMT(2), FMT(3)/ 5H(D21., 5H10, D, 5H30.10/ DATA FMT(4), FMT(5), FMT(6)/ 5H/3O7,, 5H9X, 3, 5HO7) / C DELX = DLOG(B/A) VAR = 0. AVG = 0. NOPTS = 0 NOLOW = 0 NOHIGH = 0 DO 200 I=1,100 200 N(I) = 0 C DO 600 J=1,KPTS TEM=FLOAT(2*J-1)*DELX/FLOAT(2*KPTS) X=A*DEXP(TEM) CALL SETUP(2) DTM = FC(X, FOX) CALL MP(NADD, FOX, 1) CALL MP(ST, TEM, 1) TOTEM = TEM/DTM ITEM = ITEM +39 -IDTM IF(NOPTS .NE. 0) GO TO 310 HSTMIN = TEM HSTMAX = TEM ERMIN = TOTEM ERMAX = TOTEM XLOW = X XHIGH = X 310 IF(X .GT. XLOW) GO TO 340 XLOW = X FLOW = FOX 340 IF(X .LT. XHIGH) GO TO 350 XHIGH = X FHIGH = FOX 350 IF(TOTEM .GT. ERMIN) GO TO 400 ERMIN = TOTEM DMIN = TEM XMIN = X FXMIN = FOX 400 IF(TOTEM .LT. ERMAX) GO TO 440 ERMAX = TOTEM DMAX = TEM XMAX = X FXMAX = FOX 440 IF(TEM .GT. HSTMIN) GO TO 450 HSTMIN = TEM RHSTMN = TOTEM XHSTMN = X FHSTMN = FOX 450 IF(TEM .LT. HSTMAX) GO TO 460 HSTMAX = TEM RHSTMX = TOTEM XHSTMX = X FHSTMX = FOX 460 I = TEM +51. IF(I .GE. 1) GO TO 510 NOLOW = NOLOW +1 GO TO 521 510 IF(I .LE. 100) GO TO 520 NOHIGH = NOHIGH +1 GO TO 521 520 N(I) = N(I) +1 521 AVG = AVG +TOTEM VAR = VAR +TOTEM*TOTEM 600 NOPTS = NOPTS +1 C 601 FNOP = NOPTS AVG = AVG/FNOP VAR = DSQRT(VAR/FNOP) 1 FORMAT(1H0/ 1H0/ 1H0/ 1H0/ D21.10, D30.10) 3 FORMAT(1H ) 4 FORMAT(D21.6, D30.6) 6 FORMAT(I5, 1H), 10I6) 7 FORMAT(I6, 2D14.5) 8 FORMAT(5X, 1H), I6) WRITE(4,1) A, B WRITE(4,FMT) XLOW, XHIGH, (IO(J),J=1,6) WRITE(4,FMT) FLOW, FHIGH, (IO(J), J=7,12) WRITE(4,3) WRITE(4,4) ERMIN, ERMAX WRITE(4,4) DMIN, DMAX WRITE(4,FMT) XMIN, XMAX, (IO(J),J=13,18) WRITE(4,FMT) FXMIN, FXMAX, (IO(J), J=19, 24) WRITE(4,3) WRITE(4,4) RHSTMN, RHSTMX WRITE(4,4) HSTMIN, HSTMAX WRITE(4,FMT) XHSTMN, XHSTMX, (IO(J),J=25,30) WRITE(4,FMT) FHSTMN, FHSTMX, (IO(J),J=31,36) WRITE(4,3) C WRITE(4,8) NOLOW DO 630 J=1,10 LAST = 10*J LFIRST = LAST -9 LNNO = LFIRST -51 WRITE(4,6) LNNO, (N(I),I=LFIRST,LAST) 630 CONTINUE WRITE(4,8) NOHIGH C WRITE(4,3) WRITE(4,7) NOPTS, VAR, AVG RETURN END