The re-engineered code is shown below. The changes are:
A header has been added to record when and how the code was processed;
A USE statement has been inserted for the emulation module;
The declarations of the real variables have been changed to the emulated derived type em_real_k8;
The parameter values have been converted to objects of the derived type em_real_k8;
The code has been reformatted to Fortran free format.
The engineering tool, fpt, could have left the code in fixed format. It was changed to free format in case we had to do anything else with it!
!H!****************************************************************************
!H! File: ../fpt_output/met_rocket.f90
!H! Output by FPT 3.8-j Intel-Linux On 23-SEP-15 At 17:14: 9 Input files:
!H! Main: ...ypt1/fpt/emulated_reals/met_rocket/fpt/met_rocket_precision.fsp
!H! Current: ...ypt1/fpt/emulated_reals/met_rocket/original_source/met_rocket.f
!H! Licensee: SimCon: Development version.
!H!****************************************************************************
! *****************************************************************************
! met_rocket.for 13-Jul-06 Stephen Day Mandy et al
! 18-Oct-06 John Collins
!
! *****************************************************************************
! 18-Oct-06 John Collins Removed the (very few) F90 features
! *****************************************************************************
!
PROGRAM met_rocket
!
!
USE module_emulate_real_arithmetic
!
IMPLICIT NONE
!
! *****************************************************************************
!
TYPE(em_real_k4) &
g &
,p_burn_time &
,p_burn_thrust &
,p_initial_mass &
,p_stage_2_mass &
,p_fuel_mass &
,p_launch_vel &
,frametime
PARAMETER( &
g = em_real_k4( 0.322000000000000028E+02) & ! fpsps
!--------------------------------------------------^---------------------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
, p_burn_time = em_real_k4( 0.210999999999999988E+01) & ! secs
!------------------------------------------------------------^-----------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
, p_burn_thrust = em_real_k4( 0.129476200000000012E+06) & ! lb-ft
!--------------------------------------------------------------^---------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
, p_initial_mass = em_real_k4( 0.672000000000000028E+02) & ! lb
!---------------------------------------------------------------^--------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
, p_stage_2_mass = em_real_k4( 0.1E+02) & ! lb
!----------------------------------------------^-------------------------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
, p_fuel_mass = em_real_k4( 0.376000000000000014E+02) & ! lb
!------------------------------------------------------------^-----------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
, p_launch_vel = em_real_k4(190.0) & ! fps
, frametime = em_real_k4( 0.100000000000000002E-02) & ! secs
!----------------------------------------------------------^-------------------
!!! FPT - 3769 Symbol or expression replaced by numeric value
!------------------------------------------------------------------------------
)
!
INTEGER &
frame &
, monitor_interval &
, stage & ! Stage, before/after separation
, u ! Logical unit number
!
TYPE(em_real_k4) &
dtr &
,time &
,xdd & ! Down range acceleration, fpsps
,xd & ! Down range velocity, f/s
,x & ! Down range distance, ft
,pxdd & ! Last frame accelleration
,pxd & ! Last frame velocity
,hdd & ! Height acceleration, fpsps
,hd & ! Height velocity, fps
,h & ! Height, ft
,phdd & ! Last frame height acceleration
,phd & ! Last frame height velocity
,theta & ! Angle of flight to ground, radians
,thetad & ! Launch angle to ground, degrees
,thrust &
,mass & ! lb
,drag &
,vel & ! Direction of flight
,atm_pressure & ! Atmospheres
,c_drag(2,2) ! Drag coeff, linear/quad, stage 1/2
!
! *****************************************************************************
!
OPEN(UNIT = 7,FILE = 'met_rocket.txt',STATUS = 'UNKNOWN')
DO u = 6,7
WRITE(u,'(/,''Met Rocket Simulation'')')
WRITE(u,'(''====================='',/)')
ENDDO
WRITE(6,'(''The program writes the output data to the file '' &
&,''met_rocket.txt in the current'',/,''directory. '' &
&,''Edit the program as marked to get interactice '' &
&,''control of all of'',/,''the parameters'',/)')
!
! Initial conditions
dtr = ATAN(1.0D0)/45.0D0
frame = 0
time = 0.0D0
hdd = 0.0D0
hd = 0.0D0
h = 0.0D0
xdd = 0.0D0
xd = 0.0D0
x = 0.0D0
phdd = 0.0D0
phd = 0.0D0
pxdd = 0.0D0
pxd = 0.0D0
!
! Un-comment lines beginning CCC to control drag parameters
! =========================================================
!
WRITE(6,'(''Launch angle (degrees): '',$)')
READ(5,*)thetad
theta = thetad*dtr
!
c_drag(1,1) = 0.0D0
c_drag(2,1) = 0.0008D0
c_drag(1,2) = 0.0D0
c_drag(2,2) = 0.00021D0
monitor_interval = 1000
!
!CC WRITE(6,'(''Drag stage 1 linear coeff: '',$)')
!CC READ(5,*)c_drag(1,1)
!CC WRITE(6,'(''Drag stage 1 quadratic coeff: '',$)')
!CC READ(5,*)c_drag(2,1)
!CC WRITE(6,'(''Drag stage 2 linear coeff: '',$)')
!CC READ(5,*)c_drag(1,2)
!CC WRITE(6,'(''Drag stage 2 quadratic coeff: '',$)')
!CC READ(5,*)c_drag(2,2)
!CC WRITE(6,'(''Monitor interval: '',$)')
!CC READ(5,*)monitor_interval
!
WRITE(7,'(''Lanch angle:'',T32,F12.2)')thetad
WRITE(7,'(''Drag coefficients'')')
WRITE(7,'('' Stage 1 linear:'',T32,F12.6)')c_drag(1,1)
WRITE(7,'('' Stage 1 quadratic:'',T32,F12.6)')c_drag(2,1)
WRITE(7,'('' Stage 2 linear:'',T32,F12.6)')c_drag(1,2)
WRITE(7,'('' Stage 2 quadratic:'',T32,F12.6,/)')c_drag(2,2)
!
! *****************************************************************************
!
DO WHILE(theta.GE.0.0D0)
frame = frame+1
!
IF(time.LE.p_burn_time)THEN
stage = 1
mass = p_initial_mass- &
MAX(p_fuel_mass*(time/p_burn_time),0.0)
thrust = p_burn_thrust
ELSE
stage = 2
mass = p_stage_2_mass
thrust = 0.0D0
ENDIF
!
! Pressure in atmospheres
atm_pressure = 10.0D0**(-h/50850.0D0)
!
vel = SQRT(xd*xd+hd*hd)
! Assume drag is linear with pressure and quadratic with velocity
drag = atm_pressure* &
(c_drag(2,stage)*vel**2+c_drag(1,stage)*vel)
!
xdd = ((thrust-drag)/mass)*COS(theta)
hdd = ((thrust-drag)/mass)*SIN(theta)-g
!
! Trapezoidal integration - AB2
xd = xd+frametime*(2*xdd-pxdd)
hd = hd+frametime*(2*hdd-phdd)
pxdd = xdd
phdd = hdd
x = x+frametime*(2*xd-pxd)
h = h+frametime*(2*hd-phd)
pxd = xd
phd = hd
IF(vel.GT.p_launch_vel)THEN
theta = ATAN2(hd,xd)
ENDIF
time = time+frametime
!
IF(frame.EQ.monitor_interval*(frame/monitor_interval))THEN
DO u = 6,7
WRITE(u,'(/,''Frame:'',I8,'' Time:'',F10.2 &
&,'' Theta:'',F10.2,'' Pressure:'',F10.4)') &
frame,time,theta/dtr,atm_pressure
WRITE(u,'('' h '' &
&,'' hd '' &
&,'' hdd '' &
&,'' x '' &
&,'' xd '' &
&,'' xdd '' &
&)')
WRITE(u,'(6F13.5)')h,hd,hdd,x,xd,xdd
ENDDO
!CC WRITE (6,'(''