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

adapted flux routine to current state of source_thermal_dissipation.f90

This commit is contained in:
Franz Roters 2016-07-20 08:44:12 +02:00
parent 1753d35e87
commit 2d26cfe7b8
1 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
code/DAMASK_marc.f90
View File

@ -1,5 +1,5 @@
#define QUOTE(x) #x #define QUOTE(x) #x
#define PASTE(x,y) x ## y #define PASTE(x,y) x ## y
#ifndef INT #ifndef INT
#define INT 4 #define INT 4
@ -35,7 +35,7 @@
!> @details - creeps: timinc !> @details - creeps: timinc
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
module DAMASK_interface module DAMASK_interface
implicit none implicit none
character(len=4), parameter :: InputFileExtension = '.dat' character(len=4), parameter :: InputFileExtension = '.dat'
character(len=4), parameter :: LogFileExtension = '.log' character(len=4), parameter :: LogFileExtension = '.log'
@ -57,18 +57,18 @@ subroutine DAMASK_interface_init
write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(/,a)') ' Version: '//DAMASKVERSION
write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',&
dateAndTime(2),'/',& dateAndTime(2),'/',&
dateAndTime(1) dateAndTime(1)
write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',&
dateAndTime(6),':',& dateAndTime(6),':',&
dateAndTime(7) dateAndTime(7)
write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>'
#include "compilation_info.f90" #include "compilation_info.f90"
end subroutine DAMASK_interface_init end subroutine DAMASK_interface_init
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
!> @brief returns the current workingDir !> @brief returns the current workingDir
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
function getSolverWorkingDirectoryName() function getSolverWorkingDirectoryName()
@ -185,7 +185,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
!$ include "omp_lib.h" ! the openMP function library !$ include "omp_lib.h" ! the openMP function library
integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D
ngens, & !< size of stress-strain law ngens, & !< size of stress-strain law
nn, & !< integration point number nn, & !< integration point number
ndi, & !< number of direct components ndi, & !< number of direct components
nshear, & !< number of shear components nshear, & !< number of shear components
ncrd, & !< number of coordinates ncrd, & !< number of coordinates
@ -199,7 +199,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
integer(pInt), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D integer(pInt), dimension(2), intent(in) :: & ! according to MSC.Marc 2012 Manual D
m, & !< (1) user element number, (2) internal element number m, & !< (1) user element number, (2) internal element number
matus, & !< (1) user material identification number, (2) internal material identification number matus, & !< (1) user material identification number, (2) internal material identification number
kcus, & !< (1) layer number, (2) internal layer number kcus, & !< (1) layer number, (2) internal layer number
lclass !< (1) element class, (2) 0: displacement, 1: low order Herrmann, 2: high order Herrmann lclass !< (1) element class, (2) 0: displacement, 1: low order Herrmann, 2: high order Herrmann
real(pReal), dimension(*), intent(in) :: & ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*) real(pReal), dimension(*), intent(in) :: & ! has dimension(1) according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(*)
e, & !< total elastic strain e, & !< total elastic strain
@ -244,13 +244,13 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then if (iand(debug_level(debug_MARC),debug_LEVELBASIC) /= 0_pInt) then
write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn write(6,'(a,/,i8,i8,i2)') ' MSC.MARC information on shape of element(2), IP:', m, nn
write(6,'(a,2(1i))'), ' Jacobian: ', ngens,ngens write(6,'(a,2(1i))'), ' Jacobian: ', ngens,ngens
write(6,'(a,1i)'), ' Direct stress: ', ndi write(6,'(a,1i)'), ' Direct stress: ', ndi
write(6,'(a,1i)'), ' Shear stress: ', nshear write(6,'(a,1i)'), ' Shear stress: ', nshear
write(6,'(a,1i)'), ' DoF: ', ndeg write(6,'(a,1i)'), ' DoF: ', ndeg
write(6,'(a,1i)'), ' Coordinates: ', ncrd write(6,'(a,1i)'), ' Coordinates: ', ncrd
write(6,'(a,1i)'), ' Nodes: ', nnode write(6,'(a,1i)'), ' Nodes: ', nnode
write(6,'(a,1i)'), ' Deformation gradient: ', itel write(6,'(a,1i)'), ' Deformation gradient: ', itel
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n:', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n:', &
math_transpose33(ffn) math_transpose33(ffn)
write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n+1:', & write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n+1:', &
@ -310,7 +310,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
!$OMP END CRITICAL (write2out) !$OMP END CRITICAL (write2out)
endif ! convergence treatment end endif ! convergence treatment end
if (usePingPong) then if (usePingPong) then
calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect) calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect)
if (calcMode(nn,cp_en)) then ! now --- CALC --- if (calcMode(nn,cp_en)) then ! now --- CALC ---
@ -339,7 +339,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node) mesh_node(1:ndeg,CPnodeID) = mesh_node0(1:ndeg,CPnodeID) + numerics_unitlength * dispt(1:ndeg,node)
enddo enddo
endif endif
else ! --- PLAIN MODE --- else ! --- PLAIN MODE ---
computationMode = CPFEM_CALCRESULTS ! always calc computationMode = CPFEM_CALCRESULTS ! always calc
if (lastLovl /= lovl) then if (lastLovl /= lovl) then
@ -378,7 +378,7 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
s(1:ndi+nshear) = stress(1:ndi+nshear)*invnrmMandel(1:ndi+nshear) s(1:ndi+nshear) = stress(1:ndi+nshear)*invnrmMandel(1:ndi+nshear)
g = 0.0_pReal g = 0.0_pReal
if(symmetricSolver) d = 0.5_pReal*(d+transpose(d)) if(symmetricSolver) d = 0.5_pReal*(d+transpose(d))
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value !$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
end subroutine hypela2 end subroutine hypela2
@ -391,11 +391,11 @@ subroutine flux(f,ts,n,time)
use prec, only: & use prec, only: &
pReal, & pReal, &
pInt pInt
use homogenization, only: & use thermal_conduction, only: &
materialpoint_heat thermal_conduction_getSourceAndItsTangent
use mesh, only: & use mesh, only: &
mesh_FEasCP mesh_FEasCP
implicit none implicit none
real(pReal), dimension(6), intent(in) :: & real(pReal), dimension(6), intent(in) :: &
ts ts
@ -405,9 +405,9 @@ subroutine flux(f,ts,n,time)
time time
real(pReal), dimension(2), intent(out) :: & real(pReal), dimension(2), intent(out) :: &
f f
f(1) = materialpoint_heat(n(3),mesh_FEasCP('elem',n(1))) ! f(1) = materialpoint_heat(n(3),mesh_FEasCP('elem',n(1)))
call thermal_conduction_getSourceAndItsTangent(f(1), f(2), ts(3), n(3),mesh_FEasCP('elem',n(1)))
end subroutine flux end subroutine flux
@ -426,7 +426,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
use homogenization, only: & use homogenization, only: &
materialpoint_results,& materialpoint_results,&
materialpoint_sizeResults materialpoint_sizeResults
implicit none implicit none
integer(pInt), intent(in) :: & integer(pInt), intent(in) :: &
m, & !< element number m, & !< element number
@ -438,7 +438,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
real(pReal), dimension(*), intent(in) :: & real(pReal), dimension(*), intent(in) :: &
s, & !< stress array s, & !< stress array
sp, & !< stresses in preferred direction sp, & !< stresses in preferred direction
etot, & !< total strain (generalized) etot, & !< total strain (generalized)
eplas, & !< total plastic strain eplas, & !< total plastic strain
ecreep, & !< total creep strain ecreep, & !< total creep strain
t !< current temperature t !< current temperature
@ -448,4 +448,4 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error
v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m)) v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m))
end subroutine plotv end subroutine plotv