223031012
/
DAMASK_EICMD
mirror of https://github.com/achalhp/DAMASK_EICMD.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

changed declaration of two variables from real to int, spectral method is now working. 

started to commend Ricardos code, layoutet loops and removed some redundant variables.
until now, no error calculation is done. at the moment calculations are in an infinite loop
This commit is contained in:
Martin Diehl 2010-07-02 14:10:36 +00:00
parent 661bb97800
commit d6ba9d54b6
1 changed files with 395 additions and 489 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

270
code/mpie_spectral.f90
View File

@ -269,18 +269,11 @@ program mpie_spectral
integer(pInt) unit, N_l, N_s, N_t, N_n, N, i, j, k, l ! numbers of identifiers, loop variables integer(pInt) unit, N_l, N_s, N_t, N_n, N, i, j, k, l ! numbers of identifiers, loop variables
integer(pInt) a, b, c, e, homog integer(pInt) a, b, c, e, homog
real(pReal) x, y, z real(pReal) x, y, z
!------------------------- !-------------------------
!begin RL !begin RL
!------------------------- !-------------------------
! begin change by m.diehl
!integer(pInt), parameter :: npts1 = 32
!integer(pInt), parameter :: npts2 = 32
!integer(pInt), parameter :: npts3 = 32
integer(pInt) npts1, npts2, npts3 ! will be allocated later
! end change by m.diehl
real(pReal), dimension(:), allocatable :: datafft real(pReal), dimension(:), allocatable :: datafft
real(pReal), dimension(:,:,:,:,:), allocatable :: workfft,workfftim,sg,disgrad,defgradold real(pReal), dimension(:,:,:,:,:), allocatable :: workfft,workfftim,sg,disgrad,defgradold
@ -291,13 +284,15 @@ program mpie_spectral
real(pReal), dimension(3,3) :: defgrad0,defgrad real(pReal), dimension(3,3) :: defgrad0,defgrad
real(pReal), dimension(3,3) :: udot,scauchy,scauav,aux33 real(pReal), dimension(3,3) :: udot,scauchy,scauav,aux33
real(pReal), dimension(3) :: delt,nn,xk,xk2 integer(pInt), dimension(3) :: nn
real(pReal), dimension(2) :: nn2 integer(pInt), dimension(2) :: nn2
real(pReal), dimension(3) :: delt,xk,xk2
real(pReal), dimension(6) :: aux6 real(pReal), dimension(6) :: aux6
real(pReal), dimension(3,3,3,3) :: c0,s0,g1 real(pReal), dimension(3,3,3,3) :: c0,s0,g1
real(pReal), dimension(6,6) :: c066,s066 real(pReal), dimension(6,6) :: c066,s066
integer(pInt) itmax,nsteps,jload,ielem,ii,jj,k1,kxx,kyy,kzz,kx,ky,kz,idum,iter,imicro,m1,n1,p,q integer(pInt) itmax, jload, ielem, ii, jj, k1, kxx, kyy, kzz, kx, ky, kz, idum, iter, imicro, m1, n1, p, q
real(pReal) prodnn,wgt,error,tdot,erre,errs,evm,svm,det,xknorm real(pReal) prodnn,wgt,error,tdot,erre,errs,evm,svm,det,xknorm
@ -461,21 +456,16 @@ program mpie_spectral
print *, '' print *, ''
temperature = 300.0_pReal temperature = 300.0_pReal
!-------------------------
!RL
!-------------------------
!begin change m.diehl
npts1=a
npts2=b
npts3=c
!end change m.diehl
allocate (datafft(2*npts1*npts2*npts3)) !-------------------------
allocate (workfft(3,3,npts1,npts2,npts3)) !begin RL
allocate (workfftim(3,3,npts1,npts2,npts3)) !-------------------------
allocate (sg(3,3,npts1,npts2,npts3)) allocate (datafft(2*a*b*c))
allocate (disgrad(3,3,npts1,npts2,npts3)) allocate (workfft(3,3,a,b,c))
allocate (defgradold(3,3,npts1,npts2,npts3)) allocate (workfftim(3,3,a,b,c))
allocate (sg(3,3,a,b,c))
allocate (disgrad(3,3,a,b,c))
allocate (defgradold(3,3,a,b,c))
error = 0.00001 error = 0.00001
itmax = 100 itmax = 100
@ -484,46 +474,36 @@ program mpie_spectral
delt(2) = 1. delt(2) = 1.
delt(3) = 1. delt(3) = 1.
nn(1)=npts1 nn(1) = a
nn(2)=npts2 nn(2) = b
nn(3)=npts3 nn(3) = c
nn2(1)=npts1 nn2(1) = a
nn2(2)=npts2 nn2(2) = b
prodnn = nn(1)*nn(2)*nn(3) prodnn = nn(1)*nn(2)*nn(3)
wgt = 1./prodnn wgt = 1./prodnn
! C_0 and S_0 CALCULATION ! C_0 and S_0 CALCULATION
!! !!
!! PHILIP: FE_exec_elem? !! PHILIP: FE_exec_elem?
!! !!
stress = 0. !should be initialized somewhere
dsde = 0. !should be initialized somewhere
c0 = 0. !stiffness of reference material
c066 = 0. ! other way of notating c0
ielem=0 do ielem = 1, prodnn !call each element with identity (math_i3) to initialize with high stress
c0=0.
c066=0.
do k=1,npts3
do j=1,npts2
do i=1,npts1
ielem=ielem+1
call CPFEM_general(3,math_i3,math_i3,temperature,0.0_pReal,ielem,1_pInt,stress,dsde) call CPFEM_general(3,math_i3,math_i3,temperature,0.0_pReal,ielem,1_pInt,stress,dsde)
c066 = c066+dsde c066 = c066+dsde
c0 = c0+math_Mandel66to3333(dsde) c0 = c0+math_Mandel66to3333(dsde)
enddo
enddo
enddo enddo
c066 = c066*wgt c066 = c066*wgt
c0 = c0*wgt c0 = c0*wgt
call math_invert(6,c066,s066,idum,errmatinv)
call math_invert(6,c066,s066,idum,errmatinv)
if(errmatinv) then if(errmatinv) then
write(*,*) 'ERROR IN C0 INVERSION' write(*,*) 'ERROR IN C0 INVERSION'
stop stop
@ -535,84 +515,64 @@ program mpie_spectral
disgradmacro = 0. disgradmacro = 0.
do k=1,npts3 do k = 1, c
do j=1,npts2 do j = 1, b
do i=1,npts1 do i = 1, a
defgradold(:,:,i,j,k) = math_i3(:,:) defgradold(:,:,i,j,k) = math_i3(:,:)
enddo enddo
enddo enddo
enddo enddo
do jload = 1,N do jload = 1,N !Loop over loadcases defined in the loadcase file
udot(:,:) = bc_velocityGrad(:,:,jload) udot(:,:) = bc_velocityGrad(:,:,jload)
scauchy(:,:) = bc_stress(:,:,jload) scauchy(:,:) = bc_stress(:,:,jload)
iudot = 0 iudot = 0
iscau = 0 iscau = 0
do i=1,3
do i = 1, 3 !convert information about rb's from bc_mask in corresponding arrays
do j = 1, 3 do j = 1, 3
if(bc_mask(i,j,1,jload)) iudot(i,j) = 1 if(bc_mask(i,j,1,jload)) iudot(i,j) = 1
if(bc_mask(i,j,2,jload)) iscau(i,j) = 1 if(bc_mask(i,j,2,jload)) iscau(i,j) = 1
enddo enddo
enddo enddo
nsteps=bc_steps(jload)
tdot = bc_timeIncrement(jload)/bc_steps(jload) tdot = bc_timeIncrement(jload)/bc_steps(jload)
! evm = dvm*tdot ? ! evm = dvm*tdot ?
do imicro = 1, bc_steps(jload) ! loop oper steps defined in input file for current loadcase
do imicro=1,nsteps
write(*,*) '***************************************************' write(*,*) '***************************************************'
write(*,*) 'STEP = ',imicro write(*,*) 'STEP = ',imicro
! write(21,*) 'STEP = ',imicro
! INITIALIZATION BEFORE NEW TIME STEP ! INITIALIZATION BEFORE NEW TIME STEP
disgradmacro = disgradmacro+udot*tdot !update macroscopic displacementgradient
disgradmacro=disgradmacro+udot*tdot
ddisgradmacro = 0. ddisgradmacro = 0.
ielem=0 ielem=0
do k=1,npts3 do k = 1, c !loop over FPs
do j=1,npts2 do j = 1, b
do i=1,npts1 do i = 1, a
ielem = ielem+1 ielem = ielem+1
disgrad(:,:,i,j,k)=disgradmacro(:,:) disgrad(:,:,i,j,k)=disgradmacro(:,:)
defgrad0(:,:)=defgradold(:,:,i,j,k) defgrad0(:,:)=defgradold(:,:,i,j,k)
defgrad(:,:)=math_i3(:,:)+disgrad(:,:,i,j,k) defgrad(:,:)=math_i3(:,:)+disgrad(:,:,i,j,k) ! calculate new defgrad
call CPFEM_general(3,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde) call CPFEM_general(3,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde)
! sg(:,:,i,j,k)=math_Mandel6to33(stress) ? ! sg(:,:,i,j,k)=math_Mandel6to33(stress) ?
enddo enddo
enddo enddo
enddo enddo
ielem = 0 ielem = 0
do k=1,npts3 do k = 1, c !loop over FPs
do j=1,npts2 do j = 1, b
do i=1,npts1 do i = 1, a
ielem = ielem+1 ielem = ielem+1
disgrad(:,:,i,j,k) = disgradmacro(:,:) disgrad(:,:,i,j,k) = disgradmacro(:,:)
defgrad0(:,:) = defgradold(:,:,i,j,k) defgrad0(:,:) = defgradold(:,:,i,j,k)
defgrad(:,:) = math_i3(:,:)+disgrad(:,:,i,j,k) defgrad(:,:) = math_i3(:,:)+disgrad(:,:,i,j,k)
call CPFEM_general(1,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde) call CPFEM_general(1,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde)
sg(:,:,i,j,k) = math_Mandel6to33(stress) sg(:,:,i,j,k) = math_Mandel6to33(stress)
enddo enddo
enddo enddo
enddo enddo
@ -623,79 +583,60 @@ program mpie_spectral
erre = 2.*error erre = 2.*error
errs = 2.*error errs = 2.*error
do while(iter.lt.itmax.and.(errs.gt.error.or.erre.gt.error)) do while(iter <= itmax.and.(errs.gt.error.or.erre.gt.error))
iter = iter+1 iter = iter+1
write(*,*)'ITER = ',iter write(*,*)'ITER = ',iter
write(*,*) 'DIRECT FFT OF STRESS FIELD' write(*,*) 'DIRECT FFT OF STRESS FIELD'
do ii = 1,3 do ii = 1,3
do jj = 1,3 do jj = 1,3
k1 = 0 k1 = 0
do k = 1,c
do k=1,npts3
! write(*,'(1H+,a,i2,2(a,i4))') ! write(*,'(1H+,a,i2,2(a,i4))')
! # 'STRESS - COMPONENT',ii,jj,' - Z = ',k,' OUT OF ',npts ! # 'STRESS - COMPONENT',ii,jj,' - Z = ',k,' OUT OF ',npts
do j = 1,b
do j=1,npts2 do i = 1,a
do i=1,npts1
k1 = k1+1 k1 = k1+1
datafft(k1) = sg(ii,jj,i,j,k) datafft(k1) = sg(ii,jj,i,j,k)
k1 = k1+1 k1 = k1+1
datafft(k1) = 0. datafft(k1) = 0.
enddo enddo
enddo enddo
enddo enddo
if(c.gt.1) then
if(npts3.gt.1) then
call fourn(datafft,nn,3,1) call fourn(datafft,nn,3,1)
else else
call fourn(datafft,nn2,2,1) call fourn(datafft,nn2,2,1)
endif endif
k1 = 0 k1 = 0
do k = 1, c
do k=1,npts3 do j = 1, b
do j=1,npts2 do i = 1, a
do i=1,npts1
k1 = k1+1 k1 = k1+1
workfft(ii,jj,i,j,k) = datafft(k1) workfft(ii,jj,i,j,k) = datafft(k1)
k1 = k1+1 k1 = k1+1
workfftim(ii,jj,i,j,k) = datafft(k1) workfftim(ii,jj,i,j,k) = datafft(k1)
enddo enddo
enddo enddo
enddo enddo
enddo enddo
enddo enddo
write(*,*) 'CALCULATING G^pq,ij : SG^ij ...' write(*,*) 'CALCULATING G^pq,ij : SG^ij ...'
do kzz = 1,c
do kyy = 1,b
do kxx = 1,a
if(kxx.le.a/2) kx = kxx-1
if(kxx.gt.a/2) kx = kxx-a-1
do kzz=1,npts3 if(kyy.le.b/2) ky = kyy-1
do kyy=1,npts2 if(kyy.gt.b/2) ky = kyy-b-1
do kxx=1,npts1
if(kxx.le.npts1/2) kx=kxx-1 if(kzz.le.c/2) kz = kzz-1
if(kxx.gt.npts1/2) kx=kxx-npts1-1 if(kzz.gt.c/2) kz = kzz-c-1
if(kyy.le.npts2/2) ky=kyy-1
if(kyy.gt.npts2/2) ky=kyy-npts2-1
if(kzz.le.npts3/2) kz=kzz-1
if(kzz.gt.npts3/2) kz=kzz-npts3-1
xk(1) = kx/(delt(1)*nn(1)) xk(1) = kx/(delt(1)*nn(1))
xk(2) = ky/(delt(2)*nn(2)) xk(2) = ky/(delt(2)*nn(2))
if(npts3.gt.1) then if(c.gt.1) then
xk(3) = kz/(delt(3)*nn(3)) xk(3) = kz/(delt(3)*nn(3))
else else
xk(3) = 0. xk(3) = 0.
@ -720,7 +661,6 @@ program mpie_spectral
enddo enddo
enddo enddo
enddo enddo
aux33 = math_inv3x3(aux33) aux33 = math_inv3x3(aux33)
! call minv(aux33,3,det,minv1,minv2) ! call minv(aux33,3,det,minv1,minv2)
@ -742,24 +682,17 @@ program mpie_spectral
do i = 1,3 do i = 1,3
do j = 1,3 do j = 1,3
ddisgrad(i,j) = 0. ddisgrad(i,j) = 0.
ddisgradim(i,j) = 0. ddisgradim(i,j) = 0.
! if(kx.eq.0.and.ky.eq.0.and.kz.eq.0.) goto 4 ! if(kx.eq.0.and.ky.eq.0.and.kz.eq.0.) goto 4
if(.not.(kx.eq.0.and.ky.eq.0.and.kz.eq.0.)) then if(.not.(kx.eq.0.and.ky.eq.0.and.kz.eq.0.)) then
do k = 1,3 do k = 1,3
do l = 1,3 do l = 1,3
ddisgrad(i,j) = ddisgrad(i,j)+g1(i,j,k,l)*workfft(k,l,kxx,kyy,kzz) ddisgrad(i,j) = ddisgrad(i,j)+g1(i,j,k,l)*workfft(k,l,kxx,kyy,kzz)
ddisgradim(i,j) = ddisgradim(i,j)+g1(i,j,k,l)*workfftim(k,l,kxx,kyy,kzz) ddisgradim(i,j) = ddisgradim(i,j)+g1(i,j,k,l)*workfftim(k,l,kxx,kyy,kzz)
enddo enddo
enddo enddo
endif endif
enddo enddo
enddo enddo
@ -777,37 +710,34 @@ program mpie_spectral
k1 = 0 k1 = 0
do k=1,npts3 do k = 1,c
do j=1,npts2 do j = 1,b
do i=1,npts1 do i = 1,a
k1 = k1+1 k1 = k1+1
datafft(k1) = workfft(m1,n1,i,j,k) datafft(k1) = workfft(m1,n1,i,j,k)
k1 = k1+1 k1 = k1+1
datafft(k1) = workfftim(m1,n1,i,j,k) datafft(k1) = workfftim(m1,n1,i,j,k)
enddo enddo
enddo enddo
enddo enddo
if(npts3.gt.1) then if(c.gt.1) then
call fourn(datafft,nn,3,-1) call fourn(datafft,nn,3,-1)
else else
call fourn(datafft,nn2,2,-1) call fourn(datafft,nn2,2,-1)
endif endif
datafft = datafft*wgt datafft = datafft*wgt
k1 = 0 k1 = 0
do k=1,npts3 do k = 1,c
do j=1,npts2 do j = 1,b
do i=1,npts1 do i = 1,a
k1 = k1+1 k1 = k1+1
disgrad(m1,n1,i,j,k) = disgrad(m1,n1,i,j,k)+ddisgradmacro(m1,n1)+datafft(k1) disgrad(m1,n1,i,j,k) = disgrad(m1,n1,i,j,k)+ddisgradmacro(m1,n1)+datafft(k1)
k1 = k1+1 k1 = k1+1
enddo enddo
enddo enddo
enddo enddo
@ -816,14 +746,11 @@ program mpie_spectral
enddo enddo
write(*,*) 'UPDATE STRESS FIELD' write(*,*) 'UPDATE STRESS FIELD'
!!! call evpal !!! call evpal
ielem = 0 ielem = 0
do k = 1,c
do k=1,npts3 do j = 1,b
do j=1,npts2 do i = 1,a
do i=1,npts1
ielem = ielem+1 ielem = ielem+1
@ -833,16 +760,15 @@ program mpie_spectral
call CPFEM_general(3,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde) call CPFEM_general(3,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde)
sg(:,:,i,j,k) = math_Mandel6to33(stress) sg(:,:,i,j,k) = math_Mandel6to33(stress)
enddo enddo
enddo enddo
enddo enddo
ielem = 0 ielem = 0
do k=1,npts3 do k = 1,c
do j=1,npts2 do j = 1,b
do i=1,npts1 do i = 1,a
ielem = ielem+1 ielem = ielem+1
@ -852,61 +778,43 @@ program mpie_spectral
call CPFEM_general(2,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde) call CPFEM_general(2,defgrad0,defgrad,temperature,0.0_pReal,ielem,1_pInt,stress,dsde)
sg(:,:,i,j,k) = math_Mandel6to33(stress) sg(:,:,i,j,k) = math_Mandel6to33(stress)
enddo enddo
enddo enddo
enddo enddo
!!! call get_smacro !!! call get_smacro
! AVERAGE STRESS ! AVERAGE STRESS
scauav = 0. scauav = 0.
do k=1,npts3 do k = 1,c
do j=1,npts2 do j = 1,b
do i=1,npts1 do i = 1,a
scauav(:,:) = scauav(:,:)+sg(:,:,i,j,k)*wgt scauav(:,:) = scauav(:,:)+sg(:,:,i,j,k)*wgt
enddo enddo
enddo enddo
enddo enddo
! MIXED BC ! MIXED BC
do i = 1,3 do i = 1,3
do j = 1,3 do j = 1,3
ddisgradmacro(i,j) = 0. ddisgradmacro(i,j) = 0.
if(iudot(i,j).eq.0) then if(iudot(i,j).eq.0) then
do k = 1,3 do k = 1,3
do l = 1,3 do l = 1,3
ddisgradmacro(i,j) = ddisgradmacro(i,j)+s0(i,j,k,l)*iscau(k,l)*(scauchy(k,l)-scauav(k,l)) ddisgradmacro(i,j) = ddisgradmacro(i,j)+s0(i,j,k,l)*iscau(k,l)*(scauchy(k,l)-scauav(k,l))
enddo enddo
enddo enddo
endif endif
enddo enddo
enddo enddo
ddisgradmacroacum = ddisgradmacroacum+ddisgradmacro ddisgradmacroacum = ddisgradmacroacum+ddisgradmacro
! write(*,*) 'DDEFGRADMACRO(1,1),(2,2) = ',ddefgradmacro(1,1),ddefgradmacro(2,2) ! write(*,*) 'DDEFGRADMACRO(1,1),(2,2) = ',ddefgradmacro(1,1),ddefgradmacro(2,2)
!! svm = ? !! svm = ?
! erre = erre/evm ! erre = erre/evm
! errs = errs/svm ! errs = errs/svm
write(*,*) 'STRESS FIELD ERROR = ',errs write(*,*) 'STRESS FIELD ERROR = ',errs
write(*,*) 'STRAIN FIELD ERROR = ',erre write(*,*) 'STRAIN FIELD ERROR = ',erre
! write(21,101) iter,erre,errs,svm ! write(21,101) iter,erre,errs,svm
!101 format(i3,4(1x,e10.4),10(1x,F7.4)) !101 format(i3,4(1x,e10.4),10(1x,F7.4))
@ -921,24 +829,19 @@ program mpie_spectral
!! write(*,*) 'scauav(1,1),scauav(2,2),scauav(3,3)' !! write(*,*) 'scauav(1,1),scauav(2,2),scauav(3,3)'
!! write(*,*) scauav(1,1),scauav(2,2),scauav(3,3) !! write(*,*) scauav(1,1),scauav(2,2),scauav(3,3)
do k=1,npts3 do k = 1,c
do j=1,npts2 do j = 1,b
do i=1,npts1 do i = 1,a
defgradold(:,:,i,j,k) = math_i3(:,:)+disgrad(:,:,i,j,k) defgradold(:,:,i,j,k) = math_i3(:,:)+disgrad(:,:,i,j,k)
enddo enddo
enddo enddo
enddo enddo
enddo ! IMICRO ENDDO enddo ! IMICRO ENDDO
enddo ! JLOAD ENDDO Ende looping over loadcases
enddo ! JLOAD ENDDO
!------------------------- !-------------------------
!RL !end RL
!------------------------- !-------------------------
end program mpie_spectral end program mpie_spectral
@ -955,11 +858,15 @@ subroutine quit(id)
stop stop
end subroutine end subroutine
SUBROUTINE fourn(data,nn,ndim,isign)
!
!********************************************************************
! fourn subroutine (fourier transform)
! FROM NUMERICAL RECIPES IN F77 (FIXED FORMAT), ! FROM NUMERICAL RECIPES IN F77 (FIXED FORMAT),
! CONVERTED INTO FREE FORMAT (RL @ MPIE, JUNE 2010) ! CONVERTED INTO FREE FORMAT (RL @ MPIE, JUNE 2010)
! !********************************************************************
subroutine fourn(data,nn,ndim,isign)
INTEGER isign,ndim,nn(ndim) INTEGER isign,ndim,nn(ndim)
REAL data(*) REAL data(*)
! INTEGER i1,i2,i2rev,i3,i3rev,ibit,idim,ifp1,ifp2,ip1,ip2,ip3,k1, ! INTEGER i1,i2,i2rev,i3,i3rev,ibit,idim,ifp1,ifp2,ip1,ip2,ip3,k1,
@ -970,7 +877,6 @@ end subroutine
ntot = 1 ntot = 1
! do 11 idim = 1,ndim ! do 11 idim = 1,ndim
do idim = 1,ndim ! 11 do idim = 1,ndim ! 11
!
ntot = ntot*nn(idim) ntot = ntot*nn(idim)
!11 continue !11 continue
enddo ! 11 enddo ! 11
@ -999,7 +905,7 @@ end subroutine
data(i3+1) = data(i3rev+1) data(i3+1) = data(i3rev+1)
data(i3rev) = tempr data(i3rev) = tempr
data(i3rev+1) = tempi data(i3rev+1) = tempi
!12 continue
!13 continue !13 continue
enddo ! 12 enddo ! 12
enddo ! 13 enddo ! 13