2013-03-22 23:05:05 +05:30
|
|
|
! Copyright 2011-13 Max-Planck-Institut für Eisenforschung GmbH
|
2011-04-04 19:39:54 +05:30
|
|
|
!
|
|
|
|
|
! This file is part of DAMASK,
|
2012-08-28 21:38:17 +05:30
|
|
|
! the Düsseldorf Advanced Material Simulation Kit.
|
2011-04-04 19:39:54 +05:30
|
|
|
!
|
|
|
|
|
! DAMASK is free software: you can redistribute it and/or modify
|
|
|
|
|
! it under the terms of the GNU General Public License as published by
|
|
|
|
|
! the Free Software Foundation, either version 3 of the License, or
|
|
|
|
|
! (at your option) any later version.
|
|
|
|
|
!
|
|
|
|
|
! DAMASK is distributed in the hope that it will be useful,
|
|
|
|
|
! but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
|
|
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
|
|
! GNU General Public License for more details.
|
|
|
|
|
!
|
|
|
|
|
! You should have received a copy of the GNU General Public License
|
|
|
|
|
! along with DAMASK. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
|
!
|
2013-03-01 17:18:29 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
! $Id$
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @author Philip Eisenlohr, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
|
!> @author Franz Roters, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
|
!> @author Luc Hantcherli, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
|
!> @author W.A. Counts
|
|
|
|
|
!> @author Denny Tjahjanto, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
|
!> @author Christoph Kords, Max-Planck-Institut für Eisenforschung GmbH
|
|
|
|
|
!> @brief Material subroutine for MSC.Marc
|
2013-04-09 15:38:00 +05:30
|
|
|
!> @details Usage:
|
|
|
|
|
!> @details - choose material as hypela2
|
|
|
|
|
!> @details - set statevariable 2 to index of homogenization
|
|
|
|
|
!> @details - set statevariable 3 to index of microstructure
|
|
|
|
|
!> @details - make sure the file "material.config" exists in the working directory
|
|
|
|
|
!> @details - make sure the file "numerics.config" exists in the working directory
|
|
|
|
|
!> @details - use nonsymmetric option for solver (e.g. direct profile or multifrontal sparse,
|
|
|
|
|
!> @details the latter seems to be faster!)
|
|
|
|
|
!> @details - in case of ddm (domain decomposition) a SYMMETRIC solver has to be used,
|
|
|
|
|
!> @details i.e uncheck "non-symmetric"
|
|
|
|
|
!> @details Marc subroutines used:
|
|
|
|
|
!> @details - hypela2
|
|
|
|
|
!> @details - plotv
|
|
|
|
|
!> @details - quit
|
|
|
|
|
!> @details Marc common blocks included:
|
|
|
|
|
!> @details - concom: lovl, inc
|
|
|
|
|
!> @details - creeps: timinc
|
2013-03-01 17:18:29 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-04-22 20:11:33 +05:30
|
|
|
#define QUOTE(x) #x
|
|
|
|
|
#define PASTE(x,y) x ## y
|
2012-08-28 21:38:17 +05:30
|
|
|
|
|
|
|
|
#ifndef INT
|
|
|
|
|
#define INT 4
|
|
|
|
|
#endif
|
|
|
|
|
|
|
|
|
|
#ifndef FLOAT
|
|
|
|
|
#define FLOAT 8
|
|
|
|
|
#endif
|
|
|
|
|
|
2012-06-15 21:40:21 +05:30
|
|
|
#define Marc
|
2010-05-10 20:32:59 +05:30
|
|
|
|
2012-08-28 21:38:17 +05:30
|
|
|
#include "prec.f90"
|
|
|
|
|
|
2012-03-09 01:55:28 +05:30
|
|
|
module DAMASK_interface
|
2012-06-15 21:40:21 +05:30
|
|
|
|
|
|
|
|
implicit none
|
|
|
|
|
character(len=4), parameter :: InputFileExtension = '.dat'
|
|
|
|
|
character(len=4), parameter :: LogFileExtension = '.log'
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2012-03-09 01:55:28 +05:30
|
|
|
contains
|
2009-08-31 20:51:15 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @brief only output of current version
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2012-03-09 01:55:28 +05:30
|
|
|
subroutine DAMASK_interface_init
|
2010-11-03 20:09:18 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
implicit none
|
2010-11-03 20:09:18 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
|
|
|
|
write(6,'(/,a)') ' <<<+- DAMASK_marc init -+>>>'
|
|
|
|
|
write(6,'(a)') ' $Id$'
|
2012-02-01 00:48:55 +05:30
|
|
|
#include "compilation_info.f90"
|
2013-04-09 15:38:00 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2012-03-09 01:55:28 +05:30
|
|
|
|
|
|
|
|
end subroutine DAMASK_interface_init
|
|
|
|
|
|
2009-08-31 20:39:15 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @brief returns the current workingDir
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2010-06-08 15:05:13 +05:30
|
|
|
function getSolverWorkingDirectoryName()
|
2012-03-09 01:55:28 +05:30
|
|
|
|
2010-05-10 20:32:59 +05:30
|
|
|
implicit none
|
2012-06-13 12:58:43 +05:30
|
|
|
character(1024) getSolverWorkingDirectoryName, inputName
|
2013-04-09 15:38:00 +05:30
|
|
|
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
|
2010-05-10 20:32:59 +05:30
|
|
|
|
2010-05-11 12:27:15 +05:30
|
|
|
getSolverWorkingDirectoryName=''
|
2012-06-13 12:58:43 +05:30
|
|
|
inputName=''
|
2013-04-09 15:38:00 +05:30
|
|
|
inquire(5, name=inputName) ! determine inputputfile
|
2012-06-13 12:58:43 +05:30
|
|
|
getSolverWorkingDirectoryName=inputName(1:scan(inputName,pathSep,back=.true.))
|
2012-03-09 01:55:28 +05:30
|
|
|
|
|
|
|
|
end function getSolverWorkingDirectoryName
|
2010-05-10 20:32:59 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @brief solver job name (no extension) as combination of geometry and load case name
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2010-06-08 15:05:13 +05:30
|
|
|
function getSolverJobName()
|
2013-03-01 17:18:29 +05:30
|
|
|
use prec, only: &
|
|
|
|
|
pReal, &
|
|
|
|
|
pInt
|
2010-05-10 20:32:59 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
implicit none
|
2012-06-13 15:28:06 +05:30
|
|
|
character(1024) :: getSolverJobName, inputName
|
2013-04-09 15:38:00 +05:30
|
|
|
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
|
2012-03-09 01:55:28 +05:30
|
|
|
integer(pInt) :: extPos
|
2010-05-10 20:32:59 +05:30
|
|
|
|
2010-05-11 12:27:15 +05:30
|
|
|
getSolverJobName=''
|
2012-06-13 15:28:06 +05:30
|
|
|
inputName=''
|
2013-04-09 15:38:00 +05:30
|
|
|
inquire(5, name=inputName) ! determine inputfile
|
2012-06-13 15:28:06 +05:30
|
|
|
extPos = len_trim(inputName)-4
|
|
|
|
|
getSolverJobName=inputName(scan(inputName,pathSep,back=.true.)+1:extPos)
|
2010-05-10 20:32:59 +05:30
|
|
|
|
2012-03-09 01:55:28 +05:30
|
|
|
end function getSolverJobName
|
|
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
|
2012-03-09 01:55:28 +05:30
|
|
|
end module DAMASK_interface
|
2009-08-31 20:51:15 +05:30
|
|
|
|
2013-02-26 18:19:07 +05:30
|
|
|
#include "IO.f90"
|
2013-04-18 22:10:49 +05:30
|
|
|
#include "libs.f90"
|
2011-03-29 12:57:19 +05:30
|
|
|
#include "numerics.f90"
|
|
|
|
|
#include "debug.f90"
|
|
|
|
|
#include "math.f90"
|
|
|
|
|
#include "FEsolving.f90"
|
|
|
|
|
#include "mesh.f90"
|
|
|
|
|
#include "material.f90"
|
|
|
|
|
#include "lattice.f90"
|
2012-07-03 16:46:38 +05:30
|
|
|
#include "constitutive_none.f90"
|
2011-03-29 12:57:19 +05:30
|
|
|
#include "constitutive_j2.f90"
|
|
|
|
|
#include "constitutive_phenopowerlaw.f90"
|
|
|
|
|
#include "constitutive_titanmod.f90"
|
|
|
|
|
#include "constitutive_dislotwin.f90"
|
|
|
|
|
#include "constitutive_nonlocal.f90"
|
|
|
|
|
#include "constitutive.f90"
|
|
|
|
|
#include "crystallite.f90"
|
|
|
|
|
#include "homogenization_isostrain.f90"
|
|
|
|
|
#include "homogenization_RGC.f90"
|
|
|
|
|
#include "homogenization.f90"
|
|
|
|
|
#include "CPFEM.f90"
|
2008-03-15 03:02:57 +05:30
|
|
|
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @brief This is the MSC.Marc user subroutine for defining material behavior
|
|
|
|
|
!> @details (1) F,R,U are only available for continuum and membrane elements (not for
|
|
|
|
|
!> @details shells and beams).
|
|
|
|
|
!> @details
|
2013-04-09 15:38:00 +05:30
|
|
|
!> @details (2) Use the -> 'Plasticity,3' card(=update+finite+large disp+constant d)
|
|
|
|
|
!> @details in the parameter section of input deck (updated Lagrangian formulation).
|
2013-03-01 17:18:29 +05:30
|
|
|
!> @details
|
|
|
|
|
!> @details The following operation obtains U (stretch tensor) at t=n+1 :
|
|
|
|
|
!> @details
|
|
|
|
|
!> @details call scla(un1,0.d0,itel,itel,1)
|
|
|
|
|
!> @details do k=1,3
|
|
|
|
|
!> @details do i=1,3
|
|
|
|
|
!> @details do j=1,3
|
|
|
|
|
!> @details un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k)
|
|
|
|
|
!> @details enddo
|
|
|
|
|
!> @details enddo
|
|
|
|
|
!> @details enddo
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-04-09 15:38:00 +05:30
|
|
|
subroutine hypela2(d,g,e,de,s,t,dt,ngens,m,nn,kcus,matus,ndi,nshear,disp, &
|
|
|
|
|
dispt,coord,ffn,frotn,strechn,eigvn,ffn1,frotn1, &
|
|
|
|
|
strechn1,eigvn1,ncrd,itel,ndeg,ndm,nnode, &
|
|
|
|
|
jtype,lclass,ifr,ifu)
|
|
|
|
|
use prec, only: &
|
|
|
|
|
pReal, &
|
|
|
|
|
pInt
|
|
|
|
|
use numerics, only: &
|
|
|
|
|
!$ DAMASK_NumThreadsInt, &
|
|
|
|
|
numerics_unitlength
|
|
|
|
|
use FEsolving, only: &
|
|
|
|
|
cycleCounter, &
|
|
|
|
|
theInc, &
|
|
|
|
|
calcMode, &
|
|
|
|
|
lastMode, &
|
|
|
|
|
theTime, &
|
|
|
|
|
theDelta, &
|
|
|
|
|
lastIncConverged, &
|
|
|
|
|
outdatedByNewInc, &
|
|
|
|
|
outdatedFFN1, &
|
|
|
|
|
terminallyIll, &
|
|
|
|
|
symmetricSolver
|
|
|
|
|
use math, only: &
|
|
|
|
|
math_transpose33,&
|
|
|
|
|
invnrmMandel
|
|
|
|
|
use debug, only: &
|
|
|
|
|
debug_level, &
|
|
|
|
|
debug_LEVELBASIC, &
|
|
|
|
|
debug_MARC, &
|
|
|
|
|
debug_info, &
|
|
|
|
|
debug_reset
|
|
|
|
|
use mesh, only: &
|
|
|
|
|
mesh_FEasCP, &
|
|
|
|
|
mesh_element, &
|
|
|
|
|
mesh_node0, &
|
|
|
|
|
mesh_node, &
|
2013-04-24 00:00:56 +05:30
|
|
|
mesh_Ncellnodes, &
|
2013-04-22 00:18:59 +05:30
|
|
|
mesh_cellnode, &
|
|
|
|
|
mesh_build_cellnodes, &
|
2013-04-09 15:38:00 +05:30
|
|
|
mesh_build_ipCoordinates, &
|
2013-04-15 13:43:20 +05:30
|
|
|
FE_Nnodes
|
2013-03-01 17:18:29 +05:30
|
|
|
use CPFEM, only: &
|
|
|
|
|
CPFEM_general, &
|
|
|
|
|
CPFEM_init_done, &
|
|
|
|
|
CPFEM_initAll, &
|
|
|
|
|
CPFEM_CALCRESULTS, &
|
|
|
|
|
CPFEM_AGERESULTS, &
|
|
|
|
|
CPFEM_COLLECT, &
|
|
|
|
|
CPFEM_RESTOREJACOBIAN, &
|
|
|
|
|
CPFEM_BACKUPJACOBIAN
|
2009-05-07 21:57:36 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
implicit none
|
|
|
|
|
!$ 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
|
|
|
|
|
ndi, & !< number of direct components
|
|
|
|
|
nshear, & !< number of shear components
|
|
|
|
|
ncrd, & !< number of coordinates
|
|
|
|
|
itel, & !< dimension of F and R, either 2 or 3
|
|
|
|
|
ndeg, & !< number of degrees of freedom
|
|
|
|
|
ndm, & !< not specified in MSC.Marc 2012 Manual D
|
|
|
|
|
nnode, & !< number of nodes per element
|
|
|
|
|
jtype, & !< element type
|
|
|
|
|
ifr, & !< set to 1 if R has been calculated
|
|
|
|
|
ifu !< set to 1 if stretch has been calculated
|
|
|
|
|
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
|
|
|
|
|
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
|
|
|
|
|
de, & !< increment of strain
|
|
|
|
|
dt !< increment of state variables
|
|
|
|
|
real(pReal), dimension(itel), intent(in) :: & ! according to MSC.Marc 2012 Manual D
|
|
|
|
|
strechn, & !< square of principal stretch ratios, lambda(i) at t=n
|
|
|
|
|
strechn1 !< square of principal stretch ratios, lambda(i) at t=n+1
|
|
|
|
|
real(pReal), dimension(3,3), intent(in) :: & ! has dimension(itel,*) according to MSC.Marc 2012 Manual D, but we alway assume dimension(3,3)
|
|
|
|
|
ffn, & !< deformation gradient at t=n
|
|
|
|
|
ffn1 !< deformation gradient at t=n+1
|
|
|
|
|
real(pReal), dimension(itel,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
|
|
|
|
|
frotn, & !< rotation tensor at t=n
|
|
|
|
|
eigvn, & !< i principal direction components for j eigenvalues at t=n
|
|
|
|
|
frotn1, & !< rotation tensor at t=n+1
|
|
|
|
|
eigvn1 !< i principal direction components for j eigenvalues at t=n+1
|
|
|
|
|
real(pReal), dimension(ndeg,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
|
|
|
|
|
disp, & !< incremental displacements
|
|
|
|
|
dispt !< displacements at t=n (at assembly, lovl=4) and displacements at t=n+1 (at stress recovery, lovl=6)
|
|
|
|
|
real(pReal), dimension(ncrd,*), intent(in) :: & ! according to MSC.Marc 2012 Manual D
|
|
|
|
|
coord !< coordinates
|
|
|
|
|
real(pReal), dimension(*), intent(inout) :: & ! according to MSC.Marc 2012 Manual D
|
|
|
|
|
t !< state variables (comes in at t=n, must be updated to have state variables at t=n+1)
|
|
|
|
|
real(pReal), dimension(ndi+nshear), intent(out) :: & ! has dimension(*) according to MSC.Marc 2012 Manual D, but we need to loop over it
|
|
|
|
|
s, & !< stress - should be updated by user
|
|
|
|
|
g !< change in stress due to temperature effects
|
|
|
|
|
real(pReal), dimension(ngens,ngens), intent(out) :: & ! according to MSC.Marc 2012 Manual D, but according to example hypela2.f dimension(ngens,*)
|
|
|
|
|
d !< stress-strain law to be formed
|
2008-03-15 03:02:57 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
2009-03-04 17:18:54 +05:30
|
|
|
! Marc common blocks are in fixed format so they have to be reformated to free format (f90)
|
|
|
|
|
! Beware of changes in newer Marc versions
|
2013-04-22 20:11:33 +05:30
|
|
|
|
|
|
|
|
#include QUOTE(PASTE(../lib/MarcInclude/concom,Marc4DAMASK)) ! concom is needed for inc, lovl
|
|
|
|
|
#include QUOTE(PASTE(../lib/MarcInclude/creeps,Marc4DAMASK)) ! creeps is needed for timinc (time increment)
|
2009-03-04 17:18:54 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
logical :: cutBack
|
2010-02-18 15:53:02 +05:30
|
|
|
real(pReal), dimension(6) :: stress
|
|
|
|
|
real(pReal), dimension(6,6) :: ddsdde
|
2013-04-22 00:18:59 +05:30
|
|
|
integer(pInt) :: computationMode, i, cp_en, node, CPnodeID
|
2013-04-09 15:38:00 +05:30
|
|
|
!$ integer(pInt) :: defaultNumThreadsInt !< default value set by Marc
|
|
|
|
|
|
|
|
|
|
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,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,/,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:', &
|
|
|
|
|
math_transpose33(ffn1)
|
|
|
|
|
endif
|
2013-04-23 20:12:22 +05:30
|
|
|
|
|
|
|
|
!$ defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc
|
|
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
if (.not. CPFEM_init_done) call CPFEM_initAll(t(1),m(1),nn)
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
!$ call omp_set_num_threads(DAMASK_NumThreadsInt) ! set number of threads for parallel execution set by DAMASK_NUM_THREADS
|
2010-12-02 16:34:29 +05:30
|
|
|
|
2013-04-23 20:12:22 +05:30
|
|
|
computationMode = 0_pInt ! save initialization value, since does not result in any calculation
|
2013-03-01 17:18:29 +05:30
|
|
|
if (lovl == 4 ) then
|
2013-04-09 15:38:00 +05:30
|
|
|
if(timinc < theDelta .and. theInc == inc ) computationMode = CPFEM_RESTOREJACOBIAN ! first after cutback
|
|
|
|
|
else ! stress requested (lovl == 6)
|
|
|
|
|
cp_en = mesh_FEasCP('elem',m(1))
|
|
|
|
|
if (cptim > theTime .or. inc /= theInc) then ! reached "convergence"
|
2009-08-11 22:01:57 +05:30
|
|
|
terminallyIll = .false.
|
2013-04-09 15:38:00 +05:30
|
|
|
cycleCounter = -1 ! first calc step increments this to cycle = 0
|
|
|
|
|
if (inc == 0) then ! >> start of analysis <<
|
|
|
|
|
lastIncConverged = .false. ! no Jacobian backup
|
|
|
|
|
outdatedByNewInc = .false. ! no aging of state
|
|
|
|
|
lastMode = .false. ! pretend last step was collection
|
|
|
|
|
calcMode = .false. ! pretend last step was collection
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> start of analysis..! ',m(1),nn
|
2012-11-06 21:20:20 +05:30
|
|
|
flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
else if (inc - theInc > 1) then ! >> restart of broken analysis <<
|
|
|
|
|
lastIncConverged = .false. ! no Jacobian backup
|
|
|
|
|
outdatedByNewInc = .false. ! no aging of state
|
|
|
|
|
lastMode = .true. ! pretend last step was calculation
|
|
|
|
|
calcMode = .true. ! pretend last step was calculation
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> restart of analysis..! ',m(1),nn
|
2012-11-06 21:20:20 +05:30
|
|
|
flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
else ! >> just the next inc <<
|
|
|
|
|
lastIncConverged = .true. ! request Jacobian backup
|
|
|
|
|
outdatedByNewInc = .true. ! request aging of state
|
|
|
|
|
lastMode = .true. ! assure last step was calculation
|
|
|
|
|
calcMode = .true. ! assure last step was calculation
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> new increment..! ',m(1),nn
|
2012-11-06 21:20:20 +05:30
|
|
|
flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
|
|
|
|
endif
|
2013-04-09 15:38:00 +05:30
|
|
|
else if ( timinc < theDelta ) then ! >> cutBack <<
|
2009-10-12 21:31:49 +05:30
|
|
|
terminallyIll = .false.
|
2013-04-09 15:38:00 +05:30
|
|
|
cycleCounter = -1 ! first calc step increments this to cycle = 0
|
|
|
|
|
calcMode = .true. ! pretend last step was calculation
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
write(6,'(a,i6,1x,i2)') '<< HYPELA2 >> cutback detected..! ',m(1),nn
|
2012-11-06 21:20:20 +05:30
|
|
|
flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2013-04-09 15:38:00 +05:30
|
|
|
endif ! convergence treatment end
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect)
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
if ( calcMode(nn,cp_en) ) then ! now --- CALC ---
|
|
|
|
|
if ( lastMode /= calcMode(nn,cp_en) ) then ! first after ping pong
|
|
|
|
|
call debug_reset() ! resets debugging
|
2010-09-02 02:34:02 +05:30
|
|
|
outdatedFFN1 = .false.
|
2010-11-04 23:45:50 +05:30
|
|
|
cycleCounter = cycleCounter + 1_pInt
|
2013-04-24 00:00:56 +05:30
|
|
|
mesh_cellnode = mesh_build_cellnodes(mesh_node,mesh_Ncellnodes) ! update cell node coordinates
|
2013-04-09 15:38:00 +05:30
|
|
|
call mesh_build_ipCoordinates() ! update ip coordinates
|
2009-10-12 21:31:49 +05:30
|
|
|
endif
|
|
|
|
|
if ( outdatedByNewInc ) then
|
2013-03-01 17:18:29 +05:30
|
|
|
computationMode = ior(CPFEM_CALCRESULTS,CPFEM_AGERESULTS)
|
2013-04-09 15:38:00 +05:30
|
|
|
outdatedByNewInc = .false. ! reset flag
|
2009-10-12 21:31:49 +05:30
|
|
|
else
|
2013-03-01 17:18:29 +05:30
|
|
|
computationMode = CPFEM_CALCRESULTS
|
2009-10-12 21:31:49 +05:30
|
|
|
endif
|
2013-04-09 15:38:00 +05:30
|
|
|
else ! now --- COLLECT ---
|
|
|
|
|
if ( lastMode /= calcMode(nn,cp_en) .and. & .not. terminallyIll) call debug_info() ! first after ping pong reports (meaningful) debugging
|
2009-10-12 21:31:49 +05:30
|
|
|
if ( lastIncConverged ) then
|
2013-04-09 15:38:00 +05:30
|
|
|
computationMode = ior(CPFEM_COLLECT,CPFEM_BACKUPJACOBIAN) ! collect and backup Jacobian after convergence
|
|
|
|
|
lastIncConverged = .false. ! reset flag
|
2009-10-12 21:31:49 +05:30
|
|
|
else
|
2013-04-09 15:38:00 +05:30
|
|
|
computationMode = CPFEM_COLLECT ! plain collect
|
2009-10-12 21:31:49 +05:30
|
|
|
endif
|
2013-04-15 13:43:20 +05:30
|
|
|
do node = 1,FE_Nnodes(mesh_element(2,cp_en))
|
2013-04-22 00:18:59 +05:30
|
|
|
CPnodeID = mesh_element(4_pInt+node,cp_en)
|
|
|
|
|
mesh_node(1:3,CPnodeID) = mesh_node0(1:3,CPnodeID) + numerics_unitlength * dispt(1:3,node)
|
2012-11-14 20:08:10 +05:30
|
|
|
enddo
|
2008-07-14 20:08:19 +05:30
|
|
|
endif
|
2008-03-15 03:02:57 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
theTime = cptim ! record current starting time
|
|
|
|
|
theDelta = timinc ! record current time increment
|
|
|
|
|
theInc = inc ! record current increment number
|
|
|
|
|
lastMode = calcMode(nn,cp_en) ! record calculationMode
|
2009-10-12 21:31:49 +05:30
|
|
|
endif
|
2008-02-19 00:19:06 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
call CPFEM_general(computationMode,ffn,ffn1,t(1),timinc,m(1),nn,stress,ddsdde)
|
2008-02-19 00:19:06 +05:30
|
|
|
|
|
|
|
|
! Mandel: 11, 22, 33, SQRT(2)*12, SQRT(2)*23, SQRT(2)*13
|
|
|
|
|
! Marc: 11, 22, 33, 12, 23, 13
|
2010-02-18 15:53:02 +05:30
|
|
|
! Marc: 11, 22, 33, 12
|
|
|
|
|
|
|
|
|
|
forall(i=1:ngens) d(1:ngens,i) = invnrmMandel(i)*ddsdde(1:ngens,i)*invnrmMandel(1:ngens)
|
2013-04-09 15:38:00 +05:30
|
|
|
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))
|
2011-02-08 15:55:51 +05:30
|
|
|
|
2013-04-09 15:38:00 +05:30
|
|
|
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
|
2010-11-19 23:15:27 +05:30
|
|
|
|
2012-03-09 01:55:28 +05:30
|
|
|
end subroutine hypela2
|
2009-05-07 21:57:36 +05:30
|
|
|
|
2008-04-07 20:24:29 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
!--------------------------------------------------------------------------------------------------
|
|
|
|
|
!> @brief sets user defined output variables for Marc
|
|
|
|
|
!> @details select a variable contour plotting (user subroutine).
|
|
|
|
|
!--------------------------------------------------------------------------------------------------
|
2013-04-09 15:38:00 +05:30
|
|
|
subroutine plotv(v,s,sp,etot,eplas,ecreep,t,m,nn,layer,ndi,nshear,jpltcd)
|
|
|
|
|
use prec, only: &
|
|
|
|
|
pReal, &
|
|
|
|
|
pInt
|
|
|
|
|
use mesh, only: &
|
|
|
|
|
mesh_FEasCP
|
|
|
|
|
use IO, only: &
|
|
|
|
|
IO_error
|
|
|
|
|
use homogenization, only: &
|
|
|
|
|
materialpoint_results,&
|
|
|
|
|
materialpoint_sizeResults
|
2012-03-09 01:55:28 +05:30
|
|
|
|
2007-03-22 17:39:37 +05:30
|
|
|
implicit none
|
2013-04-09 15:38:00 +05:30
|
|
|
integer(pInt), intent(in) :: &
|
|
|
|
|
m, & !< element number
|
|
|
|
|
nn, & !< integration point number
|
|
|
|
|
layer, & !< layer number
|
|
|
|
|
ndi, & !< number of direct stress components
|
|
|
|
|
nshear, & !< number of shear stress components
|
|
|
|
|
jpltcd !< user variable index
|
|
|
|
|
real(pReal), dimension(*), intent(in) :: &
|
|
|
|
|
s, & !< stress array
|
|
|
|
|
sp, & !< stresses in preferred direction
|
|
|
|
|
etot, & !< total strain (generalized)
|
|
|
|
|
eplas, & !< total plastic strain
|
|
|
|
|
ecreep, & !< total creep strain
|
|
|
|
|
t !< current temperature
|
|
|
|
|
real(pReal), intent(out) :: &
|
|
|
|
|
v !< variable
|
2009-05-07 21:57:36 +05:30
|
|
|
|
2013-03-01 17:18:29 +05:30
|
|
|
if (jpltcd > materialpoint_sizeResults) call IO_error(700_pInt,jpltcd) ! complain about out of bounds error
|
2009-05-07 21:57:36 +05:30
|
|
|
v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m))
|
|
|
|
|
|
2012-03-09 01:55:28 +05:30
|
|
|
end subroutine plotv
|
