# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
module check_tomo_ops_mod
  use tomo_chain_mod
  use dottest
  implicit none
  logical, private, save :: verb,dottest_it
  logical, private, save :: dottest_model_eps
  logical, private, save ::dottest_tau,dottest_tomo
  logical, private, save ::dottest_total
  logical, private, save ::dottest_standard
  logical, private, save ::dottest_fitting
  logical, private, save ::dottest_data_cov
  logical, private, save ::dottest_model_transform
  logical, private, save ::dottest_model_styling
  logical, private, save ::dottest_model_mask
  logical, private, save ::dottest_model_des
  logical, private, save ::dottest_reg
  logical, private, save ::dottest_prec
  logical, private, save ::dottest_extra
  logical, private, save ::dottest_extra_chain
  logical, private, save ::dottest_extra_eps
  contains
  logical function check_dot(op,nmod,ndat)
    real :: dot1(2),dot2(2)
    integer :: nmod,ndat
    interface
      integer function op(adj,add,m,d)
        real::m(:),d(:)
        logical,intent(in)::adj,add
      end function
    end interface
    check_dot=.false.
    call dot_test(op,nmod,ndat,dot1,dot2)
    if (verb) then
      write(0,"(a,g11.4,g11.4,g11.4,g11.4)") "       Dottest results"&
        &,dot1(1),dot1(2),dot2(1),dot2(2)
    end if
    if ( abs((dot1(1)-dot1(2))/maxval(dot1)) > .001) then
      write(0,*) "      ERROR: failed dottest non-add ",dot1
      return
    end if
    if ( abs((dot2(1)-dot2(2))/maxval(dot2)) > .001) then
      write(0,*) "      ERROR: failed dottest add ",dot2
      return
    end if
    if (dot1(1).eq.0. .or. dot2(1).eq.0.) then
      write(0,*) "      ERROR: Dottest result all zeros",dot1,dot2
      return
    end if
    check_dot=.true.
  end function
  logical function init_check_ops()
    integer :: nmod
    integer :: ndat,ncovar_dat,n_extra,nreg_mod,n_extra_eps,nmod_eps
    type(sep3d) :: vel_s
    init_check_ops=.false.
    if (dottest_it) then
      if (.not. vel_tomo_structure(vel_s)) then
        write(0,*) "trouble grabbing velocity tomo structure"
        return
      end if
      nreg_mod=product(vel_s%n(1:sep3d_ndims(vel_s)))
      nmod=model_des_ndomain()
      if (nmod.eq.0) then
        nmod=nreg_mod
      end if
      ndat=tomo_oper_size()
      ncovar_dat=data_covar_nrange(ndat)
      nmod_eps=get_eps_reg_nrange(nmod)
      n_extra=get_extra_nrange()
      n_extra_eps=get_eps_extra_nrange(n_extra)
      if (dottest_tomo) then
        if (verb) then
          write(0,*) "    Dottesting tomo operator"
        end if
        if (.not. check_dot(tomo_op,nreg_mod,ndat)) then
          write(0,*) "    ERROR: Failed tomo_oper dottest"
          return
        end if
      end if
      if (dottest_prec) then
        if (verb) then
          write(0,*) "    Dottesting prec_op operator"
        end if
        if (.not. check_dot(prec_op,nreg_mod,nreg_mod)) then
          write(0,*) "    ERROR: Failed prec_op dottest"
          return
        end if
      end if
      if (dottest_reg) then
        if (verb) then
          write(0,*) "    Dottesting reg_op operator"
        end if
        if (.not. check_dot(reg_op,nmod,nmod)) then
          write(0,*) "    ERROR: Failed reg_op dottest"
          return
        end if
      end if
      if (dottest_extra) then
        if (verb) then
          write(0,*) "    Dottesting extra_op operator"
        end if
        if (.not. check_dot(extra_op,nreg_mod,n_extra)) then
          write(0,*) "    ERROR: Failed extra_op dottest"
          return
        end if
      end if
      if (dottest_extra_eps) then
        if (verb) then
          write(0,*) "    Dottesting extra_eps operator"
        end if
        if (.not. check_dot(eps_extra_op,n_extra,n_extra_eps)) then
          write(0,*) "    ERROR: Failed extra_eps dottest"
          return
        end if
      end if
      if (dottest_model_eps) then
        if (verb) then
          write(0,*) "    Dottesting eps_reg_op operator"
        end if
        if (.not. check_dot(eps_reg_op,nreg_mod,nmod_eps)) then
          write(0,*) "     ERROR: Failed eps_reg_op dottest"
          return
        end if
      end if
      if (dottest_tau) then
        if (verb) then
          write(0,*) "    Dottesting calc_delta_sigma_x operator"
        end if
        if (.not. check_dot(wrap_delta_sig,nreg_mod,nreg_mod)) then
          write(0,*) "     ERROR: Failed calc_delta_sigma_x dottest"
          return
        end if
      end if
      if (dottest_model_des) then
        if (verb) then
          write(0,*) "    Dottesting model_des operator"
        end if
        if (.not. check_dot(model_des_op,nmod,nreg_mod)) then
          write(0,*) "     ERROR: Failed model_des dottest"
          return
        end if
      end if
      if (dottest_data_cov) then
        if (verb) then
          write(0,*) "    Dottesting data_cov operator"
        end if
        if (.not. check_dot(data_covar_op,ndat,ncovar_dat)) then
          write(0,*) "     ERROR: Failed eps_reg_op dottest"
          return
        end if
      end if
      if (dottest_model_mask) then
        if (verb) then
          write(0,*) "    Dottesting model_mask operator"
        end if
        if (.not. check_dot(model_mask_op,nreg_mod,nreg_mod)) then
          write(0,*) "     ERROR: Failed model_mask_op dottest"
          return
        end if
      end if
      if (dottest_model_transform) then
        if (verb) then
          write(0,*) "    Dottesting model_transform operator"
        end if
        if (.not. check_dot(model_transform_op,nmod,nreg_mod)) then
          write(0,*) "     ERROR: Failed model_transform dottest"
          return
        end if
      end if
      if (dottest_model_eps) then
        if (verb) then
          write(0,*) "    Dottesting eps_reg_op operator"
        end if
        if (.not. check_dot(eps_reg_op,nreg_mod,nreg_mod)) then
          write(0,*) "     ERROR: Failed eps_reg_op dottest"
          return
        end if
      end if
      if (dottest_fitting) then
        if (verb) then
          write(0,*) "    Dottesting data_fitting operator"
        end if
        if (.not. check_dot(data_fitting_op,nmod,ncovar_dat)) then
          write(0,*) "     ERROR: Failed eps_reg_op dottest"
          return
        end if
      end if
      if (dottest_model_styling) then
        if (verb) then
          write(0,*) "    Dottesting model_styling operator"
        end if
        if (.not. check_dot(model_styling_op,nmod,nmod_eps)) then
          write(0,*) "     ERROR: Failed model_styling_op dottest"
          return
        end if
      end if
      if (dottest_standard) then
        if (verb) then
          write(0,*) "    Dottesting standard operator"
        end if
        if (.not. check_dot(standard_combo_op,nmod,ncovar_dat+nmod_eps&
          &)) then
          write(0,*) "     ERROR: Failed standard_combo_op dottest"
          return
        end if
      end if
      if (dottest_total) then
        if (verb) then
          write(0,*) "    Dottesting total operator"
        end if
        if (.not. check_dot(total_op,nmod,ncovar_dat+nmod_eps+n_extra_eps&
          &+nreg_mod)) then
          write(0,*) "     ERROR: Failed total_op dottest"
          return
        end if
      end if
    end if
    init_check_ops=.true.
  end function
  logical function check_tomo_ops_params()
    logical :: dottest_all,tau
    integer :: niter_prec,niter_reg
    check_tomo_ops_params=.false.
    call from_param("dottest_all",dottest_all,.false.)
    call from_param("dottest_tomo",dottest_tomo,dottest_all)
    if (extra_op_method(1:4).ne."NONE") then
      call from_param("dottest_extra",dottest_extra,dottest_all)
      call from_param("dottest_extra_chain",dottest_extra_chain,dottest_all&
        &)
      call from_param("dottest_extra_eps",dottest_extra_eps,dottest_all&
        &)
    else
      dottest_extra=.false.
      dottest_extra_chain=.false.
      dottest_extra_eps=.false.
    end if
    call from_param("niter_prec",niter_prec,0)
    call from_param("niter_reg",niter_reg,0)
    if (niter_prec >0) then
      call from_param("dottest_prec",dottest_prec,dottest_all)
    else
      dottest_prec=.false.
    end if
    if (niter_reg >0) then
      call from_param("dottest_reg",dottest_reg,dottest_all)
    else
      dottest_reg=.false.
    end if
    if (model_des_method(1:4).ne."NONE") then
      call from_param("dottest_model_mask",dottest_model_mask,dottest_all&
        &)
      call from_param("dottest_model_des",dottest_model_des,dottest_all&
        &)
    else
      dottest_model_des=.false.
      dottest_model_mask=.false.
    end if
    call from_param("dottest_model_eps",dottest_model_eps,dottest_all)
    call from_param("tau",tau,.false.)
    if (tau) then
      call from_param("dottest_tau",dottest_tau,dottest_all)
    else
      dottest_tau=.false.
    end if
    call from_param("dottest_total",dottest_total,dottest_all)
    call from_param("dottest_standard",dottest_standard,dottest_all)
    call from_param("dottest_fitting",dottest_fitting,dottest_all)
    call from_param("dottest_data_covar",dottest_data_cov,dottest_all)
    call from_param("dottest_model_transform",dottest_model_transform&
      &,dottest_all)
    call from_param("dottest_model_styling",dottest_model_styling&
      &,dottest_all)
    call from_param("verb",verb,.false.)
    if ( dottest_model_eps .or. dottest_tau .or. dottest_total .or.&
      & dottest_standard .or. dottest_fitting .or. dottest_data_cov&
      & .or. dottest_model_transform .or. dottest_model_styling .or.&
      & dottest_model_mask .or. dottest_model_des .or. dottest_reg &
      & .or. dottest_prec .or. dottest_extra .or. dottest_extra_chain .or.dottest_extra_eps ) then
      dottest_it=.true.
    else
      dottest_it=.false.
    end if
    check_tomo_ops_params=.true.
  end function
end module
