PROGRAM WEBR3D
!c Spatial L2 Weiszfeld's Solver
real tempsum,xnew,ynew,znew,xstart,ystart,zstart,deltax,deltay,deltaz,error
dimension x(100),y(100),z(100),w(100),a(100),b(100)
integer q,limit,iteration
1 format (1x,f4.2)
2 format (f12.8,',',f12.8,',',f12.8)
error=0.00000001
iteration=0
xstart=0
ystart=0
zstart=0
xnew=0
ynew=0
znew=0
deltax=1
deltay=1
deltaz=1
print*
print*
print*
print*, 'WELCOME TO THE 3D SPATIAL L2 WEISZFELD SOLVER'
print*, '2001, Impact Consulting. Unlimited Distribution.'
print*, 'You may use up to 100 demand points with non-negative weights.'
print*
!c user defines how many demand points will be analyzed
print*, 'Enter the number of demand points to be analyzed.'
read*, limit
print*
!c user defines (max) arrays of size 10 for demand point data
print*, 'Now enter x,y,z,weight data for each point:'
do 100 i=1,limit
print*, 'DEMAND POINT',i
print*, 'Enter x value for number',i,'demand point.'
read*, x(i)
print*, 'Enter y value for number',i,'demand point.'
read*, y(i)
print*, 'Enter z value for number',i,'demand point.'
read*, z(i)
print*, 'Enter weight value for #',i,'demand point.'
read*, w(i)
100 continue
print*
!c user defines point x,y,z to use as initial solution
print*, 'Enter an initial starting point x,y,z.'
read*, xstart,ystart,zstart
10 if (deltax.gt.(0.00000001).or.deltay.gt.(0.00000001).or.deltaz.gt.(0.00000001)) then
iteration=iteration+1
do 101 q=1,limit
a(q)=w(q)/(abs((xstart-x(q))**2+(ystart-y(q))**2+(zstart-z(q))**2+error)**(0.5))
101 continue
tempsum=0
do 102 q=1,limit
tempsum=tempsum+a(q)
102 continue
do 103 q=1,limit
b(q)=a(q)/tempsum
103 continue
xnew=0
ynew=0
znew=0
do 104 q=1,limit
xnew=xnew+(b(q)*x(q))
ynew=ynew+(b(q)*y(q))
znew=znew+(b(q)*z(q))
104 continue
deltax=abs(xnew-xstart)
deltay=abs(ynew-ystart)
deltaz=abs(znew-zstart)
xstart=xnew
ystart=ynew
zstart=znew
go to 10
endif
!c print number of iterations required to arrive at solution
print*, 'Problem converged in',iteration,'iterations.'
!c print x,y,z solution
print*, 'Solution x,y,z coordinates are'
print 2, xnew,ynew,znew
print*, 'This solution is accurate to ',error*10,'in each direction.'
print*, 'Press enter to exit the program.'
read*
!c end program
END