# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!<;
!dip_field
!
!Usage:
!dip_field.x <in.H >out.H
!
!Input Parameters:
!
!
!Output Parameters:
!
!
!
!Description:
!
!
!
!>
!-------------------------------------------------
!
!Author: Robert Clapp, ESMB 463, 7230253
!
!Date Created:Mon May 21 15:10:48 PDT 2001
!
!Purpose:
!
module vertical_move_pts_mod
  use tomo_space_conv_mod
  use dip_calc_mod
  use calc_semblance_mod
  use envelope_mod
  use map_pts_reg_mod
  use vertical_shared_mod
  implicit none
  logical, private, save :: verb,tau
  integer, private, save :: n_d_rms_semb
  real, private, save :: pct_keep_semb
  contains
  logical function calc_vertical_pts(ntr)
    type(sep3d) :: velz_s,vel_o,gamma_space
    real, pointer,dimension(:,:,:) :: dip_xz,dip_yz,dip_coher,gamma&
      &,coher,image
    real, pointer :: headers(:,:),dxz(:),dyz(:),g(:)&
      &,d2(:,:),c(:)
    real, pointer :: d3(:,:,:),points(:,:),vel(:,:,:&
      &)
    integer :: nv(3),ntr
    real :: ov(3),dv(3)
    integer :: ierr,npts,iz
    calc_vertical_pts=.false.
    if (verb) then
      write(0,*) "    Before calculate dips"
    end if
!###########################################################################
! CALCULATE DIP FIELD #
!###########################################################################
    if (.not. vel_z_tomo_structure(velz_s)) then
      write(0,*) "trouble getting velz structure"
      return
    end if
!if(model_space(1:2)!="ds" ){
! write(0,*) "only understand model space as ds"
! return
!}
    if (.not. calc_dip_field_files("image",velz_s,"dip_xz","dip_yz"&
      &,"dip_coher","tag_r_image")) then
      write(0,*) "TROUBLE CALCULATING DIP FIELD"
      return
    end if
    if (.not. get_tag_field("dip_xz",dip_xz)) then
      write(0,*) "      ERROR: getting dip_xz"
      return
    end if
    if (.not. get_tag_field("dip_coher",dip_coher)) then
      write(0,*) "      ERROR: getting dip_coher"
      return
    end if
    if (sep3d_ndims(velz_s) .eq.3 ) then
      if (.not. get_tag_field("dip_yz",dip_yz)) then
        write(0,*) "      ERROR: getting dip_yz"
        return
      end if
    else
      allocate(dip_yz(1,1,1))
    end if
    if (verb) then
      write(0,*) "    Before grabbing semblance and coherence fields"
    end if
!READ IN/CALCULATE COHERENCE
    if (.not. get_err_fields("gamma",gamma,"semb_coher",coher,gamma_space&
      &)) then
      write(0,*) "      ERROR: grab/calc vertical moveout fields"
      return
    end if
    if (verb) then
      write(0,*) "    Before selecting back projection points"
    end if
!###########################################################################
! SELECT BACK PROJECTION POINTS #
!###########################################################################
    if (.not. get_tag_field("tag_r_image",image)) then
      write(0,*) "      ERROR: grabbing reduced image"
      return
    end if
    if (.not. calc_envelope(image,1,1)) then
      write(0,*) "      ERROR: calculating envelope"
      return
    end if
    write(0,*) "before this se",sum(coher)
    if (.not. select_pt_locations(velz_s,image,velz_s,dip_coher,velz_s&
      &,coher,gamma_space,points)) then
      write(0,*) "      ERROR: sellecting back projection points"
      return
    end if
    call srite("pts.H",points,size(points,2)*16)
    write(0,*) "AFTER SELCT POINTS"
    deallocate(image)
    if (verb .and. tau) then
      write(0,*) "    Before converting to tau"
    end if
!###########################################################################
! CONVERT TO TAU (IF NECESSARY) #
!###########################################################################
!
!if(tau){
! if(.not. convert_dips_z_tau(velz_s,dip_xz,dip_yz)){
! write(0,*) "      ERROR: converting dip fields from z to tau"
! return
! }
!}
    if (verb) then
      write(0,*) "    Before finding and writing info on points"
    end if
!###########################################################################
! FIND INFO AT SELLECT PTS #
!###########################################################################
    npts=size(points,2)
    allocate(headers(7,npts),stat=ierr)
    call srite("pts.H",points,size(points,2)*16)
    if (ierr.ne.0) then
      write(0,*) "      ERROR: allocating header arrays"
      return
    end if
    if (.not. get_selected_points(velz_s,dip_xz,points,dxz)) then
      write(0,*) "      ERROR: grabbing selected dip_xz values"
      return
    end if
    if (.not. get_selected_points(gamma_space,gamma,points,g)) then
      write(0,*) "      ERROR: grabbing selected gamma values"
      return
    end if
    if (.not. get_selected_points(gamma_space,coher,points,c)) then
      write(0,*) "      ERROR: grabbing selected gamma values"
      return
    end if
    if (sep3d_ndims(velz_s).eq.3) then
      if (.not. get_selected_points(velz_s,dip_yz,points,dyz)) then
        write(0,*) "      ERROR: grabbing selected dip_yz values"
        return
      end if
    else
      allocate(dyz(size(dxz)))
      dyz=0.
    end if
    headers(1:4,:)=points
    headers(5 ,:)=dxz
    headers(6 ,:)=dyz
    headers(7 ,:)=c
    call srite("pt2.H",headers(1:4,:),size(points,2)*16)
    deallocate(gamma,coher,dip_xz,dip_yz,dxz,dyz,c,points,dip_coher)
    call sep3df_delete(gamma_space)
!###########################################################################
! WRITE OUT ERRORS #
!###########################################################################
    if (.not. write_ireg("err",g,headers)) then
      write(0,*) "      ERROR: writing out headers"
      return
    end if
    ntr=npts
    deallocate(g,headers)
    calc_vertical_pts=.true.
  end function
  logical function check_pars_vertical_pts(file,norerun)
    character(len=*) :: file
    logical :: stat_ok(10),stat_rerun(10),norerun
    integer, external :: auxin
    norerun=.false.
    check_pars_vertical_pts=.false.
    stat_ok=.true.
    stat_rerun=.true.
    if (-1.eq.auxin("image")) then
      write(0,*) "      ERROR-Must provide image file (image)"
      stat_ok(1)=.false.
    else
      call auxclose("image")
    end if
    if (-1.eq.auxin("semb_coher")) then
      write(0,*) "      ERROR-Must provide migration file (semb_coher&
        &)"
      stat_ok(3)=.false.
    else
      call auxclose("semb_coher")
    end if
    if (-1.eq.auxin("gamma")) then
      write(0,*) "      ERROR-Must provide migration file (gamma)"
      stat_ok(4)=.false.
    else
      call auxclose("gamma")
    end if
    call from_param("verb",verb,.false.)
    call from_param("tau",tau,.false.)
    stat_ok(5)=check_pars_parse_region(file,stat_rerun(1))
    stat_ok(6)=check_pars_dip_calc(file,stat_rerun(2))
!stat_ok(7)=check_pars_calc_semb(file,stat_rerun(3))
    if (all(stat_rerun)) then
      norerun=.true.
    end if
    if (all(stat_ok)) then
      check_pars_vertical_pts=.true.
    end if
  end function
end module
