PROGRAM WEBR2D
!c Planar L2 Weiszfeld's Solver

real tempsum,xnew,ynew,xstart,ystart,deltax,deltay,error
dimension x(100),y(100),w(100),a(100),b(100)
integer place,limit,iteration
1 format (1x,f4.2)
2 format (f12.8,',',f12.8)
error=0.00000001
iteration=0
xstart=0
ystart=0
xnew=0
ynew=0
deltax=1
deltay=1
print*
print*
print*
print*, 'WELCOME TO THE 2D PLANAR 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 an array for each demand point data
print*, 'Now enter x,y,weight data for each point:'
print*
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 Weight value for #',i,'demand point'
read*, w(i)
print*
100 continue
print*
!c user defines point x,y to use as initial solution
print*, 'Enter an initial starting point x,y'
read*, xstart
read*, ystart
10 if (deltax.gt.(0.00000001).or.deltay.gt.(0.00000001)) then
iteration=iteration+1
print*
do 101 place=1,limit
a(place)=w(place)/(((xstart-x(place))**2+(ystart-y(place))**2+error)**(0.5))
101 continue
tempsum=0
do 102 place=1,limit
tempsum=tempsum+a(place)
102 continue
do 103 place=1,limit
b(place)=a(place)/tempsum
103 continue

! print*

xnew=0
ynew=0
do 104 place=1,limit
xnew=xnew+(b(place)*x(place))
ynew=ynew+(b(place)*y(place))
104 continue
! print*, 'iteration x,y resultant is'
! print 1, xnew
! print 1, ynew
deltax=abs(xnew-xstart)
deltay=abs(ynew-ystart)
xstart=xnew
ystart=ynew
go to 10
endif

!c print number of iterations required to arrive at solution
print*, 'Problem converged in',iteration,'iterations.'
!c print x,y solution
print*, 'Solution x,y coordinates are:'
print 2, xnew,ynew
print*, 'This solution is accurate to',error*10,'in each direction.'
print*, 'Press enter to exit the program.'
read*
!c end program
END
Hosted by www.Geocities.ws

1