Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- program triangles
- implicit none
- real*4 a, b, alpha, minimalangle
- integer action
- common /tr/a, b, alpha
- call menu
- contains
- logical *1 function trcon()
- trcon = a.GT.0 .AND. b.GT.0 .AND. alpha.GT.0 .AND. alpha.LT.180
- end
- subroutine menu
- write (*, *) ""
- write (*,*) "--- MENU ---"
- write (*,*) "1. Input triangle"
- write (*,*) "2. Find space"
- write (*,*) "3. Find minimal angle"
- write (*,*) "4. Find cos(minimal angle)"
- write (*,*) "5. Exit"
- write (*, *) ""
- read (*, *) action
- if (action.eq.1) call menu1
- if (action.eq.2) call menu2
- if (action.eq.3) call menu3
- if (action.eq.4) call menu4
- if (action.eq.5) call menu5
- if (action.lt.1 .or. action.gt.5) then
- write (*, *) "Wrong command"
- call exit(-1)
- end if
- end
- subroutine menu1
- ! Data input
- write (*,*) 'Type edges a, b and angle alpha:'
- read (*,*) a, b, alpha
- if (.NOT.trcon()) then
- write (*,*) 'Error: provided data is not triangle'
- a = 0
- b = 0
- alpha = 180
- end if
- call menu
- end
- subroutine menu2
- ! Space calculation
- real*4 s
- if (trcon()) then
- s = 0.5 * a * b * sind(alpha)
- write (*,*) 'S =', s
- else
- write (*, *) "Input valid triangle (1) first"
- end if
- call menu
- end
- subroutine menu3
- ! Minimal angle search (in degrees)
- real*4 gamma, beta, c
- if (trcon()) then
- c = sqrt(a**2 + b**2 - 2*a*b*cosd(alpha))
- write (*, *) "--- ANGLES ---"
- write (*, *) alpha
- beta = acosd((b**2 + c**2 - a**2) / (2 * b * c))
- write (*,*) beta
- gamma = acosd((c**2 + a**2 - b**2) / (2 * c * a))
- write (*,*) gamma
- minimalangle = alpha
- if (beta.LT.minimalangle) minimalangle = beta
- if (gamma.LT.minimalangle) minimalangle = gamma
- write (*,*) "Minimal angle equals", minimalangle
- else
- write (*, *) "Input valid triangle (1) first"
- end if
- call menu
- end
- subroutine menu4
- ! cos(minimal angle) calculation
- real*4 result
- if (trcon()) then
- result = cosd(minimalangle)
- write (*,*) "cos(minimal angle) =", result
- else
- write (*, *) "Input valid triangle (1) first"
- end if
- call menu
- end
- subroutine menu5
- ! Program exit
- call exit(0)
- end
- end
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement