get_status_message Function

    pure function get_status_message(iflag) result(msg)

    implicit none

    integer(ip),intent(in)       :: iflag  !! return code from one of the routines
    character(len=:),allocatable :: msg    !! status message associated with the flag

    character(len=10) :: istr   !! for integer to string conversion
    integer(ip)       :: istat  !! for write statement

    select case (iflag)

    case(  0_ip); msg='Successful execution'

    case( -1_ip); msg='Error in dintrv: x < xt(1_ip)'
    case( -2_ip); msg='Error in dintrv: x >= xt(lxt)'

    case(  1_ip); msg='Error in evaluate_*d: class is not initialized'

    case(  2_ip); msg='Error in db*ink: iknot out of range'
    case(  3_ip); msg='Error in db*ink: nx out of range'
    case(  4_ip); msg='Error in db*ink: kx out of range'
    case(  5_ip); msg='Error in db*ink: x not strictly increasing'
    case(  6_ip); msg='Error in db*ink: tx not non-decreasing'
    case(  7_ip); msg='Error in db*ink: ny out of range'
    case(  8_ip); msg='Error in db*ink: ky out of range'
    case(  9_ip); msg='Error in db*ink: y not strictly increasing'
    case( 10_ip); msg='Error in db*ink: ty not non-decreasing'
    case( 11_ip); msg='Error in db*ink: nz out of range'
    case( 12_ip); msg='Error in db*ink: kz out of range'
    case( 13_ip); msg='Error in db*ink: z not strictly increasing'
    case( 14_ip); msg='Error in db*ink: tz not non-decreasing'
    case( 15_ip); msg='Error in db*ink: nq out of range'
    case( 16_ip); msg='Error in db*ink: kq out of range'
    case( 17_ip); msg='Error in db*ink: q not strictly increasing'
    case( 18_ip); msg='Error in db*ink: tq not non-decreasing'
    case( 19_ip); msg='Error in db*ink: nr out of range'
    case( 20_ip); msg='Error in db*ink: kr out of range'
    case( 21_ip); msg='Error in db*ink: r not strictly increasing'
    case( 22_ip); msg='Error in db*ink: tr not non-decreasing'
    case( 23_ip); msg='Error in db*ink: ns out of range'
    case( 24_ip); msg='Error in db*ink: ks out of range'
    case( 25_ip); msg='Error in db*ink: s not strictly increasing'
    case( 26_ip); msg='Error in db*ink: ts not non-decreasing'
    case(700_ip); msg='Error in db*ink: size(x) /= size(fcn,1)'
    case(701_ip); msg='Error in db*ink: size(y) /= size(fcn,2)'
    case(702_ip); msg='Error in db*ink: size(z) /= size(fcn,3)'
    case(703_ip); msg='Error in db*ink: size(q) /= size(fcn,4)'
    case(704_ip); msg='Error in db*ink: size(r) /= size(fcn,5)'
    case(705_ip); msg='Error in db*ink: size(s) /= size(fcn,6)'
    case(706_ip); msg='Error in db*ink: size(x) /= nx'
    case(707_ip); msg='Error in db*ink: size(y) /= ny'
    case(708_ip); msg='Error in db*ink: size(z) /= nz'
    case(709_ip); msg='Error in db*ink: size(q) /= nq'
    case(710_ip); msg='Error in db*ink: size(r) /= nr'
    case(711_ip); msg='Error in db*ink: size(s) /= ns'
    case(712_ip); msg='Error in db*ink: size(tx) /= nx+kx'
    case(713_ip); msg='Error in db*ink: size(ty) /= ny+ky'
    case(714_ip); msg='Error in db*ink: size(tz) /= nz+kz'
    case(715_ip); msg='Error in db*ink: size(tq) /= nq+kq'
    case(716_ip); msg='Error in db*ink: size(tr) /= nr+kr'
    case(717_ip); msg='Error in db*ink: size(ts) /= ns+ks'
    case(800_ip); msg='Error in db*ink: size(x) /= size(bcoef,1)'
    case(801_ip); msg='Error in db*ink: size(y) /= size(bcoef,2)'
    case(802_ip); msg='Error in db*ink: size(z) /= size(bcoef,3)'
    case(803_ip); msg='Error in db*ink: size(q) /= size(bcoef,4)'
    case(804_ip); msg='Error in db*ink: size(r) /= size(bcoef,5)'
    case(805_ip); msg='Error in db*ink: size(s) /= size(bcoef,6)'

    case(806_ip); msg='Error in dbint4: currently, only k=4 can be used'

    case(100_ip); msg='Error in dbintk: k does not satisfy k>=1'
    case(101_ip); msg='Error in dbintk: n does not satisfy n>=k'
    case(102_ip); msg='Error in dbintk: x(i) does not satisfy x(i)<x(i+1) for some i'
    case(103_ip); msg='Error in dbintk: some abscissa was not in the support of the '//&
                      'corresponding basis function and the system is singular'
    case(104_ip); msg='Error in dbintk: the system of solver detects a singular system '//&
                      'although the theoretical conditions for a solution were satisfied'

    case(201_ip); msg='Error in dbspvn: k does not satisfy k>=1'
    case(202_ip); msg='Error in dbspvn: jhigh does not satisfy 1<=jhigh<=k'
    case(203_ip); msg='Error in dbspvn: index is not 1 or 2'
    case(204_ip); msg='Error in dbspvn: x does not satisfy t(ileft)<=x<=t(ileft+1)'

    case(301_ip); msg='Error in dbtpcf: n should be > 0'

    case(401_ip); msg='Error in dbvalu: k does not satisfy k>=1'
    case(402_ip); msg='Error in dbvalu: n does not satisfy n>=k'
    case(403_ip); msg='Error in dbvalu: ideriv does not satisfy 0<=ideriv<k'
    case(404_ip); msg='Error in dbvalu: x is not greater than or equal to t(k)'
    case(405_ip); msg='Error in dbvalu: x is not less than or equal to t(n+1)'
    case(406_ip); msg='Error in dbvalu: a left limiting value cannot be obtained at t(k)'

    case(501_ip); msg='Error in initialize_*d_specify_knots: tx is not the correct size (kx+nx)'
    case(502_ip); msg='Error in initialize_*d_specify_knots: ty is not the correct size (ky+ny)'
    case(503_ip); msg='Error in initialize_*d_specify_knots: tz is not the correct size (kz+nz)'
    case(504_ip); msg='Error in initialize_*d_specify_knots: tq is not the correct size (kq+nq)'
    case(505_ip); msg='Error in initialize_*d_specify_knots: tr is not the correct size (kr+nr)'
    case(506_ip); msg='Error in initialize_*d_specify_knots: ts is not the correct size (ks+ns)'

    case(601_ip); msg='Error in db*val: x value out of bounds'
    case(602_ip); msg='Error in db*val: y value out of bounds'
    case(603_ip); msg='Error in db*val: z value out of bounds'
    case(604_ip); msg='Error in db*val: q value out of bounds'
    case(605_ip); msg='Error in db*val: r value out of bounds'
    case(606_ip); msg='Error in db*val: s value out of bounds'

    case(901_ip); msg='Error in dbsqad: k does not satisfy 1<=k<=20'
    case(902_ip); msg='Error in dbsqad: n does not satisfy n>=k'
    case(903_ip); msg='Error in dbsqad: x1 or x2 or both do not satisfy t(k)<=x<=t(n+1)'

    case(1001_ip); msg='Error in dbfqad: k does not satisfy k>=1'
    case(1002_ip); msg='Error in dbfqad: n does not satisfy n>=k'
    case(1003_ip); msg='Error in dbfqad: d does not satisfy 0<=id<k'
    case(1004_ip); msg='Error in dbfqad: x1 or x2 or both do not satisfy t(k)<=x<=t(n+1)'
    case(1005_ip); msg='Error in dbfqad: tol is less than dtol or greater than 0.1'

    case(1101_ip); msg='Warning in dbsgq8: a and b are too nearly equal to allow normal integration.'
    case(1102_ip); msg='Error in dbsgq8: ans is probably insufficiently accurate.'

    case(2001_ip); msg='Error in dbint4: ndata is less than 2'
    case(2002_ip); msg='Error in dbint4: x values are not distinct or not ordered'
    case(2003_ip); msg='Error in dbint4: ibcl is not 1 or 2'
    case(2004_ip); msg='Error in dbint4: ibcr is not 1 or 2'
    case(2005_ip); msg='Error in dbint4: kntopt is not 1, 2, or 3'
    case(2006_ip); msg='Error in dbint4: knot input through tleft, tright is not ordered properly'
    case(2007_ip); msg='Error in dbint4: the system of equations is singular'

    case(3001_ip); msg='Error in dbspvd: k does not satisfy k>=1'
    case(3002_ip); msg='Error in dbspvd: nderiv does not satisfy 1<=nderiv<=k'
    case(3003_ip); msg='Error in dbspvd: ldvnik does not satisfy ldvnik>=k'

    case default
        write(istr,fmt='(I10)',iostat=istat) iflag
        msg = 'Unknown status flag: '//trim(adjustl(istr))
    end select

    end function get_status_message