c------( clc )------ c modified by RIE-chan dimension m(60000) double precision q(500,501) c open(10,file='memob.txt',status='old') open(30,file='memoc.txt') c c----------- na:tate, nb:yoko read(10,*) na,nb n = na + nb mab=na*nb do 100 i=1,mab m(i) = 0 100 continue do 200 j=1,nb do 200 i=1,na read(10,*) ka,kb,dm ka=abs(ka) kb=kb+na m(ka) = 1 m(kb) = 1 200 continue rewind 10 k = 0 do 300 i=1,mab if(m(i).eq.0) go to 300 k = k + 1 m(i) = k 300 continue do 400 i=1,k q(i,k+1) = 0. do 400 j=1,k q(i,j) = 1. 400 continue read(10,*) na,nb f=1 do 500 j=1,nb do 500 i=1,na read(10,*) ka,kb,dm ka=abs(ka) kb=kb+na kka = m(ka) kkb = m(kb) if(dm.eq.999) go to 500 if(kka.eq.0.or.kkb.eq.0) go to 500 q(kka,kka) = q(kka,kka) + f q(kka,kkb) = q(kka,kkb) - f q(kkb,kkb) = q(kkb,kkb) + f q(kkb,kka) = q(kkb,kka) - f q(kka,k+1) = q(kka,k+1) + f*dm q(kkb,k+1) = q(kkb,k+1) - f*dm 500 continue c rewind 10 do 600 i=1,k do 600 j=i,k if(q(i,i).eq.0) write(6,*) i q(i,j+1) = q(i,j+1) / q(i,i) do 600 ii=1,k if(i.eq.ii) go to 600 q(ii,j+1) = q(ii,j+1) - q(i,j+1)*q(ii,i) 600 continue do 700 i=1,n kk = m(i) if(kk.eq.0) go to 70 f = q(kk,k+1) write(30,1000) i,f go to 700 70 f = 0. write(30,1000) i,f 700 continue close(10) close(30) stop c 1000 format(1h ,i5,f8.1) end