subroutine linfitac_for(fit,addcon,prox,n) integer n,i,j,index,jone,jtwo,jthree real*8 addcon,acondiff,cr,p1,p2,p3,addconpv,del,divide real*8 prox(n,n),fit(n,n),work(n*(n-1)*(n-2)) acondiff = 1.0 addcon = 0.0 do while (acondiff.gt.(1.0e-003)) do i = 1,n do j = 1,n if(i.ne.j) then fit(i,j) = prox(i,j) + addcon end if if(i.eq.j) then fit(i,j) = 0.0 end if end do end do addconpv = addcon do i = 1,(n*(n-1)*(n-2)) work(i) = 0.0 end do cr = 1.0 do while (cr.gt.(1.0e-003)) cr = 0.0 index = 0 do jone = 1,(n-2) do jtwo = (jone+1),(n-1) do jthree = (jtwo+1),n p1 = fit(jone,jtwo) p2 = fit(jone,jthree) p3 = fit(jtwo,jthree) fit(jone,jtwo) = fit(jone,jtwo) - work(index+1) fit(jone,jthree) = fit(jone,jthree) - work(index+2) fit(jtwo,jthree) = fit(jtwo,jthree) - work(index+3) del = (fit(jone,jthree) - fit(jone,jtwo) - & fit(jtwo,jthree))/3.0 fit(jone,jthree) = fit(jone,jthree) - del fit(jone,jtwo) = fit(jone,jtwo) + del fit(jtwo,jthree) = fit(jtwo,jthree) + del work(index+1) = del work(index+2) = -del work(index+3) = del index = index + 3 cr = cr + abs(p1-fit(jone,jtwo)) + & abs(p2-fit(jone,jthree)) & + abs(p3 - fit(jtwo,jthree)) end do end do end do do jone = 1,(n-1) do jtwo = (jone+1),n p1 = fit(jone,jtwo) fit(jone,jtwo) = fit(jone,jtwo) - work(index+1) if(fit(jone,jtwo).lt.(0.0)) then work(index+1) = -fit(jone,jtwo) fit(jone,jtwo) = 0.0 else work(index+1) = 0.0 end if index = index + 1 cr= cr + abs(p1-fit(jone,jtwo)) end do end do end do do jone = 1,(n-1) do jtwo = (jone+1),n fit(jtwo,jone) = fit(jone,jtwo) end do end do addcon = 0.0 do i = 1,n do j = 1,n addcon = addcon - & (prox(i,j) - fit(i,j)) end do end do addcon = addcon/float(n*(n-1)) acondiff = abs(addcon - addconpv) end do return end