# 1 "<stdin>"
# 1 "<built-in>"
# 1 "<command line>"
# 1 "<stdin>"
!<;
!model_des_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 model_des_mod
  use adj_mod
  use basic_util_mod
  use param_check_mod
  use rectangle_region_mod
  implicit none
  character(len=128) :: model_des_method
  integer, private, save :: nmod
  logical, private, save :: verb
  contains
  logical function init_model_des()
    logical :: file_ok
    type(sep3d) :: vel_s
    init_model_des=.false.
    if (verb) then
      write(0,*) "    MODEL DESCRIPTION METHOD=",trim(model_des_method&
        &)
    end if
!check to see if parameters are different
    if (model_des_method(1:17) .eq. "rectangle_regions") then
      if (.not. init_rectangle_regions(nmod)) then
        write(0,*) "trouble initialzing rectangle regions"
        return
      end if
    else if (model_des_method(1:4).eq."NONE") then
      if (.not. vel_tomo_structure(vel_s)) then
        write(0,*) "Trouble grabbing velocity structure"
        return
      end if
      nmod=product(vel_s%n(1:sep3d_ndims(vel_s)))
    else
      write(0,*) "Unknown resid method=",trim(model_des_method)
      return
    end if
    init_model_des=.true.
  end function
  integer function model_mask_op(adj,add,model,data)
    logical,intent(in) :: adj,add
    real :: model(:),data(:)
    if (model_des_method(1:4).eq."NONE") then
      call adjnull(adj,add,model,data)
      if (.not. adj) then
        data= data+model
      else
        model= model+data
      end if
    else if (model_des_method(1:17).eq."rectangle_regions") then
      model_mask_op=rectangle_regions_mask_op(adj,add,model,data)
    else
      write(0,*) "unimplented model_des_method",trim(model_des_method)
      call seperr("mask method incompletelty implemented (programmers&
        & fault")
    end if
    model_mask_op=0
  end function
  logical function return_region_no_smooth(region,nosmooth)
    integer :: region(:)
    logical :: nosmooth(:)
    return_region_no_smooth=.false.
    if (model_des_method(1:17).eq."rectangle_regions") then
      if (.not. return_no_smooth_rectangle_regions(region,nosmooth))&
        & then
        write(0,*) "trouble grabbing no smooth region"
        return
      end if
    else if (model_des_method(1:4).eq."NONE") then
      region=1
      nosmooth=.false.
    else
      write(0,*) "unknown model description method"
      return
    end if
    return_region_no_smooth=.true.
  end function
  integer function model_des_op(adj,add,model,data)
    logical,intent(in) :: adj,add
    real :: model(:),data(:)
!BY DEFAULT DIAGONAL 1
    if (model_des_method(1:4).eq."NONE") then
      call seperr("Shouldn't call model_des_op when model_model_des_method==NONE&
        & ")
    else if (model_des_method(1:17).eq."rectangle_regions") then
      model_des_op=rectangle_regions_des_op(adj,add,model,data)
    else
      write(0,*) "model_model_des_method",trim(model_des_method)
      call seperr("Unknown model_des_method")
    end if
    model_des_op=0
  end function
  integer function model_des_ndomain()
    model_des_ndomain=nmod
  end function
  logical function model_tomo_space_clean(vel)
    real :: vel(:,:,:)
    model_tomo_space_clean=.false.
    if (model_des_method(1:4).eq."NONE") then
    else if (model_des_method(1:17).eq."rectangle_regions") then
      if (.not. rect_region_clean(vel)) then
        write(0,*) "trouble cleaning rectangular regions"
        return
      end if
    else
      write(0,*) "model_des_method",trim(model_des_method)
      call seperr("Unknown model_des_method")
    end if
    model_tomo_space_clean=.true.
  end function
  integer function model_rep_inv_op(adj,add,model,data)
    logical, intent(in) :: adj,add
    real :: model(:),data(:)
    if (model_des_method(1:4).eq."NONE") then
      call adjnull(adj,add,model,data)
      if (.not. adj) then
        data= data+model
      else
        model= model+data
      end if
    else if (model_des_method(1:17).eq."rectangle_regions") then
      model_rep_inv_op=rectangle_regions_inv_op(adj,add,model,data)
    else
      write(0,*) "unimplented model_des_method",trim(model_des_method)
      call seperr("mask method incompletelty implemented (programmers&
        & fault")
    end if
    model_rep_inv_op=0
  end function
  logical function check_model_des_params()
    character(len=128) :: tag
    logical :: stat(100)
    stat=.true.
    check_model_des_params=.false.
    call from_param("verb",verb,.false.)
!#########################################
! IMPORTANT #
! #
! THIS WHERE WE DESCRIBE HOW TO #
! INITIALIZE/CHECK OBJECT PARAMS #
! #
!#########################################
    call from_param("model_des_method",model_des_method,"NONE")
    if (model_des_method(1:4).eq."NONE") then
    else if (model_des_method(1:17) .eq. "rectangle_regions") then
      if (.not. grab_pars_rectangle_regions()) then
        write(0,*) "trouble initializing rectangular regions"
        return
      end if
    else
      write(0,*) "Unknown model_des_method=",trim(model_des_method)
      return
    end if
    check_model_des_params=.true.
  end function
end module
