Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Центр помощи > [Fortran]Goto


Автор: KJIaCCuK 11.3.2008, 20:26
Код

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


В чем может быть проблема?
Спасибо!

Автор: Cr@$h 15.1.2009, 16:07
Watcom ругается, что не может осуществлять переход по метке из управляющей структуры. И там, и там. В данном случае из веток if. Возможно, компилятор поддерживает какой-то старый стандарт языка. Сам я не могу вспомнить, что когда-то так нельзя было делать на Fortran xx. Следует переписать код так, чтобы перехода по меткам из управляющих структур не было.

P.S. Кстати, лучше вообще обходиться без меток. Наиболее эффективно и, порой, единственно возможно это делать в языках, имеющих именуемые блоки и, желательно, именуемые управляющие структуры.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)