!################################################################# ! ! 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