File: RKGSTT.FT of Tape: Various/ETH/eth11-1

(Source file text) 

---

C	RKGSTT.FTN - SAMPLE PROGRAM TO TEST
C  RKGS		- SOLUTION OF SYSTEM OF 1ST ORDER DIFF. EQNS.
C
C  PROBLEM:
C	Y1' = 1/Y2  WITH Y1(0) = 1
C	Y2' =-1/Y1  WITH Y2(0) = 1
C
C  SOLUTION:
C	Y1(X) = EXP(X) AND Y2(X) = EXP(-X)
	EXTERNAL FCN
	EXTERNAL OUTPUT
	DIMENSION Y(2),DERY(2),AUX(8,2),PARAM(5)
C
C	OUTPUT CHANNEL = IOUT
	IOUT=2
C		ALSO USED IN ROUTINE OUTPUT
C	INITIALIZATION
	Y(1)=1.
	Y(2)=1.
	PARAM(1)=0.
	PARAM(2)=1.0
	PARAM(3)=0.1
	PARAM(4)=1.E-5
	DERY(1)=.2
	DERY(2)=.8
C  DERY CONTAINS (INITIALLY) THE WEIGHTING FACTORS FOR THE ERRORS
	NDIM=2
	CALL RKGS(PARAM,Y,DERY,NDIM,IHLF,FCN,OUTPUT,AUX)
	STOP
	END
	SUBROUTINE FCN(X,Y,DERY)
	DIMENSION Y(1),DERY(1)
	DERY(1)=1./Y(2)
	DERY(2)=-1./Y(1)
	RETURN
	END
	SUBROUTINE OUTPUT(X,Y,DERY,IHLF,NDIM,PARAM)
	DIMENSION Y(1),DERY(1),PARAM(1)
	DATA LOOP/0/,IOUT/2/
C
C	OUTPUT CHANNEL = IOUT
	IF(LOOP.NE.0) GO TO 1
	LOOP=1
	WRITE(IOUT,100)
100	FORMAT(//' RESULTS OF RKGS ON:'/'   Y1''=1/Y2 AND Y1(0)=1'/
	1'   Y2''=-1/Y1 AND Y2(0)=1')
	WRITE(IOUT,101)
101	FORMAT(//7X'X'9X'Y1(X)'10X'Y1(ACTUAL)'9X'Y2(X)'10X'Y2(ACTUAL'//)
1	Y1A=EXP(X)
	Y2A=EXP(-X)
	WRITE(IOUT,102) X,Y(1),Y1A,Y(2),Y2A
102	FORMAT(F10.2,4E17.8)
	RETURN
	END

---