PROGRAM Geometry
! Copyright 2006 Matthew Norton
!
!    This program is free software; you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation; either version 2 of the License, or
!    (at your option) any later version.
!
!    This program is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with this program; if not, write to the Free Software
!    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
!
! NOTE: This is in FORTRAN 90 and you will need a FORTRAN 90 complier to run this code
! --------------------------------------------------------------------------------------
IMPLICIT NONE

DOUBLE PRECISION Area, Base, Height, Length, Width, Radius, Volume, Side, Base1, Base2
DOUBLE PRECISION, PARAMETER :: Pi = 3.141592653589793
INTEGER :: Res
CHARACTER(1) :: Resp

Main: Do
PRINT *, "What type of shape do you want to solve for? (Enter 0 to quit)"
PRINT *, "1. 2-D"
PRINT *, "2. 3-D"
READ *, Res

SELECT CASE (Res)
   CASE(1)
      CALL D2()
   CASE(2)
      CALL D3()
   CASE (0)
      EXIT Main
   CASE DEFAULT
      PRINT *, "Invalid input, please try again"
      CYCLE Main
   END SELECT

END DO Main

PRINT *, "Have a great day!"
STOP

CONTAINS

! --------------------------------------------------------------------------------------------------------------------------------------------

 SUBROUTINE D2
    PRINT *, "What shape would you like to solve for?"
    PRINT *, "1. Square"
    PRINT *, "2. Rectangle"
    PRINT *, "3. Parallelogram"
    PRINT *, "4. Triangle"
    PRINT *, "5. Circle"
    PRINT *, "6. Trapezoid"
    READ *, Res

    SELECT CASE (Res)
       CASE(1)
          CALL Square()
       CASE(2)
          CALL Rectangle()
       CASE(3)
          CALL Parallelogram()
       CASE(4)
          CALL Triangle()
       CASE(5)
          CALL Circle()
       CASE(6)
          CALL Trapezoid()
       CASE DEFAULT
          PRINT *, "ERROR invalid input!"
          RETURN
       END SELECT
END SUBROUTINE D2

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Square
  PRINT *, "What is the side lenght of the square?"
  READ *, Side

  Area = Side ** 2

  PRINT *, "The area of the square is: ", Area

  PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Square

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Rectangle
  PRINT *, "What is the lenght of the rectangle?"
  READ *, Length
  PRINT *, "What is the width of the rectangle?"
  READ *, Width

  Area = Length * Width

  PRINT *, "The area of the rectangle is: ", Area

   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Rectangle

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Parallelogram
  PRINT *, "What is the base of the parallelogram?"
  READ *, Base
  PRINT *, "What is the height of the parallelogram?"
  READ *, Height

  Area = Length * Height

  PRINT *, "The area of the parallelogram is: ", Area

   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Parallelogram

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Triangle
  PRINT *, "What is the base of the triangle?"
  READ *, base
  PRINT *, "What is the height of the triangle?"
  READ *, Height

  Area = (1./2.) * Base * Height

  PRINT *, "The area of the triangle is: ", Area


   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Triangle

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Circle
  PRINT *, "What is the radius of the circle?"
  READ *, radius

  Area = Pi * Radius ** 2

  PRINT *, "The area of the circle is: ", Area
  PRINT *, "The area of the circle is: pi*", Radius ** 2

   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Circle

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Trapezoid
  PRINT *, "What is base1 of the trapezoid?"
  READ *, Base1
  PRINT *, "What is base2 of the trapezoid?"
  READ *, Base2
  PRINT *, "What is the height of the trapezoid?"
  READ *, Height

  Area = (1./2.) * Height * (Base1 + Base2)

  PRINT *, "The area of the trapezoid is: ", Area

   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Trapezoid

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE D3
  PRINT *, "What whape do you want to solve for?"
  PRINT *, "1. Cube"
  PRINT *, "2. Right Pyramid"
  PRINT *, "3. Right Cylinder"
  PRINT *, "4. Right Cone"
  PRINT *, "5. Sphere"
  READ *, Res

    SELECT CASE (Res)
       CASE(1)
          CALL Cube()
       CASE(2)
          CALL Pyramid()
       CASE(3)
          CALL Cylinder()
       CASE(4)
          CALL Cone()
       CASE(5)
          CALL Sphere()
       CASE DEFAULT
          PRINT *, "ERROR invalid input!"
          RETURN
       END SELECT
     END Subroutine D3

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Cube
  PRINT *, "What is the length of the side of the cube?"
  READ *, Side
 
  Volume = Side ** 3

  PRINT *, "The volume of the cube is: ", Volume

   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Cube

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Pyramid
  PRINT *, "What is the length of the side of the base of the pyramid?"
  READ *, Side
  PRINT *, "What is the height of the pyramid?"
  READ *, Height

  Volume = (1./3.) * Side ** 2 * Height

  PRINT *, "The volume of the pyramid is: ", Volume

   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Pyramid

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Cylinder
  PRINT *, "What is the radius of the base of the cylinder"
  READ *, Side
  PRINT *, "What is the height of the pyramid?"
  READ *, Height

  Volume = Pi * Radius ** 2 * Height

  PRINT *, "The volume of the pyramid is: ", Volume
  PRINT *, "The volume of the pyramid is: Pi*", Radius **2 * Height
   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Cylinder

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Cone
  PRINT *, "What is the radius of the base of the cone"
  READ *, Side
  PRINT *, "What is the height of the cone?"
  READ *, Height

  Volume = (1./3.) * Pi * Radius ** 2 * Height

  PRINT *, "The volume of the cone is: ", Volume
  PRINT *, "The volume of the cone is: Pi*", (1./3.) * Radius **2 * Height
   PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Cone

! --------------------------------------------------------------------------------------------------------------------------------------------

SUBROUTINE Sphere
  PRINT *, "What is the radius of the sphere?"
  READ *, Radius

  Volume = (4./3.) * Pi * Radius ** 3

  PRINT *, "The volume of the sphere is: ", Volume
  PRINT *, "The volume of the sphere is: Pi*", (4./3.) * Radius **3

  PRINT '(// A)', "Find more (y/n)?"
  READ *, Resp

  SELECT CASE(Resp)
     CASE("n")
        STOP
     CASE Default
        RETURN
  END Select

END SUBROUTINE Sphere

END PROGRAM Geometry