Trailing-Edge
-
PDP-10 Archives
-
decuslib10-09
-
43,50466/difeq1.for
There are 2 other files named difeq1.for in the archive. Click here to see a list.
C WESTERN MICHIGAN UNIVERSITY
C DIFEQ1.FOR (FILE NAME ON LIBRARY DECTAPE)
C DIFEQ1.FOR IS A SUBROUTINE GENERATOR FOR DIFEQ2.FOR
C DIFEQ, 2.6.1 (CALLING NAME, SUBLST NO.)
C SOLUTION OF ORDINARY DIFFERENTIAL EQUATIONS
C DIFEQ IS A COMBINATION OF A PROGRAM FROM DECUS(NO. 10-101,
C IBM-SSP) WITH SOME ADDITIONAL PROGRAMMING BY SAM ANEMA.
C LATER IT WAS MODIFIED BY R.R. BARR AND B. HUNG.
C LIBRARY DECTAPE PROGS. USED: USAGE.MAC
C FORWMU PROGS. USED: RUNUUO
C DIFEQ1.FOR GENERATES SUBR. FCT AND DIV.DAT AND STORES THEM
C ON DISK TO BE USED BY DIFEQ2.FOR
C ABOVE COMMENTS AND RIGHT ADJUSTED COMMENTS PUT IN BY WG
C
DIMENSION PRMT(5),IN(15),Y(20),KL(11)
DOUBLE PRECISION FIL
C ********THIS DATA STATEMENT MUST BE CHANGED IF A PRIVATE
C COPY IS TO BE EXECUTED
DATA KL/'EX/F10 REL:DIFEQ2.REL,DSK:FCT.F4 ',4*0/
DATA FIL/'FCT.F4'/
C CALL USAGE('DIFEQ')
CALL DEFINE FILE(1,0,NEVER,FIL,0,0)
CALL OFILE(20,'DIF')
TYPE 101
101 FORMAT(' SOLUTION OF ORDINARY DIFFERENTIAL EQUATION(S)',///)
TYPE 107
107 FORMAT(' ENTER NUMBER OF EQUATIONS'/)
ACCEPT 108,NDIM
108 FORMAT(I)
WRITE(1,200)
200 FORMAT(6X,'SUBROUTINE FCT(X,Y,D)')
WRITE(1,201)
201 FORMAT(6X,'DIMENSION Y(1),D(1)')
TYPE 110
110 FORMAT(' ENTER EQUATIONS'/)
ITAB=' '
206 ACCEPT 111,(IN(I),I=1,15)
111 FORMAT(A1,14A5)
IF(IN(1).EQ.' '.AND.IN(2).EQ.' '.AND.IN(3).EQ.' ')GOTO 120
IF(IN(1).NE.' ')GO TO 400
WRITE(1,406)IN
GO TO 405
400 IF(IN(1).GE.'1'.AND.IN(1).LT.':')GO TO 404
IF(IN(1).EQ.ITAB)GO TO 404
WRITE(1,203)IN
GO TO 405
404 WRITE(1,406)IN
406 FORMAT(A1,14A5)
405 GO TO 206
202 FORMAT(5X,A1,14A5)
203 FORMAT(6X,A1,14A5)
120 WRITE(1,204)
204 FORMAT(6X,'RETURN')
WRITE(1,205)
205 FORMAT(6X,'END')
TYPE 102
102 FORMAT(' ENTER INTERVAL OF SOLUTION'/)
ACCEPT 103,PRMT(1),PRMT(2)
103 FORMAT(2F)
TYPE 104
104 FORMAT(' ENTER INITIAL INCREMENT OF X'/)
ACCEPT 103,PRMT(3)
TYPE 105
105 FORMAT(' ENTER UPPER ERROR BOUND'/)
ACCEPT 103,PRMT(4)
TYPE 106
106 FORMAT(' ENTER INITIAL VALUES'/)
ACCEPT 109,(Y(I),I=1,NDIM)
109 FORMAT(10F)
TYPE 301
301 FORMAT(//)
CALL RELEAS(1)
WRITE(20)PRMT,NDIM,Y
ENDFILE 20
C---------------SEE DATA KL ABOVE. THE MAIN PROG. IS DEFEQ2.FOR
C--------------- AT THIS POINT.
CALL RUNUUO(KL)
END