subroutine difsys4 (f,eps,h,x,y)
  use greg_interfaces, except_this=>difsys4
  !---------------------------------------------------------------------
  ! @ private
  ! GREG	Internal routine
  !       adapted from Prof. Dr. R. BULIRSCH, 1972-73
  !	P. VALIRON				21-AUG-80
  !	adapted for single precision		27-SEP-84
  !	Integration of first order differential equations.
  !	The equation is supposed to be of the form:
  !             DY/DX = F(X,Y)
  ! Arguments :
  !	F	Ext	User supplied subroutine. Computes
  !			the right end of (1) for a given X and Y
  !			F must contain the instructions:
  !				SUBROUTINE F(X,Y,DYDX)
  !				REAL*4 X,Y,DYDX
  !	EPS	R*4	Accuracy, kept internally > 1.E-11
  !	H	R*4	User estimate of the best step of
  !			integration, updated.
  !	X	R*4	initial abcissa.
  !	Y	R*4	Initial value of Y.
  !	After the calculation, X is replaced by X+H2 and Y by its
  !	value for the abscissa X+H2. H2 is less or equal to H, its value
  !	is chosen internally to satisfy the required accuracy EPS.
  !	The subroutine returns H equal to the best value for the next
  !	step. If the system seems to be ill conditioned, or if the initial
  !	value for H is much too high, H is returned equal to 0.
  !	( See BULIRSCH,R. and STOER,J.; NUM.MATH. /8/,1-13 (1966) )
  ! Subroutines :
  !	F	External
  !---------------------------------------------------------------------
  external :: f                     !
  real*4 :: eps                     !
  real*4 :: h                       !
  real*4 :: x                       !
  real*4 :: y                       !
  ! Local
  real*4 :: ya,yl,ym,dy,dz,dt(7),d(7),s
  real*4 :: xn,g,b,b1,u,v,c,ta,w,ep(4)
  logical ::   konv,bo,kl,gr
  integer :: jti,m,jr,js,j,l,k
  real :: fy,eta,fs,fv,fa
  data ep/0.4e-1,0.16e-2,0.64e-4,0.256e-5/
  !
  jti=0
  fy=1.
  eta=abs(eps)
  if (eta.lt.1.e-11) eta=1.e-11
  ya=y
  call f (x,y,dz)
10 xn=x+h
  bo=.false.
  s=0.
  m=1
  jr=2
  js=3
  do j=1,10
    if(.not.bo) goto 200
    d(2)=1.777777777777778
    d(4)=7.111111111111111
    d(6)=28.44444444444444
    goto 201
200 d(2)=2.25
    d(4)=9.
    d(6)=36.
201 if(j.le.7) goto 202
    l=7
    d(7)=64.
    goto 203
202 l=j
    d(l)=m*m
203 konv=l.gt.3
    m=m+m
    g=h/float(m)
    b=g+g
    m=m-1
    yl=ya
    ym=ya+g*dz
    do k=1,m
      call f (x+float(k)*g,ym,dy)
      u=yl+b*dy
      yl=ym
      ym=u
      u=abs(u)
      if(u.gt.s) s=u
    enddo                      ! K
    call f (xn,ym,dy)
    kl=l.lt.2
    gr=l.gt.5
    fs=0.
    v=dt(1)
    c=(ym+yl+g*dy)*0.5
    dt(1)=c
    ta=c
    if(kl) goto 233
    do k=2,l
      b1=d(k)*v
      b=b1-c
      w=c-v
      u=v
      if(b.eq.0.) goto 230
      b=w/b
      u=c*b
      c=b1*b
230   v=dt(k)
      dt(k)=u
      ta=u+ta
    enddo                      ! K
    if(.not.konv) goto 232
    if(abs(y-ta).gt.s*eta) konv=.false.
232 if(gr.or.s.eq.0.) goto 233
    fv=abs(w)/s
    if(fs.lt.fv) fs=fv
233 y=ta
    if(fs.eq.0.) goto 250
    fa=fy
    k=l-1
    fy=(ep(k)/fs)**(1./float(l+k))
    if(l.eq.2) goto 240
    if(fy.lt.0.7*fa) goto 250
240 if(fy.gt.0.7) goto 250
    h=h*fy
    jti=jti+1
    if(jti.gt.5) goto 30
    goto 10
250 if(konv) goto 20
    d(3)=4.
    d(5)=16.
    bo=.not.bo
    m=jr
    jr=js
    js=m+m
  enddo                        ! J
  h=h*0.5
  goto 10
20 x=xn
  h=h*fy
  return
30 h=0.
  y=ya
  return
end subroutine difsys4
