sfc_ocean.F

 
 
      module sfc_ocean
      implicit none
      private
      public :: sfc_ocean_run
 
      contains
 
 
      subroutine sfc_ocean_run                                          &
!...................................
!  ---  inputs:
     &     ( im, hvap, cp, rd, eps, epsm1, rvrdm1, ps, u1, v1, t1, q1,  &
     &       tskin, cm, ch, lseaspray, fm, fm10,                        &
     &       usfco, vsfco, icplocn2atm,                                 &
     &       prsl1, prslki, wet, use_lake_model, wind,                  &,  ! --- inputs
     &       flag_iter, use_med_flux, dqsfc_med, dtsfc_med,             &
     &       qsurf, cmm, chh, gflux, evap, hflx, ep,                    &   ! --- outputs
     &       errmsg, errflg                                             &
     &     )
 
! ===================================================================== !
!  description:                                                         !
!                                                                       !
!  usage:                                                               !
!                                                                       !
!    call sfc_ocean                                                     !
!       inputs:                                                         !
!        ( im, ps, u1, v1, t1, q1, tskin, cm, ch, lseaspray, fm, fm10,  !
!             usfco, vsfco, icplocn2atm,                                !
!            prsl1, prslki, wet, use_lake_model, wind, flag_iter,       !
!            use_med_flux,                                              !
!       outputs:                                                        !
!            qsurf, cmm, chh, gflux, evap, hflx, ep )                   !
!                                                                       !
!                                                                       !
!  subprograms/functions called: fpvs                                   !
!                                                                       !
!                                                                       !
!  program history log:                                                 !
!         2005  -- created from the original progtm to account for      !
!                  ocean only                                           !
!    oct  2006  -- h. wei      added cmm and chh to the output          !
!    apr  2009  -- y.-t. hou   modified to match the modified gbphys.f  !
!                  reformatted the code and added program documentation !
!    sep  2009  -- s. moorthi removed rcl and made pa as pressure unit  !
!                  and furthur reformatted the code                     !
!    dec  2021  -- u. turuncoglu added support for receiving fluxes     !
!                  from mediator                                        !
!                                                                       !
!                                                                       !
!  ====================  defination of variables  ====================  !
!                                                                       !
!  inputs:                                                       size   !
!     im       - integer, horizontal dimension                     1    !
!     ps       - real, surface pressure                            im   !
!     u1, v1   - real, u/v component of surface layer wind (m/s)   im   !
!     usfco    - real, u component of surface ocean current (m/s)  im   !
!     vsfco    - real, v component of surface ocean current (m/s)  im   !
!     icplocn2atm - integer, =1 if usfco and vsfco are used in the 1    !
!                computation of air-sea fluxes                          !
!     t1       - real, surface layer mean temperature ( k )        im   !
!     q1       - real, surface layer mean specific humidity        im   !
!     tskin    - real, ground surface skin temperature ( k )       im   !
!     cm       - real, surface exchange coeff for momentum (m/s)   im   !
!     ch       - real, surface exchange coeff heat & moisture(m/s) im   !
!     lseaspray- logical, .t. for parameterization for sea spray   1    !
!     fm       - real, a stability profile function for momentum   im   !
!     fm10     - real, a stability profile function for momentum   im   !
!                       at 10m                                          !
!     prsl1    - real, surface layer mean pressure                 im   !
!     prslki   - real,                                             im   !
!     wet      - logical, =T if any ocean/lak, =F otherwise        im   !
!     wind     - real, wind speed (m/s)                            im   !
!     flag_iter- logical,                                          im   !
!     use_med_flux - logical, =T to use fluxes coming from med     1    !
!     dqsfc_med- real, latent heat flux                            im   !
!     dtsfc_med- real, sensible heat flux                          im   !
!                                                                       !
!  outputs:                                                             !
!     qsurf    - real, specific humidity at sfc                    im   !
!     cmm      - real,                                             im   !
!     chh      - real,                                             im   !
!     gflux    - real, ground heat flux (zero for ocean)           im   !
!     evap     - real, evaporation from latent heat flux           im   !
!     hflx     - real, sensible heat flux                          im   !
!     ep       - real, potential evaporation                       im   !
!                                                                       !
! ===================================================================== !
!
      use machine , only : kind_phys
      use funcphys, only : fpvs
!
      implicit none
 
!  ---  constant parameters:
      real (kind=kind_phys), parameter :: one  = 1.0_kind_phys,         &
     &           zero = 0.0_kind_phys, qmin = 1.0e-8_kind_phys
!  ---  inputs:
      integer, intent(in) :: im
      real (kind=kind_phys), intent(in) :: hvap, cp, rd,                &
     &                 eps, epsm1, rvrdm1
 
      real (kind=kind_phys), dimension(:), intent(in) :: ps, u1, v1,    &
     &    t1, q1, tskin, cm, ch, fm, fm10, prsl1, prslki, wind,         &
     &    usfco, vsfco
 
! For sea spray effect
      logical, intent(in) :: lseaspray
!
      logical, dimension(:), intent(in) :: flag_iter, wet
      integer, dimension(:), intent(in) :: use_lake_model
      integer, intent(in) :: icplocn2atm
!
      logical, intent(in) :: use_med_flux
 
! To receive fluxes from mediator
      real (kind=kind_phys), dimension(:), intent(in), optional ::      &
     &       dqsfc_med, dtsfc_med
 
!  ---  outputs:
      real (kind=kind_phys), dimension(:), intent(inout) :: qsurf,      &
     &       cmm, chh, gflux, evap, hflx, ep
 
      character(len=*), intent(out) :: errmsg
      integer,          intent(out) :: errflg
 
!  ---  locals:
 
      real (kind=kind_phys) :: qss, rch, tem,
     &                         elocp, cpinv, hvapi
      real (kind=kind_phys), dimension(im) :: rho, q0
      real (kind=kind_phys), dimension(im) :: windrel
 
      integer :: i
 
      logical :: flag(im)
!
!  parameters for sea spray effect
!
      real (kind=kind_phys) :: f10m, u10m, v10m, ws10, ru10, qss1,
     &                         bb1, hflxs, evaps, ptem
!
!     real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.1,
!     real (kind=kind_phys), parameter :: alps=0.5, bets=0.5, gams=0.0,
!     real (kind=kind_phys), parameter :: alps=1.0, bets=1.0, gams=0.2,
      real (kind=kind_phys), parameter :: alps=0.75,bets=0.75,gams=0.15,
     &                       ws10cr=30., conlf=7.2e-9, consf=6.4e-8
!
!======================================================================================================
!===> ...  begin here
!
!  -- ...  initialize CCPP error handling variables
      errmsg = ''
      errflg = 0
 
      cpinv = one/cp
      hvapi = one/hvap
      elocp = hvap/cp
!
      do i = 1, im
        flag(i) = (wet(i) .and. flag_iter(i) .and. use_lake_model(i)/=1)
!           ps is in pascals, wind is wind speed,
!           rho is density, qss is sat. hum. at surface
 
        if ( flag(i) ) then
          if (use_med_flux) then
            q0(i)    = max( q1(i), qmin )
            rho(i)   = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i)))
            
            if (icplocn2atm == 0) then
              tem      = ch(i) * wind(i)
              cmm(i)   = cm(i) * wind(i)
            else if (icplocn2atm ==1) then
              windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 )
              tem      = ch(i) * windrel(i)
              cmm(i)   = cm(i) * windrel(i)
            endif
            chh(i)   = rho(i) * tem
 
            hflx(i)  = dtsfc_med(i)
            evap(i)  = dqsfc_med(i)
 
            qsurf(i) = q1(i) + dqsfc_med(i) / (hvap*chh(i))
            gflux(i) = zero
          else
            q0(i)    = max( q1(i), qmin )
            rho(i)   = prsl1(i) / (rd*t1(i)*(one + rvrdm1*q0(i)))
 
            qss      = fpvs( tskin(i) )
            qss      = eps*qss / (ps(i) + epsm1*qss)
 
!  --- ...    rcp  = rho cp ch v
 
            if (icplocn2atm == 0) then
              rch      = rho(i) * cp * ch(i) * wind(i)
              tem      = ch(i) * wind(i)
              cmm(i)   = cm(i) * wind(i)
            else if (icplocn2atm ==1) then
              windrel(i)=sqrt( (u1(i)-usfco(i))**2+(v1(i)-vsfco(i))**2 )
              rch      = rho(i) * cp * ch(i) * windrel(i)
              tem      = ch(i) * windrel(i)
              cmm(i)   = cm(i) * windrel(i)
            endif
            chh(i)   = rho(i) * tem
 
 
            hflx(i)  = rch * (tskin(i) - t1(i) * prslki(i))
 
            evap(i)  = elocp * rch * (qss - q0(i))
 
            qsurf(i) = qss
            gflux(i) = zero
          endif
        endif
      enddo
!
!
      do i=1,im
        if(lseaspray .and. flag(i)) then
          f10m = fm10(i) / fm(i)
          u10m = f10m * u1(i)
          v10m = f10m * v1(i)
          ws10 = sqrt(u10m*u10m + v10m*v10m)
          ws10 = max(ws10,1.)
          ws10 = min(ws10,ws10cr)
          tem = .015 * ws10 * ws10
          ru10 = 1. - .087 * log(10./tem)
          qss1 = fpvs(t1(i))
          qss1 = eps * qss1 / (prsl1(i) + epsm1 * qss1)
          tem = rd * cp * t1(i) * t1(i)
          tem = 1. + eps * hvap * hvap * qss1 / tem
          bb1 = 1. / tem
          evaps = conlf * (ws10**5.4) * ru10 * bb1
          evaps = evaps * rho(i) * hvap * (qss1 - q0(i))
          evap(i) = evap(i) + alps * evaps
          hflxs = consf * (ws10**3.4) * ru10
          hflxs = hflxs * rho(i) * cp * (tskin(i) - t1(i))
          ptem = alps - gams
          hflx(i) = hflx(i) + bets * hflxs - ptem * evaps
        endif
      enddo
!
      do i = 1, im
        if ( flag(i) ) then
          tem      = 1.0 / rho(i)
          hflx(i)  = hflx(i) * tem * cpinv
          evap(i)  = evap(i) * tem * hvapi
          ep(i)    = evap(i)
        endif
      enddo
!
      return
!...................................
      end subroutine sfc_ocean_run
!-----------------------------------
      end module sfc_ocean