<p><b>dwj07@fsu.edu</b> 2012-12-18 13:51:47 -0700 (Tue, 18 Dec 2012)</p><p><br>
-- BRANCH COMMIT --<br>
<br>
Adding coupled forcing driver.<br>
</p><hr noshade><pre><font color="gray">Added: branches/ocean_projects/generic_forcing/src/core_ocean/mpas_ocn_forcing_coupled.F
===================================================================
--- branches/ocean_projects/generic_forcing/src/core_ocean/mpas_ocn_forcing_coupled.F (rev 0)
+++ branches/ocean_projects/generic_forcing/src/core_ocean/mpas_ocn_forcing_coupled.F 2012-12-18 20:51:47 UTC (rev 2359)
@@ -0,0 +1,234 @@
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+!
+! ocn_forcing_coupled
+!
+!> \brief MPAS ocean coupled forcing
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \version SVN:$Id:$
+!> \details
+!> This module contains routines for building the forcing arrays,
+!> if coupled forcing is used.
+!
+!-----------------------------------------------------------------------
+
+module ocn_forcing_coupled
+
+ use mpas_kind_types
+ use mpas_grid_types
+ use mpas_configure
+ use mpas_timekeeping
+ use ocn_constants
+
+ implicit none
+ private
+ save
+
+ !--------------------------------------------------------------------
+ !
+ ! Public parameters
+ !
+ !--------------------------------------------------------------------
+
+ !--------------------------------------------------------------------
+ !
+ ! Public member functions
+ !
+ !--------------------------------------------------------------------
+
+ public :: ocn_build_forcing_arrays_coupled, &
+ ocn_forcing_coupled_init
+
+ !--------------------------------------------------------------------
+ !
+ ! Private module variables
+ !
+ !--------------------------------------------------------------------
+
+ logical :: coupledForcingOn !< Flag to turn on/off coupled forcing
+
+!***********************************************************************
+
+contains
+
+!***********************************************************************
+!
+! routine ocn_build_forcing_arrays
+!
+!> \brief Determines the forcing array used for the coupled forcing.
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \version SVN:$Id$
+!> \details
+!> This routine computes the forcing arrays used later in MPAS.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_build_forcing_arrays_coupled(timeStamp, grid, err)!{{{
+
+ !-----------------------------------------------------------------
+ !
+ ! input variables
+ !
+ !-----------------------------------------------------------------
+
+ type(MPAS_Time_type), intent(in) :: timeStamp
+
+ !-----------------------------------------------------------------
+ !
+ ! input/output variables
+ !
+ !-----------------------------------------------------------------
+
+ type (mesh_type), intent(inout) :: &
+ grid !< Input: grid information
+
+
+ !-----------------------------------------------------------------
+ !
+ ! output variables
+ !
+ !-----------------------------------------------------------------
+
+ integer, intent(out) :: err !< Output: Error flag
+
+ !-----------------------------------------------------------------
+ !
+ ! local variables
+ !
+ !-----------------------------------------------------------------
+
+ integer :: iEdge, cell1, cell2
+ integer :: iCell
+ integer :: index_temperature_flux, index_salinity_flux
+
+ integer, dimension(:,:), pointer :: cellsOnEdge
+
+ real :: meridionalAverage, zonalAverage
+ real, dimension(:), pointer :: windStress, angleEdge
+ real, dimension(:), pointer :: zonalWindStress, meridionalWindStress
+ real, dimension(:), pointer :: latentHeatFlux, sensibleHeatFlux, longWaveHeatFluxUp, longWaveHeatFluxDown, evaportationFlux, seaIceHeatFlux, snowFlux
+ real, dimension(:), pointer :: seaIceFreshWaterFlux, seaIceSalinityFlux, riverRunoffFlux, iceRunoffFlux
+
+ real, dimension(:), pointer :: rainFlux
+ real, dimension(:), pointer :: seaLevelPressure, iceFraction
+
+ real, dimension(:), pointer :: surfaceMassFlux
+ real, dimension(:,:), pointer :: surfaceTracerFlux
+
+
+#ifdef MPAS_CESM
+ index_temperature_flux = grid % index_temperatureFlux
+ index_salinity_flux = grid % index_salinityFlux
+
+ angleEdge => grid % angleEdge % array
+
+ cellsOnEdge => grid % cellsOnEdge % array
+
+ windStress => grid % windStress % array
+ zonalWindStress => grid % zonalWindStress % array
+ meridionalWindStress => grid % meridionalWindStress % array
+ latentHeatFlux => grid % latentHeatFlux % array
+ sensibleHeatFlux => grid % sensibleHeatFlux % array
+ longWaveHeatFluxUp => grid % longWaveHeatFluxUp % array
+ longWaveHeatFluxDown => grid % longWaveHeatFluxDown % array
+ evaporationFlux => grid % evaporationFlux % array
+ seaIceHeatFlux => grid % seaIceHeatFlux % array
+ snowFlux => grid % snowFlux % array
+
+ seaIceFreshWaterFlux => grid % seaIceFreshWaterFlux % array
+ seaIceSalinityFlux => grid % seaIceSalinityFlux % array
+ riverRunoffFlux => grid % riverRunoffFlux % array
+ iceRunoffFlux => grid % iceRunoffFlux % array
+
+ rainFlux => grid % rainFlux % array
+
+ seaLevelPressure => grid % seaLevelPressure % array
+ iceFraction => grid % iceFration % array
+
+ surfaceMassFlux => grid % surfaceMassFlux % array
+ surfaceTracerFlux => grid % surfaceTracerFlux % array
+
+ ! Convert CESM wind stress to MPAS-O windstress
+ do iEdge = 1, grid % nEdges
+ cell1 = cellsOnEdge(1, iEdge)
+ cell2 = cellsOnEdge(2, iEdge)
+
+ zonalAverage = 0.5 * (zonalWindStress(cell1) + zonalWindStress(cell2))
+ meridionalAverage = 0.5 * (meridionalWindStress(cell1) + meridionalWindStress(cell2))
+
+ windStress(iEdge) = cos(angleEdge(iEdge)) * zonalAverage + sin(angleEdge(iEdge)) * meridionalAverage
+ end do
+
+
+ do iCell = 1, grid % nCells
+! surfaceTracerFlux(index_temperature_flux, iCell) = (latentHeatFlux(iCell) + evaporationFlux(iCell) * latent_heat_vapor_mks + sensibleHeatFlux(iCell) + longWaveHeatFluxUp(iCell) + longWaveHeatFluxDown(iCell) &
+! + seaIceHeatFlux(iCell) - (snowFlux(iCell) + iceRunoffFlux(iCell)) * latent_heat_fusion_mks) * hflux_factor
+
+ surfaceTracerFlux(index_temperature_flux, iCell) = (latentHeatFlux(iCell) + sensibleHeatFlux(iCell) + longWaveHeatFluxUp(iCell) + longWaveHeatFluxDown(iCell) &
+ + seaIceHeatFlux(iCell) - (snowFlux(iCell) + iceRunoffFlux(iCell)) * latent_heat_fusion_mks) * hflux_factor
+
+ if(config_use_virtual_salinity_flux) then
+ surfaceTracerFlux(index_salinity_flux, iCell) = (rainFlux(iCell) + snowFlux(iCell) + evaportationFlux(iCell) + seaIceFreshWaterFlux(iCell) + riverRunoffFlux(iCell) + iceRunOffFlux(iCell)) * salinity_factor &
+ + seaIceSalinityFlux(iCell) * sflux_factor
+ surfaceMassFlux(iCell) = 0.0_RKIND
+ else
+ surfaceTracerFlux(index_salinity_flux, iCell) = seaIceSalinityFlux(iCell) * sflux_factor
+
+ surfaceMassFlux(iCell) = snowFlux(iCell) + rainFlux(iCell) + evaporationFlux(iCell) + seaIceFreshWaterFlux(iCell) + iceRunoffFlux(iCell) + riverRunoffFlux(iCell)
+ end if
+
+ ! FROM POP -- Heat Fluxes
+! STF(:,:,1,iblock) = (EVAP_F(:,:,iblock)*latent_heat_vapor_mks &
+! + SENH_F(:,:,iblock) + LWUP_F(:,:,iblock) &
+! + LWDN_F(:,:,iblock) + MELTH_F(:,:,iblock) &
+! -(SNOW_F(:,:,iblock)+IOFF_F(:,:,iblock)) * latent_heat_fusion_mks)* &
+! RCALCT(:,:,iblock)*hflux_factor
+
+ ! FROM POP -- Salinity Fluxes
+! STF(:,:,2,iblock) = RCALCT(:,:,iblock)*( &
+! (PREC_F(:,:,iblock)+EVAP_F(:,:,iblock)+ &
+! MELT_F(:,:,iblock)+ROFF_F(:,:,iblock)+IOFF_F(:,:,iblock))*salinity_factor &
+! + SALT_F(:,:,iblock)*sflux_factor)
+ end do
+
+
+#endif
+ !--------------------------------------------------------------------
+
+ end subroutine ocn_build_forcing_arrays_coupled!}}}
+
+!***********************************************************************
+!
+! routine ocn_forcing_coupled_init
+!
+!> \brief Initializes coupled forcing module
+!> \author Doug Jacobsen
+!> \date 04/25/12
+!> \version SVN:$Id$
+!> \details
+!> This routine initializes the coupled forcing module.
+!
+!-----------------------------------------------------------------------
+
+ subroutine ocn_forcing_coupled_init(err)!{{{
+
+ integer, intent(out) :: err !< Output: error flag
+
+ err = 0
+
+ coupledForcingOn = .false.
+
+ if(config_use_coupled_forcing) then
+ coupledForcingOn = .true.
+ end if
+
+ end subroutine ocn_forcing_coupled_init!}}}
+
+!***********************************************************************
+
+end module ocn_forcing_coupled
+
+
+!|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
+! vim: foldmethod=marker
</font>
</pre>