! -------------------------------------------------------- !
      subroutine x_sp_c(nodename,nproc,strt,shft,tids)
! -------------------------------------------------------- !
! Purpose:  This program spawns child process  
! -------------------------------------------------------- !

      implicit none

      include 'fpvm3.h'  
      integer, parameter :: s_len = 30
      integer :: i,clen,len,lmin
      integer :: info
      integer :: nproc
      integer :: nhost
      integer :: narch 
      integer :: numtot, numt
      integer :: strt   ! Starting computer (0=This computer)
      integer :: shft   ! Shift from starting computer (0=Zero shift)
      integer, dimension(32) :: dtid
      integer, dimension(32) :: speed
      integer, dimension(0:32) :: tids
      character(len=s_len) mycomp
      character(len=s_len) nodename
      character(len=s_len) comp
      character(len=s_len) arch(32)
      character(len=s_len) host(32)
      character(len=s_len) prmhost(32)
      external getcompname

      call getcompname(mycomp,s_len)
      len=len_trim(mycomp)
      write(1,*) 'mycomp=',mycomp,' len=',len

      i=1
      do
        call pvmfconfig(nhost,narch,dtid(i),host(i),arch(i),speed(i),info)
        prmhost(i)=host(i)
        write(1,*) 'nhost=',nhost,' host(',i,')=',host(i)
        i=i+1
        if(i.gt.nhost) exit 
      enddo
     
      do i=1,nhost
        comp=host(i)
        clen=len_trim(comp) 
        lmin=min(clen,len)
          if(mycomp(1:lmin).eq.comp(1:lmin)) then
            write(1,*) 'I am host(',i,')=',host(i)
            prmhost=cshift(host,i-1,1)   ! prmhost(1)=This host
            exit
          endif
      enddo
 
      prmhost=cshift(prmhost,strt,1)
      do i=1,nproc
        write(1,*) 'prmhost(1)= ',prmhost(1)
        call pvmfspawn( nodename, PVMHOST, prmhost(1), 1, tids(i-1), numt )
        call cmpshft(prmhost,shft,nhost)
        numtot=numtot+numt
      enddo

! --- Check for problems
      if( numtot .lt. nproc ) then
         write(1,*) 'trouble spawning ',nodename
         write(1,*) ' Check tids for error code'
         call shutdown( numtot, tids )
      endif

      end

! ------------------------------------------------- !
      subroutine shutdown( nproc, tids )
! ------------------------------------------------- !
! Purpose: Kill all tasks I spawned and then myself
! ------------------------------------------------- !
      integer nproc, tids(0:32)

      do i=0, nproc
         call pvmfkill( tids(i), info )
      enddo
      call pvmfexit( info )
      stop
      return
      end
! ------------------------------------------------- !
      subroutine cmpshft(array,ishft,ncomp)
! ------------------------------------------------- !
! Purpose: Shifts list of computers for spawning 
!          new processes
! ------------------------------------------------- !
      implicit none

      integer, parameter :: s_len = 30
      integer ishft,i,j
      integer ncomp
      character(len=s_len) :: aux
      character(len=s_len),dimension(32) :: array

      if(ishft .gt.0) then
        do j=1,ishft
           aux=array(1)
           do i=1,(ncomp-1)
              array(i) = array(i+1)
           enddo
           array(ncomp) = aux
        enddo
      elseif(ishft.lt.0)then
        write(1,*) 'ERROR: x_sp_c ishft < 0'
        stop
      endif
      end

