Форум программистов [Powered by Invision Power Board]

Код

subroutine vvod
    common /blok/ a1,a2,a3,b1,b2,b3, c(3),cos,i,j
    
       print* ,'Enter coordinates of'
     print* ,'first top'
     read* ,a1,b1
       print* ,'second top'
       read* , a2,b2
       print* ,'third top'
       read* , a3,b3

    end
     
    subroutine cosinus
    common /blok/ a1,a2,a3,b1,b2,b3, c(3),cos,i,j
    dimension e(6)


    e(1) = abs(a2-a1)
    e(2) = abs(b2-b1)

      e(3) = abs(a3-a1)
    e(4) = abs(b3-b1)

    e(5) = abs(a3-a2)
    e(6) = abs(b3-b2)

    c(1)  = (e(1)**2 + e(2)**2)**0.5
      c(2)  = (e(3)**2 + e(4)**2)**0.5
    c(3)  = (e(5)**2 + e(6)**2)**0.5

    c_min= c(1)
    i = 2
    j = 3
    if(c(2) .LT. c_min) then
    i = 1
    j = 3 
    c_min = c(2) 
    end if
    if(c(3) .LT. c_min) then
    c_min = c(3)
    i = 1
    j = 2
    end if

      
      cos = ((e(2*i-1)*e(2*j-1) + e(2*i)*e(2*j)) /(c(i)*c(j)))
    

    end

    


      subroutine square(S)
      common /blok/ a1,a2,a3,b1,b2,b3, c(3),cos,i,j
      
      sin = (1-cos**2)**0.5

    S = c(i)*c(j)*sin*0.5
    
      end

    subroutine ugol(U)
      common /blok/ a1,a2,a3,b1,b2,b3, c(3),cos,i,j

    pi  = 3.1415926
        U = (acos(cos)/pi)*180 
    end



    program main

    common /blok/ a1,a2,a3,b1,b2,b3, c(3),cos
    


      print* ,'Main menu'
      i_command =1
    i_error =0
    do while(i_command .NE. 5) 
       
        if (i_command .EQ. 1) then 
           call vvod    
        else 
             if (i_command .EQ. 2) then 
               call square(S)
               print* ,'Square:'
               print* , S  
           else
               if (i_command .EQ. 3) then
                   print* ,'Cosinus:'
                   print* ,cos 
                 else
                  if (i_command .EQ. 4) then
                        call ugol(U) 
                      print* , 'Angle'
                      print* , U
                  else
                      print* , 'Command Error'
                  end if
                 end if
             end if
        end if 

     
     call cosinus

       print* ,'Main menu'
     print* ,'1. Enter new coordinates'
       print* ,'2. Square of triangle'
       print* ,'3. Cosinus'
     print* ,'4. Angle'
     print* ,'5. Exit'

     print* ,'Enter command:'
       read* ,i_command

    end do

    print* ,'(c) KJIaCCuK. ALL RIGHTS RESERV'
       read*
     end