subroutine heatpump use modglobal, only : lheatpump, lfan_hp, nhppoints, dxi, dyi, dzfi, ltempeq use modfields, only : wm, w0, wp, thlp use modmpi, only : myidx, myidy use decomp_2d, only : zsize implicit none integer :: n, i, j, k if (.not.(lheatpump) .or. .not.(ltempeq) .or. (nhppoints<1)) return do n = 1, nhppoints if (lhpptsrank(n)) then i = idhppts_global(n,1) - myidx*zsize(1) j = idhppts_global(n,2) - myidy*zsize(2) k = idhppts_global(n,3) if (lfan_hp) then ! Heat pump fan is on wm(i,j,k+1) = w_hp_exhaust ! Set exhaust velocity at heat pump point [m/s], at input 'w' cell face k+1 w0(i,j,k+1) = w_hp_exhaust !wp(i,j,k+1) = 0. end if thlp(i,j,k) = thlp(i,j,k) - thl_dot_hp * dxi * dyi * dzfi(k) ! [K/s], at cell center k end if end do end subroutine heatpump