Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-05 - decus/20-0137/difeq/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