relibc_openlibm/slatec/mpchk.f

*DECK MPCHK
      SUBROUTINE MPCHK (I, J)
C***BEGIN PROLOGUE  MPCHK
C***SUBSIDIARY
C***PURPOSE  Subsidiary to DQDOTA and DQDOTI
C***LIBRARY   SLATEC
C***TYPE      ALL (MPCHK-A)
C***AUTHOR  (UNKNOWN)
C***DESCRIPTION
C
C  Checks legality of B, T, M, MXR and LUN which should be set
C  in COMMON. The condition on MXR (the dimension of the EP arrays)
C  is that  MXR .GE. (I*T + J)
C
C***SEE ALSO  DQDOTA, DQDOTI, MPBLAS
C***ROUTINES CALLED  I1MACH, MPERR
C***COMMON BLOCKS    MPCOM
C***REVISION HISTORY  (YYMMDD)
C   791001  DATE WRITTEN
C   ??????  Modified for use with BLAS.  Blank COMMON changed to named
C           COMMON.  R given dimension 12.
C   891009  Removed unreferenced statement label.  (WRB)
C   891009  REVISION DATE from Version 3.2
C   891214  Prologue converted to Version 4.0 format.  (BAB)
C   900402  Added TYPE section.  (WRB)
C   930124  Increased Array size in MPCON for SUN -r8.  (RWC)
C***END PROLOGUE  MPCHK
      COMMON /MPCOM/ B, T, M, LUN, MXR, R(30)
      INTEGER B, T, R
C***FIRST EXECUTABLE STATEMENT  MPCHK
      LUN = I1MACH(4)
C NOW CHECK LEGALITY OF B, T AND M
      IF (B.GT.1) GO TO 40
      WRITE (LUN, 30) B
   30 FORMAT (' *** B =', I10, ' ILLEGAL IN CALL TO MPCHK,'/
     1 ' PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***')
      CALL MPERR
   40 IF (T.GT.1) GO TO 60
      WRITE (LUN, 50) T
   50 FORMAT (' *** T =', I10, ' ILLEGAL IN CALL TO MPCHK,'/
     1 ' PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***')
      CALL MPERR
   60 IF (M.GT.T) GO TO 80
      WRITE (LUN, 70)
   70 FORMAT (' *** M .LE. T IN CALL TO MPCHK,'/
     1 ' PERHAPS NOT SET BEFORE CALL TO AN MP ROUTINE ***')
      CALL MPERR
C 8*B*B-1 SHOULD BE REPRESENTABLE, IF NOT WILL OVERFLOW
C AND MAY BECOME NEGATIVE, SO CHECK FOR THIS
   80 IB = 4*B*B - 1
      IF ((IB.GT.0).AND.((2*IB+1).GT.0)) GO TO 100
      WRITE (LUN, 90)
   90 FORMAT (' *** B TOO LARGE IN CALL TO MPCHK ***')
      CALL MPERR
C CHECK THAT SPACE IN COMMON IS SUFFICIENT
  100 MX = I*T + J
      IF (MXR.GE.MX) RETURN
C HERE COMMON IS TOO SMALL, SO GIVE ERROR MESSAGE.
      WRITE (LUN, 110) I, J, MX, MXR, T
  110 FORMAT (' *** MXR TOO SMALL OR NOT SET TO DIM(R) BEFORE CALL',
     1 ' TO AN MP ROUTINE *** ' /
     2 ' *** MXR SHOULD BE AT LEAST', I3, '*T +', I4, ' =', I6, '  ***'
     3 / ' *** ACTUALLY MXR =', I10, ', AND T =', I10, '  ***')
      CALL MPERR
      RETURN
      END