rkmsg_r1 Subroutine

  1. rksuite_90.f90
  2. rksuite_90
  3. rkmsg_r1

private subroutine rkmsg_r1(ier, srname, nrec, comm, flag)

Arguments

Type IntentOptional AttributesName
integer, intent(in) :: ier
character(len=*), intent(in) :: srname
integer, intent(in) :: nrec
type(rk_comm_real_1d), intent(inout) :: comm
integer, intent(out), optional :: flag

Calls

proc~~rkmsg_r1~~CallsGraph proc~rkmsg_r1 rkmsg_r1 proc~get_stop_on_fatal_r1 get_stop_on_fatal_r1 proc~rkmsg_r1->proc~get_stop_on_fatal_r1 proc~set_saved_state_r1 set_saved_state_r1 proc~rkmsg_r1->proc~set_saved_state_r1

Called by

proc~~rkmsg_r1~~CalledByGraph proc~rkmsg_r1 rkmsg_r1 proc~step_integrate_r1 step_integrate_r1 proc~step_integrate_r1->proc~rkmsg_r1 proc~interpolate_r1 interpolate_r1 proc~interpolate_r1->proc~rkmsg_r1 proc~global_error_r1 global_error_r1 proc~global_error_r1->proc~rkmsg_r1 proc~setup_r1 setup_r1 proc~setup_r1->proc~rkmsg_r1 proc~reset_t_end_r1 reset_t_end_r1 proc~reset_t_end_r1->proc~rkmsg_r1 proc~range_integrate_r1 range_integrate_r1 proc~range_integrate_r1->proc~rkmsg_r1 interface~reset_t_end reset_t_end proc~range_integrate_r1->interface~reset_t_end interface~interpolate interpolate proc~range_integrate_r1->interface~interpolate interface~step_integrate step_integrate proc~range_integrate_r1->interface~step_integrate proc~statistics_r1 statistics_r1 proc~statistics_r1->proc~rkmsg_r1 interface~reset_t_end->proc~reset_t_end_r1 interface~interpolate->proc~interpolate_r1 interface~step_integrate->proc~step_integrate_r1 interface~range_integrate range_integrate interface~range_integrate->proc~range_integrate_r1 interface~global_error global_error interface~global_error->proc~global_error_r1 interface~statistics statistics interface~statistics->proc~statistics_r1 interface~setup setup interface~setup->proc~setup_r1 proc~upstream_calculate upstream_calculate proc~upstream_calculate->interface~range_integrate proc~upstream_calculate->interface~setup

Contents

Source Code

rkmsg_r1

Source Code

subroutine rkmsg_r1(ier,srname,nrec,comm,flag)
!
! 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
!
integer, intent(in) :: ier, nrec
integer, intent(out), optional :: flag
character(len=*), intent(in) :: srname
type(rk_comm_real_1d), intent(inout) :: comm
!
logical :: ok, on, range_call
!
integer, parameter :: fatal=911, catastrophe=912, just_fine=1
logical, parameter :: tell=.false.
!
!  Check where the call came from - if it is an indirect call from 
!  RANGE_INTEGRATE the run is not STOPped.
!
range_call = (srname=="RESET_T_END" .or. srname=="STEP_INTEGRATE" .or. &
          srname=="INTERPOLATE") .and. comm%use_range
!
!  Check if can continue with integrator.
!
ok = (srname=="STEP_INTEGRATE" .or. srname=="RANGE_INTEGRATE") .and. &
     (ier==2 .or. ier==3 .or. ier==4)
!
!  Check if program termination has been overridden.
!
on = get_stop_on_fatal_r1(comm)
!
if ((comm%print_message.and.ier>just_fine) .or. ier>=fatal) then
   write (comm%outch,"(/a)") " **"
   write (comm%outch,"(a)") comm%rec(1:nrec)
   if (ier>=fatal) then
      write (comm%outch,"(a/a,a,a/a/)") &
" **",&
" ** Catastrophic error detected in ", srname, ".",&
" **"
      if ((.not.range_call.and.on.and.ier==fatal) .or. ier==catastrophe) then
         write (comm%outch,"(a/a/a)") &
" **",&
" ** Execution of your program is being terminated.",&
" **"
         stop
      end if
   else 
      if (ok) then
         write (comm%outch,"(a/a,a,a,i2,a/a/a)")  &
" **", &
" ** Warning from routine ", srname, " with flag set ",ier, ".",&
" ** You can continue integrating this problem.",&
" **"
      else
         write (comm%outch,"(a/a,a,a,i2,a/a/a)")  &
" **", &
" ** Warning from routine ", srname, " with flag set ",ier, ".", &
" ** You cannot continue integrating this problem.", &
" **"
      end if
      if (.not.present(flag)) then
         write (comm%outch,"(a/a/a)") &
" **",&
" ** Execution of your program is being terminated.",&
" **"
         stop
      end if
   end if
end if
!
if (present(flag)) flag = ier
comm%rec(nrec+1:10) = " "
!
!  Save the status of the routine associated with SRNAME
!
call set_saved_state_r1(srname,ier,comm)
!
!  Indicate that a catastrophic error has been detected
!
!call set_saved_fatal_r1(comm,ier >= catastrophe)
!
end subroutine rkmsg_r1