*-----------------------------------------------------------------------
*    Runge-Kutta Stepper.
*    Re-try when error condition is not satisfied.
*                                                 Oct. 5, 1990  S.Sakai
*-----------------------------------------------------------------------
*     Copyright (C) 2000-2022 GFD Dennou Club. All rights reserved.
*-----------------------------------------------------------------------
      SUBROUTINE ODRK4R(N, FCN, T, DT, EPSL, X, WORK)

      PARAMETER (SAFETY=0.9,ERRCON=6.E-4)
      DIMENSION X(N), WORK(N,7)
      EXTERNAL  FCN

      PGROW  = -0.20
      PSHRNK = -0.25
      TINY   = 1.E-30
      T0     = T
      CALL FCN(N, T0, X, WORK(1,1))

*-------------------- Integration with DT & DT*2 -----------------------

  100 CONTINUE
      DT2 = DT*2
      CALL ODRK4(N, FCN, T0, DT2, X, WORK(1,1), WORK(1,2), WORK(1,5))

      CALL ODRK4(N, FCN, T0, DT,  X, WORK(1,1), WORK(1,4), WORK(1,5))
      T = T0 + DT
      CALL FCN(N, T, WORK(1,4), WORK(1,3))
      CALL ODRK4(N, FCN, T, DT,
     +	         WORK(1,4), WORK(1,3), WORK(1,4),WORK(1,5))
      T = T0 + DT2

*------------------------- ERROR EVALUATION ----------------------------

      ERRMAX=0.
      DO 200 I=1, N
        WORK(I,3) = WORK(I,4)-WORK(I,2)
        XSCAL   = ABS(X(I)) + ABS(DT2*WORK(I,1)) + TINY
        ERRMAX  = MAX(ERRMAX, ABS(WORK(I,3)/XSCAL))
  200 CONTINUE
      ERRMAX = ERRMAX/EPSL

      IF(ERRMAX.GT.1.) THEN
        DT = SAFETY*DT*(ERRMAX**PSHRNK)
        CALL MSGDMP('M', 'ODRK4R', 'RECALCULATING.')
        GOTO 100
      ELSE
        IF(ERRMAX.GT.ERRCON)THEN
          DT = SAFETY*DT*(ERRMAX**PGROW)
        ELSE
          DT = 4.*DT
        ENDIF
      ENDIF

      DO 300 I=1, N
        X(I) = WORK(I,4)
  300 CONTINUE

      RETURN
      END
