boundary Subroutine

public subroutine boundary()

Uses

  • proc~~boundary~~UsesGraph proc~boundary boundary decomp_2d decomp_2d proc~boundary->decomp_2d module~moddriver moddriver proc~boundary->module~moddriver module~modfields modfields proc~boundary->module~modfields module~modglobal modglobal proc~boundary->module~modglobal module~modinletdata modinletdata proc~boundary->module~modinletdata module~modmpi modmpi proc~boundary->module~modmpi module~modsubgriddata modsubgriddata proc~boundary->module~modsubgriddata module~modsurfdata modsurfdata proc~boundary->module~modsurfdata module~moddriver->module~modinletdata module~modfields->decomp_2d mpi mpi module~modmpi->mpi

Arguments

None

Calls

proc~~boundary~~CallsGraph proc~boundary boundary proc~driverchunkread driverchunkread proc~boundary->proc~driverchunkread proc~drivergen drivergen proc~boundary->proc~drivergen proc~fluxtop fluxtop proc~boundary->proc~fluxtop proc~fluxtopscal fluxtopscal proc~boundary->proc~fluxtopscal proc~valuetop valuetop proc~boundary->proc~valuetop proc~valuetopscal valuetopscal proc~boundary->proc~valuetopscal proc~xmi_driver xmi_driver proc~boundary->proc~xmi_driver proc~xmi_profile xmi_profile proc~boundary->proc~xmi_profile proc~xmo_convective xmo_convective proc~boundary->proc~xmo_convective proc~xqi_driver xqi_driver proc~boundary->proc~xqi_driver proc~xqi_profile xqi_profile proc~boundary->proc~xqi_profile proc~xqo_convective xqo_convective proc~boundary->proc~xqo_convective proc~xsi_custom xsi_custom proc~boundary->proc~xsi_custom proc~xsi_driver xsi_driver proc~boundary->proc~xsi_driver proc~xsi_profile xsi_profile proc~boundary->proc~xsi_profile proc~xso_convective xso_convective proc~boundary->proc~xso_convective proc~xti_driver xTi_driver proc~boundary->proc~xti_driver proc~xti_profile xTi_profile proc~boundary->proc~xti_profile proc~xto_convective xTo_convective proc~boundary->proc~xto_convective proc~ymi_profile ymi_profile proc~boundary->proc~ymi_profile proc~ymo_convective ymo_convective proc~boundary->proc~ymo_convective proc~yqi_profile yqi_profile proc~boundary->proc~yqi_profile proc~yqo_convective yqo_convective proc~boundary->proc~yqo_convective proc~ysi_profile ysi_profile proc~boundary->proc~ysi_profile proc~yso_convective yso_convective proc~boundary->proc~yso_convective proc~yti_profile yTi_profile proc~boundary->proc~yti_profile proc~yto_convective yTo_convective proc~boundary->proc~yto_convective proc~readdriverfile_chunk readdriverfile_chunk proc~driverchunkread->proc~readdriverfile_chunk proc~writedriverfile writedriverfile proc~drivergen->proc~writedriverfile zstart zstart proc~xsi_custom->zstart

Called by

proc~~boundary~~CalledByGraph proc~boundary boundary program~dalesurban DALESURBAN program~dalesurban->proc~boundary

Source Code

   subroutine boundary
      use modglobal,      only : ib, ie, ih, jb, je, jh, kb, ke, kh, ihc, jhc, khc, dzf, zh, nsv, &
                                 ltempeq, lmoist, luvolflowr, luoutflowr, &
                                 BCxm, BCym, BCxT, BCyT, BCxq, BCyq, BCxs, BCys, BCtopm, BCtopT, BCtopq, BCtops, &
                                 BCtopm_freeslip, BCtopm_noslip, BCtopm_pressure, &
                                 BCtopT_flux, BCtopT_value, BCtopq_flux, BCtopq_value, BCtops_flux, BCtops_value, &
                                 BCxm_periodic, BCxm_profile, BCxm_driver, &
                                 BCxT_periodic, BCxT_profile, BCxT_driver, &
                                 BCxq_periodic, BCxq_profile, BCxq_driver, &
                                 BCxs_periodic, BCxs_profile, BCxs_driver, BCxs_custom, &
                                 BCym_periodic, BCym_profile, BCyT_periodic, BCyT_profile, &
                                 BCyq_periodic, BCyq_profile, BCys_periodic, &
                                 ibrank, ierank, jbrank, jerank, e12min, idriver, &
                                 Uinf, Vinf, &
                                 rk3step, lchunkread
      use modfields,      only : u0, v0, w0, um, vm, wm, thl0, thlm, qt0, qtm, e120, e12m, sv0, svm, u0av, v0av, uouttot, vouttot, thl0c
      use modsubgriddata, only : ekh, ekm, loneeqn
      use modsurfdata,    only : thl_top, qt_top, sv_top, wttop, wqtop, wsvtop
      use modmpi,         only : myid, slabsum, avey_ibm
      use moddriver,      only : drivergen, driverchunkread
      use modinletdata,   only : ubulk, vbulk, iangle
      use decomp_2d,      only : exchange_halo_z

      implicit none
      real, dimension(kb:ke) :: uaverage, vaverage
      real, dimension(ib:ie,kb:ke) :: uavey
      integer i, k, n

     ! if not using massflowrate need to set outflow velocity
     if (luoutflowr) then
        ! do nothing - calculated in modforces
     elseif (.not. luvolflowr) then
        !ubulk = sum(u0av)/(ke-kb+1)
        do k = kb, ke
           uaverage(k) = u0av(k)*dzf(k)
        end do

        do k = kb, ke
           vaverage(k) = v0av(k)*dzf(k)
        end do
        ! need a method to know if we have all blocks at lowest cell kb
        ! assuming this for now (hence kb+1)
        uouttot = sum(uaverage(kb:ke))/(zh(ke + 1) - zh(kb+1))
        vouttot = sum(vaverage(kb:ke))/(zh(ke + 1) - zh(kb+1))
     else
        uouttot = ubulk
        vouttot = vbulk
     end if

     ! Bottom BC - many ways of enforcing this but this is simplest
     ! Other variables handled by bottom
     wm(:, :, kb) = 0.
     w0(:, :, kb) = 0.

     !! Top
     ! Momentum
     select case(BCtopm)
     case(BCtopm_freeslip)
        !free-slip = zero-flux
        call fluxtop(um, ekm, 0.0)
        call fluxtop(u0, ekm, 0.0)
        call fluxtop(vm, ekm, 0.0)
        call fluxtop(v0, ekm, 0.0)
        w0(:, :, ke + 1) = 0.0
        wm(:, :, ke + 1) = 0.0
        if (loneeqn) then
          e120(:, :, ke + 1) = e12min
          e12m(:, :, ke + 1) = e12min
        end if
     case(BCtopm_noslip)
        !no-slip = fixed velocity at wall
        call valuetop(um, Uinf)
        call valuetop(u0, Uinf)
        call valuetop(vm, Vinf)
        call valuetop(v0, Vinf)
        w0(:, :, ke + 1) = 0.0
        wm(:, :, ke + 1) = 0.0
      case(BCtopm_pressure)
         call fluxtop(um, ekm, 0.0)
         call fluxtop(u0, ekm, 0.0)
         call fluxtop(vm, ekm, 0.0)
         call fluxtop(v0, ekm, 0.0)
         if (loneeqn) then
           e120(:, :, ke + 1) = e12min
           e12m(:, :, ke + 1) = e12min
         end if
         ! w considered in modpois
      case default
        write(0, *) "ERROR: top boundary type for velocity undefined"
        stop 1
     end select

     ! Temperature
     select case(BCtopT)
     case(BCtopT_flux)
        call fluxtop(thlm, ekh, wttop)
        call fluxtop(thl0, ekh, wttop)
        do n=1,khc
           thl0c(:,:,ke+n) = thl0c(:,:,ke+n-1)
        end do
     case(BCtopT_value)
        call valuetop(thlm, thl_top)
        call valuetop(thl0, thl_top)
     case default
        write(0, *) "ERROR: top boundary type for temperature undefined"
        stop 1

     end select

     ! Moisture
     select case(BCtopq)
     case(BCtopq_flux)
        call fluxtop(qtm, ekh, wqtop)
        call fluxtop(qt0, ekh, wqtop)
     case(BCtopq_value)
        call valuetop(qtm, qt_top)
        call valuetop(qt0, qt_top)
     case default
        write(0, *) "ERROR: top boundary type for moisture undefined"
        stop 1
     end select

     ! Scalars
     select case(BCtops)
     case(BCtops_flux)
        call fluxtopscal(wsvtop)
        call fluxtopscal(wsvtop)
     case(BCtops_value)
        call valuetopscal(sv_top)
        call valuetopscal(sv_top)
     case default
        write(0, *) "ERROR: top boundary type for scalars undefined"
        stop 1
     end select

     if (idriver == 1) call drivergen ! Should be moved elsewhere, as not related to boundary conditions.

     ! x inlet
     if (ibrank) then ! set inlet
       ! Momentum
       select case(BCxm)
       case(BCxm_periodic)
         ! Handled in halos
       case(BCxm_profile)
         !uouttot = cos(iangle)*ubulk
         call xmi_profile
       case(BCxm_driver)
         !uouttot = ubulk ! does this hold for all forcings of precursor simulations? tg3315
         if(rk3step==0 .or. rk3step==3) then
          if (lchunkread) call driverchunkread
          call drivergen ! think this should be done at the start of an rk3 loop?
         end if
         call xmi_driver
       case default
         write(0, *) "ERROR: lateral boundary type for veloctiy in x-direction undefined"
         stop 1
       end select

       ! Temperature
       if (ltempeq) then
         select case(BCxT)
         case(BCxT_periodic) ! periodic
           ! Handled in halos
         case(BCxT_profile) ! profile
           call xTi_profile
         case(BCxT_driver)
           call xTi_driver
         case default
           write(0, *) "ERROR: lateral boundary type for temperature in x-direction undefined"
           stop 1
         end select
       end if

       ! Moisture
       if (lmoist) then
         select case(BCxq)
         case(BCxq_periodic)
           ! Handled in halos
         case(BCxq_profile)
           call xqi_profile
         case(BCxq_driver)
           call xqi_driver
         case default
           write(0, *) "ERROR: lateral boundary type for humidity in x-direction undefined"
           stop 1
         end select
       end if

       ! Scalars
       if (nsv > 0) then
         select case(BCxs)
         case(BCxs_periodic)
           ! Handled in halos
         case(BCxs_profile)
           call xsi_profile
         case(BCxs_driver)
           call xsi_driver
        case(BCxs_custom)
           call xsi_custom
         case default
           write(0, *) "ERROR: lateral boundary type for scalars in x-direction undefined"
           stop 1
         end select
       end if

     end if !ibrank

     if (jbrank) then ! set y inlet
       ! Momentum
       select case(BCym)
       case(BCym_periodic)
         ! Handled in halos
       case(BCym_profile)
         call ymi_profile
       case default
         write(0, *) "ERROR: lateral boundary type for veloctiy in y-direction undefined"
         stop 1
       end select

       ! Temperature
       if (ltempeq) then
         select case(BCyT)
         case(BCyT_periodic)
           ! Handled in halos
         case(BCyT_profile)
           call yTi_profile
         case default
           write(0, *) "ERROR: lateral boundary type for temperature in y-direction undefined"
           stop 1
         end select
       end if

       ! Moisture
       if (lmoist) then
         select case(BCyq)
         case(BCyq_periodic)
           ! Handled in halos
         case(BCyq_profile)
           call yqi_profile
         case default
           write(0, *) "ERROR: lateral boundary type for humidity in y-direction undefined"
           stop 1
         end select
       end if

       if (nsv > 0) then !scalars
         select case(BCys)
         case(1)
           ! Handled in halos
         case(2)
           call ysi_profile
         case default
           write(0, *) "ERROR: lateral boundary type for scalars in y-direction undefined"
           stop 1
         end select
       end if

     end if !jbrank

     !> Outlet
     ! Currently only outflow boundary conditions are convective
     if (ierank) then
       if (BCxm .ne. BCxm_periodic) call xmo_convective
       if ((BCxT .ne. BCxT_periodic) .and. ltempeq) call xTo_convective
       if ((BCxq .ne. BCxq_periodic) .and. lmoist ) call xqo_convective
       if ((BCxs .ne. BCxs_periodic) .and. nsv > 0) call xso_convective
     end if

     if (jerank) then
       if (BCym .ne. BCym_periodic) call ymo_convective
       if ((BCyT .ne. BCyT_periodic) .and. ltempeq) call yTo_convective
       if ((BCyq .ne. BCyq_periodic) .and. lmoist ) call yqo_convective
       if ((BCys .ne. BCys_periodic) .and. nsv > 0) call yso_convective
     end if

   end subroutine boundary