Новичок
Профиль
Группа: Участник
Сообщений: 12
Регистрация: 11.5.2006
Где: Новосибирск
Репутация: нет
Всего: нет
|
| Код |
PROGRAM Lab2
common /ParamX/ Xmin, Xmax, dx, nx, tempx, x
common /ParamY/ Ymin, Ymax, dy, ny, tempy, y
common /Oth/ r, funct, umin
common /Met/ isr, eps
open(unit=2, file='IN.txt')
read(2,*) Ymin, Ymax, dy, Xmin, Xmax, dx
open(unit=1, file='Output.txt')
!~~~~~~~~???????? ???. ??????~~~~~~~~!
call sravn(Xmin,Xmax)
if (isr.EQ.0) then
if (Xmin .GT. Xmax) then
if (dx .GT. 0) goto 777
endif
else
dx=1
endif
call sravn(Ymin,Ymax)
if (isr.EQ.0) then
if (Ymin .GT. Ymax) then
if (dy .GT. 0) then
777 write(1, *) '?????: "???????? ????? ?? ?????"'
print *, '?????: "???????? ????? ?? ?????"'
goto 99
endif
endif
else
dy=1
endif
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
nx = 0
ny = 0
x = Xmin
y = Ymin
r = 0.017453292 !????. ???????? ? ??????? (Pi/180)
eps=0.0001 !????. ??? ????????? ( ???????? ?????. 2-? ?-? ????? )
tempx=x
tempy=y
umin=1e-99
nxmax=NINT(ABS((Xmax-Xmin)/dx))
nymax=NINT(ABS((Ymax-Ymin)/dy))
! print *, nymax
if (nymax.LT.8) then
n=nymax+1
else
n=8
endif
!n=8
!********************************************************!
call prov !proverKa
do
x = Xmin
!~~~~~~~~~~~~~~????? ?~~~~~~~~~~~~~~!
if (n.LT.8) then
write(1,41) ' Y/X |'
call head(n1,n2)
endif
do
if (x .GT. Xmax) x = Xmax
x = Xmin + nx*dx
555 nx = nx + 1
!if (abs(x)<=umin) x=0
call sravn(dx,x+dx)
if (isr.EQ.1) x=0
!nullx=0
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!~~~~~~~~~~~~~~????. ?~~~~~~~~~~~~~~!
R1=ABS(x)
R2=90
k=0
111 call sravn(R1,R2)
if (isr.EQ.1) then
call razd (n)
write(1,22) x,'|'
write(1,700) '??? ????? ? ?-? ?? ?????????? '
goto 67
else
if (R2 .LT. R1) then
k = k + 1
R2=90+180*k
goto 111
else
goto 47
endif
endif
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
47 y = Ymin
ny = 0
tempy = y
!~~~~~~~~~~????? Y ? ???. ?-?~~~~~~~~~!
do while (1)
n1=ny
n2=n1+8
!print *,n1,n2
if (n.GE.8) then
write(1,41) ' Y/X |'
call head(n1,n2)
endif
call razd(n)
write(1,22) x,'|'
call obh_y(n1,n2,n)
if (n.GE.8) then
call razd(n)
write(1,*)
endif
67 call sravn(y,Ymax)
if (isr.EQ.1) exit
enddo
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
call sravn(x, Xmax)
if (isr.EQ.1) goto 99
enddo
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
write(1,*) !??????? ?? ???? ???.
call sravn (y, Ymax)
if (isr .EQ. 1) exit
enddo
!********************************************************!
!~~~~~~~~~~~~~~~???????~~~~~~~~~~~~~~~!
700 format(4('-'),A31,4('-'),\)
22 format(E10.4,'°',A1\)
41 format(A12\)
21 format(\E10.4,A2)
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
99 close(1)
close(2)
end
!********************************************************!
!~~~~~~~~~~?????. ???. ?????~~~~~~~~~~!
subroutine sravn(x,y)
common /Met/ isr, eps
if (abs(x-y).LE.eps*abs(max(x,y))) then
isr=1
else
isr=0
endif
end
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!~~~~~~~~~?????? ???????????~~~~~~~~~!
subroutine razd(n)
write(1,*)
do 1 i=1, n+1
1 write(1,2)
write(1,*)
2 format(\\12('-'))
end
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!~~~~???????? ??? ?????????? ????~~~~!
subroutine prov
common /ParamX/ Xmin, Xmax, dx, nx, tempx, x
common /ParamY/ Ymin, Ymax, dy, ny, tempy, y
common /Oth/ r, funct, umin
common /Met/ isr, eps
1 x1=Xmin
x2=Xmin+dx
call sravn(x1,x2)
if (isr.EQ.1) then
dx=dx*10
goto 1
endif
2 y1=Ymin
y2=Ymin+dy
call sravn(y1,y2)
if (isr.EQ.1) then
dy=dy*10
goto 2
endif
end
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!~~~~~~~~~?????? ?????? ???????~~~~~~!
subroutine head(n1,n2)
common /ParamX/ Xmin, Xmax, dx, nx, tempx, x
common /ParamY/ Ymin, Ymax, dy, ny, tempy, y
common /Oth/ r, funct, umin
common /Met/ isr, eps
ny=n1
do while(1)
if (y.GT.Ymax) y = Ymax
y = Ymin + ny*dy
ny = ny + 1
!if (abs(y)<=umin) y=0
call sravn(dy,y+dy)
if (isr.EQ.1) y=0
write(1,1) y,'|'
call sravn(y, Ymax)
if (isr.EQ.1) exit
if (ny.EQ.n2) exit
enddo
1 format(E10.4,'°',A1\)
end
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
!~~~~~~~~~~~~??????? Y ? ?-?~~~~~~~~~!
subroutine obh_y(n1,n2)
common /ParamX/ Xmin, Xmax, dx, nx, tempx, x
common /ParamY/ Ymin, Ymax, dy, ny, tempy, y
common /Oth/ r, funct, umin
common /Met/ isr, eps
ny=n1
4 do while(1)
R1=ABS(y)
R2=90-dy
k=0
3 call sravn(R1,R2)
if (isr.EQ.1) then
write(1,41) ' error |'
y = Ymin + ny*dy
ny = ny + 1
goto 2
else
if (R2 .LT. R1) then
k = k + 1
R2=90+360*k-dy
goto 3
else
goto 1
endif
endif
1 R1=ABS(y)
R2=180-dy
k=0
33 call sravn(R1,R2)
if (isr.EQ.1) then
y = Ymin + ny*dy
ny = ny + 1
funct=0
goto 5
else
if (R2 .LT. R1) then
k = k + 1
R2=180+360*k-dy
goto 33
else
goto 11
endif
endif
enddo
11 if (y.GT.Ymax) y = Ymax
y = Ymin + ny*dy
ny = ny + 1
!if (abs(y)<=umin) y=0
call sravn(dy,y+dy)
if (isr.EQ.1) y=0
c y=x x=y
funct=(tan(y*r)/cos(x*r)) !??????? ?-?
5 write(1,21) funct,' |' !?????? ?????
2 call sravn(y, Ymax)
if (isr.EQ.1) stop
if (ny .EQ. n2) stop
22 format(E10.4,'°',A1\)
41 format(A12\)
21 format(\E10.4,A2)
end
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~!
|
Компилятор Watcom. На Вижуале все без проблемма, но нужно компилить именно на Ваткоме. При компиляции 2 ошибки: laba2.for(25): *ERR* SP-09 cannot branch to 777 from outside control structure
in line 14
laba2.for(123): *ERR* SP-09 cannot branch to 67 from outside control structure
in line 89В чем может быть проблема? Спасибо! Это сообщение отредактировал(а) KJIaCCuK - 11.3.2008, 22:14 |
[Fortran]Goto, Ошибки про компиляции 
Загрузка ...
