Let's Study Animal Breeding

외부 프로그램을 서브루틴의 인수로 사용

사다리꼴 적분 근사

PROGRAM Integral

IMPLICIT NONE

REAL :: A, B
REAL, EXTERNAL :: Integrand
INTEGER :: Number_of_Subintervals

WRITE (*, '(1X, A)', ADVANCE = "NO") &
"적분 구간의 처음과 끝, 그리고 구간 수를 입력하시오(ex 0, 1, 100 : "

READ * , A, B, Number_of_Subintervals

CALL Integrate(Integrand, A, B, Number_of_Subintervals)

CONTAINS

SUBROUTINE Integrate(F, A, B, N)

REAL, INTENT(IN) :: A, B
INTEGER, INTENT(IN) :: N
REAL :: F, DeltaX, X, Y, Sum
INTEGER :: I

DeltaX = (B - A) / REAL(N)

X = A
Sum = 0.0

DO I = 1, N - 1
X = X + DeltaX
Y = F(X)
Sum = Sum + Y
END DO

Sum = DeltaX * ((F(A) + F(B)) / 2.0 + Sum)

Print '(1X, I4, "개의 구간을 이용한 면적 = ", F10.5)', Number_of_Subintervals, Sum

END SUBROUTINE Integrate

END PROGRAM Integral

FUNCTION Integrand(X)
REAL :: Integrand
REAL, INTENT(IN) :: X
Integrand = EXP(X**2)
END FUNCTION Integrand

위 소스를 07_06_Integral.f95로 저장

컴파일 및 프로그램 테스트

모듈을 서브루틴의 인수로 사용

사다리꼴 적분 근사

모듈 부분

Module Integrand_Function

CONTAINS

FUNCTION Integrand(X)
REAL :: Integrand
REAL, INTENT(IN) :: X
Integrand = EXP(X**2)
END FUNCTION Integrand

END MODULE Integrand_Function

위 소스를 07_05_Inte_Mod.f95로 저장

메인 프로그램

PROGRAM Integral

USE Integrand_Function

IMPLICIT NONE

REAL :: A, B
INTEGER :: Number_of_Subintervals

WRITE (*, '(1X, A)', ADVANCE = "NO") &
"적분 구간의 처음과 끝, 그리고 구간 수를 입력하시오(ex 0, 1, 100 : "

READ * , A, B, Number_of_Subintervals

CALL Integrate(Integrand, A, B, Number_of_Subintervals)

CONTAINS

SUBROUTINE Integrate(F, A, B, N)

REAL, INTENT(IN) :: A, B
INTEGER, INTENT(IN) :: N
REAL :: F, DeltaX, X, Y, Sum
INTEGER :: I

DeltaX = (B - A) / REAL(N)

X = A
Sum = 0.0

DO I = 1, N - 1
X = X + DeltaX
Y = F(X)
Sum = Sum + Y
END DO

Sum = DeltaX * ((F(A) + F(B)) / 2.0 + Sum)

Print '(1X, I4, "개의 구간을 이용한 면적 = ", F10.5)', Number_of_Subintervals, Sum

END SUBROUTINE Integrate

END PROGRAM Integral

위 소스를 07_04_Integral.f95로 저장

모듈 소스로 오브젝트 파일을 만들고 메인 프로그램을 컴파일 해 봤음

프로그램 테스트

RANDOM_SEED와 RANDOM_NUMBER를 이용하여

핵반응기 차폐 모사 프로그램 작성

PROGRAM Shielding

IMPLICIT NONE

REAL :: RandomReal

INTEGER :: Thickness, DirectionChangeLimit, NewDirection, &
OldDirection, NumDirectionChanges, Forward, &
NumNeutrons, NumEscaped, I

PRINT *, "Enter thickness of shield, limit on # of direction changes"
PRINT *, "and the number of neutrons to simulate : "

READ *, Thickness, DirectionChangeLimit, NumNeutrons

NumEscaped = 0

CALL RANDOM_SEED

DO I = 1, NumNeutrons

Forward = 0
OldDirection = 0
NumDirectionChanges = 0

DO

CALL RANDOM_NUMBER(RandomReal)

NewDirection = 1 + INT(4 * RandomReal)

IF (NewDirection /= OldDirection) THEN
NumDirectionChanges = NumDirectionChanges + 1
OldDirection = NewDirection
END IF

IF (NewDirection == 1) THEN
Forward = Forward + 1
ELSE IF (NewDirection == 2) THEN
Forward = Forward - 1
END IF

IF ((Forward >= Thickness) .OR. (Forward <= 0) .OR. &
(NumDirectionChanges >= DirectionChangeLimit)) EXIT
END DO

IF (Forward == Thickness) NumEscaped = NumEscaped + 1

END DO

PRINT '(1X, F5.2, "% of the neutrons escaped")', &
100 * REAL(NumEscaped) / REAL(NumNeutrons)

END PROGRAM Shielding

위 소스를 07_03_Shielding.f95로 저장

컴파일 및 프로그램 테스트

값을 반환하는 서브루틴을 이용하여 극좌표를 직교좌표로 전화는 프로그램

PROGRAM P2R

IMPLICIT NONE

REAL :: RCoord, TCoord, XCoord, YCoord
CHARACTER(1) :: Response

DO

WRITE (*, '(1X, A)', ADVANCE = "NO") &
"극좌표를 입력하시오(ex : 2, 1) : "
READ *, RCoord, TCoord

CALL SubP2R(RCoord, TCoord, XCoord, YCoord)

PRINT *, "직교좌표 = (", XCoord, YCoord, ")"

WRITE (*, '(/ 1X, A)', ADVANCE = "NO") &
"더 변환하겠는가 (Y or N)? "

READ *, Response

IF (Response /= "Y") EXIT

END DO

CONTAINS

SUBROUTINE SubP2R(R, Theta, X, Y)

REAL, INTENT(IN) :: R, Theta
REAL, INTENT(OUT) :: X, Y

X = R * COS(Theta)
Y = R * SIN(Theta)

END SUBROUTINE SubP2R

END PROGRAM P2R

위 소스를 07_02_P2R.f95로 저장

컴파일 및 프로그램 테스트

서브루틴을 이용하여 도분초를 도로 표시하기

PROGRAM Angle

IMPLICIT NONE

INTEGER :: NumDegrees, NumMinutes, NumSeconds
CHARACTER(1) :: Response

DO

WRITE (*, '(1X, A)', ADVANCE = "NO") "도, 분 및 초를 입력하시오(ex : 100, 30, 36) : "

READ *, NumDegrees, NumMinutes, NumSeconds

CALL PrintDegrees(NumDegrees, NumMinutes, NumSeconds)

WRITE (*, '(/ 1X, A)', ADVANCE = "NO") "더 하시겠습니까? (Y or N)? "

READ *, Response

IF (Response /= "Y") EXIT

END DO

CONTAINS

SUBROUTINE PrintDegrees(Degrees, Minutes, Seconds)

INTEGER, INTENT(IN) :: Degrees, Minutes, Seconds

PRINT '(1X, I3, " degrees", I3, " minutes", I3, " seconds" / 1X, "is equivalent to" / 1X, F7.3 " degrees")', &
Degrees, Minutes, Seconds, &
REAL(Degrees) + REAL(Minutes) / 60.0 + REAL(Seconds) / 3600.0

END SUBROUTINE PrintDegrees

END PROGRAM Angle

위 소스를 07_01_Angle.f95로 저장

컴파일 및 프로그램 테스트