! ==============================================================================
! {%DBL} core
! generated: {%TIMEDATE}
!
! this module is automaticly generated by imdouble utility
! contains: some maintenance routines for budgeting configurations (isotopes)
! level: smcl
!
! {$DBL_INFO} ! this is a template file for imdouble utility
!
! [Gromov, MPIC, 2007-2009]
! ==============================================================================

! - general doubling parameters (as conditional defines) -----------------------

#include "{%CMODEL}_dbl_parameters.inc"

! ------------------------------------------------------------------------------

! {$CONF_PARAM}

MODULE {%CMODEL}_{%DBL}

  USE messy_mecca_kpp     ! dp, ... nreact, nspec, ind_*, SPC_NAMES, EQN_TAGS
  USE {%CMODEL}_dbl_common

  IMPLICIT NONE

! treshold value: below it, species might stop to sink to the others 
! (but can receive still)
  REAL(dp), PARAMETER :: THRES = 1.0E-40_dp * 2.5047E+19_dp  
!                                ?          * mean cair

! ------------------------------------------------------------------------------

! here constants and doubled species indices are to be defined
! {$TRAC_DECL} [%{%TAG}_@%]

! ------------------------------------------------------------------------------
  
! no. of "rejected" species (under threshold)
  INTEGER             :: {%DBL}_NREJCT

! ------------------------------------------------------------------------------

  PRIVATE NKRSPEC, KRSIND

  PUBLIC {%DBL}_ind_d
  PUBLIC {%DBL}_calctotals
  PUBLIC {%DBL}_correct
  PUBLIC {%DBL}_correct2reg
  PUBLIC {%DBL}_correct2dbl
  PUBLIC {%DBL}_resetPTs

! ==============================================================================

CONTAINS

! ==============================================================================

  SUBROUTINE {%DBL}_ind_d(ind_r, ind_d)

  ! returns corresponding doubling index ind_d for a regular ind_r

    IMPLICIT NONE

    INTEGER, INTENT(IN)  :: ind_r
    INTEGER, INTENT(OUT) :: ind_d
    INTEGER              :: i
    
    ind_d = -1
    DO i = 1, {%NSPEC}
      IF ({%RSIND}(i,0) .EQ. ind_r) THEN
        ind_d = i
        RETURN
      ENDIF
    ENDDO

  END SUBROUTINE {%DBL}_ind_d



! -----------------------------------------------------------------------------

  SUBROUTINE {%DBL}_calctotals(C)

    IMPLICIT NONE

    REAL(dp), INTENT(INOUT) :: C(:)     ! operational vector of concentrations
    INTEGER  :: i

  ! here the total number of {%ATOM} atoms calculated, 
  ! according to each species composition

->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>CONF:I}
  ! isotopic doubling

  ! TC is calculated for regular mech
    C({%TDIND}(0)) = SUM( C({%RSIND}(:,0))*REAL({%NQATOM}(:),dp) )

  ! major isotopologues of abundant isotope
    C({%TDIND}(1)) = SUM( C({%RSIND}(:,1))*REAL({%NQATOM}(:),dp) )

    DO i = 2, {%NISO}

    ! rare isotope of minor isotopologues
      C({%TDIND}(i)) = SUM( C({%RSIND}(:,i)) )

    ! adding rare isotope of minor to total of major
      C({%TDIND}(1)) = C({%TDIND}(1)) + &
        SUM( C({%RSIND}(:,i))*REAL({%NQATOM}(:)-1,dp) )

    ENDDO
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<CONF:I}
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>CONF:F}
  ! fractional doubling

  ! total for regular
    C({%TDIND}(0)) = SUM( C({%RSIND}(:,0))*REAL({%NQATOM}(:),dp) )

  ! totals for doubled
    DO i = 1, {%NCLASS}
      C({%TDIND}(i)) = SUM( C({%RSIND}(:,i))*REAL({%NQATOM}(:),dp) )
    ENDDO
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<CONF:F}

#ifdef DEBUG
    print *,'{%DBL}_calctotals: passed'
#endif
#ifdef DEEPDEBUG
    print *,'{%DBL}_calctotals: T{%ATOM} (R+DBL): ',C({%TDIND}(:))
#endif

  END SUBROUTINE {%DBL}_calctotals



! -----------------------------------------------------------------------------

! correction of total isotopologues budget to "regular" species budget

  SUBROUTINE {%DBL}_correct(C)

    IMPLICIT NONE

    REAL(dp), INTENT(INOUT) :: C(:)     ! operational vector of concentrations
    INTEGER  :: i
    REAL(dp) :: total


#ifdef OPT_NEG_FILTER
  ! in case anything shoots to negative, correcting
    DO i = 1, {%NCLASS}
      WHERE ( C({%RSIND}(1:,i)) .LT. 0.0_dp )
        C({%RSIND}(:,i)) = 0.0_dp
      ENDWHERE
    ENDDO
#endif

#ifdef OPT_EXC_FILTER
  ! in case fractional classes are defined, checking overshooting with
  ! relation to the original species only
    DO i = 1, {%NCLASS}
      WHERE ( C({%RSIND}(:,i)) .GT. C({%RSIND}(:,0)) )
        C({%RSIND}(:,i)) = C({%RSIND}(:,0))
      ENDWHERE
    ENDDO
#endif

#ifdef OPT_NO_CORR
  ! no correction option
    RETURN
#endif

#ifdef OPT_CORR_2DBL
  ! correction with doubled mech as reference
    CALL {%DBL}_correct2dbl(C)
#else
  ! normal correction to the regular mech
    CALL {%DBL}_correct2reg(C)
#endif

  END SUBROUTINE {%DBL}_correct

! -----------------------------------------------------------------------------



! -----------------------------------------------------------------------------

! correction of total isotopologues budget to "regular" species budget

  SUBROUTINE {%DBL}_correct2reg(C)

    IMPLICIT NONE

    REAL(dp), INTENT(INOUT) :: C(:)     ! operational vector of concentrations
    INTEGER  :: i
    REAL(dp) :: total

#ifdef CLASSES_1

#ifdef OPT_OSHOOT_FILTER
  ! in case one class is defined, checking overshooting only
    WHERE ( C({%RSIND}(:,1)) .GT. C({%RSIND}(:,0)) )
      C({%RSIND}(:,1)) = C({%RSIND}(:,0))
    ENDWHERE
#endif

#ifdef DEBUG
    print *,'{%DBL}_correct2reg: overshoot correction performed (one class)'
#endif
    return
#endif
   
#ifdef OPT_USE_KRSIND
  ! here is the ver. with corr. of only KIE-rel species to regular
  ! correcting only species related to KIE in this meccanism
    DO i = 1, NKRSPEC
      total = SUM ( C({%RSIND}(KRSIND(i),1:{%NISO})) )
      IF (total .GT. 0.0_dp) THEN
        C({%RSIND}(KRSIND(i),1:{%NISO})) = &
          ( C({%RSIND}(KRSIND(i),1:{%NISO})) * &
            C({%RSIND}(KRSIND(i),0)) ) / total
      ELSE
        C({%RSIND}(KRSIND(i),1:{%NISO})) = 0.0_dp
      ENDIF
    ENDDO
#else
  ! here is the ver. with corr. of ALL species to regular
    DO i = 1, {%NSPEC}
      total = SUM( C({%RSIND}(i,1:{%NISO})) ) 
      IF (total .GT. 0.0_dp) THEN
        C({%RSIND}(i,1:{%NISO})) = ( C({%RSIND}(i,1:{%NISO})) * C({%RSIND}(i,0)) ) / total
      ELSE
        C({%RSIND}(i,1:{%NISO})) = 0.0_dp
      ENDIF
    ENDDO
#endif

#ifdef DEEPDEBUG
    print *,'{%DBL}_correct2reg: passed'
#endif

  END SUBROUTINE {%DBL}_correct2reg



! -----------------------------------------------------------------------------
  
! correction of "regular" species budget to the total isotopologues budget

  SUBROUTINE {%DBL}_correct2dbl(C)

    IMPLICIT NONE

    REAL(dp), INTENT(INOUT) :: C(:)     ! operational vector of concentrations
    INTEGER                 :: i

#ifdef CLASSES_1
  ! in case one class is defined, quitting
#ifdef DEBUG
    print *,'{%DBL}_correct2dbl: no correction performed (one class)'
#endif
    return
#endif

#ifdef OPT_USE_KRSIND
  ! here is the ver. with corr. of only KIE-rel species to regular
    DO i = 1, NKRSPEC
      C({%RSIND}(KRSIND(i),0)) = SUM( C({%RSIND}(KRSIND(i),1:{%NISO})) )
    ENDDO
#else
  ! here is the ver. with corr. of ALL species to regular
    DO i = 1, {%NSPEC}
      C({%RSIND}(i,0)) = SUM( C({%RSIND}(i,1:{%NISO})) )      
    ENDDO
#endif

#ifdef DEEPDEBUG
    print *,'{%DBL}_correct2dbl: passed'
#endif

  END SUBROUTINE {%DBL}_correct2dbl



! -----------------------------------------------------------------------------
  
  SUBROUTINE {%DBL}_resetPTs(C)

  ! production tracers initialization (reset) routine

    IMPLICIT NONE
    
    REAL(dp), INTENT(INOUT) :: C(:)     ! operational vector of concentrations
    
! {x$RESET_PTs}
! - currently disabled with use of DRPT{%ATOM}IND()

#ifdef USE_PT
    C(DRPT{%ATOM}IND(:)) = 0.0_dp    ! <-- boxmodel syntax
#endif

#ifdef DEEPDEBUG
    print *,'{%DBL}_resetPTs: passed'
#endif

  END SUBROUTINE {%DBL}_resetPTs

! -----------------------------------------------------------------------------
  
END MODULE messy_mecca_{%DBL}

! *****************************************************************************

