# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!<
!Date Created:Mon Jan 15 16:11:09 PST 2001
!Thu Jan 9 16:28:30 PST 2003
!
!Purpose:
!
! Covariance filter that describes the inverse model covariance
!
!
!
module steer_covar_mod
  use io_nfilt
  use param_check_mod
  use build_steering3d_filters
  use build_steering2d_filters
  use interp_filter_mod
  use nbound_bob_mod
  implicit none
  integer, private, save :: ntri_steer,nwind_steer_smooth,use_refs(20)&
    &,noff_steer
  integer, private, save :: integrate_noff,integrate_npts
  real, private, save :: min_steer_amp,max_steer_amp,hwidth_steer&
    &,dip_range,azimuth_range,ddip,daz
  logical, private, save :: steer_integrate
  contains
  logical function calc_steer()
    type(nfilter) :: filt1,filt2
    type(filter) :: filt,filt_out
    type(sep3d) :: tomo_s,ref_s,dip_s,dip2_s
    real, pointer :: ref3d(:,:,:),amp(:,:,:),p(:,:,:),p2(:,:,:)
    complex, pointer :: ref2d(:,:)
    logical :: is_2d
    integer :: i,n123,nref_use,i1
    calc_steer=.false.
    call init_sep3d("dip_xz",dip_s,"INPUT")
    if (sep3d_ndims(dip_s).eq.2) then
      is_2d=.true.
    else
      is_2d=.false.
    end if
    if (.not. is_2d) then
      call init_sep3d("dip_yz",dip2_s,"INPUT")
    end if
    if (steer_integrate) then
      if (.not. init_filt_interp(dip_s%n(1),noff_steer,dip_range&
        &,azimuth_range,dip_s%n(2),integrate_npts,ddip,daz,is_2d)) then
        write(0,*) "trouble initializing integration filters"
        return
      end if
    end if
    if (is_2d) then
      call default_steering_filters_2d()
      call init_steering_filters_2d(n_in=dip_s%n,o_in=dip_s%o,d_in=dip_s%d&
        &,nwind_in=nwind_steer_smooth,hwidth_in=hwidth_steer,&
        & ns_in=ntri_steer,min_amp_in=min_steer_amp,max_amp_in=max_steer_amp&
        &,use_refs_in=use_refs(1:nref_use))
      allocate(amp(dip_s%n(1),dip_s%n(2),1))
      call init_sep3d("dip_xz",dip_s,"INPUT")
      allocate(p(dip_xz%n(1),dip_xz%n(2),1))
      allocate(p2(dip_xz%n(1),dip_xz%n(2),1))
      if (.not. sreed_field("dip_xz",p)) then
        write(0,*) "TROUBLE READING IN DIP_XZ"
        return
      end if
      call sep3df_delete(dip_s)
      amp=max_steer_amp
      if (.not.steer_integrate) then
        call create_2d_steer_op(p(:,:,1)*dip_s%d(2)/dip_s%d(1),amp(:,:&
          &,1),filt1)
      else if (.not. create_steer_integrate_op_2d(filt1,p*dip_s%d(2)&
        &/dip_s%d(1))) then
        write(0,*) "trouble creating 2-D steer op"
        return
      end if
      deallocate(p,p2,amp)
      nullify(filt1%mis)
    else
      call default_steering_filters_3d()
      call init_steering_filters_3d(n_in=dip_s%n,o_in=dip_s%o,d_in=dip_s%d&
        &,nwind_in=nwind_steer_smooth,hwidth_in=hwidth_steer,&
        & ns_in=ntri_steer,min_amp_in=min_steer_amp,max_amp_in=max_steer_amp&
        &,use_refs_in=use_refs(1:nref_use))
      allocate(amp(dip_s%n(1),dip_s%n(2),dip_s%n(3)))
      amp=max_steer_amp
      call init_sep3d("dip_xz",dip_s,"INPUT")
      allocate(p(dip_xz%n(1),dip_xz%n(2),dip_xz%n(3)))
      allocate(p2(dip_xz%n(1),dip_xz%n(2),dip_xz%n(3)))
      if (.not. sreed_field("in",p)) then
        write(0,*) "TROUBLE READING IN DIP_XZ"
        return
      end if
      if (.not. sreed_field("dip_yz",p2)) then
        write(0,*) "TROUBLE READING IN DIP_YZ"
        return
      end if
      if (.not.steer_integrate) then
        call create_3d_steer_2filt_op(p/dip_s%d(2)*dip_s%d(1),p2 /dip_s%d&
          &(3)*dip_s%d(1),amp,filt1,filt2)
      else
        if (.not. create_steer_integrate_op_3d(filt1,p/dip_s%d(2)*dip_s%d&
          &(1),p2 /dip_s%d(3)*dip_s%d(1))) then
          write(0,*) "trouble creating integrated steering op"
          return
        end if
      end if
      if (.not.steer_integrate) then
        if (.not. rite_nfilt("filt2",filt2,dip_s%n,dip_s%o,dip_s%d))&
          & then
          write(0,*) "trouble writing out filter"
          return
        end if
      end if
      deallocate(p,p2,amp)
    end if
    if (.not. rite_nfilt("out",filt1,dip_s%n,dip_s%o,dip_s%d)) then
      write(0,*) "trouble writing out filter"
      return
    end if
    calc_steer=.true.
  end function
  logical function check_pars_steer_filter(tag,struct,nfilt)
    character(len=*) :: tag
    integer :: nfilt
    call from_param("min_steer_amp" ,min_steer_amp,tag,.1)
    call from_param("max_steer_amp" ,max_steer_amp,tag,.9)
    call from_param("nwind_steer_smooth" ,nwind_steer_smooth,tag,2)
    call from_param("hwidth_steer" ,hwidth_steer,tag,2.5)
    call from_param("ntri_steer" ,ntri_steer,tag,2)
    call from_param("use_refs_steer",use_refs,tag,use_refs)
    call from_param("steer_integrate",steer_integrate,tag,.true.)
    call from_param("azimuth_range",azimuth_range,tag,30.)
    call from_param("dip_range",dip_range,tag,30.)
    call from_param("integrate_npts",integrate_npts,tag,50)
    call from_param("integrate_noff",integrate_noff,tag,8)
    call from_param("steer_daz",daz,tag,.5)
    call from_param("steer_ddip",ddip,tag,.5)
    call from_param("steer_noff",noff_steer,tag,8)
    if (sep3d_ndims(struct).eq.3 .and. .not. steer_integrate) then
      nfilt=2
    else
      nfilt=1
    end if
    check_pars_steer_filter=.true.
  end function
end module
