Advertisement
Wolfed_7

Untitled

Feb 16th, 2022
1,470
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. c     Main menu
  2.       PROGRAM main
  3.       IMPLICIT NONE
  4.  
  5.       INTEGER command
  6.  
  7.       COMMON / input / a, b, alpha
  8.       COMMON / utility / PI, beta
  9.       COMMON / flag / is_triangle_created
  10.  
  11.       REAL calculate_area, find_min_angle, min_angle_cos
  12.       REAL a, b, alpha
  13.       REAL PI, beta
  14.       LOGICAL is_triangle_created
  15.       is_triangle_created = .FALSE.
  16.       PI = 3.1415927
  17.  
  18.       PRINT *, '1. Create new triangle.'
  19.       PRINT *, '2. Calculate area.'
  20.       PRINT *, '3. Find minimal angle.'
  21.       PRINT *, '4. Find cosin of minimal angle.'
  22.       PRINT *, '5. Exit.'
  23. c     Delete this
  24.       PRINT *, '6. (temp) Show triangle params.'
  25. c     Delete this
  26.     1 PRINT *, '>> '
  27.  
  28.       READ *, command
  29.       IF(.NOT. is_triangle_created .AND.
  30.      + (command .EQ. 2 .OR. command .EQ. 3 .OR. command .EQ. 4)) THEN
  31.          PRINT *, 'Error: triangle is not created.'
  32.          GOTO 1
  33.       ENDIF
  34.  
  35.       SELECT CASE (command)
  36.       CASE (1)
  37.          CALL input_triangle
  38.       CASE (2)
  39.          PRINT *, 'Area = ', calculate_area()
  40.       CASE (3)
  41.          PRINT *, 'Minimal angle = ', find_min_angle()
  42.       CASE (4)
  43.          PRINT *, 'Minimal angle cosin = ', min_angle_cos()
  44.       CASE (5)
  45.          GOTO 2
  46.       CASE (6)
  47. c     Delete this      
  48.          CALL write_triangle
  49. c     Delete this
  50.       CASE default
  51.          PRINT *, 'Unexpected command'
  52.       END SELECT
  53.       GOTO 1
  54.     2 END
  55.  
  56. c     Triangle creation
  57.       SUBROUTINE input_triangle
  58.       IMPLICIT NONE
  59.      
  60.       COMMON / input / a, b, alpha
  61.       COMMON / utility / PI, beta
  62.       COMMON / flag / is_triangle_created
  63.      
  64.       REAL a, b, alpha
  65.       REAL PI, beta
  66.       LOGICAL is_triangle_created
  67.  
  68.     3 PRINT *, 'Enter [a] [b] [alpha]:'
  69.       READ *, a, b, alpha
  70.  
  71.       IF(a .LE. 0 .OR. b .LE. 0 .OR. alpha .LE. 0 .OR.
  72.      + (a .LE. b*SIN(alpha * PI/180))) THEN
  73.          PRINT *, 'Error: triangle is not exist'
  74.          GOTO 3
  75.       ENDIF
  76.  
  77.       is_triangle_created = .TRUE.
  78.       PRINT *, 'Triangle is created'
  79.       END
  80.  
  81. c     Area calculation
  82.       REAL FUNCTION calculate_area()
  83.       IMPLICIT NONE
  84.  
  85.       COMMON / input / a, b, alpha
  86.       COMMON / utility / PI, beta
  87.  
  88.       REAL a, b, alpha
  89.       REAL PI, beta
  90.  
  91.       beta = ASIN(b/a * SIN(alpha * PI/180)) * 180/PI
  92.       calculate_area = 0.5 * a * b * SIN((180 - beta - alpha) * PI/180)
  93.  
  94.       RETURN
  95.       END
  96.  
  97. c     Minimal angle finding
  98.       REAL FUNCTION find_min_angle()
  99.       IMPLICIT NONE
  100.  
  101.       COMMON / input / a, b, alpha
  102.       COMMON / utility / PI, beta
  103.  
  104.       REAL a, b, alpha
  105.       REAL PI, beta
  106.       REAL gamma, minv
  107.  
  108.       beta = ASIN(b/a * SIN(alpha * PI/180)) * 180/PI
  109.       gamma = 180 - alpha - beta
  110.  
  111.       minv = alpha
  112.       IF (beta .LT. minv) THEN
  113.          minv = beta
  114.       ENDIF
  115.       IF (gamma .LT. minv) THEN
  116.          minv = gamma
  117.       ENDIF
  118.       find_min_angle = minv
  119.  
  120.       RETURN
  121.       END
  122.      
  123. c     Calculate cosin of minimal angle
  124.       REAL FUNCTION min_angle_cos()
  125.       IMPLICIT NONE
  126.  
  127.       COMMON / input / a, b, alpha
  128.       COMMON / utility / PI, beta
  129.  
  130.       REAL a, b, alpha
  131.       REAL PI, beta, find_min_angle
  132.  
  133.       min_angle_cos = COS(find_min_angle() * PI/180)
  134.       END
  135.  
  136. c     Delete
  137.       SUBROUTINE write_triangle
  138.  
  139.       COMMON / input / a, b, alpha
  140.       COMMON / utility / PI, beta
  141.  
  142.       REAL a, b, alpha
  143.       REAL PI, beta
  144.  
  145.       PRINT *, 'a = ', a
  146.       PRINT *, 'b = ', b
  147.       PRINT *, 'alpha = ', alpha
  148.  
  149.       END
  150. c     Delete
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement