! ==============================================================================
! {%DBL}_si
! generated: {%TIMEDATE}
!
! this module is automaticly generated by imdouble utility
! contains: some maintenance routines for budgeting configurations (isotopes)
! level: smil si
!
! {$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"

! WARNING: THIS IS A PROTOTYPE UNDER DEVELOPMENT

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

#ifdef ECHAM5
#define _RI_KN_    jk,jt
#define _RI_YK_    jk,jrow
#endif

#ifdef COSMO
#define _RI_KN_    jt,jk
#define _RI_YK_    jrow,jk
#endif

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

! {$CONF_PARAM}

MODULE {%CMODEL}_{%DBL}_si


  USE messy_mecca_kpp, ONLY: dp
  USE {%CMODEL}_dbl_common
  USE {%CMODEL}_{%DBL}

->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>ATOM:C}
! reference standart ratio for 13C, V-PDB
  REAL(dp), PARAMETER :: VPDB_13C     = 1123.72E-05_dp
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<ATOM:C}
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>ATOM:O}
! reference standart ratio for 17O, 18O, V-SMOW
  REAL(dp), PARAMETER :: VSMOW_17O    =  386.72E-06_dp  ! Assonov, 2003b, pc
  REAL(dp), PARAMETER :: VSMOW_18O    = 2005.20E-06_dp
! oxygen mass-independent fractionation factor
  REAL(dp), PARAMETER :: NMDF_O        = 0.5281_dp      ! beta: meteoric waters
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<ATOM:O}

! tracer indices list (corresponds {%DBL}_<spec>)
  INTEGER             :: {%DBL}_DTI({%NSPEC},0:{%NCLASS})
! flag if scanned
  LOGICAL             :: {%DBL}_scan_tracs_done = .FALSE.

  PUBLIC {%DBL}_scan_tracs
  PUBLIC {%DBL}_x1
  PUBLIC {%DBL}_calc_xtte4scav

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

CONTAINS

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

! scanning tracers list and index original <-> doubled

  SUBROUTINE {%DBL}_scan_tracs

    ! ECHAM5/MESSy
    USE messy_main_tracer_mem_bi, ONLY: GPTRSTR, ntrac_gp
    USE messy_main_tracer_bi,     ONLY: tracer_halt
    USE messy_main_mpi_bi,        ONLY: p_parallel_io
    ! MESSy
    USE messy_main_tracer,        ONLY: get_tracer_list
    USE messy_main_constants_mem, ONLY: STRLEN_MEDIUM

    IMPLICIT NONE
    CHARACTER(LEN=*), PARAMETER :: substr = '{%DBL}_scan_tracs'

    INTEGER            :: status, js, jc
    INTEGER, POINTER   :: idt_temp(:)
    CHARACTER(LEN=127) :: info, ts


  ! checking if tracer indices were scanned
    IF ({%DBL}_scan_tracs_done) THEN
      IF (p_parallel_io) print *, '  ',substr,': tracers were scanned already'
      RETURN
    ENDIF

    IF (p_parallel_io) print *, '  ',substr,': finding corresponding regular <-> tagging tracer indices'

    DO js = 1, {%NSPEC}

      ! looking for original tracer
      CALL get_tracer_list(status, GPTRSTR, TRIM(SPC_NAMES({%RSIND}(js,0))), idt_temp)
      CALL tracer_halt(substr, status)

      ! storing tracer index, getting 1st entry (basename)
      {%DBL}_DTI(js,0) = idt_temp(1)
      ! checking if a reasonable index has arrived
      IF (({%DBL}_DTI(js,0) .GT. ntrac_gp) .OR. ({%DBL}_DTI(js,0) .LT. 1)) {%DBL}_DTI(js,0) = -1

      ! some info
      write (ts,'(I0)') {%DBL}_DTI(js,0)
      info = TRIM(SPC_NAMES({%RSIND}(js,0)))//'('//TRIM(ts)//') <->'
      
      DO jc = 1, {%NCLASS}
        ! getting doubled tracers
        CALL get_tracer_list(status, GPTRSTR, TRIM(SPC_NAMES({%RSIND}(js,jc))), idt_temp)
        CALL tracer_halt(substr, status)

        ! storing jcth doubled tracer index, getting 1st entry (basename)
        {%DBL}_DTI(js,jc) = idt_temp(1)
        ! checking if a reasonable index has arrived
        IF (({%DBL}_DTI(js,jc) .GT. ntrac_gp) .OR. ({%DBL}_DTI(js,jc) .LT. 1)) {%DBL}_DTI(js,jc) = -1

        ! output what is found
        write (ts,'(I0)') {%DBL}_DTI(js,jc)
        info = TRIM(info)//' '//TRIM(SPC_NAMES({%RSIND}(js,jc)))//'('//TRIM(ts)//')'
      ENDDO

      IF (p_parallel_io) write(*,*) '  '//TRIM(info)
      
    ENDDO

  ! setting the flag
    {%DBL}_scan_tracs_done = .TRUE.

  END SUBROUTINE {%DBL}_scan_tracs


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

! tracers mixing ratios initialization (x1) -- temp. for si

  SUBROUTINE {%DBL}_x1(C)
  
    IMPLICIT NONE

    REAL(dp), INTENT(INOUT) :: C(:)

    INTEGER  :: i
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>CASE:REM}
! {$x0} [%n%]  (%    D13C({%TAG}_@) = $%)
! n - # of the class, i.e. 2 for d13 / 2 for d17, 3 for d18
! @ - species name; $ - init. value
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<CASE:REM}
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>CONF:I*}
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>ATOM:C}
    REAL(dp) :: D13C(1:{%NSPEC})

! {$x0} [%2%]  (%    D13C({%TAG}_@) = $%)

#ifdef ZERO_TEST
    D13C(:) = 0.0_dp
#endif

#ifdef INIUNIT_DELTAPM
  ! 12C, 13C through delta and regular species:

    D13C(:) = D13C(:) / 1000.0_dp         ! de-permilizing

    C({%RSIND}(:,1)) = C({%RSIND}(:,0)) * &
      isofrac2r(D13C(:), VPDB_13C, {%NQATOM}(:))
    C({%RSIND}(:,2)) = C({%RSIND}(:,0)) * &
      isofrac2f(D13C(:), VPDB_13C, {%NQATOM}(:))
#endif
#ifdef INIUNIT_FRACMIN
  ! 12C, 13C through minor fraction and regular species:

    C({%RSIND}(:,1)) = C({%RSIND}(:,0)) * (1.0_dp - D13C(:))
    C({%RSIND}(:,2)) = C({%RSIND}(:,0)) * D13C(:)
#endif
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<ATOM:C}
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>ATOM:O}
    REAL(dp) :: D17O(1:{%NSPEC}), D18O(1:{%NSPEC})

! {$x0} [%2%]  (%    D17O({%TAG}_@) = $%)
! {$x0} [%3%]  (%    D18O({%TAG}_@) = $%)

#ifdef ZERO_TEST
    D17O(:) = 0.0_dp
    D18O(:) = 0.0_dp
#endif

#ifdef INIUNIT_DELTAPM
  ! 16O, 17O, 18O through delta and regular species:

    D17O(:) = D17O(:) / 1000.0_dp         ! de-permilizing
    D18O(:) = D18O(:) / 1000.0_dp

    C({%RSIND}(:,1)) = C({%RSIND}(:,0)) * &
      isofrac3r(D17O(:), VSMOW_17O, D18O(:), VSMOW_18O, QD{%ATOM}ATOM(:))
    C({%RSIND}(:,2)) = C({%RSIND}(:,0)) * &
      isofrac3f(D17O(:), VSMOW_17O, D18O(:), VSMOW_18O, QD{%ATOM}ATOM(:))
    C({%RSIND}(:,3)) = C({%RSIND}(:,0)) * &
      isofrac3f(D18O(:), VSMOW_18O, D17O(:), VSMOW_17O, QD{%ATOM}ATOM(:))
#endif
#ifdef INIUNIT_FRACMIN
  ! 16O, 17O, 18O through minor fractions and regular species:

    C({%RSIND}(:,1)) = C({%RSIND}(:,0)) * (1.0_dp - (D17O(:) + D18O(:)))
    C({%RSIND}(:,2)) = C({%RSIND}(:,0)) * D17O(:)
    C({%RSIND}(:,3)) = C({%RSIND}(:,0)) * D18O(:)
#endif
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<ATOM:O}
-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<CONF:I*}
->>- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {>CONF:F*}
  ! initializing using fractions given in cfg

! {$x0} [%#%]  (%    C({%RSIND}({%TAG}_@,#)) = C({%RSIND}({%TAG}_@,0)) * $%)

-<<- ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ {<CONF:F*}

#ifdef NULL_TEST
  ! minors are initialized emptied
#ifndef CLASSES_1
    C({%RSIND}(:,1)) = C({%RSIND}(:,0))
    C({%RSIND}(:,2:{%NISO})) = 0.0_dp
#else
    C({%RSIND}(:,1)) = 0.0_dp
#endif

#endif

  ! updating total {%ATOM} in the system
    CALL {%DBL}_calctotals(C)
    
  END SUBROUTINE {%DBL}_x1



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

  SUBROUTINE {%DBL}_calc_xtte4scav(xtte_scav, max_lev_scav, pxtp1, kproma)

    USE messy_main_data_bi,       ONLY: nlev, nproma
    USE messy_main_tracer_mem_bi, ONLY: ntrac => ntrac_gp

    IMPLICIT NONE

  ! input: calculated tendencies for regulars in scav
    REAL(dp), INTENT(INOUT) :: xtte_scav(nproma,nlev,ntrac)   ! scav_e5: ALLOCATE(xtte_scav(nproma,nlev,ntrac)), ntrac=>ntrac_gp
  ! scav. calculation levels constraint, kproma
    INTEGER, INTENT(IN)     :: max_lev_scav, kproma
  ! tracer field provided by scav
    REAL(dp), INTENT(IN)    :: pxtp1(nproma,nlev,ntrac)

    INTEGER  :: jk, jl, jt, js, jc, jtc
    REAL(dp) :: xtte_val, pxtp1_val

  ! checking if tracer indices were scanned
    IF (.NOT.{%DBL}_scan_tracs_done) CALL {%DBL}_scan_tracs

    DO jk = max_lev_scav, nlev

    ! cycling only over the set of tracers of interest
      DO js = 1, {%NSPEC}

      ! regular tracer index
        jt = {%DBL}_DTI(js,0)
      ! false index protection
        IF (jt .LE. 0) CYCLE

#ifdef DEBUG
        IF ((jk .EQ. nlev) .AND. (js .EQ. dbl_FO17_SO2)) THEN
           write(*,*) '- dbl_FO17_calc_xtte4scav debug - FO17_SO2 ----------------------------------------------'
           write(*,*) 'proma, xtte_val, pxtp1_val, pxtp1 (class) -> ratio'
        ENDIF
#endif

        DO jl = 1, kproma
!!$            if (zxtp1(jl,jk,jt)*cm(jl,jk) < -1.e-15_dp) &
!!$               print*, "WARNING, ls scav negative",js,jl,jk,jt,jrow,&
!!$               zxtp1(jl,jk,jt)*cm(jl,jk), pxtp1(jl,jk,jt)
           xtte_val = xtte_scav(jl,jk,jt)
           pxtp1_val = pxtp1(jl,jk,jt)

           IF (pxtp1_val .GT. 0.0_dp) then                    ! .AND. (xtte_val .NE. 0.0_dp)
             DO jc = 1, {%NCLASS}

             ! jc class tracer
               jtc = {%DBL}_DTI(js,jc)
             ! false index protection
               IF (jtc .LE. 0) CYCLE
             ! adjusting the tendency
               xtte_scav(jl,jk,jtc) = xtte_val * &
                  (pxtp1(jl,jk,jtc) / pxtp1_val)         ! weighting by the class fraction
#ifdef DEBUG
             ! some debug
               IF ((jk .EQ. nlev) .AND. (js .EQ. dbl_FO17_SO2)) &
                 write(*,*) jl, ', ', xtte_val, ', ', pxtp1_val, ', ', pxtp1(jl,jk,jtc), &
                                ' ( ',jc,') -> ', pxtp1(jl,jk,jtc)/pxtp1_val
#endif
             ENDDO
           ENDIF
        ENDDO
      ENDDO
    ENDDO

  END SUBROUTINE {%DBL}_calc_xtte4scav


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

  LOGICAL FUNCTION {%DBL}_sub_regtracname(trindex, reg_trname)

#ifdef DEBUG
    USE messy_main_mpi_bi,        ONLY: p_parallel_io
#endif

    IMPLICIT NONE

  ! dbl tracer index
    INTEGER, INTENT(IN)             :: trindex
  ! reg tracer name to substitute
    CHARACTER(len=*), INTENT(INOUT) :: reg_trname

    INTEGER  :: js, jc

  ! checking if tracer indices were scanned
    IF (.NOT.{%DBL}_scan_tracs_done) CALL {%DBL}_scan_tracs

#ifdef DEBUG
    if (p_parallel_io) print *,'    {%DBL}_sub_regtracname( ',trindex,', ',reg_trname,'): '
#endif

    DO js = 1, {%NSPEC}
    ! exiting immediately if the regular tracer met
      IF ( trindex .EQ. {%DBL}_DTI(js,0) ) THEN
        {%DBL}_sub_regtracname = .TRUE.
#ifdef DEBUG
        if (p_parallel_io) print *,'REGULAR IDENTIFIED'
#endif
        RETURN
      ENDIF
      
    ! checking doubled tracers' indices
      DO jc = 1, {%NCLASS}
        IF ( trindex .EQ. {%DBL}_DTI(js,jc) ) THEN
        ! substituting with the regular name
          reg_trname = TRIM(SPC_NAMES({%RSIND}(js,0)))   ! this relies on equal naming in tracer and mecca !
          {%DBL}_sub_regtracname = .TRUE.
#ifdef DEBUG
          if (p_parallel_io) print *,'DOUBLED IDENTIFIED, SUB: ', reg_trname
#endif
          RETURN
        ENDIF
      ENDDO
    ENDDO
    
  ! no substitution was found
    {%DBL}_sub_regtracname = .FALSE.

#ifdef DEBUG
    if (p_parallel_io) print *,'NOT IDENTIFIED!'
#endif

  END FUNCTION {%DBL}_sub_regtracname


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

  LOGICAL FUNCTION {%DBL}_sub_regtracno(trindex, reg_trindex)

#ifdef DEBUG
    USE messy_main_mpi_bi,        ONLY: p_parallel_io
#endif

    IMPLICIT NONE

  ! tracer referring index
    INTEGER, INTENT(IN)    :: trindex
  ! tracer name to substitute
    INTEGER, INTENT(INOUT) :: reg_trindex

    INTEGER  :: js, jc

  ! checking if tracer indices were scanned
    IF (.NOT.{%DBL}_scan_tracs_done) CALL {%DBL}_scan_tracs

#ifdef DEBUG
    if (p_parallel_io) print *,'    {%DBL}_sub_regtracno( ',trindex,', ?): '
#endif

    DO js = 1, {%NSPEC}
    ! exiting immediately if the regular tracer met
      IF ( trindex .EQ. {%DBL}_DTI(js,0) ) THEN
        {%DBL}_sub_regtracno = .TRUE.
        reg_trindex = trindex
#ifdef DEBUG
        if (p_parallel_io) print *,'REGULAR IDENTIFIED'
#endif
        RETURN
      ENDIF
      
    ! checking doubled tracers' indices
      DO jc = 1, {%NCLASS}
        IF ( trindex .EQ. {%DBL}_DTI(js,jc) ) THEN
        ! substituting with the regular name
          reg_trindex = {%DBL}_DTI(js,0)
          {%DBL}_sub_regtracno = .TRUE.
#ifdef DEBUG
          if (p_parallel_io) print *,'DOUBLED IDENTIFIED, SUB: ', reg_trindex
#endif
          RETURN
        ENDIF
      ENDDO
    ENDDO
    
  ! no substitution was found
    {%DBL}_sub_regtracno = .FALSE.

#ifdef DEBUG
    if (p_parallel_io) print *,'NOT IDENTIFIED'
#endif

  END FUNCTION {%DBL}_sub_regtracno

  
END MODULE {%CMODEL}_{%DBL}_si

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