# 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 resid_mig_pts_mod
  use tomo_space_conv_mod
  use resid_shared_mod
  use dip_calc_mod
  use calc_semblance_mod
  use envelope_mod
  use map_pts_reg_mod
  implicit none
  logical, private, save :: verb,tau
  contains
  logical function calc_stolt_pts(ntr)
    type(sep3d) :: velz_s,stolt_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(:,:)
    integer :: ierr,npts,iz,ntr
    calc_stolt_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,*) "      ERROR: getting velz structure"
      return
    end if
    if (model_space(1:2).ne."ds" .and. model_space(1:2).ne."v2") then
      write(0,*) "      ERROR: understand model space as ds or v2 model="&
        &,model_space(1:2)
      return
    end if
    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 getting residual stolt"
    end if
!###########################################################################
! GET/CALC STOLT STUFF #
!###########################################################################
!READ IN/CALCULATE COHERENCE
    if (.not. get_err_fields("gamma",gamma,"semb_coher",coher,stolt_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. 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
    if (.not. select_pt_locations(velz_s,image,velz_s,dip_coher,velz_s&
      &,coher,stolt_space,points)) then
      write(0,*) "      ERROR: sellecting back projection points"
      return
    end if
    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)
    if (ierr.ne.0) then
      write(0,*) "      ERROR: allocating header arrays"
      return
    end if
    if (.not. get_selected_points(stolt_space,gamma,points,g)) then
      write(0,*) "      ERROR: grabbing selected gamma values"
      return
    end if
    if (.not. get_selected_points(stolt_space,coher,points,c)) then
      write(0,*) "      ERROR: grabbing selected coherence values"
      return
    end if
    if (.not. get_selected_points(stolt_space,coher,points,c)) 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 (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
    headers(1:4,:)=points
    headers(5 ,:)=dxz
    headers(6 ,:)=dyz
    headers(7 ,:)=c
    deallocate(gamma,coher,dip_xz,dip_yz,dxz,dyz,c,points,dip_coher)
!###########################################################################
! WRITE OUT ERRORS #
!###########################################################################
    if (.not. write_ireg("err",g,headers)) then
      write(0,*) "      ERROR: writing out headers"
      return
    end if
!###########################################################################
! CLEAN UP #
!###########################################################################
    call sep3df_delete(stolt_space)
    deallocate(headers,g)
    ntr=npts
    calc_stolt_pts=.true.
  end function
  logical function check_pars_stolt_pts(file,norerun)
    character(len=*) :: file
    logical :: stat_ok(50),stat_rerun(50),norerun
    integer, external :: auxin
    check_pars_stolt_pts=.false.
    stat_ok=.true.
    stat_rerun=.true.
    if (-1.eq.auxin("gamma")) then
      write(0,*) "      ERROR-Must provide stolt coherence (gamma)3"
      stat_ok(3)=.false.
    else
      call auxclose("gamma")
    end if
    if (-1.eq.auxin("semb_coher")) then
      write(0,*) "     ERROR-Must provide stolt ratio (semb_coher)"
      stat_ok(3)=.false.
    else
      call auxclose("semb_coher")
    end if
    if (-1.eq.auxin("image")) then
      write(0,*) "      ERROR-Must provide image file (image)"
      stat_ok(3)=.false.
    else
      call auxclose("image")
    end if
    call from_param("tau",tau,.false.)
    stat_ok(1)=check_pars_parse_region(file,stat_rerun(1))
    stat_ok(2)=check_pars_dip_calc(file,stat_rerun(2))
    call from_param("verb",verb,.false.)
    if (all(stat_ok)) then
      check_pars_stolt_pts=.true.
    end if
    if (all(stat_rerun)) then
      norerun=.true.
    else
      norerun=.false.
    end if
  end function
end module
