! upper convected maxwell particle coalescence program
! this is the program for the transient upper convected maxwell coalescence model with 1
! mode.
implicit none
integer :: i,j,n,modes,ierror integer :: nroots,itmax,info(1)
! set # of modes
parameter (modes = 5)
integer, dimension(1:modes,1:2) :: L real :: ao,visc(modes),gam,lam(modes),t,x real :: C11,C22,T1(1:modes),T2(1:modes) real :: F(1000,6),tf,dx,dt,sol
real :: errabs,errel,eps,eta,fcn
common n,ao,visc,gam,lam,t,x,L,C11,C22,T1,T2 external ZREAL, fcn
! set n = modes n = 5 L(:,:) = 0 F(:,:) = 0
! define parameters ao = 2.74E-4
visc(1) = 1084.603559 visc(2) = 2677.551217 visc(3) = 3778.27556 visc(4) = 3259.505989 visc(5) = 1274.613484 gam = 0.02832
lam(1) = 0.02243756 lam(2) = 0.162908159 lam(3) = 1.010652684 lam(4) = 6.48507642 lam(5) = 49.20180938
! set initial conditions
t = 0.0001*(sum(visc))*ao/gam
x = asin((3./2.*gam*t/(sum(visc))/ao)**0.5)
! enter initial conditions into solution matrix
F(1,1) = t
F(1,2) = sin(x)
! end time tf = 650.
! set time step (adjust for convergence) dt = 0.001
! initial guess at solution dx = 1.
! initialize counters
! i = 2 because 1 is initial conditions
! j is for data reduction loop
i = 2
j = 1
errabs = 1.0E-5 errel = 1.0E-5 eps = 1.0E-5 eta = 1.0E-2 nroots = 1 itmax = 1000
! open file to write to
open (unit=10, file='output.ecs', status='new', iostat=ierror) write(10,*) F(1,1),F(1,2)
do while (t < tf)
! find root of expression if (i == 2) then
call ZREAL(fcn, errabs, errel, eps, eta, nroots, itmax, dx, sol, info) dx = sol
t = t + dt
F(i,1) = t
F(i,2) = sin(x + sol*dt)
! calculate extension rate and viscosity for file
K = tan(x)/2.-sin(x)/6.*((2.*(2.-cos(x))+(1.+cos(x)))/
(1.+cos(x))/(2.-cos(x)))
tvisc = (sum(T1)-sum(T2))/K/dx !biaxial extensional viscosity F(i,3) = K*dx !biaxial extension rate
F(i,4) = tvisc
F(i,5) = sum(T1) !normal stress 11
F(i,6) = sum(T2) !normal stress 22
! write solution to file
write(10,*) F(i,1),F(i,2),F(i,3),F(i,4),F(i,5),F(i,6) else if (i > 2)
call ZREAL(fcn1, errabs, errel, eps, eta, nroots, itmax, dx, sol, info)
dx = sol
t = t + dt
K = tan(x)/2.-sin(x)/6.*((2.*(2.-cos(x))+(1.+cos(x)))/
(1.+cos(x))/(2.-cos(x))) if (j == 1000) then
F(i,1) = t
F(i,2) = sin(x + sol*dt)
! calculate extension rate and viscosity for file
! biaxial extensional viscosity
tvisc = (sum(T1)-sum(T2))/K/dx
F(i,3) = K*dx !biaxial extension rate F(i,4) = tvisc
F(i,5) = sum(T1) !normal stress 11
F(i,6) = sum(T2) !normal stress 22
! write data to file
write(10,*) F(i,1),F(i,2),F(i,3),F(i,4),F(i,5),F(i,6) j = 0
end if end if
! calculate stress constants for next time step
C11 = exp((1./lam-2.*K*dx)*t)*(sum(T1)-2.*visc*K*dx/
(1.-2.*lam*K*dx))
C22 = exp((1./lam+4.*K*dx)*t)*(sum(T2)+4.*visc*K*dx/
(1.-2.*lam*K*dx))
! step forward x (theta) x = x + sol*dt
! advance counters
i = i + 1
j = j + 1
end do
end program
!- supporting function ---
! fcn is a function that is called by zreal to find dtheta/dt. It is only used for the first time
! step to initiate the program by using integration constants for the stress expressions that
! are determined from the conditions: t=0 Tau11 = Tau22 = 0.
!--- real function fcn(dx)
implicit none
integer :: i,j,n,modes parameter(modes = 5)
integer, dimension(1:modes,1:2) :: L
real :: ao,visc(modes),gam,lam(modes),t,x,dx real :: K,C11,C22,T1(1:modes),T2(1:modes)
common n,ao,visc,gam,lam,t,x,L,C11,C22,T1,T2
! for small angles (approximation)
! K = sin(x)/(1+cos(x))/(2-cos(x))
! full expression
K = tan(x)/2.-sin(x)/6.*((2.*(2.-cos(x))+(1.+cos(x)))/(1.+cos(x))/(2.-cos(x)))
i = 1
j = 1
! multimode 1st normal stress (Tau11)
! loop to determine each mode's contribution to stress
! conditions to simplify the stress equation once steady state has been reached do while (i <= n)
if (L(i,1) == 1) then
T1(i) = 2.*visc(i)*K*dx/(1.-2.*lam(i)*K*dx) !steady state else if (exp(-(1./lam(i)-2.*K*dx)*t)*(exp((1./lam(i)-2.*K*dx)*t)-1.) == 1.)
` then
T1(i) = 2.*visc(i)*K*dx/(1.-2.*lam(i)*K*dx)
L(i,1) = 1
else
T1(i) = 2.*visc(i)*K*dx/(1.-2.*lam(i)*K*dx)*
exp(-(1./lam(i)-2.*K*dx)*t)*(exp((1./lam(i)-2.*K*dx)*t)-1.) end if
i = i+1
end do
! multimode 2cnd normal stress (Tau22) do while (j <= n)
if (L(j,2) == 1) then
T2(j) = -4.*visc(j)*K*dx/(1.+4.*lam(j)*K*dx)
else if (exp(-(1./lam(j)+4.*K*dx)*t)*(exp((1./lam(j)+4.*K*dx)*t)-1.)
== 1.) then
T2(j) = -4.*visc(j)*K*dx/(1.+4.*lam(j)*K*dx)
L(j,2) = 1
else
T2(j) = -4.*visc(j)*K*dx/(1.+4.*lam(j)*K*dx)*
exp(-(1./lam(j)+4.*K*dx)*t)*(exp((1./lam(j)+4.*K*dx)*t)-1.) end if
j = j+1
end do
! define energy balance
fcn = 2.**(2./3.)*ao*K/3./gam*(sum(T1)-sum(T2))*(1.+cos(x))**(4./3.)*
(2.-cos(x))**(5./3.)/cos(x)/sin(x)-1.
return end
!- supporting function ---
! fcn1 is a function that is called by zreal to find dtheta/dt. It is used for all time steps
! after the first iteration. The integration constant for the stress expressions are
!determined using Tau11 & Tau22 from the previous time step.
!--- real function fcn1(dx)
implicit none
integer :: i,j,n,modes parameter(modes = 5)
integer, dimension(1:modes,1:2) :: L
real :: ao,visc(modes),gam,lam(modes),t,x,dx,C11,C22 real :: K,C11,C22,T1(1:modes),T2(1:modes)
common n,ao,visc,gam,lam,t,x,L,C11,C22,T1,T2
! for small angles (approximation)
! K = sin(x)/(1+cos(x))/(2-cos(x))
! full expression
K = tan(x)/2.-sin(x)/6.*((2.*(2.-cos(x))+(1.+cos(x)))/(1.+cos(x))/(2.-cos(x)))
i = 1
j = 1
! loop to determine each mode's contribution to stress
! conditions to simplify the stress equation once steady state has been reached
! multimode 1st normal stress (Tau11) do while (i <= n)
if (L(i,1) == 1) then
T1(i) = 2.*visc(i)*K*dx/(1.-2.*lam(i)*K*dx) !steady state else if (exp(-(1./lam(i)-2.*K*dx)*t)*(exp((1./lam(i)-2.*K*dx)*t)+C11)
== 1.) then
T1(i) = 2.*visc(i)*K*dx/(1.-2.*lam(i)*K*dx) !steady state
L(i,1) = 1 else
T1(i) = exp(-(1./lam(i)-2.*K*dx)*t)*(2.*visc(i)*K*dx/
(1.-2.*lam(i)*K*dx)*exp((1./lam(i)-2.*K*dx)*t)+C11)!transient end if
i = i+1
end do
! multimode 2cnd normal stress (Tau22) do while (j <= n)
if (L(j,2) == 1) then
T2(j) = -4.*visc(j)*K*dx/(1.+4.*lam(j)*K*dx) !steady state else if (exp(-(1./lam(j)+4.*K*dx)*t)*(exp((1./lam(j)+4.*K*dx)*t)+C22.)
== 1.) then
T2(j) = -4.*visc(j)*K*dx/(1.+4.*lam(j)*K*dx) !steady state
L(j,2) = 1
else
T2(j) = exp(-(1./lam(j)+4.*K*dx)*t)*(-4.*visc(j)*K*dx/
(1.+4.*lam(j)*K*dx)*exp((1./lam(j)+4.*K*dx)*t)+C22)!transient end if
j = j+1
end do
! define energy balance
fcn = 2.**(2./3.)*ao*K/3./gam*(sum(T1)-sum(T2))*(1.+cos(x))**(4./3.)*
(2.-cos(x))**(5./3.)/cos(x)/sin(x)-1.
return end
Appendix E. Physical and Mechanical Properties