#! /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 '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() Xc external yyy Xc . Xc . Xc . Xc call dep(jobtag,icango,nchks,mychkn) Xc call putq(jobtag,yyy,) 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,) Xc 10 continue Xc return Xc 2000 continue Xc . Xc . Xc . Xc return Xc n000 continue Xc 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() 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 = 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 = 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 /