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