c  24a. $B%i%W%i%9J}Dx<0$rK~$?$9EE>l$NBg$-$5$N%0%i%U(B
c     $B?9@n(B $BLwBg(B , 22980138
c
      program ex24a
c
      implicit none
      integer :: i,j
      real :: w,ep,pi,u(21,21)
c
c      write(6,*)''
c      write(6,*)''

      do i=1,21
         u(i, 1)=0.0
         u(i,21)=0.0
      enddo
      do j=1,21
         u( 1,j)=0.0
         u(21,j)=0.0
      enddo
      do i=7,14
         u(i, 1)= 1.0
         u(i,21)=-1.0
      enddo

      pi=3.141592653589
      w =2.0-sqrt(2.0)*pi*sqrt((1.0/21.0)**2+(1.0/21.0)**2)
      ep=1.0e-3

      call SOR24(u,w,ep)

      stop
      end
c
c-----SOR$BK!$rMQ$$$?%i%W%i%9J}Dx<0$r2r$-!"EE>l$r5a$a$k%5%V%k!<%A%s(B
      subroutine SOR24(u,w,ep)
      implicit none
      integer :: i,j,k
      real :: x,y,w,ep,Ee,u(21,21),up(21,21),Au,e(21,21),
     -        edx(21,21),edy(21,21),EF(21,21)
      Ee=1.0
      do j=1,21
         do i=1,21
            up(i,j)=u(i,j)
         enddo
      enddo
   
      do while (Ee > ep)

       do j=2,20
          do i=2,20
             Au=(up(i-1,j)+u(i+1,j)+up(i,j-1)+u(i,j+1))/4.0-u(i,j)
             up(i,j)=u(i,j)+w*Au
             e(i,j)=w*Au
          enddo
       enddo

       Ee=0.0 
       do j=2,20
          do i=2,20
             Ee=Ee+abs(e(i,j))
          enddo
       enddo

       do j=2,20
          do i=2,20
             u(i,j)=up(i,j)
          enddo
       enddo

      enddo
 
      do i=2,20
       do j=1,21
         edx(i,j)=(u(i+1,j)-u(i-1,j))/0.1
       enddo
      enddo

      do i=1,21
       do j=2,20
         edy(i,j)=(u(i,j+1)-u(i,j-1))/0.1
       enddo
      enddo

      do j=1,21
         edx( 1,j)=(u( 2,j)-u( 1,j))/0.05
         edx(21,j)=(u(21,j)-u(20,j))/0.05
      enddo

      do i=1,21
         edy(i, 1)=(u(i, 2)-u(i, 1))/0.05
         edy(i,21)=(u(i,21)-u(i,20))/0.05
      enddo

      do i=1,21
       do j=1,21
        EF(i,j)=sqrt((edx(i,j))**2+(edy(i,j))**2)
       enddo
      enddo

      do i=1,21
         x=0.05*float(i-1)
         do j=1,21
            y=0.05*float(j-1)
            write(10,*) y,x,EF(i,j)
         enddo
         write(10,*)''
      enddo
      return
      end
