module mrg_x2i_mct 1,7
use shr_kind_mod
, only: r8 => shr_kind_r8, cl => shr_kind_cl
use mct_mod
use seq_flds_mod
use seq_flds_indices
use seq_comm_mct
use seq_cdata_mod
use seq_infodata_mod
implicit none
save
private ! except
!--------------------------------------------------------------------------
! Public interfaces
!--------------------------------------------------------------------------
public :: mrg_x2i_init_mct
public :: mrg_x2i_run_mct
public :: mrg_x2i_final_mct
!--------------------------------------------------------------------------
! Private data
!--------------------------------------------------------------------------
!===========================================================================================
contains
!===========================================================================================
subroutine mrg_x2i_init_mct( cdata_i, a2x_i, o2x_i ) 1,1
type(seq_cdata), intent(in) :: cdata_i
type(mct_aVect), intent(inout) :: a2x_i
type(mct_aVect), intent(inout) :: o2x_i
type(mct_gsMap), pointer :: gsMap_ice
integer :: mpicom
! Set gsMap
call seq_cdata_setptrs
(cdata_i,gsMap=gsMap_ice,mpicom=mpicom)
! Initialize av for atmosphere export state on ice decomp
call MCT_aVect_init(a2x_i, rList=seq_flds_a2x_fields, &
lsize=mct_gsMap_lsize(gsMap_ice, mpicom))
call MCT_aVect_zero(a2x_i)
! Initialize av for ocn export state on ice decomp
call MCT_aVect_init(o2x_i, rList=seq_flds_o2x_fields, &
lsize=mct_gsMap_lsize(gsMap_ice, mpicom))
call MCT_aVect_zero(o2x_i)
end subroutine mrg_x2i_init_mct
!===========================================================================================
subroutine mrg_x2i_run_mct( cdata_i, a2x_i, o2x_i, x2i_i ) 1,3
!-----------------------------------------------------------------------
!
! Arguments
!
type(seq_cdata),intent(in) :: cdata_i
type(mct_aVect),intent(in) :: a2x_i
type(mct_aVect),intent(in) :: o2x_i
type(mct_aVect),intent(out):: x2i_i
!
! Local variables
!
logical :: usevector ! use vector-friendly mct_copy
integer :: i
real(r8):: flux_epbalfact
character(len=cl) :: flux_epbal
type(seq_infodata_type),pointer :: infodata
!
!----- formats -----
character(*),parameter :: F01 = "('(mrg_x2i_run_mct) ',a,3e11.3,a,f9.6)"
character(*),parameter :: subName = '(mrg_x2i_run_mct) '
!-----------------------------------------------------------------------
!
! Combine atm/ocn states to compute input ice state
!
#ifdef CPP_VECTOR
usevector = .true.
#else
usevector = .false.
#endif
call seq_cdata_setptrs
(cdata_i,infodata=infodata)
call mct_aVect_copy(aVin=o2x_i, aVout=x2i_i, vector=usevector)
call mct_aVect_copy(aVin=a2x_i, aVout=x2i_i, vector=usevector)
! Apply correction to precipitation of requested driver namelist
call seq_infodata_GetData
(infodata, flux_epbal=flux_epbal)
flux_epbalfact = 1.0_r8
if (trim(flux_epbal) == 'ocn') then
call seq_infodata_GetData
(infodata, precip_fact = flux_epbalfact)
flux_epbalfact = flux_epbalfact * 1.0e-6_r8
end if
if (flux_epbalfact <= 0.0_R8) then
if (loglevel > 0) write(logunit,F01) 'WARNING: factor from ocn = ',flux_epbalfact
if (loglevel > 0) write(logunit,F01) 'WARNING: resetting flux_epbalfact to 1.0'
flux_epbalfact = 1.0_r8
end if
! Merge total snow and precip for ice input
do i = 1,mct_aVect_lsize(x2i_i)
x2i_i%rAttr(index_x2i_Faxa_rain,i) = a2x_i%rAttr(index_a2x_Faxa_rainc,i) + &
a2x_i%rAttr(index_a2x_Faxa_rainl,i)
x2i_i%rAttr(index_x2i_Faxa_snow,i) = a2x_i%rAttr(index_a2x_Faxa_snowc,i) + &
a2x_i%rAttr(index_a2x_Faxa_snowl,i)
! scale total precip and runoff by flux_epbalfact (TODO: note in cpl6 this was always
! done over points where imask was > 0 - how does this translate here?)
x2i_i%rAttr(index_x2i_Faxa_rain,i) = x2i_i%rAttr(index_x2i_Faxa_rain,i) * flux_epbalfact
x2i_i%rAttr(index_x2i_Faxa_snow,i) = x2i_i%rAttr(index_x2i_Faxa_snow,i) * flux_epbalfact
end do
end subroutine mrg_x2i_run_mct
!
!===========================================================================================
!
subroutine mrg_x2i_final_mct
! ******************
! Do nothing for now
! ******************
end subroutine mrg_x2i_final_mct
end module mrg_x2i_mct