prarr1.f90

Go to the documentation of this file.

subroutine prarr1( name, array, isize, ll)
!
!     ******************************************************************
!     * prints 1d array(isize) with the title name.                    *
!     * if isize.lt.0, index i starts counting from 0 (rather than 1). *
!     * the argument ll has the double function of communicating the   *
!     * output unit iout=ll/10 and the format switch l=ll-iout*10.     *
!     * iout=0 (l=ll): file is "output".                               *
!     * l=1: e-format, l=2: f-format (width of 132 characters),        *
!     * l=3: e-format, l=4: f-format (width of 80 characters).         *
!     ******************************************************************
!

  use itm_types

  implicit none

  character(len=*), intent(in) :: name
  real(r8), dimension(*), intent(in) :: array
  integer(itm_i4), intent(in) :: isize, ll

  integer(itm_i4) :: iout, l, kstep, i, i0, is, k, kplus
  character(len=100) :: ch_fm
!
  iout = ll / 10
  l = ll - iout * 10

  select case (l)
    case (0)
      return
    case (1)
      kstep = 8
      ch_fm = "(1x,8(1pe12.4,'(',0p,i2,')'))"
      if ( isize >= 100 ) ch_fm = "(1x,8(1pe11.4,'(',0p,i3,')'))"
    case (2)
      ch_fm = "(1x,8(f11.5,'(',i3,')'))"
      kstep = 8
    case (3)
      ch_fm = "(1x,5(1pe12.4,'(',0p,i2,')'))"
      kstep = 4
      if ( isize >= 100 ) ch_fm = "(1x,5(1pe11.4,'(',0p,i3,')'))"
    case (4)
      ch_fm = "(1x,5(f11.5,'(',i3,')'))"
      kstep = 4
  end select

  i0 = 0
  is = isize
  if ( isize < 0 ) then
     i0 = 1
     is = -isize
  endif
!
  if ( iout == 0 ) iout = 6
  write(iout, "(/1x,a/)") name
  do k = 1, is, kstep
    kplus = min(k + kstep - 1, is)
    write(iout, ch_fm)  (array(i), i - i0, i = k, kplus)
  end do
  return
!

end subroutine prarr1