mom_surface_forcing Module Reference

Data Types
type	surface_forcing_cs

Functions/Subroutines
subroutine, public	set_forcing (state, fluxes, day_start, day_interval, G, CS)
subroutine	buoyancy_forcing_allocate (fluxes, G, CS)
subroutine	wind_forcing_const (state, fluxes, tau_x0, tau_y0, day, G, CS)
subroutine	wind_forcing_2gyre (state, fluxes, day, G, CS)
subroutine	wind_forcing_1gyre (state, fluxes, day, G, CS)
subroutine	wind_forcing_gyres (state, fluxes, day, G, CS)
subroutine	wind_forcing_from_file (state, fluxes, day, G, CS)
subroutine	wind_forcing_by_data_override (state, fluxes, day, G, CS)
subroutine	buoyancy_forcing_from_files (state, fluxes, day, dt, G, CS)
subroutine	buoyancy_forcing_from_data_override (state, fluxes, day, dt, G, CS)
subroutine	buoyancy_forcing_zero (state, fluxes, day, dt, G, CS)
subroutine	buoyancy_forcing_const (state, fluxes, day, dt, G, CS)
subroutine	buoyancy_forcing_linear (state, fluxes, day, dt, G, CS)
subroutine, public	forcing_save_restart (CS, G, Time, directory, time_stamped, filename_suffix)
subroutine, public	surface_forcing_init (Time, G, param_file, diag, CS, tracer_flow_CSp)
subroutine	surface_forcing_end (CS, fluxes)

Variables
integer	id_clock_forcing

Function/Subroutine Documentation

buoyancy_forcing_allocate()

subroutine mom_surface_forcing::buoyancy_forcing_allocate ( type(forcing), intent(inout)  fluxes, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]

g

The ocean's grid structure

Definition at line 364 of file MOM_surface_forcing.F90.

References mom_forcing_type::allocate_forcing_type().

Referenced by set_forcing().

  type(forcing),         intent(inout) :: fluxes
  type(ocean_grid_type), intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

!  This subroutine allocates arrays for buoyancy forcing.

! Arguments:
!  (inout)   fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  integer :: isd, ied, jsd, jed
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed


  ! this array is zero for all options
  if (associated(fluxes%p_surf)) then
    fluxes%p_surf(:,:) = 0.0
  endif

  if ( cs%use_temperature ) then

    ! specify surface freshwater forcing by setting the following (kg/(m^2 * s))
    ! with convention that positive values for water entering ocean.
    ! specify surface heat fluxes by setting the following (Watts/m^2)
    ! with convention that positive values for heat fluxes into the ocean.
    call allocate_forcing_type(g, fluxes, water=.true., heat=.true.)

    ! surface restoring fields
    if (cs%restorebuoy) then
      call safe_alloc_ptr(cs%T_Restore,isd,ied,jsd,jed)
      call safe_alloc_ptr(fluxes%heat_added,isd,ied,jsd,jed)
      call safe_alloc_ptr(cs%S_Restore,isd,ied,jsd,jed)
    endif

  else ! CS%use_temperature false.

    call safe_alloc_ptr(fluxes%buoy,isd,ied,jsd,jed)
    if (cs%restorebuoy) call safe_alloc_ptr(cs%Dens_Restore,isd,ied,jsd,jed)

  endif  ! endif for  CS%use_temperature

Here is the call graph for this function:

Here is the caller graph for this function:

buoyancy_forcing_const()

subroutine mom_surface_forcing::buoyancy_forcing_const ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, real, intent(in)  dt, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]	dt	The amount of time over which the fluxes apply, in s
[in]	g	The ocean's grid structure

Definition at line 1350 of file MOM_surface_forcing.F90.

Referenced by set_forcing().

  type(surface),         intent(inout) :: state
  type(forcing),         intent(inout) :: fluxes
  type(time_type),       intent(in)    :: day
  real,                  intent(in)    :: dt   !< The amount of time over which
                                               !! the fluxes apply, in s
  type(ocean_grid_type), intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

!  This subroutine specifies the current surface fluxes of buoyancy
!  temperature and fresh water.  It may also be modified to add
!  surface fluxes of user provided tracers.
!  We here define a constant surface heat flux.

! Arguments:
!  (inout)   state   = structure describing ocean surface state
!  (inout)   fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      dt      = amount of time over which the fluxes apply
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  integer :: i, j, is, ie, js, je
  call calltree_enter("buoyancy_forcing_const, MOM_surface_forcing.F90")
  is  = g%isc ; ie  = g%iec ; js  = g%jsc ; je  = g%jec

  if (cs%use_temperature) then
    do j=js,je ; do i=is,ie
      fluxes%evap(i,j)                 = 0.0
      fluxes%lprec(i,j)                = 0.0
      fluxes%fprec(i,j)                = 0.0
      fluxes%vprec(i,j)                = 0.0
      fluxes%lrunoff(i,j)              = 0.0
      fluxes%frunoff(i,j)              = 0.0
      fluxes%lw(i,j)                   = 0.0
      fluxes%latent(i,j)               = 0.0
      fluxes%sens(i,j)                 = cs%constantHeatForcing * g%mask2dT(i,j)
      fluxes%sw(i,j)                   = 0.0
      fluxes%latent_evap_diag(i,j)     = 0.0
      fluxes%latent_fprec_diag(i,j)    = 0.0
      fluxes%latent_frunoff_diag(i,j)  = 0.0
    enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      fluxes%buoy(i,j) = 0.0
    enddo ; enddo
  endif

  call calltree_leave("buoyancy_forcing_const")

Here is the caller graph for this function:

buoyancy_forcing_from_data_override()

subroutine mom_surface_forcing::buoyancy_forcing_from_data_override ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, real, intent(in)  dt, type(ocean_grid_type), intent(inout)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]	dt	The amount of time over which the fluxes apply, in s
[in,out]	g	The ocean's grid structure

Definition at line 1120 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter().

Referenced by set_forcing().

  type(surface),         intent(inout) :: state
  type(forcing),         intent(inout) :: fluxes
  type(time_type),       intent(in)    :: day
  real,                  intent(in)    :: dt   !< The amount of time over which
                                               !! the fluxes apply, in s
  type(ocean_grid_type), intent(inout) :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

!  This subroutine specifies the current surface fluxes of buoyancy
!  temperature and fresh water.  It may also be modified to add
!  surface fluxes of user provided tracers.
!  This case has surface buoyancy forcing from data over-ride.

! Arguments:
!            state   = structure describing ocean surface state
!  (out)     fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      dt      = amount of time over which the fluxes apply
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  real, dimension(SZI_(G),SZJ_(G)) :: &
    temp, &       ! A 2-d temporary work array with various units.
    sst_anom, &   ! Instantaneous sea surface temperature anomalies from a
                  ! target (observed) value, in deg C.
    sss_anom, &   ! Instantaneous sea surface salinity anomalies from a target
                  ! (observed) value, in g kg-1.
    sss_mean      ! A (mean?) salinity about which to normalize local salinity
                  ! anomalies when calculating restorative precipitation
                  ! anomalies, in g kg-1.
  real :: rhoxcp ! The mean density times the heat capacity, in J m-3 K-1.
  real :: irho0  ! The inverse of the Boussinesq density, in m3 kg-1.

  integer :: time_lev_daily     ! The time levels to read for fields with
  integer :: time_lev_monthly   ! daily and montly cycles.
  integer :: itime_lev           ! The time level that is used for a field.

  integer :: days, seconds
  integer :: i, j, is, ie, js, je, isd, ied, jsd, jed
  integer :: is_in, ie_in, js_in, je_in

  call calltree_enter("buoyancy_forcing_from_data_override, MOM_surface_forcing.F90")

  is  = g%isc ; ie  = g%iec ; js  = g%jsc ; je  = g%jec
  isd = g%isd ; ied = g%ied ; jsd = g%jsd ; jed = g%jed

  if (cs%use_temperature) rhoxcp = cs%Rho0 * fluxes%C_p
  irho0 = 1.0/cs%Rho0

  if (.not.cs%dataOverrideIsInitialized) then
    call data_override_init(ocean_domain_in=g%Domain%mpp_domain)
    cs%dataOverrideIsInitialized = .true.
  endif

  is_in = g%isc - g%isd + 1
  ie_in = g%iec - g%isd + 1
  js_in = g%jsc - g%jsd + 1
  je_in = g%jec - g%jsd + 1

  call data_override('OCN', 'lw', fluxes%LW(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)
  call data_override('OCN', 'evap', fluxes%evap(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  ! note the sign convention
  do j=js,je ; do i=is,ie
     fluxes%evap(i,j) = -fluxes%evap(i,j)  ! Normal convention is positive into the ocean
                                           ! but evap is normally a positive quantity in the files
     fluxes%latent(i,j)           = cs%latent_heat_vapor*fluxes%evap(i,j)
     fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j)
  enddo; enddo

  call data_override('OCN', 'sens', fluxes%sens(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  ! note the sign convention
  do j=js,je ; do i=is,ie
     fluxes%sens(i,j) = -fluxes%sens(i,j)  ! Normal convention is positive into the ocean
                                           ! but sensible is normally a positive quantity in the files
  enddo; enddo

  call data_override('OCN', 'sw', fluxes%sw(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  call data_override('OCN', 'snow', fluxes%fprec(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  call data_override('OCN', 'rain', fluxes%lprec(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  call data_override('OCN', 'runoff', fluxes%lrunoff(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  call data_override('OCN', 'calving', fluxes%frunoff(:,:), day, &
       is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

!     Read the SST and SSS fields for damping.
  if (cs%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then
     call data_override('OCN', 'SST_restore', cs%T_restore(:,:), day, &
          is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

     call data_override('OCN', 'SSS_restore', cs%S_restore(:,:), day, &
          is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)

  endif

  ! restoring boundary fluxes
  if (cs%restorebuoy) then
    if (cs%use_temperature) then
      do j=js,je ; do i=is,ie
        if (g%mask2dT(i,j) > 0) then
          fluxes%heat_added(i,j) = g%mask2dT(i,j) * &
              ((cs%T_Restore(i,j) - state%SST(i,j)) * rhoxcp * cs%Flux_const)
          fluxes%vprec(i,j) = - (cs%Rho0*cs%Flux_const) * &
              (cs%S_Restore(i,j) - state%SSS(i,j)) / &
              (0.5*(state%SSS(i,j) + cs%S_Restore(i,j)))
        else
          fluxes%heat_added(i,j) = 0.0
          fluxes%vprec(i,j)        = 0.0
        endif
      enddo ; enddo
    else
      do j=js,je ; do i=is,ie
        if (g%mask2dT(i,j) > 0) then
          fluxes%buoy(i,j) = (cs%Dens_Restore(i,j) - state%sfc_density(i,j)) * &
                             (cs%G_Earth*cs%Flux_const/cs%Rho0)
        else
          fluxes%buoy(i,j) = 0.0
        endif
      enddo ; enddo
    endif
  else                                              ! not RESTOREBUOY
    if (.not.cs%use_temperature) then
      call mom_error(fatal, "buoyancy_forcing in MOM_surface_forcing: "// &
                     "The fluxes need to be defined without RESTOREBUOY.")
    endif
  endif                                             ! end RESTOREBUOY


  ! mask out land points and compute heat content of water fluxes
  ! assume liquid precip enters ocean at SST
  ! assume frozen precip enters ocean at 0degC
  ! assume liquid runoff enters ocean at SST
  ! assume solid runoff (calving) enters ocean at 0degC
  ! mass leaving ocean has heat_content determined in MOM_diabatic_driver.F90
  do j=js,je ; do i=is,ie
    fluxes%evap(i,j)    = fluxes%evap(i,j)    * g%mask2dT(i,j)
    fluxes%lprec(i,j)   = fluxes%lprec(i,j)   * g%mask2dT(i,j)
    fluxes%fprec(i,j)   = fluxes%fprec(i,j)   * g%mask2dT(i,j)
    fluxes%lrunoff(i,j) = fluxes%lrunoff(i,j) * g%mask2dT(i,j)
    fluxes%frunoff(i,j) = fluxes%frunoff(i,j) * g%mask2dT(i,j)
    fluxes%LW(i,j)      = fluxes%LW(i,j)      * g%mask2dT(i,j)
    fluxes%latent(i,j)  = fluxes%latent(i,j)  * g%mask2dT(i,j)
    fluxes%sens(i,j)    = fluxes%sens(i,j)    * g%mask2dT(i,j)
    fluxes%sw(i,j)      = fluxes%sw(i,j)      * g%mask2dT(i,j)

    fluxes%latent_evap_diag(i,j)     = fluxes%latent_evap_diag(i,j) * g%mask2dT(i,j)
    fluxes%latent_fprec_diag(i,j)    = -fluxes%fprec(i,j)*cs%latent_heat_fusion
    fluxes%latent_frunoff_diag(i,j)  = -fluxes%frunoff(i,j)*cs%latent_heat_fusion
  enddo ; enddo


!### if (associated(CS%ctrl_forcing_CSp)) then
!###   do j=js,je ; do i=is,ie
!###     SST_anom(i,j) = state%SST(i,j) - CS%T_Restore(i,j)
!###     SSS_anom(i,j) = state%SSS(i,j) - CS%S_Restore(i,j)
!###     SSS_mean(i,j) = 0.5*(state%SSS(i,j) + CS%S_Restore(i,j))
!###   enddo ; enddo
!###   call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, &
!###                           fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp)
!### endif

  call calltree_leave("buoyancy_forcing_from_data_override")

Here is the call graph for this function:

Here is the caller graph for this function:

buoyancy_forcing_from_files()

subroutine mom_surface_forcing::buoyancy_forcing_from_files ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, real, intent(in)  dt, type(ocean_grid_type), intent(inout)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]	dt	The amount of time over which the fluxes apply, in s
[in,out]	g	The ocean's grid structure

Definition at line 831 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter(), and mom_error_handler::calltree_leave().

Referenced by set_forcing().

  type(surface),         intent(inout) :: state
  type(forcing),         intent(inout) :: fluxes
  type(time_type),       intent(in)    :: day
  real,                  intent(in)    :: dt   !< The amount of time over which
                                               !! the fluxes apply, in s
  type(ocean_grid_type), intent(inout) :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

!  This subroutine specifies the current surface fluxes of buoyancy
!  temperature and fresh water.  It may also be modified to add
!  surface fluxes of user provided tracers.
!  This case has surface buoyancy forcing from input files.

! Arguments:
!            state   = structure describing ocean surface state
!  (out)     fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      dt      = amount of time over which the fluxes apply
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  real, dimension(SZI_(G),SZJ_(G)) :: &
    temp, &       ! A 2-d temporary work array with various units.
    sst_anom, &   ! Instantaneous sea surface temperature anomalies from a
                  ! target (observed) value, in deg C.
    sss_anom, &   ! Instantaneous sea surface salinity anomalies from a target
                  ! (observed) value, in g kg-1.
    sss_mean      ! A (mean?) salinity about which to normalize local salinity
                  ! anomalies when calculating restorative precipitation
                  ! anomalies, in g kg-1.

  real :: rhoxcp ! reference density times heat capacity (J/(m^3 * K))
  real :: irho0  ! inverse of the Boussinesq reference density (m^3/kg)

  integer :: time_lev_daily     ! time levels to read for fields with daily cycle
  integer :: time_lev_monthly   ! time levels to read for fields with monthly cycle
  integer :: time_lev           ! time level that for a field

  integer :: days, seconds
  integer :: i, j, is, ie, js, je

  call calltree_enter("buoyancy_forcing_from_files, MOM_surface_forcing.F90")

  is  = g%isc ; ie  = g%iec ; js  = g%jsc ; je = g%jec

  if (cs%use_temperature) rhoxcp = cs%Rho0 * fluxes%C_p
  irho0 = 1.0/cs%Rho0

  ! Read the buoyancy forcing file
  call get_time(day,seconds,days)

  time_lev_daily = days - 365*floor(real(days) / 365.0)

  if (time_lev_daily < 31) then ; time_lev_monthly = 0
  else if (time_lev_daily < 59)  then ; time_lev_monthly = 1
  else if (time_lev_daily < 90)  then ; time_lev_monthly = 2
  else if (time_lev_daily < 120) then ; time_lev_monthly = 3
  else if (time_lev_daily < 151) then ; time_lev_monthly = 4
  else if (time_lev_daily < 181) then ; time_lev_monthly = 5
  else if (time_lev_daily < 212) then ; time_lev_monthly = 6
  else if (time_lev_daily < 243) then ; time_lev_monthly = 7
  else if (time_lev_daily < 273) then ; time_lev_monthly = 8
  else if (time_lev_daily < 304) then ; time_lev_monthly = 9
  else if (time_lev_daily < 334) then ; time_lev_monthly = 10
  else ; time_lev_monthly = 11
  endif

  time_lev_daily   = time_lev_daily  +1
  time_lev_monthly = time_lev_monthly+1

  if (time_lev_daily /= cs%buoy_last_lev_read) then

    ! longwave
    select case (cs%LW_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    call read_data(cs%longwave_file, cs%LW_var, fluxes%LW(:,:), &
                   domain=g%Domain%mpp_domain, timelevel=time_lev)
    if (cs%archaic_OMIP_file) then
      call read_data(cs%longwaveup_file, &
       "lwup_sfc",temp(:,:), domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie ; fluxes%LW(i,j) = fluxes%LW(i,j) - temp(i,j) ; enddo ; enddo
    endif
    cs%LW_last_lev = time_lev

    ! evaporation
    select case (cs%evap_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    if (cs%archaic_OMIP_file) then
      call read_data(cs%evaporation_file, cs%evap_var, temp(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie
        fluxes%latent(i,j)           = -cs%latent_heat_vapor*temp(i,j)
        fluxes%evap(i,j)             = -temp(i,j)
        fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j)
      enddo ; enddo
    else
      call read_data(cs%evaporation_file, cs%evap_var, fluxes%evap(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
    endif
    cs%evap_last_lev = time_lev

    select case (cs%latent_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    if (.not.cs%archaic_OMIP_file) then
      call read_data(cs%latentheat_file, cs%latent_var, fluxes%latent(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie
        fluxes%latent_evap_diag(i,j) = fluxes%latent(i,j)
      enddo ; enddo
    endif
    cs%latent_last_lev = time_lev

    select case (cs%sens_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    if (cs%archaic_OMIP_file) then
      call read_data(cs%sensibleheat_file, cs%sens_var, temp(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie ; fluxes%sens(i,j) = -temp(i,j) ; enddo ; enddo
    else
      call read_data(cs%sensibleheat_file, cs%sens_var, fluxes%sens(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
    endif
    cs%sens_last_lev = time_lev

    select case (cs%SW_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    call read_data(cs%shortwave_file, cs%SW_var, fluxes%sw(:,:), &
             domain=g%Domain%mpp_domain, timelevel=time_lev)
    if (cs%archaic_OMIP_file) then
      call read_data(cs%shortwaveup_file, "swup_sfc", temp(:,:), &
               domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie
        fluxes%sw(i,j) = fluxes%sw(i,j) - temp(i,j)
      enddo ; enddo
    endif
    cs%SW_last_lev = time_lev

    select case (cs%precip_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    call read_data(cs%snow_file, cs%snow_var, &
             fluxes%fprec(:,:), domain=g%Domain%mpp_domain, timelevel=time_lev)
    call read_data(cs%rain_file, cs%rain_var, &
             fluxes%lprec(:,:), domain=g%Domain%mpp_domain, timelevel=time_lev)
    if (cs%archaic_OMIP_file) then
      do j=js,je ; do i=is,ie
        fluxes%lprec(i,j) = fluxes%lprec(i,j) - fluxes%fprec(i,j)
      enddo ; enddo
    endif
    cs%precip_last_lev = time_lev

    select case (cs%runoff_nlev)
      case (12)    ; time_lev = time_lev_monthly
      case (365)   ; time_lev = time_lev_daily
      case default ; time_lev = 1
    end select
    if (cs%archaic_OMIP_file) then
      call read_data(cs%runoff_file, cs%lrunoff_var, temp(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie
        fluxes%lrunoff(i,j) = temp(i,j)*g%IareaT(i,j)
      enddo ; enddo
      call read_data(cs%runoff_file, cs%frunoff_var, temp(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
      do j=js,je ; do i=is,ie
        fluxes%frunoff(i,j) = temp(i,j)*g%IareaT(i,j)
      enddo ; enddo
    else
      call read_data(cs%runoff_file, cs%lrunoff_var, fluxes%lrunoff(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
      call read_data(cs%runoff_file, cs%frunoff_var, fluxes%frunoff(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
    endif
    cs%runoff_last_lev = time_lev

!     Read the SST and SSS fields for damping.
    if (cs%restorebuoy) then !### .or. associated(CS%ctrl_forcing_CSp)) then
      select case (cs%SST_nlev)
        case (12)    ; time_lev = time_lev_monthly
        case (365)   ; time_lev = time_lev_daily
        case default ; time_lev = 1
      end select
      call read_data(cs%SSTrestore_file, cs%SST_restore_var, &
               cs%T_Restore(:,:), domain=g%Domain%mpp_domain, timelevel=time_lev)
      cs%SST_last_lev = time_lev

      select case (cs%SSS_nlev)
        case (12)    ; time_lev = time_lev_monthly
        case (365)   ; time_lev = time_lev_daily
        case default ; time_lev = 1
      end select
      call read_data(cs%salinityrestore_file, cs%SSS_restore_var, &
               cs%S_Restore(:,:), domain=g%Domain%mpp_domain, timelevel=time_lev)
      cs%SSS_last_lev = time_lev
    endif
    cs%buoy_last_lev_read = time_lev_daily

    ! mask out land points and compute heat content of water fluxes
    ! assume liquid precip enters ocean at SST
    ! assume frozen precip enters ocean at 0degC
    ! assume liquid runoff enters ocean at SST
    ! assume solid runoff (calving) enters ocean at 0degC
    ! mass leaving the ocean has heat_content determined in MOM_diabatic_driver.F90
    do j=js,je ; do i=is,ie
      fluxes%evap(i,j)    = fluxes%evap(i,j)    * g%mask2dT(i,j)
      fluxes%lprec(i,j)   = fluxes%lprec(i,j)   * g%mask2dT(i,j)
      fluxes%fprec(i,j)   = fluxes%fprec(i,j)   * g%mask2dT(i,j)
      fluxes%lrunoff(i,j) = fluxes%lrunoff(i,j) * g%mask2dT(i,j)
      fluxes%frunoff(i,j) = fluxes%frunoff(i,j) * g%mask2dT(i,j)
      fluxes%LW(i,j)      = fluxes%LW(i,j)      * g%mask2dT(i,j)
      fluxes%sens(i,j)    = fluxes%sens(i,j)    * g%mask2dT(i,j)
      fluxes%sw(i,j)      = fluxes%sw(i,j)      * g%mask2dT(i,j)
      fluxes%latent(i,j)  = fluxes%latent(i,j)  * g%mask2dT(i,j)

      fluxes%latent_evap_diag(i,j)     = fluxes%latent_evap_diag(i,j) * g%mask2dT(i,j)
      fluxes%latent_fprec_diag(i,j)    = -fluxes%fprec(i,j)*cs%latent_heat_fusion
      fluxes%latent_frunoff_diag(i,j)  = -fluxes%frunoff(i,j)*cs%latent_heat_fusion
    enddo ; enddo

  endif ! time_lev /= CS%buoy_last_lev_read


  ! restoring surface boundary fluxes
  if (cs%restorebuoy) then

    if (cs%use_temperature) then
      do j=js,je ; do i=is,ie
        if (g%mask2dT(i,j) > 0) then
          fluxes%heat_added(i,j) = g%mask2dT(i,j) * &
              ((cs%T_Restore(i,j) - state%SST(i,j)) * rhoxcp * cs%Flux_const)
          fluxes%vprec(i,j) = - (cs%Rho0*cs%Flux_const) * &
              (cs%S_Restore(i,j) - state%SSS(i,j)) / &
              (0.5*(state%SSS(i,j) + cs%S_Restore(i,j)))
        else
          fluxes%heat_added(i,j) = 0.0
          fluxes%vprec(i,j)        = 0.0
        endif
      enddo ; enddo
    else
      do j=js,je ; do i=is,ie
        if (g%mask2dT(i,j) > 0) then
          fluxes%buoy(i,j) = (cs%Dens_Restore(i,j) - state%sfc_density(i,j)) * &
                             (cs%G_Earth*cs%Flux_const/cs%Rho0)
        else
          fluxes%buoy(i,j) = 0.0
        endif
      enddo ; enddo
    endif

  else                                              ! not RESTOREBUOY
    if (.not.cs%use_temperature) then
      call mom_error(fatal, "buoyancy_forcing in MOM_surface_forcing: "// &
                     "The fluxes need to be defined without RESTOREBUOY.")
    endif

  endif                                             ! end RESTOREBUOY

!### if (associated(CS%ctrl_forcing_CSp)) then
!###   do j=js,je ; do i=is,ie
!###     SST_anom(i,j) = state%SST(i,j) - CS%T_Restore(i,j)
!###     SSS_anom(i,j) = state%SSS(i,j) - CS%S_Restore(i,j)
!###     SSS_mean(i,j) = 0.5*(state%SSS(i,j) + CS%S_Restore(i,j))
!###   enddo ; enddo
!###   call apply_ctrl_forcing(SST_anom, SSS_anom, SSS_mean, fluxes%heat_added, &
!###                           fluxes%vprec, day, dt, G, CS%ctrl_forcing_CSp)
!### endif

  call calltree_leave("buoyancy_forcing_from_files")

Here is the call graph for this function:

Here is the caller graph for this function:

buoyancy_forcing_linear()

subroutine mom_surface_forcing::buoyancy_forcing_linear ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, real, intent(in)  dt, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]	dt	The amount of time over which the fluxes apply, in s
[in]	g	The ocean's grid structure

Definition at line 1402 of file MOM_surface_forcing.F90.

Referenced by set_forcing().

  type(surface),         intent(inout) :: state
  type(forcing),         intent(inout) :: fluxes
  type(time_type),       intent(in)    :: day
  real,                  intent(in)    :: dt   !< The amount of time over which
                                               !! the fluxes apply, in s
  type(ocean_grid_type), intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

!    This subroutine specifies the current surface fluxes of buoyancy
!  temperature and fresh water.  It may also be modified to add
!  surface fluxes of user provided tracers.

! Arguments:
!  (inout)   state   = structure describing ocean surface state
!  (inout)   fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      dt      = amount of time over which the fluxes apply
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  real :: y, t_restore, s_restore
  integer :: i, j, is, ie, js, je

  call calltree_enter("buoyancy_forcing_linear, MOM_surface_forcing.F90")
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec

  ! This case has no surface buoyancy forcing.
  if (cs%use_temperature) then
    do j=js,je ; do i=is,ie
      fluxes%evap(i,j)                 = 0.0
      fluxes%lprec(i,j)                = 0.0
      fluxes%fprec(i,j)                = 0.0
      fluxes%vprec(i,j)                = 0.0
      fluxes%lrunoff(i,j)              = 0.0
      fluxes%frunoff(i,j)              = 0.0
      fluxes%lw(i,j)                   = 0.0
      fluxes%latent(i,j)               = 0.0
      fluxes%sens(i,j)                 = 0.0
      fluxes%sw(i,j)                   = 0.0
      fluxes%latent_evap_diag(i,j)     = 0.0
      fluxes%latent_fprec_diag(i,j)    = 0.0
      fluxes%latent_frunoff_diag(i,j)  = 0.0
    enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      fluxes%buoy(i,j) = 0.0
    enddo ; enddo
  endif

  if (cs%restorebuoy) then
    if (cs%use_temperature) then
      do j=js,je ; do i=is,ie
        y = (g%geoLatCu(i,j)-cs%South_lat)/cs%len_lat
        t_restore = cs%T_south + (cs%T_north-cs%T_south)*y
        s_restore = cs%S_south + (cs%S_north-cs%S_south)*y
        if (g%mask2dT(i,j) > 0) then
          fluxes%heat_added(i,j) = g%mask2dT(i,j) * &
              ((t_restore - state%SST(i,j)) * ((cs%Rho0 * fluxes%C_p) * cs%Flux_const))
          fluxes%vprec(i,j) = - (cs%Rho0*cs%Flux_const) * &
              (s_restore - state%SSS(i,j)) / &
              (0.5*(state%SSS(i,j) + s_restore))
        else
          fluxes%heat_added(i,j) = 0.0
          fluxes%vprec(i,j)        = 0.0
        endif
      enddo ; enddo
    else
      call mom_error(fatal, "buoyancy_forcing_linear in MOM_surface_forcing: "// &
                     "RESTOREBUOY to linear not written yet.")
     !do j=js,je ; do i=is,ie
     !  if (G%mask2dT(i,j) > 0) then
     !    fluxes%buoy(i,j) = (CS%Dens_Restore(i,j) - state%sfc_density(i,j)) * &
     !                       (CS%G_Earth*CS%Flux_const/CS%Rho0)
     !  else
     !    fluxes%buoy(i,j) = 0.0
     !  endif
     !enddo ; enddo
    endif
  else                                              ! not RESTOREBUOY
    if (.not.cs%use_temperature) then
      call mom_error(fatal, "buoyancy_forcing_linear in MOM_surface_forcing: "// &
                     "The fluxes need to be defined without RESTOREBUOY.")
    endif
  endif                                             ! end RESTOREBUOY

  call calltree_leave("buoyancy_forcing_linear")

Here is the caller graph for this function:

buoyancy_forcing_zero()

subroutine mom_surface_forcing::buoyancy_forcing_zero ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, real, intent(in)  dt, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]	dt	The amount of time over which the fluxes apply, in s
[in]	g	The ocean's grid structure

Definition at line 1297 of file MOM_surface_forcing.F90.

Referenced by set_forcing().

  type(surface),         intent(inout) :: state
  type(forcing),         intent(inout) :: fluxes
  type(time_type),       intent(in)    :: day
  real,                  intent(in)    :: dt   !< The amount of time over which
                                               !! the fluxes apply, in s
  type(ocean_grid_type), intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

!  This subroutine specifies the current surface fluxes of buoyancy
!  temperature and fresh water.  It may also be modified to add
!  surface fluxes of user provided tracers.
!  This case has zero surface buoyancy forcing.

! Arguments:
!  (inout)   state   = structure describing ocean surface state
!  (inout)   fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      dt      = amount of time over which the fluxes apply
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  integer :: i, j, is, ie, js, je

  call calltree_enter("buoyancy_forcing_zero, MOM_surface_forcing.F90")
  is = g%isc ; ie = g%iec ; js = g%jsc ; je = g%jec

  if (cs%use_temperature) then
    do j=js,je ; do i=is,ie
      fluxes%evap(i,j)                 = 0.0
      fluxes%lprec(i,j)                = 0.0
      fluxes%fprec(i,j)                = 0.0
      fluxes%vprec(i,j)                = 0.0
      fluxes%lrunoff(i,j)              = 0.0
      fluxes%frunoff(i,j)              = 0.0
      fluxes%lw(i,j)                   = 0.0
      fluxes%latent(i,j)               = 0.0
      fluxes%sens(i,j)                 = 0.0
      fluxes%sw(i,j)                   = 0.0
      fluxes%latent_evap_diag(i,j)     = 0.0
      fluxes%latent_fprec_diag(i,j)    = 0.0
      fluxes%latent_frunoff_diag(i,j)  = 0.0
    enddo ; enddo
  else
    do j=js,je ; do i=is,ie
      fluxes%buoy(i,j) = 0.0
    enddo ; enddo
  endif

  call calltree_leave("buoyancy_forcing_zero")

Here is the caller graph for this function:

forcing_save_restart()

subroutine, public mom_surface_forcing::forcing_save_restart	(	type(surface_forcing_cs), pointer	CS,
		type(ocean_grid_type), intent(inout)	G,
		type(time_type), intent(in)	Time,
		character(len=*), intent(in)	directory,
		logical, intent(in), optional	time_stamped,
		character(len=*), intent(in), optional	filename_suffix
	)

Parameters

[in,out]

g

The ocean's grid structure

Definition at line 1493 of file MOM_surface_forcing.F90.

Referenced by mom_main(), ocean_model_mod::ocean_model_restart(), and ocean_model_mod::ocean_model_save_restart().

  type(surface_forcing_cs),   pointer       :: cs
  type(ocean_grid_type),      intent(inout) :: g    !< The ocean's grid structure
  type(time_type),            intent(in)    :: time
  character(len=*),           intent(in)    :: directory
  logical,          optional, intent(in)    :: time_stamped
  character(len=*), optional, intent(in)    :: filename_suffix

! Arguments:
!            CS              = pointer to control structure from previous surface_forcing_init call
!  (in)      G               = ocean grid structure
!  (in)      Time            = model time at this call; needed for mpp_write calls
!  (in, opt) directory       = optional directory into which to write these restart files
!  (in, opt) time_stamped    = if true, the restart file names include a unique time stamp
!                              default is false.
!  (in, opt) filename_suffix = optional suffix (e.g., a time-stamp) to append to the restart fname

  if (.not.associated(cs)) return
  if (.not.associated(cs%restart_CSp)) return

  call save_restart(directory, time, g, cs%restart_CSp, time_stamped)

Here is the caller graph for this function:

set_forcing()

subroutine, public mom_surface_forcing::set_forcing	(	type(surface), intent(inout)	state,
		type(forcing), intent(inout)	fluxes,
		type(time_type), intent(in)	day_start,
		type(time_type), intent(in)	day_interval,
		type(ocean_grid_type), intent(inout)	G,
		type(surface_forcing_cs), pointer	CS
	)

Parameters

[in,out]

g

The ocean's grid structure

Definition at line 228 of file MOM_surface_forcing.F90.

References mom_forcing_type::allocate_forcing_type(), buoyancy_forcing_allocate(), buoyancy_forcing_const(), buoyancy_forcing_from_data_override(), buoyancy_forcing_from_files(), buoyancy_forcing_linear(), buoyancy_forcing_zero(), mom_error_handler::calltree_enter(), mom_error_handler::calltree_leave(), id_clock_forcing, wind_forcing_1gyre(), wind_forcing_2gyre(), wind_forcing_by_data_override(), wind_forcing_const(), wind_forcing_from_file(), and wind_forcing_gyres().

Referenced by mom_main().

  type(surface),         intent(inout) :: state
  type(forcing),         intent(inout) :: fluxes
  type(time_type),       intent(in)    :: day_start
  type(time_type),       intent(in)    :: day_interval
  type(ocean_grid_type), intent(inout) :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer    :: cs

! This subroutine calls other subroutines in this file to get surface forcing fields.
! It also allocates and initializes the fields in the flux type.

! Arguments:
!  (inout)   state        = structure describing ocean surface state
!  (inout)   fluxes       = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day_start    = Start time of the fluxes
!  (in)      day_interval = Length of time over which these fluxes applied
!  (in)      G            = ocean grid structure
!  (in)      CS           = pointer to control struct returned by previous surface_forcing_init call

  real :: dt                     ! length of time in seconds over which fluxes applied
  type(time_type) :: day_center  ! central time of the fluxes.
  integer :: intdt

  call cpu_clock_begin(id_clock_forcing)
  call calltree_enter("set_forcing, MOM_surface_forcing.F90")

  day_center = day_start + day_interval/2
  call get_time(day_interval, intdt)
  dt = real(intdt)

  ! calls to various wind options
  if (cs%variable_winds .or. cs%first_call_set_forcing) then
    if (cs%first_call_set_forcing) call allocate_forcing_type(g, fluxes, stress=.true., ustar=.true.)
    if (trim(cs%wind_config) == "file") then
      call wind_forcing_from_file(state, fluxes, day_center, g, cs)
    elseif (trim(cs%wind_config) == "data_override") then
      call wind_forcing_by_data_override(state, fluxes, day_center, g, cs)
    elseif (trim(cs%wind_config) == "2gyre") then
      call wind_forcing_2gyre(state, fluxes, day_center, g, cs)
    elseif (trim(cs%wind_config) == "1gyre") then
      call wind_forcing_1gyre(state, fluxes, day_center, g, cs)
    elseif (trim(cs%wind_config) == "gyres") then
      call wind_forcing_gyres(state, fluxes, day_center, g, cs)
    elseif (trim(cs%wind_config) == "zero") then
      call wind_forcing_const(state, fluxes, 0., 0., day_center, g, cs)
    elseif (trim(cs%wind_config) == "const") then
      call wind_forcing_const(state, fluxes, cs%tau_x0, cs%tau_y0, day_center, g, cs)
    elseif (trim(cs%wind_config) == "MESO") then
      call meso_wind_forcing(state, fluxes, day_center, g, cs%MESO_forcing_CSp)
    elseif (trim(cs%wind_config) == "SCM_ideal_hurr") then
      call scm_idealized_hurricane_wind_forcing(state, fluxes, day_center, g, cs%SCM_idealized_hurricane_CSp)
    elseif (trim(cs%wind_config) == "SCM_CVmix_tests") then
      call scm_cvmix_tests_wind_forcing(state, fluxes, day_center, g, cs%SCM_CVmix_tests_CSp)
    elseif (trim(cs%wind_config) == "USER") then
      call user_wind_forcing(state, fluxes, day_center, g, cs%user_forcing_CSp)
    elseif (cs%variable_winds .and. .not.cs%first_call_set_forcing) then
      call mom_error(fatal, &
       "MOM_surface_forcing: Variable winds defined with no wind config")
    else
       call mom_error(fatal, &
       "MOM_surface_forcing:Unrecognized wind config "//trim(cs%wind_config))
    endif
  endif

! ! calls to various buoyancy forcing options
! if ((CS%variable_buoyforce .or. CS%first_call_set_forcing) .and. &
!     (.not.CS%adiabatic)) then
!   if (trim(CS%buoy_config) == "file") then
!     if (CS%first_call_set_forcing) call buoyancy_forcing_allocate(fluxes, G, CS)
!   elseif (trim(CS%wind_config) == "MESO") then
!     call MESO_wind_forcing(state, fluxes, day_center, G, CS%MESO_forcing_CSp)
!   elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then
!     call SCM_idealized_hurricane_wind_forcing(state, fluxes, day_center, G, CS%SCM_idealized_hurricane_CSp)
!   elseif (trim(CS%wind_config) == "USER") then
!     call USER_wind_forcing(state, fluxes, day_center, G, CS%user_forcing_CSp)
!   elseif (CS%variable_winds .and. .not.CS%first_call_set_forcing) then
!     call MOM_error(FATAL, &
!      "MOM_surface_forcing: Variable winds defined with no wind config")
!   else
!      call MOM_error(FATAL, &
!      "MOM_surface_forcing:Unrecognized wind config "//trim(CS%wind_config))
!   endif
! endif

  ! calls to various buoyancy forcing options
  if ((cs%variable_buoyforce .or. cs%first_call_set_forcing) .and. &
      (.not.cs%adiabatic)) then
    if (trim(cs%buoy_config) == "file") then
      if (cs%first_call_set_forcing) call buoyancy_forcing_allocate(fluxes, g, cs)
      call buoyancy_forcing_from_files(state, fluxes, day_center, dt, g, cs)
    elseif (trim(cs%buoy_config) == "data_override") then
      if (cs%first_call_set_forcing) call buoyancy_forcing_allocate(fluxes, g, cs)
      call buoyancy_forcing_from_data_override(state, fluxes, day_center, dt, g, cs)
    elseif (trim(cs%buoy_config) == "zero") then
      if (cs%first_call_set_forcing) call buoyancy_forcing_allocate(fluxes, g, cs)
      call buoyancy_forcing_zero(state, fluxes, day_center, dt, g, cs)
    elseif (trim(cs%buoy_config) == "const") then
      if (cs%first_call_set_forcing) call buoyancy_forcing_allocate(fluxes, g, cs)
      call buoyancy_forcing_const(state, fluxes, day_center, dt, g, cs)
    elseif (trim(cs%buoy_config) == "linear") then
      if (cs%first_call_set_forcing) call buoyancy_forcing_allocate(fluxes, g, cs)
      call buoyancy_forcing_linear(state, fluxes, day_center, dt, g, cs)
    elseif (trim(cs%buoy_config) == "MESO") then
      call meso_buoyancy_forcing(state, fluxes, day_center, dt, g, cs%MESO_forcing_CSp)
    elseif (trim(cs%buoy_config) == "SCM_CVmix_tests") then
      call scm_cvmix_tests_buoyancy_forcing(state, fluxes, day_center, g, cs%SCM_CVmix_tests_CSp)
    elseif (trim(cs%buoy_config) == "USER") then
      call user_buoyancy_forcing(state, fluxes, day_center, dt, g, cs%user_forcing_CSp)
    elseif (trim(cs%buoy_config) == "BFB") then
      call bfb_buoyancy_forcing(state, fluxes, day_center, dt, g, cs%BFB_forcing_CSp)
    elseif (trim(cs%buoy_config) == "NONE") then
      call mom_mesg("MOM_surface_forcing: buoyancy forcing has been set to omitted.")
    elseif (cs%variable_buoyforce .and. .not.cs%first_call_set_forcing) then
      call mom_error(fatal, &
       "MOM_surface_forcing: Variable buoy defined with no buoy config.")
    else
       call mom_error(fatal, &
       "MOM_surface_forcing: Unrecognized buoy config "//trim(cs%buoy_config))
    endif
  endif

  if (associated(cs%tracer_flow_CSp)) then
    if (.not.associated(fluxes%tr_fluxes)) allocate(fluxes%tr_fluxes)
    call call_tracer_set_forcing(state, fluxes, day_start, day_interval, g, cs%tracer_flow_CSp)
  endif

  ! Allow for user-written code to alter the fluxes after all the above
  call user_alter_forcing(state, fluxes, day_center, g, cs%urf_CS)

  cs%first_call_set_forcing = .false.

  call cpu_clock_end(id_clock_forcing)
  call calltree_leave("set_forcing")

Here is the call graph for this function:

Here is the caller graph for this function:

surface_forcing_end()

subroutine mom_surface_forcing::surface_forcing_end ( type(surface_forcing_cs), pointer  CS, type(forcing), intent(inout), optional  fluxes  )

private

Definition at line 1905 of file MOM_surface_forcing.F90.

  type(surface_forcing_cs), pointer       :: cs
  type(forcing), optional,  intent(inout) :: fluxes
! Arguments:  CS - A pointer to the control structure returned by a previous
!                  call to surface_forcing_init, it will be deallocated here.
!  (inout)    fluxes - A structure containing pointers to any possible
!                     forcing fields.  Unused fields have NULL ptrs.

  if (present(fluxes)) call deallocate_forcing_type(fluxes)

!###  call controlled_forcing_end(CS%ctrl_forcing_CSp)

  if (associated(cs)) deallocate(cs)
  cs => null()

surface_forcing_init()

subroutine, public mom_surface_forcing::surface_forcing_init	(	type(time_type), intent(in)	Time,
		type(ocean_grid_type), intent(in)	G,
		type(param_file_type), intent(in)	param_file,
		type(diag_ctrl), intent(inout), target	diag,
		type(surface_forcing_cs), pointer	CS,
		type(tracer_flow_control_cs), pointer	tracer_flow_CSp
	)

Parameters

[in]	g	The ocean's grid structure
[in]	param_file	A structure to parse for run-time parameters

Definition at line 1518 of file MOM_surface_forcing.F90.

References id_clock_forcing.

Referenced by mom_main().

  type(time_type),              intent(in)    :: time
  type(ocean_grid_type),        intent(in)    :: g    !< The ocean's grid structure
  type(param_file_type),        intent(in)    :: param_file !< A structure to parse for run-time parameters
  type(diag_ctrl), target,      intent(inout) :: diag
  type(surface_forcing_cs),     pointer       :: cs
  type(tracer_flow_control_cs), pointer       :: tracer_flow_csp

! Arguments:
!            Time            = current model time
!  (in)      G               = ocean grid structure
!  (in)      param_file      = structure indicating the open file to parse for model parameter values
!  (in)      diag            = structure used to regulate diagnostic output
!  (in/out)  CS              = pointer set to point to the control structure for this module
!  (in)      tracer_flow_CSp = pointer to the control structure of the tracer flow control module

  type(directories)  :: dirs
  logical            :: new_sim
  type(time_type)    :: time_frc
! This include declares and sets the variable "version".
#include "version_variable.h"
  character(len=40)  :: mdl = "MOM_surface_forcing" ! This module's name.
  character(len=200) :: filename, gust_file ! The name of the gustiness input file.

  if (associated(cs)) then
    call mom_error(warning, "surface_forcing_init called with an associated "// &
                            "control structure.")
    return
  endif
  allocate(cs)

  id_clock_forcing=cpu_clock_id('(Ocean surface forcing)', grain=clock_module)
  call cpu_clock_begin(id_clock_forcing)

  cs%diag => diag
  if (associated(tracer_flow_csp)) cs%tracer_flow_CSp => tracer_flow_csp

  ! Read all relevant parameters and write them to the model log.
  call log_version(param_file, mdl, version, '')
  call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", cs%use_temperature, &
                 "If true, Temperature and salinity are used as state \n"//&
                 "variables.", default=.true.)
  call get_param(param_file, mdl, "INPUTDIR", cs%inputdir, &
                 "The directory in which all input files are found.", &
                 default=".")
  cs%inputdir = slasher(cs%inputdir)

  call get_param(param_file, mdl, "ADIABATIC", cs%adiabatic, &
                 "There are no diapycnal mass fluxes if ADIABATIC is \n"//&
                 "true. This assumes that KD = KDML = 0.0 and that \n"//&
                 "there is no buoyancy forcing, but makes the model \n"//&
                 "faster by eliminating subroutine calls.", default=.false.)
  call get_param(param_file, mdl, "VARIABLE_WINDS", cs%variable_winds, &
                 "If true, the winds vary in time after the initialization.", &
                 default=.true.)
  call get_param(param_file, mdl, "VARIABLE_BUOYFORCE", cs%variable_buoyforce, &
                 "If true, the buoyancy forcing varies in time after the \n"//&
                 "initialization of the model.", default=.true.)

  call get_param(param_file, mdl, "BUOY_CONFIG", cs%buoy_config, &
                 "The character string that indicates how buoyancy forcing \n"//&
                 "is specified. Valid options include (file), (zero), \n"//&
                 "(linear), (USER), (BFB) and (NONE).", fail_if_missing=.true.)
  if (trim(cs%buoy_config) == "file") then
    call get_param(param_file, mdl, "ARCHAIC_OMIP_FORCING_FILE", cs%archaic_OMIP_file, &
                 "If true, use the forcing variable decomposition from \n"//&
                 "the old German OMIP prescription that predated CORE. If \n"//&
                 "false, use the variable groupings available from MOM \n"//&
                 "output diagnostics of forcing variables.", default=.true.)
    if (cs%archaic_OMIP_file) then
      call get_param(param_file, mdl, "LONGWAVEDOWN_FILE", cs%longwave_file, &
                 "The file with the downward longwave heat flux, in \n"//&
                 "variable lwdn_sfc.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "LONGWAVEUP_FILE", cs%longwaveup_file, &
                 "The file with the upward longwave heat flux, in \n"//&
                 "variable lwup_sfc.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "EVAPORATION_FILE", cs%evaporation_file, &
                 "The file with the evaporative moisture flux, in \n"//&
                 "variable evap.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", cs%sensibleheat_file, &
                 "The file with the sensible heat flux, in \n"//&
                 "variable shflx.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "SHORTWAVEUP_FILE", cs%shortwaveup_file, &
                 "The file with the upward shortwave heat flux.", &
                 fail_if_missing=.true.)
      call get_param(param_file, mdl, "SHORTWAVEDOWN_FILE", cs%shortwave_file, &
                 "The file with the downward shortwave heat flux.", &
                 fail_if_missing=.true.)
      call get_param(param_file, mdl, "SNOW_FILE", cs%snow_file, &
                 "The file with the downward frozen precip flux, in \n"//&
                 "variable snow.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "PRECIP_FILE", cs%rain_file, &
                 "The file with the downward total precip flux, in \n"//&
                 "variable precip.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "FRESHDISCHARGE_FILE", cs%runoff_file, &
                 "The file with the fresh and frozen runoff/calving fluxes, \n"//&
                 "invariables disch_w and disch_s.", fail_if_missing=.true.)

      ! These variable names are hard-coded, per the archaic OMIP conventions.
      cs%latentheat_file = cs%evaporation_file ; cs%latent_var = "evap"
      cs%LW_var = "lwdn_sfc"; cs%SW_var = "swdn_sfc"; cs%sens_var = "shflx"
      cs%evap_var = "evap"; cs%rain_var = "precip"; cs%snow_var = "snow"
      cs%lrunoff_var = "disch_w"; cs%frunoff_var = "disch_s"

    else
      call get_param(param_file, mdl, "LONGWAVE_FILE", cs%longwave_file, &
                 "The file with the longwave heat flux, in the variable \n"//&
                 "given by LONGWAVE_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "LONGWAVE_FORCING_VAR", cs%LW_var, &
                 "The variable with the longwave forcing field.", default="LW")

      call get_param(param_file, mdl, "SHORTWAVE_FILE", cs%shortwave_file, &
                 "The file with the shortwave heat flux, in the variable \n"//&
                 "given by SHORTWAVE_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "SHORTWAVE_FORCING_VAR", cs%SW_var, &
                 "The variable with the shortwave forcing field.", default="SW")

      call get_param(param_file, mdl, "EVAPORATION_FILE", cs%evaporation_file, &
                 "The file with the evaporative moisture flux, in the \n"//&
                 "variable given by EVAP_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "EVAP_FORCING_VAR", cs%evap_var, &
                 "The variable with the evaporative moisture flux.", &
                 default="evap")

      call get_param(param_file, mdl, "LATENTHEAT_FILE", cs%latentheat_file, &
                 "The file with the latent heat flux, in the variable \n"//&
                 "given by LATENT_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "LATENT_FORCING_VAR", cs%latent_var, &
                 "The variable with the latent heat flux.", default="latent")

      call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", cs%sensibleheat_file, &
                 "The file with the sensible heat flux, in the variable \n"//&
                 "given by SENSIBLE_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "SENSIBLE_FORCING_VAR", cs%sens_var, &
                 "The variable with the sensible heat flux.", default="sensible")

      call get_param(param_file, mdl, "RAIN_FILE", cs%rain_file, &
                 "The file with the liquid precipitation flux, in the \n"//&
                 "variable given by RAIN_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "RAIN_FORCING_VAR", cs%rain_var, &
                 "The variable with the liquid precipitation flux.", &
                 default="liq_precip")
      call get_param(param_file, mdl, "SNOW_FILE", cs%snow_file, &
                 "The file with the frozen precipitation flux, in the \n"//&
                 "variable given by SNOW_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "SNOW_FORCING_VAR", cs%snow_var, &
                 "The variable with the frozen precipitation flux.", &
                 default="froz_precip")

      call get_param(param_file, mdl, "RUNOFF_FILE", cs%runoff_file, &
                 "The file with the fresh and frozen runoff/calving \n"//&
                 "fluxes, in variables given by LIQ_RUNOFF_FORCING_VAR \n"//&
                 "and FROZ_RUNOFF_FORCING_VAR.", fail_if_missing=.true.)
      call get_param(param_file, mdl, "LIQ_RUNOFF_FORCING_VAR", cs%lrunoff_var, &
                 "The variable with the liquid runoff flux.", &
                 default="liq_runoff")
      call get_param(param_file, mdl, "FROZ_RUNOFF_FORCING_VAR", cs%frunoff_var, &
                 "The variable with the frozen runoff flux.", &
                 default="froz_runoff")
    endif

    call get_param(param_file, mdl, "SSTRESTORE_FILE", cs%SSTrestore_file, &
                 "The file with the SST toward which to restore in the \n"//&
                 "variable given by SST_RESTORE_VAR.", fail_if_missing=.true.)
    call get_param(param_file, mdl, "SALINITYRESTORE_FILE", cs%salinityrestore_file, &
                 "The file with the surface salinity toward which to \n"//&
                 "restore in the variable given by SSS_RESTORE_VAR.", &
                 fail_if_missing=.true.)

    if (cs%archaic_OMIP_file) then
      cs%SST_restore_var = "TEMP" ; cs%SSS_restore_var = "SALT"
    else
      call get_param(param_file, mdl, "SST_RESTORE_VAR", cs%SST_restore_var, &
                 "The variable with the SST toward which to restore.", &
                 default="SST")
      call get_param(param_file, mdl, "SSS_RESTORE_VAR", cs%SSS_restore_var, &
                 "The variable with the SSS toward which to restore.", &
                 default="SSS")
    endif

    ! Add inputdir to the file names.
    cs%shortwave_file = trim(cs%inputdir)//trim(cs%shortwave_file)
    cs%longwave_file = trim(cs%inputdir)//trim(cs%longwave_file)
    cs%sensibleheat_file = trim(cs%inputdir)//trim(cs%sensibleheat_file)
    cs%latentheat_file = trim(cs%inputdir)//trim(cs%latentheat_file)
    cs%evaporation_file = trim(cs%inputdir)//trim(cs%evaporation_file)
    cs%snow_file = trim(cs%inputdir)//trim(cs%snow_file)
    cs%rain_file = trim(cs%inputdir)//trim(cs%rain_file)
    cs%runoff_file = trim(cs%inputdir)//trim(cs%runoff_file)

    cs%shortwaveup_file = trim(cs%inputdir)//trim(cs%shortwaveup_file)
    cs%longwaveup_file = trim(cs%inputdir)//trim(cs%longwaveup_file)

    cs%SSTrestore_file = trim(cs%inputdir)//trim(cs%SSTrestore_file)
    cs%salinityrestore_file = trim(cs%inputdir)//trim(cs%salinityrestore_file)
  elseif (trim(cs%buoy_config) == "const") then
    call get_param(param_file, mdl, "SENSIBLE_HEAT_FLUX", cs%constantHeatForcing, &
                 "A constant heat forcing (positive into ocean) applied \n"//&
                 "through the sensible heat flux field. ", &
                 units='W/m2', fail_if_missing=.true.)
  endif
  call get_param(param_file, mdl, "WIND_CONFIG", cs%wind_config, &
                 "The character string that indicates how wind forcing \n"//&
                 "is specified. Valid options include (file), (2gyre), \n"//&
                 "(1gyre), (gyres), (zero), and (USER).", fail_if_missing=.true.)
  if (trim(cs%wind_config) == "file") then
    call get_param(param_file, mdl, "WIND_FILE", cs%wind_file, &
                 "The file in which the wind stresses are found in \n"//&
                 "variables STRESS_X and STRESS_Y.", fail_if_missing=.true.)
    call get_param(param_file, mdl, "WINDSTRESS_X_VAR",cs%stress_x_var, &
                 "The name of the x-wind stress variable in WIND_FILE.", &
                 default="STRESS_X")
    call get_param(param_file, mdl, "WINDSTRESS_Y_VAR", cs%stress_y_var, &
                 "The name of the y-wind stress variable in WIND_FILE.", &
                 default="STRESS_Y")
    call get_param(param_file, mdl, "WINDSTRESS_STAGGER",cs%wind_stagger, &
                 "A character indicating how the wind stress components \n"//&
                 "are staggered in WIND_FILE.  This may be A or C for now.", &
                 default="A")
    call get_param(param_file, mdl, "WINDSTRESS_SCALE", cs%wind_scale, &
                 "A value by which the wind stresses in WIND_FILE are rescaled.", &
                 default=1.0, units="nondim")
    call get_param(param_file, mdl, "USTAR_FORCING_VAR", cs%ustar_var, &
                 "The name of the friction velocity variable in WIND_FILE \n"//&
                 "or blank to get ustar from the wind stresses plus the \n"//&
                 "gustiness.", default=" ", units="nondim")
    cs%wind_file = trim(cs%inputdir) // trim(cs%wind_file)
  endif
  if (trim(cs%wind_config) == "gyres") then
    call get_param(param_file, mdl, "TAUX_CONST", cs%gyres_taux_const, &
                 "With the gyres wind_config, the constant offset in the \n"//&
                 "zonal wind stress profile: \n"//&
                 "  A in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", &
                 units="Pa", default=0.0)
    call get_param(param_file, mdl, "TAUX_SIN_AMP",cs%gyres_taux_sin_amp, &
                 "With the gyres wind_config, the sine amplitude in the \n"//&
                 "zonal wind stress profile: \n"//&
                 "  B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", &
                 units="Pa", default=0.0)
    call get_param(param_file, mdl, "TAUX_COS_AMP",cs%gyres_taux_cos_amp, &
                 "With the gyres wind_config, the cosine amplitude in \n"//&
                 "the zonal wind stress profile: \n"//&
                 "  C in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", &
                 units="Pa", default=0.0)
    call get_param(param_file, mdl, "TAUX_N_PIS",cs%gyres_taux_n_pis, &
                 "With the gyres wind_config, the number of gyres in \n"//&
                 "the zonal wind stress profile: \n"//&
                 "  n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", &
                 units="nondim", default=0.0)
  endif
  if ((trim(cs%wind_config) == "2gyre") .or. &
      (trim(cs%wind_config) == "1gyre") .or. &
      (trim(cs%wind_config) == "gyres") .or. &
      (trim(cs%buoy_config) == "linear")) then
    cs%south_lat = g%south_lat
    cs%len_lat = g%len_lat
  endif
  call get_param(param_file, mdl, "RHO_0", cs%Rho0, &
                 "The mean ocean density used with BOUSSINESQ true to \n"//&
                 "calculate accelerations and the mass for conservation \n"//&
                 "properties, or with BOUSSINSEQ false to convert some \n"//&
                 "parameters from vertical units of m to kg m-2.", &
                 units="kg m-3", default=1035.0)
  call get_param(param_file, mdl, "RESTOREBUOY", cs%restorebuoy, &
                 "If true, the buoyancy fluxes drive the model back \n"//&
                 "toward some specified surface state with a rate \n"//&
                 "given by FLUXCONST.", default= .false.)
  call get_param(param_file, mdl, "LATENT_HEAT_FUSION", cs%latent_heat_fusion, &
                 "The latent heat of fusion.", units="J/kg", default=hlf)
  call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", cs%latent_heat_vapor, &
                 "The latent heat of fusion.", units="J/kg", default=hlv)
  if (cs%restorebuoy) then
    call get_param(param_file, mdl, "FLUXCONST", cs%Flux_const, &
                 "The constant that relates the restoring surface fluxes \n"//&
                 "to the relative surface anomalies (akin to a piston \n"//&
                 "velocity).  Note the non-MKS units.", units="m day-1", &
                 fail_if_missing=.true.)
    ! Convert CS%Flux_const from m day-1 to m s-1.
    cs%Flux_const = cs%Flux_const / 86400.0
    if (trim(cs%buoy_config) == "linear") then
      call get_param(param_file, mdl, "SST_NORTH", cs%T_north, &
                 "With buoy_config linear, the sea surface temperature \n"//&
                 "at the northern end of the domain toward which to \n"//&
                 "to restore.", units="deg C", default=0.0)
      call get_param(param_file, mdl, "SST_SOUTH", cs%T_south, &
                 "With buoy_config linear, the sea surface temperature \n"//&
                 "at the southern end of the domain toward which to \n"//&
                 "to restore.", units="deg C", default=0.0)
      call get_param(param_file, mdl, "SSS_NORTH", cs%S_north, &
                 "With buoy_config linear, the sea surface salinity \n"//&
                 "at the northern end of the domain toward which to \n"//&
                 "to restore.", units="PSU", default=35.0)
      call get_param(param_file, mdl, "SSS_SOUTH", cs%S_south, &
                 "With buoy_config linear, the sea surface salinity \n"//&
                 "at the southern end of the domain toward which to \n"//&
                 "to restore.", units="PSU", default=35.0)
    endif
  endif
  call get_param(param_file, mdl, "G_EARTH", cs%G_Earth, &
                 "The gravitational acceleration of the Earth.", &
                 units="m s-2", default = 9.80)

  call get_param(param_file, mdl, "GUST_CONST", cs%gust_const, &
                 "The background gustiness in the winds.", units="Pa", &
                 default=0.02)
  call get_param(param_file, mdl, "READ_GUST_2D", cs%read_gust_2d, &
                 "If true, use a 2-dimensional gustiness supplied from \n"//&
                 "an input file", default=.false.)
  if (cs%read_gust_2d) then
    call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, &
                 "The file in which the wind gustiness is found in \n"//&
                 "variable gustiness.", fail_if_missing=.true.)
    call safe_alloc_ptr(cs%gust,g%isd,g%ied,g%jsd,g%jed)
    filename = trim(cs%inputdir) // trim(gust_file)
    call read_data(filename,'gustiness',cs%gust,domain=g%domain%mpp_domain, &
                   timelevel=1) ! units should be Pa
  endif

!  All parameter settings are now known.

  if (trim(cs%wind_config) == "USER" .or. trim(cs%buoy_config) == "USER" ) then
    call user_surface_forcing_init(time, g, param_file, diag, cs%user_forcing_CSp)
  elseif (trim(cs%buoy_config) == "BFB" ) then
    call bfb_surface_forcing_init(time, g, param_file, diag, cs%BFB_forcing_CSp)
  elseif (trim(cs%wind_config) == "MESO" .or. trim(cs%buoy_config) == "MESO" ) then
    call meso_surface_forcing_init(time, g, param_file, diag, cs%MESO_forcing_CSp)
  elseif (trim(cs%wind_config) == "SCM_ideal_hurr") then
    call scm_idealized_hurricane_wind_init(time, g, param_file, cs%SCM_idealized_hurricane_CSp)
  elseif (trim(cs%wind_config) == "const") then
    call get_param(param_file, mdl, "CONST_WIND_TAUX", cs%tau_x0, &
                 "With wind_config const, this is the constant zonal\n"//&
                 "wind-stress", units="Pa", fail_if_missing=.true.)
    call get_param(param_file, mdl, "CONST_WIND_TAUY", cs%tau_y0, &
                 "With wind_config const, this is the constant zonal\n"//&
                 "wind-stress", units="Pa", fail_if_missing=.true.)
  elseif (trim(cs%wind_config) == "SCM_CVmix_tests" .or. &
          trim(cs%buoy_config) == "SCM_CVmix_tests") then
    call scm_cvmix_tests_surface_forcing_init(time, g, param_file, cs%SCM_CVmix_tests_CSp)
    cs%SCM_CVmix_tests_CSp%Rho0 = cs%Rho0 !copy reference density for pass
  endif

  call register_forcing_type_diags(time, diag, cs%use_temperature, cs%handles)

  ! Set up any restart fields associated with the forcing.
  call restart_init(param_file, cs%restart_CSp, "MOM_forcing.res")
!###  call register_ctrl_forcing_restarts(G, param_file, CS%ctrl_forcing_CSp, &
!###                                      CS%restart_CSp)
  call restart_init_end(cs%restart_CSp)

  if (associated(cs%restart_CSp)) then
    call get_mom_input(dirs=dirs)

    new_sim = .false.
    if ((dirs%input_filename(1:1) == 'n') .and. &
        (len_trim(dirs%input_filename) == 1)) new_sim = .true.
    if (.not.new_sim) then
      call restore_state(dirs%input_filename, dirs%restart_input_dir, time_frc, &
                         g, cs%restart_CSp)
    endif
  endif

  ! Determine how many time levels are in each forcing variable.
  if (trim(cs%buoy_config) == "file") then
    cs%SW_nlev = num_timelevels(cs%shortwave_file, cs%SW_var, min_dims=3)
    cs%LW_nlev = num_timelevels(cs%longwave_file, cs%LW_var, min_dims=3)
    cs%latent_nlev = num_timelevels(cs%latentheat_file, cs%latent_var, 3)
    cs%sens_nlev = num_timelevels(cs%sensibleheat_file, cs%sens_var, min_dims=3)

    cs%evap_nlev = num_timelevels(cs%evaporation_file, cs%evap_var, min_dims=3)
    cs%precip_nlev = num_timelevels(cs%rain_file, cs%rain_var, min_dims=3)
    cs%runoff_nlev = num_timelevels(cs%runoff_file, cs%lrunoff_var, 3)

    cs%SST_nlev = num_timelevels(cs%SSTrestore_file, cs%SST_restore_var, 3)
    cs%SSS_nlev = num_timelevels(cs%salinityrestore_file, cs%SSS_restore_var, 3)
  endif

  if (trim(cs%wind_config) == "file") &
    cs%wind_nlev = num_timelevels(cs%wind_file, cs%stress_x_var, min_dims=3)

!###  call controlled_forcing_init(Time, G, param_file, diag, CS%ctrl_forcing_CSp)

  call user_revise_forcing_init(param_file, cs%urf_CS)

  call cpu_clock_end(id_clock_forcing)

Here is the caller graph for this function:

wind_forcing_1gyre()

subroutine mom_surface_forcing::wind_forcing_1gyre ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]

g

The ocean's grid structure

Definition at line 505 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter(), and mom_error_handler::calltree_leave().

Referenced by set_forcing().

  type(surface),            intent(inout) :: state
  type(forcing),            intent(inout) :: fluxes
  type(time_type),          intent(in)    :: day
  type(ocean_grid_type),    intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer       :: cs

! This subroutine sets the surface wind stresses according to single gyre.

! Arguments:
!            state   = structure describing ocean surface state
!  (out)     fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  real :: pi
  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb

  call calltree_enter("wind_forcing_1gyre, MOM_surface_forcing.F90")
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB

  ! set the steady surface wind stresses, in units of Pa.
  pi = 4.0*atan(1.0)

  do j=js,je ; do i=is-1,ieq
    fluxes%taux(i,j) =-0.2*cos(pi*(g%geoLatCu(i,j)-cs%South_lat)/cs%len_lat)
  enddo ; enddo

  do j=js-1,jeq ; do i=is,ie
    fluxes%tauy(i,j) = 0.0
  enddo ; enddo

  call calltree_leave("wind_forcing_1gyre")

Here is the call graph for this function:

Here is the caller graph for this function:

wind_forcing_2gyre()

subroutine mom_surface_forcing::wind_forcing_2gyre ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]

g

The ocean's grid structure

Definition at line 463 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter(), and mom_error_handler::calltree_leave().

Referenced by set_forcing().

  type(surface),            intent(inout) :: state
  type(forcing),            intent(inout) :: fluxes
  type(time_type),          intent(in)    :: day
  type(ocean_grid_type),    intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer       :: cs

! This subroutine sets the surface wind stresses according to double gyre.

! Arguments:
!            state   = structure describing ocean surface state
!  (out)     fluxes  = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day     = time of the fluxes
!  (in)      G       = ocean grid structure
!  (in)      CS      = pointer to control struct returned by previous surface_forcing_init call

  real :: pi
  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb

  call calltree_enter("wind_forcing_2gyre, MOM_surface_forcing.F90")
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB

  !set the steady surface wind stresses, in units of Pa.
  pi = 4.0*atan(1.0)

  do j=js,je ; do i=is-1,ieq
    fluxes%taux(i,j) = 0.1*(1.0 - cos(2.0*pi*(g%geoLatCu(i,j)-cs%South_lat) / &
                                      cs%len_lat))
  enddo ; enddo

  do j=js-1,jeq ; do i=is,ie
    fluxes%tauy(i,j) = 0.0
  enddo ; enddo

  call calltree_leave("wind_forcing_2gyre")

Here is the call graph for this function:

Here is the caller graph for this function:

wind_forcing_by_data_override()

subroutine mom_surface_forcing::wind_forcing_by_data_override ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, type(ocean_grid_type), intent(inout)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in,out]

g

The ocean's grid structure

Definition at line 761 of file MOM_surface_forcing.F90.

References mom_forcing_type::allocate_forcing_type(), mom_error_handler::calltree_enter(), and mom_error_handler::calltree_leave().

Referenced by set_forcing().

  type(surface),            intent(inout) :: state
  type(forcing),            intent(inout) :: fluxes
  type(time_type),          intent(in)    :: day
  type(ocean_grid_type),    intent(inout) :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer       :: cs
! This subroutine sets the surface wind stresses

! Arguments:
!            state  = structure describing ocean surface state
!  (out)     fluxes = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day    = time of the fluxes
!  (in)      G      = ocean grid structure
!  (in)      CS     = pointer to control struct returned by previous surface_forcing_init call

  real :: temp_x(szi_(g),szj_(g)) ! Pseudo-zonal and psuedo-meridional
  real :: temp_y(szi_(g),szj_(g)) ! wind stresses at h-points, in Pa.
  integer :: i, j, is_in, ie_in, js_in, je_in
  logical :: read_ustar

  call calltree_enter("wind_forcing_by_data_override, MOM_surface_forcing.F90")

  if (.not.cs%dataOverrideIsInitialized) then
    call allocate_forcing_type(g, fluxes, stress=.true., ustar=.true.)
    call data_override_init(ocean_domain_in=g%Domain%mpp_domain)
    cs%dataOverrideIsInitialized = .true.
  endif

  is_in = g%isc - g%isd + 1
  ie_in = g%iec - g%isd + 1
  js_in = g%jsc - g%jsd + 1
  je_in = g%jec - g%jsd + 1

  temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0
  call data_override('OCN', 'taux', temp_x, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)
  call data_override('OCN', 'tauy', temp_y, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)
  call pass_vector(temp_x, temp_y, g%Domain, to_all, agrid)
  ! Ignore CS%wind_scale when using data_override ?????
  do j=g%jsc,g%jec ; do i=g%isc-1,g%IecB
    fluxes%taux(i,j) = 0.5 * (temp_x(i,j) + temp_x(i+1,j))
  enddo ; enddo
  do j=g%jsc-1,g%JecB ; do i=g%isc,g%iec
    fluxes%tauy(i,j) = 0.5 * (temp_y(i,j) + temp_y(i,j+1))
  enddo ; enddo

  read_ustar = (len_trim(cs%ustar_var) > 0) ! Need better control higher up ????
  if (read_ustar) then
    call data_override('OCN', 'ustar', fluxes%ustar, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)
  else
    if (cs%read_gust_2d) then
      call data_override('OCN', 'gust', cs%gust, day, is_in=is_in, ie_in=ie_in, js_in=js_in, je_in=je_in)
      do j=g%jsc,g%jec ; do i=g%isc,g%iec
        fluxes%ustar(i,j) = sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + &
            temp_y(i,j)*temp_y(i,j)) + cs%gust(i,j)) / cs%Rho0)
      enddo ; enddo
    else
      do j=g%jsc,g%jec ; do i=g%isc,g%iec
        fluxes%ustar(i,j) = sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + &
            temp_y(i,j)*temp_y(i,j))/cs%Rho0 + (cs%gust_const/cs%Rho0))
      enddo ; enddo
    endif
  endif

  call pass_vector(fluxes%taux, fluxes%tauy, g%Domain, to_all)
! call pass_var(fluxes%ustar, G%Domain, To_All)     Not needed  ?????

  call calltree_leave("wind_forcing_by_data_override")

Here is the call graph for this function:

Here is the caller graph for this function:

wind_forcing_const()

subroutine mom_surface_forcing::wind_forcing_const ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, real, intent(in)  tau_x0, real, intent(in)  tau_y0, type(time_type), intent(in)  day, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]

g

The ocean's grid structure

Definition at line 410 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter(), and mom_error_handler::calltree_leave().

Referenced by set_forcing().

  type(surface),            intent(inout) :: state
  type(forcing),            intent(inout) :: fluxes
  real,                     intent(in)    :: tau_x0
  real,                     intent(in)    :: tau_y0
  type(time_type),          intent(in)    :: day
  type(ocean_grid_type),    intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer       :: cs

! subroutine sets the surface wind stresses to zero

! Arguments:
!            state        = structure describing ocean surface state
!  (out)     fluxes       = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day          = time of the fluxes
!  (in)      G            = ocean grid structure
!  (in)      CS           = pointer to control returned by previous surface_forcing_init call

  real :: mag_tau
  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb

  call calltree_enter("wind_forcing_const, MOM_surface_forcing.F90")
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB

  !set steady surface wind stresses, in units of Pa.
  mag_tau = sqrt( tau_x0**2 + tau_y0**2)

  do j=js,je ; do i=is-1,ieq
    fluxes%taux(i,j) = tau_x0
  enddo ; enddo

  do j=js-1,jeq ; do i=is,ie
    fluxes%tauy(i,j) = tau_y0
  enddo ; enddo

  if (cs%read_gust_2d) then
    if (associated(fluxes%ustar)) then ; do j=js,je ; do i=is,ie
      fluxes%ustar(i,j) = sqrt( ( mag_tau + cs%gust(i,j) ) / cs%Rho0 )
    enddo ; enddo ; endif
  else
    if (associated(fluxes%ustar)) then ; do j=js,je ; do i=is,ie
      fluxes%ustar(i,j) = sqrt( ( mag_tau + cs%gust_const ) / cs%Rho0 )
    enddo ; enddo ; endif
  endif

  call calltree_leave("wind_forcing_const")

Here is the call graph for this function:

Here is the caller graph for this function:

wind_forcing_from_file()

subroutine mom_surface_forcing::wind_forcing_from_file ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, type(ocean_grid_type), intent(inout)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in,out]

g

The ocean's grid structure

Definition at line 597 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter(), mom_error_handler::calltree_leave(), and mom_string_functions::uppercase().

Referenced by set_forcing().

  type(surface),            intent(inout) :: state
  type(forcing),            intent(inout) :: fluxes
  type(time_type),          intent(in)    :: day
  type(ocean_grid_type),    intent(inout) :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer       :: cs

! This subroutine sets the surface wind stresses.

! Arguments:
!            state  = structure describing ocean surface state
!  (out)     fluxes = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day    = time of the fluxes
!  (in)      G      = ocean grid structure
!  (in)      CS     = pointer to control struct returned by previous surface_forcing_init call

  character(len=200) :: filename  ! The name of the input file.
  real    :: temp_x(szi_(g),szj_(g)) ! Pseudo-zonal and psuedo-meridional
  real    :: temp_y(szi_(g),szj_(g)) ! wind stresses at h-points, in Pa.
  integer :: time_lev_daily          ! The time levels to read for fields with
  integer :: time_lev_monthly        ! daily and montly cycles.
  integer :: time_lev                ! The time level that is used for a field.
  integer :: days, seconds
  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb
  logical :: read_ustar

  call calltree_enter("wind_forcing_from_file, MOM_surface_forcing.F90")
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB

  call get_time(day,seconds,days)
  time_lev_daily = days - 365*floor(real(days) / 365.0)

  if (time_lev_daily < 31) then ; time_lev_monthly = 0
  else if (time_lev_daily < 59)  then ; time_lev_monthly = 1
  else if (time_lev_daily < 90)  then ; time_lev_monthly = 2
  else if (time_lev_daily < 120) then ; time_lev_monthly = 3
  else if (time_lev_daily < 151) then ; time_lev_monthly = 4
  else if (time_lev_daily < 181) then ; time_lev_monthly = 5
  else if (time_lev_daily < 212) then ; time_lev_monthly = 6
  else if (time_lev_daily < 243) then ; time_lev_monthly = 7
  else if (time_lev_daily < 273) then ; time_lev_monthly = 8
  else if (time_lev_daily < 304) then ; time_lev_monthly = 9
  else if (time_lev_daily < 334) then ; time_lev_monthly = 10
  else ; time_lev_monthly = 11
  endif

  time_lev_daily = time_lev_daily+1
  time_lev_monthly = time_lev_monthly+1

  select case (cs%wind_nlev)
    case (12) ; time_lev = time_lev_monthly
    case (365) ; time_lev = time_lev_daily
    case default ; time_lev = 1
  end select

  if (time_lev /= cs%wind_last_lev) then
    filename = trim(cs%wind_file)
    read_ustar = (len_trim(cs%ustar_var) > 0)
!    if (is_root_pe()) &
!      write(*,'("Wind_forcing Reading time level ",I," last was ",I,".")')&
!           time_lev-1,CS%wind_last_lev-1
    select case ( uppercase(cs%wind_stagger(1:1)) )
    case ("A")
      temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0
      call read_data(filename,cs%stress_x_var,temp_x(:,:), &
                     domain=g%Domain%mpp_domain,timelevel=time_lev)
      call read_data(filename,cs%stress_y_var,temp_y(:,:), &
                     domain=g%Domain%mpp_domain,timelevel=time_lev)

      call pass_vector(temp_x, temp_y, g%Domain, to_all, agrid)
      do j=js,je ; do i=is-1,ieq
        fluxes%taux(i,j) = 0.5 * cs%wind_scale * (temp_x(i,j) + temp_x(i+1,j))
      enddo ; enddo
      do j=js-1,jeq ; do i=is,ie
        fluxes%tauy(i,j) = 0.5 * cs%wind_scale * (temp_y(i,j) + temp_y(i,j+1))
      enddo ; enddo

      if (.not.read_ustar) then
        if (cs%read_gust_2d) then
          do j=js,je ; do i=is,ie
            fluxes%ustar(i,j) = sqrt((sqrt(temp_x(i,j)*temp_x(i,j) + &
                temp_y(i,j)*temp_y(i,j)) + cs%gust(i,j)) / cs%Rho0)
          enddo ; enddo
        else
          do j=js,je ; do i=is,ie
            fluxes%ustar(i,j) = sqrt(sqrt(temp_x(i,j)*temp_x(i,j) + &
                temp_y(i,j)*temp_y(i,j))/cs%Rho0 + (cs%gust_const/cs%Rho0))
          enddo ; enddo
        endif
      endif
    case ("C")
      if (g%symmetric) then
        if (.not.associated(g%Domain_aux)) call mom_error(fatal, &
          " wind_forcing_from_file with C-grid input and symmetric memory "//&
          " called with a non-associated auxiliary domain in the grid type.")
        !   Read the data as though symmetric memory were not being used, and
        ! then translate it appropriately.
        temp_x(:,:) = 0.0 ; temp_y(:,:) = 0.0
        call read_data(filename, cs%stress_x_var, temp_x(:,:), position=east_face, &
                       domain=g%Domain_aux%mpp_domain, timelevel=time_lev)
        call read_data(filename, cs%stress_y_var, temp_y(:,:), position=north_face, &
                       domain=g%Domain_aux%mpp_domain, timelevel=time_lev)

        do j=js,je ; do i=is,ie
          fluxes%taux(i,j) = cs%wind_scale * temp_x(i,j)
          fluxes%tauy(i,j) = cs%wind_scale * temp_y(i,j)
        enddo ; enddo
        call fill_symmetric_edges(fluxes%taux, fluxes%tauy, g%Domain, stagger=cgrid_ne)
      else
        call read_data(filename, cs%stress_x_var, fluxes%taux(:,:), &
                       domain=g%Domain%mpp_domain, position=east_face, &
                       timelevel=time_lev)
        call read_data(filename, cs%stress_y_var, fluxes%tauy(:,:), &
                       domain=g%Domain%mpp_domain, position=north_face, &
                       timelevel=time_lev)

        if (cs%wind_scale /= 1.0) then
          do j=js,je ; do i=isq,ieq
            fluxes%taux(i,j) = cs%wind_scale * fluxes%taux(i,j)
          enddo ; enddo
          do j=jsq,jeq ; do i=is,ie
            fluxes%tauy(i,j) = cs%wind_scale * fluxes%tauy(i,j)
          enddo ; enddo
        endif
      endif

      call pass_vector(fluxes%taux, fluxes%tauy, g%Domain, to_all)
      if (.not.read_ustar) then
        if (cs%read_gust_2d) then
          do j=js, je ; do i=is, ie
            fluxes%ustar(i,j) = sqrt((sqrt(0.5*((fluxes%tauy(i,j-1)**2 + &
              fluxes%tauy(i,j)**2) + (fluxes%taux(i-1,j)**2 + &
              fluxes%taux(i,j)**2))) + cs%gust(i,j)) / cs%Rho0 )
          enddo ; enddo
        else
          do j=js, je ; do i=is, ie
            fluxes%ustar(i,j) = sqrt(sqrt(0.5*((fluxes%tauy(i,j-1)**2 + &
              fluxes%tauy(i,j)**2) + (fluxes%taux(i-1,j)**2 + &
              fluxes%taux(i,j)**2)))/cs%Rho0 + (cs%gust_const/cs%Rho0))
          enddo ; enddo
        endif
      endif
    case default
      call mom_error(fatal, "wind_forcing_from_file: Unrecognized stagger "//&
                      trim(cs%wind_stagger)//" is not 'A' or 'C'.")
    end select

    if (read_ustar) then
      call read_data(filename, cs%Ustar_var, fluxes%ustar(:,:), &
                     domain=g%Domain%mpp_domain, timelevel=time_lev)
    endif

    cs%wind_last_lev = time_lev

  endif ! time_lev /= CS%wind_last_lev

  call calltree_leave("wind_forcing_from_file")

Here is the call graph for this function:

Here is the caller graph for this function:

wind_forcing_gyres()

subroutine mom_surface_forcing::wind_forcing_gyres ( type(surface), intent(inout)  state, type(forcing), intent(inout)  fluxes, type(time_type), intent(in)  day, type(ocean_grid_type), intent(in)  G, type(surface_forcing_cs), pointer  CS  )

private

Parameters

[in]

g

The ocean's grid structure

Definition at line 546 of file MOM_surface_forcing.F90.

References mom_error_handler::calltree_enter(), and mom_error_handler::calltree_leave().

Referenced by set_forcing().

  type(surface),            intent(inout) :: state
  type(forcing),            intent(inout) :: fluxes
  type(time_type),          intent(in)    :: day
  type(ocean_grid_type),    intent(in)    :: g    !< The ocean's grid structure
  type(surface_forcing_cs), pointer       :: cs

! This subroutine sets the surface wind stresses according to gyres.

! Arguments:
!            state  = structure describing ocean surface state
!  (out)     fluxes = structure with pointers to forcing fields; unused have NULL ptrs
!  (in)      day    = time of the fluxes
!  (in)      G      = ocean grid structure
!  (in)      CS     = pointer to control struct returned by previous surface_forcing_init call

  real :: pi, y
  integer :: i, j, is, ie, js, je, isq, ieq, jsq, jeq
  integer :: isd, ied, jsd, jed, isdb, iedb, jsdb, jedb

  call calltree_enter("wind_forcing_gyres, MOM_surface_forcing.F90")
  is   = g%isc  ; ie   = g%iec  ; js   = g%jsc  ; je   = g%jec
  isq  = g%IscB ; ieq  = g%IecB ; jsq  = g%JscB ; jeq  = g%JecB
  isd  = g%isd  ; ied  = g%ied  ; jsd  = g%jsd  ; jed  = g%jed
  isdb = g%IsdB ; iedb = g%IedB ; jsdb = g%JsdB ; jedb = g%JedB

  ! steady surface wind stresses (Pa)
  pi = 4.0*atan(1.0)

  do j=jsd,jed ; do i=is-1,iedb
    y = (g%geoLatCu(i,j)-cs%South_lat)/cs%len_lat
    fluxes%taux(i,j) = cs%gyres_taux_const +                            &
             (   cs%gyres_taux_sin_amp*sin(cs%gyres_taux_n_pis*pi*y)    &
               + cs%gyres_taux_cos_amp*cos(cs%gyres_taux_n_pis*pi*y) )
  enddo ; enddo

  do j=js-1,jedb ; do i=isd,ied
    fluxes%tauy(i,j) = 0.0
  enddo ; enddo

  ! set the friction velocity
  do j=js,je ; do i=is,ie
    fluxes%ustar(i,j) = sqrt(sqrt(0.5*(fluxes%tauy(i,j-1)*fluxes%tauy(i,j-1) + &
      fluxes%tauy(i,j)*fluxes%tauy(i,j) + fluxes%taux(i-1,j)*fluxes%taux(i-1,j) + &
      fluxes%taux(i,j)*fluxes%taux(i,j)))/cs%Rho0 + (cs%gust_const/cs%Rho0))
  enddo ; enddo

  call calltree_leave("wind_forcing_gyres")

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

id_clock_forcing

integer mom_surface_forcing::id_clock_forcing

Definition at line 223 of file MOM_surface_forcing.F90.

Referenced by set_forcing(), and surface_forcing_init().

integer :: id_clock_forcing