      program hello_pvm
      IMPLICIT NONE

C 'fpvm3.h' muss im aktuellen Verzeichnis gefunden werden, z.B. nach
C  ln -s $PVM_ROOT/include/fpvm3.h ./

      include 'fpvm3.h'

      CHARACTER*(*) MyName
      PARAMETER (MyName='hello_pvm')
C *** Der Dateiname des ausführbaren Programms kann normalerweise
C     als Argument(0) aus der Kommandozeile bestimmt werden.
C     Darauf wurde hier verzichtet und der Name fest vorgegeben.      

      INTEGER    MAX_Procs
      PARAMETER (MAX_Procs=16)
      CHARACTER HOST*16,ARCH*8,REQARCH*8,KEY*1,ARG1*16

      Integer pvm_tids(0:Max_Procs)
      Integer info,nhost,narch,idtid,ispeed,ICH,NPROC
      Integer my_tid, id_parent, i

      call pvmfmytid ( my_tid )
      if (my_tid .LT. 0) then
        write(*,*) 'no pvmd found -> single process'
C **	stop
C **    oder als single process laufen lassen:
        ICH=0
	NPROC=1
      else	
	call pvmfparent( id_parent )
C Prozessor "0" startet weitere Prozesse:
	if (id_parent .LT. 0) then
          call pvmfconfig(nhost,narch,idtid,HOST,REQARCH,ispeed,info)
	  if (info .GE. 0) then
	    write(*,80) nhost
80          format(1x,I3,' Rechner in PVM vorhanden.')
            NPROC=MAX(4,nhost)   ! oder andere Anzahl gewuenschter Prozesse
            call pvmfsetopt(PvmRoute,PvmRouteDirect,Info)
C **      Prozesse werden hier nach Ermessen von PVM verteilt
            call pvmfspawn(MyName,PVMDEFAULT,'*',NPROC-1,pvm_tids(1),
     +	                   info)
            write(*,90) info,MyName
90          format(1x,I3,' neue Prozesse "',A,'" wurden gestartet.')
C **      (es ginge aber auch individuell)
            NPROC=info+1  ! soviele Prozesse laufen tatsaechlich
            call pvmfinitsend( PVMDEFAULT, info )
            call pvmfpack( INTEGER4, NPROC, 1, 1, info )
            call pvmfpack( INTEGER4, pvm_tids, NPROC, 1, info )
            call pvmfmcast( NPROC-1, pvm_tids(1), 0, info )
          else 
            write(*,*) 'Fehler bei pvmfconfig'
            NPROC=1
          endif    
          ICH=0
C die anderen Prozessoren erhalten Informationen von Proz. 0
	else
          call pvmfrecv( id_parent, 0, info )
          call pvmfunpack( INTEGER4, NPROC, 1, 1, info )
          call pvmfunpack( INTEGER4, pvm_tids, NPROC, 1, info )
          do 10 i=1, NPROC-1
            if( my_tid .eq. pvm_tids(i) ) ICH = i
   10     continue
	endif
      endif 

      write(*,100) ICH, NPROC
100   format('*** Hallo von Prozessor',I3,' aus',I3)
      if (NPROC .GT. 1 .AND. ICH .EQ. 0) write (*,200)
200   format('   (Ausgaben anderer Prozesse - siehe /tmp/pvml.xxx)')
      if (my_tid .ge. 0) call pvmfexit(info)
      end
				   
