dsrcom.inc Source File


Source Code

!----------------------------------------------------------------------------------------------------------------------------------!
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!----------------------------------------------------------------------------------------------------------------------------------!
!>
!!### NAME
!! dsrcom(3f) - [M_odepack] Save/restore ODEPACK COMMON blocks.
!!
!!### DESCRIPTION
!!  This routine saves or restores (depending on JOB) the contents of
!!  the internal types used to store the current state
!!  by one (or more) of the ODEPACK solvers.
!!
!!### VALUES
!!
!!  RSAV
!!
!!  : real array of length 218 or more.
!!
!!  ISAV
!!
!!  : integer array of length 37 or more.
!!
!!  JOB
!!
!!  : flag indicating to save or restore the COMMON blocks:
!!              JOB  = 1 if COMMON is to be saved (written to RSAV/ISAV)
!!              JOB  = 2 if COMMON is to be restored (read from RSAV/ISAV)
!!  A call with JOB = 2 presumes a prior call with JOB = 1.
!!
!-----------------------------------------------------------------------
! ### BEGIN PROLOGUE  DSRCOM
! ### SUBSIDIARY
! ### PURPOSE  Save/restore ODEPACK COMMON blocks.
! ### TYPE      DOUBLE PRECISION (SSRCOM-S, DSRCOM-D)
! ### AUTHOR  Hindmarsh, Alan C., (LLNL)
! ### DESCRIPTION
! ### SEE ALSO  DLSODE
! ### ROUTINES CALLED  (NONE)
! ### COMMON BLOCKS    DLS001
! ### REVISION HISTORY  (YYMMDD)
!     19791129  DATE WRITTEN
!     19890501  Modified prologue to SLATEC/LDOC format.  (FNF)
!     19890503  Minor cosmetic changes.  (FNF)
!     19921116  Deleted treatment of block /EH0001/.  (ACH)
!     19930801  Reduced Common block length by 2.  (ACH)
!     19930809  Renamed to allow single/double precision versions. (ACH)
!     20010418  Reduced Common block length by 209+12. (ACH)
!     20031105  Restored 'own' variables to Common block /DLS001/, to
!               enable interrupt/restart feature. (ACH)
!     20031112  Added SAVE statement for data-loaded constants.
! ### END PROLOGUE  DSRCOM
!-----------------------------------------------------------------------
subroutine dsrcom (rsav, isav, job)
real(kind=dp)      :: Rsav(*)
integer            :: Isav(*)
integer,intent(in) :: Job

integer,parameter :: lenils=37, lenrls=218

   select case(job)

   case(1)

     rsav(1:lenrls)=return_dls1_real()
     isav(1:lenils)=return_dls1_int()

   case(2)

     call set_dls1_real(rsav(1:lenrls))
     call set_dls1_int(isav(1:lenils))

   case default

      write(*,*)'<ERROR>*dsrcom* unknown JOB value=',job
      stop 1

   end select
end subroutine dsrcom