!<
!
! Recoginized types :: z2d,z3d,tau2d,tau3d
!
!
!
!
! MODULE CONTAINING CONVERSION FROM DEPTH
! TO WHAT EVER SPACE TOMOGRAPHY WILL BE PERFORMED IN
! TO ADD TYPE MAKE SURE TO INCLUDE IN CONV_TYPE
! AND ALL ACCESSING FUNCTIONS.
!
!
!>
module update_vel_mod 
  use tomo_space_conv_mod
  use region_volume_mod
  implicit none
  contains
  logical function calc_write_new_vel()
    real, allocatable :: temp2d(:,:),temp3d(:,:,:),v(:),velocity_tomo(:&
      &)
    real, allocatable :: zemp2d(:,:),zemp3d(:,:,:),map(:,:),lemp2d(:,:&
      &)
    integer, external :: srite,getch
    integer :: beg(3),end(3)
    character(len=128) :: temp_ch
    character(len=10) :: conv_type
    real :: min_vel,max_vel
    type(sep3d) :: vel_out,vel_tomo_struct,vel_z_tomo_struct,vel
    integer :: ierr
    real,allocatable :: ds(:)
    logical :: ds_write
    calc_write_new_vel=.false.
    if (.not. vel_tomo_structure(vel_tomo_struct) .or. .not.&
      & vel_z_tomo_structure(vel_z_tomo_struct)) then
      write(0,*) "trouble obtaining vel_tomo_struct"
      return
    end if
    allocate(velocity_tomo(product(vel_tomo_struct%n(1:sep3d_ndims&
      &(vel_tomo_struct)))))
    allocate(ds(product(vel_tomo_struct%n(1:sep3d_ndims(vel_tomo_struct&
      &)))))
    if (.not. return_ds(ds)) then
      write(0,*) "trouble obtaining ds"
      return
    end if
    if (.not. vel_tomo(velocity_tomo)) then
      write(0,*) "trouble obtaining vel tomo"
      return
    end if
    if (.not. return_padding(beg,end)) then
      write(0,*) "trouble obtaining padding info"
      return
    end if
    if (.not. return_conv_type(conv_type)) then
      write(0,*) "trouble obtaining conversion type"
      return
    end if
    if (1.eq.getch("ds","s",temp_ch)) then
      ds_write=.true.
      call sep_put_data_axis_par("ds",1,vel_tomo_struct%n(1),vel_tomo_struct%o&
        &(1),vel_tomo_struct%d(1),vel_tomo_struct%label(1))
      call sep_put_data_axis_par("ds",2,vel_tomo_struct%n(2),vel_tomo_struct%o&
        &(2),vel_tomo_struct%d(2),vel_tomo_struct%label(2))
      call sep_put_data_axis_par("ds",3,vel_tomo_struct%n(3),vel_tomo_struct%o&
        &(3),vel_tomo_struct%d(3),vel_tomo_struct%label(3))
      if (sep3d_ndims(vel_tomo_struct).eq.3) then
        call to_history("n4",4,"ds")
      else
        call to_history("n3",4,"ds")
      end if 
      call to_history("titles","ds:slowness","ds")
      ierr=srite("ds",ds,size(ds)*4)
    else
      ds_write=.false.
    end if 
    velocity_tomo(:)=1./velocity_tomo(:)
    if (ds_write) then
      ierr=srite("ds",velocity_tomo,size(velocity_tomo)*4)
    end if
    velocity_tomo(:)=velocity_tomo(:)+ds(:)
    if (ds_write) then
      ierr=srite("ds",velocity_tomo,size(velocity_tomo)*4)
    end if
    velocity_tomo(:)=1./velocity_tomo(:)
    if (ds_write) then
      ierr=srite("ds",velocity_tomo,size(velocity_tomo)*4)
    end if
    call from_param("min_init_vel",min_vel,-999.)
    call from_param("max_init_vel",max_vel,99999.)
    where(velocity_tomo < min_vel)
      velocity_tomo=min_vel
end where
    where(velocity_tomo > max_vel)
      velocity_tomo=max_vel
end where
    if (.not. update_vel_tomo(velocity_tomo)) then
      write(0,*) "trouble updating vel_tomo"
      return
    end if
    if (.not. vel_structure(vel)) then
      write(0,*) "vel space not initialized"
      return
    end if
    call init_sep3d(vel,vel_out,"OUTPUT","vel_out")
    call sep3d_write_description("out",vel_out)
    if (conv_type(1:4).eq."tau3") then
      allocate(temp3d(vel_tomo_struct%n(1),vel_tomo_struct%n(2)&
        &,vel_tomo_struct%n(3)))
      allocate(zemp3d(vel_z_tomo_struct%n(1),vel_z_tomo_struct%n(2)&
        &,vel_z_tomo_struct%n(3)))
      calc_write_new_vel=vel_tomo_3d(myvel=temp3d)
      call convert_field_tau_z_3d(temp3d,zemp3d)
      allocate(v(size(zemp3d)))
      v=reshape(zemp3d,(/size(v)/))
      if (.not.clean_up_tau_conversion(vel_z_tomo_struct%n,vel_z_tomo_struct%o&
        &,vel_z_tomo_struct%d,v)) then
        write(0,*) "trouble cleaning up tau_conversion"
        return
      end if
      zemp3d=reshape(v,(/size(zemp3d,1),size(zemp3d,2),size(zemp3d,3)/&
        &))
      deallocate(v)
      if (.not. calc_write_new_vel) then
        write(0,*) "trouble obtaining velocity"
        return
      else if (product(vel%n)*4.eq.srite("out",zemp3d(beg(1)+1:beg(1)&
        &+vel%n(1),beg(2)+1:beg(2)+vel%n(2), beg(3)+1:beg(3)+vel%n(3&
        &)),product(vel%n)*4)) then
        calc_write_new_vel=.true.
      else
        write(0,*) "trouble writing out velocity"
        calc_write_new_vel=.false.
      end if 
      deallocate(zemp3d,temp3d)
    else if (conv_type(1:2).eq."z3") then
      allocate(zemp3d(vel_z_tomo_struct%n(1),vel_z_tomo_struct%n(2)&
        &,vel_z_tomo_struct%n(3)))
!AAAAAA
      write(0,*) "in veloc tomo 3d"
      calc_write_new_vel=vel_tomo_3d(myvel=zemp3d)
      if (.not. calc_write_new_vel) then
        write(0,*) "trouble obtaining velocity"
      end if
      if (product(vel%n)*4.eq.srite("out",zemp3d(beg(1)+1:beg(1)+vel%n&
        &(1),beg(2)+1:beg(2)+vel%n(2), beg(3)+1:beg(3)+vel%n(3)),product&
        &(vel%n)*4)) then
        calc_write_new_vel=.true.
      else
        write(0,*) "trouble writing out velocity"
        calc_write_new_vel=.false.
      end if 
      deallocate(zemp3d)
    else if (conv_type(1:4).eq."tau2") then
      allocate(temp2d(vel_tomo_struct%n(1),vel_tomo_struct%n(2)))
      allocate(map(vel_tomo_struct%n(1),vel_tomo_struct%n(2)))
      allocate(zemp2d(vel_z_tomo_struct%n(1),vel_z_tomo_struct%n(2)))
      calc_write_new_vel=vel_tomo_2d(myvel=temp2d)
!	call init_tau_z_conv_2d( (/vel_z_tomo_struct%n,1/), (/vel_z_tomo_struct%o,0./),
!   (/vel_z_tomo_struct%d,1./), (/vel_tomo_struct%n,1/), (/vel_tomo_struct%o,0./),
!  (/vel_tomo_struct%d,1./))
      call create_z_map_2d(temp2d,map)
      call convert_field_tau_z_2d(temp2d,zemp2d)
      allocate(v(size(zemp2d)))
      v=reshape(zemp2d,(/size(v)/))
      if (.not.clean_up_tau_conversion(  (/vel_z_tomo_struct%n(1:2),1/&
        &),(/vel_z_tomo_struct%o(1:2),0./),(/vel_z_tomo_struct%d(1:2&
        &),10000./),v)) then
        write(0,*) "trouble cleaning up tau_conversion"
        return
      end if
      zemp2d=reshape(v,(/size(zemp2d,1),size(zemp2d,2)/))
      deallocate(v)
      if (.not. calc_write_new_vel) then
        write(0,*) "trouble obtaining velocity"
      else if (product(vel%n)*4.eq.srite("out",zemp2d(beg(1)+1:beg(1)&
        &+vel%n(1),beg(2)+1:beg(2)+vel%n(2)),product(vel%n)*4)) then
        calc_write_new_vel=.true.
      else
        write(0,*) "trouble writing out velocity"
        calc_write_new_vel=.false.
      end if 
      deallocate(zemp2d,temp2d,map)
    else
      allocate(zemp2d(vel_z_tomo_struct%n(1),vel_z_tomo_struct%n(2)))
      calc_write_new_vel=vel_tomo_2d(myvel=zemp2d)
      if (.not. calc_write_new_vel) then
        write(0,*) "trouble obtaining velocity"
      else if (product(vel%n)*4.eq.srite("out",zemp2d(beg(1)+1:beg(1)&
        &+vel%n(1),beg(2)+1:beg(2)+vel%n(2)),product(vel%n)*4)) then
        calc_write_new_vel=.true.
      else
        write(0,*) "trouble writing out velocity"
        calc_write_new_vel=.false.
      end if 
      deallocate(zemp2d)
    end if 
    deallocate(ds)
  end function 
end module