Численное решение краевых задач. Учебно-методическое пособие

call Plot2((/xgmin,xgmax/),(/0.0d0,0.0d0/),icol,1000,drx) call Plot2((/0.0d0,0.0d0/),(/ygmin,ygmax/),icol,1000,dry)

call moveto_w(xgmax+0.02*dxg,-0.05*dyg,wxy); call outgtext(xax) call moveto_w(-0.05*dxg,ygmax+0.05*dyg,wxy); call outgtext(yax) end subroutine AXIS

subroutine GRID(Nxg,Nyg,icol) ! построение сетки character(6) ch1

real*8 x,dx,y,dy

ncol=setcolor(icol); dxg=xgmax-xgmin; dyg=ygmax-ygmin dx=dxg/Nxg; dy=dyg/Nyg

x=xgmin; y=ygmax do i=1,Nxg+1

call moveto_w(x,ygmin,wxy); iz=lineto_w(x,y)

call moveto_w(x,0.0_8,wxy); write(ch1,'(f6.2)')x; call outgtext(ch1) x=x+dx

end do

x=xgmax; y=ygmin do i=1,Nyg+1

call moveto_w(xgmin,y,wxy); iz=lineto_w(x,y) if(abs(y)>1.d-3)then

call moveto_w(-0.1d0*dxg,y,wxy); write(ch1,'(f6.2)')y; call outgtext(ch1) end if

y=y+dy end do

end subroutine GRID

subroutine PLOT(x,y,icol,isl,im) ! построение 2D-кривой real*8 x(:),y(:)

imin=lbound(x,dim=1); imax=ubound(x,dim=1) ncol=setcolor(icol)

select case(im);case(1);mask=#FFFF;case(2);mask=#FF00;end select call setlinestyle(mask)

call moveto_w(x(imin),y(imin),wxy) do i=imin,imax

iz=lineto_w(x(i),y(i)); call sleepqq(isl) end do

end subroutine PLOT

subroutine PLOT2(x,y,icol,Np,dr) ! построение 2D-кривой толстой линией

61

real*8 x(:),y(:),dr

imin=lbound(x,dim=1); imax=ubound(x,dim=1) ncol=setcolor(icol)

do k=imin,imax-1 dx=(x(k+1)-x(k))/(Np-1) dy=(y(k+1)-y(k))/(Np-1) do j=1,Np

if(abs(dx)<1d-9)then ! верт. линия xp=x(k)

yp=y(k)+dy*(j-1) else xp=x(k)+dx*(j-1)

yp=y(k)+(dy/dx)*(xp-x(k)) end if

iz=ellipse_w(3,xp-dr,yp-dr,xp+dr,yp+dr) end do

end do

end subroutine PLOT2

subroutine Map2D(x,y,z,ivar,x2,y2) ! параллельное проецирование real*8 x(:),y(:),z(:),x2(:)

real*8 y2(:),fi,psi,dsf,dcf,dsp,dcp select case(ivar)

case(1) ! изометрия fi=dasin(1.0_8/dsqrt(3.0_8)) psi=dasin(1.0_8/dsqrt(2.0_8)) case(2) ! диметрия fi=dasin(1.0_8)/4.0_8 psi=dasin(dtan(fi))

end select

dsf=dsin(fi); dcf=dcos(fi) dsp=dsin(psi); dcp=dcos(psi)

!x2=x*dcp+z*dsp; y2=x*dsf*dsp+y*dcf-z*dsf*dcp ! ось x вправо x2=-x*dcp+z*dsp; y2=-x*dsf*dsp+y*dcf-z*dsf*dcp ! ось x влево end subroutine Map2D

subroutine Axis3D(xax,yax,zax,ivar,icol,dr) ! построение 3D-осей real*8 xa(4),ya(4),za(4),xa2(4),ya2(4),dr

character(*) xax,yax,zax ca=1.0

62

xa=(/0.0d0,xgmax,0.d0,0.0d0/)*ca

ya=(/0.0d0,0.0d0,ygmax,0.0d0/)*ca

za=(/0.0d0,0.d0,0.0d0,zgmax/)*ca call Map2D(xa,ya,za,ivar,xa2,ya2) do i=2,4

call Plot2((/xa2(1),xa2(i)/),(/ya2(1),ya2(i)/),icol,1000,dr) end do

call moveto_w(xa2(2),ya2(2),wxy); call outgtext(xax) call moveto_w(xa2(3),ya2(3),wxy); call outgtext(yax) call moveto_w(xa2(4),ya2(4),wxy); call outgtext(zax) end subroutine Axis3D

subroutine Plot3D(x,y,z,ivar,icol,isl,im) ! построение 3D-кривой real*8 x(:),y(:),z(:)

real*8, allocatable :: x2(:),y2(:) N=size(x); allocate(x2(N),y2(N)) call Map2D(x,y,z,ivar,x2,y2) call Plot(x2,y2,icol,isl,im)

end subroutine Plot3D

subroutine Animate(x,u,xax,yax,icol,isl,im,dr,Lclear) ! анимация !use GRAFLIB

real*8 x(:),u(:,:),dr; logical Lclear character(*) xax,yax M=size(u,dim=1)

do j=1,M

call Axis(xax,yax,0,dr) call GRID(5,5,0)

call Plot(x,u(j,:),icol,0,im); call sleepqq(isl) if(Lclear)then;if(j<M)call Plot(x,u(j,:),15,0,im);end if end do

end subroutine Animate

end module GRAFLIB

63