# To unbundle, sh this file echo README 1>&2 cat >README <<'End of README' From diaz%alliant@anl-mcs.arpa Fri Jan 29 12:44:19 1988 Return-Path: Received: from anl-mcs.ARPA by antares.mcs.anl (3.2/SMI-3.2) id AA05763; Fri, 29 Jan 88 12:44:17 CST Received: from alliant.mcs.anl (alliant.ARPA) by anl-mcs.ARPA (4.12/4.9) id AA25285; Fri, 29 Jan 88 12:44:49 cst Received: by alliant.mcs.anl (4.12/SMI-3.2) id AA03999; Fri, 29 Jan 88 12:38:58 cst Date: Fri, 29 Jan 88 12:38:58 cst From: diaz%alliant@anl-mcs.arpa (Julio C. Diaz) Message-Id: <8801291838.AA03999@alliant.mcs.anl> To: dongarra@anl-mcs.ARPA, sorensen@anl-mcs.ARPA Subject: Program using schedule Cc: diaz@anl-mcs.ARPA Status: R All the files in the directory ~diaz/precon/five.ttl/working/distribute. The makefile there clarifies hwo they are related. The driver program is in ttl.f, there the number of processors is specified. Currently it is set up for the alliant nprocs=8. The output is to the terminal and contains speedups. The second parameter in each output line is nrows which determines the granularity of the problem. I would like to know of any results. It is currently working on the Alliant. I just tried it. Thank you. Julio Cesar End of README echo bulk.f 1>&2 cat >bulk.f <<'End of bulk.f' SUBROUTINE DKRFA0(dbk,ddfact,l1,l2,u1,u2) REAL DBK(1), DDFACT(1), L1(1), L2(1), U1(1), U2(1) DIMENSION BLKOUT(10000) INTEGER PTR, PTRM1, PTRMNX INTEGER NX, NY, NROWS COMMON /MTRSTR/ NX, NY, NROWS C NROWS2 = NROWS * NROWS C CALL DLUFAC( DBK(1), DDFACT(1)) C DO 10 IX = 2, NX C PTR = ( IX-1) * NROWS2 + 1 PTRM1 = PTR - NROWS2 CALL FACXBK( DDFACT(PTRM1), U1(PTRM1), BLKOUT, NROWS) CALL FMFXF ( DBK (PTR), L1(PTRM1), BLKOUT) CALL DLUFAC( DBK (PTR), DDFACT( PTR)) C 10 CONTINUE DO 30 J = 2, NY C PTR = ( J-1) * NX * NROWS2 + 1 PTRMNX = PTR - NROWS2*NX CALL FACXBK( DDFACT(PTRMNX),U2(PTRMNX),BLKOUT,NROWS) CALL FMFXF ( DBK(PTR),L2(PTRMNX),BLKOUT) CALL DLUFAC( DBK(PTR),DDFACT(PTR)) C DO 20 IX = 2, NX C PTR = ((J-1)*NX+IX-1)*NROWS2 + 1 PTRM1 = PTR - NROWS2 PTRMNX = PTR - NROWS2 * NX CALL FACXBK(DDFACT(PTRM1),U1(PTRM1),BLKOUT,NROWS) CALL FMFXF (DBK(PTR),L1(PTRM1),BLKOUT) CALL FACXBK(DDFACT(PTRMNX),U2(PTRMNX),BLKOUT,NROWS) CALL FMFXF (DBK(PTR),L2(PTRMNX),BLKOUT) CALL DLUFAC(DBK(PTR),DDFACT(PTR)) C 20 CONTINUE 30 CONTINUE RETURN END subroutine copy(DBK1,DDFAC1,L11,L21,U11,U21,NX,NY,NROWS * ,DBK,DDFAC,L1,L2,U1,U2) real DBK(1),DDFAC(1),L1(1),L2(1),U1(1),U2(1) real DBK1(1),DDFAC1(1),L11(1),L21(1),U11(1),U21(1) INTEGER NX,NY,NROWS c nr = nx*ny*nrows do 10 k=1,nr dbk(k)=dbk1(k) ddfac(k)=ddfac1(k) l1(k)=l11(k) l2(k)=l21(k) u1(k)=u11(k) u2(k)=u21(k) 10 continue return end SUBROUTINE DKRFAC (DBK,DDFACT,L1,L2,U1,U2) real DBK(1),DDFACT(1),L1(1),L2(1),U1(1),U2(1) INTEGER NX,NY,NROWS INTEGER PTR,PTRM1,PTRMNX integer mchkin(3), kndx(3) COMMON /MTRSTR/ NX, NY,NROWS external FAMLU1,FAMLU2,DLUFAC C NROWS2 = NROWS * NROWS C c jobtag = 1 myjob = 2 icango = 0 nchks = 2 mchkin(1) = jobtag + 1 mchkin(2) = jobtag + NX c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,DLUFAC,DBK(1),DDFACT(1)) c CALL DLUFAC( DBK(1), DDFACT(1) ) C DO 10 IX = 2, NX-1 C PTR = ( IX-1) * NROWS2 + 1 PTRM1 = PTR - NROWS2 c jobtag = IX myjob = 3 icango = 1 nchks = 2 mchkin(1) = jobtag + 1 mchkin(2) = jobtag + NX c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU1,DDFACT(PTRM1),DBK(PTR),U1(PTRM1), * L1(PTRM1),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRM1), U1(PTRM1), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L1(PTRM1), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C 10 CONTINUE C PTR = ( NX-1) * NROWS2 + 1 PTRM1 = PTR - NROWS2 c jobtag = NX myjob = 3 icango = 1 nchks = 1 mchkin(1) = jobtag + NX c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU1,DDFACT(PTRM1),DBK(PTR),U1(PTRM1), * L1(PTRM1),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRM1), U1(PTRM1), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L1(PTRM1), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C DO 30 J = 2, NY-1 C PTR = ( J-1) * NX * NROWS2 + 1 PTRMNX = PTR - NROWS2*NX c jobtag = ( J-1) * NX + 1 myjob = 4 icango = 1 nchks = 2 mchkin(1) = jobtag + 1 mchkin(2) = jobtag + NX c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU1,DDFACT(PTRMNX),DBK(PTR),U2(PTRMNX), * L2(PTRMNX),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRMNX), U2(PTRMNX), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L2(PTRMNX), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C DO 20 IX = 2, NX-1 C PTR = ((J-1)*NX+IX-1)*NROWS2 + 1 PTRM1 = PTR - NROWS2 PTRMNX = PTR - NROWS2 * NX c jobtag = ( J-1) * NX + IX myjob = 5 icango = 2 nchks = 2 mchkin(1) = jobtag + 1 mchkin(2) = jobtag + NX c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU2,DDFACT(PTRM1),DDFACT(PTRMNX),DBK(PTR), * U1(PTRM1),U2(PTRMNX), * L1(PTRM1),L2(PTRMNX),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRM1 ), U1(PTRM1 ), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L1(PTRM1 ), BLKOUT ) CALL FACXBK( DDFACT(PTRMNX), U2(PTRMNX), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L2(PTRMNX), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C 20 CONTINUE C PTR = ((J-1)*NX+NX-1)*NROWS2 + 1 PTRM1 = PTR - NROWS2 PTRMNX = PTR - NROWS2 * NX c jobtag = ( J-1) * NX + NX myjob = 5 icango = 2 nchks = 1 mchkin(1) = jobtag + NX c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU2,DDFACT(PTRM1),DDFACT(PTRMNX),DBK(PTR), * U1(PTRM1),U2(PTRMNX), * L1(PTRM1),L2(PTRMNX),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRM1 ), U1(PTRM1 ), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L1(PTRM1 ), BLKOUT ) CALL FACXBK( DDFACT(PTRMNX), U2(PTRMNX), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L2(PTRMNX), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C 30 CONTINUE C PTR = ( NY-1) * NX * NROWS2 + 1 PTRMNX = PTR - NROWS2*NX c jobtag = ( NY-1) * NX + 1 myjob = 4 icango = 1 nchks = 1 mchkin(1) = jobtag + 1 c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU1,DDFACT(PTRMNX),DBK(PTR),U2(PTRMNX), * L2(PTRMNX),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRMNX), U2(PTRMNX), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L2(PTRMNX), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C DO 40 IX = 2, NX-1 C PTR = ((NY-1)*NX+IX-1)*NROWS2 + 1 PTRM1 = PTR - NROWS2 PTRMNX = PTR - NROWS2 * NX c jobtag = ( NY-1) * NX + IX myjob = 5 icango = 2 nchks = 1 mchkin(1) = jobtag + 1 c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU2,DDFACT(PTRM1),DDFACT(PTRMNX),DBK(PTR), * U1(PTRM1),U2(PTRMNX), * L1(PTRM1),L2(PTRMNX),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRM1 ), U1(PTRM1 ), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L1(PTRM1 ), BLKOUT ) CALL FACXBK( DDFACT(PTRMNX)XU2(PTRMNX), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L2(PTRMNX), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C 40 CONTINUE C PTR = ((NY-1)*NX+NX-1)*NROWS2 + 1 PTRM1 = PTR - NROWS2 PTRMNX = PTR - NROWS2 * NX c jobtag = ( NY-1) * NX + NX myjob = 5 icango = 2 nchks = 0 c call dep(jobtag,icango,nchks,mchkin) call putq(jobtag,FAMLU2,DDFACT(PTRM1),DDFACT(PTRMNX),DBK(PTR), * U1(PTRM1),U2(PTRMNX), * L1(PTRM1),L2(PTRMNX),DDFACT(PTR)) c CALL FACXBK( DDFACT(PTRM1 ), U1(PTRM1 ), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L1(PTRM1 ), BLKOUT ) CALL FACXBK( DDFACT(PTRMNX), U2(PTRMNX), BLKOUT, NROWS ) CALL FMFXF ( DBK (PTR ), L2(PTRMNX), BLKOUT ) CALL DLUFAC( DBK (PTR ), DDFACT( PTR ) ) C RETURN END subroutine FAMLU1(DFAC1,DBK,U,L,DDFACT) real DFAC1(1),DBK(1),DDFACT(1),L(1),U(1) INTEGER NX,NY,NROWS DIMENSION SCRTCH(10000) COMMON /MTRSTR/ NX,NY,NROWS CALL FACXBK( DFAC1, U, SCRTCH, NROWS ) CALL FMFXF ( DBK , L, SCRTCH) CALL DLUFAC( DBK , DDFACT) return end subroutine FAMLU2(DFAC1,DFAC2,DBK,U1,U2,L1,L2,DDFACT) real DFAC1,DFAC2,DBK(1),DDFACT(1),L1(1),L2(1),U1(1),U2(1) INTEGER NX,NY,NROWS DIMENSION SCRTCH(10000) COMMON /MTRSTR/ NX, NY,NROWS CALL FACXBK( DFAC1, U1, SCRTCH, NROWS ) CALL FMFXF ( DBK , L1, SCRTCH) CALL FACXBK( DFAC2, U2, SCRTCH, NROWS ) CALL FMFXF ( DBK , L2, SCRTCH) CALL DLUFAC( DBK , DDFACT) return end End of bulk.f echo makefile 1>&2 cat >makefile <<'End of makefile' # FILESg = mtrprd.o bulk.o five: ttl.o $(FILESg) fortran ttl.o $(FILESg) -O -AS -recursive -C -o five /afs2/sorensen/SCHEDC5/sched.a #.f.o : $*.f # fortran -Ogv -AS -recursive -C -c $*.f .f.o : $*.f fortran -O -AS -recursive -C -c $*.f .c.o : $*.f cc -c $*.c clean: rm -f $(FILES) End of makefile echo mtrprd.f 1>&2 cat >mtrprd.f <<'End of mtrprd.f' SUBROUTINE MAKE2(DBK, DDFACT, L1, L2, U1, U2,NX,NY,NROWS) C real DBK(1),DDFACT(1),L1(1),L2(1),U1(1),U2(1) INTEGER NX, NY, NROWS INTEGER INDXL, INDXH c nxny = nx*ny NRWS2 = NROWS * NROWS NRWSP1 = NROWS + 1 CST1 = 6.*FLOAT(NROWS) CST2 = (.8/FLOAT(NRWS2)) C DO 2 IX = 1, NRWS2 L1(IX) = 0. 2 CONTINUE DO 4 IX = 1, NRWS2, NRWSP1 L1(IX) = 1. 4 CONTINUE C DO 20 I = 1, NXNY INDXL = (I-1)*NRWS2+1 INDXH = INDXL+NRWS2-1 DO 10 IX = INDXL, INDXH DBK(IX) = L1(IX-INDXL+1) 10 CONTINUE 20 CONTINUE C DO 50 I = 1, NX*NY INDXL = (I-1)*NRWS2+1 INDXH = INDXL+NRWS2-1 DO 40 IX = INDXL, INDXH L1(IX) = CST2 * FLOAT(IX) 40 CONTINUE 50 CONTINUE C DO 80 I = 1, NX*NY INDXL = (I-1)*NRWS2+1 INDXH = INDXL+NRWS2-1 DO 70 IX = INDXL, INDXH L2(IX) = 1. - L1(IX)/2. U1(IX) = -1.*(1. - L1(IX))/CST1 U2(IX) = -1.*(1. - L2(IX))/CST1 L1(IX) = -1.*L1(IX)/CST1 L2(IX) = -1.*L2(IX)/CST1 70 CONTINUE 80 CONTINUE C RETURN END SUBROUTINE OUTPUT2(NPROC,DBK,DDFACT,L1,L2,U1,U2,NX,NY,NROWS) C real DBK(1),DDFACT(1),L1(1),L2(1),U1(1),U2(1) C INTEGER NPROC INTEGER NX, NY, NROWS NRWS2 = NROWS * NROWS C DO 20 I = 1, NX*NY INDXL = (I-1)*NRWS2+1 INDXH = INDXL+NRWS2-1 DO 10 IND = INDXL, INDXH WRITE(6,*)I,IND,DBK(IND) 10 CONTINUE 20 CONTINUE return END SUBROUTINE DLUFAC( BKDIAG, DDFACT ) REAL BKDIAG(NRWS,NRWS), DDFACT(NRWS,NRWS) INTEGER GRDMX, STRPMX, NRWS COMMON /MTRSTR/ GRDMX, STRPMX, NRWS DO 20 J = 1, NRWS DO 10 I = 1, NRWS DDFACT(I,J) = BKDIAG(I,J) 10 CONTINUE 20 CONTINUE c c gaxpy-jki-form c do 4 j=1,nrws do 2 k= 1, j-1 do 1 i=k+1,nrws ddfact(i,j)=ddfact(i,j)+ddfact(i,k)*ddfact(k,j) 1 continue 2 continue do 3 i=j+1,nrws ddfact(i,j)= -ddfact(i,j)/ddfact(j,j) 3 continue 4 continue RETURN END SUBROUTINE FACXBK ( DDFACT, BLCKIN, BLKOUT, NCLS ) REAL DDFACT(NRWS,NRWS), BLCKIN(NRWS,NCLS), BLKOUT(NRWS,NCLS) INTEGER GRDMX, STRPMX, NRWS COMMON /MTRSTR/ GRDMX, STRPMX, NRWS NRWSP1 = NRWS + 1 DO 20 J = 1,NRWS DO 10 I = 1,NCLS BLKOUT(I,J) = BLCKIN(I,J) 10 CONTINUE 20 CONTINUE c form ikj of solving n-systems of equations. c do 3 i=2,nrws do 2 k=1,i-1 do 1 j=1,nrws BLKOUT(i,j)=BLKOUT(i,j)+DDFACT(i,k)*BLKOUT(k,j) 1 continue 2 continue 3 continue do 7 i=nrws,1,-1 do 5 k=i+1,nrws do 4 j=1,nrws BLKOUT(i,j)=BLKOUT(i,j)+DDFACT(i,k)*BLKOUT(k,j) 4 continue 5 continue do 6 j=1,nrws BLKOUT(I,J) = BLKOUT(I,J)/DDFACT(I,I) 6 continue 7 continue return end SUBROUTINE FMFXF( DIAGBK, LWRBCK, DLUXUB ) REAL DIAGBK(NRWS,NRWS), LWRBCK(NRWS,NRWS), DLUXUB(NRWS,NRWS) REAL TEMPRR INTEGER GRDMX, STRPMX, NRWS COMMON /MTRSTR/ GRDMX, STRPMX, NRWS DO 100 J = 1, NRWS DO 50 L = 1, NRWS DO 10 I = 1, NRWS DIAGBK(I,J)=DIAGBK(I,J)-LWRBCK(I,L)*DLUXUB(L,J) 10 CONTINUE 50 CONTINUE 100 CONTINUE RETURN END End of mtrprd.f echo ttl.f 1>&2 cat >ttl.f <<'End of ttl.f' PROGRAM MAIN c real DBK(410000),DDFACT(410000) real L1(410000),L2(410000),U1(410000),U2(410000) real DBK1(410000),DDFACT1(410000) real L11(410000),L21(410000),U11(410000),U21(410000) real enter,ttime,effic INTEGER NX,NY,NROWS INTEGER NPROC common /junk/ DBK,DDFACT,L1,L2,U1,U2,DBK1, * DDFACT1,L11,L21,U11,U21 COMMON /MTRSTR/ NX,NY,NROWS external DKRFAC c C nprocs=8 nx=20 ny=20 write(6,*)'nproc, nrows, speedups' do 20 nn=4,28,4 nrows=nn c write(6,*)nrows c write(6,*)' nrows,nx,ny==',nrows,nx,ny C CALL MAKE2 (DBK,DDFACT,L1,L2,U1,U2,NX,NY,NROWS) ttime0 = second(enter) call DKRFA0(dbk,ddfact,l1,l2,u1,u2) ttime0 = second(enter)-ttime0 c write(6,*)' total time=',ttime0 c do 10 npr=1,nprocs nproc = npr CALL MAKE2 (DBK,DDFACT,L1,L2,U1,U2,NX,NY,NROWS) c write(6,*)' nprocs=',nproc ttime = second(enter) call sched(nproc,DKRFAC ,DBK,DDFACT,L1,L2,U1,U2) ttime = second(enter)-ttime speedp = ttime0/ttime effic = speedp/nproc write(6,*)nproc,nn,speedp c write(6,*)' total time=',ttime,speedp,effic 10 continue 20 continue C C CALL OUTPUT2(NPROC,DBK,DDFACT,L1,L2,U1,U2,NX,NY,NROWS) C END End of ttl.f .