program master1 c PGPVM the next line may need to be modifed depending on where c this directory is located include '/users/students/general/topol/pvm3/include/fpvm3.h' c --------------------------------------------------------- c PGPVM c Example fortran program illustrating the use of PVM 3 c In this example, we are not interested in communication c to the master node. Hence, he does not call pgftids, c only the slave nodes do. Tracing information will only c be produced for communication among the slave nodes. So c when you run ParaGraph, notice that you will not see sends c to or from the master node. Should you want this, the master node c would also have to call pgftids and make sure his tid is in the c tids array before multicasting the tids array. c c Note that I still have changed the pertinent calls to pgf... c These will default to standard pvm routines if pgftids c is not called. please refer to slave1.f for the part of this c application that calls pgftids. c c Remember, pgfile. will be produced in /tmp on the host of c tid[0], which may not be the same as the host the master is c executing on. Remember that in this application, the master node c does not partake in the visualization and hence is not tid[0] c --------------------------------------------------------- integer i, info, nproc, nhost, msgtype integer mytid, iptid, dtid, tids(0:32) integer who, speed double precision result(32), data(100) character*18 nodename, host character*8 arch c ------------ Starting up all the tasks --------------------------- c Enroll this program in PVM c PGPVM change pvmfmytid to pgfmytid call pgfmytid( mytid ) c Set number of slaves to spawn. c Can't do standard input if master started with spawn so c just set nproc = number of hosts in this case. Else ask for nproc. c PGPVM No need to change this call call pvmfparent( iptid ) if( iptid .gt. 1 ) then c PGPVM No need to change this call call pvmfconfig( nhost, narch, dtid, host, arch, speed, info ) nproc = nhost if( nproc .gt. 32 ) nproc = 32 else print *,'How many slave programs (1-32)?' read *, nproc endif c c Initiate nproc instances of slave1 program c If arch is set to '*' then ANY configured machine is acceptable c IMPORTANT add \0 to character parameters nodename = 'slave1\0' arch = '*\0' print *,'Before startadmin' c call pgfstartadmin('BRAD\0', '*\0', nproc+1) call pgfstartadmin('*\0', '*\0', nproc+1) print *,'After start admin' call pgftids('y\0', info) print *, 'After pgftids info= ',info c PGPVM change this call to pgfspawn call pgfspawn( nodename, PVMDEFAULT, arch, nproc, tids, numt ) print *,'After pgfspawn' c Print out task IDs of spawned tasks and check for problems do 100 i=0, nproc-1 print *,'tid',i,tids(i) 100 continue if( numt .lt. nproc ) then print *, 'trouble spawning ',nodename print *, ' Check tids for error code' call shutdown( numt, tids ) endif c ------- Begin user program -------- n = 10 c Initiate data array do 20 i=1,n data(i) = 1 20 continue c broadcast data to all node programs c PGPVM No need to change these calls call pvmfinitsend( PVMDEFAULT, info ) call pvmfpack( INTEGER4, nproc, 1, 1, info ) call pvmfpack( INTEGER4, tids, nproc, 1, info ) call pvmfpack( INTEGER4, n, 1, 1, info ) call pvmfpack( REAL8, data, n, 1, info ) msgtype = 1 c PGPVM change pvmfmcast to pgfmcast c Note that this node will not produce trace information because c 1) This node did not call pgftids and c 2) This node is not in the tids array c call pgfmcast( nproc, tids, msgtype, info ) c wait for results from nodes msgtype = 2 do 30 i=1,nproc c PGPVM change pvmfrecv to pgfrecv call pgfrecv( -1, msgtype, info ) call pvmfunpack( INTEGER4, who, 1, 1, info ) call pvmfunpack( REAL8, result(who+1), 1, 1, info ) print *, 'I got',result(who+1), ' from', who 30 continue c --------- End user program -------- c program finished leave PVM before exiting c PGPVM change pvmfexit to pgfexit call pgfexit(info) stop end subroutine shutdown( nproc, tids ) integer nproc, tids(*) c c Kill all tasks I spawned and then myself c do 10 i=0, nproc call pvmfkill( tids(i), info ) 10 continue call pgfexit( info ) return end