c
c*******************************************************************************
c
      subroutine ARRAY ( A, nr, nc, ldA, name, iwlp, mou )
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c      Authors  L. Feldman and J Dunphey, with alterations by  B.W. Rust
c
c  ARRAY is an output subroutine which prints a single precision matrix.
c  The arguments are:
c
c         A      single precision matrix array to be listed.
c
c         nr     integer number of rows of A.
c
c         nc     integer number of columns of A.
c
c         ldA    integer first dimension of A in calling program, 
c                         i.e. A(ldA,*) or A(ldA)
c
c         name   character string heading for the matrix A.
c
c         iwlp   integer print flag
c                =  0 , to print on standard output only
c                =  1 , to print on standard output and unit mou as well
c                = -1 , to print on unit mou only
c
c         mou    integer unit for line printer output
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      character*(*)  name
      character*8 column
c
      dimension A(*)
c
      logical ip
c
      data column /'column  '/
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      if ( iwlp .ne. 0 ) then 
                              ip = .true.
                         else 
                              ip = .false.
      end if
c
      do 3 ml = 1,nc,5
c
         mh = ml + 4
         if ( nc .lt. mh ) mh = nc
         mlm1 = (ml-1)*ldA
         mhm1 = (mh-1)*ldA
c
         do 3 li = 1,nr,100
c
            nl = li
            nh = nl + 99
            if ( nr .lt. nh ) nh = nr
            if ( iwlp .ge. 0 ) print 100, name 
            if ( ip )     write (mou,100) name
            if ( iwlp .ge. 0) print 200, ( column, j, j=ml,mh )
            if ( ip )    write (mou,200) ( column, j, j=ml,mh )
            if ( iwlp .ge. 0 ) print 300
            if ( ip )     write (mou,300)
c 
            do 3 l=nl,nh
c
               mml = mlm1 + l
               mmh = mhm1 + l
               if ( iwlp .ge. 0) print 400, l, ( A(j), j=mml,mmh,ldA )
               if ( ip )    write (mou,400) l, ( A(j), j=mml,mmh,ldA )
c
    3 continue
c
  100 format (' '/' '/' ', a ) 
  200 format (' '/' row', 2x, 5( a6, i4, 4x ) )
  300 format (' ')
  400 format (' ', i3, 1p5e14.6 ) 
c
      return
c
      end 
c
c
c*******************************************************************************
c
      subroutine ARRAYD ( A, nr, nc, ldA, name, iwlp, mou )
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c      Authors  L. Feldman and J Dunphey, with alterations by  B.W. Rust
c
c  ARRAYD is an output subroutine which prints a double precision matrix.
c  The arguments are:
c
c         A      double precision matrix array to be listed.
c
c         nr     integer number of rows of A.
c
c         nc     integer number of columns of A.
c
c         ldA    integer first dimension of A in calling program, 
c                         i.e. A(ldA,*) or A(ldA)
c
c         name   character string heading for the matrix A.
c
c         iwlp   integer print flag
c                =  0 , to print on standard output only
c                =  1 , to print on standard output and unit mou as well
c                = -1 , to print on unit mou only
c
c         mou    integer unit for line printer output
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      character*(*)  name
      character*8 column
c
      double precision A(*)
c
      logical ip
c
      data column /'column  '/
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      if ( iwlp .ne. 0 ) then 
                              ip = .true.
                         else 
                              ip = .false.
      end if
c
      do 3 ml = 1,nc,5
c
         mh = ml + 4
         if ( nc .lt. mh ) mh = nc
         mlm1 = (ml-1)*ldA
         mhm1 = (mh-1)*ldA
c
         do 3 li = 1,nr,100
c
            nl = li
            nh = nl + 99
            if ( nr .lt. nh ) nh = nr
            if ( iwlp .ge. 0 ) print 100, name 
            if ( ip )     write (mou,100) name
            if ( iwlp .ge. 0) print 200, ( column, j, j=ml,mh )
            if ( ip )    write (mou,200) ( column, j, j=ml,mh )
            if ( iwlp .ge. 0 ) print 300
            if ( ip )     write (mou,300)
c 
            do 3 l=nl,nh
c
               mml = mlm1 + l
               mmh = mhm1 + l
               if ( iwlp .ge. 0) print 400, l, ( A(j), j=mml,mmh,ldA )
               if ( ip )    write (mou,400) l, ( A(j), j=mml,mmh,ldA )
c
    3 continue
c
  100 format (' '/' '/' ', a ) 
  200 format (' '/' row', 2x, 5( a6, i4, 4x ) )
  300 format (' ')
  400 format (' ', i3, 1p5d14.6 ) 
c
      return
c
      end 
c
c
c*******************************************************************************
c
      subroutine VECPR ( vec, n, vecnam, iwlp, mou )
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  A subroutine to print out a single precision vector array
c
c   vec      single precision vector array to be printed
c
c   n        integer dimension of the vector vec
c
c   vecnam   character string heading for the vector vec
c
c   iwlp     integer print flag
c                =  0 , to print on standard output only
c                =  1 , to print on standard output and unit mou as well
c                = -1 , to print on unit mou only
c
c   mou      integer unit for line printer output
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      logical ipr
c
      character*(*)  vecnam
c
      dimension vec(n)
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      if ( iwlp .ne. 0 ) then 
                              ipr = .true.
                         else 
                              ipr = .false.
      end if
c
      if ( iwlp .ge. 0 ) print 10, vecnam
      if ( ipr )    write (mou,10) vecnam
   10 format (' '/' '/' ', a / )
c
      do 50 jl=1,n,5
c
         jlo = jl
         jup = jl + 4 
         if ( jup .gt. n ) jup = n
         if ( iwlp .ge. 0 ) print 20, jlo, ( vec(j), j=jlo,jup )
         if ( ipr )    write (mou,20) jlo, ( vec(j), j=jlo,jup )
c
   50 continue
c
   20 format (1h ,i4, 1p5e14.6 )
c
      return
c
      end 
c
c
c*******************************************************************************
c
      subroutine VECPRD ( vec, n, vecnam, iwlp, mou )
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
c  A subroutine to print out a double precision vector array
c
c   vec      double precision vector array to be printed
c
c   n        integer dimension of the vector vec
c
c   vecnam   character string heading for the vector vec
c
c   iwlp     integer print flag
c                =  0 , to print on standard output only
c                =  1 , to print on standard output and unit mou as well
c                = -1 , to print on unit mou only
c
c   mou      integer unit for line printer output
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      logical ipr
c
      character*(*)  vecnam
c
      double precision  vec(n)
c
c+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
c
      if ( iwlp .ne. 0 ) then 
                              ipr = .true.
                         else 
                              ipr = .false.
      end if
c
      if ( iwlp .ge. 0 ) print 10, vecnam
      if ( ipr )    write (mou,10) vecnam
   10 format (' '/' '/' ', a / )
c
      do 50 jl=1,n,5
c
         jlo = jl
         jup = jl + 4 
         if ( jup .gt. n ) jup = n
         if ( iwlp .ge. 0 ) print 20, jlo, ( vec(j), j=jlo,jup )
         if ( ipr )    write (mou,20) jlo, ( vec(j), j=jlo,jup )
c
   50 continue
c
   20 format (1h ,i4, 1p5d14.6 )
c
      return
c
      end 
