# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!<;
!err_mod
!
!Author: Robert Clapp, ESMB 463, 7230253
!
! Sun Jan 12 14:02:42 PST 2003
!
!
!Purpose:
!
! Handle extra constraints
!
!To add a new error type:
!
! -add to check_pars
! -add to initializer
! -add to op
!
!
! Currently
!
! -none
!
module extra_op_mod
  use adj_mod
  use basic_util_mod
  use param_check_mod
  use dip_constraint_mod
  implicit none
  character(len=128) :: extra_op_method
  integer, private, save :: nrange
  contains
  logical function init_extra_op()
    logical :: file_ok
    init_extra_op=.false.
!check to see if parameters are different
!#########################################
! IMPORTANT #
! #
! THIS WHERE WE DESCRIBE HOW TO #
! BUILD EXTRA OP #
! #
! MUST HAVE A CORARLY IN #
! #
! CHECK PARS/OP/INITIAL_OP #
! #
!#########################################
    if (extra_op_method(1:4).eq."NONE") then
      nrange=0
    else if (extra_op_method(1:14).eq."dip_constraint") then
      if (.not. init_dip_constraint(nrange)) then
        write(0,*) "trouble initializing dip constraint mod"
        return
      end if
    else
      write(0,*) "Unknown resid method=",trim(extra_op_method)
      return
    end if
    init_extra_op=.true.
  end function
  logical function get_extra_d(dat)
    real, pointer :: dat(:)
    get_extra_d=.false.
    if (extra_op_method(1:4).eq."NONE") then
      allocate(dat(0))
    else if (extra_op_method(1:5).eq."dip_c") then
      if (.not. get_extra_d_dip_con(dat)) then
        write(0,*) "trouble getting extra dip data"
        return
      end if
    else
      write(0,*) "unknown extra operator",trim(extra_op_method)
      return
    end if
    get_extra_d=.true.
  end function
  integer function extra_op(adj,add,model,data)
    logical,intent(in) :: adj,add
    real :: model(:),data(:)
!BY DEFAULT DIAGONAL 1
    if (extra_op_method(1:4).eq."NONE") then
      call adjnull(adj,add,model,data)
    else if (extra_op_method(1:14).eq."dip_constraint") then
      extra_op=dip_constraint_op(adj,add,model,data)
    else
      write(0,*) "extra_op_method",trim(extra_op_method)
      call seperr("Unknown extra_op_method")
    end if
    extra_op=0
  end function
  integer function get_extra_nrange()
    get_extra_nrange=nrange
  end function
  logical function check_extra_op_params()
    character(len=128) :: tag
    logical :: stat(100)
    stat=.true.
    check_extra_op_params=.false.
!#########################################
! IMPORTANT #
! #
! THIS WHERE WE DESCRIBE HOW TO #
! INITIALIZE/CHECK OBJECT PARAMS #
! #
!#########################################
    call from_param("extra_op_method",extra_op_method,"NONE")
    if (extra_op_method(1:4).eq."NONE") then
    else if (extra_op_method(1:14).eq."dip_constraint") then
      stat(1)=check_dip_constraint_params()
    else
      write(0,*) "Unknown extra_op_method=",trim(extra_op_method)
      return
    end if
    if (all(stat)) then
      check_extra_op_params=.true.
    end if
  end function
end module
