Modern addition: VIEW drew pre-flight predictions; this engine integrates our own trajectory.
DEMO
g.e.t.
Jumps here re-point it; it plays in real time on its own, and its pause and rate are independent. Opening or resyncing it starts Following. Apollo in Real Time (Ben Feist), apolloinrealtime.org
View
Target
Screen
Refresh
Drag: look around. Wheel / pinch: field of view. Arrows: yaw, pitch. Q/E: roll. +/-: field of view. Space: pause. [ ]: speed. R: reset. : quick views (the numbered entries of the event list). J: film jitter. D: dust. F: 16 fps film rate. T: beam trace (Print). L: copy link. B: bloom. C: star catalog. S: screen (film or scope). H: scope refresh. I: cabin. W: cabin walls. V: look around or move the eye. Look pad: the same keys, for touch; under WASD, W A S D are its arrows and the shortcuts greyed here wait. Any input leaves Attract or Tour.
A reconstruction of VIEW, the Manned Spacecraft Center program that drew Apollo window views on a UNIVAC 1108 (FORTRAN V, output photographed from a CRT onto microfilm: NASA TN D-6853, p. 3). We know of no surviving source code; the geometry here is our own FORTRAN and this page only films it.
G. B. Roush, Computation and Analysis Division, MSC, is credited with developing the major analytical tool (MSC IN 69-FM-197). Sources: NASA TN D-6853 (Hyle and Lunde, 1972); MSC IN 69-FM-197. Code MIT; data, fonts and three.js under their own licences: THIRD_PARTY.md.
VIEW KERNEL - our reconstruction; we know of no surviving source code
src/vdrive.f
C=======================================================================
C
C V I E W - 1 1 0 8 WINDOW VIEW KERNEL: FRAME DRIVER
C
C Draws what an Apollo 11 crewman would see out of a window, as
C line vectors and star points in plot degrees, for a film
C recorder to expose. After the MSC program VIEW (G. B. Roush;
C documented by A. N. Lunde and C. T. Hyle). New code; the target
C is the surviving output, MSC IN 69-FM-197 and the film clip.
C
C ENTRY POINTS (called by the chassis, shell.f90; also SIMRUN in
C sim.f, which runs the engine and fills the tape)
C VINIT (ISC, GET, YAW, PIT, ROL, FOV)
C select situation ISC (the scene number; its SITUATION
C card, read by the card reader) and return its defaults.
C VFRAME (GET, YAW, PIT, ROL, FOV, IFLAG,
C VB, NV, SB, NS, LB, NL, HD, TB, NT, TC, NCH)
C draw one frame. VB(5,MAXV) line vectors X1 Y1 X2 Y2
C STYLE, SB(3,MAXS) points X Y MAG, LB(4,MAXL) labels
C X Y KIND ID, HD(24) header values, TB/TC text records.
C
C ELEMENTS. The kernel is a set of separately compiled elements,
C linked by the build, as an 1108 program was put together by
C the Collector, which "is a system processor designed to provide
C the user with a means of gathering (collecting) and
C interconnecting one or more relocatable elements to produce a
C program" (UE-637 sec. 5.1; docs/batch-pipeline.md).
C vdrive.f this driver: situations, camera recipes, model
C placement
C vlayer.f the layer dispatcher over the situation's layer list
C Core: ephem.f (time, Sun, Moon), traj.f (trajectory legs,
C the replay), sim.f (the engine), tape.f (the tape it
C writes), vsrc.f (the state source: replay or tape),
C vview.f (camera target and external view),
C veye.f (the moved eye: its offset, clamp and axes),
C pen.f (projection, clipping, visibility, vectors),
C vmask.f (the outside cut to the cabin's windows),
C vtext.f (text records), vmath.f (vectors, matrices),
C models.f, mpad.f (spacecraft model library; mpad.f the
C launch complex), vdeck.f, vdkscn.f,
C vdksit.f, vdkfld.f, vdktap.f, vdksum.f (the card
C reader: run decks and tapes into the tables)
C Layers, one per drawable, all called as
C LAYER(GET, VB, NV, SB, NS, LB, NL) by LAYERS:
C lframe.f 1 plot frame, lstars.f 2 stars, lsun.f 3 Sun,
C lmoon.f 4 Moon and craters (lmoon6.f its whole-disc
C extras), learth.f 5 Earth, lvehic.f 6 vehicles
C (lvlab.f their labels and markers),
C lcoas.f 7 COAS reticle, lshad.f 8 LM shadow,
C llpd.f 9 LPD and LM window, lburn.f 10 burn cue
C Data: viewdata.f (BLOCK DATA, the catalogs, generated),
C vdvoc.f (the card reader's words, generated), the run
C decks (data/missions, read at load), viewcom.inc and
C viewsit.inc COMMON
C
C THE ELEMENTS AGAINST TN D-6853, printed p. 3 (our reading). "The
C program consists of two basic parts: the integrator portion and
C the graphic-display portion"; the Apollo modifications "were
C associated with the input/output options, coordinate
C transformations, lunar- and solar-ephemeris installation, three-
C dimensional-display problems, and realistic spacecraft-window
C outlines".
C integrator portion sim.f (and traj.f's replay)
C graphic-display portion pen.f, the layers via vlayer.f
C ephemeris installation ephem.f
C coordinate transformations vmath.f, the frames in vdrive.f
C three-dimensional display pen.f, models.f
C window outlines window and cabin models (to come)
C input/output vtext.f, the plot-tape buffers,
C the scenarios (data/missions) and
C their card reader (vdeck.f), the
C tape (tape.f)
C OUR READING: THE REPORT NAMES FUNCTIONS, NOT FILES.
C
C PROJECTION
C Radially symmetric about the boresight, gnomonic to
C stereographic with the field; see PROJ (pen.f).
C
C=======================================================================
SUBROUTINE VINIT(ISC, GET, YAW, PIT, ROL, FOV)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
C RESTOMOD END
INTEGER ISC
DOUBLE PRECISION GET, YAW, PIT, ROL, FOV
DOUBLE PRECISION R(3), V(3), PM(3), E(3), S(3), X, Y, TFIX
INTEGER I, IVS, ISV
DOUBLE PRECISION VDOT, EVGET
C
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (INITD .NE. 1) THEN
CALL TABSET
CALL MLIB
ISN = 0
INITD = 1
END IF
C RESTOMOD END
C No situation (a deck the card reader refused, vdeck.f): nothing
C selected, all defaults 0, and VFRAME draws an empty frame.
IF (NSIT .GE. 1) GO TO 5
ISCN = 0
GET = 0.0D0
YAW = 0.0D0
PIT = 0.0D0
ROL = 0.0D0
FOV = 0.0D0
RETURN
C The situation (its SITUATION card) and its scenario. Its set-up
C (the Earthrise search, the camera's turn and held attitude) reads
C the CSM on the replay, whatever source the last frame drew from
C (ISRC, set by VFRAME), so a situation's defaults are its deck's
C and not the source's (#26; ours).
5 ISV = ISRC
ISRC = 0
ISCN = ISC
IF (ISCN .LT. 1 .OR. ISCN .GT. NSIT) ISCN = 1
CALL SITSET(ISCN)
IF (SISN(ISCN) .NE. ISN) CALL SNSET(SISN(ISCN))
YAW = SILK(1,ISCN)
PIT = SILK(2,ISCN)
ROL = SILK(3,ISCN)
C
C The Earthrise search (ERFIND) for a view turned to the Earth's
C sightline: its time is the GET rule's Earthrise (gen_data.py
C allows that rule only there). Without that turn, no azimuth
C offset: AZOFF is not left from the last situation.
IF (JRCP .EQ. 1 .AND. SIAZ(ISCN) .EQ. 1) CALL ERFIND
IF (SIAZ(ISCN) .EQ. 0) AZOFF = 0.0D0
C Default GET: a g.e.t., an event plus an offset, or the
C Earthrise plus an offset.
GET = SIGT(ISCN)
IF (SIGK(ISCN) .EQ. 2) GET = EVGET(SIGE(ISCN)) + SIGT(ISCN)
IF (SIGK(ISCN) .EQ. 3) GET = TERISE + SIGT(ISCN)
IF (SIFK(ISCN) .EQ. 1) FOV = SIFV(ISCN)
C
C The recipe's set-up at the default GET.
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (JRCP .EQ. 1 .AND. SIAZ(ISCN) .EQ. 1) THEN
C FORWARD about the Moon, turned in azimuth (AZOFF) to the
C Earth's sightline at the default GET, so the Earth rises
C mid-frame.
CALL VSTATE(GET, 1, 2, R, V, IVS)
CALL MOONG(GET, PM)
E(1) = -PM(1) - R(1)
E(2) = -PM(2) - R(2)
E(3) = -PM(3) - R(3)
CALL VUNIT(R)
CALL VUNIT(V)
C The horizontal as SCNCAM takes it (VORTH; #80).
CALL VORTH(R, V)
CALL VCRS(V, R, S)
X = VDOT(E, V)
Y = VDOT(E, S)
AZOFF = DATAN2(Y, X) / DR
ELSE IF (JRCP .EQ. 2 .AND. JATT .EQ. 1) THEN
C INERTIAL from the Earth's sightline. The attitude is held
C inertially: boresight ELOFF deg ahead of the Earth's centre as
C seen FXDT before the event (TFIX), up against the Earth's
C drift across the sky from then to SIDT before the event.
FXDT = SIFT(ISCN)
TFIX = EVGET(SIFE(ISCN)) - FXDT
ELOFF = SIEO(ISCN)
CALL VSTATE(TFIX, 1, 1, R, V, IVS)
CALL VSTATE(EVGET(SIFE(ISCN)) - SIDT(ISCN), 1, 1, E, S, IVS)
DO 22 I = 1, 3
PM(I) = -R(I)
E(I) = -E(I)
22 CONTINUE
CALL VUNIT(PM)
CALL VUNIT(E)
C Net drift of the Earth centre across the line of sight.
X = VDOT(E, PM)
DO 24 I = 1, 3
S(I) = E(I) - X * PM(I)
24 CONTINUE
CALL VUNIT(S)
Y = ELOFF * DR
DO 26 I = 1, 3
FXB(I) = DCOS(Y) * PM(I) + DSIN(Y) * S(I)
FXU(I) = -(DCOS(Y) * S(I) - DSIN(Y) * PM(I))
26 CONTINUE
ELSE IF (JRCP .EQ. 4) THEN
C BODYCTR: the camera SIAL km above the Moon's surface.
S6DST = RM + SIAL(ISCN)
END IF
C RESTOMOD END
C The disc rule: the body's disc fills SIFV of the frame, rounded
C to 0.1 deg (BODYCTR's distance).
IF (SIFK(ISCN) .EQ. 2) FOV = DBLE(NINT(20.0D0
& * DASIN(RM / S6DST) / DR / SIFV(ISCN))) / 10.0D0
ISRC = ISV
RETURN
END
C
C-----------------------------------------------------------------------
C SITSET: copy situation K's row of the tables (viewsit.inc, filled
C by the card reader) into the current situation, /CSITU/
C (viewcom.inc).
C-----------------------------------------------------------------------
SUBROUTINE SITSET(K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
C RESTOMOD END
INTEGER K, I
JRCP = SIRC(K)
JBOD = SIBD(K)
JMOD = SIMD(K)
JTRN = SITR(K)
JFAL = SIFB(K)
JATT = SIAT(K)
JVEH = SIVH(K)
JWIN = SIWN(K)
JPOS = SIPS(K)
JDRW = SIDW(K)
JVW = SIVW(K)
JTGT = SITG(K)
JTGF = SITF(K)
JRID = SIRD(K)
JSCM = SICM(K)
JSLM = SILM(K)
JFIX = SIFX(K)
JXOF = SIXO(K)
JHRK = SIHK(K)
QELV = SIEL(K)
QFEL = SIFL(K)
QDST = SIDS(K)
QHOF = SIHO(K)
QHRR = SIHR(K)
DO 10 I = 1, 3
QTRN(I) = SITN(I,K)
10 CONTINUE
QXY(1) = SIXY(1,K)
QXY(2) = SIXY(2,K)
DO 20 I = 1, MXLAY
JLL(I) = SILY(I,K)
20 CONTINUE
RETURN
END
C
C=======================================================================
SUBROUTINE VFRAME(GET, YAW, PIT, ROL, FOV, IFLAG,
& VB, NV, SB, NS, LB, NL, HD, TB, NT, TC, NCH)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
C RESTOMOD END
DOUBLE PRECISION GET, YAW, PIT, ROL, FOV
INTEGER IFLAG, NV, NS, NL
DOUBLE PRECISION VB(5,MAXV), SB(3,MAXS), LB(4,MAXL), HD(24)
DOUBLE PRECISION TB(4,MAXT)
INTEGER NT, TC(MAXTC), NCH
DOUBLE PRECISION PM(3), CG(3), CV(3), RB, RNG, D1, D2, D3, D4
DOUBLE PRECISION PB(3), RR, VNRM, VDOT, RHO, RC(3), RL(3), VX(3)
INTEGER I, IREF, IWIN, IOK, J, LOOKD, KLMPL, KCSPL, LMEX
C
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (INITD .NE. 1 .OR. ISCN .EQ. 0) THEN
CALL VINIT(1, D1, D2, D3, D4, RB)
END IF
C RESTOMOD END
NV = 0
NS = 0
NL = 0
DO 10 I = 1, 24
HD(I) = 0.0D0
10 CONTINUE
C RESTOMOD: the moved eye is ours (veye.f; #72)
CALL EYCLR
IF (ISCN .GE. 1) GO TO 12
NT = 0
NCH = 0
RETURN
12 IFLG = IFLAG
C Label level (VSETIN). With in_lablv 0, in_flags bit 0 means all
C labels, as before; with 1 or more the level decides and bit 0
C is set here, so the names are lettered (TXALL).
ILEV = 3 * MOD(IFLG, 2)
IF (ILABL .GE. 1) ILEV = ILABL
IF (ILABL .GE. 1 .AND. MOD(IFLG, 2) .EQ. 0) IFLG = IFLG + 1
C State source: in_flags bit 3, the tape if the engine has run.
ISRC = MOD(IFLG / 8, 2)
ISRCU = 0
FOVH = 0.5D0 * FOV
IF (FOVH .LT. 0.05D0) FOVH = 0.05D0
IF (FOVH .GT. 89.0D0) FOVH = 89.0D0
C Projection constant (see PROJ), box half-width in plot deg, the
C angle to the frame corner, and the projection's usable limit.
PK = 1.0D0 + DMIN1(1.0D0, DMAX1(0.0D0, (2.0D0*FOVH - 100.0D0)
& / 70.0D0))
BOXH = PK * DTAN(FOVH * DR / PK) / DR
THVIEW = PK * DATAN(1.4143D0 * BOXH * DR / PK) / DR + 0.5D0
THLIM = 90.0D0 * PK - 0.5D0
IF (THVIEW .GT. THLIM) THVIEW = THLIM
CSVIEW = DCOS(THVIEW * DR)
C
C World at this GET.
CALL TSET(GET)
CALL MOONG(GET, PM)
CALL SUNG(GET, SUNU)
CALL MOONRT(GET, MMF)
C Earth fixed to J2000: GMST about the pole of date, then the
C precession back to J2000 (PRECM).
CALL MEFAT(GET, MEF)
C
C Camera position CG (geocentric), velocity CV relative to the
C reference body IREF, window code IWIN, reference attitude.
S6LAT = PIT
S6LON = YAW
CALL SCNCAM(GET, PM, CG, CV, IREF, IWIN)
C Spacecraft models first: they hide stars and bodies.
CALL SCNMOD(GET, PM, CG)
C The camera target and the external view (vview.f).
CALL VIEWPT(GET, PM, CG, CV, IREF, YAW, PIT, ROL, LOOKD)
DO 20 I = 1, 3
EPOS(I) = -CG(I)
MPOS(I) = PM(I) - CG(I)
20 CONTINUE
CALL MTXV(MMF, MPOS, CAMF)
DO 30 I = 1, 3
CAMF(I) = -CAMF(I)
30 CONTINUE
C
C Free look, then the boresight in the Moon frame. BODYCTR's
C yaw and pitch moved the sub-observer point (SCNCAM): roll only.
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (JRCP .EQ. 4) THEN
CALL LOOK(0.0D0, 0.0D0, ROL)
ELSE IF (LOOKD .EQ. 0) THEN
CALL LOOK(YAW, PIT, ROL)
END IF
C RESTOMOD END
C RESTOMOD: the moved eye is ours (veye.f; #72): the camera's axes
C in the eye offset's frame, for the page
CALL EYAXES
CALL MTXV(MMF, CB, CBMF)
C
ISTYLE = 1
C No burn text until the burn cue (lburn.f) asks for one.
IBRTX = 0
C The cabin's windows for the window mask (vmask.f).
CALL WMSET
C The situation's layers, in order (vlayer.f).
CALL LAYERS(GET, VB, NV, SB, NS, LB, NL)
C
C Header.
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IREF .EQ. 1) THEN
RNG = VNRM(EPOS)
RB = RE
ELSE
RNG = VNRM(MPOS)
RB = RM
END IF
C RESTOMOD END
HD(1) = GET
HD(2) = 2.0D0 * FOVH
HD(3) = RNG / 1.852D0
HD(4) = (RNG - RB) / 1.609344D0
HD(5) = VNRM(CV) * 1000.0D0 / 0.3048D0
HD(6) = DBLE(IREF)
HD(7) = DBLE(ISCN)
HD(8) = DBLE(IWIN)
C The LM crew station riding the descending LM: the footpads'
C altitude (LMDESC), 0 at touchdown.
IF (JRCP .EQ. 3) HD(10) = LMALT * 1000.0D0 / 0.3048D0
C Reference body in the picture, for the page's camera steering:
C centre X, Y (deg, even off frame), angular radius, in front flag.
C Or the situation's header object (HDRREF): the placed LM, the
C LM's docking target (S7POSE), the placed CSM's tunnel.
DO 40 I = 1, 3
PB(I) = EPOS(I)
IF (IREF .EQ. 2) PB(I) = MPOS(I)
IF (JHRK .EQ. 1 .AND. KLMPL() .NE. 0) PB(I) = MDP(I,KLMPL())
IF (JHRK .EQ. 2) PB(I) = S7LP(I) - QHOF * S7AT(I,2)
IF (JHRK .EQ. 3) PB(I) = MDP(I,KCSM) + QHOF * MDAT(I,1,KCSM)
40 CONTINUE
RR = RE
IF (IREF .EQ. 2) RR = RM
IF (JHRK .EQ. 1 .AND. KLMPL() .NE. 0) RR = QHRR
IF (JHRK .EQ. 2 .OR. JHRK .EQ. 3) RR = QHRR
CALL PROJ(PB, HD(11), HD(12), IOK)
HD(13) = RHO(DASIN(DMIN1(1.0D0, RR / VNRM(PB))))
HD(15) = BOXH
C The scenario's epoch as an offset (s) from Apollo 11 range zero,
C for the page's clock: UTC = 1969-07-16 13:32:00 + HD(16) + GET.
HD(16) = (TJD0 - JD0) * 86400.0D0
C The state source used (0 replay, 1 sim corrected, 2 sim free),
C and the last engine run's error at the reference row nearest
C GET: position (km), velocity (ft/s), that row's g.e.t. (s).
HD(17) = DBLE(ISRCU)
CALL SIMERR(GET, J, HD(20), HD(18), HD(19))
C The CSM to LM range (ft) where both states are known (VSTATE;
C 0 docked), kept from HD(17)'s record of the source; with S7POSE
C the docking ring's range of its closing law.
I = ISRCU
CALL CSMSL(GET, RC, VX)
CALL VSTATE(GET, 2, 2, RL, VX, IOK)
ISRCU = I
IF (IOK .NE. 0) HD(9) = DSQRT((RL(1) - RC(1))**2
& + (RL(2) - RC(2))**2 + (RL(3) - RC(3))**2) * 1.0D3 / 0.3048D0
IF (JPOS .EQ. 2) HD(9) = S7RNG
HD(14) = 0.0D0
IF (VDOT(PB, CB) .GT. 0.0D0) HD(14) = 1.0D0
C The vehicles in this frame's world (VPRES): 1 CSM, 2 LM, 4 S-IVB.
CALL VPRES(GET)
HD(21) = DBLE(IVBIT)
C The crew stations this situation offers (its VIEWS card; STATCM,
C STATLM): 1 the CM, 2 the LM, each always or where that vehicle
C is placed (in a station the camera's own vehicle is not placed,
C the camera being inside it), the LM also wherever it exists
C (LMEX: a state of its own or the CSM's, docked or stowed in the
C SLA; #70 option C), and 4 always, so the page can tell this
C from a kernel without HD(22). The page enables its station
C buttons from these; HD(21) leaves out the vehicle the camera
C rides, so it cannot.
HD(22) = 4.0D0
IF (JSCM .EQ. 2 .OR. (JSCM .EQ. 1 .AND. (KCSPL() .NE. 0
& .OR. IVUSE .EQ. 2))) HD(22) = HD(22) + 1.0D0
IF (JSLM .EQ. 2 .OR. (JSLM .EQ. 1 .AND. LMEX(GET) .EQ. 1))
& HD(22) = HD(22) + 2.0D0
C The target's status (VIEWPT, ITGST): the page says why a pick
C cannot be aimed from the window and looks from outside instead.
HD(23) = DBLE(ITGST)
C Text for the recorder's character generator.
CALL TXALL(LB, NL, TB, NT, TC, NCH)
RETURN
END
C
C=======================================================================
C CAMERA RECIPES. Position, velocity, reference body and the
C reference attitude RREF, UREF, BREF of the situation's recipe
C (JRCP, its parameters in /CSITU/) at GET. Each branch is the
C camera code of the scenes it came from, unchanged.
C=======================================================================
SUBROUTINE SCNCAM(GET, PM, CG, CV, IREF, IWIN)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), CV(3)
INTEGER IREF, IWIN
DOUBLE PRECISION R(3), V(3), RU(3), VU(3), SU(3), H(3), E(3)
DOUBLE PRECISION DIP, CA, SA, CD, SD, P2(3), R2(3), K, VDOT
DOUBLE PRECISION XB(3), YB(3), ZB(3), PMF(3), VNRM, ELV
INTEGER I, LB, LUNIN, IVS
C
IWIN = JWIN
C The platform's body and elevation, but where the recipe has an
C off-leg fallback (JFAL) and no LUNAR leg holds the GET, FORWARD
C about the Earth instead (scene 9, Apollo 8, away from lunar
C orbit; our choice: no Apollo 8 view survives, TN D-6853 printed
C p. 3).
LB = JBOD
ELV = QELV
IF (JFAL .EQ. 1 .AND. LUNIN(GET) .EQ. 0) LB = 1
IF (LB .NE. JBOD) ELV = QFEL
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (JRCP .EQ. 1 .AND. LB .EQ. 2) THEN
C LOCALVERT about the Moon: the CSM in lunar orbit.
IREF = 2
CALL VSTATE(GET, 1, 2, R, V, IVS)
DO 10 I = 1, 3
CG(I) = PM(I) + R(I)
CV(I) = V(I)
RU(I) = R(I)
VU(I) = V(I)
10 CONTINUE
CALL VUNIT(RU)
CALL VUNIT(VU)
C The horizontal: the velocity's direction made square to the
C radius (VORTH), so the frame below is orthonormal off a
C circular leg too (the engine's tape; #80).
CALL VORTH(RU, VU)
IF (JMOD .EQ. 1) THEN
C FORWARD along the orbit, turned AZOFF in azimuth, down to
C the horizon by the dip angle.
CALL VCRS(VU, RU, SU)
CA = DCOS(AZOFF * DR)
SA = DSIN(AZOFF * DR)
DIP = DACOS(RM / VNRM(R))
CD = DCOS(DIP)
SD = DSIN(DIP)
DO 20 I = 1, 3
H(I) = CA * VU(I) + SA * SU(I)
BREF(I) = CD * H(I) - SD * RU(I)
UREF(I) = SD * H(I) + CD * RU(I)
20 CONTINUE
C The situation's reference turn (REFTRN).
IF (JTRN .EQ. 1) CALL REFTRN
ELSE
C NORMAL: out of plane toward the LM, local vertical up.
CALL VCRS(RU, VU, BREF)
DO 30 I = 1, 3
UREF(I) = RU(I)
30 CONTINUE
END IF
ELSE IF (JRCP .EQ. 2 .AND. JATT .EQ. 1) THEN
C INERTIAL from the Earth's sightline, the coast. Attitude held
C inertially (FXB, FXU, set by VINIT).
IREF = 1
CALL VSTATE(GET, 1, 1, R, V, IVS)
DO 40 I = 1, 3
CG(I) = R(I)
CV(I) = V(I)
BREF(I) = FXB(I)
UREF(I) = FXU(I)
40 CONTINUE
ELSE IF (JRCP .EQ. 1) THEN
C LOCALVERT about the Earth (parking orbit, and the off-leg
C fallback). FORWARD, boresight ELV deg above the horizon.
IREF = 1
CALL VSTATE(GET, 1, 1, R, V, IVS)
DO 70 I = 1, 3
CG(I) = R(I)
CV(I) = V(I)
RU(I) = R(I)
VU(I) = V(I)
70 CONTINUE
CALL VUNIT(RU)
CALL VUNIT(VU)
C The horizontal, as about the Moon (VORTH; #80, #65): off a
C circular orbit the velocity is not square to the radius (on
C the ascent; after TLI its direction is 0.86 along the radius
C at 4:00, and -0.98 at 120 h on Apollo 8's transearth coast),
C and a boresight and up built from it unchanged were short and
C near parallel, and the frame drawn from them empty.
CALL VORTH(RU, VU)
DIP = DACOS(RE / VNRM(R)) - ELV * DR
CD = DCOS(DIP)
SD = DSIN(DIP)
DO 80 I = 1, 3
BREF(I) = CD * VU(I) - SD * RU(I)
UREF(I) = SD * VU(I) + CD * RU(I)
80 CONTINUE
ELSE IF (JRCP .EQ. 4) THEN
C BODYCTR, the Moon view: looking at the centre from above the
C sub-observer point (S6LAT, S6LON), selenographic north up (our
C choice; a J2000-north layout would do as well).
IREF = 2
E(1) = DCOS(S6LAT * DR) * DCOS(S6LON * DR)
E(2) = DCOS(S6LAT * DR) * DSIN(S6LON * DR)
E(3) = DSIN(S6LAT * DR)
CALL MXV(MMF, E, H)
DO 95 I = 1, 3
CG(I) = PM(I) + S6DST * H(I)
CV(I) = 0.0D0
BREF(I) = -H(I)
UREF(I) = MMF(I,3)
95 CONTINUE
K = VDOT(UREF, BREF)
DO 96 I = 1, 3
UREF(I) = UREF(I) - K * BREF(I)
96 CONTINUE
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (VDOT(UREF, UREF) .LT. 1.0D-12) THEN
DO 97 I = 1, 3
UREF(I) = MMF(I,1)
97 CONTINUE
END IF
C RESTOMOD END
CALL VUNIT(UREF)
ELSE IF (JRCP .EQ. 5) THEN
C EXTSEED, the docked stack (S8ATT) from QDST on its far side
C from the Earth, looking at it with the Earth behind; the
C stack's X axis up. Its own view is external (JVW, VIEWPT),
C which yaw and pitch carry around the stack.
IREF = 1
CALL VSTATE(GET, 1, 1, R, V, IVS)
CALL S8ATT(GET)
DO 120 I = 1, 3
BREF(I) = -R(I)
120 CONTINUE
CALL VUNIT(BREF)
K = VDOT(S8AT(1,1), BREF)
DO 125 I = 1, 3
UREF(I) = S8AT(I,1) - K * BREF(I)
CG(I) = R(I) - QDST * BREF(I)
CV(I) = V(I)
125 CONTINUE
CALL VUNIT(UREF)
ELSE IF (JRCP .EQ. 2) THEN
C INERTIAL from a vehicle, transposition and docking. The CSM
C on the translunar ellipse (30 m from the S-IVB, nothing at
C this scale), turned around to face the stack, which holds an
C inertial attitude (S7ATT). Boresight along the CSM +X axis,
C which is down the LM's -X axis; the LM front (+Z) up.
IREF = 1
CALL VSTATE(GET, 1, 1, R, V, IVS)
CALL S7ATT
DO 110 I = 1, 3
CG(I) = R(I)
CV(I) = V(I)
BREF(I) = -S7AT(I,1)
UREF(I) = S7AT(I,3)
110 CONTINUE
ELSE
C CREWSTN, the LM (JVEH 2; gen_data.py refuses the CM until it
C has an axes source): the LM descent. Boresight LPDDN (30.2)
C deg down from the LM +Z axis in the X-Z plane, the LPD's
C plane; the film's LPD marks give the angle (llpd.f).
IREF = 2
CALL LMDESC(GET, PMF, XB, YB, ZB)
CALL LMDESC(GET + 1.0D0, P2, H, E, R2)
CALL MXV(MMF, PMF, R)
CALL MXV(MMF, P2, R2)
DO 90 I = 1, 3
CG(I) = PM(I) + R(I)
CV(I) = R2(I) - R(I)
90 CONTINUE
CALL MXV(MMF, XB, H)
CALL MXV(MMF, ZB, E)
CD = DCOS(LPDDN * DR)
SD = DSIN(LPDDN * DR)
DO 100 I = 1, 3
BREF(I) = CD * E(I) - SD * H(I)
UREF(I) = SD * E(I) + CD * H(I)
100 CONTINUE
END IF
C RESTOMOD END
CALL VCRS(BREF, UREF, RREF)
CALL VUNIT(RREF)
RETURN
END
C
C-----------------------------------------------------------------------
C FREE LOOK. Camera axes from the reference attitude turned by
C yaw (+ right), pitch (+ up) and roll (+ camera clockwise as the
C viewer sees it, so the picture turns counter-clockwise).
C-----------------------------------------------------------------------
SUBROUTINE LOOK(YAW, PIT, ROL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION YAW, PIT, ROL
DOUBLE PRECISION B1(3), R1(3), U2(3), C, S
INTEGER I
C = DCOS(YAW * DR)
S = DSIN(YAW * DR)
DO 10 I = 1, 3
B1(I) = C * BREF(I) + S * RREF(I)
R1(I) = C * RREF(I) - S * BREF(I)
10 CONTINUE
C = DCOS(PIT * DR)
S = DSIN(PIT * DR)
DO 20 I = 1, 3
CB(I) = C * B1(I) + S * UREF(I)
U2(I) = C * UREF(I) - S * B1(I)
20 CONTINUE
C = DCOS(ROL * DR)
S = DSIN(ROL * DR)
DO 30 I = 1, 3
CU(I) = C * U2(I) + S * R1(I)
CR(I) = C * R1(I) - S * U2(I)
30 CONTINUE
RETURN
END
C
C=======================================================================
C TABLES. Crater centres and coastline points to unit vectors.
C=======================================================================
SUBROUTINE TABSET
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION A, B
INTEGER I
DO 10 I = 1, NCRAT
A = CRLAT(I) * DR
B = CRLON(I) * DR
CRV(1,I) = DCOS(A) * DCOS(B)
CRV(2,I) = DCOS(A) * DSIN(B)
CRV(3,I) = DSIN(A)
10 CONTINUE
DO 20 I = 1, NCPT
A = CLAT(I) * DR
B = CLON(I) * DR
CEV(1,I) = DCOS(A) * DCOS(B)
CEV(2,I) = DCOS(A) * DSIN(B)
CEV(3,I) = DSIN(A)
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C SCNMOD: place this frame's models (after SCNCAM, before the sky
C is drawn, since placed solids hide stars and bodies): the
C situation's own (its pose, JPOS), then the vehicles near the
C camera at their states (VEHPL, SIVPL). PM the Moon, CG the
C camera (geocentric, km).
C-----------------------------------------------------------------------
SUBROUTINE SCNMOD(GET, PM, CG)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3)
CALL MCLEAR
IF (JPOS .EQ. 1) CALL LMPIRO(GET, PM, CG)
IF (JPOS .EQ. 2) CALL S7POSE(GET)
IF (JPOS .EQ. 3) CALL S8POSE
CALL VEHPL(GET, PM, CG)
CALL SIVPL(GET, CG)
RETURN
END
C
C-----------------------------------------------------------------------
C LMREL: the LM's position LP (km) relative to the camera CG, from
C its state (VSTATE); IOK = 0 if it has none of its own (docked,
C or none at all) or is within 15 m of the camera, where its model
C would hold the camera (ours).
C-----------------------------------------------------------------------
SUBROUTINE LMREL(GET, PM, CG, LP, V, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), LP(3), V(3), R(3), VNRM
INTEGER IOK, I
CALL VSTATE(GET, 2, 2, R, V, IOK)
IF (IOK .NE. 1) IOK = 0
IF (IOK .EQ. 0) RETURN
DO 10 I = 1, 3
LP(I) = PM(I) + R(I) - CG(I)
10 CONTINUE
IF (VNRM(LP) .LT. 15.0D-6) IOK = 0
RETURN
END
C
C-----------------------------------------------------------------------
C VEHPL: the LM at its state (LMSTAT), placed when it is within 5
C km of the camera (where its model spans more than about 0.1 deg;
C ours), not already placed by the situation and not carrying the
C camera (JRID, the LM descent): before touchdown with its descent stage, the
C gear-down model (KLMD); from lift-off (the LIFT event) the ascent
C stage alone (KLMA). Landed, from touchdown to lift-off, it is
C not placed (the marker of lvlab.f stands for it). Attitude ours:
C +X along the local vertical, +Z along the motion; the ascent
C stage from TPF (terminal phase finalize) on, braking to the CSM,
C turns its +X, the docking tunnel's axis, toward the CSM.
C-----------------------------------------------------------------------
SUBROUTINE VEHPL(GET, PM, CG)
DOUBLE PRECISION GET, PM(3), CG(3)
CALL VEHPLD(GET, PM, CG, 5.0D0)
RETURN
END
C
C VEHPLD: VEHPL within DMAX km of the camera (VEHPL's 5 km; the LM
C station's LMSTPL places it at any range).
SUBROUTINE VEHPLD(GET, PM, CG, DMAX)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), DMAX, LP(3), V(3), AT(3,3)
DOUBLE PRECISION BO(3)
DOUBLE PRECISION RL(3), RC(3), VC(3), TL, TF, C, VDOT, VNRM
DOUBLE PRECISION EVGET
INTEGER IOK, I, J, K, KLMPL
IF (JRID .EQ. 2 .OR. KLMPL() .NE. 0) RETURN
K = KLMD
TL = EVGET(KELFT)
IF (TL .GE. 0.0D0 .AND. GET .GE. TL) K = KLMA
IF (K .EQ. KLMD .AND. LUT0 .GT. 0.0D0 .AND. GET .GE. LUT0)
& RETURN
CALL LMREL(GET, PM, CG, LP, V, IOK)
IF (IOK .EQ. 0) RETURN
IF (VNRM(LP) .GT. DMAX) RETURN
C Up: from the Moon's centre to the LM.
DO 10 I = 1, 3
AT(I,1) = CG(I) + LP(I) - PM(I)
10 CONTINUE
TF = EVGET(KETPF)
IF (K .NE. KLMA .OR. TF .LT. 0.0D0 .OR. GET .LT. TF) GO TO 15
C The ascent stage braking to docking: up toward the CSM (the
C source used, ISRCU, kept as the camera's).
J = ISRCU
CALL VSTATE(GET, 2, 2, RL, V, IOK)
CALL VSTATE(GET, 1, 2, RC, VC, IOK)
ISRCU = J
DO 12 I = 1, 3
AT(I,1) = RC(I) - RL(I)
12 CONTINUE
15 CALL VUNIT(AT(1,1))
C = VDOT(V, AT(1,1))
DO 20 I = 1, 3
AT(I,3) = V(I) - C * AT(I,1)
20 CONTINUE
CALL VUNIT(AT(1,3))
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
CALL SETV(BO, 2.3D0, 0.0D0, 0.0D0)
CALL MPLACE(K, AT, LP, BO)
RETURN
END
C
C-----------------------------------------------------------------------
C SIVPL: the S-IVB at its state (traj.f SIVST), placed as the LM is
C (VEHPL): within 5 km of the camera, not within 15 m of it, not
C already placed by the scene (scene 7), and only on a state of its
C own (IOK 1: not with the CSM before separation, nor docked to the
C stack, as the docked LM). Attitude: the stack's, held inertially
C for the docking (S7ATT); the S-IVB's turn to its slingshot
C attitude from 4:41:07.6 (SP p. 106) is not modelled (ours).
C Before the ejection (EJECT) the LM, gear stowed (KLMS), stands in
C it as S7POSE puts it. The source used, ISRCU, kept as the
C camera's (S7ATT reads a state).
C-----------------------------------------------------------------------
SUBROUTINE SIVPL(GET, CG)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, CG(3), R(3), V(3), LP(3), BO(3), D, VNRM
DOUBLE PRECISION EVGET
INTEGER IOK, I, J, KLMPL, KSIVPL
IF (KSIVPL() .NE. 0) RETURN
CALL VSTATE(GET, 3, 1, R, V, IOK)
IF (IOK .NE. 1) RETURN
DO 10 I = 1, 3
LP(I) = R(I) - CG(I)
10 CONTINUE
D = VNRM(LP)
IF (D .GT. 5.0D0 .OR. D .LT. 15.0D-6) RETURN
J = ISRCU
CALL S7ATT
ISRCU = J
C The state's point: the stage's centre (S7SIV).
CALL SETV(BO, -0.5D0 * (SIVBH + SIUH) * 0.3048D0, 0.0D0,
& 0.0D0)
CALL MPLACE(KSIV, S7AT, LP, BO)
IF (GET .GE. EVGET(KEEJC) .OR. KLMPL() .NE. 0) RETURN
C The LM's tunnel top 1.5 + 4.51 m above the IU's top (S7POSE).
D = (1.5D0 + 4.51D0 - BO(1)) * 1.0D-3
DO 20 I = 1, 3
LP(I) = LP(I) + D * S7AT(I,1)
20 CONTINUE
CALL SETV(BO, 4.51D0, 0.0D0, 0.0D0)
CALL MPLACE(KLMS, S7AT, LP, BO)
RETURN
END
C
C-----------------------------------------------------------------------
C LVPL: the launch stack (KSTK: S-IVB, IU and the closed SLA, the
C LM hidden in it) behind the placed CSM before the separation
C (the scenario's SEP event), in the CSM's attitude, the SLA's top
C at the SM's aft end ("the forward end at the service module
C mating line", Apollo 11 press kit, printed p. 88; SMAFT). Not
C where the situation places an S-IVB or an LM of its own (the
C docking, the docked stack), nor without a SEP event (ours).
C Below it the S-II (KSII) to the scenario's SIISEP event and the
C S-IC (KSIC) to its SICSEP event, and on the CM the launch escape
C system (KLES) to its LESJET event (#97): each only where the
C scenario has that event. The CSM must be placed (KCSM, CSMCAM);
C after CM/SM separation there is no stack.
C-----------------------------------------------------------------------
SUBROUTINE LVPL(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, V(3), W(3), P(3), BO(3), AT(3,3), TS
DOUBLE PRECISION EVGET, SMAFT
INTEGER I, J, KSIVPL, KLMPL
IF (MDON(KCSM) .EQ. 0 .OR. KSIVPL() .NE. 0) RETURN
IF (KLMPL() .NE. 0) RETURN
TS = EVGET(KESEP)
IF (TS .LT. 0.0D0 .OR. GET .GE. TS) RETURN
C The SM's aft end on the CSM's axis, camera relative, km.
DO 10 I = 1, 3
V(I) = -MDBO(I,KCSM) * 1.0D-3
DO 5 J = 1, 3
AT(I,J) = MDAT(I,J,KCSM)
5 CONTINUE
10 CONTINUE
V(1) = V(1) + SMAFT() * 1.0D-3
CALL MXV(AT, V, W)
DO 20 I = 1, 3
P(I) = MDP(I,KCSM) + W(I)
20 CONTINUE
CALL SETV(BO, SLAH * 0.3048D0, 0.0D0, 0.0D0)
CALL MPLACE(KSTK, AT, P, BO)
TS = EVGET(KESII)
IF (TS .GE. 0.0D0 .AND. GET .LT. TS) CALL MPLACE(KSII, AT, P, BO)
TS = EVGET(KESIC)
IF (TS .GE. 0.0D0 .AND. GET .LT. TS) CALL MPLACE(KSIC, AT, P, BO)
TS = EVGET(KELES)
IF (TS .GE. 0.0D0 .AND. GET .LT. TS) CALL MPLACE(KLES, AT,
& MDP(1,KCSM), MDBO(1,KCSM))
RETURN
END
C
C-----------------------------------------------------------------------
C PADAX: the launch complex's axes AT (EQ; PADBLD's body frame) and
C the foot of the pad P0 (camera relative, km; the camera at
C geocentric CG) at this frame's time. Axes from the pad's place
C on the drawn Earth (learth.f PADEF, where DPAD marks it): X up,
C -Z north, toward the umbilical tower (ours: no source we hold
C says which side of the vehicle the tower stood), Y = Z x X; the
C vehicle on the pad has the same axes, so the CM's side hatch
C (CSMBLD, -Z) faces the tower's access arm. The foot is under
C PADEF's place, where the scenario's ascent table stands the CSM
C before lift-off (TABRV takes the table's low rows onto the same
C geodetic footing, #105), at the radius of the CSM's state at the
C LIFTOFF event less the stack's height PADHC, so the stack on the
C pad and the CSM's own state agree and the vehicle rises from the
C pad along the table (ASCPL). The table's lift-off altitude
C (0.032 n mi, SP-4029 p. 103) being less than the stack's height,
C the foot lies about 70 m inside the drawn sphere (ours). Without
C a LIFTOFF event or a state there, the foot is on the sphere. IOK
C 0 if the scenario has no pad.
C-----------------------------------------------------------------------
SUBROUTINE PADAX(CG, AT, P0, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION CG(3), AT(3,3), P0(3), U(3), EN(3), W(3)
DOUBLE PRECISION R0(3), V0(3), TL, HC, EVGET, PADHC, VDOT
INTEGER IOK, I, J, I0
CALL PADEF(U, EN, IOK)
IF (IOK .EQ. 0) RETURN
CALL MXV(MEF, U, AT(1,1))
CALL MXV(MEF, EN, W)
DO 10 I = 1, 3
AT(I,3) = -W(I)
P0(I) = RE * AT(I,1) - CG(I)
10 CONTINUE
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
TL = EVGET(KELFO)
IF (TL .LT. 0.0D0) RETURN
J = ISRCU
CALL VSTATE(TL, 1, 1, R0, V0, I0)
ISRCU = J
IF (I0 .NE. 1) RETURN
HC = DSQRT(VDOT(R0, R0)) - PADHC() * 1.0D-3
DO 20 I = 1, 3
P0(I) = HC * AT(I,1) - CG(I)
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C PADPL: the launch complex (KPAD: the pad, the mobile launcher and
C its umbilical tower; #97) fixed to the turning Earth at the pad
C (PADAX), with the tower's service arms: arms 1 to 8 swung out to
C the vehicle (KARE) before the scenario's LIFTOFF event and swung
C back (KARR) from it (ours: "The remaining five arms are set to
C swing back at vehicle first motion", the others earlier, Apollo
C 11 press kit, printed p. 164); arm 9, the Apollo access arm, at
C the spacecraft (KA9E) to T-43 minutes, "moved to a parked
C position, 12 degrees from the spacecraft, at about T-43 minutes"
C (KA9P) and "fully retracted at the T-5 minute mark" (KA9R;
C printed p. 165), the count's T- taken as g.e.t. before range zero
C (ours). Placed with the CSM drawn around an external view's
C camera (CSMCAM), where the scenario has a pad and a LIFTOFF
C event, before its S-II/S-IVB separation (SIISEP; without one,
C before lift-off) and within 500 km of the camera (ours: past that
C it is under a hundredth of a degree across).
C-----------------------------------------------------------------------
SUBROUTINE PADPL(GET, CG)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, CG(3), AT(3,3), P0(3), Z(3), TL, TE, EVGET
DOUBLE PRECISION VNRM
INTEGER IOK, K
TL = EVGET(KELFO)
IF (TL .LT. 0.0D0) RETURN
TE = EVGET(KESII)
IF (TE .LT. 0.0D0) TE = TL
IF (GET .GE. TE) RETURN
CALL PADAX(CG, AT, P0, IOK)
IF (IOK .EQ. 0 .OR. VNRM(P0) .GT. 500.0D0) RETURN
CALL SETV(Z, 0.0D0, 0.0D0, 0.0D0)
CALL MPLACE(KPAD, AT, P0, Z)
K = KARE
IF (GET .GE. TL) K = KARR
CALL MPLACE(K, AT, P0, Z)
K = KA9E
IF (GET .GE. -2580.0D0) K = KA9P
IF (GET .GE. -300.0D0) K = KA9R
CALL MPLACE(K, AT, P0, Z)
RETURN
END
C
C-----------------------------------------------------------------------
C ASCPL: where CSMCAM places the CSM from the pad to the S-II/S-IVB
C separation (#97): its axes AT and its origin P (camera relative,
C km; the camera at geocentric CG); IOK 0 outside that span, or
C where the scenario has no pad or no LIFTOFF event.
C Before lift-off (LIFTOFF) on the pad, in the launch complex's
C axes, PADHC above the foot of the pad (PADAX): where the
C ascent table stands it.
C After it at its state, its X axis along the velocity relative
C to the turning Earth, with the pad's up added at 50 m/s (ours:
C no attitude for the ascent is held), so it lifts off upright
C and turns over with its flight path; Z from the pad's (no roll
C programme; ours).
C After the S-II/S-IVB separation (SIISEP), the stack is the one
C #70 draws behind the CSM, around the camera (CSMCAM), so the
C attitude steps there by a few degrees.
C-----------------------------------------------------------------------
SUBROUTINE ASCPL(GET, CG, AT, P, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, CG(3), AT(3,3), P(3)
DOUBLE PRECISION PA(3,3), P0(3), R(3), V(3), D(3), OM(3), HC
DOUBLE PRECISION TL, TE, C, OMG, EVGET, PADHC, VDOT
INTEGER IOK, I, J, I1
IOK = 0
TL = EVGET(KELFO)
TE = EVGET(KESII)
IF (TL .LT. 0.0D0) RETURN
IF (GET .GE. TL .AND. (TE .LT. 0.0D0 .OR. GET .GE. TE)) RETURN
CALL PADAX(CG, PA, P0, I)
IF (I .EQ. 0) RETURN
IF (GET .GE. TL) GO TO 20
HC = PADHC() * 1.0D-3
DO 10 I = 1, 3
P(I) = P0(I) + HC * PA(I,1)
DO 5 J = 1, 3
AT(I,J) = PA(I,J)
5 CONTINUE
10 CONTINUE
IOK = 1
RETURN
C The CSM's state now (the camera's source kept).
20 J = ISRCU
CALL VSTATE(GET, 1, 1, R, V, I1)
ISRCU = J
IF (I1 .NE. 1) RETURN
C The velocity relative to the Earth, turning about its pole of
C date (MEF's third column), with the pad's up at 50 m/s.
OMG = 360.98564736629D0 * DR / 86400.0D0
DO 30 I = 1, 3
P(I) = R(I) - CG(I)
OM(I) = OMG * MEF(I,3)
30 CONTINUE
CALL VCRS(OM, R, D)
DO 35 I = 1, 3
AT(I,1) = V(I) - D(I) + 0.05D0 * PA(I,1)
35 CONTINUE
CALL VUNIT(AT(1,1))
C = VDOT(PA(1,3), AT(1,1))
DO 40 I = 1, 3
AT(I,3) = PA(I,3) - C * AT(I,1)
40 CONTINUE
CALL VUNIT(AT(1,3))
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
IOK = 1
RETURN
END
C
C MEFAT: the Earth-fixed to J2000 matrix M at GET (VFRAME's MEF for
C its frame): GMST about the pole of date, then the IAU 1976
C precession back to J2000 (PRECM).
SUBROUTINE MEFAT(GET, M)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, M(3,3), R1(3,3), R2(3,3), GMSTAT
INTEGER I, J
CALL ROTZ(GMSTAT(GET), R1)
CALL PRECM((TJD0 + GET / 86400.0D0 - 2451545.0D0) / 36525.0D0,
& R2)
DO 20 I = 1, 3
DO 10 J = 1, 3
M(I,J) = R2(1,I) * R1(1,J) + R2(2,I) * R1(2,J)
& + R2(3,I) * R1(3,J)
10 CONTINUE
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C LMPIRO: the LM at its state (LMSTAT: 300 ft out along the orbit
C normal from undocking to the separation burn), turning slowly for
C inspection (scene 4); not placed where it has no state of its
C own (LMREL), nor from touchdown on, as in VEHPL (the gear-down
C model is the LM with its descent stage).
C-----------------------------------------------------------------------
SUBROUTINE LMPIRO(GET, PM, CG)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3)
DOUBLE PRECISION AT(3,3), R1(3,3), R2(3,3), R3(3,3), R4(3,3)
DOUBLE PRECISION BX(3,3), LP(3), BO(3), V(3), T, PS, TH, PH, C
DOUBLE PRECISION EVGET, VDOT
INTEGER I, IOK, K
C Nothing between touchdown and lift-off (VEHPL's rule): the LM
C stands at the landing site, below any scene 4 camera.
IF (LUT0 .GT. 0.0D0 .AND. GET .GE. LUT0 .AND. (EVGET(KELFT)
& .LT. 0.0D0 .OR. GET .LT. EVGET(KELFT))) RETURN
CALL LMREL(GET, PM, CG, LP, V, IOK)
IF (IOK .EQ. 0) RETURN
C Body axes: X up (the reference up made square to the line of
C sight), Z toward the camera.
DO 10 I = 1, 3
BX(I,3) = -LP(I)
10 CONTINUE
CALL VUNIT(BX(1,3))
C = VDOT(UREF, BX(1,3))
DO 15 I = 1, 3
BX(I,1) = UREF(I) - C * BX(I,3)
15 CONTINUE
CALL VUNIT(BX(1,1))
CALL VCRS(BX(1,3), BX(1,1), BX(1,2))
T = GET - EVGET(KEUND)
PS = (35.0D0 + 1.5D0 * T) * DR
TH = -(20.0D0 + 15.0D0 * DSIN(T * 2.0D0 * PI / 300.0D0)) * DR
PH = (10.0D0 * DSIN(T * 2.0D0 * PI / 420.0D0)) * DR
C Yaw about body X, tilt toward the camera about body Y, then
C turn in the picture about body Z (toward the camera).
CALL ROTX(PS, R1)
CALL ROTY(TH, R2)
CALL ROTZ(PH, R3)
CALL MXM(R3, R2, R4)
CALL MXM(R4, R1, R2)
CALL MXM(BX, R2, AT)
C Centred on the stage joint, the state's point (LMSTAT). From
C lift-off (the LIFT event) the ascent stage alone (KLMA).
CALL SETV(BO, 2.3D0, 0.0D0, 0.0D0)
K = KLMD
IF (EVGET(KELFT) .GE. 0.0D0 .AND. GET .GE. EVGET(KELFT)) K = KLMA
CALL MPLACE(K, AT, LP, BO)
RETURN
END
C
C=======================================================================
C TRANSPOSITION AND DOCKING (scene 7). TN D-6853 (printed p. 12)
C lists among VIEW's capabilities integrating trajectories "after
C separation of the LM and the CSM or the CSM/LM and S-IVB
C vehicles", drawing "the vehicle outlines of the CSM, LM, and the
C S-IVB" at their apparent size, and "hidden-line models of the LM
C and the S-IVB". The contents and OCR of the Apollo 11 report
C (MSC IN 69-FM-197) list no such views: no answer key.
C
C Apollo 11 times (Mission Report MSC-00171, table 7-II, printed
C p. 7-9): command module/S-IVB separation 3:17:04.6, docking
C 3:24:03.1. The crew expected to be "out about 66 feet", and
C Collins guessed "around 100 or so" (Apollo 11 Flight Journal,
C 003:38:07); the report has "a maximum separation distance of at
C least 100 feet" and contact "at an estimated 0.1 ft/sec"
C (printed p. 4-2). Our closing law: 100 ft until 3:20:30 (the
C turnaround is not modelled; the time is our guess, between the
C separation and Collins' "I'm still quite a ways" at 3:22:25),
C then range = 100 (A U + (1-A) U**2) ft, U the fraction of the
C closing time left, A set so the range rate at contact is 0.1
C ft/s.
C-----------------------------------------------------------------------
SUBROUTINE S7POSE(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, D, V(3), W(3), Z(3)
DOUBLE PRECISION PS(3), AC(3,3), S7RF, CMTOP
INTEGER I
S7RNG = S7RF(GET)
C The camera is the COAS in the CSM's left rendezvous window,
C looking parallel to the docking axis 0.72 m to the LM's -Y side
C of it and 2 m behind the CSM's docking ring (our guesses; the
C target is set off to match, LMDOCK). S7BO: the tunnel top.
CALL SETV(S7BO, 4.51D0, 0.0D0, 0.0D0)
D = (S7RNG * 0.3048D0 + 2.0D0) * 1.0D-3
DO 10 I = 1, 3
S7LP(I) = D * BREF(I) + 0.72D-3 * S7AT(I,2)
10 CONTINUE
CALL MPLACE(KLMS, S7AT, S7LP, S7BO)
C The S-IVB on the same axes, the top of its IU 1.5 m below the
C LM's base on the descent stage's axis (Y = Z = 0), which puts
C the LM tunnel near the top of the 28 ft SLA (press kit, printed
C p. 88) with room for the SPS nozzle: our guess.
CALL SETV(V, (-1.5D0 - S7BO(1)) * 1.0D-3, -S7BO(2) * 1.0D-3,
& -S7BO(3) * 1.0D-3)
CALL MXV(S7AT, V, W)
DO 20 I = 1, 3
PS(I) = S7LP(I) + W(I)
20 CONTINUE
CALL SETV(Z, 0.0D0, 0.0D0, 0.0D0)
CALL MPLACE(KSIV, S7AT, PS, Z)
C Seen from outside (IVIEW 1; SCNMOD runs before VIEWPT sets
C IVUSE), the CSM itself, coaxial with the LM and facing it: its
C axes S7AT's with X and Y turned over (STKPL's half turn about Z),
C the CSM's origin CMTOP (models.f; STKPL) plus the range S7RNG
C behind the LM's tunnel top S7LP, so the two tunnels' tops meet
C at docking and the camera, 2 m behind that top (above), sits in
C the CM 0.77 m above the CSM's origin, near the eye's X 0.70
C (CMEYE). Placed, it replaces VIEWPT's CSM around the camera
C (CSMCAM); the window view keeps the camera in the CSM and draws
C no CSM (ours).
IF (IVIEW .NE. 1) RETURN
DO 30 I = 1, 3
AC(I,1) = -S7AT(I,1)
AC(I,2) = -S7AT(I,2)
AC(I,3) = S7AT(I,3)
30 CONTINUE
D = S7RNG * 0.3048D-3 + CMTOP() * 1.0D-3
DO 40 I = 1, 3
PS(I) = S7LP(I) - D * AC(I,1)
40 CONTINUE
CALL MPLACE(KCSM, AC, PS, Z)
RETURN
END
C
C S7RF: scene 7's range (ft) from the CSM's docking ring to the
C LM's at GET, S7POSE's closing law, between the approach start and
C the docking from the scenario (APPR, DOCK); 100 without them.
DOUBLE PRECISION FUNCTION S7RF(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, TCLS, TDOK, U, A, EVGET
TCLS = EVGET(KEAPR)
TDOK = EVGET(KEDOK)
S7RF = 100.0D0
IF (TDOK .LE. TCLS) RETURN
U = (TDOK - GET) / (TDOK - TCLS)
IF (U .GT. 1.0D0) U = 1.0D0
IF (U .LT. 0.0D0) U = 0.0D0
A = 0.1D0 * (TDOK - TCLS) / 100.0D0
S7RF = 100.0D0 * (A * U + (1.0D0 - A) * U * U)
RETURN
END
C
C S7SIV: the S-IVB's centre, the point of its state (traj.f SIVST),
C from the CSM's eye in scene 7's geometry at range RNG (ft), EQ km:
C S7POSE's LM tunnel top RNG ft plus 2 m down the docking axis and
C 0.72 m to the LM's -Y side, the IU's top 6.01 m below that, the
C centre half the stage's 61.3 ft (SIVBMD) below the IU's top, on
C the axes S7AT (S7ATT must have set them).
SUBROUTINE S7SIV(RNG, P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION RNG, P(3), D
INTEGER I
D = (RNG * 0.3048D0 + 2.0D0 + 1.5D0 + 4.51D0
& + 0.5D0 * (SIVBH + SIUH) * 0.3048D0) * 1.0D-3
DO 10 I = 1, 3
P(I) = -D * S7AT(I,1) + 0.72D-3 * S7AT(I,2)
10 CONTINUE
RETURN
END
C
C S7ATT: the stack's attitude, LM (and S-IVB) body axes in S7AT.
C The S-IVB held "a fixed inertial attitude to provide a stable
C docking platform" (MPR-SAT-FE-69-9, printed p. 11-1), reached by
C a manoeuvre that was to be "completed at plus 09 plus 20", so
C "the Sun will shine across the top of the LM after separation"
C (Apollo 11 Flight Journal, 002:54:09 and commentary). The
C attitude itself is our guess: the stack's X axis square to the
C Sun and in the plane of the trajectory, pointing along the
C motion, frozen at 3:09:20; the LM front (+Z) toward the Sun.
SUBROUTINE S7ATT
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T, R(3), V(3), S(3), H(3), X(3), Y(3), VDOT
DOUBLE PRECISION EVGET
INTEGER I
C The attitude time from the scenario (TDATT).
T = EVGET(KETDA)
CALL CSMST(T, 1, R, V)
CALL SUNG(T, S)
CALL VCRS(R, V, H)
CALL VUNIT(H)
CALL VCRS(S, H, X)
CALL VUNIT(X)
IF (VDOT(X, V) .LT. 0.0D0) CALL SETV(X, -X(1), -X(2), -X(3))
CALL VCRS(S, X, Y)
DO 10 I = 1, 3
S7AT(I,1) = X(I)
S7AT(I,2) = Y(I)
S7AT(I,3) = S(I)
10 CONTINUE
RETURN
END
C
C VSETIN: the view inputs for the next frame (the chassis calls it
C before VFRAME): view, camera target, label level. Out-of-range
C values fall back to 0.
SUBROUTINE VSETIN(IV, IT, IL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER IV, IT, IL
IVIEW = IV
ITARG = IT
ILABL = IL
IF (IVIEW .LT. 0 .OR. IVIEW .GT. 3) IVIEW = 0
IF (ITARG .LT. 0 .OR. ITARG .GT. 6) ITARG = 0
IF (ILABL .LT. 0 .OR. ILABL .GT. 3) ILABL = 0
RETURN
END
C
C-----------------------------------------------------------------------
C S8ATT: the docked stack's attitude in passive thermal control,
C CSM body axes in S8AT. "In this attitude the spacecraft will be
C rotated at a rate of about 3 revolutions per hour" (Apollo 11
C Flight Journal, commentary after 008:11:00); "rotated about its
C X axis" (same, Apollo Control at 8 hours 59 minutes); "PTC is
C started now" (Collins, 010:58:19). The axis is ours: square to
C the ecliptic, so the Sun stays square to it (J2000 ecliptic pole);
C the roll starts with +Z toward the Sun. Before PTC, no roll.
C-----------------------------------------------------------------------
SUBROUTINE S8ATT(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, X(3), Y(3), Z(3), EP, PH, C, S, EVGET
INTEGER I
EP = 23.4392911D0 * DR
CALL SETV(X, 0.0D0, -DSIN(EP), DCOS(EP))
CALL VCRS(X, SUNU, Y)
CALL VUNIT(Y)
CALL VCRS(X, Y, Z)
PH = 0.0D0
IF (GET .GT. EVGET(KEPTC)) PH = 3.0D0 * 2.0D0 * PI / 3600.0D0
& * (GET - EVGET(KEPTC))
C = DCOS(PH)
S = DSIN(PH)
DO 10 I = 1, 3
S8AT(I,1) = X(I)
S8AT(I,2) = C * Y(I) + S * Z(I)
S8AT(I,3) = C * Z(I) - S * Y(I)
10 CONTINUE
RETURN
END
C
C S8POSE: place the docked stack (STKPL), the LM with its gear
C stowed (KLMS) as in translunar coast (press kit p. 103), QDST
C (EXTSEED's distance, 60 m) along the reference boresight from
C the camera.
SUBROUTINE S8POSE
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3)
INTEGER I
DO 10 I = 1, 3
P(I) = QDST * BREF(I)
10 CONTINUE
CALL STKPL(S8AT, P, KLMS)
RETURN
END
C
C-----------------------------------------------------------------------
C REFTRN: the recipe's reference attitude turned by the situation's
C TURN angles, QTRN: yaw, pitch, roll offsets in LOOK's sense.
C Situation 9 (Apollo 8 Earthrise) turns the forward horizon view
C to the framing of the photograph AS08-14-2383 as it is usually
C shown (the film frame turned a quarter turn clockwise, the lunar
C horizon at the bottom), with three angles FITTED by us (not
C sourced; see its SITUATION card): they put the Earth's centre
C where the photograph has it and the horizon at its tilt,
C measured on the ASU scan; the Earth's size, its height above the
C horizon and its phase are then checks, not inputs.
C-----------------------------------------------------------------------
SUBROUTINE REFTRN
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER I
CALL VCRS(BREF, UREF, RREF)
CALL VUNIT(RREF)
CALL LOOK(QTRN(1), QTRN(2), QTRN(3))
DO 10 I = 1, 3
BREF(I) = CB(I)
UREF(I) = CU(I)
RREF(I) = CR(I)
10 CONTINUE
RETURN
END
src/ephem.f
C=======================================================================
C
C V I E W - 1 1 0 8 EPHEMERIS
C
C Core element. Time, Sun, Moon and their orientation. One
C relocatable element of the kernel; see vdrive.f for the list.
C
C WORLD MODEL
C Moon: Meeus ch. 47 (ELP-2000/82 abridged, 60 + 60 terms),
C within about 15 km of JPL Horizons over Apollo 8 and 11
C (docs/simulation.md); precessed to J2000 (PRECM). Sun: the
C low-precision series of the Astronomical Almanac, ecliptic of
C date carried to the J2000 equinox by the general precession in
C longitude. Moon orientation: IAU (Archinal et al.) with its
C periodic terms. Earth rotation: GMST about the pole of date,
C carried to J2000 by the IAU 1976 precession (PRECM).
C
C=======================================================================
C
C=======================================================================
C TIME AND EPHEMERIDES
C=======================================================================
SUBROUTINE TSET(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET
C RESTOMOD BEGIN: J2000 epoch (IAU 1976/1984), GMST of Aoki 1982
TJD = TJD0 + GET / 86400.0D0
TDAY = TJD - 2451545.0D0
TCEN = TDAY / 36525.0D0
GMST = DMOD(280.46061837D0 + 360.98564736629D0 * TDAY, 360.0D0)
GMST = GMST * DR
C RESTOMOD END
RETURN
END
C
C-----------------------------------------------------------------------
C MOONG: geocentric Moon, EQ km.
C
C Meeus, Astronomical Algorithms (2nd ed., 1998), ch. 47: the
C ELP-2000/82 lunar theory (Chapront-Touze and Chapront, 1982)
C abridged to the 60 + 60 periodic terms of tables 47.A and 47.B,
C with the E factor for terms in M and the additive terms A1-A3.
C The tables are data (data/meeus47.txt, BLOCK DATA /CMEEUS/).
C Mean ecliptic and equinox of date to J2000 equatorial: mean
C obliquity of date, then the IAU 1976 precession (Lieske 1977;
C Meeus eqs. 22.2 and 21.3, PRECM). Time is TT: UTC plus 32.184 s
C plus
C TAI-UTC by the USNO formula for 1968-02-01 to 1972-01-01,
C 4.21317 s + (MJD - 39126) x 0.002592 s (maia.usno.navy.mil,
C ser7/tai-utc.dat); ours outside that span too.
C Checked against JPL Horizons, docs/simulation.md. MSC's RTCC
C did not compute its ephemeris from a short series: its
C "ephemeris subroutines used in the RTCC will be system
C subroutines", reading "an ephemeris tape" (Analytical Mechanics
C Associates Report 68-4, NAS 9-4036, April 1968, p. 17),
C so a precise Moon is nearer period practice than the
C low-precision formula this replaces.
C-----------------------------------------------------------------------
SUBROUTINE MOONG(GET, P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, P(3)
DOUBLE PRECISION T, TJ, XMJD, LP, DD, AM, AMP, F, A1, A2, A3, E
DOUBLE PRECISION SL, SR, SB, ARG, EK, L, B, R, EPS, CE, SE
DOUBLE PRECISION X, Y, Z, Q(3), PR(3,3), SND, CSD
INTEGER K, J, M
C RESTOMOD BEGIN: ELP-2000/82 (1982) as abridged by Meeus (1991,
C 1998); IAU 1976 precession; TT and TAI-UTC (1970s definitions)
XMJD = TJD0 + GET / 86400.0D0 - 2400000.5D0
TJ = TJD0 + (GET + 32.184D0 + 4.21317D0
& + (XMJD - 39126.0D0) * 0.002592D0) / 86400.0D0
T = (TJ - 2451545.0D0) / 36525.0D0
LP = 218.3164477D0 + 481267.88123421D0 * T
& - 0.0015786D0 * T**2 + T**3 / 538841.0D0 - T**4 / 65194000.0D0
DD = 297.8501921D0 + 445267.1114034D0 * T
& - 0.0018819D0 * T**2 + T**3 / 545868.0D0
& - T**4 / 113065000.0D0
AM = 357.5291092D0 + 35999.0502909D0 * T
& - 0.0001536D0 * T**2 + T**3 / 24490000.0D0
AMP = 134.9633964D0 + 477198.8675055D0 * T
& + 0.0087414D0 * T**2 + T**3 / 69699.0D0
& - T**4 / 14712000.0D0
F = 93.2720950D0 + 483202.0175233D0 * T
& - 0.0036539D0 * T**2 - T**3 / 3526000.0D0
& + T**4 / 863310000.0D0
A1 = 119.75D0 + 131.849D0 * T
A2 = 53.09D0 + 479264.290D0 * T
A3 = 313.45D0 + 481266.484D0 * T
E = 1.0D0 - 0.002516D0 * T - 0.0000074D0 * T**2
LP = DMOD(LP, 360.0D0)
DD = DMOD(DD, 360.0D0)
AM = DMOD(AM, 360.0D0)
AMP = DMOD(AMP, 360.0D0)
F = DMOD(F, 360.0D0)
SL = 0.0D0
SR = 0.0D0
SB = 0.0D0
DO 10 K = 1, 60
J = 6 * (K - 1)
M = IABS(MMA(J + 2))
EK = 1.0D0
IF (M .EQ. 1) EK = E
IF (M .EQ. 2) EK = E * E
ARG = DBLE(MMA(J + 1)) * DD + DBLE(MMA(J + 2)) * AM
& + DBLE(MMA(J + 3)) * AMP + DBLE(MMA(J + 4)) * F
SL = SL + DBLE(MMA(J + 5)) * EK * SND(ARG)
SR = SR + DBLE(MMA(J + 6)) * EK * CSD(ARG)
10 CONTINUE
DO 20 K = 1, 60
J = 5 * (K - 1)
M = IABS(MMB(J + 2))
EK = 1.0D0
IF (M .EQ. 1) EK = E
IF (M .EQ. 2) EK = E * E
ARG = DBLE(MMB(J + 1)) * DD + DBLE(MMB(J + 2)) * AM
& + DBLE(MMB(J + 3)) * AMP + DBLE(MMB(J + 4)) * F
SB = SB + DBLE(MMB(J + 5)) * EK * SND(ARG)
20 CONTINUE
SL = SL + 3958.0D0 * SND(A1) + 1962.0D0 * SND(LP - F)
& + 318.0D0 * SND(A2)
SB = SB - 2235.0D0 * SND(LP) + 382.0D0 * SND(A3)
& + 175.0D0 * SND(A1 - F) + 175.0D0 * SND(A1 + F)
& + 127.0D0 * SND(LP - AMP) - 115.0D0 * SND(LP + AMP)
L = (LP + SL * 1.0D-6) * DR
B = SB * 1.0D-6 * DR
R = 385000.56D0 + SR * 1.0D-3
C Ecliptic of date to equator of date, mean obliquity (eq. 22.2).
EPS = (23.4392911D0 - 0.0130041667D0 * T
& - 1.6388889D-7 * T**2 + 5.0361111D-7 * T**3) * DR
CE = DCOS(EPS)
SE = DSIN(EPS)
X = R * DCOS(B) * DCOS(L)
Y = R * DCOS(B) * DSIN(L)
Z = R * DSIN(B)
Q(1) = X
Q(2) = CE * Y - SE * Z
Q(3) = SE * Y + CE * Z
C Equator and equinox of date to J2000: PRECM's transpose.
CALL PRECM(T, PR)
CALL MTXV(PR, Q, P)
C RESTOMOD END
RETURN
END
C
C-----------------------------------------------------------------------
C SND: sine of an angle in degrees, reduced first.
C-----------------------------------------------------------------------
DOUBLE PRECISION FUNCTION SND(A)
DOUBLE PRECISION A
DOUBLE PRECISION PI, DR
C RESTOMOD: real-valued PARAMETER; FORTRAN V PARAMETER was
C integer-only (UP-4046 Rev 3, sec. 10.4.1, p. 10-8)
PARAMETER (PI=3.141592653589793D0, DR=PI/180.0D0)
SND = DSIN(DMOD(A, 360.0D0) * DR)
RETURN
END
C
C-----------------------------------------------------------------------
C SUNG: unit vector Earth to Sun, EQ.
C-----------------------------------------------------------------------
SUBROUTINE SUNG(GET, U)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, U(3)
DOUBLE PRECISION D, T, G, L, CE, SE, SND
C RESTOMOD BEGIN: Astronomical Almanac low-precision Sun, 1980s
D = TJD0 + GET / 86400.0D0 - 2451545.0D0
T = D / 36525.0D0
G = 357.528D0 + 0.9856003D0 * D
L = 280.460D0 + 0.9856474D0 * D + 1.915D0 * SND(G)
& + 0.020D0 * SND(2.0D0 * G)
L = DMOD(L - 1.3969713D0 * T, 360.0D0) * DR
CE = DCOS(23.4392911D0 * DR)
SE = DSIN(23.4392911D0 * DR)
U(1) = DCOS(L)
U(2) = CE * DSIN(L)
U(3) = SE * DSIN(L)
C RESTOMOD END
RETURN
END
C
C-----------------------------------------------------------------------
C MOONRT: Moon-fixed to EQ rotation, IAU pole and prime meridian
C with the periodic terms E1..E13. M = RZ(A0+90) RX(90-D0) RZ(W).
C-----------------------------------------------------------------------
SUBROUTINE MOONRT(GET, M)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, M(3,3)
DOUBLE PRECISION D, T, E(13), A0, D0, W, SND, CSD
DOUBLE PRECISION R1(3,3), R2(3,3), R3(3,3), R4(3,3)
C RESTOMOD BEGIN: IAU WGCCRE lunar orientation, 1980s-2010s
D = TJD0 + GET / 86400.0D0 - 2451545.0D0
T = D / 36525.0D0
E(1) = 125.045D0 - 0.0529921D0 * D
E(2) = 250.089D0 - 0.1059842D0 * D
E(3) = 260.008D0 + 13.0120009D0 * D
E(4) = 176.625D0 + 13.3407154D0 * D
E(5) = 357.529D0 + 0.9856003D0 * D
E(6) = 311.589D0 + 26.4057084D0 * D
E(7) = 134.963D0 + 13.0649930D0 * D
E(8) = 276.617D0 + 0.3287146D0 * D
E(9) = 34.226D0 + 1.7484877D0 * D
E(10) = 15.134D0 - 0.1589763D0 * D
E(11) = 119.743D0 + 0.0036096D0 * D
E(12) = 239.961D0 + 0.1643573D0 * D
E(13) = 25.053D0 + 12.9590088D0 * D
A0 = 269.9949D0 + 0.0031D0 * T - 3.8787D0 * SND(E(1))
& - 0.1204D0 * SND(E(2)) + 0.0700D0 * SND(E(3))
& - 0.0172D0 * SND(E(4)) + 0.0072D0 * SND(E(6))
& - 0.0052D0 * SND(E(10)) + 0.0043D0 * SND(E(13))
D0 = 66.5392D0 + 0.0130D0 * T + 1.5419D0 * CSD(E(1))
& + 0.0239D0 * CSD(E(2)) - 0.0278D0 * CSD(E(3))
& + 0.0068D0 * CSD(E(4)) - 0.0029D0 * CSD(E(6))
& + 0.0009D0 * CSD(E(7)) + 0.0008D0 * CSD(E(10))
& - 0.0009D0 * CSD(E(13))
W = 38.3213D0 + 13.17635815D0 * D - 1.4D-12 * D * D
& + 3.5610D0 * SND(E(1)) + 0.1208D0 * SND(E(2))
& - 0.0642D0 * SND(E(3)) + 0.0158D0 * SND(E(4))
& + 0.0252D0 * SND(E(5)) - 0.0066D0 * SND(E(6))
& - 0.0047D0 * SND(E(7)) - 0.0046D0 * SND(E(8))
& + 0.0028D0 * SND(E(9)) + 0.0052D0 * SND(E(10))
& + 0.0040D0 * SND(E(11)) + 0.0019D0 * SND(E(12))
& - 0.0044D0 * SND(E(13))
CALL ROTZ((A0 + 90.0D0) * DR, R1)
CALL ROTX((90.0D0 - D0) * DR, R2)
CALL ROTZ(DMOD(W, 360.0D0) * DR, R3)
CALL MXM(R1, R2, R4)
CALL MXM(R4, R3, M)
C RESTOMOD END
RETURN
END
C
DOUBLE PRECISION FUNCTION CSD(A)
DOUBLE PRECISION A
DOUBLE PRECISION PI, DR
C RESTOMOD: real-valued PARAMETER; FORTRAN V PARAMETER was
C integer-only (UP-4046 Rev 3, sec. 10.4.1, p. 10-8)
PARAMETER (PI=3.141592653589793D0, DR=PI/180.0D0)
CSD = DCOS(DMOD(A, 360.0D0) * DR)
RETURN
END
C
C GMSTAT: Greenwich mean sidereal time (rad) at GET of the current
C scenario; the formula of TSET.
DOUBLE PRECISION FUNCTION GMSTAT(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET
C RESTOMOD BEGIN: GMST of Aoki 1982
GMSTAT = DMOD(280.46061837D0 + 360.98564736629D0 *
& (TJD0 + GET / 86400.0D0 - 2451545.0D0), 360.0D0) * DR
C RESTOMOD END
RETURN
END
C
C MOONV: the Moon's geocentric position P (km) and velocity V
C (km/s) at GET, the velocity by a central difference over 2 s.
SUBROUTINE MOONV(GET, P, V)
DOUBLE PRECISION GET, P(3), V(3), A(3), B(3)
INTEGER I
CALL MOONG(GET, P)
CALL MOONG(GET - 1.0D0, A)
CALL MOONG(GET + 1.0D0, B)
DO 10 I = 1, 3
V(I) = 0.5D0 * (B(I) - A(I))
10 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C PRECM: the IAU 1976 precession matrix P for T Julian centuries
C from J2000 (Lieske 1977; Meeus, Astronomical Algorithms, 2nd ed.,
C eq. 21.3): P carries J2000 equatorial vectors to the mean
C equator and equinox of date, and its transpose (MTXV) back.
C The Earth-fixed frame turns about the pole of date by GMST, so
C Earth-fixed positions (coastlines, the reports' latitudes and
C longitudes) need the transpose to meet our J2000 stars and Moon:
C about 0.43 deg of precession between 1969 and 2000.
C-----------------------------------------------------------------------
SUBROUTINE PRECM(T, P)
DOUBLE PRECISION T, P(3,3), ZT, ZZ, TH, C1, S1, C2, S2, C3, S3
DOUBLE PRECISION AS
C RESTOMOD BEGIN: IAU 1976 precession (Lieske 1977)
AS = 3.141592653589793D0 / 180.0D0 / 3600.0D0
ZT = (2306.2181D0 * T + 0.30188D0 * T**2 + 0.017998D0 * T**3) * AS
ZZ = (2306.2181D0 * T + 1.09468D0 * T**2 + 0.018203D0 * T**3) * AS
TH = (2004.3109D0 * T - 0.42665D0 * T**2 - 0.041833D0 * T**3) * AS
C RESTOMOD END
C1 = DCOS(ZT)
S1 = DSIN(ZT)
C2 = DCOS(ZZ)
S2 = DSIN(ZZ)
C3 = DCOS(TH)
S3 = DSIN(TH)
P(1,1) = C1 * C3 * C2 - S1 * S2
P(1,2) = -S1 * C3 * C2 - C1 * S2
P(1,3) = -S3 * C2
P(2,1) = C1 * C3 * S2 + S1 * C2
P(2,2) = -S1 * C3 * S2 + C1 * C2
P(2,3) = -S3 * S2
P(3,1) = C1 * S3
P(3,2) = -S1 * S3
P(3,3) = C3
RETURN
END
src/lburn.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 10 BURN CUE
C
C Layer element. One relocatable element of the kernel; see
C vdrive.f for the list.
C
C A modern addition throughout (ours). No source we hold shows
C VIEW marking an engine firing: its burn plots (MSC IN 69-FM-197,
C figures 5.1-1, 6.1-1, 7.1-1, PDF pp. 53, 113, 203) show only the
C view out of the window. While a vehicle fires a main engine
C (the firings of /CBRN/: SP-4029's ignition and cutoff rows of the
C scenario's timeline, paired by its BURNCUE cards):
C Exhaust: its placed model gets NPL lines out of the engine's
C exit rim, along the model's -X, opening at APL each side and
C three of the model's lengths long, hidden by the placed solids
C like a free line (LMSEG). Exit planes and radii: the SPS
C nozzle's, as CSMBLD builds it; the others ours (the models
C have no engine bells): the descent engine at the descent
C stage's base, the ascent engine at its top, the J-2 at the
C S-IVB model's aft end.
C Text: in a window or station view from the burning vehicle
C (IRIDE), "SPS BURN", "DPS BURN", "APS BURN" or "S-IVB BURN"
C (the S-IVB's while the CSM rides on it, before the SEP
C event), lettered in the frame's top left corner by TXALL
C with a label level set (in_lablv 1-3).
C Both only with a label level set, so in_lablv 0 keeps the
C picture it had, as with the other cues of the levels.
C No burn attitude is modelled: the exhaust leaves -X of the model
C as the scene places it, so an external view that starts behind
C the CSM looks up its exhaust (a starburst). Not lettered: the
C LM station while the docked CSM fires.
C=======================================================================
SUBROUTINE DBURN(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION XE(4), RE0(4), PL(4), FT, TS, EVGET
INTEGER K, KM, IV, IE, IRIDE, KCSPL, KLMPL, KSIVPL
FT = 0.3048D0
C Per engine (SPS, DPS, APS, J-2): exit plane X and radius (m, in
C the model's body frame), plume length (m). SPS: CSMBLD's nozzle
C exit, 22 in + 12 ft 11 in + 9 ft 8 in aft of the CM's base
C (CSMBLD's XS - XN, its origin 0.457 m above that base),
C radius 3 ft 11.25 in; the CSM 35 ft long (CSMBLD). DPS, APS:
C the descent stage's base (X 0) and top (X 1.7, LMBODY), radii
C 0.75 and 0.4 m, ours; the LM model 4.51 m to its tunnel's top
C (STKPL), the ascent stage 2.81 m of it. J-2: the S-IVB model's
C aft end, 61.3 ft (SIVBMD), radius 1.0 m, ours.
XE(1) = -(22.0D0 / 12.0D0 + 12.0D0 + 11.0D0 / 12.0D0 + 9.0D0
& + 8.0D0 / 12.0D0) * FT
RE0(1) = 0.5D0 * (7.0D0 + 10.5D0 / 12.0D0) * FT
PL(1) = 3.0D0 * 35.0D0 * FT
XE(2) = 0.0D0
RE0(2) = 0.75D0
PL(2) = 3.0D0 * 4.51D0
XE(3) = 1.7D0
RE0(3) = 0.4D0
PL(3) = 3.0D0 * 2.81D0
XE(4) = -(SIVBH + SIUH) * FT
RE0(4) = 1.0D0
PL(4) = 3.0D0 * (SIVBH + SIUH) * FT
IBRTX = 0
IF (ILABL .LT. 1) RETURN
DO 50 K = 1, NBR
IF (BRSN(K) .NE. ISN) GO TO 50
IF (GET .LT. BRT1(K) .OR. GET .GE. BRT2(K)) GO TO 50
IV = BRVH(K)
IE = BREN(K)
C The text, from the vehicle the camera rides.
IF (IVUSE .EQ. 1) GO TO 20
IF (IV .EQ. IRIDE()) IBRTX = IE
TS = EVGET(KESEP)
IF (IV .EQ. 3 .AND. IRIDE() .EQ. 1 .AND. TS .GE. 0.0D0
& .AND. GET .LT. TS) IBRTX = IE
C The exhaust, from the vehicle's placed model.
20 KM = 0
IF (IV .EQ. 1) KM = KCSPL()
IF (KM .EQ. KCMO) KM = 0
IF (IV .EQ. 2) KM = KLMPL()
IF (IV .EQ. 3) KM = KSIVPL()
IF (KM .NE. 0) CALL PLUME(VB, NV, KM, XE(IE), RE0(IE), PL(IE))
50 CONTINUE
ISTYLE = 1
RETURN
END
C
C-----------------------------------------------------------------------
C PLUME: the exhaust of placed model K: NPL lines from the rim of
C radius R0 in the plane X = XE of its body frame (m) back along
C -X for length PLEN, opening at APL deg (ours: 8 lines, 10 deg).
C-----------------------------------------------------------------------
SUBROUTINE PLUME(VB, NV, K, XE, R0, PLEN)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), XE, R0, PLEN
INTEGER NV, K
DOUBLE PRECISION APL, C, S, R1, BA(3), BB(3), A(3), B(3), W(3)
INTEGER NPL, J, I
NPL = 8
APL = 10.0D0
R1 = R0 + PLEN * DTAN(APL * DR)
DO 30 J = 1, NPL
C = DCOS(2.0D0 * PI * DBLE(J) / DBLE(NPL))
S = DSIN(2.0D0 * PI * DBLE(J) / DBLE(NPL))
CALL SETV(BA, XE - MDBO(1,K), R0 * C - MDBO(2,K),
& R0 * S - MDBO(3,K))
CALL SETV(BB, XE - PLEN - MDBO(1,K), R1 * C - MDBO(2,K),
& R1 * S - MDBO(3,K))
CALL MXV(MDAT(1,1,K), BA, W)
DO 10 I = 1, 3
A(I) = MDP(I,K) + W(I) * 1.0D-3
10 CONTINUE
CALL MXV(MDAT(1,1,K), BB, W)
DO 20 I = 1, 3
B(I) = MDP(I,K) + W(I) * 1.0D-3
20 CONTINUE
CALL LMSEG(VB, NV, A, B, 0, 0)
30 CONTINUE
RETURN
END
src/lcoas.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 7 COAS RETICLE
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C S7COAS: the COAS cross hairs, fixed to the CSM. TN D-6853
C (printed p. 12): "Command module and LM windows and optics
C outlines can be simulated." The reticle's pattern and size here
C are our guess: a cross +-6 deg, open in the middle so the target
C shows.
SUBROUTINE S7COAS(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
IVMODE = 0
ISTYLE = 1
CALL OVLINE(VB, NV, -6.0D0, 0.0D0, -1.0D0, 0.0D0)
CALL OVLINE(VB, NV, 1.0D0, 0.0D0, 6.0D0, 0.0D0)
CALL OVLINE(VB, NV, 0.0D0, -6.0D0, 0.0D0, -1.0D0)
CALL OVLINE(VB, NV, 0.0D0, 1.0D0, 0.0D0, 6.0D0)
RETURN
END
src/learth.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 5 EARTH
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C EARTH. Limb, coastlines (Natural Earth, turned by GMST), the
C terminator, and the night side hatched with meridians every
C 10 deg. Everything behind the Moon is dropped.
C=======================================================================
SUBROUTINE DEARTH(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION D, AE, C(3), U(3), P(3), Q(3), X, Y, VNRM
DOUBLE PRECISION OCCL
INTEGER I, K, J, IOK, IP, LMOCC
D = VNRM(EPOS)
IF (D .LE. RE * 1.0001D0) RETURN
AE = DASIN(RE / D)
DO 10 I = 1, 3
U(I) = EPOS(I) / D
C(I) = -U(I)
10 CONTINUE
IF (U(1)*CB(1) + U(2)*CB(2) + U(3)*CB(3) .LT.
& DCOS(DMIN1(THVIEW * DR + AE, PI))) RETURN
C
C Limb.
IVMODE = 2
CALL CIRCLE(VB, NV, EPOS, RE, C, DACOS(RE / D), 360)
C
C Coastlines.
IVMODE = 1
DO 30 K = 1, NCST
IP = 0
DO 20 J = KCST(K), KCST(K+1) - 1
CALL MXV(MEF, CEV(1,J), Q)
DO 15 I = 1, 3
P(I) = EPOS(I) + RE * Q(I)
15 CONTINUE
CALL PEN(VB, NV, P, IP)
IP = 1
20 CONTINUE
30 CONTINUE
C
C Terminator.
CALL CIRCLE(VB, NV, EPOS, RE, SUNU, 0.5D0 * PI, 180)
C
C Night side shading (SHADE), unless the situation turns it off
C (JDRW bit 1: from low orbit, where the film shows none).
IF (MOD(JDRW, 2) .EQ. 0) CALL SHADE(VB, NV, EPOS, RE, 4)
IVMODE = 0
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (MOD(IFLG, 2) .EQ. 1 .AND. AE .LT. 0.3D0 * FOVH * DR) THEN
CALL PROJ(EPOS, X, Y, IOK)
IF (IOK .EQ. 1) THEN
IF (OCCL(EPOS, MPOS, RM) .LE. 0.0D0) THEN
IF (NACT .EQ. 0 .OR. LMOCC(EPOS, 0) .EQ. 0)
& CALL LABEL(LB, NL, X, Y, 4, 0)
END IF
END IF
END IF
C RESTOMOD END
C The launch pad, with a label level set, once the disc is too big
C to carry the EARTH name (DPAD; the rule is ours).
IF (ILABL .GE. 1 .AND. AE .GE. 0.3D0 * FOVH * DR)
& CALL DPAD(VB, NV, LB, NL)
RETURN
END
C
C-----------------------------------------------------------------------
C DPAD: the scenario's launch pad (its PAD card) as a small boxed
C X, the mark the Moon view gives the Apollo 11 landing site
C (DMOON6), and its name (LB kind 9) beside it. A modern
C addition (ours), drawn only with a label level set (in_lablv
C 1-3; DEARTH), at the pad's place on the drawn Earth (PADEF).
C Hidden on the Earth's far side and behind the Moon or a placed
C model (ISVIS mode 1).
C-----------------------------------------------------------------------
SUBROUTINE DPAD(VB, NV, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), LB(4,MAXL)
INTEGER NV, NL
DOUBLE PRECISION U(3), EN(3), Q(3), P(3), X, Y, W, H, D, R(3)
DOUBLE PRECISION C(3), AT(3,3)
INTEGER I, IOK, ISVIS
CALL PADEF(U, EN, IOK)
IF (IOK .EQ. 0) RETURN
CALL MXV(MEF, U, Q)
DO 10 I = 1, 3
P(I) = EPOS(I) + RE * Q(I)
10 CONTINUE
C Where the launch complex is placed (vdrive.f PADPL) it stands for
C the mark: the name alone, 20 ft above the umbilical tower's top,
C on the complex's own foot (PADAX; ours).
IF (MDON(KPAD) .EQ. 0) GO TO 20
DO 12 I = 1, 3
C(I) = -EPOS(I)
12 CONTINUE
CALL PADAX(C, AT, R, IOK)
H = (MNDH + MLPED + MLBH + LUTH + 20.0D0) * 0.3048D-3
D = LUTZ * 0.3048D-3
DO 15 I = 1, 3
P(I) = R(I) + H * AT(I,1) - D * AT(I,3)
15 CONTINUE
20 CONTINUE
IF (P(1)*CB(1) + P(2)*CB(2) + P(3)*CB(3) .LE. 0.0D0) RETURN
IVMODE = 1
IF (ISVIS(P) .EQ. 0) GO TO 90
CALL PROJ(P, X, Y, IOK)
IF (IOK .EQ. 0) GO TO 90
W = 0.012D0 * FOVH
IF (MDON(KPAD) .EQ. 0) CALL BOXX(VB, NV, X, Y, W)
IF (ILEV .GE. 1) CALL LABEL(LB, NL, X + W, Y + W, 9, 0)
90 IVMODE = 0
RETURN
END
C
C-----------------------------------------------------------------------
C PADEF: the scenario's launch pad (its PAD card) on the drawn
C Earth, Earth fixed: U the unit vector up to it, EN the unit
C vector north there; IOK 0 if the scenario has no pad. The
C coastlines are geodetic latitudes placed on a sphere and turned
C with the Earth (MEF, VFRAME), so the pad goes on the same
C footing: a geocentric latitude is made geodetic first, TAN(GD) =
C TAN(GC) / (1 - F)**2, F the flattening STATEV uses. DPAD's mark
C and the launch complex (vdrive.f PADAX) stand there.
C-----------------------------------------------------------------------
SUBROUTINE PADEF(U, EN, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION U(3), EN(3), F, FI, LA
INTEGER IOK
IOK = 0
IF (PADCH(8 * (ISN - 1) + 1) .EQ. 0) RETURN
IOK = 1
F = 1.0D0 / 298.257D0
FI = SNPLA(ISN) * DR
IF (SNPGC(ISN) .EQ. 1) FI = DATAN(DTAN(FI) / (1.0D0 - F)**2)
LA = SNPLO(ISN) * DR
U(1) = DCOS(FI) * DCOS(LA)
U(2) = DCOS(FI) * DSIN(LA)
U(3) = DSIN(FI)
EN(1) = -DSIN(FI) * DCOS(LA)
EN(2) = -DSIN(FI) * DSIN(LA)
EN(3) = DCOS(FI)
RETURN
END
src/lframe.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 1 PLOT FRAME
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C PLOT FRAME. Box at the field edge, ticks inward every 5 deg
C up to a 25 deg field, 10 deg up to 60, else 20 deg, at
C multiples of the step from 0 (the page letters those values).
C=======================================================================
SUBROUTINE DFRAME(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION ST, TL, B, X
INTEGER K, N
C Only when IFLG bit 1 (frame and ticks) is set.
IF (MOD(IFLG / 2, 2) .NE. 1) RETURN
B = BOXH
ST = 20.0D0
IF (2.0D0 * B .LE. 60.0D0) ST = 10.0D0
IF (2.0D0 * B .LE. 25.0D0) ST = 5.0D0
TL = 0.02D0 * B
CALL EMIT(VB, NV, -B, -B, B, -B)
CALL EMIT(VB, NV, B, -B, B, B)
CALL EMIT(VB, NV, B, B, -B, B)
CALL EMIT(VB, NV, -B, B, -B, -B)
N = INT(B / ST + 1.0D-9)
DO 30 K = -N, N
X = DBLE(K) * ST
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (DABS(X) .LT. B - 1.0D-9) THEN
CALL EMIT(VB, NV, X, -B, X, -B + TL)
CALL EMIT(VB, NV, X, B, X, B - TL)
CALL EMIT(VB, NV, -B, X, -B + TL, X)
CALL EMIT(VB, NV, B, X, B - TL, X)
END IF
C RESTOMOD END
30 CONTINUE
RETURN
END
src/llpd.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 9 LPD AND LM WINDOW
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C LM FRONT WINDOW OVERLAY. Landing point designator scale and the
C commander's window frame, fixed to the LM (drawn in reference
C plot degrees, so they move with free-look). TN D-6853 (printed
C p. 7) says the LPD and scribe marks came from LM window
C engineering drawings; we do not have them.
C The LPD marks "elevation angles measured sequentially down from
C a reference line that is parallel to the LEM axis" (MSC IN
C 65-EG-52, Cheatham and Steele, NTRS 19700024922, printed p. 1);
C its Fig. 2(b) draws that 0 deg line along the Z axis. Grumman's
C drawing (LM structures study guide, 1967, printed p. 36, Fig.
C 26, "LANDING POINT DESIGNATOR") numbers it 0 to 60 every 10 deg
C with a mark every 2, and crosses it at 0 with a bar marked 5 and
C 10 each side. The film's scale (film seconds 29-35, reference/
C video_frames/descent_t*.png, 60 px per 10 deg from the edge
C numbers, Y = 0 at the left "0" labels) is that scale: symmetric
C marks every 2 deg, a longer mark to the right every 10, a bar
C with marks at 5 and 10 at the top. Its 29 marks from 0 to 58
C lie at
C Y = LPDK tan(LPDDN - L), LPDDN 30.2 deg, LPDK 49.8,
C to 0.05 deg rms (our fit), so the boresight is 30.2 deg below
C the LM's +Z. A gnomonic plot from the eye would have LPDK
C 57.3; 0.87 of it is what an eye about 15 per cent further from
C the window than the scale's design eye would see (our guess).
C Ours from the film: the lower bar at 50 (the film's sits 0.7
C deg lower), +-7.5 deg with end ticks down; the scale line from
C -6 to the sill; the window, sill near Y = -35 and the right
C edge as two lines to the frame top (the film's frame is cut at
C Y = +41).
C=======================================================================
SUBROUTINE OVLPD(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION Y, WX(9), WY(9), YU, YL, XT, A, YLPD
INTEGER K, J
C Plot Y of LPD angle A (deg).
YLPD(A) = LPDK * DTAN((LPDDN - A) * DR)
IVMODE = 0
ISTYLE = 1
YU = YLPD(0.0D0)
YL = YLPD(50.0D0)
CALL OVLINE(VB, NV, 0.0D0, YLPD(-6.0D0), 0.0D0, -35.5D0)
DO 10 J = -3, 32
IF (J .EQ. 0 .OR. J .EQ. 25) GO TO 10
Y = YLPD(2.0D0 * DBLE(J))
IF (Y .LT. -35.0D0) GO TO 10
IF (MOD(J, 5) .NE. 0 .OR. J .LT. 0) GO TO 8
CALL OVLINE(VB, NV, 0.0D0, Y, 2.5D0, Y)
GO TO 10
8 CALL OVLINE(VB, NV, -0.6D0, Y, 0.6D0, Y)
10 CONTINUE
C Upper bar at 0, marks up at 5 and 10 deg each side of the LPD's
C plane, its ends at 10.
XT = LPDK * DTAN(10.0D0 * DR) / DCOS(LPDDN * DR)
CALL OVLINE(VB, NV, -XT, YU, XT, YU)
DO 20 K = -2, 2
XT = LPDK * DTAN(5.0D0 * DBLE(K) * DR) / DCOS(LPDDN * DR)
IF (K .NE. 0) CALL OVLINE(VB, NV, XT, YU, XT, YU + 1.3D0)
20 CONTINUE
C Lower bar with end ticks down.
CALL OVLINE(VB, NV, -7.5D0, YL, 7.5D0, YL)
CALL OVLINE(VB, NV, -7.5D0, YL, -7.5D0, YL - 1.5D0)
CALL OVLINE(VB, NV, 7.5D0, YL, 7.5D0, YL - 1.5D0)
C Window frame: sill, then the right-hand edge as two lines.
WX(1) = -60.0D0
WY(1) = -34.8D0
WX(2) = -30.0D0
WY(2) = -34.5D0
WX(3) = -12.0D0
WY(3) = -35.3D0
WX(4) = -1.0D0
WY(4) = -35.7D0
WX(5) = 13.4D0
WY(5) = 38.0D0
WX(6) = 10.0D0
WY(6) = 40.5D0
DO 40 K = 1, 5
CALL OVLINE(VB, NV, WX(K), WY(K), WX(K+1), WY(K+1))
40 CONTINUE
WX(1) = -1.0D0
WY(1) = -35.7D0
WX(2) = 2.0D0
WY(2) = -33.5D0
WX(3) = 5.5D0
WY(3) = -27.0D0
WX(4) = 16.0D0
WY(4) = 37.0D0
WX(5) = 15.5D0
WY(5) = 38.5D0
WX(6) = 10.0D0
WY(6) = 40.5D0
DO 50 K = 1, 5
CALL OVLINE(VB, NV, WX(K), WY(K), WX(K+1), WY(K+1))
50 CONTINUE
RETURN
END
src/lmoon.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 4 MOON AND CRATERS
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C MOON. Limb (the horizon when close), gazetteer craters, and
C near the surface seeded small craters.
C=======================================================================
SUBROUTINE DMOON(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION D, AM, C(3), U(3), H, HOR, X, Y, OCCL, VNRM
DOUBLE PRECISION G(3), Q(3), CA
INTEGER I, IOK, K
D = VNRM(MPOS)
IF (D .LE. RM * 1.000001D0) RETURN
AM = DASIN(RM / D)
DO 10 I = 1, 3
U(I) = MPOS(I) / D
C(I) = -U(I)
10 CONTINUE
IF (U(1)*CB(1) + U(2)*CB(2) + U(3)*CB(3) .LT.
& DCOS(DMIN1(THVIEW * DR + AM, PI))) RETURN
H = D - RM
HOR = DACOS(RM / D)
C
C Limb.
IVMODE = 5
CALL CIRCLE(VB, NV, MPOS, RM, C, HOR, 720)
C
C Gazetteer craters inside the visible cap.
IVMODE = 3
CA = DCOS(DMIN1(HOR + 0.05D0, PI))
DO 20 K = 1, NCRAT
IF (CRV(1,K)*CAMF(1) + CRV(2,K)*CAMF(2) + CRV(3,K)*CAMF(3)
& .LT. CA * D) GO TO 20
C Whole-disc view: gazetteer craters of 25 km and up only (our
C floor, so the disc is not a solid mass), unlabelled.
IF (MOD(JDRW / 2, 2) .EQ. 1 .AND. CRDIA(K) .LT. 25.0D0)
& GO TO 20
CALL CRATER(VB, NV, CRV(1,K), 0.5D0 * CRDIA(K) / RM, IOK)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IOK .EQ. 1 .AND. CRDIA(K) .GE. 20.0D0 .AND.
& MOD(IFLG, 2) .EQ. 1 .AND. MOD(JDRW / 2, 2) .EQ. 0) THEN
DO 15 I = 1, 3
G(I) = RM * CRV(I,K)
15 CONTINUE
CALL MXV(MMF, G, Q)
DO 16 I = 1, 3
Q(I) = Q(I) + MPOS(I)
16 CONTINUE
CALL PROJ(Q, X, Y, IOK)
CALL LABEL(LB, NL, X, Y, 2, K)
END IF
C RESTOMOD END
20 CONTINUE
C
C Seeded craters, a FIXED set on the ground (no level of detail
C by range). Sources: VIEW had "two-dimensional crater models"
C built from photographs of the area near Apollo landing site 2
C (TN D-6853, printed p. 7), and "the smallest craters depicted
C ... have a size of 1 minute of arc (1658 ft)" (MSC IN
C 69-FM-197, sec. 3.1). Our model of that, not the original:
C regional patch, site 2 (see DMOON6) +-5 deg, cells of
C 0.1 deg, craters 1658 ft (0.505 km) to 4 km, where the
C gazetteer takes over;
C global fill elsewhere, cells of 0.5 deg, 2.5 to 25 km, so
C orbital views keep the density the film shows (t04).
C The IN (sec. 3.6, 3.7) notes few craters near the site, from
C the flat approach, the oblique look and few large craters;
C the patch density is set low to match. Cells are seeded from
C their indices, so craters stay put from frame to frame.
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (MOD(JDRW / 2, 2) .EQ. 1) THEN
CALL DMOON6(VB, NV, LB, NL)
ELSE
CALL PCRAT(VB, NV, 0.5D0, 1.2D0, 2.5D0, 25.0D0, 1,
& -90.0D0, 90.0D0, -180.0D0, 180.0D0, 1)
CALL PCRAT(VB, NV, 0.1D0, 0.8D0, 0.505D0, 4.0D0, 2,
& 0.67416D0 - 5.0D0, 0.67416D0 + 5.0D0,
& 23.47314D0 - 5.0D0, 23.47314D0 + 5.0D0, 0)
END IF
C RESTOMOD END
IVMODE = 0
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (MOD(IFLG, 2) .EQ. 1 .AND. AM .LT. 0.3D0 * FOVH * DR) THEN
CALL PROJ(MPOS, X, Y, IOK)
IF (IOK .EQ. 1) THEN
IF (OCCL(MPOS, EPOS, RE) .LE. 0.0D0)
& CALL LABEL(LB, NL, X, Y, 5, 0)
END IF
END IF
C RESTOMOD END
RETURN
END
C
C LLUNIT: selenographic latitude, east longitude (deg) to a unit
C vector (MF). SURFPT: unit MF direction to the surface point,
C camera relative EQ.
SUBROUTINE LLUNIT(FI, LA, U)
DOUBLE PRECISION FI, LA, U(3), DR
DR = 3.141592653589793D0 / 180.0D0
U(1) = DCOS(FI * DR) * DCOS(LA * DR)
U(2) = DCOS(FI * DR) * DSIN(LA * DR)
U(3) = DSIN(FI * DR)
RETURN
END
C
SUBROUTINE SURFPT(CM, P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION CM(3), P(3), G(3)
INTEGER I
DO 10 I = 1, 3
G(I) = RM * CM(I)
10 CONTINUE
CALL MXV(MMF, G, P)
DO 20 I = 1, 3
P(I) = P(I) + MPOS(I)
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C CRATER: rim circle of angular radius A (rad) about unit centre
C CM (MF). Culled when off frame, beyond the horizon or too small
C to see. IOK = 1 if drawn.
C-----------------------------------------------------------------------
SUBROUTINE CRATER(VB, NV, CM, A, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), CM(3), A
INTEGER NV, IOK
DOUBLE PRECISION D(3), DD, RA, CS, E1(3), E2(3), G(3), P(3)
DOUBLE PRECISION CA, SA, T, CT, ST, SIZ
INTEGER I, K, N
IOK = 0
DO 10 I = 1, 3
D(I) = RM * CM(I) - CAMF(I)
10 CONTINUE
DD = DSQRT(D(1)*D(1) + D(2)*D(2) + D(3)*D(3))
RA = RM * A / DD
C Apparent diameter against the field. Rims under 1.2 percent
C of the frame (about 12 points of a 1024-point recorder raster,
C docs/univac-1108.md) are not drawn: our choice of floor.
SIZ = 2.0D0 * RA / DR / (2.0D0 * FOVH)
IF (SIZ .LT. 0.012D0) RETURN
C Outside the cone through the frame corners (COS(T+RA) is at
C least COS(T) - RA).
CS = (D(1)*CBMF(1) + D(2)*CBMF(2) + D(3)*CBMF(3)) / DD
IF (CS .LT. CSVIEW - RA) RETURN
N = 10 + INT(SIZ * 60.0D0)
IF (N .GT. 36) N = 36
CALL PERP(CM, E1, E2)
CA = DCOS(A) * RM
SA = DSIN(A) * RM
DO 30 K = 0, N
T = DBLE(K) * 2.0D0 * PI / DBLE(N)
CT = DCOS(T) * SA
ST = DSIN(T) * SA
DO 20 I = 1, 3
G(I) = CA * CM(I) + CT * E1(I) + ST * E2(I)
20 CONTINUE
CALL MXV(MMF, G, P)
DO 25 I = 1, 3
P(I) = P(I) + MPOS(I)
25 CONTINUE
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (K .EQ. 0) THEN
CALL PEN(VB, NV, P, 0)
ELSE
CALL PEN(VB, NV, P, 1)
END IF
C RESTOMOD END
30 CONTINUE
IOK = 1
RETURN
END
C
C-----------------------------------------------------------------------
C PCRAT: seeded craters on a latitude-longitude grid of GC deg,
C inside the fixed box F1..F2 lat, L1..L2 east lon (deg); IEXC=1
C skips cells inside the site 2 patch (drawn by its own level).
C AVG mean craters per cell, diameters DMIN..DMAX km with a -2
C power law. Only cells under a 7 x 7 grid of sight lines across
C the frame are visited, and only craters on the near side of the
C horizon are drawn: culling by visibility, not by range. More
C than 40000 cells in view is taken as "Moon too small to show
C seeded craters" (every one would fall under the size floor in
C CRATER). Random numbers: Park-Miller minimal standard
C generator, exact in double precision.
C-----------------------------------------------------------------------
SUBROUTINE PCRAT(VB, NV, GC, AVG, DMIN, DMAX, LEV,
& F1, F2, L1, L2, IEXC)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), GC, AVG, DMIN, DMAX
DOUBLE PRECISION F1, F2, L1, L2, P1, CH, DCAM, FC, LC, CFR
INTEGER NV, LEV, IEXC
DOUBLE PRECISION U(3), W(3), GP(3), B, C, DS, T, FI, DL, LO0
DOUBLE PRECISION FMIN, FMAX, LMIN, LMAX, MARG, SEED, RND
DOUBLE PRECISION CLAT0, CLON0, CF, DIA, CM(3), Q
INTEGER I, J, K, IA, IB, JA, JB, NLON, JJ, NC, IOK, IFLR
C
C The size floor of CRATER applied to the largest crater of this
C level at the nearest ground: if even that is too small, stop.
DCAM = DSQRT(CAMF(1)**2 + CAMF(2)**2 + CAMF(3)**2)
IF (DMAX / (DCAM - RM) / DR / (2.0D0 * FOVH) .LT. 0.012D0) RETURN
LO0 = DATAN2(CAMF(2), CAMF(1)) / DR
FMIN = 90.0D0
FMAX = -90.0D0
LMIN = 180.0D0
LMAX = -180.0D0
C = CAMF(1)**2 + CAMF(2)**2 + CAMF(3)**2 - RM * RM
DO 20 I = 0, 6
DO 10 J = 0, 6
CALL UNPROJ(BOXH * DBLE(I - 3) / 3.0D0,
& BOXH * DBLE(J - 3) / 3.0D0, 0, W)
CALL MTXV(MMF, W, U)
B = U(1) * CAMF(1) + U(2) * CAMF(2) + U(3) * CAMF(3)
DS = B * B - C
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (DS .GE. 0.0D0 .AND. -B - DSQRT(DS) .GT. 0.0D0) THEN
T = -B - DSQRT(DS)
ELSE
T = -B
IF (T .LT. 0.0D0) T = 0.0D0
END IF
C RESTOMOD END
DO 5 K = 1, 3
GP(K) = CAMF(K) + T * U(K)
5 CONTINUE
CALL VUNIT(GP)
FI = DASIN(GP(3)) / DR
DL = DATAN2(GP(2), GP(1)) / DR - LO0
IF (DL .GT. 180.0D0) DL = DL - 360.0D0
IF (DL .LT. -180.0D0) DL = DL + 360.0D0
FMIN = DMIN1(FMIN, FI)
FMAX = DMAX1(FMAX, FI)
LMIN = DMIN1(LMIN, DL)
LMAX = DMAX1(LMAX, DL)
10 CONTINUE
20 CONTINUE
C Take in the ground under the camera too, then pad.
FI = DASIN(CAMF(3) / DSQRT(C + RM * RM)) / DR
FMIN = DMIN1(FMIN, FI)
FMAX = DMAX1(FMAX, FI)
LMIN = DMIN1(LMIN, 0.0D0)
LMAX = DMAX1(LMAX, 0.0D0)
MARG = 0.5D0 * DMAX / RM / DR + GC
FMIN = DMAX1(FMIN - MARG, -89.0D0)
FMAX = DMIN1(FMAX + MARG, 89.0D0)
LMIN = LMIN - MARG / DMAX1(DCOS(DMAX1(DABS(FMIN),
& DABS(FMAX)) * DR), 0.05D0)
LMAX = LMAX + MARG /
& DMAX1(DCOS(DMAX1(DABS(FMIN), DABS(FMAX)) * DR), 0.05D0)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (LMAX - LMIN .GT. 360.0D0) THEN
LMIN = -180.0D0
LMAX = 180.0D0
END IF
C RESTOMOD END
C Clip to the fixed box of this level.
FMIN = DMAX1(FMIN, F1)
FMAX = DMIN1(FMAX, F2)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (L2 - L1 .LT. 360.0D0) THEN
P1 = DMOD(L1 - LO0 + 540.0D0, 360.0D0) - 180.0D0
LMIN = DMAX1(LMIN, P1)
LMAX = DMIN1(LMAX, P1 + (L2 - L1))
END IF
C RESTOMOD END
IF (FMIN .GT. FMAX .OR. LMIN .GT. LMAX) RETURN
DCAM = DSQRT(C + RM * RM)
CH = RM / DCAM
IA = IFLR((FMIN + 90.0D0) / GC)
IB = IFLR((FMAX + 90.0D0) / GC)
JA = IFLR((LO0 + LMIN + 180.0D0) / GC)
JB = IFLR((LO0 + LMAX + 180.0D0) / GC)
IF (DBLE(IB - IA + 1) * DBLE(JB - JA + 1) .GT. 40000.0D0) RETURN
NLON = NINT(360.0D0 / GC)
DO 60 I = IA, IB
C Thin the cells toward the poles, where they shrink in area.
CFR = DCOS((DBLE(I) + 0.5D0) * GC * DR - 0.5D0 * PI)
DO 50 J = JA, JB
JJ = MOD(J, NLON)
IF (JJ .LT. 0) JJ = JJ + NLON
C Seed from both cell indices through a nonlinear mix (the
C fraction of a square), so neighbouring cells do not start the
C linear generator on a lattice (that showed as crater rows).
Q = DBLE(I) * 0.6180339887D0 + DBLE(JJ) * 0.7548776662D0
& + DBLE(LEV) * 0.5698402910D0
Q = DMOD(Q * Q * 7919.0D0, 1.0D0)
C RESTOMOD: seed for the Park-Miller generator (1988)
SEED = 1.0D0 + DBLE(INT(Q * 2147483645.0D0))
Q = RND(SEED)
NC = INT(RND(SEED) * (2.0D0 * AVG + 1.0D0))
CLAT0 = DBLE(I) * GC - 90.0D0
CLON0 = DBLE(JJ) * GC - 180.0D0
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IEXC .EQ. 1) THEN
FC = CLAT0 + 0.5D0 * GC - 0.67416D0
LC = CLON0 + 0.5D0 * GC - 23.47314D0
IF (DABS(FC) .LT. 5.0D0 .AND. DABS(LC) .LT. 5.0D0) GO TO 50
END IF
C RESTOMOD END
DO 40 K = 1, NC
FI = (CLAT0 + RND(SEED) * GC) * DR
DL = (CLON0 + RND(SEED) * GC) * DR
Q = RND(SEED)
CF = RND(SEED)
IF (Q .GT. CFR) GO TO 40
DIA = DMIN / DSQRT(1.0D0 - CF * (1.0D0 - (DMIN/DMAX)**2))
CM(1) = DCOS(FI) * DCOS(DL)
CM(2) = DCOS(FI) * DSIN(DL)
CM(3) = DSIN(FI)
C Near side of the horizon only (centre within the cap
C seen from the camera, padded by the crater's radius).
IF ((CM(1)*CAMF(1) + CM(2)*CAMF(2) + CM(3)*CAMF(3)) / DCAM
& .LT. CH - 0.5D0 * DIA / RM) GO TO 40
CALL CRATER(VB, NV, CM, 0.5D0 * DIA / RM, IOK)
40 CONTINUE
50 CONTINUE
60 CONTINUE
RETURN
END
C
DOUBLE PRECISION FUNCTION RND(SEED)
DOUBLE PRECISION SEED
C RESTOMOD BEGIN: Park-Miller minimal standard generator, 1988
SEED = DMOD(16807.0D0 * SEED, 2147483647.0D0)
RND = SEED / 2147483647.0D0
C RESTOMOD END
RETURN
END
C
INTEGER FUNCTION IFLR(X)
DOUBLE PRECISION X
IFLR = INT(X)
IF (DBLE(IFLR) .GT. X) IFLR = IFLR - 1
RETURN
END
src/lmoon6.f
C=======================================================================
C
C V I E W - 1 1 0 8 MOON VIEW
C
C Part of layer 4: the whole-disc Moon view's extras,
C called by DMOON in scene 6. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C-----------------------------------------------------------------------
C DMOON6: the whole-disc Moon view's extras. Terminator; night
C side shading as for the Earth (TN D-6853, printed p. 8); maria,
C lacus, sinus and oceanus from the IAU gazetteer, which gives
C only a centre and a diameter, so each is drawn as a circle of
C that diameter, not its true outline; the Apollo 11 landing site
C as a small boxed X. Labels (LB kind 6 = mare, id its index;
C kind 7 = landing site) when IFLG bit 0 is set.
C-----------------------------------------------------------------------
SUBROUTINE DMOON6(VB, NV, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), LB(4,MAXL)
INTEGER NV, NL
DOUBLE PRECISION CM(3), P(3), X, Y, W, DCAM, HN, WD
DOUBLE PRECISION XA(64), XB(64), YA(64), YB(64)
INTEGER I, K, IOK, ISVIS, NP, NC
IVMODE = 3
CALL CIRCLE(VB, NV, MPOS, RM, SUNU, 0.5D0 * PI, 360)
CALL SHADE(VB, NV, MPOS, RM, 6)
DCAM = DSQRT(CAMF(1)**2 + CAMF(2)**2 + CAMF(3)**2)
C Labels placed so far, as text rectangles in plot deg (0.7 name
C height per character wide, one name height tall, the extents
C TXALL will give them), for the clutter test: a label whose
C rectangle meets one already placed is dropped. Our rule.
NP = 0
HN = 0.028D0 * FOVH
C Apollo 11 landing site, first so its label always wins. The
C 1969 reports call it "landing site 2" (MSC IN 69-FM-197). LM
C position 0.67416 N, 23.47314 E, planetocentric Mean Earth/Polar
C Axis (DE421), from LRO images: NSSDC, "Apollo Landing Site
C Coordinates", https://nssdc.gsfc.nasa.gov/planetary/lunar/
C lunar_sites.html, citing Wagner et al., Icarus 283, 92-103
C (2017). The same values are in the run deck's SITE card (for
C the descent) and in the crater patch (lmoon.f).
IVMODE = 3
CALL LLUNIT(0.67416D0, 23.47314D0, CM)
CALL SURFPT(CM, P)
IF (ISVIS(P) .EQ. 0) GO TO 10
CALL PROJ(P, X, Y, IOK)
W = 0.012D0 * FOVH
CALL BOXX(VB, NV, X, Y, W)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (MOD(IFLG, 2) .EQ. 1) THEN
CALL LABEL(LB, NL, X + W, Y + W, 7, 0)
NP = 1
XA(1) = X + W + 0.4D0 * HN
XB(1) = XA(1) + 0.7D0 * HN * 22.0D0
YA(1) = Y + W + 0.4D0 * HN
YB(1) = YA(1) + HN
END IF
C RESTOMOD END
C Maria etc., largest first (the table is sorted by diameter).
C All are drawn; only a mare or oceanus of any size, or another
C feature of 150 km or more, is labelled (our clutter rule).
10 DO 30 K = 1, NMARE
CALL LLUNIT(MRLAT(K), MRLON(K), CM)
CALL CRATER(VB, NV, CM, 0.5D0 * MRDIA(K) / RM, IOK)
IF (MOD(IFLG, 2) .EQ. 0) GO TO 30
IF (MRDIA(K) .LT. 150.0D0 .AND. MRCH((K - 1) * 24 + 1) .NE. 77
& .AND. MRCH((K - 1) * 24 + 1) .NE. 79) GO TO 30
IF (CM(1)*CAMF(1) + CM(2)*CAMF(2) + CM(3)*CAMF(3)
& .LT. RM * RM / DCAM) GO TO 30
CALL SURFPT(CM, P)
CALL PROJ(P, X, Y, IOK)
C Name length, then its rectangle, centred on the point.
NC = 0
DO 15 I = 1, 24
IF (MRCH((K - 1) * 24 + I) .EQ. 0) GO TO 16
NC = NC + 1
15 CONTINUE
16 WD = 0.35D0 * HN * DBLE(NC)
DO 20 I = 1, NP
IF (X - WD .LT. XB(I) .AND. X + WD .GT. XA(I) .AND.
& Y - 0.5D0 * HN .LT. YB(I) .AND. Y + 0.5D0 * HN .GT. YA(I))
& GO TO 30
20 CONTINUE
CALL LABEL(LB, NL, X, Y, 6, K)
IF (NP .GE. 64) GO TO 30
NP = NP + 1
XA(NP) = X - WD
XB(NP) = X + WD
YA(NP) = Y - 0.5D0 * HN
YB(NP) = Y + 0.5D0 * HN
30 CONTINUE
IVMODE = 0
RETURN
END
src/lshad.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 8 LM SHADOW
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C-----------------------------------------------------------------------
C LMSHAD: the LM's shadow on the ground in the descent. Every
C vertex of the LM wireframe (model KLMD, MLIB) is carried along
C the Sun's
C direction to the lunar sphere and the edges are drawn there as a
C surface feature (facing test, so it hides below the horizon and
C foreshortens like a crater). The film shows a small LM-shaped
C figure below the horizon late in the descent (descent_t35.png);
C that it is the shadow is our reading. The model's pads (X =
C -1.1 m, LMGEAR) sit at the footpads, LMEYE below the eye.
C-----------------------------------------------------------------------
SUBROUTINE LMSHAD(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION PMF(3), XB(3), YB(3), ZB(3), SMF(3), V(3)
DOUBLE PRECISION A(3), B(3)
INTEGER IS, J, K, IOK
CALL LMDESC(GET, PMF, XB, YB, ZB)
CALL MTXV(MMF, SUNU, SMF)
IVMODE = 3
ISTYLE = 1
DO 20 IS = MDS1(KLMD), MDS2(KLMD)
DO 10 J = 1, NLE(IS)
DO 5 K = 1, 3
V(K) = LMV(K,LME(1,J,IS),IS)
5 CONTINUE
CALL SHADPT(V, PMF, XB, YB, ZB, SMF, A, IOK)
IF (IOK .EQ. 0) GO TO 10
DO 6 K = 1, 3
V(K) = LMV(K,LME(2,J,IS),IS)
6 CONTINUE
CALL SHADPT(V, PMF, XB, YB, ZB, SMF, B, IOK)
IF (IOK .EQ. 0) GO TO 10
CALL PEN(VB, NV, A, 0)
CALL PEN(VB, NV, B, 1)
10 CONTINUE
20 CONTINUE
DO 30 J = MDX1(KLMD), MDX2(KLMD)
IF (LXS(J) .NE. 0) GO TO 30
CALL SHADPT(LXL(1,J), PMF, XB, YB, ZB, SMF, A, IOK)
IF (IOK .EQ. 0) GO TO 30
CALL SHADPT(LXL(4,J), PMF, XB, YB, ZB, SMF, B, IOK)
IF (IOK .EQ. 0) GO TO 30
CALL PEN(VB, NV, A, 0)
CALL PEN(VB, NV, B, 1)
30 CONTINUE
IVMODE = 0
RETURN
END
C
C SHADPT: LM body point V (m; X up, Y right, Z forward) to its
C shadow on the Moon, returned camera relative EQ in P.
SUBROUTINE SHADPT(V, PMF, XB, YB, ZB, SMF, P, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION V(3), PMF(3), XB(3), YB(3), ZB(3), SMF(3), P(3)
DOUBLE PRECISION W(3), G(3), B, C, DS, T
INTEGER IOK, K
IOK = 0
DO 10 K = 1, 3
W(K) = PMF(K) + ((V(1) + 1.1D0 - LMEYE * 1.0D3) * XB(K)
& + V(2) * YB(K)
& + V(3) * ZB(K)) * 1.0D-3
10 CONTINUE
B = W(1) * SMF(1) + W(2) * SMF(2) + W(3) * SMF(3)
C = W(1)**2 + W(2)**2 + W(3)**2 - RM * RM
DS = B * B - C
IF (DS .LT. 0.0D0) RETURN
T = B - DSQRT(DS)
IF (T .LT. 0.0D0) RETURN
DO 20 K = 1, 3
G(K) = W(K) - T * SMF(K)
20 CONTINUE
CALL MXV(MMF, G, P)
DO 30 K = 1, 3
P(K) = P(K) + MPOS(K)
30 CONTINUE
IOK = 1
RETURN
END
src/lstars.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 2 STARS
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C STARS. Points inside the frame not behind the Earth or Moon.
C Nav stars (1..37) labelled when IFLG bit 0 is set.
C=======================================================================
SUBROUTINE DSTARS(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION U(3), X, Y, RAYHIT
INTEGER I, IOK, LMOCC, WMIN
DO 10 I = 1, NSTAR
U(1) = STX(I)
U(2) = STY(I)
U(3) = STZ(I)
IF (U(1)*CB(1) + U(2)*CB(2) + U(3)*CB(3) .LT. CSVIEW) GO TO 10
CALL PROJ(U, X, Y, IOK)
IF (DABS(X) .GT. BOXH .OR. DABS(Y) .GT. BOXH) GO TO 10
IF (RAYHIT(U, EPOS, RE) .GT. 0.0D0) GO TO 10
IF (RAYHIT(U, MPOS, RM) .GT. 0.0D0) GO TO 10
C Behind a placed spacecraft model (U taken as a point 1 km out).
IF (NACT .EQ. 0) GO TO 8
IF (LMOCC(U, 0) .EQ. 1) GO TO 10
C Outside the windows when the window mask applies (vmask.f).
8 IF (IMSK .EQ. 1 .AND. WMIN(U) .EQ. 0) GO TO 10
IF (NS .GE. MAXS) RETURN
NS = NS + 1
SB(1,NS) = X
SB(2,NS) = Y
SB(3,NS) = STM(I)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (I .LE. NNAV .AND. MOD(IFLG, 2) .EQ. 1) THEN
CALL LABEL(LB, NL, X, Y, 1, I)
END IF
C RESTOMOD END
10 CONTINUE
RETURN
END
src/lsun.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 3 SUN
C
C Layer element. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C SUN. The report's Sun symbol where the Sun is in view: a ring of
C rays round a clear centre, the same size on the screen whatever
C the field (MSC IN 69-FM-197 PDF p. 89, printed 71, 50 deg field;
C PDF p. 137, printed 119, 100 deg). Our measurements on those
C pages: the rays reach 0.056-0.062 of the plot's half-width, the
C centre is clear to about 0.4 of that, about 36 rays, each a thin
C wedge. We draw each ray out and back (two vectors); the wedge's
C width (3 deg of position angle) is ours. Where the field is
C narrow enough to show the true disc (radius 0.267 deg) larger than
C the clear centre, the disc is drawn and the rays start at its rim
C (ours; the report's Sun views are 50 deg and wider).
C=======================================================================
SUBROUTINE DSUN(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
DOUBLE PRECISION X, Y, RAYHIT, A, C, S, R0, R1, R2, DW
INTEGER IOK, K, LMOCC
IF (SUNU(1)*CB(1) + SUNU(2)*CB(2) + SUNU(3)*CB(3) .LT. CSVIEW)
& RETURN
IF (RAYHIT(SUNU, EPOS, RE) .GT. 0.0D0) RETURN
IF (RAYHIT(SUNU, MPOS, RM) .GT. 0.0D0) RETURN
IF (NACT .EQ. 0) GO TO 5
IF (LMOCC(SUNU, 0) .EQ. 1) RETURN
5 CALL PROJ(SUNU, X, Y, IOK)
IF (IOK .EQ. 0) RETURN
C R0 the true disc, R1 the clear centre, R2 the rays' tips.
R0 = 0.267D0
R1 = 0.024D0 * BOXH
R2 = 0.059D0 * BOXH
IF (R0 .LE. R1) GO TO 15
DO 10 K = 0, 23
A = DBLE(K) * PI / 12.0D0
C = DCOS(A) * R0
S = DSIN(A) * R0
CALL EMIT(VB, NV, X + C, Y + S,
& X + DCOS(A + PI / 12.0D0) * R0,
& Y + DSIN(A + PI / 12.0D0) * R0)
10 CONTINUE
R2 = R0 + R2 - R1
R1 = R0
15 DW = 1.5D0 * PI / 180.0D0
DO 20 K = 0, 35
A = DBLE(K) * PI / 18.0D0
C = X + DCOS(A) * R2
S = Y + DSIN(A) * R2
CALL EMIT(VB, NV, X + DCOS(A - DW) * R1, Y + DSIN(A - DW) * R1,
& C, S)
CALL EMIT(VB, NV, C, S,
& X + DCOS(A + DW) * R1, Y + DSIN(A + DW) * R1)
20 CONTINUE
IF (MOD(IFLG, 2) .EQ. 1) CALL LABEL(LB, NL, X, Y, 3, 0)
RETURN
END
src/lvehic.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER 6 VEHICLES
C
C Layer element. Placing and drawing the
C spacecraft models, with hidden lines. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C MCLEAR: no model placed.
SUBROUTINE MCLEAR
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
DO 10 K = 1, MMOD
MDON(K) = 0
10 CONTINUE
DO 20 K = 1, MSOL
LACT(K) = 0
LINS(K) = 0
20 CONTINUE
NACT = 0
RETURN
END
C
C-----------------------------------------------------------------------
C MPLACE: place model K for this frame. AT: its body axes in EQ
C (columns X, Y, Z). Body point BO (m) goes to P (km, camera
C relative). Its solids go to camera-relative EQ km (LWV, LWN,
C LWD) and join the solids that hide things.
C A model can ride on the observer's own vehicle, a cabin seen
C from inside: AT the vehicle's body axes, BO the eye point in
C body metres, P = 0. A solid with the camera inside it (every
C face turned away) does not hide anything and its edges are all
C drawn (LINS); a cabin is better built of free lines anyway.
C-----------------------------------------------------------------------
SUBROUTINE MPLACE(K, AT, P, BO)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
DOUBLE PRECISION AT(3,3), P(3), BO(3), V(3), W(3), R
INTEGER I, J, IS
DO 10 I = 1, 3
MDP(I,K) = P(I)
MDBO(I,K) = BO(I)
DO 5 J = 1, 3
MDAT(I,J,K) = AT(I,J)
5 CONTINUE
10 CONTINUE
MDON(K) = 1
IF (MDS2(K) .LT. MDS1(K)) RETURN
DO 60 IS = MDS1(K), MDS2(K)
DO 40 J = 1, NLV(IS)
DO 30 I = 1, 3
V(I) = (LMV(I,J,IS) - BO(I)) * 1.0D-3
30 CONTINUE
CALL MXV(AT, V, W)
DO 35 I = 1, 3
LWV(I,J,IS) = P(I) + W(I)
35 CONTINUE
40 CONTINUE
C Its bounding sphere, for LMOCC.
DO 42 I = 1, 3
LWC(I,IS) = 0.0D0
42 CONTINUE
DO 44 J = 1, NLV(IS)
DO 43 I = 1, 3
LWC(I,IS) = LWC(I,IS) + LWV(I,J,IS) / DBLE(NLV(IS))
43 CONTINUE
44 CONTINUE
LWR(IS) = 0.0D0
DO 46 J = 1, NLV(IS)
R = (LWV(1,J,IS) - LWC(1,IS))**2 + (LWV(2,J,IS)
& - LWC(2,IS))**2 + (LWV(3,J,IS) - LWC(3,IS))**2
IF (R .GT. LWR(IS)) LWR(IS) = R
46 CONTINUE
LWR(IS) = DSQRT(LWR(IS))
LINS(IS) = 1
DO 50 J = 1, NLF(IS)
CALL MXV(AT, LMN(1,J,IS), W)
DO 45 I = 1, 3
LWN(I,J,IS) = W(I)
45 CONTINUE
LWD(J,IS) = (LMD(J,IS) - LMN(1,J,IS) * BO(1)
& - LMN(2,J,IS) * BO(2) - LMN(3,J,IS) * BO(3)) * 1.0D-3
& + W(1) * P(1) + W(2) * P(2) + W(3) * P(3)
IF (LWD(J,IS) .LE. 0.0D0) LINS(IS) = 0
50 CONTINUE
C An outline model's solids hide nothing (MDHL = 0).
IF (MDHL(K) .EQ. 0) GO TO 60
LACT(IS) = 1
NACT = NACT + 1
60 CONTINUE
RETURN
END
C
C MDRALL: draw every placed model, then their labels and the
C markers of vehicles too small to see (VLABEL).
SUBROUTINE MDRALL(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
INTEGER K, IM
C The cabins are drawn whole, outside the window mask (vmask.f).
IM = IMSK
DO 10 K = 1, NMOD
IMSK = IM
IF (K .EQ. KCMC .OR. K .EQ. KCMI .OR. K .EQ. KLMI) IMSK = 0
IF (MDON(K) .EQ. 1) CALL MDRAW(VB, NV, K)
10 CONTINUE
IMSK = IM
ISTYLE = 1
C Vehicle labels and markers, with a label level set (lvlab.f);
C none from the LM station in the closed SLA (ISLA), which sees
C nothing outside.
IF (ILABL .GE. 1 .AND. ISLA .EQ. 0) CALL VLABEL(GET, VB, NV, LB,
& NL)
RETURN
END
C
C MDRAW: draw placed model K: solid edges, then free lines and
C face marks, each against every placed solid.
SUBROUTINE MDRAW(VB, NV, K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV)
INTEGER NV, K
DOUBLE PRECISION V(3), W(3), A(3), B(3)
INTEGER I, J, L, IS, IH, IA, IB, NS, IC, ICABN
C Solid edges. Hidden when both faces are turned away, unless
C the camera is inside the solid. Between two sides of a smooth
C solid (LSMO) only where it is the outline: one side turned
C toward the camera, the other away.
IF (MDS2(K) .LT. MDS1(K)) GO TO 90
DO 80 IS = MDS1(K), MDS2(K)
NS = NLF(IS) - 2
DO 70 J = 1, NLE(IS)
DO 65 I = 1, 3
A(I) = LWV(I,LME(1,J,IS),IS)
B(I) = LWV(I,LME(2,J,IS),IS)
65 CONTINUE
IA = 0
IF (LWD(LME(3,J,IS),IS) .GE. 0.0D0) IA = 1
IB = 0
IF (LWD(LME(4,J,IS),IS) .GE. 0.0D0) IB = 1
IF (LSMO(IS) .EQ. 1 .AND. LME(3,J,IS) .LE. NS .AND.
& LME(4,J,IS) .LE. NS .AND. IA .EQ. IB) GO TO 70
IH = IA * IB
IF (LINS(IS) .EQ. 1) IH = 0
C An outline model (MDHL = 0): every edge, nothing hidden.
IF (MDHL(K) .EQ. 0) GO TO 68
CALL LMSEG(VB, NV, A, B, IS, IH)
GO TO 70
68 ISTYLE = 1
CALL MSEG(VB, NV, A, B)
70 CONTINUE
80 CONTINUE
C Free lines and face marks; a cabin's, the pieces its hidden
C lines leave (vmask.f CBCUT).
90 IC = ICABN(K)
IF (IC .GT. 0) GO TO 110
IF (MDX2(K) .LT. MDX1(K)) RETURN
DO 100 J = MDX1(K), MDX2(K)
C The CSM's high-gain antenna, stowed in the closed SLA before
C the separation (CSMBLD), not drawn while the stack is placed.
IF (K .EQ. KCSM .AND. MDON(KSTK) .EQ. 1 .AND. J .GE. LHGA1
& .AND. J .LE. LHGA2) GO TO 100
DO 85 L = 0, 1
DO 82 I = 1, 3
V(I) = (LXL(I + 3 * L, J) - MDBO(I,K)) * 1.0D-3
82 CONTINUE
CALL MXV(MDAT(1,1,K), V, W)
DO 84 I = 1, 3
IF (L .EQ. 0) A(I) = MDP(I,K) + W(I)
IF (L .EQ. 1) B(I) = MDP(I,K) + W(I)
84 CONTINUE
85 CONTINUE
IS = LXS(J)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IS .GT. 0) THEN
IF (LWD(LXF(J),IS) .GE. 0.0D0 .AND. LINS(IS) .EQ. 0)
& GO TO 100
END IF
C RESTOMOD END
IF (MDHL(K) .EQ. 0) GO TO 95
CALL LMSEG(VB, NV, A, B, IS, 0)
GO TO 100
95 ISTYLE = 1
CALL MSEG(VB, NV, A, B)
100 CONTINUE
ISTYLE = 1
RETURN
110 ISTYLE = 1
IF (NCP(IC) .LT. 1) RETURN
DO 130 J = 1, NCP(IC)
DO 125 L = 0, 1
DO 122 I = 1, 3
V(I) = (CPL(I + 3 * L, J, IC) - MDBO(I,K)) * 1.0D-3
122 CONTINUE
CALL MXV(MDAT(1,1,K), V, W)
DO 124 I = 1, 3
IF (L .EQ. 0) A(I) = MDP(I,K) + W(I)
IF (L .EQ. 1) B(I) = MDP(I,K) + W(I)
124 CONTINUE
125 CONTINUE
CALL MSEG(VB, NV, A, B)
130 CONTINUE
RETURN
END
C
C LMSEG: edge A-B of solid IS (0 for a free line) in 12 pieces,
C each tested against the other solids, then against the Earth and
C the Moon (MBODY). IHID = 1: the whole edge is known hidden.
C Hidden by a solid: dropped, or dashed (IFLG bit 2); behind a
C body: dropped.
SUBROUTINE LMSEG(VB, NV, A, B, IS, IHID)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), A(3), B(3)
INTEGER NV, IS, IHID
DOUBLE PRECISION P0(3), P1(3), M(3), F0, F1
INTEGER I, K, NP, IV, IV0, LMOCC, MBODY
INTEGER IDSH
NP = 12
IDSH = MOD(IFLG / 4, 2)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IHID .EQ. 1) THEN
IF (IDSH .EQ. 1) THEN
ISTYLE = 2
CALL MSEG(VB, NV, A, B)
ISTYLE = 1
END IF
RETURN
END IF
C RESTOMOD END
C Runs of equal visibility are merged into one vector.
IV0 = -1
DO 30 K = 1, NP
F0 = DBLE(K - 1) / DBLE(NP)
F1 = DBLE(K) / DBLE(NP)
DO 10 I = 1, 3
M(I) = A(I) + 0.5D0 * (F0 + F1) * (B(I) - A(I))
10 CONTINUE
IV = 1 - LMOCC(M, IS)
IF (MBODY(M) .EQ. 1) IV = 2
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IV .NE. IV0) THEN
IF (IV0 .GE. 0) CALL LMRUN(VB, NV, P0, P1, IV0, IDSH)
DO 15 I = 1, 3
P0(I) = A(I) + F0 * (B(I) - A(I))
15 CONTINUE
IV0 = IV
END IF
C RESTOMOD END
DO 20 I = 1, 3
P1(I) = A(I) + F1 * (B(I) - A(I))
20 CONTINUE
30 CONTINUE
CALL LMRUN(VB, NV, P0, P1, IV0, IDSH)
RETURN
END
C
SUBROUTINE LMRUN(VB, NV, P0, P1, IV, IDSH)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), P0(3), P1(3)
INTEGER NV, IV, IDSH
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IV .EQ. 1) THEN
ISTYLE = 1
CALL MSEG(VB, NV, P0, P1)
ELSE IF (IV .EQ. 0 .AND. IDSH .EQ. 1) THEN
ISTYLE = 2
CALL MSEG(VB, NV, P0, P1)
ISTYLE = 1
END IF
C RESTOMOD END
RETURN
END
C
C MBODY: 1 if the sight line to camera-relative P (km) passes
C through the Earth or the Moon (OCCL). A point inside a body's
C sphere (on ground below its mean radius) is tested against the
C sphere through it, so its own ground does not hide it.
INTEGER FUNCTION MBODY(P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3), D(3), R, OCCL, VNRM
INTEGER I
MBODY = 1
DO 10 I = 1, 3
D(I) = P(I) - EPOS(I)
10 CONTINUE
R = DMIN1(RE, 0.999999D0 * VNRM(D))
IF (OCCL(P, EPOS, R) .GT. 0.0D0) RETURN
DO 20 I = 1, 3
D(I) = P(I) - MPOS(I)
20 CONTINUE
R = DMIN1(RM, 0.999999D0 * VNRM(D))
IF (OCCL(P, MPOS, R) .GT. 0.0D0) RETURN
MBODY = 0
RETURN
END
C
C LMOCC: 1 if the sight line to P passes through a placed solid
C other than IS (Cyrus-Beck against the face planes). Solids with
C the camera inside do not count (MPLACE).
INTEGER FUNCTION LMOCC(P, IS)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3), T0, T1, DEN, T, PP
INTEGER IS, K, J
C RESTOMOD BEGIN: Cyrus-Beck ray/convex test, published 1978
LMOCC = 0
DO 20 K = 1, NSOL
IF (K .EQ. IS) GO TO 20
IF (LACT(K) .EQ. 0 .OR. LINS(K) .EQ. 1) GO TO 20
C Not if the sight line misses the solid's bounding sphere.
PP = P(1)*P(1) + P(2)*P(2) + P(3)*P(3)
T = (P(1)*LWC(1,K) + P(2)*LWC(2,K) + P(3)*LWC(3,K)) / PP
IF (T .LT. 0.0D0) T = 0.0D0
IF (T .GT. 1.0D0) T = 1.0D0
IF ((T*P(1) - LWC(1,K))**2 + (T*P(2) - LWC(2,K))**2
& + (T*P(3) - LWC(3,K))**2 .GT. LWR(K)**2) GO TO 20
T0 = 0.0D0
T1 = 0.999D0
DO 10 J = 1, NLF(K)
DEN = LWN(1,J,K)*P(1) + LWN(2,J,K)*P(2) + LWN(3,J,K)*P(3)
IF (DEN .EQ. 0.0D0) THEN
IF (LWD(J,K) .LT. 0.0D0) GO TO 20
ELSE
T = LWD(J,K) / DEN
IF (DEN .GT. 0.0D0) THEN
IF (T .LT. T1) T1 = T
ELSE
IF (T .GT. T0) T0 = T
END IF
END IF
IF (T0 .GE. T1) GO TO 20
10 CONTINUE
LMOCC = 1
RETURN
20 CONTINUE
C RESTOMOD END
RETURN
END
C
C-----------------------------------------------------------------------
C STKPL: place the docked CSM and LM. AT: the CSM's body axes in
C EQ; P (km, camera relative): where the CSM's body origin is
C (the CM's axis at its widest, CSMBLD). The LM (model KL: KLMD
C gear down, KLMS stowed) faces it, its X axis against the CSM's and its Z axis along the CSM's (a
C half turn about Z; the roll between them is ours), tunnel top
C to tunnel top on the CSM's axis: the LM's at the top of the CM's
C docking ring (CMTOP).
C-----------------------------------------------------------------------
SUBROUTINE STKPL(AT, P, KL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION AT(3,3), P(3), AL(3,3), PL(3), BO(3), Z(3)
DOUBLE PRECISION CMTOP
INTEGER KL, I
CALL SETV(Z, 0.0D0, 0.0D0, 0.0D0)
CALL MPLACE(KCSM, AT, P, Z)
DO 10 I = 1, 3
AL(I,1) = -AT(I,1)
AL(I,2) = -AT(I,2)
AL(I,3) = AT(I,3)
PL(I) = P(I) + CMTOP() * 1.0D-3 * AT(I,1)
10 CONTINUE
CALL SETV(BO, 4.51D0, 0.0D0, 0.0D0)
CALL MPLACE(KL, AL, PL, BO)
RETURN
END
src/lvlab.f
C=======================================================================
C
C V I E W - 1 1 0 8 VEHICLE LABELS AND MARKERS
C
C Part of layer 6: called by MDRALL after the placed models are
C drawn. One relocatable element of the kernel; see vdrive.f for
C the list.
C
C A modern addition throughout (ours). VIEW drew "the vehicle
C outlines of the CSM, LM, and the S-IVB" at their apparent size
C (TN D-6853, printed p. 12); we have no source that it lettered
C them or marked the ones too small to see. Drawn only with a
C label level set (in_lablv 1-3), so in_lablv 0 keeps the picture
C it had.
C Labels (LB kind 8; id 1 CM, 2 SM, 3 LM, 4 S-IVB, 5 CSM) beside
C each placed model: off the model's projected X axis by the
C model's projected half-width across that axis plus a gap,
C so the name clears the model's lines. The CSM gets CM and SM
C labels beside its two modules, on the same side, or one CSM
C label when those two would touch. The CM alone (after CM/SM
C separation) is CM, the ascent stage alone (after lunar
C lift-off) LM.
C Markers: a placed model whose picture spans less than 0.2
C percent of the field (under about one plot pixel) gets the
C small boxed X of the Moon view's landing site (DMOON6, BOXX)
C at its centre instead, with its label beside the box. So do
C vehicles known only by their state (VSTATE): one not placed
C as a model, which the camera does not ride (IRIDE), where it
C has a state; the CSM's is CM from CM/SM separation on. The
C LM has one only where LMSTAT's rules (traj.f)
C give it one; docked to the CSM it is not marked (the CSM's
C mark or model stands for both), nor in the Moon view (scene
C 6) while landed (the landing site's box stands for it). The
C S-IVB has one only where SIVST's rules (traj.f) give it one
C of its own: from the separation to the docking, and from the
C spacecraft's ejection to the slingshot.
C A label that would leave the frame or meet a name already
C lettered (the other layers' labels, VLSEED, or a vehicle's)
C tries the other side of its vehicle, then is dropped.
C=======================================================================
C
C-----------------------------------------------------------------------
C VLABEL: label the placed models and mark the vehicles too small
C to draw. Order CSM, LM, S-IVB: the first placed label wins.
C-----------------------------------------------------------------------
SUBROUTINE VLABEL(GET, VB, NV, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), LB(4,MAXL)
INTEGER NV, NL
DOUBLE PRECISION XA(64), XB(64), YA(64)
DOUBLE PRECISION YB(64), XM(8), YM(8), H, TINY, C(3), P(3), Q(3)
DOUBLE PRECISION R(3), V(3), XMN, XMX, YMN, YMX, X1, Y1, X2, Y2
INTEGER KORD(7), IDM(7), NCH(5), M, K, N, J, NP, NP0, NM, IOK
INTEGER ISD, IRIDE, KCSPL, KLMPL, ID, KSIVPL
DOUBLE PRECISION TS, TL, EVGET
DATA KORD / KCSM, KCMO, KLMD, KLMS, KLMA, KSIV, KSTK /
DATA IDM / 5, 1, 3, 3, 3, 4, 4 /
DATA NCH / 2, 2, 2, 5, 3 /
NM = 0
C The name height TXALL letters at, and 0.2 percent of the field.
H = 0.028D0 * BOXH
TINY = 0.004D0 * BOXH
C The names already placed by the other layers are kept clear of.
CALL VLSEED(LB, NL, H, XA, XB, YA, YB, NP)
DO 50 M = 1, 7
K = KORD(M)
IF (MDON(K) .EQ. 0) GO TO 50
CALL VLPTS(K, VLPX, VLPY, N)
IF (N .EQ. 0) GO TO 50
XMN = VLPX(1)
XMX = VLPX(1)
YMN = VLPY(1)
YMX = VLPY(1)
DO 10 J = 2, N
XMN = DMIN1(XMN, VLPX(J))
XMX = DMAX1(XMX, VLPX(J))
YMN = DMIN1(YMN, VLPY(J))
YMX = DMAX1(YMX, VLPY(J))
10 CONTINUE
CALL VLCEN(K, MDS1(K), MDS2(K), C)
IF (DMAX1(XMX - XMN, YMX - YMN) .GE. TINY) GO TO 30
CALL VLMARK(VB, NV, LB, NL, C, IDM(M), NCH(IDM(M)), 0, H,
& XA, XB, YA, YB, NP, XM, YM, NM)
GO TO 50
C The CSM: the CM (its first two solids, cone and tunnel), then
C the SM (the rest) on the same side with the CM's box counted.
30 IF (K .NE. KCSM) GO TO 40
CALL VLCEN(K, MDS1(K), MDS1(K) + 1, P)
ISD = 0
CALL VLSIDE(K, P, VLPX, VLPY, N, 2, H, XA, XB, YA, YB, NP,
& X1, Y1, ISD, IOK)
IF (IOK .EQ. 0) GO TO 40
NP0 = NP
CALL VLADD(X1, Y1, 1.4D0 * H, H, XA, XB, YA, YB, NP)
CALL VLCEN(K, MDS1(K) + 2, MDS2(K), Q)
CALL VLSIDE(K, Q, VLPX, VLPY, N, 2, H, XA, XB, YA, YB, NP,
& X2, Y2, ISD, IOK)
NP = NP0
IF (IOK .EQ. 0) GO TO 40
CALL VLPUT(LB, NL, X1, Y1, H, 1, 2, XA, XB, YA, YB, NP)
CALL VLPUT(LB, NL, X2, Y2, H, 2, 2, XA, XB, YA, YB, NP)
GO TO 50
40 ISD = 0
CALL VLSIDE(K, C, VLPX, VLPY, N, NCH(IDM(M)), H, XA, XB, YA, YB,
& NP, X1, Y1, ISD, IOK)
IF (IOK .EQ. 1) CALL VLPUT(LB, NL, X1, Y1, H, IDM(M),
& NCH(IDM(M)), XA, XB, YA, YB, NP)
50 CONTINUE
C
C The CSM and the LM from their states, where they are not placed
C and the camera does not ride them; the LM not while docked, nor
C in the Moon view while it stands at the landing site, whose boxed
C X (DMOON6) stands for it there.
IF (KCSPL() .NE. 0 .OR. IRIDE() .EQ. 1) GO TO 60
CALL VSTATE(GET, 1, 2, R, V, IOK)
DO 55 J = 1, 3
P(J) = MPOS(J) + R(J)
55 CONTINUE
ID = 5
TS = EVGET(KECMS)
IF (TS .GE. 0.0D0 .AND. GET .GE. TS) ID = 1
CALL VLMARK(VB, NV, LB, NL, P, ID, NCH(ID), 1, H, XA, XB, YA, YB,
& NP, XM, YM, NM)
60 IF (KLMPL() .NE. 0) GO TO 70
IF (IRIDE() .EQ. 2) GO TO 70
TL = EVGET(KELFT)
IF (MOD(JDRW / 4, 2) .EQ. 1 .AND. LUT0 .GT. 0.0D0
& .AND. GET .GE. LUT0
& .AND. (TL .LT. 0.0D0 .OR. GET .LT. TL)) GO TO 70
CALL VSTATE(GET, 2, 2, R, V, IOK)
IF (IOK .NE. 1) GO TO 70
DO 65 J = 1, 3
P(J) = MPOS(J) + R(J)
65 CONTINUE
CALL VLMARK(VB, NV, LB, NL, P, 3, 2, 1, H, XA, XB, YA, YB, NP,
& XM, YM, NM)
C The S-IVB from its state where it is not placed: not with the
C CSM (SIVST's IOK 2, before separation or docked to the stack).
70 IF (KSIVPL() .NE. 0) RETURN
CALL VSTATE(GET, 3, 2, R, V, IOK)
IF (IOK .NE. 1) RETURN
DO 75 J = 1, 3
P(J) = MPOS(J) + R(J)
75 CONTINUE
CALL VLMARK(VB, NV, LB, NL, P, 4, NCH(4), 1, H, XA, XB, YA, YB,
& NP, XM, YM, NM)
RETURN
END
C
C VPRES: IVBIT, the vehicles in this frame's world, for hdr(21): 1
C the CSM, 2 the LM, 4 the S-IVB, each if placed as a model or
C known by its state (VSTATE; the LM docked too, the S-IVB docked
C to the stack too); the vehicle the camera rides in a window or
C station view (IRIDE) is not counted, nor the S-IVB before the
C separation (SEP), while it carries the CSM, unless the launch
C stack is placed (KSTK, LVPL).
SUBROUTINE VPRES(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, R(3), V(3), EVGET
INTEGER IRIDE, IOK, KCSPL, KLMPL, KSIVPL
IVBIT = 0
IF (KCSPL() .NE. 0 .OR. IRIDE() .NE. 1) IVBIT = 1
IOK = 0
IF (IRIDE() .NE. 2) CALL VSTATE(GET, 2, 2, R, V, IOK)
IF (KLMPL() .NE. 0 .OR. IOK .NE. 0) IVBIT = IVBIT + 2
IOK = 0
IF (KSIVPL() .EQ. 0) CALL VSTATE(GET, 3, 1, R, V, IOK)
IF (GET .LT. EVGET(KESEP)) IOK = 0
IF (KSIVPL() .NE. 0 .OR. IOK .NE. 0) IVBIT = IVBIT + 4
RETURN
END
C
C VLPTS: the plot points (PX, PY; N of them) of placed model K's
C solid vertices and free-line ends in front of the camera.
SUBROUTINE VLPTS(K, PX, PY, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K, N
DOUBLE PRECISION PX(2400), PY(2400), V(3), W(3), A(3)
INTEGER I, J, L, IS
N = 0
IF (MDS2(K) .LT. MDS1(K)) GO TO 30
DO 20 IS = MDS1(K), MDS2(K)
DO 10 J = 1, NLV(IS)
CALL VLPT1(LWV(1,J,IS), PX, PY, N)
10 CONTINUE
20 CONTINUE
30 IF (MDX2(K) .LT. MDX1(K)) RETURN
DO 50 J = MDX1(K), MDX2(K)
DO 45 L = 0, 1
DO 35 I = 1, 3
V(I) = (LXL(I + 3 * L, J) - MDBO(I,K)) * 1.0D-3
35 CONTINUE
CALL MXV(MDAT(1,1,K), V, W)
DO 40 I = 1, 3
A(I) = MDP(I,K) + W(I)
40 CONTINUE
CALL VLPT1(A, PX, PY, N)
45 CONTINUE
50 CONTINUE
RETURN
END
C
C VLPT1: add camera-relative point A's plot position, if it is in
C front of the camera and projected, to PX, PY.
SUBROUTINE VLPT1(A, PX, PY, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION A(3), PX(2400), PY(2400), X, Y
INTEGER N, IOK
IF (N .GE. 2400) RETURN
IF (A(1)*CB(1) + A(2)*CB(2) + A(3)*CB(3) .LE. 0.0D0) RETURN
CALL PROJ(A, X, Y, IOK)
IF (IOK .EQ. 0) RETURN
N = N + 1
PX(N) = X
PY(N) = Y
RETURN
END
C
C VLCEN: P (km, camera relative), the centre of the body-axis box
C around the vertices of placed model K's solids IS1..IS2.
SUBROUTINE VLCEN(K, IS1, IS2, P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K, IS1, IS2
DOUBLE PRECISION P(3), BMN(3), BMX(3), V(3), W(3)
INTEGER I, J, IS
DO 10 I = 1, 3
BMN(I) = 1.0D30
BMX(I) = -1.0D30
10 CONTINUE
DO 30 IS = IS1, IS2
DO 25 J = 1, NLV(IS)
DO 20 I = 1, 3
BMN(I) = DMIN1(BMN(I), LMV(I,J,IS))
BMX(I) = DMAX1(BMX(I), LMV(I,J,IS))
20 CONTINUE
25 CONTINUE
30 CONTINUE
DO 40 I = 1, 3
V(I) = (0.5D0 * (BMN(I) + BMX(I)) - MDBO(I,K)) * 1.0D-3
40 CONTINUE
CALL MXV(MDAT(1,1,K), V, W)
DO 50 I = 1, 3
P(I) = MDP(I,K) + W(I)
50 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C VLSIDE: where to letter NC characters (height H) for the part of
C placed model K centred at P. The side is square to the model's
C projected X axis (right of it, or above it when the axis lies
C across the frame; right of the model when it is seen near end
C on); the text's near edge is the model's largest
C projected distance from that axis (over PX, PY) plus half a
C character height out. ISD 0 tries that side then the other
C and returns the one used (+1 or -1); ISD +-1 tries only that
C side. X0, Y0: the text's lower left. IOK = 1 if it fits in the
C frame clear of the labels placed so far (IVFREE).
C-----------------------------------------------------------------------
SUBROUTINE VLSIDE(K, P, PX, PY, N, NC, H, XA, XB, YA, YB, NP,
& X0, Y0, ISD, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K, N, NC, NP, ISD, IOK
DOUBLE PRECISION P(3), PX(2400), PY(2400), H, XA(64), XB(64)
DOUBLE PRECISION YA(64), YB(64), X0, Y0
DOUBLE PRECISION A(3), CX, CY, AX, AY, DX, DY, D, NX, NY, E, T
DOUBLE PRECISION WD, UX, UY, G, S
INTEGER I, J, L, L1, L2, IK, IVFREE
IOK = 0
IF (P(1)*CB(1) + P(2)*CB(2) + P(3)*CB(3) .LE. 0.0D0) RETURN
CALL PROJ(P, CX, CY, IK)
IF (IK .EQ. 0) RETURN
C The model's X axis in the plot, 1 m of it from P. Seen within
C 30 deg of end on, the axis says little: the label goes to the
C right (or left) of the whole model instead.
NX = 1.0D0
NY = 0.0D0
D = DSQRT(P(1) * P(1) + P(2) * P(2) + P(3) * P(3))
IF (DABS(P(1) * MDAT(1,1,K) + P(2) * MDAT(2,1,K)
& + P(3) * MDAT(3,1,K)) .GT. 0.866D0 * D) GO TO 15
DO 10 I = 1, 3
A(I) = P(I) + 1.0D-3 * MDAT(I,1,K)
10 CONTINUE
IF (A(1)*CB(1) + A(2)*CB(2) + A(3)*CB(3) .LE. 0.0D0) GO TO 15
CALL PROJ(A, AX, AY, IK)
DX = AX - CX
DY = AY - CY
D = DSQRT(DX * DX + DY * DY)
IF (IK .EQ. 0 .OR. D .LT. 1.0D-9) GO TO 15
NX = -DY / D
NY = DX / D
IF (NX .GT. 0.0D0 .OR. (NX .EQ. 0.0D0 .AND. NY .GT. 0.0D0))
& GO TO 15
NX = -NX
NY = -NY
C The model's half-width across the axis.
15 E = 0.0D0
DO 20 J = 1, N
T = DABS((PX(J) - CX) * NX + (PY(J) - CY) * NY)
IF (T .GT. E) E = T
20 CONTINUE
WD = 0.7D0 * H * DBLE(NC)
L1 = 1
L2 = 2
IF (ISD .EQ. 1) L2 = 1
IF (ISD .EQ. -1) L1 = 2
DO 40 L = L1, L2
S = DBLE(3 - 2 * L)
UX = S * NX
UY = S * NY
IF (DABS(UX) .LT. 0.5D0) GO TO 30
C Beside a steep axis: the text starts (or ends) G out.
G = E + 0.5D0 * H + 0.5D0 * H * DABS(UY)
X0 = CX + UX * G
IF (UX .LT. 0.0D0) X0 = X0 - WD
Y0 = CY + UY * G - 0.5D0 * H
GO TO 35
C Above or below a flat axis: the text centred G out.
30 G = E + 0.5D0 * H + 0.5D0 * WD * DABS(UX)
X0 = CX + UX * G - 0.5D0 * WD
Y0 = CY + UY * G
IF (UY .LT. 0.0D0) Y0 = Y0 - H
35 IF (IVFREE(X0, Y0, WD, H, XA, XB, YA, YB, NP) .EQ. 0) GO TO 40
IOK = 1
ISD = 3 - 2 * L
RETURN
40 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C VLMARK: mark a vehicle at P (km, camera relative) with a boxed X,
C and its label (id ID, NC characters, height H) at a corner of
C the box, the first of four that fits. Hidden behind the Earth
C or Moon; ISOL = 1 also hidden behind placed models and, from the
C LM window, below the sill (ISVIS mode 2), for a vehicle that is
C not itself placed. A second mark within a box of one already
C made (a docked stack) is left out.
C-----------------------------------------------------------------------
SUBROUTINE VLMARK(VB, NV, LB, NL, P, ID, NC, ISOL, H,
& XA, XB, YA, YB, NP, XM, YM, NM)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), LB(4,MAXL), P(3), H, XA(64), XB(64)
DOUBLE PRECISION YA(64), YB(64), XM(8), YM(8)
INTEGER NV, NL, ID, NC, ISOL, NP, NM
DOUBLE PRECISION X, Y, W, WD, X0, Y0, OCCL
INTEGER J, IOK, ISVIS, IVFREE
IOK = 1
IF (P(1)*CB(1) + P(2)*CB(2) + P(3)*CB(3) .LE. 0.0D0) RETURN
IF (OCCL(P, MPOS, RM) .GT. 0.0D0) RETURN
IF (OCCL(P, EPOS, RE) .GT. 0.0D0) RETURN
IVMODE = 2
IF (ISOL .EQ. 1) IOK = ISVIS(P)
IVMODE = 0
IF (ISOL .EQ. 1 .AND. IOK .EQ. 0) RETURN
CALL PROJ(P, X, Y, IOK)
IF (IOK .EQ. 0) RETURN
IF (DABS(X) .GT. BOXH .OR. DABS(Y) .GT. BOXH) RETURN
W = 0.012D0 * FOVH
DO 10 J = 1, NM
IF (DABS(X - XM(J)) .LT. W .AND. DABS(Y - YM(J)) .LT. W)
& RETURN
10 CONTINUE
CALL BOXX(VB, NV, X, Y, W)
IF (NM .GE. 8) GO TO 20
NM = NM + 1
XM(NM) = X
YM(NM) = Y
C The label at the box's upper right, upper left, lower right or
C lower left, the first that is free.
20 WD = 0.7D0 * H * DBLE(NC)
DO 25 J = 1, 4
X0 = X + W + 0.4D0 * H
IF (J .EQ. 2 .OR. J .EQ. 4) X0 = X - W - 0.4D0 * H - WD
Y0 = Y + W + 0.4D0 * H
IF (J .GE. 3) Y0 = Y - W - 0.4D0 * H - H
IF (IVFREE(X0, Y0, WD, H, XA, XB, YA, YB, NP) .EQ. 1) GO TO 30
25 CONTINUE
RETURN
30 CALL VLPUT(LB, NL, X0, Y0, H, ID, NC, XA, XB, YA, YB, NP)
RETURN
END
C
C IVFREE: 1 if a text box, lower left X0, Y0, WD wide and H high,
C lies in the frame (with its label point 0.4 H below and left, as
C TXALL letters it) and clear by 0.2 H of the NP boxes placed.
INTEGER FUNCTION IVFREE(X0, Y0, WD, H, XA, XB, YA, YB, NP)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X0, Y0, WD, H, XA(64), XB(64), YA(64), YB(64)
DOUBLE PRECISION M
INTEGER NP, J
IVFREE = 0
IF (X0 - 0.4D0 * H .LT. -BOXH .OR. X0 + WD .GT. BOXH) RETURN
IF (Y0 - 0.4D0 * H .LT. -BOXH .OR. Y0 + H .GT. BOXH) RETURN
M = 0.2D0 * H
DO 10 J = 1, NP
IF (X0 - M .LT. XB(J) .AND. X0 + WD + M .GT. XA(J) .AND.
& Y0 - M .LT. YB(J) .AND. Y0 + H + M .GT. YA(J)) RETURN
10 CONTINUE
IVFREE = 1
RETURN
END
C
C VLSEED: the text boxes of the names the other layers have placed
C (LB kinds 1, 3-7, 9) that TXALL letters at this level, height H,
C as the first NP boxes. Crater names (kind 2) are the page's.
SUBROUTINE VLSEED(LB, NL, H, XA, XB, YA, YB, NP)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION LB(4,MAXL), H, XA(64), XB(64), YA(64), YB(64)
DOUBLE PRECISION X0, Y0
INTEGER NL, NP, I, J, K, ID, N
NP = 0
DO 50 I = 1, NL
K = NINT(LB(3,I))
ID = NINT(LB(4,I))
N = 0
IF ((K .EQ. 1 .OR. K .EQ. 6) .AND. ILEV .LT. 2) GO TO 50
IF (K .NE. 1 .OR. ID .LT. 1 .OR. ID .GT. NNAV) GO TO 15
DO 10 J = 1, 10
IF (NAVCH((ID - 1) * 10 + J) .NE. 0) N = N + 1
10 CONTINUE
15 IF (K .LT. 3 .OR. K .GT. 5) GO TO 25
DO 20 J = 1, 5
IF (BODCH((K - 3) * 5 + J) .NE. 0) N = N + 1
20 CONTINUE
25 IF (K .NE. 6 .OR. ID .LT. 1 .OR. ID .GT. NMARE) GO TO 35
DO 30 J = 1, 24
IF (MRCH((ID - 1) * 24 + J) .NE. 0) N = N + 1
30 CONTINUE
35 IF (K .EQ. 7) N = 22
IF (K .NE. 9) GO TO 45
DO 40 J = 1, 8
IF (PADCH(8 * (ISN - 1) + J) .NE. 0) N = N + 1
40 CONTINUE
45 IF (N .EQ. 0) GO TO 50
C Mare names are centred on the point, the others up and right.
X0 = LB(1,I) + 0.4D0 * H
Y0 = LB(2,I) + 0.4D0 * H
IF (K .EQ. 6) X0 = LB(1,I) - 0.35D0 * H * DBLE(N)
IF (K .EQ. 6) Y0 = LB(2,I) - 0.5D0 * H
CALL VLADD(X0, Y0, 0.7D0 * H * DBLE(N), H, XA, XB, YA, YB, NP)
50 CONTINUE
RETURN
END
C
C VLADD: count a text box (lower left X0, Y0, WD by H) as placed.
SUBROUTINE VLADD(X0, Y0, WD, H, XA, XB, YA, YB, NP)
DOUBLE PRECISION X0, Y0, WD, H, XA(64), XB(64), YA(64), YB(64)
INTEGER NP
IF (NP .GE. 64) RETURN
NP = NP + 1
XA(NP) = X0
XB(NP) = X0 + WD
YA(NP) = Y0
YB(NP) = Y0 + H
RETURN
END
C
C VLPUT: the vehicle label (LB kind 8, id ID) whose NC-character
C name TXALL letters with its lower left at X0, Y0: the label
C point is 0.4 H below and left of it.
SUBROUTINE VLPUT(LB, NL, X0, Y0, H, ID, NC, XA, XB, YA, YB, NP)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION LB(4,MAXL), X0, Y0, H, XA(64), XB(64), YA(64)
DOUBLE PRECISION YB(64)
INTEGER NL, ID, NC, NP
CALL LABEL(LB, NL, X0 - 0.4D0 * H, Y0 - 0.4D0 * H, 8, ID)
CALL VLADD(X0, Y0, 0.7D0 * H * DBLE(NC), H, XA, XB, YA, YB, NP)
RETURN
END
src/models.f
C=======================================================================
C
C V I E W - 1 1 0 8 SPACECRAFT MODELS
C
C Core element. The wireframe model library
C (data built once) that the vehicles layer draws. One
C relocatable element of the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C SPACECRAFT MODELS. A library of wireframe models in /CLM/,
C built once (MLIB). Each model is data: convex solids (prisms,
C MKPRS; frusta, MKFRU) and free lines (XLINE), in its own body
C frame, in metres. A solid standing for a curved surface (the
C CSM's cone, cylinder, nozzles) is smooth (LSMO): the edges
C between its sides are drawn only where they are its outline.
C A free line with IS = 0 is a stand-alone line (legs, rims); with
C IS > 0 it is a mark on face LXF of solid IS (windows, target),
C hidden when that face is turned away. The model table /CMODI/
C gives each model's range of solids and lines.
C
C Per frame: MCLEAR, then MPLACE for each model in view (body axes,
C where a body point sits, camera relative), then MDRALL after the
C sky and bodies. Hidden parts: an edge between two faces turned
C away is hidden; any piece whose sight line passes through a
C placed solid is hidden (Cyrus-Beck, LMOCC); placed solids also
C hide stars, Sun, Earth and Moon (ISVIS, DSTARS, DSUN). Hidden
C pieces are dropped, as on the film, or drawn dashed (style 2)
C when IFLG bit 2 is set. TN D-6853 (printed p. 12): "Hidden-line
C models of the LM and the S-IVB can be produced".
C
C To add a model: a builder routine between MODBEG(K) and
C MODEND(K) in MLIB, a model number in viewcom.inc, and one MPLACE
C call in the scene's part of SCNMOD.
C=======================================================================
SUBROUTINE MLIB
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION OFF(3)
NSOL = 0
NXL = 0
NMOD = 0
NWIN = 0
NOC = 0
NOCX = 0
NMODX = 0
NSOLX = 0
NXLX = 0
C LM, landing gear deployed (scene 4).
CALL MODBEG(KLMD)
CALL LMBODY
CALL LMGEAR(0)
CALL LMRCS
CALL LMANT
CALL MODEND(KLMD)
C LM, landing gear stowed, with drogue and docking target, in its
C place on the S-IVB (scene 7).
CALL MODBEG(KLMS)
CALL LMBODY
CALL LMGEAR(1)
CALL LMDOCK
CALL LMRCS
CALL LMANT
CALL MODEND(KLMS)
C LM ascent stage alone, after lunar lift-off, with the drogue and
C docking target (LMDOCK) kept for the lunar-orbit docking (ours).
CALL MODBEG(KLMA)
CALL LMASC
CALL LMDOCK
CALL LMRCS
CALL LMANT
CALL MODEND(KLMA)
C S-IVB with the instrument unit and the stub of the SLA.
CALL MODBEG(KSIV)
CALL SIVBMD
CALL MODEND(KSIV)
C CSM, with the docking probe.
CALL MODBEG(KCSM)
CALL CSMBLD
CALL MODEND(KCSM)
C CM alone, after CM/SM separation.
CALL MODBEG(KCMO)
CALL CMBLD
CALL MODEND(KCMO)
C CM cabin: the commander's window outlines about the design eye,
C an outline (station view only).
CALL MODBEG(KCMC)
CALL CMCAB
CALL MODEND(KCMC)
MDHL(KCMC) = 0
C CM and LM crew compartments, outlines (in_flags bit 4).
CALL MODBEG(KCMI)
CALL CMINT
CALL MODEND(KCMI)
MDHL(KCMI) = 0
CALL MODBEG(KLMI)
CALL LMINT
CALL MODEND(KLMI)
MDHL(KLMI) = 0
C Their hidden lines, for the design eyes (vmask.f CBCUT; ours).
CALL SETV(OFF, 0.0D0, 0.0D0, 0.0D0)
KCOK(1) = 0
KCOK(2) = 0
CALL CBCUT(KCMI, OFF)
CALL CBCUT(KLMI, OFF)
C The launch stack behind the CSM before separation: S-IVB, IU
C and the closed SLA, the LM hidden inside (not built).
CALL MODBEG(KSTK)
CALL LVSTK
CALL MODEND(KSTK)
C Below it the S-II and the S-IC, and on the CM the launch escape
C system, each dropped at its own event (vdrive.f LVPL; #97).
CALL MODBEG(KSII)
CALL LVSII
CALL MODEND(KSII)
CALL MODBEG(KSIC)
CALL LVSIC
CALL MODEND(KSIC)
CALL MODBEG(KLES)
CALL LESBLD
CALL MODEND(KLES)
C The launch complex fixed to the Earth at the pad, with the
C umbilical tower's arms swung out and swung back, the access
C arm also parked (mpad.f; vdrive.f PADPL).
CALL MODBEG(KPAD)
CALL PADBLD
CALL MODEND(KPAD)
CALL MODBEG(KARE)
CALL ARMBLD(1, 8, 0.0D0)
CALL MODEND(KARE)
CALL MODBEG(KARR)
CALL ARMBLD(1, 8, 90.0D0)
CALL MODEND(KARR)
CALL MODBEG(KA9E)
CALL ARMBLD(9, 9, 0.0D0)
CALL MODEND(KA9E)
CALL MODBEG(KA9P)
CALL ARMBLD(9, 9, 12.0D0)
CALL MODEND(KA9P)
CALL MODBEG(KA9R)
CALL ARMBLD(9, 9, 90.0D0)
CALL MODEND(KA9R)
RETURN
END
C
C MODBEG, MODEND: open and close model K in the table. A model
C number past MMOD is refused and counted (NMODX): its builder's
C solids and lines are still made, but no model holds them.
SUBROUTINE MODBEG(K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
IF (K .GT. MMOD .OR. K .LT. 1) NMODX = NMODX + 1
IF (K .GT. MMOD .OR. K .LT. 1) RETURN
MDS1(K) = NSOL + 1
MDX1(K) = NXL + 1
MDHL(K) = 1
MDBLD = K
RETURN
END
C
SUBROUTINE MODEND(K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
IF (K .GT. MMOD .OR. K .LT. 1) RETURN
MDS2(K) = NSOL
MDX2(K) = NXL
IF (K .GT. NMOD) NMOD = K
RETURN
END
C
C KLMPL: the LM model placed this frame (KLMD, KLMS or KLMA), else
C 0. KCSPL: the same for the CSM (KCSM, or the CM alone, KCMO);
C KSIVPL the S-IVB (KSIV, or the launch stack before separation,
C KSTK; both in SIVBMD's body frame).
INTEGER FUNCTION KLMPL()
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
KLMPL = 0
IF (MDON(KLMD) .EQ. 1) KLMPL = KLMD
IF (MDON(KLMS) .EQ. 1) KLMPL = KLMS
IF (MDON(KLMA) .EQ. 1) KLMPL = KLMA
RETURN
END
C
INTEGER FUNCTION KCSPL()
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
KCSPL = 0
IF (MDON(KCSM) .EQ. 1) KCSPL = KCSM
IF (MDON(KCMO) .EQ. 1) KCSPL = KCMO
RETURN
END
C
INTEGER FUNCTION KSIVPL()
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
KSIVPL = 0
IF (MDON(KSIV) .EQ. 1) KSIVPL = KSIV
IF (MDON(KSTK) .EQ. 1) KSIVPL = KSTK
RETURN
END
C
C-----------------------------------------------------------------------
C LMBODY: the LM's stages, body axes X up, Y right, Z forward, the
C descent stage base at X = 0: the descent stage (LMDSC, solid
C IS0+1), then the ascent stage (LMASC, solids IS0+2 .. IS0+8).
C LMASC alone is the ascent stage after lift-off (KLMA), in the
C same body frame. The hatch is a mark on the lower cabin's front
C (ascent solid 1, face 10, its +Z cap), the windows on the upper
C cabin's (ascent solid 7, face 8).
C The ascent stage is placed by Grumman's LM inch stations (Lunar
C Module Structures ... Study Guide, course 30915, 2-15-67, "SG"):
C "a design reference point given as the X 200.00 inch station"
C (SG p. 5), drawn at the top of the descent stage (SG Fig. 3, p.
C 4), is our 1.7 m, so X = 1.7 + 0.0254 (XSTA - 200) m; Y and Z
C stations are Y and Z, 0 on the thrust axis, "+Z being forward"
C (SG p. 5). "The aft bulkhead/frame of the crew
C compartment, which mates with the midsection, is designated as
C station +Z27.000. The front face assembly is mounted ... at an
C angle; the lower end at station +Z64.557 angling to ... 86.180
C at the top" (SG p. 10); midsection decks at "+X294.643 and
C +X233,500" (same page); the cabin "cylindrical (92 inches in
C diameter and 42 inches deep)" (Grumman, Apollo News Reference:
C Lunar Module, 1969, "LMNR", p. LV-3). Ours: the cabin's axis
C at X 3.0 m (from SG Fig. 13), the front's knee at X 3.021, the
C octagons and the outside of the midsection and aft bay.
C-----------------------------------------------------------------------
SUBROUTINE LMBODY
CALL LMDSC
CALL LMASC
RETURN
END
C
C LMDSC: the descent stage, solid 1 of LMBODY.
SUBROUTINE LMDSC
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P(2,8)
C 1 descent stage: octagon 4.2 m across, X 0 .. 1.7.
CALL OCTAG(2.1D0, 2.1D0, 0.9D0, P)
CALL SETV(O, 0.0D0, 0.0D0, 0.0D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL MKPRS(8, P, O, A1, A2, AN, 1.7D0)
RETURN
END
C
C LMASC: the ascent stage, solids 2 .. 8 of LMBODY (1 .. 7 here),
C with its window and hatch marks.
SUBROUTINE LMASC
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P(2,8), W(2,3)
DOUBLE PRECISION Q(2,6), C(2), F, ZF, LMWIN
INTEGER IS0, IC, IU, K, J
DATA Q / 1.168D0, 0.0D0, 1.168D0, 0.463D0, 0.484D0, 1.147D0,
& -0.484D0, 1.147D0, -1.168D0, 0.463D0, -1.168D0, 0.0D0 /
IS0 = NSOL
IC = IS0 + 1
IU = IS0 + 7
C
C 2 crew cabin, an octagon about the 92 in cylinder, from the aft
C bulkhead (Z27) to the lower front face (Z64.557).
CALL OCTAG(1.168D0, 1.168D0, 0.684D0, P)
CALL SETV(O, 3.0D0, 0.0D0, 0.686D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 1.0D0, 0.0D0, 0.0D0)
CALL SETV(AN, 0.0D0, 0.0D0, 1.0D0)
CALL MKPRS(8, P, O, A1, A2, AN, 0.954D0)
C 3 midsection, Z27 aft to Z27 forward, its top the upper deck
C (X294.643).
CALL OCTAG(1.2D0, 1.102D0, 0.3D0, P)
CALL SETV(O, 3.002D0, 0.0D0, -0.686D0)
CALL MKPRS(8, P, O, A1, A2, AN, 1.372D0)
C 4 aft equipment bay, behind the aft bulkhead to Z-65.515 (SG
C Fig. 10, "-Z65.515 (REF)").
CALL OCTAG(1.55D0, 0.5D0, 0.05D0, P)
CALL SETV(O, 3.1D0, 0.0D0, -1.664D0)
CALL MKPRS(8, P, O, A1, A2, AN, 0.978D0)
C 5 docking tunnel on the thrust axis, "32 inches in diameter and
C 16 inches long" (LMNR p. LV-6) above the upper deck; its base
C sunk 0.1 m into the midsection.
CALL OCTAG(0.406D0, 0.406D0, 0.168D0, P)
CALL SETV(O, 4.0D0, 0.0D0, 0.0D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL MKPRS(8, P, O, A1, A2, AN, 0.51D0)
C 6, 7 propellant tank bulges, left and right.
CALL OCTAG(0.6D0, 0.6D0, 0.25D0, P)
CALL SETV(O, 2.55D0, -1.2D0, 0.0D0)
CALL SETV(A1, 1.0D0, 0.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 0.0D0, -1.0D0, 0.0D0)
CALL MKPRS(8, P, O, A1, A2, AN, 0.65D0)
CALL SETV(O, 2.55D0, 1.2D0, 0.0D0)
CALL SETV(AN, 0.0D0, 1.0D0, 0.0D0)
CALL MKPRS(8, P, O, A1, A2, AN, 0.65D0)
C 8 the cabin's upper front, above the knee, out to the slanted
C face (Z64.557 at the knee to Z86.180 at the top); its base
C inside solid 2.
CALL SETV(O, 3.021D0, 0.0D0, 1.2D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 1.0D0, 0.0D0, 0.0D0)
CALL SETV(AN, 0.0D0, 0.0D0, 1.0D0)
CALL MKWDG(6, Q, O, A1, A2, AN, 0.44D0, 0.4784D0)
C
C Windows: two triangles on the upper front, "approximately 2
C square feet of viewing area" each (LMNR p. LV-4): the window
C frames (LMWIN) grown to that area about their centre and carried
C forward onto the face (ours).
DO 20 J = -1, 1, 2
DO 10 K = 1, 3
W(1,K) = DBLE(J) * LMWIN(2,K)
W(2,K) = LMWIN(1,K)
10 CONTINUE
C(1) = (W(1,1) + W(1,2) + W(1,3)) / 3.0D0
C(2) = (W(2,1) + W(2,2) + W(2,3)) / 3.0D0
F = 1.265D0
DO 15 K = 1, 3
W(1,K) = C(1) + F * (W(1,K) - C(1))
W(2,K) = C(2) + F * (W(2,K) - C(2))
15 CONTINUE
DO 18 K = 1, 3
CALL XLINE(W(1,K), W(2,K), ZF(W(2,K)),
& W(1,MOD(K,3)+1), W(2,MOD(K,3)+1), ZF(W(2,MOD(K,3)+1)), IU)
LXF(NXL) = 8
18 CONTINUE
20 CONTINUE
C Hatch on the lower front, "approximately 32 inches square"
C (LMNR p. LV-4), its sill at the cabin floor (ours).
CALL XLINE(-0.406D0, 2.094D0, 1.64D0, 0.406D0, 2.094D0, 1.64D0,
& IC)
CALL XLINE(0.406D0, 2.094D0, 1.64D0, 0.406D0, 2.906D0, 1.64D0,
& IC)
CALL XLINE(0.406D0, 2.906D0, 1.64D0, -0.406D0, 2.906D0, 1.64D0,
& IC)
CALL XLINE(-0.406D0, 2.906D0, 1.64D0, -0.406D0, 2.094D0, 1.64D0,
& IC)
RETURN
END
C
C ZF: Z of the LM's front face at height X (m): Z64.557 up to the
C knee at X 3.021 (ours), then slanting to Z86.180 at the cabin's
C top (SG p. 10).
DOUBLE PRECISION FUNCTION ZF(X)
DOUBLE PRECISION X
ZF = 1.64D0
IF (X .GT. 3.021D0) ZF = 1.64D0 + 0.4784D0 * (X - 3.021D0)
RETURN
END
C
C LMWIN: corner K (1 inboard top, 2 bottom, 3 outboard) of the
C commander's window frame, coordinate I (X, Y, Z) in LM body
C metres; the LM pilot's is its mirror in Y. Rays from the design
C eye (LDEYE) along the corners of SG Fig. 25 (p. 35, "visual
C elevation" +10 to -65 deg, heading 12 deg inboard to about 80
C outboard), ended where they meet the window's outline on SG Fig.
C 7 (p. 11; corners read by eye): our construction.
DOUBLE PRECISION FUNCTION LMWIN(I, K)
INTEGER I, K
DOUBLE PRECISION W(3,3)
DATA W / 3.778D0, -0.483D0, 1.730D0, 3.249D0, -0.533D0, 1.585D0,
& 3.727D0, -0.813D0, 1.425D0 /
LMWIN = W(I,K)
RETURN
END
C
C-----------------------------------------------------------------------
C LMGEAR: landing gear as free lines. ISTOW = 0 deployed: on the
C diagonals a primary strut, two secondaries and a pad.
C ISTOW = 1 stowed. "In a retracted position until after the
C crew mans the LM, the landing gear struts are explosively
C extended" (Apollo 11 press kit, NASA release 69-83K, printed
C p. 103). How the folded gear lay is our guess: each primary
C strut runs up from its outrigger to a pad beside the ascent
C stage, the pad (37 in across, same page) square to the LM X
C axis; the secondaries are left out.
C-----------------------------------------------------------------------
SUBROUTINE LMGEAR(ISTOW)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER ISTOW
DOUBLE PRECISION SX, SZ, R0, R1, X0, X1, Q, C, S, C2, S2
INTEGER I, K
IF (ISTOW .EQ. 1) GO TO 30
DO 20 K = 0, 3
C = DCOS((45.0D0 + 90.0D0 * DBLE(K)) * DR)
S = DSIN((45.0D0 + 90.0D0 * DBLE(K)) * DR)
R0 = 2.33D0
R1 = 4.3D0
X0 = 1.5D0
X1 = -1.0D0
CALL XLINE(R0 * C, X0, R0 * S, R1 * C, X1, R1 * S, 0)
Q = 3.5D0
SX = Q * C
SZ = Q * S
CALL XLINE(SX, -0.45D0, SZ, 2.1D0 * DSIGN(1.0D0, C), 0.2D0,
& 1.2D0 * DSIGN(1.0D0, S), 0)
CALL XLINE(SX, -0.45D0, SZ, 1.2D0 * DSIGN(1.0D0, C), 0.2D0,
& 2.1D0 * DSIGN(1.0D0, S), 0)
DO 10 I = 0, 7
CALL XLINE(R1 * C + 0.45D0 * DCOS(DBLE(I) * PI / 4.0D0),
& X1 - 0.1D0, R1 * S + 0.45D0 * DSIN(DBLE(I) * PI / 4.0D0),
& R1 * C + 0.45D0 * DCOS(DBLE(I + 1) * PI / 4.0D0),
& X1 - 0.1D0,
& R1 * S + 0.45D0 * DSIN(DBLE(I + 1) * PI / 4.0D0), 0)
10 CONTINUE
20 CONTINUE
RETURN
30 DO 40 K = 0, 3
C = DCOS((45.0D0 + 90.0D0 * DBLE(K)) * DR)
S = DSIN((45.0D0 + 90.0D0 * DBLE(K)) * DR)
CALL XLINE(2.33D0 * C, 1.5D0, 2.33D0 * S,
& 2.3D0 * C, 2.2D0, 2.3D0 * S, 0)
DO 35 I = 0, 11
C2 = DCOS(DBLE(I) * PI / 6.0D0) * 0.47D0
S2 = DSIN(DBLE(I) * PI / 6.0D0) * 0.47D0
CALL XLINE(2.3D0 * C + C2, 2.2D0, 2.3D0 * S + S2,
& 2.3D0 * C + DCOS(DBLE(I + 1) * PI / 6.0D0) * 0.47D0, 2.2D0,
& 2.3D0 * S + DSIN(DBLE(I + 1) * PI / 6.0D0) * 0.47D0, 0)
35 CONTINUE
40 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C LMDOCK: docking drogue and CSM-active docking target, as marks
C on the LM model LMBODY (or LMASC) has just built (tunnel = its
C solid 5, midsection = its solid 3, of 8; of LMASC's 7, 4 and 2).
C Drogue, a cone in the tunnel's +X cap (face 10): "a conical
C drogue mounted in the LM docking tunnel", which is 32 in across
C (press kit, printed p. 88 and p. 101). Depth: ours.
C Target for the CSM's crewman optical alignment sight (COAS): a
C disc on the midsection top (face 3) with a cross on a standoff
C above it, set off from the tunnel axis by as much as the COAS
C line of sight is from the CSM's docking axis (S7POSE), so it
C sits on the boresight. Size, standoff and offset: our guess.
C-----------------------------------------------------------------------
SUBROUTINE LMDOCK
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION C, S, C2, S2
INTEGER K, IT, IM
IT = NSOL - 3
IM = NSOL - 5
DO 70 K = 0, 11
C = DCOS(DBLE(K) * PI / 6.0D0)
S = DSIN(DBLE(K) * PI / 6.0D0)
C2 = DCOS(DBLE(K + 1) * PI / 6.0D0)
S2 = DSIN(DBLE(K + 1) * PI / 6.0D0)
CALL XLINE(0.4D0 * C, 4.51D0, 0.4D0 * S,
& 0.4D0 * C2, 4.51D0, 0.4D0 * S2, IT)
CALL XLINE(0.06D0 * C, 4.21D0, 0.06D0 * S,
& 0.06D0 * C2, 4.21D0, 0.06D0 * S2, IT)
IF (MOD(K, 3) .EQ. 0) CALL XLINE(0.4D0 * C, 4.51D0,
& 0.4D0 * S, 0.06D0 * C, 4.21D0, 0.06D0 * S, IT)
70 CONTINUE
DO 80 K = 0, 11
C = 0.18D0 * DCOS(DBLE(K) * PI / 6.0D0)
S = 0.18D0 * DSIN(DBLE(K) * PI / 6.0D0)
C2 = 0.18D0 * DCOS(DBLE(K + 1) * PI / 6.0D0)
S2 = 0.18D0 * DSIN(DBLE(K + 1) * PI / 6.0D0)
CALL XLINE(-0.72D0 + C, 4.104D0, S,
& -0.72D0 + C2, 4.104D0, S2, IM)
LXF(NXL) = 3
80 CONTINUE
CALL XLINE(-0.82D0, 4.554D0, 0.0D0, -0.62D0, 4.554D0, 0.0D0, 0)
CALL XLINE(-0.72D0, 4.554D0, -0.1D0, -0.72D0, 4.554D0, 0.1D0, 0)
RETURN
END
C
C-----------------------------------------------------------------------
C LMRCS: the four RCS thruster clusters, after LMBODY (and LMGEAR,
C LMDOCK, which count back from LMBODY's last solid). "The four
C reaction control engine clusters are mounted on truss members
C extending from both sides of the crew compartment (two forward
C clusters) and both sides of the midsection (two aft clusters)"
C (SG p. 8). The forward ones on "tubular truss members bolted to
C both sides of the front face assembly. A truss member extends
C aft and is secured to a longeron located at the compartment's
C maximum breadth" (SG p. 10); the aft ones on "truss members
C bolted to the upper and lower corners of the equipment rack
C assembly and to the -Z27 bulkhead" (SG p. 16). Each cluster
C has four nozzles, up, down, outboard and fore (forward pair) or
C aft (aft pair): our reading of SG Fig. 1 (p. 2), "RCS thruster
C assembly", and of MSC IN 69-FM-197, fig. 6.1-1(c) (printed p.
C 97), where each cluster is a circle (a nozzle seen end on) and
C two horns. Cluster centres, heights read off SG Fig. 1 (about
C the cabin's axis), the housing (a 0.3 m block) and the nozzles
C (0.35 m long, 0.09 to 0.22 m across) are ours; so are the truss
C ends, put on our LMBODY solids where the text puts them.
C Solids: a housing and four frusta per cluster, 20 in all.
C-----------------------------------------------------------------------
SUBROUTINE LMRCS
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P(2,8)
DOUBLE PRECISION CX(4), CY(4), CZ(4), SY, SZ, HB, YI
INTEGER J
DATA CX / 3.0D0, 3.0D0, 3.1D0, 3.1D0 /
DATA CY / 1.55D0, -1.55D0, 1.85D0, -1.85D0 /
DATA CZ / 1.30D0, 1.30D0, -1.25D0, -1.25D0 /
HB = 0.15D0
CALL OCTAG(HB, HB, 0.03D0, P)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
DO 40 J = 1, 4
SY = DSIGN(1.0D0, CY(J))
SZ = DSIGN(1.0D0, CZ(J))
CALL SETV(O, CX(J) - HB, CY(J), CZ(J))
CALL MKPRS(8, P, O, A1, A2, AN, 2.0D0 * HB)
CALL RCSNZ(CX(J), CY(J), CZ(J), 1, 1.0D0, HB)
CALL RCSNZ(CX(J), CY(J), CZ(J), 1, -1.0D0, HB)
CALL RCSNZ(CX(J), CY(J), CZ(J), 2, SY, HB)
CALL RCSNZ(CX(J), CY(J), CZ(J), 3, SZ, HB)
C Trusses from the housing's inboard face.
YI = CY(J) - SY * HB
IF (J .GT. 2) GO TO 30
CALL XLINE(YI, CX(J), CZ(J), SY * 1.168D0, 2.8D0, 1.6D0, 0)
CALL XLINE(YI, CX(J), CZ(J), SY * 1.168D0, 3.2D0, 1.6D0, 0)
CALL XLINE(YI, CX(J), CZ(J), SY * 1.168D0, 3.0D0, 0.7D0, 0)
GO TO 40
30 CALL XLINE(YI, CX(J), CZ(J), SY * 1.55D0, 3.6D0, -1.664D0, 0)
CALL XLINE(YI, CX(J), CZ(J), SY * 1.55D0, 2.6D0, -1.664D0, 0)
CALL XLINE(YI, CX(J), CZ(J), SY * 1.2D0, 3.1D0, -0.686D0, 0)
40 CONTINUE
RETURN
END
C
C RCSNZ: one RCS nozzle (RCSNV) from the LM cluster housing (half
C size HB) about X, Y, Z (m), firing along body axis IA (1 X, 2 Y,
C 3 Z) with sign SG.
SUBROUTINE RCSNZ(X, Y, Z, IA, SG, HB)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X, Y, Z, SG, HB
INTEGER IA
DOUBLE PRECISION A1(3), A2(3), AN(3)
INTEGER I1, I2
CALL SETV(AN, 0.0D0, 0.0D0, 0.0D0)
CALL SETV(A1, 0.0D0, 0.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 0.0D0)
I1 = MOD(IA, 3) + 1
I2 = MOD(IA + 1, 3) + 1
AN(IA) = SG
A1(I1) = 1.0D0
A2(I2) = 1.0D0
CALL RCSNV(X, Y, Z, AN, A1, A2, HB)
RETURN
END
C
C RCSNV: one RCS nozzle, an 8-sided frustum from the face of a
C cluster housing (half size HB) about X, Y, Z (m), firing along
C unit AN, its octagon in axes A1, A2. Sizes: ours.
SUBROUTINE RCSNV(X, Y, Z, AN, A1, A2, HB)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X, Y, Z, AN(3), A1(3), A2(3), HB
DOUBLE PRECISION O(3), Q(2,8)
INTEGER K
DO 10 K = 1, 8
Q(1,K) = 0.045D0 * DCOS(DBLE(K) * PI / 4.0D0)
Q(2,K) = 0.045D0 * DSIN(DBLE(K) * PI / 4.0D0)
10 CONTINUE
CALL SETV(O, X, Y, Z)
DO 20 K = 1, 3
O(K) = O(K) + AN(K) * (HB - 0.01D0)
20 CONTINUE
CALL MKFRU(8, Q, O, A1, A2, AN, 0.35D0, 0.11D0 / 0.045D0)
RETURN
END
C
C-----------------------------------------------------------------------
C LMANT: the ascent stage's two dish antennas as free lines, each a
C rim and a hub ring facing +X on a post, as MSC IN 69-FM-197 draws
C them from above (fig. 6.1-1(c), printed p. 97: a circle in a
C circle). Rendezvous radar: "Attached to a movable mounting
C secured to the curved bulkhead top side of the crew compartment
C just above the front face assembly" (SG p. 44), "on the upper
C structural beams of the crew compartment" (LMNR p. LV-3); a
C little right of the centreline, our reading of SG Fig. 1 (p. 2).
C S-band steerable: "On extended truss members secured to the
C upper right structure of the Midsection" (SG p. 44). Dish sizes
C (0.6 and 0.66 m), heights, the trusses' ends and the dishes
C facing +X (stowed, or turned to the CSM) are ours.
C-----------------------------------------------------------------------
SUBROUTINE LMANT
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION C(3)
C Rendezvous radar on a post from the cabin top.
CALL XLINE(0.3D0, 4.168D0, 1.85D0, 0.3D0, 4.45D0, 1.85D0, 0)
CALL SETV(C, 4.55D0, 0.3D0, 1.85D0)
CALL XRING(C, 1, 0.3D0, 16)
CALL SETV(C, 4.45D0, 0.3D0, 1.85D0)
CALL XRING(C, 1, 0.08D0, 8)
C S-band steerable: three truss members to a gimbal, a post, dish.
CALL XLINE(1.2D0, 3.804D0, 0.0D0, 1.45D0, 4.35D0, -0.3D0, 0)
CALL XLINE(1.2D0, 3.804D0, -0.6D0, 1.45D0, 4.35D0, -0.3D0, 0)
CALL XLINE(0.9D0, 4.104D0, -0.3D0, 1.45D0, 4.35D0, -0.3D0, 0)
CALL XLINE(1.45D0, 4.35D0, -0.3D0, 1.45D0, 4.5D0, -0.3D0, 0)
CALL SETV(C, 4.6D0, 1.45D0, -0.3D0)
CALL XRING(C, 1, 0.33D0, 16)
CALL SETV(C, 4.5D0, 1.45D0, -0.3D0)
CALL XRING(C, 1, 0.08D0, 8)
RETURN
END
C
C-----------------------------------------------------------------------
C SIVBMD: S-IVB with the instrument unit on top, body axes X
C forward along the stage, origin at the centre of the top of the
C IU. One prism of 24 sides: both 21.7 ft across, 58.3 ft and
C 3 ft high (Apollo 11 press kit, printed p. 109; SIVBH, SIUH and
C SLVD in viewcom.inc).
C The SLA's fixed lower ring, left on the IU when the four upper
C panels were jettisoned at separation (AS-506 launch vehicle
C flight evaluation report, MPR-SAT-FE-69-9, p. xxiii; Apollo 11
C Flight Journal, 003:18:19). The SLA "is a truncated cone 28
C feet long tapering from 260 inches diameter at the base to 154
C inches at the forward end" (press kit, printed p. 88). The
C fixed panels are 7 ft high (secondary source: Wikipedia, "Apollo
C (spacecraft)"), so the ring's top is 233.5 in across. The
C jettisoned panels are not drawn; by the approach they had drifted
C off (our choice). Rim and four panel joints, the joints on the
C Y and Z axes (our guess).
C-----------------------------------------------------------------------
SUBROUTINE SIVBMD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P24(2,24)
DOUBLE PRECISION RIU, XSL, RSL, Q, C, S, C2, S2
INTEGER K
RIU = 0.5D0 * SLVD * 0.0254D0
DO 50 K = 1, 24
P24(1,K) = RIU * DCOS(DBLE(K) * PI / 12.0D0)
P24(2,K) = RIU * DSIN(DBLE(K) * PI / 12.0D0)
50 CONTINUE
Q = (SIVBH + SIUH) * 0.3048D0
CALL SETV(O, -Q, 0.0D0, 0.0D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL MKPRS(24, P24, O, A1, A2, AN, Q)
XSL = 7.0D0 * 0.3048D0
RSL = 0.5D0 * (SLVD - (SLVD - SLATD) * 7.0D0 / SLAH) * 0.0254D0
DO 60 K = 0, 23
C = DCOS(DBLE(K) * PI / 12.0D0)
S = DSIN(DBLE(K) * PI / 12.0D0)
C2 = DCOS(DBLE(K + 1) * PI / 12.0D0)
S2 = DSIN(DBLE(K + 1) * PI / 12.0D0)
CALL XLINE(RSL * C, XSL, RSL * S, RSL * C2, XSL, RSL * S2, 0)
IF (MOD(K, 6) .EQ. 0) CALL XLINE(0.99D0 * RIU * C, 0.01D0,
& 0.99D0 * RIU * S, RSL * C, XSL, RSL * S, 0)
60 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C LVSTK: the launch vehicle's stack above the S-II, as the CSM rode
C it from launch to the separation (SEP): the S-IVB, the IU and the
C closed SLA, which housed the LM ("a housing for the lunar module",
C press kit, printed p. 86). SIVBMD's body frame: X forward along
C the vehicle, origin at the centre of the top of the IU, metres.
C Plain primitives from the published overall sizes (viewcom.inc;
C press kit, printed pp. 88, 109, 113), each its own solid along X
C (LVCYL, LVFRU), the stages below it models of their own (LVSII,
C LVSIC):
C S-IVB and IU, one cylinder SIVBH + SIUH ft long, SLVD in
C across, X from -(SIVBH + SIUH) ft to 0;
C SLA, a frustum SLAH ft long from SLVD in across at X 0 to
C SLATD in, the SM's own 154 in (12 ft 10 in, press kit printed
C p. 88), at its top, where it meets the SM's aft end (SMAFT).
C Rough by design (the operator's call, #70): no panel joints, LM
C supports or antennas; the LM inside is hidden, so not built.
C Smooth solids (LSMO), as the CSM's: only outlines and rims show.
C-----------------------------------------------------------------------
SUBROUTINE LVSTK
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION FT
FT = 0.3048D0
CALL LVCYL(-(SIVBH + SIUH) * FT, (SIVBH + SIUH) * FT, SLVD)
CALL LVFRU(0.0D0, SLAH * FT, SLVD, SLATD / SLVD)
RETURN
END
C
C-----------------------------------------------------------------------
C LVSII, LVSIC: the S-II and the S-IC below the stack (#97), each
C its own model so that it drops at its separation (vdrive.f LVPL),
C in SIVBMD's body frame as LVSTK: smooth cylinders SICD in across,
C SIIH and SICH ft long (Apollo 11 press kit, printed p. 109;
C viewcom.inc). The S-II/S-IVB interstage, the taper from 33 ft to
C 21 ft 8 in, is the S-II's top SIIIS ft, one smooth frustum
C (LVFRU) on the cylinder, which is that much shorter: no source
C we hold gives its length (the press kit lists its weight only),
C so the 18 ft and the choice to count it in the S-II's 81.5 ft
C are ours, and the stack's height is unchanged (mpad.f PADHC).
C No fins, engines or fairings.
C-----------------------------------------------------------------------
SUBROUTINE LVSII
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION FT
FT = 0.3048D0
CALL LVCYL(-(SIVBH + SIUH + SIIH) * FT, (SIIH - SIIIS) * FT,
& SICD)
CALL LVFRU(-(SIVBH + SIUH + SIIIS) * FT, SIIIS * FT, SICD,
& SLVD / SICD)
RETURN
END
C
SUBROUTINE LVSIC
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION FT
FT = 0.3048D0
CALL LVCYL(-(SIVBH + SIUH + SIIH + SICH) * FT, SICH * FT, SICD)
RETURN
END
C
C-----------------------------------------------------------------------
C LESBLD: the launch escape system on the CM (#97), in CSMBLD's
C body frame, by the Apollo Operations Handbook's stations (Fig.
C 1-2, p. 1-5; LESXC to LESTP in viewcom.inc): the LES-CM
C separation plane at CM station 83.476 in (X = 0.0254 (Xc - 18)
C m, as CMINT), the tower to LES station 118.3, the skirt to 138.0,
C the motor to 363.7 and the tip at 400.762, "33 feet tall, four
C feet in diameter at the base" (press kit, printed p. 86). Plain
C primitives: the open-frame tower a square frustum, 48 in (LESBD)
C across at its base to 36 in at its top; the skirt a frustum from
C 48 in to the motor's 27 in; the motor a cylinder 27 in across;
C the nose a frustum to the Q-ball, 4 in. The widths but LESBD
C are ours, measured on the handbook's figure; the canards and the
C boost protective cover over the CM are not drawn.
C-----------------------------------------------------------------------
SUBROUTINE LESBLD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X0, HB, DM
X0 = 0.0254D0 * (LESXC - 18.0D0)
HB = 0.5D0 * LESBD * 0.0254D0
DM = 27.0D0
CALL MKBOX(X0, LESTW * 0.0254D0, 0.0D0, 0.0D0, HB, HB,
& 36.0D0 / LESBD)
CALL LVFRU(X0 + LESTW * 0.0254D0, (LESSK - LESTW) * 0.0254D0,
& LESBD, DM / LESBD)
CALL LVCYL(X0 + LESSK * 0.0254D0, (LESMO - LESSK) * 0.0254D0,
& DM)
CALL LVFRU(X0 + LESMO * 0.0254D0, (LESTP - LESMO) * 0.0254D0,
& DM, 4.0D0 / DM)
RETURN
END
C
C LVFRU: a smooth 24-sided frustum on the X axis from X0 for H (m),
C D inches across at X0, its top scaled by SC.
SUBROUTINE LVFRU(X0, H, D, SC)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X0, H, D, SC, O(3), A1(3), A2(3), AN(3), P(2,24)
DOUBLE PRECISION R
INTEGER K
R = 0.5D0 * D * 0.0254D0
DO 10 K = 1, 24
P(1,K) = R * DCOS(DBLE(K) * PI / 12.0D0)
P(2,K) = R * DSIN(DBLE(K) * PI / 12.0D0)
10 CONTINUE
CALL SETV(O, X0, 0.0D0, 0.0D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL MKFRU(24, P, O, A1, A2, AN, H, SC)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
RETURN
END
C
C LVCYL: one stage of the stack, a smooth 24-sided prism on the X
C axis from X0 for H (m), D inches across.
SUBROUTINE LVCYL(X0, H, D)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X0, H, D, O(3), A1(3), A2(3), AN(3), P(2,24)
DOUBLE PRECISION R
INTEGER K
R = 0.5D0 * D * 0.0254D0
DO 10 K = 1, 24
P(1,K) = R * DCOS(DBLE(K) * PI / 12.0D0)
P(2,K) = R * DSIN(DBLE(K) * PI / 12.0D0)
10 CONTINUE
CALL SETV(O, X0, 0.0D0, 0.0D0)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL MKPRS(24, P, O, A1, A2, AN, H)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
RETURN
END
C
C XLINE: free line (IS=0) or mark on face LXF (10 unless set
C after the call: the cap of an 8-sided prism) of solid IS, given
C as Y, X, Z in the model's body metres.
SUBROUTINE XLINE(Y1, X1, Z1, Y2, X2, Z2, IS)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION Y1, X1, Z1, Y2, X2, Z2
INTEGER IS
LXOK = 0
IF (NXL .GE. MXL) NXLX = NXLX + 1
IF (NXL .GE. MXL) RETURN
LXOK = 1
NXL = NXL + 1
LXL(1,NXL) = X1
LXL(2,NXL) = Y1
LXL(3,NXL) = Z1
LXL(4,NXL) = X2
LXL(5,NXL) = Y2
LXL(6,NXL) = Z2
LXS(NXL) = IS
LXF(NXL) = 10
RETURN
END
C
C OCTAG: chamfered rectangle, half sizes A by B, chamfer C, as 8
C points counter-clockwise (duplicates when C = 0 are harmless).
SUBROUTINE OCTAG(A, B, C, P)
DOUBLE PRECISION A, B, C, P(2,8)
P(1,1) = A
P(2,1) = -B + C
P(1,2) = A
P(2,2) = B - C
P(1,3) = A - C
P(2,3) = B
P(1,4) = -A + C
P(2,4) = B
P(1,5) = -A
P(2,5) = B - C
P(1,6) = -A
P(2,6) = -B + C
P(1,7) = -A + C
P(2,7) = -B
P(1,8) = A - C
P(2,8) = -B
RETURN
END
C
C MKPRS: prism over polygon P (NP points in axes A1, A2 about O),
C extruded H along AN. Faces 1..NP sides, NP+1 base, NP+2 cap,
C the base's plane through its points 1, 3 and 6 (4 for a box).
C Its edges are all real (LSMO = 0); a caller building a curved
C surface sets LSMO(NSOL) = 1 after the call (as MKFRU's), if
C the call added it (LBOK).
SUBROUTINE MKPRS(NP, P, O, A1, A2, AN, H)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER NP
DOUBLE PRECISION P(2,NP), O(3), A1(3), A2(3), AN(3), H
DOUBLE PRECISION CEN(3), E1(3), E2(3), N(3), D, VDOT
INTEGER I, K, K2, IS, IA, IB, IC, NE
C A full model table takes no more solids (as XLINE takes no more
C lines).
LBOK = 0
IF (NSOL .GE. MSOL) NSOLX = NSOLX + 1
IF (NSOL .GE. MSOL) RETURN
LBOK = 1
NSOL = NSOL + 1
IS = NSOL
NLV(IS) = 2 * NP
NLF(IS) = NP + 2
LSMO(IS) = 0
DO 20 K = 1, NP
DO 10 I = 1, 3
LMV(I,K,IS) = O(I) + P(1,K) * A1(I) + P(2,K) * A2(I)
LMV(I,K+NP,IS) = LMV(I,K,IS) + H * AN(I)
10 CONTINUE
20 CONTINUE
DO 25 I = 1, 3
CEN(I) = O(I) + 0.5D0 * H * AN(I)
25 CONTINUE
C Face planes, oriented away from the centre.
DO 40 K = 1, NP + 2
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (K .LE. NP) THEN
K2 = MOD(K, NP) + 1
IA = K
IB = K2
IC = K + NP
ELSE IF (K .EQ. NP + 1) THEN
IA = 1
IB = 3
IC = MIN0(NP, 6)
ELSE
IA = 1 + NP
IB = 3 + NP
IC = MIN0(NP, 6) + NP
END IF
C RESTOMOD END
DO 30 I = 1, 3
E1(I) = LMV(I,IB,IS) - LMV(I,IA,IS)
E2(I) = LMV(I,IC,IS) - LMV(I,IA,IS)
30 CONTINUE
CALL VCRS(E1, E2, N)
CALL VUNIT(N)
D = VDOT(N, LMV(1,IA,IS))
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (D - VDOT(N, CEN) .LT. 0.0D0) THEN
DO 35 I = 1, 3
N(I) = -N(I)
35 CONTINUE
D = -D
END IF
C RESTOMOD END
DO 38 I = 1, 3
LMN(I,K,IS) = N(I)
38 CONTINUE
LMD(K,IS) = D
40 CONTINUE
C Edges: base, top, uprights.
NE = 0
DO 50 K = 1, NP
K2 = MOD(K, NP) + 1
NE = NE + 1
LME(1,NE,IS) = K
LME(2,NE,IS) = K2
LME(3,NE,IS) = K
LME(4,NE,IS) = NP + 1
NE = NE + 1
LME(1,NE,IS) = K + NP
LME(2,NE,IS) = K2 + NP
LME(3,NE,IS) = K
LME(4,NE,IS) = NP + 2
NE = NE + 1
LME(1,NE,IS) = K
LME(2,NE,IS) = K + NP
LME(3,NE,IS) = K
LME(4,NE,IS) = MOD(K + NP - 2, NP) + 1
50 CONTINUE
NLE(IS) = NE
RETURN
END
C
C-----------------------------------------------------------------------
C MKFRU: frustum over polygon P (NP points in axes A1, A2 about O),
C reaching H along AN with the top polygon scaled by SC; faces and
C edges numbered as MKPRS's (1..NP sides, NP+1 base, NP+2 top).
C-----------------------------------------------------------------------
SUBROUTINE MKFRU(NP, P, O, A1, A2, AN, H, SC)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER NP
DOUBLE PRECISION P(2,NP), O(3), A1(3), A2(3), AN(3), H, SC
DOUBLE PRECISION CEN(3), E1(3), E2(3), N(3), D, VDOT
INTEGER I, K, K2, IS, IA, IB, IC, NE
C A full model table takes no more solids (as XLINE takes no more
C lines).
LBOK = 0
IF (NSOL .GE. MSOL) NSOLX = NSOLX + 1
IF (NSOL .GE. MSOL) RETURN
LBOK = 1
NSOL = NSOL + 1
IS = NSOL
NLV(IS) = 2 * NP
NLF(IS) = NP + 2
LSMO(IS) = 0
DO 20 K = 1, NP
DO 10 I = 1, 3
LMV(I,K,IS) = O(I) + P(1,K) * A1(I) + P(2,K) * A2(I)
LMV(I,K+NP,IS) = O(I) + H * AN(I)
& + SC * (P(1,K) * A1(I) + P(2,K) * A2(I))
10 CONTINUE
20 CONTINUE
DO 25 I = 1, 3
CEN(I) = O(I) + 0.5D0 * H * AN(I)
25 CONTINUE
DO 40 K = 1, NP + 2
K2 = MOD(K, NP) + 1
IA = K
IB = K2
IC = K + NP
IF (K .EQ. NP + 1) IA = 1
IF (K .EQ. NP + 1) IB = 3
IF (K .EQ. NP + 1) IC = MIN0(NP, 6)
IF (K .EQ. NP + 2) IA = 1 + NP
IF (K .EQ. NP + 2) IB = 3 + NP
IF (K .EQ. NP + 2) IC = MIN0(NP, 6) + NP
DO 30 I = 1, 3
E1(I) = LMV(I,IB,IS) - LMV(I,IA,IS)
E2(I) = LMV(I,IC,IS) - LMV(I,IA,IS)
30 CONTINUE
CALL VCRS(E1, E2, N)
CALL VUNIT(N)
D = VDOT(N, LMV(1,IA,IS))
IF (D - VDOT(N, CEN) .GE. 0.0D0) GO TO 36
DO 35 I = 1, 3
N(I) = -N(I)
35 CONTINUE
D = -D
36 DO 38 I = 1, 3
LMN(I,K,IS) = N(I)
38 CONTINUE
LMD(K,IS) = D
40 CONTINUE
NE = 0
DO 50 K = 1, NP
K2 = MOD(K, NP) + 1
NE = NE + 1
LME(1,NE,IS) = K
LME(2,NE,IS) = K2
LME(3,NE,IS) = K
LME(4,NE,IS) = NP + 1
NE = NE + 1
LME(1,NE,IS) = K + NP
LME(2,NE,IS) = K2 + NP
LME(3,NE,IS) = K
LME(4,NE,IS) = NP + 2
NE = NE + 1
LME(1,NE,IS) = K
LME(2,NE,IS) = K + NP
LME(3,NE,IS) = K
LME(4,NE,IS) = MOD(K + NP - 2, NP) + 1
50 CONTINUE
NLE(IS) = NE
RETURN
END
C
C MKWDG: a prism as MKPRS's, its cap tilted: top point K lies H +
C G P(2,K) along AN. The cap stays a plane, so the solid stays
C convex; the sides keep their planes.
SUBROUTINE MKWDG(NP, P, O, A1, A2, AN, H, G)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER NP
DOUBLE PRECISION P(2,NP), O(3), A1(3), A2(3), AN(3), H, G
DOUBLE PRECISION E1(3), E2(3), N(3), VDOT
INTEGER I, K, IS
LBOK = 0
IF (NSOL .GE. MSOL) NSOLX = NSOLX + 1
IF (NSOL .GE. MSOL) RETURN
LBOK = 1
CALL MKPRS(NP, P, O, A1, A2, AN, H)
IS = NSOL
DO 20 K = 1, NP
DO 10 I = 1, 3
LMV(I,K+NP,IS) = LMV(I,K+NP,IS) + G * P(2,K) * AN(I)
10 CONTINUE
20 CONTINUE
C The cap's plane again, facing along AN.
DO 30 I = 1, 3
E1(I) = LMV(I,3+NP,IS) - LMV(I,1+NP,IS)
E2(I) = LMV(I,MIN0(NP, 6)+NP,IS) - LMV(I,1+NP,IS)
30 CONTINUE
CALL VCRS(E1, E2, N)
CALL VUNIT(N)
IF (VDOT(N, AN) .GE. 0.0D0) GO TO 36
DO 35 I = 1, 3
N(I) = -N(I)
35 CONTINUE
36 DO 38 I = 1, 3
LMN(I,NP+2,IS) = N(I)
38 CONTINUE
LMD(NP+2,IS) = VDOT(N, LMV(1,1+NP,IS))
RETURN
END
C
C-----------------------------------------------------------------------
C CSMBLD: the command and service module, hidden-line solids like
C the LM's. Body axes X along the stack toward the CM apex, Y and
C Z across (Apollo CSM convention: the RCS quads sit near +-Y and
C +-Z, below); origin on the axis where the CM is widest, X =
C 0.0254 (Xc - 18) m as CMINT, metres. Sources (CSM News
C Reference, North American Rockwell 1969, "NR"; Apollo Operations
C Handbook SM2A-03-Block II-(1), 1969, "AOH"; Apollo 11 press kit,
C "PK"), where they disagree the one used is named:
C CM: CMBLD (solids 1 to 3, its windows and hatch), then the
C docking probe: an 8-sided frustum 0.3 m proud of the docking
C ring, as deep as the LM's drogue (LMDOCK), so docked it sits
C in the LM's tunnel and is hidden there; three support arms.
C Sizes ours.
C SM and fairing, one 24-sided prism of the SM's diameter up to
C the CM: the SM "12 feet 11 inches long (high) and 12 feet 10
C inches in diameter" (AOH p. 1-50); the fairing "22 inches
C high" (NR p. 55; AOH p. 1-50 has 26 in), "composed of 16
C pieces; eight electrical power subsystem radiators alternated
C with eight aluminum honeycomb panels" (NR p. 55): its joint
C to the SM a ring, the 16 pieces' joints marks.
C Sectors: "two 50-degree (Sectors 1 and 4), two 60-degree
C (Sectors 3 and 6), and two 70-degree (Sectors 2 and 5)" (NR
C p. 56), the RCS packages in sectors II (+Y), III (+Z), V (-Y)
C and VI (-Z) (AOH Fig. 1-28, p. 1-49); the sector panels "are
C bolted to the radial beams" (NR p. 55), so the six beams are
C seams on the skin. Their angles allow sector 1 to start
C anywhere 0 to 40 deg before +Y (toward -Z); we take 20.
C ECS radiators: "bonded to the sector panels on opposite sides
C of the module ... each about 30 square feet in area" (NR p.
C 55), across sectors II/III and V/VI (AOH Fig. 1-28): two
C panels 1.39 by 2.0 m centred on those sector joints, their
C height on the SM ours.
C SPS nozzle: an extension "protruding more than 9 feet below
C the aft bulkhead" (NR p. 58); we take 9 ft 8 in, the NR p. 3
C "22ft,7 in. excluding fairing" less the AOH's 12 ft 11 in
C (ours), and "an exit diameter of 7 feet 10-1/2 inches" (NR
C p. 162); the throat end (0.5 m radius) is ours.
C RCS quads: "four clusters of 90 degrees apart around the upper
C portion" (NR p. 58), "offset about 7 degrees from the Y and Z
C axes" (NR p. 147); each package "eight feet long and nearly
C three feet wide" (NR p. 59), a panel marked on the skin,
C centred 1.5 m below the SM's top (ours). Its engines,
C "mounted with two pointed up and down and two pointed to the
C sides in opposite directions" (NR p. 59), "canted 10 degrees
C outward" (NR p. 147), on a housing 0.3 m proud; housing and
C nozzle sizes are the LM's (LMRCS, ours). Five solids a quad.
C VHF scimitar antennas: two, "mounted 180 degrees apart on the
C service module" (NR p. 175), "approximately 13-3/4 inches
C long" (NR p. 59), free lines; their place on the SM (between
C the quads, near the top) and the blade's outline are ours.
C High-gain antenna: on the aft bulkhead; "four 31-inch diameter
C reflectors surrounding an 11-inch square reflector" (NR p.
C 59); the boom "swings out at right angles to the spacecraft
C longitudinal axis, with the boom pointing 52 degrees below
C the heads-up horizontal" (PK p. 90). Our reading: the boom
C leaves the SM's aft edge in the Y-Z plane, 52 deg from +Y
C toward -Z; its length (2.4 m) and the dishes' arrangement (2
C by 2, square to the boom) are ours. Free lines.
C Curved surfaces (cone, cylinder, nozzle, probe) are smooth
C solids (LSMO): only their outlines and rims are drawn.
C-----------------------------------------------------------------------
SUBROUTINE CSMBLD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P(2,24), Q(2,8)
DOUBLE PRECISION FT, RB, XF, XS, HS, XN, RN, C, S, CMTOP, XT
DOUBLE PRECISION SMAFT
DOUBLE PRECISION BR(3), BD(3), BU(3), T(3), CX, CY, HA, R, XQ
DOUBLE PRECISION B0, SA(6), HB, CS, SN, U(3), W(3), D, XB
DOUBLE PRECISION BL(2,6)
INTEGER K, J, I, ISM
DATA SA / 0.0D0, 70.0D0, 130.0D0, 180.0D0, 250.0D0, 310.0D0 /
DATA BL / 0.0D0, 0.0D0, 0.05D0, 0.11D0, 0.17D0, 0.17D0,
& 0.34D0, 0.15D0, 0.20D0, 0.10D0, 0.10D0, 0.0D0 /
FT = 0.3048D0
RB = 0.5D0 * (12.0D0 + 10.0D0 / 12.0D0) * FT
XT = CMTOP()
C CM: cone, apex, docking ring, windows and hatch.
CALL CMBLD
C Docking probe and its three arms.
DO 10 K = 1, 8
Q(1,K) = 0.06D0 * DCOS(DBLE(K) * PI / 4.0D0)
Q(2,K) = 0.06D0 * DSIN(DBLE(K) * PI / 4.0D0)
10 CONTINUE
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL SETV(O, XT, 0.0D0, 0.0D0)
CALL MKFRU(8, Q, O, A1, A2, AN, 0.3D0, 0.5D0)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
DO 12 K = 0, 2
C = DCOS(DBLE(K) * 2.0D0 * PI / 3.0D0)
S = DSIN(DBLE(K) * 2.0D0 * PI / 3.0D0)
CALL XLINE(0.36D0 * C, XT, 0.36D0 * S, 0.06D0 * C,
& XT + 0.12D0, 0.06D0 * S, 0)
12 CONTINUE
C
C SM and fairing.
XF = 22.0D0 / 12.0D0 * FT
HS = (12.0D0 + 11.0D0 / 12.0D0) * FT
XS = SMAFT()
DO 14 K = 1, 24
P(1,K) = RB * DCOS(DBLE(K) * PI / 12.0D0)
P(2,K) = RB * DSIN(DBLE(K) * PI / 12.0D0)
14 CONTINUE
CALL SETV(O, XS, 0.0D0, 0.0D0)
CALL MKPRS(24, P, O, A1, A2, AN, HS + XF)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
IF (LBOK .EQ. 1) ISM = NSOL
C The fairing's joint to the SM and its 16 pieces.
CALL XARC(-XF, RB, 0.0D0, 360.0D0, ISM, 24)
DO 16 K = 0, 15
C = DCOS(DBLE(K) * PI / 8.0D0 + PI / 16.0D0)
S = DSIN(DBLE(K) * PI / 8.0D0 + PI / 16.0D0)
CALL XMK(RB * C, -XF, RB * S, RB * C, 0.0D0, RB * S, ISM, 24)
16 CONTINUE
C Sector joints, sector 1 from B0 (deg from +Y toward +Z).
B0 = -20.0D0
DO 18 K = 1, 6
C = DCOS((B0 + SA(K)) * DR)
S = DSIN((B0 + SA(K)) * DR)
CALL XMK(RB * C, XS, RB * S, RB * C, -XF, RB * S, ISM, 24)
18 CONTINUE
C ECS radiators on the joints of sectors II/III and V/VI.
D = 0.695D0 / RB / DR
DO 20 K = 0, 1
XB = B0 + 70.0D0 + 180.0D0 * DBLE(K)
CALL XARC(-XF - 0.6D0, RB, XB - D, XB + D, ISM, 24)
CALL XARC(-XF - 2.6D0, RB, XB - D, XB + D, ISM, 24)
DO 19 J = -1, 1, 2
C = DCOS((XB + DBLE(J) * D) * DR)
S = DSIN((XB + DBLE(J) * D) * DR)
CALL XMK(RB * C, -XF - 0.6D0, RB * S, RB * C, -XF - 2.6D0,
& RB * S, ISM, 24)
19 CONTINUE
20 CONTINUE
C
C SPS nozzle extension, from its throat end at the aft bulkhead.
XN = (9.0D0 + 8.0D0 / 12.0D0) * FT
RN = 0.5D0 * (7.0D0 + 10.5D0 / 12.0D0) * FT
DO 22 K = 1, 24
P(1,K) = 0.5D0 * DCOS(DBLE(K) * PI / 12.0D0)
P(2,K) = 0.5D0 * DSIN(DBLE(K) * PI / 12.0D0)
22 CONTINUE
CALL SETV(O, XS, 0.0D0, 0.0D0)
CALL SETV(AN, -1.0D0, 0.0D0, 0.0D0)
CALL MKFRU(24, P, O, A1, A2, AN, XN, RN / 0.5D0)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
C
C RCS quads: panel marks, housing, four nozzles.
HB = 0.15D0
XQ = -XF - 1.5D0
CS = DCOS(10.0D0 * DR)
SN = DSIN(10.0D0 * DR)
CALL OCTAG(HB, HB, 0.03D0, Q)
D = 0.5D0 * 3.0D0 * FT / RB / DR
DO 30 J = 0, 3
XB = 7.0D0 + 90.0D0 * DBLE(J)
C = DCOS(XB * DR)
S = DSIN(XB * DR)
CALL SETV(BR, 0.0D0, C, S)
CALL SETV(T, 0.0D0, -S, C)
CALL XARC(XQ + 4.0D0 * FT, RB, XB - D, XB + D, ISM, 24)
CALL XARC(XQ - 4.0D0 * FT, RB, XB - D, XB + D, ISM, 24)
DO 25 K = -1, 1, 2
CX = DCOS((XB + DBLE(K) * D) * DR)
CY = DSIN((XB + DBLE(K) * D) * DR)
CALL XMK(RB * CX, XQ + 4.0D0 * FT, RB * CY, RB * CX,
& XQ - 4.0D0 * FT, RB * CY, ISM, 24)
25 CONTINUE
R = RB + HB - 0.05D0
CALL SETV(O, XQ - HB, R * C, R * S)
CALL MKPRS(8, Q, O, T, BR, AN, 2.0D0 * HB)
DO 28 K = 1, 4
DO 26 I = 1, 3
IF (K .EQ. 1) U(I) = CS * AN(I) + SN * BR(I)
IF (K .EQ. 2) U(I) = -CS * AN(I) + SN * BR(I)
IF (K .EQ. 3) U(I) = CS * T(I) + SN * BR(I)
IF (K .EQ. 4) U(I) = -CS * T(I) + SN * BR(I)
26 CONTINUE
CALL PERP(U, W, BU)
CALL RCSNV(XQ, R * C, R * S, U, W, BU, HB)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
28 CONTINUE
30 CONTINUE
C
C VHF scimitars, 180 deg apart, between the quads (BL: the
C blade's outline, down the SM and out from it, m).
DO 34 J = 0, 1
C = DCOS((142.0D0 + 180.0D0 * DBLE(J)) * DR)
S = DSIN((142.0D0 + 180.0D0 * DBLE(J)) * DR)
DO 32 K = 1, 6
I = MOD(K, 6) + 1
CALL XLINE((RB + BL(2,K)) * C, -XF - 0.25D0 - BL(1,K),
& (RB + BL(2,K)) * S, (RB + BL(2,I)) * C,
& -XF - 0.25D0 - BL(1,I), (RB + BL(2,I)) * S, 0)
32 CONTINUE
34 CONTINUE
C
C High-gain antenna: boom, four dishes, the square horn, drawn
C deployed. Before the separation it was "Nested alongside the
C service propulsion system engine nozzle until deployment"
C (Apollo 11 press kit, printed p. 90), inside the closed SLA, so
C MDRAW leaves its lines (LHGA1 to LHGA2) out while the launch
C stack is placed (KSTK).
LHGA1 = NXL + 1
C = DCOS(-52.0D0 * DR)
S = DSIN(-52.0D0 * DR)
CALL SETV(BD, 0.0D0, C, S)
CALL SETV(BU, 1.0D0, 0.0D0, 0.0D0)
CALL VCRS(BD, BU, T)
CALL XLINE(RB * C, XS, RB * S, (RB + 2.4D0) * C, XS,
& (RB + 2.4D0) * S, 0)
HA = 0.5D0 * 31.0D0 * 0.0254D0
R = RB + 2.4D0
DO 50 I = 0, 3
CX = (DBLE(MOD(I, 2)) - 0.5D0) * 2.0D0 * HA
CY = (DBLE(I / 2) - 0.5D0) * 2.0D0 * HA
CALL HGARNG(R, C, S, XS, CX, CY, HA, T, BU, 12)
50 CONTINUE
C The horn, a square ring (a 4-sided ring turned 45 deg).
HA = 0.5D0 * 11.0D0 * 0.0254D0 * DSQRT(2.0D0)
CALL HGARNG(R, C, S, XS, 0.0D0, 0.0D0, HA, T, BU, 4)
LHGA2 = NXL
RETURN
END
C
C HGARNG: a ring on the high-gain antenna, N sides (12 a dish rim,
C 4 the horn, corners at 45 deg) of radius HA about (CX, CY) in the
C plane of T and BU at the boom's end (R out along (C, S) in Y-Z,
C at X = XS).
SUBROUTINE HGARNG(R, C, S, XS, CX, CY, HA, T, BU, N)
DOUBLE PRECISION R, C, S, XS, CX, CY, HA, T(3), BU(3)
INTEGER N
DOUBLE PRECISION PI, A, B, A2, B2, H, F
INTEGER K
PI = 3.141592653589793D0
H = 2.0D0 * PI / DBLE(N)
F = 0.0D0
IF (N .EQ. 4) F = 0.25D0 * PI
DO 10 K = 0, N - 1
A = CX + DCOS(DBLE(K) * H + F) * HA
B = CY + DSIN(DBLE(K) * H + F) * HA
A2 = CX + DCOS(DBLE(K + 1) * H + F) * HA
B2 = CY + DSIN(DBLE(K + 1) * H + F) * HA
CALL XLINE(R * C + A * T(2) + B * BU(2),
& XS + A * T(1) + B * BU(1), R * S + A * T(3) + B * BU(3),
& R * C + A2 * T(2) + B2 * BU(2),
& XS + A2 * T(1) + B2 * BU(1), R * S + A2 * T(3) + B2 * BU(3),
& 0)
10 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C CMBLD: the CM, solids 1 to 3 of CSMBLD, same body frame; alone it
C is the CM after CM/SM separation (KCMO), without the probe (the
C probe is "removed from the vehicle tunnels and stowed" for crew
C transfer, PK p. 88; that the CM comes home without it is ours).
C Cone: the afterbody's "33 deg" half-angle (NASA TM X-1243, Fig.
C 1(a)) from the "12ft 10in." diameter (NR p. 39) at X = 0 up
C to X 2.3 m, a 24-sided smooth frustum; then the forward heat
C shield's top, flattened to the docking ring (a frustum to
C 0.43 m, ours), and the docking ring, 0.40 m in radius (ours)
C to CMTOP. The forward heat shield's seam a ring at X 1.75,
C above the crew compartment's forward bulkhead (CMINT; ours).
C Windows 1 to 5 (TN D-7439, p. 3): CMINT's inner outlines (CMWIN)
C carried out along rays from the eye they were read for (the
C commander's, mirrored for 4 and 5; the centre couch's, Y 0,
C DB Fig. 4.4-7, for the hatch window 3) to the outer cone, so
C from the eye the outer and inner outlines agree (ours).
C Marks on the cone, hidden with their face.
C Side hatch: CMINT's outline ("about 29 inches high and 34
C inches wide", NR p. 45) carried out square to the wall.
C-----------------------------------------------------------------------
SUBROUTINE CMBLD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P(2,24), FT, RB, TC
DOUBLE PRECISION W(3,8), E(3), F(3), V(3), G(3,8), XK, RK, CMTOP
DOUBLE PRECISION SY, CN, SNN, R
INTEGER K, J, I, IC, N, NW
FT = 0.3048D0
RB = 0.5D0 * (12.0D0 + 10.0D0 / 12.0D0) * FT
TC = DTAN(33.0D0 * DR)
XK = 2.3D0
RK = RB - TC * XK
DO 10 K = 1, 24
P(1,K) = RB * DCOS(DBLE(K) * PI / 12.0D0)
P(2,K) = RB * DSIN(DBLE(K) * PI / 12.0D0)
10 CONTINUE
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
CALL SETV(O, 0.0D0, 0.0D0, 0.0D0)
CALL MKFRU(24, P, O, A1, A2, AN, XK, RK / RB)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
IC = NSOL
DO 12 K = 1, 24
P(1,K) = RK * DCOS(DBLE(K) * PI / 12.0D0)
P(2,K) = RK * DSIN(DBLE(K) * PI / 12.0D0)
12 CONTINUE
CALL SETV(O, XK, 0.0D0, 0.0D0)
CALL MKFRU(24, P, O, A1, A2, AN, 0.25D0, 0.43D0 / RK)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
DO 14 K = 1, 16
P(1,K) = 0.40D0 * DCOS(DBLE(K) * PI / 8.0D0)
P(2,K) = 0.40D0 * DSIN(DBLE(K) * PI / 8.0D0)
14 CONTINUE
CALL SETV(O, XK + 0.25D0, 0.0D0, 0.0D0)
CALL MKPRS(16, P, O, A1, A2, AN, CMTOP() - XK - 0.25D0)
IF (LBOK .EQ. 1) LSMO(NSOL) = 1
C Forward heat shield seam.
CALL XARC(1.75D0, RB - TC * 1.75D0, 0.0D0, 360.0D0, IC, 24)
C Windows 1, 2 (and mirrored 5, 4), 3, then the side hatch.
CN = DCOS(33.0D0 * DR)
SNN = DSIN(33.0D0 * DR)
DO 40 J = 1, 6
I = J
IF (J .GT. 2) I = J - 2
SY = 1.0D0
IF (J .EQ. 3 .OR. J .EQ. 4) SY = -1.0D0
CALL CMWIN(I, N, W)
CALL CMEYE(E)
E(2) = SY * E(2)
IF (I .EQ. 3) E(2) = 0.0D0
DO 30 K = 1, N
DO 20 NW = 1, 3
F(NW) = W(NW,K)
20 CONTINUE
F(2) = SY * F(2)
C The hatch: from a point inside, square to the wall.
IF (I .NE. 4) GO TO 28
R = DSQRT(F(2) * F(2) + F(3) * F(3))
E(1) = F(1) - SNN
E(2) = F(2) - CN * F(2) / R
E(3) = F(3) - CN * F(3) / R
28 CALL CONHIT(E, F, RB, TC, V)
DO 25 NW = 1, 3
G(NW,K) = V(NW)
25 CONTINUE
30 CONTINUE
DO 35 K = 1, N
NW = MOD(K, N) + 1
CALL XMK(G(2,K), G(1,K), G(3,K), G(2,NW), G(1,NW), G(3,NW),
& IC, 24)
35 CONTINUE
40 CONTINUE
RETURN
END
C
C CMTOP: X (m) of the top of the CM's docking ring, where the LM's
C tunnel meets it docked: the CM's "Height 10ft 7 in." (NR p. 39)
C above Xc 0, the bottom of the aft heat shield (AOH Fig. 1-2, p.
C 1-5), with X = 0.0254 (Xc - 18) as CMINT.
DOUBLE PRECISION FUNCTION CMTOP()
CMTOP = 0.0254D0 * (127.0D0 - 18.0D0)
RETURN
END
C
C SMAFT: X (m) of the SM's aft end in CSMBLD's frame, below its
C fairing ("22 inches high", NR p. 55) and the SM ("12 feet 11
C inches long", AOH p. 1-50; see CSMBLD), where the SLA's top met
C it before the separation (press kit, printed p. 88; LVPL).
DOUBLE PRECISION FUNCTION SMAFT()
DOUBLE PRECISION FT
FT = 0.3048D0
SMAFT = -(22.0D0 / 12.0D0 * FT) - (12.0D0 + 11.0D0 / 12.0D0) * FT
RETURN
END
C
C CMWIN: CM window I (1 left side, 2 left rendezvous, 3 hatch) or,
C I = 4, the side hatch: N corners W (X, Y, Z, CSM body metres) on
C CMINT's inner wall; see CMINT for their sources.
SUBROUTINE CMWIN(I, N, W)
INTEGER I, N, K, J
DOUBLE PRECISION W(3,8), W1(3,5), W2(3,5), W3(3,8), HS(3,4)
DATA W1 / 0.742D0, -1.020D0, -0.851D0, 0.879D0, -0.939D0,
& -0.808D0, 0.902D0, -0.945D0, -0.778D0, 0.909D0, -1.016D0,
& -0.675D0, 0.744D0, -1.120D0, -0.711D0 /
DATA W2 / 0.924D0, -0.629D0, -1.034D0, 0.929D0, -0.611D0,
& -1.040D0, 1.036D0, -0.577D0, -0.979D0, 1.058D0, -0.690D0,
& -0.885D0, 0.996D0, -0.715D0, -0.917D0 /
DATA W3 / 0.986D0, 0.089D0, -1.166D0, 0.942D0, 0.052D0,
& -1.197D0, 0.926D0, 0.0D0, -1.208D0, 0.942D0, -0.052D0,
& -1.197D0, 0.986D0, -0.089D0, -1.166D0, 1.044D0, -0.075D0,
& -1.129D0, 1.073D0, 0.0D0, -1.113D0, 1.044D0, 0.075D0,
& -1.129D0 /
DATA HS / 0.688D0, -0.425D0, -1.295D0, 1.306D0, -0.417D0,
& -0.866D0, 1.306D0, 0.417D0, -0.866D0, 0.688D0, 0.425D0,
& -1.295D0 /
N = 5
IF (I .EQ. 3) N = 8
IF (I .EQ. 4) N = 4
DO 20 K = 1, N
DO 10 J = 1, 3
IF (I .EQ. 1) W(J,K) = W1(J,K)
IF (I .EQ. 2) W(J,K) = W2(J,K)
IF (I .EQ. 3) W(J,K) = W3(J,K)
IF (I .EQ. 4) W(J,K) = HS(J,K)
10 CONTINUE
20 CONTINUE
RETURN
END
C
C CONHIT: P, where the ray from E through F (CSM body metres) meets
C the CM's outer cone, radius RB at X = 0 narrowing by TC a metre
C (the nearest crossing ahead of E); F itself if it never does.
SUBROUTINE CONHIT(E, F, RB, TC, P)
DOUBLE PRECISION E(3), F(3), RB, TC, P(3)
DOUBLE PRECISION D(3), A, B, C, Q, T, T1, T2, H
INTEGER I
DO 10 I = 1, 3
D(I) = F(I) - E(I)
P(I) = F(I)
10 CONTINUE
H = RB - TC * E(1)
A = D(2) * D(2) + D(3) * D(3) - TC * TC * D(1) * D(1)
B = 2.0D0 * (E(2) * D(2) + E(3) * D(3) + TC * D(1) * H)
C = E(2) * E(2) + E(3) * E(3) - H * H
Q = B * B - 4.0D0 * A * C
IF (Q .LT. 0.0D0 .OR. DABS(A) .LT. 1.0D-12) RETURN
T1 = (-B + DSQRT(Q)) / (2.0D0 * A)
T2 = (-B - DSQRT(Q)) / (2.0D0 * A)
T = T1
IF (T2 .GT. 0.0D0 .AND. (T2 .LT. T .OR. T .LE. 0.0D0)) T = T2
IF (T .LE. 0.0D0) RETURN
DO 20 I = 1, 3
P(I) = E(I) + T * D(I)
20 CONTINUE
RETURN
END
C
C KFACE: the side face of an N-sided solid about the body X axis
C (MKPRS, MKFRU with axes Y, Z; vertex K at K 360/N deg from +Y
C toward +Z, face K from vertex K to K+1) that holds the point at
C Y, Z.
INTEGER FUNCTION KFACE(Y, Z, N)
DOUBLE PRECISION Y, Z, A
INTEGER N
A = DATAN2(Z, Y)
IF (A .LT. 0.0D0) A = A + 2.0D0 * 3.141592653589793D0
KFACE = INT(A / (2.0D0 * 3.141592653589793D0 / DBLE(N)))
IF (KFACE .LT. 1) KFACE = N
IF (KFACE .GT. N) KFACE = N
RETURN
END
C
C XMK: a mark from (Y1, X1, Z1) to (Y2, X2, Z2) on the sides of
C solid IS, N-sided about the body X axis: cut where it would span
C more than half a face, each piece on the face it lies over.
SUBROUTINE XMK(Y1, X1, Z1, Y2, X2, Z2, IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION Y1, X1, Z1, Y2, X2, Z2
INTEGER IS, N
DOUBLE PRECISION A, F0, F1, YM, ZM
INTEGER K, M, KFACE
A = DABS(DATAN2(Y1 * Z2 - Z1 * Y2, Y1 * Y2 + Z1 * Z2))
M = 1 + INT(A / (PI / DBLE(N)))
DO 10 K = 1, M
F0 = DBLE(K - 1) / DBLE(M)
F1 = DBLE(K) / DBLE(M)
CALL XLINE(Y1 + F0 * (Y2 - Y1), X1 + F0 * (X2 - X1),
& Z1 + F0 * (Z2 - Z1), Y1 + F1 * (Y2 - Y1),
& X1 + F1 * (X2 - X1), Z1 + F1 * (Z2 - Z1), IS)
YM = Y1 + 0.5D0 * (F0 + F1) * (Y2 - Y1)
ZM = Z1 + 0.5D0 * (F0 + F1) * (Z2 - Z1)
IF (LXOK .EQ. 1) LXF(NXL) = KFACE(YM, ZM, N)
10 CONTINUE
RETURN
END
C
C XARC: a mark on the sides of solid IS (as XMK), the arc at X of
C radius R from D1 to D2 deg (from +Y toward +Z), in pieces of
C half a face.
SUBROUTINE XARC(X, R, D1, D2, IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X, R, D1, D2
INTEGER IS, N
DOUBLE PRECISION A0, A1
INTEGER K, M, KFACE
M = 1 + INT((D2 - D1) / (180.0D0 / DBLE(N)))
DO 10 K = 1, M
A0 = (D1 + (D2 - D1) * DBLE(K - 1) / DBLE(M)) * DR
A1 = (D1 + (D2 - D1) * DBLE(K) / DBLE(M)) * DR
CALL XLINE(R * DCOS(A0), X, R * DSIN(A0),
& R * DCOS(A1), X, R * DSIN(A1), IS)
IF (LXOK .EQ. 1) LXF(NXL) = KFACE(DCOS(0.5D0 * (A0 + A1)),
& DSIN(0.5D0 * (A0 + A1)), N)
10 CONTINUE
RETURN
END
C-----------------------------------------------------------------------
C CMCAB: the CM cabin as the station view shows it: the left
C rendezvous window's outlines as VIEW drew them, in CSM body
C metres about the eye point CMEYE. MSC IN 69-FM-197, figure 9.0-3
C (PDF p. 263): "View as seen along CM X-axis during the PTC
C attitudes (X-axis in center of view)", gimbal angles 90, 0, 0,
C and "The CM left rendezvous window outline is shown for a zero
C roll attitude" (p. 17). The report draws two outlines; we read
C both off the plot by eye (to about 1 deg), in its plot degrees,
C where a point at plot radius R lies R deg off the centre (an
C azimuthal equidistant plot): the named stars of figures 9.0-3
C and 5.1-1(a) (PDF pp. 263, 53, both with a 100 deg field) lie
C there to 0.11 and 0.25 deg rms, where a tangent plot misses by
C 7 to 25 deg (our fits). Over the window this agrees to 0.5 deg
C with the CSM Data Book's look angles (azimuth, elevation; SNA-
C 8-D-027(I), Fig. 4.4-5), whose Fig. 4.4-6 has the same two
C outlines for the commander's right and left eyes. Our reading
C of the plot's axes: right is the
C CM's +Y, up its -Z (the rendezvous windows are on the -Z half,
C TN D-7439 p. 3), which puts the left window up and to the left.
C The x at the centre marks the CM X-axis, as in the report's CSM
C maneuver views ("the x also denotes the projection of the CM X-
C axis", MSC IN 69-FM-197 PDF p. 24, where "The CM left rendezvous
C window has been superimposed on these views"). The lines sit
C 0.5 m from the eye (CMEYE), so they are seen exactly along the
C outlines wherever the eye is.
C Other windows: no outline we can read, so none drawn.
C-----------------------------------------------------------------------
SUBROUTINE CMCAB
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION WA(2,15), WB(2,13), E(3), A(3), B(3)
INTEGER K
DATA WA / -20.9D0, 11.5D0, -18.9D0, 16.9D0, -16.7D0, 22.6D0,
& -13.5D0, 28.4D0, -10.7D0, 33.4D0, -6.6D0, 38.6D0,
& -2.5D0, 38.8D0, -0.4D0, 34.5D0, 1.0D0, 30.5D0,
& 2.5D0, 25.5D0, 3.2D0, 20.5D0, -14.6D0, 4.3D0,
& -18.7D0, 8.3D0, -20.9D0, 10.4D0, -20.9D0, 11.5D0 /
DATA WB / -13.8D0, 10.4D0, -11.1D0, 16.9D0, -8.6D0, 21.9D0,
& -5.4D0, 26.9D0, -1.4D0, 32.7D0, 3.5D0, 38.4D0,
& 7.5D0, 38.8D0, 8.0D0, 34.5D0, 9.0D0, 34.2D0,
& 9.6D0, 29.1D0, 11.7D0, 19.0D0, -7.1D0, 4.3D0,
& -13.8D0, 10.4D0 /
CALL CMEYE(E)
DO 10 K = 1, 14
CALL CMDIR(E, WA(1,K), WA(2,K), A)
CALL CMDIR(E, WA(1,K+1), WA(2,K+1), B)
CALL XLINE(A(2), A(1), A(3), B(2), B(1), B(3), 0)
10 CONTINUE
DO 20 K = 1, 12
CALL CMDIR(E, WB(1,K), WB(2,K), A)
CALL CMDIR(E, WB(1,K+1), WB(2,K+1), B)
CALL XLINE(A(2), A(1), A(3), B(2), B(1), B(3), 0)
20 CONTINUE
CALL CMDIR(E, -0.7D0, -0.7D0, A)
CALL CMDIR(E, 0.7D0, 0.7D0, B)
CALL XLINE(A(2), A(1), A(3), B(2), B(1), B(3), 0)
CALL CMDIR(E, -0.7D0, 0.7D0, A)
CALL CMDIR(E, 0.7D0, -0.7D0, B)
CALL XLINE(A(2), A(1), A(3), B(2), B(1), B(3), 0)
RETURN
END
C
C CMEYE: the CM eye point, CSM body metres: the commander's eye,
C 80th percentile, between his two eyes ("CYCLOPS"), "XE = 45.7",
C "YCY = -24.5", "ZE = -33.8" in (CSM/LM Spacecraft Operational
C Data Book Vol. I, SNA-8-D-027(I) Rev 3, 1970, Fig. 4.4-8,
C printed p. 4.4-65), with X = 0.0254 (Xc - 18) as CMINT.
SUBROUTINE CMEYE(E)
DOUBLE PRECISION E(3)
E(1) = 0.0254D0 * (45.7D0 - 18.0D0)
E(2) = 0.0254D0 * (-24.5D0)
E(3) = 0.0254D0 * (-33.8D0)
RETURN
END
C
C LDEYE: the LM eye point, LM body metres: "CMDR'S DESIGN EYE
C X=279.25, Y=22, Z=54" (SG Fig. 25, p. 35; see LMBODY), the
C commander on the left, so Y -22.
SUBROUTINE LDEYE(E)
DOUBLE PRECISION E(3)
E(1) = 1.7D0 + 0.0254D0 * (279.25D0 - 200.0D0)
E(2) = 0.0254D0 * (-22.0D0)
E(3) = 0.0254D0 * 54.0D0
RETURN
END
C
C CMDIR: the point 0.5 m from the eye E toward plot point (X, Y)
C of the report's CSM views (right +Y, up -Z, centre +X), which
C lies SQRT(X**2 + Y**2) deg off the centre (see CMCAB).
SUBROUTINE CMDIR(E, X, Y, P)
DOUBLE PRECISION E(3), X, Y, P(3), U(3), DR, R, S
DR = 3.141592653589793D0 / 180.0D0
R = DSQRT(X * X + Y * Y)
S = 0.0D0
IF (R .GT. 0.0D0) S = DSIN(R * DR) / R
U(1) = DCOS(R * DR)
U(2) = X * S
U(3) = -Y * S
P(1) = E(1) + 0.5D0 * U(1)
P(2) = E(2) + 0.5D0 * U(2)
P(3) = E(3) + 0.5D0 * U(3)
RETURN
END
C
C-----------------------------------------------------------------------
C CMINT: the CM's crew compartment about the station eye, free
C lines in CSM body metres (X = 0 at the CM's widest diameter, as
C CSMBLD; Y toward the LM pilot, Z toward the crew's feet). An
C outline model (MDHL = 0), drawn with in_flags bit 4: the camera
C is inside it, and stars, Earth and Moon show through its walls
C unless the window mask (bit 5) cuts them to the windows.
C Stations are Xc of the Apollo Operations Handbook (SM2A-03-Block
C II-(1), 1969, "AOH", Fig. 1-2, "XC = 0" below the aft heat
C shield), X = 0.0254 (Xc - 18) m, the 18 in read off that figure
C (ours). "DB": CSM/LM Spacecraft Operational Data Book Vol. I,
C SNA-8-D-027(I) Rev 3, 1970; "NR": CSM News Reference, NAA 1969.
C Windows 1 to 5 from -Y to +Y (TN D-7439, p. 3): 1, 2, 3 (left
C side, left rendezvous, hatch) are rays from the eye along
C DB's outlines for the 80th percentile commander (Figs.
C 4.4-8, 4.4-6, 4.4-7, printed pp. 4.4-63 to 4.4-65), read by
C eye to about 1 deg as DB's look angles (Fig. 4.4-5: azimuth
C from +X toward +Y, elevation toward -Z), ended on our inner
C wall; 4 and 5 mirror 2 and 1 (ours). Window 2's corners are
C the means of the two eyes' corners in CMCAB's outlines, along
C CMDIR, so from the eye it lies between those outlines.
C Inner wall: the outer cone's "33 deg" half-angle (NASA TM X-
C 1243, Fig. 1(a)) set in 4 in, from the floor's rim to the
C forward bulkhead; floor dish, bulkhead and tunnel are ours,
C sized to hold about the "10.4 cubic meters" of TN D-8178
C (printed p. 10).
C Hatches: the forward one "about 30 inches in diameter" at "the
C top of the docking tunnel" (NR p. 47); the side one "about
C 29 inches high and 34 inches wide" (NR p. 45), about window
C 3 (ours).
C Couches CDR, CMP, LMP from -Y, their back pans "32 by 22
C inches" (NR p. 79) under the eyes (DB's Y), the seat at the
C "85-degree position" (NR p. 72); leg pans and heights ours.
C Main display console, lower equipment bay, left and right hand
C equipment bays: placed by eye from AOH Figs. 1-26 and 1-27
C (ours).
C Opaque (ours): the console, the couches' pans, the bays' faces
C and the forward bulkhead about the tunnel hide the cabin's
C lines behind them (OCPOLY, XOCC, OCSTRP; vmask.f CBCUT).
C The windows and hatches are not opaque: nothing of the
C cabin is behind them.
C-----------------------------------------------------------------------
SUBROUTINE CMINT
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION W1(3,8), W2(3,8), W3(3,8), HS(3,8), D1(3,4)
DOUBLE PRECISION D2(3,4), CX(5), CZ(5), EB(3,6), HB(3,4), C(3)
DOUBLE PRECISION GA(7), CA, SA, YC, YA, YB, QC(3,4), RI(3,16)
DOUBLE PRECISION RO(3,16)
INTEGER K, J, L, N1, N2, N3, N4
C Main display console: left wing (panel 1; panel 3 its mirror)
C and centre (panel 2), hung from the wall above the side hatch.
DATA D1 / 1.372D0, -0.388D0, -0.833D0, 1.016D0, -0.508D0,
& -0.203D0, 0.914D0, -1.118D0, 0.0D0, 1.168D0, -0.953D0,
& -0.444D0 /
DATA D2 / 1.372D0, -0.388D0, -0.833D0, 1.372D0, 0.388D0,
& -0.833D0, 1.016D0, 0.508D0, -0.203D0, 1.016D0, -0.508D0,
& -0.203D0 /
C A couch's side, X and Z: head, hip, knee, heel, foot.
DATA CX / 0.483D0, 0.483D0, 0.940D0, 0.813D0, 0.813D0 /
DATA CZ / -1.067D0, 0.025D0, 0.076D0, 0.508D0, 0.610D0 /
C Lower equipment bay face (+Z) and left hand bay face (-Y).
DATA EB / 0.102D0, -0.965D0, 1.067D0, 0.102D0, 0.965D0, 1.067D0,
& 0.762D0, 0.762D0, 1.067D0, 1.016D0, 0.305D0, 1.067D0,
& 1.016D0, -0.305D0, 1.067D0, 0.762D0, -0.762D0, 1.067D0 /
DATA HB / 0.102D0, -1.27D0, -0.559D0, 0.635D0, -1.27D0,
& -0.559D0, 0.635D0, -1.27D0, 0.559D0, 0.102D0, -1.27D0,
& 0.559D0 /
C Wall lines, deg from +Y toward +Z; none across the side hatch.
DATA GA / 0.0D0, 45.0D0, 90.0D0, 135.0D0, 180.0D0, 225.0D0,
& 315.0D0 /
C
C Wall: rings at the floor's rim and the forward bulkhead, lines
C between them.
CALL SETV(C, 0.051D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 1.777D0, 24)
CALL SETV(C, 1.626D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.754D0, 24)
DO 10 K = 1, 7
CA = DCOS(GA(K) * DR)
SA = DSIN(GA(K) * DR)
CALL XLINE(1.777D0 * CA, 0.051D0, 1.777D0 * SA,
& 0.754D0 * CA, 1.626D0, 0.754D0 * SA, 0)
10 CONTINUE
C Floor, a shallow dish down to X -0.254 at the centre.
CALL SETV(C, -0.178D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.889D0, 24)
DO 20 K = 0, 7
CA = DCOS(DBLE(K) * PI / 4.0D0)
SA = DSIN(DBLE(K) * PI / 4.0D0)
CALL XLINE(1.777D0 * CA, 0.051D0, 1.777D0 * SA,
& 0.889D0 * CA, -0.178D0, 0.889D0 * SA, 0)
CALL XLINE(0.889D0 * CA, -0.178D0, 0.889D0 * SA,
& 0.0D0, -0.254D0, 0.0D0, 0)
20 CONTINUE
C Forward bulkhead, tunnel and forward hatch.
DO 30 K = 0, 7
CA = DCOS(DBLE(K) * PI / 4.0D0)
SA = DSIN(DBLE(K) * PI / 4.0D0)
IF (MOD(K, 2) .EQ. 0) CALL XLINE(0.754D0 * CA, 1.626D0,
& 0.754D0 * SA, 0.419D0 * CA, 1.626D0, 0.419D0 * SA, 0)
CALL XLINE(0.419D0 * CA, 1.626D0, 0.419D0 * SA,
& 0.419D0 * CA, 2.286D0, 0.419D0 * SA, 0)
30 CONTINUE
CALL SETV(C, 1.626D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.419D0, 16)
CALL SETV(C, 2.286D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.419D0, 16)
CALL XRING(C, 1, 0.381D0, 16)
C The forward bulkhead is opaque about the tunnel's mouth: a strip
C from the tunnel's ring out to the wall's (OCSTRP; ours).
DO 35 K = 1, 16
CA = DCOS(DBLE(K - 1) * PI / 8.0D0)
SA = DSIN(DBLE(K - 1) * PI / 8.0D0)
CALL SETV(RI(1,K), 1.626D0, 0.419D0 * CA, 0.419D0 * SA)
CALL SETV(RO(1,K), 1.626D0, 0.754D0 * CA, 0.754D0 * SA)
35 CONTINUE
CALL OCSTRP(16, RI, RO)
C Windows (XWIN: also the window mask's) and the side hatch, on
C the inner wall (CMWIN): 1, left side; 2, left rendezvous; 3,
C hatch; the side hatch, 29 in along the cone, 34 in around.
C Window 2 is kept for the mask only (WKEEP): CMCAB draws its two
C outlines, one for each of the commander's eyes, and window 2
C lies between them.
CALL CMWIN(1, N1, W1)
CALL CMWIN(2, N2, W2)
CALL CMWIN(3, N3, W3)
CALL CMWIN(4, N4, HS)
CALL XWIN(N1, W1, 1.0D0)
CALL XWIN(N1, W1, -1.0D0)
CALL WKEEP(N2, W2, 1.0D0)
CALL XWIN(N2, W2, -1.0D0)
CALL XWIN(N3, W3, 1.0D0)
CALL XPOLY(N4, HS, 1, 1.0D0)
C Main display console, opaque (XOCC).
CALL XOCC(4, D2, 1.0D0)
CALL XOCC(4, D1, 1.0D0)
CALL XOCC(4, D1, -1.0D0)
C Couches: two sides, cross members at each joint, each pan
C between two joints opaque (OCPOLY). The eye is 0.22 m above the
C commander's back pan, which hides what is behind his head.
DO 50 J = -1, 1
YC = 0.622D0 * DBLE(J)
YA = YC - 0.279D0
YB = YC + 0.279D0
DO 40 K = 1, 5
IF (K .EQ. 5) GO TO 38
L = K + 1
CALL SETV(QC(1,1), CX(K), YA, CZ(K))
CALL SETV(QC(1,2), CX(K), YB, CZ(K))
CALL SETV(QC(1,3), CX(L), YB, CZ(L))
CALL SETV(QC(1,4), CX(L), YA, CZ(L))
CALL OCPOLY(4, QC, 1.0D0)
38 CALL XLINE(YA, CX(K), CZ(K), YB, CX(K), CZ(K), 0)
IF (K .EQ. 5) GO TO 40
CALL XLINE(YA, CX(K), CZ(K), YA, CX(L), CZ(L), 0)
CALL XLINE(YB, CX(K), CZ(K), YB, CX(L), CZ(L), 0)
40 CONTINUE
50 CONTINUE
C Equipment bays' faces, opaque.
CALL XOCC(6, EB, 1.0D0)
CALL XOCC(4, HB, 1.0D0)
CALL XOCC(4, HB, -1.0D0)
RETURN
END
C
C-----------------------------------------------------------------------
C LMINT: the LM's crew compartment and midsection about the
C commander's station, free lines in LM body metres, the stations
C and sources of LMBODY ("SG", "LMNR"). An outline model, drawn
C with in_flags bit 4.
C Eye: LDEYE.
C Cabin: the 92 in cylinder about our X 3.0 m axis, from the aft
C bulkhead to the front face (ZF); floor at X 215.5, the lower
C deck less the "18-inch step up into the midsection" (LMNR p.
C LV-5), "approximately 36 by 55 inches" (LMNR p. LV-4).
C Midsection: "54 inches deep and approximately 5 feet high.
C The internal shape is elliptical, with a minor axis of
C approximately 56 inches" (LMNR p. LV-5), between the decks;
C the ellipse's major axis (82.7 in, across the decks, so the
C overhead hatch fits the upper one) is ours. The engine
C cover "cylindrical" (LMNR p. LV-6), its size ours.
C Hatches: overhead "approximately 33 inches in diameter, ... at
C the top centerline of the midsection", under the tunnel;
C forward "approximately 32 inches square" (LMNR pp. LV-6,
C LV-4), its sill at the floor (ours).
C Windows: the commander's (LMWIN), the LM pilot's its mirror;
C the docking window above the commander from rays along SG
C Fig. 25's docking outline from the docking eye (X280.375,
C Z37.75), ended on the shell: our construction.
C Panels: "two main display panels (1 & 2), cantered forward
C 10 deg; two lower center panels (3 & 4), sloping down and aft
C 45 deg ...; two bottom side panels (5 & 6)" (SG p. 27); the
C side consoles run "from the front face assembly to the aft
C bulkhead", tiers "cantered up 15 deg", "36.5 deg" (same
C page); the alignment optical telescope "between and above
C the flight stations" (LMNR p. CD-2). Sizes and cross-
C sections from SG Figs. 12 and 13 by eye (ours).
C Opaque (ours): the floor, the panels, the side consoles' tiers,
C the engine cover, the aft bulkhead about the midsection and
C the upper deck about the overhead hatch hide the cabin's
C lines behind them (vmask.f CBCUT).
C-----------------------------------------------------------------------
SUBROUTINE LMINT
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION FL(3,4), FH(3,4), DW(3,4), P1(3,4), P3(3,4)
DOUBLE PRECISION P4(3,4), P5(3,4), CN(2,6), WN(3,3), EM(3,14)
DOUBLE PRECISION C(3), A, CA, SA, X1, X2, T1, T2, T, ZF, LMWIN
DOUBLE PRECISION SY, QC(3,4), RI(3,16), RO(3,16), YH, R
INTEGER K, J, I
DATA FL / 2.094D0, -0.699D0, 0.724D0, 2.094D0, 0.699D0, 0.724D0,
& 2.094D0, 0.699D0, 1.638D0, 2.094D0, -0.699D0, 1.638D0 /
DATA FH / 2.094D0, -0.406D0, 1.64D0, 2.094D0, 0.406D0, 1.64D0,
& 2.906D0, 0.406D0, 1.64D0, 2.906D0, -0.406D0, 1.64D0 /
DATA DW / 4.027D0, -0.640D0, 1.224D0, 4.027D0, -0.490D0,
& 1.224D0, 4.027D0, -0.508D0, 0.925D0, 4.027D0, -0.620D0,
& 0.925D0 /
C Panels 1, 3, 4, 5 (2 and 6 are the mirrors of 1 and 5).
DATA P1 / 3.351D0, -0.483D0, 1.562D0, 3.351D0, 0.0D0, 1.562D0,
& 3.961D0, 0.0D0, 1.669D0, 3.961D0, -0.483D0, 1.669D0 /
DATA P3 / 3.351D0, -0.406D0, 1.562D0, 3.351D0, 0.406D0,
& 1.562D0, 3.122D0, 0.406D0, 1.333D0, 3.122D0, -0.406D0,
& 1.333D0 /
DATA P4 / 3.122D0, -0.203D0, 1.333D0, 3.122D0, 0.203D0,
& 1.333D0, 2.945D0, 0.203D0, 1.156D0, 2.945D0, -0.203D0,
& 1.156D0 /
DATA P5 / 2.894D0, -0.711D0, 1.575D0, 2.894D0, -0.406D0,
& 1.575D0, 3.046D0, -0.406D0, 1.575D0, 3.046D0, -0.711D0,
& 1.575D0 /
C Commander's side console, X and Y: lower tier, riser, centre
C tier, upper (circuit breaker) tier.
DATA CN / 2.868D0, -0.787D0, 2.922D0, -0.991D0, 3.072D0,
& -0.991D0, 3.138D0, -1.079D0, 3.275D0, -1.041D0, 3.935D0,
& -0.622D0 /
C
C Shell: the aft bulkhead's ring, the front's rim, and lines along
C the cylinder every 45 deg but under the floor.
CALL SETV(C, 3.0D0, 0.0D0, 0.686D0)
CALL XRING(C, 3, 1.168D0, 24)
DO 10 K = 0, 23
A = DBLE(K) * PI / 12.0D0
X1 = 3.0D0 + 1.168D0 * DCOS(A)
X2 = 3.0D0 + 1.168D0 * DCOS(A + PI / 12.0D0)
CALL XLINE(1.168D0 * DSIN(A), X1, ZF(X1),
& 1.168D0 * DSIN(A + PI / 12.0D0), X2, ZF(X2), 0)
IF (MOD(K, 3) .NE. 0 .OR. K .EQ. 12) GO TO 10
CALL XLINE(1.168D0 * DSIN(A), X1, 0.686D0,
& 1.168D0 * DSIN(A), X1, ZF(X1), 0)
10 CONTINUE
C The front's knee, floor, forward hatch.
CALL XLINE(-1.168D0, 3.021D0, 1.64D0, 1.168D0, 3.021D0, 1.64D0,
& 0)
CALL XOCC(4, FL, 1.0D0)
CALL XPOLY(4, FH, 1, 1.0D0)
C Windows (XWIN: also the window mask's).
DO 15 K = 1, 3
DO 12 I = 1, 3
WN(I,K) = LMWIN(I,K)
12 CONTINUE
15 CONTINUE
C The commander's window is kept for the mask (WKEEP) with only
C its outboard edge drawn (corner 3 to 1): OVLPD (llpd.f) draws
C its sill and inboard edge, the period frame. The LM pilot's is
C drawn whole.
CALL WKEEP(3, WN, 1.0D0)
CALL XLINE(WN(2,3), WN(1,3), WN(3,3), WN(2,1), WN(1,1), WN(3,1),
& 0)
CALL XWIN(3, WN, -1.0D0)
CALL XWIN(4, DW, 1.0D0)
C Midsection: its section at both ends, the decks' edges and the
C sides joined along it.
T1 = DACOS((4.104D0 - 3.327D0) / 1.05D0)
T2 = DACOS((2.551D0 - 3.327D0) / 1.05D0)
DO 20 K = 1, 7
T = T1 + DBLE(K - 1) * (T2 - T1) / 6.0D0
EM(1,K) = 3.327D0 + 1.05D0 * DCOS(T)
EM(2,K) = 0.711D0 * DSIN(T)
EM(1,15-K) = EM(1,K)
EM(2,15-K) = -EM(2,K)
20 CONTINUE
DO 30 J = -1, 1, 2
DO 25 K = 1, 14
EM(3,K) = 0.686D0 * DBLE(J)
25 CONTINUE
CALL XPOLY(14, EM, 1, 1.0D0)
30 CONTINUE
C The aft bulkhead is opaque about the midsection's mouth, EM at
C its last (forward) end: a strip from EM out to the bulkhead's
C ring along rays from the ring's centre (OCSTRP; ours).
DO 32 K = 1, 14
R = DSQRT((EM(1,K) - 3.0D0)**2 + EM(2,K)**2)
CALL SETV(RI(1,K), EM(1,K), EM(2,K), EM(3,K))
CALL SETV(RO(1,K), 3.0D0 + 1.168D0 * (EM(1,K) - 3.0D0) / R,
& 1.168D0 * EM(2,K) / R, EM(3,K))
32 CONTINUE
CALL OCSTRP(14, RI, RO)
DO 35 K = 1, 14
IF (K .EQ. 1 .OR. K .EQ. 4 .OR. K .EQ. 7 .OR. K .EQ. 8
& .OR. K .EQ. 11 .OR. K .EQ. 14) CALL XLINE(EM(2,K), EM(1,K),
& -0.686D0, EM(2,K), EM(1,K), 0.686D0, 0)
35 CONTINUE
C The step up from the floor to the lower deck.
DO 38 J = -1, 1, 2
SY = DBLE(J) * EM(2,7)
CALL XLINE(SY, 2.094D0, 0.724D0, SY, 2.551D0, 0.686D0, 0)
38 CONTINUE
C Ascent engine cover, overhead hatch, docking tunnel. The cover
C is opaque, its top and sides; so is the upper deck about the
C hatch, a strip from the hatch's ring out to the deck's edges,
C EM(2,1) either side and the midsection's ends (ours).
YH = EM(2,1)
DO 37 K = 1, 16
CA = DCOS(DBLE(K - 1) * PI / 8.0D0)
SA = DSIN(DBLE(K - 1) * PI / 8.0D0)
CALL SETV(RI(1,K), 2.551D0, 0.356D0 * CA, 0.356D0 * SA)
CALL SETV(RO(1,K), 3.249D0, 0.356D0 * CA, 0.356D0 * SA)
37 CONTINUE
CALL OCSTRP(16, RI, RO)
CALL OCPOLY(16, RO, 1.0D0)
DO 39 K = 1, 16
CA = DCOS(DBLE(K - 1) * PI / 8.0D0)
SA = DSIN(DBLE(K - 1) * PI / 8.0D0)
R = 1.0D3
IF (DABS(CA) .GT. 1.0D-9) R = YH / DABS(CA)
IF (DABS(SA) .GT. 1.0D-9 .AND. 0.686D0 / DABS(SA) .LT. R)
& R = 0.686D0 / DABS(SA)
CALL SETV(RI(1,K), 4.104D0, 0.419D0 * CA, 0.419D0 * SA)
CALL SETV(RO(1,K), 4.104D0, R * CA, R * SA)
39 CONTINUE
CALL OCSTRP(16, RI, RO)
CALL SETV(C, 2.551D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.356D0, 16)
CALL SETV(C, 3.249D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.356D0, 16)
CALL SETV(C, 4.104D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.419D0, 16)
CALL SETV(C, 4.51D0, 0.0D0, 0.0D0)
CALL XRING(C, 1, 0.406D0, 16)
DO 40 K = 0, 3
CA = DCOS(DBLE(K) * PI / 2.0D0)
SA = DSIN(DBLE(K) * PI / 2.0D0)
CALL XLINE(0.356D0 * CA, 2.551D0, 0.356D0 * SA,
& 0.356D0 * CA, 3.249D0, 0.356D0 * SA, 0)
CA = DCOS((DBLE(K) + 0.5D0) * PI / 2.0D0)
SA = DSIN((DBLE(K) + 0.5D0) * PI / 2.0D0)
CALL XLINE(0.406D0 * CA, 4.104D0, 0.406D0 * SA,
& 0.406D0 * CA, 4.51D0, 0.406D0 * SA, 0)
40 CONTINUE
C Panels, opaque.
CALL XOCC(4, P1, 1.0D0)
CALL XOCC(4, P1, -1.0D0)
CALL XOCC(4, P3, 1.0D0)
CALL XOCC(4, P4, 1.0D0)
CALL XOCC(4, P5, 1.0D0)
CALL XOCC(4, P5, -1.0D0)
C Side consoles, aft bulkhead to the panels' plane; each tier and
C riser opaque (OCPOLY).
DO 60 J = -1, 1, 2
SY = DBLE(J)
DO 55 K = 1, 6
CALL XLINE(SY * CN(2,K), CN(1,K), 0.686D0,
& SY * CN(2,K), CN(1,K), 1.575D0, 0)
IF (K .EQ. 6) GO TO 55
CALL SETV(QC(1,1), CN(1,K), CN(2,K), 0.686D0)
CALL SETV(QC(1,2), CN(1,K+1), CN(2,K+1), 0.686D0)
CALL SETV(QC(1,3), CN(1,K+1), CN(2,K+1), 1.575D0)
CALL SETV(QC(1,4), CN(1,K), CN(2,K), 1.575D0)
CALL OCPOLY(4, QC, SY)
CALL XLINE(SY * CN(2,K), CN(1,K), 0.686D0,
& SY * CN(2,K+1), CN(1,K+1), 0.686D0, 0)
CALL XLINE(SY * CN(2,K), CN(1,K), 1.575D0,
& SY * CN(2,K+1), CN(1,K+1), 1.575D0, 0)
55 CONTINUE
60 CONTINUE
C Alignment optical telescope.
CALL SETV(C, 3.757D0, 0.0D0, 1.016D0)
CALL XRING(C, 1, 0.1D0, 8)
CALL SETV(C, 4.169D0, 0.0D0, 1.016D0)
CALL XRING(C, 1, 0.1D0, 8)
DO 70 K = 0, 3
CA = 0.1D0 * DCOS(DBLE(K) * PI / 2.0D0)
SA = 0.1D0 * DSIN(DBLE(K) * PI / 2.0D0)
CALL XLINE(CA, 3.757D0, 1.016D0 + SA, CA, 4.169D0,
& 1.016D0 + SA, 0)
70 CONTINUE
RETURN
END
C
C XPOLY: free lines through the N points P (X, Y, Z, body metres),
C back to the first if ICL = 1; Y is multiplied by SY (-1 mirrors).
SUBROUTINE XPOLY(N, P, ICL, SY)
INTEGER N, ICL
DOUBLE PRECISION P(3,N), SY
INTEGER K, J, M
M = N - 1
IF (ICL .EQ. 1) M = N
DO 10 K = 1, M
J = MOD(K, N) + 1
CALL XLINE(SY * P(2,K), P(1,K), P(3,K),
& SY * P(2,J), P(1,J), P(3,J), 0)
10 CONTINUE
RETURN
END
C
C XWIN: a window of the cabin being built, its N corners P as
C XPOLY takes them: drawn as a closed outline, and kept (WKEEP).
SUBROUTINE XWIN(N, P, SY)
INTEGER N
DOUBLE PRECISION P(3,N), SY
CALL XPOLY(N, P, 1, SY)
CALL WKEEP(N, P, SY)
RETURN
END
C
C WKEEP: a window of the cabin being built, kept in /CWIN/ for the
C window mask (vmask.f), not drawn.
SUBROUTINE WKEEP(N, P, SY)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER N
DOUBLE PRECISION P(3,N), SY
INTEGER K
IF (NWIN .GE. MWIN .OR. N .GT. MWV) RETURN
NWIN = NWIN + 1
NWV(NWIN) = N
WMOD(NWIN) = MDBLD
DO 10 K = 1, N
WBV(1,K,NWIN) = P(1,K)
WBV(2,K,NWIN) = SY * P(2,K)
WBV(3,K,NWIN) = P(3,K)
10 CONTINUE
RETURN
END
C
C XOCC: an opaque face of the cabin being built, its N corners P
C as XPOLY takes them: drawn as a closed outline, and kept as an
C occluder (OCPOLY).
SUBROUTINE XOCC(N, P, SY)
INTEGER N
DOUBLE PRECISION P(3,N), SY
CALL XPOLY(N, P, 1, SY)
CALL OCPOLY(N, P, SY)
RETURN
END
C
C OCPOLY: an opaque face of the cabin being built, not drawn: the
C N corners P (X, Y, Z, body metres, Y times SY), convex, kept in
C /COCC/ as a fan of triangles for the cabin's hidden lines
C (vmask.f CBCUT). A triangle is plane whatever its corners, so a
C face need not be quite plane.
SUBROUTINE OCPOLY(N, P, SY)
INTEGER N
DOUBLE PRECISION P(3,N), SY
DOUBLE PRECISION A(3), B(3), C(3)
INTEGER K, I
DO 20 K = 2, N - 1
DO 10 I = 1, 3
A(I) = P(I,1)
B(I) = P(I,K)
C(I) = P(I,K+1)
10 CONTINUE
A(2) = SY * A(2)
B(2) = SY * B(2)
C(2) = SY * C(2)
CALL OCTRI(A, B, C)
20 CONTINUE
RETURN
END
C
C OCSTRP: an opaque ring, not drawn: the strip between the closed
C outlines PIN and POUT of N corners each (body metres), corner K
C of one facing corner K of the other, as triangles (OCTRI). A
C face with a hole: the forward bulkhead about the CM's tunnel.
SUBROUTINE OCSTRP(N, PIN, POUT)
INTEGER N
DOUBLE PRECISION PIN(3,N), POUT(3,N)
DOUBLE PRECISION A(3), B(3), C(3), D(3)
INTEGER K, L, I
DO 20 K = 1, N
L = MOD(K, N) + 1
DO 10 I = 1, 3
A(I) = PIN(I,K)
B(I) = PIN(I,L)
C(I) = POUT(I,L)
D(I) = POUT(I,K)
10 CONTINUE
CALL OCTRI(A, B, C)
CALL OCTRI(A, C, D)
20 CONTINUE
RETURN
END
C
C OCTRI: triangle A, B, C (body metres) of the cabin being built
C (MDBLD), into /COCC/; counted in NOCX if the table is full.
SUBROUTINE OCTRI(A, B, C)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION A(3), B(3), C(3)
INTEGER I
IF (NOC .LT. MOC) GO TO 5
NOCX = NOCX + 1
RETURN
5 NOC = NOC + 1
OCMOD(NOC) = MDBLD
DO 10 I = 1, 3
OCV(I,1,NOC) = A(I)
OCV(I,2,NOC) = B(I)
OCV(I,3,NOC) = C(I)
10 CONTINUE
RETURN
END
C
C XRING: a free-line circle, N sides, radius R about C (X, Y, Z,
C body metres) square to body axis IA (1 X, 2 Y, 3 Z).
SUBROUTINE XRING(C, IA, R, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION C(3), R
INTEGER IA, N
DOUBLE PRECISION A(3), B(3), T1, T2
INTEGER K, I, I1, I2
I1 = MOD(IA, 3) + 1
I2 = MOD(IA + 1, 3) + 1
DO 20 K = 1, N
T1 = 2.0D0 * PI * DBLE(K - 1) / DBLE(N)
T2 = 2.0D0 * PI * DBLE(K) / DBLE(N)
DO 10 I = 1, 3
A(I) = C(I)
B(I) = C(I)
10 CONTINUE
A(I1) = C(I1) + R * DCOS(T1)
A(I2) = C(I2) + R * DSIN(T1)
B(I1) = C(I1) + R * DCOS(T2)
B(I2) = C(I2) + R * DSIN(T2)
CALL XLINE(A(2), A(1), A(3), B(2), B(1), B(3), 0)
20 CONTINUE
RETURN
END
src/mpad.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAUNCH COMPLEX MODELS
C
C Core element. The launch complex's part of the spacecraft model
C library (models.f MLIB builds it): Launch Complex 39, Pad A, the
C mobile launcher, its umbilical tower and service arms (#97), and
C the box builders. One relocatable element of the kernel; see
C vdrive.f for the list.
C
C=======================================================================
C
C-----------------------------------------------------------------------
C PADBLD: Launch Complex 39, Pad A, with the mobile launcher (#97;
C the sizes and their sources in viewcom.inc, MNDH to ARM9H). Body
C axes X up the local vertical, -Z toward the umbilical tower, Y to
C make them right handed; origin on the vehicle's axis at the foot
C of the pad, on the drawn Earth (vdrive.f PADAX). Feet below.
C Pad: a truncated pyramid MNDH high, its top MNDT square, its
C sides at the ramp's five percent all round (ours: the pad is
C "roughly octagonal", printed p. 168, and its slopes are not
C given).
C Mobile launcher: six pedestals MLPED high (8 ft square, their
C places ours) and the base on them, a box MLBW across Y and
C MLBL along Z, MLBH high, its deck MNDH + MLPED + MLBH above
C the foot of the pad; the vehicle stands on the deck at the
C base's centre (ours: the 45-foot opening it stands over is not
C drawn, nor the hold-down arms).
C Umbilical tower: on the base's -Z end, its centre LUTZ from the
C vehicle's axis, LUTW square (ours) and LUTH above the deck;
C the lowest LUTFH flared to LUTFW square (ours); the hammerhead
C crane a box along Y, LUTCR each side of the tower's centre, 10
C ft deep and wide, the tower's top 10 ft (ours).
C Plain primitives, none smooth: every edge is drawn where seen.
C-----------------------------------------------------------------------
SUBROUTINE PADBLD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION FT, HT, HB, XB, XD, ZT, PY(2), PZ(3)
INTEGER I, J
DATA PY / -50.0D0, 50.0D0 /
DATA PZ / -60.0D0, 0.0D0, 60.0D0 /
FT = 0.3048D0
HT = 0.5D0 * MNDT * FT
HB = HT + MNDH / MNDG * FT
CALL MKBOX(0.0D0, MNDH * FT, 0.0D0, 0.0D0, HB, HB, HT / HB)
XB = (MNDH + MLPED) * FT
DO 20 I = 1, 2
DO 10 J = 1, 3
CALL MKBOX(MNDH * FT, MLPED * FT, PY(I) * FT, PZ(J) * FT,
& 4.0D0 * FT, 4.0D0 * FT, 1.0D0)
10 CONTINUE
20 CONTINUE
CALL MKBOX(XB, MLBH * FT, 0.0D0, 0.0D0, 0.5D0 * MLBW * FT,
& 0.5D0 * MLBL * FT, 1.0D0)
XD = XB + MLBH * FT
ZT = -LUTZ * FT
CALL MKBOX(XD, LUTFH * FT, 0.0D0, ZT, 0.5D0 * LUTFW * FT,
& 0.5D0 * LUTFW * FT, LUTW / LUTFW)
CALL MKBOX(XD + LUTFH * FT, (LUTH - LUTFH - 10.0D0) * FT, 0.0D0,
& ZT, 0.5D0 * LUTW * FT, 0.5D0 * LUTW * FT, 1.0D0)
CALL MKBOX(XD + (LUTH - 10.0D0) * FT, 10.0D0 * FT, 0.0D0, ZT,
& LUTCR * FT, 5.0D0 * FT, 1.0D0)
RETURN
END
C
C-----------------------------------------------------------------------
C ARMBLD(K1, K2, TH): service arms K1 to K2 of the umbilical
C tower's nine (press kit, printed p. 164), in PADBLD's frame, each
C turned TH deg about a vertical hinge at its -Y side on the
C tower's face: 0 swung out to the vehicle, 90 swung back along the
C face toward -Y (the hinge, its side and the sense ours). Each a
C box 6 ft wide and 8 ft deep (ours), as long as the reach from the
C tower's face to the vehicle's skin at its level, AH ft above the
C deck, AR ft from the vehicle's axis: arm 9, the Apollo access
C arm, "at the 320-foot level above the launcher base" (ARM9H;
C printed p. 165) to the CM's side hatch; the others' levels ours,
C two at the S-IC, three at the S-II, two at the S-IVB and one at
C the instrument unit. MLIB builds arms 1-8 out and back (KARE,
C KARR) and arm 9 out, parked at 12 deg and back (KA9E, KA9P,
C KA9R); vdrive.f PADPL says when.
C-----------------------------------------------------------------------
SUBROUTINE ARMBLD(K1, K2, TH)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K1, K2
DOUBLE PRECISION TH, FT, AH(9), AR(9), XD, ZF, O(3), AX(3)
DOUBLE PRECISION AW(3), AN(3), C, S
INTEGER K
DATA AH / 60.0D0, 120.0D0, 150.0D0, 185.0D0, 212.0D0, 228.0D0,
& 262.0D0, 279.0D0, 0.0D0 /
DATA AR / 16.5D0, 16.5D0, 16.5D0, 16.5D0, 16.5D0, 10.83D0,
& 10.83D0, 10.83D0, 7.0D0 /
AH(9) = ARM9H
FT = 0.3048D0
XD = (MNDH + MLPED + MLBH) * FT
ZF = -(LUTZ - 0.5D0 * LUTW) * FT
C = DCOS(TH * DR)
S = DSIN(TH * DR)
CALL SETV(AX, 1.0D0, 0.0D0, 0.0D0)
CALL SETV(AN, 0.0D0, -S, C)
CALL SETV(AW, 0.0D0, C, S)
IF (K2 .LT. K1) RETURN
DO 10 K = K1, K2
CALL SETV(O, XD + (AH(K) + 4.0D0) * FT,
& -3.0D0 * FT + 3.0D0 * FT * C, ZF + 3.0D0 * FT * S)
CALL MKBAR(O, AW, AX, AN, 3.0D0 * FT, 4.0D0 * FT,
& -ZF - AR(K) * FT)
10 CONTINUE
RETURN
END
C
C PADHC: the height (m) of the CSM's origin (CSMBLD) above the foot
C of the pad, the vehicle standing on the mobile launcher's deck:
C the pad, the pedestals and the base (MNDH, MLPED, MLBH), the
C stages (SICH, SIIH, SIVBH, SIUH) and the SLA (SLAH), less the
C SM's aft end below the origin (SMAFT).
DOUBLE PRECISION FUNCTION PADHC()
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION SMAFT
PADHC = (MNDH + MLPED + MLBH + SICH + SIIH + SIVBH + SIUH + SLAH)
& * 0.3048D0 - SMAFT()
RETURN
END
C
C MKBOX: a box on the model's X axis, from X0 for H (m), centred on
C (YC, ZC), HY by HZ (m) each side of it across, its top scaled by
C SC (1 a box, below 1 a truncated pyramid).
SUBROUTINE MKBOX(X0, H, YC, ZC, HY, HZ, SC)
DOUBLE PRECISION X0, H, YC, ZC, HY, HZ, SC
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), P(2,4)
CALL SETV(O, X0, YC, ZC)
CALL SETV(A1, 0.0D0, 1.0D0, 0.0D0)
CALL SETV(A2, 0.0D0, 0.0D0, 1.0D0)
CALL SETV(AN, 1.0D0, 0.0D0, 0.0D0)
P(1,1) = HY
P(2,1) = -HZ
P(1,2) = HY
P(2,2) = HZ
P(1,3) = -HY
P(2,3) = HZ
P(1,4) = -HY
P(2,4) = -HZ
CALL MKFRU(4, P, O, A1, A2, AN, H, SC)
RETURN
END
C
C MKBAR: a box along AN from O, the centre of its base, for H (m),
C HA along A1 and HB along A2 each side of it.
SUBROUTINE MKBAR(O, A1, A2, AN, HA, HB, H)
DOUBLE PRECISION O(3), A1(3), A2(3), AN(3), HA, HB, H, P(2,4)
P(1,1) = HA
P(2,1) = -HB
P(1,2) = HA
P(2,2) = HB
P(1,3) = -HA
P(2,3) = HB
P(1,4) = -HA
P(2,4) = -HB
CALL MKPRS(4, P, O, A1, A2, AN, H)
RETURN
END
src/pen.f
C=======================================================================
C
C V I E W - 1 1 0 8 PROJECTION AND PEN
C
C Core element. Directions to plot degrees,
C clipping, visibility, and vectors to the plot buffer. One
C relocatable element of the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C THE PEN. Points are camera-relative EQ vectors (km).
C PROJ direction to plot degrees
C UNPROJ plot degrees to a direction (reference or live camera)
C EMIT clip a plot-degree segment to the frame and store it
C SEG project and emit a 3-D segment
C EMIT, SEG and MSEG go through the window mask first (vmask.f),
C which calls EMIT0, SEG0 and MSEG0 here.
C PEN move (IP=0) or draw (IP=1) with the visibility test
C IVMODE; a segment crossing from seen to hidden is cut at
C the boundary by bisection.
C=======================================================================
C-----------------------------------------------------------------------
C PROJECTION. Radially symmetric about the boresight: a direction
C at angle T from the boresight and position angle P (from the
C right axis toward up) lands at radius RHO = K TAN(T/K), taken
C in degrees (times 180/PI, so RHO is T in degrees near the
C centre), at X = RHO COS P, Y = RHO SIN P. K = 1 (gnomonic, true
C perspective) up to a 100 deg field, rising linearly to K = 2
C (stereographic) at 170 deg (PK, set in VFRAME). The frame box
C half-width is RHO(FOV/2) (BOXH).
C Evidence, and it is our inference, not stated in either report:
C the film's descent frames (t28, t31, t35; FOV about 100) show
C the lunar horizon as a straight line at every height, and MSC
C IN 69-FM-197 (PDF p. 170, docking window, FOV 100) shows it
C straight across +-50 at Y = -30: a gnomonic plot draws every
C great circle straight. The same page's 170 deg front-window
C panel shows a fisheye dome, which a stereographic plot gives
C (conformal, circles stay circles); a gnomonic plot cannot reach
C 90 deg off axis at all. The film's evenly spaced ticks,
C labelled in degrees, fit a tangent-plane plot marked in degrees
C at the centre. (An earlier angle-angle mapping drew off-axis
C circles as rounded squares.) PTH returns T (rad).
C-----------------------------------------------------------------------
SUBROUTINE PROJ(D, X, Y, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION D(3), X, Y, A, B, C, S, T, R
INTEGER IOK
A = D(1)*CR(1) + D(2)*CR(2) + D(3)*CR(3)
B = D(1)*CU(1) + D(2)*CU(2) + D(3)*CU(3)
C = D(1)*CB(1) + D(2)*CB(2) + D(3)*CB(3)
S = DSQRT(A * A + B * B)
T = DATAN2(S, C)
PTH = T
IOK = 1
IF (T / DR .GT. THLIM) IOK = 0
IF (T / DR .GT. THLIM) T = THLIM * DR
R = PK * DTAN(T / PK) / DR
X = 0.0D0
Y = 0.0D0
IF (S .GT. 0.0D0) X = R * A / S
IF (S .GT. 0.0D0) Y = R * B / S
RETURN
END
C
C RHO: plot radius (deg) of a direction T (rad) off the boresight.
DOUBLE PRECISION FUNCTION RHO(T)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T
RHO = PK * DTAN(T / PK) / DR
RETURN
END
C
C UNPROJ: plot (X, Y) to a unit direction D. IREF=1: reference
C attitude with K = 1, for window overlays fixed to the vehicle
C (their plot coordinates were read off the film's 100 deg,
C gnomonic frames); IREF=0: the live camera and PK.
SUBROUTINE UNPROJ(X, Y, IREF, D)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION X, Y, D(3), A, B, C, R, T, Q
INTEGER IREF, I
R = DSQRT(X * X + Y * Y)
Q = PK
IF (IREF .EQ. 1) Q = 1.0D0
T = Q * DATAN(R * DR / Q)
C = DCOS(T)
A = 0.0D0
B = 0.0D0
IF (R .GT. 0.0D0) A = DSIN(T) * X / R
IF (R .GT. 0.0D0) B = DSIN(T) * Y / R
DO 10 I = 1, 3
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IREF .EQ. 1) THEN
D(I) = C * BREF(I) + A * RREF(I) + B * UREF(I)
ELSE
D(I) = C * CB(I) + A * CR(I) + B * CU(I)
END IF
C RESTOMOD END
10 CONTINUE
RETURN
END
C
C EMIT0: Liang-Barsky clip to the frame, then store.
C
C The segment is stored as four DOUBLE PRECISION plot degrees
C (60-bit fractions, about 18 digits; UP-4046 Rev 3 pp. 4-9,
C 4-10), far more than a recorder frame resolves (about 1000
C points an axis, 10 bits). A 1969 plot-tape writer could
C plausibly have packed each end point as two 18-bit raster
C coordinates in one 36-bit word (partial-word addressing in
C 6, 9, 12 and 18-bit portions, sec. 4.3.2; FORTRAN V's FLD,
C sec. 10.4.1), and shifted a whole frame with one Add Halves
C (function code 72,04, sec. 4.7.2) per point. Our conjecture:
C no VIEW listing survives. We keep plot degrees for the page.
SUBROUTINE EMIT0(VB, NV, X1, Y1, X2, Y2)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), X1, Y1, X2, Y2
INTEGER NV
DOUBLE PRECISION DX, DY, T0, T1, P(4), Q(4), R
INTEGER K
C RESTOMOD BEGIN: Liang-Barsky line clipping, published 1984
DX = X2 - X1
DY = Y2 - Y1
P(1) = -DX
Q(1) = X1 + BOXH
P(2) = DX
Q(2) = BOXH - X1
P(3) = -DY
Q(3) = Y1 + BOXH
P(4) = DY
Q(4) = BOXH - Y1
T0 = 0.0D0
T1 = 1.0D0
DO 10 K = 1, 4
IF (P(K) .EQ. 0.0D0) THEN
IF (Q(K) .LT. 0.0D0) RETURN
ELSE
R = Q(K) / P(K)
IF (P(K) .LT. 0.0D0) THEN
IF (R .GT. T1) RETURN
IF (R .GT. T0) T0 = R
ELSE
IF (R .LT. T0) RETURN
IF (R .LT. T1) T1 = R
END IF
END IF
10 CONTINUE
IF (NV .GE. MAXV) RETURN
NV = NV + 1
VB(1,NV) = X1 + T0 * DX
VB(2,NV) = Y1 + T0 * DY
VB(3,NV) = X1 + T1 * DX
VB(4,NV) = Y1 + T1 * DY
VB(5,NV) = DBLE(ISTYLE)
C RESTOMOD END
RETURN
END
C
C SEG0: 3-D segment A-B (camera relative) to the frame. A segment
C running past the projection's limit (THLIM off the boresight) is
C cut at the limit by bisection.
SUBROUTINE SEG0(VB, NV, A, B)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), A(3), B(3)
INTEGER NV
DOUBLE PRECISION X1, Y1, X2, Y2, P(3), Q(3), M(3), XM, YM
INTEGER K1, K2, KM, I, IT
CALL PROJ(A, X1, Y1, K1)
CALL PROJ(B, X2, Y2, K2)
IF (K1 .EQ. 0 .AND. K2 .EQ. 0) RETURN
IF (K1 .EQ. 1 .AND. K2 .EQ. 1) GO TO 50
C P inside the limit, Q outside.
DO 10 I = 1, 3
P(I) = A(I)
Q(I) = B(I)
IF (K1 .EQ. 0) P(I) = B(I)
IF (K1 .EQ. 0) Q(I) = A(I)
10 CONTINUE
DO 30 IT = 1, 20
DO 20 I = 1, 3
M(I) = 0.5D0 * (P(I) + Q(I))
20 CONTINUE
CALL PROJ(M, XM, YM, KM)
DO 25 I = 1, 3
IF (KM .EQ. 1) P(I) = M(I)
IF (KM .EQ. 0) Q(I) = M(I)
25 CONTINUE
30 CONTINUE
CALL PROJ(P, XM, YM, KM)
IF (K1 .EQ. 1) X2 = XM
IF (K1 .EQ. 1) Y2 = YM
IF (K1 .EQ. 0) X1 = XM
IF (K1 .EQ. 0) Y1 = YM
50 CALL EMIT0(VB, NV, X1, Y1, X2, Y2)
RETURN
END
C
SUBROUTINE PEN(VB, NV, P, IP)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), P(3)
INTEGER NV, IP
DOUBLE PRECISION A(3), B(3), M(3)
INTEGER IV, ISVIS, I, IT
IV = ISVIS(P)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IP .EQ. 1) THEN
IF (IV .EQ. 1 .AND. IPV .EQ. 1) THEN
CALL SEG(VB, NV, PPX, P)
ELSE IF (IV .NE. IPV) THEN
C Seen end in A, hidden end in B; home in on the boundary.
DO 10 I = 1, 3
IF (IV .EQ. 1) THEN
A(I) = P(I)
B(I) = PPX(I)
ELSE
A(I) = PPX(I)
B(I) = P(I)
END IF
10 CONTINUE
DO 30 IT = 1, 10
DO 20 I = 1, 3
M(I) = 0.5D0 * (A(I) + B(I))
20 CONTINUE
IF (ISVIS(M) .EQ. 1) THEN
DO 22 I = 1, 3
A(I) = M(I)
22 CONTINUE
ELSE
DO 24 I = 1, 3
B(I) = M(I)
24 CONTINUE
END IF
30 CONTINUE
IF (IV .EQ. 1) THEN
CALL SEG(VB, NV, A, P)
ELSE
CALL SEG(VB, NV, PPX, A)
END IF
END IF
END IF
C RESTOMOD END
DO 40 I = 1, 3
PPX(I) = P(I)
40 CONTINUE
IPV = IV
RETURN
END
C
C-----------------------------------------------------------------------
C ISVIS: 1 if camera-relative point P is seen, by IVMODE:
C 0 always
C 1 on the Earth's surface: facing us, not behind the Moon
C 2 on the Earth's limb: not behind the Moon
C 3 on the Moon's surface: facing us, not behind the Earth
C 4 as 1, and on the night side
C 5 on the Moon's limb: not behind the Earth
C 6 on the Moon's surface, facing us and on the night side
C-----------------------------------------------------------------------
INTEGER FUNCTION ISVIS(P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3), N(3), OCCL, SILL
INTEGER I, LMOCC
ISVIS = 1
IF (IVMODE .EQ. 0) RETURN
C Placed spacecraft models hide what lies behind them.
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (NACT .GT. 0) THEN
IF (LMOCC(P, 0) .EQ. 1) THEN
ISVIS = 0
RETURN
END IF
END IF
C RESTOMOD END
C From the LM the window sill hides everything below it: the LM
C station, and the situation's own view from the LM front window.
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF ((JWIN .EQ. 2 .AND. IVUSE .EQ. 0) .OR. IVUSE .EQ. 3) THEN
IF (SILL(P) .GT. 0.0D0) THEN
ISVIS = 0
RETURN
END IF
END IF
C RESTOMOD END
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IVMODE .EQ. 1 .OR. IVMODE .EQ. 4) THEN
DO 10 I = 1, 3
N(I) = P(I) - EPOS(I)
10 CONTINUE
IF (N(1)*P(1) + N(2)*P(2) + N(3)*P(3) .GE. 0.0D0) ISVIS = 0
IF (IVMODE .EQ. 4 .AND. ISVIS .EQ. 1) THEN
IF (N(1)*SUNU(1) + N(2)*SUNU(2) + N(3)*SUNU(3) .GT. 0.0D0)
& ISVIS = 0
END IF
IF (ISVIS .EQ. 1) THEN
IF (OCCL(P, MPOS, RM) .GT. 0.0D0) ISVIS = 0
END IF
ELSE IF (IVMODE .EQ. 2) THEN
IF (OCCL(P, MPOS, RM) .GT. 0.0D0) ISVIS = 0
ELSE IF (IVMODE .EQ. 3) THEN
DO 20 I = 1, 3
N(I) = P(I) - MPOS(I)
20 CONTINUE
IF (N(1)*P(1) + N(2)*P(2) + N(3)*P(3) .GE. 0.0D0) ISVIS = 0
IF (ISVIS .EQ. 1) THEN
IF (OCCL(P, EPOS, RE) .GT. 0.0D0) ISVIS = 0
END IF
ELSE IF (IVMODE .EQ. 5) THEN
IF (OCCL(P, EPOS, RE) .GT. 0.0D0) ISVIS = 0
ELSE IF (IVMODE .EQ. 6) THEN
DO 30 I = 1, 3
N(I) = P(I) - MPOS(I)
30 CONTINUE
IF (N(1)*P(1) + N(2)*P(2) + N(3)*P(3) .GE. 0.0D0) ISVIS = 0
IF (N(1)*SUNU(1) + N(2)*SUNU(2) + N(3)*SUNU(3) .GT. 0.0D0)
& ISVIS = 0
END IF
C RESTOMOD END
RETURN
END
C
C SILL: > 0 if P lies below the LM window sill, 35 deg below the
C centre of the reference (vehicle-fixed) frame.
DOUBLE PRECISION FUNCTION SILL(P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3), B, C
B = P(1)*UREF(1) + P(2)*UREF(2) + P(3)*UREF(3)
C = P(1)*BREF(1) + P(2)*BREF(2) + P(3)*BREF(3)
C Reference plot Y with K = 1 is TAN(T) SIN(P) = B / C (deg).
SILL = 1.0D0
IF (C .GT. 0.0D0) SILL = -35.0D0 - B / C / DR
IF (C .LE. 0.0D0 .AND. B .GE. 0.0D0) SILL = -1.0D0
RETURN
END
C
C OCCL: > 0 if the sight line from the camera to P passes inside
C the sphere of centre S (camera relative) and radius R.
DOUBLE PRECISION FUNCTION OCCL(P, S, R)
DOUBLE PRECISION P(3), S(3), R, T, PP, D1, D2, D3
PP = P(1)*P(1) + P(2)*P(2) + P(3)*P(3)
T = (P(1)*S(1) + P(2)*S(2) + P(3)*S(3)) / PP
IF (T .LT. 0.0D0) T = 0.0D0
IF (T .GT. 1.0D0) T = 1.0D0
D1 = T * P(1) - S(1)
D2 = T * P(2) - S(2)
D3 = T * P(3) - S(3)
OCCL = R * R - (D1 * D1 + D2 * D2 + D3 * D3)
RETURN
END
C
C RAYHIT: > 0 if the ray from the camera along unit U meets the
C sphere of centre S, radius R.
DOUBLE PRECISION FUNCTION RAYHIT(U, S, R)
DOUBLE PRECISION U(3), S(3), R, B
B = U(1)*S(1) + U(2)*S(2) + U(3)*S(3)
RAYHIT = -1.0D0
IF (B .LE. 0.0D0) RETURN
RAYHIT = R * R - (S(1)*S(1) + S(2)*S(2) + S(3)*S(3) - B * B)
RETURN
END
C
SUBROUTINE LABEL(LB, NL, X, Y, KIND, ID)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION LB(4,MAXL), X, Y, D(3)
INTEGER NL, KIND, ID, WMIN
IF (NL .GE. MAXL) RETURN
C With a label level set, the last 8 places are kept for the
C vehicle and pad labels (kinds 8, 9), which come after the sky's
C (ours: a full buffer of crater labels would crowd them out).
IF (ILABL .GE. 1 .AND. KIND .LT. 8 .AND. NL .GE. MAXL - 8) RETURN
IF (DABS(X) .GT. BOXH .OR. DABS(Y) .GT. BOXH) RETURN
C Outside the windows when the window mask applies (vmask.f).
IF (IMSK .EQ. 0) GO TO 10
CALL UNPROJ(X, Y, 0, D)
IF (WMIN(D) .EQ. 0) RETURN
10 NL = NL + 1
LB(1,NL) = X
LB(2,NL) = Y
LB(3,NL) = DBLE(KIND)
LB(4,NL) = DBLE(ID)
RETURN
END
C
C BOXX: a small boxed X of half-width W (plot deg) about (X, Y),
C the mark of the Moon view's landing site (DMOON6), also used for
C the launch pad (DPAD) and vehicle markers (VLMARK).
SUBROUTINE BOXX(VB, NV, X, Y, W)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), X, Y, W
INTEGER NV
CALL EMIT(VB, NV, X - W, Y - W, X + W, Y - W)
CALL EMIT(VB, NV, X + W, Y - W, X + W, Y + W)
CALL EMIT(VB, NV, X + W, Y + W, X - W, Y + W)
CALL EMIT(VB, NV, X - W, Y + W, X - W, Y - W)
CALL EMIT(VB, NV, X - W, Y - W, X + W, Y + W)
CALL EMIT(VB, NV, X - W, Y + W, X + W, Y - W)
RETURN
END
C
C-----------------------------------------------------------------------
C SHADE: night side of the sphere (centre S camera relative, radius
C R) as straight parallel lines (TN D-6853, printed p. 8, fig. 6).
C Each is cut from the sphere by a plane through the eye that
C contains the Sun's direction across the line of sight, so it
C draws as a straight line along the light; 15 span the disc.
C IVM is the visibility test for the night-side points.
C-----------------------------------------------------------------------
SUBROUTINE SHADE(VB, NV, S, R, IVM)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), S(3), R
INTEGER NV, IVM
DOUBLE PRECISION D, AE, U(3), Q(3), C(3), P(3), CF, LA, SF
INTEGER I, J
D = DSQRT(S(1)**2 + S(2)**2 + S(3)**2)
IF (D .LE. R) RETURN
AE = DASIN(R / D)
DO 10 I = 1, 3
U(I) = S(I) / D
10 CONTINUE
CF = SUNU(1)*U(1) + SUNU(2)*U(2) + SUNU(3)*U(3)
DO 20 I = 1, 3
Q(I) = SUNU(I) - CF * U(I)
20 CONTINUE
IF (Q(1)**2 + Q(2)**2 + Q(3)**2 .LT. 1.0D-12) RETURN
CALL VUNIT(Q)
CALL VCRS(U, Q, C)
IVMODE = IVM
DO 40 J = -7, 7
LA = DBLE(J) * AE / 7.5D0
DO 30 I = 1, 3
P(I) = C(I) * DCOS(LA) - U(I) * DSIN(LA)
30 CONTINUE
SF = D * DSIN(LA) / R
IF (DABS(SF) .LT. 1.0D0)
& CALL CIRCLE(VB, NV, S, R, P, DACOS(SF), 180)
40 CONTINUE
IVMODE = 0
RETURN
END
C
C-----------------------------------------------------------------------
C CIRCLE: small circle on the sphere (centre S camera relative,
C radius R), at angle G from the unit axis A, N points, drawn with
C the current IVMODE.
C-----------------------------------------------------------------------
SUBROUTINE CIRCLE(VB, NV, S, R, A, G, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), S(3), R, A(3), G
INTEGER NV, N
DOUBLE PRECISION E1(3), E2(3), P(3), T, CG, SG, CT, ST
INTEGER I, K
CALL PERP(A, E1, E2)
CG = DCOS(G)
SG = DSIN(G)
DO 20 K = 0, N
T = DBLE(K) * 2.0D0 * PI / DBLE(N)
CT = DCOS(T) * SG
ST = DSIN(T) * SG
DO 10 I = 1, 3
P(I) = S(I) + R * (CG * A(I) + CT * E1(I) + ST * E2(I))
10 CONTINUE
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (K .EQ. 0) THEN
CALL PEN(VB, NV, P, 0)
ELSE
CALL PEN(VB, NV, P, 1)
END IF
C RESTOMOD END
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C MSEG0: 3-D segment A-B (camera relative) to the frame, for model
C edges, which may pass beside or behind the camera or very close
C to it (a cabin seen from inside). Without recursion, a stack of
C pieces:
C both ends projected: one vector if the projected midpoint is
C within 0.1 percent of the box half-width of the chord (always
C so in the gnomonic plot, where lines stay straight), else
C split in two (a line bends in the stereographic plot, and
C can pass behind the camera between two seen ends);
C one end past the limit (THLIM, 90 deg times k): cut at the
C limit by bisection, keep the seen part;
C both ends past it: the limit cone is convex only up to 90 deg,
C so the piece can still cross the view: find its point
C nearest the boresight (the angle off it has one minimum along
C a line, so a ternary search) and split there if it is seen.
C Pieces are split at most 10 deep. A point at the camera itself
C projects to the centre (PROJ); nothing divides by the range.
C-----------------------------------------------------------------------
SUBROUTINE MSEG0(VB, NV, A, B)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), A(3), B(3)
INTEGER NV
DOUBLE PRECISION SP(3,32), SQ(3,32), P(3), Q(3), M(3), T(3), W(3)
DOUBLE PRECISION XP, YP, XQ, YQ, XM, YM, DEV, TOL, T0, T1, TA, TB
DOUBLE PRECISION FA, FB, MSCOS
INTEGER SD(32), NS, D, KP, KQ, KM, I, IT
TOL = 1.0D-3 * BOXH
NS = 1
SD(1) = 0
DO 5 I = 1, 3
SP(I,1) = A(I)
SQ(I,1) = B(I)
5 CONTINUE
10 IF (NS .EQ. 0) RETURN
DO 12 I = 1, 3
P(I) = SP(I,NS)
Q(I) = SQ(I,NS)
12 CONTINUE
D = SD(NS)
NS = NS - 1
CALL PROJ(P, XP, YP, KP)
CALL PROJ(Q, XQ, YQ, KQ)
IF (KP .EQ. 0 .AND. KQ .EQ. 0) GO TO 40
IF (KP .EQ. 0 .OR. KQ .EQ. 0) GO TO 30
C Both ends seen.
DO 14 I = 1, 3
M(I) = 0.5D0 * (P(I) + Q(I))
14 CONTINUE
CALL PROJ(M, XM, YM, KM)
C Distance of the projected midpoint off the chord's line (the
C midpoint in space need not project to the chord's midpoint).
T0 = DSQRT((XQ - XP)**2 + (YQ - YP)**2)
DEV = DSQRT((XM - XP)**2 + (YM - YP)**2)
IF (T0 .GT. 1.0D-9) DEV = DABS((XM - XP) * (YQ - YP)
& - (YM - YP) * (XQ - XP)) / T0
IF (D .GE. 10) GO TO 20
IF (KM .EQ. 1 .AND. DEV .LE. TOL) GO TO 20
IF (NS .GE. 31) GO TO 20
CALL MSPUSH(SP, SQ, SD, NS, M, Q, D + 1)
CALL MSPUSH(SP, SQ, SD, NS, P, M, D + 1)
GO TO 10
20 CALL EMIT0(VB, NV, XP, YP, XQ, YQ)
GO TO 10
C One end past the limit: bisect for the crossing (T seen, M not),
C keep the order A to B.
30 DO 32 I = 1, 3
T(I) = P(I)
M(I) = Q(I)
IF (KP .EQ. 0) T(I) = Q(I)
IF (KP .EQ. 0) M(I) = P(I)
32 CONTINUE
DO 36 IT = 1, 20
CALL MSMID(T, M, W, KM)
36 CONTINUE
IF (KP .EQ. 1) CALL MSPUSH(SP, SQ, SD, NS, P, T, D)
IF (KP .EQ. 0) CALL MSPUSH(SP, SQ, SD, NS, T, Q, D)
GO TO 10
C Both ends past the limit.
40 IF (D .GE. 10) GO TO 10
TA = 0.0D0
TB = 1.0D0
DO 44 IT = 1, 40
T0 = TA + (TB - TA) / 3.0D0
T1 = TB - (TB - TA) / 3.0D0
FA = MSCOS(P, Q, T0)
FB = MSCOS(P, Q, T1)
IF (FA .LT. FB) TA = T0
IF (FA .GE. FB) TB = T1
44 CONTINUE
T0 = 0.5D0 * (TA + TB)
DO 46 I = 1, 3
T(I) = P(I) + T0 * (Q(I) - P(I))
46 CONTINUE
CALL PROJ(T, XM, YM, KM)
IF (KM .EQ. 0 .OR. NS .GE. 31) GO TO 10
CALL MSPUSH(SP, SQ, SD, NS, T, Q, D + 1)
CALL MSPUSH(SP, SQ, SD, NS, P, T, D + 1)
GO TO 10
END
C
C MSPUSH: push the piece P-Q, depth D, on the MSEG stack.
SUBROUTINE MSPUSH(SP, SQ, SD, NS, P, Q, D)
DOUBLE PRECISION SP(3,32), SQ(3,32), P(3), Q(3)
INTEGER SD(32), NS, D, I
NS = NS + 1
DO 10 I = 1, 3
SP(I,NS) = P(I)
SQ(I,NS) = Q(I)
10 CONTINUE
SD(NS) = D
RETURN
END
C
C MSMID: one bisection step between seen T and unseen U; P is
C scratch. The midpoint replaces whichever end it matches.
SUBROUTINE MSMID(T, U, P, KM)
DOUBLE PRECISION T(3), U(3), P(3), X, Y
INTEGER KM, I
DO 10 I = 1, 3
P(I) = 0.5D0 * (T(I) + U(I))
10 CONTINUE
CALL PROJ(P, X, Y, KM)
DO 20 I = 1, 3
IF (KM .EQ. 1) T(I) = P(I)
IF (KM .EQ. 0) U(I) = P(I)
20 CONTINUE
RETURN
END
C
C MSCOS: cosine of the angle off the boresight of the point a
C fraction F from P to Q (-1 at the camera itself).
DOUBLE PRECISION FUNCTION MSCOS(P, Q, F)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3), Q(3), F, X(3), R
INTEGER I
DO 10 I = 1, 3
X(I) = P(I) + F * (Q(I) - P(I))
10 CONTINUE
R = DSQRT(X(1) * X(1) + X(2) * X(2) + X(3) * X(3))
MSCOS = -1.0D0
IF (R .GT. 0.0D0) MSCOS = (X(1) * CB(1) + X(2) * CB(2)
& + X(3) * CB(3)) / R
RETURN
END
C
C OVLINE: straight line in reference plot degrees, carried to the
C live camera through its 3-D directions in 1 deg steps.
SUBROUTINE OVLINE(VB, NV, X1, Y1, X2, Y2)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), X1, Y1, X2, Y2
INTEGER NV
DOUBLE PRECISION D(3), F, L
INTEGER K, N
L = DSQRT((X2 - X1)**2 + (Y2 - Y1)**2)
N = 1 + INT(L)
DO 10 K = 0, N
F = DBLE(K) / DBLE(N)
CALL UNPROJ(X1 + F * (X2 - X1), Y1 + F * (Y2 - Y1), 1, D)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (K .EQ. 0) THEN
CALL PEN(VB, NV, D, 0)
ELSE
CALL PEN(VB, NV, D, 1)
END IF
C RESTOMOD END
10 CONTINUE
RETURN
END
src/sim.f
C=======================================================================
C
C V I E W - 1 1 0 8 THE ENGINE
C
C Core element. Flies the CSM through the current scenario: from
C its START state it integrates the motion, plays the SCORE (the
C BURN cards) as impulses, and at each REFERENCE row either resets
C the state to the sourced one (state vector updates on; our
C "delta correction") or only measures how far it has drifted
C (off). It writes the TAPE
C (tape.f) and knows nothing about drawing. One relocatable
C element of the kernel; see vdrive.f for the list.
C
C Period terms (docs/simulation.md). This plays the part of the
C RTACF integrator, "the Apollo Reference Mission Program", which
C wrote the trajectory ephemeris tape (Allday, TN D-6855, pp. 7-
C 8); the RTACF programs were taken over "without change to the
C basic logic and equations" and "run in a batch-processing mode"
C during missions (p. 7). A reset at a reference row plays a
C "CSM/LM STATE VECTOR UPDATE", uplinked to program P27 with verb
C 71 (Comanche 055, UPDATE_PROGRAM.agc). Fig. 2 of TN D-6855
C (p. 6) draws a "Vector transmit" line from the RTCC (IBM
C 360/75s, NASA-TM-X-64290, p. 113) to the RTACF, whose fig. 3
C computers are two Univac 1108s. The mapping is ours.
C VIEW's own integrator was Encke/Cowell (TN D-6853, p. 3).
C
C Physics (ours): Cowell's method, the CSM's geocentric position
C and velocity integrated directly, with the Earth, the Moon and
C the Sun as point masses (the Moon and Sun from ephem.f, the Moon
C through a half-hourly table, MOONQ; the Sun at 1 AU). Fourth-
C order Runge-Kutta; the step is 1/50 of the
C shorter of sqrt(r**3/mu) about the Earth and about the Moon,
C from 1 to 600 s, and it lands exactly on every burn and
C reference row. Burns are impulses at mid-burn. No Earth or
C Moon oblateness, no venting or attitude thrusting.
C
C=======================================================================
C
C-----------------------------------------------------------------------
C SIMRUN: run the engine over the current scenario and fill the
C tape. IFL bit 0: state vector updates on.
C-----------------------------------------------------------------------
SUBROUTINE SIMRUN(IFL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER IFL
DOUBLE PRECISION R(3), V(3), RR(3), VR(3), T, TEND, TN, H
DOUBLE PRECISION SIMDT
INTEGER K, J, I, IST, IDB(MXBURN), IDR(MXREF), ICOR
IF (ISN .EQ. 0) CALL SNSET(1)
CALL TPCLR
ISIMF = IFL
ITPSN = ISN
ICOR = MOD(IFL, 2)
DO 5 J = 1, NRF
RFOK(J) = 0
5 CONTINUE
IST = 0
DO 10 K = 1, NSTART
IF (STSN(K) .EQ. ISN) IST = K
10 CONTINUE
IF (IST .EQ. 0) RETURN
C Done flags: set for cards of other scenarios.
DO 13 K = 1, NBN
IDB(K) = 0
IF (BNSN(K) .NE. ISN) IDB(K) = 1
13 CONTINUE
DO 15 K = 1, NRF
IDR(K) = 0
IF (RFSN(K) .NE. ISN) IDR(K) = 1
15 CONTINUE
T = STP(3,IST)
TEND = STP(2,IST)
C The Moon at nodes every half hour over the run, for MOONQ.
MQDT = 1800.0D0
MQT0 = T - MQDT
NMQ = INT((TEND - MQT0) / MQDT) + 3
IF (NMQ .GT. MXMQ) NMQ = MXMQ
DO 16 K = 1, NMQ
CALL MOONV(MQT0 + DBLE(K - 1) * MQDT, MQ(1,K), MQ(4,K))
16 CONTINUE
CALL STATEV(STP(1,IST), STGC(IST), R, V)
CALL TPPUT(1, T, R, V)
C
C Step to the next event, or by the dynamic step.
20 IF (T .GE. TEND) RETURN
TN = TEND
DO 22 K = 1, NBN
IF (IDB(K) .EQ. 0 .AND. BNT(K) .GT. T .AND. BNT(K) .LT. TN)
& TN = BNT(K)
22 CONTINUE
DO 24 K = 1, NRF
IF (IDR(K) .EQ. 0 .AND. RFP(3,K) .GT. T .AND. RFP(3,K) .LT. TN)
& TN = RFP(3,K)
24 CONTINUE
H = SIMDT(T, R)
IF (T + H .GE. TN) H = TN - T
CALL RK4(T, H, R, V)
T = T + H
IF (T .GE. TN) T = TN
CALL TPPUT(1, T, R, V)
IF (T .LT. TN) GO TO 20
C
C Reference rows at this time: measure, then correct if asked.
DO 40 J = 1, NRF
IF (IDR(J) .NE. 0 .OR. RFP(3,J) .NE. T) GO TO 40
IDR(J) = 1
CALL REFST(J, RR, VR)
RFERR(1,J) = DSQRT((R(1)-RR(1))**2 + (R(2)-RR(2))**2
& + (R(3)-RR(3))**2)
RFERR(2,J) = DSQRT((V(1)-VR(1))**2 + (V(2)-VR(2))**2
& + (V(3)-VR(3))**2) * 1.0D3 / 0.3048D0
RFOK(J) = 1
CALL TPMARK(T, 2, 1, J)
IF (ICOR .EQ. 0) GO TO 40
DO 30 I = 1, 3
R(I) = RR(I)
V(I) = VR(I)
30 CONTINUE
CALL TPPUT(1, T, R, V)
40 CONTINUE
C Burns at this time, as impulses.
DO 50 K = 1, NBN
IF (IDB(K) .NE. 0 .OR. BNT(K) .NE. T) GO TO 50
IDB(K) = 1
CALL BURN(K, T, R, V)
CALL TPMARK(T, 1, 1, K)
CALL TPPUT(1, T, R, V)
50 CONTINUE
GO TO 20
END
C
C SIMDT: the integration step (s) at T, R: 1/50 of the local
C dynamical time about the nearer-acting body, 1 to 600 s.
DOUBLE PRECISION FUNCTION SIMDT(T, R)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T, R(3), PM(3), VM(3), RE3, RM3
CALL MOONQ(T, PM, VM)
RE3 = R(1)**2 + R(2)**2 + R(3)**2
RE3 = RE3 * DSQRT(RE3)
RM3 = (R(1)-PM(1))**2 + (R(2)-PM(2))**2 + (R(3)-PM(3))**2
RM3 = RM3 * DSQRT(RM3)
SIMDT = 0.02D0 * DMIN1(DSQRT(RE3 / GME), DSQRT(RM3 / GMM))
IF (SIMDT .LT. 1.0D0) SIMDT = 1.0D0
IF (SIMDT .GT. 600.0D0) SIMDT = 600.0D0
RETURN
END
C
C MOONQ: the Moon's geocentric position P and velocity V at T from
C the engine's node table (cubic Hermite; the series itself where
C T is off the table).
SUBROUTINE MOONQ(T, P, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T, P(3), V(3), S, H00, H10, H01, H11
DOUBLE PRECISION D00, D10, D01, D11
INTEGER K, I
K = INT((T - MQT0) / MQDT) + 1
IF (NMQ .LT. 2 .OR. K .LT. 1 .OR. K .GE. NMQ) GO TO 20
S = (T - MQT0) / MQDT - DBLE(K - 1)
H00 = (1.0D0 + 2.0D0 * S) * (1.0D0 - S)**2
H10 = S * (1.0D0 - S)**2
H01 = S * S * (3.0D0 - 2.0D0 * S)
H11 = S * S * (S - 1.0D0)
D00 = 6.0D0 * S * (S - 1.0D0)
D10 = (1.0D0 - S) * (1.0D0 - 3.0D0 * S)
D01 = -D00
D11 = S * (3.0D0 * S - 2.0D0)
DO 10 I = 1, 3
P(I) = H00 * MQ(I,K) + H10 * MQDT * MQ(I+3,K)
& + H01 * MQ(I,K+1) + H11 * MQDT * MQ(I+3,K+1)
V(I) = (D00 * MQ(I,K) + D10 * MQDT * MQ(I+3,K)
& + D01 * MQ(I,K+1) + D11 * MQDT * MQ(I+3,K+1)) / MQDT
10 CONTINUE
RETURN
20 CALL MOONV(T, P, V)
RETURN
END
C
C RK4: one Runge-Kutta step of H seconds from T for R, V.
SUBROUTINE RK4(T, H, R, V)
DOUBLE PRECISION T, H, R(3), V(3)
DOUBLE PRECISION A1(3), A2(3), A3(3), A4(3), R2(3), R3(3), R4(3)
DOUBLE PRECISION V2(3), V3(3), V4(3)
INTEGER I
CALL ACCEL(T, R, A1)
DO 10 I = 1, 3
R2(I) = R(I) + 0.5D0 * H * V(I)
V2(I) = V(I) + 0.5D0 * H * A1(I)
10 CONTINUE
CALL ACCEL(T + 0.5D0 * H, R2, A2)
DO 20 I = 1, 3
R3(I) = R(I) + 0.5D0 * H * V2(I)
V3(I) = V(I) + 0.5D0 * H * A2(I)
20 CONTINUE
CALL ACCEL(T + 0.5D0 * H, R3, A3)
DO 30 I = 1, 3
R4(I) = R(I) + H * V3(I)
V4(I) = V(I) + H * A3(I)
30 CONTINUE
CALL ACCEL(T + H, R4, A4)
DO 40 I = 1, 3
R(I) = R(I) + H / 6.0D0 * (V(I) + 2.0D0 * V2(I)
& + 2.0D0 * V3(I) + V4(I))
V(I) = V(I) + H / 6.0D0 * (A1(I) + 2.0D0 * A2(I)
& + 2.0D0 * A3(I) + A4(I))
40 CONTINUE
RETURN
END
C
C ACCEL: geocentric acceleration (km/s**2) at T, R: the Earth, and
C the Moon and the Sun as third bodies (direct minus indirect).
SUBROUTINE ACCEL(T, R, A)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T, R(3), A(3), PM(3), PS(3), D(3), R3, D3, P3
DOUBLE PRECISION GMS, AU, VM(3)
INTEGER I
GMS = 1.32712440018D11
AU = 1.495978707D8
CALL MOONQ(T, PM, VM)
CALL SUNG(T, PS)
R3 = R(1)**2 + R(2)**2 + R(3)**2
R3 = R3 * DSQRT(R3)
DO 10 I = 1, 3
A(I) = -GME * R(I) / R3
PS(I) = AU * PS(I)
D(I) = PM(I) - R(I)
10 CONTINUE
D3 = D(1)**2 + D(2)**2 + D(3)**2
D3 = D3 * DSQRT(D3)
P3 = PM(1)**2 + PM(2)**2 + PM(3)**2
P3 = P3 * DSQRT(P3)
DO 20 I = 1, 3
A(I) = A(I) + GMM * (D(I) / D3 - PM(I) / P3)
D(I) = PS(I) - R(I)
20 CONTINUE
D3 = D(1)**2 + D(2)**2 + D(3)**2
D3 = D3 * DSQRT(D3)
P3 = PS(1)**2 + PS(2)**2 + PS(3)**2
P3 = P3 * DSQRT(P3)
DO 30 I = 1, 3
A(I) = A(I) + GMS * (D(I) / D3 - PS(I) / P3)
30 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C BURN: apply burn K at T to R, V as an impulse: BNDV (ft/s) along
C BNP, BNR, BNN, the direction's components against the velocity,
C the in-plane radial and the orbit normal relative to the body
C BNBOD (1 Earth, 2 Moon).
C-----------------------------------------------------------------------
SUBROUTINE BURN(K, T, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K, I
DOUBLE PRECISION T, R(3), V(3), RB(3), VB(3), PM(3), VM(3)
DO 10 I = 1, 3
RB(I) = R(I)
VB(I) = V(I)
10 CONTINUE
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (BNBOD(K) .EQ. 2) THEN
CALL MOONV(T, PM, VM)
DO 20 I = 1, 3
RB(I) = R(I) - PM(I)
VB(I) = V(I) - VM(I)
20 CONTINUE
END IF
C RESTOMOD END
CALL IMPULS(RB, VB, BNDV(K), BNP(K), BNR(K), BNN(K), V)
RETURN
END
C
C-----------------------------------------------------------------------
C REFST: reference row J as a geocentric EQ state. About the Earth
C from its card as a CONIC leg's state (STATEV). About the Moon:
C its selenographic position at its altitude above the mean
C radius RM, its speed and flight-path angle, and the horizontal
C direction of the lunar leg's plane at that time (LCST, traj.f;
C our choice), then the Moon's own state added.
C-----------------------------------------------------------------------
SUBROUTINE REFST(J, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER J, I
DOUBLE PRECISION R(3), V(3), PM(3), VM(3)
IF (RFBOD(J) .EQ. 2) GO TO 10
CALL STATEV(RFP(1,J), RFGC(J), R, V)
RETURN
10 CALL LCST(RFP(1,J), R, V)
CALL MOONV(RFP(3,J), PM, VM)
DO 20 I = 1, 3
R(I) = PM(I) + R(I)
V(I) = VM(I) + V(I)
20 CONTINUE
RETURN
END
src/tape.f
C=======================================================================
C
C V I E W - 1 1 0 8 THE TAPE
C
C Core element. Time-tagged vehicle states written by the engine
C (sim.f) and read by the state source (vsrc.f); it knows nothing
C of how they were made or how they are drawn. One relocatable
C element of the kernel; see vdrive.f for the list.
C
C Up to four vehicle channels (TN D-6853, printed p. 12: "As many
C as four vehicle trajectories can be integrated simultaneously");
C only channel 1, the CSM, is written now. A burn or a state
C vector update writes two samples at one time, before and after,
C and the reader never interpolates across such a pair. Reading
C is by cubic Hermite interpolation on the positions and
C velocities of the two samples around the time (ours).
C Period term: the "trajectory ephemeris tape", which "contained
C position and velocity-vector data and spacecraft-attitude
C information for one or two spacecraft" and was written by the
C RTACF integrator for programs "that contained no integrator"
C (Allday, TN D-6855, pp. 7-8). That VIEW read such a tape is our
C guess (TN D-6853 p. 3 names only the two parts).
C
C=======================================================================
C
C TPCLR: empty the tape.
SUBROUTINE TPCLR
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER C
DO 10 C = 1, MXCHN
NTP(C) = 0
10 CONTINUE
NMK = 0
RETURN
END
C
C TPPUT: append a sample of channel C at g.e.t. T, state R, V.
C A full channel keeps its last sample slot for the latest state.
SUBROUTINE TPPUT(C, T, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER C, I, K
DOUBLE PRECISION T, R(3), V(3)
K = NTP(C) + 1
IF (K .GT. MXSAM) K = MXSAM
NTP(C) = K
TPT(K,C) = T
DO 10 I = 1, 3
TPS(I,K,C) = R(I)
TPS(I+3,K,C) = V(I)
10 CONTINUE
RETURN
END
C
C TPMARK: append an event mark (kind KIND, channel C, index IX).
SUBROUTINE TPMARK(T, KIND, C, IX)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T
INTEGER KIND, C, IX
IF (NMK .GE. MXMRK) RETURN
NMK = NMK + 1
TMKT(NMK) = T
TMKK(NMK) = KIND
TMKC(NMK) = C
TMKI(NMK) = IX
RETURN
END
C
C-----------------------------------------------------------------------
C TPGET: state of channel C at g.e.t. T. IOK = 0 if T is outside
C the tape. At a time with two samples (a burn or an update)
C the later one is read.
C-----------------------------------------------------------------------
SUBROUTINE TPGET(C, T, R, V, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER C, IOK, LO, HI, MI, I
DOUBLE PRECISION T, R(3), V(3), H, S, H00, H10, H01, H11
DOUBLE PRECISION D00, D10, D01, D11
IOK = 0
IF (NTP(C) .LT. 2) RETURN
IF (T .LT. TPT(1,C) .OR. T .GT. TPT(NTP(C),C)) RETURN
IOK = 1
C The last sample LO with TPT(LO) <= T, by bisection.
LO = 1
HI = NTP(C)
10 IF (HI - LO .LE. 1) GO TO 20
MI = (LO + HI) / 2
IF (TPT(MI,C) .LE. T) LO = MI
IF (TPT(MI,C) .GT. T) HI = MI
GO TO 10
20 IF (TPT(HI,C) .LE. T) LO = HI
IF (LO .EQ. NTP(C)) LO = NTP(C) - 1
HI = LO + 1
H = TPT(HI,C) - TPT(LO,C)
C A zero-length step is a burn or an update: read its later side.
IF (H .GT. 0.0D0) GO TO 30
DO 25 I = 1, 3
R(I) = TPS(I,HI,C)
V(I) = TPS(I+3,HI,C)
25 CONTINUE
RETURN
30 S = (T - TPT(LO,C)) / H
IF (S .GT. 1.0D0) S = 1.0D0
C Cubic Hermite basis and its derivative (per unit S).
H00 = (1.0D0 + 2.0D0 * S) * (1.0D0 - S)**2
H10 = S * (1.0D0 - S)**2
H01 = S * S * (3.0D0 - 2.0D0 * S)
H11 = S * S * (S - 1.0D0)
D00 = 6.0D0 * S * (S - 1.0D0)
D10 = (1.0D0 - S) * (1.0D0 - 3.0D0 * S)
D01 = -D00
D11 = S * (3.0D0 * S - 2.0D0)
DO 40 I = 1, 3
R(I) = H00 * TPS(I,LO,C) + H10 * H * TPS(I+3,LO,C)
& + H01 * TPS(I,HI,C) + H11 * H * TPS(I+3,HI,C)
V(I) = (D00 * TPS(I,LO,C) + D10 * H * TPS(I+3,LO,C)
& + D01 * TPS(I,HI,C) + D11 * H * TPS(I+3,HI,C)) / H
40 CONTINUE
RETURN
END
src/traj.f
C=======================================================================
C
C V I E W - 1 1 0 8 TRAJECTORY LEGS
C
C Core element. Where the spacecraft is at a GET. One relocatable
C element of the kernel; see vdrive.f for the list.
C
C The scenario (data/missions, read into /CSCEN/: one mission's
C data, a run deck in 1969 terms) gives the
C epoch, the trajectory legs and the events. VIEW itself
C integrated trajectories from the state vectors of the operational
C trajectory document (TN D-6853, p. 3, 12); we put each leg on
C one simple model instead, fixed by sourced states:
C CIRC Earth circular orbit through a state (parking orbit);
C CONIC Earth-centred Kepler conic from a state, no lunar
C gravity (translunar and transearth coast);
C LUNAR circle about the Moon through two states, its plane
C and mean motion from those states (lunar orbit); its
C radius may change steadily from the one to the other;
C LCONIC Moon-centred Kepler conic from a state, or from the
C vehicle's leg before it plus an impulse (the LM's
C descent orbit and rendezvous);
C TABLE states listed at their g.e.t.s about the Earth, joined
C by cubic Hermite arcs (TABRV): the powered ascent from
C lift-off to S-IVB cutoff and the entry from entry
C interface to splashdown. Before its first row and
C after its last a table holds that row's place on the
C turning Earth (the pad, the splash point).
C Each leg carries one vehicle, the CSM, the LM or the S-IVB. For
C the CSM a g.e.t. outside every leg takes the nearest leg; the LM
C and the S-IVB have a state only where LMSTAT's and SIVST's rules
C give them one.
C LM descent: P64 approach from 7200 ft altitude and 25600 ft
C range at GET 102:41:30 down to the site at touchdown.
C
C=======================================================================
C
C-----------------------------------------------------------------------
C SNSET: make scenario IM current: its epoch TJD0 (the ephemeris
C keys on it), the elements of each of its legs (LGEL), and the
C event times the scenes use. The LCONIC legs go last, as they
C take their plane from the CSM's lunar legs and, with an impulse,
C their start from the LM's leg before them.
C-----------------------------------------------------------------------
SUBROUTINE SNSET(IM)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER IM
DOUBLE PRECISION R(3), V(3), A(3), B(3), H(3), Y(3), M(3,3)
DOUBLE PRECISION S(3)
DOUBLE PRECISION EVGET, VDOT, ANG
INTEGER K, I, IP, KP
ISN = IM
TJD0 = SNJD0(IM)
DO 95 IP = 1, 2
DO 90 K = 1, NLEG
IF (LGSN(K) .NE. IM) GO TO 90
IF (IP .EQ. 1 .AND. LGTYP(K) .EQ. KLCON) GO TO 90
IF (IP .EQ. 2 .AND. LGTYP(K) .NE. KLCON) GO TO 90
C A TABLE leg is read from its rows each time (TABRV).
IF (LGTYP(K) .EQ. KTABL) GO TO 90
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (LGTYP(K) .EQ. KCIRC) THEN
C Circle through the state's position, along its heading
C made square to the radius (the card's flight-path angle
C dropped, #105; ours).
CALL STATEV(LGP(1,K), LGGC(K), R, V)
CALL VUNIT(R)
CALL VUNIT(V)
CALL VORTH(R, V)
DO 10 I = 1, 3
LGEL(I,K) = R(I)
LGEL(I+3,K) = V(I)
10 CONTINUE
LGEL(9,K) = LGP(3,K)
LGEL(10,K) = RE + LGP(6,K) * 1.852D0
LGEL(11,K) = DSQRT(GME / LGEL(10,K)**3)
ELSE IF (LGTYP(K) .EQ. KCONIC) THEN
CALL STATEV(LGP(1,K), LGGC(K), R, V)
CALL CONEL(R, V, GME, LGP(3,K), LGEL(1,K))
ELSE IF (LGTYP(K) .EQ. KLCON) THEN
C A Moon-centred conic: from the same vehicle's leg before
C this one at T with the impulse DV, or from a selenographic
C state at T (LCST).
KP = 0
DO 20 I = 1, K - 1
IF (LGSN(I) .EQ. IM .AND. LGVEH(I) .EQ. LGVEH(K)) KP = I
20 CONTINUE
IF (LGP(13,K) .NE. 0.0D0 .AND. KP .GT. 0) THEN
CALL LEGRV(KP, LGP(3,K), R, A)
DO 25 I = 1, 3
V(I) = A(I)
25 CONTINUE
CALL IMPULS(R, A, LGP(13,K), LGP(14,K), LGP(15,K),
& LGP(16,K), V)
ELSE
CALL LCST(LGP(1,K), R, V)
END IF
CALL CONEL(R, V, GMM, LGP(3,K), LGEL(1,K))
ELSE
C Lunar circle through state A at T and state B at TB, both
C selenographic, carried to EQ by the Moon's orientation at
C their times. Sense: retrograde (LGGC = 0), the westward
C motion of MR Table 7-II's lunar rows, or prograde (1).
CALL LLUNIT(LGP(4,K), LGP(5,K), S)
CALL MOONRT(LGP(3,K), M)
CALL MXV(M, S, A)
CALL LLUNIT(LGP(11,K), LGP(12,K), S)
CALL MOONRT(LGP(10,K), M)
CALL MXV(M, S, B)
CALL VCRS(A, B, H)
CALL VUNIT(H)
DO 40 I = 1, 3
S(I) = M(I,3)
40 CONTINUE
IF ((VDOT(H, S) .GT. 0.0D0) .EQV. (LGGC(K) .EQ. 0)) THEN
DO 45 I = 1, 3
H(I) = -H(I)
45 CONTINUE
END IF
CALL VCRS(H, A, Y)
ANG = DATAN2(VDOT(B, Y), VDOT(B, A))
IF (ANG .LT. 0.0D0) ANG = ANG + 2.0D0 * PI
DO 50 I = 1, 3
LGEL(I,K) = A(I)
LGEL(I+3,K) = Y(I)
50 CONTINUE
LGEL(9,K) = LGP(3,K)
LGEL(10,K) = RM + LGP(6,K) * 1.852D0
LGEL(11,K) = (ANG + 2.0D0 * PI * DBLE(LGN(K)))
& / (LGP(10,K) - LGP(3,K))
C Radius changing at a steady rate from ALT at T to ALTB at TB
C (km/s; 0 for a circle).
LGEL(7,K) = (LGP(17,K) - LGP(6,K)) * 1.852D0
& / (LGP(10,K) - LGP(3,K))
END IF
C RESTOMOD END
90 CONTINUE
95 CONTINUE
LUT0 = EVGET(KETD)
TETP = EVGET(KEEI)
RETURN
END
C
C CONEL: conic elements EL of the state R, V (km, km/s, about a
C body of GM) at time T: perigee unit P (1-3), Q 90 deg ahead
C (4-6), eccentricity (7), semi-major axis (8), perigee time (9).
SUBROUTINE CONEL(R, V, GM, T, EL)
DOUBLE PRECISION R(3), V(3), GM, T, EL(11)
DOUBLE PRECISION H(3), E(3), Y(3), EV, AX, RR, VV, CN, SN, NU
DOUBLE PRECISION EA, AN, VDOT, VNRM
INTEGER I
CALL VCRS(R, V, H)
RR = VNRM(R)
VV = VDOT(V, V)
CALL VCRS(V, H, E)
DO 20 I = 1, 3
E(I) = E(I) / GM - R(I) / RR
20 CONTINUE
EV = VNRM(E)
AX = 1.0D0 / (2.0D0 / RR - VV / GM)
CALL VUNIT(H)
CALL VUNIT(E)
CALL VCRS(H, E, Y)
CN = VDOT(R, E) / RR
SN = VDOT(R, Y) / RR
NU = DATAN2(SN, CN)
EA = 2.0D0 * DATAN(DSQRT((1.0D0 - EV) / (1.0D0 + EV))
& * DTAN(0.5D0 * NU))
AN = DSQRT(GM / AX**3)
DO 30 I = 1, 3
EL(I) = E(I)
EL(I+3) = Y(I)
30 CONTINUE
EL(7) = EV
EL(8) = AX
EL(9) = T - (EA - EV * DSIN(EA)) / AN
RETURN
END
C
C LCST: an LCONIC card's state (P, the layout of LGP) about the
C Moon, EQ km and km/s: its selenographic position at its altitude
C above the mean radius RM, its speed and flight-path angle, and
C the horizontal direction of the CSM's lunar leg's plane at that
C time (our choice; REFST, sim.f, puts the lunar REF rows so too).
SUBROUTINE LCST(P, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(NLGP), R(3), V(3), S(3), U(3), M(3,3), HN(3)
DOUBLE PRECISION W(3), RA, SP, G
INTEGER K, I, LEGAT
CALL LLUNIT(P(4), P(5), S)
CALL MOONRT(P(3), M)
CALL MXV(M, S, U)
K = LEGAT(P(3), 2, 1)
C No lunar leg of the CSM (a deck without one): no state.
IF (K .GT. 0) GO TO 5
DO 4 I = 1, 3
R(I) = 0.0D0
V(I) = 0.0D0
4 CONTINUE
RETURN
5 CALL VCRS(LGEL(1,K), LGEL(4,K), HN)
CALL VCRS(HN, U, W)
CALL VUNIT(W)
RA = RM + P(6) * 1.852D0
SP = P(7) * 0.3048D-3
G = P(8) * DR
DO 10 I = 1, 3
R(I) = RA * U(I)
V(I) = SP * (DSIN(G) * U(I) + DCOS(G) * W(I))
10 CONTINUE
RETURN
END
C
C IMPULS: add DV (ft/s) to VO along P, RD, N: the components
C along the velocity, the in-plane radial and the orbit normal of
C the state R, V (relative to the body whose frame they are in).
SUBROUTINE IMPULS(R, V, DV, P, RD, N, VO)
DOUBLE PRECISION R(3), V(3), DV, P, RD, N, VO(3)
DOUBLE PRECISION X(3), Y(3), Z(3), DN, D
INTEGER I
DO 10 I = 1, 3
X(I) = V(I)
10 CONTINUE
CALL VUNIT(X)
CALL VCRS(R, V, Z)
CALL VUNIT(Z)
CALL VCRS(Z, X, Y)
DN = DSQRT(P * P + RD * RD + N * N)
IF (DN .LE. 0.0D0) RETURN
D = DV * 0.3048D-3 / DN
DO 20 I = 1, 3
VO(I) = VO(I) + D * (P * X(I) + RD * Y(I) + N * Z(I))
20 CONTINUE
RETURN
END
C
C EVGET: g.e.t. (s) of the current scenario's event of kind KIND,
C or -1 if it has none.
DOUBLE PRECISION FUNCTION EVGET(KIND)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER KIND, J
EVGET = -1.0D0
DO 10 J = 1, NEVT
IF (EVSN(J) .EQ. ISN .AND. EVKND(J) .EQ. KIND) EVGET = EVT(J)
10 CONTINUE
RETURN
END
C
C LEGAT: the current scenario's leg of vehicle IVEH (1 CSM, 2 LM,
C 3 S-IVB)
C about the Earth (ICLS = 1: CIRC, CONIC or TABLE) or the Moon
C (ICLS = 2: LUNAR or LCONIC) whose span holds GET, else the one
C whose span ends nearest it; 0 if there is none.
INTEGER FUNCTION LEGAT(GET, ICLS, IVEH)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, D, DBEST
INTEGER ICLS, IVEH, K, IC
LEGAT = 0
DBEST = 1.0D30
DO 10 K = 1, NLEG
IF (LGSN(K) .NE. ISN .OR. LGVEH(K) .NE. IVEH) GO TO 10
IC = 1
IF (LGTYP(K) .EQ. KLUNAR .OR. LGTYP(K) .EQ. KLCON) IC = 2
IF (IC .NE. ICLS) GO TO 10
D = 0.0D0
IF (GET .LT. LGP(1,K)) D = LGP(1,K) - GET
IF (GET .GT. LGP(2,K)) D = GET - LGP(2,K)
IF (D .GE. DBEST) GO TO 10
DBEST = D
LEGAT = K
10 CONTINUE
RETURN
END
C
C LUNIN: 1 if a CSM lunar leg of the current scenario holds GET in its
C span, else 0 (between the lunar legs, or before or after them,
C LEGAT still gives the nearest circle; a scene that rides the
C CSM only in lunar orbit asks this first). It follows the legs
C even when the tape is the state source: the engine's impulsive
C LOI and TEI sit at mid-burn, so for a minute or two at each edge
C the tape's CSM and this test disagree (ours, accepted).
INTEGER FUNCTION LUNIN(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET
INTEGER K, LEGAT
LUNIN = 0
K = LEGAT(GET, 2, 1)
IF (K .EQ. 0) RETURN
IF (GET .GE. LGP(1,K) .AND. GET .LE. LGP(2,K)) LUNIN = 1
RETURN
END
C
C-----------------------------------------------------------------------
C STATEV: the state in card fields P (the layout of LGP), geocentric
C EQ km and km/s. Latitude
C geodetic (MR Table 7-I, p. 7-8) or geocentric (IGC = 1 or 3, as in
C SP-4029's ascent table); altitude above the ellipsoid (ours:
C equatorial radius RE, flattening 1/298.257); longitude Earth
C fixed, turned by GMST at the state's time to the equator and
C equinox of date, then to J2000 by PRECM's transpose. Speed,
C flight-
C path angle and heading are space-fixed, against the geocentric
C horizontal (MR Table 7-I), or, with IGC 2 or 3, relative to the
C turning Earth (a TABLE row's VEL=EF), the Earth's turning added.
C-----------------------------------------------------------------------
SUBROUTINE STATEV(P, IGC, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER IGC
DOUBLE PRECISION P(NLGP), R(3), V(3)
DOUBLE PRECISION F, E2, FI, LA, H, SF, CF, XN, U(3), N(3), E(3)
DOUBLE PRECISION G, HD, SP, GMSTAT, PSI, RA, PM(3,3), W(3), OM
INTEGER I
C The Earth's turning, rad/s: the rate of GMSTAT.
OM = 360.98564736629D0 * DR / 86400.0D0
F = 1.0D0 / 298.257D0
E2 = F * (2.0D0 - F)
FI = P(4) * DR
LA = P(5) * DR + GMSTAT(P(3))
H = P(6) * 1.852D0
SF = DSIN(FI)
CF = DCOS(FI)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (MOD(IGC, 2) .EQ. 1) THEN
RA = RE * (1.0D0 - F * SF * SF) + H
R(1) = RA * CF * DCOS(LA)
R(2) = RA * CF * DSIN(LA)
R(3) = RA * SF
ELSE
XN = RE / DSQRT(1.0D0 - E2 * SF * SF)
R(1) = (XN + H) * CF * DCOS(LA)
R(2) = (XN + H) * CF * DSIN(LA)
R(3) = (XN * (1.0D0 - E2) + H) * SF
END IF
C RESTOMOD END
C Geocentric horizontal at R.
DO 10 I = 1, 3
U(I) = R(I)
10 CONTINUE
CALL VUNIT(U)
PSI = DASIN(U(3))
N(1) = -DSIN(PSI) * DCOS(LA)
N(2) = -DSIN(PSI) * DSIN(LA)
N(3) = DCOS(PSI)
E(1) = -DSIN(LA)
E(2) = DCOS(LA)
E(3) = 0.0D0
SP = P(7) * 0.3048D-3
G = P(8) * DR
HD = P(9) * DR
DO 20 I = 1, 3
V(I) = SP * (DSIN(G) * U(I) + DCOS(G) * (DCOS(HD) * N(I)
& + DSIN(HD) * E(I)))
20 CONTINUE
IF (IGC .LT. 2) GO TO 25
V(1) = V(1) - OM * R(2)
V(2) = V(2) + OM * R(1)
25 CONTINUE
C Equator of date to J2000.
CALL PRECM((TJD0 + P(3) / 86400.0D0 - 2451545.0D0) / 36525.0D0,
& PM)
CALL MTXV(PM, R, W)
CALL MTXV(PM, V, U)
DO 30 I = 1, 3
R(I) = W(I)
V(I) = U(I)
30 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C ERTORB: the CSM about the Earth, geocentric EQ km and km/s, on
C the current scenario's Earth leg for GET.
C-----------------------------------------------------------------------
SUBROUTINE ERTORB(GET, R, V)
DOUBLE PRECISION GET, R(3), V(3)
INTEGER LEGAT
CALL LEGRV(LEGAT(GET, 1, 1), GET, R, V)
RETURN
END
C
C-----------------------------------------------------------------------
C LUNORB: vehicle IVEH (1 CSM, 2 LM) relative to the Moon, EQ km
C and km/s, on the current scenario's lunar leg of that vehicle
C for GET (the nearest one: LMSTAT decides where the LM has one).
C-----------------------------------------------------------------------
SUBROUTINE LUNORB(GET, IVEH, R, V)
DOUBLE PRECISION GET, R(3), V(3)
INTEGER IVEH, LEGAT
CALL LEGRV(LEGAT(GET, 2, IVEH), GET, R, V)
RETURN
END
C
C-----------------------------------------------------------------------
C LEGRV: position and velocity on leg K at GET, about its body (the
C Earth for CIRC, CONIC and TABLE, the Moon for LUNAR and LCONIC),
C EQ km and km/s.
C-----------------------------------------------------------------------
SUBROUTINE LEGRV(K, GET, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, R(3), V(3), TH, C, S, GM, RA
INTEGER K, I
C No leg (LEGAT found none for that body and vehicle): no state.
IF (K .GT. 0) GO TO 5
DO 4 I = 1, 3
R(I) = 0.0D0
V(I) = 0.0D0
4 CONTINUE
RETURN
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
5 IF (LGTYP(K) .EQ. KCONIC .OR. LGTYP(K) .EQ. KLCON) THEN
GM = GME
IF (LGTYP(K) .EQ. KLCON) GM = GMM
CALL KEPLER(LGEL(1,K), LGEL(4,K), LGEL(7,K), LGEL(8,K),
& LGEL(9,K), GM, GET, R, V)
ELSE IF (LGTYP(K) .EQ. KTABL) THEN
CALL TABRV(K, GET, R, V)
ELSE IF (LGTYP(K) .EQ. KCIRC) THEN
TH = LGEL(11,K) * (GET - LGEL(9,K))
C = DCOS(TH)
S = DSIN(TH)
DO 10 I = 1, 3
R(I) = LGEL(10,K) * (C * LGEL(I,K) + S * LGEL(I+3,K))
V(I) = LGEL(10,K) * LGEL(11,K)
& * (C * LGEL(I+3,K) - S * LGEL(I,K))
10 CONTINUE
ELSE
C LUNAR: the radius RA moves at LGEL(7) km/s.
TH = LGEL(11,K) * (GET - LGEL(9,K))
C = DCOS(TH)
S = DSIN(TH)
RA = LGEL(10,K) + LGEL(7,K) * (GET - LGEL(9,K))
DO 20 I = 1, 3
R(I) = RA * (C * LGEL(I,K) + S * LGEL(I+3,K))
V(I) = RA * LGEL(11,K)
& * (C * LGEL(I+3,K) - S * LGEL(I,K))
& + LGEL(7,K) * (C * LGEL(I,K) + S * LGEL(I+3,K))
20 CONTINUE
END IF
C RESTOMOD END
RETURN
END
C
C-----------------------------------------------------------------------
C TABRV: position and velocity at GET on TABLE leg K, the arc
C between two listed states A (at TA) and B (at TB), geocentric EQ
C km and km/s. Each row is made inertial at its own time
C (STATEV), and the arc is the cubic Hermite through the two
C positions with the two velocities as end slopes, as the tape is
C read (TPGET): ours, VIEW integrated (TN D-6853, p. 3). Before TA
C the vehicle stands at A's place on the turning Earth, after TB
C at B's (LEGAT hands a table its times outside every leg: before
C lift-off and after splashdown).
C The rows' altitudes are above the ellipsoid, but the Earth is
C drawn as a sphere of radius RE, which the pad and the splash
C point lie up to 6 km inside. Near the ground a row is lifted
C onto the sphere, by its ellipsoid's depth there times
C 1 - ALT/HB, nothing from HB (50 n mi, ours) up: the vehicle
C stands on the drawn pad, and the rows at orbit and at entry
C interface keep their true radius, where the legs either side
C meet them. Below HB a geocentric row's latitude is also made
C geodetic, TAN(GD) = TAN(GC) / (1 - F)**2, the footing of the
C coastlines, the pad's mark (learth.f PADEF, DPAD) and the launch
C complex, so the vehicle lifts off from the drawn pad, not 17.9
C km south of it (#105; ours). The latitude is taken whole, not
C blended by altitude as the radius is: a blend would lean the
C climb south by 0.19 m for each metre up (114 m off the pad's
C axis at 10 s, 739 at 30 s, against the table's own northing),
C where whole rows put the 0.16 deg step on the arc from the last
C row below HB to the first above it (Apollo 11 2:42.30 to
C 7:40.62, 36 to 97 n mi up, some 1000 km down range).
C-----------------------------------------------------------------------
SUBROUTINE TABRV(K, GET, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
DOUBLE PRECISION GET, R(3), V(3)
DOUBLE PRECISION PA(NLGP), PB(NLGP), RA(3), VA(3), RB(3), VB(3)
DOUBLE PRECISION TA, TB, H, S, H00, H10, H01, H11, D00, D10, D01
DOUBLE PRECISION D11, HB, SF, FG
INTEGER I, IGA, IGB
HB = 50.0D0
FG = (1.0D0 - 1.0D0 / 298.257D0)**2
DO 10 I = 1, NLGP
PA(I) = LGP(I,K)
PB(I) = LGP(I,K)
10 CONTINUE
TA = LGP(3,K)
TB = LGP(10,K)
PB(3) = TB
PB(4) = LGP(11,K)
PB(5) = LGP(12,K)
PB(6) = LGP(17,K)
PB(7) = LGP(13,K)
PB(8) = LGP(14,K)
PB(9) = LGP(15,K)
IF (LGGC(K) .NE. 1) GO TO 5
IF (PA(6) .LT. HB) PA(4) = DATAN(DTAN(PA(4) * DR) / FG) / DR
IF (PB(6) .LT. HB) PB(4) = DATAN(DTAN(PB(4) * DR) / FG) / DR
5 SF = DSIN(PA(4) * DR)
IF (PA(6) .LT. HB) PA(6) = PA(6)
& + RE * SF * SF / (298.257D0 * 1.852D0) * (1.0D0 - PA(6) / HB)
SF = DSIN(PB(4) * DR)
IF (PB(6) .LT. HB) PB(6) = PB(6)
& + RE * SF * SF / (298.257D0 * 1.852D0) * (1.0D0 - PB(6) / HB)
IGA = LGGC(K) + 2 * MOD(LGN(K), 2)
IGB = LGGC(K) + 2 * (LGN(K) / 2)
C Outside the arc: the end row's place at GET, at rest on the
C Earth.
IF (GET .GE. TA) GO TO 20
PA(3) = GET
PA(7) = 0.0D0
CALL STATEV(PA, LGGC(K) + 2, R, V)
RETURN
20 IF (GET .LE. TB) GO TO 30
PB(3) = GET
PB(7) = 0.0D0
CALL STATEV(PB, LGGC(K) + 2, R, V)
RETURN
30 CALL STATEV(PA, IGA, RA, VA)
CALL STATEV(PB, IGB, RB, VB)
H = TB - TA
S = (GET - TA) / H
H00 = (1.0D0 + 2.0D0 * S) * (1.0D0 - S)**2
H10 = S * (1.0D0 - S)**2
H01 = S * S * (3.0D0 - 2.0D0 * S)
H11 = S * S * (S - 1.0D0)
D00 = 6.0D0 * S * (S - 1.0D0) / H
D10 = (1.0D0 - S) * (1.0D0 - 3.0D0 * S) / H
D01 = -D00
D11 = S * (3.0D0 * S - 2.0D0) / H
DO 40 I = 1, 3
R(I) = H00 * RA(I) + H10 * H * VA(I) + H01 * RB(I)
& + H11 * H * VB(I)
V(I) = D00 * RA(I) + D10 * H * VA(I) + D01 * RB(I)
& + D11 * H * VB(I)
40 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C KEPLER: position and velocity at GET on the ellipse P, Q, E, A
C about a body of GM, with perigee at time TP.
C-----------------------------------------------------------------------
SUBROUTINE KEPLER(P, Q, E, A, TP, GM, GET, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3), Q(3), E, A, TP, GM, GET, R(3), V(3)
DOUBLE PRECISION AM, EA, F, RR, B, C, S, VF
INTEGER I, IT
AM = DSQRT(GM / A**3) * (GET - TP)
EA = AM
IF (E .GT. 0.8D0) EA = PI * DSIGN(1.0D0, AM)
IF (DABS(AM) .GT. PI) EA = AM
DO 10 IT = 1, 50
F = (EA - E * DSIN(EA) - AM) / (1.0D0 - E * DCOS(EA))
EA = EA - F
IF (DABS(F) .LT. 1.0D-12) GO TO 20
10 CONTINUE
20 C = DCOS(EA)
S = DSIN(EA)
B = DSQRT(1.0D0 - E * E)
RR = A * (1.0D0 - E * C)
VF = DSQRT(GM * A) / RR
DO 30 I = 1, 3
R(I) = A * ((C - E) * P(I) + B * S * Q(I))
V(I) = VF * (-S * P(I) + B * C * Q(I))
30 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C LMDESC: LM on the P64 approach. PMF (Moon centred, MF, km) is
C the commander's eye, the camera; body axes XB (thrust, up), YB
C (right), ZB (forward); LMALT the footpads' altitude (km).
C Range and footpad altitude fall as the square of the time to go
C to touchdown (the scenario's TOUCH event, LUT0), reaching 0 there;
C after it the LM stands landed. The line of sight to the site
C stays near 16 deg below the horizontal; the LM pitches up from
C 24 deg off vertical 250 s out to upright 77 s out, and stays
C upright. The film's horizon gives the boresight's depression,
C and the pitch is LPDDN less that. This profile is ours, fitted
C to the film's descent frames (VIEW's pre-flight output). It is
C NOT the flown one: the altitude calls (Apollo Lunar Surface
C Journal, apollojournals.org/alsj/a11/a11.landing.html) have
C 1000 ft at 102:42:37, 300 at 102:43:46, 100 at 102:44:45, 40 at
C 102:45:17, 20 at 102:45:25 and "Contact Light" at 102:45:40;
C ours has about 3850, 1490, 350, 60 and 26 ft at those times.
C In the last minute ours falls about 350 ft where the flown
C descent fell about 100 ft, mostly a hover.
C Eye height above the footpads, LMEYE: ours, 5.1 m. The LM
C "stands 22 feet 11 inches high" with the gear out, the ascent
C stage is 12 feet 4 inches and the descent stage 10 feet 7 inches
C high (Apollo 11 press kit, printed pp. 96, 101), so the ascent
C stage's base is 3.23 m above the pads; we add 0.3 m to the cabin
C floor and 1.6 m for a standing man's eye (our estimates).
C-----------------------------------------------------------------------
SUBROUTINE LMDESC(GET, PMF, XB, YB, ZB)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PMF(3), XB(3), YB(3), ZB(3)
DOUBLE PRECISION S(3), N(3), E(3), F(3), U(3), G(3)
DOUBLE PRECISION FI, LA, AZ, TAU, Q, X, H, TP, C, SN
INTEGER I
C The landing site and descent azimuth from the scenario.
FI = SNSLA(ISN) * DR
LA = SNSLO(ISN) * DR
AZ = SNSAZ(ISN) * DR
S(1) = DCOS(FI) * DCOS(LA)
S(2) = DCOS(FI) * DSIN(LA)
S(3) = DSIN(FI)
N(1) = -DSIN(FI) * DCOS(LA)
N(2) = -DSIN(FI) * DSIN(LA)
N(3) = DCOS(FI)
E(1) = -DSIN(LA)
E(2) = DCOS(LA)
E(3) = 0.0D0
DO 10 I = 1, 3
F(I) = DCOS(AZ) * N(I) + DSIN(AZ) * E(I)
10 CONTINUE
LMEYE = 5.1D-3
TAU = LUT0 - GET
IF (TAU .LT. 0.0D0) TAU = 0.0D0
IF (TAU .GT. 600.0D0) TAU = 600.0D0
Q = TAU / 250.0D0
X = 7.80D0 * Q * Q
H = 2.19D0 * Q * Q
LMALT = H
DO 20 I = 1, 3
G(I) = S(I) - (X / RM) * F(I)
20 CONTINUE
CALL VUNIT(G)
DO 30 I = 1, 3
U(I) = G(I)
30 CONTINUE
C Forward direction made horizontal at the LM.
C = F(1) * U(1) + F(2) * U(2) + F(3) * U(3)
DO 40 I = 1, 3
F(I) = F(I) - C * U(I)
40 CONTINUE
CALL VUNIT(F)
TP = (35.0D0 * Q - 10.8D0) * DR
IF (TP .GT. 44.2D0 * DR) TP = 44.2D0 * DR
IF (TP .LT. 0.0D0) TP = 0.0D0
C = DCOS(TP)
SN = DSIN(TP)
DO 50 I = 1, 3
XB(I) = C * U(I) - SN * F(I)
ZB(I) = SN * U(I) + C * F(I)
C The eye, LMEYE above the footpads along the LM's up axis.
PMF(I) = (RM + H) * G(I) + LMEYE * XB(I)
50 CONTINUE
CALL VCRS(ZB, XB, YB)
RETURN
END
C
C-----------------------------------------------------------------------
C LMSTAT: the LM at GET relative to the Moon, EQ km and km/s: the
C point of its body axes 2.3 m up the thrust axis from the descent
C stage's base, the stage joint MPLACE centres it on (LMLOC, ours).
C IOK = 0 where we have no state for it, 1 its own state, 2 docked
C (the CSM's state). The rules, in the scenario's events (ours
C where marked):
C before UNDOCK, and from LMDOK to JETT: docked;
C UNDOCK to LMSEP: 300 ft from the CSM along the orbit normal,
C the pirouette's distance (scene 4; ours);
C LMSEP to LMSEP + 300 s: its first leg plus its offset from that
C leg at LMSEP, dying away linearly, so the LM leaves the 300 ft
C point without a jump (ours). The range then opens at about
C 16 ft/s, 21 ft/s once on the leg (measured): faster than the
C separation burn's 1.4 ft/s (MR Table 7-V p. 7-11), the leg
C sinking toward the DOI row from separation on (ours);
C TOUCH - 600 s to TOUCH: the modelled descent (LMDESC);
C TOUCH to LIFT: landed at the site;
C TPF to LMDOK: the CSM plus the LM's offset from it at TPF on
C its last leg, closing linearly to nothing at docking (ours);
C otherwise on a VEH=LM leg whose span holds GET, or across a
C gap of 60 s or less between two of them (a burn; ours);
C else none: the powered descent before LMDESC, the powered
C ascent, after JETT, and a scenario without an UNDOCK event.
C The CSM's state comes from the state source (CSMSL, CSMST:
C replay or tape); the LM's own legs from the replay only.
C-----------------------------------------------------------------------
SUBROUTINE LMSTAT(GET, R, V, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, R(3), V(3)
INTEGER IOK
DOUBLE PRECISION TU, TS, TF, TD, TJ, TL, F, D(3), DV(3), H(3)
DOUBLE PRECISION PMF(3), P2(3), XB(3), YB(3), ZB(3), M(3,3)
DOUBLE PRECISION SALT, SEYE, W, LMLOC, TBL, EVGET
INTEGER I, K, LMLEG
C Body point of the state above the footpads (km): the stage joint
C at X = 2.3 m, the gear's pads at X = -1.1 m (LMGEAR).
LMLOC = 3.4D-3
C The separation's blend time (s; ours).
TBL = 300.0D0
IOK = 0
TU = EVGET(KEUND)
IF (TU .LT. 0.0D0) RETURN
TS = EVGET(KELMS)
TF = EVGET(KETPF)
TD = EVGET(KELDK)
TJ = EVGET(KEJET)
TL = EVGET(KELFT)
IF (TJ .GE. 0.0D0 .AND. GET .GE. TJ) RETURN
IF (GET .LT. TU .OR. (TD .GE. 0.0D0 .AND. GET .GE. TD)) GO TO 10
IF (TS .GE. 0.0D0 .AND. GET .LT. TS) GO TO 20
IF (TF .GE. 0.0D0 .AND. TD .GT. TF .AND. GET .GE. TF) GO TO 30
IF (LUT0 .GT. 0.0D0 .AND. GET .GE. LUT0 - 600.0D0
& .AND. GET .LT. LUT0) GO TO 40
IF (LUT0 .GT. 0.0D0 .AND. GET .GE. LUT0
& .AND. (TL .LT. 0.0D0 .OR. GET .LT. TL)) GO TO 50
K = LMLEG(GET)
IF (K .EQ. 0) RETURN
CALL LEGRV(K, GET, R, V)
IOK = 1
IF (TS .LT. 0.0D0 .OR. GET .GE. TS + TBL) RETURN
IF (LMLEG(TS) .NE. K) RETURN
C Just after the separation: the offset at LMSEP of the 300 ft
C point (label 20) from the leg, dying away over TBL.
CALL LEGRV(K, TS, D, DV)
CALL CSMSL(TS, P2, XB)
CALL VCRS(P2, XB, H)
CALL VUNIT(H)
F = 1.0D0 - (GET - TS) / TBL
DO 5 I = 1, 3
D(I) = P2(I) + 300.0D0 * 0.3048D-3 * H(I) - D(I)
R(I) = R(I) + F * D(I)
V(I) = V(I) - D(I) / TBL
5 CONTINUE
RETURN
C Docked: the CSM.
10 CALL CSMSL(GET, R, V)
IOK = 2
RETURN
C Undocked, before the separation burn.
20 CALL CSMSL(GET, R, V)
CALL VCRS(R, V, H)
CALL VUNIT(H)
DO 25 I = 1, 3
R(I) = R(I) + 300.0D0 * 0.3048D-3 * H(I)
25 CONTINUE
IOK = 1
RETURN
C Braking to docking: the offset at TPF, closing.
30 K = LMLEG(TF)
IF (K .EQ. 0) RETURN
CALL LEGRV(K, TF, D, DV)
CALL CSMSL(TF, H, XB)
DO 32 I = 1, 3
D(I) = D(I) - H(I)
32 CONTINUE
F = (TD - GET) / (TD - TF)
CALL CSMSL(GET, R, V)
DO 35 I = 1, 3
R(I) = R(I) + F * D(I)
V(I) = V(I) - D(I) / (TD - TF)
35 CONTINUE
IOK = 1
RETURN
C The modelled descent: LMDESC's eye less its height above the
C state's point; velocity over one second, as scene 5 takes it.
C LMDESC's LMALT and LMEYE belong to scene 5's frame: kept.
40 SALT = LMALT
SEYE = LMEYE
CALL LMDESC(GET, PMF, XB, YB, ZB)
CALL LMDESC(GET + 1.0D0, P2, YB, ZB, H)
DO 42 I = 1, 3
PMF(I) = PMF(I) - (LMEYE - LMLOC) * XB(I)
P2(I) = P2(I) - (LMEYE - LMLOC) * YB(I)
42 CONTINUE
LMALT = SALT
LMEYE = SEYE
CALL MOONRT(GET, M)
CALL MXV(M, PMF, R)
CALL MOONRT(GET + 1.0D0, M)
CALL MXV(M, P2, H)
DO 45 I = 1, 3
V(I) = H(I) - R(I)
45 CONTINUE
IOK = 1
RETURN
C Landed: the site, LMLOC above the mean radius, carried by the
C Moon's turning (the IAU rate MOONRT uses, 13.17635815 deg/day).
50 CALL LLUNIT(SNSLA(ISN), SNSLO(ISN), H)
CALL MOONRT(GET, M)
CALL MXV(M, H, PMF)
W = 13.17635815D0 * DR / 86400.0D0
DO 55 I = 1, 3
R(I) = (RM + LMLOC) * PMF(I)
XB(I) = M(I,3)
55 CONTINUE
CALL VCRS(XB, R, V)
DO 58 I = 1, 3
V(I) = W * V(I)
58 CONTINUE
IOK = 1
RETURN
END
C
C-----------------------------------------------------------------------
C SIVST: the S-IVB at GET, geocentric EQ km and km/s: the centre of
C the stage with its IU (half SIVBMD's 61.3 ft below the IU's top,
C on its axis). IOK = 0 where we have no state for it, 1 its own,
C 2 with the CSM (the CSM's state before separation; the stack's
C place, docked). The rules, in the scenario's events (ours where
C marked):
C before SEP: with the CSM, which it carries (IOK 2);
C SEP to EJECT: the CSM plus scene 7's geometry (vdrive.f S7SIV
C at S7RF's range, as S7POSE places it), IOK 1 to DOCK and 2
C from it;
C EJECT to SLING: the CSM plus its offset from the CSM at EJECT,
C less the separation the CSM made from then on: the ejection
C springs' "about one fps velocity to the spacecraft" (Apollo
C 11 press kit, printed p. 30) along the stack's axis, and each
C of the scenario's BURN cards about the Earth in the span (the
C evasive manoeuvre), an impulse at its time in the CSM leg's
C frame there (IMPULS). Straight lines (ours: the half hour's
C gravity gradient, 25,000 km and more from the Earth's
C centre, bends them by a few percent);
C otherwise on a VEH=SIVB leg whose span holds GET, else none:
C after SEP in a scenario without an EJECT event (Apollo 8,
C see its scenario), and from SLING on (the slingshot: no
C velocity change we hold).
C The CSM's state is the state source's (CSMST: replay or tape).
C The offsets are relative, so the range between the two is the
C same from either; the replay's CSM leg has no evasive burn, so
C there both are off their own paths by the burn's drift (ours).
C ISRCU is left as it was (S7ATT and CSMST set it).
C-----------------------------------------------------------------------
SUBROUTINE SIVST(GET, R, V, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, R(3), V(3)
INTEGER IOK
DOUBLE PRECISION TS, TE, TG, TD, T, P(3), DV(3), RB(3), VB(3)
DOUBLE PRECISION VEJ, EVGET, S7RF
INTEGER I, K, J, LEGAT
J = ISRCU
IOK = 0
TS = EVGET(KESEP)
TE = EVGET(KEEJC)
TG = EVGET(KESLG)
TD = EVGET(KEDOK)
IF (TS .GE. 0.0D0 .AND. GET .LT. TS) GO TO 10
IF (TE .LT. 0.0D0) GO TO 80
IF (TG .GE. 0.0D0 .AND. GET .GE. TG) GO TO 80
CALL S7ATT
IF (GET .GE. TE) GO TO 30
C Separated, docking, docked: scene 7's geometry.
CALL S7SIV(S7RF(GET), P)
CALL CSMST(GET, 1, R, V)
DO 5 I = 1, 3
R(I) = R(I) + P(I)
5 CONTINUE
IOK = 1
IF (TD .GE. 0.0D0 .AND. GET .GE. TD) IOK = 2
GO TO 90
C Before the separation: with the CSM.
10 CALL CSMST(GET, 1, R, V)
IOK = 2
GO TO 90
C Ejected: the offset at EJECT, the springs' drift (1 ft/s, the
C S-IVB down the stack's -X), then the CSM's burns taken back.
30 CALL S7SIV(S7RF(TE), P)
VEJ = 0.3048D-3
T = GET - TE
CALL CSMST(GET, 1, R, V)
DO 35 I = 1, 3
R(I) = R(I) + P(I) - VEJ * T * S7AT(I,1)
V(I) = V(I) - VEJ * S7AT(I,1)
35 CONTINUE
DO 50 K = 1, NBN
IF (BNSN(K) .NE. ISN .OR. BNBOD(K) .NE. 1) GO TO 50
IF (BNT(K) .LE. TE .OR. BNT(K) .GT. GET) GO TO 50
CALL ERTORB(BNT(K), RB, VB)
CALL SETV(DV, 0.0D0, 0.0D0, 0.0D0)
CALL IMPULS(RB, VB, BNDV(K), BNP(K), BNR(K), BNN(K), DV)
DO 45 I = 1, 3
R(I) = R(I) - (GET - BNT(K)) * DV(I)
V(I) = V(I) - DV(I)
45 CONTINUE
50 CONTINUE
IOK = 1
GO TO 90
C A VEH=SIVB leg (none in our scenarios).
80 K = LEGAT(GET, 1, 3)
IF (K .EQ. 0) GO TO 90
IF (GET .LT. LGP(1,K) .OR. GET .GT. LGP(2,K)) GO TO 90
CALL LEGRV(K, GET, R, V)
IOK = 1
90 ISRCU = J
RETURN
END
C
C LMLEG: the LM leg (VEH=LM) of the current scenario whose span
C holds GET, or, in a gap of 60 s or less between two of them (a
C burn), the nearer of the two; 0 if none.
INTEGER FUNCTION LMLEG(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, DA, DB
INTEGER K, KA, KB
LMLEG = 0
KA = 0
KB = 0
DA = 61.0D0
DB = 61.0D0
DO 10 K = 1, NLEG
IF (LGSN(K) .NE. ISN .OR. LGVEH(K) .NE. 2) GO TO 10
IF (GET .GE. LGP(1,K) .AND. GET .LE. LGP(2,K)) LMLEG = K
IF (GET .GT. LGP(2,K) .AND. GET - LGP(2,K) .LT. DA) KA = K
IF (GET .GT. LGP(2,K) .AND. GET - LGP(2,K) .LT. DA)
& DA = GET - LGP(2,K)
IF (GET .LT. LGP(1,K) .AND. LGP(1,K) - GET .LT. DB) KB = K
IF (GET .LT. LGP(1,K) .AND. LGP(1,K) - GET .LT. DB)
& DB = LGP(1,K) - GET
10 CONTINUE
IF (LMLEG .NE. 0 .OR. KA .EQ. 0 .OR. KB .EQ. 0) RETURN
IF (DA + DB .GT. 60.0D0) RETURN
LMLEG = KA
IF (DB .LT. DA) LMLEG = KB
RETURN
END
C
C-----------------------------------------------------------------------
C ERFIND: time TERISE at which the Earth's disc clears the lunar
C horizon, on the revolution ending at touchdown (the scenario's
C TOUCH event), or at its PHOTO event if it has no landing.
C-----------------------------------------------------------------------
SUBROUTINE ERFIND
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T, T1, T2, TM, F1, FM, P, ERCLR, TR, EVGET
INTEGER I, K, LEGAT
C The revolution ends at touchdown, or, in a scenario with no
C landing (Apollo 8), at its PHOTO event. Without a lunar leg of
C the CSM there is no Earthrise: half an hour before that time, as
C when the search finds none.
TR = LUT0
IF (TR .LE. 0.0D0) TR = EVGET(KEPHO)
TERISE = TR - 1800.0D0
K = LEGAT(TR, 2, 1)
IF (K .EQ. 0) RETURN
P = 2.0D0 * PI / LGEL(11, K)
T1 = TR - P
F1 = ERCLR(T1)
DO 10 I = 1, 720
T = TR - P + DBLE(I) * P / 720.0D0
FM = ERCLR(T)
IF (F1 .LT. 0.0D0 .AND. FM .GE. 0.0D0) GO TO 20
T1 = T
F1 = FM
10 CONTINUE
TERISE = TR - 1800.0D0
RETURN
20 T2 = T
DO 30 I = 1, 40
TM = 0.5D0 * (T1 + T2)
FM = ERCLR(TM)
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (FM .LT. 0.0D0) THEN
T1 = TM
ELSE
T2 = TM
END IF
C RESTOMOD END
30 CONTINUE
TERISE = T2
RETURN
END
C
C ERCLR: angle (rad) of the Earth's lower limb above the lunar
C horizon as seen from the CSM.
DOUBLE PRECISION FUNCTION ERCLR(T)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION T, R(3), V(3), PM(3), E(3), DN(3), DE, VDOT
INTEGER I
CALL VSTATE(T, 1, 2, R, V, I)
CALL MOONG(T, PM)
DO 10 I = 1, 3
E(I) = -PM(I) - R(I)
DN(I) = -R(I)
10 CONTINUE
DE = DSQRT(VDOT(E, E))
CALL VUNIT(E)
CALL VUNIT(DN)
ERCLR = DACOS(VDOT(E, DN)) - DASIN(RM / DSQRT(VDOT(R, R)))
& - DASIN(RE / DE)
RETURN
END
src/vdeck.f
C VDECK: the card reader (#26), the kernel reading its own run
C decks: a mission's cards (MISSION, EPOCH, SITE, PAD) and its
C scenarios' (data/missions/*/*.scn), one card image at a time,
C into the run tables (/CSCEN/ to /CBRN/, the situation tables,
C SITECH); they have no other source. TN D-6853 printed p. 12 has VIEW
C take its trajectory from the operational trajectory document per
C mission; a deck read per run is that shape. Which cards, their
C keys and code words: tools/gen_data.py, which writes the
C vocabulary (vdvoc.f) from the same tables it checks decks with.
C
C CRDOPN empties the run tables; CRDIN reads one card; CRDEOF ends
C a file (the open TABLE leg, the scenario in hand); CRDEND ends the
C deck (resolves the burn cues, checks what the kernel needs: ids
C 1..N, a situation, each scenario's epoch, CSM leg and the events
C its situations name) and gives the first deck error, its card
C number and the warnings. A refused deck leaves the run tables
C empty, and VINIT then selects nothing. CRDSUM is a hash total of
C the run tables (ours; vdksum.f), so two loads can be compared
C word for word. The card semantics are in vdkscn.f (the
C mission's and scenario's cards) and vdksit.f (the situation
C cards), the field readers (words, numbers, lists, text) in
C vdkfld.f, the tape cards (a TAPE card, then rows of numbers into
C /CTAPE/) in vdktap.f.
C tools/gen_data.py still checks the rest of a deck (each recipe's
C keys, poses).
C
C A card: KIND KEY=VALUE ..., values in double or single quotes
C where they hold blanks (no escapes); a * in column 1 or a blank
C card is a comment. A number: one sign, digits with one point at
C most, an E exponent. A g.e.t.: h:mm:ss.s, h:mm or a number, one
C leading - at most. Every number is read exactly: its digits as
C an integer (15 at most),
C then one multiply or divide by a power of ten up to 10**22, both
C exact, so the double is the decimal correctly rounded, the value
C a compiler gives the same digits as a constant (Clinger 1990,
C the fast path). A number of 16 or 17 significant digits, as a
C tape row carries (a double from about 10**-28 to 10**38 in
C magnitude, written with 17 digits, reads back the same), or with
C a power of ten down to 10**-44, is carried in two doubles and
C rounded once (DKDD, vdkfld.f). A g.e.t. h:mm:ss.s folds h and
C mm into that integer (15 digits at most). RESTOMOD: free-field
C input was a FORTRAN V extension
C (UP-4046 sec. 10.4.1); this hand reader of KEY=VALUE cards stands
C in for NAMELIST, which LFortran does not have. Every DO here
C whose count can be 0 is guarded: no FORTRAN V source we hold says
C such a loop is skipped (#26; ours).
C
C Deck errors (IDKER; the first one stands, the deck is refused):
C 1 card longer than MXCRD 2 bad number
C 3 more than 17 significant digits (15 in a g.e.t. h:mm:ss),
C or a power of ten outside 10**-44 to 10**22
C 4 unknown word 5 a required key missing
C 6 card out of place 7 ID out of range
C 8 ID (or a scenario's START) given twice
C 9 TABLE leg: fewer than two ROW cards, or rows out of order
C 10 BURNCUE: no TIMELINE row by that name
C 11 legs full 12 events full 13 START full 14 BURN full
C 15 REF full 16 TIMELINE full 17 BURNCUE full
C 18 TABLE rows full 19 name store full
C 20 scenario or situation ids not 1..N, or a situation without
C its RECIPE and VIEWS cards
C 21 too many tokens, an open quote, or a word without =
C 22 list of the wrong length, or a layer named twice
C 23 name too long or not plain ASCII, or a second SITE NAME
C 24 no situation 25 mission cards out of order (one
C MISSION, then EPOCH, before the mission's scenarios)
C 26 a scenario without a CSM leg, or with an LM leg about the Moon
C but no CSM leg about the Moon (the LM's legs are built on it)
C 27 a situation's GET= or AT= event not in its scenario
C 28 tape full (MXSAM samples on a channel)
C 29 tape rows out of time order, or a tape of fewer than two
C 30 TAPE: its scenario not read yet, or a second scenario's tape
C (/CTAPE/ holds one)
C A card that starts with a number is a tape row: deck error 6 if
C no tape is open, 22 if it has not seven numbers.
C
SUBROUTINE CRDOPN
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K
CALL DKCLR
C The deck in hand, and no scenario or tape left from the last.
IDKER = 0
IDKCD = 0
NDKWN = 0
NDKCD = 0
IMHV = 0
CALL DKMSN
ITBON = 0
NTBR = 0
NTNC = 0
NCQ = 0
NCQC = 0
ITPON = 0
ISN = 0
ISCN = 0
P10(1) = 1.0D0
DO 30 K = 2, 23
P10(K) = P10(K-1) * 10.0D0
30 CONTINUE
RETURN
END
C
C DKCLR: the run tables emptied, every row and count, SITECH, and
C the tape (no scenario on it).
SUBROUTINE DKCLR
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER I, K
DO 10 K = 1, MXSN
SNJD0(K) = 0.0D0
SNSLA(K) = 0.0D0
SNSLO(K) = 0.0D0
SNSAZ(K) = 0.0D0
SNPLA(K) = 0.0D0
SNPLO(K) = 0.0D0
SNPGC(K) = 0
ISNHV(K) = 0
10 CONTINUE
DO 11 K = 1, 8*MXSN
PADCH(K) = 0
11 CONTINUE
DO 12 K = 1, 22
SITECH(K) = 0
12 CONTINUE
DO 14 K = 1, MXLEG
DO 13 I = 1, NLGP
LGP(I,K) = 0.0D0
13 CONTINUE
LGSN(K) = 0
LGTYP(K) = 0
LGN(K) = 0
LGGC(K) = 0
LGVEH(K) = 0
14 CONTINUE
DO 15 K = 1, MXEVT
EVT(K) = 0.0D0
EVSN(K) = 0
EVKND(K) = 0
15 CONTINUE
DO 17 K = 1, MXSTRT
DO 16 I = 1, NLGP
STP(I,K) = 0.0D0
16 CONTINUE
STSN(K) = 0
STBOD(K) = 0
STGC(K) = 0
17 CONTINUE
DO 19 K = 1, MXREF
DO 18 I = 1, NLGP
RFP(I,K) = 0.0D0
18 CONTINUE
RFSN(K) = 0
RFBOD(K) = 0
RFGC(K) = 0
RFOK(K) = 0
19 CONTINUE
DO 20 K = 1, MXBURN
BNT(K) = 0.0D0
BNDV(K) = 0.0D0
BNP(K) = 0.0D0
BNR(K) = 0.0D0
BNN(K) = 0.0D0
BNSN(K) = 0
BNBOD(K) = 0
20 CONTINUE
DO 21 K = 1, MXTL
TLT(K) = 0.0D0
TLK(K) = 0
TLSN(K) = 0
21 CONTINUE
DO 22 K = 1, MXCUE
BRT1(K) = 0.0D0
BRT2(K) = 0.0D0
BRSN(K) = 0
BRVH(K) = 0
BREN(K) = 0
22 CONTINUE
DO 23 K = 1, MXSIT
CALL DKSIZ(K)
ISTHV(K) = 0
23 CONTINUE
NSN = 0
NLEG = 0
NEVT = 0
NSTART = 0
NRF = 0
NBN = 0
NTL = 0
NBR = 0
NSIT = 0
CALL TPCLR
ITPSN = 0
ISIMF = 0
RETURN
END
C
C CRDIN: one card image, NC character codes in IC.
SUBROUTINE CRDIN(IC, NC)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IC(MXCRD), NC
INTEGER I, J, K, W, IB, C, DKLOOK
NDKCD = NDKCD + 1
IF (IDKER .NE. 0) RETURN
IF (NC .GE. 0 .AND. NC .LE. MXCRD) GO TO 5
CALL DKERR(1)
RETURN
5 NCRD = NC
IF (NC .EQ. 0) RETURN
DO 10 I = 1, NC
ICRD(I) = IC(I)
10 CONTINUE
C Trailing blanks, tabs and carriage returns off; blank cards and
C cards with * in column 1 are comments.
20 IF (NCRD .EQ. 0) RETURN
I = ICRD(NCRD)
IF (I .NE. ICBLK .AND. I .NE. ICTAB .AND. I .NE. ICCR) GO TO 30
NCRD = NCRD - 1
GO TO 20
30 IF (ICRD(1) .EQ. ICSTR) RETURN
CALL DKTOK
IF (IDKER .NE. 0) RETURN
C A card that starts with a number: a row of the open tape.
IF (TKL(1) .EQ. 0) GO TO 34
C = ITKB(TKS(1))
IF ((C .LT. ICD0 .OR. C .GT. ICD9) .AND. C .NE. ICPLS .AND.
& C .NE. ICMIN .AND. C .NE. ICPT) GO TO 34
IF (ITPON .EQ. 1) GO TO 32
CALL DKERR(6)
RETURN
32 CALL DKTROW
RETURN
34 CONTINUE
DO 35 K = 1, NVOCK
KSLT(K) = 0
35 CONTINUE
KCRD = 0
W = DKLOOK(VCARD, TKS(1), TKL(1))
IF (W .GT. 0) KCRD = VOCV(W)
IF (KCRD .GT. 0) GO TO 40
C An unknown card: skipped and counted; it ends an open tape.
NDKWN = NDKWN + 1
IF (ITPON .EQ. 1) CALL DKTPCL
RETURN
C The keys: a word without = is refused; an unknown key is skipped
C and counted, and a key of another card kind counted and read.
40 IF (NTOK .LT. 2) GO TO 60
DO 50 J = 2, NTOK
IF (TVL(J) .GE. 0) GO TO 42
CALL DKERR(21)
RETURN
42 W = DKLOOK(VKEY, TKS(J), TVS(J) - 1 - TKS(J))
IF (W .EQ. 0) GO TO 45
KSLT(VOCV(W)) = J
C Bit KCRD-1 of the key's card kinds.
IB = KYCARD(VOCV(W))
IF (KCRD .LT. 2) GO TO 44
DO 43 I = 2, KCRD
IB = IB / 2
43 CONTINUE
44 IF (MOD(IB, 2) .EQ. 1) GO TO 50
45 NDKWN = NDKWN + 1
50 CONTINUE
60 CONTINUE
IF (ITBON .EQ. 1 .AND. KCRD .NE. QROW) CALL DKTBCL
IF (ITPON .EQ. 1) CALL DKTPCL
IF (IDKER .NE. 0) RETURN
CALL DKCARD
RETURN
END
C
C CRDEOF: the end of a file of the deck. Its open TABLE leg ends,
C its open tape, and its scenario: the next file's cards start with
C a SCENARIO card (or a MISSION card, or a TAPE card).
SUBROUTINE CRDEOF
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
IF (IDKER .EQ. 0 .AND. ITBON .EQ. 1) CALL DKTBCL
IF (IDKER .EQ. 0 .AND. ITPON .EQ. 1) CALL DKTPCL
ITPON = 0
IDSN = 0
IDST = 0
RETURN
END
C
C CRDEND: the end of the deck. IERR the first deck error (0 none),
C ICARD its card number, NWARN the cards and keys skipped. A deck
C with an error leaves the run tables empty.
SUBROUTINE CRDEND(IERR, ICARD, NWARN)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IERR, ICARD, NWARN, K, J, M, IHAS, ICML, ILML, DKEVOK
CALL CRDEOF
IF (IDKER .EQ. 0) CALL DKCUES
C Scenarios 1..NSN and situations 1..NSIT, none missing.
NSN = 0
DO 10 K = 1, MXSN
IF (ISNHV(K) .NE. 0) NSN = K
10 CONTINUE
IF (NSN .EQ. 0) GO TO 12
DO 11 K = 1, NSN
IF (ISNHV(K) .EQ. 0) CALL DKERRC(20, NDKCD)
11 CONTINUE
12 NSIT = 0
DO 13 K = 1, MXSIT
IF (ISTHV(K) .NE. 0) NSIT = K
13 CONTINUE
IF (NSIT .EQ. 0) CALL DKERRC(24, NDKCD)
IF (NSIT .EQ. 0) GO TO 30
DO 14 K = 1, NSIT
IF (ISTHV(K) .LT. 3) CALL DKERRC(20, STCD(K))
14 CONTINUE
C Each scenario a CSM leg; each situation's events in its scenario.
IF (NSN .EQ. 0 .OR. NLEG .EQ. 0) GO TO 20
DO 16 M = 1, NSN
IHAS = 0
ICML = 0
ILML = 0
DO 15 J = 1, NLEG
IF (LGSN(J) .NE. M) GO TO 15
IF (LGVEH(J) .EQ. 1) IHAS = 1
IF (LGTYP(J) .NE. KLUNAR .AND. LGTYP(J) .NE. KLCON) GO TO 15
IF (LGVEH(J) .EQ. 1) ICML = 1
IF (LGVEH(J) .EQ. 2) ILML = 1
15 CONTINUE
IF (IHAS .EQ. 0) CALL DKERRC(26, SNCD(M))
IF (ILML .EQ. 1 .AND. ICML .EQ. 0) CALL DKERRC(26, SNCD(M))
16 CONTINUE
GO TO 21
20 CALL DKERRC(26, NDKCD)
21 DO 24 K = 1, NSIT
IF (SIGK(K) .NE. 2) GO TO 22
IF (DKEVOK(SISN(K), SIGE(K)) .EQ. 0) CALL DKERRC(27, STCD(K))
22 IF (SIFE(K) .EQ. 0) GO TO 24
IF (DKEVOK(SISN(K), SIFE(K)) .EQ. 0) CALL DKERRC(27, STCD(K))
24 CONTINUE
30 IF (IDKER .NE. 0) CALL DKCLR
IERR = IDKER
ICARD = IDKCD
NWARN = NDKWN
RETURN
END
C
C DKERR: deck error K on the card in hand, unless one stands.
SUBROUTINE DKERR(K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K
CALL DKERRC(K, NDKCD)
RETURN
END
C
C DKERRC: deck error K on card ICARD, unless one stands.
SUBROUTINE DKERRC(K, ICARD)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, ICARD
IF (IDKER .NE. 0) RETURN
IDKER = K
IDKCD = ICARD
RETURN
END
C
C DKEVOK: 1 if scenario M has an EVENT card of kind KIND, else 0.
INTEGER FUNCTION DKEVOK(M, KIND)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER M, KIND, J
DKEVOK = 0
IF (NEVT .EQ. 0) RETURN
DO 10 J = 1, NEVT
IF (EVSN(J) .EQ. M .AND. EVKND(J) .EQ. KIND) DKEVOK = 1
10 CONTINUE
RETURN
END
C
C DKTOK: the card in hand into tokens, split at blanks outside
C quotes, the quotes dropped (ITKB, TKS, TKL), and each token's
C value after its first = outside quotes (TVS, TVL).
SUBROUTINE DKTOK
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER I, J, C, IQ
NTOK = 0
J = 0
I = 1
10 IF (I .GT. NCRD) RETURN
IF (ICRD(I) .NE. ICBLK .AND. ICRD(I) .NE. ICTAB) GO TO 20
I = I + 1
GO TO 10
20 IF (NTOK .LT. MXTOK) GO TO 25
CALL DKERR(21)
RETURN
25 NTOK = NTOK + 1
TKS(NTOK) = J + 1
TVS(NTOK) = 0
TVL(NTOK) = -1
IQ = 0
30 IF (I .GT. NCRD) GO TO 80
C = ICRD(I)
I = I + 1
IF (IQ .NE. 0) GO TO 40
IF (C .EQ. ICBLK .OR. C .EQ. ICTAB) GO TO 80
IF (C .NE. ICQUO .AND. C .NE. ICAPO) GO TO 50
IQ = C
GO TO 30
40 IF (C .NE. IQ) GO TO 50
IQ = 0
GO TO 30
50 J = J + 1
ITKB(J) = C
IF (IQ .EQ. 0 .AND. C .EQ. ICEQ .AND. TVL(NTOK) .LT. 0)
& TVL(NTOK) = 0
IF (TVL(NTOK) .EQ. 0 .AND. TVS(NTOK) .EQ. 0) TVS(NTOK) = J + 1
GO TO 30
80 IF (IQ .NE. 0) CALL DKERR(21)
TKL(NTOK) = J - TKS(NTOK) + 1
IF (TVL(NTOK) .GE. 0) TVL(NTOK) = J - TVS(NTOK) + 1
GO TO 10
END
C
C DKTBCL: close the open LEG TYPE=TABLE: one TABLE leg (KTABL) per
C pair of its ROW cards in time order. LGP 1, 2 the pair's times,
C 3-9 the first row's T LAT LON ALT V FPA HDG, 10-12 the second's T
C LAT LON, 13-15 its V FPA HDG, 17 its ALT; LGN 1 the first row's
C velocity Earth-fixed, plus 2 the second's.
SUBROUTINE DKTBCL
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, K, I
ITBON = 0
IF (NTBR .LT. 2) GO TO 90
DO 10 J = 1, NTBR - 1
IF (TBR(1,J) .GE. TBR(1,J+1)) GO TO 90
10 CONTINUE
DO 30 J = 1, NTBR - 1
IF (NLEG .LT. MXLEG) GO TO 15
CALL DKERR(11)
RETURN
15 K = NLEG + 1
NLEG = K
LGP(1,K) = TBR(1,J)
LGP(2,K) = TBR(1,J+1)
DO 20 I = 1, 7
LGP(2+I,K) = TBR(I,J)
20 CONTINUE
LGP(10,K) = TBR(1,J+1)
LGP(11,K) = TBR(2,J+1)
LGP(12,K) = TBR(3,J+1)
LGP(13,K) = TBR(5,J+1)
LGP(14,K) = TBR(6,J+1)
LGP(15,K) = TBR(7,J+1)
LGP(16,K) = 0.0D0
LGP(17,K) = TBR(4,J+1)
LGSN(K) = ITBSN
LGTYP(K) = KTABL
LGN(K) = TBEF(J) + 2 * TBEF(J+1)
LGGC(K) = ITBGC
LGVEH(K) = ITBVH
30 CONTINUE
NTBR = 0
RETURN
90 CALL DKERR(9)
NTBR = 0
RETURN
END
C
C DKCUES: the burn cues read, each paired with its scenario's
C TIMELINE rows in time order: the first row named IGN=, then the
C first after it named CUT=; into /CBRN/, sorted by scenario and
C ignition (stably, in card order).
SUBROUTINE DKCUES
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER Q, K, M, K1, K2, P, DKNMEQ
DOUBLE PRECISION T1, T2
NBR = 0
IF (NCQ .EQ. 0) RETURN
DO 50 Q = 1, NCQ
M = CQSN(Q)
K1 = 0
IF (NTL .EQ. 0) GO TO 90
DO 10 K = 1, NTL
IF (TLSN(K) .NE. M) GO TO 10
IF (DKNMEQ(K, CQIS(Q), CQIL(Q)) .EQ. 0) GO TO 10
K1 = K
GO TO 15
10 CONTINUE
GO TO 90
15 T1 = TLT(K1)
K2 = 0
DO 20 K = 1, NTL
IF (TLSN(K) .NE. M .OR. TLT(K) .LE. T1) GO TO 20
IF (DKNMEQ(K, CQCS(Q), CQCL(Q)) .EQ. 0) GO TO 20
K2 = K
GO TO 25
20 CONTINUE
GO TO 90
25 T2 = TLT(K2)
P = NBR
30 IF (P .LT. 1) GO TO 40
IF (BRSN(P) .LT. M) GO TO 40
IF (BRSN(P) .EQ. M .AND. BRT1(P) .LE. T1) GO TO 40
BRT1(P+1) = BRT1(P)
BRT2(P+1) = BRT2(P)
BRSN(P+1) = BRSN(P)
BRVH(P+1) = BRVH(P)
BREN(P+1) = BREN(P)
P = P - 1
GO TO 30
40 BRT1(P+1) = T1
BRT2(P+1) = T2
BRSN(P+1) = M
BRVH(P+1) = CQVH(Q)
BREN(P+1) = CQEN(Q)
NBR = NBR + 1
50 CONTINUE
RETURN
90 CALL DKERRC(10, CQCD(Q))
RETURN
END
C
C DKNMEQ: 1 if timeline row K's name is the burn cue name at
C CQCH(IS) for N codes, else 0.
INTEGER FUNCTION DKNMEQ(K, IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, IS, N, I
DKNMEQ = 0
IF (TLNL(K) .NE. N) RETURN
DKNMEQ = 1
IF (N .EQ. 0) RETURN
DKNMEQ = 0
DO 10 I = 1, N
IF (TNCH(TLNS(K)+I-1) .NE. CQCH(IS+I-1)) RETURN
10 CONTINUE
DKNMEQ = 1
RETURN
END
src/vdkfld.f
C VDKFLD: the card reader's field readers (#26; the reader is
C vdeck.f): a card's words looked up in the vocabulary (vdvoc.f),
C its numbers and g.e.t.s read exactly, its lists and its text.
C The grammar is in vdeck.f's header.
C
C DKLOOK: the word of list L spelled by ITKB(IS) .. ITKB(IS+N-1),
C its number in the vocabulary, or 0.
INTEGER FUNCTION DKLOOK(L, IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER L, IS, N, W, I
DKLOOK = 0
DO 20 W = VOCLST(L), VOCLST(L+1) - 1
IF (VOCN(W) .NE. N) GO TO 20
DO 10 I = 1, N
IF (VOCC(VOCS(W)+I-1) .NE. ITKB(IS+I-1)) GO TO 20
10 CONTINUE
DKLOOK = W
RETURN
20 CONTINUE
RETURN
END
C
C DKWSP: the code of the word of list L at ITKB(IS) for N codes;
C deck error 4 (and 0) if the list has no such word.
INTEGER FUNCTION DKWSP(L, IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER L, IS, N, W, DKLOOK
DKWSP = 0
W = DKLOOK(L, IS, N)
IF (W .EQ. 0) CALL DKERR(4)
IF (W .GT. 0) DKWSP = VOCV(W)
RETURN
END
C
C DKWRD: the code of key KY's word in list L; IDEF if the card has
C no such key, or deck error 5 if IDEF is -1 (a required key).
INTEGER FUNCTION DKWRD(L, KY, IDEF)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER L, KY, IDEF, J, DKWSP
J = KSLT(KY)
DKWRD = IDEF
IF (J .GT. 0) DKWRD = DKWSP(L, TVS(J), TVL(J))
IF (J .GT. 0 .OR. IDEF .NE. -1) RETURN
DKWRD = 0
CALL DKERR(5)
RETURN
END
C
C DKREQ: the token of required key KY, or deck error 5 (and 0).
INTEGER FUNCTION DKREQ(KY)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER KY
DKREQ = KSLT(KY)
IF (DKREQ .EQ. 0) CALL DKERR(5)
RETURN
END
C
C DKNMS: the decimal number at ITKB(IS) for N codes into X: sign,
C digits, a point, an exponent of three digits at most after E or
C e. Up to 15 significant digits and a power of ten within
C 10**22 the fast path (vdeck.f); 16 or 17 digits, enough to carry
C a double, or a power down to 10**-44, through DKDD. The power
C scales the digits as a whole number, so 17 digits read from
C about 10**-28 to 10**38 in magnitude.
SUBROUTINE DKNMS(IS, N, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IS, N, I, IE, C, ND, NF, NDIG, IDOT, IEX, IES, NE, K, NX
DOUBLE PRECISION X, SG, AM, AX
X = 0.0D0
SG = 1.0D0
AM = 0.0D0
AX = 0.0D0
NX = 0
ND = 0
NF = 0
NDIG = 0
IDOT = 0
IEX = 0
I = IS
IE = IS + N - 1
IF (N .LE. 0) GO TO 90
IF (ITKB(I) .EQ. ICPLS) GO TO 5
IF (ITKB(I) .NE. ICMIN) GO TO 10
SG = -1.0D0
5 I = I + 1
10 IF (I .GT. IE) GO TO 50
C = ITKB(I)
I = I + 1
IF (C .GE. ICD0 .AND. C .LE. ICD9) GO TO 20
IF (C .EQ. ICPT) GO TO 30
IF (C .EQ. ICUE .OR. C .EQ. ICLE) GO TO 40
GO TO 90
20 IF (ND .GT. 0 .OR. C .GT. ICD0) ND = ND + 1
NDIG = NDIG + 1
IF (IDOT .EQ. 1) NF = NF + 1
IF (ND .GT. 17) GO TO 91
IF (ND .GT. 15) GO TO 25
AM = AM * 10.0D0 + DBLE(C - ICD0)
GO TO 10
C The 16th and 17th significant digits, held apart (AX, NX).
25 AX = AX * 10.0D0 + DBLE(C - ICD0)
NX = NX + 1
GO TO 10
30 IF (IDOT .EQ. 1) GO TO 90
IDOT = 1
GO TO 10
C The exponent.
40 IES = 1
NE = 0
IF (I .GT. IE) GO TO 90
IF (ITKB(I) .EQ. ICPLS) GO TO 44
IF (ITKB(I) .NE. ICMIN) GO TO 45
IES = -1
44 I = I + 1
45 IF (I .GT. IE) GO TO 48
C = ITKB(I)
I = I + 1
IF (C .LT. ICD0 .OR. C .GT. ICD9) GO TO 90
IF (NE .GE. 3) GO TO 91
IEX = IEX * 10 + (C - ICD0)
NE = NE + 1
GO TO 45
48 IF (NE .EQ. 0) GO TO 90
IEX = IES * IEX
50 IF (NDIG .EQ. 0) GO TO 90
K = IEX - NF
IF (AM .EQ. 0.0D0) GO TO 60
IF (K .GT. 22 .OR. K .LT. -44) GO TO 91
IF (NX .GT. 0 .OR. K .LT. -22) GO TO 55
IF (K .GE. 0) X = AM * P10(K+1)
IF (K .LT. 0) X = AM / P10(1-K)
GO TO 60
55 CALL DKDD(AM, NX, AX, K, X)
60 X = SG * X
RETURN
90 CALL DKERR(2)
RETURN
91 CALL DKERR(3)
X = 0.0D0
RETURN
END
C
C DKDD: X = (A * 10**NX + B) * 10**K, correctly rounded, for A a
C whole number below 10**15 (at least 10**14 if NX > 0), B below
C 10**NX, NX 0 to 2, K -44 to 22. The integer of 17 digits at
C most is held exactly as the sum of two doubles, then multiplied
C by 10**K or divided by 10**-K (exact powers, in two steps below
C 10**-22) carrying about 106 bits, and rounded once (Dekker 1971,
C the exact product by splitting). Correct unless the decimal
C lies within about 2**-103 of halfway between two doubles; a
C double written with 17 digits lies near a double, never near
C halfway. Ours. It counts on each operation rounded alone: no
C fused multiply-add (wasm has none; gfortran makes none for
C x86-64 without -mfma).
C RESTOMOD BEGIN: double-double arithmetic (Dekker 1971). The
C 1108's double had a 60-bit fraction, "18-digit precision"
C (UP-4046 Rev 3, pp. 4-10; docs/univac-1108.md), and would hold
C 17 digits outright; IEEE's 53 bits need this.
SUBROUTINE DKDD(A, NX, B, K, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER NX, K, KR, KD
DOUBLE PRECISION A, B, X, H, E, S, T, L, D, Q, PH, PL
C The integer as H + L, exactly: A * 10**NX as H + E, then B added
C (H is at least 10**15 when NX > 0, above B, and B is 0 when NX
C is 0, so the sum's error T is exact).
CALL DKTWOP(A, P10(NX+1), H, E)
S = H + B
T = B - (S - H)
L = E + T
H = S + L
L = L - (H - S)
IF (K .LT. 0) GO TO 20
CALL DKTWOP(H, P10(K+1), PH, PL)
X = PH + (PL + L * P10(K+1))
RETURN
C Division by D = 10**22 at most: the quotient Q, its remainder
C from the exact product Q * D, and the remainder's quotient, the
C new H + L; again while KR, the power left, is not 0.
20 KR = -K
25 KD = KR
IF (KD .GT. 22) KD = 22
D = P10(KD+1)
KR = KR - KD
Q = H / D
CALL DKTWOP(Q, D, PH, PL)
L = (((H - PH) - PL) + L) / D
H = Q
IF (KR .GT. 0) GO TO 25
X = H + L
RETURN
END
C
C DKTWOP: P + E = A * B exactly, P the rounded product (Dekker's
C split of each factor into halves of 26 bits, 134217729 = 2**27 +
C 1).
SUBROUTINE DKTWOP(A, B, P, E)
DOUBLE PRECISION A, B, P, E, C, AH, AL, BH, BL
C = 134217729.0D0 * A
AH = C - (C - A)
AL = A - AH
C = 134217729.0D0 * B
BH = C - (C - B)
BL = B - BH
P = A * B
E = ((AH * BH - P) + AH * BL + AL * BH) + AL * BL
RETURN
END
C RESTOMOD END
C
C DKGTS: a g.e.t. at ITKB(IS) for N codes into X (s): h:mm:ss.s,
C h:mm, or a decimal number of seconds; a leading - counts down to
C range zero. h*3600 + mm*60 + ss is one exact integer of tenths
C (or whatever ss's last place is), divided once.
SUBROUTINE DKGTS(IS, N, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IS, N, I, IE, C, NP, ND, NS, NF, IDOT
DOUBLE PRECISION X, SG, HM(3)
X = 0.0D0
IE = IS + N - 1
IF (N .LE. 0) GO TO 7
DO 5 I = IS, IE
IF (ITKB(I) .EQ. ICCOL) GO TO 8
5 CONTINUE
7 CALL DKNMS(IS, N, X)
RETURN
8 SG = 1.0D0
I = IS
IF (ITKB(I) .NE. ICMIN) GO TO 9
SG = -1.0D0
I = I + 1
C Up to three fields: hours, minutes, seconds; ND digits in each,
C NS of them significant (15 at most), NF of the seconds' after the
C point.
9 NP = 1
HM(1) = 0.0D0
HM(2) = 0.0D0
HM(3) = 0.0D0
ND = 0
NS = 0
NF = 0
IDOT = 0
10 IF (I .GT. IE) GO TO 50
C = ITKB(I)
I = I + 1
IF (C .GE. ICD0 .AND. C .LE. ICD9) GO TO 20
IF (C .EQ. ICCOL) GO TO 30
IF (C .EQ. ICPT .AND. NP .EQ. 3 .AND. IDOT .EQ. 0) GO TO 40
GO TO 90
20 HM(NP) = HM(NP) * 10.0D0 + DBLE(C - ICD0)
ND = ND + 1
IF (NS .GT. 0 .OR. C .GT. ICD0) NS = NS + 1
IF (IDOT .EQ. 1) NF = NF + 1
IF (NS .GT. 15 .OR. NF .GT. 15) GO TO 91
GO TO 10
30 IF (ND .EQ. 0 .OR. NP .EQ. 3) GO TO 90
NP = NP + 1
ND = 0
NS = 0
GO TO 10
40 IDOT = 1
GO TO 10
50 IF (ND .EQ. 0) GO TO 90
X = (HM(1) * 3600.0D0 + HM(2) * 60.0D0) * P10(NF+1) + HM(3)
IF (X .GE. 1.0D15) GO TO 91
X = SG * (X / P10(NF+1))
RETURN
90 CALL DKERR(2)
X = 0.0D0
RETURN
91 CALL DKERR(3)
X = 0.0D0
RETURN
END
C
C DKINS: the whole number at ITKB(IS) for N codes, or deck error 2.
INTEGER FUNCTION DKINS(IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IS, N, I, C, ISG
DKINS = 0
ISG = 1
I = IS
IF (N .LE. 0) GO TO 90
IF (ITKB(I) .NE. ICMIN) GO TO 10
ISG = -1
I = I + 1
IF (N .EQ. 1) GO TO 90
10 IF (I .GT. IS + N - 1) GO TO 20
C = ITKB(I)
I = I + 1
IF (C .LT. ICD0 .OR. C .GT. ICD9 .OR. DKINS .GT. 99999) GO TO 90
DKINS = DKINS * 10 + (C - ICD0)
GO TO 10
20 DKINS = ISG * DKINS
RETURN
90 CALL DKERR(2)
DKINS = 0
RETURN
END
C
C Key KY's value: DKNUM a required number, DKNMD a number with the
C default DEF, DKGET a required g.e.t., DKGTD a g.e.t. with DEF,
C DKINT a whole number (IDEF -1: required).
SUBROUTINE DKNUM(KY, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER KY, J, DKREQ
DOUBLE PRECISION X
X = 0.0D0
J = DKREQ(KY)
IF (J .GT. 0) CALL DKNMS(TVS(J), TVL(J), X)
RETURN
END
C
SUBROUTINE DKNMD(KY, DEF, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER KY, J
DOUBLE PRECISION DEF, X
X = DEF
J = KSLT(KY)
IF (J .GT. 0) CALL DKNMS(TVS(J), TVL(J), X)
RETURN
END
C
SUBROUTINE DKGET(KY, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER KY, J, DKREQ
DOUBLE PRECISION X
X = 0.0D0
J = DKREQ(KY)
IF (J .GT. 0) CALL DKGTS(TVS(J), TVL(J), X)
RETURN
END
C
SUBROUTINE DKGTD(KY, DEF, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER KY, J
DOUBLE PRECISION DEF, X
X = DEF
J = KSLT(KY)
IF (J .GT. 0) CALL DKGTS(TVS(J), TVL(J), X)
RETURN
END
C
INTEGER FUNCTION DKINT(KY, IDEF)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER KY, IDEF, J, DKINS
J = KSLT(KY)
DKINT = IDEF
IF (J .GT. 0) DKINT = DKINS(TVS(J), TVL(J))
IF (J .GT. 0 .OR. IDEF .NE. -1) RETURN
DKINT = 0
CALL DKERR(5)
RETURN
END
C
C DKNLS: token J's value as a list of exactly N numbers separated by
C commas, into X(1..N); deck error 22 for another count.
SUBROUTINE DKNLS(J, N, X)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, N, I, IS, K
DOUBLE PRECISION X(N)
K = 0
IS = TVS(J)
DO 10 I = TVS(J), TVS(J) + TVL(J)
IF (I .LT. TVS(J) + TVL(J) .AND. ITKB(I) .NE. ICCOM) GO TO 10
K = K + 1
IF (K .GT. N) GO TO 20
CALL DKNMS(IS, I - IS, X(K))
IS = I + 1
10 CONTINUE
IF (K .EQ. N) RETURN
20 CALL DKERR(22)
RETURN
END
C
C DKWLS: token J's value as a list of words of list L separated by
C commas, their codes into IV(1..N), N at most MX (deck error 22).
SUBROUTINE DKWLS(J, L, MX, IV, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, L, MX, IV(MX), N, I, IS, DKWSP
N = 0
IS = TVS(J)
DO 10 I = TVS(J), TVS(J) + TVL(J)
IF (I .LT. TVS(J) + TVL(J) .AND. ITKB(I) .NE. ICCOM) GO TO 10
N = N + 1
IF (N .GT. MX) GO TO 20
IV(N) = DKWSP(L, IS, I - IS)
IS = I + 1
10 CONTINUE
RETURN
20 N = MX
CALL DKERR(22)
RETURN
END
C
C DKTXT: token J's value as text, its codes appended to the store
C IST (MX codes, NU used): IS where they start, N how many.
SUBROUTINE DKTXT(J, IST, MX, NU, IS, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, MX, IST(MX), NU, IS, N, I
IS = NU + 1
N = TVL(J)
IF (NU + N .LE. MX) GO TO 5
CALL DKERR(19)
N = 0
RETURN
5 IF (N .EQ. 0) RETURN
DO 10 I = 1, N
IST(NU+I) = ITKB(TVS(J)+I-1)
10 CONTINUE
NU = NU + N
RETURN
END
C
src/vdkscn.f
C VDKSCN: the card reader's card semantics (#26; the reader is
C vdeck.f): what each card of a run deck writes into the run
C tables. The field layouts are in src/viewcom.inc and
C src/viewsit.inc; the defaults and orderings are the ones
C tools/gen_data.py wrote into BLOCK DATA before the reader took
C over (#26), so the tables are word for word what they were.
C
C DKCARD: the card in hand (KCRD) to its routine. A mission's
C cards come first, MISSION once and then EPOCH (SITE and PAD
C anywhere among them), before its scenarios; a scenario's cards
C after its SCENARIO card. SPAN, REEL and SHOT are the page's and
C are passed over. A TAPE card may come anywhere after its
C scenario's cards.
SUBROUTINE DKCARD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
IF (KCRD .EQ. QSPAN .OR. KCRD .EQ. QREEL .OR. KCRD .EQ. QSHOT)
& RETURN
IF (KCRD .NE. QMISSI) GO TO 10
IF (IMHV .EQ. 1 .OR. IMHV .EQ. 2) GO TO 91
CALL DKMSN
IMHV = 1
RETURN
10 IF (KCRD .NE. QEPOCH .AND. KCRD .NE. QSITE .AND.
& KCRD .NE. QPAD) GO TO 20
IF (IDSN .NE. 0) GO TO 90
IF (IMHV .NE. 1 .AND. IMHV .NE. 2) GO TO 91
IF (KCRD .EQ. QEPOCH) CALL DKNUM(YJD, MJD)
IF (KCRD .EQ. QEPOCH) IMHV = 2
IF (KCRD .EQ. QSITE) CALL DKSITE
IF (KCRD .EQ. QPAD) CALL DKPAD
RETURN
20 IF (KCRD .NE. QSCENA) GO TO 25
CALL DKSCN
RETURN
C A tape names its scenario (vdktap.f).
25 IF (KCRD .NE. QTAPE) GO TO 30
CALL DKTAP
RETURN
30 IF (IDSN .EQ. 0) GO TO 90
IF (KCRD .EQ. QLEG) CALL DKLEG
IF (KCRD .EQ. QROW) CALL DKROW
IF (KCRD .EQ. QEVENT) CALL DKEVT
IF (KCRD .EQ. QTIMEL) CALL DKTLN
IF (KCRD .EQ. QSTART) CALL DKSTR(1)
IF (KCRD .EQ. QREF) CALL DKSTR(2)
IF (KCRD .EQ. QBURN) CALL DKBRN
IF (KCRD .EQ. QBURNC) CALL DKCUE
IF (KCRD .EQ. QSITUA) CALL DKSIT
IF (KCRD .EQ. QRECIP) CALL DKRCP
IF (KCRD .EQ. QVIEWS) CALL DKVWS
IF (KCRD .EQ. QHDRRE) CALL DKHDR
RETURN
90 CALL DKERR(6)
RETURN
91 CALL DKERR(25)
RETURN
END
C
C DKMSN: a MISSION card starts a mission: no scenario in hand, and
C its epoch, landing site and pad zero until its cards give them
C (IMHV, the mission's state, is the caller's).
SUBROUTINE DKMSN
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER I
MJD = 0.0D0
DO 10 I = 1, 3
MSIT(I) = 0.0D0
10 CONTINUE
MPAD(1) = 0.0D0
MPAD(2) = 0.0D0
MPGC = 0
DO 20 I = 1, 8
MPCH(I) = 0
20 CONTINUE
IDSN = 0
IDST = 0
RETURN
END
C
C DKSITE: SITE LAT= LON= AZ= (deg) and NAME=, the name lettered in
C the whole-disc Moon view (SITECH, 22 codes, zero padded): one for
C the deck, so a second, different name is refused.
SUBROUTINE DKSITE
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, I, IW(22), DKNMOK
CALL DKNUM(YLAT, MSIT(1))
CALL DKNUM(YLON, MSIT(2))
CALL DKNUM(YAZ, MSIT(3))
J = KSLT(YNAME)
IF (J .EQ. 0) RETURN
IF (DKNMOK(J, 22) .EQ. 0) RETURN
DO 10 I = 1, 22
IW(I) = 0
IF (I .LE. TVL(J)) IW(I) = ITKB(TVS(J)+I-1)
IF (SITECH(1) .NE. 0 .AND. IW(I) .NE. SITECH(I)) GO TO 90
10 CONTINUE
DO 20 I = 1, 22
SITECH(I) = IW(I)
20 CONTINUE
RETURN
90 CALL DKERR(23)
RETURN
END
C
C DKNMOK: 1 if token J's value is a name of MX codes at most, each
C a printable ASCII character, else deck error 23 and 0.
INTEGER FUNCTION DKNMOK(J, MX)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, MX, I
DKNMOK = 0
IF (TVL(J) .GT. MX) GO TO 90
IF (TVL(J) .EQ. 0) GO TO 20
DO 10 I = TVS(J), TVS(J) + TVL(J) - 1
IF (ITKB(I) .LT. ICBLK .OR. ITKB(I) .GT. ICTIL) GO TO 90
10 CONTINUE
20 DKNMOK = 1
RETURN
90 CALL DKERR(23)
RETURN
END
C
C DKPAD: PAD NAME= (7 codes at most) LAT= LON= (deg) LATTYPE=.
SUBROUTINE DKPAD
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, I, DKREQ, DKWRD, DKNMOK
CALL DKNUM(YLAT, MPAD(1))
CALL DKNUM(YLON, MPAD(2))
MPGC = DKWRD(VLATT, YLATTY, 0)
J = DKREQ(YNAME)
IF (J .EQ. 0) RETURN
IF (DKNMOK(J, 7) .EQ. 0) RETURN
DO 10 I = 1, 8
MPCH(I) = 0
IF (I .LE. TVL(J)) MPCH(I) = ITKB(TVS(J)+I-1)
10 CONTINUE
RETURN
END
C
C DKSCN: SCENARIO ID=, the row of /CSCEN/ it fills with the
C mission's epoch, site and pad; the mission's MISSION and EPOCH
C cards come first (deck error 25).
SUBROUTINE DKSCN
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, I, DKINT
IDSN = 0
IDST = 0
IF (IMHV .GE. 2) GO TO 2
CALL DKERR(25)
RETURN
2 IMHV = 3
K = DKINT(YID, -1)
IF (IDKER .NE. 0) RETURN
IF (K .GE. 1 .AND. K .LE. MXSN) GO TO 5
CALL DKERR(7)
RETURN
5 IF (ISNHV(K) .EQ. 0) GO TO 10
CALL DKERR(8)
RETURN
10 SNJD0(K) = MJD
SNSLA(K) = MSIT(1)
SNSLO(K) = MSIT(2)
SNSAZ(K) = MSIT(3)
SNPLA(K) = MPAD(1)
SNPLO(K) = MPAD(2)
SNPGC(K) = MPGC
DO 20 I = 1, 8
PADCH(8*(K-1)+I) = MPCH(I)
20 CONTINUE
ISNHV(K) = 1
SNCD(K) = NDKCD
IDSN = K
RETURN
END
C
C DKLEG: LEG TYPE= (opening a TABLE leg, whose ROW cards follow, or
C one leg): LGP 1 FROM, 2 TO, 3 T (g.e.t. s), 4 LAT, 5 LON, 6 ALT,
C 7 V, 8 FPA, 9 HDG, 10 TB, 11 LATB, 12 LONB, 13 DV, 14 P, 15 R,
C 16 N (LCONIC: the impulse's direction; otherwise LGN, whole
C revolutions), 17 ALTB (default ALT); absent keys 0.
SUBROUTINE DKLEG
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IT, IVH, IGC, K, DKWRD, DKINT
IT = DKWRD(VLEGT, YTYPE, -1)
IVH = DKWRD(VLVEH, YVEH, 1)
IGC = DKWRD(VLATT, YLATTY, 0)
IF (IDKER .NE. 0) RETURN
IF (IT .NE. KTABL) GO TO 10
ITBON = 1
ITBSN = IDSN
ITBGC = IGC
ITBVH = IVH
NTBR = 0
RETURN
10 IF (NLEG .LT. MXLEG) GO TO 20
CALL DKERR(11)
RETURN
20 K = NLEG + 1
NLEG = K
CALL DKGET(YFROM, LGP(1,K))
CALL DKGET(YTO, LGP(2,K))
CALL DKGET(YT, LGP(3,K))
CALL DKNMD(YLAT, 0.0D0, LGP(4,K))
CALL DKNMD(YLON, 0.0D0, LGP(5,K))
CALL DKNMD(YALT, 0.0D0, LGP(6,K))
CALL DKNMD(YV, 0.0D0, LGP(7,K))
CALL DKNMD(YFPA, 0.0D0, LGP(8,K))
CALL DKNMD(YHDG, 0.0D0, LGP(9,K))
CALL DKGTD(YTB, 0.0D0, LGP(10,K))
CALL DKNMD(YLATB, 0.0D0, LGP(11,K))
CALL DKNMD(YLONB, 0.0D0, LGP(12,K))
CALL DKNMD(YDV, 0.0D0, LGP(13,K))
CALL DKNMD(YP, 0.0D0, LGP(14,K))
CALL DKNMD(YR, 0.0D0, LGP(15,K))
LGP(16,K) = 0.0D0
LGN(K) = 0
IF (IT .EQ. KLCON) CALL DKNMD(YN, 0.0D0, LGP(16,K))
IF (IT .NE. KLCON) LGN(K) = DKINT(YN, 0)
CALL DKNMD(YALTB, LGP(6,K), LGP(17,K))
LGSN(K) = IDSN
LGTYP(K) = IT
LGGC(K) = IGC
LGVEH(K) = IVH
RETURN
END
C
C DKROW: a ROW of the open TABLE leg: T LAT LON ALT V FPA HDG, VEL=.
SUBROUTINE DKROW
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, DKWRD
IF (ITBON .EQ. 1) GO TO 10
CALL DKERR(6)
RETURN
10 IF (NTBR .LT. MXTBR) GO TO 20
CALL DKERR(18)
RETURN
20 J = NTBR + 1
NTBR = J
CALL DKGET(YT, TBR(1,J))
CALL DKNUM(YLAT, TBR(2,J))
CALL DKNUM(YLON, TBR(3,J))
CALL DKNUM(YALT, TBR(4,J))
CALL DKNUM(YV, TBR(5,J))
CALL DKNUM(YFPA, TBR(6,J))
CALL DKNUM(YHDG, TBR(7,J))
TBEF(J) = DKWRD(VVEL, YVEL, 0)
RETURN
END
C
C DKEVT: EVENT KIND= T=.
SUBROUTINE DKEVT
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, DKWRD
IF (NEVT .LT. MXEVT) GO TO 10
CALL DKERR(12)
RETURN
10 K = NEVT + 1
NEVT = K
EVKND(K) = DKWRD(VEVK, YKIND, -1)
CALL DKGET(YT, EVT(K))
EVSN(K) = IDSN
RETURN
END
C
C DKTLN: TIMELINE T= KIND= NAME=, put in its place by scenario and
C g.e.t. (after any row of the same time, so the cards' order
C stands); its name kept for the burn cues.
SUBROUTINE DKTLN
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER J, KK, P, IS, N, DKWRD, DKREQ
DOUBLE PRECISION T
IF (NTL .LT. MXTL) GO TO 10
CALL DKERR(16)
RETURN
10 CALL DKGET(YT, T)
KK = DKWRD(VTLK, YKIND, -1)
J = DKREQ(YNAME)
IF (IDKER .NE. 0) RETURN
CALL DKTXT(J, TNCH, MXTNC, NTNC, IS, N)
IF (IDKER .NE. 0) RETURN
P = NTL
20 IF (P .LT. 1) GO TO 30
IF (TLSN(P) .LT. IDSN) GO TO 30
IF (TLSN(P) .EQ. IDSN .AND. TLT(P) .LE. T) GO TO 30
TLT(P+1) = TLT(P)
TLK(P+1) = TLK(P)
TLSN(P+1) = TLSN(P)
TLNS(P+1) = TLNS(P)
TLNL(P+1) = TLNL(P)
P = P - 1
GO TO 20
30 TLT(P+1) = T
TLK(P+1) = KK
TLSN(P+1) = IDSN
TLNS(P+1) = IS
TLNL(P+1) = N
NTL = NTL + 1
RETURN
END
C
C DKSTR: START (IS 1, one per scenario) or REF (IS 2): T= END=
C (START: the run's end) BODY= LATTYPE= LAT= LON= ALT= V= FPA= HDG=
C into STP or RFP laid out as LGP: 1 T, 2 END, 3 T, 4-9 LAT .. HDG.
SUBROUTINE DKSTR(IS)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IS, K, I, DKWRD
DOUBLE PRECISION P(9)
CALL DKGET(YT, P(1))
CALL DKGTD(YEND, 0.0D0, P(2))
P(3) = P(1)
CALL DKNUM(YLAT, P(4))
CALL DKNUM(YLON, P(5))
CALL DKNUM(YALT, P(6))
CALL DKNUM(YV, P(7))
CALL DKNUM(YFPA, P(8))
CALL DKNMD(YHDG, 0.0D0, P(9))
IF (IS .EQ. 2) GO TO 50
IF (NSTART .EQ. 0) GO TO 15
DO 10 K = 1, NSTART
IF (STSN(K) .EQ. IDSN) GO TO 91
10 CONTINUE
15 IF (NSTART .GE. MXSTRT) GO TO 92
K = NSTART + 1
NSTART = K
DO 20 I = 1, NLGP
STP(I,K) = 0.0D0
IF (I .LE. 9) STP(I,K) = P(I)
20 CONTINUE
STSN(K) = IDSN
STBOD(K) = DKWRD(VBODY, YBODY, -1)
STGC(K) = DKWRD(VLATT, YLATTY, 0)
RETURN
50 IF (NRF .GE. MXREF) GO TO 93
K = NRF + 1
NRF = K
DO 60 I = 1, NLGP
RFP(I,K) = 0.0D0
IF (I .LE. 9) RFP(I,K) = P(I)
60 CONTINUE
RFSN(K) = IDSN
RFBOD(K) = DKWRD(VBODY, YBODY, -1)
RFGC(K) = DKWRD(VLATT, YLATTY, 0)
RETURN
91 CALL DKERR(8)
RETURN
92 CALL DKERR(13)
RETURN
93 CALL DKERR(15)
RETURN
END
C
C DKBRN: BURN T= (mid-burn) DV= P= R= N= BODY=.
SUBROUTINE DKBRN
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, DKWRD
IF (NBN .LT. MXBURN) GO TO 10
CALL DKERR(14)
RETURN
10 K = NBN + 1
NBN = K
CALL DKGET(YT, BNT(K))
CALL DKNUM(YDV, BNDV(K))
CALL DKNUM(YP, BNP(K))
CALL DKNUM(YR, BNR(K))
CALL DKNUM(YN, BNN(K))
BNSN(K) = IDSN
BNBOD(K) = DKWRD(VBODY, YBODY, -1)
RETURN
END
C
C DKCUE: BURNCUE IGN= CUT= (TIMELINE row names) VEH= ENG=, kept
C until CRDEND pairs it with the rows (DKCUES).
SUBROUTINE DKCUE
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER Q, J1, J2, DKREQ, DKWRD
IF (NCQ .LT. MXCUE) GO TO 10
CALL DKERR(17)
RETURN
10 J1 = DKREQ(YIGN)
J2 = DKREQ(YCUT)
IF (IDKER .NE. 0) RETURN
Q = NCQ + 1
NCQ = Q
CQSN(Q) = IDSN
CQCD(Q) = NDKCD
CQVH(Q) = DKWRD(VBVEH, YVEH, -1)
CQEN(Q) = DKWRD(VBENG, YENG, -1)
CALL DKTXT(J1, CQCH, MXCQC, NCQC, CQIS(Q), CQIL(Q))
CALL DKTXT(J2, CQCH, MXCQC, NCQC, CQCS(Q), CQCL(Q))
RETURN
END
src/vdksit.f
C VDKSIT: the card reader's situation cards (#26; the reader is
C vdeck.f, the scenario cards vdkscn.f): SITUATION and the RECIPE,
C VIEWS and HDRREF cards that follow it, into the situation tables
C (src/viewsit.inc), as tools/gen_data.py wrote them into BLOCK
C DATA before the reader took over (#26).
C
C DKSIT: SITUATION ID= GET= FOV= LOOK= WINDOW= LAYERS= POSE= DRAW=
C opens situation row ID of the scenario in hand; its RECIPE, VIEWS
C and (optional) HDRREF cards follow in that order. GET: a g.e.t.
C (SIGK 1, SIGT), EVENT+-offset (2, SIGE the event, SIGT the
C offset) or a rule+-offset (VGRUL: 3 the Earthrise search). FOV:
C degrees (SIFK 1) or DISC:f (2). A layer named twice is refused.
SUBROUTINE DKSIT
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, J, I, L, N, IW(12), DKINT, DKREQ, DKWRD, DKWSP
IDST = 0
K = DKINT(YID, -1)
IF (IDKER .NE. 0) RETURN
IF (K .GE. 1 .AND. K .LE. MXSIT) GO TO 5
CALL DKERR(7)
RETURN
5 IF (ISTHV(K) .EQ. 0) GO TO 10
CALL DKERR(8)
RETURN
10 CALL DKSIZ(K)
ISTHV(K) = 1
STCD(K) = NDKCD
IDST = K
SISN(K) = IDSN
J = DKREQ(YGET)
IF (J .GT. 0) CALL DKGRL(TVS(J), TVL(J), SIGK(K), SIGE(K),
& SIGT(K))
J = DKREQ(YFOV)
IF (J .EQ. 0) RETURN
SIFK(K) = 1
IF (TVL(J) .EQ. 0) GO TO 22
DO 20 I = TVS(J), TVS(J) + TVL(J) - 1
IF (ITKB(I) .NE. ICCOL) GO TO 20
SIFK(K) = DKWSP(VFOVR, TVS(J), I - TVS(J))
CALL DKNMS(I + 1, TVS(J) + TVL(J) - 1 - I, SIFV(K))
GO TO 25
20 CONTINUE
22 CALL DKNMS(TVS(J), TVL(J), SIFV(K))
25 J = KSLT(YLOOK)
IF (J .GT. 0) CALL DKNLS(J, 3, SILK(1,K))
SIWN(K) = DKWRD(VWIN, YWINDO, -1)
J = DKREQ(YLAYER)
IF (J .EQ. 0) GO TO 28
CALL DKWLS(J, VLAYR, MXLAY, SILY(1,K), N)
IF (N .LT. 2) GO TO 28
DO 27 I = 2, N
DO 26 L = 1, I - 1
IF (SILY(L,K) .EQ. SILY(I,K)) CALL DKERR(22)
26 CONTINUE
27 CONTINUE
28 SIPS(K) = DKWRD(VPOSE, YPOSE, 0)
J = KSLT(YDRAW)
IF (J .EQ. 0) RETURN
CALL DKWLS(J, VDRAW, 12, IW, N)
IF (N .EQ. 0) RETURN
DO 30 I = 1, N
SIDW(K) = SIDW(K) + IW(I)
30 CONTINUE
RETURN
END
C
C DKGRL: a SITUATION's GET= at ITKB(IS) for N codes: its rule KG,
C event KE and g.e.t. or offset T (DKSIT).
SUBROUTINE DKGRL(IS, N, KG, KE, T)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER IS, N, KG, KE, I, IE, C, W, DKLOOK
DOUBLE PRECISION T
KG = 1
KE = 0
T = 0.0D0
IE = IS + N - 1
C = ITKB(IS)
IF (N .GT. 0 .AND. C .GE. ICUA .AND. C .LE. ICUZ) GO TO 10
CALL DKGTS(IS, N, T)
RETURN
C A word (letters, then letters or digits), then +- an offset.
10 I = IS + 1
15 IF (I .GT. IE) GO TO 20
C = ITKB(I)
IF ((C .GE. ICUA .AND. C .LE. ICUZ) .OR.
& (C .GE. ICD0 .AND. C .LE. ICD9)) GO TO 18
GO TO 20
18 I = I + 1
GO TO 15
20 W = DKLOOK(VGRUL, IS, I - IS)
IF (W .EQ. 0) GO TO 25
KG = VOCV(W)
GO TO 30
25 W = DKLOOK(VEVK, IS, I - IS)
IF (W .EQ. 0) GO TO 90
KG = 2
KE = VOCV(W)
C One sign: the offset itself takes none.
30 IF (I .GT. IE) RETURN
C = ITKB(I)
IF (C .NE. ICPLS .AND. C .NE. ICMIN) GO TO 91
IF (I .EQ. IE) GO TO 91
IF (ITKB(I+1) .EQ. ICPLS .OR. ITKB(I+1) .EQ. ICMIN) GO TO 91
CALL DKGTS(I + 1, IE - I, T)
IF (C .EQ. ICMIN) T = -T
RETURN
90 CALL DKERR(4)
RETURN
91 CALL DKERR(2)
RETURN
END
C
C DKRCP: RECIPE NAME= and its parameters (the keys each recipe
C takes are tools/gen_data.py's RECIPE_KEYS), into the situation in
C hand. CREWSTN and BODYCTR take the Moon as their body, EXTSEED
C the Earth.
SUBROUTINE DKRCP
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, J, DKWRD, DKWSP
IF (IDST .EQ. 0) GO TO 90
K = IDST
IF (ISTHV(K) .NE. 1) GO TO 90
ISTHV(K) = 2
SIRC(K) = DKWRD(VRCP, YNAME, -1)
J = KSLT(YBODY)
IF (J .GT. 0) SIBD(K) = DKWSP(VBODY, TVS(J), TVL(J))
SIMD(K) = DKWRD(VMODE, YMODE, 0)
SIAZ(K) = DKWRD(VAZ, YAZ, 0)
CALL DKNMD(YELEV, 0.0D0, SIEL(K))
J = KSLT(YTURN)
IF (J .EQ. 0) GO TO 10
SITR(K) = 1
CALL DKNLS(J, 3, SITN(1,K))
10 SIFB(K) = DKWRD(VOFFL, YOFFLE, 0)
IF (SIFB(K) .NE. 0) CALL DKNUM(YOFFEL, SIFL(K))
SIAT(K) = DKWRD(VATT, YATT, 0)
SIFE(K) = DKWRD(VEVK, YAT, 0)
CALL DKGTD(YFIX, 0.0D0, SIFT(K))
CALL DKGTD(YDRIFT, 0.0D0, SIDT(K))
CALL DKNMD(YELOFF, 0.0D0, SIEO(K))
SIVH(K) = DKWRD(VCRV, YVEH, 0)
CALL DKNMD(YALT, 0.0D0, SIAL(K))
CALL DKNMD(YDIST, 0.0D0, SIDS(K))
IF (SIRC(K) .EQ. 3 .OR. SIRC(K) .EQ. 4) SIBD(K) = 2
IF (SIRC(K) .EQ. 5) SIBD(K) = 1
RETURN
90 CALL DKERR(6)
RETURN
END
C
C DKVWS: VIEWS VIEW= TARGET= OFFTARGET= RIDES= CM= LM= FIXED=
C XSTART=, into the situation in hand.
SUBROUTINE DKVWS
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, J, DKWRD
IF (IDST .EQ. 0) GO TO 90
K = IDST
IF (ISTHV(K) .NE. 2) GO TO 90
ISTHV(K) = 3
SIVW(K) = DKWRD(VVIEW, YVIEW, 0)
SITG(K) = DKWRD(VTGT, YTARGE, -1)
SITF(K) = DKWRD(VTGT, YOFFTA, 0)
SIRD(K) = DKWRD(VRIDE, YRIDES, -1)
SICM(K) = DKWRD(VSTN, YCM, -1)
SILM(K) = DKWRD(VSTN, YLM, -1)
SIFX(K) = DKWRD(VYN, YFIXED, 0)
J = KSLT(YXSTAR)
IF (J .EQ. 0) RETURN
SIXO(K) = 1
CALL DKNLS(J, 2, SIXY(1,K))
RETURN
90 CALL DKERR(6)
RETURN
END
C
C DKHDR: HDRREF OBJ= OFFSET= RADIUS=, into the situation in hand.
SUBROUTINE DKHDR
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER K, DKWRD
IF (IDST .EQ. 0) GO TO 90
K = IDST
IF (ISTHV(K) .NE. 3) GO TO 90
ISTHV(K) = 4
SIHK(K) = DKWRD(VHDR, YOBJ, -1)
CALL DKNMD(YOFFSE, 0.0D0, SIHO(K))
CALL DKNMD(YRADIU, 0.0D0, SIHR(K))
RETURN
90 CALL DKERR(6)
RETURN
END
C
C DKSIZ: situation row K emptied.
SUBROUTINE DKSIZ(K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewsit.inc'
C RESTOMOD END
INTEGER K, I
SIGT(K) = 0.0D0
SIFV(K) = 0.0D0
SIEL(K) = 0.0D0
SIFL(K) = 0.0D0
SIFT(K) = 0.0D0
SIDT(K) = 0.0D0
SIEO(K) = 0.0D0
SIAL(K) = 0.0D0
SIDS(K) = 0.0D0
SIHO(K) = 0.0D0
SIHR(K) = 0.0D0
DO 10 I = 1, 3
SILK(I,K) = 0.0D0
SITN(I,K) = 0.0D0
10 CONTINUE
SIXY(1,K) = 0.0D0
SIXY(2,K) = 0.0D0
SISN(K) = 0
SIGK(K) = 0
SIGE(K) = 0
SIFK(K) = 0
SIWN(K) = 0
SIPS(K) = 0
SIDW(K) = 0
SIRC(K) = 0
SIBD(K) = 0
SIMD(K) = 0
SIAZ(K) = 0
SITR(K) = 0
SIFB(K) = 0
SIAT(K) = 0
SIFE(K) = 0
SIVH(K) = 0
SIVW(K) = 0
SITG(K) = 0
SITF(K) = 0
SIRD(K) = 0
SICM(K) = 0
SILM(K) = 0
SIFX(K) = 0
SIXO(K) = 0
SIHK(K) = 0
DO 20 I = 1, MXLAY
SILY(I,K) = 0
20 CONTINUE
RETURN
END
src/vdksum.f
C VDKSUM: the run tables' hash total (#26; ours), CRDSUM, so the
C tables the card reader (vdeck.f) fills natively and in
C WebAssembly can be compared word for word without listing them.
C
C CRDSUM: a hash total of the run tables' used entries (ours), four
C sums ISUM(1..4) over every 32-bit word, a double as its two
C words, so two loads of a deck can be compared without listing
C the tables.
SUBROUTINE CRDSUM(ISUM)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER ISUM(4), I, K, C
DO 5 I = 1, 4
ISUM(I) = 0
5 CONTINUE
CALL DKHI(NSN, ISUM)
IF (NSN .EQ. 0) GO TO 110
DO 10 K = 1, NSN
CALL DKHD(SNJD0(K), ISUM)
CALL DKHD(SNSLA(K), ISUM)
CALL DKHD(SNSLO(K), ISUM)
CALL DKHD(SNSAZ(K), ISUM)
CALL DKHD(SNPLA(K), ISUM)
CALL DKHD(SNPLO(K), ISUM)
CALL DKHI(SNPGC(K), ISUM)
10 CONTINUE
110 CONTINUE
IF (NSN .EQ. 0) GO TO 111
DO 11 K = 1, 8*NSN
CALL DKHI(PADCH(K), ISUM)
11 CONTINUE
111 CONTINUE
DO 12 K = 1, 22
CALL DKHI(SITECH(K), ISUM)
12 CONTINUE
CALL DKHI(NLEG, ISUM)
IF (NLEG .EQ. 0) GO TO 114
DO 14 K = 1, NLEG
DO 13 I = 1, NLGP
CALL DKHD(LGP(I,K), ISUM)
13 CONTINUE
CALL DKHI(LGSN(K), ISUM)
CALL DKHI(LGTYP(K), ISUM)
CALL DKHI(LGN(K), ISUM)
CALL DKHI(LGGC(K), ISUM)
CALL DKHI(LGVEH(K), ISUM)
14 CONTINUE
114 CONTINUE
CALL DKHI(NEVT, ISUM)
IF (NEVT .EQ. 0) GO TO 115
DO 15 K = 1, NEVT
CALL DKHD(EVT(K), ISUM)
CALL DKHI(EVSN(K), ISUM)
CALL DKHI(EVKND(K), ISUM)
15 CONTINUE
115 CONTINUE
CALL DKHI(NSTART, ISUM)
IF (NSTART .EQ. 0) GO TO 117
DO 17 K = 1, NSTART
DO 16 I = 1, NLGP
CALL DKHD(STP(I,K), ISUM)
16 CONTINUE
CALL DKHI(STSN(K), ISUM)
CALL DKHI(STBOD(K), ISUM)
CALL DKHI(STGC(K), ISUM)
17 CONTINUE
117 CONTINUE
CALL DKHI(NRF, ISUM)
IF (NRF .EQ. 0) GO TO 119
DO 19 K = 1, NRF
DO 18 I = 1, NLGP
CALL DKHD(RFP(I,K), ISUM)
18 CONTINUE
CALL DKHI(RFSN(K), ISUM)
CALL DKHI(RFBOD(K), ISUM)
CALL DKHI(RFGC(K), ISUM)
19 CONTINUE
119 CONTINUE
CALL DKHI(NBN, ISUM)
IF (NBN .EQ. 0) GO TO 120
DO 20 K = 1, NBN
CALL DKHD(BNT(K), ISUM)
CALL DKHD(BNDV(K), ISUM)
CALL DKHD(BNP(K), ISUM)
CALL DKHD(BNR(K), ISUM)
CALL DKHD(BNN(K), ISUM)
CALL DKHI(BNSN(K), ISUM)
CALL DKHI(BNBOD(K), ISUM)
20 CONTINUE
120 CONTINUE
CALL DKHI(NTL, ISUM)
IF (NTL .EQ. 0) GO TO 121
DO 21 K = 1, NTL
CALL DKHD(TLT(K), ISUM)
CALL DKHI(TLK(K), ISUM)
CALL DKHI(TLSN(K), ISUM)
21 CONTINUE
121 CONTINUE
CALL DKHI(NBR, ISUM)
IF (NBR .EQ. 0) GO TO 122
DO 22 K = 1, NBR
CALL DKHD(BRT1(K), ISUM)
CALL DKHD(BRT2(K), ISUM)
CALL DKHI(BRSN(K), ISUM)
CALL DKHI(BRVH(K), ISUM)
CALL DKHI(BREN(K), ISUM)
22 CONTINUE
122 CONTINUE
CALL DKHI(NSIT, ISUM)
IF (NSIT .EQ. 0) GO TO 130
DO 30 K = 1, NSIT
CALL DKHSIT(K, ISUM)
30 CONTINUE
130 CONTINUE
C A tape read from the deck (vdktap.f; ISIMF -1), not one the
C engine wrote, and only if there is one: a deck without a tape
C sums as before.
IF (ITPSN .EQ. 0 .OR. ISIMF .GE. 0) RETURN
CALL DKHI(ITPSN, ISUM)
DO 43 C = 1, MXCHN
CALL DKHI(NTP(C), ISUM)
IF (NTP(C) .EQ. 0) GO TO 43
DO 42 K = 1, NTP(C)
CALL DKHD(TPT(K,C), ISUM)
DO 41 I = 1, 6
CALL DKHD(TPS(I,K,C), ISUM)
41 CONTINUE
42 CONTINUE
43 CONTINUE
RETURN
END
C
C DKHSIT: situation row K into the hash total.
SUBROUTINE DKHSIT(K, ISUM)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
C RESTOMOD END
INTEGER K, ISUM(4), I
CALL DKHD(SIGT(K), ISUM)
CALL DKHD(SIFV(K), ISUM)
CALL DKHD(SIEL(K), ISUM)
CALL DKHD(SIFL(K), ISUM)
CALL DKHD(SIFT(K), ISUM)
CALL DKHD(SIDT(K), ISUM)
CALL DKHD(SIEO(K), ISUM)
CALL DKHD(SIAL(K), ISUM)
CALL DKHD(SIDS(K), ISUM)
CALL DKHD(SIHO(K), ISUM)
CALL DKHD(SIHR(K), ISUM)
DO 10 I = 1, 3
CALL DKHD(SILK(I,K), ISUM)
CALL DKHD(SITN(I,K), ISUM)
10 CONTINUE
CALL DKHD(SIXY(1,K), ISUM)
CALL DKHD(SIXY(2,K), ISUM)
CALL DKHI(SISN(K), ISUM)
CALL DKHI(SIGK(K), ISUM)
CALL DKHI(SIGE(K), ISUM)
CALL DKHI(SIFK(K), ISUM)
CALL DKHI(SIWN(K), ISUM)
CALL DKHI(SIPS(K), ISUM)
CALL DKHI(SIDW(K), ISUM)
CALL DKHI(SIRC(K), ISUM)
CALL DKHI(SIBD(K), ISUM)
CALL DKHI(SIMD(K), ISUM)
CALL DKHI(SIAZ(K), ISUM)
CALL DKHI(SITR(K), ISUM)
CALL DKHI(SIFB(K), ISUM)
CALL DKHI(SIAT(K), ISUM)
CALL DKHI(SIFE(K), ISUM)
CALL DKHI(SIVH(K), ISUM)
CALL DKHI(SIVW(K), ISUM)
CALL DKHI(SITG(K), ISUM)
CALL DKHI(SITF(K), ISUM)
CALL DKHI(SIRD(K), ISUM)
CALL DKHI(SICM(K), ISUM)
CALL DKHI(SILM(K), ISUM)
CALL DKHI(SIFX(K), ISUM)
CALL DKHI(SIXO(K), ISUM)
CALL DKHI(SIHK(K), ISUM)
DO 20 I = 1, MXLAY
CALL DKHI(SILY(I,K), ISUM)
20 CONTINUE
RETURN
END
C
C DKHD: a double into the hash total, as its two 32-bit words.
SUBROUTINE DKHD(X, ISUM)
DOUBLE PRECISION X, D
INTEGER ISUM(4), IW(2)
EQUIVALENCE (D, IW(1))
D = X
CALL DKHI(IW(1), ISUM)
CALL DKHI(IW(2), ISUM)
RETURN
END
C
C DKHI: a 32-bit word into the hash total, as two 16-bit pieces,
C each sum kept below its prime so no product overflows 2**31.
SUBROUTINE DKHI(IW, ISUM)
INTEGER IW, ISUM(4), LO, IHI, I, IPR(4)
DATA IPR / 32749, 32719, 32717, 32713 /
LO = MOD(IW, 65536)
IF (LO .LT. 0) LO = LO + 65536
IHI = (IW - LO) / 65536 + 32768
DO 10 I = 1, 4
ISUM(I) = MOD(ISUM(I) * 65536 + LO, IPR(I))
ISUM(I) = MOD(ISUM(I) * 65536 + IHI, IPR(I))
10 CONTINUE
RETURN
END
src/vdktap.f
C VDKTAP: the card reader's tape cards (#26 slice 6; the reader is
C vdeck.f): a tape read from the deck into /CTAPE/, as the engine
C (sim.f) would have written it. A TAPE card names the scenario
C and the vehicle channel; each card after it that starts with a
C number is one sample, seven numbers: g.e.t. (s, or h:mm:ss.s),
C then geocentric EQ position (km) and velocity (km/s), as TPPUT
C takes them. The tape ends at the next card that does not start
C with a number (a comment or blank card excepted), or at the end
C of its file. tools/vtape.f writes a tape in this form, every
C number with 17 digits so it reads back to the same double (DKNMS,
C vdkfld.f; 10**-28 to 10**38 in magnitude, or 0).
C Period term: the "trajectory ephemeris tape" of position and
C velocity vectors that the RTACF integrator wrote for programs
C "that contained no integrator" (Allday, TN D-6855, pp. 7-8; see
C tape.f). A tape of card images, its layout and its numbers'
C digits are ours. /CTAPE/ holds one scenario's tape: the tape
C the engine writes, or the deck's, whichever came last (SIMRUN
C empties it first). The marks (TPMARK) are the engine's own and
C are not read from a deck. A deck tape's samples are read as
C the engine's (vsrc.f CSMST), the source reported as 3 (ISRCU).
C
C DKTAP: TAPE SCN= (the scenario, already read) CHAN= (1 to MXCHN,
C default 1; channel 1 the CSM, the one vsrc.f reads).
SUBROUTINE DKTAP
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER M, C, DKINT
M = DKINT(YSCN, -1)
C = DKINT(YCHAN, 1)
IF (IDKER .NE. 0) RETURN
IF (M .GE. 1 .AND. M .LE. MXSN .AND. C .GE. 1 .AND.
& C .LE. MXCHN) GO TO 10
CALL DKERR(7)
RETURN
10 IF (ISNHV(M) .EQ. 0) GO TO 90
IF (ITPSN .NE. 0 .AND. ITPSN .NE. M) GO TO 90
IF (NTP(C) .EQ. 0) GO TO 20
CALL DKERR(8)
RETURN
20 ITPSN = M
ISIMF = -1
ITPON = 1
ITPCH = C
ITPCD = NDKCD
RETURN
90 CALL DKERR(30)
RETURN
END
C
C DKTROW: a sample of the open tape, the card's seven tokens, in
C time order (two at one time are a burn or an update: before,
C then after; tape.f).
SUBROUTINE DKTROW
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
INTEGER I, C
DOUBLE PRECISION T, R(3), V(3)
C = ITPCH
IF (NTOK .EQ. 7) GO TO 10
CALL DKERR(22)
RETURN
10 CALL DKGTS(TKS(1), TKL(1), T)
DO 20 I = 1, 3
CALL DKNMS(TKS(I+1), TKL(I+1), R(I))
CALL DKNMS(TKS(I+4), TKL(I+4), V(I))
20 CONTINUE
IF (IDKER .NE. 0) RETURN
IF (NTP(C) .LT. MXSAM) GO TO 30
CALL DKERR(28)
RETURN
30 IF (NTP(C) .EQ. 0) GO TO 40
IF (T .GE. TPT(NTP(C),C)) GO TO 40
CALL DKERR(29)
RETURN
40 CALL TPPUT(C, T, R, V)
RETURN
END
C
C DKTPCL: close the open tape; it needs two samples at least.
SUBROUTINE DKTPCL
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
INCLUDE 'viewsit.inc'
INCLUDE 'vdvoc.inc'
INCLUDE 'vdeck.inc'
C RESTOMOD END
ITPON = 0
IF (NTP(ITPCH) .GE. 2) RETURN
CALL DKERRC(29, ITPCD)
RETURN
END
src/vdvoc.f
C Generated by tools/gen_data.py from its card tables. Do not edit.
C The card reader's vocabulary, layout in vdvoc.inc. Lists:
C 1. card kinds: MISSION, SCENARIO, EPOCH, SITE, PAD, LEG, ROW,
C EVENT, TIMELINE, START, REF, BURN, BURNCUE, SITUATION, RECIPE,
C VIEWS, HDRREF, SPAN, REEL, SHOT, TAPE
C 2. keys: NAME, SRC, ID, JD, AZ, LAT, LON, LATTYPE, ALT, ALTB, DV,
C FPA, FROM, HDG, LATB, LONB, N, P, R, T, TB, TO, TYPE, V, VEH,
C VEL, KIND, BODY, END, CUT, ENG, IGN, CAPTION, DRAW, FOV, GET,
C LAYERS, LOOK, POSE, TITLE, WINDOW, AT, ATT, DIST, DRIFT, ELEV,
C ELOFF, FIX, MODE, OFFELEV, OFFLEG, TURN, CM, FIXED, LM,
C OFFTARGET, RIDES, TARGET, VIEW, XSTART, OBJ, OFFSET, RADIUS,
C BUTTON, LEN, SIT, TRACK, UNTIL, ALIAS, FADE, FILM, NEXT, TAG,
C DUR, FRAME, LABELS, LIMB, PITCH, RATE, ROLL, TTE, YAW, CHAN, SCN
C 3. LEG TYPE=: CIRC, CONIC, LUNAR, LCONIC, TABLE
C 4. LEG VEH=: CSM, LM, SIVB
C 5. LATTYPE=: GD, GC
C 6. ROW VEL=: SF, EF
C 7. EVENT KIND= (and GET=, AT=): TDATT, SEP, APPR, DOCK, UNDOCK,
C TOUCH, EI, PTC, TLI, LOI1, LOI2, PHOTO, TEI, LMSEP, PDI, LIFT,
C TPF, LMDOK, JETT, CMSEP, EJECT, SLING, LIFTOFF, SICSEP, LESJET,
C SIISEP
C 8. TIMELINE KIND=: LAUNCH, BURN, STAGING, ORBIT, SEP, SURFACE,
C TV, CREW, PHOTO, ENTRY, MARK
C 9. BODY=: EARTH, MOON
C 10. BURNCUE VEH=: CSM, LM, S-IVB
C 11. BURNCUE ENG=: SPS, DPS, APS, J-2
C 12. GET= rules: ERISE
C 13. FOV= rules: DISC
C 14. WINDOW=: CSM, LM
C 15. LAYERS=: FRAME, STARS, SUN, MOON, EARTH, VEHICLES, COAS,
C SHADOW, LPD, BURN
C 16. POSE=: LMPIRO, S7POSE, S8POSE
C 17. DRAW= (bits): NOSHADE, MOONDISC, NOLMMARK
C 18. RECIPE NAME=: LOCALVERT, INERTIAL, CREWSTN, BODYCTR, EXTSEED
C 19. MODE=: FORWARD, NORMAL
C 20. AZ=: NONE, EARTH
C 21. OFFLEG=: EARTH
C 22. ATT=: SIGHTLINE, S7ATT, S8ATT
C 23. RECIPE VEH=: CM, LM
C 24. VIEW=: WINDOW, EXTERNAL, CM, LM
C 25. TARGET=, OFFTARGET=: EARTH, MOON, SUN, CSM, LM, SIVB
C 26. RIDES=: NONE, CSM, LM
C 27. CM=, LM=: NO, PLACED, ALWAYS
C 28. FIXED=: NO, YES
C 29. HDRREF OBJ=: BODY, LM, LMDOCK, CSMTUNNEL
C RESTOMOD BEGIN: implied-DO DATA not found in FORTRAN V docs;
C the 1108 loader skips unreferenced BLOCK DATA
C (docs/univac-1108.md); ASCII codes, not FIELDATA.
BLOCK DATA VDVOCB
INCLUDE 'vdvoc.inc'
INTEGER IVD
DATA (VOCC(IVD),IVD=1,95) /
1 77,73,83,83,73,79,78,83,67,69,
1 78,65,82,73,79,69,80,79,67,72,
1 83,73,84,69,80,65,68,76,69,71,
1 82,79,87,69,86,69,78,84,84,73,
1 77,69,76,73,78,69,83,84,65,82,
1 84,82,69,70,66,85,82,78,66,85,
1 82,78,67,85,69,83,73,84,85,65,
1 84,73,79,78,82,69,67,73,80,69,
1 86,73,69,87,83,72,68,82,82,69,
1 70,83,80,65,78/
DATA (VOCC(IVD),IVD=96,190) /
1 82,69,69,76,83,72,79,84,84,65,
1 80,69,78,65,77,69,83,82,67,73,
1 68,74,68,65,90,76,65,84,76,79,
1 78,76,65,84,84,89,80,69,65,76,
1 84,65,76,84,66,68,86,70,80,65,
1 70,82,79,77,72,68,71,76,65,84,
1 66,76,79,78,66,78,80,82,84,84,
1 66,84,79,84,89,80,69,86,86,69,
1 72,86,69,76,75,73,78,68,66,79,
1 68,89,69,78,68/
DATA (VOCC(IVD),IVD=191,285) /
1 67,85,84,69,78,71,73,71,78,67,
1 65,80,84,73,79,78,68,82,65,87,
1 70,79,86,71,69,84,76,65,89,69,
1 82,83,76,79,79,75,80,79,83,69,
1 84,73,84,76,69,87,73,78,68,79,
1 87,65,84,65,84,84,68,73,83,84,
1 68,82,73,70,84,69,76,69,86,69,
1 76,79,70,70,70,73,88,77,79,68,
1 69,79,70,70,69,76,69,86,79,70,
1 70,76,69,71,84/
DATA (VOCC(IVD),IVD=286,380) /
1 85,82,78,67,77,70,73,88,69,68,
1 76,77,79,70,70,84,65,82,71,69,
1 84,82,73,68,69,83,84,65,82,71,
1 69,84,86,73,69,87,88,83,84,65,
1 82,84,79,66,74,79,70,70,83,69,
1 84,82,65,68,73,85,83,66,85,84,
1 84,79,78,76,69,78,83,73,84,84,
1 82,65,67,75,85,78,84,73,76,65,
1 76,73,65,83,70,65,68,69,70,73,
1 76,77,78,69,88/
DATA (VOCC(IVD),IVD=381,475) /
1 84,84,65,71,68,85,82,70,82,65,
1 77,69,76,65,66,69,76,83,76,73,
1 77,66,80,73,84,67,72,82,65,84,
1 69,82,79,76,76,84,84,69,89,65,
1 87,67,72,65,78,83,67,78,67,73,
1 82,67,67,79,78,73,67,76,85,78,
1 65,82,76,67,79,78,73,67,84,65,
1 66,76,69,67,83,77,76,77,83,73,
1 86,66,71,68,71,67,83,70,69,70,
1 84,68,65,84,84/
DATA (VOCC(IVD),IVD=476,570) /
1 83,69,80,65,80,80,82,68,79,67,
1 75,85,78,68,79,67,75,84,79,85,
1 67,72,69,73,80,84,67,84,76,73,
1 76,79,73,49,76,79,73,50,80,72,
1 79,84,79,84,69,73,76,77,83,69,
1 80,80,68,73,76,73,70,84,84,80,
1 70,76,77,68,79,75,74,69,84,84,
1 67,77,83,69,80,69,74,69,67,84,
1 83,76,73,78,71,76,73,70,84,79,
1 70,70,83,73,67/
DATA (VOCC(IVD),IVD=571,665) /
1 83,69,80,76,69,83,74,69,84,83,
1 73,73,83,69,80,76,65,85,78,67,
1 72,66,85,82,78,83,84,65,71,73,
1 78,71,79,82,66,73,84,83,69,80,
1 83,85,82,70,65,67,69,84,86,67,
1 82,69,87,80,72,79,84,79,69,78,
1 84,82,89,77,65,82,75,69,65,82,
1 84,72,77,79,79,78,67,83,77,76,
1 77,83,45,73,86,66,83,80,83,68,
1 80,83,65,80,83/
DATA (VOCC(IVD),IVD=666,760) /
1 74,45,50,69,82,73,83,69,68,73,
1 83,67,67,83,77,76,77,70,82,65,
1 77,69,83,84,65,82,83,83,85,78,
1 77,79,79,78,69,65,82,84,72,86,
1 69,72,73,67,76,69,83,67,79,65,
1 83,83,72,65,68,79,87,76,80,68,
1 66,85,82,78,76,77,80,73,82,79,
1 83,55,80,79,83,69,83,56,80,79,
1 83,69,78,79,83,72,65,68,69,77,
1 79,79,78,68,73/
DATA (VOCC(IVD),IVD=761,855) /
1 83,67,78,79,76,77,77,65,82,75,
1 76,79,67,65,76,86,69,82,84,73,
1 78,69,82,84,73,65,76,67,82,69,
1 87,83,84,78,66,79,68,89,67,84,
1 82,69,88,84,83,69,69,68,70,79,
1 82,87,65,82,68,78,79,82,77,65,
1 76,78,79,78,69,69,65,82,84,72,
1 69,65,82,84,72,83,73,71,72,84,
1 76,73,78,69,83,55,65,84,84,83,
1 56,65,84,84,67/
DATA (VOCC(IVD),IVD=856,946) /
1 77,76,77,87,73,78,68,79,87,69,
1 88,84,69,82,78,65,76,67,77,76,
1 77,69,65,82,84,72,77,79,79,78,
1 83,85,78,67,83,77,76,77,83,73,
1 86,66,78,79,78,69,67,83,77,76,
1 77,78,79,80,76,65,67,69,68,65,
1 76,87,65,89,83,78,79,89,69,83,
1 66,79,68,89,76,77,76,77,68,79,
1 67,75,67,83,77,84,85,78,78,69,
1 76/
DATA (VOCS(IVD),IVD=1,95) /
1 1,8,16,21,25,28,31,34,39,47,
1 52,55,59,66,75,81,86,92,96,100,
1 104,108,112,115,117,119,121,124,127,134,
1 137,141,143,146,150,153,157,161,162,163,
1 164,165,167,169,173,174,177,180,184,188,
1 191,194,197,200,207,211,214,217,223,227,
1 231,236,242,244,247,251,256,260,265,268,
1 272,279,285,289,291,296,298,307,312,318,
1 322,328,331,337,343,349,352,355,360,365,
1 370,374,378,382,385/
DATA (VOCS(IVD),IVD=96,190) /
1 388,393,399,403,408,412,416,419,422,426,
1 429,433,438,443,449,454,457,459,463,465,
1 467,469,471,476,479,483,487,493,498,500,
1 503,506,510,514,519,522,527,530,534,537,
1 542,546,551,556,561,568,574,580,586,592,
1 596,603,608,611,618,620,624,629,634,638,
1 643,647,650,652,657,660,663,666,669,674,
1 678,681,683,688,693,696,700,705,713,717,
1 723,726,730,736,742,748,755,763,771,780,
1 788,795,802,809,816/
DATA (VOCS(IVD),IVD=191,220) /
1 822,826,831,836,845,850,855,857,859,865,
1 873,875,877,882,886,889,892,894,898,902,
1 905,907,909,915,921,923,926,930,932,938/
DATA (VOCN(IVD),IVD=1,95) /
1 7,8,5,4,3,3,3,5,8,5,
1 3,4,7,9,6,5,6,4,4,4,
1 4,4,3,2,2,2,3,3,7,3,
1 4,2,3,4,3,4,4,1,1,1,
1 1,2,2,4,1,3,3,4,4,3,
1 3,3,3,7,4,3,3,6,4,4,
1 5,6,2,3,4,5,4,5,3,4,
1 7,6,4,2,5,2,9,5,6,4,
1 6,3,6,6,6,3,3,5,5,5,
1 4,4,4,3,3/
DATA (VOCN(IVD),IVD=96,190) /
1 5,6,4,5,4,4,3,3,4,3,
1 4,5,5,6,5,3,2,4,2,2,
1 2,2,5,3,4,4,6,5,2,3,
1 3,4,4,5,3,5,3,4,3,5,
1 4,5,5,5,7,6,6,6,6,4,
1 7,5,3,7,2,4,5,5,4,5,
1 4,3,2,5,3,3,3,3,5,4,
1 3,2,5,5,3,4,5,8,4,6,
1 3,4,6,6,6,7,8,8,9,8,
1 7,7,7,7,6/
DATA (VOCN(IVD),IVD=191,220) /
1 4,5,5,9,5,5,2,2,6,8,
1 2,2,5,4,3,3,2,4,4,3,
1 2,2,6,6,2,3,4,2,6,9/
DATA (VOCV(IVD),IVD=1,95) /
1 1,2,3,4,5,6,7,8,9,10,
1 11,12,13,14,15,16,17,18,19,20,
1 21,1,2,3,4,5,6,7,8,9,
1 10,11,12,13,14,15,16,17,18,19,
1 20,21,22,23,24,25,26,27,28,29,
1 30,31,32,33,34,35,36,37,38,39,
1 40,41,42,43,44,45,46,47,48,49,
1 50,51,52,53,54,55,56,57,58,59,
1 60,61,62,63,64,65,66,67,68,69,
1 70,71,72,73,74/
DATA (VOCV(IVD),IVD=96,190) /
1 75,76,77,78,79,80,81,82,83,84,
1 1,2,3,4,5,1,2,3,0,1,
1 0,1,1,2,3,4,5,6,7,8,
1 9,10,11,12,13,14,15,16,17,18,
1 19,20,21,22,23,24,25,26,1,2,
1 3,4,5,6,7,8,9,10,11,1,
1 2,1,2,3,1,2,3,4,3,2,
1 1,2,1,2,3,4,5,6,7,8,
1 9,10,1,2,3,1,2,4,1,2,
1 3,4,5,1,2/
DATA (VOCV(IVD),IVD=191,220) /
1 0,1,1,1,2,3,1,2,0,1,
1 2,3,1,2,3,4,5,6,0,1,
1 2,0,1,2,0,1,0,1,2,3/
DATA (VOCLST(IVD),IVD=1,30) /
1 1,22,106,111,114,116,118,144,155,157,
1 160,164,165,166,168,178,181,184,189,191,
1 193,194,197,199,203,209,212,215,217,221/
DATA (KYCARD(IVD),IVD=1,84) /
1 680219,2097151,270338,4,16392,1656,
1 1656,1584,18016,32,2080,1632,
1 131104,1632,32,32,2080,2080,
1 2080,4064,32,524320,32,1632,
1 20512,64,262528,19968,512,4096,
1 4096,4096,663552,8192,663552,532480,
1 8192,8192,8192,270336,8192,540672,
1 16384,16384,16384,16384,16384,16384,
1 16384,16384,16384,16384,32768,32768,
1 32768,32768,32768,688128,688128,32768,
1 65536,65536,65536,131072,131072,655360,
1 131072,131072,262144,262144,262144,262144,
1 262144,524288,524288,524288,524288,524288,
1 524288,524288,524288,524288,1048576,1048576/
END
C RESTOMOD END
src/veye.f
C=======================================================================
C
C V I E W - 1 1 0 8 THE MOVED EYE
C
C Core element. The viewer moves the eye (#72, #31): in a crew
C station (in_view 2, 3, and the LM descent asked for as the LM
C station) the eye leaves the design eye (CMEYE, LDEYE) by an
C offset in the vehicle's body frame, clamped inside the cabin's
C walls; in the external view the point the camera flies round
C leaves the target. The offset is in_eyeo (VSETEY); the one used,
C clamped, goes back to the chassis with the camera's axes in the
C offset's frame (VGETEY), so the page can step the eye along
C where it looks. One relocatable element of the kernel; see
C vdrive.f for the list.
C
C RESTOMOD: all of this is ours, a modern addition. VIEW drew from
C fixed eye points ("as seen through the spacecraft windows", TN
C D-6853 printed p. 3), and the cabins are ours (models.f CMINT,
C LMINT). With the offset 0 every frame is what it was: nothing
C here moves the camera, the cabins or the external centre unless
C the offset is nonzero.
C=======================================================================
C
C VSETEY: the eye offset asked for the next frame (the chassis
C calls it before VFRAME, from in_eyeo).
SUBROUTINE VSETEY(EO)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION EO(3)
INTEGER I
DO 10 I = 1, 3
EYOI(I) = EO(I)
10 CONTINUE
RETURN
END
C
C VGETEY: after VFRAME, the offset the frame used (clamped; the
C one asked where the frame used none), its kind K (IEYK) and the
C camera's axes in its frame, AX (EYAX).
SUBROUTINE VGETEY(EO, K, AX)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION EO(3), AX(3,3)
INTEGER K, I, J
K = IEYK
DO 20 J = 1, 3
EO(J) = EYOI(J)
IF (IEYK .NE. 0) EO(J) = EYOF(J)
DO 10 I = 1, 3
AX(I,J) = EYAX(I,J)
10 CONTINUE
20 CONTINUE
RETURN
END
C
C EYCLR: no offset used yet this frame (VFRAME, first).
SUBROUTINE EYCLR
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER I, J
IEYK = 0
DO 20 J = 1, 3
EYOF(J) = 0.0D0
DO 10 I = 1, 3
EYAT(I,J) = 0.0D0
EYAX(I,J) = 0.0D0
10 CONTINUE
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C EYUSE: this frame's view takes the offset: kind IK (1 external,
C 2 CM station, 3 LM station), its frame's axes AT (columns, EQ:
C the vehicle's body axes, or the target's reference axes). OFF
C the offset asked, clamped (EYCLMP); NZ 1 if it is not 0.
C-----------------------------------------------------------------------
SUBROUTINE EYUSE(IK, AT, OFF, NZ)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION AT(3,3), OFF(3)
INTEGER IK, NZ, I, J
IEYK = IK
DO 10 J = 1, 3
DO 5 I = 1, 3
EYAT(I,J) = AT(I,J)
5 CONTINUE
10 CONTINUE
CALL EYCLMP(IK, OFF)
NZ = 0
DO 20 I = 1, 3
EYOF(I) = OFF(I)
IF (OFF(I) .NE. 0.0D0) NZ = 1
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C EYCLMP: the offset asked (EYOI), clamped for view kind IK, in
C OFF. All bounds ours, from the cabin models' own walls:
C CM (2): the eye between the floor's rim and the forward
C bulkhead, X 0.10 to 1.50 m, and 0.15 m (about half a head)
C inside the cone wall CMINT draws, from radius 1.777 m at X
C 0.051 to 0.754 m at X 1.626 (the couches and the console are
C not walls: the eye can enter them);
C LM (3): Z 0.85 to 1.45 m, between the aft bulkhead's ring (Z
C 0.686) and the front panels (Z 1.56 and up, LMINT), X 2.40
C m and up, above the floor (X 2.094), and 0.15 m inside the
C cabin's cylinder, radius 1.168 m about X 3.0, Y 0;
C external (1): each component -1 to 1, the camera's distance.
C The design eyes are inside both, so 0 stays 0.
C-----------------------------------------------------------------------
SUBROUTINE EYCLMP(IK, OFF)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION OFF(3)
INTEGER IK, I
DOUBLE PRECISION E(3), P(3), R, RMAX, DX, DY
DO 5 I = 1, 3
OFF(I) = EYOI(I)
5 CONTINUE
IF (OFF(1) .EQ. 0.0D0 .AND. OFF(2) .EQ. 0.0D0 .AND.
& OFF(3) .EQ. 0.0D0) RETURN
IF (IK .EQ. 2) GO TO 20
IF (IK .EQ. 3) GO TO 40
DO 10 I = 1, 3
OFF(I) = DMAX1(-1.0D0, DMIN1(1.0D0, OFF(I)))
10 CONTINUE
RETURN
C The CM.
20 CALL CMEYE(E)
DO 25 I = 1, 3
P(I) = E(I) + OFF(I)
25 CONTINUE
P(1) = DMAX1(0.10D0, DMIN1(1.50D0, P(1)))
RMAX = 1.777D0 + (0.754D0 - 1.777D0) * (P(1) - 0.051D0)
& / (1.626D0 - 0.051D0) - 0.15D0
R = DSQRT(P(2) * P(2) + P(3) * P(3))
IF (R .LE. RMAX) GO TO 60
P(2) = P(2) * RMAX / R
P(3) = P(3) * RMAX / R
GO TO 60
C The LM.
40 CALL LDEYE(E)
DO 45 I = 1, 3
P(I) = E(I) + OFF(I)
45 CONTINUE
P(3) = DMAX1(0.85D0, DMIN1(1.45D0, P(3)))
IF (P(1) .LT. 2.40D0) P(1) = 2.40D0
RMAX = 1.168D0 - 0.15D0
DX = P(1) - 3.0D0
DY = P(2)
R = DSQRT(DX * DX + DY * DY)
IF (R .LE. RMAX) GO TO 60
P(1) = 3.0D0 + DX * RMAX / R
P(2) = DY * RMAX / R
60 DO 65 I = 1, 3
OFF(I) = P(I) - E(I)
65 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C EYAXES: the camera's right, up and boresight (CR, CU, CB, after
C free-look) in the offset's frame (EYAT), as EYAX's columns, for
C the page to step the eye along them. None where no view took
C the offset.
C-----------------------------------------------------------------------
SUBROUTINE EYAXES
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER I
DOUBLE PRECISION VDOT
IF (IEYK .EQ. 0) RETURN
DO 10 I = 1, 3
EYAX(I,1) = VDOT(EYAT(1,I), CR)
EYAX(I,2) = VDOT(EYAT(1,I), CU)
EYAX(I,3) = VDOT(EYAT(1,I), CB)
10 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C EYMOVE: carry the camera CG (km) by the body offset OFF (metres)
C in axes AT, and the placed models but KX with it, so the world
C stays where it was (MSHIFT).
C-----------------------------------------------------------------------
SUBROUTINE EYMOVE(AT, OFF, CG, KX)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION AT(3,3), OFF(3), CG(3)
INTEGER KX, I
DOUBLE PRECISION V(3), W(3), DS(3)
DO 10 I = 1, 3
V(I) = OFF(I) * 1.0D-3
10 CONTINUE
CALL MXV(AT, V, W)
DO 20 I = 1, 3
CG(I) = CG(I) + W(I)
DS(I) = -W(I)
20 CONTINUE
CALL MSHIFT(DS, KX)
RETURN
END
src/vlayer.f
C=======================================================================
C
C V I E W - 1 1 0 8 LAYER DISPATCHER
C
C Walks the situation's layer list (JLL, from its SITUATION card)
C and calls each layer by its id.
C Every layer is a subroutine of one file with the same argument
C list, (GET, VB, NV, SB, NS, LB, NL), and draws into the plot
C buffers in list order. FORTRAN 66 has no procedure variables,
C so the call is chosen by a computed GO TO over the id. One
C relocatable element of the kernel; see vdrive.f for the list.
C
C To add a layer: a new file with its subroutine, the next id, one
C GO TO target and CALL below, a name for it in tools/gen_data.py
C (LAYER_IDS), and the name in the SITUATION cards' LAYERS.
C
C id layer element
C 1 plot frame and ticks lframe.f DFRAME
C 2 stars lstars.f DSTARS
C 3 Sun lsun.f DSUN
C 4 Moon and craters lmoon.f DMOON
C 5 Earth learth.f DEARTH
C 6 vehicles (placed models) lvehic.f MDRALL
C their labels and markers lvlab.f VLABEL
C 7 COAS reticle lcoas.f S7COAS
C 8 LM shadow lshad.f LMSHAD
C 9 LPD and LM window llpd.f OVLPD
C 10 burn cue (exhaust, text) lburn.f DBURN
C
C=======================================================================
SUBROUTINE LAYERS(GET, VB, NV, SB, NS, LB, NL)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, VB(5,MAXV), SB(3,MAXS), LB(4,MAXL)
INTEGER NV, NS, NL
INTEGER K, L
C The situation's layer list, JLL, ended by 0 (its SITUATION
C card's LAYERS, copied by SITSET).
DO 90 K = 1, 12
L = JLL(K)
IF (L .LT. 1 .OR. L .GT. 10) GO TO 95
C Window overlays (COAS, LPD) only in the scene's window view.
IF (IVUSE .NE. 0 .AND. (L .EQ. 7 .OR. L .EQ. 9)) GO TO 90
C The LM station in the closed SLA (ISLA, STATLM) sees nothing
C outside: only the frame, and the cabin (a placed model, the
C only one; its labels and markers left out with the rest).
IF (ISLA .EQ. 1 .AND. L .NE. 1 .AND. L .NE. 6) GO TO 90
C The window mask (vmask.f) is for the outside: not the frame
C and the window overlays.
IMSK = IMSKON
IF (L .EQ. 1 .OR. L .EQ. 7 .OR. L .EQ. 9) IMSK = 0
GO TO (11, 12, 13, 14, 15, 16, 17, 18, 19, 20), L
11 CALL DFRAME(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
12 CALL DSTARS(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
13 CALL DSUN(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
14 CALL DMOON(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
15 CALL DEARTH(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
16 CALL MDRALL(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
17 CALL S7COAS(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
18 CALL LMSHAD(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
19 CALL OVLPD(GET, VB, NV, SB, NS, LB, NL)
GO TO 90
20 CALL DBURN(GET, VB, NV, SB, NS, LB, NL)
90 CONTINUE
C The LM station view (in_view 3) carries the LM window overlay.
95 IMSK = 0
IF (IVUSE .EQ. 3) CALL OVLPD(GET, VB, NV, SB, NS, LB, NL)
RETURN
END
src/vmask.f
C=======================================================================
C
C V I E W - 1 1 0 8 WINDOW MASK, CABIN HIDDEN LINES
C
C Core element. With in_flags bit 5 and a cabin interior drawn
C (bit 4, the CM and LM station views), the outside is seen only
C through the cabin's windows: every line of the sky, the Earth,
C the Moon and the other vehicles is cut to the windows, and stars
C and labels outside them are dropped. The cabin's own lines, the
C plot frame and the window overlays (LPD scale, COAS) are drawn
C whole. A modern addition (ours): VIEW drew the scene through
C one window outline (TN D-6853, printed p. 3, "realistic
C spacecraft-window outlines"), and no source we have says how.
C One relocatable element of the kernel; see vdrive.f for the
C list.
C
C The windows are the cabin models' own window outlines (XWIN in
C models.f: the CM's five, the LM's two front windows and its
C docking window). Each is a cone from the eye: the planes
C through the eye and each edge, facing in, bound it, and a point
C is in the window when it is on the inner side of all of them.
C That needs the cone to be convex; every outline is, seen from
C its eye (our check: each corner is inside the planes of the
C edges it is not on). A segment's points A + T (B - A) are on a
C plane's inner side over one interval of T, so the cut is exact,
C whatever the projection, for segments behind the eye or
C across the projection's limit, and a segment seen through two
C windows gives two pieces.
C
C The pen's entry points SEG, MSEG and EMIT pass through here and
C go on to SEG0, MSEG0 and EMIT0 in pen.f; with the mask off they
C call them straight through, so frames are as before.
C
C The cabins' hidden lines (CBCUT, below; ours) use the same plane
C test the other way round: a cabin line is cut where the cabin's
C opaque faces hide it from the eye, once, when MLIB builds the
C cabins.
C=======================================================================
C
C-----------------------------------------------------------------------
C WMSET: the window planes of this frame, after the models are
C placed (VIEWPT). Corners camera relative, metres: what MDRAW
C does to a free line, without the 1.0D-3.
C-----------------------------------------------------------------------
SUBROUTINE WMSET
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION V(3,MWV), B(3), C(3), N(3), S, VNRM, VDOT
INTEGER J, K, L, I, KM
IMSKON = 0
IMSK = 0
DO 50 J = 1, NWIN
WACT(J) = 0
KM = WMOD(J)
IF (MDON(KM) .EQ. 0) GO TO 50
CALL SETV(C, 0.0D0, 0.0D0, 0.0D0)
DO 20 K = 1, NWV(J)
DO 10 I = 1, 3
B(I) = WBV(I,K,J) - MDBO(I,KM)
10 CONTINUE
CALL MXV(MDAT(1,1,KM), B, V(1,K))
DO 15 I = 1, 3
V(I,K) = V(I,K) + 1.0D3 * MDP(I,KM)
C(I) = C(I) + V(I,K)
15 CONTINUE
20 CONTINUE
C Edge K's plane; C, the sum of the corners, is inside. A
C plane through two corners in line with the eye bounds nothing.
DO 40 K = 1, NWV(J)
L = MOD(K, NWV(J)) + 1
CALL VCRS(V(1,K), V(1,L), N)
S = VNRM(N)
IF (S .LE. 1.0D-12) S = 0.0D0
IF (S .GT. 0.0D0) S = 1.0D0 / S
IF (VDOT(N, C) .LT. 0.0D0) S = -S
DO 30 I = 1, 3
WPN(I,K,J) = S * N(I)
30 CONTINUE
40 CONTINUE
WACT(J) = 1
IF (MOD(IFLG / 32, 2) .EQ. 1) IMSKON = 1
50 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C WMCUT: the parts of segment A-B (camera relative) seen through a
C window: NP intervals TA(K) .. TB(K) of T along A + T (B - A),
C in order, overlaps merged. Cyrus-Beck against each window's
C planes.
C-----------------------------------------------------------------------
SUBROUTINE WMCUT(A, B, TA, TB, NP)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION A(3), B(3), TA(MWIN), TB(MWIN)
INTEGER NP
DOUBLE PRECISION T0, T1, T, FA, FB
INTEGER J, K, I, M
C RESTOMOD BEGIN: Cyrus-Beck clipping, published 1978
NP = 0
DO 50 J = 1, NWIN
IF (WACT(J) .EQ. 0) GO TO 50
T0 = 0.0D0
T1 = 1.0D0
DO 30 K = 1, NWV(J)
FA = WPN(1,K,J) * A(1) + WPN(2,K,J) * A(2)
& + WPN(3,K,J) * A(3)
FB = WPN(1,K,J) * B(1) + WPN(2,K,J) * B(2)
& + WPN(3,K,J) * B(3)
IF (FA .GE. 0.0D0 .AND. FB .GE. 0.0D0) GO TO 30
IF (FA .LT. 0.0D0 .AND. FB .LT. 0.0D0) GO TO 50
T = FA / (FA - FB)
IF (FA .LT. 0.0D0 .AND. T .GT. T0) T0 = T
IF (FB .LT. 0.0D0 .AND. T .LT. T1) T1 = T
IF (T0 .GE. T1) GO TO 50
30 CONTINUE
C Into the list, kept in order of TA.
NP = NP + 1
I = NP
40 IF (I .EQ. 1) GO TO 45
IF (TA(I-1) .LE. T0) GO TO 45
TA(I) = TA(I-1)
TB(I) = TB(I-1)
I = I - 1
GO TO 40
45 TA(I) = T0
TB(I) = T1
50 CONTINUE
C RESTOMOD END
M = 0
DO 60 I = 1, NP
IF (M .EQ. 0) GO TO 55
IF (TA(I) .GT. TB(M)) GO TO 55
IF (TB(I) .GT. TB(M)) TB(M) = TB(I)
GO TO 60
55 M = M + 1
TA(M) = TA(I)
TB(M) = TB(I)
60 CONTINUE
NP = M
RETURN
END
C
C WMIN: 1 if the direction of P (camera relative) is in a window.
INTEGER FUNCTION WMIN(P)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION P(3)
INTEGER J, K
WMIN = 1
DO 20 J = 1, NWIN
IF (WACT(J) .EQ. 0) GO TO 20
DO 10 K = 1, NWV(J)
IF (WPN(1,K,J) * P(1) + WPN(2,K,J) * P(2)
& + WPN(3,K,J) * P(3) .LT. 0.0D0) GO TO 20
10 CONTINUE
RETURN
20 CONTINUE
WMIN = 0
RETURN
END
C
C WMPT: the point of segment A-B at T (camera relative), the ends
C themselves at T = 0 and T = 1.
SUBROUTINE WMPT(A, B, T, P)
DOUBLE PRECISION A(3), B(3), T, P(3)
INTEGER I
DO 10 I = 1, 3
P(I) = A(I) + T * (B(I) - A(I))
IF (T .GE. 1.0D0) P(I) = B(I)
10 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C SEG, MSEG: the pen's 3-D segments (SEG0, MSEG0 in pen.f), cut to
C the windows while the mask applies.
C-----------------------------------------------------------------------
SUBROUTINE SEG(VB, NV, A, B)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), A(3), B(3)
INTEGER NV
DOUBLE PRECISION TA(MWIN), TB(MWIN), P(3), Q(3)
INTEGER NP, K
IF (IMSK .EQ. 1) GO TO 10
CALL SEG0(VB, NV, A, B)
RETURN
10 CALL WMCUT(A, B, TA, TB, NP)
DO 20 K = 1, NP
CALL WMPT(A, B, TA(K), P)
CALL WMPT(A, B, TB(K), Q)
CALL SEG0(VB, NV, P, Q)
20 CONTINUE
RETURN
END
C
SUBROUTINE MSEG(VB, NV, A, B)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), A(3), B(3)
INTEGER NV
DOUBLE PRECISION TA(MWIN), TB(MWIN), P(3), Q(3)
INTEGER NP, K
IF (IMSK .EQ. 1) GO TO 10
CALL MSEG0(VB, NV, A, B)
RETURN
10 CALL WMCUT(A, B, TA, TB, NP)
DO 20 K = 1, NP
CALL WMPT(A, B, TA(K), P)
CALL WMPT(A, B, TB(K), Q)
CALL MSEG0(VB, NV, P, Q)
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C EMIT: a segment given in plot degrees (EMIT0 in pen.f), the Sun's
C disc and the boxed X marks. While the mask applies, its ends go
C back to directions (UNPROJ) and the chord between them is cut;
C the pieces' ends are projected again. In the gnomonic plot a
C straight line is a great circle, so this is exact; in the
C stereographic plot it holds for these short marks.
C-----------------------------------------------------------------------
SUBROUTINE EMIT(VB, NV, X1, Y1, X2, Y2)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION VB(5,MAXV), X1, Y1, X2, Y2
INTEGER NV
DOUBLE PRECISION TA(MWIN), TB(MWIN), A(3), B(3), P(3)
DOUBLE PRECISION XA, YA, XB, YB
INTEGER NP, K, IOK
IF (IMSK .EQ. 1) GO TO 10
CALL EMIT0(VB, NV, X1, Y1, X2, Y2)
RETURN
10 CALL UNPROJ(X1, Y1, 0, A)
CALL UNPROJ(X2, Y2, 0, B)
CALL WMCUT(A, B, TA, TB, NP)
DO 20 K = 1, NP
XA = X1
YA = Y1
XB = X2
YB = Y2
CALL WMPT(A, B, TA(K), P)
IF (TA(K) .GT. 0.0D0) CALL PROJ(P, XA, YA, IOK)
CALL WMPT(A, B, TB(K), P)
IF (TB(K) .LT. 1.0D0) CALL PROJ(P, XB, YB, IOK)
CALL EMIT0(VB, NV, XA, YA, XB, YB)
20 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C CABIN HIDDEN LINES (ours). A cabin's lines are hidden by its
C opaque faces (the triangles OCPOLY and OCSTRP keep in /COCC/:
C the consoles, couches, equipment bays and panels, the bulkheads
C about the tunnel and the midsection). The cabin is placed about
C its eye (STATCM, STATLM, LDCAB), so what hides what does not
C change as the view turns: CBCUT cuts each line once, when MLIB
C builds the cabins, and MDRAW draws the pieces left. For an eye
C moved in the cabin, CBCUT again with its offset; the cut is
C kept with the offset it was made for, and asking again for the
C same offset costs nothing. The cut is exact: a point of a line
C is hidden by a triangle when its direction is inside the planes
C through the eye and the triangle's edges (as WMCUT's windows)
C and it is beyond the triangle's plane. A line on a face's own
C plane is not hidden by it, so a face's outline and the lines
C along its edges stay. TN D-6853 (printed p. 12) names hidden-
C line models of the LM and the S-IVB only; VIEW drew no cabin.
C-----------------------------------------------------------------------
C
C ICABN: the cabin number of model K, 1 the CM's (KCMI), 2 the
C LM's (KLMI), else 0.
INTEGER FUNCTION ICABN(K)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
ICABN = 0
IF (K .EQ. KCMI) ICABN = 1
IF (K .EQ. KLMI) ICABN = 2
RETURN
END
C
C-----------------------------------------------------------------------
C CBCUT: cut cabin model K's free lines (MDX1(K)..MDX2(K)) for its
C eye (CMEYE, LDEYE) moved by OFF (body metres) into the pieces
C CPL of /COCC/ that MDRAW draws. Nothing to do when the cabin is
C already cut for OFF. Pieces past MCP are counted in NCPX.
C-----------------------------------------------------------------------
SUBROUTINE CBCUT(K, OFF)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
INTEGER K
DOUBLE PRECISION OFF(3)
DOUBLE PRECISION E(3), A(3), B(3), T0, T1
DOUBLE PRECISION D, VNRM
INTEGER IC, I, J, L, NP, ICABN
C RESTOMOD BEGIN: the cabins and their hidden lines are ours, a
C modern addition (VIEW drew no cabin; TN D-6853, printed p. 12)
IC = ICABN(K)
IF (IC .EQ. 0) RETURN
IF (KCOK(IC) .EQ. 0) GO TO 5
IF (OFF(1) .EQ. COFF(1,IC) .AND. OFF(2) .EQ. COFF(2,IC) .AND.
& OFF(3) .EQ. COFF(3,IC)) RETURN
5 IF (IC .EQ. 1) CALL CMEYE(E)
IF (IC .EQ. 2) CALL LDEYE(E)
DO 10 I = 1, 3
E(I) = E(I) + OFF(I)
COFF(I,IC) = OFF(I)
10 CONTINUE
NCP(IC) = 0
NCPX(IC) = 0
IF (MDX2(K) .LT. MDX1(K)) GO TO 90
DO 80 J = MDX1(K), MDX2(K)
DO 20 I = 1, 3
A(I) = LXL(I,J) - E(I)
B(I) = LXL(I + 3,J) - E(I)
20 CONTINUE
CALL OCCUT(A, B, E, K, OCTA, OCTB, NP)
C The pieces between the hidden runs, but none under 1 mm.
DO 25 I = 1, 3
B(I) = B(I) - A(I)
25 CONTINUE
D = VNRM(B)
T0 = 0.0D0
DO 60 L = 1, NP + 1
T1 = 1.0D0
IF (L .LE. NP) T1 = OCTA(L)
IF ((T1 - T0) * D .LE. 1.0D-3) GO TO 50
IF (NCP(IC) .LT. MCP) GO TO 30
NCPX(IC) = NCPX(IC) + 1
GO TO 50
30 NCP(IC) = NCP(IC) + 1
DO 40 I = 1, 3
CPL(I,NCP(IC),IC) = LXL(I,J)
& + T0 * (LXL(I + 3,J) - LXL(I,J))
CPL(I + 3,NCP(IC),IC) = LXL(I,J)
& + T1 * (LXL(I + 3,J) - LXL(I,J))
IF (T1 .GE. 1.0D0) CPL(I + 3,NCP(IC),IC) = LXL(I + 3,J)
40 CONTINUE
50 IF (L .LE. NP) T0 = OCTB(L)
60 CONTINUE
80 CONTINUE
90 KCOK(IC) = 1
C RESTOMOD END
RETURN
END
C
C-----------------------------------------------------------------------
C OCCUT: the parts of segment A-B (body metres, relative to the
C eye E) that model K's opaque triangles hide: NP intervals TA(L)
C .. TB(L) of T along A + T (B - A), in order, overlaps merged.
C For each triangle four planes, as WMCUT's: three through the
C eye and an edge, facing in, and the triangle's own, facing away
C from the eye, 0.1 mm past it, so nothing on it is hidden by it.
C The edges' planes are let out by 1.0D-9 m so that two triangles
C of one face leave no gap along the edge they share.
C-----------------------------------------------------------------------
SUBROUTINE OCCUT(A, B, E, K, TA, TB, NP)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION A(3), B(3), E(3), TA(MOC), TB(MOC)
INTEGER K, NP
DOUBLE PRECISION V(3,3), U(3), W(3), C(3), PN(3,4), PD(4)
DOUBLE PRECISION S, T0, T1, T, FA, FB, VNRM, VDOT
INTEGER J, I, L, M, IV
C RESTOMOD BEGIN: the cabins' hidden lines are ours (see CBCUT);
C and Cyrus-Beck clipping, published 1978
NP = 0
DO 50 J = 1, NOC
IF (OCMOD(J) .NE. K) GO TO 50
DO 5 IV = 1, 3
DO 4 I = 1, 3
V(I,IV) = OCV(I,IV,J) - E(I)
4 CONTINUE
5 CONTINUE
C The triangle's plane, facing away from the eye; none when the
C eye is in it (the triangle is seen edge on).
DO 8 I = 1, 3
U(I) = V(I,2) - V(I,1)
W(I) = V(I,3) - V(I,1)
C(I) = V(I,1) + V(I,2) + V(I,3)
8 CONTINUE
CALL VCRS(U, W, PN(1,4))
S = VNRM(PN(1,4))
IF (S .LE. 1.0D-12) GO TO 50
PD(4) = VDOT(PN(1,4), V(1,1)) / S
IF (DABS(PD(4)) .LE. 1.0D-6) GO TO 50
IF (PD(4) .LT. 0.0D0) S = -S
DO 10 I = 1, 3
PN(I,4) = PN(I,4) / S
10 CONTINUE
PD(4) = DABS(PD(4)) + 1.0D-4
C The edges' planes, facing in.
DO 20 M = 1, 3
L = MOD(M, 3) + 1
CALL VCRS(V(1,M), V(1,L), PN(1,M))
S = VNRM(PN(1,M))
IF (S .LE. 1.0D-12) GO TO 50
IF (VDOT(PN(1,M), C) .LT. 0.0D0) S = -S
DO 15 I = 1, 3
PN(I,M) = PN(I,M) / S
15 CONTINUE
PD(M) = -1.0D-9
20 CONTINUE
T0 = 0.0D0
T1 = 1.0D0
DO 30 M = 1, 4
FA = VDOT(PN(1,M), A) - PD(M)
FB = VDOT(PN(1,M), B) - PD(M)
IF (FA .GE. 0.0D0 .AND. FB .GE. 0.0D0) GO TO 30
IF (FA .LT. 0.0D0 .AND. FB .LT. 0.0D0) GO TO 50
T = FA / (FA - FB)
IF (FA .LT. 0.0D0 .AND. T .GT. T0) T0 = T
IF (FB .LT. 0.0D0 .AND. T .LT. T1) T1 = T
IF (T0 .GE. T1) GO TO 50
30 CONTINUE
C Into the list, kept in order of TA.
NP = NP + 1
I = NP
40 IF (I .EQ. 1) GO TO 45
IF (TA(I-1) .LE. T0) GO TO 45
TA(I) = TA(I-1)
TB(I) = TB(I-1)
I = I - 1
GO TO 40
45 TA(I) = T0
TB(I) = T1
50 CONTINUE
IF (NP .EQ. 0) RETURN
M = 0
DO 60 I = 1, NP
IF (M .EQ. 0) GO TO 55
IF (TA(I) .GT. TB(M)) GO TO 55
IF (TB(I) .GT. TB(M)) TB(M) = TB(I)
GO TO 60
55 M = M + 1
TA(M) = TA(I)
TB(M) = TB(I)
60 CONTINUE
NP = M
C RESTOMOD END
RETURN
END
src/vmath.f
C=======================================================================
C
C V I E W - 1 1 0 8 VECTOR AND MATRIX
C
C Core element. 3-vector and 3x3 utilities. One relocatable
C element of the kernel; see vdrive.f for the list.
C
C=======================================================================
C
SUBROUTINE SETV(V, A, B, C)
DOUBLE PRECISION V(3), A, B, C
V(1) = A
V(2) = B
V(3) = C
RETURN
END
C
C=======================================================================
C VECTOR AND MATRIX UTILITIES
C=======================================================================
DOUBLE PRECISION FUNCTION VDOT(A, B)
DOUBLE PRECISION A(3), B(3)
VDOT = A(1) * B(1) + A(2) * B(2) + A(3) * B(3)
RETURN
END
C
DOUBLE PRECISION FUNCTION VNRM(A)
DOUBLE PRECISION A(3)
VNRM = DSQRT(A(1) * A(1) + A(2) * A(2) + A(3) * A(3))
RETURN
END
C
SUBROUTINE VCRS(A, B, C)
DOUBLE PRECISION A(3), B(3), C(3)
C(1) = A(2) * B(3) - A(3) * B(2)
C(2) = A(3) * B(1) - A(1) * B(3)
C(3) = A(1) * B(2) - A(2) * B(1)
RETURN
END
C
C VORTH: B, a unit vector, made square to the unit vector A and
C unit again (Gram-Schmidt); a B along A gives a perpendicular. A
C B already square to A within rounding (1.0D-12) is left as it
C is, so a frame that was orthonormal stays bit for bit (ours).
SUBROUTINE VORTH(A, B)
DOUBLE PRECISION A(3), B(3), K, P(3), VDOT
INTEGER I
K = VDOT(A, B)
IF (DABS(K) .LE. 1.0D-12) RETURN
DO 10 I = 1, 3
B(I) = B(I) - K * A(I)
10 CONTINUE
IF (VDOT(B, B) .LT. 1.0D-24) CALL PERP(A, B, P)
CALL VUNIT(B)
RETURN
END
C
SUBROUTINE VUNIT(A)
DOUBLE PRECISION A(3), S
S = DSQRT(A(1) * A(1) + A(2) * A(2) + A(3) * A(3))
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (S .GT. 0.0D0) THEN
A(1) = A(1) / S
A(2) = A(2) / S
A(3) = A(3) / S
END IF
C RESTOMOD END
RETURN
END
C
C MXV: B = M A. MTXV: B = transpose(M) A. MXM: C = A B.
SUBROUTINE MXV(M, A, B)
DOUBLE PRECISION M(3,3), A(3), B(3)
INTEGER I
DO 10 I = 1, 3
B(I) = M(I,1) * A(1) + M(I,2) * A(2) + M(I,3) * A(3)
10 CONTINUE
RETURN
END
C
SUBROUTINE MTXV(M, A, B)
DOUBLE PRECISION M(3,3), A(3), B(3)
INTEGER I
DO 10 I = 1, 3
B(I) = M(1,I) * A(1) + M(2,I) * A(2) + M(3,I) * A(3)
10 CONTINUE
RETURN
END
C
SUBROUTINE MXM(A, B, C)
DOUBLE PRECISION A(3,3), B(3,3), C(3,3)
INTEGER I, J
DO 20 J = 1, 3
DO 10 I = 1, 3
C(I,J) = A(I,1) * B(1,J) + A(I,2) * B(2,J) + A(I,3) * B(3,J)
10 CONTINUE
20 CONTINUE
RETURN
END
C
C Active rotations by angle A (rad) about X, Y, Z.
SUBROUTINE ROTX(A, M)
DOUBLE PRECISION A, M(3,3)
CALL MUNIT(M)
M(2,2) = DCOS(A)
M(2,3) = -DSIN(A)
M(3,2) = DSIN(A)
M(3,3) = DCOS(A)
RETURN
END
C
SUBROUTINE ROTY(A, M)
DOUBLE PRECISION A, M(3,3)
CALL MUNIT(M)
M(1,1) = DCOS(A)
M(1,3) = DSIN(A)
M(3,1) = -DSIN(A)
M(3,3) = DCOS(A)
RETURN
END
C
SUBROUTINE ROTZ(A, M)
DOUBLE PRECISION A, M(3,3)
CALL MUNIT(M)
M(1,1) = DCOS(A)
M(1,2) = -DSIN(A)
M(2,1) = DSIN(A)
M(2,2) = DCOS(A)
RETURN
END
C
SUBROUTINE MUNIT(M)
DOUBLE PRECISION M(3,3)
INTEGER I, J
DO 20 J = 1, 3
DO 10 I = 1, 3
M(I,J) = 0.0D0
10 CONTINUE
M(J,J) = 1.0D0
20 CONTINUE
RETURN
END
C
C PERP: unit vectors E1, E2 completing unit A to a right-handed set.
SUBROUTINE PERP(A, E1, E2)
DOUBLE PRECISION A(3), E1(3), E2(3), Z(3)
Z(1) = 0.0D0
Z(2) = 0.0D0
Z(3) = 1.0D0
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (DABS(A(3)) .GT. 0.9D0) THEN
Z(1) = 1.0D0
Z(3) = 0.0D0
END IF
C RESTOMOD END
CALL VCRS(Z, A, E1)
CALL VUNIT(E1)
CALL VCRS(A, E1, E2)
RETURN
END
src/vsrc.f
C=======================================================================
C
C V I E W - 1 1 0 8 STATE SOURCE
C
C The one place the display side gets the CSM's, the LM's and
C the S-IVB's states. It reads
C the replay (the scenario's legs, traj.f) or, when the frame asks
C for it (in_src, which the chassis passes as in_flags bit 3) and
C the tape covers the time, the tape the engine wrote (tape.f,
C sim.f) or the deck held (vdktap.f). Scene cameras and layers do
C not know which. One relocatable element of the kernel; see
C vdrive.f for the list.
C
C=======================================================================
C
C VSTATE: vehicle IVEH (1 the CSM, 2 the LM, 3 the S-IVB) at GET,
C about the Earth (IBODY = 1, geocentric EQ) or the Moon (IBODY =
C 2, selenocentric EQ), km and km/s. IOK = 0 if there is no state
C for it (the LM outside LMSTAT's rules, the S-IVB outside SIVST's,
C traj.f), 1 if there is, 2 for the LM docked to the CSM (the
C CSM's state) or the S-IVB with the CSM (SIVST). The CSM always
C has one.
C The CSM's from CSMST.
SUBROUTINE VSTATE(GET, IVEH, IBODY, R, V, IOK)
DOUBLE PRECISION GET, R(3), V(3), PM(3), VM(3)
INTEGER IVEH, IBODY, IOK, I
IOK = 1
IF (IVEH .EQ. 2) GO TO 30
IF (IVEH .EQ. 3) GO TO 50
CALL CSMST(GET, IBODY, R, V)
RETURN
C The LM: relative to the Moon (LMSTAT), then geocentric if asked.
30 CALL LMSTAT(GET, R, V, IOK)
IF (IOK .EQ. 0 .OR. IBODY .EQ. 2) RETURN
CALL MOONV(GET, PM, VM)
DO 40 I = 1, 3
R(I) = R(I) + PM(I)
V(I) = V(I) + VM(I)
40 CONTINUE
RETURN
C The S-IVB: geocentric (SIVST), then relative to the Moon if asked.
50 CALL SIVST(GET, R, V, IOK)
IF (IOK .EQ. 0 .OR. IBODY .EQ. 1) RETURN
CALL MOONV(GET, PM, VM)
DO 60 I = 1, 3
R(I) = R(I) - PM(I)
V(I) = V(I) - VM(I)
60 CONTINUE
RETURN
END
C
C CSMST: the CSM at GET about the Earth (IBODY = 1) or the Moon
C (IBODY = 2), as VSTATE. ISRCU records the source used: 0
C replay, 1 sim with state vector updates, 2 sim without, 3 a tape
C read from the deck (vdktap.f). The LM's
C own legs are read from the replay only (the tape carries the
C CSM). From the scenario's entry interface (its EI event, TETP)
C on, the CSM is the replay's too: the engine flies in a vacuum,
C the entry leg (a TABLE, traj.f) through the atmosphere (ours).
C The LM's and the S-IVB's rules (LMSTAT, SIVST) call this, not
C VSTATE, which calls them: FORTRAN V has no recursion.
SUBROUTINE CSMST(GET, IBODY, R, V)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, R(3), V(3), PM(3), VM(3)
INTEGER IBODY, I, ITP
ISRCU = 0
IF (ISRC .NE. 1 .OR. ITPSN .NE. ISN) GO TO 20
IF (TETP .GE. 0.0D0 .AND. GET .GT. TETP) GO TO 20
CALL TPGET(1, GET, R, V, ITP)
IF (ITP .EQ. 0) GO TO 20
ISRCU = 2 - MOD(ISIMF, 2)
IF (ISIMF .LT. 0) ISRCU = 3
IF (IBODY .EQ. 1) RETURN
CALL MOONV(GET, PM, VM)
DO 10 I = 1, 3
R(I) = R(I) - PM(I)
V(I) = V(I) - VM(I)
10 CONTINUE
RETURN
20 IF (IBODY .EQ. 1) CALL ERTORB(GET, R, V)
IF (IBODY .EQ. 2) CALL LUNORB(GET, 1, R, V)
RETURN
END
C
C CSMSL: the CSM relative to the Moon (EQ km, km/s) on whichever leg
C holds GET: a lunar one (LUNIN), else from its state about the
C Earth less the Moon's (CSMST about the Moon alone would take the
C nearest lunar leg). For the LM's CSM-relative states and ranges.
SUBROUTINE CSMSL(GET, R, V)
DOUBLE PRECISION GET, R(3), V(3), PM(3), VM(3)
INTEGER I, LUNIN
IF (LUNIN(GET) .EQ. 0) GO TO 10
CALL CSMST(GET, 2, R, V)
RETURN
10 CALL CSMST(GET, 1, R, V)
CALL MOONV(GET, PM, VM)
DO 20 I = 1, 3
R(I) = R(I) - PM(I)
V(I) = V(I) - VM(I)
20 CONTINUE
RETURN
END
C
C SIMERR: for the header, the reference row nearest GET that the
C last engine run passed: its g.e.t. and the position (km) and
C velocity (ft/s) error there. JN = 0 if there is none.
SUBROUTINE SIMERR(GET, JN, TR, EP, EV)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, TR, EP, EV, D, DB
INTEGER JN, J
JN = 0
TR = 0.0D0
EP = 0.0D0
EV = 0.0D0
IF (ITPSN .NE. ISN) RETURN
DB = 1.0D30
DO 10 J = 1, NRF
IF (RFOK(J) .EQ. 0) GO TO 10
D = DABS(RFP(3,J) - GET)
IF (D .GE. DB) GO TO 10
DB = D
JN = J
10 CONTINUE
IF (JN .EQ. 0) RETURN
TR = RFP(3,JN)
EP = RFERR(1,JN)
EV = RFERR(2,JN)
RETURN
END
src/vtext.f
C=======================================================================
C
C V I E W - 1 1 0 8 TEXT
C
C Core element. Records for the recorder's character
C generator. One relocatable element of
C the kernel; see vdrive.f for the list.
C
C=======================================================================
C
C=======================================================================
C TEXT. Records for the recorder's character generator (the SC-4020
C class had a "type character" order; docs/univac-1108.md): X, Y
C of the first character's lower left (plot deg), height (plot
C deg), start index in TC; each string is character codes ending
C in 0. Tick numbers when IFLG bit 1 is set, at the ticks DFRAME
C draws, OUTSIDE the box: left edge right-aligned, right edge,
C bottom edge centred below, 1.0 percent of the field high (read
C from the film, descent_t29.png, and the report's plot pages).
C Names of nav stars, Sun, Earth and Moon beside their labels when
C bit 0 is set, 1.4 percent of the field high, by the label level
C (ILEV): primary Sun, Earth, Moon, the landing site, vehicles and
C the pad; secondary also nav stars and maria; all, everything.
C The labels (LB) themselves are not filtered. Also vehicles (LB
C kind 8: CM, SM, LM, S-IVB, CSM by id) and the launch pad (kind 9,
C its name from the PAD card), both modern additions. Crater
C names stay with the page (LB kind 2). With a label level set
C (in_lablv 1-3), the burn cue's text (IBRTX, lburn.f; ours) in
C the box's top left corner, at the names' height. Character
C width 0.7 of the height, used for alignment: ours.
C=======================================================================
SUBROUTINE TXALL(LB, NL, TB, NT, TC, NCH)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION LB(4,MAXL), TB(4,MAXT)
INTEGER NL, NT, TC(MAXTC), NCH
DOUBLE PRECISION B, ST, TL, H, V, R
INTEGER I, J, K, N, ID, IC(24), VEHCH(25), ENGCH(20), SLACH(38)
C Vehicle names, 5 codes each, zero padded: CM, SM, LM, S-IVB, CSM.
DATA VEHCH / 67, 77, 0, 0, 0, 83, 77, 0, 0, 0, 76, 77, 0, 0, 0,
& 83, 45, 73, 86, 66, 67, 83, 77, 0, 0 /
C Engine names, 5 codes each, zero padded: SPS, DPS, APS, S-IVB.
DATA ENGCH / 83, 80, 83, 0, 0, 68, 80, 83, 0, 0, 65, 80, 83, 0,
& 0, 83, 45, 73, 86, 66 /
C The SLA caption, 20 and 18 codes: LM IN THE CLOSED SLA,
C OCCLUDED UNTIL SEP.
DATA SLACH / 76, 77, 32, 73, 78, 32, 84, 72, 69, 32, 67, 76, 79,
& 83, 69, 68, 32, 83, 76, 65, 79, 67, 67, 76, 85, 68,
& 69, 68, 32, 85, 78, 84, 73, 76, 32, 83, 69, 80 /
NT = 0
NCH = 0
B = BOXH
H = 0.02D0 * B
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (MOD(IFLG / 2, 2) .EQ. 1) THEN
ST = 20.0D0
IF (2.0D0 * B .LE. 60.0D0) ST = 10.0D0
IF (2.0D0 * B .LE. 25.0D0) ST = 5.0D0
TL = 0.02D0 * B
N = INT(B / ST + 1.0D-9)
DO 10 K = -N, N
V = DBLE(K) * ST
IF (DABS(V) .GE. B - 1.0D-9) GO TO 10
CALL ITOC(NINT(V), IC, J)
CALL TXPUT(TB, NT, TC, NCH, V - 0.35D0 * H * DBLE(J),
& -B - 1.5D0 * H, H, IC, J)
CALL TXPUT(TB, NT, TC, NCH, -B - 0.5D0 * H
& - 0.7D0 * H * DBLE(J), V - 0.5D0 * H, H, IC, J)
CALL TXPUT(TB, NT, TC, NCH, B + 0.5D0 * H,
& V - 0.5D0 * H, H, IC, J)
10 CONTINUE
END IF
C RESTOMOD END
H = 0.028D0 * B
C The burn cue's text: the engine's name and BURN.
IF (ILABL .LT. 1 .OR. IBRTX .LT. 1 .OR. IBRTX .GT. 4) GO TO 38
N = 0
DO 36 J = 1, 5
IF (ENGCH((IBRTX - 1) * 5 + J) .EQ. 0) GO TO 37
N = N + 1
IC(N) = ENGCH((IBRTX - 1) * 5 + J)
36 CONTINUE
37 IC(N + 1) = 32
IC(N + 2) = 66
IC(N + 3) = 85
IC(N + 4) = 82
IC(N + 5) = 78
CALL TXPUT(TB, NT, TC, NCH, -0.97D0 * B, 0.97D0 * B - H, H,
& IC, N + 5)
C The LM station in the closed SLA (ISLA, STATLM): why its window
C shows nothing, in the box's top left corner at every label level
C (ours, #70 option C): LM IN THE CLOSED SLA, OCCLUDED UNTIL SEP.
38 IF (ISLA .EQ. 0) GO TO 39
DO 381 J = 1, 20
IC(J) = SLACH(J)
381 CONTINUE
CALL TXPUT(TB, NT, TC, NCH, -0.97D0 * B, 0.97D0 * B - H, H,
& IC, 20)
DO 382 J = 1, 18
IC(J) = SLACH(20 + J)
382 CONTINUE
CALL TXPUT(TB, NT, TC, NCH, -0.97D0 * B, 0.97D0 * B - 2.6D0 * H,
& H, IC, 18)
39 IF (MOD(IFLG, 2) .EQ. 0) RETURN
DO 40 I = 1, NL
K = NINT(LB(3,I))
ID = NINT(LB(4,I))
N = 0
IF ((K .EQ. 1 .OR. K .EQ. 6) .AND. ILEV .LT. 2) GO TO 40
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (K .EQ. 1 .AND. ID .GE. 1 .AND. ID .LE. NNAV) THEN
DO 20 J = 1, 10
IF (NAVCH((ID - 1) * 10 + J) .EQ. 0) GO TO 30
N = N + 1
IC(N) = NAVCH((ID - 1) * 10 + J)
20 CONTINUE
ELSE IF (K .GE. 3 .AND. K .LE. 5) THEN
DO 25 J = 1, 5
IF (BODCH((K - 3) * 5 + J) .EQ. 0) GO TO 30
N = N + 1
IC(N) = BODCH((K - 3) * 5 + J)
25 CONTINUE
ELSE IF (K .EQ. 6 .AND. ID .GE. 1 .AND. ID .LE. NMARE) THEN
C Mare names centred on the mare's centre.
DO 26 J = 1, 24
IF (MRCH((ID - 1) * 24 + J) .EQ. 0) GO TO 27
N = N + 1
IC(N) = MRCH((ID - 1) * 24 + J)
26 CONTINUE
27 IF (N .GT. 0) CALL TXPUT(TB, NT, TC, NCH,
& LB(1,I) - 0.35D0 * H * DBLE(N), LB(2,I) - 0.5D0 * H,
& H, IC, N)
GO TO 40
ELSE IF (K .EQ. 7) THEN
DO 28 J = 1, 22
N = N + 1
IC(N) = SITECH(J)
28 CONTINUE
ELSE IF (K .EQ. 8 .AND. ID .GE. 1 .AND. ID .LE. 5) THEN
DO 29 J = 1, 5
IF (VEHCH((ID - 1) * 5 + J) .EQ. 0) GO TO 30
N = N + 1
IC(N) = VEHCH((ID - 1) * 5 + J)
29 CONTINUE
ELSE IF (K .EQ. 9) THEN
DO 32 J = 1, 8
IF (PADCH(8 * (ISN - 1) + J) .EQ. 0) GO TO 30
N = N + 1
IC(N) = PADCH(8 * (ISN - 1) + J)
32 CONTINUE
END IF
C RESTOMOD END
30 IF (N .EQ. 0) GO TO 40
C The Sun's name centred under its ring of rays (DSUN), as MSC IN
C 69-FM-197 letters it (PDF pp. 89, 137).
IF (K .NE. 3) GO TO 35
R = DMAX1(0.059D0 * B, 0.267D0 + 0.035D0 * B)
CALL TXPUT(TB, NT, TC, NCH, LB(1,I) - 0.35D0 * H * DBLE(N),
& LB(2,I) - R - 1.3D0 * H, H, IC, N)
GO TO 40
35 CALL TXPUT(TB, NT, TC, NCH, LB(1,I) + 0.4D0 * H,
& LB(2,I) + 0.4D0 * H, H, IC, N)
40 CONTINUE
RETURN
END
C
C TXPUT: append a text record of N codes IC.
SUBROUTINE TXPUT(TB, NT, TC, NCH, X, Y, H, IC, N)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION TB(4,MAXT), X, Y, H
INTEGER NT, TC(MAXTC), NCH, IC(24), N, K
IF (NT .GE. MAXT .OR. NCH + N + 1 .GT. MAXTC) RETURN
NT = NT + 1
TB(1,NT) = X
TB(2,NT) = Y
TB(3,NT) = H
TB(4,NT) = DBLE(NCH + 1)
DO 10 K = 1, N
TC(NCH + K) = IC(K)
10 CONTINUE
NCH = NCH + N + 1
TC(NCH) = 0
RETURN
END
C
C ITOC: integer IV to character codes IC(1..N), ASCII digits.
SUBROUTINE ITOC(IV, IC, N)
INTEGER IV, IC(24), N, M, K, D(10), ND
M = IABS(IV)
ND = 0
10 ND = ND + 1
D(ND) = MOD(M, 10)
M = M / 10
IF (M .GT. 0 .AND. ND .LT. 10) GO TO 10
N = 0
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IV .LT. 0) THEN
N = 1
IC(1) = 45
END IF
C RESTOMOD END
DO 20 K = ND, 1, -1
N = N + 1
IC(N) = 48 + D(K)
20 CONTINUE
RETURN
END
src/vview.f
C=======================================================================
C
C V I E W - 1 1 0 8 CAMERA POINTING
C
C Core element. The camera target and the external view, applied
C after the scene has set its own camera (SCNCAM) and placed its
C models (SCNMOD). One relocatable element of the kernel; see
C vdrive.f for the list.
C
C TN D-6853 (printed p. 13) offers "an inertially fixed platform
C or a local-vertical platform". Pointing at a target and flying
C the camera around one are a third and fourth mode: ours.
C Window view (in_view 0) with a target: the reference boresight
C points from the scene's camera at the target; free-look
C yaw, pitch and roll are offsets from it. A target with no
C point of its own here (the camera's own vehicle, one docked
C to it or carried with it, one with no state) leaves the
C scene's aim; hdr 23 says which (TGTPOS), for the page. With
C no target, a situation with an off-leg fallback aims at its
C off-leg target on the coasts (ECOAST; ours, #65).
C Stations (in_view 2, 3): the camera at the CM or LM eye, the
C cabin around it (STATCM, STATLM), its interior with in_flags
C bit 4 (CMINT, LMINT; the LM descent too, LDCAB).
C External view (in_view 1): the camera sits D from the target
C and looks at it; yaw and pitch carry it around the target
C (starting from the side the scene's own camera is on), roll
C turns the picture, the field of view zooms. D is ours: 60 m
C for the CSM, the docked stack or the S-IVB, 40 m for the
C LM, 60,000 km for the Earth, 36,737 km (35,000 km up, as
C scene 6) for the Moon. The Sun is a target only for the
C window view. A docked or carried vehicle is flown round at
C the point of the vehicle it is with, but before the
C separation the S-IVB at its centre and the LM at its place in
C the SLA, in the launch stack drawn behind the CSM (LVPL); a
C target with no point gives way to the situation's subject,
C else the Earth.
C A situation with FIXED=YES (the Moon view's body-centred camera)
C keeps its own camera and ignores both.
C=======================================================================
C
C-----------------------------------------------------------------------
C VIEWPT: apply the view and target to the camera: CG (geocentric,
C km) may move (and with it, in the LM station at the LM's own
C state, CV, relative to the reference body IREF), BREF, UREF, RREF
C may turn, and placed models are carried along. LOOKD = 1 if
C the camera axes are already set (external view), so VFRAME skips
C its free-look step. ITGST, the
C target's status (hdr 23; see TGTPOS), is taken before anything
C is placed for the external view.
C-----------------------------------------------------------------------
SUBROUTINE VIEWPT(GET, PM, CG, CV, IREF, YAW, PIT, ROL, LOOKD)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), CV(3), YAW, PIT, ROL
INTEGER LOOKD, IREF
DOUBLE PRECISION TG(3), D(3), DIST, DS(3), CG0(3), P(3), VDOT
DOUBLE PRECISION C, AX(3,3), OFF(3)
INTEGER IT, IST, IOK, I, J, KCSPL, ECOAST, NZ
LOOKD = 0
ITGST = 0
ISLA = 0
IVUSE = IVIEW
C The situation's own view where in_view is 0 (JVW; the docked
C stack's is the external one).
IF (IVUSE .EQ. 0) IVUSE = JVW
C A crew-station recipe is that station already; asked for as
C one, it gets the cabin (the LM's: JVEH 2, in_view 3).
IF (JRCP .EQ. 3 .AND. IVUSE .EQ. JVEH + 1) CALL LDCAB(GET, CG)
IF (JRCP .EQ. 3 .AND. IVUSE .EQ. JVEH + 1) IVUSE = 0
IF (JFIX .EQ. 1) IVUSE = 0
IT = ITARG
IF (JFIX .EQ. 1) RETURN
C Stations: the camera moves to the eye, the cabin goes around it.
C Where the scene has no such vehicle, the window view.
IF (IVUSE .EQ. 2) CALL STATCM(CG, IOK)
IF (IVUSE .EQ. 2 .AND. IOK .EQ. 0) IVUSE = 0
IF (IVUSE .EQ. 3) CALL STATLM(GET, PM, CG, CV, IREF, IOK)
IF (IVUSE .EQ. 3 .AND. IOK .EQ. 0) IVUSE = 0
C The LM station keeps its window's own aim (its overlay is drawn in
C the reference frame, OVLPD).
IF (IVUSE .EQ. 3) RETURN
C The window view with no target asked, where the recipe's off-leg
C fallback applies on a coast (ECOAST: no LUNAR leg holds the GET
C and the CSM's Earth leg there is a CONIC), aims at the situation's
C off-leg target (JTGF; Apollo 8's VIEWS card, the Earth) instead of
C the forward view above the horizon, whose 8 deg climb showed
C little but stars there (#65; ours, since no Apollo 8 view
C survives, TN D-6853 printed p. 3). The field stays the viewer's.
C hdr 23 stays 0: no target was asked.
IF (IVUSE .NE. 0 .OR. IT .NE. 0 .OR. JFAL .NE. 1) GO TO 3
IF (ECOAST(GET) .EQ. 0) GO TO 3
CALL TGTPOS(GET, JTGF, PM, CG, TG, DIST, IST)
IF (IST .EQ. 1) GO TO 8
3 IF (IVUSE .NE. 1 .AND. IT .EQ. 0) RETURN
IF (IT .NE. 0) CALL TGTPOS(GET, IT, PM, CG, TG, DIST, ITGST)
IF (IVUSE .EQ. 1) GO TO 5
C A window or the CM station aims only at a point of the target's
C own: not its own vehicle, nor one docked to it or carried with
C it, nor one with no state.
IF (ITGST .NE. 1) RETURN
GO TO 8
C External: a target with no point to fly round (no state, the
C Sun) gives way to the situation's subject, and that, where it
C has none either, to the Earth (ours), so the camera always
C leaves the eye before the CSM is placed around it.
5 IF (IT .EQ. 0 .OR. ITGST .EQ. 4) CALL TGTDEF(GET, IT)
CALL TGTPOS(GET, IT, PM, CG, TG, DIST, IST)
IF (IST .EQ. 4) IT = 1
C Seen from outside, a camera riding the CSM in its own view (JRID
C 1: situations 1, 2, 3, 4, 7, 9) shows the CSM: its origin
C (CSMBLD) 1.2 m behind the eye along the reference boresight, its
C X axis along that boresight (ours), or on the pad and rising from
C it (ASCPL); after CM/SM separation the CM alone. The target's
C point is then taken again: the CSM's is the top of the tunnel of
C the CSM placed here.
IF (KCSPL() .EQ. 0 .AND. JRID .EQ. 1) CALL CSMCAM(GET, CG)
CALL TGTPOS(GET, IT, PM, CG, TG, DIST, IST)
8 DO 10 I = 1, 3
CG0(I) = CG(I)
D(I) = TG(I) - CG(I)
10 CONTINUE
C Reference boresight at the target, up kept as near the scene's
C as it can be. A target at the camera's own point (a vehicle
C docked to it or carried with it, seen from outside) keeps the
C scene's boresight, which every recipe makes unit (SCNCAM; #80).
IF (VDOT(D, D) .LE. 1.0D-18) GO TO 22
C On the pad and in the ascent (the launch complex placed, PADPL)
C the target is in the stack the camera rides, a few tens of metres
C up or down it, which says nothing of where to look from: the
C scene's own boresight is kept (ours, #97).
IF (MDON(KPAD) .EQ. 1) GO TO 22
CALL VUNIT(D)
DO 20 I = 1, 3
BREF(I) = D(I)
20 CONTINUE
22 CONTINUE
C = VDOT(UREF, BREF)
DO 25 I = 1, 3
UREF(I) = UREF(I) - C * BREF(I)
25 CONTINUE
IF (VDOT(UREF, UREF) .LT. 1.0D-12) CALL PERP(BREF, UREF, P)
CALL VUNIT(UREF)
CALL VCRS(BREF, UREF, RREF)
CALL VUNIT(RREF)
IF (IVUSE .NE. 1) RETURN
C RESTOMOD BEGIN: the moved eye is ours (veye.f; #72): the point
C flown round leaves the target by the eye offset, along the
C reference axes at the target, in units of the distance
DO 26 I = 1, 3
AX(I,1) = RREF(I)
AX(I,2) = UREF(I)
AX(I,3) = BREF(I)
26 CONTINUE
CALL EYUSE(1, AX, OFF, NZ)
IF (NZ .EQ. 0) GO TO 28
DO 27 I = 1, 3
TG(I) = TG(I) + DIST * (OFF(1) * RREF(I) + OFF(2) * UREF(I)
& + OFF(3) * BREF(I))
27 CONTINUE
28 CONTINUE
C RESTOMOD END
C
C External: free-look sets the direction, the camera backs off
C along it to DIST from the target. A situation with XSTART (JXOF;
C the docking, whose reference looks down the docking axis, where
C the CSM's solids hide the LM it docks with) starts QXY round:
C there 60 deg round and 25 deg up (ours). A vehicle target
C picked (in_target 4-6, where it is flown round) starts 60 deg
C round and 25 deg down, the camera above the vehicle looking down
C on it, before the separation as after it, so the camera does not
C jump at SEP
C (#70; ours): before it the launch stack is placed behind the CSM
C (LVPL), and from straight behind or ahead one end of the stack
C hides the rest. While the stack is placed the situation's own
C vehicle target (in_target 0) starts there too; after SEP it
C keeps the scene's own start (the docked stack's, scene 8).
J = 0
IF (JXOF .NE. 1 .AND. MDON(KSTK) .EQ. 1 .AND. IT .GE. 4) J = 1
IF (JXOF .NE. 1 .AND. ITARG .GE. 4 .AND. IT .GE. 4) J = 1
IF (JXOF .EQ. 1) CALL LOOK(YAW + QXY(1), PIT + QXY(2), ROL)
IF (J .EQ. 1) CALL LOOK(YAW + 60.0D0, PIT - 25.0D0, ROL)
IF (JXOF .NE. 1 .AND. J .EQ. 0) CALL LOOK(YAW, PIT, ROL)
LOOKD = 1
DO 30 I = 1, 3
CG(I) = TG(I) - DIST * CB(I)
DS(I) = CG0(I) - CG(I)
30 CONTINUE
C Carry the placed models, shifted by DS.
CALL MSHIFT(DS, 0)
RETURN
END
C
C TGTDEF: the situation's default external target at GET (its
C VIEWS card): JTGT, or JTGF where the recipe's off-leg fallback
C applies (no LUNAR leg holds the GET, LUNIN).
SUBROUTINE TGTDEF(GET, IT)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET
INTEGER IT, LUNIN
IT = JTGT
IF (JFAL .EQ. 1 .AND. LUNIN(GET) .EQ. 0) IT = JTGF
RETURN
END
C
C ECOAST: 1 if GET is on a coast about the Earth: no LUNAR leg
C holds it (LUNIN) and the CSM's Earth leg holding it (LEGAT) is a
C CONIC (the translunar and transearth coasts), not the parking
C orbit's CIRC nor the ascent's or the entry's TABLE; else 0.
INTEGER FUNCTION ECOAST(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET
INTEGER K, LEGAT, LUNIN
ECOAST = 0
IF (LUNIN(GET) .NE. 0) RETURN
K = LEGAT(GET, 1, 1)
IF (K .EQ. 0) RETURN
IF (LGTYP(K) .NE. KCONIC) RETURN
IF (GET .GE. LGP(1,K) .AND. GET .LE. LGP(2,K)) ECOAST = 1
RETURN
END
C
C-----------------------------------------------------------------------
C TGTPOS: target IT's geocentric position TG (km), the external
C view's distance DIST (km) and its status IST (hdr 23, ITGST):
C 1 a point of its own: a body, a placed model (the CSM, KCSPL;
C the LM, KLMPL; the S-IVB), or a vehicle's own state (VSTATE
C IOK 1);
C 2 the vehicle the camera rides (IRIDE), unplaced;
C 3 docked to or carried with another vehicle (VSTATE IOK 2: the
C LM docked, the S-IVB with the CSM before SEP or docked to the
C stack), TG that vehicle's point; in a window view also a
C point at the camera itself;
C 4 no point here: no state, or the Sun from outside;
C 5 as 3, the LM before the separation (SEP): stowed in the SLA
C on the S-IVB, docked to nothing yet.
C The caller aims at 1, and from outside at 3 and 5 too. Before
C the separation the external view draws the launch stack behind
C the CSM (LVPL); once it is placed the S-IVB's point is its centre
C in it and the LM's its place in the closed SLA (still 3 and 5).
C-----------------------------------------------------------------------
SUBROUTINE TGTPOS(GET, IT, PM, CG, TG, DIST, IST)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), TG(3), DIST, R(3), V(3)
DOUBLE PRECISION D, C(3), W(3), EVGET
INTEGER IT, IST, I, IOK, KL, IRIDE, KC, KCSPL, KLMPL, IVEH
INTEGER KS, KSIVPL
IST = 1
DIST = 0.0D0
IVEH = 0
DO 5 I = 1, 3
TG(I) = 0.0D0
5 CONTINUE
C RESTOMOD BEGIN: block IF is FORTRAN 77 (1978)
IF (IT .EQ. 1) THEN
DIST = 60000.0D0
ELSE IF (IT .EQ. 2) THEN
DO 10 I = 1, 3
TG(I) = PM(I)
10 CONTINUE
DIST = RM + 35000.0D0
ELSE IF (IT .EQ. 3) THEN
DO 20 I = 1, 3
TG(I) = CG(I) + 1.495978707D8 * SUNU(I)
20 CONTINUE
IF (IVUSE .EQ. 1) IST = 4
ELSE IF (IT .EQ. 4) THEN
DIST = 0.060D0
KC = KCSPL()
IF (KC .NE. 0) THEN
C The placed CSM (or CM): aim at the top of its tunnel.
DO 30 I = 1, 3
TG(I) = CG(I) + MDP(I,KC) + 3.2D-3 * MDAT(I,1,KC)
30 CONTINUE
ELSE IF (IRIDE() .NE. 1) THEN
IVEH = 1
ELSE
IST = 2
END IF
ELSE IF (IT .EQ. 5) THEN
DIST = 0.040D0
KL = KLMPL()
IF (KL .NE. 0) THEN
DO 50 I = 1, 3
TG(I) = CG(I) + MDP(I,KL)
50 CONTINUE
ELSE IF (MDON(KSTK) .EQ. 1) THEN
C Stowed in the placed stack's SLA, hidden by it: its stage
C joint, the point of its state, the LM's base 1.5 m above the
C IU's top (S7POSE) plus the joint 2.3 m above the base
C (VEHPL's body point).
IST = 5
CALL SETV(C, (1.5D0 + 2.3D0 - MDBO(1,KSTK)) * 1.0D-3,
& -MDBO(2,KSTK) * 1.0D-3, -MDBO(3,KSTK) * 1.0D-3)
CALL MXV(MDAT(1,1,KSTK), C, W)
DO 52 I = 1, 3
TG(I) = CG(I) + MDP(I,KSTK) + W(I)
52 CONTINUE
ELSE IF (IRIDE() .NE. 2) THEN
IVEH = 2
ELSE
IST = 2
END IF
ELSE
DIST = 0.060D0
KS = KSIVPL()
IF (KS .NE. 0) THEN
C The placed S-IVB (alone, or the launch stack before the
C separation): aim at its centre, the point of its state
C (SIVST), half its 61.3 ft below the IU's top (SIVBMD). In
C the stack it is still carried with the CSM (3).
IF (KS .EQ. KSTK) IST = 3
CALL SETV(C, (-0.5D0 * (SIVBH + SIUH) * 0.3048D0
& - MDBO(1,KS)) * 1.0D-3, -MDBO(2,KS) * 1.0D-3,
& -MDBO(3,KS) * 1.0D-3)
CALL MXV(MDAT(1,1,KS), C, W)
DO 70 I = 1, 3
TG(I) = CG(I) + MDP(I,KS) + W(I)
70 CONTINUE
ELSE
IVEH = 3
END IF
END IF
C RESTOMOD END
C An unplaced vehicle: its state, its own (1), another's (3: the
C CSM's before SEP or docked; 5 the LM in the SLA), or none (4).
IF (IVEH .EQ. 0) GO TO 80
CALL VSTATE(GET, IVEH, 1, R, V, IOK)
IST = 4
IF (IOK .EQ. 1) IST = 1
IF (IOK .EQ. 2) IST = 3
IF (IVEH .EQ. 2 .AND. IST .EQ. 3 .AND. GET .LT. EVGET(KESEP))
& IST = 5
DO 75 I = 1, 3
TG(I) = R(I)
75 CONTINUE
80 IF (IST .NE. 1 .OR. IVUSE .EQ. 1) RETURN
C A window view cannot aim at its own camera.
D = 0.0D0
DO 60 I = 1, 3
D = D + (TG(I) - CG(I))**2
60 CONTINUE
IF (D .LT. 1.0D-10) IST = 3
RETURN
END
C
C IRIDE: the vehicle the camera rides this frame (after VIEWPT has
C set IVUSE): in the situation's own view JRID (1 the CSM in
C situations 1, 2, 3, 4, 7 and 9, 2 the LM in 5, 0 none in 6 and
C 8), 1 in the CM station, 2 in the LM station, 0 in the external
C views.
INTEGER FUNCTION IRIDE()
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
IRIDE = JRID
IF (IVUSE .EQ. 1) IRIDE = 0
IF (IVUSE .EQ. 2) IRIDE = 1
IF (IVUSE .EQ. 3) IRIDE = 2
RETURN
END
C
C CSMCAM: place the CSM around the scene's camera (geocentric CG),
C its origin (CSMBLD) 1.2 m behind the eye, X along the reference
C boresight, Z along its up (ours); but from the pad to the S-II/
C S-IVB separation where ASCPL puts it (#97): on the pad, then
C rising from it along its flight path. From CM/SM separation (the
C scenario's CMSEP event) the CM alone (KCMO). Before the
C separation (SEP) the launch vehicle's stages below it and the
C escape system above it (LVPL), and near the pad the launch
C complex (PADPL).
SUBROUTINE CSMCAM(GET, CG)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, CG(3), AT(3,3), P(3), Z(3), TS, EVGET
INTEGER I, K, IOK
K = KCSM
TS = EVGET(KECMS)
IF (TS .GE. 0.0D0 .AND. GET .GE. TS) K = KCMO
DO 10 I = 1, 3
AT(I,1) = BREF(I)
AT(I,3) = UREF(I)
P(I) = -1.2D-3 * BREF(I)
Z(I) = 0.0D0
10 CONTINUE
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
CALL ASCPL(GET, CG, AT, P, IOK)
CALL MPLACE(K, AT, P, Z)
C Before the separation the launch stack behind it (LVPL).
CALL LVPL(GET)
CALL PADPL(GET, CG)
RETURN
END
C
C MSHIFT: place every placed model again, shifted by DS (km); model
C KX (0 for none) is left out, as the one the camera is inside.
SUBROUTINE MSHIFT(DS, KX)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION DS(3), AT(3,3), P(3), BO(3)
INTEGER KX, KP(MMOD), I, J, K
DO 10 K = 1, NMOD
KP(K) = MDON(K)
10 CONTINUE
CALL MCLEAR
DO 30 K = 1, NMOD
IF (KP(K) .EQ. 0 .OR. K .EQ. KX) GO TO 30
DO 20 I = 1, 3
P(I) = MDP(I,K) + DS(I)
BO(I) = MDBO(I,K)
DO 15 J = 1, 3
AT(I,J) = MDAT(I,J,K)
15 CONTINUE
20 CONTINUE
CALL MPLACE(K, AT, P, BO)
30 CONTINUE
RETURN
END
C
C-----------------------------------------------------------------------
C STATCM: the CM station. The camera at the CM eye (CMEYE), looking
C along the CSM's +X axis with its -Z up, the view of MSC IN 69-FM-
C 197's CSM maneuver plots (see CMCAB); the cabin (KCMC) around it,
C and with in_flags bit 4 its interior (KCMI).
C The CSM's axes: the placed CSM's (scene 8), else X along the
C reference boresight and Z against its up, so the station looks
C where the window view looked (ours). Only where the situation
C offers it (JSCM: always, or where the CSM is placed).
C-----------------------------------------------------------------------
SUBROUTINE STATCM(CG, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION CG(3), AT(3,3), E(3), V(3), W(3), DS(3), Z(3)
DOUBLE PRECISION OFF(3)
INTEGER IOK, I, J, KC, KCSPL, NZ
IOK = 0
IF (JSCM .EQ. 0 .OR. (JSCM .EQ. 1 .AND. KCSPL() .EQ. 0)) RETURN
IOK = 1
CALL CMEYE(E)
CALL SETV(Z, 0.0D0, 0.0D0, 0.0D0)
KC = KCSPL()
IF (KC .EQ. 0) GO TO 20
DO 10 I = 1, 3
DO 5 J = 1, 3
AT(I,J) = MDAT(I,J,KC)
5 CONTINUE
10 CONTINUE
C RESTOMOD BEGIN: the moved eye is ours (veye.f; #72): the eye
C leaves the design eye by the offset, in the CSM's body frame
CALL EYUSE(2, AT, OFF, NZ)
DO 11 I = 1, 3
E(I) = E(I) + OFF(I)
11 CONTINUE
C RESTOMOD END
DO 12 I = 1, 3
V(I) = (E(I) - MDBO(I,KC)) * 1.0D-3
12 CONTINUE
CALL MXV(AT, V, W)
DO 15 I = 1, 3
W(I) = W(I) + MDP(I,KC)
CG(I) = CG(I) + W(I)
DS(I) = -W(I)
15 CONTINUE
CALL MSHIFT(DS, KC)
GO TO 30
20 DO 25 I = 1, 3
AT(I,1) = BREF(I)
AT(I,3) = -UREF(I)
25 CONTINUE
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
C RESTOMOD BEGIN: the moved eye is ours (veye.f; #72): the camera
C moves with it, the world stays
CALL EYUSE(2, AT, OFF, NZ)
IF (NZ .EQ. 1) CALL EYMOVE(AT, OFF, CG, 0)
DO 26 I = 1, 3
E(I) = E(I) + OFF(I)
26 CONTINUE
C RESTOMOD END
30 DO 35 I = 1, 3
BREF(I) = AT(I,1)
UREF(I) = -AT(I,3)
35 CONTINUE
CALL VCRS(BREF, UREF, RREF)
CALL MPLACE(KCMC, AT, Z, E)
C The interior's hidden lines for this eye (vmask.f CBCUT: none to
C redo while the offset is the one cut last).
IF (MOD(IFLG / 16, 2) .EQ. 1) CALL CBCUT(KCMI, OFF)
IF (MOD(IFLG / 16, 2) .EQ. 1) CALL MPLACE(KCMI, AT, Z, E)
RETURN
END
C
C-----------------------------------------------------------------------
C STATLM: the LM station. The camera at the commander's design eye
C (LDEYE) in the LM, looking as scene 5 does, LPDDN deg down from
C the LM's +Z in the X-Z plane; the LM window and LPD overlay
C (OVLPD) is drawn about that aim, and with in_flags bit 4 the
C interior (KLMI) around the eye. Only where the situation offers
C it (JSLM) and an LM exists (#70 option C): the LM the situation
C placed (scenes 4, 7, 8), else the one LMSTPL places for the
C station at its state, docked to the CSM or landed; before the
C separation, stowed in the closed SLA, its window sees nothing
C (ISLA; below). IOK 0 where there is no LM: the window view.
C-----------------------------------------------------------------------
SUBROUTINE STATLM(GET, PM, CG, CV, IREF, IOK)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), CV(3)
DOUBLE PRECISION AT(3,3), E(3), V(3), W(3), DS(3), C, S
DOUBLE PRECISION Z(3), OFF(3)
INTEGER IREF, IOK, I, J, KL, KLMPL, NZ
IOK = 0
IF (JSLM .EQ. 0) RETURN
IF (KLMPL() .EQ. 0) CALL LMSTPL(GET, PM, CG, CV, IREF)
IF (ISLA .EQ. 1) GO TO 40
KL = KLMPL()
IF (KL .EQ. 0) RETURN
IOK = 1
CALL LDEYE(E)
DO 10 I = 1, 3
DO 5 J = 1, 3
AT(I,J) = MDAT(I,J,KL)
5 CONTINUE
10 CONTINUE
C RESTOMOD BEGIN: the moved eye is ours (veye.f; #72), in the LM's
C body frame
CALL EYUSE(3, AT, OFF, NZ)
DO 11 I = 1, 3
E(I) = E(I) + OFF(I)
11 CONTINUE
C RESTOMOD END
DO 12 I = 1, 3
V(I) = (E(I) - MDBO(I,KL)) * 1.0D-3
12 CONTINUE
CALL MXV(AT, V, W)
DO 15 I = 1, 3
W(I) = W(I) + MDP(I,KL)
CG(I) = CG(I) + W(I)
DS(I) = -W(I)
15 CONTINUE
CALL MSHIFT(DS, KL)
GO TO 50
C Stowed in the closed SLA before the separation: the window faces
C the adapter's inner wall a metre or two away, unlit, so nothing
C outside is drawn (LAYERS), no model is placed, and the frame
C letters why (TXALL); the window overlay and, with in_flags bit
C 4, the cabin are drawn as in any LM station. The LM's axes: X
C along the CSM's +X, as it stood under the SM with its docking
C tunnel up, and Z the CSM's +Z, the CSM's axes as STATCM takes
C them from the window view (the turn about X is ours; nothing
C outside depends on it). The camera stays where the window
C view's was, at the CM some metres away (ours: nothing outside is
C drawn from it). A modern addition, ours: VIEW drew no LM
C station before separation.
40 IOK = 1
DO 45 I = 1, 3
AT(I,1) = BREF(I)
AT(I,3) = -UREF(I)
45 CONTINUE
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
CALL MCLEAR
CALL LDEYE(E)
C RESTOMOD BEGIN: the moved eye is ours (veye.f; #72); the camera
C stays (nothing outside is drawn), the cabin goes about the eye
CALL EYUSE(3, AT, OFF, NZ)
DO 46 I = 1, 3
E(I) = E(I) + OFF(I)
46 CONTINUE
C RESTOMOD END
50 C = DCOS(LPDDN * DR)
S = DSIN(LPDDN * DR)
DO 20 I = 1, 3
BREF(I) = C * AT(I,3) - S * AT(I,1)
UREF(I) = S * AT(I,3) + C * AT(I,1)
20 CONTINUE
CALL VCRS(BREF, UREF, RREF)
CALL VUNIT(RREF)
CALL SETV(Z, 0.0D0, 0.0D0, 0.0D0)
IF (MOD(IFLG / 16, 2) .EQ. 1) CALL CBCUT(KLMI, OFF)
IF (MOD(IFLG / 16, 2) .EQ. 1) CALL MPLACE(KLMI, AT, Z, E)
RETURN
END
C
C-----------------------------------------------------------------------
C LMSTPL: place the LM for its station where the scene has not
C (#70 option C), from its state (VSTATE; the source used, ISRCU,
C kept as the camera's):
C none: nothing (no station);
C the CSM's (docked, or stowed in the SLA) before the separation
C (the scenario's SEP event): ISLA 1, nothing placed;
C the CSM's after it, docked: the CSM in the axes STATCM gives it
C (X along the window view's boresight, Z against its up), its
C CM eye at the camera, and the LM docked to it as STKPL docks
C the stack, gear stowed (KLMS), or the ascent stage alone
C (KLMA) after lunar lift-off;
C its own, from 600 s before touchdown (the TOUCH event) to
C lunar lift-off (LIFT): the descending and then landed LM of
C scene 5 (LMDESC), the gear-down model (KLMD) with its
C commander's eye at LMDESC's;
C its own otherwise: as VEHPL places it, at any range;
C and with its own state, CV the LM's velocity about IREF. All
C ours.
C-----------------------------------------------------------------------
SUBROUTINE LMSTPL(GET, PM, CG, CV, IREF)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, PM(3), CG(3), CV(3), R(3), V(3), AT(3,3)
DOUBLE PRECISION E(3), P(3), W(3), PMF(3), XB(3), YB(3), ZB(3)
DOUBLE PRECISION TS, TL, EVGET
INTEGER IREF, IOK, I, J, K, KCSPL
J = ISRCU
CALL VSTATE(GET, 2, 1, R, V, IOK)
ISRCU = J
IF (IOK .EQ. 0) RETURN
TS = EVGET(KESEP)
TL = EVGET(KELFT)
IF (IOK .EQ. 2 .AND. TS .GE. 0.0D0 .AND. GET .LT. TS) ISLA = 1
IF (ISLA .EQ. 1) RETURN
IF (IOK .EQ. 2) GO TO 50
IF (LUT0 .LE. 0.0D0 .OR. GET .LT. LUT0 - 600.0D0) GO TO 20
IF (TL .GE. 0.0D0 .AND. GET .GE. TL) GO TO 20
C Descending or landed: LMDESC's axes and eye (LDCAB's).
CALL LMDESC(GET, PMF, XB, YB, ZB)
CALL MXV(MMF, XB, AT(1,1))
CALL MXV(MMF, YB, AT(1,2))
CALL MXV(MMF, ZB, AT(1,3))
CALL MXV(MMF, PMF, W)
DO 10 I = 1, 3
P(I) = PM(I) + W(I) - CG(I)
10 CONTINUE
CALL LDEYE(E)
CALL MPLACE(KLMD, AT, P, E)
GO TO 30
20 CALL VEHPLD(GET, PM, CG, 1.0D30)
30 J = ISRCU
CALL VSTATE(GET, 2, IREF, R, V, IOK)
ISRCU = J
IF (IOK .EQ. 0) RETURN
DO 35 I = 1, 3
CV(I) = V(I)
35 CONTINUE
RETURN
C Docked to the CSM.
50 IF (KCSPL() .NE. 0) RETURN
DO 55 I = 1, 3
AT(I,1) = BREF(I)
AT(I,3) = -UREF(I)
55 CONTINUE
CALL VCRS(AT(1,3), AT(1,1), AT(1,2))
CALL CMEYE(E)
CALL MXV(AT, E, W)
DO 60 I = 1, 3
P(I) = -W(I) * 1.0D-3
60 CONTINUE
K = KLMS
IF (TL .GE. 0.0D0 .AND. GET .GE. TL) K = KLMA
CALL STKPL(AT, P, K)
RETURN
END
C
C LMEX: 1 if an LM exists this frame, for its station (hdr 22): one
C placed, the LM station in use, or a state (VSTATE: its own, or
C the CSM's, docked or stowed in the SLA); else 0. The source
C used, ISRCU, kept.
INTEGER FUNCTION LMEX(GET)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, R(3), V(3)
INTEGER IOK, J, KLMPL
LMEX = 1
IF (KLMPL() .NE. 0 .OR. IVUSE .EQ. 3) RETURN
J = ISRCU
CALL VSTATE(GET, 2, 1, R, V, IOK)
ISRCU = J
IF (IOK .EQ. 0) LMEX = 0
RETURN
END
C
C LDCAB: the LM crew-station recipe's camera is the commander's
C eye; asked for as the LM station, it moves with the eye offset
C (veye.f; #72) and with in_flags bit 4 the LM interior goes
C around it, on the descending LM's axes (LMDESC).
SUBROUTINE LDCAB(GET, CG)
C RESTOMOD BEGIN: file INCLUDE; FORTRAN V's named PDP elements
INCLUDE 'viewdims.inc'
INCLUDE 'viewcom.inc'
C RESTOMOD END
DOUBLE PRECISION GET, CG(3), PMF(3), XB(3), YB(3), ZB(3)
DOUBLE PRECISION E(3), Z(3), AT(3,3), OFF(3)
INTEGER I, NZ
CALL LMDESC(GET, PMF, XB, YB, ZB)
CALL MXV(MMF, XB, AT(1,1))
CALL MXV(MMF, YB, AT(1,2))
CALL MXV(MMF, ZB, AT(1,3))
CALL LDEYE(E)
C RESTOMOD BEGIN: the moved eye is ours (veye.f; #72)
CALL EYUSE(3, AT, OFF, NZ)
IF (NZ .EQ. 1) CALL EYMOVE(AT, OFF, CG, 0)
DO 10 I = 1, 3
E(I) = E(I) + OFF(I)
10 CONTINUE
C RESTOMOD END
IF (MOD(IFLG / 16, 2) .EQ. 0) RETURN
CALL SETV(Z, 0.0D0, 0.0D0, 0.0D0)
CALL CBCUT(KLMI, OFF)
CALL MPLACE(KLMI, AT, Z, E)
RETURN
END
src/viewdims.inc
C Generated by tools/gen_data.py from data/. Do not edit.
C Catalog sizes shared by the kernel (src/*.f) and its BLOCK DATA.
INTEGER NSTAR, NNAV, NCPT, NCST, NCRAT, NMARE
C RESTOMOD BEGIN: parenthesised PARAMETER list is FORTRAN 77
C (1978); FORTRAN V wrote PARAMETER I = 2 (UP-4046 sec. 10.4.1)
PARAMETER (NSTAR=921, NNAV=37, NCPT=5128, NCST=134)
PARAMETER (NCRAT=7968, NMARE=56)
C RESTOMOD END
C The run decks' codes (their tables are in viewcom.inc, filled by
C the card reader, vdeck.f): NLGP parameters a leg, leg types and
C event kinds.
INTEGER NLGP
INTEGER KCIRC, KCONIC, KLUNAR, KLCON, KTABL
INTEGER KETDA, KESEP, KEAPR, KEDOK, KEUND, KETD, KEEI, KEPTC
INTEGER KETLI, KELOI1, KELOI2, KEPHO, KETEI, KELMS, KEPDI, KELFT
INTEGER KETPF, KELDK, KEJET, KECMS, KEEJC, KESLG, KELFO, KESIC
INTEGER KELES, KESII
C RESTOMOD BEGIN: parenthesised PARAMETER list is FORTRAN 77
PARAMETER (NLGP=17)
PARAMETER (KCIRC=1, KCONIC=2, KLUNAR=3, KLCON=4, KTABL=5)
PARAMETER (KETDA=1, KESEP=2, KEAPR=3, KEDOK=4)
PARAMETER (KEUND=5, KETD=6, KEEI=7, KEPTC=8)
PARAMETER (KETLI=9, KELOI1=10, KELOI2=11, KEPHO=12)
PARAMETER (KETEI=13, KELMS=14, KEPDI=15, KELFT=16)
PARAMETER (KETPF=17, KELDK=18, KEJET=19, KECMS=20)
PARAMETER (KEEJC=21, KESLG=22, KELFO=23, KESIC=24)
PARAMETER (KELES=25, KESII=26)
C RESTOMOD END
src/viewcom.inc
C VIEW-1108 KERNEL COMMON. Included by every kernel routine
C after viewdims.inc. Hand written (viewdims.inc is generated).
C
C Units: km, km/s, seconds of GET, radians inside, degrees at the
C edges (plot coordinates, inputs). Frame: J2000 equatorial (EQ)
C unless a name says MF (Moon fixed, IAU) or EF (Earth fixed).
C
DOUBLE PRECISION PI, DR, RE, RM, GME, GMM, JD0, LPDDN, LPDK
C RESTOMOD BEGIN: real-valued PARAMETERs; FORTRAN V PARAMETER was
C integer-only, written PARAMETER I = 2 (UP-4046 Rev 3, sec. 10.4.1)
PARAMETER (PI=3.141592653589793D0, DR=PI/180.0D0)
PARAMETER (RE=6378.137D0, RM=1737.4D0)
PARAMETER (GME=398600.4418D0, GMM=4902.800D0)
C Apollo 11 range zero 1969-07-16 13:32:00 UTC, the page's clock
C base: hdr(16) is each scenario's epoch offset from it.
PARAMETER (JD0=2440419.063889D0)
C LM window view: the boresight LPDDN deg below the LM's +Z in the
C X-Z plane, and the LPD scale's plot constant LPDK; both fitted
C to the film's LPD marks (llpd.f).
PARAMETER (LPDDN=30.2D0, LPDK=49.8D0)
C RESTOMOD END
C The launch vehicle's stages as the Apollo 11 press kit gives them
C (models.f SIVBMD, LVSTK; the S-IVB's state point, SIVPL, S7SIV,
C TGTPOS): S-IVB height SIVBH ft and IU height SIUH ft ("THIRD
C STAGE (S-IVB) ... HEIGHT 58.3 FEET", "INSTRUMENT UNIT ... HEIGHT
C 3 FEET", printed p. 109); both SLVD in across (the S-IVB "21 feet
C 8 inches in diameter", the IU a cylinder "21 feet 8 inches in
C diameter", printed p. 113; the SLA "260 inches diameter at the
C base", printed p. 88); the SLA "a truncated cone 28 feet long"
C (SLAH ft) tapering to "154 inches at the forward end at the
C service module mating line" (SLATD in; printed p. 88). The same
C page-109 table: the S-IC "DIAMETER-33 FEET", "HEIGHT 138 FEET"
C (SICH ft) and the S-II "DIAMETER-33 FEET", "HEIGHT 81.5 FEET"
C (SIIH ft), both SICD in across (models.f LVSIC, LVSII). The
C S-II/S-IVB interstage, the taper from SICD to SLVD, SIIIS ft
C long, is ours: no source we hold gives its length (the same
C table lists its weight, 8,081 lb, but no height; p. 110 too), and we count
C it inside the S-II's SIIH, so the stack's height is unchanged.
C The launch escape system (models.f LESBLD) by the Apollo Operations
C Handbook's spacecraft stations (SM2A-03-Block II-(1), Fig. 1-2,
C p. 1-5), in inches: the LES-CM separation plane at CM station
C LESXC (LES station 0), the tower to LES station LESTW, the skirt
C to LESSK, the motor to LESMO, the tip at LESTP; "33 feet tall,
C four feet in diameter at the base" (LESBD in; press kit, printed
C p. 86).
DOUBLE PRECISION SIVBH, SIUH, SLVD, SLAH, SLATD, SICH, SIIH, SICD
DOUBLE PRECISION SIIIS
DOUBLE PRECISION LESXC, LESTW, LESSK, LESMO, LESTP, LESBD
C RESTOMOD BEGIN: real-valued PARAMETERs (as above)
PARAMETER (SIVBH=58.3D0, SIUH=3.0D0, SLVD=260.0D0)
PARAMETER (SLAH=28.0D0, SLATD=154.0D0)
PARAMETER (SICH=138.0D0, SIIH=81.5D0, SICD=396.0D0)
PARAMETER (SIIIS=18.0D0)
PARAMETER (LESXC=83.476D0, LESTW=118.3D0, LESSK=138.0D0)
PARAMETER (LESMO=363.7D0, LESTP=400.762D0, LESBD=48.0D0)
C RESTOMOD END
C Launch Complex 39, Pad A and the mobile launcher (mpad.f PADBLD,
C ARMBLD; vdrive.f PADPL, ASCPL; #97), in feet, from the press kit's
C Launch Complex 39 pages: "The top of the pad stands some 48 feet
C above sea level" (MNDH, the mound's height above the drawn
C sphere; printed p. 168), "the five percent ramp which leads to
C the launch pad" (MNDG, the mound's slope all round, ours; printed
C p. 166); "The launcher base is a two-story steel structure, 25
C feet high, 160 feet long, and 135 feet wide. It is positioned on
C six steel pedestals 22 feet high ... at the launch pad" (MLBH,
C MLBL, MLBW, MLPED); "The umbilical tower, extending 398 feet above
C the launch platform, is mounted on one end of the launcher base.
C A hammerhead crane at the top has a hook height of 376 feet above
C the deck with a traverse radius of 85 feet from the center of the
C tower" (LUTH, LUTCR; printed p. 164); "The Apollo access arm
C (service arm 9), located at the 320-foot level above the launcher
C base" (ARM9H; printed p. 165). Ours: the hardstand's top MNDT ft
C square, the tower LUTW ft square with its centre LUTZ ft from the
C vehicle's axis, its base flared to LUTFW ft square over LUTFH ft.
DOUBLE PRECISION MNDH, MNDG, MNDT, MLBH, MLBL, MLBW, MLPED
DOUBLE PRECISION LUTH, LUTCR, LUTW, LUTZ, LUTFW, LUTFH, ARM9H
C RESTOMOD BEGIN: real-valued PARAMETERs (as above)
PARAMETER (MNDH=48.0D0, MNDG=0.05D0, MNDT=400.0D0)
PARAMETER (MLBH=25.0D0, MLBL=160.0D0, MLBW=135.0D0, MLPED=22.0D0)
PARAMETER (LUTH=398.0D0, LUTCR=85.0D0, LUTW=40.0D0, LUTZ=57.0D0)
PARAMETER (LUTFW=46.0D0, LUTFH=30.0D0, ARM9H=320.0D0)
C RESTOMOD END
C RESTOMOD BEGIN: 60000x5 DP buffer is 600K words, core 262,144
C (docs/univac-1108.md); VIEW would stream vectors to plot tape.
C Also the parenthesised PARAMETER list (FORTRAN 77, 1978).
INTEGER MAXV, MAXS, MAXL, MAXT, MAXTC
PARAMETER (MAXV=60000, MAXS=4000, MAXL=200)
PARAMETER (MAXT=300, MAXTC=6000)
C RESTOMOD END
INTEGER MSOL, MVX, MFC, MED, MXL, MMOD, KLMD, KLMS, KSIV, KCSM
INTEGER KCMC, KCMI, KLMI, KLMA, KCMO, KSTK
C RESTOMOD BEGIN: parenthesised PARAMETER list is FORTRAN 77
C (1978); FORTRAN V wrote PARAMETER I = 2 (UP-4046 Rev 3, sec.
C 10.4.1). And 160 solids (the LM's RCS clusters are 20 a model,
C in three LM models; the CSM's quads 20 more; the launch vehicle's
C stages, the escape system and the launch complex 36 more, #97)
C make /CLM/ and /CLMI/ about 228K words (our count: 1,294 words a
C solid, 21,000 for the free lines, 2 words a DP number), 87
C percent of the 1108's 262,144 (docs/univac-1108.md). 24 models.
C A full table refuses and counts (NMODX, NSOLX, NXLX; MODBEG,
C MKPRS, MKFRU, MKWDG, XLINE), and the selftest's model tables
C line fails on a refusal or a table at its maximum.
PARAMETER (MSOL=160, MVX=48, MFC=26, MED=72, MXL=1500, MMOD=24)
C RESTOMOD END
C Model numbers (MLIB): LM gear down, LM gear stowed with docking
C aids, S-IVB with IU and SLA ring, CSM, CM cabin (window), CM
C interior, LM interior (in_flags bit 4), LM ascent stage alone
C (after lunar lift-off), CM alone (after CM/SM separation), the
C launch stack behind the CSM before separation: S-IVB, IU and
C the closed SLA (LVSTK); and (#97) the launch complex (PADBLD:
C the pad's mound, the mobile launcher's base and its umbilical
C tower), the tower's service arms 1-8 swung out to the vehicle and
C swung back and the access arm out, parked and back (mpad.f
C ARMBLD), the S-II, the S-IC (LVSII, LVSIC) and the
C launch escape system (LESBLD).
INTEGER KPAD, KARE, KARR, KSII, KSIC, KLES, KA9E, KA9P, KA9R
C RESTOMOD: parenthesised PARAMETER list is FORTRAN 77 (1978)
PARAMETER (KLMD=1, KLMS=2, KSIV=3, KCSM=4, KCMC=5, KCMI=6,
& KLMI=7, KLMA=8, KCMO=9, KSTK=10, KPAD=11, KARE=12,
& KARR=13, KSII=14, KSIC=15, KLES=16, KA9E=17, KA9P=18,
& KA9R=19)
C
C Tables loaded by BLOCK DATA VIEWBD (viewdata.f)
C RESTOMOD BEGIN: post-1969 data: Natural Earth coast (2009),
C IAU crater gazetteer (names from 1970 on), 37K words of tables.
DOUBLE PRECISION STX(NSTAR), STY(NSTAR), STZ(NSTAR), STM(NSTAR)
DOUBLE PRECISION CLON(NCPT), CLAT(NCPT)
INTEGER KCST(NCST+1)
DOUBLE PRECISION CRLAT(NCRAT), CRLON(NCRAT), CRDIA(NCRAT)
COMMON /CSTAR/ STX, STY, STZ, STM
COMMON /CCOST/ CLON, CLAT, KCST
COMMON /CCRAT/ CRLAT, CRLON, CRDIA
C RESTOMOD END
C Label text for the recorder's character generator: ASCII codes,
C 10 per nav star (NAVCH), 5 each for SUN, EARTH, MOON (BODCH),
C zero padded. Loaded by VIEWBD.
INTEGER NAVCH(370), BODCH(15), SITECH(22)
COMMON /CNAME/ NAVCH, BODCH, SITECH
C RESTOMOD BEGIN: post-1969 data: IAU gazetteer maria (centres and
C diameters only, so drawn as circles), names as character codes.
DOUBLE PRECISION MRLAT(NMARE), MRLON(NMARE), MRDIA(NMARE)
INTEGER MRCH(24*NMARE)
COMMON /CMARE/ MRLAT, MRLON, MRDIA, MRCH
C RESTOMOD END
C
C /CTAB/ unit vectors built from the tables at first call:
C crater centres (MF) and coastline points (EF).
DOUBLE PRECISION CRV(3,NCRAT), CEV(3,NCPT)
COMMON /CTAB/ CRV, CEV
C
C /CTIM/ current frame time. TDAY days and TCEN Julian centuries
C from J2000.0, GMST radians.
DOUBLE PRECISION TJD, TDAY, TCEN, GMST
COMMON /CTIM/ TJD, TDAY, TCEN, GMST
C
C /CBOD/ bodies seen from the camera. EPOS, MPOS: Earth and Moon
C centres relative to the camera (EQ). SUNU: unit vector to the
C Sun. MMF: MF -> EQ. MEF: EF -> EQ. CAMF: camera relative to
C the Moon centre, MF. CBMF: boresight in MF.
DOUBLE PRECISION EPOS(3), MPOS(3), SUNU(3), MMF(3,3), MEF(3,3)
DOUBLE PRECISION CAMF(3), CBMF(3)
COMMON /CBOD/ EPOS, MPOS, SUNU, MMF, MEF, CAMF, CBMF
C
C /CCAM/ camera. CR, CU, CB: right, up, boresight (EQ). RREF,
C UREF, BREF: the scene reference attitude before free-look.
C FOVH half field (deg), BOXH clip half size (deg), THVIEW angle
C from boresight to the frame corner (deg), THLIM the largest
C angle from the boresight that is projected at all (deg). PK
C projection constant (1 gnomonic .. 2 stereographic), PTH the last
C angle off the boresight PROJ saw (rad).
DOUBLE PRECISION CR(3), CU(3), CB(3), RREF(3), UREF(3), BREF(3)
DOUBLE PRECISION FOVH, BOXH, THVIEW, THLIM, CSVIEW, PK, PTH
COMMON /CCAM/ CR, CU, CB, RREF, UREF, BREF,
& FOVH, BOXH, THVIEW, THLIM, CSVIEW, PK, PTH
C
C /CPEN/ the pen. PPX last point, IPV its visibility, IVMODE the
C visibility test for points now being drawn (see ISVIS), ISTYLE
C line style written to VBUF.
DOUBLE PRECISION PPX(3)
COMMON /CPEN/ PPX
INTEGER IPV, IVMODE, ISTYLE
COMMON /CPENI/ IPV, IVMODE, ISTYLE
C
C /CORB/ trajectories and scene set-up.
C LUT0, TETP: the current scenario's touchdown and entry interface
C g.e.t. (s) (SNSET). LMALT, LMEYE: the descending LM's
C footpad altitude and the commander's eye above the pads (km),
C set by LMDESC.
C AZOFF, ELOFF: scene reference offsets (deg); TERISE: Earthrise.
C FXB, FXU: inertially held boresight and up (scene 2), fixed at
C FXDT seconds before entry interface.
C S6LAT, S6LON, S6DST: scene 6 sub-observer point (deg) and
C camera distance from the Moon's centre (km).
DOUBLE PRECISION LUT0, TETP, LMALT, LMEYE
DOUBLE PRECISION AZOFF, ELOFF, TERISE, FXB(3), FXU(3), FXDT
DOUBLE PRECISION S6LAT, S6LON, S6DST
COMMON /CORB/ LUT0, TETP, LMALT, LMEYE, AZOFF, ELOFF, TERISE,
& FXB, FXU, FXDT, S6LAT, S6LON, S6DST
C
C The run tables' fixed maxima (ours, #26): headroom over today's
C two scenarios for a few more missions' decks; the card reader
C (vdeck.f) refuses a deck that needs more, never truncates.
C Scenarios, trajectory legs, events, START, BURN and REF cards,
C TIMELINE rows, burn cues (MXSIT, situations: viewsit.inc).
INTEGER MXSN, MXLEG, MXEVT, MXSTRT, MXBURN, MXREF, MXTL, MXCUE
C RESTOMOD: parenthesised PARAMETER list is FORTRAN 77 (1978)
PARAMETER (MXSN=8, MXLEG=200, MXEVT=100, MXSTRT=8, MXBURN=50,
& MXREF=80, MXTL=1500, MXCUE=64)
C
C /CSCEN/, /CSCENI/ the scenarios, one mission's data each, run
C decks in 1969 terms, filled by the card reader (vdeck.f) from
C data/missions; NSN scenarios, NLEG legs and NEVT events used.
C Scenario M: epoch SNJD0 (JD of range zero), landing site SNSLA
C lat, SNSLO east lon, SNSAZ descent azimuth (deg).
C Leg K of scenario LGSN(K), type LGTYP, whole revolutions LGN
C (LUNAR), latitude geocentric if LGGC = 1, and LGP: 1 FROM, 2 TO,
C 3 T (g.e.t. s), 4 LAT, 5 LON (deg), 6 ALT (n mi), 7 V (ft/s),
C 8 FPA, 9 HDG (deg), 10 TB (s), 11 LATB, 12 LONB (deg), LCONIC
C 13 DV (ft/s), 14 P, 15 R, 16 N, 17 ALTB (n mi; LUNAR, the
C altitude at TB). TABLE (one leg per pair of rows): 3-9 row A,
C 10-12 row B's T LAT LON, 13-15 its V FPA HDG, 17 its ALT; LGN
C 1 A's, 2 B's velocity Earth fixed.
C Event J of scenario EVSN(J), kind EVKND, g.e.t. EVT (s).
DOUBLE PRECISION SNJD0(MXSN), SNSLA(MXSN), SNSLO(MXSN)
DOUBLE PRECISION SNSAZ(MXSN)
DOUBLE PRECISION LGP(NLGP,MXLEG), EVT(MXEVT)
C Launch pad (PAD card): SNPLA, SNPLO lat, east lon (deg),
C geocentric latitude if SNPGC = 1; PADCH its name, 8 codes per
C scenario, zero padded (none if the first is 0).
DOUBLE PRECISION SNPLA(MXSN), SNPLO(MXSN)
INTEGER LGSN(MXLEG), LGTYP(MXLEG), LGN(MXLEG), LGGC(MXLEG)
INTEGER EVSN(MXEVT), EVKND(MXEVT), SNPGC(MXSN), PADCH(8*MXSN)
C LGVEH(K): the vehicle leg K carries, 1 the CSM, 2 the LM, 3 the
C S-IVB.
INTEGER LGVEH(MXLEG), NSN, NLEG, NEVT
COMMON /CSCEN/ SNJD0, SNSLA, SNSLO, SNSAZ, LGP, EVT,
& SNPLA, SNPLO
COMMON /CSCENI/ LGSN, LGTYP, LGN, LGGC, EVSN, EVKND,
& SNPGC, PADCH, LGVEH, NSN, NLEG, NEVT
C
C /CMEEUS/ the Moon's periodic terms, Meeus tables 47.A and 47.B
C (BLOCK DATA from data/meeus47.txt): MMA(6*(K-1)+1..6) = D M M' F
C sigma_l sigma_r of table 47.A row K, MMB(5*(K-1)+1..5) = D M M' F
C sigma_b of table 47.B.
C RESTOMOD: ELP-2000/82 (1982) as abridged by Meeus (1991, 1998)
INTEGER MMA(360), MMB(300)
COMMON /CMEEUS/ MMA, MMB
C
C /CSIM/, /CSIMI/ the scenarios' simulation cards: START, the
C SCORE (BURN) and the REFERENCE rows; NSTART, NBN and NRF used.
C START of scenario STSN (one at most), REF rows: state STP / RFP
C as LGP (2 = END for START), body STBOD / RFBOD (1 Earth, 2
C Moon), geocentric latitude if STGC / RFGC = 1. BURN: mid-burn
C g.e.t. BNT (s), BNDV (ft/s), direction BNP, BNR, BNN in the
C BNBOD body's frame (along the velocity, radial in the orbit
C plane, orbit normal).
DOUBLE PRECISION STP(NLGP,MXSTRT), RFP(NLGP,MXREF)
DOUBLE PRECISION BNT(MXBURN), BNDV(MXBURN), BNP(MXBURN)
DOUBLE PRECISION BNR(MXBURN), BNN(MXBURN)
INTEGER STSN(MXSTRT), STBOD(MXSTRT), STGC(MXSTRT), NSTART
INTEGER RFSN(MXREF), RFBOD(MXREF), RFGC(MXREF), NRF
INTEGER BNSN(MXBURN), BNBOD(MXBURN), NBN
COMMON /CSIM/ STP, RFP, BNT, BNDV, BNP, BNR, BNN
COMMON /CSIMI/ STSN, STBOD, STGC, NSTART, RFSN, RFBOD, RFGC,
& NRF, BNSN, BNBOD, NBN
C
C /CTLN/, /CTLNI/ the scenarios' timelines (TIMELINE cards, from
C SP-4029's mission timelines): row K of scenario TLSN(K) at
C g.e.t. TLT(K) (s), kind TLK(K): 1 LAUNCH, 2 BURN, 3 STAGING,
C 4 ORBIT, 5 SEP, 6 SURFACE, 7 TV, 8 CREW, 9 PHOTO, 10 ENTRY,
C 11 MARK (CLAUDE.md); sorted by scenario and g.e.t. The names
C are the page's (build/names.js). NTL rows.
DOUBLE PRECISION TLT(MXTL)
INTEGER TLK(MXTL), TLSN(MXTL), NTL
COMMON /CTLN/ TLT
COMMON /CTLNI/ TLK, TLSN, NTL
C
C /CBRN/, /CBRNI/ the burn cue's main-engine firings (lburn.f; a
C modern addition), from the TIMELINE rows by the scenarios'
C BURNCUE cards: row K of scenario BRSN(K) burns from g.e.t. BRT1(K)
C to BRT2(K) (s), vehicle BRVH(K) (1 CSM, 2 LM, 3 S-IVB), engine
C BREN(K) (1 SPS, 2 DPS, 3 APS, 4 J-2); NBR rows. IBRTX: the
C engine whose BURN text TXALL letters this frame (DBURN), 0 none.
DOUBLE PRECISION BRT1(MXCUE), BRT2(MXCUE)
INTEGER BRSN(MXCUE), BRVH(MXCUE), BREN(MXCUE), NBR, IBRTX
COMMON /CBRN/ BRT1, BRT2
COMMON /CBRNI/ BRSN, BRVH, BREN, NBR
COMMON /CBRNT/ IBRTX
C
C /CTAPE/ the TAPE (tape.f): per vehicle channel C (1 = CSM; up to
C four, TN D-6853 p. 12), NTP(C) samples of g.e.t. TPT and state
C TPS (geocentric EQ r km, v km/s), in time order; a burn or a
C state vector update leaves two samples at one time, before and
C after.
C Marks: NMK of them, g.e.t. TMKT, kind TMKK (1 burn, 2 reference
C row), channel TMKC, index TMKI (burn or reference row).
C RESTOMOD BEGIN: 1.1 M words of tape in core; the 1108 would
C have written it to drum or tape (docs/univac-1108.md).
INTEGER MXSAM, MXCHN, MXMRK
PARAMETER (MXSAM=30000, MXCHN=4, MXMRK=64)
DOUBLE PRECISION TPT(MXSAM,MXCHN), TPS(6,MXSAM,MXCHN)
DOUBLE PRECISION TMKT(MXMRK)
INTEGER NTP(MXCHN), NMK, TMKK(MXMRK), TMKC(MXMRK), TMKI(MXMRK)
COMMON /CTAPE/ TPT, TPS, TMKT
COMMON /CTAPEI/ NTP, NMK, TMKK, TMKC, TMKI
C RESTOMOD END
C
C /CSIMR/ the last engine run (sim.f): ITPSN the scenario on the
C tape (0 none yet), ISIMF the run's flags (bit 0 state vector
C updates on), and for each reference row the error of the
C simulated state against it just before any update, RFERR(1,J)
C position (km) and RFERR(2,J) velocity (ft/s), valid if RFOK(J)
C = 1. ISRC the state source asked for this frame (in_src,
C passed as in_flags bit 3: 0 replay, 1 tape), ISRCU the one used
C (0 replay, 1 sim with updates, 2 sim free, 3 a tape read from
C the deck). A tape read from the deck (vdktap.f) sets ITPSN to
C its scenario and ISIMF to -1; it has no reference errors (the
C card reader empties RFOK, and sets ISIMF to 0 with no tape).
C /CSIMM/ the Moon for the engine: geocentric position and
C velocity every MQDT seconds from MQT0, NMQ nodes (SIMRUN),
C read by cubic Hermite interpolation (MOONQ); the series is too
C slow to call at every integration step.
INTEGER MXMQ
PARAMETER (MXMQ=800)
DOUBLE PRECISION MQ(6,MXMQ), MQT0, MQDT
INTEGER NMQ
COMMON /CSIMM/ MQ, MQT0, MQDT
COMMON /CSIMMI/ NMQ
DOUBLE PRECISION RFERR(2,MXREF)
INTEGER ITPSN, ISIMF, RFOK(MXREF), ISRC, ISRCU
COMMON /CSIMR/ RFERR
COMMON /CSIMRI/ ITPSN, ISIMF, RFOK, ISRC, ISRCU
C
C /CSN/ the current scenario (SNSET): id ISN, epoch TJD0
C (Julian date of its range zero; g.e.t. counts from it), and the
C elements of its legs, LGEL(1..11, K):
C CONIC, LCONIC 1-3 perigee unit P, 4-6 Q, 7 eccentricity,
C 8 semi-major axis (km), 9 perigee time (s);
C CIRC, LUNAR 1-3 position unit at 9, 4-6 direction of motion
C there, 9 time (s), 10 radius (km) at 9, 11 mean motion
C (rad/s); LUNAR 7 the radius's rate (km/s).
DOUBLE PRECISION TJD0, LGEL(11,MXLEG)
COMMON /CSN/ TJD0, LGEL
INTEGER ISN
COMMON /CSNI/ ISN
C
C /CVIEW/ the view inputs of this frame (VSETIN): IVIEW 0 window,
C 1 external, 2 CM station, 3 LM station; ITARG camera target 0
C scene default, 1 Earth, 2 Moon, 3 Sun, 4 CSM, 5 LM, 6 S-IVB;
C ILABL label level 0-3 (0: in_flags bit 0 decides).
C IVUSE the view this frame actually uses (VIEWPT). ILEV the
C label level this frame applies (VFRAME): 0 none, 1 primary, 2
C secondary, 3 all; with ILABL 0 it is 3 if in_flags bit 0 is
C set, else 0. IVBIT the vehicles in this frame's world (VPRES,
C hdr 21). ITGST the target's status this frame (VIEWPT, hdr 23):
C 0 none asked (in_target 0) or none applies (the LM station, a
C FIXED situation), 1 aimed at a point of its own, 2 the vehicle
C the camera rides, 3 docked to or carried with another vehicle
C (its point is that vehicle's: aimed only from outside), 4 no
C point here (no state; the Sun from outside), 5 as 3, the LM in
C the SLA before the separation (SEP). ISLA 1 if this frame is
C the LM station inside the closed SLA before SEP (STATLM, #70
C option C): nothing outside is drawn, and the frame says why.
INTEGER IVIEW, ITARG, ILABL, IVUSE, ILEV, IVBIT, ITGST, ISLA
COMMON /CVIEW/ IVIEW, ITARG, ILABL, IVUSE, ILEV, IVBIT, ITGST,
& ISLA
C
C RESTOMOD BEGIN: a moved eye is ours (#72, #31); VIEW drew from
C fixed design-eye points (CMEYE, LDEYE), TN D-6853 printed p. 3
C /CEYE/ the eye offset (vview.f EYCLMP). EYOI the offset asked
C (in_eyeo, VSETEY); EYOF the one this frame uses, clamped: in a
C crew station body metres from the design eye, inside the cabin's
C walls; in the external view the orbit centre's offset from the
C target along the target's reference axes (right, up, boresight
C before free-look), in units of the camera's distance, each in
C -1..1. EYAT the axes of that frame (columns, EQ), EYAX the
C camera's right, up and boresight in it (columns; VFRAME), IEYK
C the kind: 0 none (a window view, the offset unused), 1 the
C external view, 2 the CM station, 3 the LM station.
DOUBLE PRECISION EYOI(3), EYOF(3), EYAT(3,3), EYAX(3,3)
INTEGER IEYK
COMMON /CEYE/ EYOI, EYOF, EYAT, EYAX, IEYK
C RESTOMOD END
C
C /CSCN/ scene number (the situation, row ISCN of the situation
C tables), flags of this frame, init done.
INTEGER ISCN, IFLG, INITD
COMMON /CSCN/ ISCN, IFLG, INITD
C
C /CSITU/, /CSITUI/ the current situation, row ISCN of the tables
C in viewsit.inc (filled from the SITUATION cards), copied by
C SITSET when VINIT selects it. All codes ours.
C JRCP the camera recipe: 1 LOCALVERT (local-vertical platform),
C 2 INERTIAL (inertially fixed), 3 CREWSTN (a crew station's
C eye), 4 BODYCTR (body-centred), 5 EXTSEED (external, seeded
C on a vehicle). JBOD its body, 1 Earth, 2 Moon. JMOD
C (LOCALVERT) 1 FORWARD, 2 NORMAL. JTRN 1 if the reference is
C turned by QTRN (yaw, pitch, roll, deg; REFTRN). JFAL 1 if,
C where no LUNAR leg holds the GET, the camera is FORWARD about
C the Earth QFEL deg above its horizon instead. QELV: FORWARD
C about the Earth, deg above the horizon. JATT attitude source,
C 1 the Earth's sightline (FXB, FXU), 2 S7ATT, 3 S8ATT. JVEH
C (CREWSTN) 1 CM, 2 LM. QDST (EXTSEED) the camera's distance
C from the vehicle (km).
C JWIN window code (hdr 8): 1 CSM window, 2 LM front window.
C JPOS the pose routine placing the situation's models: 0 none,
C 1 LMPIRO, 2 S7POSE, 3 S8POSE. JDRW drawing switches, bits:
C 1 no Earth night shading, 2 the whole-disc Moon, 4 no LM
C marker while landed. JLL the layers in order, ended by 0
C (12: MXLAY of viewsit.inc, which is included after this file).
C JVW the view used when in_view is 0 (0 window, 1 external,
C 2 CM station, 3 LM station). JTGT the external view's
C default target (as ITARG), JTGF the same where JFAL applies.
C JRID the vehicle the camera rides in its own view, 0 none,
C 1 the CSM, 2 the LM. JSCM, JSLM the CM and LM stations: 0
C not offered, 1 where that vehicle is placed, 2 always. JFIX 1
C if in_view and in_target are ignored. JXOF 1 if the external
C view starts QXY (yaw, pitch, deg) round.
C JHRK the header's reference object (hdr 11-14): 0 the body, 1
C the placed LM, 2 S7POSE's docking target QHOF km to the LM's
C -Y, 3 the placed CSM's tunnel QHOF km along its +X; QHRR its
C radius (km).
INTEGER JRCP, JBOD, JMOD, JTRN, JFAL, JATT, JVEH, JWIN, JPOS
INTEGER JDRW, JLL(12), JVW, JTGT, JTGF, JRID, JSCM, JSLM, JFIX
INTEGER JXOF, JHRK
DOUBLE PRECISION QELV, QTRN(3), QFEL, QDST, QXY(2), QHOF, QHRR
COMMON /CSITU/ QELV, QTRN, QFEL, QDST, QXY, QHOF, QHRR
COMMON /CSITUI/ JRCP, JBOD, JMOD, JTRN, JFAL, JATT, JVEH, JWIN,
& JPOS, JDRW, JLL, JVW, JTGT, JTGF, JRID, JSCM,
& JSLM, JFIX, JXOF, JHRK
C
C /CLM/ spacecraft wireframe models (MLIB), each in its own body
C axes (m); for the LM X up, Y right, Z forward.
C Solid K is convex: vertices LMV, outward face planes N.x = D
C (LMN, LMD), edges LME(1..4,J) = vertex, vertex, face, face.
C Free lines LXL (legs, pads) and face marks LXS/LXF (windows).
C LSMO(K) = 1: solid K stands for a curved surface (MKPRS, MKFRU
C sides about its axis); an edge between two of its sides is drawn
C only where one is turned toward the camera and the other away.
C LWV, LWN, LWD: the same in camera-relative EQ for this frame,
C with LWC, LWR the centre and radius of a sphere holding it.
DOUBLE PRECISION LMV(3,MVX,MSOL), LMN(3,MFC,MSOL), LMD(MFC,MSOL)
DOUBLE PRECISION LWV(3,MVX,MSOL), LWN(3,MFC,MSOL), LWD(MFC,MSOL)
DOUBLE PRECISION LXL(6,MXL), LWC(3,MSOL), LWR(MSOL)
COMMON /CLM/ LMV, LMN, LMD, LWV, LWN, LWD, LXL, LWC, LWR
INTEGER NSOL, NLV(MSOL), NLF(MSOL), NLE(MSOL), LME(4,MED,MSOL)
INTEGER NXL, LXS(MXL), LXF(MXL), LSMO(MSOL)
COMMON /CLMI/ NSOL, NLV, NLF, NLE, LME, NXL, LXS, LXF, LSMO
C
C /CS7/ scene 7, transposition and docking. S7AT: LM body axes
C (columns X, Y, Z) in EQ, held inertially. S7LP: the LM tunnel
C top centre, camera relative, km. S7BO: that point in LM body
C metres. S7RNG: CSM to LM docking ring range, ft.
DOUBLE PRECISION S7AT(3,3), S7LP(3), S7BO(3), S7RNG
C S8AT: scene 8's stack attitude, CSM body axes in EQ (S8ATT).
DOUBLE PRECISION S8AT(3,3)
COMMON /CS8/ S8AT
COMMON /CS7/ S7AT, S7LP, S7BO, S7RNG
C
C /CMOD/ model table. Model K is solids MDS1(K)..MDS2(K) and free
C lines MDX1(K)..MDX2(K) of /CLM/. This frame: MDON(K) = 1 if
C placed (MPLACE), with body axes MDAT (EQ), body point MDBO (m)
C at MDP (km, camera relative). LACT(IS) = 1 if solid IS is
C placed, LINS(IS) = 1 if the camera is inside it; NACT solids
C placed.
INTEGER NMOD, MDS1(MMOD), MDS2(MMOD), MDX1(MMOD), MDX2(MMOD)
INTEGER MDON(MMOD), LACT(MSOL), LINS(MSOL), NACT
COMMON /CMODI/ NMOD, MDS1, MDS2, MDX1, MDX2, MDON, LACT, LINS,
& NACT
DOUBLE PRECISION MDAT(3,3,MMOD), MDP(3,MMOD), MDBO(3,MMOD)
C MDHL(K) = 1: model K is drawn with hidden lines removed and its
C solids hide other things; 0: an outline, hiding nothing else
C (the cabins about the eye; their own lines are cut once against
C their opaque faces, vmask.f CBCUT). TN D-6853 p. 12
C names hidden-line models of the LM and S-IVB only; the CSM's is
C ours.
INTEGER MDHL(MMOD)
COMMON /CMODH/ MDHL
C LBOK 1 if the last solid builder (MKPRS, MKFRU, MKWDG) added a
C solid, 0 if the table was full; LXOK the same for XLINE. Code
C that marks the solid or line just built tests them first.
INTEGER LBOK, LXOK
COMMON /CMOK/ LBOK, LXOK
C /CMODX/ the model table's refusals since MLIB began: models past
C MMOD (MODBEG), solids past MSOL, free lines past MXL. LHGA1,
C LHGA2: the CSM's high-gain antenna, its free lines in CSMBLD
C (MDRAW leaves them out while the launch stack is placed).
INTEGER NMODX, NSOLX, NXLX, LHGA1, LHGA2
COMMON /CMODX/ NMODX, NSOLX, NXLX, LHGA1, LHGA2
COMMON /CMOD/ MDAT, MDP, MDBO
C
C /CWIN/ the cabin windows, for the window mask (vmask.f): window
C J of model WMOD(J) has NWV(J) corners WBV(1..3, K, J) in that
C model's body metres (XWIN, as MLIB builds the cabins; MDBLD is
C the model being built). This frame: WACT(J) = 1 if its model is
C placed, with WPN(1..3, K, J) the unit normal, camera relative
C EQ, of the plane through the eye and edge K, facing into the
C window. IMSKON = 1 if in_flags bit 5 asks for the mask and a
C cabin with windows is placed; IMSK = 1 while the outside draws
C and is masked (LAYERS, MDRALL).
INTEGER MWIN, MWV
C RESTOMOD: parenthesised PARAMETER list is FORTRAN 77 (1978)
PARAMETER (MWIN=8, MWV=8)
DOUBLE PRECISION WBV(3,MWV,MWIN), WPN(3,MWV,MWIN)
INTEGER NWIN, NWV(MWIN), WMOD(MWIN), WACT(MWIN), MDBLD
INTEGER IMSKON, IMSK
COMMON /CWIN/ WBV, WPN
COMMON /CWINI/ NWIN, NWV, WMOD, WACT, MDBLD, IMSKON, IMSK
C
C /COCC/ the cabins' hidden lines (vmask.f CBCUT; ours). The
C cabins' opaque faces as triangles: triangle J of model OCMOD(J)
C has corners OCV(1..3, K, J) in that model's body metres (OCPOLY,
C OCSTRP, as MLIB builds the cabins). Cabin IC (1 the CM's, KCMI;
C 2 the LM's, KLMI) is drawn as its NCP(IC) visible pieces
C CPL(1..6, J, IC), as LXL holds a free line, cut for its eye
C moved by COFF(1..3, IC) body metres; KCOK(IC) = 1 once cut.
C NOCX triangles and NCPX(IC) pieces were refused, the tables
C full: the selftest fails on any (its cabin tables line).
C OCTA, OCTB: CBCUT's work area, a line's hidden runs (OCCUT).
INTEGER MOC, MCP
C RESTOMOD BEGIN: parenthesised PARAMETER list is FORTRAN 77
C (1978); and about 21,400 words more of core for the cabins'
C hidden lines (2 words a DP number), on top of /CLM/'s two
C thirds of the 1108's 262,144 (docs/univac-1108.md).
PARAMETER (MOC=512, MCP=400)
DOUBLE PRECISION OCV(3,3,MOC), CPL(6,MCP,2), COFF(3,2)
DOUBLE PRECISION OCTA(MOC), OCTB(MOC)
INTEGER NOC, OCMOD(MOC), NCP(2), KCOK(2), NOCX, NCPX(2)
COMMON /COCC/ OCV, CPL, COFF, OCTA, OCTB
COMMON /COCCI/ NOC, OCMOD, NCP, KCOK, NOCX, NCPX
C RESTOMOD END
C
C /CVLAB/ work area of the vehicle labels (lvlab.f): the plot
C points of the model being labelled (VLPTS).
DOUBLE PRECISION VLPX(2400), VLPY(2400)
COMMON /CVLAB/ VLPX, VLPY
src/viewsit.inc
C The situation tables, row K for situation K (the scene number
C of view_init), filled from the SITUATION, RECIPE, VIEWS and
C HDRREF cards of the run decks by the card reader (vdksit.f; the
C code words are tools/gen_data.py's, in vdvoc.f). SITSET
C (vdrive.f) copies a row into /CSITU/ (viewcom.inc); the codes
C are listed there. SISN scenario; GET rule SIGK (1 g.e.t. SIGT,
C 2 event SIGE plus SIGT, 3 ERFIND's Earthrise plus SIGT); FOV
C rule SIFK (1 SIFV deg, 2 the disc fills SIFV of the frame);
C SILK default yaw, pitch, roll; SILY layers, ended by 0; SITN
C the recipe's reference turn; SIXY the external start offset;
C SIFE, SIFT, SIDT, SIEO the INERTIAL SIGHTLINE fix event, fix
C and drift intervals before it (s) and boresight offset (deg).
C MXSIT rows at most (ours), NSIT used; MXLAY layers a row.
INTEGER MXSIT, MXLAY, NSIT
C RESTOMOD: parenthesised PARAMETER list is FORTRAN 77 (1978)
PARAMETER (MXSIT=40, MXLAY=12)
INTEGER SISN(MXSIT), SIGK(MXSIT), SIGE(MXSIT), SIFK(MXSIT)
INTEGER SIWN(MXSIT), SIPS(MXSIT), SIDW(MXSIT), SIRC(MXSIT)
INTEGER SIBD(MXSIT), SIMD(MXSIT), SIAZ(MXSIT), SITR(MXSIT)
INTEGER SIFB(MXSIT), SIAT(MXSIT), SIFE(MXSIT), SIVH(MXSIT)
INTEGER SIVW(MXSIT), SITG(MXSIT), SITF(MXSIT), SIRD(MXSIT)
INTEGER SICM(MXSIT), SILM(MXSIT), SIFX(MXSIT), SIXO(MXSIT)
INTEGER SIHK(MXSIT), SILY(MXLAY,MXSIT)
DOUBLE PRECISION SIGT(MXSIT), SIFV(MXSIT), SIEL(MXSIT)
DOUBLE PRECISION SIFL(MXSIT), SIFT(MXSIT), SIDT(MXSIT)
DOUBLE PRECISION SIEO(MXSIT), SIAL(MXSIT), SIDS(MXSIT)
DOUBLE PRECISION SIHO(MXSIT), SIHR(MXSIT), SILK(3,MXSIT)
DOUBLE PRECISION SITN(3,MXSIT), SIXY(2,MXSIT)
COMMON /CSIT/ SIGT, SIFV, SIEL, SIFL, SIFT, SIDT, SIEO, SIAL,
& SIDS, SIHO, SIHR, SILK, SITN, SIXY
COMMON /CSITI/ SISN, SIGK, SIGE, SIFK, SIWN, SIPS, SIDW, SIRC,
& SIBD, SIMD, SIAZ, SITR, SIFB, SIAT, SIFE, SIVH,
& SIVW, SITG, SITF, SIRD, SICM, SILM, SIFX, SIXO,
& SIHK, SILY, NSIT
src/vdeck.inc
C The card reader's state (vdeck.f, vdkscn.f; #26), included after
C viewdims.inc, viewcom.inc, viewsit.inc and vdvoc.inc. Maxima are
C ours.
C
C /CDECK/ the card in hand: ICRD(1..NCRD) its character codes;
C ITKB its tokens with their quotes removed, token J at
C ITKB(TKS(J)) for TKL(J) codes, its value (after the first =) at
C TVS(J) for TVL(J) (TVL -1: no =); KCRD the card kind (Q...,
C vdvoc.inc), 0 if unknown; KSLT(K) the token holding key K
C (Y...), 0 if the card has none.
C The deck: IDKER the first deck error (0 none; codes in vdeck.f),
C IDKCD its card number, NDKWN warnings (unknown cards and keys,
C skipped), NDKCD cards read.
C The mission in hand (MISSION, EPOCH, SITE, PAD cards), copied into
C each scenario that follows: IMHV 0 none, 1 its MISSION card read,
C 2 its EPOCH too; MJD epoch, MSIT landing site lat, lon, azimuth,
C MPAD pad lat, lon, MPGC its latitude geocentric, MPCH its name (8
C codes). IDSN the scenario in hand (0 none), ISNHV(M) 1 once
C scenario M is read, SNCD(M) its SCENARIO card's number. IDST
C the situation in hand (0 none);
C ISTHV(K) the cards situation K has: 0 none, 1 its SITUATION, 2 its
C RECIPE, 3 its VIEWS, 4 its HDRREF; STCD(K) its SITUATION card's
C number.
C The open LEG TYPE=TABLE (ITBON 1): its scenario ITBSN, latitude
C type ITBGC, vehicle ITBVH, and NTBR ROW cards, TBR(1..7, J) T LAT
C LON ALT V FPA HDG and TBEF(J) 1 for VEL=EF.
C Timeline names, for the burn cues: row K's at TNCH(TLNS(K)) for
C TLNL(K) codes, NTNC used (MXTNC: MXTL names of 60 codes, today's
C longest). Burn cues read, resolved by CRDEND: NCQ of them,
C scenario CQSN, vehicle CQVH, engine CQEN, ignition row name at
C CQCH(CQIS) for CQIL codes, cutoff at CQCH(CQCS) for CQCL, card
C number CQCD; NCQC used. P10(K+1) = 10**K, K = 0 .. 22, exact.
C The open tape (vdktap.f; ITPON 1): its channel ITPCH, its TAPE
C card's number ITPCD.
INTEGER MXCRD, MXTOK, MXTBR, MXTNC, MXCQC
INTEGER ICBLK, ICTAB, ICCR, ICQUO, ICAPO, ICEQ, ICCOL, ICCOM
INTEGER ICPLS, ICMIN, ICPT, ICSTR, ICD0, ICD9, ICUA, ICUZ, ICUE
INTEGER ICLE, ICTIL
C RESTOMOD BEGIN: card images longer than 80 columns, in ASCII
C codes one per word (FIELDATA packed six to a 36-bit word, and had
C no lower case, tab or carriage return); the parenthesised
C PARAMETER list is FORTRAN 77 (1978).
PARAMETER (MXCRD=1024, MXTOK=48, MXTBR=60, MXTNC=90000,
& MXCQC=4000)
PARAMETER (ICBLK=32, ICTAB=9, ICCR=13, ICQUO=34, ICAPO=39,
& ICEQ=61, ICCOL=58, ICCOM=44, ICPLS=43, ICMIN=45,
& ICPT=46, ICSTR=42, ICD0=48, ICD9=57, ICUA=65, ICUZ=90,
& ICUE=69, ICLE=101, ICTIL=126)
C RESTOMOD END
INTEGER ICRD(MXCRD), NCRD, ITKB(MXCRD), NTOK, TKS(MXTOK)
INTEGER TKL(MXTOK), TVS(MXTOK), TVL(MXTOK), KCRD, KSLT(NVOCK)
INTEGER IDKER, IDKCD, NDKWN, NDKCD
INTEGER IMHV, MPGC, MPCH(8), IDSN, ISNHV(MXSN), SNCD(MXSN), IDST
INTEGER ISTHV(MXSIT), STCD(MXSIT)
INTEGER ITBON, ITBSN, ITBGC, ITBVH, NTBR, TBEF(MXTBR)
INTEGER TLNS(MXTL), TLNL(MXTL), NTNC, TNCH(MXTNC)
INTEGER NCQ, CQSN(MXCUE), CQVH(MXCUE), CQEN(MXCUE), CQIS(MXCUE)
INTEGER CQIL(MXCUE), CQCS(MXCUE), CQCL(MXCUE), CQCD(MXCUE), NCQC
INTEGER CQCH(MXCQC), ITPON, ITPCH, ITPCD
DOUBLE PRECISION MJD, MSIT(3), MPAD(2), TBR(7,MXTBR), P10(23)
COMMON /CDECK/ ICRD, NCRD, ITKB, NTOK, TKS, TKL, TVS, TVL, KCRD,
& KSLT, IDKER, IDKCD, NDKWN, NDKCD, IMHV, MPGC, MPCH,
& IDSN, ISNHV, SNCD, IDST, ISTHV, STCD, ITBON, ITBSN,
& ITBGC, ITBVH, NTBR, TBEF, TLNS, TLNL, NTNC, TNCH,
& NCQ, CQSN, CQVH, CQEN, CQIS, CQIL, CQCS, CQCL,
& CQCD, NCQC, CQCH, ITPON, ITPCH, ITPCD
COMMON /CDECKD/ MJD, MSIT, MPAD, TBR, P10
src/vdvoc.inc
C Generated by tools/gen_data.py from its card tables. Do not edit.
C The card reader's vocabulary (src/vdeck.f; layout in
C tools/gen_data.py write_vocab): the lists, their numbers in
C VOCLST, and the codes of the card kinds (Q...) and keys (Y...).
INTEGER NVOCC, NVOCW, NVOCL
C RESTOMOD BEGIN: parenthesised PARAMETER list is FORTRAN 77 (1978)
PARAMETER (NVOCC=946, NVOCW=220, NVOCL=29)
INTEGER NVOCK
PARAMETER (NVOCK=84)
INTEGER VCARD, VKEY, VLEGT, VLVEH, VLATT
PARAMETER (VCARD=1, VKEY=2, VLEGT=3, VLVEH=4, VLATT=5)
INTEGER VVEL, VEVK, VTLK, VBODY, VBVEH
PARAMETER (VVEL=6, VEVK=7, VTLK=8, VBODY=9, VBVEH=10)
INTEGER VBENG, VGRUL, VFOVR, VWIN, VLAYR
PARAMETER (VBENG=11, VGRUL=12, VFOVR=13, VWIN=14, VLAYR=15)
INTEGER VPOSE, VDRAW, VRCP, VMODE, VAZ
PARAMETER (VPOSE=16, VDRAW=17, VRCP=18, VMODE=19, VAZ=20)
INTEGER VOFFL, VATT, VCRV, VVIEW, VTGT
PARAMETER (VOFFL=21, VATT=22, VCRV=23, VVIEW=24, VTGT=25)
INTEGER VRIDE, VSTN, VYN, VHDR
PARAMETER (VRIDE=26, VSTN=27, VYN=28, VHDR=29)
INTEGER QMISSI, QSCENA, QEPOCH, QSITE
PARAMETER (QMISSI=1, QSCENA=2, QEPOCH=3, QSITE=4)
INTEGER QPAD, QLEG, QROW, QEVENT
PARAMETER (QPAD=5, QLEG=6, QROW=7, QEVENT=8)
INTEGER QTIMEL, QSTART, QREF, QBURN
PARAMETER (QTIMEL=9, QSTART=10, QREF=11, QBURN=12)
INTEGER QBURNC, QSITUA, QRECIP, QVIEWS
PARAMETER (QBURNC=13, QSITUA=14, QRECIP=15, QVIEWS=16)
INTEGER QHDRRE, QSPAN, QREEL, QSHOT
PARAMETER (QHDRRE=17, QSPAN=18, QREEL=19, QSHOT=20)
INTEGER QTAPE, YNAME, YSRC, YID
PARAMETER (QTAPE=21, YNAME=1, YSRC=2, YID=3)
INTEGER YJD, YAZ, YLAT, YLON
PARAMETER (YJD=4, YAZ=5, YLAT=6, YLON=7)
INTEGER YLATTY, YALT, YALTB, YDV
PARAMETER (YLATTY=8, YALT=9, YALTB=10, YDV=11)
INTEGER YFPA, YFROM, YHDG, YLATB
PARAMETER (YFPA=12, YFROM=13, YHDG=14, YLATB=15)
INTEGER YLONB, YN, YP, YR
PARAMETER (YLONB=16, YN=17, YP=18, YR=19)
INTEGER YT, YTB, YTO, YTYPE
PARAMETER (YT=20, YTB=21, YTO=22, YTYPE=23)
INTEGER YV, YVEH, YVEL, YKIND
PARAMETER (YV=24, YVEH=25, YVEL=26, YKIND=27)
INTEGER YBODY, YEND, YCUT, YENG
PARAMETER (YBODY=28, YEND=29, YCUT=30, YENG=31)
INTEGER YIGN, YCAPTI, YDRAW, YFOV
PARAMETER (YIGN=32, YCAPTI=33, YDRAW=34, YFOV=35)
INTEGER YGET, YLAYER, YLOOK, YPOSE
PARAMETER (YGET=36, YLAYER=37, YLOOK=38, YPOSE=39)
INTEGER YTITLE, YWINDO, YAT, YATT
PARAMETER (YTITLE=40, YWINDO=41, YAT=42, YATT=43)
INTEGER YDIST, YDRIFT, YELEV, YELOFF
PARAMETER (YDIST=44, YDRIFT=45, YELEV=46, YELOFF=47)
INTEGER YFIX, YMODE, YOFFEL, YOFFLE
PARAMETER (YFIX=48, YMODE=49, YOFFEL=50, YOFFLE=51)
INTEGER YTURN, YCM, YFIXED, YLM
PARAMETER (YTURN=52, YCM=53, YFIXED=54, YLM=55)
INTEGER YOFFTA, YRIDES, YTARGE, YVIEW
PARAMETER (YOFFTA=56, YRIDES=57, YTARGE=58, YVIEW=59)
INTEGER YXSTAR, YOBJ, YOFFSE, YRADIU
PARAMETER (YXSTAR=60, YOBJ=61, YOFFSE=62, YRADIU=63)
INTEGER YBUTTO, YLEN, YSIT, YTRACK
PARAMETER (YBUTTO=64, YLEN=65, YSIT=66, YTRACK=67)
INTEGER YUNTIL, YALIAS, YFADE, YFILM
PARAMETER (YUNTIL=68, YALIAS=69, YFADE=70, YFILM=71)
INTEGER YNEXT, YTAG, YDUR, YFRAME
PARAMETER (YNEXT=72, YTAG=73, YDUR=74, YFRAME=75)
INTEGER YLABEL, YLIMB, YPITCH, YRATE
PARAMETER (YLABEL=76, YLIMB=77, YPITCH=78, YRATE=79)
INTEGER YROLL, YTTE, YYAW, YCHAN
PARAMETER (YROLL=80, YTTE=81, YYAW=82, YCHAN=83)
INTEGER YSCN
PARAMETER (YSCN=84)
C RESTOMOD END
INTEGER VOCC(NVOCC), VOCS(NVOCW), VOCN(NVOCW), VOCV(NVOCW)
C KYCARD(K): the card kinds that take key K, bit Q-1 for kind Q.
INTEGER VOCLST(NVOCL+1), KYCARD(NVOCK)
COMMON /CDVOC/ VOCC, VOCS, VOCN, VOCV, VOCLST, KYCARD