Trailing-Edge
-
PDP-10 Archives
-
decuslib20-05
-
decus/20-0137/intgr/intgr.for
There are 2 other files named intgr.for in the archive. Click here to see a list.
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.FOR')
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.FOR,REL:ITGTN.REL,SYS:
1FORLIB/LIB')
END