16 subroutine foam_morpholgy
17 integer,
parameter :: n=2
19 real (dp) :: tol=1e-8_dp
20 real (dp),
dimension(n) :: x,fvec,diag
21 write(*,*)
'Foam morphology:' 22 write(mfi,*)
'Foam morphology:' 23 select case(morph_input)
27 call hbrd(fcn_dwall,n,x,fvec,epsilon(pi),tol,info,diag)
29 write(*,*)
'unable to determine foam morphology parameters, & 31 write(mfi,*)
'unable to determine foam morphology parameters, & 37 if (fs<0 .or. dstrut< 0)
then 38 write(*,*)
'unable to determine foam morphology & 39 parameters, try different initial guess' 40 write(mfi,*)
'unable to determine foam morphology & 41 parameters, try different initial guess' 46 dwall=(1-por)*dcell/3.775_dp
52 call hbrd(fcn_fs,n,x,fvec,epsilon(pi),tol,info,diag)
54 write(*,*)
'unable to determine foam morphology & 55 parameters, hbrd returned',info,
'restarting' 56 write(mfi,*)
'unable to determine foam morphology & 57 parameters, hbrd returned',info,
'restarting' 63 write(*,*)
'unable to determine foam morphology parameters, & 65 write(mfi,*)
'unable to determine foam morphology parameters, & 71 if (dwall<0 .or. dstrut< 0)
then 72 write(*,*)
'unable to determine foam & 73 morphology parameters, try different initial guess' 74 write(mfi,*)
'unable to determine foam & 75 morphology parameters, try different initial guess' 82 call hbrd(fcn_dstrut,n,x,fvec,epsilon(pi),tol,info,diag)
84 write(*,*)
'unable to determine foam morphology parameters, & 86 write(mfi,*)
'unable to determine foam morphology parameters, & 92 if (dwall<0 .or. fs< 0)
then 93 write(*,*)
'unable to determine foam morphology & 94 parameters, try different initial guess' 95 write(mfi,*)
'unable to determine foam morphology & 96 parameters, try different initial guess' 100 if (fs<struttol)
then 101 dwall=(1-por)*dcell/3.775_dp
106 call hbrd(fcn_fs2,n,x,fvec,epsilon(pi),tol,info,diag)
108 write(*,*)
'unable to determine foam morphology parameters, & 110 write(mfi,*)
'unable to determine foam morphology parameters, & 116 if (dwall<0 .or. dstrut< 0)
then 117 write(*,*)
'unable to determine foam & 118 morphology parameters, try different initial guess' 119 write(mfi,*)
'unable to determine foam & 120 morphology parameters, try different initial guess' 125 write(*,*)
'unknown foam morphology input' 126 write(mfi,*)
'unknown foam morphology input' 129 write(*,
'(2x,A,1x,e9.3)')
'porosity:', por
130 write(*,
'(2x,A,1x,e9.3,1x,A)')
'foam density:', rhof,
'kg/m^3' 131 write(*,
'(2x,A,1x,e9.3,1x,A)')
'cell size:', dcell*1e6,
'um' 132 write(*,
'(2x,A,1x,e9.3,1x,A)')
'wall thickness:', dwall*1e6,
'um' 133 write(*,
'(2x,A,1x,e9.3)')
'strut content:', fs
134 write(*,
'(2x,A,1x,e9.3,1x,A)')
'strut diameter:', dstrut*1e6,
'um' 135 write(mfi,
'(2x,A,1x,e9.3)')
'porosity:', por
136 write(mfi,
'(2x,A,1x,e9.3,1x,A)')
'foam density:', rhof,
'kg/m^3' 137 write(mfi,
'(2x,A,1x,e9.3,1x,A)')
'cell size:', dcell*1e6,
'um' 138 write(mfi,
'(2x,A,1x,e9.3,1x,A)')
'wall thickness:', dwall*1e6,
'um' 139 write(mfi,
'(2x,A,1x,e9.3)')
'strut content:', fs
140 write(mfi,
'(2x,A,1x,e9.3,1x,A)')
'strut diameter:', dstrut*1e6,
'um' 141 end subroutine foam_morpholgy
147 subroutine fcn_dwall(n,x,fvec,iflag)
148 integer,
intent(in) :: n
149 real (dp),
intent(in) :: x(n)
150 real (dp),
intent(out) :: fvec(n)
151 integer,
intent(inout) :: iflag
152 real(dp) :: Vcell,Vstruts,Vwalls,fs,dstrut,dcelldd
155 dcelldd=dcell*(pi/6/0.348_dp)**(1/3._dp)
156 vcell=0.348_dp*dcelldd**3
157 vstruts=2.8_dp*dstrut**2*dcelldd-3.93_dp*dstrut**3
158 vwalls=(1.3143_dp*dcelldd**2-7.367_dp*dstrut*dcelldd+10.323_dp*dstrut**2)*&
160 fvec(1)=fs-vstruts/(vstruts+vwalls)
161 fvec(2)=1-por-(vstruts+vwalls)/vcell
162 end subroutine fcn_dwall
168 subroutine fcn_fs(n,x,fvec,iflag)
169 integer,
intent(in) :: n
170 real (dp),
intent(in) :: x(n)
171 real (dp),
intent(out) :: fvec(n)
172 integer,
intent(inout) :: iflag
173 real(dp) :: Vcell,Vstruts,Vwalls,dwall,dstrut,dcelldd
176 dcelldd=dcell*(pi/6/0.348_dp)**(1/3._dp)
177 vcell=0.348_dp*dcelldd**3
178 vstruts=2.8_dp*dstrut**2*dcelldd-3.93_dp*dstrut**3
179 vwalls=(1.3143_dp*dcelldd**2-7.367_dp*dstrut*dcelldd+10.323_dp*dstrut**2)*&
181 fvec(1)=fs-vstruts/(vstruts+vwalls)
182 fvec(2)=1-por-(vstruts+vwalls)/vcell
183 end subroutine fcn_fs
189 subroutine fcn_dstrut(n,x,fvec,iflag)
190 integer,
intent(in) :: n
191 real (dp),
intent(in) :: x(n)
192 real (dp),
intent(out) :: fvec(n)
193 integer,
intent(inout) :: iflag
194 real(dp) :: Vcell,Vstruts,Vwalls,dwall,fs,dcelldd
197 dcelldd=dcell*(pi/6/0.348_dp)**(1/3._dp)
198 vcell=0.348_dp*dcelldd**3
199 vstruts=2.8_dp*dstrut**2*dcelldd-3.93_dp*dstrut**3
200 vwalls=(1.3143_dp*dcelldd**2-7.367_dp*dstrut*dcelldd+10.323_dp*dstrut**2)*&
202 fvec(1)=fs-vstruts/(vstruts+vwalls)
203 fvec(2)=1-por-(vstruts+vwalls)/vcell
204 end subroutine fcn_dstrut
212 subroutine fcn_fs2(n,x,fvec,iflag)
213 integer,
intent(in) :: n
214 real (dp),
intent(in) :: x(n)
215 real (dp),
intent(out) :: fvec(n)
216 integer,
intent(inout) :: iflag
217 real(dp) :: Vcell,Vstruts,Vwalls,dwall,dstrut,dcelldd,x1,x2,x3
220 dcelldd=dcell*(pi/6/0.348_dp)**(1/3._dp)
221 vcell=0.348_dp*dcelldd**3
222 vstruts=2.8_dp*dstrut**2*dcelldd
223 vwalls=(1.317_dp*dcelldd**2-13.4284_dp*dstrut*dcelldd+34.2375_dp*dstrut**2)*&
224 dwall+(4.639_dp*dcell-17.976_dp*dstrut)*dwall**2
225 fvec(1)=fs-vstruts/(vstruts+vwalls)
226 fvec(2)=1-por-(vstruts+vwalls)/vcell
227 end subroutine fcn_fs2