Написание программы, реализующей на языке ФОРТРАН построение таблицы значений функции ctg(x+y) (Лабораторная работа № 2), страница 2

        if((min_y.eq.max_y).and.(step_y.eq.0)) then

        call s4et(x,y,err,tab,i,j)

        else

        do while(y.le.max_y)

                call s4et(x,y,err,tab,i,j) !s4itaem znachenie funkcii dlia x i y

                y=y+step_y

                j=j+1  

        end do

        end if

        if(y.lt.(y-step_y)) then !esli shag izmeneniya y ne delit diapazon zna4enij y nacelo

        y=max_y 

        call s4et(x,y,err,tab,i,j) !otdelno pos4itaem zna4enie funkcii pri maksimalnom y

        end if

        x=okrgl(x)

        u=check(x) !proverka na ravenstvo argumenta x 0

        if (u.eq.1) then

        write(2,2) 0.0

        else

        write(2,2) x !vivodim zna4enie x dlya i-toj stroki tablici

        end if             

        kt=1

        if((min_y.eq.max_y).and.(step_y.eq.0)) then

        if(err(i,kt).eq.1) then !esli pri zadannix zna4eniyax argumentov funkciya ne opredelena

        write(2,4)'err   ' !vivedem soob6enie ob o6ibke

        else

          write(2,2) tab(i,kt)

        end if

        else

        do while (kt.ne.j)

        if(err(i,kt).eq.1) then !esli pri zadannix zna4eniyax argumentov funkciya ne opredelena

        write(2,4)'err   ' !vivedem soob6enie ob o6ibke

        kt=kt+1

        else

          write(2,2) tab(i,kt) !vivodim zna4enie funkcii v kt-ya4ejku i-toj stroki tablici 

            kt=kt+1

            end if

        end do

        end if

        write(2,1) (' ',kt=1,160)

        write(2,3) '|'

        write(2,1) ('_', kt=1,160) !perexod na sleduyushuyu stroku tablici

      if((min_x.eq.max_x).and.(step_x.eq.0)) then !esli promezhutok izmeneniya x to4ka

      goto 8

      else    

        x=x+step_x

        i=i+1

        end if

      end do

8     if(x.lt.(x-step_x)) then !esli shag izmeneniya x ne delit diapazon zna4enij x nacelo

      x=max_x 

      y=min_y

      j=1

      if((min_y.eq.max_y).and.(step_y.eq.0)) then

        call s4et(x,y,err,tab,i,j)

        else

      do while(y.le.max_y) !otdelno pos4itaem zna4eniya funkcii dlya maksimalnogo x i vsex y iz diapazona y

      call s4et(x,y,err,tab,i,j)

      y=y+step_y

      j=j+1  

      end do

      end if

      if(y.lt.(y-step_y)) then !esli shag izmeneniya y ne delit diapazon zna4enij y nacelo

      y=max_y

      call s4et(x,y,err,tab,i,j) !otdelno pos4itaem zna4enie funkcii pri maksimalnom y

      end if

      write(2,3) '|'

      write(2,2) x   !vivodim x dlya poslednej stroki        

      kt=1

      do while(kt.ne.j)

      if(err(i,kt).eq.1) then

      write(2,4)'err   '

      kt=kt+1

      else

      write(2,2) tab(i,kt) !vivodim zna4enie funkcii v kt-ya4ejku poslednej stroki tablici

      kt=kt+1

      end if

      end do

      write(2,1) (' ',kt=1,160)

      write(2,3) '|'

      write(2,1) ('_', kt=1,160) 

      end if     

      close(1)

      end

      function ctg(x,y) !s4itiaem funkciyu

      rad=3.1415927/180.0

      ctg=cotan((x+y)*rad)

      end

      real function okrgl(a)

      character *10 ba

      write(ba,25)a

      write(55,25)a

      read(ba,25)c

      write(55,25)c

      okrgl=c

      return

25    format(E10.4)

      end

      integer function check(a)

      character *10 a1,a2

      write(a1,5) a

      write(a2,5) 0.0

      if(a1.eq.a2) then

      check=1

      else

      check=0

      end if

      return

5     format(E10.4)

      end

      subroutine s4et(x,y,err,tab,i,j)

      dimension tab(100,100)

      dimension err(100,100)     

      rad=3.1415927/180.0

      arg=(int(x+y))/180 !proveryaem

      xt=real(arg)*180.0 !kratnost' argumenta 180

      if((x+y).ne.xt) then !esli znachenie funkcii opredeleno

      arg=(int(x+y))/90 !to proveryaem

      xt=real(arg)*90.0 !kratnost' argumenta 90

      if(xt.ne.(x+y)) then !esli cos(x+y)!=0 i sin(x+y)!=0

      tab(i,j)=ctg(x,y)   !s4itaem ego

      err(i,j)=0 !oshibki net, zanosim 0 v massiv metok soobsh'enij ob oshibke

        else

                err(i,j)=0

                tab(i,j)=0 !esli cos(x+y)=0 i sin(x+y)!=0

        end if

        else !esli znachenie nekorrektno

        err(i,j)=1  !oshibka est', zanosim 1 v massiv metok soobsh'enij ob oshibke

        end if

        end

Тесты:

[min_x, max_x] – промежуток изменения аргумента x

[min_y, max_y] – промежуток изменения аргумента y