# new interface for Abaqus

# IO has some additional functionality for Abaqus parsing
# ping pong scheme in FE interface now similar (and more human understandable) in both versions
# mesh has better splitting of different tasks, plus operation on database whenever possible
# FEsolver as new global var to indicate FEM solver type
# computation mode reshuffling: 6 is now Marc special case of recycling...
This commit is contained in:
Philip Eisenlohr 2009-10-12 16:01:49 +00:00
parent 02602144d2
commit 21cad32137
7 changed files with 2775 additions and 1579 deletions

View File

@ -79,8 +79,6 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
terminallyIll, &
cycleCounter, &
theInc, &
theCycle, &
theLovl, &
theTime, &
FEsolving_execElem, &
FEsolving_execIP
@ -133,12 +131,12 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
real(pReal), intent(in) :: dt ! time increment
real(pReal), dimension (3,3), intent(in) :: ffn, & ! deformation gradient for t=t0
ffn1 ! deformation gradient for t=t1
integer(pInt), intent(in) :: mode ! computation mode 1: regular computation with aged results
integer(pInt), intent(in) :: mode ! computation mode 1: regular computation plus aging of results
! 2: regular computation
! 3: collection of FEM data
! 4: recycling of former results (MARC speciality)
! 5: record tangent from former converged inc
! 6: restore tangent from former converged inc
! 4: backup tangent from former converged inc
! 5: restore tangent from former converged inc
! 6: recycling of former results (MARC speciality)
!*** output variables ***!
real(pReal), dimension(ngens), intent(out) :: cauchyStress ! stress vector in Mandel notation
@ -176,7 +174,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
call debug_init()
call math_init()
call FE_init()
call mesh_init()
call mesh_init(IP, element) ! pass on coordinates to alter calcMode of first ip
call lattice_init()
call material_init()
call constitutive_init()
@ -190,12 +188,14 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
cp_en = mesh_FEasCP('elem',element)
if (cp_en == 1 .and. IP == 1) then
!$OMP CRITICAL (write2out)
write(6,*)
write(6,*) '#####################################'
write(6,'(a10,1x,f8.4,1x,a10,1x,i4,1x,a10,1x,i3,1x,a10,1x,i2,x,a10,1x,i2)') &
'theTime',theTime,'theInc',theInc,'theCycle',theCycle,'theLovl',theLovl,&
'mode',mode
write(6,'(a10,x,f8.4,x,a10,x,i4,x,a10,x,i3,x,a16,x,i2,x,a16,x,i2)') &
'theTime',theTime,'theInc',theInc,'cycleCounter',cycleCounter,'computationMode',mode
write(6,*) '#####################################'
call flush (6)
!$OMP END CRITICAL (write2out)
endif
! according to our "mode" we decide what to do
@ -213,7 +213,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
j = 1:mesh_maxNips, &
k = 1:mesh_NcpElems ) &
constitutive_state0(i,j,k)%p = constitutive_state(i,j,k)%p ! microstructure of crystallites
!$OMP CRITICAL (write2out)
write(6,'(a10,/,4(3(e20.8,x),/))') 'aged state',constitutive_state(1,1,1)%p
!$OMP END CRITICAL (write2out)
do k = 1,mesh_NcpElems
do j = 1,mesh_maxNips
if (homogenization_sizeState(j,k) > 0_pInt) &
@ -225,7 +227,9 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
! deformation gradient outdated or any actual deformation gradient differs more than relevantStrain from the stored one
if (terminallyIll .or. outdatedFFN1 .or. any(abs(ffn1 - materialpoint_F(:,:,IP,cp_en)) > relevantStrain)) then
if (.not. terminallyIll .and. .not. outdatedFFN1) then
!$OMP CRITICAL (write2out)
write(6,'(a11,x,i5,x,i2,x,a10,/,3(3(f10.6,x),/))') 'outdated at',cp_en,IP,'FFN1 now:',ffn1(:,1),ffn1(:,2),ffn1(:,3)
!$OMP END CRITICAL (write2out)
outdatedFFN1 = .true.
endif
CPFEM_cs(1:ngens,IP,cp_en) = CPFEM_odd_stress
@ -234,7 +238,7 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
! deformation gradient is not outdated
else
! set flag for Jacobian update
updateJaco = (mod(cycleCounter-4,4_pInt*iJacoStiffness)==0)
updateJaco = mod(cycleCounter,iJacoStiffness) == 0
! no parallel computation
if (.not. parallelExecution) then
@ -278,8 +282,13 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
endif
endif
! --+>> COLLECTION OF FEM DATA AND RETURN OF ODD STRESS AND JACOBIAN <<+--
case (3)
! --+>> COLLECTION OF FEM INPUT WITH RETURNING OF ODD STRESS AND JACOBIAN <<+--
case (3,4,5)
if (mode == 4) then
CPFEM_dcsde_knownGood = CPFEM_dcsde ! --+>> BACKUP JACOBIAN FROM FORMER CONVERGED INC
else if (mode == 5) then
CPFEM_dcsde = CPFEM_dcsde_knownGood ! --+>> RESTORE CONSISTENT JACOBIAN FROM FORMER CONVERGED INC
end if
materialpoint_Temperature(IP,cp_en) = Temperature
materialpoint_F0(:,:,IP,cp_en) = ffn
materialpoint_F(:,:,IP,cp_en) = ffn1
@ -288,29 +297,26 @@ subroutine CPFEM_general(mode, ffn, ffn1, Temperature, dt, element, IP, cauchySt
CPFEM_calc_done = .false.
! --+>> RECYCLING OF FORMER RESULTS (MARC SPECIALTY) <<+--
case (4)
! do nothing
! --+>> RECORD JACOBIAN FROM FORMER CONVERGED INC <<+--
case (5)
CPFEM_dcsde_knownGood = CPFEM_dcsde
! --+>> RESTORE CONSISTENT JACOBIAN FROM FORMER CONVERGED INC <<+--
case (6)
CPFEM_dcsde = CPFEM_dcsde_knownGood
! do nothing
end select
! return the local stress and the jacobian from storage
cauchyStress(1:ngens) = CPFEM_cs(1:ngens,IP,cp_en)
jacobian(1:ngens,1:ngens) = CPFEM_dcsdE(1:ngens,1:ngens,IP,cp_en)
if (IP == 1 .and. cp_en == 1) write(6,'(a,/,6(6(f10.3,x)/))') 'jacobian/GPa at ip 1 el 1',jacobian/1e9
if (IP == 1 .and. cp_en == 1) then
!$OMP CRITICAL (write2out)
write(6,'(a,/,6(6(f10.3,x)/))') 'jacobian/GPa at ip 1 el 1',jacobian/1e9
call flush(6)
!$OMP END CRITICAL (write2out)
endif
! return temperature
if (theInc > 0_pInt) Temperature = materialpoint_Temperature(IP,cp_en) ! homogenized result except for potentially non-isothermal starting condition.
return
end subroutine
END MODULE CPFEM
END MODULE CPFEM

View File

@ -6,12 +6,13 @@
use prec, only: pInt,pReal
implicit none
integer(pInt) cycleCounter
integer(pInt) theInc,theCycle,theLovl
real(pReal) theTime
integer(pInt) cycleCounter, theInc
real(pReal) theTime, theDelta
logical :: lastIncConverged = .false.,outdatedByNewInc = .false.,outdatedFFN1 = .false.,terminallyIll = .false.
logical :: symmetricSolver = .false.
logical :: parallelExecution = .true.
logical :: lastMode = .true., cutBack = .false.
logical, dimension(:,:), allocatable :: calcMode
integer(pInt), dimension(:,:), allocatable :: FEsolving_execIP
integer(pInt), dimension(2) :: FEsolving_execElem

View File

@ -27,11 +27,16 @@
!********************************************************************
! output version number
!********************************************************************
subroutine IO_init
subroutine IO_init ()
!$OMP CRITICAL (write2out)
write(6,*)
write(6,*) '<<<+- IO init -+>>>'
write(6,*) '$Id$'
write(6,*)
call flush(6)
!$OMP END CRITICAL (write2out)
return
endsubroutine
@ -64,6 +69,7 @@ endsubroutine
!********************************************************************
logical function IO_open_inputFile(unit)
use cpfem_interface
use prec, only: pReal, pInt
implicit none
@ -74,11 +80,18 @@ endsubroutine
inquire(6, name=outName) ! determine outputfileName
extPos = len_trim(outName)-2
if(outName(extPos:extPos+2)=='out') then
ext='dat' ! MARC
else
ext='inp' ! ABAQUS
endif
! if(outName(extPos:extPos+2)=='out') then
! ext='dat' ! MARC
! else
! ext='inp' ! ABAQUS
! endif
select case (FEsolver)
case ('Marc')
ext='dat'
case ('Abaqus')
ext='inp'
end select
open(unit,status='old',err=100,file=outName(1:extPos-1)//ext)
IO_open_inputFile = .true.
return
@ -461,7 +474,7 @@ endfunction
implicit none
character(len=*), intent(in) :: line
character(len=*), parameter :: sep=achar(32)//achar(9)//achar(10)//achar(13) ! whitespaces
character(len=*), parameter :: sep=achar(44)//achar(32)//achar(9)//achar(10)//achar(13) ! comma and whitespaces
integer(pInt), intent(in) :: N
integer(pInt) part
integer(pInt) IO_stringPos(1+N*2)
@ -705,58 +718,145 @@ endfunction
!********************************************************************
! count items in consecutive lines of ints concatenated by "c"
! as last char or range of values a "to" b
! extract value from key=value pair and check whether key matches
!********************************************************************
function IO_countContinousIntValues (unit)
pure function IO_extractValue (line,key)
use prec, only: pReal,pInt
implicit none
integer(pInt) IO_countContinousIntValues,unit
integer(pInt), dimension(67) :: pos ! allow for 32 values excl "c"
character(len=300) line
character(len=*), intent(in) :: line,key
character(len=*), parameter :: sep = achar(61) ! '='
integer(pInt) pos
character(len=300) IO_extractValue
IO_countContinousIntValues = 0
IO_extractValue = ''
pos = scan(line,sep)
if (pos > 0 .and. line(:pos-1) == key(:pos-1)) & ! key matches expected key
IO_extractValue = line(pos+1:) ! extract value
return
endfunction
!********************************************************************
! count lines containig data up to next *keyword
!********************************************************************
function IO_countDataLines (unit)
use prec, only: pReal,pInt
implicit none
integer(pInt) IO_countDataLines,unit
integer(pInt), parameter :: maxNchunks = 64
integer(pInt), dimension(1+2*maxNchunks) :: pos
character(len=300) line,tmp
IO_countDataLines = 0
do
read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,33)
if (IO_lc(IO_stringValue(line,pos,2)) == 'to' ) then ! found range indicator
IO_countContinousIntValues = IO_countContinousIntValues+1+IO_intValue(line,pos,3)-IO_intValue(line,pos,1)
pos = IO_stringPos(line,maxNchunks)
tmp = IO_lc(IO_stringValue(line,pos,1))
if (tmp(1:1) == '*' ) then ! found keyword
exit
else
IO_countContinousIntValues = IO_countContinousIntValues+pos(1)-1
IO_countDataLines = IO_countDataLines + 1_pInt
endif
enddo
100 backspace(unit)
return
endfunction
!********************************************************************
! count items in consecutive lines
! Marc: ints concatenated by "c" as last char or range of values a "to" b
! Abaqus: triplet of start,stop,inc
!********************************************************************
function IO_countContinousIntValues (unit)
use cpfem_interface
use prec, only: pReal,pInt
implicit none
integer(pInt) unit,i,j,l,count
integer(pInt) IO_countContinousIntValues
integer(pInt), parameter :: maxNchunks = 64
integer(pInt), dimension(1+2*maxNchunks) :: pos
character(len=300) line
IO_countContinousIntValues = 0_pInt
select case (FEsolver)
case ('Marc')
do
read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,maxNchunks)
if (IO_lc(IO_stringValue(line,pos,2)) == 'to' ) then ! found range indicator
IO_countContinousIntValues = 1 + IO_intValue(line,pos,3) - IO_intValue(line,pos,1)
exit ! only one single range indicator allowed
else
IO_countContinousIntValues = IO_countContinousIntValues+pos(1)-1 ! add line's count when assuming 'c'
if ( IO_lc(IO_stringValue(line,pos,pos(1))) /= 'c' ) then ! line finished, read last value
IO_countContinousIntValues = IO_countContinousIntValues+1
exit
exit ! data ended
endif
endif
enddo
case('Abaqus')
count = IO_countDataLines(unit)
do l = 1,count
backspace(unit)
enddo
do l = 1,count
read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,maxNchunks)
IO_countContinousIntValues = IO_countContinousIntValues + 1 + & ! assuming range generation
(IO_intValue(line,pos,2)-IO_intValue(line,pos,1))/max(1,IO_intValue(line,pos,3))
enddo
endselect
100 return
endfunction
!*********************************************************************
! read consecutive lines of ints concatenated by "c" as last char
! or range of values a "to" b
!*********************************************************************
!********************************************************************
! return integer list corrsponding to items in consecutive lines
! Marc: ints concatenated by "c" as last char, range of a "to" b, or named set
! Abaqus: triplet of start,stop,inc or named set
!********************************************************************
function IO_continousIntValues (unit,maxN,lookupName,lookupMap,lookupMaxN)
use cpfem_interface
use prec, only: pReal,pInt
implicit none
integer(pInt) unit,maxN,i
integer(pInt) unit,maxN,i,j,l,count,first,last
integer(pInt), dimension(1+maxN) :: IO_continousIntValues
integer(pInt), dimension(67) :: pos ! allow for 32 values excl "c"
integer(pInt), parameter :: maxNchunks = 64
integer(pInt), dimension(1+2*maxNchunks) :: pos
character(len=64), dimension(:) :: lookupName
integer(pInt) :: lookupMaxN
integer(pInt), dimension(:,:) :: lookupMap
character(len=300) line
IO_continousIntValues = 0_pInt
IO_continousIntValues = 0
select case (FEsolver)
case ('Marc')
do
read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,33)
pos = IO_stringPos(line,maxNchunks)
if (verify(IO_stringValue(line,pos,1),"0123456789") > 0) then ! a non-int, i.e. set name
do i = 1,lookupMaxN ! loop over known set names
if (IO_stringValue(line,pos,1) == lookupName(i)) then ! found matching name
@ -767,13 +867,13 @@ endfunction
exit
else if (IO_lc(IO_stringValue(line,pos,2)) == 'to' ) then ! found range indicator
do i = IO_intValue(line,pos,1),IO_intValue(line,pos,3)
IO_continousIntValues(1) = IO_continousIntValues(1)+1
IO_continousIntValues(1) = IO_continousIntValues(1) + 1
IO_continousIntValues(1+IO_continousIntValues(1)) = i
enddo
exit
else
do i = 1,pos(1)-1 ! interpret up to second to last value
IO_continousIntValues(1) = IO_continousIntValues(1)+1
IO_continousIntValues(1) = IO_continousIntValues(1) + 1
IO_continousIntValues(1+IO_continousIntValues(1)) = IO_intValue(line,pos,i)
enddo
if ( IO_lc(IO_stringValue(line,pos,pos(1))) /= 'c' ) then ! line finished, read last value
@ -783,11 +883,44 @@ endfunction
endif
endif
enddo
case('Abaqus')
count = IO_countDataLines(unit)
do l = 1,count
backspace(unit)
enddo
do l = 1,count
read(unit,'(A300)',end=100) line
pos = IO_stringPos(line,maxNchunks)
if (verify(IO_stringValue(line,pos,1),"0123456789") > 0) then ! a non-int, i.e. set names follow on this line
do i = 1,pos(1) ! loop over set names in line
do j = 1,lookupMaxN ! look thru known set names
if (IO_stringValue(line,pos,i) == lookupName(j)) then ! found matching name
first = 2 + IO_continousIntValues(1) ! where to start appending data
last = first + lookupMap(1,j) - 1 ! up to where to append data
IO_continousIntValues(first:last) = lookupMap(2:1+lookupMap(1,j),j) ! add resp. entity list
IO_continousIntValues(1) = IO_continousIntValues(1) + lookupMap(1,j) ! count them
endif
enddo
enddo
else ! assuming range generation
do i = IO_intValue(line,pos,1),IO_intValue(line,pos,2),max(1,IO_intValue(line,pos,3))
IO_continousIntValues(1) = IO_continousIntValues(1) + 1
IO_continousIntValues(1+IO_continousIntValues(1)) = i
enddo
endif
enddo
endselect
100 return
endfunction
!********************************************************************
! write error statements to standard out
! and terminate the Marc run with exit #9xxx

View File

@ -175,7 +175,7 @@ subroutine homogenization_RGC_partitionDeformation(&
use prec, only: pReal,pInt,p_vec
use mesh, only: mesh_element,mesh_NcpElems,mesh_maxNips
use material, only: homogenization_maxNgrains,homogenization_Ngrains,homogenization_typeInstance
use FEsolving, only: theInc,theCycle,theTime
use FEsolving, only: theInc,cycleCounter,theTime
implicit none
@ -198,7 +198,7 @@ subroutine homogenization_RGC_partitionDeformation(&
!* Debugging the overall deformation gradient
if (RGCdebug) then
write(6,'(x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',theCycle,' =========='
write(6,'(x,a,i3,a,i3,a)')'========== Increment: ',theInc,' Cycle: ',cycleCounter,' =========='
write(6,'(x,a32)')'Overall deformation gradient: '
do i = 1,3
write(6,'(x,3(e14.8,x))')(avgF(i,j), j = 1,3)
@ -256,7 +256,7 @@ function homogenization_RGC_updateState(&
use mesh, only: mesh_element,mesh_NcpElems,mesh_maxNips
use material, only: homogenization_maxNgrains,homogenization_typeInstance,homogenization_Ngrains
use numerics, only: absTol_RGC,relTol_RGC,absMax_RGC,relMax_RGC,pPert_RGC
use FEsolving, only: theInc,theCycle,theTime
use FEsolving, only: theInc,cycleCounter,theTime
implicit none

File diff suppressed because it is too large Load Diff

270
code/mpie_cpfem_abaqus.f90 Normal file
View File

@ -0,0 +1,270 @@
!* $Id$
!********************************************************************
! Material subroutine for Abaqus
!
! written by P. Eisenlohr,
! F. Roters,
! K. Janssens
!
! MPI fuer Eisenforschung, Duesseldorf
! PSI, Switzerland
!********************************************************************
MODULE cpfem_interface
character(len=64), parameter :: FEsolver = 'Abaqus'
CONTAINS
subroutine mpie_cpfem_init ()
!$OMP CRITICAL (write2out)
write(6,*)
write(6,*) '<<<+- mpie_cpfem_abaqus init -+>>>'
write(6,*)
call flush(6)
!$OMP END CRITICAL (write2out)
return
end subroutine
END MODULE
include "prec.f90" ! uses nothing else
include "IO.f90" ! uses prec
include "numerics.f90" ! uses prec, IO
include "math.f90" ! uses prec, numerics
include "debug.f90" ! uses prec, numerics
include "FEsolving.f90" ! uses prec, IO
include "mesh.f90" ! uses prec, math, IO, FEsolving
include "material.f90" ! uses prec, math, IO, mesh
include "lattice.f90" ! uses prec, math, IO, material
include "constitutive_phenopowerlaw.f90" ! uses prec, math, IO, latt ice, material, debug
include "constitutive_j2.f90" ! uses prec, math, IO, latt ice, material, debug
include "constitutive_dislobased.f90" ! uses prec, math, IO, latt ice, material, debug
include "constitutive_nonlocal.f90" ! uses prec, math, IO, latt ice, material, debug
include "constitutive.f90" ! uses prec, IO, math, lattice, mesh, debug
include "crystallite.f90" ! uses prec, math, IO, numerics
include "homogenization_isostrain.f90" ! uses prec, math, IO,
include "homogenization_RGC.f90" ! uses prec, math, IO, numerics, mesh: added <<<updated 31.07.2009>>>
include "homogenization.f90" ! uses prec, math, IO, numerics
include "CPFEM.f90" ! uses prec, math, IO, numerics, debug, FEsolving, mesh, lattice, constitutive, crystallite
subroutine UMAT(STRESS,STATEV,DDSDDE,SSE,SPD,SCD,&
RPL,DDSDDT,DRPLDE,DRPLDT,STRAN,DSTRAN,&
TIME,DTIME,TEMP,DTEMP,PREDEF,DPRED,CMNAME,NDI,NSHR,NTENS,&
NSTATV,PROPS,NPROPS,COORDS,DROT,PNEWDT,CELENT,&
DFGRD0,DFGRD1,NOEL,NPT,KSLAY,KSPT,KSTEP,KINC)
use prec, only: pReal, &
pInt
use FEsolving, only: cycleCounter, &
theInc, &
cutBack, &
calcMode, &
lastMode, &
theTime, &
theDelta, &
lastIncConverged, &
outdatedByNewInc, &
outdatedFFN1, &
terminallyIll, &
symmetricSolver
use math, only: invnrmMandel
use debug, only: debug_info, &
debug_reset
use mesh, only: mesh_FEasCP
use CPFEM, only: CPFEM_general,CPFEM_init_done
use homogenization, only: materialpoint_sizeResults, materialpoint_results
implicit none
CHARACTER*80 CMNAME
integer(pInt) ndi, nshr, ntens, nstatv, nprops, noel, npt,&
kslay, kspt, kstep, kinc
real(pReal) STRESS(NTENS),STATEV(NSTATV),&
DDSDDE(NTENS,NTENS),DDSDDT(NTENS),DRPLDE(NTENS),&
STRAN(NTENS),DSTRAN(NTENS),TIME(2),PREDEF(1),DPRED(1),&
PROPS(NPROPS),COORDS(3),DROT(3,3),&
DFGRD0(3,3),DFGRD1(3,3)
real(pReal) SSE, SPD, SCD, RPL, DRPLDT, DTIME, TEMP,&
DTEMP, PNEWDT, CELENT
! local variables
real(pReal), dimension(6) :: stress_h
real(pReal), dimension(6,6) :: ddsdde_h
integer(pInt) computationMode, i, cp_en
if (noel == 1 .and. npt == 1) then
!$OMP CRITICAL (write2out)
write(6,*) 'el',noel,'ip',npt
write(6,*) 'got kinc as',kinc
write(6,*) 'got dStran',dstran
call flush(6)
!$OMP END CRITICAL (write2out)
endif
if ( .not. CPFEM_init_done ) then
computationMode = 2 ! calc + init
!$OMP CRITICAL (write2out)
write(6,'(i6,x,i2,x,a)') noel,npt,'first call special case..!'; call flush(6)
!$OMP END CRITICAL (write2out)
else
cp_en = mesh_FEasCP('elem',noel)
if (theTime < time(2) .or. theInc /= kinc) then ! reached convergence
lastIncConverged = .true.
outdatedByNewInc = .true.
terminallyIll = .false.
cycleCounter = 0
!$OMP CRITICAL (write2out)
write (6,'(i6,x,i2,x,a)') noel,npt,'lastIncConverged + outdated'; call flush(6)
!$OMP END CRITICAL (write2out)
endif
if ( dtime < theDelta ) then ! cutBack
calcMode = .true. ! pretend last step was calculation
cutBack = .true.
terminallyIll = .false.
cycleCounter = 0
!$OMP CRITICAL (write2out)
write(6,'(i6,x,i2,x,a)') noel,npt,'cutback detected..!'; call flush(6)
!$OMP END CRITICAL (write2out)
endif
calcMode(npt,cp_en) = .not. calcMode(npt,cp_en) ! ping pong (calc <--> collect)
if ( calcMode(npt,cp_en) ) then ! now calc
if ( lastMode .ne. calcMode(npt,cp_en) ) then ! first after ping pong
call debug_reset() ! resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1
endif
if ( outdatedByNewInc ) then
outdatedByNewInc = .false.
computationMode = 1 ! calc and age results
else
computationMode = 2 ! plain calc
endif
else ! now collect
if ( lastMode .ne. calcMode(npt,cp_en) ) call debug_info() ! first after ping pong reports debugging
if ( lastIncConverged ) then
lastIncConverged = .false.
computationMode = 4 ! collect and backup Jacobian after convergence
elseif ( cutBack ) then
cutBack = .false.
computationMode = 5 ! collect and restore Jacobian after cutback
else
computationMode = 3 ! plain collect
endif
endif
endif
theTime = time(2) ! record current starting time
theDelta = dtime ! record current time increment
theInc = kinc ! record current increment number
if (CPFEM_init_done) lastMode = calcMode(npt,cp_en) ! record calculationMode
!$OMP CRITICAL (write2out)
write(6,'(a16,x,i2,x,a,i5,a,i5,x,i5,a)') 'computationMode',computationMode,'(',cp_en,':',noel,npt,')'; call flush(6)
!$OMP END CRITICAL (write2out)
call CPFEM_general(computationMode,dfgrd0,dfgrd1,temp,dtime,noel,npt,stress,ddsdde,ntens)
! Mandel: 11, 22, 33, SQRT(2)*12, SQRT(2)*23, SQRT(2)*13
! straight: 11, 22, 33, 12, 23, 13
forall(i=1:ntens) ddsdde(1:ntens,i) = invnrmMandel(i)*ddsdde(1:ntens,i)*invnrmMandel(1:ntens)
stress(1:ntens) = stress(1:ntens)*invnrmMandel(1:ntens)
if(symmetricSolver) ddsdde(1:ntens,1:ntens) = 0.5_pReal*(ddsdde(1:ntens,1:ntens) + transpose(ddsdde(1:ntens,1:ntens)))
! ABAQUS: 11, 22, 33, 12, 13, 23
if(ntens == 6) then
stress_h=stress
stress(5)=stress_h(6)
stress(6)=stress_h(5)
ddsdde_h=ddsdde
ddsdde(:,5)=ddsdde_h(:,6)
ddsdde(:,6)=ddsdde_h(:,5)
ddsdde_h=ddsdde
ddsdde(5,:)=ddsdde_h(6,:)
ddsdde(6,:)=ddsdde_h(5,:)
end if
statev = materialpoint_results(1:min(nstatv,materialpoint_sizeResults),npt,mesh_FEasCP('elem', noel))
if ( terminallyIll ) pnewdt = 0.5_pReal ! force cutback directly ?
return
end subroutine
!********************************************************************
! This subroutine replaces the corresponding Marc subroutine
!********************************************************************
subroutine quit(mpie_error)
use prec, only: pReal, &
pInt
implicit none
integer(pInt) mpie_error
call xit
end subroutine
!############################################################################
!
! include "KJ_Disp.f"
subroutine disp(u,kstep,kinc,time,node,noel,jdof,coords)
! hardwired aba_param.inc
implicit real*8(a-h,o-z)
parameter (nprecd=2)
!
dimension u(3),time(2), coords(3)
real ktime,ktcl,ktmax,ktmin,ktdeltaup,ktdeltadown
real klmin,klmax,kldelta,klbegincycle
real kdeltau, kru, kret
! When using stdb_abqerr for debugging
! dimension intv(2),realv(4)
! character*8 charv(1)
! ratchet displacement per cycle
kru = 0.1
! ratcheting ends at time kret
kret = 400.
! displacement amplitude
kdeltau = 0.5
! time cycle length:
ktcl = 4.
ktmax = ktcl/4
ktmin = 3.*ktmax
ktdeltadown = ktmin - ktmax
ktdeltaup = ktcl - ktdeltadown
! load minimum & maximum:
klmin = -kdeltau
klmax = kdeltau
kldelta = klmax - klmin
klbegincycle = klmin + kldelta * (ktcl-ktmin) / ktdeltaup
! load as a function of (total time); trianglar loading cycle
ktime = time(2)
kru = kru * MIN(kret, ktime) / ktcl
if ( ktime .lt. ktmax ) then
! special case for path to first maximum
u(1) = kru + (ktime/ktmax) * klmax
else
do while ( ktime .ge. ktcl )
ktime = ktime - ktcl
end do
if ( ktime .le. ktmax ) then
u(1) = kru + klbegincycle + ktime * (klmax-klbegincycle) / ktmax
else if ( ktime .lt. ktmin ) then
u(1) = kru + klmax - (ktime-ktmax) * kldelta / (ktmin-ktmax)
else
u(1) = kru + klmin + (ktime-ktmin) * (klbegincycle-klmin)/(ktcl-ktmin)
end if
endif
return
end
!

View File

@ -38,6 +38,8 @@
!
MODULE cpfem_interface
character(len=64), parameter :: FEsolver = 'Marc'
CONTAINS
subroutine mpie_cpfem_init
@ -61,7 +63,7 @@ END MODULE
include "lattice.f90" ! uses prec, math, IO, material
include "constitutive_phenopowerlaw.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_j2.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_dislotwin.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_dislobased.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive_nonlocal.f90" ! uses prec, math, IO, lattice, material, debug
include "constitutive.f90" ! uses prec, IO, math, lattice, mesh, debug
include "crystallite.f90" ! uses prec, math, IO, numerics
@ -148,18 +150,22 @@ subroutine hypela2(&
pInt
use FEsolving, only: cycleCounter, &
theInc, &
theCycle, &
theLovl, &
cutBack, &
calcMode, &
lastMode, &
theTime, &
theDelta, &
lastIncConverged, &
outdatedByNewInc, &
outdatedFFN1, &
terminallyIll, &
symmetricSolver
use CPFEM, only: CPFEM_general
use math, only: invnrmMandel
use debug, only: debug_info, &
debug_reset
use mesh, only: mesh_FEasCP
use CPFEM, only: CPFEM_general,CPFEM_init_done
use homogenization, only: materialpoint_sizeResults, materialpoint_results
implicit none
! ** Start of generated type statements **
@ -179,47 +185,74 @@ subroutine hypela2(&
include "concom%%MARCVERSION%%" ! concom is needed for inc, subinc, ncycle, lovl
include "creeps%%MARCVERSION%%" ! creeps is needed for timinc (time increment)
integer(pInt) computationMode, i
integer(pInt) computationMode, i, cp_en
if (inc == 0) then
cycleCounter = 4
if ( .not. CPFEM_init_done ) then
computationMode = 2 ! calc + init
!$OMP CRITICAL (write2out)
write (6,'(i6,x,i2,x,a)') n(1),nn,'first call special case..!'; call flush(6)
!$OMP END CRITICAL (write2out)
else if (lovl == 4) then ! Marc requires stiffness in separate call
computationMode = 6 ! --> just return known value
else
if (theCycle > ncycle .or. theInc /= inc) then
cycleCounter = 0 ! reset counter for each cutback or new inc
terminallyIll = .false.
endif
if (theCycle /= ncycle .or. theLovl /= lovl) then
cycleCounter = cycleCounter+1 ! ping pong
outdatedFFN1 = .false.
write (6,*) n(1),nn,'cycleCounter',cycleCounter
call debug_info() ! output of debugging/performance statistics of former
call debug_reset()
endif
endif
if (cptim > theTime .or. theInc /= inc) then ! reached convergence
cp_en = mesh_FEasCP('elem',n(1))
if (theTime < cptim .or. theInc /= inc) then ! reached convergence
lastIncConverged = .true.
outdatedByNewInc = .true.
write (6,*) n(1),nn,'lastIncConverged + outdated'
terminallyIll = .false.
cycleCounter = 0
!$OMP CRITICAL (write2out)
write (6,'(i6,x,i2,x,a)') n(1),nn,'lastIncConverged + outdated'; call flush(6)
!$OMP END CRITICAL (write2out)
endif
if (mod(cycleCounter,2) /= 0) computationMode = 4 ! recycle in odd cycles
if (mod(cycleCounter,4) == 2) computationMode = 3 ! collect in 2,6,10,...
if (mod(cycleCounter,4) == 0) computationMode = 2 ! compute in 0,4,8,...
if (computationMode == 4 .and. ncycle == 0 .and. .not. lastIncConverged) &
computationMode = 6 ! recycle but restore known good consistent tangent
if (computationMode == 4 .and. lastIncConverged) then
computationMode = 5 ! recycle and record former consistent tangent
lastIncConverged = .false.
if ( timinc < theDelta ) then ! cutBack
calcMode = .true. ! pretend last step was calculation
cutBack = .true.
terminallyIll = .false.
cycleCounter = 0
!$OMP CRITICAL (write2out)
write(6,'(i6,x,i2,x,a)') n(1),nn,'cutback detected..!'; call flush(6)
!$OMP END CRITICAL (write2out)
endif
if (computationMode == 2 .and. outdatedByNewInc) then
computationMode = 1 ! compute and age former results
calcMode(nn,cp_en) = .not. calcMode(nn,cp_en) ! ping pong (calc <--> collect)
if ( calcMode(nn,cp_en) ) then ! now calc
if ( lastMode .ne. calcMode(nn,cp_en) ) then ! first after ping pong
call debug_reset() ! resets debugging
outdatedFFN1 = .false.
cycleCounter = cycleCounter + 1
endif
if ( outdatedByNewInc ) then
outdatedByNewInc = .false.
computationMode = 1 ! calc and age results
else
computationMode = 2 ! plain calc
endif
else ! now collect
if ( lastMode .ne. calcMode(nn,cp_en) ) call debug_info() ! first after ping pong reports debugging
if ( lastIncConverged ) then
lastIncConverged = .false.
computationMode = 4 ! collect and backup Jacobian after convergence
elseif ( cutBack ) then
cutBack = .false.
computationMode = 5 ! collect and restore Jacobian after cutback
else
computationMode = 3 ! plain collect
endif
endif
endif
if (lovl /= 4) then ! pass-by for Marc recycle
theTime = cptim ! record current starting time
theDelta = timinc ! record current time increment
theInc = inc ! record current increment number
theCycle = ncycle ! record current cycle count
theLovl = lovl ! record current lovl
if (CPFEM_init_done) lastMode = calcMode(nn,cp_en) ! record calculationMode
endif
call CPFEM_general(computationMode,ffn,ffn1,t(1),timinc,n(1),nn,s,d,ngens)
@ -269,55 +302,3 @@ subroutine plotv(&
return
end subroutine
! subroutine utimestep(timestep,timestepold,icall,time,timeloadcase)
!********************************************************************
! This routine modifies the addaptive time step of Marc
!********************************************************************
! use prec, only: pReal,pInt
! use CPFEM, only : CPFEM_timefactor_max
! implicit none
!
! real(pReal) timestep, timestepold, time,timeloadcase
! integer(pInt) icall
!
! user subroutine for modifying the time step in auto step
!
! timestep : the current time step as suggested by marc
! to be modified in this routine
! timestepold : the current time step before it was modified by marc
! icall : =1 for setting the initial time step
! =2 if this routine is called during an increment
! =3 if this routine is called at the beginning
! of the increment
! time : time at the start of the current increment
! timeloadcase: time period of the current load case
!
! it is in general not recommended to increase the time step
! during the increment.
! this routine is called right after the time step has (possibly)
! been updated by marc.
!
! user coding
! reduce timestep during increment in case mpie_timefactor is too large
! if(icall==2_pInt) then
! if(mpie_timefactor_max>1.25_pReal) then
! timestep=min(timestep,timestepold*0.8_pReal)
! end if
! return
! modify timestep at beginning of new increment
! else if(icall==3_pInt) then
! if(mpie_timefactor_max<=0.8_pReal) then
! timestep=min(timestep,timestepold*1.25_pReal)
! else if (mpie_timefactor_max<=1.0_pReal) then
! timestep=min(timestep,timestepold/mpie_timefactor_max)
! else if (mpie_timefactor_max<=1.25_pReal) then
! timestep=min(timestep,timestepold*1.01_pReal)
! else
! timestep=min(timestep,timestepold*0.8_pReal)
! end if
! end if
! return
! end