(*Demonstration of the Mathematica built-in database ChemicalData*)
ChemicalData["Pentacene","MoleculePlot"]

Build the molecule/visual representation we want to use

Needed to scale down the molecule, add axes, recolor, and rotate/center the coordinates of the object for ease of use (for some reason (0,0,0) is the center of the molecule, but the long axis is not along x, y, OR z)

(*Define object to play the role of the magnetic field axes *)
magneticAxes=GraphicsComplex[{{0,0,0},{30,0,0},{0,30,0},{0,0,30}},{Arrowheads[0.05],Purple,Arrow[Tube[{1,2},largeCylinder]] ,Cyan,Arrow[Tube[{1,3},largeCylinder]], Black,Arrow[Tube[{1,4},largeCylinder]]}];

(*Get initial data from Chemical Data, "MoleculePlot" returns a graphics displayable object containing, in order, (1) Specularity of the objects, (2) Edgeform to be used, (3) AbsoluteThickness of following lines, (4) GraphicsComplex defining the shape of the object *)
penta=First@ChemicalData["Pentacene","MoleculePlot"];
ratio=0.8;
smallCylinder=0.1;
largeCylinder=0.3;
smallSphere=0.6;
largeSphere=0.9;
(*Copy the first field in the GraphicsComplex in penta, this holds the points where all the objects defined in the second field are placed*)
pentaPoints=penta[[4]][[1]];
penta[[3]]=AbsoluteThickness[0.01];
(**)
(*Find z-axis defined by the vector perpendicular to the plane in which the molecule lies. This could be improved! I'm mostly doing it by hand/eye*)
zVec=Cross[({-121.99`,-70.339`,3.566`}-{346.83379785483595`,105.13001268158078`,100.1581344259247`}),({526.1159159918064`,54.214762311316804`,277.43895470464355`}-{346.83379785483595`,105.13001268158078`,100.1581344259247`})];
zVec=zVec/Norm[zVec];(*Normalize*)
(* Find which rotation matrix makes zVec closest to (0,0,1} *)
RollPitchYawMatrix[{61.25Degree,53.60Degree,0}].zVec;
(**)
(*Find x-axis defined by the vector along the length of the molecule *)
xVec=RollPitchYawMatrix[{61.25Degree,53.60Degree,0}].{608.6500000000001`,177.855`,183.88`};
xVec=xVec/Norm[xVec];
(*Find which rotation matrx makes xVec closest to (1,0,0) *)
RollPitchYawMatrix[{-69.69Degree,0,0}].xVec;
(**)
(*Rotate shape to be in line with axes using found rotation angles (!!Needed to add 9 Degrees to the found z-axis rotation for some reason to get the moelcule to more visually appear parallel to the x-axis !!), also scale down size by 50 so I'm not dealing with lengths like 500 along the side*)
pentaPoints=Table[(1/50)(RollPitchYawMatrix[{(-69.69+9)Degree,0,0}].RollPitchYawMatrix[{61.25Degree,53.60Degree,0}]).pentaPoints[[i]],{i,1,Length[pentaPoints]}];
(*Add points to use for placement of axes*)
pentaPoints=Join[pentaPoints,{{0,0,0},{10,0,0},{0,10,0},{0,0,10}}];
(*Translate the center of the molecule*)
pentaPoints=Table[pentaPoints[[i]]+{0,0,0},{i,1,Length[pentaPoints]}];
pentaShapes[colour_]={Arrowheads[0.03],Red,Arrow[Tube[{95,96},largeCylinder]] ,Green,Arrow[Tube[{95,97},largeCylinder]], Blue,Arrow[Tube[{95,98},largeCylinder]],Blend[{colour,},ratio],Sphere[23,smallSphere],Sphere[24,smallSphere],Sphere[25,smallSphere],Sphere[26,smallSphere],Sphere[27,smallSphere],Sphere[28,smallSphere],Sphere[29,smallSphere],Sphere[30,smallSphere],Sphere[31,smallSphere],Sphere[32,smallSphere],Sphere[33,smallSphere],Sphere[34,smallSphere],Sphere[35,smallSphere],Sphere[36,smallSphere],Blend[{colour,},ratio],Sphere[1,largeSphere],Sphere[2,largeSphere],Sphere[3,largeSphere],Sphere[4,largeSphere],Sphere[5,largeSphere],Sphere[6,largeSphere],Sphere[7,largeSphere],Sphere[8,largeSphere],Sphere[9,largeSphere],Sphere[10,largeSphere],Sphere[11,largeSphere],Sphere[12,largeSphere],Sphere[13,largeSphere],Sphere[14,largeSphere],Sphere[15,largeSphere],Sphere[16,largeSphere],Sphere[17,largeSphere],Sphere[18,largeSphere],Sphere[19,largeSphere],Sphere[20,largeSphere],Sphere[21,largeSphere],Sphere[22,largeSphere],Blend[{colour,},ratio],Cylinder[{53,23},largeCylinder],Cylinder[{54,24},largeCylinder],Cylinder[{71,25},largeCylinder],Cylinder[{72,26},largeCylinder],Cylinder[{73,27},largeCylinder],Cylinder[{74,28},largeCylinder],Cylinder[{79,29},largeCylinder],Cylinder[{84,30},largeCylinder],Cylinder[{85,31},largeCylinder],Cylinder[{86,32},largeCylinder],Cylinder[{87,33},largeCylinder],Cylinder[{88,34},largeCylinder],Cylinder[{93,35},largeCylinder],Cylinder[{94,36},largeCylinder],Blend[{colour,},ratio],Cylinder[{1,2},largeCylinder],Cylinder[{37,38},smallCylinder],Cylinder[{39,40},smallCylinder],Cylinder[{1,11},largeCylinder],Cylinder[{41,42},smallCylinder],Cylinder[{43,44},smallCylinder],Cylinder[{2,12},largeCylinder],Cylinder[{3,4},largeCylinder],Cylinder[{3,5},largeCylinder],Cylinder[{45,46},smallCylinder],Cylinder[{47,48},smallCylinder],Cylinder[{4,6},largeCylinder],Cylinder[{49,50},smallCylinder],Cylinder[{51,52},smallCylinder],Cylinder[{5,53},largeCylinder],Cylinder[{6,54},largeCylinder],Cylinder[{7,8},largeCylinder],Cylinder[{55,56},smallCylinder],Cylinder[{57,58},smallCylinder],Cylinder[{7,15},largeCylinder],Cylinder[{59,60},smallCylinder],Cylinder[{61,62},smallCylinder],Cylinder[{8,16},largeCylinder],Cylinder[{9,10},largeCylinder],Cylinder[{9,13},largeCylinder],Cylinder[{63,64},smallCylinder],Cylinder[{65,66},smallCylinder],Cylinder[{10,14},largeCylinder],Cylinder[{67,68},smallCylinder],Cylinder[{69,70},smallCylinder],Cylinder[{11,71},largeCylinder],Cylinder[{12,72},largeCylinder],Cylinder[{13,73},largeCylinder],Cylinder[{14,74},largeCylinder],Cylinder[{75,76},smallCylinder],Cylinder[{77,78},smallCylinder],Cylinder[{15,79},largeCylinder],Cylinder[{80,81},smallCylinder],Cylinder[{82,83},smallCylinder],Cylinder[{16,84},largeCylinder],Cylinder[{17,21},largeCylinder],Cylinder[{17,85},largeCylinder],Cylinder[{18,22},largeCylinder],Cylinder[{18,86},largeCylinder],Cylinder[{19,20},largeCylinder],Cylinder[{19,87},largeCylinder],Cylinder[{20,88},largeCylinder],Cylinder[{89,90},smallCylinder],Cylinder[{91,92},smallCylinder],Cylinder[{21,93},largeCylinder],Cylinder[{22,94},largeCylinder]};
(* Create two different color pentacenes to use, errors about blend don't seem to be a problem and started when I parameterized the colour as an input to a function *)
pentaRed=penta;
pentaRed[[4]]=GraphicsComplex[pentaPoints,pentaShapes[Red]];
pentaBlue=penta;
pentaBlue[[4]]=GraphicsComplex[pentaPoints,pentaShapes[Cyan]];

Display the resulting object

I’ve chosen to shift the molecule so that one end is at x=0, this can easily be undone so that the center of the molecule is at the origin by changing the appropriate line above

Graphics3D[pentaBlue,Axes->True,AxesLabel->{x,y,z}]

?GeometricTransformation
?TranslationTransform

(*Generate single graphics *)
Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,-15}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[-θ,{0,1,0}],RotationTransform[-ϕ,{0,0,1}],RotationTransform[-(Pi-β)/2,{0,1,0}],TranslationTransform[{-15,0,0}],RotationTransform[Pi,{0,0,1}]}](*Remove this rotation to get a 'chasing' orientation of the x-axes *),GeometricTransformation[pentaBlue,Composition@@{RotationTransform[-θ,{0,1,0}],RotationTransform[-ϕ,{0,0,1}],RotationTransform[(Pi-β)/2,{0,1,0},{0,0,0}],TranslationTransform[{15,0,0}]}]},Axes->False,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}},Boxed->False,ViewPoint->{5,10,6}]/.{β->Pi/2,ϕ->0,θ->0}
Export["/Users/sina/Google Drive/Research/Singlet Fission Project/beta90_still.png",%,ImageResolution->500]

(*Symmetric rotation (math version) *)
(* let (Subscript[D, i])p refer to the zero field tensor of the triplet on chromophore i in the principle frame of that chromophore and (Subscript[D, i]) refer to the equivalent zero field tensor in the lab frame *)
Dip = {{-d/3+e,0,0},{0,-d/3-e,0},{0,0,2d/3}};
DA = EulerMatrix[{0,-θ,-ϕ}].EulerMatrix[{Pi,-(Pi-β)/2,0}].Dip.Transpose[EulerMatrix[{Pi,-(Pi-β)/2,0}]] .Transpose[EulerMatrix[{0,-θ,-ϕ}]] ;(*Remove Pi in 1st argument to get a 'chasing' orientation of the x-axes *)
DB = EulerMatrix[{0,-θ,-ϕ}].EulerMatrix[{0,(Pi-β)/2,0}].Dip.Transpose[EulerMatrix[{0,(Pi-β)/2,0}]].Transpose[EulerMatrix[{0,-θ,-ϕ}]] ;
%//MatrixForm

(Pi-1.11)/2

(*Example of the above rotation where 'A' is the red-tinted molecule and 'B' is the blue-tinted molecule *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,-15}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[-θ,{0,1,0}],RotationTransform[-ϕ,{0,0,1}],RotationTransform[-(Pi-β)/2,{0,1,0}],TranslationTransform[{-15,0,0}],RotationTransform[Pi,{0,0,1}]}](*Remove this rotation to get a 'chasing' orientation of the x-axes *),GeometricTransformation[pentaBlue,Composition@@{RotationTransform[-θ,{0,1,0}],RotationTransform[-ϕ,{0,0,1}],RotationTransform[(Pi-β)/2,{0,1,0},{0,0,0}],TranslationTransform[{15,0,0}]}]},Axes->False,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}},Boxed->False,ViewPoint->{5,10,6}],{{β,Pi,"Symmetric β Rotation"},0,Pi},{{θ,0},0,2Pi},{{ϕ,0},0,2Pi}]

(* Showing active rotation of the B field is the same as a passive rotation of the molecules *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{RotationTransform[θ,{0,1,0}],RotationTransform[ϕ,{0,0,1}],TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[-(Pi-β)/2,{0,1,0}],TranslationTransform[{-15,0,0}],RotationTransform[Pi,{0,0,1}]}](*Remove this rotation to get a 'chasing' orientation of the x-axes *),GeometricTransformation[pentaBlue,Composition@@{RotationTransform[(Pi-β)/2,{0,1,0},{0,0,0}],TranslationTransform[{15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}}],{{β,Pi,"Symmetric β Rotation"},0,Pi},{{θ,0},0,2Pi},{{ϕ,0},0,2Pi}]

(* Showing symmetric rotation is the same as rotation of only one of the molecules *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[-ϕ,{0,0,1}],RotationTransform[-θ,{0,1,0}],RotationTransform[-(Pi-β),{0,1,0}],TranslationTransform[{-15,0,0}],RotationTransform[Pi,{0,0,1}]}](*Remove this rotation to get a 'chasing' orientation of the x-axes *),GeometricTransformation[pentaBlue,Composition@@{RotationTransform[-ϕ,{0,0,1}],RotationTransform[-θ,{0,1,0}],TranslationTransform[{15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}}],{{β,Pi,"Symmetric β Rotation"},0,Pi},{{θ,0},0,2Pi},{{ϕ,0},0,2Pi}]

(* Rotating just one Dimer by β *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,TranslationTransform[{-15,0,0}]],GeometricTransformation[pentaBlue,Composition@@{RotationTransform[(Pi-β),{0,1,0},{0,0,0}],RotationTransform[180Degree,{0,0,1},{15,0,0}],TranslationTransform[{15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},PlotRange->{{-30,30},{-30,30},{-30,30}},ImageSize->Large],{{β,0},0,Pi}]

?Graphics3D

(* Demonstration of Euler Angles being used *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,TranslationTransform[{-15,0,0}]],GeometricTransformation[pentaBlue,Composition@@{RotationTransform[γ,{Cos[α]Sin[β],Sin[α]Sin[β],Cos[β]},{15,0,0}],RotationTransform[β,{-Sin[α],Cos[α],0},{15,0,0}],RotationTransform[α,{0,0,1},{15,0,0}],TranslationTransform[{15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},PlotRange->{{-30,30},{-30,30},{-30,30}},ImageSize->Large,PlotLabel->Style["Rotation of Chromophore B using Euler angles {α,β,γ}",Black,20]],{{α,0},-Pi,Pi},{{β,0},-Pi,Pi},{{γ,0},-Pi,Pi}]

(* Demonstration of Euler Angles being used (alternate using identity (Subscript[D, z''])(γ)(Subscript[D, y'])(β)(Subscript[D, z])(α)≡ (Subscript[D, z])(α)(Subscript[D, y])(β)(Subscript[D, z])(γ) ) *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,TranslationTransform[{-15,0,0}]],GeometricTransformation[pentaBlue,Composition@@{RotationTransform[α,{0,0,1},{15,0,0}],RotationTransform[β,{0,1,0},{15,0,0}],RotationTransform[γ,{0,0,1},{15,0,0}],TranslationTransform[{15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},PlotRange->{{-30,30},{-30,30},{-30,30}},ImageSize->Large,PlotLabel->Style["Rotation of Chromophore B using Euler angles {α,β,γ} (alternate)",Black,20]],{{α,0},-Pi,Pi},{{β,0},-Pi,Pi},{{γ,0},-Pi,Pi}]

(* Symmetric rotation of both dimers *)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[α,{1,0,0}],RotationTransform[-(Pi-β)/2,{0,1,0}],TranslationTransform[{-15,0,0}],RotationTransform[Pi,{0,0,1}]}](*Remove this rotation to get a 'chasing' orientation of the x-axes *),GeometricTransformation[pentaBlue,Composition@@{TranslationTransform[{15,0,0}],RotationTransform[(Pi-β)/2,{0,1,0},{-15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}}],{{β,Pi,"Symmetric β Rotation"},0,Pi},{{α,0,"xRotation"},-Pi,Pi}]

(* Symmetric rotation of both dimers with passive rotation of magnetic field*)
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[-ϕ,{0,0,1}],RotationTransform[-θ,{0,1,0}],RotationTransform[-(Pi-β)/2,{0,1,0}],TranslationTransform[{-15,0,0}]}],GeometricTransformation[pentaBlue,Composition@@{RotationTransform[-ϕ,{0,0,1}],RotationTransform[-θ,{0,1,0}],TranslationTransform[{15,0,0}],RotationTransform[(Pi-β)/2,{0,1,0},{-15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}}],{{β,Pi,"Symmetric β Rotation"},0,Pi},{{ϕ,0},0,2Pi},{{θ,0},-Pi,Pi}]

N[UnitConvert[Quantity[111,"Degree"],"Radians"]]

?RollPitchYawMatrix

RollPitchYawMatrix[{0,θ,0}].RollPitchYawMatrix[{ϕ,0,0}].RollPitchYawMatrix[{0,-(Pi-β)/2,0}].{0,1,0}

(*Starting with initial angles and seeing how rotations bring everything into each other *)
βStart=QuantityMagnitude[UnitConvert[Quantity[111,"Degree"],"Radians"]];
ϕStart=QuantityMagnitude[UnitConvert[Quantity[90,"Degree"],"Radians"]];
θStart =QuantityMagnitude[UnitConvert[Quantity[90,"Degree"],"Radians"]];
Manipulate[Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,10}]}],GeometricTransformation[pentaRed,Composition@@{RotationTransform[θ,{0,1,0}],RotationTransform[ϕ,{0,0,1}],RotationTransform[(Pi-β)/2,{-Cos[θStart]Sin[ϕStart],Cos[ϕStart],Sin[θStart]Sin[ϕStart]}],RotationTransform[θStart,{0,1,0}],RotationTransform[ϕStart,{0,0,1}],RotationTransform[βStart/2,{0,1,0}],TranslationTransform[{-15,0,0}]}],GeometricTransformation[pentaBlue,Composition@@{RotationTransform[θ,{0,1,0}],RotationTransform[ϕ,{0,0,1}],RotationTransform[-(Pi-β)/2,{-Cos[θStart]Sin[ϕStart],Cos[ϕStart],Sin[θStart]Sin[ϕStart]}],RotationTransform[θStart,{0,1,0}],RotationTransform[ϕStart,{0,0,1}],TranslationTransform[{15,0,0}],RotationTransform[-βStart/2,{0,1,0},{-15,0,0}]}]},Axes->True,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-30,30},{-30,30},{-30,30}}],{{β,0,"Symmetric β Rotation"},0,Pi},{{ϕ,0},0,2Pi},{{θ,0},0,2Pi}]

Rotation transform is defined with respect to the global axes, need to keep track of how internal axes rotate if you want to do a rotation wrt to those axes

?RotationTransform

Movie Making!

Degree2Radian[ang_]:=QuantityMagnitude[UnitConvert[Quantity[ang,"Degrees"],"Radians"]];

movie[mode_,axes_,flip_,finalβDegrees_,finalϕ_,finalθ_,fileName_,step_:0.05]:=Module[{frame,flipVal=flip,axesShown=axes,finalβ=QuantityMagnitude[UnitConvert[Quantity[finalβDegrees,"Degrees"],"Radians"]]},
(*set frame style with sequence of IF statements *)
If[mode=="symmetricPassive",frame[f_,a_,β_,ϕ_,θ_]:=Graphics3D[{GeometricTransformation[magneticAxes ,Composition@@{TranslationTransform[{0,0,-15}]}],GeometricTransformation[pentaRed ,
Composition@@{(* We end with a passive rotation that takes us into the lab frame (Subscript[R, P])(ϕ,θ,0)=(Subscript[R, A])(0,-θ,-ϕ); we use the following identity to simplify the expressions used here (Subscript[D, z''])(γ)(Subscript[D, y'])(β)(Subscript[D, z])(α)=(Subscript[D, z])(α)(Subscript[D, y])(β)(Subscript[D, z])(γ) *)
RotationTransform[-θ,{0,1,0}],RotationTransform[-ϕ,{0,0,1}],
(* Our first rotation is to symmetrically rotate A and B into a shared 'dimer' frame. This is achieved by the active rotation (Subscript[R, A])(0,(Pi-β)/2,0) for molecule A. Note that if we want the x-axis to point towards the joined edge we have to change the first arguement to Pi and change the sign of the 2nd arguement (since we actually want to now rotate around the -y axis) this is done by the if statements*)RotationTransform[If[f,Pi,0],{0,0,1}],RotationTransform[If[f,-1,1]*(Pi-β)/2,{0,1,0}],TranslationTransform[{If[f,-15,15],0,0}]}],GeometricTransformation[pentaBlue (*B*),Composition@@{(* Same rotations for the magnetic here as for molecule A *)
RotationTransform[-θ,{0,1,0}],RotationTransform[-ϕ,{0,0,1}],
(*Since all of the changes from 'flip' are captured in rotations of molecule A we simply do an active rotation (Subscript[R, A])(0,-(Pi-β)/2,0) for molecule B*)
RotationTransform[-(Pi-β)/2,{0,1,0},{0,0,0}],TranslationTransform[{-15,0,0}]}]},Axes->a,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-40,40},{-40,40},{-40,40}},Boxed->a,ViewPoint->{5, 10,6}];,
If[mode=="symmetricActive",frame[f_,a_,β_,ϕ_,θ_]:=Graphics3D[{GeometricTransformation[magneticAxes (*also works as a 'lab' axes reference*),Composition@@{RotationTransform[ϕ,{0,0,1}],RotationTransform[θ,{0,1,0}],TranslationTransform[{0,0,-15}]}],GeometricTransformation[pentaRed,
Composition@@{(* Since we are actively rotating the B field in this picture we only need to rotate A and B into a shared dimer frame. This is achieved by the active rotation (Subscript[R, A])(0,(Pi-β)/2,0) for molecule A. Note that if we want the x-axis to point towards the joined edge we have to change the first arguement to Pi and change the sign of the 2nd arguement (since we actually want to now rotate around the -y axis) this is done by the if statements*)RotationTransform[If[flip,Pi,0],{0,0,1}],RotationTransform[If[f,-1,1]*(Pi-β)/2,{0,1,0}],TranslationTransform[{If[f,-15,15],0,0}]}],GeometricTransformation[pentaBlue,Composition@@{
(*Since all of the changes from 'flip' are captured in rotations of molecule A we simply do an active rotation (Subscript[R, A])(0,-(Pi-β)/2,0) for molecule B*)
RotationTransform[-(Pi-β)/2,{0,1,0},{0,0,0}],TranslationTransform[{-15,0,0}]}]},Axes->a,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-40,40},{-40,40},{-40,40}},Boxed->a,ViewPoint->{5, 10,6}];,
If[mode=="singularPassive",frame[f_,a_,β_,ϕ_,θ_]:=Graphics3D[{GeometricTransformation[magneticAxes,Composition@@{TranslationTransform[{0,0,-15}]}],GeometricTransformation[pentaRed ,
Composition@@{(*We end with an active rotation that takes us into the lab frame (Subscript[R, A])(ϕ,θ,0); we use the following identity to simplify the expressions used here (Subscript[D, z''])(γ)(Subscript[D, y'])(β)(Subscript[D, z])(α)=(Subscript[D, z])(α)(Subscript[D, y])(β)(Subscript[D, z])(γ) *)
RotationTransform[-θ,{0,0,1}],RotationTransform[-ϕ,{0,1,0}],
(* We only want to rotate molecule A. This is achieved by the active rotation (Subscript[R, A])(0,(Pi-β),0) for molecule A. Note that if we want the x-axis to point towards the joined edge we have to change the first arguement to Pi and change the sign of the 2nd arguement (since we actually want to now rotate around the -y axis) this is done by the if statements*)RotationTransform[If[f,Pi,0],{0,0,1}],RotationTransform[If[f,-1,1]*(Pi-β),{0,1,0}],TranslationTransform[{If[f,-15,15],0,0}]}],GeometricTransformation[pentaBlue (*B*),Composition@@{(* Same rotations for the magnetic here as for molecule A *)
RotationTransform[ϕ,{0,0,1}],RotationTransform[θ,{0,1,0}],
TranslationTransform[{-15,0,0}]}]},Axes->a,AxesLabel->{x,y,z},ImageSize->Large,PlotRange->{{-40,40},{-40,40},{-40,40}},Boxed->a,ViewPoint->{5, 10,6}];,
Print["Not a valid mode, try one of these \n (1)", InputForm["symmetricPassive"],"\n (2)",InputForm["symmetricActive"]] 
]
]
];
mov={};
For[i=1,i<4,i=i+1,AppendTo[mov,frame[False,axesShown,Pi,0,0]]];
For[i=1,i<4,i=i+1,AppendTo[mov,frame[flipVal,axesShown,Pi,0,0]]];
mov=Join[mov,Reverse[Table[frame[flipVal,axesShown,β,0,0],{β,finalβ,Pi,step}]]];
For[i=1,i<4,i=i+1,AppendTo[mov,frame[flipVal,axesShown,finalβ,0,0]]];
mov=Join[mov,Table[frame[flipVal,axesShown,finalβ,ϕ,0],{ϕ,0,finalϕ,step}]];
For[i=1,i<4,i=i+1,AppendTo[mov,frame[flipVal,axesShown,finalβ,finalϕ,0]]];
mov=Join[mov,Table[frame[flipVal,axesShown,finalβ,finalϕ,θ],{θ,0,finalθ,step}]];
AppendTo[mov,frame[flipVal,axesShown,finalβ,finalϕ,finalθ]];
Export[fileName,mov];
]

(*movie["symmetricPassive",False,True,90,Pi/2,Pi/2,"/Users/sina/Google Drive/Research/Singlet Fission Project/rotationGIF_test.gif"]*);

(*movie["singularPassive",False,True,90,Pi,Pi/2,"/Users/sina/Google Drive/Research/Singlet Fission Project/rotationGIF_test2.gif"]*);

%84