99 format (E12.5)

open (3,FILE=trim(txtFile))

 do k=lbk,ubk

 do i=lbi,ubi

 do j=lbj,ubj

 read(3,99,END=3) TDMas(k,i,j);

 end do

end do

 end do

close (3)

!starting state k=1, i=1, j=1

3 k=1

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

delay = 80

!Block_3

!prepare to start AV

call faglStartWatch(VMas, status)

call faglStartWatch(PXMas, status)

call faglStartWatch(PYMas, status)

call faglStartWatch(XAxis, status)

call faglStartWatch(YAxis, status)

!starting graph is 'visual' k=1

plx=0;

ply=0;

pld=0;

vis=1;

call favStartViewer(hav, status)

call favSetArray(hav, VMas, status)

call favSetDimScale(hav, 1, YAxis, status)

call favSetDimScale(hav, 2, XAxis, status)

call favShowWindow(hav, av_true, 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)

call Stat()

!Block_4

4 call favSetArrayName(hav, 'Array Visualizer Extender Shell', status)

write (*,'(a\)') 'Enter comand (help for comand list)> '

read(*,'(a)') com

if (trim(com) == 'status') then

 call Stat()

end if

if (trim(com) == 'anim') then

 call Animat()

end if

if (trim(com) == 'delay') then

 call ChangeDelay()

end if

if (trim(com) == 'k') then

 call ChangeK()

end if

if (trim(com) == 'plainx') then

 call PlainX()

end if

if (trim(com) == 'plainy') then

 call PlainY()

end if

if (trim(com) == 'plain3d') then

 call Plain()

end if

if (trim(com) == 'visual') then

 call Visu()

end if

if (trim(com) == 'help') then

 call Help()

end if

if (trim(com) == 'exit') then

 goto 5

end if

if (trim(com) == 'pause') then

call Paus()

end if

if (trim(com) == 'newfile') then

 goto 1

end if

goto 4

!Block_5

5 print *, "Ending work"

 call faglEndWatch(Vmas, status)

 call faglEndWatch(PXMas, status)

 call faglEndWatch(PYMas, status)

 call faglEndWatch(XAxis, status)

 call faglEndWatch(YAxis, status)

 deallocate(TDMas)

 deallocate(VMas)

 deallocate(PXMas)

 deallocate(PYMas)

 deallocate(XAxis)

 deallocate(YAxis)

 call favEndViewer(hav, status)

 

contains

!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<lbk) then

 k1=lbk

 end if

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

 read *, k2

 if (k2>ubk) then

 k2=ubk

 end if

 if (k2<lbk) then

 k2=lbk

 end if

 if (k2<k1) then

 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<lbi) then

 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<lbj) then

 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<lbk) then

 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<lbi) then

 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<lbj) then

 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


Информация о работе «Визуализация инженерных и научных расчетов»
Раздел: Информатика, программирование
Количество знаков с пробелами: 112439
Количество таблиц: 9
Количество изображений: 11

Похожие работы

Скачать
249178
21
46

... системам линейных алгебраических уравнений с более чем одной неизвестной; MATLAB решает такие уравнения без вычисле-ния обратной матрицы. Хотя это и не является стандартным математическим обозначением, система MATLAB использует терминологию, связанную с обычным делением в одномерном случае, для описания общего случая решения совместной системы нескольких линейных уравнений. Два символа деления / ...

Скачать
114601
5
73

... концентрических окружностей с уменьшающимся радиусом по мере затухания колебаний скорости и момента. Аналогичная картина наблюдается при ступенчатом набросе нагрузки. 5. РАЗРАБОТКА ВИРТУАЛЬНОЙ ЛАБОРАТОРНОЙ РАБОТЫ НА БАЗЕ ВИРТУАЛЬНОЙ АСИНХРОННОЙ МАШИНЫ   Иную возможность анализа АД представляет специализированный раздел по электротехнике Toolbox Power System Block. В его библиотеке имеются блоки ...

Скачать
60267
1
0

... - в группе переменных, «зажатых в кулак», но этот «кулак», как мы уже отмечали, легко разжать, выводя на дисплей найденные значения с «первородной» размерностью массы (kg), длины (m) и времени (sec): пакет MathCAD «разжимает» и сам вектор, м составные размерности, приписывая к числам комбинации основных физических единиц. Но не только этим хороша размерность в задачах. Главное то , что она ...

Скачать
55431
1
0

... де-факто, чему способствовала и их большая универсальность). Таким образом, именно Microsoft Excel был выбран мной для разработки средства автоматизации расчетов в лабораторной работе «Предварительные вычисления в триангуляции». Поэтому другие средства построения электронных таблиц здесь не рассматриваются, но зато уделяестся внимание некоторым специфичным средствам Excel. Возможности EXCEL ...

0 комментариев


Наверх