# 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_refs_mod
  use tomo_space_conv_mod
  use dip_calc_mod
  use reflector_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_refs(ntr)
    type(sep3d) :: velz_s,vel_o,ref_s,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(:,:,:&
      &)
    complex, pointer :: ref2d(:,:)
    real, pointer :: ref3d(:,:,:)
    integer :: nv(3),ntr
    real :: ov(3),dv(3)
    integer :: ierr,npts,iz
    calc_vertical_refs=.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,*) "      ERROR: getting velz structure"
      return
    end if
!if(model_space(1:2)!="ds" ){
! write(0,*) "      ERROR: 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_xz"
      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
!READ IN/CALCULATE COHERENCE
    if (.not. get_err_fields("gamma",gamma,"semb_coher",coher,gamma_space&
      &)) then
      write(0,*) "      ERROR: grab/calc stolt fields"
      return
    end if
    if (verb) then
      write(0,*) "    Before selecting back projection points"
    end if
!###########################################################################
! SELECT BACK PROJECTION POINTS #
!###########################################################################
    if (.not. return_ref(ref_s)) then
      write(0,*) "      ERROR: grabbing reflector structure"
      return
    end if
    if (sep3d_ndims(ref_s).ne.3) then
      allocate(ref2d(ref_s%n(1),ref_s%n(2)))
      if (.not. return_2d_conv_refs(ref2d)) then
        write(0,*) "      ERROR: grabbing 2-D reflector"
        return
      end if
      if (.not. select_ref_locations(velz_s,ref2d,points)) then
        write(0,*) "      ERROR: sellecting back projection points"
        return
      end if
      deallocate(ref2d)
    else
      allocate(ref3d(ref_s%n(1),ref_s%n(2),ref_s%n(3)))
      if (.not. return_3d_conv_refs(ref3d)) then
        write(0,*) "      ERROR: grabbing 3-D reflector"
        return
      end if
      if (.not. select_ref_locations(velz_s,ref_s,ref3d,points)) then
        write(0,*) "      ERROR: sellecting back projection points"
        return
      end if
      deallocate(ref3d)
      calc_vertical_refs=.true.
    end if
    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)
    if (ierr.ne.0) then
      write(0,*) "      ERROR: allocating header arrays"
      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(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,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
      dyz=0.
    end if
    ntr=npts
    headers(1:4,:)=points
    headers(5 ,:)=dxz
    headers(6 ,:)=dyz
    headers(7 ,:)=c
    deallocate(gamma,coher,dip_xz,dip_yz,dxz,dyz,c,points,headers)
    deallocate(dip_coher)
!###########################################################################
! WRITE OUT ERRORS #
!###########################################################################
    if (.not. write_ireg("err",g,headers)) then
      write(0,*) "      ERROR: writing out headers"
      return
    end if
    deallocate(g,headers)
  end function
  logical function check_pars_vertical_refs(file,norerun)
    character(len=*) :: file
    logical :: stat_ok(10),stat_rerun(10),norerun
    integer, external :: auxin
    check_pars_vertical_refs=.false.
    stat_rerun=.true.
    stat_ok=.true.
    stat_ok(1)=check_pars_parse_region(file,stat_rerun(1))
    stat_ok(2)=check_pars_dip_calc(file,stat_rerun(2))
    stat_ok(3)=check_pars_calc_semb(file,stat_rerun(3))
    call from_param("verb",verb,.false.)
    call from_param("tau",tau,.false.)
    if (-1.eq.auxin("gamma")) then
      write(0,*) "      ERROR-Must provide gamma coherence file2 (gamma&
        &)"
      stat_ok(4)=.false.
    else
      call auxclose("gamma")
    end if
    if (-1.eq.auxin("semb_coher")) then
      write(0,*) "      ERROR-Must provide semblance coherence file &
        &(semb_coher)"
      stat_ok(5)=.false.
    else
      call auxclose("semb_coher")
    end if
    if (-1.eq.auxin("image")) then
      write(0,*) "      ERROR-Must provide image file (image)"
      stat_ok(6)=.false.
    else
      call auxclose("image")
    end if
    if (all(stat_ok)) then
      check_pars_vertical_refs=.true.
    end if
    if (all(stat_rerun)) then
      norerun=.true.
    else
      norerun=.false.
    end if
  end function
end module
