# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!<;
!err_mod
!
!Author: Robert Clapp, ESMB 463, 7230253
!
! Wed Jan 8 21:37:08 PST 2003
!
!Purpose:
!
! Handle constructing the error (moveout) module
!
!To add a new error type:
!
! - Add to check_err_params
! - Add to the init
! - Add a calc_error
!
! Currently
! - stolt_pts
! - stolt_refs
! - vertical_pts
! - vertical_refs
!
module error_mod
  use param_check_mod
  use vertical_move_pts_mod
  use vertical_move_refs_mod
  use map_pts_reg_mod
  use resid_mig_pts_mod
  use resid_mig_refs_mod
  implicit none
  logical, private, save :: verb,tau
  logical, save :: data_errors_build_ok
  character(len=60),private, save :: err_method
  type(sep3d),private,save :: vel_tomo_s
  real, pointer,private,save :: loce(:,:)
  integer, pointer, private, save :: err_loc(:)
  integer,private, save :: icount,iray
  contains
  logical function init_data_errs()
    type(sep3d) :: err_s
    logical :: is_2d
    integer :: ntr
    init_data_errs=.false.
!check to see if parameters are different
    if (.not. data_errors_build_ok) then
      if (.not. write_err_params()) then
        write(0,*) "    ERROR: writing parameters"
        return
      end if
      if (.not. struct_params(err_s,"err")) then
        write(0,*) "    ERROR: writing error file format"
        return
      end if
!#########################################
! IMPORTANT #
! #
! THIS WHERE WE DESCRIBE HOW TO #
! BUILD FILTER(s) #
! #
! MUST HAVE A CORARLY IN #
! #
! COVAR REG/COVAR PREC #
! #
!#########################################
      if (verb) then
        write(0,*) "   DATA ERROR METHOD=",trim(err_method)
      end if
      if (err_method(1:9).eq."stolt_pts") then
        if (.not. calc_stolt_pts(ntr)) then
          write(0,*) "    ERROR: calculating calc_stolt_pts"
          return
        end if
      else if (err_method(1:10).eq."stolt_refs") then
        if (.not. calc_stolt_refs(ntr)) then
          write(0,*) "    ERROR: calculating calc_stolt_refs"
          return
        end if
      else if (err_method(1:12).eq."vertical_pts") then
        if (.not. calc_vertical_pts(ntr)) then
          write(0,*) "    ERROR: calculating vertical moveout pts"
          return
        end if
      else if (err_method(1:14).eq."vertical_refs") then
        if (.not. calc_vertical_refs(ntr)) then
          write(0,*) "    ERROR: calculating vertical moveout refs"
          return
        end if
      else
        write(0,*) "    ERROR:Unknown error method=",trim(err_method)
        return
      end if
      err_s%ntraces=ntr
      call sep3d_set_sep3d(err_s)
      call sep3d_rite_num_traces("err",err_s)
      call sep3df_delete(err_s,"err")
    else if (verb) then
      write(0,*) "    Using old data error file"
    end if
    if (.not. load_err_pos()) then
      write(0,*) "        ERROR: loading data position locations"
      return
    end if
    init_data_errs=.true.
  end function
  logical function init_err_map(rtag)
    character(len=*) :: rtag
    type(sep3d) :: rays
    call init_sep3d(rtag,rays,"SCRATCH")
    iray=0
    icount=0
    allocate(err_loc(rays%ntraces))
    err_loc=-1
    call sep3df_delete(rays)
    init_err_map=.true.
  end function
  logical function write_err_params()
    write_err_params=.false.
    call auxout("err")
    if (.not. write_current("err")) then
      write(0,*) "    ERROR: writing parameters to file"
      return
    end if
    write_err_params=.true.
  end function
  logical function load_err_pos()
    type(sep3d) :: err_s
    integer :: nh
    load_err_pos=.false.
    call init_sep3d("err",err_s,"INPUT")
    call auxin("err")
    call sep3d_grab_headers("err",err_s,nh)
    allocate(loce(3,nh))
    call sep3d_grab_key_vals(err_s,"s_x",loce(:,1))
    call sep3d_grab_key_vals(err_s,"s_y",loce(:,2))
    call sep3d_grab_key_vals(err_s,"s_z",loce(:,3))
    call sep3df_delete(err_s,"err")
    load_err_pos=.true.
  end function
  subroutine map_dat_reg(vals,field)
    real :: vals(:)
    real,pointer :: field(:,:,:)
    type(sep3d) :: err_s
    call init_sep3d("err",err_s,"INPUT")
    call interp_ireg_to_reg(err_s,loce,vals,field,(/10.,10.,10./))
    call sep3df_delete(err_s,"err")
  end subroutine
  logical function get_error_map(imap)
    integer,pointer :: imap(:)
    allocate(imap(size(err_loc)))
    imap=err_loc
    get_error_map=.true.
  end function
  logical function get_data_errors(pos,extra,time,dip,semb,axis,dt,scale&
    &,zeros,bulk)
    real :: pos(:),axis(:),dt(:),scale(:),zeros(:),dip(:),time(:)
    real ::semb,extra
    integer :: i
    logical :: bulk
    get_data_errors=.false.
    icount=icount+1
    do i=1,size(dt)
      iray=iray+1
      err_loc(iray)=icount
    end do
!if(err_method(1:5)=="stolt"){
    if (.not. stolt_errors(pos,extra,time,dip,semb,axis,scale,zeros,dt&
      &,bulk)) then
      write(0,*) "    ERROR: calculating stolt errors"
      return
    end if
!}
!else if(err_method(1:8)=="vertical") {
! if(.not. vertical_errors(pos,extra,time,dip,semb,axis,scale,zeros,dt,bulk)){
! write(0,*) "    ERROR: calculating vertical errors"
! return
! }
!}
!else { write(0,*) "Unknown data_err_method=",trim(err_method);return}
    get_data_errors=.true.
  end function
  logical function struct_params(struct,tag)
    type(sep3d) :: struct
    character(len=*) :: tag
    struct_params=.false.
    struct_params=.false.
    call init_sep3d(struct,"OUTPUT","FLOAT","HEADER",ctag=tag)
    call axis_allocate(struct,2)
    call key_allocate(struct,7)
    struct%keytype="scalar_float"
    struct%keyfmt="scalar_float"
    struct%keyname(1)="s_x"
    struct%keyname(2)="s_y"
    struct%keyname(3)="s_z"
    struct%keyname(4)="descriptor"
    struct%keyname(5)="dip_xz"
    struct%keyname(6)="dip_yz"
    struct%keyname(7)="var"
    struct%n(1:2)=(/1,1/)
    struct%label(2)="trace_in_bin"
    struct%ndims=2
    call sep3d_set_sep3d(struct)
    call sep3d_grab_sep3d(struct%tag ,struct)
    call sep3d_inorder(struct)
    call sep3d_write_description(tag,struct)
    call sep3d_set_write_status(struct,.true.,.true.)
    struct_params=.true.
  end function
  logical function check_data_err_params()
    character(len=128) :: tag
    integer, external :: auxin
    logical :: stat_rerun(20),stat_ok(20)
    stat_ok=.true.
    stat_rerun=.true.
    check_data_err_params=.false.
    if (.not. vel_tomo_structure(vel_tomo_s)) then
      write(0,*) "could not grab converted velocity structure"
      return
    end if
    if (.not. new_par_check()) then
      write(0,*) "    ERROR: initializing new param check"
      return
    end if
    if (-1.eq.auxin("err")) then
      tag="NONE"
    else
      tag="err"
    end if
    call from_param("verb",verb,.false.)
    stat_rerun(1)= check_par_file("data_err_method" ,err_method &
      & ,tag,"vertical_pts")
!#########################################
! IMPORTANT #
! #
! THIS WHERE WE DESCRIBE HOW TO #
! INITIALIZE/CHECK OBJECT PARAMS #
! #
!#########################################
    if (err_method(1:9).eq."stolt_pts") then
      stat_ok(2)=check_pars_stolt_pts(tag,stat_rerun(10))
    else if (err_method(1:12).eq."vertical_pts") then
      stat_ok(2)=check_pars_vertical_pts(tag,stat_rerun(11))
    else if (err_method(1:10).eq."stolt_refs") then
      stat_ok(2)=check_pars_stolt_refs(tag,stat_rerun(12))
    else if (err_method(1:13).eq."vertical_refs") then
      stat_ok(2)=check_pars_vertical_refs(tag,stat_rerun(13))
    else
      write(0,*) "    ERROR-Unknown data_err_method=",trim(err_method)
      return
    end if
    stat_rerun(4)=check_par_file("tau" ,tau ,tag&
      &,.false.)
    stat_rerun(5)=check_par_space(vel_tomo_s,tag,2,3,"ns")
    call from_param("rerun_data_err_calc",stat_rerun(7),.false.)
    call from_param("rerun_all",stat_rerun(8),.false.)
    stat_rerun(7:8)=.not. stat_rerun(7:8)
    if (all(stat_ok)) then
      check_data_err_params=.true.
    end if
    if (all(stat_rerun)) then
      data_errors_build_ok=.true.
    else
      data_errors_build_ok=.false.
    end if
    call auxclose("err")
  end function
end module
