subroutine init_heatpump use modglobal, only : lheatpump, nhppoints, Q_dot_hp, QH_dot_hp, rhoa, cp, ifinput, cexpnr, ltempeq, dxi, dyi use modmpi, only : myid, comm3d, mpierr use decomp_2d, only : zstart, zend implicit none integer :: n character(80) :: chmess if (.not.(lheatpump) .or. .not.(ltempeq) .or. (nhppoints<1)) return allocate(idhppts_global(nhppoints,3)) ! Allocate global heat pump points array allocate(lhpptsrank(nhppoints)) ! Allocate logical array for heat pump points on this rank ! read global heat pump points if(myid==0) then open (ifinput,file='heatpump.inp.'//cexpnr) read (ifinput,'(a80)') chmess read (ifinput,'(a80)') chmess do n = 1, nhppoints read (ifinput,*) idhppts_global(n,1), idhppts_global(n,2), idhppts_global(n,3) end do close (ifinput) end if ! Broadcast the heat pump points to all processes call MPI_BCAST(idhppts_global, nhppoints*3, MPI_INTEGER, 0, comm3d, mpierr) ! Determine whether points are on this rank do n = 1, nhppoints if ((idhppts_global(n,1) >= zstart(1) .and. idhppts_global(n,1) <= zend(1)) .and. & (idhppts_global(n,2) >= zstart(2) .and. idhppts_global(n,2) <= zend(2))) then lhpptsrank(n) = .true. else lhpptsrank(n) = .false. end if end do thl_dot_hp = QH_dot_hp / (nhppoints*rhoa*cp) ! Calculate temperature change rate from heat loss [Km^3/s] w_hp_exhaust = (Q_dot_hp/nhppoints)*dxi*dyi ! Calculate exhaust velocity at heat pump points [m/s] end subroutine init_heatpump