!+
! My translation of the Fortran translation of the original Lunar
! Lander program from <
https://www.cs.brandeis.edu/~storer/LunarLander/LunarLander.html>.
!-
program lunar_lander
implicit none
integer, parameter :: useprec = kind(0.0d0)
! need to use double precision; single precision is not enough
! to give correct results for second perfect game from above page
real(kind = useprec) :: altitude, next_altitude, next_velocity, fuel_rate, elapsed
real(kind = useprec) :: mass_total, mass_empty, time_subinterval, time_interval, velocity
logical :: endgame, out_of_fuel, done_update
real(kind = useprec), parameter :: G = 0.001
real(kind = useprec), parameter :: Z = 1.8
call intro
do
! play another game
print "(A//)", "FIRST RADAR CHECK COMING UP"
print "(A)", "COMMENCE LANDING PROCEDURE"
print "(A)", "TIME,SECS ALTITUDE,MILES+FEET VELOCITY,MPH FUEL,LBS FUEL RATE"
altitude = 120
velocity = 1
mass_total = 32500
mass_empty = 16500
elapsed = 0
out_of_fuel = .false.
endgame = .false.
do
time_interval = 10
write (*, fmt = "(i7, i16, i7, F15.2, F12.1, A9)", advance = "no") &
nint(elapsed), int(altitude), nint(5280 * (altitude - int(altitude))), &
3600 * velocity, mass_total - mass_empty, "K=:"
call get_fuel_rate
do
if (mass_total - mass_empty .lt. 0.001) then
out_of_fuel = .true.
endgame = .true.
exit
end if
if (time_interval .lt. 0.001) &
exit ! start a new interval
time_subinterval = time_interval
if (mass_empty + time_subinterval * fuel_rate .gt. mass_total) &
time_subinterval = (mass_total - mass_empty) / fuel_rate
! calculate only as far as ahead as fuel will allow
call delta
done_update = .false.
if (next_altitude .le. 0) then
call down_to_the_ground
done_update = .true.
else if (velocity .gt. 0 .and. next_velocity .lt. 0) then
call going_back_up
done_update = .true.
end if
if (endgame) &
exit
if (.not. done_update) &
call update
end do
if (endgame) &
exit
end do
call final_status
print "(///A)", "TRY AGAIN?"
if (.not. yn()) then
print "(A)", "CONTROL OUT"
exit
end if
end do
contains
subroutine intro
print "(A)", "CONTROL CALLING LUNAR MODULE. MANUAL CONTROL IS NECESSARY"
print "(A)", "YOU MAY RESET FUEL RATE K EACH 10 SECS TO 0 OR ANY VALUE"
print "(A)", "BETWEEN 8 & 200 LBS/SEC. YOU'VE 16000 LBS FUEL. ESTIMATED"
print "(A)", "FREE FALL IMPACT TIME-120 SECS. CAPSULE WEIGHT-32500 LBS"
end subroutine
subroutine get_fuel_rate
! asks the user what fuel rate to apply for the next interval.
integer :: ios
do
read (*, *, iostat = ios) fuel_rate
if (ios .eq. 0) then
if ( &
fuel_rate .gt. 200 &
.or. &
fuel_rate .lt. 0 &
.or. &
fuel_rate .lt. 8 .and. fuel_rate .gt. 0 &
) &
ios = 1
end if
if (ios .eq. 0) &
exit
write (*, fmt = "(A)", advance = "no") "NOT POSSIBLE"
call dots
write (*, fmt = "(A)", advance = "no") "K=:"
end do
end subroutine
subroutine dots
integer :: loop
do loop = 1, 51
write (*, fmt = "(A)", advance = "no") "."
end do
end subroutine
logical function yn() result(y)
! prompts the user for an answer to a yes/no question.
character(len = 3) :: ans
do
write (*, fmt = "(A)", advance = "no") "(ANS. YES OR NO):"
read *, ans
if (ans .eq. "Y" .or. ans .eq. "y" .or. ans .eq. "YES" .or. ans .eq. "yes") then
y = .true.
exit
else if (ans .eq. "N" .or. ans .eq. "n" .or. ans .eq. "NO" .or. ans .eq. "no") then
y = .false.
exit
end if
end do
end function
subroutine update
! updates the time and spacecraft fuel, altitude and velocity.
elapsed = elapsed + time_subinterval
time_interval = time_interval - time_subinterval
mass_total = mass_total - time_subinterval * fuel_rate
altitude = next_altitude
velocity = next_velocity
end subroutine
subroutine delta
! calculates the new velocity and altitude at the end of the
! current time subinterval.
real(kind = useprec) :: delta_v, delta_v2, delta_v4
delta_v = time_subinterval * fuel_rate / mass_total
delta_v2 = delta_v * delta_v ! just to shorten ...
delta_v4 = delta_v2 * delta_v2 ! ... some formulas
next_velocity = &
velocity &
+ &
G * time_subinterval &
- &
Z &
* &
( &
delta_v &
+ &
delta_v2 / 2 &
+ &
delta_v2 * delta_v / 3 &
+ &
delta_v4 / 4 &
+ &
delta_v4 * delta_v / 5 &
)
next_altitude = &
altitude &
- &
G * time_subinterval * time_subinterval / 2 &
- &
velocity * time_subinterval &
+ &
Z &
* &
time_subinterval &
* &
( &
delta_v / 2 &
+ &
delta_v2 / 6 &
+ &
delta_v2 * delta_v / 12 &
+ &
delta_v4 / 20 &
+ &
delta_v4 * delta_v / 30 &
)
end subroutine
subroutine down_to_the_ground
! handles landing/impact situation.
do
if (time_subinterval .lt. 0.005) then
endgame = .true.
exit
end if
time_subinterval = &
2 &
* &
altitude &
/ &
( &
velocity &
+ &
sqrt &
( &
velocity * velocity &
+ &
2 * altitude * (G - Z * fuel_rate / mass_total) &
) &
)
call delta
call update
end do
end subroutine
subroutine going_back_up
! handles situation where spacecraft is reversing direction
! from descent to ascent, checking in case it is going to hit
! the ground.
real(kind = useprec) :: W
do
W = (1 - mass_total * G / (Z * fuel_rate)) / 2
time_subinterval = &
mass_total &
* &
velocity &
/ &
(Z * fuel_rate * (W + sqrt(W * W + velocity / Z))) &
+ &
0.05
call delta
if (next_altitude .le. 0) then
call down_to_the_ground
exit
end if
call update
if (next_velocity .ge. 0 .or. velocity .le. 0) &
exit ! no danger of landing/impact
end do
end subroutine
subroutine final_status
real(kind = useprec) :: W
if (out_of_fuel) then
print "('FUEL OUT AT ', F9.2, ' SECS')", elapsed
time_subinterval = (sqrt(velocity * velocity + 2 * altitude * G) - velocity) / G
velocity = velocity + G * time_subinterval
elapsed = elapsed + time_subinterval
end if
print "('ON THE MOON AT ', F9.2, ' SECS')", elapsed
W = 3600 * velocity
print "('IMPACT VELOCITY OF ', F9.2, ' M.P.H')", W
print "('FUEL LEFT: ', F15.2, ' LBS')", mass_total - mass_empty
if (W .gt. 1) then
if (W .gt. 10) then
if (W .gt. 22) then
if (W .gt. 40) then
if (W .gt. 60) then
print "(A)", "SORRY,BUT THERE WERE NO SURVIVORS-YOU BLEW IT!"
print "('IN FACT YOU BLASTED A NEW LUNAR CRATER ', F9.2, ' FT. DEEP')", &
W * 0.277777
else
print "(A)", "CRASH LANDING-YOU'VE 5 HRS OXYGEN"
end if
else
print "(A)", "CRAFT DAMAGE. GOOD LUCK"
end if
else
print "(A)", "CONGRATULATIONS ON A POOR LANDING"
end if
else
print "(A)", "GOOD LANDING-(COULD BE BETTER)"
end if
else
print "(A)", "PERFECT LANDING !-(LUCKY)"
end if
end subroutine
end program
Vintage Lunar Lander Game
Re: Vintage Lunar Lander Game
