MODULE generic_maxval
IMPLICIT NONE
INTEGER, PARAMETER :: SGL = SELECTED_REAL_KIND(p=6)
INTEGER, PARAMETER :: DBL = SELECTED_REAL_KIND(p=13)
INTERFACE maxval
  MODULE PROCEDURE maxval_i
  MODULE PROCEDURE maxval_r
  MODULE PROCEDURE maxval_d
  MODULE PROCEDURE maxval_c
  MODULE PROCEDURE maxval_dc
END INTERFACE maxval

CONTAINS
  SUBROUTINE maxval_i(array, nvals, value_max, pos_maxval)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: nvals
  INTEGER, INTENT(IN), DIMENSION(nvals) :: array
  INTEGER, INTENT(OUT) :: value_max
  INTEGER, INTENT(OUT), OPTIONAL :: pos_maxval
  INTEGER :: i
  INTEGER :: pos_max
  value_max = array(1)
  pos_max = 1
  DO i = 2, nvals
    IF (array(i) > value_max) THEN
      value_max = array(i)
      pos_max = i
    END IF
  END DO
  IF (PRESENT(pos_maxval)) THEN
    pos_maxval = pos_max
  END IF
  END SUBROUTINE maxval_i

  SUBROUTINE maxval_r(array, nvals, value_max, pos_maxval)
  IMPLICIT NONE
  INTEGER, INTENT(IN) :: nvals
  REAL(KIND=SGL), INTENT(IN), DIMENSION(nvals) :: array
  REAL(KIND=SGL), INTENT(OUT) :: value_max
  INTEGER, INTENT(OUT), OPTIONAL :: pos_maxval
  INTEGER :: i
  INTEGER :: pos_max
  value_max = array(1)
  pos_max = 1
  DO i = 2, nvals
    IF (array(i) > value_max) THEN
      value_max = array(i)
      pos_max = i
    END IF
  END DO
  IF (PRESENT(pos_maxval)) THEN
    pos_maxval = pos_max
  END IF
  END SUBROUTINE maxval_r
END MODULE generic_maxval

PROGRAM test_maxval
IMPLICIT NONE

END PROGRAM test_maxval


!***************************************************************************************
 module ordered_module
!***************************************************************************************
 implicit none

	!the dictionary file:
	integer,parameter :: file_unit = 1000
	character(len=*),parameter :: filename = 'unixdict.txt'

	!maximum number of characters in a word:
	integer,parameter :: max_chars = 50

	type word
	  character(len=max_chars) :: str    !the word from the dictionary
	  integer	:: n = 0    !length of this word
	  logical	:: ordered = .false.    !if it is an ordered word
	end type word

	!the dictionary structure:
	type(word),dimension(:),allocatable :: dict

	contains
!***************************************************************************************

	!******************************************************************************
		function count_lines_in_file(fid) result(n_lines)
	!******************************************************************************
		implicit none

		integer             :: n_lines
		integer,intent(in)  :: fid
		character(len=1)    :: tmp
		integer             :: i
		integer             :: ios

		!the file is assumed to be open already.

		rewind(fid)	  !rewind to beginning of the file

		n_lines = 0
		do !read each line until the end of the file.
			read(fid,'(A1)',iostat=ios) tmp
			if (ios < 0) exit      !End of file
			n_lines = n_lines + 1  !row counter
		end do

		rewind(fid)   !rewind to beginning of the file

	!******************************************************************************
		end function count_lines_in_file
	!******************************************************************************

	!******************************************************************************
	 pure elemental function ordered_word(word) result(yn)
	!******************************************************************************
	! turns true if word is an ordered word, false if it is not.
	!******************************************************************************

	 implicit none
	 character(len=*),intent(in) :: word
	 logical :: yn

	 integer :: i

	 yn = .true.
	 do i=1,len_trim(word)-1
	 	if (ichar(word(i+1:i+1))<ichar(word(i:i))) then
	 		yn = .false.
	 		exit
	 	end if
	 end do

	!******************************************************************************
	 end function ordered_word
	!******************************************************************************

!***************************************************************************************
 end module ordered_module
!***************************************************************************************

!****************************************************
 program main
!****************************************************
 use ordered_module
 implicit none

	integer :: i,n,n_max

	!open the dictionary and read in all the words:
	open(unit=file_unit,file=filename)     		!open the file
	n = count_lines_in_file(file_unit)      !count lines in the file
	allocate(dict(n))                       !allocate dictionary structure
	do i=1,n                                !
		read(file_unit,'(A)') dict(i)%str   !each line is a word in the dictionary
		dict(i)%n = len_trim(dict(i)%str)   !save word length
	end do
	close(file_unit)                        !close the file

	!use elemental procedure to get ordered words:
	dict%ordered = ordered_word(dict%str)

	!max length of an ordered word:
	n_max = maxval(dict%n, mask=dict%ordered)

	!write the output:
	do i=1,n
		if (dict(i)%ordered .and. dict(i)%n==n_max) write(*,'(A,A)',advance='NO') trim(dict(i)%str),' '
	end do
	write(*,*) ''

!****************************************************
 end program main
!****************************************************


C
C;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
C;
C;                Copyright (C)  1996
C;        University Corporation for Atmospheric Research
C;                All Rights Reserved
C;
C;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
C
C    File:       vc05f.f
C
C    Author: Lynn Hermanson
C            National Center for Atmospheric Research
C            PO 3000, Boulder, Colorado
C
C    Date:       April 11, 1996
C
C    Description: Given a simple mathematically generated data set,
C                 which looks like the intersection of two vector fields
C                 with opposite directions,this program produces three
C                 plot frames which demonstrate the use of VectorPlot;1st-
C                 default resources, 2nd- overlayed on a world map, 3rd-
C                 overlayed on an orthographic projection of the globe
C                 centered on the north pole covering 90 to 40 degrees
C                 north latitude.
C
C   Begin by generating the data set called "increasingvectors".
C   The values in the array "U" are defined to be the magnitude of the
C   x component of the vectors.  The values in the array "V" are
C   defined to be the magnitude of the y component of the vectors. The
C   location of the vectors corresponds to the indices of the arrays.
C   Each index pair will eventually correspond to a latitude,longitude
C   location on a map.
C ;;********* see resource file vc05.res ******

      external NhlFAppClass
      external NhlFNcgmWorkstationClass
      external NhlFPSWorkstationClass
      external NhlFPDFWorkstationClass
      external NhlFCairoPSPDFWorkstationClass
      external NhlFCairoImageWorkstationClass
      external NhlFCairoWindowWorkstationClass
      external NhlFMapPlotClass
      external NhlFVectorFieldClass
      external NhlFVectorPlotClass

      integer appid,wid,mapid,dataid,vcid
      integer srlist, ierr

      parameter(M=25,N=25)
      real U(M,N),V(M,N)

      integer len_dims(2)
      real x,y
      integer i,j
      character*7  wks_type

      wks_type = "x11"

      DO 100 i= 1,25
         DO 200 j= 1,25
          x =  2.5*(i + 1)/1.4142
          y =  2.5*(j + 1)/1.4142
          U(i,j) = x
          V(i,j) = y
200   CONTINUE
100   CONTINUE

C Initialize the high level utility library

       call NhlFInitialize

C  Next,
C  create an application context. Set the app dir to the current
C  directory so the application looks for a resource file (vc05.res)
C  in the working directory. The necessary
C  resources will be set in this program as each object is created.

C  Setup to choose the type of output workstation for all 3 frames.
C  Choose to display output to an X11 workstation.
C  Change the output from the
C  default colorMap (random sequence of colors) to a sequence
C  of colors so that vectors of increasing magnitude will move from
C  to cooler to hotter colors.

      call NhlFRLCreate(srlist,'SETRL')
      call NhlFRLClear(srlist)
      call NhlFRLSetstring(srlist,'appUsrDir','./',ierr)
      call NhlFCreate(appid,'vc05',NhlFAppClass,0,
     1    srlist,ierr)

      if (wks_type.eq."ncgm".or.wks_type.eq."NCGM") then

C Create a meta file workstation.
         call NhlFRLClear(srlist)
         call NhlFRLSetstring(srlist,'wkMetaName','./vc05f.ncgm',ierr)
         call NhlFCreate(wid,'vc05Work',NhlFNcgmWorkstationClass,0,
     1        srlist,ierr)

      else if (wks_type.eq."x11".or.wks_type.eq."X11") then

C Create an X workstation.

         call NhlFRLClear(srlist)
         call NhlFRLSetstring(srlist,'wkPause','true',ierr)

C ;;********* see resource file vc05.res ******
C       call NhlFRLSetstring(srlist,'wkColorMap', 'temp1',ierr)
C
         call NhlFCreate(wid,'vc05Work',
     +        NhlFCairoWindowWorkstationClass,
     1        0,srlist,ierr)

      else if (wks_type.eq."oldps".or.wks_type.eq."OLDPS") then

C Create an older-style PS workstation.

         call NhlFRLClear(srlist)
         call NhlFRLSetstring(srlist,'wkPSFileName','./vc05f.ps',ierr)
         call NhlFCreate(wid,'vc05Work',NhlFPSWorkstationClass,
     1        0,srlist,ierr)

      else if (wks_type.eq."oldpdf".or.wks_type.eq."OLDPDF") then

C Create an older-style PDF workstation.

         call NhlFRLClear(srlist)
         call NhlFRLSetstring(srlist,'wkPDFFileName','./vc05f.pdf',ierr)
         call NhlFCreate(wid,'vc05Work',NhlFPDFWorkstationClass,
     1        0,srlist,ierr)
      else if (wks_type.eq."pdf".or.wks_type.eq."PDF".or.
     +         wks_type.eq."ps".or.wks_type.eq."PS") then

C Create a cairo PS/PDF  workstation.

         call NhlFRLClear(srlist)
         call NhlFRLSetString(srlist,'wkFormat',wks_type,ierr)
         call NhlFRLSetstring(srlist,'wkFileName','./vc05f',ierr)
         call NhlFCreate(wid,'vc05Work',
     1        NhlFCairoPSPDFWorkstationClass,0,srlist,ierr)
      else if (wks_type.eq."png".or.wks_type.eq."PNG") then

C Create a cairo PNG  workstation.

         call NhlFRLClear(srlist)
         call NhlFRLSetString(srlist,'wkFormat',wks_type,ierr)
         call NhlFRLSetstring(srlist,'wkFileName','./vc05f',ierr)
         call NhlFCreate(wid,'vc05Work',
     1        NhlFCairoImageWorkstationClass,0,srlist,ierr)
      endif

C  BEGIN CREATING 1st FRAME

C  Create the 1st VectorField data object using the data set
C  generated above.

      call NhlFRLClear(srlist)
      len_dims(1) = N
      len_dims(2) = M
      call NhlFRLSetmdfloatarray(srlist,'vfUDataArray',U,2,
     1    len_dims,ierr)
      call NhlFRLSetmdfloatarray(srlist,'vfVDataArray',V,2,
     1    len_dims,ierr)
      call NhlFCreate(dataid,'increasingvectors',NhlFVectorFieldClass,
     1    appid,srlist,ierr)

C  Create the 1st VectorPlot object, supplying the 1st VectorField
C  object as data.
C  Turn off black and white arrows and use the temp1 colors spread
C  between
C  the lowest and highest vector magnitudes. The default vectors
C  appear as
C  solid lines with arrowheads in a linear coordinate system with the
C  origin at the lower left. Tickmarks with labels show the data
C  coordinate
C  range, and an informational label at the lower right gives
C  the reference vector value.

      call NhlFRLClear(srlist)
      call NhlFRLSetinteger(srlist,'vcVectorFieldData',dataid,ierr)

C ********* see resource file vc05.res ******
C       call NhlFRLSetstring(srlist,'vcMonoLineArrowColor','false',
C      1    ierr)
C       call NhlFRLSetstring(srlist,'vcMaxLevelCount',61,
C      1    ierr)
C

      call NhlFCreate(vcid,'VectorPlot1',NhlFVectorPlotClass,wid,
     1    srlist,ierr)

C  Draw the 1st frame, signify end of 1st frame.

      call NhlFDraw(vcid,ierr)
      call NhlFFrame(wid,ierr)

C  Destroy the objects created for the 1st frame.
C  Keep wid and appid for 2nd frame.

      call NhlFDestroy(dataid,ierr)
      call NhlFDestroy(vcid,ierr)

C  BEGIN CREATING 2nd FRAME

C  Create the 2nd VectorField data object using the same data.
C  Map the domain and range of the vector locations to the latitude
C  and longitude ranges of the world map on which the vectors
C  will be overlayed. Thus, cause the x axis locations to cover -180
C  to 180 degrees longitude, and cause the y axis locations to cover
C  -90 to 90 degrees latitude.

        call NhlFRLClear(srlist)
        call NhlFRLSetmdfloatArray(srlist,'vfUDataArray',U,2,
     1      len_dims,ierr)
        call NhlFRLSetmdfloatArray(srlist,'vfVDataArray',V,2,
     1      len_dims,ierr)

C ********* see resource file vc05.res ******
C         call NhlFRLSetinteger(srlist,'vfXCStartV', -180,ierr)
C         call NhlFRLSetinteger(srlist,'vfXCEndV', 180,ierr)
C         call NhlFRLSetinteger(srlist,'vfYCStartV', -90,ierr)
C         call NhlFRLSetinteger(srlist,'vfYCEndV', 90,ierr)
C

      call NhlFCreate(dataid,'increasingvectors2',NhlFVectorFieldClass,
     1      appid,srlist,ierr)

C  Create the 2nd VectorPlot object, as in the 1st frame.
C  Make the minimum vector length 1/3 of the reference vector length.

      call NhlFRLClear(srlist)
      call NhlFRLSetinteger(srlist,'vcVectorFieldData',dataid,ierr)

C ********* see resource file vc05.res ******
C       call NhlFRLSetstring(srlist,'vcMonoLineArrowColor','false',
C      1    ierr)
C       call NhlFRLSetstring(srlist,'vcMaxLevelCount',61,
C      1    ierr)
C       call NhlFRLSetfloat(srlist,'vcMinFracLengthF', .33,ierr)
C

      call NhlFCreate(vcid,'VectorPlot2',NhlFVectorPlotClass,
     1      wid,srlist,ierr)

C  Create a mapPlot object consisting of, the default, gridded
C  world map.
C  Add a title object which says "vc05 frame 2".
C  Turn off the grid lines.

      call NhlFRLClear(srlist)
      call NhlFRLSetstring(srlist,'pmTitleDisplayMode','always',ierr)
      call NhlFRLSetstring(srlist,'tiMainString','vc05 frame 2',
     1    ierr)

C********* see resource file vc05.res ******
C      call NhlFRLSetstring(srlist,'mpGridAndLimbOn', 'false',ierr)
C

      call NhlFCreate(mapid,'Map1',NhlFMapPlotClass,wid,srlist,ierr)

C  Overlay the VectorPlot2 VectorPlot object onto the Map1 MapPlot
C  object.

      call NhlFAddOverlay(mapid, vcid,-1,ierr)

C  Draw the 2nd frame. Signify end of 2nd frame.

      call NhlFDraw(mapid,ierr)
      call NhlFFrame(wid,ierr)

C  Destroy the objects created for 2nd frame. Keep wid and appid
C  for 3rd frame.

      call NhlFDestroy(dataid,ierr)
      call NhlFDestroy(vcid,ierr)
      call NhlFDestroy(mapid,ierr)

C  BEGIN CREATING 3rd FRAME

C  Create a data object from the same data.
C  Cause the x axis data locations to cover -180 to 180 degrees
C   longitude.
C  Cause the y axis data locations to cover 50 degrees latitude up
C  to the
C  north pole.

      call NhlFRLClear(srlist)
      call NhlFRLSetmdfloatArray(srlist,'vfUDataArray',U,2,
     1    len_dims,ierr)
      call NhlFRLSetmdfloatArray(srlist,'vfVDataArray',V,2,
     1    len_dims,ierr)

C********* see resource file vc05.res ******
C      call NhlFRLSetinteger(srlist,'vfXCStartV', -180,ierr)
C      call NhlFRLSetinteger(srlist,'vfXCEndV', 180,ierr)
C      call NhlFRLSetinteger(srlist,'vfYCStartV', 50,ierr)
C      call NhlFRLSetinteger(srlist,'vfYCEndV', 90,ierr)
C

      call NhlFCreate(dataid,'increasingvectors3',NhlFVectorFieldClass,
     1    appid,srlist,ierr)

C  Create a VectorPlot object, supplying the VectorField object as data,
C  as in frame 2.
C  Double the default vector length in NDC. The default was to
C  dynamically
C  calulate it by dividing viewport width by the number of data values.
C  Display a horizontal label bar (at the bottom of the plot)
C  showing the color levels and their corresponding magnitudes.
C  Decrease the height of the label bar to .1 NDC so that it fits
C  into the
C  default viewPort.

        call NhlFRLClear(srlist)
      call NhlFRLSetinteger(srlist,'vcVectorFieldData',dataid,ierr)

C********* see resource file vc05.res ******
C      call NhlFRLSetstring(srlist,'vcMonoLineArrowColor','false',
C     1    ierr)
C      call NhlFRLSetstring(srlist,'vcMaxLevelCount',61,
C     1    ierr)
C      call NhlFRLSetfloat(srlist,'vcMinFracLengthF', .33,ierr)
C      call NhlFRLSetfloat(srlist,'vcRefLengthF', .05,ierr)
C      call NhlFRLSetstring(srlist,'pmLabelBarDisplayMode','always',
C     1    ierr)
C      call NhlFRLSetstring(srlist,'pmLabelBarSide', 'bottom',ierr)
C      call NhlFRLSetstring(srlist,'lbOrientation','horizontal',ierr)
C      call  NhlFRLSetfloat(srlist,'pmLabelBarHeightF', .11,ierr)
C      call  NhlFRLSetfloat(srlist,'pmLabelBarWidthF', .6,ierr)
C

      call NhlFCreate(vcid,'VectorPlot3',NhlFVectorPlotClass,wid,
     1      srlist,ierr)

C  Create an orthographic map of the world, centered at the north pole,
C  making the points at all four of the frame edges be 50 degrees north
C  latitude. Make the center of the top edge of the frame be 180
C  degrees
C  longitude, the center of the bottom edge of the frame correspond to
C  0 degrees longitude, the center of the left edge of the frame
C  correspond
C  to -90 degrees longitude,and the center of right edge of the frame
C  correspond to +90 degrees longitude.
C  Create a title object which says "vc05 frame 3".
C  Turn off the grid lines.

      call NhlFRLClear(srlist)
      call NhlFRLSetstring(srlist,'pmTitleDisplayMode','always',ierr)
      call NhlFRLSetstring(srlist,'tiMainString','vc05 frame 3',
     1    ierr)

C********* see resource file vc05.res ******
C      call NhlFRLSetstring(srlist,'mpProjection', 'Orthographic',
C    1    ierr)
C      call NhlFRLSetfloat(srlist,'mpCenterLatF', 90.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpCenterLonF', 0.0,ierr)
C      call NhlFRLSetstring(srlist,'mpLimitMode', 'points',ierr)
C      call NhlFRLSetfloat(srlist,'mpBottomPointLatF', 50.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpTopPointLatF', 50.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpLeftPointLatF', 50.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpRightPointLatF', 50.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpBottomPointLonF', 0.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpTopPointLonF', 180.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpLeftPointLonF', 270.0,ierr)
C      call NhlFRLSetfloat(srlist,'mpRightPointLonF', 90.0,ierr)
C      call NhlFRLSetstring(srlist,'mpGridAndLimbOn', 'false',ierr)
C

      call NhlFCreate(mapid,'Map2',NhlFMapPlotClass,wid,srlist,ierr)

C  Overlay the VectorPlot3 VectorPlot object onto the Map2 MapPlot
C  object.

       call  NhlFAddOverlay(mapid, vcid,-1,ierr)

C  Draw the 3rd frame. Signify end of 3rd frame.

      call NhlFDraw(mapid,ierr)
      call NhlFFrame(wid,ierr)

C  Destroy all of the objects created, close the HLU library and exit.

      call NhlFDestroy(dataid,ierr)
      call NhlFDestroy(vcid,ierr)
      call NhlFDestroy(mapid,ierr)
      call NhlFDestroy(wid,ierr)
      call NhlFDestroy(appid,ierr)

      call NhlFClose

      stop
      end


SUBROUTINE DPTSVX1_F95(D, E, B, X, DF, EF, FACT, FERR, BERR, RCOND, INFO)
!
!  -- LAPACK95 interface driver routine (version 3.0) --
!     UNI-C, Denmark; Univ. of Tennessee, USA; NAG Ltd., UK
!     September, 2000
!
!  .. USE STATEMENTS ..
   USE LA_PRECISION, ONLY: WP => DP
   USE LA_AUXMOD, ONLY: LSAME, ERINFO
   USE F77_LAPACK, ONLY: PTSVX_F77 => LA_PTSVX
!  .. IMPLICIT STATEMENT ..
   IMPLICIT NONE
!  .. SCALAR ARGUMENTS ..
   CHARACTER(LEN=1), INTENT(IN), OPTIONAL :: FACT
   INTEGER, INTENT(OUT), OPTIONAL :: INFO
   REAL(WP), INTENT(OUT), OPTIONAL :: RCOND, FERR, BERR
!  .. ARRAY ARGUMENTS ..
   REAL(WP), INTENT(IN) :: D(:)
   REAL(WP), INTENT(IN) :: E(:), B(:)
   REAL(WP), INTENT(OUT) :: X(:)
   REAL(WP), INTENT(INOUT), OPTIONAL, TARGET :: DF(:)
   REAL(WP), INTENT(INOUT), OPTIONAL, TARGET :: EF(:)
!  .. PARAMETERS ..
   CHARACTER(LEN=8), PARAMETER :: SRNAME = 'LA_PTSVX'
!  .. LOCAL SCALARS ..
   CHARACTER(LEN=1) :: LFACT
   INTEGER :: LINFO, N, ISTAT, ISTAT1, SDF, SEF
   REAL(WP) :: LRCOND, LFERR, LBERR
!  .. LOCAL POINTERS ..
   REAL(WP),  POINTER :: LDF(:)
   REAL(WP),  POINTER :: WORK(:), LEF(:)
!  .. INTRINSIC FUNCTIONS ..
   INTRINSIC PRESENT, SIZE
!  .. EXECUTABLE STATEMENTS ..
   LINFO = 0; ISTAT = 0
   N = SIZE(D)
   IF( PRESENT(RCOND) ) RCOND = 1.0_WP
   IF( PRESENT(FACT) )THEN; LFACT = FACT; ELSE; LFACT='N'; END IF
   IF( PRESENT(DF) )THEN; SDF = SIZE(DF); ELSE; SDF = N; END IF
   IF( PRESENT(EF) )THEN; SEF = SIZE(EF); ELSE; SEF = N-1; END IF
!  .. TEST THE ARGUMENTS
   IF( N < 0 ) THEN; LINFO = -1
   ELSE IF( SIZE( E ) /= N-1 .AND. N /= 0 ) THEN; LINFO = -2
   ELSE IF( SIZE(B) /= N )THEN; LINFO = -3
   ELSE IF( SIZE(X) /= N )THEN; LINFO = -4
   ELSE IF( SDF /= N ) THEN; LINFO = -5
   ELSE IF( .NOT.( PRESENT(DF).AND.PRESENT(EF) ) &
       .AND.( PRESENT(DF).OR.PRESENT(EF) ) )THEN; LINFO = -5
   ELSE IF( SEF /= N-1 .AND. N>0 ) THEN; LINFO = -6
   ELSE IF( ( .NOT.LSAME(LFACT,'F') .AND. .NOT.LSAME(LFACT,'N') ) .OR. &
            ( LSAME(LFACT,'F') .AND. .NOT.PRESENT(DF) ) )THEN; LINFO = -7
   ELSE IF ( N > 0 )THEN
      IF( .NOT.PRESENT(DF) ) THEN; ALLOCATE( LDF(N), LEF(N-1), STAT=ISTAT )
      ELSE; LDF => DF; LEF => EF; END IF
      IF( ISTAT == 0 ) ALLOCATE(WORK(2*N), STAT=ISTAT )
      IF( ISTAT == 0 )THEN
         CALL PTSVX_F77( LFACT, N, 1, D, E, LDF, LEF, B, N, X, N, LRCOND, &
                         LFERR, LBERR, WORK, LINFO )
      ELSE; LINFO = -100; END IF
      IF( .NOT.PRESENT(DF) ) DEALLOCATE( LDF, LEF, STAT=ISTAT1 )
      IF( PRESENT(FERR) ) FERR = LFERR
      IF( PRESENT(BERR) ) BERR = LBERR
      IF( PRESENT(RCOND) ) RCOND=LRCOND
      DEALLOCATE( WORK, STAT=ISTAT1 )
   END IF
   CALL ERINFO( LINFO, SRNAME, INFO, ISTAT )
END SUBROUTINE DPTSVX1_F95


    program demo_popcnt
    use, intrinsic :: iso_fortran_env, only : integer_kinds, &
       & int8, int16, int32, int64
    implicit none
       print  *,  popcnt(127),            poppar(127)
       print  *,  popcnt(huge(0_int8)),   poppar(huge(0_int8))
       print  *,  popcnt(huge(0_int16)),  poppar(huge(0_int16))
       print  *,  popcnt(huge(0_int32)),  poppar(huge(0_int32))
       print  *,  popcnt(huge(0_int64)),  poppar(huge(0_int64))
    end program demo_popcnt


      SUBROUTINE STIM51( LINE, NSIZES, NN, NTYPES, DOTYPE, NPARMS, NNB,
     $                   NSHFTS, NEISPS, MINNBS, MINBKS, LDAS, TIMMIN,
     $                   NOUT, ISEED, A, B, H, T, Q, Z, W, WORK, LWORK,
     $                   LLWORK, TIMES, LDT1, LDT2, LDT3, OPCNTS, LDO1,
     $                   LDO2, LDO3, INFO )
*
*  -- LAPACK timing routine (version 3.0) --
*     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
*     Courant Institute, Argonne National Lab, and Rice University
*     September 30, 1994
*
*     .. Scalar Arguments ..
      CHARACTER*80       LINE
      INTEGER            INFO, LDO1, LDO2, LDO3, LDT1, LDT2, LDT3,
     $                   LWORK, NOUT, NPARMS, NSIZES, NTYPES
      REAL               TIMMIN
*     ..
*     .. Array Arguments ..
      LOGICAL            DOTYPE( * ), LLWORK( * )
      INTEGER            ISEED( * ), LDAS( * ), MINBKS( * ),
     $                   MINNBS( * ), NEISPS( * ), NN( * ), NNB( * ),
     $                   NSHFTS( * )
      REAL               A( * ), B( * ), H( * ),
     $                   OPCNTS( LDO1, LDO2, LDO3, * ), Q( * ), T( * ),
     $                   TIMES( LDT1, LDT2, LDT3, * ), W( * ),
     $                   WORK( * ), Z( * )
*     ..
*
*  Purpose
*  =======
*
*  STIM51 times the LAPACK routines for the real non-symmetric
*  generalized eigenvalue problem   A x = w B x.
*
*  For each N value in NN(1:NSIZES) and .TRUE. value in
*  DOTYPE(1:NTYPES), a pair of matrices will be generated and used to
*  test the selected routines.  Thus, NSIZES*(number of .TRUE. values
*  in DOTYPE) matrices will be generated.
*
*  Arguments
*  =========
*
*  LINE    (input) CHARACTER*80
*          The input line which requested this routine.  This line may
*          contain a subroutine name, such as SGGHRD, indicating that
*          only routine SGGHRD will be timed, or it may contain a
*          generic name, such as SHG.  In this case, the rest of the
*          line is scanned for the first 18 non-blank characters,
*          corresponding to the eighteen combinations of subroutine and
*          options:
*          LAPACK:                                     Table Heading:
*           1: SGGHRD(no Q, no Z) (+SGEQRF, etc.)      'SGGHRD(N)'
*           2: SGGHRD(Q only)     (+SGEQRF, etc.)      'SGGHRD(Q)'
*           3: SGGHRD(Z only)     (+SGEQRF, etc.)      'SGGHRD(Z)'
*           4: SGGHRD(Q and Z)    (+SGEQRF, etc.)      'SGGHRD(Q,Z)'
*           5: SHGEQZ(Eigenvalues only)                'SHGEQZ(E)'
*           6: SHGEQZ(Schur form only)                 'SHGEQZ(S)'
*           7: SHGEQZ(Schur form and Q)                'SHGEQZ(Q)'
*           8: SHGEQZ(Schur form and Z)                'SHGEQZ(Z)'
*           9: SHGEQZ(Schur form, Q and Z)             'SHGEQZ(Q,Z)'
*          10: STGEVC(SIDE='L', HOWMNY='A')            'STGEVC(L,A)'
*          11: STGEVC(SIDE='L', HOWMNY='B')            'STGEVC(L,B)'
*          12: STGEVC(SIDE='R', HOWMNY='A')            'STGEVC(R,A)'
*          13: STGEVC(SIDE='R', HOWMNY='B')            'STGEVC(R,B)'
*          EISPACK:                       Compare w/:  Table Heading:
*          14: QZHES w/ matz=.false.            1      'QZHES(F)'
*          15: QZHES w/ matz=.true.             3      'QZHES(T)'
*          16: QZIT and QZVAL w/ matz=.false.   5      'QZIT(F)'
*          17: QZIT and QZVAL w/ matz=.true.    8      'QZIT(T)'
*          18: QZVEC                           13      'QZVEC'
*          If a character is 'T' or 't', the corresponding routine in
*          this path is timed.  If the entire line is blank, all the
*          routines in the path are timed.
*
*          Note that since QZHES does more than SGGHRD, the
*          "SGGHRD" timing also includes the time for the calls
*          to SGEQRF, SORMQR, and (if Q is computed) SORGQR
*          which are necessary to get the same functionality
*          as QZHES.
*
*  NSIZES  (input) INTEGER
*          The number of values of N contained in the vector NN.
*
*  NN      (input) INTEGER array, dimension (NSIZES)
*          The values of the matrix size N to be tested.  For each
*          N value in the array NN, and each .TRUE. value in DOTYPE,
*          a matrix A will be generated and used to test the routines.
*
*  NTYPES  (input) INTEGER
*          The number of types in DOTYPE.  Only the first MAXTYP
*          elements will be examined.  Exception: if NSIZES=1 and
*          NTYPES=MAXTYP+1, and DOTYPE=MAXTYP*f,t, then the input
*          value of A will be used.
*
*  DOTYPE  (input) LOGICAL
*          If DOTYPE(j) is .TRUE., then a pair of matrices (A,B) of
*          type j will be generated.  A and B have the form  U T1 V
*          and  U T2 V , resp., where U and V are orthogonal, T1 is
*          block upper triangular (with 1x1 and 2x2 diagonal blocks),
*          and T2 is upper triangular.  T2 has random O(1) entries in
*          the strict upper triangle and ( 0, 1, 0, 1, 1, ..., 1, 0 )
*          on the diagonal, while T1 has random O(1) entries in the
*          strict (block) upper triangle, its block diagonal will have
*          the singular values:
*          (j=1)   0, 0, 1, 1, ULP,..., ULP, 0.
*          (j=2)   0, 0, 1, 1, 1-d, 1-2*d, ..., 1-(N-5)*d=ULP, 0.
*
*                                  2        N-5
*          (j=3)   0, 0, 1, 1, a, a , ..., a   =ULP, 0.
*          (j=4)   0, 0, 1, r1, r2, ..., r(N-4), 0, where r1, etc.
*                  are random numbers in (ULP,1).
*
*  NPARMS  (input) INTEGER
*          The number of values in each of the arrays NNB, NSHFTS,
*          NEISPS, and LDAS.  For each matrix A generated according to
*          NN and DOTYPE, tests will be run with (NB,NSHIFT,NEISP,LDA)=
*          (NNB(1), NSHFTS(1), NEISPS(1), LDAS(1)),...,
*          (NNB(NPARMS), NSHFTS(NPARMS), NEISPS(NPARMS), LDAS(NPARMS))
*
*  NNB     (input) INTEGER array, dimension (NPARMS)
*          The values of the blocksize ("NB") to be tested.  They must
*          be at least 1.  Currently, this is only used by SGEQRF,
*          etc., in the timing of SGGHRD.
*
*  NSHFTS  (input) INTEGER array, dimension (NPARMS)
*          The values of the number of shifts ("NSHIFT") to be tested.
*          (Currently not used.)
*
*  NEISPS  (input) INTEGER array, dimension (NPARMS)
*          The values of "NEISP", the size of largest submatrix to be
*          processed by SLAEQZ (EISPACK method), to be tested.
*          (Currently not used.)
*
*  MINNBS  (input) INTEGER array, dimension (NPARMS)
*          The values of "MINNB", the minimum size of a product of
*          transformations which may be applied as a blocked
*          transformation, to be tested.  (Currently not used.)
*
*  MINBKS  (input) INTEGER array, dimension (NPARMS)
*          The values of "MINBK", the minimum number of rows/columns
*          to be updated with a blocked transformation, to be tested.
*          (Currently not used.)
*
*  LDAS    (input) INTEGER array, dimension (NPARMS)
*          The values of LDA, the leading dimension of all matrices,
*          to be tested.
*
*  TIMMIN  (input) REAL
*          The minimum time a subroutine will be timed.
*
*  NOUT    (input) INTEGER
*          If NOUT > 0 then NOUT specifies the unit number
*          on which the output will be printed.  If NOUT <= 0, no
*          output is printed.
*
*  ISEED   (input/output) INTEGER array, dimension (4)
*          The random seed used by the random number generator, used
*          by the test matrix generator.  It is used and updated on
*          each call to STIM51
*
*  A       (workspace) REAL array, dimension
*                      (max(NN)*max(LDAS))
*          (a) During the testing of SGGHRD, "A", the original
*              left-hand-side matrix to be tested.
*          (b) Later, "S", the Schur form of the original "A" matrix.
*
*  B       (workspace) REAL array, dimension
*                      (max(NN)*max(LDAS))
*          (a) During the testing of SGGHRD, "B", the original
*              right-hand-side matrix to be tested.
*          (b) Later, "P", the Schur form of the original "B" matrix.
*
*  H       (workspace) REAL array, dimension
*                      (max(NN)*max(LDAS))
*          (a) During the testing of SGGHRD and SHGEQZ, "H", the
*              Hessenberg form of the original "A" matrix.
*          (b) During the testing of STGEVC, "L", the matrix of left
*              eigenvectors.
*
*  T       (workspace) REAL array, dimension
*                      (max(NN)*max(LDAS))
*          (a) During the testing of SGGHRD and SHGEQZ, "T", the
*              triangular form of the original "B" matrix.
*          (b) During the testing of STGEVC, "R", the matrix of right
*              eigenvectors.
*
*  Q       (workspace) REAL array, dimension
*                      (max(NN)*max(LDAS))
*          The orthogonal matrix on the left generated by SGGHRD.  If
*          SHGEQZ computes only Q or Z, then that matrix is stored here.
*          If both Q and Z are computed, the Q matrix goes here.
*
*  Z       (workspace) REAL array, dimension
*                      (max(NN)*max(LDAS))
*          The orthogonal matrix on the right generated by SGGHRD.
*          If SHGEQZ computes both Q and Z, the Z matrix is stored here.
*          Also used as scratch space for timing the SLACPY calls.
*
*  W       (workspace) REAL array, dimension (3*max(LDAS))
*          Treated as an LDA x 3 matrix whose 1st and 2nd columns hold
*          ALPHAR and ALPHAI, the real and imaginary parts of the
*          diagonal entries of "S" that would result from reducing "S"
*          and "P" simultaneously to triangular form), and whose 3rd
*          column holds BETA, the diagonal entries of "P" that would so
*          result.
*
*  WORK    (workspace) REAL array, dimension (LWORK)
*
*  LWORK   (input) INTEGER
*          Number of elements in WORK.  It must be at least
*          (a)  6*max(NN)
*          (b)  NSIZES*NTYPES*NPARMS
*
*  LLWORK  (workspace) LOGICAL array, dimension (max( max(NN), NPARMS ))
*
*  TIMES   (output) REAL array, dimension
*                   (LDT1,LDT2,LDT3,NSUBS)
*          TIMES(i,j,k,l) will be set to the run time (in seconds) for
*          subroutine l, with N=NN(k), matrix type j, and LDA=LDAS(i),
*          NEISP=NEISPS(i), NBLOCK=NNB(i), NSHIFT=NSHFTS(i),
*          MINNB=MINNBS(i), and MINBLK=MINBKS(i).
*
*  LDT1    (input) INTEGER
*          The first dimension of TIMES.  LDT1 >= min( 1, NPARMS ).
*
*  LDT2    (input) INTEGER
*          The second dimension of TIMES.  LDT2 >= min( 1, NTYPES ).
*
*  LDT3    (input) INTEGER
*          The third dimension of TIMES.  LDT3 >= min( 1, NSIZES ).
*
*  OPCNTS  (output) REAL array, dimension
*                   (LDO1,LDO2,LDO3,NSUBS)
*          OPCNTS(i,j,k,l) will be set to the number of floating-point
*          operations executed by subroutine l, with N=NN(k), matrix
*          type j, and LDA=LDAS(i), NEISP=NEISPS(i), NBLOCK=NNB(i),
*          NSHIFT=NSHFTS(i), MINNB=MINNBS(i), and MINBLK=MINBKS(i).
*
*  LDO1    (input) INTEGER
*          The first dimension of OPCNTS.  LDO1 >= min( 1, NPARMS ).
*
*  LDO2    (input) INTEGER
*          The second dimension of OPCNTS.  LDO2 >= min( 1, NTYPES ).
*
*  LDO3    (input) INTEGER
*          The third dimension of OPCNTS.  LDO3 >= min( 1, NSIZES ).
*
*  INFO    (output) INTEGER
*          Error flag.  It will be set to zero if no error occurred.
*
*  =====================================================================
*
*     .. Parameters ..
      INTEGER            MAXTYP, NSUBS
      PARAMETER          ( MAXTYP = 4, NSUBS = 18 )
      REAL               ZERO, ONE
      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
*     ..
*     .. Local Scalars ..
      LOGICAL            RUNEQ, RUNES, RUNHES, RUNHRD, RUNQZ
      INTEGER            IC, IINFO, IN, IPAR, ISUB, ITEMP, ITYPE, J, J1,
     $                   J2, J3, J4, JC, JR, LASTL, LDA, LDAMIN, LDH,
     $                   LDQ, LDS, LDW, MINBLK, MINNB, MTYPES, N, N1,
     $                   NB, NBSMAX, NEISP, NMAX, NSHIFT
      REAL               S1, S2, TIME, ULP, UNTIME
*     ..
*     .. Local Arrays ..
      LOGICAL            TIMSUB( NSUBS )
      CHARACTER*6        PNAMES( 6 )
      CHARACTER*11       SUBNAM( NSUBS )
      INTEGER            INPARM( NSUBS ), IOLDSD( 4 ), KATYPE( MAXTYP )
*     ..
*     .. External Functions ..
      REAL               SECOND, SLAMCH, SLARND, SOPLA
      EXTERNAL           SECOND, SLAMCH, SLARND, SOPLA
*     ..
*     .. External Subroutines ..
      EXTERNAL           ATIMIN, QZHES, QZIT, QZVAL, QZVEC, SHGEQZ,
     $                   SLACPY, SLAQZH, SLARFG, SLATM4, SLASET, SORM2R,
     $                   SPRTBG, STGEVC, XLAENV
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          ABS, MAX, MIN, REAL, SIGN
*     ..
*     .. Common blocks ..
      COMMON             / LATIME / OPS, ITCNT
*     ..
*     .. Scalars in Common ..
      REAL               ITCNT, OPS
*     ..
*     .. Data statements ..
      DATA               SUBNAM / 'SGGHRD(N)', 'SGGHRD(Q)', 'SGGHRD(Z)',
     $                   'SGGHRD(Q,Z)', 'SHGEQZ(E)', 'SHGEQZ(S)',
     $                   'SHGEQZ(Q)', 'SHGEQZ(Z)', 'SHGEQZ(Q,Z)',
     $                   'STGEVC(L,A)', 'STGEVC(L,B)', 'STGEVC(R,A)',
     $                   'STGEVC(R,B)', 'QZHES(F)', 'QZHES(T)',
     $                   'QZIT(F)', 'QZIT(T)', 'QZVEC' /
      DATA               INPARM / 4*2, 5*1, 4*1, 5*1 /
      DATA               PNAMES / '   LDA', '    NB', '    NS',
     $                   ' NEISP', ' MINNB', 'MINBLK' /
      DATA               KATYPE / 5, 8, 7, 9 /
*     ..
*     .. Executable Statements ..
*
*     Quick Return
*
      INFO = 0
      IF( NSIZES.LE.0 .OR. NTYPES.LE.0 .OR. NPARMS.LE.0 )
     $   RETURN
*
*     Extract the timing request from the input line.
*
      CALL ATIMIN( 'SHG', LINE, NSUBS, SUBNAM, TIMSUB, NOUT, INFO )
      IF( INFO.NE.0 )
     $   RETURN
*
*     Compute Maximum Values
*
      NMAX = 0
      DO 10 J1 = 1, NSIZES
         NMAX = MAX( NMAX, NN( J1 ) )
   10 CONTINUE
*
      LDAMIN = 2*MAX( 1, NMAX )
      NBSMAX = 0
      DO 20 J1 = 1, NPARMS
         LDAMIN = MIN( LDAMIN, LDAS( J1 ) )
         NBSMAX = MAX( NBSMAX, NNB( J1 )+NSHFTS( J1 ) )
   20 CONTINUE
*
*     Check that N <= LDA for the input values.
*
      IF( NMAX.GT.LDAMIN ) THEN
         INFO = -12
         WRITE( NOUT, FMT = 9999 )LINE( 1: 6 )
 9999    FORMAT( 1X, A, ' timing run not attempted -- N > LDA', / )
         RETURN
      END IF
*
*     Check LWORK
*
      IF( LWORK.LT.MAX( ( NBSMAX+1 )*( 2*NBSMAX+NMAX+1 ), 6*NMAX,
     $    NSIZES*NTYPES*NPARMS ) ) THEN
         INFO = -24
         WRITE( NOUT, FMT = 9998 )LINE( 1: 6 )
 9998    FORMAT( 1X, A, ' timing run not attempted -- LWORK too small.',
     $         / )
         RETURN
      END IF
*
*     Check to see whether SGGHRD or SHGEQZ must be run.
*        RUNHRD -- if SGGHRD must be run.
*        RUNES  -- if SHGEQZ must be run to get Schur form.
*        RUNEQ  -- if SHGEQZ must be run to get Schur form and Q.
*
      RUNHRD = .FALSE.
      RUNES = .FALSE.
      RUNEQ = .FALSE.
*
      IF( TIMSUB( 10 ) .OR. TIMSUB( 12 ) )
     $   RUNES = .TRUE.
      IF( TIMSUB( 11 ) .OR. TIMSUB( 13 ) )
     $   RUNEQ = .TRUE.
      IF( TIMSUB( 5 ) .OR. TIMSUB( 6 ) .OR. TIMSUB( 7 ) .OR.
     $    TIMSUB( 8 ) .OR. TIMSUB( 9 ) .OR. RUNES .OR. RUNEQ )
     $    RUNHRD = .TRUE.
*
      IF( TIMSUB( 6 ) .OR. TIMSUB( 7 ) .OR. TIMSUB( 8 ) .OR.
     $    TIMSUB( 9 ) .OR. RUNEQ )RUNES = .FALSE.
      IF( TIMSUB( 7 ) .OR. TIMSUB( 8 ) .OR. TIMSUB( 9 ) )
     $   RUNEQ = .FALSE.
      IF( TIMSUB( 1 ) .OR. TIMSUB( 2 ) .OR. TIMSUB( 3 ) .OR.
     $    TIMSUB( 4 ) )RUNHRD = .FALSE.
*
*     Check to see whether QZHES or QZIT must be run.
*
*     RUNHES -- if QZHES must be run.
*     RUNQZ  -- if QZIT and QZVAL must be run (w/ MATZ=.TRUE.).
*
      RUNHES = .FALSE.
      RUNQZ = .FALSE.
*
      IF( TIMSUB( 18 ) )
     $   RUNQZ = .TRUE.
      IF( TIMSUB( 16 ) .OR. TIMSUB( 17 ) .OR. RUNQZ )
     $   RUNHES = .TRUE.
      IF( TIMSUB( 17 ) )
     $   RUNQZ = .FALSE.
      IF( TIMSUB( 14 ) .OR. TIMSUB( 15 ) )
     $   RUNHES = .FALSE.
*
*     Various Constants
*
      ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
*
*     Zero out OPCNTS, TIMES
*
      DO 60 J4 = 1, NSUBS
         DO 50 J3 = 1, NSIZES
            DO 40 J2 = 1, NTYPES
               DO 30 J1 = 1, NPARMS
                  OPCNTS( J1, J2, J3, J4 ) = ZERO
                  TIMES( J1, J2, J3, J4 ) = ZERO
   30          CONTINUE
   40       CONTINUE
   50    CONTINUE
   60 CONTINUE
*
*     Do for each value of N:
*
      DO 930 IN = 1, NSIZES
*
         N = NN( IN )
         N1 = MAX( 1, N )
*
*        Do for each .TRUE. value in DOTYPE:
*
         MTYPES = MIN( MAXTYP, NTYPES )
         IF( NTYPES.EQ.MAXTYP+1 .AND. NSIZES.EQ.1 )
     $      MTYPES = NTYPES
         DO 920 ITYPE = 1, MTYPES
            IF( .NOT.DOTYPE( ITYPE ) )
     $         GO TO 920
*
*           Save random number seed for error messages
*
            DO 70 J = 1, 4
               IOLDSD( J ) = ISEED( J )
   70       CONTINUE
*
*           Time the LAPACK Routines
*
*           Generate A and B
*
            IF( ITYPE.LE.MAXTYP ) THEN
*
*              Generate A (w/o rotation)
*
               CALL SLATM4( KATYPE( ITYPE ), N, 3, 1, 2, ONE, ULP, ONE,
     $                      2, ISEED, A, N1 )
               IF( 3.LE.N )
     $            A( 3+2*N1 ) = ONE
*
*              Generate B (w/o rotation)
*
               CALL SLATM4( 8, N, 3, 1, 0, ONE, ONE, ONE, 2, ISEED, B,
     $                      N1 )
               IF( 2.LE.N )
     $            B( 2+N1 ) = ONE
*
               IF( N.GT.0 ) THEN
*
*                 Include rotations
*
*                 Generate U, V as Householder transformations times
*                 a diagonal matrix.
*
                  DO 90 JC = 1, N - 1
                     IC = ( JC-1 )*N1
                     DO 80 JR = JC, N
                        Q( JR+IC ) = SLARND( 3, ISEED )
                        Z( JR+IC ) = SLARND( 3, ISEED )
   80                CONTINUE
                     CALL SLARFG( N+1-JC, Q( JC+IC ), Q( JC+1+IC ), 1,
     $                            WORK( JC ) )
                     WORK( 2*N+JC ) = SIGN( ONE, Q( JC+IC ) )
                     Q( JC+IC ) = ONE
                     CALL SLARFG( N+1-JC, Z( JC+IC ), Z( JC+1+IC ), 1,
     $                            WORK( N+JC ) )
                     WORK( 3*N+JC ) = SIGN( ONE, Z( JC+IC ) )
                     Z( JC+IC ) = ONE
   90             CONTINUE
                  IC = ( N-1 )*N1
                  Q( N+IC ) = ONE
                  WORK( N ) = ZERO
                  WORK( 3*N ) = SIGN( ONE, SLARND( 2, ISEED ) )
                  Z( N+IC ) = ONE
                  WORK( 2*N ) = ZERO
                  WORK( 4*N ) = SIGN( ONE, SLARND( 2, ISEED ) )
*
*                 Apply the diagonal matrices
*
                  DO 110 JC = 1, N
                     DO 100 JR = 1, N
                        A( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
     $                               A( JR+IC )
                        B( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
     $                               B( JR+IC )
  100                CONTINUE
  110             CONTINUE
                  CALL SORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, A, N1,
     $                         WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 120
                  CALL SORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
     $                         A, N1, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 120
                  CALL SORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, B, N1,
     $                         WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 120
                  CALL SORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
     $                         B, N1, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 120
               END IF
  120          CONTINUE
            END IF
*
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
*
*           Time SGGHRD
*
*           Time SGEQRF+SGGHRD('N','N',...) for each pair
*           (LDAS(j),NNB(j))
*
            IF( TIMSUB( 1 ) ) THEN
               DO 160 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  NB = NNB( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 1 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 1 ) = ZERO
                     GO TO 160
                  END IF
*
*                 If this value of (NB,LDA) has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 130 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
     $                  LASTL = J
  130             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time SGGHRD, computing neither Q nor Z
*                    (Actually, time SGEQRF + SORMQR + SGGHRD.)
*
                     CALL XLAENV( 1, NB )
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  140                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, N1, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, N1, T, LDA )
                     CALL SLAQZH( .FALSE., .FALSE., N, 1, N, H, LDA, T,
     $                            LDA, Q, LDA, Z, LDA, WORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 1 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
*
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 140
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 150 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, N1, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, N1, Z, LDA )
  150                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 1 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 1 ) = OPS / REAL( IC ) +
     $                  SOPLA( 'SGEQRF', N, N, 0, 0, NB ) +
     $                  SOPLA( 'SORMQR', N, N, 0, 0, NB )
                     LDH = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 1 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 1 )
                     TIMES( IPAR, ITYPE, IN, 1 ) = TIMES( LASTL, ITYPE,
     $                  IN, 1 )
                  END IF
  160          CONTINUE
            ELSE IF( RUNHRD ) THEN
               CALL SLACPY( 'Full', N, N, A, N1, H, N1 )
               CALL SLACPY( 'Full', N, N, B, N1, T, N1 )
               CALL SLAQZH( .FALSE., .FALSE., N, 1, N, H, N1, T, N1, Q,
     $                      N1, Z, N1, WORK, IINFO )
               IF( IINFO.NE.0 ) THEN
                  WRITE( NOUT, FMT = 9997 )SUBNAM( 1 ), IINFO, N,
     $               ITYPE, 0, IOLDSD
                  INFO = ABS( IINFO )
                  GO TO 920
               END IF
               LDH = N
            END IF
*
*           Time SGGHRD('I','N',...) for each pair (LDAS(j),NNB(j))
*
            IF( TIMSUB( 2 ) ) THEN
               DO 200 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  NB = NNB( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 2 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 2 ) = ZERO
                     GO TO 200
                  END IF
*
*                 If this value of (NB,LDA) has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 170 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
     $                  LASTL = J
  170             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time SGGHRD, computing Q but not Z
*                    (Actually, SGEQRF + SORMQR + SORGQR + SGGHRD.)
*
                     CALL XLAENV( 1, NB )
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  180                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, N1, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, N1, T, LDA )
                     CALL SLAQZH( .TRUE., .FALSE., N, 1, N, H, LDA, T,
     $                            LDA, Q, LDA, Z, LDA, WORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 2 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
*
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 180
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 190 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, N1, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, N1, Z, LDA )
  190                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 2 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 2 ) = OPS / REAL( IC ) +
     $                  SOPLA( 'SGEQRF', N, N, 0, 0, NB ) +
     $                  SOPLA( 'SORMQR', N, N, 0, 0, NB ) +
     $                  SOPLA( 'SORGQR', N, N, 0, 0, NB )
                     LDH = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 2 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 2 )
                     TIMES( IPAR, ITYPE, IN, 2 ) = TIMES( LASTL, ITYPE,
     $                  IN, 2 )
                  END IF
  200          CONTINUE
            END IF
*
*           Time SGGHRD('N','I',...) for each pair (LDAS(j),NNB(j))
*
            IF( TIMSUB( 3 ) ) THEN
               DO 240 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  NB = NNB( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 3 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 3 ) = ZERO
                     GO TO 240
                  END IF
*
*                 If this value of (NB,LDA) has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 210 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
     $                  LASTL = J
  210             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time SGGHRD, computing Z but not Q
*                    (Actually, SGEQRF + SORMQR + SGGHRD.)
*
                     CALL XLAENV( 1, NB )
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  220                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, N1, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, N1, T, LDA )
                     CALL SLAQZH( .FALSE., .TRUE., N, 1, N, H, LDA, T,
     $                            LDA, Q, LDA, Z, LDA, WORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 3 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
*
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 220
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 230 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, N1, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, N1, Z, LDA )
  230                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 3 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 3 ) = OPS / REAL( IC ) +
     $                  SOPLA( 'SGEQRF', N, N, 0, 0, NB ) +
     $                  SOPLA( 'SORMQR', N, N, 0, 0, NB )
                     LDH = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 3 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 3 )
                     TIMES( IPAR, ITYPE, IN, 3 ) = TIMES( LASTL, ITYPE,
     $                  IN, 3 )
                  END IF
  240          CONTINUE
            END IF
*
*           Time SGGHRD('I','I',...) for each pair (LDAS(j),NNB(j))
*
            IF( TIMSUB( 4 ) ) THEN
               DO 280 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  NB = NNB( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 4 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 4 ) = ZERO
                     GO TO 280
                  END IF
*
*                 If this value of (NB,LDA) has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 250 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) .AND. NB.EQ.NNB( J ) )
     $                  LASTL = J
  250             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time SGGHRD, computing Q and Z
*                    (Actually, SGEQRF + SORMQR + SORGQR + SGGHRD.)
*
                     CALL XLAENV( 1, NB )
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  260                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, N1, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, N1, T, LDA )
                     CALL SLAQZH( .TRUE., .TRUE., N, 1, N, H, LDA, T,
     $                            LDA, Q, LDA, Z, LDA, WORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 4 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
*
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 260
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 270 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, N1, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, N1, Z, LDA )
  270                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 4 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 4 ) = OPS / REAL( IC ) +
     $                  SOPLA( 'SGEQRF', N, N, 0, 0, NB ) +
     $                  SOPLA( 'SORMQR', N, N, 0, 0, NB ) +
     $                  SOPLA( 'SORGQR', N, N, 0, 0, NB )
                     LDH = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 4 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 4 )
                     TIMES( IPAR, ITYPE, IN, 4 ) = TIMES( LASTL, ITYPE,
     $                  IN, 4 )
                  END IF
  280          CONTINUE
            END IF
*
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
*
*           Time SHGEQZ
*
*           Time SHGEQZ with JOB='E' for each value of LDAS(j)
*
            IF( TIMSUB( 5 ) ) THEN
               DO 320 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 5 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 5 ) = ZERO
                     GO TO 320
                  END IF
*
*                 If this value of LDA has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 290 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  290             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time SHGEQZ with JOB='E'
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  300                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL SHGEQZ( 'E', 'N', 'N', N, 1, N, A, LDA, B,
     $                            LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
     $                            LDA, Z, LDA, WORK, LWORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 5 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 300
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 310 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
  310                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 5 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 5 ) = OPS / REAL( IC )
                     LDS = 0
                     LDQ = 0
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 5 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 5 )
                     TIMES( IPAR, ITYPE, IN, 5 ) = TIMES( LASTL, ITYPE,
     $                  IN, 5 )
                  END IF
  320          CONTINUE
            END IF
*
*           Time SHGEQZ with JOB='S', COMPQ=COMPZ='N' for each value
*           of LDAS(j)
*
            IF( TIMSUB( 6 ) ) THEN
               DO 360 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 6 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 6 ) = ZERO
                     GO TO 360
                  END IF
*
*                 If this value of LDA has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 330 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  330             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                 Time SHGEQZ with JOB='S', COMPQ=COMPZ='N'
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  340                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL SHGEQZ( 'S', 'N', 'N', N, 1, N, A, LDA, B,
     $                            LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
     $                            LDA, Z, LDA, WORK, LWORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 6 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 340
*
*                 Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 350 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
  350                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 6 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 6 ) = OPS / REAL( IC )
                     LDS = LDA
                     LDQ = 0
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 6 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 6 )
                     TIMES( IPAR, ITYPE, IN, 6 ) = TIMES( LASTL, ITYPE,
     $                  IN, 6 )
                  END IF
  360          CONTINUE
            ELSE IF( RUNES ) THEN
               CALL SLACPY( 'Full', N, N, H, LDH, A, N1 )
               CALL SLACPY( 'Full', N, N, T, LDH, B, N1 )
               CALL SHGEQZ( 'S', 'N', 'N', N, 1, N, A, N1, B, N1, W,
     $                      W( N1+1 ), W( 2*N1+1 ), Q, N1, Z, N1, WORK,
     $                      LWORK, IINFO )
               IF( IINFO.NE.0 ) THEN
                  WRITE( NOUT, FMT = 9997 )SUBNAM( 6 ), IINFO, N,
     $               ITYPE, 0, IOLDSD
                  INFO = ABS( IINFO )
                  GO TO 920
               END IF
               LDS = N1
               LDQ = 0
            END IF
*
*           Time SHGEQZ with JOB='S', COMPQ='I', COMPZ='N' for each
*           value of LDAS(j)
*
            IF( TIMSUB( 7 ) ) THEN
               DO 400 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 7 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 7 ) = ZERO
                     GO TO 400
                  END IF
*
*                 If this value of LDA has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 370 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  370             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                 Time SHGEQZ with JOB='S', COMPQ='I', COMPZ='N'
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  380                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL SHGEQZ( 'S', 'I', 'N', N, 1, N, A, LDA, B,
     $                            LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
     $                            LDA, Z, LDA, WORK, LWORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 7 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 380
*
*                 Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 390 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
  390                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 7 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 7 ) = OPS / REAL( IC )
                     LDS = LDA
                     LDQ = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 7 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 7 )
                     TIMES( IPAR, ITYPE, IN, 7 ) = TIMES( LASTL, ITYPE,
     $                  IN, 7 )
                  END IF
  400          CONTINUE
            ELSE IF( RUNEQ ) THEN
               CALL SLACPY( 'Full', N, N, H, LDH, A, N1 )
               CALL SLACPY( 'Full', N, N, T, LDH, B, N1 )
               CALL SHGEQZ( 'S', 'I', 'N', N, 1, N, A, N1, B, N1, W,
     $                      W( N1+1 ), W( 2*N1+1 ), Q, N1, Z, N1, WORK,
     $                      LWORK, IINFO )
               IF( IINFO.NE.0 ) THEN
                  WRITE( NOUT, FMT = 9997 )SUBNAM( 7 ), IINFO, N,
     $               ITYPE, 0, IOLDSD
                  INFO = ABS( IINFO )
                  GO TO 920
               END IF
               LDS = N1
               LDQ = N1
            END IF
*
*           Time SHGEQZ with JOB='S', COMPQ='N', COMPZ='I' for each
*           value of LDAS(j)
*
            IF( TIMSUB( 8 ) ) THEN
               DO 440 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 8 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 8 ) = ZERO
                     GO TO 440
                  END IF
*
*                 If this value of LDA has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 410 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  410             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
                     NB = MIN( N, NNB( IPAR ) )
                     NSHIFT = NSHFTS( IPAR )
                     NEISP = NEISPS( IPAR )
                     MINNB = MINNBS( IPAR )
                     MINBLK = MINBKS( IPAR )
*
*                 Time SHGEQZ with JOB='S', COMPQ='N', COMPZ='I'
*                 (Note that the "Z" matrix is stored in the array Q)
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  420                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL SHGEQZ( 'S', 'N', 'I', N, 1, N, A, LDA, B,
     $                            LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Z,
     $                            LDA, Q, LDA, WORK, LWORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 8 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 420
*
*                 Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 430 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
  430                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 8 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 8 ) = OPS / REAL( IC )
                     LDS = LDA
                     LDQ = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 8 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 8 )
                     TIMES( IPAR, ITYPE, IN, 8 ) = TIMES( LASTL, ITYPE,
     $                  IN, 8 )
                  END IF
  440          CONTINUE
            END IF
*
*           Time SHGEQZ with JOB='S', COMPQ='I', COMPZ='I' for each
*           value of LDAS(j)
*
            IF( TIMSUB( 9 ) ) THEN
               DO 480 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 9 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 9 ) = ZERO
                     GO TO 480
                  END IF
*
*                 If this value of LDA has occurred before,
*                 just use that value.
*
                  LASTL = 0
                  DO 450 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  450             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                 Time SHGEQZ with JOB='S', COMPQ='I', COMPZ='I'
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  460                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL SHGEQZ( 'S', 'I', 'I', N, 1, N, A, LDA, B,
     $                            LDA, W, W( LDA+1 ), W( 2*LDA+1 ), Q,
     $                            LDA, Z, LDA, WORK, LWORK, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 9 ), IINFO, N,
     $                     ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 460
*
*                 Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 470 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
  470                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 9 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 9 ) = OPS / REAL( IC )
                     LDS = LDA
                     LDQ = LDA
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 9 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 9 )
                     TIMES( IPAR, ITYPE, IN, 9 ) = TIMES( LASTL, ITYPE,
     $                  IN, 9 )
                  END IF
  480          CONTINUE
            END IF
*
* . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
*
*           Time STGEVC
*
            IF( TIMSUB( 10 ) .OR. TIMSUB( 11 ) .OR. TIMSUB( 12 ) .OR.
     $          TIMSUB( 13 ) ) THEN
               DO 610 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     DO 490 J = 10, 13
                        IF( TIMSUB( J ) ) THEN
                           TIMES( IPAR, ITYPE, IN, J ) = ZERO
                           OPCNTS( IPAR, ITYPE, IN, J ) = ZERO
                        END IF
  490                CONTINUE
                     GO TO 610
                  END IF
*
*                 If this value of LDA has come up before, just use
*                 the value previously computed.
*
                  LASTL = 0
                  DO 500 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  500             CONTINUE
*
*                 Time STGEVC if this is a new value of LDA
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Copy S (which is in A) and P (which is in B)
*                    if necessary to get right LDA.
*
                     IF( LDA.GT.LDS ) THEN
                        DO 520 JC = N, 1, -1
                           DO 510 JR = N, 1, -1
                              A( JR+( JC-1 )*LDA ) = A( JR+( JC-1 )*
     $                           LDS )
                              B( JR+( JC-1 )*LDA ) = B( JR+( JC-1 )*
     $                           LDS )
  510                      CONTINUE
  520                   CONTINUE
                     ELSE IF( LDA.LT.LDS ) THEN
                        DO 540 JC = 1, N
                           DO 530 JR = 1, N
                              A( JR+( JC-1 )*LDA ) = A( JR+( JC-1 )*
     $                           LDS )
                              B( JR+( JC-1 )*LDA ) = B( JR+( JC-1 )*
     $                           LDS )
  530                      CONTINUE
  540                   CONTINUE
                     END IF
                     LDS = LDA
*
*                    Time STGEVC for Left Eigenvectors only,
*                    without back transforming
*
                     IF( TIMSUB( 10 ) ) THEN
                        IC = 0
                        OPS = ZERO
                        S1 = SECOND( )
  550                   CONTINUE
                        CALL STGEVC( 'L', 'A', LLWORK, N, A, LDA, B,
     $                               LDA, H, LDA, T, LDA, N, ITEMP,
     $                               WORK, IINFO )
                        IF( IINFO.NE.0 ) THEN
                           WRITE( NOUT, FMT = 9997 )SUBNAM( 10 ),
     $                        IINFO, N, ITYPE, IPAR, IOLDSD
                           INFO = ABS( IINFO )
                           GO TO 920
                        END IF
                        S2 = SECOND( )
                        TIME = S2 - S1
                        IC = IC + 1
                        IF( TIME.LT.TIMMIN )
     $                     GO TO 550
*
                        TIMES( IPAR, ITYPE, IN, 10 ) = TIME / REAL( IC )
                        OPCNTS( IPAR, ITYPE, IN, 10 ) = OPS / REAL( IC )
                     END IF
*
*                    Time STGEVC for Left Eigenvectors only,
*                    with back transforming
*
                     IF( TIMSUB( 11 ) ) THEN
                        IC = 0
                        OPS = ZERO
                        S1 = SECOND( )
  560                   CONTINUE
                        CALL SLACPY( 'Full', N, N, Q, LDQ, H, LDA )
                        CALL STGEVC( 'L', 'B', LLWORK, N, A, LDA, B,
     $                               LDA, H, LDA, T, LDA, N, ITEMP,
     $                               WORK, IINFO )
                        IF( IINFO.NE.0 ) THEN
                           WRITE( NOUT, FMT = 9997 )SUBNAM( 11 ),
     $                        IINFO, N, ITYPE, IPAR, IOLDSD
                           INFO = ABS( IINFO )
                           GO TO 920
                        END IF
                        S2 = SECOND( )
                        TIME = S2 - S1
                        IC = IC + 1
                        IF( TIME.LT.TIMMIN )
     $                     GO TO 560
*
*                       Subtract the time used in SLACPY.
*
                        S1 = SECOND( )
                        DO 570 J = 1, IC
                           CALL SLACPY( 'Full', N, N, Q, LDQ, H, LDA )
  570                   CONTINUE
                        S2 = SECOND( )
                        UNTIME = S2 - S1
*
                        TIMES( IPAR, ITYPE, IN, 11 ) = MAX( TIME-UNTIME,
     $                     ZERO ) / REAL( IC )
                        OPCNTS( IPAR, ITYPE, IN, 11 ) = OPS / REAL( IC )
                     END IF
*
*                    Time STGEVC for Right Eigenvectors only,
*                    without back transforming
*
                     IF( TIMSUB( 12 ) ) THEN
                        IC = 0
                        OPS = ZERO
                        S1 = SECOND( )
  580                   CONTINUE
                        CALL STGEVC( 'R', 'A', LLWORK, N, A, LDA, B,
     $                               LDA, H, LDA, T, LDA, N, ITEMP,
     $                               WORK, IINFO )
                        IF( IINFO.NE.0 ) THEN
                           WRITE( NOUT, FMT = 9997 )SUBNAM( 12 ),
     $                        IINFO, N, ITYPE, IPAR, IOLDSD
                           INFO = ABS( IINFO )
                           GO TO 920
                        END IF
                        S2 = SECOND( )
                        TIME = S2 - S1
                        IC = IC + 1
                        IF( TIME.LT.TIMMIN )
     $                     GO TO 580
*
                        TIMES( IPAR, ITYPE, IN, 12 ) = TIME / REAL( IC )
                        OPCNTS( IPAR, ITYPE, IN, 12 ) = OPS / REAL( IC )
                     END IF
*
*                    Time STGEVC for Right Eigenvectors only,
*                    with back transforming
*
                     IF( TIMSUB( 13 ) ) THEN
                        IC = 0
                        OPS = ZERO
                        S1 = SECOND( )
  590                   CONTINUE
                        CALL SLACPY( 'Full', N, N, Q, LDQ, T, LDA )
                        CALL STGEVC( 'R', 'B', LLWORK, N, A, LDA, B,
     $                               LDA, H, LDA, T, LDA, N, ITEMP,
     $                               WORK, IINFO )
                        IF( IINFO.NE.0 ) THEN
                           WRITE( NOUT, FMT = 9997 )SUBNAM( 13 ),
     $                        IINFO, N, ITYPE, IPAR, IOLDSD
                           INFO = ABS( IINFO )
                           GO TO 920
                        END IF
                        S2 = SECOND( )
                        TIME = S2 - S1
                        IC = IC + 1
                        IF( TIME.LT.TIMMIN )
     $                     GO TO 590
*
*                       Subtract the time used in SLACPY.
*
                        S1 = SECOND( )
                        DO 600 J = 1, IC
                           CALL SLACPY( 'Full', N, N, Q, LDQ, T, LDA )
  600                   CONTINUE
                        S2 = SECOND( )
                        UNTIME = S2 - S1
*
                        TIMES( IPAR, ITYPE, IN, 13 ) = MAX( TIME-UNTIME,
     $                     ZERO ) / REAL( IC )
                        OPCNTS( IPAR, ITYPE, IN, 13 ) = OPS / REAL( IC )
                     END IF
*
                  ELSE
*
*                    If this LDA has previously appeared, use the
*                    previously computed value(s).
*
                     IF( TIMSUB( 10 ) ) THEN
                        OPCNTS( IPAR, ITYPE, IN, 10 ) = OPCNTS( LASTL,
     $                     ITYPE, IN, 10 )
                        TIMES( IPAR, ITYPE, IN, 10 ) = TIMES( LASTL,
     $                     ITYPE, IN, 10 )
                     END IF
                     IF( TIMSUB( 11 ) ) THEN
                        OPCNTS( IPAR, ITYPE, IN, 11 ) = OPCNTS( LASTL,
     $                     ITYPE, IN, 11 )
                        TIMES( IPAR, ITYPE, IN, 11 ) = TIMES( LASTL,
     $                     ITYPE, IN, 11 )
                     END IF
                     IF( TIMSUB( 12 ) ) THEN
                        OPCNTS( IPAR, ITYPE, IN, 12 ) = OPCNTS( LASTL,
     $                     ITYPE, IN, 12 )
                        TIMES( IPAR, ITYPE, IN, 12 ) = TIMES( LASTL,
     $                     ITYPE, IN, 12 )
                     END IF
                     IF( TIMSUB( 13 ) ) THEN
                        OPCNTS( IPAR, ITYPE, IN, 13 ) = OPCNTS( LASTL,
     $                     ITYPE, IN, 13 )
                        TIMES( IPAR, ITYPE, IN, 13 ) = TIMES( LASTL,
     $                     ITYPE, IN, 13 )
                     END IF
                  END IF
  610          CONTINUE
            END IF
*
*           Time the EISPACK Routines
*
*           Restore random number seed
*
            DO 620 J = 1, 4
               ISEED( J ) = IOLDSD( J )
  620       CONTINUE
*
*           Re-generate A
*
            IF( ITYPE.LE.MAXTYP ) THEN
*
*              Generate A (w/o rotation)
*
               CALL SLATM4( KATYPE( ITYPE ), N, 3, 1, 2, ONE, ULP, ONE,
     $                      2, ISEED, A, N1 )
               IF( 3.LE.N )
     $            A( 3+2*N1 ) = ONE
*
*              Generate B (w/o rotation)
*
               CALL SLATM4( 8, N, 3, 1, 0, ONE, ONE, ONE, 2, ISEED, B,
     $                      N1 )
               IF( 2.LE.N )
     $            B( 2+N1 ) = ONE
*
               IF( N.GT.0 ) THEN
*
*                 Include rotations
*
*                 Generate U, V as Householder transformations times
*                 a diagonal matrix.
*
                  DO 640 JC = 1, N - 1
                     IC = ( JC-1 )*N1
                     DO 630 JR = JC, N
                        Q( JR+IC ) = SLARND( 3, ISEED )
                        Z( JR+IC ) = SLARND( 3, ISEED )
  630                CONTINUE
                     CALL SLARFG( N+1-JC, Q( JC+IC ), Q( JC+1+IC ), 1,
     $                            WORK( JC ) )
                     WORK( 2*N+JC ) = SIGN( ONE, Q( JC+IC ) )
                     Q( JC+IC ) = ONE
                     CALL SLARFG( N+1-JC, Z( JC+IC ), Z( JC+1+IC ), 1,
     $                            WORK( N+JC ) )
                     WORK( 3*N+JC ) = SIGN( ONE, Z( JC+IC ) )
                     Z( JC+IC ) = ONE
  640             CONTINUE
                  IC = ( N-1 )*N1
                  Q( N+IC ) = ONE
                  WORK( N ) = ZERO
                  WORK( 3*N ) = SIGN( ONE, SLARND( 2, ISEED ) )
                  Z( N+IC ) = ONE
                  WORK( 2*N ) = ZERO
                  WORK( 4*N ) = SIGN( ONE, SLARND( 2, ISEED ) )
*
*                 Apply the diagonal matrices
*
                  DO 660 JC = 1, N
                     DO 650 JR = 1, N
                        A( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
     $                               A( JR+IC )
                        B( JR+IC ) = WORK( 2*N+JR )*WORK( 3*N+JC )*
     $                               B( JR+IC )
  650                CONTINUE
  660             CONTINUE
                  CALL SORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, A, N1,
     $                         WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 670
                  CALL SORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
     $                         A, N1, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 670
                  CALL SORM2R( 'L', 'N', N, N, N-1, Q, N1, WORK, B, N1,
     $                         WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 670
                  CALL SORM2R( 'R', 'T', N, N, N-1, Z, N1, WORK( N+1 ),
     $                         B, N1, WORK( 2*N+1 ), IINFO )
                  IF( IINFO.NE.0 )
     $               GO TO 670
               END IF
  670          CONTINUE
            END IF
*
*           Time QZHES w/ MATZ=.FALSE. for each LDAS(j)
*
            IF( TIMSUB( 14 ) ) THEN
               DO 710 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 14 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 14 ) = ZERO
                     GO TO 710
                  END IF
*
*                 If this value of LDA has come up before, just use
*                 the value previously computed.
*
                  LASTL = 0
                  DO 680 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  680             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time QZHES( ...,.FALSE.,..)
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  690                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, N1, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, N1, T, LDA )
                     CALL QZHES( LDA, N, H, T, .FALSE., Q )
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 690
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 700 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, N1, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, N1, Z, LDA )
  700                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 14 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 14 ) = OPS / REAL( IC )
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 14 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 14 )
                     TIMES( IPAR, ITYPE, IN, 14 ) = TIMES( LASTL, ITYPE,
     $                  IN, 14 )
                  END IF
                  LDH = LDA
  710          CONTINUE
            ELSE IF( RUNHES ) THEN
               CALL SLACPY( 'Full', N, N, A, N1, H, N1 )
               CALL SLACPY( 'Full', N, N, B, N1, T, N1 )
               CALL QZHES( N1, N, H, T, .FALSE., Q )
               LDH = N1
            END IF
*
*           Time QZHES w/ MATZ=.TRUE. for each LDAS(j)
*
            IF( TIMSUB( 15 ) ) THEN
               DO 750 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 15 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 15 ) = ZERO
                     GO TO 750
                  END IF
*
*                 If this value of LDA has come up before, just use
*                 the value previously computed.
*
                  LASTL = 0
                  DO 720 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  720             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time QZHES( ...,.TRUE.,..)
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  730                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, N1, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, N1, T, LDA )
                     CALL QZHES( LDA, N, H, T, .TRUE., Q )
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 730
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 740 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, N1, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, N1, Z, LDA )
  740                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 15 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 15 ) = OPS / REAL( IC )
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 15 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 15 )
                     TIMES( IPAR, ITYPE, IN, 15 ) = TIMES( LASTL, ITYPE,
     $                  IN, 15 )
                  END IF
                  LDH = LDA
  750          CONTINUE
            END IF
*
*           Time QZIT and QZVAL w/ MATZ=.FALSE. for each LDAS(j)
*
            IF( TIMSUB( 16 ) ) THEN
               DO 790 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 16 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 16 ) = ZERO
                     GO TO 790
                  END IF
*
*                 If this value of LDA has come up before, just use
*                 the value previously computed.
*
                  LASTL = 0
                  DO 760 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  760             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time QZIT and QZVAL with MATZ=.FALSE.
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  770                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL QZIT( LDA, N, A, B, ZERO, .FALSE., Q, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 16 ), IINFO,
     $                     N, ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
*
                     CALL QZVAL( LDA, N, A, B, W, W( LDA+1 ),
     $                           W( 2*LDA+1 ), .FALSE., Q )
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 770
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 780 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
  780                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 16 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 16 ) = OPS / REAL( IC )
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 16 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 16 )
                     TIMES( IPAR, ITYPE, IN, 16 ) = TIMES( LASTL, ITYPE,
     $                  IN, 16 )
                  END IF
                  LDS = 0
  790          CONTINUE
            END IF
*
*           Time QZIT and QZVAL w/ MATZ=.TRUE. for each LDAS(j)
*
            IF( TIMSUB( 17 ) ) THEN
               DO 830 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 17 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 17 ) = ZERO
                     GO TO 830
                  END IF
*
*                 If this value of LDA has come up before, just use
*                 the value previously computed.
*
                  LASTL = 0
                  DO 800 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  800             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Time QZIT and QZVAL with MATZ=.TRUE.
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  810                CONTINUE
                     CALL SLACPY( 'Full', N, N, H, LDH, A, LDA )
                     CALL SLACPY( 'Full', N, N, T, LDH, B, LDA )
                     CALL SLASET( 'Full', N, N, ZERO, ONE, Q, LDA )
                     CALL QZIT( LDA, N, A, B, ZERO, .TRUE., Q, IINFO )
                     IF( IINFO.NE.0 ) THEN
                        WRITE( NOUT, FMT = 9997 )SUBNAM( 17 ), IINFO,
     $                     N, ITYPE, IPAR, IOLDSD
                        INFO = ABS( IINFO )
                        GO TO 920
                     END IF
*
                     CALL QZVAL( LDA, N, A, B, W, W( LDA+1 ),
     $                           W( 2*LDA+1 ), .TRUE., Q )
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 810
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 820 J = 1, IC
                        CALL SLACPY( 'Full', N, N, H, LDH, Z, LDA )
                        CALL SLACPY( 'Full', N, N, T, LDH, Z, LDA )
                        CALL SLASET( 'Full', N, N, ZERO, ONE, Z, LDA )
  820                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 17 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 17 ) = OPS / REAL( IC )
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 17 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 17 )
                     TIMES( IPAR, ITYPE, IN, 17 ) = TIMES( LASTL, ITYPE,
     $                  IN, 17 )
                  END IF
                  LDS = LDA
                  LDW = LDA
  830          CONTINUE
            ELSE IF( RUNQZ ) THEN
               CALL SLACPY( 'Full', N, N, H, LDH, A, N1 )
               CALL SLACPY( 'Full', N, N, T, LDH, B, N1 )
               CALL SLASET( 'Full', N, N, ZERO, ONE, Q, N1 )
               CALL QZIT( N1, N, A, B, ZERO, .TRUE., Q, IINFO )
               IF( IINFO.NE.0 ) THEN
                  WRITE( NOUT, FMT = 9997 )SUBNAM( 17 ), IINFO, N,
     $               ITYPE, IPAR, IOLDSD
                  INFO = ABS( IINFO )
                  GO TO 920
               END IF
*
               CALL QZVAL( N1, N, A, B, W, W( N1+1 ), W( 2*N1+1 ),
     $                     .TRUE., Q )
               LDS = N1
               LDW = N1
            END IF
*
*           Time QZVEC for each LDAS(j)
*
            IF( TIMSUB( 18 ) ) THEN
               DO 910 IPAR = 1, NPARMS
                  LDA = LDAS( IPAR )
                  IF( LDA.LT.N1 ) THEN
                     TIMES( IPAR, ITYPE, IN, 18 ) = ZERO
                     OPCNTS( IPAR, ITYPE, IN, 18 ) = ZERO
                     GO TO 910
                  END IF
*
*                 If this value of LDA has come up before, just use
*                 the value previously computed.
*
                  LASTL = 0
                  DO 840 J = 1, IPAR - 1
                     IF( LDA.EQ.LDAS( J ) )
     $                  LASTL = J
  840             CONTINUE
*
                  IF( LASTL.EQ.0 ) THEN
*
*                    Copy W if necessary to get right LDA.
*
                     IF( LDA.GT.LDW ) THEN
                        DO 860 JC = 3, 1, -1
                           DO 850 JR = N, 1, -1
                              W( JR+( JC-1 )*LDA ) = W( JR+( JC-1 )*
     $                           LDW )
  850                      CONTINUE
  860                   CONTINUE
                     ELSE IF( LDA.LT.LDW ) THEN
                        DO 880 JC = 1, 3
                           DO 870 JR = 1, N
                              W( JR+( JC-1 )*LDA ) = W( JR+( JC-1 )*
     $                           LDW )
  870                      CONTINUE
  880                   CONTINUE
                     END IF
                     LDW = LDA
*
*                    Time QZVEC
*
                     IC = 0
                     OPS = ZERO
                     S1 = SECOND( )
  890                CONTINUE
                     CALL SLACPY( 'Full', N, N, A, LDS, H, LDA )
                     CALL SLACPY( 'Full', N, N, B, LDS, T, LDA )
                     CALL SLACPY( 'Full', N, N, Q, LDS, Z, LDA )
                     CALL QZVEC( LDA, N, H, T, W, W( LDA+1 ),
     $                           W( 2*LDA+1 ), Z )
                     S2 = SECOND( )
                     TIME = S2 - S1
                     IC = IC + 1
                     IF( TIME.LT.TIMMIN )
     $                  GO TO 890
*
*                    Subtract the time used in SLACPY.
*
                     S1 = SECOND( )
                     DO 900 J = 1, IC
                        CALL SLACPY( 'Full', N, N, A, LDS, Z, LDA )
                        CALL SLACPY( 'Full', N, N, B, LDS, Z, LDA )
                        CALL SLACPY( 'Full', N, N, Q, LDS, Z, LDA )
  900                CONTINUE
                     S2 = SECOND( )
                     UNTIME = S2 - S1
*
                     TIMES( IPAR, ITYPE, IN, 18 ) = MAX( TIME-UNTIME,
     $                  ZERO ) / REAL( IC )
                     OPCNTS( IPAR, ITYPE, IN, 18 ) = OPS / REAL( IC )
                  ELSE
                     OPCNTS( IPAR, ITYPE, IN, 18 ) = OPCNTS( LASTL,
     $                  ITYPE, IN, 18 )
                     TIMES( IPAR, ITYPE, IN, 18 ) = TIMES( LASTL, ITYPE,
     $                  IN, 18 )
                  END IF
  910          CONTINUE
            END IF
*
  920    CONTINUE
  930 CONTINUE
*
*     Print a table of results for each timed routine.
*
      DO 940 ISUB = 1, NSUBS
         IF( TIMSUB( ISUB ) ) THEN
            CALL SPRTBG( SUBNAM( ISUB ), MTYPES, DOTYPE, NSIZES, NN,
     $                   INPARM( ISUB ), PNAMES, NPARMS, LDAS, NNB,
     $                   NSHFTS, NEISPS, MINNBS, MINBKS,
     $                   OPCNTS( 1, 1, 1, ISUB ), LDO1, LDO2,
     $                   TIMES( 1, 1, 1, ISUB ), LDT1, LDT2, WORK,
     $                   LLWORK, NOUT )
         END IF
  940 CONTINUE
*
      RETURN
*
*     End of STIM51
*
 9997 FORMAT( ' STIM51: ', A, ' returned INFO=', I6, '.', / 9X, 'N=',
     $      I6, ', ITYPE=', I6, ', IPAR=', I6, ', ISEED=(',
     $      3( I5, ',' ), I5, ')' )
*
      END