求一个用于稀疏矩阵求解的ICCG的fortran程序.docxVIP

implicit real(a-h,o-z) real a(200000),af(200000),b(28000),x(28000), $ anrm,xnrm,resd,g(28000),p(28000),t1(28000),t2(28000) integer ia(28001),ja(200000),nit(3) real d,c2,a2,cf common /tomm/ a,af,ia,ja common /area2/ d,c2,a2,cf common /order/ iorflg data nit/1,5,10/ c c this is a main program for running the incomplete LU c conjugate gradient for solving linear systems. c the matrix need not be symmetric. c c ilucg this flag if 1 will cause incomplete factoization c if 0 no factorization just straight cg c c write(6,*) start in main c c call trapov(100) loca = 200000 continue c write(6,*) input ineum5,ineum6,irot,iorflg c write(6,*)set irot0 to stop c read(5,*) ineum5,ineum6,irot,iorflg c if( irot .lt. 0 ) then c write(6,*) end test c stop c end if c write(6,*) ineum5,ineum6,irot,iorflg,ineum5,ineum6,irot,iorflg c write(6,*)input mesh cells for x, y, and z c read(5,*)imx,imy,imz c write(6,*)inner, middle, and outer fill-in integers c read(5,*)ifli,iflm,iflo cc write(6,*)ising (normally zero) cc read(5,*)ising ineum5 = 1 ineum6 = 1 irot = 1 iorflg = 2 imx = 20 imy = 20 imz = 20 cc if (ineum5 .ne. 1 .or. ineum6 .ne. 1) ising=0 ising = 0 cc imx = 5 cc imy = 5 cc imz = 5 n = imx*imy*imz c write(6,*) ***** mesh cells in x dir,imx, ***** c write(6,*) ***** mesh cells in y dir,imy, ***** c write(6,*) ***** mesh cells in z dir,imz, ***** c ccccccccccccccccwrite(6,*) ***********problem typeif( ineum5 .eq. 0 ) then write(6,*) ***** dir on bottom elsewrite(6,*) ***** endif************֪neuman on bottomif( ineum6 .eq. cccccccccccccccc write(6,*) *********** problem type if( ineum5 .eq. 0 ) then write(6,*) ***** dir on bottom else write(6,*) ***** endif ************֪ neuman on bottom if( ineum6 .eq. 0 ) then write(6,*) ***** dir on top else write(6,*) ***** endif neuman on top if( ising .eq. 0 ) then write(6,*) ***** regular else write(6,*) ***** singular if neuman endif *****. *****. *****. on top and bottom ***** c ifli is the number of fillin s