2011-04-07 12:50:28 +05:30
|
|
|
! Copyright 2011 Max-Planck-Institut für Eisenforschung GmbH
|
2011-04-04 19:39:54 +05:30
|
|
|
!
|
|
|
|
! This file is part of DAMASK,
|
2011-04-07 12:50:28 +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/>.
|
|
|
|
!
|
|
|
|
!##############################################################
|
2009-08-31 20:39:15 +05:30
|
|
|
!* $Id$
|
2007-03-22 17:39:37 +05:30
|
|
|
!********************************************************************
|
2009-03-23 21:38:17 +05:30
|
|
|
! Material subroutine for MSC.Marc
|
|
|
|
!
|
|
|
|
! written by P. Eisenlohr,
|
|
|
|
! F. Roters,
|
|
|
|
! L. Hantcherli,
|
|
|
|
! W.A. Counts
|
|
|
|
! D.D. Tjahjanto
|
2009-08-31 20:39:15 +05:30
|
|
|
! C. Kords
|
2007-03-22 17:39:37 +05:30
|
|
|
!
|
|
|
|
! MPI fuer Eisenforschung, Duesseldorf
|
|
|
|
!
|
|
|
|
!********************************************************************
|
|
|
|
! Usage:
|
|
|
|
! - choose material as hypela2
|
2009-03-04 17:18:54 +05:30
|
|
|
! - set statevariable 2 to index of homogenization
|
|
|
|
! - set statevariable 3 to index of microstructure
|
|
|
|
! - make sure the file "material.config" exists in the working
|
2007-03-22 17:39:37 +05:30
|
|
|
! directory
|
2009-06-15 18:41:21 +05:30
|
|
|
! - make sure the file "numerics.config" exists in the working
|
|
|
|
! directory
|
2007-04-11 18:51:22 +05:30
|
|
|
! - use nonsymmetric option for solver (e.g. direct
|
|
|
|
! profile or multifrontal sparse, the latter seems
|
|
|
|
! to be faster!)
|
2009-03-23 21:38:17 +05:30
|
|
|
! - in case of ddm (domain decomposition)a SYMMETRIC
|
|
|
|
! solver has to be used, i.e uncheck "non-symmetric"
|
2007-03-22 17:39:37 +05:30
|
|
|
!********************************************************************
|
|
|
|
! Marc subroutines used:
|
|
|
|
! - hypela2
|
|
|
|
! - plotv
|
|
|
|
! - quit
|
|
|
|
!********************************************************************
|
|
|
|
! Marc common blocks included:
|
2007-03-26 15:57:34 +05:30
|
|
|
! - concom: lovl, ncycle, inc, incsub
|
2007-03-22 17:39:37 +05:30
|
|
|
! - creeps: timinc
|
|
|
|
!********************************************************************
|
|
|
|
!
|
2011-03-29 12:57:19 +05:30
|
|
|
#include "prec.f90"
|
2010-05-10 20:32:59 +05:30
|
|
|
|
|
|
|
|
2010-05-11 12:27:15 +05:30
|
|
|
MODULE mpie_interface
|
2009-08-31 20:51:15 +05:30
|
|
|
|
2009-10-12 21:31:49 +05:30
|
|
|
character(len=64), parameter :: FEsolver = 'Marc'
|
2010-05-11 12:27:15 +05:30
|
|
|
character(len=4), parameter :: InputFileExtension = '.dat'
|
2010-11-03 20:09:18 +05:30
|
|
|
character(len=4), parameter :: LogFileExtension = '.log'
|
2009-10-12 21:31:49 +05:30
|
|
|
|
2009-08-31 20:51:15 +05:30
|
|
|
CONTAINS
|
|
|
|
|
2010-06-08 15:05:13 +05:30
|
|
|
subroutine mpie_interface_init()
|
2010-11-03 20:09:18 +05:30
|
|
|
|
|
|
|
|
|
|
|
!$OMP CRITICAL (write2out)
|
2009-08-31 20:39:15 +05:30
|
|
|
write(6,*)
|
2009-08-31 20:51:15 +05:30
|
|
|
write(6,*) '<<<+- mpie_cpfem_marc init -+>>>'
|
2009-08-31 20:39:15 +05:30
|
|
|
write(6,*) '$Id$'
|
|
|
|
write(6,*)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2009-08-31 20:39:15 +05:30
|
|
|
return
|
|
|
|
end subroutine
|
|
|
|
|
2010-06-08 15:05:13 +05:30
|
|
|
function getSolverWorkingDirectoryName()
|
2010-05-10 20:32:59 +05:30
|
|
|
implicit none
|
2010-05-11 12:27:15 +05:30
|
|
|
character(1024) getSolverWorkingDirectoryName, outName
|
2010-08-04 05:17: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=''
|
2010-05-10 20:32:59 +05:30
|
|
|
outName=''
|
|
|
|
inquire(6, name=outName) ! determine outputfile
|
2010-05-11 12:27:15 +05:30
|
|
|
getSolverWorkingDirectoryName=outName(1:scan(outName,pathSep,back=.true.))
|
|
|
|
! write(6,*) 'getSolverWorkingDirectoryName', getSolverWorkingDirectoryName
|
2010-05-10 20:32:59 +05:30
|
|
|
end function
|
|
|
|
|
2011-02-21 20:07:38 +05:30
|
|
|
|
|
|
|
function getModelName()
|
|
|
|
use prec
|
|
|
|
implicit none
|
|
|
|
|
|
|
|
character(1024) getModelName
|
|
|
|
|
|
|
|
getModelName = getSolverJobName()
|
|
|
|
end function
|
|
|
|
|
|
|
|
|
2010-06-08 15:05:13 +05:30
|
|
|
function getSolverJobName()
|
2010-05-10 20:32:59 +05:30
|
|
|
use prec
|
|
|
|
implicit none
|
|
|
|
|
2010-05-11 12:27:15 +05:30
|
|
|
character(1024) getSolverJobName, outName
|
2010-08-04 05:17:00 +05:30
|
|
|
character(len=*), parameter :: pathSep = achar(47)//achar(92) ! forward and backward slash
|
2010-05-10 20:32:59 +05:30
|
|
|
integer(pInt) extPos
|
|
|
|
|
2010-05-11 12:27:15 +05:30
|
|
|
getSolverJobName=''
|
2010-05-10 20:32:59 +05:30
|
|
|
outName=''
|
|
|
|
inquire(6, name=outName) ! determine outputfile
|
|
|
|
extPos = len_trim(outName)-4
|
2010-05-11 12:27:15 +05:30
|
|
|
getSolverJobName=outName(scan(outName,pathSep,back=.true.)+1:extPos)
|
|
|
|
! write(6,*) 'getSolverJobName', getSolverJobName
|
2010-05-10 20:32:59 +05:30
|
|
|
end function
|
|
|
|
|
2009-08-31 20:51:15 +05:30
|
|
|
END MODULE
|
|
|
|
|
2011-03-29 12:57:19 +05:30
|
|
|
#include "IO.f90"
|
|
|
|
#include "numerics.f90"
|
|
|
|
#include "debug.f90"
|
|
|
|
#include "math.f90"
|
|
|
|
#include "FEsolving.f90"
|
|
|
|
#include "mesh.f90"
|
|
|
|
#include "material.f90"
|
|
|
|
#include "lattice.f90"
|
|
|
|
#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
|
|
|
|
2007-03-22 17:39:37 +05:30
|
|
|
!********************************************************************
|
|
|
|
! This is the Marc material routine
|
|
|
|
!********************************************************************
|
|
|
|
!
|
2007-10-16 18:52:39 +05:30
|
|
|
! ************* user subroutine for defining material behavior **************
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! CAUTION : Due to calculation of the Deformation gradients, Stretch Tensors and
|
|
|
|
! Rotation tensors at previous and current states, the analysis can be
|
|
|
|
! computationally expensive. Please use the user subroutine -> hypela
|
|
|
|
! if these kinematic quantities are not needed in the constitutive model
|
|
|
|
!
|
|
|
|
!
|
|
|
|
! IMPORTANT NOTES :
|
|
|
|
!
|
|
|
|
! (1) F,R,U are only available for continuum and membrane elements (not for
|
|
|
|
! shells and beams).
|
|
|
|
!
|
|
|
|
! (2) For total Lagrangian formulation use the -> 'Elasticity,1' card(=
|
|
|
|
! total Lagrange with large disp) in the parameter section of input deck.
|
|
|
|
! For updated Lagrangian formulation use the -> 'Plasticity,3' card(=
|
|
|
|
! update+finite+large disp+constant d) in the parameter section of
|
|
|
|
! input deck.
|
|
|
|
!
|
|
|
|
! The following operation obtains U (stretch tensor) at t=n+1 :
|
|
|
|
!
|
|
|
|
! call scla(un1,0.d0,itel,itel,1)
|
|
|
|
! do 3 k=1,3
|
|
|
|
! do 2 i=1,3
|
|
|
|
! do 1 j=1,3
|
|
|
|
! un1(i,j)=un1(i,j)+dsqrt(strechn1(k))*eigvn1(i,k)*eigvn1(j,k)
|
|
|
|
!1 continue
|
|
|
|
!2 continue
|
|
|
|
!3 continue
|
|
|
|
!
|
2009-05-07 21:57:36 +05:30
|
|
|
!********************************************************************
|
|
|
|
subroutine hypela2(&
|
|
|
|
d,& ! stress strain law to be formed
|
|
|
|
g,& ! change in stress due to temperature effects
|
|
|
|
e,& ! total elastic strain
|
|
|
|
de,& ! increment of strain
|
|
|
|
s,& ! stress - should be updated by user
|
|
|
|
t,& ! state variables (comes in at t=n, must be updated to have state variables at t=n+1)
|
|
|
|
dt,& ! increment of state variables
|
|
|
|
ngens,& ! size of stress - strain law
|
|
|
|
n,& ! element number
|
|
|
|
nn,& ! integration point number
|
|
|
|
kcus,& ! (1) layer number, (2) internal layer number
|
|
|
|
matus,& ! (1) user material identification number, (2) internal material identification number
|
|
|
|
ndi,& ! number of direct components
|
|
|
|
nshear,& ! number of shear components
|
|
|
|
disp,& ! incremental displacements
|
|
|
|
dispt,& ! displacements at t=n (at assembly, lovl=4) and displacements at t=n+1 (at stress recovery, lovl=6)
|
|
|
|
coord,& ! coordinates
|
|
|
|
ffn,& ! deformation gradient
|
|
|
|
frotn,& ! rotation tensor
|
|
|
|
strechn,& ! square of principal stretch ratios, lambda(i)
|
|
|
|
eigvn,& ! i principal direction components for j eigenvalues
|
|
|
|
ffn1,& ! deformation gradient
|
|
|
|
frotn1,& ! rotation tensor
|
|
|
|
strechn1,& ! square of principal stretch ratios, lambda(i)
|
|
|
|
eigvn1,& ! i principal direction components for j eigenvalues
|
|
|
|
ncrd,& ! number of coordinates
|
|
|
|
itel,& ! dimension of F and R, either 2 or 3
|
|
|
|
ndeg,& ! number of degrees of freedom ==> is this at correct list position ?!?
|
|
|
|
ndm,& !
|
|
|
|
nnode,& ! number of nodes per element
|
|
|
|
jtype,& ! element type
|
|
|
|
lclass,& ! element class
|
|
|
|
ifr,& ! set to 1 if R has been calculated
|
|
|
|
ifu & ! set to 1 if stretch has been calculated
|
|
|
|
)
|
|
|
|
|
2009-06-15 18:41:21 +05:30
|
|
|
use prec, only: pReal, &
|
|
|
|
pInt
|
|
|
|
use FEsolving, only: cycleCounter, &
|
|
|
|
theInc, &
|
2009-10-12 21:31:49 +05:30
|
|
|
cutBack, &
|
|
|
|
calcMode, &
|
|
|
|
lastMode, &
|
2009-06-15 18:41:21 +05:30
|
|
|
theTime, &
|
2009-10-12 21:31:49 +05:30
|
|
|
theDelta, &
|
2009-06-15 18:41:21 +05:30
|
|
|
lastIncConverged, &
|
|
|
|
outdatedByNewInc, &
|
|
|
|
outdatedFFN1, &
|
2009-08-12 13:40:28 +05:30
|
|
|
terminallyIll, &
|
2009-06-15 18:41:21 +05:30
|
|
|
symmetricSolver
|
|
|
|
use math, only: invnrmMandel
|
|
|
|
use debug, only: debug_info, &
|
|
|
|
debug_reset
|
2009-10-12 21:31:49 +05:30
|
|
|
use mesh, only: mesh_FEasCP
|
2010-11-03 20:09:18 +05:30
|
|
|
use CPFEM, only: CPFEM_initAll,CPFEM_general,CPFEM_init_done
|
2010-12-02 16:34:29 +05:30
|
|
|
!$ use OMP_LIB ! the openMP function library
|
|
|
|
!$ use numerics, only: mpieNumThreadsInt ! number of threads set by MPIE_NUMTHREADS
|
2009-03-04 17:18:54 +05:30
|
|
|
implicit none
|
|
|
|
|
|
|
|
! ** Start of generated type statements **
|
|
|
|
real(pReal) coord, d, de, disp, dispt, dt, e, eigvn, eigvn1, ffn, ffn1
|
|
|
|
real(pReal) frotn, frotn1, g
|
|
|
|
integer(pInt) ifr, ifu, itel, jtype, kcus, lclass, matus, n, ncrd, ndeg
|
|
|
|
integer(pInt) ndi, ndm, ngens, nn, nnode, nshear
|
|
|
|
real(pReal) s, strechn, strechn1, t
|
|
|
|
! ** End of generated type statements **
|
2009-05-07 21:57:36 +05:30
|
|
|
|
2008-03-15 03:02:57 +05:30
|
|
|
dimension e(*),de(*),t(*),dt(*),g(*),d(ngens,*),s(*), n(2),coord(ncrd,*),disp(ndeg,*),matus(2),dispt(ndeg,*),ffn(itel,*),&
|
2009-04-22 19:51:18 +05:30
|
|
|
frotn(itel,*),strechn(itel),eigvn(itel,*),ffn1(itel,*),frotn1(itel,*),strechn1(itel),eigvn1(itel,*),kcus(2), lclass(2)
|
2008-03-15 03:02:57 +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
|
|
|
|
|
2009-03-23 21:38:17 +05:30
|
|
|
include "concom%%MARCVERSION%%" ! concom is needed for inc, subinc, ncycle, lovl
|
|
|
|
include "creeps%%MARCVERSION%%" ! creeps is needed for timinc (time increment)
|
2007-10-16 18:52:39 +05:30
|
|
|
|
2010-02-18 15:53:02 +05:30
|
|
|
real(pReal), dimension(6) :: stress
|
|
|
|
real(pReal), dimension(6,6) :: ddsdde
|
2010-07-07 15:28:18 +05:30
|
|
|
|
2010-11-04 23:45:50 +05:30
|
|
|
real(pReal), dimension (3,3) :: pstress ! dummy argument for call of cpfem_general (used by mpie_spectral)
|
|
|
|
real(pReal), dimension (3,3,3,3) :: dPdF ! dummy argument for call of cpfem_general (used by mpie_spectral)
|
2010-02-18 15:53:02 +05:30
|
|
|
|
2011-03-17 18:43:13 +05:30
|
|
|
integer(pInt) computationMode, i, cp_en
|
2011-02-08 15:55:51 +05:30
|
|
|
|
2010-12-02 16:34:29 +05:30
|
|
|
! OpenMP variable
|
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
|
|
|
!$ integer(pInt) defaultNumThreadsInt ! default value set by Marc
|
2010-11-19 23:15:27 +05:30
|
|
|
|
|
|
|
|
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
|
|
|
!$ defaultNumThreadsInt = omp_get_num_threads() ! remember number of threads set by Marc
|
2010-12-02 16:34:29 +05:30
|
|
|
|
2010-11-03 20:09:18 +05:30
|
|
|
if (.not. CPFEM_init_done) call CPFEM_initAll(t(1),n(1),nn)
|
2009-10-12 21:31:49 +05:30
|
|
|
|
openmp parallelization working again (at least for j2 and nonlocal constitutive model).
In order to keep it like that, please follow these simple rules:
DON'T use implicit array subscripts:
example: real, dimension(3,3) :: A,B
A(:,2) = B(:,1) <--- DON'T USE
A(1:3,2) = B(1:3,1) <--- BETTER USE
In many cases the use of explicit array subscripts is inevitable for parallelization. Additionally, it is an easy means to prevent memory leaks.
Enclose all write statements with the following:
!$OMP CRITICAL (write2out)
<your write statement>
!$OMP END CRITICAL (write2out)
Whenever you change something in the code and are not sure if it affects parallelization and leads to nonconforming behavior, please ask me and/or Franz to check this.
2011-03-17 16:16:17 +05:30
|
|
|
!$ call omp_set_num_threads(mpieNumThreadsInt) ! set number of threads for parallel execution set by MPIE_NUM_THREADS
|
2010-12-02 16:34:29 +05:30
|
|
|
|
2010-11-03 20:09:18 +05:30
|
|
|
if (lovl == 4) then ! Marc requires stiffness in separate call
|
2010-02-18 15:53:02 +05:30
|
|
|
if ( timinc < theDelta .and. theInc == inc ) then ! first after cutback
|
2010-11-03 20:09:18 +05:30
|
|
|
computationMode = 7 ! --> restore tangent and return it
|
2009-10-17 14:55:36 +05:30
|
|
|
else
|
2010-11-03 20:09:18 +05:30
|
|
|
computationMode = 6 ! --> just return known tangent
|
2009-10-17 14:55:36 +05:30
|
|
|
endif
|
2010-11-03 20:09:18 +05:30
|
|
|
else ! stress requested (lovl == 6)
|
2011-03-17 18:43:13 +05:30
|
|
|
cp_en = mesh_FEasCP('elem',n(1))
|
2010-11-04 23:45:50 +05:30
|
|
|
if (cptim > theTime .or. inc /= theInc) then ! reached "convergence"
|
2009-08-11 22:01:57 +05:30
|
|
|
terminallyIll = .false.
|
2010-11-04 23:45:50 +05:30
|
|
|
cycleCounter = -1 ! first calc step increments this to cycle = 0
|
|
|
|
if (inc == 0) then ! >> start of analysis <<
|
2010-11-03 20:09:18 +05:30
|
|
|
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
|
|
|
|
!$OMP CRITICAL (write2out)
|
2011-03-21 16:01:17 +05:30
|
|
|
write (6,'(a,i6,x,i2)') '<< HYPELA2 >> start of analysis..! ',n(1),nn
|
|
|
|
call flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2010-11-04 23:45:50 +05:30
|
|
|
else if (inc - theInc > 1) then ! >> restart of broken analysis <<
|
2010-11-03 20:09:18 +05:30
|
|
|
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
|
|
|
|
!$OMP CRITICAL (write2out)
|
2011-03-21 16:01:17 +05:30
|
|
|
write (6,'(a,i6,x,i2)') '<< HYPELA2 >> restart of analysis..! ',n(1),nn
|
|
|
|
call flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
2010-11-04 23:45:50 +05:30
|
|
|
else ! >> just the next inc <<
|
|
|
|
lastIncConverged = .true. ! request Jacobian backup
|
|
|
|
outdatedByNewInc = .true. ! request aging of state
|
2010-11-03 20:09:18 +05:30
|
|
|
lastMode = .true. ! assure last step was calculation
|
|
|
|
calcMode = .true. ! assure last step was calculation
|
|
|
|
!$OMP CRITICAL (write2out)
|
2011-03-21 16:01:17 +05:30
|
|
|
write (6,'(a,i6,x,i2)') '<< HYPELA2 >> new increment..! ',n(1),nn
|
|
|
|
call flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
|
|
|
endif
|
2010-11-04 23:45:50 +05:30
|
|
|
else if ( timinc < theDelta ) then ! >> cutBack <<
|
2009-10-12 21:31:49 +05:30
|
|
|
terminallyIll = .false.
|
2010-11-04 23:45:50 +05:30
|
|
|
cycleCounter = -1 ! first calc step increments this to cycle = 0
|
2010-11-03 20:09:18 +05:30
|
|
|
calcMode = .true. ! pretend last step was calculation
|
|
|
|
!$OMP CRITICAL (write2out)
|
2011-03-21 16:01:17 +05:30
|
|
|
write(6,'(a,i6,x,i2)') '<< HYPELA2 >> cutback detected..! ',n(1),nn
|
|
|
|
call flush(6)
|
2010-11-03 20:09:18 +05:30
|
|
|
!$OMP END CRITICAL (write2out)
|
|
|
|
endif ! convergence treatment end
|
2009-10-12 21:31:49 +05:30
|
|
|
|
|
|
|
calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect)
|
|
|
|
|
2010-09-02 02:34:02 +05:30
|
|
|
if ( calcMode(nn,cp_en) ) then ! now --- CALC ---
|
2010-11-03 20:09:18 +05:30
|
|
|
if ( lastMode /= calcMode(nn,cp_en) ) then ! first after ping pong
|
2009-10-12 21:31:49 +05:30
|
|
|
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
|
2009-10-12 21:31:49 +05:30
|
|
|
endif
|
|
|
|
if ( outdatedByNewInc ) then
|
2010-11-04 23:45:50 +05:30
|
|
|
outdatedByNewInc = .false. ! reset flag
|
2009-10-12 21:31:49 +05:30
|
|
|
computationMode = 1 ! calc and age results
|
|
|
|
else
|
|
|
|
computationMode = 2 ! plain calc
|
|
|
|
endif
|
2010-09-02 02:34:02 +05:30
|
|
|
else ! now --- COLLECT ---
|
2010-11-03 20:09:18 +05:30
|
|
|
if ( lastMode /= calcMode(nn,cp_en) .and. &
|
2011-02-08 15:55:51 +05:30
|
|
|
.not. terminallyIll ) then
|
|
|
|
call debug_info() ! first after ping pong reports (meaningful) debugging
|
|
|
|
endif
|
2009-10-12 21:31:49 +05:30
|
|
|
if ( lastIncConverged ) then
|
2010-11-04 23:45:50 +05:30
|
|
|
lastIncConverged = .false. ! reset flag
|
2009-10-12 21:31:49 +05:30
|
|
|
computationMode = 4 ! collect and backup Jacobian after convergence
|
|
|
|
else
|
|
|
|
computationMode = 3 ! plain collect
|
|
|
|
endif
|
2008-07-14 20:08:19 +05:30
|
|
|
endif
|
2008-03-15 03:02:57 +05:30
|
|
|
|
2009-10-12 21:31:49 +05:30
|
|
|
theTime = cptim ! record current starting time
|
|
|
|
theDelta = timinc ! record current time increment
|
|
|
|
theInc = inc ! record current increment number
|
2009-10-19 18:16:02 +05:30
|
|
|
lastMode = calcMode(nn,cp_en) ! record calculationMode
|
2009-10-12 21:31:49 +05:30
|
|
|
endif
|
2008-02-19 00:19:06 +05:30
|
|
|
|
2010-07-07 15:28:18 +05:30
|
|
|
call CPFEM_general(computationMode,ffn,ffn1,t(1),timinc,n(1),nn,stress,ddsdde, pstress, dPdF)
|
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)
|
|
|
|
s(1:ngens) = stress(1:ngens)*invnrmMandel(1:ngens)
|
2008-09-22 14:06:51 +05:30
|
|
|
if(symmetricSolver) d(1:ngens,1:ngens) = 0.5_pReal*(d(1:ngens,1:ngens)+transpose(d(1:ngens,1:ngens)))
|
2011-02-08 15:55:51 +05:30
|
|
|
|
2010-12-02 16:34:29 +05:30
|
|
|
!$ call omp_set_num_threads(defaultNumThreadsInt) ! reset number of threads to stored default value
|
2010-11-19 23:15:27 +05:30
|
|
|
|
2009-05-07 21:57:36 +05:30
|
|
|
end subroutine
|
|
|
|
|
2008-04-07 20:24:29 +05:30
|
|
|
|
2007-03-22 17:39:37 +05:30
|
|
|
!********************************************************************
|
|
|
|
! This routine sets user defined output variables for Marc
|
|
|
|
!********************************************************************
|
|
|
|
!
|
|
|
|
! select a variable contour plotting (user subroutine).
|
|
|
|
!
|
2007-10-16 18:52:39 +05:30
|
|
|
!********************************************************************
|
2009-05-07 21:57:36 +05:30
|
|
|
subroutine plotv(&
|
|
|
|
v,& ! variable
|
|
|
|
s,& ! stress array
|
|
|
|
sp,& ! stresses in preferred direction
|
|
|
|
etot,& ! total strain (generalized)
|
|
|
|
eplas,& ! total plastic strain
|
|
|
|
ecreep,& ! total creep strain
|
|
|
|
t,& ! current temperature
|
|
|
|
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
|
|
|
|
)
|
2007-10-16 18:52:39 +05:30
|
|
|
use prec, only: pReal,pInt
|
|
|
|
use mesh, only: mesh_FEasCP
|
2011-05-04 21:32:18 +05:30
|
|
|
use IO, only: IO_error
|
|
|
|
use homogenization, only: materialpoint_results,materialpoint_sizeResults
|
2007-03-22 17:39:37 +05:30
|
|
|
implicit none
|
2009-05-07 21:57:36 +05:30
|
|
|
|
2007-03-22 17:39:37 +05:30
|
|
|
real(pReal) s(*),etot(*),eplas(*),ecreep(*),sp(*)
|
|
|
|
real(pReal) v, t(*)
|
2007-10-16 18:52:39 +05:30
|
|
|
integer(pInt) m, nn, layer, ndi, nshear, jpltcd
|
2009-05-07 21:57:36 +05:30
|
|
|
|
2011-05-04 21:32:18 +05:30
|
|
|
if (jpltcd > materialpoint_sizeResults) IO_error(667,jpltcd) ! complain about out of bounds error
|
|
|
|
|
2009-05-07 21:57:36 +05:30
|
|
|
v = materialpoint_results(jpltcd,nn,mesh_FEasCP('elem', m))
|
2007-03-22 17:39:37 +05:30
|
|
|
return
|
2009-05-07 21:57:36 +05:30
|
|
|
|
|
|
|
end subroutine
|