wfGR Subroutine

subroutine wfGR(hi, hj, hk, ioq, ioqflux, icth, obcqfluxA, qcell, qwall, hurel, resc, ress, n, ind, wforient)

Uses

  • proc~~wfgr~~UsesGraph proc~wfgr wf_gr.f90::wfGR module~initfac initfac proc~wfgr->module~initfac module~modglobal modglobal proc~wfgr->module~modglobal module~modibmdata modibmdata proc~wfgr->module~modibmdata module~modmpi modmpi proc~wfgr->module~modmpi module~modsubgriddata modsubgriddata proc~wfgr->module~modsubgriddata module~initfac->module~modglobal module~initfac->module~modmpi netcdf netcdf module~initfac->netcdf mpi mpi module~modmpi->mpi

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: hi
integer, intent(in) :: hj
integer, intent(in) :: hk
real, intent(inout) :: ioq(ib-hi:ie+hi,jb-hj:je+hj,kb:ke+hk)
real, intent(inout) :: ioqflux(ib-hi:ie+hi,jb-hj:je+hj,kb-hk:ke+hk)
real, intent(in) :: icth(ib-hi:ie+hi,jb-hj:je+hj,kb-hk:ke+hk)
real, intent(out) :: obcqfluxA
real, intent(in) :: qcell(ib-hi:ie+hi,jb-hj:je+hj,kb-hk:ke+hk)
real, intent(in) :: qwall
real, intent(in) :: hurel
real, intent(in) :: resc
real, intent(in) :: ress
integer, intent(in) :: n
integer, intent(in) :: ind
integer, intent(in) :: wforient

Called by

proc~~wfgr~~CalledByGraph proc~wfgr wf_gr.f90::wfGR proc~xwallfun modibm::xwallfun proc~xwallfun->proc~wfgr proc~ywallfunmin modibm::ywallfunmin proc~ywallfunmin->proc~wfgr proc~ywallfunplus modibm::ywallfunplus proc~ywallfunplus->proc~wfgr proc~zwallfun modibm::zwallfun proc~zwallfun->proc~wfgr proc~ibmwallfun modibm::ibmwallfun proc~ibmwallfun->proc~xwallfun proc~ibmwallfun->proc~ywallfunmin proc~ibmwallfun->proc~ywallfunplus proc~ibmwallfun->proc~zwallfun program~dalesurban DALESURBAN program~dalesurban->proc~ibmwallfun

Contents

Source Code


Source Code

SUBROUTINE wfGR(hi,hj,hk,ioq,ioqflux,icth,obcqfluxA,qcell,qwall,hurel,resc,ress,n,ind,wforient)
   !wfGR
   USE modglobal, ONLY : dzf,dzfi,dzh2i,dzhi,dzhiq,dy,dyi,dy2i,dyi5,dxf,dxh,dxfi,dxhi,dxh2i,ib,ie,jb,je,kb,ke,fkar,grav,jmax,rk3step
   USE modsubgriddata, ONLY:ekh
   USE modmpi, ONLY:myid
   USE initfac, ONLY:block
   USE modibmdata
   INTEGER i, j, k, jl, ju, kl, ku, il, iu, km, im, jm, ip, jp, kp

   REAL :: bcqflux = 0. !temp storage for temperature flux
   REAL :: bcmomflux = 0. !temp storage for momentum flux
   REAL :: dummy = 0. !for debugging
   REAL :: delta = 0. !distance from wall
   REAL :: fkar2 = fkar**2 !fkar^2, von Karman constant squared
   REAL :: emmo = 0., epmo = 0., epom = 0., emom = 0., eopm = 0., eomm = 0., empo = 0.
   REAL :: umin = 0.0001 !m^2/s^2
   REAL :: cveg=0.8 !hardcoded for now, !fraction of GR covered in vegetation, should be made into a proper model parameter (-> modglobal)

   INTEGER, INTENT(in) :: hi !<size of halo in i
   INTEGER, INTENT(in) :: hj !<size of halo in j
   INTEGER, INTENT(in) :: hk !<size of halo in k
   REAL, INTENT(out)   :: obcqfluxA; !temperature flux of entire wall facet (double sum over indeces) [Km/s]
   REAL, INTENT(inout) :: ioq(ib - hi:ie + hi, jb - hj:je + hj, kb:ke + hk) !updated prognostic temperature
   REAL, INTENT(inout) :: ioqflux(ib - hi:ie + hi, jb - hj:je + hj, kb-hk:ke + hk) !a field to save the momentum flux
   REAL, INTENT(in)   :: icth(ib - hi:ie + hi, jb - hj:je + hj, kb-hk:ke + hk) ; !heat transfer coefficient, used to calculate moisture flux
   REAL, INTENT(in)    :: qcell(ib - hi:ie + hi, jb - hj:je + hj, kb - hk:ke + hk) !Temperature of fluid cell
   !       real, intent(in)    :: Troof(ib:ie,jb:je,kb:ke)  !Temperature of horizontal surfaces (also includes roads)
   REAL, INTENT(in)    :: qwall
   REAL, INTENT(in)    :: hurel
   REAL, INTENT(in)    :: resc
   REAL, INTENT(in)    :: ress
   INTEGER, INTENT(in) :: n ! number of the block, used to get i,j,k-indeces
   INTEGER, INTENT(in) :: ind ! in case of y-wall (case 3x & 4x) "ind" is used for j-index, otherwise this is irrelevant
   INTEGER, INTENT(in) :: wforient !frist digit, orientation of wall, determines iteration idices and if Twall or Troof is used
   obcqfluxA = 0.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!CASES!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!CASES FOR SCALARS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   SELECT CASE (wforient)
   CASE (12) !wall in yz -> wf in x (=vertical), lower wall, west wall
      i = block(n, 1) - 1 !wall property and fluid index
      ip = i + 1 !index to remove subgrid flux
      jl = MAX(block(n, 3) - myid*jmax, 1) ! starting j-index
      ju = MIN(block(n, 4) - myid*jmax, jmax) ! ending j-index
      kl = block(n, 5) ! starting k-index
      ku = block(n, 6) ! ending k-index

      delta = dxf(i)*0.5 !
      DO k = kl, ku
         DO j = jl, ju
            bcqflux=min(0.,cveg*(qcell(i,j,k)-qwall)*1/(1/icth(i,j,k)+resc)+(1-cveg)*(qcell(i,j,k)-qwall*hurel)*1/(1/icth(i,j,k)+ress))

            obcqfluxA = obcqfluxA + bcqflux
            ioqflux(i, j, k) = ioqflux(i, j, k) + bcqflux*dxfi(i)  

            ioq(i,j,k)=ioq(i,j,k)-0.5*(ekh(ip,j,k)*dxf(i)+ekh(i,j,k)*dxf(ip))*(qcell(ip,j,k)-qcell(i,j,k))*dxh2i(ip)*dxfi(i)-bcqflux*dxfi(i) !

         END DO
      END DO

!!! case 22 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   CASE (22)
      i = block(n, 2) + 1 !
      im = i - 1 !
      jl = MAX(block(n, 3) - myid*jmax, 1) ! starting j-index
      ju = MIN(block(n, 4) - myid*jmax, jmax) ! ending j-index
      kl = block(n, 5) ! starting k-index
      ku = block(n, 6) ! ending k-index

      delta = dxh(i)*0.5
      DO k = kl, ku
         DO j = jl, ju

            !dq * 1/res, where res is in [s/m]
            bcqflux=min(0.,cveg*(qcell(i,j,k)-qwall)*1/(1/icth(i,j,k)+resc)+(1-cveg)*(qcell(i,j,k)-qwall*hurel)*1/(1/icth(i,j,k)+ress))

            obcqfluxA = obcqfluxA + bcqflux
            ioqflux(i, j, k) = ioqflux(i, j, k) + bcqflux*dxfi(i) 

           ioq(i,j,k) = ioq(i,j,k) +0.5*(ekh(i,j,k)*dxf(im)+ekh(im,j,k)*dxf(i))*(qcell(i,j,k)-qcell(im,j,k))*dxh2i(i) * dxfi(i) - bcqflux*dxfi(i)

         END DO
      END DO
!!! case 32 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   CASE (32) !wall in xz -> wf in y (=vertical) upper, north wall

      j = ind
      jm = j - 1
      il = block(n, 1)
      iu = block(n, 2)
      kl = block(n, 5)
      ku = block(n, 6)

      DO k = kl, ku
         DO i = il, iu
            
            bcqflux=min(0.,cveg*(qcell(i,j,k)-qwall)*1/(1/icth(i,j,k)+resc)+(1-cveg)*(qcell(i,j,k)-qwall*hurel)*1/(1/icth(i,j,k)+ress))

            obcqfluxA = obcqfluxA + bcqflux
            ioqflux(i, j, k) = ioqflux(i, j, k) + bcqflux*dyi  

            ioq(i, j, k) = ioq(i, j, k) + ( &
                           0.5*(ekh(i, j, k) + ekh(i, jm, k))*(qcell(i, j, k) - qcell(i, jm, k)))*dy2i &
                           -bcqflux*dyi
         END DO
      END DO

!!! case 42 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   CASE (42) !wall in xz -> wf in y (=vertical) lower, south wall

      j = ind
      jp = j + 1
      il = block(n, 1)
      iu = block(n, 2)
      kl = block(n, 5)
      ku = block(n, 6)

      DO k = kl, ku
         DO i = il, iu

            bcqflux=min(0.,cveg*(qcell(i,j,k)-qwall)*1/(1/icth(i,j,k)+resc)+(1-cveg)*(qcell(i,j,k)-qwall*hurel)*1/(1/icth(i,j,k)+ress))

            obcqfluxA = obcqfluxA + bcqflux
            ioqflux(i, j, k) = ioqflux(i, j, k) + bcqflux*dyi 

            ioq(i, j, k) = ioq(i, j, k) - &
                           0.5*(ekh(i, jp, k) + ekh(i, j, k))*(qcell(i, jp, k) - qcell(i, j, k))*dy2i &
                           -bcqflux*dyi
         END DO
      END DO

!!! case 52 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   CASE (52) !wall in xy -> wf in z (=horizontal), top wall

      k = block(n, 6) + 1 !block location
      km = k - 1 !
      il = block(n, 1)
      iu = block(n, 2)
      jl = MAX(block(n, 3) - myid*jmax, 1)
      ju = MIN(block(n, 4) - myid*jmax, jmax)

      delta = dzf(k)*0.5

      DO j = jl, ju
         DO i = il, iu
            bcqflux=min(0.,cveg*(qcell(i,j,k)-qwall)*1/(1/icth(i,j,k)+resc)+(1-cveg)*(qcell(i,j,k)-qwall*hurel)*1/(1/icth(i,j,k)+ress))

            obcqfluxA = obcqfluxA + bcqflux
            ioqflux(i, j, k) = ioqflux(i, j, k) + bcqflux*dzfi(k)

            ioq(i, j, k) = ioq(i, j, k) &
                           + 0.5*(dzf(km)*ekh(i, j, k) + dzf(k)*ekh(i, j, km))*(qcell(i, j, k) - qcell(i, j, km))*dzh2i(k)*dzfi(k) &
                           - bcqflux*dzfi(k)

         END DO
      END DO
END SELECT

END SUBROUTINE wfGR