        subroutine GRSUB0(Y,SAVER,YP,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 T, HOLD, H, EPS, AHINV, A, HMIN, TOLD, BND
      double precision ABSH, EPSMIN, YPNORM, YNORM, FOURU
      double precision Y, SAVER, YP, WT
      integer NEQN,K,NFE,ICRASH,KOLD,ITST,IWEVAL
      integer IFAIL,KP1,I,J
      logical CONVRG, START
      dimension Y(NEQN,7), SAVER(NEQN,7), YP(NEQN), WT(NEQN)
      HMIN = FOURU*dabs(T)
      if (dabs(H).ge.HMIN) go to 100
      HMIN = HMIN*1.005
      H = dsign(HMIN,H)
      ICRASH = 1
      go to 170
100   continue
      YNORM = 0.0
      do 110 I = 1, NEQN
         YNORM = dmax1(YNORM,dabs(Y(I,1)/WT(I)))
110   continue
      EPSMIN = FOURU*YNORM
      if (EPS.ge.EPSMIN) go to 120
      EPS = EPSMIN*(1.+FOURU)
      ICRASH = 2
      go to 170
120   continue
      if (.not.START) go to 150
      call FCT (T,Y,YP)
      NFE = NFE+1
      YPNORM = 0.0
      do 130 I = 1, NEQN
         YPNORM = dmax1(YPNORM,dabs(YP(I)/WT(I)))
130   continue
      ABSH = dabs(H)
      if (EPS.lt.16.*YPNORM*H*H) ABSH = 0.25*dsqrt(EPS/YPNORM)
      H = dsign(dmax1(ABSH,HMIN),H)
      do 140 I = 1, NEQN
         Y(I,2) = YP(I)*H
140   continue
      HOLD = H
      K = 1
      KOLD = 0
      START = .false.
150   continue
      ICRASH = 0
      IFAIL = 0
      KP1 = K+1
      TOLD = T
      do 160 J = 1, KP1
         do 160 I = 1, NEQN
            SAVER(I,J) = Y(I,J)
160   continue
170   continue
      return
      end
