        subroutine GRSUB3(IQ,Y,SAVER,YP,D,WT,FOURU)
      common /GEDATA/ T, HOLD, H, EPS, AHINV, A(7),
     &NEQN, K, NFE, ICRASH, KOLD, ITST, IWEVAL, START
      common/GEDAT2/BND,HMIN,TOLD,IFAIL,KP1,CONVRG
      double precision D, D1, ERDWN, GFACT, R, RDWN, FOURU
      double precision T, HOLD, H, EPS, AHINV, A, HMIN, TOLD, BND
      double precision Y, SAVER, YP, WT
      integer NEQN, K, NFE, ICRASH, KOLD, ITST, IWEVAL, IFAIL, KP1
      integer I,IQ,J
      logical CONVRG, START
      dimension ERDWN(6),Y(NEQN,7),SAVER(NEQN,7),YP(NEQN),WT(NEQN)
      data ERDWN/1.0,1.0,0.5,0.1667,0.04133,0.008267/
      T = TOLD
      do 100 I = 1, NEQN
         Y(I,1) = SAVER(I,1)
100   continue
      IFAIL = IFAIL+1
      if (IFAIL.gt.3) go to 120
      if ((IFAIL.lt.3).and.(K.gt.1)) go to 130
      IFAIL = 3
      H = 0.5*H
      if (dabs(H).lt.HMIN) H = dsign(HMIN,H)
      call FCT (T,Y,YP)
      NFE = NFE+1
      do 110 I = 1, NEQN
         SAVER(I,2) = YP(I)*H
         Y(I,2) = SAVER(I,2)
110   continue
      HOLD = H
      K = 1
      KP1 = 2
      A(1) = -1.
      KOLD = 1
      ITST = 2
      IWEVAL = 1
      IQ = 3
      go to 190
120   continue
      H = H/dsqrt(2.*D)
      if (dabs(H).lt.HMIN) go to 170
      IQ = 2
      go to 190
130   continue
      R = 1.2*(2.*D)**(1./float(KP1))
      D1 = 0.
      do 140 I = 1, NEQN
         D1 = dmax1(D1,dabs(Y(I,KP1)/WT(I)))
140   continue
      RDWN = 1.3*(2.*D1/(ERDWN(K)*EPS))**(1./float(K))
      if (RDWN.lt.R) go to 150
      if (R.gt.10.) R = 10.
      H = H/R
      if (dabs(H).lt.HMIN) go to 170
      IQ = 2
      go to 190
150   continue
      K = K-1
      if (RDWN.lt.1.1) RDWN = 1.1
      if (RDWN.gt.10.) RDWN = 10.
      H = H/R
      if (dabs(H).lt.HMIN) go to 160
      IQ = 1
      go to 190
160   continue
      KP1 = K+1
170   continue
      GFACT = (HMIN/dabs(H))**KP1
      if (GFACT.lt.2.) GFACT = 2.
      EPS = EPS*GFACT*(1.+FOURU)
      H = dsign(HMIN,H)
      do 180 J = 2, KP1
         do 180 I = 1, NEQN
            Y(I,J) = SAVER(I,J)
180   continue
      ICRASH = 4
190   continue
      return
      end
