dnl $Id$
dnl
dnl Copyright 1989-2016 MINES ParisTech
dnl
dnl This file is part of PIPS.
dnl
dnl PIPS is free software: you can redistribute it and/or modify it
dnl under the terms of the GNU General Public License as published by
dnl the Free Software Foundation, either version 3 of the License, or
dnl any later version.
dnl
dnl PIPS is distributed in the hope that it will be useful, but WITHOUT ANY
dnl WARRANTY; without even the implied warranty of MERCHANTABILITY or
dnl FITNESS FOR A PARTICULAR PURPOSE.
dnl
dnl See the GNU General Public License for more details.
dnl
dnl You should have received a copy of the GNU General Public License
dnl along with PIPS.  If not, see <http://www.gnu.org/licenses/>.
dnl

! communication routines used by the compiler... could abstract both
! pvm and mpi, maybe. The pvm model (separate init/pack/send) is kept.

!
!-----------------
!
! HPFC DIRECTROUTE IF POSSIBLE
!
_direct(`'
      subroutine HPFC DIRECTROUTE IF POSSIBLE
      include "hpfc_commons_pvm.h"
      integer nhost, narch, dtid, speed, info
      character host(50), arch(20)
      call pvmfconfig(nhost, narch, dtid, host, arch, speed, info)
      if (nhost.ge.NB OF TASKS) then
         call pvmfsetopt(PVMROUTE, PVMROUTEDIRECT, info)
      else
         if (HOSTTID.eq.MYTID) write (unit=0,fmt=*)
     $        "Warning: no direct route (not enough processors)..."
      endif
      end
)dnl

!
!-----------------
!
! HPFC PVMLENGTH
!
      integer function HPFC PVMLENGTH(what)
      include "fpvm3.h"
      include "hpfc_specific_pvm.h"
      integer what,pvm_what
      pvm_what = HPFC TYPE PVM(what)
      if (pvm_what.eq.INTEGER4.or.pvm_what.eq.REAL4) then
         HPFC PVMLENGTH=4
         return
      endif
      if (pvm_what.eq.REAL8.or.pvm_what.eq.COMPLEX8) then
         HPFC PVMLENGTH=8
         return
      endif
      if (pvm_what.eq.BYTE1.or.pvm_what.eq.STRING) then
         HPFC PVMLENGTH=1
         return
      endif
      if (pvm_what.eq.INTEGER2) then
         HPFC PVMLENGTH=2
         return
      endif
      if (pvm_what.eq.COMPLEX16) then
         HPFC PVMLENGTH=16
         return
      endif
      write (unit=0,fmt=*) "[HPFC PVMLENGTH] unexpected tag ", what
      stop
      end

!
!-----------------
!
! HPFC INIT MAIN
!
! entry point in the library for a non differentiated host/node program.
! 
      subroutine HPFC INIT MAIN

      include "hpfc_commons_pvm.h"
      _CRAY(integer my rank)
      integer info, inum
      logical host known

      debug(print *, "[HPFC INIT MAIN] in")
!
! GLOBAL INITS
! 
      call HPFC CHECK

      NB OF TASKS = MAX SIZE OF PROCS

      HOST NODE MODEL = .false.
      SPAWN PERFORMED = .false.
      OUTSIDE SPAWN   = .false.

      call HPFC INIT COMMON PARAM LIB

      host known = .false.

      call pvmfmytid(MY TID)
      debug(print *, "[HPFC INIT MAIN] MY TID -", MY TID)

      _getpe(
! the CRAY T3D does not have spawn, but the spawning is automatic!
      call pvmfgetpe(MY TID, my rank)
      debug(print *, "[HPFC INIT MAIN] getting pe ", MY TID, "-", my rank)
! mouais...
      MY TID = my rank
      MY LID = my rank
      SPAWN PERFORMED = .true.
      OUTSIDE SPAWN = .true.
      host known = .true.
      if (my rank.eq.0) then
         MY LID = 0
         HOST TID = MY TID
      end if)
      
      call pvmfjoingroup(HPFC GROUP NAME, inum)
      if (inum.lt.0) then
         call pvmfperror("while joining group in HPFC INIT MAIN", info)
         call pvmfexit(info)
         stop
      end if

      debug(print *, "[HPFC INIT MAIN] group ", HPFC GROUP NAME, inum)

      if (.not. host known) then
! decide which process is the host
         debug(print *, "[HPFC INIT MAIN] choosing host")
         if (inum.eq.0) then
            MY LID = 0
            HOST TID = MY TID
         else
! the host is not know, but i am its child!
            SPAWN PERFORMED = .true.
            call pvmfparent(HOST TID)
         end if
         host known = .true.
      end if
 
      _spawn(
      if (.not. SPAWN PERFORMED) then
         debug(print *, "spawning ", NB OF TASKS, " ", MAIN PROGRAM NAME)
         call pvmfspawn(
     $        MAIN PROGRAM NAME,
     $        PVM ARCH,
     $        NODE ARCHITECTURE,
     $        NB OF TASKS,
     $        NODE TIDS(1),
     $        info)

! may think of an external spawning?
         SPAWN PERFORMED = .true.
         
      end if)

      debug(print *, "[HPFC INIT MAIN] exiting")

      end


! 
!-----------------
!
! HPFC INIT HOST NODE  (probably useless) 
!
      subroutine HPFC INIT HOST NODE
      include "hpfc_commons.h"

      integer  inum

      call HPFC CHECK

      HOST NODE MODEL = .true.
      SPAWN PERFORMED = .false.
      OUTSIDE SPAWN = .false.
      
      NB OF TASKS = MAX SIZE OF PROCS

      call HPFC INIT COMMON PARAM LIB

      call pvmfmytid(MY TID)

!
! done before the spawn so host is (group, 0)
!
      call pvmfjoingroup(inum)

      if (inum.ne.0) then
         SPAWN PERFORMED = .true.
      endif
      end

!
!-----------------
!
! HPFC INIT NODE
!
! this is the entry point in the hpfc runtime library for a node.
!
      subroutine HPFC INIT NODE
      _CM5(include "cmmd_fort.h")
      include "hpfc_commons_pvm.h"
      integer i, bufid, info

      HOST LID = 0

      debug(print *, "[HPFC INIT NODE] in ")

! in order to get the host tid 
      if (.not.OUTSIDE SPAWN) then
         call pvmfparent(HOST TID)
      end if

      _direct(call HPFC DIRECTROUTE IF POSSIBLE)

      call HPFC INIT COMMON PROCS
      call HPFC INIT COMMON BUFFER
      call HPFC INIT SPECIFIC COMMONS

! receive from host global informations about the nodes implicated
! in this run.
      _spawn(
! Should be a call to HPFC BCAST RECV, but NODETIDS is not yet available 
!     call HPFC BCAST RECV(HOST LID, 1)
      call pvmfrecv(HOSTTID, 1, bufid)
      call HPFC UNPACK(HPFC INTEGER4, NODE TIDS, NB OF TASKS + 1,
     $     1, info)
      debug(if (info.lt.0) then
         call HPFC PRINT ERROR MSG("[HPFC INIT NODE] node tids recv",
     $     info)
         call HPFC TERMINATE TASK(info)
         stop
      endif)
      
      debug(print *,"[HPFC INIT NODE] MYTID is", MYTID) 
      do i=1, NB OF TASKS
         debug(print *,"[HPFC INIT NODE] NODETIDS(",i,") =",NODE TIDS(i))
         if (NODE TIDS(i).EQ.MYTID) then
          MYLID = i
          debug(print *, "[HPFC INIT NODE] MYLID is", MYLID)
         endif
      enddo)

      _getpe(
      do i=0, NB OF TASKS
         NODE TIDS(i) = i
      enddo)

      debug(print *, "[HPFC INIT NODE] lid: ", MY LID, " tid: ", MYTID)

      do i=1, NB OF PROCESSORS
         call HPFC CMPPOS(i, MY LID, MY POS(1, i))
      enddo

!
! 1 sends node version key to host
!
      if (MY LID.eq.1) then
      debug(print *, "[HPFC INIT NODE] sending key to ", HOSTLID)
         call HPFC INIT SEND(DATARAW ENCODING, BUFFER ID(1))
         call HPFC PACK(HPFC STRING, hpfc key, 64, 1, info)
         call HPFC SEND(HOSTLID, 1, info)
      endif

_CM5(
!
! cm5 related id initializations
!
      CM HOST ID = cmmd_host_node()
      CM MY ID   = cmmd_self_address()
      CM SIZE    = cmmd_partition_size()
!
      call HPFC INIT SEND(DATARAW ENCODING, BUFFER ID(1))
      call HPFC PACK(HPFC INTEGER4, CM MY ID, 1, 1, info)
      call HPFC SEND(HOSTLID, 1, info)
!
      call HPFC RECEIVE(HOSTLID, 1)
      call HPFC UNPACK(HPFC INTEGER4, CM NODE IDS, NBOFTASKS, 1, info)
!
! end of cm5 related initializations
!)

!
! insures that all nodes joined the group and are there
!
      call HPFC SYNCHRO

      debug(print *, "[HPFC INIT NODE] out", MY LID)

      end


!
!-----------------
!
! HPFC INIT HOST
!
! this is the entry point in the hpfc runtime library for a program.
!
      subroutine HPFC INIT HOST
      _CM5(include "cmmd_fort.h")
      include "hpfc_commons_pvm.h"
      integer info
      character*64 node key
      
      debug(print *, "[HPFC INIT HOST] in ")
      
      MYLID = 0
      HOSTLID = 0
      
      _direct(call HPFC DIRECTROUTE IF POSSIBLE)

      _spawn(
      if (.not. SPAWN PERFORMED) then
       debug(`print *,"[HPFCINITHOST] spawning",NB OF TASKS," ", 
     $ NODE PROGRAM NAME')

       call pvmfspawn(
     $      NODE PROGRAM NAME, 
     $      PVM ARCH, 
     $      NODE ARCHITECTURE, 
     $      NB OF TASKS, 
     $      NODE TIDS(1), 
     $      info)

         if (info.lt.0) then
            call HPFC PRINT ERROR MSG("initial spawning", info)
            call HPFC TERMINATE TASK(info)
            stop
         endif

         if (info.ne.NBOFTASKS) then
            call HPFC PRINT ERROR MSG("not spawned", 0)
            call HPFC TERMINATE TASK(0)
            stop
         endif

        endif)

        debug(`
        do i = 1, NB OF TASKS 
           print *,"[HPFC INIT HOST] NODE TIDS(", i, ") =", NODE TIDS(i) 
        enddo')

      _getpe(
! rather specific to CRAY T3D
      debug(print *, "[HPFC INIT HOST] initializing NODE TIDS")
      do i=0, NB OF TASKS
         NODE TIDS(i)=i
      end do)
      
      _spawn(
! if not T3D and not MPI, the host sends the tids...
      NODETIDS(0) = MY TID
      call HPFC INIT SEND(DATARAW ENCODING, BUFFER ID(1))
      call HPFC PACK(HPFC INTEGER4, NODETIDS, NBOFTASKS + 1, 1, info)
      debug(if (info.lt.0) then
         call HPFC PRINT ERROR MSG("initial pack", info)
         call HPFC TERMINATE TASK(info)
         stop
      endif)
      call HPFC BCAST ROOT(NBOFTASKS, NODETIDS(1), 1, info)
      debug(if (info.lt.0) then
         call HPFC PRINT ERROR MSG("initial mcast", info)
         call HPFC TERMINATE TASK(info)
         stop
      endif))

      call HPFC INIT COMMON PROCS
      call HPFC INIT COMMON BUFFER
      call HPFC INIT SPECIFIC COMMONS

!
! check version of host and node
! to insure that both host and node where generated together...
!
      debug(print *, "[HPFC INIT HOST] receiving key")
      call HPFC RECEIVE(1, 1)
      call HPFC UNPACK(HPFC STRING, node key, 64, 1, info)
      if (node key.ne.hpfc key) then
         print *, "*** incompatible version keys!"
         print *, "*** host: ", hpfc key
         print *, "*** node: ", node key
         call HPFC KILL ALLTASKS
!the following line should be deleted ??          
         call HPFC TERMINATE TASK(info)
         stop
      endif

_CM5(
!
! cm5 related id initializations
!
      CM HOST ID = cmmd_self_address()
      CM MY ID   = CM HOST ID
      CM SIZE    = cmmd_partition_size()
!
      do i=1, NBOFTASKS
         call HPFC RECEIVE(i, 1)
         call HPFC UNPACK(HPFC INTEGER4, CM NODE IDS(i), 1, 1, info)
      enddo
!
      call HPFC INIT SEND(DATARAW ENCODING, BUFFER ID(1))
      call HPFC PACK(HPFC INTEGER4, CM NODE IDS, NBOFTASKS, 1, info)
      call HPFC BCAST ROOT(NBOFTASKS, NODETIDS(1), 1, info)
!
! end of cm5 related initializations
!)

      demo(
      call print host info
      if (HOST NODE MODEL) then 
         write (unit=0,fmt=*) " -- host node model"
      else
         write (unit=0,fmt=*) " -- single main program"
      end if
      call print task info(NBOFTASKS, NODETIDS(1), HOSTTID))

!
! insures that all nodes joined the group...
!
      call HPFC SYNCHRO

      debug(print *, "[HPFC INIT HOST] out ", MY LID)

      end



!
! HPFC INIT PVM COMMONS 
!
      subroutine HPFC INIT SPECIFIC COMMONS 
      include "hpfc_commons_pvm.h"
      data HPFC BUFFER ENCODING /PVMDATARAW,_HPFC_ENCODING_/

      data HPFC TYPE PVM /INTEGER2,INTEGER4,REAL4,REAL8,STRING,
     $     BYTE1, COMPLEX8, COMPLEX16/

      end



!
! Reduce operation 
!
!!!!! root has not the same signification in mpi and pvm
! in pvm : Integer instance number of group member who gets the result
!


      subroutine HPFC REDUCTION(func, data, count, datatype, msgtag
     $     ,root, info)
      include "hpfc_commons_pvm.h"
      integer count, datatype, msgtag, root, info, func, data
      external PvmMin, PvmMax, PvmSum, PvmProduct

      debug(`print *, MYLID, "[HPFC REDUCTION] in - func :", func, 
     $     "count :", count, "type :", datatype, "root :", root')
      if (func.eq.HPFC SUM) then 
       call pvmfreduce(PvmSum, data, count, HPFC TYPE PVM(datatype)
     $      , msgtag, HPFCGROUPNAME, root, info) 
      else 
       if (func.eq.HPFC PROD) then
        call pvmfreduce(PvmProduct, data, count, HPFC TYPE PVM
     $       (datatype), msgtag, HPFCGROUPNAME, root, info) 
       else 
        if (func.eq.HPFC MAX) then
         call pvmfreduce(PvmMax, data, count, HPFC TYPE PVM
     $        (datatype), msgtag, HPFCGROUPNAME, root, info) 
        else 
         if (func.eq.HPFC MIN) then
          call pvmfreduce(PvmMin, data, count, HPFC TYPE PVM
     $         (datatype), msgtag, HPFCGROUPNAME, root, info) 
         else
          print *,"Invalid reduction function"
          call HPFC KILL ALLTASKS
         endif
        endif
       endif
      endif
      

      end




!--------------------  HPFC MESSAGE INFO -----------------
!
! Give informations about the received message (or buffer) 
! (length, tag, source, info) 
!
      subroutine HPFC MESSAGE INFO(length, tag, source, info)
      include "hpfc_commons_pvm.h"
      integer length, tag, source, info
      call pvmfbufinfo(BUFFER ID(1), length, tag, source, info)
      debug(`print *, MYLID, "HPFC MESSAGE INFO ", info, " length = ", 
     $  length, " tag = ", tag , " source = ", source ')
      if (info.lt.0) then
         call pvmfperror("hpfc message info", info)
         call HPFC TERMINATE TASK(info)
         stop
      endif
      end 


!--------------------  HPFC PRINT ERROR MSG  -----------------
!
! Return an error string associated with the error code 
! plus additional information to the error message 
!
! MPI_ERROR_STRING(integer errorcode,charcter string(*),
!                     integer resultlen,integer ierror)
!
      subroutine HPFC PRINT ERROR MSG(message, error code)
      include "hpfc_commons_pvm.h"
      integer error code
      character*(*) message
      call pvmfperror(message, error code)
      end

!-------------------- HPFC TERMINATE TASK   -----------------
!
! Terminate the current task 
!
! MPI_FINALIZE(integer ierror)
!
      subroutine HPFC TERMINATE TASK
      include "hpfc_commons_pvm.h"
      integer info
      debug(print *, MYLID , "hpfc terminate task")
      call pvmfexit(info)
      end

!--------------------  HPFC KILL ALLTASKS  -----------------
!
! Kill all the tasks
!
! MPI_ABORT(integer comm,integer errorcode,integer ierror)
!
      subroutine HPFC KILL ALLTASKS
      include "hpfc_commons_pvm.h"
      integer info,i
      do i=1, NBOFTASKS
         call pvmfkill(NODETIDS(i), info)
      enddo
      end

!-------------------- HPFC SYNCHRO  -----------------
!
! add a synchronisation step 
!
!
      subroutine HPFC SYNCHRO
      include "hpfc_commons_pvm.h"
      integer info
      debug(print *, MYLID, "[hpfc synchro] waiting ", NBOFTASKS+1, "tasks")
      call pvmfbarrier(HPFC GROUP NAME, NBOFTASKS+1, info)
      if (info.lt.0) then
         call pvmfperror("hpfc synchro", info)
         call HPFC TERMINATE TASK(info)
         stop
      endif
      debug(print *, MYLID, "[hpfc synchro] done")
      end



!-------------------- HPFC INIT SEND  -----------------
!
! Initialize the current buffer
!
!
      subroutine HPFC INIT SEND(encoding,bufid)
      include "hpfc_commons_pvm.h"
      integer bufid,encoding
      debug(`print *, MYLID, "[HPFC INIT SEND] in - encoding : " , 
     $     encoding, "bufid : ", bufid')
      call pvmfinitsend(HPFC BUFFER ENCODING(encoding), bufid)
      debug(print *, MYLID, "[HPFC INIT SEND] buffer initialized")
      end 

!-------------------- HPFC PACK  -----------------
!
! Packing count value in the current buffer...
!
!
      subroutine HPFC PACK(what, value, count, stride, info) 
      include "hpfc_commons_pvm.h"
      integer what, value, count, stride, info
      debug(print *, MYLID, "[HPFC PACK] count values", count)
      call pvmfpack(HPFC TYPE PVM(what), value, count, stride, info)
      debug(print *, MYLID, "[HPFC PACK] done")
      end

!-------------------- HPFC SEND  -----------------
!
! Sending the current buffer to dest...
!
!
      subroutine HPFC SEND(dest, tag, info)
      include "hpfc_commons_pvm.h"
      integer dest, tag, info
      debug(print *, MYLID, "[HPFC SEND] sending message to - ", dest)
      call pvmfsend(NODE TIDS(dest), tag, info)
      debug(print *, MYLID, "[HPFC SEND] done to - ", dest )
      end

!-------------------- HPFC UNPACK  -----------------
!
! Unpacking count value from the current buffer
!
!
      subroutine HPFC UNPACK(what, value, count, stride, info) 
      include "hpfc_commons_pvm.h"
      integer what, value, count, stride, info
      debug(`print *, MYLID, "[HPFC UNPACK] count values", count, 
     $     "type", what')
      call pvmfunpack(HPFC TYPE PVM(what), value, count, stride, info)
      debug(print *, MYLID, "[HPFC UNPACK] done - info :", info)
      end

!--------------------  HPFC RECEIVE -----------------
!
! Receiving a message from source
!
!

      subroutine HPFC RECEIVE(source, tag)
      include "hpfc_commons_pvm.h"
      integer source, tag, bufid
      debug(`print *, MYLID, "[HPFC RECEIVE] message from - ", source 
     $     ,"tag : ", tag ')
      call pvmfrecv(NODE TIDS(source), tag, bufid)
      debug(print *, MYLID, "[HPFC RECEIVE] bufid is - ", bufid)
      BUFFER ID(1) = bufid
      debug(print *, MYLID, "[HPFC RECEIVE] done from - ", source)
      end

!-------------------- HPFC BCAST ROOT  -----------------
!
! Root initiate a broadcast communication 
!
! MPI_BCAST (choice buffer,integer count,integer datatype,integer root,
!              integer comm,integer ierror)

      subroutine HPFC BCAST ROOT(ntask, listoftids, tag, info )
      include "hpfc_commons_pvm.h"
      integer ntask, tag, info
      integer listoftids(MAX MAX SIZE OF PROCS)
      debug(print *, MY LID, "broadcast a message (root)")
      call pvmfmcast(ntask, listoftids, tag, info)
      debug(print *, MY LID, "broadcast performed (root)")
      end

!-------------------- HPFC BCAST RECV  -----------------
!
! Receive from a broadcast communication 
!
! MPI_BCAST 
      subroutine HPFC BCAST RECV(source, tag)
      include "hpfc_commons_pvm.h"
      integer source, tag, bufid
      debug(print *, MYLID, "Receive broadcast from", source)
      call pvmfrecv(NODETIDS(source), tag, bufid)
      BUFFER ID(1) = bufid
      debug(print *, MYLID, "Receive broadcast performed from", source )
      end

!
!-------------------- HPFC HCAST  -----------------
! The host send a message to every node.
!
      subroutine HPFC HCAST
      include "hpfc_commons.h"
      integer info
      debug(print *,"[HPFC HCAST] in")
      call HPFC BCAST ROOT(NBOFTASKS, NODETIDS(1), MCASTHOST, info) 
      MCAST HOST = MCAST HOST + 2
      debug(print *,"[HPFC HCAST] done")
      end


!
!-------------------- HPFC NCAST  -----------------
!
! a node sends a message to host
!

      subroutine HPFC NCAST
      include "hpfc_commons.h"
      debug(print *,"[HPFC NCAST] in")
      call HPFC BCAST RECV(HOSTLID, MCASTHOST) 
      MCAST HOST = MCAST HOST + 2
      debug(print *,"[HPFC NCAST] done")
      end

!
!-----------------
!
! HPFC NSNDTO A
!
! One node send to all nodes (broadcast communication)
!
      subroutine HPFC NSNDTO A(what, val)
      integer what, val
      include "hpfc_commons.h"
      integer bufid, info
      call HPFC INIT SEND(DATARAW ENCODING, bufid)
      call HPFC PACK(what, val, 1, 1, info)
      if (MYLID.GT.1)
     $     call HPFC BCAST ROOT(
     $     MYLID-1, 
     $     NODETIDS(1), 
     $     MCASTNODES, 
     $     info)
      if (MYLID.LT.NBOFTASKS)
     $     call HPFC BCAST ROOT(
     $     NBOFTASKS-MYLID, 
     $     NODETIDS(MYLID+1), 
     $     MCASTNODES, 
     $     info)
      MCASTNODES = MCASTNODES + 2
      end

!-----------------
!
! HPFC HSNDTO A
!
! host send to all nodes (broadcast communication)
!
      subroutine HPFC HSNDTO A(what, val)
      integer what, val
      include "hpfc_commons.h"
      integer bufid, info
      debug(print *, "sending to all nodes")
      call HPFC INIT SEND(DATARAW ENCODING, bufid)
      call HPFC PACK(what, val, 1, 1, info)
      call HPFC BCAST ROOT(NBOFTASKS, NODETIDS(1), MCASTHOST, info)
      MCASTHOST = MCASTHOST + 2
      debug(print *, "sent!")
      end
!
!-----------------
!
! HPFC NSNDTO HA
!
! One node send to host and all nodes (broadcast communication)
!
!
      subroutine HPFC NSNDTO HA(what, val)
      integer what, val
      include "hpfc_commons.h"
      integer bufid, info
      call HPFC INIT SEND(DATARAW ENCODING, bufid)
      call HPFC PACK(what, val, 1, 1, info)
      if (MYLID.GT.1)
     $     call HPFC BCAST ROOT(
     $     MYLID-1, 
     $     NODETIDS(1), 
     $     MCASTNODES, 
     $     info)
      if (MYLID.LT.NBOFTASKS)
     $     call HPFC BCAST ROOT(
     $     NBOFTASKS-MYLID, 
     $     NODETIDS(MYLID+1), 
     $     MCASTNODES, 
     $     info)
      MCASTNODES = MCASTNODES + 2
      call HPFC SEND(HOSTLID, HOST SND CHANNEL, info)
      HOST SND CHANNEL = HOST SND CHANNEL + 2
      end

!
!-----------------
!
! HPFC RCVFR NBCAST S
!
! Receive from a BROADCAST between nodes
! root is SENDERLID, comm is HPFC NODES
!
      subroutine HPFC RCVFR NBCAST S(what, goal)
      integer what, goal
      include "hpfc_commons.h"
      integer info
      call HPFC BCAST RECV(SENDERLID, MCASTNODES)
      call HPFC UNPACK(what, goal, 1, 1, info)
      MCASTNODES = MCASTNODES + 2
      end

!
!-----------------
!
! HPFC RCVFR HNBCAST S
!
! Receive from a broadcast between nodes and host
! root is SENDERLID, comm is HPFC COMMUNICATOR
!
      subroutine HPFC RCVFR HNBCAST S(what, goal)
      integer what, goal
      include "hpfc_commons.h"
      integer info
      call HPFC BCAST RECV(SENDERLID, MCASTNODES)
      call HPFC UNPACK(what, goal, 1, 1, info)
      MCASTNODES = MCASTNODES + 2
      end
!
!-----------------
!
! HPFC RCVFR HNBCAST H
!
! Receive from a broadcast between nodes and host
! root is HOSTLID, comm is HPFC COMMUNICATOR
!
      subroutine HPFC RCVFR HNBCAST H(what, goal)
      integer what, goal
      include "hpfc_commons.h"
      integer info
      debug(print *, "receiving from host")
      call HPFC BCAST RECV(HOSTLID, MCASTHOST)
      call HPFC UNPACK(what, goal, 1, 1, info)
      MCASTHOST = MCASTHOST + 2
      debug(print *, "received!")
      end