46985 (588457), страница 5

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 5)

!Block_6

!Subroutins

subroutine Stat()

print *, "Matrix information"

write (*,*) 'min i=',lbi,' max i=',ubi

write (*,*) 'min j=',lbj,' max j=',ubj

write (*,*) 'max k=', ubk

print *, "Current position"

write (*,*) 'k=', k

write (*,*) 'Animate delay is ', delay

end subroutine

subroutine ChangeDelay()

write (*,*) 'Current animate delay is ', delay

write (*,'(a\)') 'Enter new value of delay > '

read *, delay

return

end subroutine

subroutine Animat()

integer :: k1, k2, tmp

if (pld==1) then

print *, "Can't animate in this view type"

return

end if

write (*, '(a\)') 'Current k is '

print *, k

write (*, '(a\)') 'Enter start k > '

read *, k1

if (k1>ubk) then

k1=ubk

end if

if (k1

k1=lbk

end if

write (*, '(a\)') 'Enter end k > '

read *, k2

if (k2>ubk) then

k2=ubk

end if

if (k2

k2=lbk

end if

if (k2

tmp=k1

k1=k2

k2=tmp

end if

if (plx==1) then

write(*,'(a\)') 'Enter i > '

read *,ii

i=int(ii/hy)

if (i>ubi) then

i=ubi

end if

if (i

i=lbi

end if

end if

if (ply==1) then

write(*,'(a\)') 'Enter j > '

read *,jj

j=int(jj/hx)

if (j>ubj) then

j=ubj

end if

if (j

j=lbj

end if

end if

print *, "Start animation"

if (vis==1) then

print *, "3D animation"

do k=k1,k2

write (*,*) 'k=', k

do i=lbi,ubi

do j=lbj,ubj

VMas(i,j)=TDMas(k,i,j)

end do

end do

call favUpdate(hav,0,status)

do tmp=1,(delay*1000000)

end do

end do

end if

if (plx==1) then

do k=k1,k2

write (*,*) 'k=', k

do j=lbj,ubj

PXMas(j)=TDMas(k,i,j)

end do

call favUpdate(hav,0,status)

do tmp=1,(delay*1000000)

end do

end do

end if

if (ply==1) then

do k=k1,k2

write (*,*) 'k=', k

do i=lbi,ubi

PYMas(i)=TDMas(k,i,j)

end do

print *, k

call favUpdate(hav,0,status)

do tmp=1,(delay*1000000)

end do

end do

end if

k=k-1

print *, "End animation"

return

end subroutine

subroutine Help()

print *, "Array Visualizer extender v1.01"

print *, "by V. Sidorin (year 2002)"

print *, "View comands:"

print *, "anim, plainx, plainy, plain3d, visual"

print *, "Other comands:"

print *, "newfile, help, k, delay, status, exit"

return

end subroutine

subroutine ChangeK()

write (*,*) 'Current k is: ', k

write(*,'(a\)') 'Enter k > '

read *,k

if (k>ubk) then

k=ubk

end if

if (k

k=lbk

end if

do i=lbi,ubi

do j=lbj,ubj

VMas(i,j)=TDMas(k,i,j)

end do

end do

j=1

do i=lbi,ubi

PYMas(i)=VMas(i,j)

end do

i=1

do j=lbj,ubj

PXMas(j)=VMas(i,j)

end do

call favUpdate(hav, 0, status)

return

end subroutine

subroutine PlainX()

if (plx==0) then

plx=1

ply=0

pld=0

vis=0

call favSetArray(hav, PXMas, status)

call favSetDimScale(hav, 1, XAxis, status)

call favSetUseAxisLabel(hav, X_AXIS, 1, status)

call favSetAxisLabel(hav,X_AXIS, trim(xname), status)

call favSetUseAxisLabel(hav, Z_AXIS, 1, status)

call favSetAxisLabel(hav,Z_AXIS, trim(zname), status)

end if

write(*,'(a\)') 'Enter i > '

read *,ii

i=int(ii/hy)

if (i>ubi) then

i=ubi

end if

if (i

i=lbi

end if

do j=lbj,ubj

PXMas(j)=TDMas(k,i,j)

end do

call favUpdate(hav,0,status)

return

end subroutine

subroutine PlainY()

if (ply==0) then

plx=0

ply=1

pld=0

vis=0

call favSetArray(hav, PYMas, status)

call favSetDimScale(hav, 1, YAxis, status)

call favSetUseAxisLabel(hav, X_AXIS, 1, status)

call favSetAxisLabel(hav,X_AXIS, trim(yname), status)

call favSetUseAxisLabel(hav, Z_AXIS, 1, status)

call favSetAxisLabel(hav,Z_AXIS, trim(zname), status)

end if

write(*,'(a\)') 'Enter j > '

read *,jj

j=int(jj/hx)

if (j>ubi) then

j=ubj

end if

if (j

j=lbj

end if

do i=lbi,ubi

PYMas(i)=TDMas(k,i,j)

end do

call favUpdate(hav,0,status)

return

end subroutine

subroutine Plain()

if (pld==0) then

plx=0

ply=0

pld=1

vis=0

call favSetArray(hav, VMas, status)

call favSetDimScale(hav, 1, YAxis, status)

call favSetDimScale(hav, 2, XAxis, status)

call favSetGraphType(hav, 2, status)

call favSetUseAxisLabel(hav, X_AXIS, 1, status)

call favSetAxisLabel(hav,X_AXIS, trim(xname), status)

call favSetUseAxisLabel(hav, Y_AXIS, 1, status)

call favSetAxisLabel(hav,Y_AXIS, trim(yname), status)

end if

do i=lbi,ubi

do j=lbj,ubj

VMas(i,j)=TDMas(k,i,j)

end do

end do

call favUpdate(hav,0,status)

return

end subroutine

subroutine Visu()

if (vis==0) then

plx=0

ply=0

pld=0

vis=1

call favSetArray(hav, VMas, status)

call favSetDimScale(hav, 1, YAxis, status)

call favSetDimScale(hav, 2, XAxis, status)

call favSetGraphType(hav, 1, status)

call favSetUseAxisLabel(hav, X_AXIS, 1, status)

call favSetAxisLabel(hav,X_AXIS, trim(xname), status)

call favSetUseAxisLabel(hav, Y_AXIS, 1, status)

call favSetAxisLabel(hav,Y_AXIS, trim(yname), status)

call favSetUseAxisLabel(hav, Z_AXIS, 1, status)

call favSetAxisLabel(hav,Z_AXIS, trim(zname), status)

end if

do i=lbi,ubi

do j=lbj,ubj

VMas(i,j)=TDMas(k,i,j)

end do

end do

call favUpdate(hav,0,status)

return

end subroutine

subroutine Paus()

integer(4) :: tmp, a, b

write(*,'(a\)') 'Enter number of delays > '

read *, a

if (a<1) then

a=1

end if

do b=1,a

do tmp=1,(delay*1000000)

end do

end do

end subroutine

end program

Характеристики

Список файлов ВКР