ecearth3/sources/tm5mp/base/tm5_tendency_eval.F90

!#################################################################
!
! tendency dimensions
!
!### macro's #####################################################
!
#define TRACEBACK write (gol,'("in ",a," (",a,", line",i5,")")') rname, __FILE__, __LINE__; call goErr
#define IF_NOTOK_RETURN(action) if (status/=0) then; TRACEBACK; action; return; end if
#define IF_ERROR_RETURN(action) if (status> 0) then; TRACEBACK; action; return; end if
!
#include "tm5.inc"
!
!#################################################################

module TM5_Tendency_eval

  use GO, only : gol, goPr, goErr
  
  use tm5_tendency
  implicit none
  
  
  ! --- in/out --------------------------------
  
#ifdef oasis4
  public :: prism_init_time
#endif
  public :: set_init_tend,apply_tendency,reset_tendency



contains

#ifdef oasis4
  subroutine prism_init_time
  ! subroutine to get start/end timing from prism-coupler.
 


  use dims         , only : idatei,idatee, idatet
  use PRISM        , only : PRISM_Jobstart_date, PRISM_Jobend_date


      !
      ! set times provided by prism coupler:
      !
      idatei(1) = PRISM_Jobstart_date%year
      idatei(2) = PRISM_Jobstart_date%month
      idatei(3) = PRISM_Jobstart_date%day
      idatei(4) = PRISM_Jobstart_date%hour
      idatei(5) = PRISM_Jobstart_date%minute
      idatei(6) = nint(PRISM_Jobstart_date%second)
      !
      idatee(1) = PRISM_Jobend_date%year
      idatee(2) = PRISM_Jobend_date%month
      idatee(3) = PRISM_Jobend_date%day
      idatee(4) = PRISM_Jobend_date%hour
      idatee(5) = PRISM_Jobend_date%minute
      idatee(6) = nint(PRISM_Jobend_date%second)

      ! copy
      idatet = idatee

  end subroutine prism_init_time
#endif


  subroutine set_init_tend (rcfile,status)

    use GO           , only : gol, goPr, goErr, goLabel
    use GO           , only : TrcFile, Init, Done, ReadRc
    use GO           , only : TDate, NewDate, IncrDate, AnyDate
    use dims         , only : idate
    use tracer_data     , only : PLC_Set, PLC_Reset
    use tracer_data     , only : plc_reset_period
#ifdef with_feedback
    use tm5_feedback    , only : fdb_ntr, fdb_trname, fdb_replace
    use tm5_feedback    , only : fdb_firstonly
#endif
#ifdef oasis4
    use prism_putget , only : TM5_Prism_Puts
#endif




    ! --- in/out ----------------------------------------

    character(len=*), intent(in)      ::  rcfile
    integer, intent(out)              ::  status

    ! --- const ----------------------------------------

    character(len=*), parameter ::  rname = mname//'/set_tend'

    ! --- local ---------------------------------------------

    integer             ::  itr, ipr
#ifdef with_feedback
    integer             ::  fdb_itr
#endif
 
    type(TrcFile)       ::  rcF
    type(TDate)         ::  tdyn

    ! --- begin -----------------------------------------------




    write (gol,'(a,": read tendency settings ...")') rname; call goPr

    ! open rcfile:
    call Init( rcF, rcfile, status )
    IF_NOTOK_RETURN(status=1)

    ! which tendencies form pchem ?
    call ReadRc( rcF, 'tend.pchem.emis'    , tend_pchem_emis    , status )
    IF_NOTOK_RETURN(status=1)
    call ReadRc( rcF, 'tend.pchem.drydepos', tend_pchem_drydepos, status )
    IF_NOTOK_RETURN(status=1)
    call ReadRc( rcF, 'tend.pchem.convdiff', tend_pchem_convdiff, status )
    IF_NOTOK_RETURN(status=1)
    ! which tendencies form lchem ?
    call ReadRc( rcF, 'tend.lchem.convdiff', tend_lchem_convdiff, status )
    IF_NOTOK_RETURN(status=1)
    call ReadRc( rcF, 'tend.lchem.chem'    , tend_lchem_chem    , status )
    IF_NOTOK_RETURN(status=1)
    call ReadRc( rcF, 'tend.lchem.emis'    , tend_lchem_emis    , status )
    IF_NOTOK_RETURN(status=1)
    call ReadRc( rcF, 'tend.lchem.drydepos', tend_lchem_drydepos, status )
    IF_NOTOK_RETURN(status=1)
    call ReadRc( rcF, 'tend.lchem.wetdepos', tend_lchem_wetdepos, status )
    IF_NOTOK_RETURN(status=1)

#ifdef with_feedback
    ! apply feedbacks for certain tracers ?
    do fdb_itr = 1, fdb_ntr
      call ReadRc( rcF, 'feedback.replace.'//trim(fdb_trname(fdb_itr)), fdb_replace(fdb_it
r), status )
      IF_NOTOK_RETURN(status=1)
    end do

    ! adhoc: only at start time field seem to be send:
    call ReadRc( rcF, 'feedback.firstonly', fdb_firstonly, status )
    IF_NOTOK_RETURN(status=1)
#endif

    call Done( rcF, status )
    IF_NOTOK_RETURN(status=1)

    write (gol,'(a,":  initialize tendency data ...")') rname; call goPr

        ! Do not fill current tracer fields from rm_k / rm_t: They are not present yet.
        ! Use the previously stored values instead.
        !  do itr = 1, plc_ntr
        !    call PLC_Set( 'fill-tracer', itr, plc_ipr_conc, status )
        !    IF_NOTOK_RETURN(status=1)
        !  end do

    ! reset pchem and lchem only:
    do itr = 1, plc_ntr
      ipr = plc_ipr_pchem
        call PLC_Reset( itr, ipr, status )
        IF_NOTOK_RETURN(status=1)
      ipr = plc_ipr_lchem
        call PLC_Reset( itr, ipr, status )
        IF_NOTOK_RETURN(status=1)
    end do

          ! add tendencies:
          do itr = 1, plc_ntr
            ! ~~ collected into pchem
            if ( tend_pchem_emis ) then
              call PLC_Set( 'add-low', itr, plc_ipr_pchem, status, ipr2=plc_ipr_pemi )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_pchem_drydepos ) then
              call PLC_Set( 'add', itr, plc_ipr_pchem, status, ipr2=plc_ipr_lddep, fac=-1.0 )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_pchem_convdiff ) then
              call PLC_Set( 'add', itr, plc_ipr_pchem, status, ipr2=plc_ipr_tcnvd )
              IF_NOTOK_RETURN(status=1)
            end if
            ! ~~ collected into lchem
            !    conventions: lchem negative means 'loss',
            !    thus emissions have a positive contribution to lchem ...
            if ( tend_lchem_convdiff ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_tcnvd )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_chem ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_tchem )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_emis ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_pemi )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_drydepos ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_lddep, fac=-1.0 )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_wetdepos ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_lwdep, fac=-1.0 )
              IF_NOTOK_RETURN(status=1)
            end if
          end do



#ifdef oasis4
        write (gol,'(a,":   send chemical tendency data ...")') rname; call goPr
        ! put tendencies to IFS:
        ! current time (begin of dynamics step)
        tdyn = NewDate( time6=idate  )
        call TM5_Prism_Puts( tdyn , status, isfirst=.true. )
        IF_NOTOK_RETURN(status=1)
#endif


  end subroutine set_init_tend


  subroutine apply_tendency (isfirst, tdyn, status )

    use GO, only : gol, goPr, goErr
    use GO              , only : TDate
    use tracer_data     , only : PLC_Set
#ifdef oasis4
    use prism_putget , only : TM5_Prism_Puts, TM5_Prism_gets
#endif

    ! --- in/out ----------------------------------


    type(TDate),intent(in)          ::  tdyn
    logical, intent(in)             ::  isfirst
    integer, intent(out)            ::  status

    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/apply_tendency'

    ! --- local ----------------------------------


    integer           ::  itr, ipr


    ! --- begin -----------------------------------



          ! no modifications of tendencies if this is initial time,
          ! since fields are either zero or read from restart file:
          if ( .not. isfirst ) then

            ! add budgets collected parallel over tracers:
            do itr = 1, plc_ntr
              call PLC_Set( 'add-t', itr, plc_ipr_tcnvd, status )  ! convection/diffusion
              IF_NOTOK_RETURN(status=1)
              call PLC_Set( 'add-t', itr, plc_ipr_lwdep, status )  ! wet deposition
              IF_NOTOK_RETURN(status=1)
              call PLC_Set( 'add-t', itr, plc_ipr_pemi , status )  ! emissions (not nox)
              IF_NOTOK_RETURN(status=1)
            end do

            ! dry depos is applied in chemistry, thus substract loss from chemical production
            ! (note that loss is positive, thus adding loss to change is the same as removing it):
            do itr = 1, plc_ntr
              call PLC_Set( 'add', itr, plc_ipr_tchem, status, ipr2=plc_ipr_lddep )
              IF_NOTOK_RETURN(status=1)
            end do

            ! nox emis is applied in chemistry, thus substract nox emis from chemical tendency:
            call PLC_Set( 'add', plc_itr_nox, plc_ipr_tchem, status, ipr2=plc_ipr_pemi, fac=-1.0 )
            IF_NOTOK_RETURN(status=1)


          ! fill current tracer fields:
          do itr = 1, plc_ntr
            call PLC_Set( 'fill-tracer', itr, plc_ipr_conc, status )
            IF_NOTOK_RETURN(status=1)
          end do

          ! add tendencies:
          do itr = 1, plc_ntr
            ! ~~ collected into pchem
            if ( tend_pchem_emis ) then
              call PLC_Set( 'add-low', itr, plc_ipr_pchem, status, ipr2=plc_ipr_pemi )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_pchem_drydepos ) then
              call PLC_Set( 'add', itr, plc_ipr_pchem, status, ipr2=plc_ipr_lddep, fac=-1.0 )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_pchem_convdiff ) then
              call PLC_Set( 'add', itr, plc_ipr_pchem, status, ipr2=plc_ipr_tcnvd)
              IF_NOTOK_RETURN(status=1)
            end if
            ! ~~ collected into lchem
            !    conventions: lchem negative means 'loss',
            !    thus emissions have a positive contribution to lchem ...
            if ( tend_lchem_convdiff ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_tcnvd )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_chem ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_tchem )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_emis ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_pemi )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_drydepos ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_lddep, fac=-1.0 )
              IF_NOTOK_RETURN(status=1)
            end if
            if ( tend_lchem_wetdepos ) then
              call PLC_Set( 'add', itr, plc_ipr_lchem, status, ipr2=plc_ipr_lwdep, fac=-1.0 )
              IF_NOTOK_RETURN(status=1)
            end if
          end do

          end if  ! not first

#ifdef oasis4
        ! put tendencies to IFS:
        if ( .not. isfirst ) then ! First submission is already performed in initexit.F90, before meteo-gets.
          call TM5_Prism_Puts( tdyn, status )
          IF_NOTOK_RETURN(status=1)
        endif

        ! get concentrations, eventuall feedback:
        call TM5_Prism_Gets( tdyn, isfirst, status )
        IF_NOTOK_RETURN(status=1)
#endif


  end subroutine apply_tendency


  subroutine reset_tendency ( status )

    use GO              , only : gol, goPr, goErr, goLabel
    use tracer_data     , only :  PLC_Reset


    ! --- in/out ----------------------------------

    integer, intent(out)            ::  status

    ! --- const ------------------------------

    character(len=*), parameter ::  rname = mname//'/reset_tendency'


    ! --- local ----------------------------------

    integer           ::  itr, ipr

    ! --- begin -----------------------------------


          ! loops over plc tracers and processes:
          do itr = 1, plc_ntr
            do ipr = 1, plc_npr
              ! not for for concentrations
              if ( ipr == plc_ipr_conc ) cycle
              ! reset tendencies to zero:
              call PLC_Reset( itr, ipr, status )
              IF_NOTOK_RETURN(status=1)
            end do  ! ipr
          end do  ! itr


  end subroutine reset_tendency



end module TM5_Tendency_eval