Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

C	WESTERN MICHIGAN UNIVERSITY
C	INTGR.FOR (FILENAME ON LIBRARY DECTAPE)
C	INTGR,2.7.1 (CALLING NAME, SUBLST NO.)
C	1,2, AND 3 DIMENSIONAL INTEGRATION
C	INTGR GENERALES FILE FUNC.F4 TO BE USED BY ITGTN.  FOR 1 DIM
C	 FUNC.F4 CONTAINS FUNCTION F; FOR 2 DIM. IT CONTAINS FUNCTIONS
C	 F, FL1, FU1; FOR 3 DIM. IT CONTAINS F, FL1, FU1, FL2, FU2.
C	THIS PROGRAM WAS ADAPTED BY B. G. HOUCHARD.
C	REPRINTING PRIVILEGE WERE GRANTED BY PERMISSION OF THE
C	 ASSOCIATION FOR COMPUTING MACHINERY, BUT NOT FOR PROFIT.
C	THIS PROGRAM UTILIZES SUBROUTINES TAKEN FROM:
C	 (1) A. H. STROUD, "APPROXIMATE CALCULATION OF MULTIPLE
C	 INTEGRALS", PRENTICE-HALL, INC. PP. 14-17, 346-349.
C	 (2) J. H. LYNESS, SQUANK (SIMPSON QUADRATURE USED
C	 ADAPTIVELY--NOISE KILLED), COMMUNICATIONS OF THE ACM,
C	 VOLUME 13, NUMBER 4, APRIL, 1970. PP.260-263.
C	LIBRARY DECTAPE PROGS. USED:  USAGE.MAC
C	FORWMU PROGS. USED:  RUNUUO
C	ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
C
C	LIMITATIONS:
C
C	(1)  60 COLUMNS ARE ALLOTED FOR THE FUNCTIONS AND LIMITS TO BE
C	      BE ENTERED BY THE USERS.
C
C	(2)  ONLY 1,2 AND 3 DIMENSION INTEGRATION POSSIBLE
C
C	(3)  PROGRAM IS BASICALLY  TELETYPE ORIENTED
C
C***********************************************************************
C***********************************************************************
C
	DIMENSION F(12),FL1(12),FU1(12),FL2(12),FU2(12)
C
C**********************************************************************
C	DEVICES USED:
C
C	IDLG---DEVICE USED TO COMMUNICATE WITH USERS.
C	       IT IS ALWAYS SET TO -1.
C	ICC----DEVICE USED TO ACCEPT USER'S RESPONSES.
C              IT IS ALWAYS SET TO -4.
C	IOUT---DEVICE USED TO WRITE UP THE REPORT.
C	       IT IS ALWAYS SET TO 30.
C	IDSK---DEVICE USED TO WRITE THE TEMPORARY DISK FILE FOR RUNUUO.
C	       IT IS ALWAYS SET TO 1.
C	ITEMP--DEVICE USED TO WRITE A TEMPORARY DISK FILE TO BE READ
C	       BY ITGTN.F4.
C	       IT IS ALWAYS SET TO 20.
C
C**********************************************************************
C
	IDLG=-1
	ICC=-4
	IDSK=1
	ITEMP=20
C	CALL USAGE('INTGR')
	DO 100 I=1,12
	F(I)=' '
	FL1(I)=' '
	FU1(I)=' '
	FL2(I)=' '
100	FU2(I)=' '
10	WRITE(IDLG,11)
11	FORMAT('-WMU INTEGRATION PROGRAM')
C
C***********************************************************************
C	DETERMINE DIMENSION
C***********************************************************************
12	WRITE(IDLG,13)
13	FORMAT('-DIMENSION?--',$)
	READ(ICC,14) IDIM
14	FORMAT(I)
	IF ((IDIM.LE.3).AND.(IDIM.GT.0)) GO TO 20
	WRITE(IDLG,15) IDIM
15	FORMAT('-PROGRAM CANNOT HANDLE',I3,'-DIMENSIONAL INTEGRATION,
     1 TRY AGAIN'/)
	GO TO 12
C
C***********************************************************************
C	GATHER FUNCTION AND LIMITS AND SET UP TEMPORARY FILES
C***********************************************************************
C
C---------------WITH 1 DIM INTEG. FUNCTION F IS STORED ON DISK IN FILE
C--------------- CALLED FUNC.F4; IN 2 DIM., FUNCTION F(X,Y),
C--------------- FUNCTION FL1(X) FUNCTION FU1(X) ARE STORED ON DISK IN
C--------------- FILE FUNC.F4; IN 3 DIM., FUNCTION F(X,Y,Z),
C--------------- FUNCTION FL1(X,Y), FUNCTION FU1(X,Y), FUNCTION
C--------------- FL2(X), FUNCTION FU2(X) ARE STORED ON DISK
C--------------- IN FILE FUNC.F4.
20	WRITE(IDLG,21)
21	FORMAT('-ENTER FUNCTION'/)
	READ(ICC,22) F
22	FORMAT(12A5)
	WRITE(ITEMP) IDIM,F
	OPEN (UNIT=IDSK,ACCESS='SEQOUT',MODE='ASCII',FILE='FUNC.F4')
	IF (IDIM.EQ.1) WRITE(IDSK,23)
23	FORMAT(6X,'FUNCTION F(X)')
	IF (IDIM.EQ.2) WRITE(IDSK,24)
24	FORMAT(6X,'FUNCTION F(X,Y)')
	IF (IDIM.EQ.3) WRITE(IDSK,25)
25	FORMAT(6X,'FUNCTION F(X,Y,Z)')
	WRITE(IDSK,26) F
26	FORMAT(6X,'F=',12A5/6X,'RETURN'/6X,'END')
	IF (IDIM.GE.2) GO TO 300
	WRITE(IDSK,301)
301	FORMAT(6X,'FUNCTION FL1(X)'/6X,
     1'FL1=0'/6X,
     2'RETURN'/6X,
     3'END'/6X,
     4'FUNCTION FU1(X)'/6X,
     5'FU1=0'/6X,
     6'RETURN'/6X,
     7'END'/)
	WRITE(ITEMP) FL1,FU1
	GO TO 350
300	WRITE(IDLG,30)
30	FORMAT('-LIMITS FOR INNER INTEGRAL:')
	WRITE(IDLG,31)
31	FORMAT(' LOWER: ',$)
	READ(ICC,22) FL1
	WRITE(IDLG,32)
32	FORMAT('+UPPER: ',$)
	READ(ICC,22) FU1
	WRITE(ITEMP) FL1,FU1
	IF (IDIM.GT.2) GO TO 40
	WRITE(IDSK,33) FL1
33	FORMAT(6X,'FUNCTION FL1(X)'/6X,'FL1=',12A5)
	WRITE(IDSK,34)
34	FORMAT(6X,'RETURN'/6X,'END')
	WRITE(IDSK,35) FU1
35	FORMAT(6X,'FUNCTION FU1(X)'/6X,'FU1=',12A5)
	WRITE(IDSK,34)
350	WRITE(ITEMP) FL2,FU2
	WRITE(IDSK,351)
351	FORMAT(6X,'FUNCTION FL2(X)'/6X,
     1'FL2=0'/6X,
     2'RETURN'/6X,
     3'END'/6X,
     4'FUNCTION FU2(X)'/6X,
     5'FU2=0'/6X,
     6'RETURN'/6X,
     7'END'/)
	GO TO 50
40	WRITE(IDSK,41) FL1
41	FORMAT(6X,'FUNCTION FL1(X,Y)'/6X,'FL1=',12A5)
	WRITE(IDSK,34)
	WRITE(IDSK,42) FU1
42	FORMAT(6X,'FUNCTION FU1(X,Y)'/6X,'FU1=',12A5)
	WRITE(IDSK,34)
	WRITE(IDLG,43)
43	FORMAT(' LIMITS FOR  MIDDLE INTEGRAL:')
	WRITE(IDLG,31)
	READ(ICC,22) FL2
	WRITE(IDLG,32)
	READ(ICC,22) FU2
	WRITE(IDSK,44) FL2
44	FORMAT(6X,'FUNCTION FL2(X)'/6X,'FL2=',12A5)
	WRITE(IDSK,34)
	WRITE(IDSK,45) FU2
45	FORMAT(6X,'FUNCTION FU2(X)'/6X,'FU2=',12A5)
	WRITE(IDSK,34)
	WRITE(ITEMP) FL2,FU2
C
C***********************************************************************
C	CLOSE TEMPORARY FILES AND CALL RUNUUO TO COMPILE THE FUNCTION
C	AND LIMITS.
C***********************************************************************
C
50	ENDFILE IDSK
	CLOSE(UNIT=IDSK)
	ENDFILE ITEMP
C---------------/FOROTS IS NO LONGER NECESSARY.  THE MAIN PROG. AT THIS
C--------------- POINT IS ITGTN.FOR
	CALL RUNUUO('EX/F10/FOROTS FUNC.F4,REL:ITGTN.REL,SYS:
     1FORLIB/LIB')
	END