!        Generated by TAPENADE     (INRIA, Ecuador team)
!  tapenade 3.x
!
!  Differentiation of set_optip in forward (tangent) mode:
!   variations   of useful results: *dbc_data *bcperiod *propunit
!   with respect to varying inputs: *dbc_data *bcperiod *propunit
!                pvalue
!   Plus diff mem management of: dbc_data:in bcperiod:in propunit:in
! MIT License
!
! Copyright (c) 2020 SHEMAT-Suite
!
! Permission is hereby granted, free of charge, to any person obtaining a copy
! of this software and associated documentation files (the "Software"), to deal
! in the Software without restriction, including without limitation the rights
! to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
! copies of the Software, and to permit persons to whom the Software is
! furnished to do so, subject to the following conditions:
!
! The above copyright notice and this permission notice shall be included in all
! copies or substantial portions of the Software.
!
! THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
! IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
! FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
! AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
! LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
! OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
! SOFTWARE.
!>    @brief set parameter value with index "seedi"
!>    @param[in] seedi parameter component/index
!>    @param[in] pvalue value to set
!>    @param[in] ismpl local sample index
SUBROUTINE g_SET_OPTIP(seedi, pvalue, g_pvalue, ismpl)
  USE ARRAYS

  USE g_ARRAYS

  USE MOD_GENRL
  IMPLICIT NONE
  INTEGER :: ismpl
  INTEGER :: seedi, s_k, s_u
  DOUBLE PRECISION :: pvalue
  DOUBLE PRECISION :: g_pvalue
  IF (seedi .LT. 1 .OR. seedi .GT. mpara) THEN
    WRITE(*, *) 'error: in "set_optip", no valid index=', seedi, &
&   ' out of range'
    STOP
  ELSE
    s_k = seed_para(1, seedi)
    s_u = seed_para(2, seedi)
    IF (s_k .LE. lastidx .AND. s_k .GE. firstidx) THEN
!         parameter units
      g_propunit(s_u, s_k, ismpl) = g_pvalue
      propunit(s_u, s_k, ismpl) = pvalue
      CALL g_STAB_PARAM(propunit(s_u, s_k, ismpl), g_propunit(s_u, &
&                   s_k, ismpl), s_k, s_u)
    ELSE IF (s_k .LE. bc_lastidx .AND. s_k .GE. bc_firstidx) THEN
!        bc units
      g_propunit(s_u, s_k, ismpl) = g_pvalue
      propunit(s_u, s_k, ismpl) = pvalue
    ELSE IF (s_k .EQ. -1) THEN
!        tp units
!        warning, the second parameter need an addition of 1,
!          because of restricted range [1..2] instead of [1..3]
      g_bcperiod(opti_tp(1, s_u), opti_tp(2, s_u)+1, opti_tp(3, s_u), &
&     ismpl) = g_pvalue
      bcperiod(opti_tp(1, s_u), opti_tp(2, s_u)+1, opti_tp(3, s_u), &
&     ismpl) = pvalue
    ELSE IF (s_k .EQ. -2) THEN
!        single cell bc
      g_dbc_data(s_u, 1, ismpl) = g_pvalue
      dbc_data(s_u, 1, ismpl) = pvalue
    ELSE
      WRITE(*, *) 'error: "set_optip" has an incorrect index=', seedi, &
&     ' value !'
      STOP
    END IF
    RETURN
  END IF
END SUBROUTINE g_SET_OPTIP

