Initial commit

2016-02-03 18:52:05 +00:00
commit d40505e161
507 changed files with 91383 additions and 0 deletions
@@ -0,0 +1,37 @@
+      SUBROUTINE rkqs(y,dydx,n,x,htry,eps,yscal,hdid,hnext,derivs)
+      INTEGER n,NMAX
+      REAL eps,hdid,hnext,htry,x,dydx(n),y(n),yscal(n)
+      EXTERNAL derivs
+      PARAMETER (NMAX=50)
+CU    USES derivs,rkck
+      INTEGER i
+      REAL errmax,h,htemp,xnew,yerr(NMAX),ytemp(NMAX),SAFETY,PGROW,
+     *PSHRNK,ERRCON
+      PARAMETER (SAFETY=0.9,PGROW=-.2,PSHRNK=-.25,ERRCON=1.89e-4)
+      h=htry
+1     call rkck(y,dydx,n,x,h,ytemp,yerr,derivs)
+      errmax=0.
+      do 11 i=1,n
+        errmax=max(errmax,abs(yerr(i)/yscal(i)))
+11    continue
+      errmax=errmax/eps
+      if(errmax.gt.1.)then
+        htemp=SAFETY*h*(errmax**PSHRNK)
+        h=sign(max(abs(htemp),0.1*abs(h)),h)
+        xnew=x+h
+        if(xnew.eq.x)pause 'stepsize underflow in rkqs'
+        goto 1
+      else
+        if(errmax.gt.ERRCON)then
+          hnext=SAFETY*h*(errmax**PGROW)
+        else
+          hnext=5.*h
+        endif
+        hdid=h
+        x=x+h
+        do 12 i=1,n
+          y(i)=ytemp(i)
+12      continue
+        return
+      endif
+      END