statistics_r1 Subroutine

subroutine statistics_r1(comm,total_f_calls,step_cost,waste,num_succ_steps,&
                         h_next,y_maxvals)
!
! Part of rksuite_90 v1.0 (Aug 1994)
!         software for initial value problems in ODEs
!
! Authors: R.W. Brankin (NAG Ltd., Oxford, England)
!          I. Gladwell  (Math Dept., SMU, Dallas, TX, USA)
!          see main doc for contact details
!
type(rk_comm_real_1d), intent(inout) :: comm
real(kind=wp), optional, intent(out) :: h_next                       !indep!
real(kind=wp), optional, intent(out) :: waste
real(kind=wp), dimension(:), optional, intent(out) :: y_maxvals      !shp-dep!
integer, optional, intent(out) :: step_cost, num_succ_steps, total_f_calls
!
character(len=*), parameter :: srname="STATISTICS"
!
integer :: ier, nrec, state
!
integer, parameter :: not_ready=-1, not_reusable=-3, fatal=911, &
   catastrophe=912, just_fine=1
logical, parameter :: ask=.true.
real(kind=wp), parameter :: zero=0.0_wp
!
ier = just_fine; nrec = 0
!
body: do
!
!  Is it permissible to call STATISTICS?
!
   state = get_saved_state_r1(srname,comm%save_states)
   if (state==fatal) then
      ier = catastrophe; nrec = 1; write (comm%rec,"(a)") &
" ** A catastrophic error has already been detected elsewhere."
      exit body
   end if
   if (state==not_reusable) then
      ier = fatal; nrec = 2; write (comm%rec,"(a/a)") &
" ** You have already made a call to STATISTICS after a hard failure was ", &
" ** reported from the integrator. You cannot call STATISTICS again."
      exit body
   end if
   state = get_saved_state_r1("STEP_INTEGRATE",comm%save_states)
   if (state==not_ready) then
      ier = fatal; nrec = 1
      if (comm%use_range) then
         write (comm%rec,"(a)") &
" ** You have not called RANGE_INTEGRATE, so you cannot use STATISTICS."
      else
         write (comm%rec,"(a)") &
" ** You have not called STEP_INTEGRATE, so you cannot use STATISTICS."
      end if
      exit body
   end if
   if (present(y_maxvals)) then
      if (any(shape(y_maxvals) /= shape(comm%y))) then
         ier = fatal; nrec = 2; write (comm%rec,"(a,i6,a/a,i6,a)") &
" ** The shape of Y_MAXVALS is not consistent with the shape of the", &
" ** dependent variables."
         exit body
      end if
   end if
!
!  Set flag so that the routine can only be called once after a hard 
!  failure from the integrator.
!
   if (state==5 .or. state==6) ier = not_reusable
!
   if (present(total_f_calls)) then
      total_f_calls = comm%full_f_count + comm%f_count
!      if (comm%erason) total_f_calls = total_f_calls + comm%ge_f_count
   end if
   if (present(step_cost)) step_cost = comm%cost
   if (present(num_succ_steps)) num_succ_steps = comm%step_count
   if (present(waste)) then
      if (comm%step_count<=1) then
         waste = zero
      else
         waste = real(comm%bad_step_count,kind=wp) / &
                 real(comm%bad_step_count+comm%step_count,kind=wp)
      end if
   end if
   if (present(h_next)) h_next = comm%h
   if (present(y_maxvals)) y_maxvals = comm%ymax
   exit body
end do body
!
call rkmsg_r1(ier,srname,nrec,comm)
!
end subroutine statistics_r1