From 3b673d23dc1ecb8a191592bc272b25c0df38ea5d Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 3 May 2016 17:06:55 +0200 Subject: [PATCH 1/5] added code for solving heat equation --- code/DAMASK_marc.f90 | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) diff --git a/code/DAMASK_marc.f90 b/code/DAMASK_marc.f90 index a4542f96a..bef54489e 100644 --- a/code/DAMASK_marc.f90 +++ b/code/DAMASK_marc.f90 @@ -384,6 +384,33 @@ subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, & end subroutine hypela2 +!-------------------------------------------------------------------------------------------------- +!> @brief thermomechanical coupling +!-------------------------------------------------------------------------------------------------- +subroutine flux(f,ts,n,time) + use prec, only: & + pReal, & + pInt + use homogenization, only: & + materialpoint_heat + use mesh, only: & + mesh_FEasCP + + implicit none + real(pReal), dimension(6), intent(in) :: & + ts + integer(pInt), dimension(10), intent(in) :: & + n + real(pReal), intent(in) :: & + time + real(pReal), dimension(2), intent(out) :: & + f + + f(1) = materialpoint_heat(n(3),mesh_FEasCP('elem',n(1))) + +end subroutine flux + + !-------------------------------------------------------------------------------------------------- !> @brief sets user defined output variables for Marc !> @details select a variable contour plotting (user subroutine). From 1753d35e875b8804ce0b83fac3b23efe4cc46bb9 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Tue, 3 May 2016 17:07:51 +0200 Subject: [PATCH 2/5] corrected subroutine description --- code/DAMASK_marc.f90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/code/DAMASK_marc.f90 b/code/DAMASK_marc.f90 index bef54489e..5750b8850 100644 --- a/code/DAMASK_marc.f90 +++ b/code/DAMASK_marc.f90 @@ -385,7 +385,7 @@ end subroutine hypela2 !-------------------------------------------------------------------------------------------------- -!> @brief thermomechanical coupling +!> @brief solve the heat equation !-------------------------------------------------------------------------------------------------- subroutine flux(f,ts,n,time) use prec, only: & @@ -413,7 +413,7 @@ end subroutine flux !-------------------------------------------------------------------------------------------------- !> @brief sets user defined output variables for Marc -!> @details select a variable contour plotting (user subroutine). +!> @details select a variable contour plotting (user subgiroutine). !-------------------------------------------------------------------------------------------------- subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) use prec, only: & From 2d26cfe7b87fe7956a423d8a2699865fac03eb1e Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Wed, 20 Jul 2016 08:44:12 +0200 Subject: [PATCH 3/5] adapted flux routine to current state of source_thermal_dissipation.f90 --- code/DAMASK_marc.f90 | 52 ++++++++++++++++++++++---------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/code/DAMASK_marc.f90 b/code/DAMASK_marc.f90 index 5750b8850..6c4294163 100644 --- a/code/DAMASK_marc.f90 +++ b/code/DAMASK_marc.f90 @@ -1,5 +1,5 @@ -#define QUOTE(x) #x -#define PASTE(x,y) x ## y +#define QUOTE(x) #x +#define PASTE(x,y) x ## y #ifndef INT #define INT 4 @@ -35,7 +35,7 @@ !> @details - creeps: timinc !-------------------------------------------------------------------------------------------------- module DAMASK_interface - + implicit none character(len=4), parameter :: InputFileExtension = '.dat' character(len=4), parameter :: LogFileExtension = '.log' @@ -57,18 +57,18 @@ subroutine DAMASK_interface_init write(6,'(/,a)') ' Version: '//DAMASKVERSION write(6,'(a,2(i2.2,a),i4.4)') ' Date: ',dateAndTime(3),'/',& dateAndTime(2),'/',& - dateAndTime(1) + dateAndTime(1) write(6,'(a,2(i2.2,a),i2.2)') ' Time: ',dateAndTime(5),':',& dateAndTime(6),':',& - dateAndTime(7) + dateAndTime(7) write(6,'(/,a)') ' <<<+- DAMASK_interface init -+>>>' -#include "compilation_info.f90" +#include "compilation_info.f90" end subroutine DAMASK_interface_init !-------------------------------------------------------------------------------------------------- -!> @brief returns the current workingDir +!> @brief returns the current workingDir !-------------------------------------------------------------------------------------------------- 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 integer(pInt), intent(in) :: & ! according to MSC.Marc 2012 Manual D ngens, & !< size of stress-strain law - nn, & !< integration point number + nn, & !< integration point number ndi, & !< number of direct components nshear, & !< number of shear components 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 m, & !< (1) user element number, (2) internal element 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 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 @@ -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 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,1i)'), ' Direct stress: ', ndi - write(6,'(a,1i)'), ' Shear stress: ', nshear + write(6,'(a,2(1i))'), ' Jacobian: ', ngens,ngens + write(6,'(a,1i)'), ' Direct stress: ', ndi + write(6,'(a,1i)'), ' Shear stress: ', nshear write(6,'(a,1i)'), ' DoF: ', ndeg write(6,'(a,1i)'), ' Coordinates: ', ncrd - write(6,'(a,1i)'), ' Nodes: ', nnode - write(6,'(a,1i)'), ' Deformation gradient: ', itel + write(6,'(a,1i)'), ' Nodes: ', nnode + write(6,'(a,1i)'), ' Deformation gradient: ', itel write(6,'(/,a,/,3(3(f12.7,1x)/))',advance='no') ' Deformation gradient at t=n:', & math_transpose33(ffn) 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) endif ! convergence treatment end - + if (usePingPong) then calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect) 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) enddo endif - + else ! --- PLAIN MODE --- computationMode = CPFEM_CALCRESULTS ! always calc 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) g = 0.0_pReal if(symmetricSolver) d = 0.5_pReal*(d+transpose(d)) - + !$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value end subroutine hypela2 @@ -391,11 +391,11 @@ subroutine flux(f,ts,n,time) use prec, only: & pReal, & pInt - use homogenization, only: & - materialpoint_heat + use thermal_conduction, only: & + thermal_conduction_getSourceAndItsTangent use mesh, only: & mesh_FEasCP - + implicit none real(pReal), dimension(6), intent(in) :: & ts @@ -405,9 +405,9 @@ subroutine flux(f,ts,n,time) time real(pReal), dimension(2), intent(out) :: & 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 @@ -426,7 +426,7 @@ subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd) use homogenization, only: & materialpoint_results,& materialpoint_sizeResults - + implicit none integer(pInt), intent(in) :: & 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) :: & s, & !< stress array sp, & !< stresses in preferred direction - etot, & !< total strain (generalized) + etot, & !< total strain (generalized) eplas, & !< total plastic strain ecreep, & !< total creep strain 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 v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m)) -end subroutine plotv \ No newline at end of file +end subroutine plotv From 7081931c02623369bac1123bfa99edd94dbfba97 Mon Sep 17 00:00:00 2001 From: Franz Roters Date: Wed, 8 Feb 2017 10:02:56 +0100 Subject: [PATCH 4/5] cleaning up Marc subroutine flux can be used for specifying volume flux boundary condition (dissipated plastic work) in thermomechanically coupled simulations --- code/DAMASK_marc.f90 | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/code/DAMASK_marc.f90 b/code/DAMASK_marc.f90 index 6c4294163..105db0543 100644 --- a/code/DAMASK_marc.f90 +++ b/code/DAMASK_marc.f90 @@ -385,7 +385,7 @@ end subroutine hypela2 !-------------------------------------------------------------------------------------------------- -!> @brief solve the heat equation +!> @brief calculate internal heat generated due to inelastic energy dissipation !-------------------------------------------------------------------------------------------------- subroutine flux(f,ts,n,time) use prec, only: & @@ -406,9 +406,9 @@ subroutine flux(f,ts,n,time) real(pReal), dimension(2), intent(out) :: & f -! 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 !-------------------------------------------------------------------------------------------------- From 829c89247f57f29d4d4ff5e1c981136773e0f602 Mon Sep 17 00:00:00 2001 From: Martin Diehl Date: Wed, 8 Feb 2017 20:04:47 +0100 Subject: [PATCH 5/5] not needed (processes >0 write to dev/Null) --- code/lattice.f90 | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/code/lattice.f90 b/code/lattice.f90 index 06f9c84d9..332647d9e 100644 --- a/code/lattice.f90 +++ b/code/lattice.f90 @@ -1283,11 +1283,9 @@ subroutine lattice_init a_fcc, & !< lattice parameter a for fcc austenite a_bcc !< lattice paramater a for bcc martensite - mainProcess: if (worldrank == 0) then - write(6,'(/,a)') ' <<<+- lattice init -+>>>' - write(6,'(a15,a)') ' Current time: ',IO_timeStamp() + write(6,'(/,a)') ' <<<+- lattice init -+>>>' + write(6,'(a15,a)') ' Current time: ',IO_timeStamp() #include "compilation_info.f90" - endif mainProcess !-------------------------------------------------------------------------------------------------- ! consistency checks (required since ifort 15.0 does not support sum/maxval in parameter definition)