removed functions added for debugging of divergence calculation to math.f90
corrected calculation of stress BC condition. Depending on given BC, the stiffness matrix is reduced and than inversed. Then it is filled with zeros and used for the calculation of the correct change of deformation gradient. All calculation is done using dP/dF
This commit is contained in:
Martin Diehl
parent
1ffb59a96a
commit
f99bf63397
|
|
@ -120,25 +120,6 @@ program DAMASK_spectral
|
||||||
integer(pInt) loadcase, ielem, iter, calcmode, CPFEM_mode, ierr, not_converged_counter
|
integer(pInt) loadcase, ielem, iter, calcmode, CPFEM_mode, ierr, not_converged_counter
|
||||||
logical errmatinv
|
logical errmatinv
|
||||||
|
|
||||||
!real(pReal) temperature ! not used, but needed for call to CPFEM_general
|
|
||||||
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
integer*8 plan_div(3)
|
|
||||||
real(pReal), dimension(:,:,:,:), allocatable :: divergence
|
|
||||||
complex(pReal), dimension(:,:,:,:), allocatable :: divergence_hat
|
|
||||||
complex(pReal), dimension(:,:,:,:), allocatable :: divergence_hat_full
|
|
||||||
complex(pReal), dimension(:,:,:,:), allocatable :: divergence_hat_full2
|
|
||||||
complex(pReal), dimension(:,:,:,:,:), allocatable :: pstress_field_hat, pstress_field
|
|
||||||
real(pReal) ev1, ev2, ev3
|
|
||||||
real(pReal), dimension(3,3) :: evb1, evb2, evb3
|
|
||||||
real(pReal) p_hat_avg_inf, p_hat_avg_two, p_real_avg_inf, p_real_avg_two, &
|
|
||||||
err_div_avg_inf, err_div_avg_two, err_div_max_inf, err_div_max_two, &
|
|
||||||
err_div_avg_inf2, err_div_avg_two2, err_div_max_two2, err_div_max_inf2, &
|
|
||||||
err_real_div_avg_inf, err_real_div_avg_two, err_real_div_max_inf, err_real_div_max_two, &
|
|
||||||
err_real_div_avg_inf2, err_real_div_avg_two2, err_real_div_max_inf2, err_real_div_max_two2, &
|
|
||||||
rho
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
!Initializing
|
!Initializing
|
||||||
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
|
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
|
||||||
|
|
||||||
|
|
@ -356,17 +337,7 @@ program DAMASK_spectral
|
||||||
allocate (defgradold ( resolution(1),resolution(2),resolution(3),3,3)); defgradold = 0.0_pReal
|
allocate (defgradold ( resolution(1),resolution(2),resolution(3),3,3)); defgradold = 0.0_pReal
|
||||||
allocate (coordinates(3,resolution(1),resolution(2),resolution(3))); coordinates = 0.0_pReal
|
allocate (coordinates(3,resolution(1),resolution(2),resolution(3))); coordinates = 0.0_pReal
|
||||||
allocate (temperature( resolution(1),resolution(2),resolution(3))); temperature = bc_temperature(1) ! start out isothermally
|
allocate (temperature( resolution(1),resolution(2),resolution(3))); temperature = bc_temperature(1) ! start out isothermally
|
||||||
|
allocate (xi (3,resolution(1)/2+1,resolution(2),resolution(3))); xi =0.0_pReal
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
!allocate (xi (3,resolution(1)/2+1,resolution(2),resolution(3))); xi = 0.0_pReal
|
|
||||||
allocate (xi (3,resolution(1),resolution(2),resolution(3))); xi = 0.0_pReal
|
|
||||||
allocate (divergence (resolution(1) ,resolution(2),resolution(3),3)); divergence = 0.0_pReal
|
|
||||||
allocate (divergence_hat (resolution(1)/2+1,resolution(2),resolution(3),3)); divergence_hat = 0.0_pReal
|
|
||||||
allocate (divergence_hat_full(resolution(1),resolution(2),resolution(3),3)); divergence_hat_full = 0.0_pReal
|
|
||||||
allocate (divergence_hat_full2(resolution(1),resolution(2),resolution(3),3)); divergence_hat_full2 = 0.0_pReal
|
|
||||||
allocate (pstress_field_hat(resolution(1),resolution(2),resolution(3),3,3)); pstress_field_hat = 0.0_pReal
|
|
||||||
allocate (pstress_field (resolution(1),resolution(2),resolution(3),3,3)); pstress_field = 0.0_pReal
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
wgt = 1.0_pReal/real(resolution(1)*resolution(2)*resolution(3), pReal)
|
wgt = 1.0_pReal/real(resolution(1)*resolution(2)*resolution(3), pReal)
|
||||||
defgradAim = math_I3
|
defgradAim = math_I3
|
||||||
|
|
@ -393,13 +364,8 @@ program DAMASK_spectral
|
||||||
do j = 1, resolution(2)
|
do j = 1, resolution(2)
|
||||||
k_s(2) = j-1
|
k_s(2) = j-1
|
||||||
if(j > resolution(2)/2+1) k_s(2) = k_s(2)-resolution(2)
|
if(j > resolution(2)/2+1) k_s(2) = k_s(2)-resolution(2)
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
do i = 1, resolution(1)/2+1
|
||||||
!do i = 1, resolution(1)/2+1
|
|
||||||
! k_s(1) = i-1
|
|
||||||
do i = 1, resolution(1) !defining full xi vector field (no conjugate complex symmetry)
|
|
||||||
k_s(1) = i-1
|
k_s(1) = i-1
|
||||||
if(i > resolution(1)/2+1) k_s(1) = k_s(1)-resolution(1)
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
xi(3,i,j,k) = 0.0_pReal ! 2D case
|
xi(3,i,j,k) = 0.0_pReal ! 2D case
|
||||||
if(resolution(3) > 1) xi(3,i,j,k) = real(k_s(3), pReal)/geomdimension(3) ! 3D case
|
if(resolution(3) > 1) xi(3,i,j,k) = real(k_s(3), pReal)/geomdimension(3) ! 3D case
|
||||||
xi(2,i,j,k) = real(k_s(2), pReal)/geomdimension(2)
|
xi(2,i,j,k) = real(k_s(2), pReal)/geomdimension(2)
|
||||||
|
|
@ -444,21 +410,6 @@ program DAMASK_spectral
|
||||||
workfft,(/resolution(1)/2+1,resolution(2),resolution(3)/),1,(resolution(1)/2+1)*resolution(2)*resolution(3),&
|
workfft,(/resolution(1)/2+1,resolution(2),resolution(3)/),1,(resolution(1)/2+1)*resolution(2)*resolution(3),&
|
||||||
workfft,(/resolution(1) +2,resolution(2),resolution(3)/),1,(resolution(1) +2)*resolution(2)*resolution(3),FFTW_PATIENT)
|
workfft,(/resolution(1) +2,resolution(2),resolution(3)/),1,(resolution(1) +2)*resolution(2)*resolution(3),FFTW_PATIENT)
|
||||||
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
call dfftw_plan_many_dft(plan_div(1),3,(/resolution(1),resolution(2),resolution(3)/),9,&
|
|
||||||
pstress_field, (/resolution(1),resolution(2),resolution(3)/),1,(resolution(1)*resolution(2)*resolution(3)),&
|
|
||||||
pstress_field_hat,(/resolution(1),resolution(2),resolution(3)/),1,(resolution(1)*resolution(2)*resolution(3)),&
|
|
||||||
FFTW_FORWARD,FFTW_PATIENT)
|
|
||||||
call dfftw_plan_many_dft_c2r(plan_div(2),3,(/resolution(1),resolution(2),resolution(3)/),3,&
|
|
||||||
divergence_hat, (/resolution(1)/2+1,resolution(2),resolution(3)/),1,(resolution(1)/2+1)*resolution(2)*resolution(3),&
|
|
||||||
divergence ,(/resolution(1), resolution(2),resolution(3)/),1, resolution(1)* resolution(2)*resolution(3),&
|
|
||||||
FFTW_PATIENT)
|
|
||||||
call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(3)/),3,&
|
|
||||||
divergence_hat_full,(/resolution(1),resolution(2),resolution(3)/),1,resolution(1)*resolution(2)*resolution(3),&
|
|
||||||
divergence_hat_full2,(/resolution(1),resolution(2),resolution(3)/),1,resolution(1)* resolution(2)*resolution(3),&
|
|
||||||
FFTW_BACKWARD,FFTW_PATIENT)
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
! write header of output file
|
! write header of output file
|
||||||
open(538,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())&
|
open(538,file=trim(getSolverWorkingDirectoryName())//trim(getSolverJobName())&
|
||||||
//'.spectralOut',form='UNFORMATTED')
|
//'.spectralOut',form='UNFORMATTED')
|
||||||
|
|
@ -551,7 +502,6 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
CPFEM_mode = 1_pInt ! winding forward
|
CPFEM_mode = 1_pInt ! winding forward
|
||||||
iter = 0_pInt
|
iter = 0_pInt
|
||||||
err_div= 2.0_pReal * err_div_tol ! go into loop
|
err_div= 2.0_pReal * err_div_tol ! go into loop
|
||||||
defgradAimCorr = 0.0_pReal ! reset damping calculation
|
|
||||||
|
|
||||||
!*************************************************************
|
!*************************************************************
|
||||||
! convergence loop
|
! convergence loop
|
||||||
|
|
@ -607,12 +557,13 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
call math_invert(9, math_plain3333to99(c_current),s_current99,i,errmatinv)
|
call math_invert(9, math_plain3333to99(c_current),s_current99,i,errmatinv)
|
||||||
if(errmatinv) then
|
if(errmatinv) then
|
||||||
print*, 'using symmetric compliance'
|
print*, 'using symmetric compliance'
|
||||||
pause !somehow not working, maybe we don't need it
|
pause !maybe we don't need it. Code below is not working
|
||||||
!mask_stress6 = math_Plain33to6_logical(bc_mask(:,:,2,loadcase))
|
!mask_stress6 = math_Plain33to6_logical(bc_mask(:,:,2,loadcase))
|
||||||
|
!if the symmetrized stiffness is not used at all, the allocate terms only needed at the beginning of a load case
|
||||||
size_reduced = count(mask_stress6)
|
size_reduced = count(mask_stress6)
|
||||||
allocate (c_reduced(size_reduced,size_reduced)); c_reduced = 0.0_pReal
|
allocate (c_reduced(size_reduced,size_reduced)); c_reduced = 0.0_pReal
|
||||||
allocate (s_reduced(size_reduced,size_reduced)); s_reduced = 0.0_pReal
|
allocate (s_reduced(size_reduced,size_reduced)); s_reduced = 0.0_pReal
|
||||||
c_current66 = math_Plain3333to66(c_current)
|
! c_current66 = math_Plain3333to66(c_current)
|
||||||
k = 0_pInt
|
k = 0_pInt
|
||||||
do n = 1,6
|
do n = 1,6
|
||||||
if(mask_stress6(n)) then
|
if(mask_stress6(n)) then
|
||||||
|
|
@ -642,15 +593,14 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
enddo
|
enddo
|
||||||
endif
|
endif
|
||||||
enddo
|
enddo
|
||||||
s_current = math_Plain66to3333(s_current66)
|
! s_current = math_Plain66to3333(s_current66)
|
||||||
else
|
else
|
||||||
print*, 'using non-symmetric compliance'
|
|
||||||
mask_stress9 = reshape(bc_mask(:,:,2,loadcase),(/9/))
|
mask_stress9 = reshape(bc_mask(:,:,2,loadcase),(/9/))
|
||||||
size_reduced = count(mask_stress9)
|
size_reduced = count(mask_stress9)
|
||||||
allocate (c_reduced(size_reduced,size_reduced)); c_reduced = 0.0_pReal
|
allocate (c_reduced(size_reduced,size_reduced)); c_reduced = 0.0_pReal
|
||||||
allocate (s_reduced(size_reduced,size_reduced)); s_reduced = 0.0_pReal
|
allocate (s_reduced(size_reduced,size_reduced)); s_reduced = 0.0_pReal
|
||||||
c_current99 = math_Plain3333to99(c_current)
|
c_current99 = math_Plain3333to99(c_current)
|
||||||
k = 0_pInt
|
k = 0_pInt ! build reduced stiffness
|
||||||
do n = 1,9
|
do n = 1,9
|
||||||
if(mask_stress9(n)) then
|
if(mask_stress9(n)) then
|
||||||
k = k + 1_pInt
|
k = k + 1_pInt
|
||||||
|
|
@ -659,14 +609,12 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
if(mask_stress9(m)) then
|
if(mask_stress9(m)) then
|
||||||
j = j + 1_pInt
|
j = j + 1_pInt
|
||||||
c_reduced(k,j) = c_current99(n,m)
|
c_reduced(k,j) = c_current99(n,m)
|
||||||
endif
|
endif; enddo; endif; enddo
|
||||||
enddo
|
|
||||||
endif
|
call math_invert(size_reduced, c_reduced, s_reduced, i, errmatinv) ! invert reduced stiffness
|
||||||
enddo
|
|
||||||
call math_invert(size_reduced, c_reduced, s_reduced, i, errmatinv)
|
|
||||||
if(errmatinv) call IO_error(800)
|
if(errmatinv) call IO_error(800)
|
||||||
|
|
||||||
s_current99 = 0.0_pReal
|
s_current99 = 0.0_pReal ! build full compliance
|
||||||
k = 0_pInt
|
k = 0_pInt
|
||||||
do n = 1,9
|
do n = 1,9
|
||||||
if(mask_stress9(n)) then
|
if(mask_stress9(n)) then
|
||||||
|
|
@ -676,35 +624,19 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
if(mask_stress9(m)) then
|
if(mask_stress9(m)) then
|
||||||
j = j + 1_pInt
|
j = j + 1_pInt
|
||||||
s_current99(n,m) = s_reduced(k,j)
|
s_current99(n,m) = s_reduced(k,j)
|
||||||
endif
|
endif; enddo; endif; enddo
|
||||||
enddo
|
|
||||||
endif
|
|
||||||
enddo
|
|
||||||
s_current = math_Plain99to3333(s_current99)
|
s_current = math_Plain99to3333(s_current99)
|
||||||
endif
|
endif
|
||||||
|
|
||||||
deallocate(c_reduced)
|
deallocate(c_reduced)
|
||||||
deallocate(s_reduced)
|
deallocate(s_reduced)
|
||||||
print*, 'Correcting deformation gradient to fullfill BCs'
|
print*, 'Correcting deformation gradient to fullfill BCs'
|
||||||
|
|
||||||
defgradAimCorr = - math_mul3333xx33(s_current, ((pstress_av - bc_stress(:,:,loadcase)))) ! residual on given stress components
|
defgradAimCorr = - math_mul3333xx33(s_current, ((pstress_av - bc_stress(:,:,loadcase)))) ! residual on given stress components
|
||||||
|
|
||||||
print*, 'change of Stress:'
|
|
||||||
print '(3(f10.4,x))', -math_transpose3x3(math_mul3333xx33(c_current,defgradAimCorr))/1.e6
|
|
||||||
print*, 'defgradAimCorr:'
|
|
||||||
print '(3(e12.3,x))', math_transpose3x3(defgradAimCorr)
|
|
||||||
do m=1,3; do n =1,3 ! calculate damper
|
|
||||||
! if ( sign(1.0_pReal,defgradAimCorr(m,n))/=sign(1.0_pReal,defgradAimCorrPrev(m,n))) then
|
|
||||||
if (defgradAimCorr(m,n) * defgradAimCorrPrev(m,n) < -relevantStrain ** 2.0_pReal) then ! insignificant within relevantstrain around zero
|
|
||||||
damper(m,n) = max(0.01_pReal,damper(m,n)*0.8)
|
|
||||||
else
|
|
||||||
damper(m,n) = min(1.0_pReal,damper(m,n) *1.2)
|
|
||||||
endif
|
|
||||||
enddo; enddo
|
|
||||||
defgradAimCorr = damper * defgradAimCorr
|
|
||||||
defgradAim = defgradAim + defgradAimCorr
|
defgradAim = defgradAim + defgradAimCorr
|
||||||
|
|
||||||
do m = 1,3; do n = 1,3
|
do m = 1,3; do n = 1,3
|
||||||
defgrad(:,:,:,m,n) = defgrad(:,:,:,m,n) + (defgradAim(m,n) - defgrad_av(m,n)) ! anticipated target minus current state
|
defgrad(:,:,:,m,n) = defgrad(:,:,:,m,n) + defgradAim(m,n) - defgrad_av(m,n) ! anticipated target minus current state
|
||||||
enddo; enddo
|
enddo; enddo
|
||||||
err_div = 2.0_pReal * err_div_tol
|
err_div = 2.0_pReal * err_div_tol
|
||||||
err_defgrad = maxval(abs(mask_defgrad * (defgrad_av - defgradAim)))
|
err_defgrad = maxval(abs(mask_defgrad * (defgrad_av - defgradAim)))
|
||||||
|
|
@ -727,9 +659,7 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
cstress,dsde, pstress, dPdF)
|
cstress,dsde, pstress, dPdF)
|
||||||
enddo; enddo; enddo
|
enddo; enddo; enddo
|
||||||
ielem = 0_pInt
|
ielem = 0_pInt
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
pstress_field = cmplx(0.0_pReal,0.0_pReal)
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1)
|
do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1)
|
||||||
ielem = ielem + 1_pInt
|
ielem = ielem + 1_pInt
|
||||||
call CPFEM_general(CPFEM_mode,& ! first element in first iteration retains CPFEM_mode 1,
|
call CPFEM_general(CPFEM_mode,& ! first element in first iteration retains CPFEM_mode 1,
|
||||||
|
|
@ -739,9 +669,6 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
cstress,dsde, pstress, dPdF)
|
cstress,dsde, pstress, dPdF)
|
||||||
CPFEM_mode = 2_pInt
|
CPFEM_mode = 2_pInt
|
||||||
workfft(i,j,k,:,:) = pstress
|
workfft(i,j,k,:,:) = pstress
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
pstress_field(i,j,k,:,:) = pstress
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
cstress_av = cstress_av + math_mandel6to33(cstress)
|
cstress_av = cstress_av + math_mandel6to33(cstress)
|
||||||
enddo; enddo; enddo
|
enddo; enddo; enddo
|
||||||
cstress_av = cstress_av * wgt
|
cstress_av = cstress_av * wgt
|
||||||
|
|
@ -752,194 +679,20 @@ call dfftw_plan_many_dft(plan_div(3),3,(/resolution(1),resolution(2),resolution(
|
||||||
print *, 'Calculating equilibrium using spectral method'
|
print *, 'Calculating equilibrium using spectral method'
|
||||||
err_div = 0.0_pReal
|
err_div = 0.0_pReal
|
||||||
p_hat_avg = 0.0_pReal
|
p_hat_avg = 0.0_pReal
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
|
|
||||||
p_hat_avg_inf = 0.0_pReal
|
|
||||||
p_hat_avg_two = 0.0_pReal
|
|
||||||
p_real_avg_inf = 0.0_pReal
|
|
||||||
p_real_avg_two = 0.0_pReal
|
|
||||||
err_div_avg_inf = 0.0_pReal
|
|
||||||
err_div_avg_inf2 = 0.0_pReal
|
|
||||||
err_div_avg_two = 0.0_pReal
|
|
||||||
err_div_avg_two2 = 0.0_pReal
|
|
||||||
err_div_max_inf = 0.0_pReal
|
|
||||||
err_div_max_inf2 = 0.0_pReal
|
|
||||||
err_div_max_two = 0.0_pReal
|
|
||||||
err_div_max_two2 = 0.0_pReal
|
|
||||||
err_real_div_avg_inf = 0.0_pReal
|
|
||||||
err_real_div_avg_two = 0.0_pReal
|
|
||||||
err_real_div_max_inf = 0.0_pReal
|
|
||||||
err_real_div_max_two = 0.0_pReal
|
|
||||||
err_real_div_avg_inf2 = 0.0_pReal
|
|
||||||
err_real_div_avg_two2 = 0.0_pReal
|
|
||||||
err_real_div_max_inf2 = 0.0_pReal
|
|
||||||
err_real_div_max_two2 = 0.0_pReal
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
call dfftw_execute_dft_r2c(plan_fft(1),workfft,workfft) ! FFT of pstress
|
call dfftw_execute_dft_r2c(plan_fft(1),workfft,workfft) ! FFT of pstress
|
||||||
do m = 1,3 ! L infinity norm of stress tensor
|
do m = 1,3 ! L infinity norm of stress tensor
|
||||||
p_hat_avg = max(p_hat_avg, sum(abs(workfft(1,1,1,:,m)))) ! ignore imaginary part as it is always zero (Nyquist freq for real only input)
|
p_hat_avg = max(p_hat_avg, sum(abs(workfft(1,1,1,:,m)))) ! ignore imaginary part as it is always zero (Nyquist freq for real only input)
|
||||||
enddo
|
enddo
|
||||||
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
call dfftw_execute_dft(plan_div(1),pstress_field,pstress_field_hat)
|
|
||||||
p_hat_avg_inf = p_hat_avg ! using L inf norm as criterion
|
|
||||||
! L2 matrix norm, NuMI Skript, LNM, TU Muenchen p. 47, again ignore imaginary part
|
|
||||||
call math_spectral1(math_mul33x33(workfft(1,1,1,:,:),math_transpose3x3(workfft(1,1,1,:,:))),ev1,ev2,ev3,evb1,evb2,evb3)
|
|
||||||
rho = max (ev1,ev2,ev3)
|
|
||||||
p_hat_avg_two = sqrt(rho)
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1)/2+1
|
do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1)/2+1
|
||||||
! print*, workfft(2*i-1,j,k,:,:)+workfft(i*2,j,k,:,:)*cmplx(0.0,1.0)-pstress_field_hat(i,j,k,:,:)
|
|
||||||
err_div = max(err_div, maxval(abs(math_mul33x3_complex(workfft(i*2-1,j,k,:,:)+& ! maximum of L infinity norm of div(stress), Suquet 2001
|
err_div = max(err_div, maxval(abs(math_mul33x3_complex(workfft(i*2-1,j,k,:,:)+& ! maximum of L infinity norm of div(stress), Suquet 2001
|
||||||
workfft(i*2, j,k,:,:)*img,xi(:,i,j,k)*minval(geomdimension)))))
|
workfft(i*2, j,k,:,:)*img,xi(:,i,j,k)*minval(geomdimension)))))
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
!if(abs(sqrt(sum(math_mul33x3_complex(workfft(i*2-1,j,k,:,:)+workfft(i*2,j,k,:,:)*img,xi(:,i,j,k)*minval(geomdimension)))**2.0))>err_div_max_two) print*, i,j,k
|
|
||||||
err_div_max_two = max(err_div_max_two,abs(sqrt(sum(math_mul33x3_complex(workfft(i*2-1,j,k,:,:)+& ! maximum of L two norm of div(stress), Suquet 2001
|
|
||||||
workfft(i*2,j,k,:,:)*img,xi(:,i,j,k)*minval(geomdimension)))**2.0)))
|
|
||||||
err_div_avg_inf = err_div_avg_inf + (maxval(abs(math_mul33x3_complex(workfft(i*2-1,j,k,:,:)+& ! sum of squared L infinity norm of div(stress), Suquet 1998
|
|
||||||
workfft(i*2,j,k,:,:)*img,xi(:,i,j,k)*minval(geomdimension)))))**2.0
|
|
||||||
err_div_avg_two = err_div_avg_two + abs(sum((math_mul33x3_complex(workfft(i*2-1,j,k,:,:)+& ! sum of squared L2 norm of div(stress) ((sqrt())**2 missing), Suquet 1998
|
|
||||||
workfft(i*2,j,k,:,:)*img,xi(:,i,j,k)*minval(geomdimension)))**2.0))
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
enddo; enddo; enddo
|
enddo; enddo; enddo
|
||||||
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
do i = 0, resolution(1)/2-2 ! reconstruct data of conjugated complex (symmetric) part in Fourier space
|
|
||||||
m = 1
|
|
||||||
do k = 1, resolution(3)
|
|
||||||
n = 1
|
|
||||||
do j = 1, resolution(2)
|
|
||||||
!print*, xi(:,resolution(1)-i,j,k) + xi(:,i+2,n,m), resolution(1)-i,j,k
|
|
||||||
err_div_avg_inf = err_div_avg_inf + (maxval(abs(math_mul33x3_complex&
|
|
||||||
(workfft(3+2*i,n,m,:,:)+workfft(4+i*2,n,m,:,:)*cmplx(0.0,-1.0),xi(:,resolution(1)-i,j,k)*minval(geomdimension)))))**2.0
|
|
||||||
err_div_avg_two = err_div_avg_two + abs(sum((math_mul33x3_complex(workfft(3+2*i,n,m,:,:)+workfft(4+i*2,n,m,:,:)*cmplx(0.0,-1.0),&
|
|
||||||
xi(:,resolution(1)-i,j,k)*minval(geomdimension)))**2.0))
|
|
||||||
! print*, workfft(3+2*i,n,m,:,:)+workfft(4+i*2,n,m,:,:)*cmplx(0.0,-1.0)-pstress_field_hat(resolution(1)-i,j,k,:,:)
|
|
||||||
|
|
||||||
! workfft(resolution(1)-i,j,k,:,:) = conjg(workfft(2+i,n,m,:,:)) original code for complex array, code above is a little bit confusing because compley data is stored in real array
|
|
||||||
if(n == 1) n = resolution(2) +1
|
|
||||||
n = n-1
|
|
||||||
enddo
|
|
||||||
if(m == 1) m = resolution(3) +1
|
|
||||||
m = m -1
|
|
||||||
enddo; enddo
|
|
||||||
! print*, 'new'
|
|
||||||
do k = 1, resolution(3); do j = 1, resolution(2); do i = 1, resolution(1) !calculating divergence criteria for full field (no complex symmetry)
|
|
||||||
if (abs(sqrt(sum(math_mul33x3_complex(pstress_field_hat(i,j,k,:,:),xi(:,i,j,k)*minval(geomdimension)))**2.0))>err_div_max_two2) print*, i,j,k
|
|
||||||
err_div_max_two2 = max(err_div_max_two2,abs(sqrt(sum(math_mul33x3_complex(pstress_field_hat(i,j,k,:,:),xi(:,i,j,k)*&
|
|
||||||
minval(geomdimension)))**2.0)))
|
|
||||||
err_div_max_inf2 = max(err_div_max_inf2,(maxval(abs(math_mul33x3_complex(pstress_field_hat(i,j,k,:,:),xi(:,i,j,k)*&
|
|
||||||
minval(geomdimension))))))
|
|
||||||
err_div_avg_inf2 = err_div_avg_inf2 + (maxval(abs(math_mul33x3_complex(pstress_field_hat(i,j,k,:,:),&
|
|
||||||
xi(:,i,j,k)*minval(geomdimension)))))**2.0
|
|
||||||
err_div_avg_two2 = err_div_avg_two2 + abs(sum((math_mul33x3_complex(pstress_field_hat(i,j,k,:,:),&
|
|
||||||
xi(:,i,j,k)*minval(geomdimension)))**2.0))
|
|
||||||
enddo; enddo; enddo
|
|
||||||
|
|
||||||
err_div_max_inf = err_div ! using L inf norm as criterion, others will be just printed on screen
|
|
||||||
err_div_max_inf = err_div_max_inf/p_hat_avg_inf
|
|
||||||
err_div_max_inf2 = err_div_max_inf2/p_hat_avg_inf
|
|
||||||
err_div_max_two = err_div_max_two/p_hat_avg_two
|
|
||||||
err_div_max_two2 = err_div_max_two2/p_hat_avg_two
|
|
||||||
err_div_avg_inf = sqrt(err_div_avg_inf*wgt)/p_hat_avg_inf
|
|
||||||
err_div_avg_two = sqrt(err_div_avg_two*wgt)/p_hat_avg_two
|
|
||||||
err_div_avg_inf2 = sqrt(err_div_avg_inf2*wgt)/p_hat_avg_inf
|
|
||||||
err_div_avg_two2 = sqrt(err_div_avg_two2*wgt)/p_hat_avg_two
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
err_div = err_div/p_hat_avg !weigthting of error by average stress (L infinity norm)
|
err_div = err_div/p_hat_avg !weigthting of error by average stress (L infinity norm)
|
||||||
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
|
||||||
divergence_hat_full=0.0
|
|
||||||
!divergence in real space
|
|
||||||
do k = 1, resolution(3) ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around)
|
|
||||||
do j = 1, resolution(2)
|
|
||||||
do i = 1, resolution(1)/2+1
|
|
||||||
divergence_hat(i,j,k,1) = (workfft(i*2-1,j,k,1,1)+ workfft(i*2,j,k,1,1)*img)*xi(1,i,j,k)*img*pi*2.0&
|
|
||||||
+ (workfft(i*2-1,j,k,2,1)+ workfft(i*2,j,k,2,1)*img)*xi(2,i,j,k)*img*pi*2.0&
|
|
||||||
+ (workfft(i*2-1,j,k,3,1)+ workfft(i*2,j,k,3,1)*img)*xi(3,i,j,k)*img*pi*2.0
|
|
||||||
divergence_hat(i,j,k,2) = (workfft(i*2-1,j,k,1,2)+ workfft(i*2,j,k,1,2)*img)*xi(1,i,j,k)*img*pi*2.0&
|
|
||||||
+ (workfft(i*2-1,j,k,2,2)+ workfft(i*2,j,k,2,2)*img)*xi(2,i,j,k)*img*pi*2.0&
|
|
||||||
+ (workfft(i*2-1,j,k,3,2)+ workfft(i*2,j,k,3,2)*img)*xi(3,i,j,k)*img*pi*2.0
|
|
||||||
divergence_hat(i,j,k,3) = (workfft(i*2-1,j,k,1,3)+ workfft(i*2,j,k,1,3)*img)*xi(1,i,j,k)*img*pi*2.0&
|
|
||||||
+ (workfft(i*2-1,j,k,2,3)+ workfft(i*2,j,k,2,3)*img)*xi(2,i,j,k)*img*pi*2.0&
|
|
||||||
+ (workfft(i*2-1,j,k,3,3)+ workfft(i*2,j,k,3,3)*img)*xi(3,i,j,k)*img*pi*2.0
|
|
||||||
enddo; enddo; enddo
|
|
||||||
do k = 1, resolution(3) ! calculation of discrete angular frequencies, ordered as in FFTW (wrap around)
|
|
||||||
do j = 1, resolution(2)
|
|
||||||
do i = 1, resolution(1)/2+1
|
|
||||||
divergence_hat_full(i,j,k,1) = pstress_field_hat(i,j,k,1,1)*xi(1,i,j,k)*img*pi*2.0&
|
|
||||||
+ pstress_field_hat(i,j,k,2,1)*xi(2,i,j,k)*img*pi*2.0&
|
|
||||||
+ pstress_field_hat(i,j,k,3,1)*xi(3,i,j,k)*img*pi*2.0
|
|
||||||
divergence_hat_full(i,j,k,2) = pstress_field_hat(i,j,k,1,2)*xi(1,i,j,k)*img*pi*2.0&
|
|
||||||
+ pstress_field_hat(i,j,k,2,2)*xi(2,i,j,k)*img*pi*2.0&
|
|
||||||
+ pstress_field_hat(i,j,k,3,2)*xi(3,i,j,k)*img*pi*2.0
|
|
||||||
divergence_hat_full(i,j,k,3) = pstress_field_hat(i,j,k,1,3)*xi(1,i,j,k)*img*pi*2.0&
|
|
||||||
+ pstress_field_hat(i,j,k,2,3)*xi(2,i,j,k)*img*pi*2.0&
|
|
||||||
+ pstress_field_hat(i,j,k,3,3)*xi(3,i,j,k)*img*pi*2.0
|
|
||||||
enddo; enddo; enddo
|
|
||||||
|
|
||||||
! do i = 0, resolution(1)/2-2 ! reconstruct data of conjugated complex (symmetric) part in Fourier spaced
|
|
||||||
! m = 1
|
|
||||||
! do k = 1, resolution(3)
|
|
||||||
! n = 1
|
|
||||||
! do j = 1, resolution(2)
|
|
||||||
! divergence_hat_full(resolution(1)-i,j,k,1) = pstress_field_hat(resolution(1)-i,j,k,1,1)*xi(1,2+i,n,m)*img*pi*2.0&
|
|
||||||
! + pstress_field_hat(resolution(1)-i,j,k,2,1)*xi(2,2+i,n,m)*img*pi*2.0&
|
|
||||||
! + pstress_field_hat(resolution(1)-i,j,k,3,1)*xi(3,2+i,n,m)*img*pi*2.0
|
|
||||||
! divergence_hat_full(resolution(1)-i,j,k,2) = pstress_field_hat(resolution(1)-i,j,k,1,2)*xi(1,2+i,n,m)*img*pi*2.0&
|
|
||||||
! + pstress_field_hat(resolution(1)-i,j,k,2,2)*xi(2,2+i,n,m)*img*pi*2.0&
|
|
||||||
! + pstress_field_hat(resolution(1)-i,j,k,3,2)*xi(3,2+i,n,m)*img*pi*2.0
|
|
||||||
! divergence_hat_full(resolution(1)-i,j,k,3) = pstress_field_hat(resolution(1)-i,j,k,1,3)*xi(1,2+i,n,m)*img*pi*2.0&
|
|
||||||
! + pstress_field_hat(resolution(1)-i,j,k,2,3)*xi(2,2+i,n,m)*img*pi*2.0&
|
|
||||||
! + pstress_field_hat(resolution(1)-i,j,k,3,3)*xi(3,2+i,n,m)*img*pi*2.0
|
|
||||||
! if(n == 1) n = resolution(2) +1
|
|
||||||
! n = n-1
|
|
||||||
! enddo
|
|
||||||
! if(m == 1) m = resolution(3) +1
|
|
||||||
! m = m -1
|
|
||||||
! enddo; enddo
|
|
||||||
print*, divergence_hat_full
|
|
||||||
|
|
||||||
pause
|
|
||||||
call dfftw_execute_dft_c2r(plan_div(2), divergence_hat, divergence)
|
|
||||||
call dfftw_execute_dft(plan_div(3), divergence_hat_full, divergence_hat_full2)
|
|
||||||
|
|
||||||
divergence = divergence*wgt
|
|
||||||
divergence_hat_full2 = divergence_hat_full2*wgt
|
|
||||||
print*, divergence_hat_full2
|
|
||||||
|
|
||||||
do m = 1,3 ! L infinity norm of stress tensor
|
|
||||||
p_real_avg_inf = max(p_real_avg_inf, sum(abs(pstress_av(:,m))))
|
|
||||||
enddo
|
|
||||||
|
|
||||||
call math_spectral1(math_mul33x33(pstress_av,math_transpose3x3(pstress_av)),ev1,ev2,ev3,evb1,evb2,evb3)
|
|
||||||
rho = max (ev1,ev2,ev3)
|
|
||||||
p_real_avg_two = sqrt(rho)
|
|
||||||
|
|
||||||
do k = 1, resolution(3); do j = 1, resolution(2) ;do i = 1, resolution(1)
|
|
||||||
err_real_div_max_inf = max(err_real_div_max_inf, maxval(divergence(i,j,k,:)))
|
|
||||||
err_real_div_max_inf2 = max(err_real_div_max_inf2, maxval(real(divergence_hat_full2(i,j,k,:))))
|
|
||||||
err_real_div_max_two = max(err_real_div_max_two, sqrt(sum(divergence(i,j,k,:)**2.0)))
|
|
||||||
err_real_div_max_two2 = max(err_real_div_max_two2, sqrt(sum(real(divergence_hat_full2(i,j,k,:))**2.0)))
|
|
||||||
err_real_div_avg_inf = err_real_div_avg_inf + (maxval(divergence(i,j,k,:)))**2.0
|
|
||||||
err_real_div_avg_inf2 = err_real_div_avg_inf2 + (maxval(real(divergence_hat_full2(i,j,k,:))))**2.0
|
|
||||||
err_real_div_avg_two = err_real_div_avg_two + sum(divergence(i,j,k,:)**2.0) ! don't take square root just to square it again
|
|
||||||
err_real_div_avg_two2 = err_real_div_avg_two2 + sum(real(divergence_hat_full2(i,j,k,:))**2.0) ! don't take square root just to square it again
|
|
||||||
enddo; enddo; enddo
|
|
||||||
|
|
||||||
err_real_div_max_inf = err_real_div_max_inf/p_real_avg_inf
|
|
||||||
err_real_div_max_inf2 = err_real_div_max_inf2/p_real_avg_inf
|
|
||||||
err_real_div_max_two = err_real_div_max_two/p_real_avg_two
|
|
||||||
err_real_div_max_two2 = err_real_div_max_two2/p_real_avg_two
|
|
||||||
err_real_div_avg_inf = sqrt(err_real_div_avg_inf*wgt)/p_real_avg_inf
|
|
||||||
err_real_div_avg_inf2 = sqrt(err_real_div_avg_inf2*wgt)/p_real_avg_inf
|
|
||||||
err_real_div_avg_two = sqrt(err_real_div_avg_two*wgt)/p_real_avg_two
|
|
||||||
err_real_div_avg_two2 = sqrt(err_real_div_avg_two2*wgt)/p_real_avg_two
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
|
|
||||||
if(memory_efficient) then ! memory saving version, on-the-fly calculation of gamma_hat
|
if(memory_efficient) then ! memory saving version, on-the-fly calculation of gamma_hat
|
||||||
do k = 1, resolution(3); do j = 1, resolution(2) ;do i = 1, resolution(1)/2+1
|
do k = 1, resolution(3); do j = 1, resolution(2) ;do i = 1, resolution(1)/2+1
|
||||||
if (any(xi(:,i,j,k) /= 0.0_pReal)) then
|
if (any(xi(:,i,j,k) /= 0.0_pReal)) then
|
||||||
|
|
@ -980,34 +733,16 @@ divergence_hat_full=0.0
|
||||||
defgrad = defgrad + workfft(1:resolution(1),:,:,:,:)*wgt
|
defgrad = defgrad + workfft(1:resolution(1),:,:,:,:)*wgt
|
||||||
do m = 1,3; do n = 1,3
|
do m = 1,3; do n = 1,3
|
||||||
defgrad_av(m,n) = sum(defgrad(:,:,:,m,n))*wgt
|
defgrad_av(m,n) = sum(defgrad(:,:,:,m,n))*wgt
|
||||||
defgrad(:,:,:,m,n) = defgrad(:,:,:,m,n) + mask_defgrad(m,n)*(defgradAim(m,n) - defgrad_av(m,n)) ! anticipated target minus current state on components with prescribed deformation
|
defgrad(:,:,:,m,n) = defgrad(:,:,:,m,n) + (defgradAim(m,n) - defgrad_av(m,n)) ! anticipated target minus current state
|
||||||
enddo; enddo
|
enddo; enddo
|
||||||
|
|
||||||
err_stress = maxval(abs(mask_stress * (pstress_av - bc_stress(:,:,loadcase))))
|
err_stress = maxval(abs(mask_stress * (pstress_av - bc_stress(:,:,loadcase))))
|
||||||
err_stress_tol = maxval(abs(pstress_av))*err_stress_tolrel ! accecpt relative error specified
|
err_stress_tol = maxval(abs(pstress_av))*err_stress_tolrel ! accecpt relative error specified
|
||||||
err_defgrad = maxval(abs(mask_defgrad * (defgrad_av - defgradAim)))
|
err_defgrad = maxval(abs(mask_defgrad * (defgrad_av - defgradAim)))
|
||||||
|
|
||||||
print '(2(a,E8.2))', ' error divergence: ',err_div, ' Tol. = ', err_div_tol
|
print '(2(a,E13.8))', ' error divergence: ',err_div, ' Tol. = ', err_div_tol
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! start divergence debugging
|
print '(2(a,E13.8))', ' error stress: ',err_stress, ' Tol. = ', err_stress_tol
|
||||||
print '((a,E16.11))', ' error divergence FT (max,inf): ',err_div_max_inf
|
print '(2(a,E13.8))', ' error deformation gradient: ',err_defgrad,' Tol. = ', err_defgrad_tol
|
||||||
print '((a,E16.11))', ' error divergence FT (max,inf2): ',err_div_max_inf2
|
|
||||||
print '((a,E16.11))', ' error divergence FT (max,two): ',err_div_max_two
|
|
||||||
print '((a,E16.11))', ' error divergence FT (max,two2): ',err_div_max_two2
|
|
||||||
print '((a,E16.11))', ' error divergence FT (avg,inf): ',err_div_avg_inf
|
|
||||||
print '((a,E16.11))', ' error divergence FT (avg,inf2): ',err_div_avg_inf2
|
|
||||||
print '((a,E16.11))', ' error divergence FT (avg,two): ',err_div_avg_two
|
|
||||||
print '((a,E16.11))', ' error divergence FT (avg,two2): ',err_div_avg_two2
|
|
||||||
print '((a,E8.2))', ' error divergence Real (max,inf): ',err_real_div_max_inf
|
|
||||||
print '((a,E8.2))', ' error divergence Real (max,inf2): ',err_real_div_max_inf2
|
|
||||||
print '((a,E8.2))', ' error divergence Real (max,two): ',err_real_div_max_two
|
|
||||||
print '((a,E8.2))', ' error divergence Real (max,two2): ',err_real_div_max_two2
|
|
||||||
print '((a,E8.2))', ' error divergence Real (avg,inf): ',err_real_div_avg_inf
|
|
||||||
print '((a,E8.2))', ' error divergence Real (avg,inf2): ',err_real_div_avg_inf2
|
|
||||||
print '((a,E8.2))', ' error divergence Real (avg,two): ',err_real_div_avg_two
|
|
||||||
print '((a,E8.2))', ' error divergence Real (avg,two2): ',err_real_div_avg_two2
|
|
||||||
!!!!!!!!!!!!!!!!!!!!!!!! end divergence debugging
|
|
||||||
print '(2(a,E8.2))', ' error stress: ',err_stress, ' Tol. = ', err_stress_tol
|
|
||||||
print '(2(a,E8.2))', ' error deformation gradient: ',err_defgrad,' Tol. = ', err_defgrad_tol
|
|
||||||
!ToDo: usefull .and. for err_div?
|
!ToDo: usefull .and. for err_div?
|
||||||
if((err_stress > err_stress_tol .or. err_defgrad > err_defgrad_tol) .and. err_div < err_div_tol) then ! change to calculation of BCs, reset damper etc.
|
if((err_stress > err_stress_tol .or. err_defgrad > err_defgrad_tol) .and. err_div < err_div_tol) then ! change to calculation of BCs, reset damper etc.
|
||||||
calcmode = 0_pInt
|
calcmode = 0_pInt
|
||||||
|
|
|
||||||
|
|
@ -1165,25 +1165,6 @@ pure function math_transpose3x3(A)
|
||||||
forall (i=1:9) math_Plain33to9(i) = m33(mapPlain(1,i),mapPlain(2,i))
|
forall (i=1:9) math_Plain33to9(i) = m33(mapPlain(1,i),mapPlain(2,i))
|
||||||
|
|
||||||
endfunction math_Plain33to9
|
endfunction math_Plain33to9
|
||||||
|
|
||||||
|
|
||||||
!********************************************************************
|
|
||||||
! convert symmetric 3x3 matrix into plain vector 6x1
|
|
||||||
!********************************************************************
|
|
||||||
pure function math_Plain33to6(m33)
|
|
||||||
|
|
||||||
use prec, only: pReal,pInt
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
real(pReal), dimension(3,3), intent(in) :: m33
|
|
||||||
real(pReal), dimension(6) :: math_Plain33to6
|
|
||||||
integer(pInt) i
|
|
||||||
|
|
||||||
forall (i=1:6) math_Plain33to6(i) = m33(mapMandel(1,i),mapMandel(2,i))
|
|
||||||
|
|
||||||
endfunction math_Plain33to6
|
|
||||||
|
|
||||||
|
|
||||||
!********************************************************************
|
!********************************************************************
|
||||||
! convert Plain 9x1 back to 3x3 matrix
|
! convert Plain 9x1 back to 3x3 matrix
|
||||||
!********************************************************************
|
!********************************************************************
|
||||||
|
|
@ -1330,45 +1311,6 @@ pure function math_transpose3x3(A)
|
||||||
|
|
||||||
endfunction math_Mandel3333to66
|
endfunction math_Mandel3333to66
|
||||||
|
|
||||||
!********************************************************************
|
|
||||||
! convert symmetric 3x3x3x3 tensor into Plain matrix 6x6
|
|
||||||
!********************************************************************
|
|
||||||
pure function math_Plain3333to66(m3333)
|
|
||||||
|
|
||||||
use prec, only: pReal,pInt
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
real(pReal), dimension(3,3,3,3), intent(in) :: m3333
|
|
||||||
real(pReal), dimension(6,6) :: math_Plain3333to66
|
|
||||||
integer(pInt) i,j
|
|
||||||
|
|
||||||
forall (i=1:6,j=1:6) math_Plain3333to66(i,j) = &
|
|
||||||
m3333(mapMandel(1,i),mapMandel(2,i),mapMandel(1,j),mapMandel(2,j))
|
|
||||||
|
|
||||||
endfunction math_Plain3333to66
|
|
||||||
|
|
||||||
!********************************************************************
|
|
||||||
! convert Plain matrix 6x6 back to symmetric 3x3x3x3 tensor
|
|
||||||
!********************************************************************
|
|
||||||
pure function math_Plain66to3333(m66)
|
|
||||||
|
|
||||||
use prec, only: pReal,pInt
|
|
||||||
implicit none
|
|
||||||
|
|
||||||
real(pReal), dimension(6,6), intent(in) :: m66
|
|
||||||
real(pReal), dimension(3,3,3,3) :: math_Plain66to3333
|
|
||||||
integer(pInt) i,j
|
|
||||||
|
|
||||||
forall (i=1:6,j=1:6)
|
|
||||||
math_Plain66to3333(mapMandel(1,i),mapMandel(2,i),mapMandel(1,j),mapMandel(2,j)) = m66(i,j)
|
|
||||||
math_Plain66to3333(mapMandel(2,i),mapMandel(1,i),mapMandel(1,j),mapMandel(2,j)) = m66(i,j)
|
|
||||||
math_Plain66to3333(mapMandel(1,i),mapMandel(2,i),mapMandel(2,j),mapMandel(1,j)) = m66(i,j)
|
|
||||||
math_Plain66to3333(mapMandel(2,i),mapMandel(1,i),mapMandel(2,j),mapMandel(1,j)) = m66(i,j)
|
|
||||||
end forall
|
|
||||||
|
|
||||||
endfunction math_Plain66to3333
|
|
||||||
|
|
||||||
|
|
||||||
!********************************************************************
|
!********************************************************************
|
||||||
! convert Mandel matrix 6x6 back to symmetric 3x3x3x3 tensor
|
! convert Mandel matrix 6x6 back to symmetric 3x3x3x3 tensor
|
||||||
!********************************************************************
|
!********************************************************************
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue