      subroutine GEAR(Y,W,IPS,WT,YP,C,ERROR,SAVER,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 A, ADEN, AHINV, ANUM, BND, C,
     &                 D, EPS, ERROR, ERTST,
     &                 FOURU, H, HMIN, HOLD, RATIO,
     &                 R1, SAVER, T, TOLD, W, WT, Y, YP
      integer ICRASH,NEQN,K,KOLD,KP1,index,J,J1,ITST,IWEVAL,I,IPS,IQ
      integer NFE,IFAIL
      logical START,CONVRG
      dimension Y(NEQN,7),SAVER(NEQN,7),YP(NEQN),WT(NEQN),
     &          ERROR(NEQN),C(NEQN),IPS(NEQN),W(NEQN,NEQN)
      dimension ERTST(6),ANUM(27),ADEN(6)
      data ERTST/2.0,4.5,7.333,10.42,13.7,17.15/
      data ANUM/1.,1.,2.,3.,1.,6.,11.,6.,1.,24.,50.,35.,10.,
     &          1.,120.,274.,225.,85.,15.,1.,720.,1764.,
     &          1624.,735.,175.,21.,1./
      data ADEN/-1.,-3.,-11.,-50.,-274.,-1764./
      call GRSUB0 (Y,SAVER,YP,WT,FOURU)
      if (ICRASH.eq.1.or.ICRASH.eq.2) go to 190
100   continue
      if (K.eq.KOLD) go to 120
      KP1 = K+1
      index = (K*KP1)/2-1
      do 110 J = 1, KP1
         J1 = index+J
         A(J) = ANUM(J1)/ADEN(K)
110   continue
      ITST = KP1
      IWEVAL = 1
      KOLD = K
120   continue
      if (H.eq.HOLD) go to 150
      RATIO = H/HOLD
      R1 = 1.0
      do 140 J = 2, KP1
         R1 = R1*RATIO
         do 130 I = 1, NEQN
            Y(I,J) = SAVER(I,J)*R1
130      continue
140   continue
      ITST = KP1
      IWEVAL = 1
150   continue
      BND = EPS/float(2*NEQN*(K+2))
160   continue
      call GRSUB2 (Y,W,IPS,WT,YP,C,ERROR,SAVER,FOURU)
      if (ICRASH.eq.3) go to 190
      if (.not.CONVRG) go to 120
      IWEVAL = 0
      D = 0.0
      do 170 I = 1, NEQN
         D = dmax1(D,dabs(ERROR(I)/WT(I)))
170   continue
      D = D/(ERTST(K)*EPS)
      if (D.le.1.) go to 180
      call GRSUB3 (IQ,Y,SAVER,YP,D,WT,FOURU)
      if (ICRASH.eq.4) go to 190
      go to (100,120,160), IQ
180   continue
      call GRSUB4 (Y,ERROR,WT,D,FOURU)
190   continue
      return
      end
