c  23. $BAP6J7?J}Dx<0(B($BGHF0J}Dx<0(B)$B$N2rK!(B($B$H2r@O2r$H$N8m:9(B)
c     $B?9@n(B $BLwBg(B , 22980138
c
      program ex23
c
      implicit none
      integer :: xp,tp
      real :: h,k,r
c
      write(6,*)'23. $BAP6J7?J}Dx<0(B($BGHF0J}Dx<0(B)$B$N2rK!(B
     -($B$H2r@O2r$H$N8m:9(B)'
      write(6,*)''
      h =0.1
      xp=11
      k =0.1
      tp=11
      r =1.0

      call EOW23(h,xp,k,tp,r)

      stop 
      end
c
c-----$BAP6J7?J}Dx<0(B($BGHF0J}Dx<0(B)$B$N2rK!$N%5%V%k!<%A%s(B
      subroutine EOW23(h,xp,k,tp,r)
      implicit none
      integer :: i,j,xp,tp
      real :: x,t,h,k,r,pi,gosa,u(xp,tp),ut(xp,tp)

      pi=3.141592653589
      do i=1,xp
         x=h*float(i-1)
         u(i,1)=sin(x*pi)/8.0
         u(i,2)=u(i,1)
      enddo
      do j=1,tp
         u( 1,j)=0.0
         u(xp,j)=0.0
      enddo

      do j=2,tp-1
         do i=2,xp-1
            u(i,j+1)=2.0*(1.0-(r**2))*u(i,j)+
     -               (r**2)*(u(i+1,j)+u(i-1,j))-u(i,j-1)
         enddo
      enddo

c-----$B2r@O2r(B
      do j=1,tp
         t=(j-1)*k
         do i=1,xp
            x=(i-1)*h
            ut(i,j)=(sin(x*pi)*cos(t*pi))/8.0
         enddo
      enddo

      do j=1,tp
         ut( 1,j)=0.0
         ut(xp,j)=0.0
      enddo
c----------
      write(6,200)
      do j=1,tp
         do i=1,xp
            t=(j-1)*k
            x=(i-1)*h
            gosa=abs(u(i,j)-ut(i,j))
            write(6,100) t,x,u(i,j),ut(i,j),gosa
         enddo
         write(6,*)''
      enddo

      return
  100 format(f5.2,1x,f5.2,e18.9,1x,e18.9,1x,e18.9)
  200 format(4x,'t',5x,'x',3x,'$B:9J,2rK!$G$N2r(B',
     -       5x,'$B2r@O2r(B',13x,'$B@dBP8m:9(B') 
      end
