# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!velocity
!
!Usage:
!call velocity (arg1, arg2 arg3)
!
!Input Parameters:
!
!
!Output Parameters:
!
!
!
!Description:
!
!
!
!>
!-------------------------------------------------
!
!Author: Robert Clapp, ESMB 463, 7230253
!
!Date Created:Mon Dec 18 15:31:37 PST 2000
!
!Purpose:
!
!
module velocity_mod
  use basic_util_mod
  use sep3d_struct_mod
  use sep
  implicit none
  type(sep3d),private :: vel
  real, pointer,private :: velocity(:,:,:)
  contains
  logical function read_in_velocity()
    real,allocatable :: tempr(:)
    integer :: ierr
    integer, external :: sreed
    integer :: n(3)
    real :: o(3),d(3)
    read_in_velocity=.false.
    call init_sep3d("in",vel,"INPUT")
    if (sep3d_ndims(vel)<2 .or. sep3d_ndims(vel)>3) then
      write(0,*) "ndims must be 2 or 3 see:",sep3d_ndims(vel)
      read_in_velocity=.false.
    else
      call set_n_o_d_3d(vel,n,o,d)
      allocate(tempr(product(n)),velocity(n(1),n(2),n(3)),stat=ierr)
      call add_mem(size(velocity))
      if (ierr.ne.0) then
        write(0,*) "trouble allocating velocity"
        read_in_velocity=.false.
      else
        if (4*size(tempr).ne.sreed("in",tempr,4*product(vel%n))) then
          write(0,*) "trouble reading velocity"
          read_in_velocity=.false.
          deallocate(tempr)
        else
          velocity=reshape(tempr,n)
          deallocate(tempr)
        end if
      end if
    end if
    read_in_velocity=.true.
  end function
  logical function vel_structure(myvel)
    type(sep3d) :: myvel
    if (.not. valid_structure(vel)) then
      vel_structure=.false.
    else
      myvel=vel
      vel_structure=.true.
    end if
  end function
  logical function vel_1d(vel_out)
    real :: vel_out(:)
    vel_1d=.true.
    if (.not. valid_structure(vel)) then
      vel_1d=.false.
    else
      vel_out=reshape(velocity,(/size(velocity)/))
    end if
  end function
  logical function vel_2d(vel_out)
    real :: vel_out(:,:)
    vel_2d=.true.
    if (.not. valid_structure(vel)) then
      vel_2d=.false.
    else
      vel_out=velocity(:,:,1)
    end if
  end function
  logical function vel_3d(vel_out)
    real :: vel_out(:,:,:)
    vel_3d=.true.
    if (.not. valid_structure(vel)) then
      vel_3d=.false.
    else
      vel_out=velocity
    end if
  end function
  logical function set_write(tag,myv)
    real :: myv(:,:,:)
    character(len=*) ::tag
    set_write=.false.
    if (.not. set_vel(myv)) then
      write(0,*) "trouble setting new velocity"
      return
    end if
    if (.not. write_vel(tag)) then
      write(0,*) "trouble writing velocity"
      return
    end if
    set_write=.true.
  end function
  logical function set_vel(vel)
    real :: vel(:,:,:)
    set_vel=.false.
    if (size(velocity).ne.size(vel)) then
      write(0,*) "velocity sizes don't match"
      return
    end if
    velocity=vel
    set_vel=.true.
  end function
  logical function write_vel(tag)
    character(len=*) :: tag
    integer, external :: srite
    write_vel=.false.
    if (4*size(velocity) .ne. srite(tag,velocity,size(velocity)*4))&
      & then
      write(0,*) "trouble writing out velocity"
      return
    end if
    write_vel=.true.
  end function
end module
