something.f90

MODULE circleFunctions
	CONTAINS
	SUBROUTINE circle(x, y)
		REAL (KIND=8), INTENT(IN) :: x
		REAL (KIND=8), INTENT(OUT) :: y
		IF (x**2 < 1) THEN
			y = sqrt(1-x**2)
		ELSE
			y = 0
		END IF
	END SUBROUTINE
END MODULE
!*************************************************************************
PROGRAM unnecessarilyComplicatedFortranProgram
IMPLICIT NONE
REAL :: cherryPi ! Monte Carlo
REAL :: applePi  ! Reimann Sum
INTEGER :: it1, it2
LOGICAL :: theres_something_strange, you_cant_touch_this, sailing_away

DO
	CALL jenny8675309(1, 0, 0)
	CALL bad_fortran_jokes(theres_something_strange, you_cant_touch_this, sailing_away)
	IF(sailing_away) EXIT ! Styx
	IF(theres_something_strange) CALL ghostbusters(cherryPi, it1)
	IF(theres_something_strange) CALL jenny8675309(2, cherryPi, it1)
	IF(you_cant_touch_this) CALL mcHammer(applePi, it2)
	IF(you_cant_touch_this) CALL jenny8675309(3, applePi, it2)
	CALL jenny8675309(4, 0, 0)
END DO
END PROGRAM
!*************************************************************************
SUBROUTINE jenny8675309(section, nArg1, iArg1)
INTEGER, INTENT(IN) :: section
REAL, INTENT(IN) :: nArg1
CHARACTER :: g
SELECT CASE (section)
CASE(1)
	WRITE(*,*) "This program computes the value of pi"
	WRITE(*,*) "Choose a method:"
	WRITE(*,*) ' '
	WRITE(*,*) '1.) Monte Carlo method'
	WRITE(*,*) '2.) Reimann Sums method'
	WRITE(*,*) '3.) Both'
	WRITE(*,*) ' ' 
	WRITE(*,*) '4.) Exit'
	WRITE(*,*) ' '
CASE(2)
	WRITE(*,*) 'Calculating...'
	WRITE(*,*) ' '
	WRITE(*,*) 'Pi by Monte Carlo method =', nArg1
	WRITE(*,*) 'Iterations =', iArg1
	WRITE(*,*) ' '
CASE(3)
	WRITE(*,*) 'Calculating...'
	WRITE(*,*) ' '
	WRITE(*,*) 'Pi by Reimann Sums method =', nArg1
	WRITE(*,*) 'Iterations =', iArg1
	WRITE(*,*) ' '
CASE(4)
	WRITE(*,*) "Wow that was exciting!"
	WRITE(*,*) ' '
END SELECT
END SUBROUTINE jenny8675309
!*************************************************************************
SUBROUTINE bad_fortran_jokes(run1, run2, quitAll)
LOGICAL, INTENT(OUT) :: run1, run2, quitAll
INTEGER :: selection, io

READ(*,*,IOSTAT=io) selection
IF((io == 0) .AND. (selection > 0) .AND. (selection < 5)) THEN
	! Party
ELSE
	selection = 6
END IF
SELECT CASE (selection)
CASE(1)
	run1 = .TRUE.
	run2 = .FALSE.
	quitAll = .FALSE.
CASE(2)
	run1 = .FALSE.
	run2 = .TRUE.
	quitAll = .FALSE.
CASE(3)
	run1 = .TRUE.
	run2 = .TRUE.
	quitAll = .FALSE.
CASE(4)
	run1 = .FALSE.
	run2 = .FALSE.
	quitAll = .TRUE.
CASE(6)
	WRITE(*,*) 'Take another look at your options'
	WRITE(*,*) ' '
	run1 = .FALSE.
	run2 = .FALSE.
	quitAll = .FALSE.
END SELECT
END SUBROUTINE bad_fortran_jokes
!*************************************************************************
SUBROUTINE mcHammer(out, iterations)
USE circleFunctions
IMPLICIT NONE
REAL, INTENT(OUT) :: out
INTEGER, INTENT(OUT) ::iterations

! Reimann Sums
INTEGER :: div = 2, cycles=0, i
REAL(KIND=8) :: width, temp
REAL(KIND=8) :: height
REAL :: newPi=5, oldPi=0, ar=0, diff=.0000001

DO
	IF(abs(newPi-oldPi) < diff) EXIT
	cycles = cycles + 1
	width = 1./(div)
	DO i=0,div-1
		CALL circle((width*i),height)
		ar = ar + width*height
	END DO
	oldPi = newPi
	newPi = ar*4
	div = div+200
	ar=0
END DO
iterations = cycles
out = newPi
END SUBROUTINE mcHammer
!*************************************************************************
SUBROUTINE ghostbusters(out, iterations)
USE circleFunctions
IMPLICIT NONE

! Define Outputs
REAL, INTENT(OUT) :: out
INTEGER, INTENT(OUT) :: iterations

! Monte Carlo Method
REAL ::  pointY, diff=.00000001
INTEGER :: seed, cntUnder=0, itr = 10000, cntAll=0, cnt=0,cntu=0, cycles = 0, i
REAL(KIND=8) :: newPi=5, oldPi=0, pointX, calcY


! Start Random Fx
CALL SYSTEM_CLOCK(count=seed)
CALL SRAND(seed)

DO
	IF(abs(newPi-oldPi) < diff) EXIT ! Done
	cycles = cycles + 1
	DO i=1, itr
		cnt = cnt + 1
		pointY = rand()
		pointX = rand()
		CALL circle(pointX, calcY)
		IF (pointY < calcY) cntUnder = cntUnder + 1
	END DO
	cntu = cntu + cntunder
	cntAll = cntAll + cnt
	oldPi = newPi
	newPi = ((cntu/REAL(cntAll))*4)
END DO
out = newPi
iterations = cntAll
END SUBROUTINE ghostbusters