#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: README args.h assign.h blkjac.f d_and_c.f data data.blkjac
# data.ts_dynamic defs.h example.f ftsubs.F indx0.h indxj.h make1
# makefile newsched.h oldtest putq.c second.f stuffspawn.f testrun
# ts_dynamic.f
# Wrapped by manchek@fred on Wed Aug 8 15:08:48 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(7037 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
X======== Schedule for the Sun (note Sun-4 changes below) ========
X
XThis package contains an enhanced version of the SCHEDULE Parallel
XProgramming Package for the Sun workstation.
XBy way of reusable or recycling queues, applications
Xwith the new ftsubs.f are now limited to 1000 active job processes,
Xrather than a 1000 cumulative job processes (see the new version of
Xthe demonstration program ts_dynamic.f that illustrates the use of
Xthe new SCHEDULE subroutine GETTAG and see the description below;
Xi.e. jobtags are now assigned by SCHEDULE instead of the user).
X
XThis new version of ftsubs.f now also permits iterations of static
Xdependency graphs (see the example blkjac.f that illustrates the
Xuse of the new SCHEDULE subroutines RESET and RSCHED).
X
XThe new putq.c requires "include" files: maxparms.h, indx0.h and indxj.h
X(these may be easily changed from 20 to 60 parameters to allow an
Xincreased number of parameters in the calls to sched, putq and spawn;
XCAUTION: there is usually more overhead in subroutine argument passing
Xthan common argument passing, so rely more on common unless the job is
Xbig enough to underwrite the extra overhead or subroutine arguments
Xcan not be avoided).
X
XThis revised version of SCHEDULE is currently only available on the
XAlliant, Balance, Symmetry, and Sun.
X
X*******************************************************************************
XREAD THIS PART!!!
XCAUTION: The first two arguments of NXTAG and SPAWN are now
Xreversed from older versions to make them consistent with the
Xstatic dependency subroutines DEP and PUTQ.
X*******************************************************************************
X
XCaution: Calls to SCHED, PUTQ and SPAWN, should include at
Xleast one parameter in the argument list.
X
XTo build the libraries, type:
X
X"make sched" or "make graph"
X
X make sched will produce the schedule library in file sched.a .
X This is the standard libarary for schedule. All examples
X begining with 'x' use this library.
X
X make graph will produce the trace version of schedule in file graph.a .
X This version produces output which can be viewed using the
X Schedule Trace Facility. All examples begining with 'g' use
X this library.
X
XTo run the examples type:
X
X"make xtest; xtest" or "make gtest; gtest"
X
X This will make and run a test program which solves a triangular
X system of equations using the spawning capabilities of schedule.
X
X"make xdandc; xdandc" or "make gdandc; gdandc"
X
X This will make and run a test program which implements a recursive
X divide and conquer technique using the spawning capabilities of schedule.
X The output from gdandc will not work with the current trace facility
X because spawned processes also spawn other processes and the trace
X facility does not yet support more than one level of spawning.
X
X"make xexample; xexample" or "make gexample; gexample"
X
X This will make and run a test program which computes the
X inner product of two vectors.
X
X"make xts_tsdynamic; xts_dynamic" or "make gts_tsdynamic; gts_dynamic"
X
X This will make and run an example program illustrating use of the
X new SCHEDULE package with the triangular stuffer demonstration program;
X note especially the new subroutine GETTAG that gets a SCHEDULE generated
X job for each of the user's processes; note that the arguments of NXTAG
X and SPAWN have been reordered to be more like that of DEP and PUTQ.
X The input to ts_dynamic the form:
X [n_processors] [n_array_size] [n_work_iterations].
X There is a sample input file in data.ts_dynamic.
X
X"make xblkjac; xblkjac" or "make gblkjac; gblkjac"
X
X This will make and run asample FORTRAN static iteration driver
X for ftsubs.f with block Jacobi iteration of a variable coefficient EPDE;
X The input has the form:
X [n_processors] [n_x_size] [n_y_size] [n_x_blocks]
X [n_y_blocks] [max_iterations] [n_result_precision].
X There is a sample input file in data.blkjac.
X Up to 10 X 10 blocks are permitted. The new SCHEDULE subroutine RSET
X marks processes that will take part in an iteration. Another new
X SCHEDULE subroutine RSCHED restores only those parameters, such as
X ICANGO, that have changed; NSLOTS have been increased to 105 to permit
X at most 10 X 10 block iterations.
X
XA complete make and test can be carried out by doing:
X
Xtestrun >& testout
Xdiff oldtest testout
X
X
X======== Sun-4 Changes ========
X
X SCHEDULE package for Sun Sparcstation 1
X
XThis version of SCHEDULE has been tested on the Sparcstation 1. The
Xdifferences between this version and the one for other Sun workstations
Xhave to do with passing fortran arguments through argument lists into
Xc structures; these differences are located in putq.c.
X
XThis version contains two other improvements. The first allows more
Xthan 20 arguments to be passed through SCHEDULE to paralg. This limit
Xcan optionally be increased to 99.
X
XThe second improvement is the option to have SCHEDULE use only one ready
Xqueue instead of nprocs ready sub-queues. In this version, an extra
Xargument, cost, is included on the end of the argument lists to 'dep' and
X'nxtag'. This version sorts the single ready queue in order of decreasing
Xcost. The sort is performed in the function addrq, and can be modified
Xto represent any desirable queueing function. This has the effect of
Xmodifying the scheduling discipline; the discipline used now in addrq is
Xa longest-processing-time first (LPT) algorithm, where the expected
Xprocessing time is passed in as the cost parameter.
X
XNote that whether a single or multiple ready queue is more desirable
Xdepends on the problem using the SCHEDULE package. If all the task
Xexecution times are expected to be the same, it is more desirable to use
Xthe multiple ready queue, which decreases lock contention at the head and tail
Xof the ready queue. A good example of this would be parallel execution of DO
Xloops. However, for tasks with varying execution times, a random scheduling
Xalgorithm (which is in effect the algorithm used by the multiple ready queue
Xapproach) will not be optimum.
X
XThe default is to use multiple ready sub-queues, since this was the original
Xapproach. To change this, you must edit make1 and add 'SINGLERQ' to the
X'CPPFLAGS = ' line; that is, the line becomes
X
XCPPFLAGS = SINGLERQ
X
Xand all other 'CPPFLAGS = ' lines are commented out (# sign in first column).
X
XTo enable using more arguments, add 'MOREPARMS' to the CPPFLAGS line. The
Xdefault is to allow only 20 arguments, since performance degrades slightly
Xfor more parameters. MOREPARMS and SINGLERQ can be used together by adding
Xthem both, separated by a space, to the CPPFLAGS line.
X
XFinally, the graph portion of the new SCHEDULE package for the Sparcstation has
Xnot been tested and may not be correct.
X
X
XTimothy J. Tautges tautges@neep.engr.wisc.edu
XDept. of Nuclear Engin. & Engin. Physics
XUniversity of Wisconsin - Madison
X3/21/90
X
END_OF_FILE
if test 7037 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'args.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'args.h'\"
else
echo shar: Extracting \"'args.h'\" \(655 characters\)
sed "s/^X//" >'args.h' <<'END_OF_FILE'
X#ifndef MOREPARMS
X arg11,arg12,arg13,arg14,arg15,arg16,arg17,arg18,arg19,arg20)
X#else
X arg11,arg12,arg13,arg14,arg15,arg16,arg17,arg18,arg19,arg20,
X arg21,arg22,arg23,arg24,arg25,arg26,arg27,arg28,arg29,arg30,
X arg31,arg32,arg33,arg34,arg35,arg36,arg37,arg38,arg39,arg40,
X arg41,arg42,arg43,arg44,arg45,arg46,arg47,arg48,arg49,arg50,
X arg51,arg52,arg53,arg54,arg55,arg56,arg57,arg58,arg59,arg60,
X arg61,arg62,arg63,arg64,arg65,arg66,arg67,arg68,arg69,arg70,
X arg71,arg72,arg73,arg74,arg75,arg76,arg77,arg78,arg79,arg80,
X arg81,arg82,arg83,arg84,arg85,arg86,arg87,arg88,arg89,arg90,
X arg91,arg92,arg93,arg94,arg95,arg96,arg97,arg98,arg99)
X#endif
END_OF_FILE
if test 655 -ne `wc -c <'args.h'`; then
echo shar: \"'args.h'\" unpacked with wrong size!
fi
# end of 'args.h'
fi
if test -f 'assign.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'assign.h'\"
else
echo shar: Extracting \"'assign.h'\" \(2767 characters\)
sed "s/^X//" >'assign.h' <<'END_OF_FILE'
X parms.subname = arg0; parms.parms[0] = arg1; parms.parms[1] = arg2;
X parms.parms[2] = arg3; parms.parms[3] = arg4; parms.parms[4] = arg5;
X parms.parms[5] = arg6; parms.parms[6] = arg7; parms.parms[7] = arg8;
X parms.parms[8] = arg9; parms.parms[9] = arg10; parms.parms[10] = arg11;
X parms.parms[11] = arg12; parms.parms[12] = arg13; parms.parms[13] = arg14;
X parms.parms[14] = arg15; parms.parms[15] = arg16; parms.parms[16] = arg17;
X parms.parms[17] = arg18; parms.parms[18] = arg19; parms.parms[19] = arg20;
X#ifdef MOREPARMS
X parms.parms[20] = arg21; parms.parms[21] = arg22; parms.parms[22] = arg23;
X parms.parms[23] = arg24; parms.parms[24] = arg25; parms.parms[25] = arg26;
X parms.parms[26] = arg27; parms.parms[27] = arg28; parms.parms[28] = arg29;
X parms.parms[29] = arg30; parms.parms[30] = arg31; parms.parms[31] = arg32;
X parms.parms[32] = arg33; parms.parms[33] = arg34; parms.parms[34] = arg35;
X parms.parms[35] = arg36; parms.parms[36] = arg37; parms.parms[37] = arg38;
X parms.parms[38] = arg39; parms.parms[39] = arg40; parms.parms[40] = arg41;
X parms.parms[41] = arg42; parms.parms[42] = arg43; parms.parms[43] = arg44;
X parms.parms[44] = arg45; parms.parms[45] = arg46; parms.parms[46] = arg47;
X parms.parms[47] = arg48; parms.parms[48] = arg49; parms.parms[49] = arg50;
X parms.parms[50] = arg51; parms.parms[51] = arg52; parms.parms[52] = arg53;
X parms.parms[53] = arg54; parms.parms[54] = arg55; parms.parms[55] = arg56;
X parms.parms[56] = arg57; parms.parms[57] = arg58; parms.parms[58] = arg59;
X parms.parms[59] = arg60; parms.parms[60] = arg61; parms.parms[61] = arg62;
X parms.parms[62] = arg63; parms.parms[63] = arg64; parms.parms[64] = arg65;
X parms.parms[65] = arg66; parms.parms[66] = arg67; parms.parms[67] = arg68;
X parms.parms[68] = arg69; parms.parms[69] = arg70; parms.parms[70] = arg71;
X parms.parms[71] = arg72; parms.parms[72] = arg73; parms.parms[73] = arg74;
X parms.parms[74] = arg75; parms.parms[75] = arg76; parms.parms[76] = arg77;
X parms.parms[77] = arg78; parms.parms[78] = arg79; parms.parms[79] = arg80;
X parms.parms[80] = arg81; parms.parms[81] = arg82; parms.parms[82] = arg83;
X parms.parms[83] = arg84; parms.parms[84] = arg85; parms.parms[85] = arg86;
X parms.parms[86] = arg87; parms.parms[87] = arg88; parms.parms[88] = arg89;
X parms.parms[89] = arg90; parms.parms[90] = arg91; parms.parms[91] = arg92;
X parms.parms[92] = arg93; parms.parms[93] = arg94; parms.parms[94] = arg95;
X parms.parms[95] = arg96; parms.parms[96] = arg97; parms.parms[97] = arg98;
X parms.parms[98] = arg99;
X#endif
END_OF_FILE
if test 2767 -ne `wc -c <'assign.h'`; then
echo shar: \"'assign.h'\" unpacked with wrong size!
fi
# end of 'assign.h'
fi
if test -f 'blkjac.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'blkjac.f'\"
else
echo shar: Extracting \"'blkjac.f'\" \(11598 characters\)
sed "s/^X//" >'blkjac.f' <<'END_OF_FILE'
X program blkjac
Xc
XCode Name: blkjac.f (STATIC VERSION)
XCode Data Input: [n_processors] [n_x_size] [n_y_size] [n_x_blocks] [n_y_blocks]
XContinued Input (single line assumed): [max_iterations] [n_result_precision]
XChange: Block Jacobi test for SCHEDULE rsched to restore STATIC & DYNAMIC
Xcont: dependency graph for the next iteration.
X implicit real*8 (a-h,o-z)
X parameter(mdim=102, ndim=102, maxblk=11, maxprc=8)
X parameter(xmax1=100.d0,ymax1=100.d0,tol1=0.5d-4)
X parameter(nmyck=10*maxblk)
X parameter(mxprcs = 1000)
X integer itmp(maxblk),jtmp(maxblk),mychkn(nmyck),statag(mdim,ndim)
X integer itag(mxprcs)
X real t1,t2,t3,tt,second,foo
X real*8 u(mdim,ndim),v(mdim,ndim)
X common /comint/ m,n,mb,nb,mbpts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
XCaution: common block CONWRT is used in SCHEDULE for concurrent prints.
X COMMON /CONWRT/ WRLOCK
X EXTERNAL PARALG
X read(5,*) nprocs,m,n,mb,nb,mxiter,nprec
X write(6,6666) nprocs,m,n,mb,nb,mxiter,nprec
X6666 format(' Static Block Jacobi Input:'
X & /3x,'nprocs =',i3,'; (m,n) = (',i4,',',i4
X & ,'); (mblks,nblks) = (',i3,',',i3
X & ,')'/3x,'; max iterations =',i6,'; nprec =',i3)
X mbpts = m/mb
X nbpts = n/nb
X tol = 0.5d0/10**nprec
X write(6,6667) mdim,ndim,maxblk,maxprc,nmyck,mbpts,nbpts
X & ,xmax1,ymax1,nprec,tol
X6667 format(' Parameter input:'/3x,'(mdim,ndim) = (',i4,',',i4
X & ,'); maxblkdim = ',i4
X & /3x,'; maxprc =',i3,'; nmychk =',i6,'; (mbpts,nbpts) = ('
X & ,i4,',',i4,')'
X & /3x,' (xmax,ymax) = (',f7.2,',',f7.2,'); nprec =',i2
X & ,'( tol =',d11.4,')')
Xc
X if(m.gt.(mdim-2).or.n.gt.(ndim-2).or.mb.gt.maxblk.or.nb.gt.maxblk
X & .or.nprocs.gt.maxprc.or.nprocs.lt.1.or.mb*nb.gt.100)
X & then
X write(6,6668) mdim,ndim,maxblk,m,n,mb,nb,nprocs,mxiter
X6668 format(' Improper inputs with limits exceeded; input was:'
X & ' mdim =',i5,'; ndim =',i5,'; maxblk =',i5
X & /' m =',i5,'; n =',i5,';mb =',i5,';nb =',i5
X & /' nprocs =',i5,'; max iterations =',i5)
X write(6,*) 'S T O P E X E C U T I O N I N M A I N'
X stop
X endif
Xc
X xmax = xmax1
X ymax = ymax1
Xc
X do 10 ib = 1,mb
X10 itmp(ib) = ib
X do 11 jb = 1,nb
X11 jtmp(jb) = jb
Xc
Xc: remove second.f timer
X t1 = second(foo)
X t2 = second(foo)
Xc
X CALL SCHED(nprocs,paralg,mdim,ndim,itmp,jtmp,itag,statag,mychkn
X & ,u,v)
Xc
X t3 = second(foo)
X tt = t3-t2-(t2-t1)
Xc
Xc output
Xc
X amstep = amax1(m/10.,1.)
X anstep = amax1(n/10.,1.)
X mtop = min0(m+1,11)
X ntop = min0(n+1,11)
X do 1002 i = 1,mtop
X1002 itmp(i) = 1 + (i-1)*amstep + .5
X do 1003 j = 1,ntop
X1003 jtmp(j) = 1 + (j-1)*anstep + .5
X write(6,1001) (itmp(i),i = 1,mtop),m+2
X j = n+2
X write(6,1000) j,(u(itmp(i),n+2),i = 1,mtop),u(m+2,n+2)
X do 100 k = 1,ntop
X j = jtmp(ntop+1-k)
X write(6,1000) j,(u(itmp(i),j),i = 1,mtop),u(m+2,j)
X100 continue
X1000 format(i4,2x,12f5.2)
X1001 format(' Static Block Jacobi -'
X & ,' Iteration SCHEDULE Final Results:'
X & /3x,'j/i',12i5)
Xc
X mxjobs = 1+niter*(1+mb*nb+2)+1
X if(nprocs.eq.1) write(6,664) mb,nb,niter,mxiter
X664 format(' # Static Block Jacobi Schedule rsched & gettag & name '
X & ,'program'
X & /' # ftsubs.f for iterated circular readyq & parmq & '
X & ,'freeq version'
X & /' # with mblks, nblks =',2i5'; niter =',i8,'; mxiter=',i8)
X write(6,665) nprocs,tt
X665 format(' #',i2,f12.5)
X write(*,666) m,n,mb,nb,niter,nprocs,mxjobs,tt,uvdiff
X666 format(9x,'code',7x,'m',7x,'n',3x,'mblks',3x,'nblks',3x,'niter'
X & ,2x,'nprocs',1x,'maxjobs'
X & /1x,'BLOCK-JACOBI',7i8
X & /1x,'STATIC VERSION',5x,'seconds =',f12.5,'; uvdiff =',d12.5)
X if(uvdiff.ge.tol) write(6,667) niter,mxiter,uvdiff,tol
X667 format(3x,'Iteration UNSUCCESSFUL: niter =',i6, ' & mxiter ='
X & ,i6/5x,'while uvdiff =',d12.5,' .GE. tol = ',d12.5)
Xc
X stop
X end
Xc
X subroutine paralg(mdim,ndim,itmp,jtmp,itag,statag,mychkn
X & ,u,v)
X parameter(mxprcs = 1000)
X implicit real*8 (a-h,o-z)
X integer m,n,mb,nb,statag(mdim,*),mychkn(*),itmp(*),jtmp(*)
X integer itag(mxprcs)
X integer jobtag,initag,strtag,cnvtag,testag,stptag
X real*8 u(mdim,*),v(mdim,*)
X common /comint/ m,n,mb,nb,mbpts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
X EXTERNAL INIT,STARTT,JACOBI,CONVRG,TEST,STOPIT
Xc
Xc this is the parallel driver for the iterated dependency graph
Xc
Xc first, get all static job tags necessary to construct the
Xc dependency graph.
Xc
XCAUTION: At this point, execution is in parallel because sub paralg
XCAUTION: and its args are only passed to SCHEDULE by sub sched and is
XCAUTION: executed in concurrent mode by a copy of the sub work.
XCAUTION: It is essential that all subsequent sub args must be global
XCAUTION: variables, such as itag, statag, itmp and jtmp, else values
XCAUTION: passed will not be protected from concurrent overwrite.
Xc
X CALL GETTAG(initag)
X itag(initag) = initag
X CALL GETTAG(strtag)
X itag(strtag) = strtag
X do 100 jb = 1,nb
X do 100 ib = 1,mb
XCaution: statag(ib,jb) gets the static job tag
Xcont: for the block (ib,jb).
X CALL GETTAG(statag(ib,jb))
X100 continue
X CALL GETTAG(cnvtag)
X itag(cnvtag) = cnvtag
X CALL GETTAG(testag)
X itag(testag) = testag
X CALL GETTAG(stptag)
X itag(stptag) = stptag
Xc
X jobtag = itag(initag)
X icango = 0
X nchks = 1
X nreset = 0
X mychkn(1) = itag(strtag)
Xc
XCAUTION: PUTQ does not call INIT, but only passes its name and args to
XCONT: SCHEDULE.
Xc
X CALL name(jobtag,' init')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL PUTQ(jobtag,init,itag(initag),mdim,u)
Xc
X jobtag = itag(strtag)
X icango = 1
X nchks = mb*nb
XComment: Here nreset = 2 is used as the iteration set number,
Xcont: but it may be any nonzero integer.
X nreset = 2
X do 201 jb = 1,nb
X do 201 ib = 1,mb
X mychkn(ib+mb*(jb-1)) = statag(ib,jb)
X201 continue
Xc
X CALL name(jobtag,'startt')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL RESET(jobtag,nreset)
X CALL PUTQ(jobtag,startt,itag(strtag),mdim,u,v)
Xc
X do 301 jb = 1,nb
X do 301 ib = 1,mb
X jobtag = statag(ib,jb)
X icango = 1
X nchks = 1
X nreset = 2
X mychkn(1) = itag(cnvtag)
Xc
X CALL name(jobtag,'jacobi')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL RESET(jobtag,nreset)
XCAUTION: Make certain that global variables like itmp are passed as
Xcont: arguments of subroutines that are passed to Schedule.
X CALL PUTQ(jobtag,jacobi,statag(ib,jb),mdim
X & ,itmp(ib),jtmp(jb),u,v)
X301 continue
Xc
X jobtag = itag(cnvtag)
X icango = mb*nb
X nchks = 1
X nreset = 2
X mychkn(1) = itag(testag)
Xc
X CALL name(jobtag,'convrg')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL RESET(jobtag,nreset)
X CALL PUTQ(jobtag,convrg,itag(cnvtag),mdim,u,v)
Xc
X jobtag = itag(testag)
X icango = 1
X nchks = 1
X nreset = 2
X mychkn(1) = itag(stptag)
Xc
X CALL name(jobtag,' test')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL RESET(jobtag,nreset)
X CALL PUTQ(jobtag,test,itag(testag),itag(strtag)
X & ,itag(stptag))
Xc
X jobtag = itag(stptag)
X icango = 1
X nchks = 0
X nreset = 0
Xc
X CALL name(jobtag,'stopit')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL PUTQ(jobtag,stopit,itag(stptag))
Xc
X return
X end
Xc
X subroutine init(initag,mdim,u)
X implicit real*8 (a-h,o-z)
X real*8 u(mdim,*)
X integer initag,mdim,m,n
X common /comint/ m,n,mb,nb,mbpts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
X niter = 0
X dx = xmax/(m+1)
X dy = ymax/(n+1)
X do 200 i = 1,m+2
X x = (i-1)*dx
X u(i,1) = (x/xmax)**2
X u(i,n+2) = 0.5*(1+(x/xmax)**2)
X200 continue
X do 300 j = 2,n+1
X y = (j-1)*dy
X u(1,j)= 0.5*(y/ymax)**3
X u(m+2,j) = 1.0
X300 continue
X do 100 j = 2,n+1
X do 100 i = 2,m+1
X u(i,j) = ((n+2-j)*u(i,1)+(j-1)*u(i,n+2))/(n+1)
X100 continue
X mstep=m/10
X nstep=n/10
X return
X end
X subroutine startt(strtag,mdim,u,v)
X implicit real*8 (a-h,o-z)
X integer strtag,mdim,m,n
X real*8 u(mdim,*),v(mdim,*)
X common /comint/ m,n,mb,nb,mbpts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
XCode: saves current node values and is restarting point for iterations.
X niter = niter + 1
X do 100 j = 1,n+2
X do 100 i = 1,m+2
X v(i,j) = u(i,j)
X100 continue
X return
X end
X subroutine jacobi(statag,mdim,ib,jb,u,v)
X implicit real*8 (a-h,o-z)
X integer statag,mdim,m,n,mb,nb,ib,jb
X real*8 u(mdim,*),v(mdim,*)
X common /comint/ m,n,mb,nb,mbpts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
X r = dy/dx
X do 100 js = 1,nbpts
X j = js + 1 + nbpts*(jb-1)
X y = (j-1)*dy
X do 100 is = 1,mbpts
X i = is + 1 + mbpts*(ib-1)
X x = (i-1)*dx
X a = 1.d0/dsqrt(1.d0+x**2+y**2)
X b = dexp(-x**2 -y**2)
X den = 2*(r**2*a + b)
X u(i,j) = (r**2*a*(v(i+1,j)+v(i-1,j))
X & + b*(v(i,j+1)+v(i,j-1)))/den
X100 continue
X mstep=m/10
X nstep=n/10
XCode: computes Block Jacobi updates for block (ib,jb)
X return
X end
X subroutine convrg(cnvtag,mdim,u,v)
X implicit real*8 (a-h,o-z)
X integer cnvtag,mdim,m,n,idone
X real*8 u(mdim,*),v(mdim,*)
X common /comint/ m,n,mb,nb,mbpts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
XCode: computes the Cauchy Convergence crierion in the inf-norm and
Xcont: passes the flag idone as 0 for reset and 1 for stop
X uvdiff = 0
X do 100 j = 2,n+1
X do 100 i = 2,m+1
X dumax = abs(u(i,j)-v(i,j))
X if(dumax.gt.uvdiff) uvdiff = dumax
X100 continue
X if(uvdiff.lt.tol.or.niter.ge.mxiter) then
X idone = 1
X else
X idone = 0
X endif
Xc
X return
X end
X subroutine test(testag,strtag,stptag)
X implicit real*8 (a-h,o-z)
X integer testag,strtag,stptag,reset
X common /comint/ m,n,mb,nb,mbpkts,nbpts,niter,mxiter,idone
X common /comdat/ xmax,ymax,dx,dy,tol,uvdiff
XCTERM INTEGER WRLOCK
XCTERM COMMON /CONWRT/ WRLOCK
X if(idone.eq.0) then
XComment: If iteration is unfinished, Reset SCHEDULE sub RSCHED is called
XCont: and my check in is changed to iteration start tag strtag.
XComment: In this example, the iteration set integer is 2.
X kreset = 2
X CALL RSCHED(testag,strtag,kreset)
X else
XComment: Else, reset my check in to the iteration stop tag stptag.
X kreset = 0
X CALL RSCHED(testag,stptag,kreset)
X endif
X return
X end
X subroutine stopit(stptag)
X integer stptag
X continue
X return
X end
END_OF_FILE
if test 11598 -ne `wc -c <'blkjac.f'`; then
echo shar: \"'blkjac.f'\" unpacked with wrong size!
fi
# end of 'blkjac.f'
fi
if test -f 'd_and_c.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'d_and_c.f'\"
else
echo shar: Extracting \"'d_and_c.f'\" \(1560 characters\)
sed "s/^X//" >'d_and_c.f' <<'END_OF_FILE'
X integer a(256),klevl(8),myid(256)
X external top
X write(6,*) ' input nprocs nlevls '
X read (5,*) nprocs,nlevls
X do 50 j = 1,8
X klevl(j) = j
X 50 continue
X call sched(nprocs,top,a,nlevls,klevl,myid)
X do 100 j = 1,2**nlevls-1
X write(6,*) a(j)
X 100 continue
X stop
X end
X subroutine top(a,nlevls,klevl,myid)
X integer a(*),klevl(*),myid(*)
X character*6 subnam
X external split
Xc write(6,*) ' from top ' , a(1)
X call gettag(jobtag)
X icango = 0
X nchks = 0
X myid(1) = jobtag
X a(1) = 1
Xc
X subnam = 'split'
X call name(jobtag,subnam)
X call dep(jobtag,icango,nchks,mychkn)
X call putq(jobtag,split,myid,a,nlevls,klevl)
Xc
X return
X end
X subroutine split(myid,a,nlevls,klevl)
X integer a(*),klevl(*),myid(*),rnode
X external clone
X character*6 subnam
Xc write(6,*) ' from split ',a(1)
Xc
X if (klevl(1) .ge. nlevls) return
Xc
X lnode = 2*a(1)
X rnode = lnode + 1
X indx = lnode - a(1) + 1
X a(indx) = lnode
X a(indx+1) = rnode
X mytag = myid(a(1))
Xc
X call gettag(jobtag)
X subnam = 'split'
X call name(jobtag,subnam)
X call nxtag(jobtag,mytag)
X myid(lnode) = jobtag
X call spawn(jobtag,mytag,clone,myid,a(indx),nlevls,klevl(2))
Xc
X call gettag(jobtag)
X subnam = 'split'
X call name(jobtag,subnam)
X call nxtag(jobtag,mytag)
X myid(rnode) = jobtag
X call spawn(jobtag,mytag,clone,myid,a(indx+1),nlevls,klevl(2))
Xc
X return
X end
END_OF_FILE
if test 1560 -ne `wc -c <'d_and_c.f'`; then
echo shar: \"'d_and_c.f'\" unpacked with wrong size!
fi
# end of 'd_and_c.f'
fi
if test -f 'data' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'data'\"
else
echo shar: Extracting \"'data'\" \(4 characters\)
sed "s/^X//" >'data' <<'END_OF_FILE'
X1
X3
END_OF_FILE
if test 4 -ne `wc -c <'data'`; then
echo shar: \"'data'\" unpacked with wrong size!
fi
# end of 'data'
fi
if test -f 'data.blkjac' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'data.blkjac'\"
else
echo shar: Extracting \"'data.blkjac'\" \(22 characters\)
sed "s/^X//" >'data.blkjac' <<'END_OF_FILE'
X1 100 100 10 10 100 2
END_OF_FILE
if test 22 -ne `wc -c <'data.blkjac'`; then
echo shar: \"'data.blkjac'\" unpacked with wrong size!
fi
# end of 'data.blkjac'
fi
if test -f 'data.ts_dynamic' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'data.ts_dynamic'\"
else
echo shar: Extracting \"'data.ts_dynamic'\" \(10 characters\)
sed "s/^X//" >'data.ts_dynamic' <<'END_OF_FILE'
X1 43 1000
END_OF_FILE
if test 10 -ne `wc -c <'data.ts_dynamic'`; then
echo shar: \"'data.ts_dynamic'\" unpacked with wrong size!
fi
# end of 'data.ts_dynamic'
fi
if test -f 'defs.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'defs.h'\"
else
echo shar: Extracting \"'defs.h'\" \(757 characters\)
sed "s/^X//" >'defs.h' <<'END_OF_FILE'
X#ifndef MOREPARMS
X *arg11,*arg12,*arg13,*arg14,*arg15,*arg16,*arg17,*arg18,*arg19,*arg20;
X#else
X *arg11,*arg12,*arg13,*arg14,*arg15,*arg16,*arg17,*arg18,*arg19,*arg20,
X *arg21,*arg22,*arg23,*arg24,*arg25,*arg26,*arg27,*arg28,*arg29,*arg30,
X *arg31,*arg32,*arg33,*arg34,*arg35,*arg36,*arg37,*arg38,*arg39,*arg40,
X *arg41,*arg42,*arg43,*arg44,*arg45,*arg46,*arg47,*arg48,*arg49,*arg50,
X *arg51,*arg52,*arg53,*arg54,*arg55,*arg56,*arg57,*arg58,*arg59,*arg60,
X *arg61,*arg62,*arg63,*arg64,*arg65,*arg66,*arg67,*arg68,*arg69,*arg70,
X *arg71,*arg72,*arg73,*arg74,*arg75,*arg76,*arg77,*arg78,*arg79,*arg80,
X *arg81,*arg82,*arg83,*arg84,*arg85,*arg86,*arg87,*arg88,*arg89,*arg90,
X *arg91,*arg92,*arg93,*arg94,*arg95,*arg96,*arg97,*arg98,*arg99;
X#endif
END_OF_FILE
if test 757 -ne `wc -c <'defs.h'`; then
echo shar: \"'defs.h'\" unpacked with wrong size!
fi
# end of 'defs.h'
fi
if test -f 'example.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'example.f'\"
else
echo shar: Extracting \"'example.f'\" \(2089 characters\)
sed "s/^X//" >'example.f' <<'END_OF_FILE'
X program main
X integer n, k
Xc
X external parprd
Xc
X real a(1000), b(1000), temp(50), sigma
X write (6,*) 'Input number of processors'
X read (5,*) nprocs
X n = 1000
X k = 20
Xc
X do 100 j = 1, n
X a(j) = j
X b(j) = 1
X100 continue
Xc
X call sched(nprocs, parprd, n, k, a, b, temp, sigma)
Xc
X write (6,*) ' sigma = ', sigma
X stop
X end
Xc
X subroutine parprd(n, k, a, b, temp, sigma)
Xc
X integer n, k
X real a(*), b(*), temp(*), sigma
Xc
X integer m1, m2, index, j, jobtag, icango, ncheks, mychkn(2)
X integer itags(500)
Xc
X character*6 subnam
X external inprod, addup
X save m1, m2
Xc
X do 150 j = 1, k + 1
X call gettag(jobtag)
X itags(j) = jobtag
X 150 continue
Xc
X m1 = n/k
X index = 1
X do 200 j = 1, k - 1
X jobtag = itags(j)
X icango = 0
X ncheks = 1
X mychkn(1) = itags(k + 1)
X subnam = 'inprod'
X call name(jobtag,subnam)
X call dep(jobtag, icango, ncheks, mychkn)
X call putq(jobtag, inprod, m1, a(index), b(index), temp(j))
X index = index + m1
X200 continue
Xc
X m2 = n - index + 1
X jobtag = itags(k)
X icango = 0
X ncheks = 1
X mychkn(1) = itags(k + 1)
X subnam = 'inprod'
X call name(jobtag,subnam)
X call dep(jobtag, icango, ncheks, mychkn)
X call putq(jobtag, inprod, m2, a(index), b(index), temp(k))
X index = index + m1
Xc
X jobtag = itags(k + 1)
X icango = k
X ncheks = 0
X subnam = 'addup'
X call name(jobtag,subnam)
X call dep(jobtag, icango, ncheks, mychkn)
X call putq(jobtag, addup, k, sigma, temp)
Xc
X return
X end
Xc
Xc
X subroutine inprod(m, a, b, sigma)
X integer m
X real a(*), b(*), sigma
X sigma = 0.0
X do 100 j = 1, m
X sigma = sigma + a(j)*b(j)
X100 continue
X return
X end
Xc
Xc
X subroutine addup(k, sigma, temp)
X integer k
X real sigma, temp(*)
X sigma = 0.0
X do 100 j = 1, k
X sigma = sigma + temp(j)
X100 continue
X return
X end
END_OF_FILE
if test 2089 -ne `wc -c <'example.f'`; then
echo shar: \"'example.f'\" unpacked with wrong size!
fi
# end of 'example.f'
fi
if test -f 'ftsubs.F' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ftsubs.F'\"
else
echo shar: Extracting \"'ftsubs.F'\" \(76182 characters\)
sed "s/^X//" >'ftsubs.F' <<'END_OF_FILE'
X subroutine chekin(jobtag)
Xcode path: balance:/bfs2/brewer/sched/hanson/ftsubs.f
Xcomment: integrated iteration version of ftsubs.f and ftsubs.iter.f
Xcont: with option to iterate a set of nodes with reset dependencies.
Xcomment: combined graphics and terminal trace version of ftsubt.f
Xcode parent: alliant:/afs1/hanson/dirsched/ftsubs.f
Xchange(1): iprcs = 200 <- 120;
Xchange(2): automatic return stmt removed out of loop do 20 in chekin;
Xchange(3): installed vector-circular ready queue,
Xcont: vector <= nproc sub-qs, elastic with nproc processors;
Xcont: circular <= readyq free space wraps around from rtail to rhead,
Xcont: with the top end of readyq connected to the bottom end;
Xcont: ready(rhead(id)+ndmrsq*(id-1)) <- readyq(rhead(id),id);
Xcont: most mxces replaced by nprocc = nproc = no. sub-qs;
Xcont: ldimrq = leading dim of readyq = iprcs*mxces
Xcont: ndmrsq = dim of a ready-sub-q = ldimrq/nproc
Xcont: idrsq = id of ready-sub-q <- iwrkr; dummy iw used in do's;
Xcont: installed sched error flags for readyq over-runs (mtail cond.);
Xcont: round robin test in getprb reduced to single statement.
Xchange: corrected next in nxtag & intspn in start2 to recover lost tag.
Xcaution: nxtag and spawn arguments are consistent with dep and putq
Xcont: now, but order of arguments may not be consistent with older
Xcont: versions of ftsubs.f.
Xchange(4): installed circular parm queue, jobtag is the circular
Xcont: (reusable) job tag with 1.le.jobtag.le.mxprcs,
Xcont: snext is the schedule or sum or cumulative jobtag.
Xchange(5): install super next tag, whereby user gets schedule job tags
Xcont: from new schedule sub gettag; hence schedule has no knowledge
Xcont: of user tags and consequently the principal restriction on user
Xcont: is that there be less than "mxprcs" undone jobs at any time.
Xcont: integer array "unitag" keeps a unique job tag for undone jobs.
Xchange(6): install rest and save arrays for jobtags that will be
Xcont: iterated more than once with original dependencies: ireset,
Xcont: icnsav. install sub rsched to reset icangoes
Xcont: and call sub place on iteration.
Xchange(6a): nslots = 105 <- 30 to handle multiple dependencies.
Xchange(7): installed common block conwrt with key wrlock for concurrent
Xcont: writes for use in both ftsubs.f and the user's driver code.
Xchange(8): installed c-include indx*.h files to enable the passing of
Xcont: up to 60 parameters with sched, putq and spawn calls (via m.
Xcont: johnson, ssi).
Xchange(9): installed lock initializations in libopn to make porting
Xcont: to other machines without automatic variable initialization.
Xcaution: subroutine second uses machine dependent timer, which must be
Xcont: changed when porting to other machines.
Xcgraphchange: install write nproc in sub libopn.
Xcgraphchange: installed extra traces in chekin & place.
Xcgraphchange: replaced qlock(mxprcs) by glock as igraph's own lock.
Xcgraphchange: installed process names for dongarra/brewer's sched.trace.
Xcgraphchange(8): cgraph lines made compatible for sched.trace/sched.trace.
Xcgraphcdirectory: /usr/alcaid/brewer/sched.trace/sched.trace
Xcgraphcomment: for graphics trace, change 'cgraph' to null '' and run.
Xctermcomment: for terminal trace, change 'cterm' to null '' and run.
Xchange(9): conversion of ftsubs.f to run on sequent balance 21000
Xcont: add $stdunit & $alignwarn compiler directives at beginning of file.
Xcont: change parameter "mxces" from 8 to 24.
Xcont: add line "ierr = m_set_procs(nproc)."
Xcont: all locks are integer.
Xcont: use microtasking calls s_init_lock, s_lock, & lockoff.
Xcont: add routines lckasn, lockon, lockoff, & nops.
Xcvd$r noconcur
X integer jobtag
Xc***********************************************************************
Xc
Xc this subroutine reports unit of computation labeled by
Xc jobtag has completed to all dependent nodes. these nodes are
Xc recorded in parmq(i,jobtag) where 6 .le. i .le. nchks+5
Xc checkin consists of decrementing the value in each of these
Xc locations by 1. each of these is done in a critical section
Xc protected by qlock(jobtag)
Xc
Xc if the value in parmq(2,jobtag) is 0 where jobtag is a process
Xc dependent upon this one then jobtag is placed on the readyq
Xc by entering the critical section protected by trlock. the
Xc pointer rtail to the tail of the readyq is incremented
Xc unless task done is to be recorded. task done is placed on
Xc the ready q and the pointer rtail left in place if nchks .eq. 0
Xc is found.
Xc
Xc see the common block description in libopn for more detail.
Xc
Xc***********************************************************************
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc
Xc common block description:
Xc
Xc a complete common block description is given in the routine libopn
Xc
Xc****************************************************************************
Xc
Xc check to see if this process has completed. if not do not checkin
Xc
X mtail = 0
X idrsq = 0
Xc
Xc first ask if any kids spawned by jobtag
Xc
X if (parmq(4,jobtag) .ne. 0 .or. parmq(5,jobtag) .ne. 0 ) then
Xc
Xc either kids have been spawned or ientry has been referenced
Xc indicating reentry is required
Xc
Xc
Xc find out how many are waiting to complete
Xc
X if (parmq(4,jobtag) .ne. 0) then
X call lockon(qlock(jobtag))
X parmq(2,jobtag) = parmq(2,jobtag) - parmq(4,jobtag)
X call lockoff(qlock(jobtag))
X endif
Xc
Xc reset number of kids
Xc
X parmq(4,jobtag) = 0
Xc
Xc update the number of times this procedure has been
Xc entered
Xc
X parmq(1,jobtag) = parmq(1,jobtag) + 1
Xc
Xc return without checkin if all the kids have not
Xc checked in to jobtag yet or if a reentry is required.
Xc process jobtag is not done in either case.
Xc
Xcomment: extra trace data.
X if (parmq(2,jobtag) .ne. 0) then
Xcgraph call lockon(glock)
Xcgraph if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcgraph insrt = endgrf
Xcgraph endgrf = endgrf + 1
Xcgraph call lockoff(glock)
Xcgraph inext = unitag(jobtag)
Xcgraph if (inext .ge. intspn) then
Xcgraphc trace for chekin/child (entry_flag.ne.0.or.nkids.ne.0 & icango.ne.0)
Xcgraph igraph(1,insrt) = 7
Xcgraph igraph(2,insrt) = parmq(6,jobtag)
Xcgraph igraph(3,insrt) = inext
Xcgraph igraph(4,insrt) = second(foo)
Xcgraph else
Xcgraphc trace for chekin/parent (entry_flag.ne.0.or.nkids.ne.0 & icango.ne.0)
Xcgraph igraph(1,insrt) = 6
Xcgraph igraph(2,insrt) = inext
Xcgraph igraph(3,insrt) = second(foo)
Xcgraph endif
X return
X endif
Xc
Xc if ientry has been called but jobtag is not waiting
Xc on any kids then jobtag is placed back on the readyq
Xc
X if ( parmq(5,jobtag) .ne. 0) then
X#ifdef SINGLERQ
Xc add jobtag to single ready queue; addrq returns 0 if successful, -1 if not
X mtail = addrq(jobtag)
X#else
X idrsq = mod((jobtag-1),nprocc) + 1
X call lockon(trlock(idrsq))
X if(mod(rtail(idrsq),ndmrsq) + 1 .ne. rhead(idrsq)) then
X readyq(rtail(idrsq)+ndmrsq*(idrsq-1)) = jobtag
X rtail(idrsq) = mod(rtail(idrsq),ndmrsq) + 1
X else
X mtail = -1
X endif
X call lockoff(trlock(idrsq))
X#endif
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xcterm if (inext .ge. intspn) then
Xctermc trace for chekin/child (entry_flag.ne.0 & icango=0 & nkids=0)
Xcterm igraph(1,insrt) = 10
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = parmq(8,jobtag)
Xcterm igraph(4,insrt) = idrsq
Xcterm igraph(5,insrt) = rhead(idrsq)
Xcterm igraph(6,insrt) = rtail(idrsq)
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm else
Xctermc trace for chekin/parent (entry_flag.ne.0 & icango=0 & nkids=0)
Xcterm igraph(1,insrt) = 9
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = idrsq
Xcterm igraph(4,insrt) = rhead(idrsq)
Xcterm igraph(5,insrt) = rtail(idrsq)
Xcterm igraph(6,insrt) = parmq(8,jobtag)
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm endif
X return
X endif
X endif
Xc
Xc the process has completed so chekin proceeds
Xc
Xcgraph call lockon(glock)
Xcgraph if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcgraph insrt = endgrf
Xcgraph endgrf = endgrf + 1
Xcgraph call lockoff(glock)
Xcgraph inext = unitag(jobtag)
Xcgraph if (inext .ge. intspn) then
Xcgraphc trace for chekin/child (entry_flag.eq.0 & nkids = 0)
Xcgraph igraph(1,insrt) = 5
Xcgraph igraph(2,insrt) = parmq(6,jobtag)
Xcgraph igraph(3,insrt) = inext
Xcgraph igraph(4,insrt) = second(foo)
Xcgraph gnames(insrt) = names(jobtag)
Xcgraph else
Xcgraphc trace for chekin/parent (entry_flag.eq.0 & nkids = 0)
Xcgraph igraph(1,insrt) = 2
Xcgraph igraph(2,insrt) = inext
Xcgraph igraph(3,insrt) = second(foo)
Xcgraph gnames(insrt) = names(jobtag)
Xcgraph endif
Xc
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xcterm if (inext .ge. intspn) then
Xctermc trace for chekin/child (entry_flag.eq.0 & nkids = 0)
Xcterm igraph(1,insrt) = 5
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = parmq(6,jobtag)
Xcterm igraph(4,insrt) = idrsq
Xcterm igraph(5,insrt) = jobtag
Xcterm igraph(6,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm else
Xctermc trace for chekin/parent (entry_flag.eq.0 & nkids = 0)
Xcterm igraph(1,insrt) = 2
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = idrsq
Xcterm igraph(4,insrt) = jobtag
Xcterm igraph(5,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm endif
Xc
Xc
X if (mtail .lt. 0) then
X write(6,*) '*************sched user error********************'
X write(6,*) ' user attempt to create too many processes'
X write(6,*) ' exceeding the space in the ready queue'
X#ifdef SINGLERQ
X write(6,*) ' the maximum allowed is ',ldimrq
X#else
X write(6,*) ' the maximum allowed is ',ndmrsq,' per sub-q'
X#endif
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine chekin'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xc
X nchks = parmq(3,jobtag)
Xc
Xc if this is the final process (indicated by nchks .eq. 0) then
Xc record task done. do not advance the tail so task done sequence
Xc is set. all subsequent gtprb queries will leave rhead .eq. rtail
Xc with readyq(rhead+ndmrsq*(i-1)) .eq. done.
Xc
X if (nchks .eq. 0) then
X#ifdef SINGLERQ
Xc set readyq value to done
X call lockon(trlock)
X readyq(rtail) = done
X call lockoff(trlock)
X#else
X do 20 iw = 1,nprocc
X call lockon(trlock(iw))
X readyq(rtail(iw)+ndmrsq*(iw-1)) = done
X call lockoff(trlock(iw))
X 20 continue
X#endif
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xcterm if (inext .ge. intspn) then
Xctermc trace for chekin/child (nchks.eq.0 & nkids=0 & entry_flag=0)
Xcterm igraph(1,insrt) = 12
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = parmq(6,jobtag)
Xcterm igraph(4,insrt) = idrsq
Xcterm igraph(5,insrt) = rhead(idrsq)
Xcterm igraph(6,insrt) = rtail(idrsq)
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm else
Xctermc trace for chekin/parent (nchks.eq.0 & nkids=0 & entry_flag=0)
Xcterm igraph(1,insrt) = 11
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = idrsq
Xcterm igraph(4,insrt) = rhead(idrsq)
Xcterm igraph(5,insrt) = rtail(idrsq)
Xcterm igraph(6,insrt) = parmq(6,jobtag)
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm endif
Xchange(2): removed following return from end of above loop do 20.
X return
X endif
X do 50 j = 6,nchks+5
X mychek = parmq(j,jobtag)
Xc
Xc get unique access to the checkin node mychek
Xc and checkin by decrementing the appropriate counter
Xc
X mchkgo = 1
X call lockon(qlock(mychek))
X parmq(2,mychek) = parmq(2,mychek) - 1
X mchkgo = parmq(2,mychek)
X call lockoff(qlock(mychek))
Xc
Xc place mychek on readyq if parmq(2,mychek) is 0
Xc
X if (mchkgo .eq. 0 ) then
X#ifdef SINGLERQ
Xc add mychek to the ready queue
X mtail = addrq(mychek)
X#else
X idrsq = mod((mychek-1),nprocc) + 1
X call lockon(trlock(idrsq))
X if(mod(rtail(idrsq),ndmrsq) + 1 .ne. rhead(idrsq)) then
X readyq(rtail(idrsq)+ndmrsq*(idrsq-1)) = mychek
X rtail(idrsq) = mod(rtail(idrsq),ndmrsq) + 1
X else
X mtail = -1
X endif
X call lockoff(trlock(idrsq))
X#endif
X endif
X 50 continue
Xc
Xc place finished process at the end of the free list freeq
Xc provided it will not be reset for another iteration.
Xc
X if(ireset(jobtag).eq.0) then
X call lockon(tflock)
X ftail = mod(ftail,mxprcs) + 1
X if(fhead.eq. ftail) free = 0
X freeq(ftail) = jobtag
X call lockoff(tflock)
X endif
Xc
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xcterm if (inext .ge. intspn) then
Xctermc trace for chekin/child (nchks.ne.0 & nkids=0 & entry_flag=0)
Xcterm igraph(1,insrt) = 8
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = parmq(6,jobtag)
Xcterm igraph(4,insrt) = idrsq
Xcterm igraph(5,insrt) = fhead
Xcterm igraph(6,insrt) = ftail
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm else
Xctermc trace for chekin/parent (nchks.ne.0 & nkids=0 & entry_flag=0)
Xcterm igraph(1,insrt) = 7
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = idrsq
Xcterm igraph(4,insrt) = fhead
Xcterm igraph(5,insrt) = ftail
Xcterm igraph(6,insrt) = parmq(6,jobtag)
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm endif
Xc
X if (mtail .lt. 0) then
X write(6,*) '*************sched limit error********************'
X write(6,*) ' user attempt to create too many processes'
X write(6,*) ' exceeding the space in the ready queue'
X#ifdef SINGLERQ
X write(6,*) ' the maximum allowed is ',ldimrq
X#else
X write(6,*) ' the maximum allowed is ',ndmrsq,' per sub-q'
X#endif
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine chekin'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xc
X if ( free .eq. 0 ) then
X call lockon(wrlock)
X inext = unitag(jobtag)
X write(6,*) '*************sched error*************************'
X write(6,*) ' more processes have checked into sub chekin,'
X write(6,*) ' than should be active for free slots in the'
X write(6,*) ' parmq parameter queue. jobs are too many.'
X write(6,*) ' total number of jobtags were:',inext
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine chekin'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X call lockoff(wrlock)
X stop
Xc
X endif
Xc
X return
Xc
Xc last card of chekin
Xc
X end
X#ifdef SINGLERQ
X subroutine dep(jobtag,icango,nchks,mychkn,cost)
X#else
X subroutine dep(jobtag,icango,nchks,mychkn)
X#endif
Xcvd$r noconcur
X integer jobtag,icango,nchks,mychkn(*)
Xc*************************************************************************
Xc
Xc warning - this routine may only be used by driver in a static definition
Xc of the data dependencies in the task.
Xc
Xc
Xc usage
Xc subroutine xxx(<parms>)
Xc external yyy
Xc .
Xc .
Xc .
Xc call dep(jobtag,icango,nchks,mychkn)
Xc call putq(jobtag,yyy,<parms2>)
Xc .
Xc .
Xc .
Xc
Xc this subroutine puts data dependencies for problem on the queue.
Xc no synchronization is necessary because each index of a column of
Xc parmq is associated with a jobtag specified by the user and
Xc associated with a unique unit of computation. the arguments of
Xc dep specify a the data dependencies associated with the unit of
Xc computation labeled by jobtag and are placed in a column of parmq
Xc to the menu specified below.
Xc
Xc
Xc jobtag is an integer specifying a unique column of parmq obtained
Xc from subprogram gettag and is reused when the process jobtag
Xc becomes done.
Xc
Xc icango is a positive integer specifying how many processes must check
Xc in to this process before it can be placed on the readyq.
Xc
Xc nchks is the number of processes that depend upon the completion of
Xc this process.
Xc
Xc mychkn is an integer array specifying schedule jobtags of the
Xc processes which depend upon completion of this process.
Xc
Xc*************************************************************************
Xc
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc
Xc common block description:
Xc
Xc for a complete common block description see the subroutine libopn
Xc
Xc
Xc place process jobtag on the problem queue
Xc no synchronization required since
Xc only one program work executes this code.
Xc
X if( icango .lt. 0 .or. nchks .lt. 0) then
X write(6,*) '*************sched user error********************'
X write(6,*) ' incorrect specification of dependencies '
X write(6,*) ' dep parameters icango and nchks '
X write(6,*) ' must be non-negative'
X write(6,*) ' input was '
X write(6,*) ' jobtag ',jobtag
X write(6,*) ' icango ',icango
X write(6,*) ' nchks ',nchks
X write(6,*) ' '
X write(6,*) ' execution terminated by sched in subroutine dep'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
Xc
X endif
Xc
X parmq(1,jobtag) = 1
X parmq(2,jobtag) = icango
X parmq(3,jobtag) = nchks
X parmq(4,jobtag) = 0
Xc
Xc check to see that exactly one node has nchks set to 0
Xc
X if (nchks .eq. 0 .and. done .eq. 0) then
X done = -2
X else
X if (nchks .eq. 0) done = 0
X endif
Xc
Xc specify identifiers of processes which depend on this one
Xc if there are too many abort
Xc
X if (nchks .gt. nslots - 5) then
X write(6,*) '*************sched user error********************'
X write(6,*) ' attempt to place too many dependencies '
X write(6,*) ' on chekin list during call to dep '
X write(6,*) ' with jobtag ',jobtag
X write(6,*) ' '
X write(6,*) ' user tried to place ',nchks ,' dependencies '
X write(6,*) ' the maximum number is ',nslots - 5
X write(6,*) ' '
X write(6,*) ' execution terminated by sched in subroutine dep'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
Xc
X endif
X do 50 j = 1,nchks
X parmq(j+5,jobtag) = mychkn(j)
Xc
X if (mychkn(j) .le. 0) then
X write(6,*) '*************sched user error********************'
X write(6,*) ' incorrect specification of dependencies '
X write(6,*) ' all mychkn entries must be positive'
X write(6,*) ' input was '
X write(6,*) ' mychkn(',j,') = ',mychkn(j)
X write(6,*) ' '
X write(6,*) ' execution terminated by sched in subroutine dep'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
X 50 continue
X#ifdef SINGLERQ
Xc
Xc assign level cost for this task
Xc
X xlevel(jobtag) = cost
X#endif
Xc
Xcgraph call lockon(glock)
Xcgraph if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcgraph insrt = endgrf
Xcgraph endgrf = endgrf + 1
Xcgraph call lockoff(glock)
Xcgraph inext = unitag(jobtag)
Xcgraphc trace for dep
Xcgraph igraph(1,insrt) = 0
Xcgraph igraph(2,insrt) = inext
Xcgraph igraph(3,insrt) = icango
Xcgraph igraph(4,insrt) = nchks
Xcgraph do 9001 jnsrt = 5,nchks + 4
Xcgraph igraph(jnsrt,insrt) = parmq(jnsrt+1,jobtag)
Xcgraph 9001 continue
Xcgraph gnames(insrt) = names(jobtag)
Xc
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xctermc trace for dep
Xcterm igraph(1,insrt) = 0
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = icango
Xcterm igraph(4,insrt) = nchks
Xcterm igraph(5,insrt) = fhead
Xcterm igraph(6,insrt) = ftail
Xcterm igraph(7,insrt) = jobtag
Xcterm do 9001 jnsrt = 8,nchks + 7
Xcterm igraph(jnsrt,insrt) = parmq(jnsrt-2,jobtag)
Xcterm 9001 continue
Xcterm gnames(insrt) = names(jobtag)
Xc
X return
Xc
Xc last card of dep
Xc
X end
X subroutine dump(endgrf,igraph)
Xcvd$r noconcur
Xchange: combined sun sched.trace/sched.trace and terminal version of dump.
X parameter (nslots = 105,nbuffr = 500)
X parameter (mxprcs = 1000)
X integer endgrf
X real igraph(nslots,nbuffr)
X character*6 gnames,aname
X common /gphnam/ gnames(nbuffr)
X integer ievent(nslots)
Xc***********************************************************************
Xc
Xc this routine writes graphics and terminal output to a file
Xc and resets endgrf to 1
Xc
Xc***********************************************************************
X do 300 j = 1,endgrf-1
X do 302 i = 1,nslots
X ievent(i) = igraph(i,j)
X 302 continue
X inext = ievent(2)
X if( ievent(1) .eq. 0 ) then
X aname = gnames(j)
Xcgraph write(3,30000) (ievent(i),i=1,ievent(4)+4)
Xcgraph write(3,30010) aname
Xcterm write(3,3000) j,(ievent(i),i=1,7)
Xcterm & ,aname,(ievent(i),i=8,ievent(4)+7)
X endif
X if( ievent(1) .eq. 1 ) then
X aname = gnames(j)
Xcgraph write(3,30001) (ievent(i),i=1,2),igraph(3,j)
Xcgraph & ,ievent(4)
Xcterm write(3,3001) j,(ievent(i),i=1,7),aname,igraph(8,j)
X endif
X if( ievent(1) .eq. 2 ) then
X aname = gnames(j)
Xcgraph write(3,30002) (ievent(i),i=1,2),igraph(3,j)
Xcterm write(3,3002) j,(ievent(i),i=1,4),aname,igraph(5,j)
X endif
X if( ievent(1) .eq. 3 ) then
X aname = gnames(j)
Xcgraph write(3,30003) (ievent(i),i=1,3),aname
Xcterm write(3,3003) j,(ievent(i),i=1,6),aname
X endif
X if( ievent(1) .eq. 4 ) then
X aname = gnames(j)
Xcgraph write(3,30004) (ievent(i),i=1,3),igraph(4,j)
Xcgraph & ,ievent(5)
Xcterm write(3,3004) j,(ievent(i),i=1,8),aname,igraph(9,j)
X endif
X if( ievent(1) .eq. 5 ) then
X aname = gnames(j)
Xcgraph write(3,30005) (ievent(i),i=1,3),igraph(4,j)
Xcterm write(3,3005) j,(ievent(i),i=1,5),aname,igraph(6,j)
X endif
X if( ievent(1) .eq. 6 ) then
Xcgraph write(3,30002) (ievent(i),i=1,2),igraph(3,j)
X endif
X if( ievent(1) .eq. 7 ) then
Xcgraph write(3,30005) (ievent(i),i=1,3),igraph(4,j)
X endif
Xcterm if( ievent(1) .eq. 6 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3006) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 7 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3007) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 8 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3008) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 9 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3009) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 10 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3010) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 11 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3011) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 12 ) then
Xcterm aname = gnames(j)
Xcterm write(3,3012) j,(ievent(i),i=1,7),aname,igraph(8,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 13 ) then
Xcterm if ( ievent(4) .ne. 0 ) then
Xcterm aname = gnames(j)
Xcterm else
Xcterm aname = ' work'
Xcterm endif
Xcterm write(3,3013) j,(ievent(i),i=1,4),aname,igraph(5,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 14 ) then
Xcterm if ( ievent(5) .ne. 0 ) then
Xcterm aname = gnames(j)
Xcterm else
Xcterm aname = ' work'
Xcterm endif
Xcterm write(3,3014) j,(ievent(i),i=1,5),aname,igraph(6,j)
Xcterm endif
Xcterm if( ievent(1) .eq. 15 ) then
Xcterm write(3,3015) j,(ievent(i),i=1,5)
Xcterm endif
Xcgraph30000 format(14i8)
Xcgraph30010 format(2x,a)
Xcgraph30001 format(2i8,1pe16.8,i8)
Xcgraph30002 format(2i8,1pe16.8)
Xcgraph30003 format(3i8,2x,a)
Xcgraph30004 format(3i8,1pe16.8,i8)
Xcgraph30005 format(3i8,1pe16.8)
Xcterm3000 format(i4,'. dep:',i2,';jobtag=',i4,';icango=',i4
Xcterm & ,'; nchks=',i4,';fhead,ftail=',i4,',',i4
Xcterm & /21x,12x,';idparm=',i4,';mytask= ',a6
Xcterm & /21x,'; mychkn(s)=',5i4,(/21x,10i4))
Xcterm3001 format(i4,'. gtprb/parent:',i2,';jobtag=',i4,12x
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /4x,' (mhead.gt.0) ',';idwork=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3002 format(i4,'.chekin/parent:',i2,';jobtag=',i4,12x
Xcterm & ,'; idrsq=',i4
Xcterm & /4x,' (entryflag.eq.0)',12x
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3003 format(i4,'. nxtag:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & ,12x,';fhead,ftail=',i4,',',i4
Xcterm & /21x,12x,';idparm=',i4,';mytask= ',a6)
Xcterm3004 format(i4,'. gtprb/child:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /4x,' (mhead.gt.0) ',';idwork=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3005 format(i4,'. chekin/child:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & ,' idrsq=',i4
Xcterm & /4x,' (entryflag.eq.0)',12x
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3006 format(i4,'. place:',i2,';jobtag=',i4,12x
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /21x,';icango=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3007 format(i4,'.chekin/parent:',i2,';jobtag=',i4,12x
Xcterm & ,'; idrsq=',i4,';fhead,ftail=',i4,',',i4
Xcterm & /4x,' (nchks.ne.0) ',2x,';mychek=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3008 format(i4,'. chekin/child:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & ,'; idrsq=',i4,';fhead,ftail=',i4,',',i4
Xcterm & /4x,' (nchks.ne.0) ',2x,12x
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3009 format(i4,'.chekin/parent:',i2,';jobtag=',i4,12x
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /4x,' (entryflag.ne.0)',';mychek=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3010 format(i4,'. chekin/child:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /4x,' (entryflag.ne.0)',12x
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3011 format(i4,'.chekin/parent:',i2,';jobtag=',i4,12x
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /4x,' (nchks.eq.0) ',2x,';mychek=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3012 format(i4,'. chekin/child:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & ,'; idrsq=',i4,';rhead,rtail=',i4,',',i4
Xcterm & /,4x,' (nchks.eq.0) ',12x
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3013 format(i4,'. gtprb/parent:',i2,';jobtag=',i4,12x
Xcterm & /4x,' (mhead.le.0) ',';idwork=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3014 format(i4,'. gtprb/child:',i2,';jobtag=',i4,'; mypar=',i4
Xcterm & /4x,' (mhead.lt.0) ',';idwork=',i4
Xcterm & ,';idparm=',i4,';mytask= ',a6,'; time=',1pe16.8)
Xcterm3015 format(i4,'. gettag:',i2,';jobtag=',i4,';idparm=',i4
Xcterm & ,12x,';fhead,ftail=',i4,',',i4)
X 300 continue
Xc
X endgrf = 1
Xc
X return
Xc
Xc last line of dump
Xc
X end
X subroutine gettag(jobtag)
Xcvd$r noconcur
X integer jobtag
Xc*************************************************************************
Xc
Xc this subroutine gets a schedule jobtag for problem on the queue,
Xc provided a free column is available in parmq.
Xc
Xc*************************************************************************
Xc
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc
Xc common block description:
Xc
Xc for a complete common block description see the subroutine libopn
Xc
Xc
X if ( free .eq. 0 ) then
X call lockon(wrlock)
X write(6,*) '*************sched limit error*******************'
X write(6,*) ' user attempt to create to many active '
X write(6,*) ' processes ; total number of jobs =',snext
X write(6,*) ' too many unfinished jobs while in gettag '
X write(6,*) ' and no free slots on the parameter queue '
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine gettag'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X call lockoff(wrlock)
X stop
Xc
X endif
Xc
Xc get tag for process on the next free column in the problem queue
Xc
X call lockon(hflock)
X jobtag = freeq(fhead)
X snext = snext + 1
X if(fhead.eq. ftail) free = 0
X fhead = mod(fhead,mxprcs) + 1
X if(jobtag.ge.1.and.jobtag.le.mxprcs) unitag(jobtag) = snext
X call lockoff(hflock)
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xctermc trace for gettag
Xcterm igraph(1,insrt) = 15
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = jobtag
Xcterm igraph(4,insrt) = fhead
Xcterm igraph(5,insrt) = ftail
Xc
X if ( jobtag .le. 0 .or. jobtag .gt. mxprcs ) then
X write(6,*) '*************sched error***********************'
X write(6,*) ' illegal jobtag for parmq column;'
X write(6,*) ' need 1 .le. jobtag .le. ',mxprcs,';'
X write(6,*) ' current jobtag =',jobtag,' in gettag'
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine gettag'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
Xc
X endif
Xc
X return
Xc
Xc last card of gettag
Xc
X end
X integer function gtprb(id,jobtag)
Xcvd$r noconcur
Xc**************************************************************************
Xc
Xc this function gets unique access to the head of the readyq.
Xc if there are no entries in the readyq, a no-op is done and the
Xc readyq is retested, until either task done is recorded or a ready
Xc job is found. if task done has been recorded the value
Xc zero is returned in gtprb. if a nonzero value is returned in gtprb,
Xc the integer jobtag will contain the identifier of the unit of
Xc computation that is to be executed.
Xc
Xc input parameter
Xc
Xc id an integer specifying which readyq to access first
Xc for work to do. (** - not used for one readyq )
Xc
Xc output parameters
Xc
Xc jobtag an integer containing the next process to be executed
Xc
Xc gtprb the return value of this integer function is:
Xc
Xc 0 if task done has been posted
Xc
Xc nonzero if a schedulable process has been claimed.
Xc
Xc
Xc***************************************************************************
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc common block description:
Xc
Xc for a complete common block description see the routine libopn
Xc
Xc
Xc gain access to head of readyq. if task done has not been recorded
Xc then increment the head of the readyq. otherwise the head pointer
Xc is left fixed so the next active process will receive task done.
Xc
X#ifndef SINGLERQ
X idrsq = id
X#endif
X nspins = 0
X fsave = second(foo)
X 10 continue
X mhead = -1
X#ifdef SINGLERQ
X call lockon(hrlock)
X if (rhead .ne. rtail) then
X mhead = rhead
X rhead = mod(rhead,ldimrq) + 1
X endif
X call lockoff(hrlock)
X#else
X call lockon(hrlock(idrsq))
X if (rhead(idrsq) .ne. rtail(idrsq)) then
X mhead = rhead(idrsq)
X rhead(idrsq) = mod(rhead(idrsq),ndmrsq) + 1
X endif
X call lockoff(hrlock(idrsq))
X#endif
Xc
X if (mhead .gt. 0) then
Xc
Xc there was a work unit on the readyq
Xc
X#ifdef SINGLERQ
X jobtag = readyq(mhead)
X#else
X jobtag = readyq(mhead+ndmrsq*(idrsq-1))
X#endif
Xchange: events 1 & 4 changed from here to if/else below.
Xc
X if (jobtag .ne. done) then
Xc
Xc record the subroutine call identifier in gtprb and return
Xc the process identifier in jobtag.
Xc
X gtprb = parmq(1,jobtag)
X if (gtprb .gt. 1 .and. parmq(5,jobtag) .eq. 0) then
X gtprb = -1
X else
Xcgraph call lockon(glock)
Xcgraph if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcgraph insrt = endgrf
Xcgraph endgrf = endgrf + 1
Xcgraph call lockoff(glock)
Xcgraph inext = unitag(jobtag)
Xcgraph if (inext .ge. intspn) then
Xcgraphc trace for grprb/child(mhead.gt.0)
Xcgraph igraph(1,insrt) = 4
Xcgraph igraph(2,insrt) = parmq(6,jobtag)
Xcgraph igraph(3,insrt) = inext
Xcgraph igraph(4,insrt) = second(foo)
Xcgraph igraph(5,insrt) = id
Xcgraph gnames(insrt) = names(jobtag)
Xcgraph else
Xcgraphc trace for grprb/parent(mhead.gt.0)
Xcgraph igraph(1,insrt) = 1
Xcgraph igraph(2,insrt) = inext
Xcgraph igraph(3,insrt) = second(foo)
Xcgraph igraph(4,insrt) = id
Xcgraph gnames(insrt) = names(jobtag)
Xcgraph endif
Xc
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xcterm if (inext .ge. intspn) then
Xctermc trace for grprb/child(mhead.gt.0)
Xcterm igraph(1,insrt) = 4
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = parmq(6,jobtag)
Xcterm igraph(4,insrt) = idrsq
Xcterm igraph(5,insrt) = rhead(idrsq)
Xcterm igraph(6,insrt) = rtail(idrsq)
Xcterm igraph(7,insrt) = id
Xcterm igraph(8,insrt) = jobtag
Xcterm igraph(9,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm else
Xctermc trace for grprb/parent(mhead.gt.0)
Xcterm igraph(1,insrt) = 1
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = idrsq
Xcterm igraph(4,insrt) = rhead(idrsq)
Xcterm igraph(5,insrt) = rtail(idrsq)
Xcterm igraph(6,insrt) = id
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
X endif
Xc
X else
Xc
Xc task done has been indicated. request a return from subroutine work
Xc by returning the value 0 in gtprb.
Xc
X gtprb = 0
Xc
X endif
X else
Xc
X#ifdef SINGLERQ
X jobtag = readyq(rhead)
X#else
X jobtag = readyq(rhead(idrsq)+ndmrsq*(idrsq-1))
X#endif
X if (jobtag .eq. done) then
Xc
Xc task done has been posted
Xc
X gtprb = 0
Xc
X else
Xc
Xc there was not any work on the readyq
Xc
Xchange(3a): round robin test replaced by single statement.
X nspins = nspins + 1
X#ifdef SINGLERQ
X call nops
X#else
X idrsq = mod(idrsq,nprocc) + 1
X if (mod(nspins,nprocc) .eq. 0) call nops
X#endif
X go to 10
Xc
X endif
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xcterm if (inext .ge. intspn) then
Xctermc trace for grprb/child(mhead.le.0)
Xcterm igraph(1,insrt) = 14
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = parmq(6,jobtag)
Xcterm igraph(4,insrt) = id
Xcterm igraph(5,insrt) = jobtag
Xcterm igraph(6,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm else
Xctermc trace for grprb/parent(mhead.le.0)
Xcterm igraph(1,insrt) = 13
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = id
Xcterm igraph(4,insrt) = jobtag
Xcterm igraph(5,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xcterm endif
Xc
X endif
X return
Xc
Xc last card of gtprb
Xc
X end
X integer function ientry(mypar,nentrs)
Xc
X integer mypar
Xc*****************************************************************************
Xc
Xc this routine will allow process mypar to continue after
Xc spawned processes have all checked in. it should only be called if
Xc processes have been spawned by mypar through the use of
Xc the subroutine spawn.
Xc
Xc go to (1000,2000,...,n000), ientry(mypar,n)
Xc 1000 continue
Xc .
Xc .
Xc .
Xc do 10 j = 1,nproc
Xc .
Xc . (set parameters to define spawned process)
Xc .
Xc call nxtag(jobtag,mypar)
Xc call spawn(jobtag,mypar,subname,<parms>)
Xc 10 continue
Xc return
Xc 2000 continue
Xc .
Xc .
Xc .
Xc return
Xc n000 continue
Xc <statements>
Xc return
Xc end
Xc
Xc this subroutine returns the number of times process mypar
Xc has been entered. if that number is equal to the total
Xc number nentrs of expected reentries then parmq(5,mypar)
Xc is set to 0 indicating no more reentries required.
Xc
Xc*****************************************************************************
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc report the entry point where process jobtag should resume
Xc computation
Xc
X inext = unitag(mypar)
X if (nentrs .lt. 2) then
X write(6,*) '*************sched user error********************'
X write(6,*) ' user call to ientry with number of '
X write(6,*) ' labels in nentrs set less than 2 '
X write(6,*) ' from parent process ',inext
X write(6,*) ' '
X write(6,*) ' execution terminated by sched '
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
X ientry = parmq(1,mypar)
X if (ientry .lt. nentrs) then
X parmq(5,mypar) = nentrs
X else
X parmq(5,mypar) = 0
X endif
Xc
X return
Xc
Xc last card of ientry
Xc
X end
X subroutine libopn(nproc)
X integer nproc
Xc************************************************************************
Xc
Xc this routine sets locks and initializes variables
Xc and then spawns nproc generic work routines.
Xc
Xc nproc is a positive integer. care should be taken to
Xc match nproc to the number of physical processors
Xc available.
Xc
Xc************************************************************************
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
X integer ispace(mxces)
Xc
Xc common block description:
Xc
Xc common/qdata/
Xc
Xc parmq is a two dimensional integer array. each column of
Xc this array represents a schedulable process. a process is
Xc identified by its jobtag which corresponds to a unique
Xc column of parmq. a column of parmq has the following
Xc entries
Xc
Xc parmq(1,jobtag) = nentries
Xc a nonzero integer. if process jobtag
Xc is on the readyq then this integer
Xc is equal to the one plus number of times
Xc process jobtag has been entered.
Xc thus when work executes this process
Xc the integer is equal to the number
Xc of times the process has been entered.
Xc
Xc parmq(2,jobtag) = icango
Xc an integer specifying the number
Xc of processes that must check in
Xc before this process may scheduled
Xc (ie. be placed on the ready queue)
Xc
Xc parmq(3,jobtag) = nchks
Xc an integer specifying the number
Xc of processes that this process
Xc must checkin to. identifiers of
Xc these processes are recorded below.
Xc if nchks .eq. 0 then completion of
Xc this process signifies completion of
Xc task.
Xc
Xc parmq(4,jobtag) = the number of kids spawned by this
Xc process. if this value is zero
Xc then this process has not spawned
Xc any subprocesses.
Xc
Xc parmq(5,jobtag) = entry_flag
Xc has the value 1 if ientry was called
Xc has the value 0 otherwise
Xc
Xc parmq(6:5+nchks,jobtag) is reserved for identifiers of the nchks
Xc processes that must wait for completion
Xc of this process before they can execute.
Xc
Xc fhead integer pointer to head of freeq.
Xc
Xc ftail integer pointer to tail of freeq.
Xc
Xc free integer flag so that there are free columns on parmq if
Xc free = 1, while there are no free columns if free = 0.
Xc
Xc freeq one dimensional free list of free columns of parmq, with
Xc free columns starting at fhead and ending at ftail in a
Xc circular order. once a job is finished at the end of
Xc chekin, its column or slot is added back onto freeq,
Xc incrementing ftail mod mxprcs.
Xc
Xc snext integer counter holding the cumulative number of job tags
Xc given out by gettag.
Xc
Xc unitag integer array holding the unique job tags "snext"s
Xc corresponding to each current jobtag.
Xc
Xc intspn pointer to first spawned process. all jobtags with values
Xc greater than or equal to intspn will be spawned processes.
Xc
Xc readyq a one dimensional integer array that holds the jobtags of
Xc those processes that are ready to execute. the ready q can
Xc either be sorted by decreasing cost function, or can be
Xc divided up into nproc sub-queues (see make1 and subroutine
Xc addrq for details.) if readyq(*) .eq. done has been set
Xc then a return from subroutine work(*,*) is indicated.
Xc
Xc rhead a scalar integer which is a pointer to the head of the readyq
Xc
Xc rtail a scalar integer which is a pointer to the tail of the readyq
Xc
Xc
Xc
Xc common/qsync/
Xc
Xc qlock is an integer array of locks. there is one lock for each
Xc column of parmq. the purpose of this lock is to ensure
Xc unique access to a column of parmq during the checkin operation.
Xc
Xc hrlock is an integer lock. the purpose of this lock is to ensure
Xc unique access to the pointer rhead to the head of the readyq.
Xc
Xc trlock is an integer lock. the purpose of this lock is to ensure
Xc unique access to the pointer rtail to the tail of the readyq.
Xc
Xc hflock is an integer lock. the purpose of this lock is to ensure
Xc unique access to the pointer fhead to the head of the freeq.
Xc
Xc tflock is an integer lock. the purpose of this lock is to ensure
Xc unique access to the pointer ftail to the tail of the freeq.
Xc
Xc common /qreset/
Xc
Xc ireset is an integer flag array with ireset(j) .ne. 0 if job j
Xc dependency will be reset, else ireset(j) = 0.
Xc
Xc icnsav is an integer array where icango will be caved for each job
Xc that will be reset.
Xc
Xc common /conwrt/
Xc
Xc wrlock is an integer lock. the purpose of this lock is to ensure
Xc a unique write during concurrent execution.
Xc
Xc done is a unique non positive integer set in libopn to indicate
Xc task done.
Xc
Xc common /gphout/
Xc
Xc endgrf is an integer pointing to the next available
Xc slot in igraph
Xc
Xc glock is an integer lock. the purpose of this lock is to ensure
Xc unique access to the pointer endgrf of a column of igraph.
Xc
Xc igraph is a two dimensional integer array
Xc used as a buffer for graphics output
Xc each column of igraph records an event.
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Xc
Xchange(3): nproc passed in common as nprocc
X nprocc = nproc
Xchange(3): ndmrsq is the size of each sub-q, corresp. one proc.
X#ifndef SINGLERQ
X ndmrsq = ldimrq/nprocc
X#endif
Xc
X if (nproc .gt. mxces .or. nproc .lt. 1) then
X write(6,*) '*************sched user error********************'
X write(6,*) ' user asking for non-physical processors'
X write(6,*) ' on this system: nprocs = ',nproc
X write(6,*) ' the maximum allowed is nproc = ',mxces-1
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine libopn'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xc
X done = -1
Xc
Xc set readyq locks off
Xc initialize readyq(*) = -1 to set done sequence
Xc
X#ifdef SINGLERQ
X hrlock = 0
X trlock = 0
X rhead = 1
X rtail = 1
X do 20 i = 1, ldimrq
X readyq(i) = -1
X 20 continue
X#else
X do 50 j = 1,nprocc
X hrlock(j) = 0
X trlock(j) = 0
X rhead(j) = 1
X rtail(j) = 1
X do 20 i = 1,ndmrsq
X readyq(i+ndmrsq*(j-1)) = -1
X 20 continue
X 50 continue
X#endif
Xc
Xc set freeq pointers and locks
Xc set qlocks off
Xc initialize reentry indicator in parmq(5,*)
Xc initial circular freeq with all parmq columns
Xc
X free = 1
X fhead = 1
X ftail = mxprcs
X hflock = 0
X tflock = 0
X wrlock = 0
Xcgraph glock = 0
Xcterm glock = 0
X do 100 j = 1,mxprcs
X qlock(j) = 0
X parmq(5,j) = 0
X freeq(j) = j
X ireset(j) = 0
X icnsav(j) = 0
X 100 continue
Xc
Xc initialize queue pointers
Xc
X intspn = 1
X snext = 0
Xcgraph endgrf = 1
Xcgraph open( file='trace.graph',unit=3)
Xcgraphc
Xcgraphchange: output nproc for sched.trace format
Xcgraph write(3,30000) nproc
Xcgraph30000 format(i8)
Xcterm endgrf = 1
Xcterm open( file='term.trace',unit=3)
Xctermc
Xctermchange: output nproc for terminal trace format
Xcterm write(3,30000) nproc
Xcterm30000 format('nprocs = ',i1/)
Xc
Xc set lock on pointer to head of readyq so
Xc no process may start until all process and data dependencies
Xc have been specified by the user supplied routine driver.
Xc
X#ifdef SINGLERQ
X call lockon(hrlock)
X#else
X do 150 j = 1,nprocc
X call lockon(hrlock(j))
X 150 continue
X#endif
Xc
Xc now spawn virtual processors. these generic work routines will
Xc assume the identity of any schedulable process specified by driver.
Xc
X do 200 j = 1,nproc
X call work(j,ispace(j))
X 200 continue
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X return
Xc
Xc last card of libopn
Xc
X end
Xc
X subroutine lockoff(ilock)
X integer ilock
X ilock = 0
X return
X end
Xc
X subroutine lockon(ilock)
X integer ilock
X ilock = 1
X return
X end
X subroutine name(jobtag,myname)
X parameter (mxprcs = 1000)
X character*6 names,myname
X common /calls/ names(mxprcs)
X names(jobtag) = myname
X return
Xc
Xc last card of name
Xc
X end
Xc
X subroutine nops
X j = 1
X return
X end
X#ifdef SINGLERQ
X subroutine nxtag(jobtag,mypar,cost)
X#else
X subroutine nxtag(jobtag,mypar)
X#endif
Xcvd$r noconcur
Xcaution: nxtag arguments are consistent with dep now, but order of
Xcont: arguments may not be consistent with older versions of ftsubs.f.
X integer jobtag,mypar
Xc***********************************************************************
Xc
Xc
Xc this subroutine puts parental dependencies for problem on the
Xc queue. the arguments of spawn specify a process for this job.
Xc
Xc jobtag is an integer specifying a unique column of parmq.
Xc
Xc mypar is an integer specifying the parent of the dynamically
Xc spawned process jobtag.
Xc
Xc
Xc***********************************************************************
Xc
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc
Xc common block description:
Xc
Xc for a complete common block description see the subroutine libopn
Xc
Xc
Xc
Xc place this process on the free slot in the problem queue
Xc obtained from subprogram gettag.
Xc
X parmq(1,jobtag) = 1
X parmq(2,jobtag) = 0
X parmq(3,jobtag) = 1
X parmq(6,jobtag) = mypar
X#ifdef SINGLERQ
X xlevel(jobtag) = cost
X#endif
Xc
Xcgraph call lockon(glock)
Xcgraph if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcgraph insrt = endgrf
Xcgraph endgrf = endgrf + 1
Xcgraph call lockoff(glock)
Xcgraph inext = unitag(jobtag)
Xcgraphc trace for nxtag
Xcgraph igraph(1,insrt) = 3
Xcgraph igraph(2,insrt) = mypar
Xcgraph igraph(3,insrt) = inext
Xcgraph gnames(insrt) = names(jobtag)
Xc
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xctermc trace for nxtag
Xcterm igraph(1,insrt) = 3
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = mypar
Xcterm igraph(4,insrt) = fhead
Xcterm igraph(5,insrt) = ftail
Xcterm igraph(6,insrt) = jobtag
Xcterm gnames(insrt) = names(jobtag)
Xc
Xc update the icango counter of the parent process
Xc by adding 2 to parmq(2,mypar)... prevents race condition.
Xc add 1 to the number of kids spawned by parent mypar
Xc
X call lockon(qlock(mypar))
X parmq(2,mypar) = parmq(2,mypar) + 2
X parmq(4,mypar) = parmq(4,mypar) + 1
X call lockoff(qlock(mypar))
Xc
Xc set number of kids spawned by jobtag to zero
Xc
X parmq(4,jobtag) = 0
Xc
Xc
Xc
X return
Xc
Xc last card of nxtag
Xc
X end
X subroutine place(jobtag)
Xcvd$r noconcur
X integer jobtag
Xc*************************************************************************
Xc
Xc
Xc this subroutine places a problem on the readyq
Xc
Xc jobtag is an integer specifying a unique column of parmq.
Xc
Xc
Xc icango is a positive integer specifying how many processes must check
Xc into this process before it can be placed on the readyq.
Xc
Xc
Xc*************************************************************************
Xc
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Xc
Xc common block description:
Xc
Xc for a complete common block description see the subroutine libopn
Xc
Xc place this process on readyq if icango is 0
Xc when icango .eq. 0 this process does not depend on any
Xc others.
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Xc
X mtail = 0
X icango = parmq(2,jobtag)
X#ifndef SINGLERQ
X idrsq = mod((jobtag-1),nprocc) + 1
X#endif
X if (icango .eq. 0 ) then
X#ifdef SINGLERQ
X mtail = addrq(jobtag)
X#else
X call lockon(trlock(idrsq))
X if(mod(rtail(idrsq),ndmrsq) + 1 .ne. rhead(idrsq)) then
X readyq(rtail(idrsq)+ndmrsq*(idrsq-1)) = jobtag
X rtail(idrsq) = mod(rtail(idrsq),ndmrsq) + 1
X else
X mtail = -1
X endif
X call lockoff(trlock(idrsq))
X#endif
X endif
Xchange:
Xcterm call lockon(glock)
Xcterm if (endgrf .gt. nbuffr) call dump(endgrf,igraph)
Xcterm insrt = endgrf
Xcterm endgrf = endgrf + 1
Xcterm call lockoff(glock)
Xcterm inext = unitag(jobtag)
Xctermc trace for place
Xcterm igraph(1,insrt) = 6
Xcterm igraph(2,insrt) = inext
Xcterm igraph(3,insrt) = idrsq
Xcterm igraph(4,insrt) = rhead(idrsq)
Xcterm igraph(5,insrt) = rtail(idrsq)
Xcterm igraph(6,insrt) = icango
Xcterm igraph(7,insrt) = jobtag
Xcterm igraph(8,insrt) = second(foo)
Xcterm gnames(insrt) = names(jobtag)
Xc
X if (mtail .lt. 0) then
X write(6,*) '*************sched limit error********************'
X write(6,*) ' user attempt to create too many processes'
X write(6,*) ' exceeding the space in the readyq'
X#ifdef SINGLERQ
X write(6,*) ' the maximum allowed is ',ldimrq
X#else
X write(6,*) ' the maximum allowed is ',ndmrsq,' per sub-q'
X#endif
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine place'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xc
X return
Xc
Xc last card of place
Xc
X end
X subroutine reset(jobtag,nreset)
Xcvd$r noconcur
X integer jobtag,nreset
Xc**************************************************************************
Xc
Xc this subroutine saves reset values of icango if nreset .ne. 0.
Xc
Xc nreset is the integer flag specifing that job jobtag can have its
Xc dependencies reset to the originals for the next iteration.
Xc
Xc**************************************************************************
Xc
X#include "newsched.h"
X if (nreset .ne. 0) then
X ireset(jobtag) = nreset
X icnsav(jobtag) = parmq(2,jobtag)
X endif
Xc
X return
Xc
Xc last card of reset
Xc
X end
X subroutine rsched(jobtag,settag,kreset)
Xcvd$r noconcur
X integer jobtag,settag,kreset
Xc*************************************************************************
Xc
Xcomment: usage
Xc subroutine paralg(<subargs>)
Xc integer strtag,stptag,itag(*)
Xc external start,test
Xc .
Xc .
Xc call gettag(strtag)
Xc itag(strtag) = strtag
Xc .
Xc .
Xc call gettag(stptag)
Xc itag(stptag) = stptag
Xc .
Xc .
Xcomment: start iteration or time stepping
Xc jobtag = strtag
Xc icango = 1
Xc nchks = ...
Xc nreset = <positive number for iteration set>
Xc .
Xc .
Xc call dep(jobtag,icango,nchks,mychkn)
Xc call reset(jobtag,nreset)
Xc call putq(jobtag,start,itag(strtag))
Xc .
Xc .
Xcomment: test and continue iteration at start if undone
Xc jobtag = testag
Xc icango = ...
Xc nreset = <positive number for iteration set>
Xc .
Xc .
Xc call dep(jobtag,icango,nchks,mychkn)
Xc call reset(jobtag,nreset)
Xc call putq(jobtag,test,itag(strtag),itag(stptag))
Xc .
Xc .
Xc subroutine test(jobtag,strtag,stptag)
Xc common /<label>/ <finished>
Xc .
Xc .
Xc if(<finished>) then
Xc kreset = <positive number for iteration set>
Xc call rsched(jobtag,strtag,kreset)
Xc else
Xc kreset = 0
Xc call rsched(jobtag,stptag,kreset)
Xc endif
Xc return
Xc end
Xc
Xc this subroutine restores the icangoes of jobtags that work in
Xc an iteration of a loop and calls place to place the reset jobtags
Xc back on the ready queue. only those jobtags with
Xc ireset(*) = kreset are reset.
Xc
Xc
Xc jobtag is an integer job tag of the calling test subroutine,
Xc that tests whether or not the iteration is done.
Xc
Xc strtag is an integer job tag of the iteration starting node.
Xc
Xc stptag is an integer job tag of the iteration stopping node.
Xc
Xc settag is an integer job tag of the iteration reset node, strtag if
Xc kreset = <nonzero> and stptag if kreset = 0.
Xc
Xc kreset is an integer iteration number specifying how a resetting of
Xc parmq and replacement on the readyq is in progress.
Xc
Xc*************************************************************************
Xc
X#include "newsched.h"
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Xc
Xc common block description:
Xc
Xc for a complete common block description see the subroutine libopn
Xc
Xcccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc
Xc
X mtail = 0
X if(kreset.ne.0) then
X parmq(6,jobtag) = settag
X jmax = min0(mxprcs,snext)
X do 1111 j = 1,jmax
X if(ireset(j).eq.kreset) then
X if(j.ne.settag) then
X parmq(2,j) = icnsav(j)
X else
X parmq(2,j) = 1
X endif
X icango = parmq(2,j)
Xcaution: dynamic spawning nodes must have nentries reset to 1
X parmq(1,j) = 1
X parmq(5,j) = 0
Xc
Xcaution: what about race condition for dynamically spawned jobs?
Xcaution: what about resetting nkids = parmq(4,j)?
Xc
X#ifndef SINGLERQ
X idrsq = mod((j-1),nprocc) + 1
X#endif
X if (icango .eq. 0 ) then
X#ifdef SINGLERQ
X mtail = addrq(j)
X#else
X call lockon(trlock(idrsq))
X if(mod(rtail(idrsq),ndmrsq) + 1 .ne. rhead(idrsq)) then
X readyq(rtail(idrsq)+ndmrsq*(idrsq-1)) = j
X rtail(idrsq) = mod(rtail(idrsq),ndmrsq) + 1
X else
X mtail = -1
X endif
X call lockoff(trlock(idrsq))
X#endif
X endif
Xc
X endif
X1111 continue
X else
Xcomment: kreset = 0 and the stop tag must be restored.
X parmq(6,jobtag) = settag
X endif
Xc
X if (mtail .lt. 0) then
X write(6,*) '*************sched limit error********************'
X write(6,*) ' user attempt to create too many processes'
X write(6,*) ' exceeding the space in the readyq'
X#ifdef SINGLERQ
X write(6,*) ' the maximum allowed is ',ldimrq
X#else
X write(6,*) ' the maximum allowed is ',ndmrsq,' per sub-q'
X#endif
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine rsched'
Xcgraph call dump(endgrf,igraph)
X stop
X endif
Xc
X return
Xc
Xc last card of rsched
Xc
X end
X subroutine start2
Xc
Xc this routine allows parallel processing to start after user supplied
Xc driver has completed by unlocking the head of the readyq
Xc
X#include "newsched.h"
X logical nostrt
Xcgraph integer endgrf
Xcgraph integer glock
Xcgraph real igraph
Xcgraph character*6 names,gnames
Xcgraph common /calls/ names(mxprcs)
Xcgraph common /gphnam/ gnames(nbuffr)
Xcgraph common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xcterm integer endgrf
Xcterm integer glock
Xcterm real igraph
Xcterm character*6 names,gnames
Xcterm common /calls/ names(mxprcs)
Xcterm common /gphnam/ gnames(nbuffr)
Xcterm common /gphout/ endgrf,igraph(nslots,nbuffr),glock
Xc
Xc
Xc for common block description see subroutine libopn.
Xc
X if (done .ne. 0) then
X write(6,*) '*************sched user error********************'
X if (done .eq. -1 ) then
X write(6,*) ' no process has set nchks equal to 0 '
X else
X write(6,*) ' more than one process has set nchks to 0 '
X endif
X write(6,*) ' schedule will not be able to terminate job'
X write(6,*) ' correctly '
X write(6,*) ' '
X write(6,*) ' check subroutine passed to initial call to'
X write(6,*) ' to see that at exactly one call to dep has '
X write(6,*) ' set nchks = 0 '
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine start2'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xc
X#ifdef SINGLERQ
X if (rhead .eq. rtail) then
X#else
X nostrt = .true.
X do 100 iw = 1,nprocc
X if (rhead(iw) .ne. rtail(iw)) nostrt = .false.
X 100 continue
X if (nostrt) then
X#endif
X write(6,*) '*************sched user error********************'
X write(6,*) ' no process had an intitial icango of 0 '
X write(6,*) ' schedule could not begin '
X write(6,*) ' '
X write(6,*) ' check subroutine passed to initial call to'
X write(6,*) ' to see that at least one call to dep has '
X write(6,*) ' set icango = 0 '
X write(6,*) ' '
X write(6,*) 'execution terminated by sched in subroutine start2'
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xchange: intspn correction to recover lost jobtag.
Xc intspn is the unique tag of the first or initially spawned process.
X intspn = snext + 1
Xc
X#ifdef SINGLERQ
X call lockoff(hrlock)
X#else
X do 200 iw = 1,nprocc
X call lockoff(hrlock(iw))
X 200 continue
X#endif
Xc
X return
Xc
Xc last card of start2
Xc
X end
X logical function wait(mypar,ienter)
Xc
X integer mypar,ienter
Xc*****************************************************************************
Xc
Xc this routine will allow process mypar to continue after
Xc spawned processes have all checked in. it should only be called if
Xc processes have been spawned by mypar through the use of
Xc the subroutine spawn. this routine must be used in conjunction with
Xc subroutine prtspn. the required syntax is
Xc
Xc go to (1000,...,l000,...,n000), ientry(mypar,n)
Xc 1000 continue
Xc .
Xc .
Xc .
Xc do 100 j = 1,nproc
Xc .
Xc . (set parameters to define spawned process)
Xc .
Xc call nxtag(jobtag,mypar)
Xc call spawn(jobtag,mypar,subname,<parms>)
Xc 100 continue
Xc label = l
Xc if (wait(mypar,label)) return
Xc l000 continue
Xc .
Xc .
Xc .
Xc
Xc if this subroutine returns a value of .true. then the calling process
Xc mypar should issue a return. if a value of .false. is returned then
Xc the calling process mypar should resume execution at the
Xc statement immediately following the reference to wait (ie. at l000 in
Xc the example above. a return value .true. indicates that some spawned
Xc process has not yet completed and checked in. a return value .false.
Xc indicates all spawned processes have checked in.
Xc
Xc***********************************************************************
X#include "newsched.h"
Xc
Xc
Xc check the icango counter to see if all spawned processes (kids)
Xc have checked in.
Xc
X inext = unitag(mypar)
X icango = 1
X call lockon(qlock(mypar))
X icango = parmq(2,mypar) - parmq(4,mypar)
X call lockoff(qlock(mypar))
Xc
X if (icango .eq. 0) then
Xc
Xc all kids are done ... dont wait (ie return false)
Xc
X wait = .false.
Xc
Xc record re_entry label where computation is to
Xc resume after wait is complete
Xc
X parmq(1,mypar) = ienter
Xc
X if (ienter .gt. parmq(5,mypar)) then
X write(6,*) '*************sched limit error*****************'
X write(6,*) ' executing schedule function wait '
X write(6,*) ' return label larger than the maximum '
X write(6,*) ' specified by user in call to ientry '
X write(6,*) ' from parent process ', inext
X write(6,*) ' '
X write(6,*) ' the maximum reentry number is '
X write(6,*) ' ', parmq(5,mypar)
X write(6,*) ' '
X write(6,*) ' execution terminated by sched '
Xcgraph call dump(endgrf,igraph)
Xcterm call dump(endgrf,igraph)
X stop
X endif
Xc
Xc set last re_entry indication (parmq(5,mypar) = 0)
Xc if this reentry point corresponds to last one
Xc (recorded in parmq(5,mypar) during call to ientry)
Xc
X if (ienter .eq. parmq(5,mypar)) parmq(5,mypar) = 0
Xc
X else
Xc
Xc kids are not done
Xc
X wait = .true.
Xc
Xc a checkin will be made so set the number of
Xc entries to return label ienter - 1 to get
Xc correct entry point after checkin
Xc
X parmq(1,mypar) = ienter - 1
Xc
X endif
Xc
X return
Xc
Xc last card of wait
Xc
X end
X#ifdef SINGLERQ
X integer function addrq(jobtag)
X parameter (mxprcs = 1000,iprcs = 200,mxces = 8,nslots = 105)
X parameter (nbuffr = 500,ldimrq = 8*iprcs)
X integer parmq,freeq,readyq,intspn,rhead,rtail,
X & done,free,fhead,ftail,snext,unitag
X & ,ireset,icnsav
X integer qlock,hrlock,trlock,hflock,tflock
X common /qdata/ parmq(nslots,mxprcs),freeq(mxprcs),intspn,
X & readyq(ldimrq),rhead,rtail,
X & ndmrsq,nprocc,fhead,ftail,snext,unitag(mxprcs),
X & xlevel(mxprcs)
X common /qsync/ qlock(mxprcs),hrlock,trlock,
X & done,free,hflock,tflock
X common /qreset/ ireset(mxprcs),icnsav(mxprcs)
X integer addrq
Xc
Xc put on single ready q; lock, find spot and place there
Xc
X cost = xlevel(jobtag)
X call lockon(trlock)
X if (mod(rtail,ldimrq)+1 .eq. rhead) then
Xc ready queue is full; exit with error
X addrq = -1
X return
X else
X addrq = 0
X endif
X iplace = rhead
X if (rhead .le. rtail) then
X 10 if (cost .le. xlevel(readyq(iplace)) .and.
X & iplace .lt. rtail-1) then
X iplace = iplace + 1
X goto 10
X endif
Xc
X if (iplace .le. rtail-1) then
X do 20 i = rtail, iplace+1, -1
X readyq(i) = readyq(i-1)
X 20 continue
X endif
X readyq(iplace) = jobtag
X rtail = mod(rtail,ldimrq) + 1
X else
X 30 idum = mod(iplace,ldimrq)+1
X if (cost .le. xlevel(readyq(iplace)) .and.
X & idum .ne. rtail) then
X iplace = idum
X goto 30
X endif
Xc
X if (idum .ne. rtail) then
X if (iplace .lt. rtail) then
Xc
Xc place jobtag in the wrapped portion; handle as if we weren't wrapped
Xc
X do 40 i = rtail, idum, -1
X readyq(i) = readyq(i-1)
X 40 continue
Xc
X else
Xc
Xc place jobtag in the unwrapped portion; move jobs on low side of
Xc the q, then move the end job to the first spot in the q, then move
Xc jobs in the high side of the queue
Xc
X do 50 i = rtail, 2, -1
X readyq(i) = readyq(i-1)
X 50 continue
X readyq(1) = readyq(ldimrq)
X do 60 i = ldimrq, iplace+1, -1
X readyq(i) = readyq(i-1)
X 60 continue
X endif
X endif
Xc
X readyq(iplace) = jobtag
X rtail = rtail + 1
X endif
Xc
X call lockoff(trlock)
X return
X end
X#endif
END_OF_FILE
if test 76182 -ne `wc -c <'ftsubs.F'`; then
echo shar: \"'ftsubs.F'\" unpacked with wrong size!
fi
# end of 'ftsubs.F'
fi
if test -f 'indx0.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'indx0.h'\"
else
echo shar: Extracting \"'indx0.h'\" \(2372 characters\)
sed "s/^X//" >'indx0.h' <<'END_OF_FILE'
X indx[0].subname(indx[0].parms[0], indx[0].parms[1],
X indx[0].parms[2], indx[0].parms[3],
X indx[0].parms[4], indx[0].parms[5],
X indx[0].parms[6], indx[0].parms[7],
X indx[0].parms[8], indx[0].parms[9],
X indx[0].parms[10], indx[0].parms[11],
X indx[0].parms[12], indx[0].parms[13],
X indx[0].parms[14], indx[0].parms[15],
X indx[0].parms[16], indx[0].parms[17],
X#ifndef MOREPARMS
X indx[0].parms[18], indx[0].parms[19]);
X#else
X indx[0].parms[18], indx[0].parms[19],
X indx[0].parms[20], indx[0].parms[21],
X indx[0].parms[22], indx[0].parms[23],
X indx[0].parms[24], indx[0].parms[25],
X indx[0].parms[26], indx[0].parms[27],
X indx[0].parms[28], indx[0].parms[29],
X indx[0].parms[30], indx[0].parms[31],
X indx[0].parms[32], indx[0].parms[33],
X indx[0].parms[34], indx[0].parms[35],
X indx[0].parms[36], indx[0].parms[37],
X indx[0].parms[38], indx[0].parms[39],
X indx[0].parms[40], indx[0].parms[41],
X indx[0].parms[42], indx[0].parms[43],
X indx[0].parms[44], indx[0].parms[45],
X indx[0].parms[46], indx[0].parms[47],
X indx[0].parms[48], indx[0].parms[49],
X indx[0].parms[50], indx[0].parms[51],
X indx[0].parms[52], indx[0].parms[53],
X indx[0].parms[54], indx[0].parms[55],
X indx[0].parms[56], indx[0].parms[57],
X indx[0].parms[58], indx[0].parms[59],
X indx[0].parms[60], indx[0].parms[61],
X indx[0].parms[62], indx[0].parms[63],
X indx[0].parms[64], indx[0].parms[65],
X indx[0].parms[66], indx[0].parms[67],
X indx[0].parms[68], indx[0].parms[69],
X indx[0].parms[70], indx[0].parms[71],
X indx[0].parms[72], indx[0].parms[73],
X indx[0].parms[74], indx[0].parms[75],
X indx[0].parms[76], indx[0].parms[77],
X indx[0].parms[78], indx[0].parms[79],
X indx[0].parms[80], indx[0].parms[81],
X indx[0].parms[82], indx[0].parms[83],
X indx[0].parms[84], indx[0].parms[85],
X indx[0].parms[86], indx[0].parms[87],
X indx[0].parms[88], indx[0].parms[89],
X indx[0].parms[90], indx[0].parms[91],
X indx[0].parms[92], indx[0].parms[93],
X indx[0].parms[94], indx[0].parms[95],
X indx[0].parms[96], indx[0].parms[97],
X indx[0].parms[98], indx[0].parms[99]);
X#endif
END_OF_FILE
if test 2372 -ne `wc -c <'indx0.h'`; then
echo shar: \"'indx0.h'\" unpacked with wrong size!
fi
# end of 'indx0.h'
fi
if test -f 'indxj.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'indxj.h'\"
else
echo shar: Extracting \"'indxj.h'\" \(2730 characters\)
sed "s/^X//" >'indxj.h' <<'END_OF_FILE'
X indx[j].subname(indx[j].parms[0], indx[j].parms[1],
X indx[j].parms[2], indx[j].parms[3],
X indx[j].parms[4], indx[j].parms[5],
X indx[j].parms[6], indx[j].parms[7],
X indx[j].parms[8], indx[j].parms[9],
X indx[j].parms[10], indx[j].parms[11],
X indx[j].parms[12], indx[j].parms[13],
X indx[j].parms[14], indx[j].parms[15],
X indx[j].parms[16], indx[j].parms[17],
X#ifndef MOREPARMS
X indx[j].parms[18], indx[j].parms[19]);
X#else
X indx[j].parms[18], indx[j].parms[19],
X indx[j].parms[20], indx[j].parms[21],
X indx[j].parms[22], indx[j].parms[23],
X indx[j].parms[24], indx[j].parms[25],
X indx[j].parms[26], indx[j].parms[27],
X indx[j].parms[28], indx[j].parms[29],
X indx[j].parms[30], indx[j].parms[31],
X indx[j].parms[32], indx[j].parms[33],
X indx[j].parms[34], indx[j].parms[35],
X indx[j].parms[36], indx[j].parms[37],
X indx[j].parms[38], indx[j].parms[39],
X indx[j].parms[40], indx[j].parms[41],
X indx[j].parms[42], indx[j].parms[43],
X indx[j].parms[44], indx[j].parms[45],
X indx[j].parms[46], indx[j].parms[47],
X indx[j].parms[48], indx[j].parms[49],
X indx[j].parms[50], indx[j].parms[51],
X indx[j].parms[52], indx[j].parms[53],
X indx[j].parms[54], indx[j].parms[55],
X indx[j].parms[56], indx[j].parms[57],
X indx[j].parms[58], indx[j].parms[59],
X indx[j].parms[60], indx[j].parms[61],
X indx[j].parms[62], indx[j].parms[63],
X indx[j].parms[64], indx[j].parms[65],
X indx[j].parms[66], indx[j].parms[67],
X indx[j].parms[68], indx[j].parms[69],
X indx[j].parms[70], indx[j].parms[71],
X indx[j].parms[72], indx[j].parms[73],
X indx[j].parms[74], indx[j].parms[75],
X indx[j].parms[76], indx[j].parms[77],
X indx[j].parms[78], indx[j].parms[79],
X indx[j].parms[80], indx[j].parms[81],
X indx[j].parms[82], indx[j].parms[83],
X indx[j].parms[84], indx[j].parms[85],
X indx[j].parms[86], indx[j].parms[87],
X indx[j].parms[88], indx[j].parms[89],
X indx[j].parms[90], indx[j].parms[91],
X indx[j].parms[92], indx[j].parms[93],
X indx[j].parms[94], indx[j].parms[95],
X indx[j].parms[96], indx[j].parms[97],
X indx[j].parms[98], indx[j].parms[99]);
X#endif
END_OF_FILE
if test 2730 -ne `wc -c <'indxj.h'`; then
echo shar: \"'indxj.h'\" unpacked with wrong size!
fi
# end of 'indxj.h'
fi
if test -f 'make1' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'make1'\"
else
echo shar: Extracting \"'make1'\" \(568 characters\)
sed "s/^X//" >'make1' <<'END_OF_FILE'
X#
XCPPFLAGS =
X#CPPFLAGS = -DSINGLERQ
X#CPPFLAGS = -DMOREPARMS
XFILES = ftsubs.o putq.o second.o
XFILES2 = ftsubs.graph.o putq.o second.o
X
Xsched : $(FILES)
X rm -f sched.a; ar q sched.a $(FILES); ranlib sched.a
X
Xgraph : $(FILES2)
X rm -f graph.a; ar q graph.a $(FILES2); ranlib graph.a
X
Xftsubs.f : ftsubs.F newsched.h
X /lib/cpp -P $(CPPFLAGS) ftsubs.F ftsubs.f
Xftsubs.graph.f : ftsubs.F newsched.h
X sed 's/^cgraph//' ftsubs.F | /lib/cpp -P $(CPPFLAGS) > ftsubs.graph.f
X
X#.F.f : ; /lib/cpp -P $(CPPFLAGS) $*.F $*.f
X.f.o : ; f77 -g -c $*.f
X.c.o : ; cc $(CPPFLAGS) -g -c $*.c
END_OF_FILE
if test 568 -ne `wc -c <'make1'`; then
echo shar: \"'make1'\" unpacked with wrong size!
fi
# end of 'make1'
fi
if test -f 'makefile' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'makefile'\"
else
echo shar: Extracting \"'makefile'\" \(760 characters\)
sed "s/^X//" >'makefile' <<'END_OF_FILE'
XFILES1 = stuffspawn.o
Xxtest : $(FILES1)
X f77 $(FILES1) sched.a -o xtest
Xgtest : $(FILES1)
X f77 $(FILES1) graph.a -o gtest
X
XFILES2 = d_and_c.o
Xxdandc : $(FILES2)
X f77 $(FILES2) sched.a -o xdandc
Xgdandc : $(FILES2)
X f77 $(FILES2) graph.a -o gdandc
X
XFILES6 = example.o
Xxexample : $(FILES6)
X f77 $(FILES6) sched.a -o xexample
Xgexample : $(FILES6)
X f77 $(FILES6) graph.a -o gexample
X
XFILES7 = ts_dynamic.o
Xxts_dynamic : $(FILES7)
X f77 $(FILES7) sched.a -o xts_dynamic
Xgts_dynamic : $(FILES7)
X f77 $(FILES7) graph.a -o gts_dynamic
X
XFILES8 = blkjac.o
Xxblkjac : $(FILES8)
X f77 $(FILES8) sched.a -o xblkjac
Xgblkjac : $(FILES8)
X f77 $(FILES8) graph.a -o gblkjac
X
Xsched:
X make -f make1 sched
Xgraph:
X make -f make1 graph
X
Xclean:
X /bin/rm -f *.o *~
X
X.f.o : ; f77 -c $*.f
END_OF_FILE
if test 760 -ne `wc -c <'makefile'`; then
echo shar: \"'makefile'\" unpacked with wrong size!
fi
# end of 'makefile'
fi
if test -f 'newsched.h' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'newsched.h'\"
else
echo shar: Extracting \"'newsched.h'\" \(1034 characters\)
sed "s/^X//" >'newsched.h' <<'END_OF_FILE'
X parameter (mxprcs = 1000,iprcs = 200,mxces = 8,nslots = 105)
X parameter (nbuffr = 500,ldimrq = 8*iprcs)
X integer parmq,freeq,readyq,intspn,rhead,rtail,
X & done,free,fhead,ftail,snext,unitag
X & ,ireset,icnsav
X integer qlock,hrlock,trlock,hflock,tflock
X#ifdef SINGLERQ
X common /qdata/ parmq(nslots,mxprcs),freeq(mxprcs),intspn,
X & readyq(ldimrq),rhead,rtail,
X & ndmrsq,nprocc,fhead,ftail,snext,unitag(mxprcs),
X & xlevel(mxprcs)
X common /qsync/ qlock(mxprcs),hrlock,trlock,
X & done,free,hflock,tflock
X#else
X common /qdata/ parmq(nslots,mxprcs),freeq(mxprcs),intspn,
X & readyq(ldimrq),rhead(mxces),rtail(mxces),
X & ndmrsq,nprocc,fhead,ftail,snext,unitag(mxprcs)
X common /qsync/ qlock(mxprcs),hrlock(mxces),trlock(mxces),
X & done,free,hflock,tflock
X#endif
X common /qreset/ ireset(mxprcs),icnsav(mxprcs)
X external addrq
X integer addrq
END_OF_FILE
if test 1034 -ne `wc -c <'newsched.h'`; then
echo shar: \"'newsched.h'\" unpacked with wrong size!
fi
# end of 'newsched.h'
fi
if test -f 'oldtest' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'oldtest'\"
else
echo shar: Extracting \"'oldtest'\" \(8620 characters\)
sed "s/^X//" >'oldtest' <<'END_OF_FILE'
Xmake -f make1 sched
X/lib/cpp -P ftsubs.F ftsubs.f
Xf77 -g -c ftsubs.f
Xftsubs.f:
X chekin:
X dep:
X dump:
X gettag:
X gtprb:
X ientry:
X libopn:
X lockoff:
X lockon:
X name:
X nops:
X nxtag:
X place:
X reset:
X rsched:
X start2:
X wait:
Xcc -g -c putq.c
Xf77 -g -c second.f
Xsecond.f:
X second:
Xrm -f sched.a; ar q sched.a ftsubs.o putq.o second.o; ranlib sched.a
Xar: creating sched.a
Xmake -f make1 graph
Xsed 's/^cgraph//' ftsubs.F | /lib/cpp -P > ftsubs.graph.f
Xf77 -g -c ftsubs.graph.f
Xftsubs.graph.f:
X chekin:
X dep:
X dump:
X gettag:
X gtprb:
X ientry:
X libopn:
X lockoff:
X lockon:
X name:
X nops:
X nxtag:
X place:
X reset:
X rsched:
X start2:
X wait:
Xrm -f graph.a; ar q graph.a ftsubs.graph.o putq.o second.o; ranlib graph.a
Xar: creating graph.a
Xf77 -c stuffspawn.f
Xstuffspawn.f:
X MAIN:
X paralg:
X stuff1:
X stuff2:
X stuff3:
Xf77 stuffspawn.o sched.a -o xtest
X input nprocs
X time = 2.22000 nprocs = 1
X 1.0000000000000
X -4.0000000000000
X -6.0000000000000
X -8.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 2.0000000000000
X -6.0000000000000
X -8.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 3.0000000000000
X -8.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 4.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 5.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 6.0000000000000
X -14.000000000000
X -16.000000000000
X 7.0000000000000
X -16.000000000000
X 8.0000000000000
Xf77 stuffspawn.o graph.a -o gtest
X input nprocs
X time = 2.59000 nprocs = 1
X 1.0000000000000
X -4.0000000000000
X -6.0000000000000
X -8.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 2.0000000000000
X -6.0000000000000
X -8.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 3.0000000000000
X -8.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 4.0000000000000
X -10.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 5.0000000000000
X -12.000000000000
X -14.000000000000
X -16.000000000000
X 6.0000000000000
X -14.000000000000
X -16.000000000000
X 7.0000000000000
X -16.000000000000
X 8.0000000000000
Xf77 -c d_and_c.f
Xd_and_c.f:
X MAIN:
X top:
X split:
Xf77 d_and_c.o sched.a -o xdandc
X input nprocs nlevls
X 1
X 2
X 3
X 4
X 5
X 6
X 7
Xf77 d_and_c.o graph.a -o gdandc
X input nprocs nlevls
X 1
X 2
X 3
X 4
X 5
X 6
X 7
Xf77 -c example.f
Xexample.f:
X MAIN main:
X parprd:
X inprod:
X addup:
Xf77 example.o sched.a -o xexample
XInput number of processors
X sigma = 500500.
Xf77 example.o graph.a -o gexample
XInput number of processors
X sigma = 500500.
Xf77 -c ts_dynamic.f
Xts_dynamic.f:
X MAIN dynamc:
X paralg:
X stuff1:
X stuff2:
Xf77 ts_dynamic.o sched.a -o xts_dynamic
X 1.
X 47. 5.
X 51. 209. 9.
X 55. 213. 355. 13.
X 59. 217. 359. 485. 17.
X 63. 221. 363. 489. 599. 21.
X 67. 225. 367. 493. 603. 697. 25.
X 71. 229. 371. 497. 607. 701. 779. 29.
X 75. 233. 375. 501. 611. 705. 783. 845. 33.
X 79. 237. 379. 505. 615. 709. 787. 849. 895. 37.
X 83. 241. 383. 509. 619. 713. 791. 853. 899. 929. 41.
X 85. 243. 385. 511. 621. 715. 793. 855. 901. 931. 945.
X 43.
X # ts_dynamic.f = pgm.f schedule gettag & name program
X # ftsubs.f for circular readyq & parmq & freeq version
X # with nblks = 43; niter = 1000; maxjobs = 946
X # 1 2.28000
X code norder niter nprocs maxjobs seconds
X ts_dynamic.f 43 1000 1 946 2.28000
Xf77 ts_dynamic.o graph.a -o gts_dynamic
X 1.
X 47. 5.
X 51. 209. 9.
X 55. 213. 355. 13.
X 59. 217. 359. 485. 17.
X 63. 221. 363. 489. 599. 21.
X 67. 225. 367. 493. 603. 697. 25.
X 71. 229. 371. 497. 607. 701. 779. 29.
X 75. 233. 375. 501. 611. 705. 783. 845. 33.
X 79. 237. 379. 505. 615. 709. 787. 849. 895. 37.
X 83. 241. 383. 509. 619. 713. 791. 853. 899. 929. 41.
X 85. 243. 385. 511. 621. 715. 793. 855. 901. 931. 945.
X 43.
X # ts_dynamic.f = pgm.f schedule gettag & name program
X # ftsubs.f for circular readyq & parmq & freeq version
X # with nblks = 43; niter = 1000; maxjobs = 946
X # 1 5.29000
X code norder niter nprocs maxjobs seconds
X ts_dynamic.f 43 1000 1 946 5.29000
Xf77 -c blkjac.f
Xblkjac.f:
X MAIN blkjac:
X paralg:
X init:
X startt:
X jacobi:
X convrg:
X test:
X"blkjac.f", line 324: Warning: local variable "reset" never used
X stopit:
Xf77 blkjac.o sched.a -o xblkjac
X Warning: the following IEEE floating-point arithmetic exceptions
X occurred in this program and were never cleared:
X Inexact; Underflow;
X Static Block Jacobi Input:
X nprocs = 1; (m,n) = ( 100, 100); (mblks,nblks) = ( 10, 10)
X ; max iterations = 100; nprec = 2
X Parameter input:
X (mdim,ndim) = ( 102, 102); maxblkdim = 11
X ; maxprc = 8; nmychk = 110; (mbpts,nbpts) = ( 10, 10)
X (xmax,ymax) = ( 100.00, 100.00); nprec = 2( tol = 0.5000D-02)
X Static Block Jacobi - Iteration SCHEDULE Final Results:
X j/i 1 11 21 31 41 51 61 71 81 91 101 102
X 102 0.50 0.50 0.52 0.54 0.58 0.62 0.68 0.74 0.81 0.90 0.99 1.00
X 101 0.49 0.50 0.52 0.54 0.58 0.62 0.67 0.74 0.81 0.90 0.99 1.00
X 91 0.35 0.45 0.47 0.50 0.53 0.58 0.64 0.71 0.79 0.89 0.99 1.00
X 81 0.25 0.40 0.42 0.45 0.49 0.55 0.61 0.69 0.78 0.88 0.99 1.00
X 71 0.17 0.35 0.37 0.41 0.45 0.51 0.58 0.66 0.76 0.87 0.99 1.00
X 61 0.10 0.30 0.33 0.36 0.41 0.47 0.55 0.64 0.74 0.86 0.99 1.00
X 51 0.06 0.25 0.28 0.32 0.37 0.43 0.51 0.61 0.72 0.85 0.99 1.00
X 41 0.03 0.20 0.23 0.27 0.33 0.40 0.48 0.58 0.70 0.84 0.98 1.00
X 31 0.01 0.16 0.18 0.23 0.28 0.36 0.45 0.56 0.68 0.83 0.98 1.00
X 21 0.00 0.11 0.14 0.18 0.24 0.32 0.42 0.53 0.67 0.82 0.98 1.00
X 11 0.00 0.06 0.09 0.14 0.20 0.28 0.39 0.51 0.65 0.81 0.98 1.00
X 1 0.00 0.01 0.04 0.09 0.16 0.25 0.35 0.48 0.63 0.79 0.98 1.00
X # Static Block Jacobi Schedule rsched & gettag & name program
X # ftsubs.f for iterated circular readyq & parmq & freeq version
X # with mblks, nblks = 10 10; niter = 19; mxiter= 100
X # 1 28.85000
X code m n mblks nblks niter nprocs maxjobs
X BLOCK-JACOBI 100 100 10 10 19 1 1959
X STATIC VERSION seconds = 28.85000; uvdiff = 0.48139D-02
Xf77 blkjac.o graph.a -o gblkjac
X Warning: the following IEEE floating-point arithmetic exceptions
X occurred in this program and were never cleared:
X Inexact; Underflow;
X Static Block Jacobi Input:
X nprocs = 1; (m,n) = ( 100, 100); (mblks,nblks) = ( 10, 10)
X ; max iterations = 100; nprec = 2
X Parameter input:
X (mdim,ndim) = ( 102, 102); maxblkdim = 11
X ; maxprc = 8; nmychk = 110; (mbpts,nbpts) = ( 10, 10)
X (xmax,ymax) = ( 100.00, 100.00); nprec = 2( tol = 0.5000D-02)
X Static Block Jacobi - Iteration SCHEDULE Final Results:
X j/i 1 11 21 31 41 51 61 71 81 91 101 102
X 102 0.50 0.50 0.52 0.54 0.58 0.62 0.68 0.74 0.81 0.90 0.99 1.00
X 101 0.49 0.50 0.52 0.54 0.58 0.62 0.67 0.74 0.81 0.90 0.99 1.00
X 91 0.35 0.45 0.47 0.50 0.53 0.58 0.64 0.71 0.79 0.89 0.99 1.00
X 81 0.25 0.40 0.42 0.45 0.49 0.55 0.61 0.69 0.78 0.88 0.99 1.00
X 71 0.17 0.35 0.37 0.41 0.45 0.51 0.58 0.66 0.76 0.87 0.99 1.00
X 61 0.10 0.30 0.33 0.36 0.41 0.47 0.55 0.64 0.74 0.86 0.99 1.00
X 51 0.06 0.25 0.28 0.32 0.37 0.43 0.51 0.61 0.72 0.85 0.99 1.00
X 41 0.03 0.20 0.23 0.27 0.33 0.40 0.48 0.58 0.70 0.84 0.98 1.00
X 31 0.01 0.16 0.18 0.23 0.28 0.36 0.45 0.56 0.68 0.83 0.98 1.00
X 21 0.00 0.11 0.14 0.18 0.24 0.32 0.42 0.53 0.67 0.82 0.98 1.00
X 11 0.00 0.06 0.09 0.14 0.20 0.28 0.39 0.51 0.65 0.81 0.98 1.00
X 1 0.00 0.01 0.04 0.09 0.16 0.25 0.35 0.48 0.63 0.79 0.98 1.00
X # Static Block Jacobi Schedule rsched & gettag & name program
X # ftsubs.f for iterated circular readyq & parmq & freeq version
X # with mblks, nblks = 10 10; niter = 19; mxiter= 100
X # 1 36.18000
X code m n mblks nblks niter nprocs maxjobs
X BLOCK-JACOBI 100 100 10 10 19 1 1959
X STATIC VERSION seconds = 36.18000; uvdiff = 0.48139D-02
END_OF_FILE
if test 8620 -ne `wc -c <'oldtest'`; then
echo shar: \"'oldtest'\" unpacked with wrong size!
fi
# end of 'oldtest'
fi
if test -f 'putq.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'putq.c'\"
else
echo shar: Extracting \"'putq.c'\" \(4760 characters\)
sed "s/^X//" >'putq.c' <<'END_OF_FILE'
X#include <stdio.h>
X
X#ifdef MOREPARMS
X#define MAXPARMS 99
X#else
X#define MAXPARMS 20
X#endif
X
Xstruct parms {
X int (*subname)();
X long *parms[MAXPARMS];
X };
Xstruct parms indx[1001];
Xsched_(nprocs,arg0,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,
X#include "args.h"
Xint *nprocs;
Xint (*arg0)();
Xlong *arg1,*arg2,*arg3,*arg4,*arg5,*arg6,*arg7,*arg8,*arg9,*arg10,
X#include "defs.h"
X/*
X this procedure obtains nprocs physical processors devoted
X to the the execution of the parallel program indicated through parms
X which is a structure whose first entry is a subroutine name and whose
X remaining entries are parameters appearing in the calling sequence
X of that subroutine.
X*/
X{
X struct parms parms;
X int libopn_();
X
X#include "assign.h"
X
X bcopy(&parms, &indx[0], sizeof(struct parms));
X/*
X the subroutine name and prameter list have been copied and
X placed in a special slot on the parmq
X
X then libopn is invoked to initialize pointers, grab physical
X processors and begin the computation
X*/
X libopn_(nprocs);
X return(0);
X}
Xputq_(jobtag,arg0,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,
X#include "args.h"
Xint (*arg0)();
Xlong *arg1,*arg2,*arg3,*arg4,*arg5,*arg6,*arg7,*arg8,*arg9,*arg10,
X#include "defs.h"
Xint *jobtag;
X/*
X this procedure puts the descriptor of a schedulable process <jobtag>
X onto the problem queue. this process will be scheduled for execution
X when its data dependencies have been satisfied (indicated by icango==0).
X the argument parms is a structure whose first entry is a subroutine name
X and whose remaining entries are parameters appearing in the calling sequence
X of that subroutine.
X*/
X{
X struct parms parms;
X register int j;
X int place_();
X j = *jobtag;
X
X#include "assign.h"
X
X bcopy(&parms, &indx[j], sizeof(struct parms));
X/*
X first the parms block is copied into the slot pointed to by
X by jobtag and then this descriptor is placed on the problem
X queue
X*/
X place_(jobtag);
X return(0);
X}
Xspawn_(jobtag,parent,arg0,arg1,arg2,arg3,arg4,arg5,arg6,arg7,arg8,arg9,arg10,
X#include "args.h"
Xint (*arg0)();
Xlong *arg1,*arg2,*arg3,*arg4,*arg5,*arg6,*arg7,*arg8,*arg9,*arg10,
X#include "defs.h"
Xint *jobtag,*parent;
X/*
X this procedure puts the descriptor of a schedulable process <jobtag>
X onto the problem queue. this process will be scheduled for execution
X when its data dependencies have been satisfied (indicated by icango==0).
X the argument parms is a structure whose first entry is a subroutine name
X and whose remaining entries are parameters appearing in the calling sequence
X of that subroutine.
X
X the action of this procedure differs from putq in that the user does not
X assign jobtags or data dependencies. a parent may spawn any number of
X children but these child processes only report to the parent.
X*/
X{
X struct parms parms;
X register int j,i;
X int place_(),clone_();
X j = *jobtag;
X i = *parent;
X#include "assign.h"
X bcopy(&parms, &indx[j], sizeof(struct parms));
X/*
X first the parms block is copied into the slot pointed to by
X by jobtag and then this descriptor is placed on the problem
X queue
X*/
X if (indx[j].subname == clone_) indx[j].subname = indx[i].subname;
X/*
X here we ask if this is a recursive spawning. if so the name
X clone has been called instead of subname so we replace the name
X clone by subname.
X*/
X place_(jobtag);
X return(0);
X}
Xclone_()
X{
X/*
X this is a dummy routine to satisfy unresolved external
X*/
X return(0);
X}
Xwork_(id,jobtag)
Xint *id,*jobtag;
X{
X int start2_(),gtprb_();
X register int j,myjob;
X j = *id;
X if (j == 1)
X/*
X the worker whose id is 1 will execute the subroutine passed to
X sched. this subroutine executes the static data dependency graph.
X this graph must have at least one node.
X*/
X {
X
X#include "indx0.h"
X
X start2_();
X }
X myjob = gtprb_(id,jobtag);
X while (myjob != 0)
X {
X j = *jobtag;
X if (myjob <= -1 )
X {
X/*
X reenter... simple spawning was done
X all kids completed and no reentry
X is required. this indicates
X jobtag is all done and checkin can proceed.
X*/
X chekin_(jobtag);
X myjob = gtprb_(id,jobtag);
X }
X else
X {
X/*
X call subname(<parms>)..........
X*/
X
X#include "indxj.h"
X
X chekin_(jobtag);
X myjob = gtprb_(id,jobtag);
X }
X }
X return(0);
X}
END_OF_FILE
if test 4760 -ne `wc -c <'putq.c'`; then
echo shar: \"'putq.c'\" unpacked with wrong size!
fi
# end of 'putq.c'
fi
if test -f 'second.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'second.f'\"
else
echo shar: Extracting \"'second.f'\" \(141 characters\)
sed "s/^X//" >'second.f' <<'END_OF_FILE'
X real function second(t)
X real t
X real t1(2)
X t = etime(t1)
X t = t1(1)
X second = t
X return
X end
X
END_OF_FILE
if test 141 -ne `wc -c <'second.f'`; then
echo shar: \"'second.f'\" unpacked with wrong size!
fi
# end of 'second.f'
fi
if test -f 'stuffspawn.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'stuffspawn.f'\"
else
echo shar: Extracting \"'stuffspawn.f'\" \(3786 characters\)
sed "s/^X//" >'stuffspawn.f' <<'END_OF_FILE'
X double precision a,b
X common /prbdef/ a(1000),b(100),itmp(10),jtmp(10),myid(10)
X EXTERNAL PARALG
X nblks = 8
X do 10 j = 1,10
X itmp(j) = j
X jtmp(j) = j
X 10 continue
X write(6,*) ' input nprocs '
X read (5,*) nprocs
X t1 = second(foo)
Xc
X CALL SCHED(nprocs,paralg,nblks,a,b,itmp,jtmp,myid)
Xc
X t2 = second(foo)
X write(6,*) ' time = ',t2-t1,' nprocs = ',nprocs
X nn = 36
X do 100 j = 1,nn
X write(6,*) a(j)
X 100 continue
X stop
X end
Xc
X subroutine paralg(n,a,b,itmp,jtmp,myid)
X integer itmp(*),jtmp(*),myid(*)
X double precision a(*),b(*)
X integer mychkn(1)
X character*6 subnam
X EXTERNAL STUFF1
Xc
Xc this is the driver for filling a packed triangular matrix with
Xc i on the i-th diagonal and -(i+j) in the (i,j) off diagonal position
Xc
X do 150 j = 1, n
X call GETTAG(jobtag)
X myid(j) = jobtag
X 150 continue
Xc
X icount = 1
X do 200 j = 1, n
Xc
Xc the j-th diagonal waits for the diagonal above to complete
Xc the j-th diagonal completion will allow
Xc the (j+1)-st diagonal to start
Xc
X jobtag = myid(j)
X if (j .eq. 1) then
X icango = 0
X else
X icango = 1
X endif
X if (j .eq. n) then
X nchks = 0
X else
X nchks = 1
X mychkn(1) = myid(j + 1)
X endif
Xc
Xc we just set up data dependencies and are ready to put
Xc this process on the queue
Xc
X subnam = 'stuff1'
X CALL NAME(jobtag,subnam)
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL PUTQ(jobtag,stuff1,myid(j),n,a(icount),jtmp(j),itmp(1))
Xc
Xc when the data dependencies for process jobtag are satisfied
Xc the following call will be made
Xc
Xc call stuff1(myid....,itmp(1))
Xc
X icount = icount + (n-j+1)
X 200 continue
Xc
X return
X end
Xc
X subroutine stuff1(myid,n,a,j,itmp)
X double precision a(*)
X integer myid,n,j,itmp(*)
X logical wait
X character*6 subnam
X EXTERNAL STUFF2,STUFF3
Xc
X go to (1111,2222,3333),ientry(myid,3)
X 1111 continue
X ii = 2
X do 100 i = 2,n
Xc
X CALL GETTAG(jobtag)
X subnam = 'stuff2'
X CALL NAME(jobtag,subnam)
X CALL NXTAG(jobtag,myid)
X CALL SPAWN(jobtag,myid,stuff2,a(ii + 1),itmp(i),itmp(j))
Xc
Xc this spawns a process that will execute a call to stuff2
Xc and report completion to process MYID
Xc
X ii = ii + 1
X 100 continue
X call stuff2(a(2),itmp(1),itmp(j))
X if (wait(myid,2)) return
Xc
Xc return to help out and then return here (at label 2222)
Xc on the next reentry
Xc
X 2222 continue
X ii = 2
X do 200 i = 2,n
Xc
X CALL GETTAG(jobtag)
X subnam = 'stuff3'
X CALL NAME(jobtag,subnam)
X CALL NXTAG(jobtag,myid)
X CALL SPAWN(jobtag,myid,stuff3,a(ii + 1),itmp(i),itmp(j))
Xc
Xc this spawns a process that will execute a call to stuff3
Xc and report completion to process MYID
Xc
X ii = ii + 1
X 200 continue
X call stuff3(a(2),itmp(1),itmp(j))
X if (wait(myid,3)) return
X 3333 continue
X a(1) = j
Xc
X return
X end
X subroutine stuff2(a,i,j)
X double precision a(*),one
X one = 1.0d0
X a(1) = 0.0d0
X do 100 kk = 1,10000
X a(1) = a(1) + one
X 100 continue
X a(1) = -(i+j)
X return
X end
X subroutine stuff3(a,i,j)
X double precision a(*),one,save
X one = 1.0d0
X save = a(1)
X do 100 kk = 1,10000
X a(1) = a(1) + one
X 100 continue
X a(1) = -(i+j) + save
X return
X end
Xc
END_OF_FILE
if test 3786 -ne `wc -c <'stuffspawn.f'`; then
echo shar: \"'stuffspawn.f'\" unpacked with wrong size!
fi
# end of 'stuffspawn.f'
fi
if test -f 'testrun' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'testrun'\"
else
echo shar: Extracting \"'testrun'\" \(377 characters\)
sed "s/^X//" >'testrun' <<'END_OF_FILE'
Xmake sched; make graph
Xmake xtest; ./xtest < data
Xmake gtest; ./gtest < data
Xmake xdandc; ./xdandc < data
Xmake gdandc; ./gdandc < data
Xmake xexample; ./xexample < data
Xmake gexample; ./gexample < data
Xmake xts_dynamic; ./xts_dynamic < data.ts_dynamic
Xmake gts_dynamic; ./gts_dynamic < data.ts_dynamic
Xmake xblkjac; ./xblkjac < data.blkjac
Xmake gblkjac; ./gblkjac < data.blkjac
END_OF_FILE
if test 377 -ne `wc -c <'testrun'`; then
echo shar: \"'testrun'\" unpacked with wrong size!
fi
chmod +x 'testrun'
# end of 'testrun'
fi
if test -f 'ts_dynamic.f' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'ts_dynamic.f'\"
else
echo shar: Extracting \"'ts_dynamic.f'\" \(5834 characters\)
sed "s/^X//" >'ts_dynamic.f' <<'END_OF_FILE'
X program dynamc
Xc
XCode Name: ts_dynamic.f
XCode Input Data: [nprocessors] [narraysize] [nworkiterations]
XCode Note: variation on tridiagonal stuffer program ts_dynamic.f
XChange: Modification for circular parmq & super nxtag.
Xc: modification of ts_dynamic.f to correspond to ts_static.f
Xc...or old stuffspawn.f: the triangular array stuffer.
X parameter(maxsiz=1000,mxszsq=500500,maxprc=8)
Xc: mxszsq .ge. maxsiz*(maxsiz+1)/2
X double precision a,b
X common /comitr/ niter
X common /prbdef/ a(mxszsq),b(maxsiz),itmp(maxsiz),jtmp(maxsiz)
X & ,statag(maxsiz)
X EXTERNAL PARALG
XC write(6,*) ' input order of array .le. 44, but dim =',maxsiz
XC read (5,*) nblks
XC write(6,*) ' input nprocs .le. ',maxprc
XC read (5,*) nprocs
X read(5,*) nprocs,nblks,niter
Xc
X if(nblks.gt.maxsiz) then
X write(6,*) 'order of array, nblks =',nblks,' .gt. ',maxsiz
X & ,' = maxsize'
X write(6,*) 'S T O P E X E C U T I O N I N M A I N'
X stop
X endif
Xc
X mxjobs = nblks*(nblks+1)/2
X jstep = (nblks)/(10-0)
Xc
X do 10 j = 1,nblks
X itmp(j) = j
X jtmp(j) = j
X 10 continue
Xc
Xc: add second.f timer
X t1=second(foo)
X t2=second(foo)
Xc do 111 jj = 1,100
Xc
X CALL SCHED(nprocs,paralg,nblks,a,b,itmp,jtmp,statag)
Xc
Xc111 continue
X t3=second(foo)
X tt=t3-t2-(t2-t1)
Xc
Xc output
Xc lower triangle of a matrix of order n
Xc
X do 100 j = 1,nblks
X k = j
X b(1)= a(j)
X do 50 i = 1,j-1
X b(i+1) = a(k+nblks-i)
X k = k+nblks-i
X 50 continue
X if(mxjobs.lt.100) then
X write(6,1000) (b(i),i=1,j)
X else
X if(mod(j-1,jstep).eq.0.or.j.eq.nblks)
X & write(6,2000) (b(i),i=1,j-1,jstep),b(j)
X endif
X 100 continue
X1000 format(16f5.0)
X2000 format(11f7.0)
Xc
X if(nprocs.eq.1) write(6,664) nblks,niter,mxjobs
X664 format(' # ts_dynamic.f = pgm.f schedule gettag & name program'
X & /' # ftsubs.f for circular readyq & parmq & freeq version'
X & /' # with nblks =',i5'; niter =',i8,'; maxjobs =',i8)
X write(6,665) nprocs,tt
X665 format(' #',i2,f12.5)
X write(*,666) nblks,niter,nprocs,mxjobs,tt
X666 format(11x,'code',4x,'norder',4x,' niter',4x,'nprocs'
X & ,3x,'maxjobs',5x,'seconds'
X & /3x,'ts_dynamic.f',4i10,f12.5)
Xc
X stop
X end
Xc
X subroutine paralg(n,a,b,itmp,jtmp,statag)
X integer n,itmp(*),jtmp(*),statag(*)
X double precision a(*),b(*)
X integer mychkn(1)
X EXTERNAL STUFF1
Xc
Xc this is the driver for filling a packed triangular matrix with
Xc j on the j-th diagonal and (j*n+i-j*(j+1)/2) in the (i,j) off
Xc diagonal position
Xc
Xc first, get all static job tags necessary to construct the
Xc dependency graph.
Xc
X do 100 j = 1,n
XCaution: statag(j) gets the schedule output static job tag.
X CALL GETTAG(statag(j))
X100 continue
Xc
X icount = 1
X do 200 j = 1,n-1
Xc
Xc
Xc the j-th diagonal waits for the diagonal above to complete
Xc
Xc the j-th diagonal completion will allow
Xc the (j+1)-st diagonal to start
Xc
Xc
X jobtag = j
X icango = 1
X if (jobtag .eq. 1) icango = 0
X nchks = 1
XCaution: jobtag = j 's chekin is defined in terms of schedule static tags.
X mychkn(1) = statag(j+1)
Xc
Xc we just set up data dependencies and are ready to put
Xc this process on the queue
Xc
X jobtag = statag(j)
X CALL name(jobtag,'stuff1')
X CALL DEP(jobtag,icango,nchks,mychkn)
XCAUTION: Make certain that all arguments of the subroutine whose name
Xcont: is passed to SCHEDULE, are global variables, as jtmp(j) is for
Xcont: sub name stuff1.
X CALL PUTQ(jobtag,stuff1,statag(j),n,
X & a(icount),jtmp(j),itmp(1))
Xc
Xc when the data dependencies for process statag(j) are satisfied
Xc the following call will be made
Xc
Xc call stuff1(jobtag,....,itmp(1))
Xc
X icount = icount + (n-j+1)
X 200 continue
Xc
X icango = 1
X nchks = 0
XCaution: mychkn gets dummy value only.
X mychkn(1) = n+1
Xc
X jobtag = statag(n)
X CALL name(jobtag,'stuff1')
X CALL DEP(jobtag,icango,nchks,mychkn)
X CALL PUTQ(jobtag,stuff1,statag(n),n,
X & a(icount),jtmp(n),itmp(1))
Xc
X return
X end
Xc
X subroutine stuff1(mypar,n,a,j,itmp)
X double precision a(*)
X integer mypar,n,j,itmp(*)
X logical wait
X EXTERNAL STUFF2
Xc
Xc write(6,*) ' enter stuff1 ',mypar,j
Xc
Xc write(6,*) ' enter stuff1 ',ientry(mypar),mypar
X nentrs=2
X go to (1111,2222),ientry(mypar,nentrs)
X 1111 continue
X ii = 1
X do 100 i = j+1,n
Xc
X CALL GETTAG(jobtag)
X CALL name(jobtag,'stuff2')
XCAUTION: ARGUMENTS OF NXTAG & SPAWN ARE REORDERED FROM OLDER VERSIONS,
XCAUTION: MAKING THEM MORE CONSISTENT WITH DEP & PUTQ.
X CALL NXTAG(jobtag,mypar)
Xc write(6,*) ' about to spawn jobtag, mypar ',jobtag,mypar
X CALL SPAWN(jobtag,mypar,stuff2,a(ii + 1),itmp(i),itmp(j),n)
Xc
Xc this spawns a process that will execute a call to stuff2
Xc and report completion to parent process MYPAR
Xc
X ii = ii + 1
X 100 continue
X iexit=2
X if (wait(mypar,iexit)) return
Xc
Xc return to help out and then return here (at label 2222)
Xc on the next reentry
Xc
X 2222 continue
Xc
X a(1) = j
Xc
X return
X end
X subroutine stuff2(a,i,j,n)
X double precision a(*)
X common /comitr/ niter
X do 99999 kk = 1,niter
X a(1) = a(1) + kk
X99999 continue
X a(1) = j*n + i - j*(j+1)/2
X return
X end
END_OF_FILE
if test 5834 -ne `wc -c <'ts_dynamic.f'`; then
echo shar: \"'ts_dynamic.f'\" unpacked with wrong size!
fi
# end of 'ts_dynamic.f'
fi
echo shar: End of shell archive.
exit 0