!----------------------------------------------------------------------------------------------------------------------------------! !()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()! !----------------------------------------------------------------------------------------------------------------------------------! !> ! ### NAME !! xerrwd(3f) - [M_odepack::Matrix] Write error message with values. !! ! ### SYNOPSIS !! subroutine xerrwd(Msg,Nmes,Nerr,Level,Ni,I1,I2,Nr,R1,R2) !! !! character(len=*),intent(in) :: Msg !! integer :: Nmes !! integer :: Nerr !! integer,intent(in) :: Level !! integer,intent(in) :: Ni !! integer,intent(in) :: I1 !! integer,intent(in) :: I2 !! integer,intent(in) :: Nr !! real(kind=dp),intent(in) :: R1 !! real(kind=dp),intent(in) :: R2 !! !!### DESCRIPTION !! !! Subroutines XERRWD, XSETF, XSETUN, and the function routine IXSAV, !! as given here, constitute a simplified version of the SLATEC error !! handling package. !! !!### OPTIONS !! All arguments are input arguments. !! !! MSG !! !! : The message (character array). !! !! NMES !! !! : The length of MSG (number of characters). !! !! NERR !! !! : The error number (not used). !! !! LEVEL !! !! : The error level.. !! 0 or 1 means recoverable (control returns to caller). !! 2 means fatal (run is aborted--see note below). !! !! NI !! !! : Number of integers (0, 1, or 2) to be printed with message. !! !! I1,I2 !! !! : Integers to be printed, depending on NI. !! !! NR !! !! : Number of reals (0, 1, or 2) to be printed with message. !! !! R1,R2 !! !! : Reals to be printed, depending on NR. !! !! Note.. this routine is machine-dependent and specialized for use !! in limited context, in the following ways.. !! !! 1. The argument MSG is assumed to be of type CHARACTER, and !! the message is printed with a format of (1X,A). !! 2. The message is assumed to take only one line. !! Multi-line messages are generated by repeated calls. !! 3. If LEVEL = 2, control passes to the statement STOP !! to abort the run. This statement may be machine-dependent. !! 4. R1 and R2 are assumed to be in double precision and are printed !! in D21.13 format. !! ! ### SUBSIDIARY ! ### CATEGORY R3C ! ### TYPE DOUBLE PRECISION (XERRWV-S, XERRWD-D) ! ### AUTHOR Hindmarsh, Alan C., (LLNL) ! ### ROUTINES CALLED IXSAV ! ### REVISION HISTORY (YYMMDD) ! 19920831 DATE WRITTEN ! 19921118 Replaced MFLGSV/LUNSAV by IXSAV. (ACH) ! 19930329 Modified prologue to SLATEC format. (FNF) ! 19930407 Changed MSG from CHARACTER*1 array to variable. (FNF) ! 19930922 Minor cosmetic change. (FNF) ! ! *Internal Notes: ! ! For a different default logical unit number, IXSAV (or a subsidiary ! routine that it calls) will need to be modified. ! For a different run-abort command, change the STOP statement ! ----------------------------------------------------------------------- ! Subroutines called by XERRWD.. None ! Function routine called by XERRWD.. IXSAV ! ----------------------------------------------------------------------- ! subroutine xerrwd(Msg,Nmes,Nerr,Level,Ni,I1,I2,Nr,R1,R2) character(len=*),intent(in) :: Msg integer :: Nmes integer :: Nerr integer,intent(in) :: Level integer,intent(in) :: Ni integer,intent(in) :: I1 integer,intent(in) :: I2 integer,intent(in) :: Nr real(kind=dp),intent(in) :: R1 real(kind=dp),intent(in) :: R2 integer :: lunit , mesflg ! Get LUN (logical unit number) and message print flag. lunit = ixsav(1,0,.false.) mesflg = ixsav(2,0,.false.) if ( mesflg/=0 ) then ! Write the message. write (lunit,'(1x,a)') Msg if ( Ni==1 ) write (lunit,"(6x,'In above message, I1 =',i10)") I1 if ( Ni==2 ) write (lunit,"(6x,'In above message, I1 =',i10,3x,'I2 =',i10)") I1 , I2 if ( Nr==1 ) write (lunit,"(6x,'In above message, R1 =',d21.13)") R1 if ( Nr==2 ) write (lunit,"(6x,'In above, R1 =',d21.13,3x,'R2 =',d21.13)") R1 , R2 endif ! Abort the run if LEVEL = 2. if ( Level==2 ) stop end subroutine xerrwd