Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0152/peak6.for
There are 2 other files named peak6.for in the archive. Click here to see a list.
	PROGRAM PEAK6
	DIMENSION Y(1200),H(1200),EMU(6),SIGMA(6),SIZE(6)
	DIMENSION IBUF(30), ARRAY(10), Y1(1200), H1(1200)
	DATA EMU/20.,75.,200.,500.,600.,900./
	DATA SIGMA/20.,10.,75.,30.,35.,100./
	DATA SIZE/500.,100.,200.,800.,700.,300./
	CALL VTCLR
	DO 1 I=1,1200
	   A=0.
	   H(I) = FLOAT(I)
	   DO 2 J=1,6
2	      A=A+SIZE(J)*EXP(-.5*((H(I)-EMU(J))/SIGMA(J))**2)
1	   Y(I)=A
	CALL GRINIT (IBUF)
	CALL GRREGN(IBUF,0,1)
	CALL GRAPHS (IBUF, 227, H, Y, 1200,0., 0)
	CALL VTHTXT(8,21,1,' Use <-- and --> to move cursor ')
	CALL VTHTXT(8,22,1,' Select start (1) and end (2) of window ')
	CALL VTHTXT(8,23,1,' Press RETURN to display ')
10	CALL GRINDX (IBUF, H, 1200, ARRAY, 0)
	POINT1 = ARRAY(1)
	POINT2 = ARRAY(2)
	CALL GRMARK (IBUF, POINT1, 1, 0)
	CALL GRMARK (IBUF, POINT2, 1, 0)
	ISIZE = POINT2 - POINT1
	IF (POINT2 .GT. POINT1) GOTO 15
	CALL VTHTXT (8,15,10, 'POINT (2) MUST BE TO THE RIGHT
	1 OF POINT (1)')
	CALL OUTSTR (BELL,3)
	CALLSLEEP (2)
	CALL VTELIN (2, 15)
	CALL VTMCUR (23, 26)
	GOTO 10
15	DO 20 I = 1, ISIZE
	   H1(I) = H(I+POINT1)
20	   Y1(I) = Y (I + POINT1)
	CALL VTMCUR (21,1)
	CALL VTERAS (0)
	CALL GRREGN(IBUF,1,2)
	CALL VTHTXT (8, 23, 1, ' Expanded display of window contents ')
	CALL GRAPHS (IBUF, 227, H1, Y1, ISIZE,0., 1)
	CALL VTMCUR(24,1)
	CALL EXIT
	END