!******************************************************************************
!
!    pbinarymodel.f95 (part of doptomog package v2.0)
!    Copyright (C) 2015  Enrico J. Kotze ejk@saao.ac.za
!
!    This program is free software: you can redistribute it and/or modify
!    it under the terms of the GNU General Public License as published by
!    the Free Software Foundation, either version 3 of the License, or
!    (at your option) any later version.
!
!    This program is distributed in the hope that it will be useful,
!    but WITHOUT ANY WARRANTY; without even the implied warranty of
!    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!    GNU General Public License for more details.
!
!    You should have received a copy of the GNU General Public License
!    along with this program.  If not, see <http://www.gnu.org/licenses/>.
!
!******************************************************************************
program pbinarymodel
!******************************************************************************

!******************************************************************************
	use mconstants
	use mfunctions
	use mbinarymodel
	implicit none

	integer											::	i
	character(len=255)								::	arg

	! current working directory
	call getcwd(cwd)

	! input parameters from command line 
	do i = 1, command_argument_count()
		call get_command_argument(i, arg)
		if (i == 1) read(arg, *) IDL
		if (i == 2) read(arg, '(a)') inpath
		if (i == 3) read(arg, '(a)') outpath
		! ... that's it for now...
	end do

	! input parameters from 'binarymodel.in'
	call inputParameters()

	! calculate binary parameters
	call binaryParameters()

	! calculate and output binary centres of mass
	call centresOfMass()

	! calculate and output binary Roche lobes velocity and spatial coordinates
	call rocheLobes()

	! calculate and output ballistic stream velocity and spatial coordinates
	call ballisticStream()

	! calculate and output accretion disc velocity and spatial coordinates
	call accretionDisc()

	! calculate and output magnetic stream velocity and spatial coordinates
	call magneticStream()

	! calculate and output Keplerian trace velocity coordinates
	call keplerianTrace()

	! calculate and output general velocity information
	call velocityInfo()

	! output parameters for plotting routines
	call outputParameters()

!******************************************************************************
contains	
!******************************************************************************

!******************************************************************************

!******************************************************************************
	subroutine inputParameters()

		! get input from 'binarymodel.in'
		open(unit = 1, file = trim(inpath)//'binarymodel.in')
		read(1, *) mCV
		read(1, *) M1
		read(1, *) qm
		read(1, *) inc
		read(1, *) Porb
		read(1, *) Pspin
		read(1, *) azE
		read(1, *) azMs
		read(1, *) azMe
		read(1, *) azMi
		read(1, *) Psi
		read(1, *) beta

		read(1, *) vDi
		read(1, *) cmInd

		close(1)

		! validate mass ratio qm
		if (abs(qm - 1) < 1e-4) qm = 1e-4
		! validate input for magnetic stuff...
		if (mCV >= 1) then
			if (Pspin == 0d0) Pspin = Porb
			if (mCV == 1 .and. azE < azMe) azE = azMe
			if (azMi == 0.) then
				call nrerror('inputParameters: check magnetic related input!')
			end if
		end if

		! 360 degree array
		do i = 0, nDp
			theta360(i) = twoPI * float(i) / float(nDp)
		end do

		return

	end subroutine inputParameters
!******************************************************************************

!******************************************************************************
	subroutine binaryParameters()

		real(kind(1d0))	::	Omega

		! system centre of mass
		comSys = qm / (1. + qm)
		! assumed centre of mass
		com = 0.; if (cmInd == 0) com = comSys
		comAdj = com - comSys
		! sine of the inclination in radians
		sini = sin(inc * PI / 180.)
		! angular velocity = 2*PI / orbital period in seconds
		Omega = twoPI / (86400. * Porb)
		! binary separation
		aa = (GC * M1 * MSun * (1. + qm))**(1. / 3.) / Omega**(2. / 3.)
		! binary velocity scaling factor
		bvs = aa * Omega / vf

		return

	end subroutine binaryParameters
!******************************************************************************

!******************************************************************************
	subroutine centresOfMass()

		! initialise centres of mass spatial and velocity coordinates
		sCOM = 0.; vCOM = 0.
		! system centre of mass: x spatial and y velocity coordinates
		sCOM(0,x) = comSys - com
		vCOM(0,y) = (comSys - com) * bvs * sini
		! primary centre of mass: x spatial and y velocity coordinates
		sCOM(1,x) = 0. - com
		vCOM(1,y) = (0. - com) * bvs * sini
		! secondary centre of mass: x spatial and y velocity coordinates
		sCOM(2,x) = 1. - com
		vCOM(2,y) = (1. - com) * bvs * sini
		! output centres of mass velocity and spatial coordinates
		call centresOfMassOutput()

		return

	end subroutine centresOfMass
!******************************************************************************

!******************************************************************************
	subroutine centresOfMassOutput()

		integer										::	i, funit

		! open output files
		call centresOfMassOutputFiles()
		! loop for system(0), primary(1) and secondary(2) centres of mass
		do i = 0, 2
			if (i == 0) funit = 1
			if (i > 0) funit = 3
			! calculate polar velocity coordinates for centre of mass
			call polarCoords(vCOM(i,x), vCOM(i,y), theta, v)
			! write velocity coordinates for centre of mass to file
			call outputEntry(funit, 1, 1, vCOM(i,x), vCOM(i,y), 0d0, theta, 0d0, v)
			! write spatial coordinates for centre of mass to file
			call outputEntry(funit + 1, 2, 1, sCOM(i,x), sCOM(i,y), 0d0)
		end do
		! close output files
		call closeOutputFiles()

		return

	end subroutine centresOfMassOutput
!******************************************************************************

!******************************************************************************
	subroutine centresOfMassOutputFiles()

		! system com velocity coordinates
		open(unit = 1, file = trim(outpath)//'vCOM.out')
		call outputHeader(1, 1)
		! system com spatial coordinates
		open(unit = 2, file = trim(outpath)//'sCOM.out')
		call outputHeader(2, 2)
		! primary and secondary velocity coordinates relative to system com
		open(unit = 3, file = trim(outpath)//'vBinary.out')
		call outputHeader(3, 1)
		! primary and secondary spatial coordinates relative to system com
		open(unit = 4, file = trim(outpath)//'sBinary.out')
		call outputHeader(4, 2)
		! # of output files
		nF = 4

		return

	end subroutine centresOfMassOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine rocheLobes()

		real(kind(1d0)), dimension(nRl)				::	xRlm, yRlm
		real(kind(1d0)), dimension(nRl)				::	vxRlm, vyRlm
		real(kind(1d0)), dimension(3,nRl,0:nDp)		::	sXYZ
		real(kind(1d0))								::	qS, rS
		integer										::	m, n, i, j

		n = nRl / 2
		! allocate dimension to xRl(:,:), yRl(:,:), rRl(:,:), chi(:), phi(:)
		allocate(xRl(2,nRl), yRl(2,nRl), rRl(n,n), chi(n), phi(n))
		! calculate RL1 [a] from centre of primary to inner Lagrangian point
		call calculateRL1()
		! initialise 3D spatial coordinate array
		sXYZ = 0.
		! loop for # of Roche lobes: primary (M1), secondary (M2)
		do m = 1, 2
			! mass ratio and radius for Roche surface
			if (m == 1) qS = 1 / qm
			if (m == 2) qS = qm
			if (m == 1) rS = 1 - RL1
			if (m == 2) rS = RL1
			! calculate Roche surface
			call rocheSurface(qS, rS)
			! populate spatial x and y arrays
			do i = 1, n
				xRl(m,i) = rRl(i,1) * cos(chi(i))
				if (m == 2) xRl(m,i) = 1d0 - xRl(m,i)
				yRl(m,i) = rRl(i,1) * sin(chi(i))
				if (m == 2) yRl(m,i) = 0d0 - yRl(m,i)
				j = nRl + 1 - i
				xRl(m,j) = xRl(m,i)
				yRl(m,j) = 0d0 - yRl(m,i)
			end do
			! spatial coordinates of Roche lobe
			! adjust x coordinates with assumed system com
			xRlm = xRl(m,1:nRl) - com
			yRlm = yRl(m,1:nRl)
			! 3D spatial coordinates
			do i = 1, nRl / 2 + 1
				do j = 0, nDp, 12
					sXYZ(x,i,j) = xRlm(i)
					sXYZ(y,i,j) = yRlm(i) * cos(theta360(j))
					sXYZ(z,i,j) = yRlm(i) * sin(theta360(j))
				end do
			end do
			! velocity coordinates of Roche lobe
			vxRlm = xRlm * bvs * sini
			vyRlm = yRlm * bvs * sini
			! output Roche lobe velocity and spatial coordinates
			call rocheLobesOutput(m, vxRlm, vyRlm, xRlm, yRlm, sXYZ)
		end do

		return

	end subroutine rocheLobes
!******************************************************************************

!******************************************************************************
	subroutine rocheSurface(qS, rS)

		! Roche surface around M1 and M2, coordinates on surface are chi, phi.
		! qS: mass ratio for surface,
		! rS: radius of surface at point facing surface
		real(kind(1d0)), intent(in)					::	qS, rS
		! max no of iterations
		integer, parameter							::	im = 20
		character(len=50)							::	msg = '', frmt = ''
		real(kind(1d0))								::	rS0, fS0, fS, rRl0
		real(kind(1d0))								::	x, y, z, r0, pR
		integer										::	i, j, k, n

		rRl = 0d0; chi = 0d0; phi = 0d0

		n = nRl / 2
		rS0 = 1 - rS
		call rochePotential(qS, rS0, 0d0, 0d0, pR, fS0)
		rRl0 = (1 - PI / n) * rS0

		do i = 1, n
			phi(i) = twoPI * float(i - 1) / n
			rRl(1,i) = rS0
			do j = 2, n
				chi(j) = PI * float(j - 1) / (n - 1)
				x = cos(chi(j))
				y = sin(chi(j)) * cos(phi(i))
				z = sin(chi(j)) * sin(phi(i))
				k = 0
				fS = 1d0
				do while (k < im .and. abs(fS - fS0) > 1e-4)
					k = k + 1
					r0 = rRl0
					call rochePotential(qS, r0 * x, r0 * y, r0 * z, pR, fS)
					rRl0 = r0 - (fS - fS0) / pr
					if (rRl0 > rS0) rRl0 = rS0
				end do
				if (k >= im) then
					frmt = '('' j, i, chi, phi'', 2i4, 2f7.3)'
					write(msg, trim(frmt)) j, i, chi(j), phi(i)
					call nrerror('no convergence in rocheSurface:'//msg)
				end if
				rRl(j,i) = rRl0
			end do
		end do

		return

	end subroutine rocheSurface
!******************************************************************************
	
!******************************************************************************
	subroutine rochePotential(qS, x, y, z, pR, fS)

		! Roche potential: coordinates centered on Roche surface
		! pR is gradient in radius from Roche surface
		! fS is Roche potential at Roche surface
		real(kind(1d0)), intent(in)					::	qS, x, y, z
		real(kind(1d0)), intent(out)				::	pR, fS
		real(kind(1d0))								::	r, r1, r2, rh, st, cf

		! first transform to spherical coordinates w/r rotation axis
		r = sqrt(x**2 + y**2 + z**2)
		if (r == 0) call nrerror('r = 0 in rochePotential')
		rh = sqrt(x**2 + y**2)
		st = rh / r
		if (rh == 0) then
			cf = 1
		else
			cf = x / rh
		end if
		r1 = sqrt(1 + r**2 - 2 * r * cf * st)
		r2 = 1 / (1 + qS)
		fS = -1 / r - 1 / qS / r1 - 0.5 * (1 + 1 / qS) * &
			(r2**2 + (r * st)**2 - 2 * r2 * r * cf * st)
		pR = 1 / r**2 + 1 / qS / (r1**3) * (r - cf * st) - &
			(1 + 1 / qS) * (r * st**2 - r2 * cf * st)

		return

	end subroutine rochePotential
!******************************************************************************

!******************************************************************************
	subroutine rocheLobesOutput(m, vxRl, vyRl, xRl, yRl, sXYZ)

		integer, intent(in) 						::	m
		real(kind(1d0)), dimension(nRl), intent(in)	::	vxRl, vyRl, xRl, yRl
		real(kind(1d0)), dimension(3,nRl,0:nDp), intent(in)	::	sXYZ
		integer 									::	i, j

		! open output files
		call rocheLobesOutputFiles(m)
		! velocity and spatial coordinates
		do i = 1, nRl, 2
			! calculate polar velocity coordinates for Roche lobe
			call polarCoords(vyRl(i), vxRl(i), theta, v)
			! write velocity coordinates to file
			call outputEntry(1, 1, 0, vyRl(i), vxRl(i), 0d0, theta, 0d0, v)
			! write spatial coordinates to file
			call outputEntry(2, 2, 0, xRl(i), yRl(i), 0d0)
		end do
		! 3D spatial coordinates
		do i = 1, nRl / 2 + 1, 12
			do j = 0, nDp, 12
				! write 3D spatial coordinates to file
				call outputEntry(3, 2, 0, sXYZ(x,i,j), sXYZ(y,i,j), sXYZ(z,i,j))
			end do
			if (IDL == 0) write(3, '(a1)') ''
		end do
		! close output files
		call closeOutputFiles()

		return

	end subroutine rocheLobesOutput
!******************************************************************************

!******************************************************************************
	subroutine rocheLobesOutputFiles(m)

		integer, intent(in) 						::	m
		character(len=10)							::	theLobe

		! set file name
		if (m == 1) theLobe = 'Primary'
		if (m == 2) theLobe = 'Secondary'
		! Roche lobe velocity coordinates
		open(unit = 1, file = trim(outpath)//'v'//trim(theLobe)//'.out')
		call outputHeader(1, 1)
		! Roche lobe spatial coordinates
		open(unit = 2, file = trim(outpath)//'s'//trim(theLobe)//'.out')
		call outputHeader(2, 2)
		! Roche lobe 3D spatial coordinates
		open(unit = 3, file = trim(outpath)//'s3D'//trim(theLobe)//'.out')
		call outputHeader(3, 2)
		! # of output files
		nF = 3

		return

	end subroutine rocheLobesOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine ballisticStream()

		real(kind(1d0)), dimension(nMax)			::	xB, yB, rB
		complex(kind(1d0)), dimension(nMax)			::	vB, vKB
		complex(kind(1d0))							::	s, w, sp, wp, sM1, sM2
		complex(kind(1d0))							::	ds, dw, wK, wI, ur
		real(kind(1d0))								::	phase, dphase, vK, rK
		! t = time and dt = time increment
		real(kind(1d0))								::	t = 0d0, dt = 1e-5
		real(kind(1d0))								::	azMax

		! spatial coordinates of M1 and M2
		sM1 = 0d0 - comSys; sM2 = 1 - comSys
		! start at L1 - eps with zero velocity
		s = cmplx(RL1 - comSys - eps, 0); ds = 0d0
		w = 0d0; dw = 0d0
		! initialise loop variables: nBs (count) and phase
		nBs = 0; phase = 0d0
		! loop until max # of array points or max phase
		do while(nBs < nMax .and. phase < phaseMax)
			! increment count
			nBs = nBs + 1
			! calculate position and velocity
			call rungeKutta(dt, s, w, sM1, sM2, ds, dw)
			! add deltas
			s = s + ds; w = w + dw; t = t + dt
			! update time increment dt, if necessary
			if (abs(ds) / abs(s) > 0.020) dt = dt / 2
			if (abs(ds) / abs(s) < 0.005) dt = 2 * dt
			! calculate delta phase and increment phase
			dphase = -aimag(s * conjg(s - ds)) / abs(s) / abs(s - ds)
			phase = phase + dphase
			! velocity in inertial frame
			wI = w + cmplx(0, 1) * s
			! vector normal to circular Kepler orbit
			rK = abs(s - sM1)
			! unit vector in rK
			ur = conjg(s - sM1) / rK
			! Kepler velocity in potential of M1, relative to M1
			vK = 1 / sqrt(rK * (1 + qm))
			! same but relative to comSys, i.e., velocity in inertial frame
			wK = -vK * ur * cmplx(0, 1) + conjg(cmplx(0, -comSys))
			! populate work arrays
			xB(nBs) = s + comSys
			yB(nBs) = -aimag(s)
			vB(nBs) = wI								
			vKB(nBs) = conjg(wK)
		end do
		! allocate dimensions to output arrays
		allocate(xBs(nBs), yBs(nBs), vxBs(nBs), vyBs(nBs), vxKt(nBs), vyKt(nBs))
		! populate output arrays
		xBs = xB(1:nBs); yBs = yB(1:nBs)
		vxBs = real(vB(1:nBs)); vyBs = aimag(vB(1:nBs))
		vxKt = real(vKB(1:nBs)); vyKt = aimag(vKB(1:nBs))
		! 'negatise' ballistic stream y spatial coordinates
		yBs = -yBs
		! velocity coordinates of ballistic stream
		vxBs = vxBs * bvs * sini
		vyBs = (vyBs - comAdj) * bvs * sini
		! calculate ballistic stream azimuth measured from line M1-M2
		allocate(azBs(nBs))
		azBs = atan(yBs / xBs)
		azBs = azBs + merge(1, 0, xBs < 0.) * PI
		azBs = azBs * 180. / PI
		azMax = min(265., azE)
		! determine # of points for ballistic stream up to required azimuth
		nBa = 0
		do while (azBs(nBa + 1) < (azMax + 1.) .and. (nBa + 1) < (nBs - 1))
			nBa = nBa + 1
		end do
		! output ballistic stream velocity and spatial coordinates
		call ballisticStreamOutput()

		return

	end subroutine ballisticStream
!******************************************************************************

!******************************************************************************
	subroutine rungeKutta(dt, s, w, sM1, sM2, ds, dw)

		! Runge-Kutta...
		real(kind(1d0)), intent(in)			::	dt
		complex(kind(1d0)), intent(in)		::	s, w, sM1, sM2
		complex(kind(1d0)), intent(out)		::	ds, dw
		complex(kind(1d0))					::	sp, sa, wp, wa
		complex(kind(1d0))					::	hs0, hs1, hs2, hs3
		complex(kind(1d0))					::	hw0, hw1, hw2, hw3

		sa = s
		wa = w
		call equationOfMotion(sa, wa, sM1, sM2, sp, wp)
		hs0 = sp * dt
		hw0 = wp * dt

		sa = s + hs0 / 2
		wa = w + hw0 / 2
		call equationOfMotion(sa, wa, sM1, sM2, sp, wp)
		hs1 = sp * dt
		hw1 = wp * dt

		sa = s + hs1 / 2
		wa = w + hw1 / 2
		call equationOfMotion(sa, wa, sM1, sM2, sp, wp)
		hs2 = sp * dt
		hw2 = wp * dt

		sa = s + hs2
		wa = w + hw2
		call equationOfMotion(sa, wa, sM1, sM2, sp, wp)
		hs3 = sp * dt
		hw3 = wp * dt

		ds = (hs0 + 2 * hs1 + 2 * hs2 + hs3) / 6
		dw = (hw0 + 2 * hw1 + 2 * hw2 + hw3) / 6

		return

	end subroutine rungeKutta
!******************************************************************************

!******************************************************************************
	subroutine equationOfMotion(s, w, sM1, sM2, sp, wp)

		! equation of motion routine
		complex(kind(1d0)), intent(in)		::	s, w, sM1, sM2
		complex(kind(1d0)), intent(out)		::	sp, wp
		complex(kind(1d0))					::	s1, s2

		sp = w
		s1 = s - sM1
		s2 = s - sM2
		! change in velocity under gravity and Coriolis force
		wp = s - (s1 / (abs(s1))**3 + qm * s2 / (abs(s2))**3) / (1 + qm) &
			- cmplx(0, 2) * w
		! ... and magnetic drag for polars
		if (mCV == 1) wp = wp - exp(-sqrt(s1**2 + s2**2)) * w

		return

	end subroutine equationOfMotion
!******************************************************************************

!******************************************************************************
	subroutine ballisticStreamOutput()

		integer										::	i

		! open output files
		call ballisticStreamOutputFiles()
		! ballistic stream velocity and spatial coordinates
		do i = 1, nBa
			! calculate polar velocity coordinates for ballistic stream
			call polarCoords(vxBs(i), vyBs(i), theta, v)
			! write velocity coordinates to file
			call outputEntry(1, 1, 0, vxBs(i), vyBs(i), 0d0, theta, 0d0, v)
			! write spatial coordinates to file
			! adjust x coordinates with assumed system com
			call outputEntry(2, 2, 0, xBs(i) - com, yBs(i), 0d0)
		end do
		! ballistic stream ALL spatial coordinates
		do i = 1, nBs
			! write spatial coordinates to file
			! adjust x coordinates with assumed system com
			call outputEntry(3, 2, 0, xBs(i) - com, yBs(i), 0d0)
		end do
		! close output files
		call closeOutputFiles()

		return

	end subroutine ballisticStreamOutput
!******************************************************************************

!******************************************************************************
	subroutine ballisticStreamOutputFiles()

		! ballistic stream velocity coordinates
		open(unit = 1, file = trim(outpath)//'vStreamBal.out')
		call outputHeader(1, 1)
		! ballistic stream spatial coordinates
		open(unit = 2, file = trim(outpath)//'sStreamBal.out')
		call outputHeader(2, 2)
		! ballistic stream spatial coordinates (all)
		open(unit = 3, file = trim(outpath)//'sStreamAll.out')
		call outputHeader(3, 2)
		! # of output files
		nF = 3

		return

	end subroutine ballisticStreamOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine accretionDisc()

		real(kind(1d0))								::	vK, Rs
		integer										::	i, j

		if (mCV== 0 .or. mCV == 2) then
			rAd = 0d0
			! calculate inner disc radius [binary separation] (Eq 2.81 Warner 1995)
			if (vDi > 0d0) rAd(1) = (GC * M1 * MSun * sini**2 / (vDi * vf)**2) / aa
			! calculate outer disc radius [binary separation]
			if (qm <= 0.3) then
				! 3:1 resonance (Eq 3.39 Warner 1995 -- P = Porb / 3)
				rAd(nAd) = round((1./3.)**(2./3.) * (1. + qm)**(-1./3.), 2)
			else
				! r(tidal), where r(tidal) = 0.6a / (1 + q) (Paczynski 1977)
				rAd(nAd) = 0.6 / (1. + qm)
			end if
			! calculate outer disc height: 5% of outer disc radius
			hAd(nAd) = 0.05 * rAd(nAd)
			! calculate inner disc height: 2.5% of outer disc height
			hAd(1) = 0.025 * hAd(nAd)
			! calculate other radii as a fraction of outer disc radius
			do j = 2, nAd - 1
				rAd(j) = rAd(nAd) * float(j - 1) / float(nAd - 1)
			end do
			! calculate and output disc coordinates for all disc radii
			do j = 1, nAd
				! Keplerian velocity
				vK = sqrt(GC * M1 * MSun / (rAd(j) * aa)) / vf
				! velocity coordinates
				vxAd(j,0:nDp) = vK * cos(theta360) * sini
				vyAd(j,0:nDp) = vK * sin(theta360) * sini + vCOM(1,y)
				! spatial coordinates
				! adjust x coordinates with assumed system com
				xAd(j,0:nDp) = rAd(j) * cos(theta360) - com
				yAd(j,0:nDp) = rAd(j) * sin(theta360)
				! output disc velocity and spatial coordinates
				call accretionDiscOutput(j)
			end do
			! output 3D spatial coordinates (using inner and outer disc)
			call accretionDisc3DOutput()
			! calculate and output disc reference points coordinates
			call accretionDiscReferencePoints()
		end if

		return

	end subroutine accretionDisc
!******************************************************************************

!******************************************************************************
	subroutine accretionDiscOutput(j)

		integer, intent(in)							::	j
		integer										::	i

		! open output files
		call accretionDiscOutputFiles(j)
		! accretion disc radius velocity and spatial coordinates
		! loop for # of data points
		do i = 0, nDp
			! calculate polar velocity coordinates for disc radius
			call polarCoords(vxAd(j,i), vyAd(j,i), theta, v)
			! write velocity coordinates to file
			call outputEntry(1, 1, 0, vxAd(j,i), vyAd(j,i), 0d0, theta, 0d0, v)
			! write spatial coordinates to file
			call outputEntry(2, 2, 0, xAd(j,i), yAd(j,i), 0d0)
		end do
		if (j > 1 .and. j < nAd) then
			if (IDL == 0) write(1,'(a1)') ''
			if (IDL == 0) write(2,'(a1)') ''
		end if
		! close output files
		call closeOutputFiles()

		return

	end subroutine accretionDiscOutput
!******************************************************************************

!******************************************************************************
	subroutine accretionDiscOutputFiles(j)

		integer, intent(in)							::	j
		character(len=10)							::	theDisc, accessFile
		logical										::	writeHeader

		! set accessFile and writeHeader default values
		accessFile = 'SEQUENTIAL'
		writeHeader = .true.
		! set file name
		if (j == 1) theDisc = 'DiscInner'
		if (j > 1 .and. j < nAd) then
			theDisc = 'Disc'
			if (j > 2) then
				! override accessFile and writeHeader
				accessFile = 'APPEND'
				writeHeader = .false.
			end if
		end if
		if (j == nAd) theDisc = 'DiscOuter'
		! inner accretion disc velocity coordinates
		open(unit = 1, file = trim(outpath)//'v'//trim(theDisc)//'.out', &
			access = trim(accessFile))
		if (writeHeader) call outputHeader(1, 1)
		! inner accretion disc spatial coordinates
		open(unit = 2, file = trim(outpath)//'s'//trim(theDisc)//'.out', &
			access = trim(accessFile))
		if (writeHeader) call outputHeader(2, 2)
		! # of output files
		nF = 2

		return

	end subroutine accretionDiscOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine accretionDisc3DOutput()

		integer										::	i, j
		real(kind(1d0))								::	zF = 1d0

		! accretion disc 3D spatial coordinates
		open(unit = 1, file = trim(outpath)//'s3DDisc.out')
		call outputHeader(1, 2)
		! 3D spatial coordinates (using inner and outer disc)
		do j = 1, nAd, (nAd - 1)
			! loop for # of data points
			do i = 0, nDp, 6
				! write 3D spatial coordinates to file
				call outputEntry(1, 2, 0, xAd(j,i), yAd(j,i), -zF * hAd(j))
			end do
			if (IDL == 0) write(1, '(a1)') ''
			! loop for # of data points
			do i = 0, nDp, 6
				! write 3D spatial coordinates to file
				call outputEntry(1, 2, 0, xAd(j,i), yAd(j,i), zF * hAd(j))
			end do
			if (IDL == 0) write(1, '(a1)') ''
			zF = -zF
		end do
		! 'close' the disc...
		! loop for # of data points
		do i = 0, nDp, 6
			! write 3D spatial coordinates to file
			call outputEntry(1, 2, 0, xAd(1,i), yAd(1,i), -zF * hAd(1))
		end do
		if (IDL == 0) write(1, '(a1)') ''
		! close output file
		close(1)

		return

	end subroutine accretionDisc3DOutput
!******************************************************************************

!******************************************************************************
	subroutine accretionDiscReferencePoints()

		real(kind(1d0))								::	vK, Rs
		real(kind(1d0))								::	xRp, yRp, vxRp, vyRp
		integer										::	j

		! open output files
		call accretionDiscReferencePointsOutputFiles()
		! loop for # of references points
		do j = 1, 2
			! calculate reference points coordinates relative to primary
!			if (j == 1) xRp = 1.2 * sqrt(0.5 * (0.5 * rAd(nAd))**2)
!			if (j == 1) yRp = -sqrt((0.5 * rAd(nAd))**2 - xRp**2)
			if (j == 1) xRp = com
			if (j == 1) yRp = -sqrt((0.5 * rAd(nAd))**2 - xRp**2)
			if (j == 2) xRp = -rAd(nAd)
			if (j == 2) yRp = 0.
			! calculate polar spatial coordinates
			call polarCoords(xRp, yRp, theta, Rs)
			! calculate Keplerian velocity
			vK = sqrt(GC * M1 * MSun / (Rs * aa)) / vf
			! shift theta by 90 degrees (spatial vs velocity)
			theta = theta + PI / 2.
			! velocity coordinates
			vxRp = vK * cos(theta) * sini
			vyRp = vK * sin(theta) * sini + vCOM(1,y)
			! output accretion disc reference point coordinates
			call accretionDiscReferencePointOutput(xRp, yRp, vxRp, vyRp)
		end do
		! close output files
		call closeOutputFiles()

		return

	end subroutine accretionDiscReferencePoints
!******************************************************************************

!******************************************************************************
	subroutine accretionDiscReferencePointsOutputFiles()

		! accretion disc reference points velocity coordinates
		open(unit = 1, file = trim(outpath)//'vAB.out')
		call outputHeader(1, 1)
		! accretion disc reference points spatial coordinates
		open(unit = 2, file = trim(outpath)//'sAB.out')
		call outputHeader(2, 2)
		! # of output files
		nF = 2

		return

	end subroutine accretionDiscReferencePointsOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine accretionDiscReferencePointOutput(xRp, yRp, vxRp, vyRp)

		real(kind(1d0)), intent(in)					::	xRp, yRp, vxRp, vyRp

		! output accretion disc reference point velocity and spatial coordinates
		! calculate polar velocity coordinates for disc radius
		call polarCoords(vxRp, vyRp, theta, v)
		! write velocity coordinates to file
		call outputEntry(1, 1, 1, vxRp, vyRp, 0d0, theta, 0d0, v)
		! write reference points spatial coordinates to file
		call outputEntry(2, 2, 1, xRp - com, yRp, 0d0)

		return

	end subroutine accretionDiscReferencePointOutput
!******************************************************************************

!******************************************************************************
	subroutine magneticStream()

		integer										::	i, j, nO, nM
		real(kind(1d0))								::	dFac, azRg

		if (mCV >= 1) then
			! default: above (nO = 1) orbital plane only
			nO = 1
			dFac = 1d0
			! for intermediate polars...
			if (mCV == 2) then
				! above and below (nO = 2) orbital plane
				nO = 2
				! calculate magnetosphere radius [binary separation]
				if (vDi > 0d0) then
					! ... inner disc radius [binary separation] (Eq 2.81 Warner 1995)
					rMag = (GC * M1 * MSun * sini**2 / (vDi * vf)**2) / aa
				else
					! ... 20% of outer disc radius [binary separation]
					rMag = 0.2d0 * rAd(nAd)
				end if
				! calculate Keplerian velocity at rMag
				vKMag = sqrt(GC * M1 * MSun / (rMag * aa)) / vf
!				write(*, '(3es14.6)') rAd(1), rMag, vKMag
!				call pause_here()
			end if
			! calculate magnetic dipole rotation and tilt matrix
			call magneticDipoleMatrix()
			! open output files
			call magneticStreamOutputFiles()
			! calculate # of magnetic dipole lines
			azRg = (azMe - azMs)
			if (azRg < 0d0) azRg = azRg + 360d0
			nM = int(azRg / azMi) + 1
			! loop for above and below orbital plane (if necessary)
			do i = 1, nO
				if (i == 2) then
					dFac = -1d0 * dFac
					! magnetic stream velocity coordinates
					close(3)
					open(unit = 3, file = trim(outpath)//'vStreamMag.1.out')
					call outputHeader(3, 1)
				end if
				! loop for # of magnetic dipole lines
				do j = 1, nM
					! calculate dipole connection point
					call magneticDipoleConnection(j)
					! calculate un-rotated, un-tilted dipole parameters
					call magneticDipoleParameters()
					! calculate spatial coordinates along rotated, tilted dipole line
					call magneticDipoleSpatialCoordinates(dFac)
					! calculate velocity coordinates along rotated, tilted dipole line
					call magneticDipoleVelocityCoordinates(dFac)
					! adjust x coordinates with assumed system com
					magnD(x,1:nDp) = magnD(x,1:nDp) - com
					! output dipole line velocity and spatial coordinates
					call magneticDipoleOutput(dFac)
				end do
			end do
			! close output files
			call closeOutputFiles()
			! calculate and output magnetic dipole 3d overlay
			call magneticDipole3D()
		end if

		return

	end subroutine magneticStream
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleMatrix()

		real(kind(1d0))								::	A0, B0
		integer										::	i, j, k

		! convert magnetic field axis angles to radians
		A0 = twoPI * Psi / 360.
		B0 = twoPI * beta / 360.
		! rotation matrix - rotate
		rotate(1,1) = cos(A0);	rotate(1,2) = -sin(A0);	rotate(1,3) = 0.
		rotate(2,1) = sin(A0);	rotate(2,2) = cos(A0);	rotate(2,3) = 0.
		rotate(3,1) = 0.;		rotate(3,2) = 0.;		rotate(3,3) = 1.
		! tilt matrix - tilt
		! tilt towards (+ beta) / away from (- beta) secondary
		tilt(1,1) = cos(B0);	tilt(1,2) = 0.;			tilt(1,3) = sin(B0)
		tilt(2,1) = 0.;			tilt(2,2) = 1.;			tilt(2,3) = 0.
		tilt(3,1) = -sin(B0);	tilt(3,2) = 0.;			tilt(3,3) = cos(B0)
		! rotate and tilt matrix - roTilt
		do i = 1, 3
			do j = 1, 3
				roTilt(i,j) = 0.	! for each roTilt(i,j)
				do k = 1, 3			! (row i of rotate) * (col j of tilt)
					roTilt(i,j) = roTilt(i,j) + rotate(i,k) * tilt(k,j)
				end do
			end do
		end do
!		do i = 1, 3 ! print row-by-row
!			write(*, '(3f11.6)') (roTilt(i, j), j = 1, 3)
!		end do

		return

	end subroutine magneticDipoleMatrix
!******************************************************************************

!******************************************************************************
	subroutine magneticStreamOutputFiles()

		! ballistic-magnetic stream connections velocity coordinates
		open(unit = 1, file = trim(outpath)//'vStreamBalConnect.out')
		call outputHeader(1, 1)
		! ballistic-magnetic stream connections velocity coordinates
		open(unit = 2, file = trim(outpath)//'vStreamMagConnect.out')
		call outputHeader(2, 1)
		! magnetic stream velocity coordinates
		open(unit = 3, file = trim(outpath)//'vStreamMag.out')
		call outputHeader(3, 1)
		! magnetic stream spatial coordinates
		open(unit = 4, file = trim(outpath)//'sStreamMag.out')
		call outputHeader(4, 2)
		! # of output files
		nF = 4

		return

	end subroutine magneticStreamOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleConnection(j)

		integer, intent(in)							::	j
		real(kind(1d0)) 							::	azDeg, azRad

		! initialise spatial and velocity coordinate arrays
		sMagnD = 0d0
		vMagnD = 0d0
		! azimuth angle where magnetic field line connects
		azDeg = azMs + (j - 1) * azMi
		if (azDeg > 360d0) azDeg = azDeg - 360d0
		! for polars...
		if (mCV == 1) then
			! interpolate spatial and velocity coordinates at this angle
			call interpolate1(nBa, azBs, xBs, azDeg, sMagnD(x,1))	! x-spatial
			call interpolate1(nBa, azBs, yBs, azDeg, sMagnD(y,1))	! y-spatial
			call interpolate1(nBa, azBs, vxBs, azDeg, vMagnD(x,1))	! x-velocity
			call interpolate1(nBa, azBs, vyBs, azDeg, vMagnD(y,1))	! y-velocity
		end if
		! for intermediate polars
		if (mCV == 2) then
			! upper curtain
			azRad = azDeg * PI / 180d0
			sMagnD(x,1) = rMag * cos(azRad)					! x-spatial
			sMagnD(y,1) = rMag * sin(azRad)					! y-spatial
			vMagnD(x,1) = vKMag * cos(azRad + 0.5d0 * PI)	! x-velocity
			vMagnD(y,1) = vKMag * sin(azRad + 0.5d0 * PI)	! y-velocity
		end if

		return

	end subroutine magneticDipoleConnection
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleParameters()

		real(kind(1d0)), dimension(3,3)				::	temp
		real(kind(1d0)), dimension(3,1)				::	sABC
		real(kind(1d0))								::	rU, phiU

		! initialise temporary arrays
		temp = roTilt
		sABC = sMagnD
		! assume connection is on a rotated and tilted field line, therefore
		! calculate un-rotated, un-tilted xyz spatial coordinates
		call gaussj(temp, 3, 3, sABC, 1, 1)
		! calculate un-rotated, un-tilted polar spatial coordinates
		! thetaU: un-rotated, un-tilted dipole azimuthal angle (xy-plane)
		! rU: un-rotated, un-tilted dipole radius (xy-plane)
		call polarCoords(sABC(x,1), sABC(y,1), thetaU, rU)
		! phiU: un-rotated, un-tilted dipole co-latitude angle (xz-plane)
		phiU = atan(abs(sABC(z,1)) / rU)
		! rE: un-rotated, un-tilted dipole equatorial radius
		rE = sqrt(sABC(x,1)**2 + sABC(y,1)**2 + sABC(z,1)**2) / cos(phiU)**2
		return

	end subroutine magneticDipoleParameters
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleSpatialCoordinates(dFac)

		real(kind(1d0)), intent(in)					::	dFac
		real(kind(1d0)), dimension(3,1)				::	sABC, sXYZ
		real(kind(1d0))								::	phiU, rU, azRad
		integer										::	i, j, k

		! initialise magnetic dipole line spatial and velocity coordinates array 
		magnD = 0d0
		! loop for # of data points
		do i = 1, nDp
			! calculate un-rotated, un-tilted dipole co-latitude angle (xz-plane)
!			phiU = 0.5 * PI * (1d0 - dFac + float(i) / float(nDp))
			phiU = PI * (-0.5d0 * dFac + float(i) / float(nDp))
			! calculate un-rotated, un-tilted dipole radius (xy-plane)
			rU = rE * cos(phiU)**2
			! calculate un-rotated, un-tilted spatial coordinates
			sABC(x,1) = rU * cos(phiU) * cos(thetaU)
			sABC(y,1) = rU * cos(phiU) * sin(thetaU)
			sABC(z,1) = rU * sin(phiU)
			! rotate and tilt spatial coordinates
			do j = 1, 3
				sXYZ(j,1) = 0.	! for each sXYZ(j,1)
				do k = 1, 3		! (row j of roTilt) * (col 1 of sABC)
					sXYZ(j,1) = sXYZ(j,1) + roTilt(j,k) * sABC(k,1)
				end do
				! write spatial coordinates to magnetic dipole line array
				magnD(j,i) = sXYZ(j,1)
			end do
		end do
		! update sMagnD and vMagnD array for lower curtain
		if (dFac == -1d0) then
			do i = 1, nDp
				if (dFac * magnD(z,i) >= 0.) then
					sMagnD(x,1) = magnD(x,i)				! x-spatial
					sMagnD(y,1) = magnD(y,i)				! y-spatial
					exit
				end if
			end do
			! determine azimuth
			call polarCoords(sMagnD(x,1), sMagnD(y,1), azRad, rU)
			vMagnD(x,1) = vKMag * cos(azRad + 0.5d0 * PI)	! x-velocity
			vMagnD(y,1) = vKMag * sin(azRad + 0.5d0 * PI)	! y-velocity
		end if

		return

	end subroutine magneticDipoleSpatialCoordinates
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleVelocityCoordinates(dFac)

		real(kind(1d0)), intent(in)					::	dFac
		real(kind(1d0)), dimension(0:3)				::	sXYZ0, sXYZ
		real(kind(1d0)), dimension(0:3)				::	vXYZ0, vXYZ
		real(kind(1d0)), dimension(0:3)				::	g0, g
		real(kind(1d0))								::	dX, dY, dZ
		real										::	dirX, dirY, dirZ
		real										::	thetaD, kappaD
		integer										::	i

		! initialise starting spatial coordinates
		sXYZ0(x) = sMagnD(x,1)
		sXYZ0(y) = sMagnD(y,1)
		sXYZ0(z) = sMagnD(z,1)
		sXYZ0(r) = sqrt(sXYZ0(x)**2 + sXYZ0(y)**2 + sXYZ0(z)**2)
		sXYZ = sXYZ0
		! initialise starting velocity coordinates
		vXYZ0(x) = vMagnD(x,1)
		vXYZ0(y) = vMagnD(y,1)
		vXYZ0(z) = vMagnD(z,1)
		vXYZ0(r) = sqrt(vXYZ0(x)**2 + vXYZ0(y)**2 + vXYZ0(z)**2)
		vXYZ = vXYZ0
		! calculate starting values - acceleration
		call magneticDipoleAcceleration(sXYZ0, g0)
		! calculate values along magnetic dipole line
		do i = 1, nDp
			! assume material follows 'positive' part (z>0) of dipole line,
			! i.e., dipole line with equatorial radius = rE...
			if (dFac * magnD(z,i) >= 0.) then
!			if (dFac * magnD(z,i) <= 0.) then
				! spatial coordinates
				sXYZ(x) = magnD(x,i)
				sXYZ(y) = magnD(y,i)
				sXYZ(z) = magnD(z,i)
				sXYZ(r) = sqrt(sXYZ(x)**2 + sXYZ(y)**2 + sXYZ(z)**2)
				! delta spatial coordinates
				dX = sXYZ(x) - sXYZ0(x)
				dY = sXYZ(y) - sXYZ0(y)
				dZ = sXYZ(z) - sXYZ0(z)
				! calculate acceleration
				call magneticDipoleAcceleration(sXYZ, g)
				! calculate velocity under assumption of conservation of energy
				vXYZ(r) = sqrt(vXYZ0(r)**2 + &
								2. * (g0(r) * sXYZ0(r) - g(r) * sXYZ(r)))
				! thetaD: angle in xy-plane
				thetaD = atan(abs(dY / dX))
				! kappaD: angle in xy-z plane ('bounce-off' angle)
				kappaD = atan(abs(dZ / sqrt(dX**2 + dY**2)))
				! calculate x, y and z directions
				dirX = 1.; dirY = 1.; dirZ = 1.
				if (dX /= 0.) dirX = dX / abs(dX)	! x-direction
				if (dY /= 0.) dirY = dY / abs(dY)	! y-direction
				if (dZ /= 0.) dirZ = dZ / abs(dZ)	! z-direction
				! split velocity in xyz-components
				vXYZ(x) = vXYZ(r) * cos(kappaD) * cos(thetaD) * dirX	! x-velocity
				vXYZ(y) = vXYZ(r) * cos(kappaD) * sin(thetaD) * dirY	! y-velocity
				vXYZ(z) = vXYZ(r) * sin(kappaD) * dirZ					! z-velocity
				! write velocity coordinates to magnetic dipole line array
				magnD(vx,i) = vXYZ(x)
				magnD(vy,i) = vXYZ(y)
				magnD(vz,i) = vXYZ(z)
				! update starting values
				sXYZ0 = sXYZ
				vXYZ0 = vXYZ
				g0 = g
			end if
		end do

		return

	end subroutine magneticDipoleVelocityCoordinates
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleAcceleration(sXYZ, g)

		real(kind(1d0)), dimension(0:3), intent(in)	::	sXYZ
		real(kind(1d0)), dimension(0:3), intent(out)	::	g
		real(kind(1d0))								::	thetag, rg
		real										::	phig

		! calculate azimuth angle
		call polarCoords(sXYZ(x), sXYZ(y), thetag, rg)
		! calculate polar angle
		phig = atan(sXYZ(z) / rg)
		! total acceleration in direction of primary
		g(r) = -1. / (sXYZ(r)**2)
		! split acceleration in xyz-components
		g(x) = g(r) * cos(phig) * cos(thetag)
		g(y) = g(r) * cos(phig) * sin(thetag)
		g(z) = g(r) * sin(phig)

		return

	end subroutine magneticDipoleAcceleration
!******************************************************************************

!******************************************************************************
	subroutine magneticDipoleOutput(dFac)

		real(kind(1d0)), intent(in)					::	dFac
		integer										::	i

		! set first flag
		first = 1
		! calculate polar velocity coordinates for dipole line connection
		call polarCoords(vMagnD(x,1), vMagnD(y,1), theta, v)
		! write velocity coordinates to file
		call outputEntry(1, 1, 0, vMagnD(x,1), vMagnD(y,1), 0d0, theta, 0d0, v)
		call outputEntry(2, 1, 0, vMagnD(x,1), vMagnD(y,1), 0d0, theta, 0d0, v)
		! loop for # of data points
		do i = 1, nDp
			! only 'positive' part (z>0) of dipole line
			if (dFac * magnD(z,i) >= 0.) then
!			if (dFac * magnD(z,i) <= 0.) then
				! calculate polar velocity coordinates for dipole line
				call polarCoords(magnD(vx,i), magnD(vy,i), theta, v)
				! write velocity coordinates to file
				if (first == 1) then
					call outputEntry(2, 1, 0, magnD(vx,i), magnD(vy,i), 0d0, theta, 0d0, v)
					first = 0
				end if
				call outputEntry(3, 1, 0, magnD(vx,i), magnD(vy,i), 0d0, theta, 0d0, v)
				! write dipole 3d spatial coordinates to file
				call outputEntry(4, 2, 0, magnD(x,i), magnD(y,i), magnD(z,i))
			end if
		end do
		if (IDL == 0) write(1, '(a1)') 'e'
		if (IDL == 0) write(2, '(a1)') 'e'
		if (IDL == 0) write(3, '(a1)') 'e'
		if (IDL == 0) write(4, '(a1)') ''

		return

	end subroutine magneticDipoleOutput
!******************************************************************************

!******************************************************************************
	subroutine magneticDipole3D()

		real(kind(1d0)), dimension(3,1)				::	sABC, sXYZ
		real(kind(1d0))								::	thetaD, phiD, rD
		integer										::	h, i, j, k, m, n

		! 3D magnetic dipole spatial coordinates
		open(unit = 1, file = trim(outpath)//'s3DDipole.out')
		call outputHeader(1, 2)
		! # of dipole lines
		m = 4	! m = 1,2,3,...
		! loop for # of dipole lines
		do n = 1, m
			do h = 0, 1
				! un-rotated, un-tilted dipole azimuthal angle
				thetaD = (n - 1) * PI / (2. * m) + h * 0.5 * PI
				! loop for # of data points
				do i = 0, nDp
					! un-rotated, un-tilted dipole co-latitude angle
					phiD = twoPI * float(i) / float(nDp)
					! calculate un-rotated, un-tilted dipole radius
					rD = rE * sin(phiD)**2
					! un-rotated, un-tilted spatial coordinates
					sABC(x,1) = rD * sin(phiD) * cos(thetaD)
					sABC(y,1) = rD * sin(phiD) * sin(thetaD)
					sABC(z,1) = rD * cos(phiD)
					! rotate and tilt
					do j = 1, 3
						sXYZ(j,1) = 0.	! for each sXYZ(j,1)
						do k = 1, 3		! (row j of roTilt) * (col 1 of sABC)
							sXYZ(j,1) = sXYZ(j,1) + roTilt(j,k) * sABC(k,1)
						end do
					end do
					! write dipole 3d spatial coordinates to file
					write(1, '(3es14.6)') sXYZ(x,1) - com, sXYZ(y,1), sXYZ(z,1)
				end do
				if (IDL == 0) write(1, '(a1)') 'e'
			end do
		end do
		close(1)

		return

	end subroutine magneticDipole3D
!******************************************************************************

!******************************************************************************
	subroutine keplerianTrace()

		real(kind(1d0))								::	xR0, xR, dxR, f, RR
		real(kind(1d0))								::	vxBc, vyBc, vxKc, vyKc
		integer										::	i, ix0, ix

		! velocity coordinates of Keplerian trace
		vxKt = vxKt * bvs * sini
		vyKt = (vyKt - comAdj) * bvs * sini
		! set starting values for Keplerian trace connections
		! starting radius (xBs(1) = RL1, i.e., radius at L1)
		xR = xBs(1)
		! delta radius
		dxR = 0.1
		ix = int(xR / dxR) + 1
		! open output files
		call keplerianTraceOutputFiles()
		! loop for # of points on ballistic stream
		do i = 1, nBa
			! output Keplerian trace velocity coordinates
			call keplerianTraceOutput(1, vxKt(i), vyKt(i))
			! save starting values for Keplerian trace connections
			xR0 = xR
			ix0 = ix
			! calculate radius at point on ballistic stream
			xR = sqrt(xBs(i)**2 + yBs(i)**2) / xBs(1)
			ix = int(xR / dxR)
!			if (abs(ix0 - ix) == 1) then
			if (ix0 - ix == 1) then
				RR = ix0 * dxR
				f = (ix0 * dxR - xR0) / (xR - xR0)
				! calculate ballistic stream connection velocity coordinates
				vxBc = f * vxBs(i) + (1 - f) * vxBs(i-1)
				vyBc = f * vyBs(i) + (1 - f) * vyBs(i-1)
				! output ballistic stream connection velocity coordinates
				call keplerianTraceOutput(2, vxBc, vyBc, RR)
				! calculate Keplerian trace connection velocity coordinates
				vxKc = f * vxKt(i) + (1 - f) * vxKt(i-1)
				vyKc = f * vyKt(i) + (1 - f) * vyKt(i-1)
				! output Keplerian trace connection velocity coordinates
				call keplerianTraceOutput(2, vxKc, vyKc)
			end if
		end do
		! close output files
		call closeOutputFiles()

		return

	end subroutine keplerianTrace
!******************************************************************************

!******************************************************************************
	subroutine keplerianTraceOutputFiles()

		! Keplerian trace velocity coordinates
		open(unit = 1, file = trim(outpath)//'vKeplerian.out')
		call outputHeader(1, 1)
		! Keplerian trace connections velocity coordinates
		open(unit = 2, file = trim(outpath)//'vKeplerianConnect.out')
		call outputHeader(2, 1)
		! # of output files
		nF = 2

		return

	end subroutine keplerianTraceOutputFiles
!******************************************************************************

!******************************************************************************
	subroutine keplerianTraceOutput(funit, vxK, vyK, RR)

		integer, intent(in)							::	funit
		real(kind(1d0)), intent(in)					::	vxK, vyK
		real(kind(1d0)), optional, intent(in)		::	RR

		! calculate polar velocity coordinates for ballistic stream
		call polarCoords(vxK, vyK, theta, v)
		! write velocity coordinates to file
		if (present(RR)) then
			write(funit, '(8es14.6)') vxK, vyK, 0., theta, 0., v, RR
		else
			write(funit, '(7es14.6)') vxK, vyK, 0., theta, 0., v
		end if

		return

	end subroutine keplerianTraceOutput
!******************************************************************************

!******************************************************************************
	subroutine calculateRL1()

		! L1 radius: distance from centre of primary to inner Lagrangian point
		real(kind(1d0))								::	rl, rn, f, fa

		if (abs(1 - qm) < 1e-4) then
			rn = 0.5
		else
			rl = 0
			rn = 1 - qm
	 		do while (abs(rl / rn - 1) > 1e-4)
				rl = rn
				f = qm / (1 - rl)**2 - 1 / rl**2 + (1 + qm) * rl - qm
				fa = 2 * qm / (1 - rl)**3 + 2 / rl**3 + (1 + qm)
				rn = rl - f / fa
			end do
		end if
		RL1 = rn

		return

	end subroutine calculateRL1
!******************************************************************************

!******************************************************************************
	subroutine velocityInfo()

		integer										::	i
		real(kind(1d0))								::	sd, vd

		! radius of the primary (Eq 2.82 Warner 1995 (Nauenberg 1972))
		R1 = 0.78 * 1.e+7 * sqrt((MCh / M1)**(2./3.) - (M1 / MCh)**(2./3.))
!		! distance from L1 to primary (Eq 2.4c Warner 1995 (Silber 1992))
!		RL1 = aa / (1.0015 + qm**0.4056)
		! maximum Keplerian velocity (at the surface of the primary)
		vKmax = sqrt(GC * M1 * MSun / R1) * sini
		! maximum free fall velocity from infinity to the surface of the primary
		vFFmax = sqrt(2. * GC * M1 * MSun * (1. / R1)) * sini
		! maximum free fall velocity from L1 to the surface of the primary
		vFFmaxL1 = sqrt(2. * GC * M1 * MSun * ((1. / R1) - (1. / (aa * RL1)))) * sini
		! calculate 'length' of ballistic stream
		sd = 0d0
		do i = 2, nBa
			sd = sd + sqrt((xBs(i) - xBs(i - 1))**2 + (yBs(i) - yBs(i - 1))**2)
			vd = sqrt(vxBs(i)**2 + vyBs(i)**2)
		end do

		! open general velocity information output file
		open(unit = 1, file = trim(outpath)//'vInfo.out')
!		write(1, 65) RL1 / aa, 'RL1: Eq 2.4c Warner 1995 (Silber 1992)'
		write(1, 65) RL1, 'RL1'
		write(1, 65) sd, 'length of ballistic stream'
		if (mCV == 0 .or. mCV == 2) then
			if (vDi > 0d0) write(1, 65) rAd(1), 'radius, inner disc: Eq 2.81 Warner 1995'
			if (qm <= 0.3) then
				! 3:1 resonance (Eq 3.39 Warner 1995 -- P = Porb / 3)
				write(1, 65) rAd(nAd), 'radius, outer disc: 3:1 resonance - Eq 3.39 Warner 1995'
			else
				! r(tidal), where r(tidal) = 0.6a / (1 + q) (Paczynski 1977)
				write(1, 65) rAd(nAd), 'radius, outer disc: r(tidal) - Paczynski 1977'
			end if
		end if
		write(1, 65) R1 / aa, 'radius, primary: Eq 2.82 Warner 1995 (Nauenberg 1972)'
		write(1,  *)
		write(1, 66) vd, 'velocity at ballistic stream end'
		write(1, 66) vDi, 'max inner disc velocity (radial)'
		write(1, 66) vKmax / vf, 'max Keplerian velocity'
		write(1, 66) vFFmaxL1 / vf, 'max free fall velocity from RL1'
		write(1, 66) vFFmax / vf, 'max free fall velocity from infinity'
		write(1, 66) vCOM(0,y), 'y velocity component of system centre of mass'
		write(1, 66) vCOM(1,y), 'y velocity component of primary centre of mass'
		write(1, 66) vCOM(2,y), 'y velocity component of secondary centre of mass'
		! close output file
		close(1)

65 		format (1x, f6.3, ' [a]: ', a)
66 		format (1x, f6.3, ' [10**3 km/s]: ', a)

		return

	end subroutine velocityInfo
!******************************************************************************

!******************************************************************************
	subroutine outputParameters()

		integer										::	i

		! open parameter output file (needed for plotting routines)
		open(unit = 1, file = trim(outpath)//'pBinary')
		! write parameter file
		write(1, '(''mCV  = '', i3)') mCV
		write(1, '(''M1   = '', f7.3)') M1
		write(1, '(''inc  = '', f6.2)') inc
		write(1, '(''qm   = '', f7.3)') qm
		write(1, '(''com  = '', f10.6)') com
		write(1, '(''Porb = '', f10.6)') Porb
		write(1, '(''Pspn = '', f10.6)') Pspin
		write(1, '(''azE  = '', f6.2)') azE
		write(1, '(''azMs = '', f6.2)') azMs
		write(1, '(''azMe = '', f6.2)') azMe
		write(1, '(''azMi = '', f6.2)') azMi
		write(1, '(''Psi  = '', f6.2)') Psi
		write(1, '(''beta = '', f6.2)') beta
		write(1, '(''R1   = '', f7.3)') R1 / aa
		close(1)

		return

	end subroutine outputParameters
!******************************************************************************

!******************************************************************************
	subroutine outputHeader(funit, ftype)

		integer, intent(in)	::	funit, ftype

		if (IDL == 0) then
			select case (ftype)
				case (1) ! velocity coordinates output file
					write(funit, '(a)') '# velocity: x y z theta phi v'
				case (2) ! spatial coordinates output file
					write(funit, '(a)') '# position: x y z'
			end select
		end if

		return

	end subroutine outputHeader
!******************************************************************************

!******************************************************************************
	subroutine outputEntry(funit, ftype, fe, fx, fy, fz, ft, fp, fv)

		integer, intent(in)							::	funit, ftype, fe
		real(kind(1d0)), intent(in)					::	fx, fy, fz
		real(kind(1d0)), optional, intent(in)		::	ft, fp, fv

		select case (ftype)
			case (1) ! velocity coordinates output entry
				write(funit, '(7es14.6)') fx, fy, fz, ft, fp, fv
			case (2) ! spatial coordinates output entry
				write(funit, '(3es14.6)') fx, fy, fz
		end select
		if (IDL == 0 .and. fe == 1) write(funit, '(a1)') 'e'

		return

	end subroutine outputEntry
!******************************************************************************

!******************************************************************************
	subroutine closeOutputFiles()

		integer										::	i

		do i = 1, nF
			close(i)
		end do

		return

	end subroutine closeOutputFiles
!******************************************************************************

!******************************************************************************
	end program pbinarymodel
!******************************************************************************
