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

try to directly allocate pointers

This commit is contained in:
Martin Diehl 2019-05-12 09:47:21 +02:00
parent 7f0008c4a3
commit 8286a289df
1 changed files with 28 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
src/mesh/FEM_mech.f90
View File

@ -84,11 +84,9 @@ subroutine FEM_mech_init(fieldBC)
PetscDS :: mechDS PetscDS :: mechDS
PetscDualSpace :: mechDualSpace PetscDualSpace :: mechDualSpace
DMLabel :: BCLabel DMLabel :: BCLabel
PetscInt, dimension(:), allocatable, target :: numComp, numDoF, bcField
PetscInt, dimension(:), pointer :: pNumComp, pNumDof, pBcField, pBcPoint PetscInt, dimension(:), pointer :: pNumComp, pNumDof, pBcField, pBcPoint
PetscInt :: numBC, bcSize, nc PetscInt :: numBC, bcSize, nc
IS :: bcPoint IS :: bcPoint
IS, allocatable, target :: bcComps(:), bcPoints(:)
IS, pointer :: pBcComps(:), pBcPoints(:) IS, pointer :: pBcComps(:), pBcPoints(:)
PetscSection :: section PetscSection :: section
PetscInt :: field, faceSet, topologDim, nNodalPoints PetscInt :: field, faceSet, topologDim, nNodalPoints
@ -98,7 +96,7 @@ subroutine FEM_mech_init(fieldBC)
PetscScalar, pointer :: px_scal(:) PetscScalar, pointer :: px_scal(:)
PetscScalar, allocatable, target :: x_scal(:) PetscScalar, allocatable, target :: x_scal(:)
PetscReal :: detJ PetscReal :: detJ
PetscReal, allocatable, target :: v0(:), cellJ(:), invcellJ(:), cellJMat(:,:) PetscReal, allocatable, target :: cellJMat(:,:)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:) PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscInt :: cellStart, cellEnd, cell, basis PetscInt :: cellStart, cellEnd, cell, basis
character(len=7) :: prefix = 'mechFE_' character(len=7) :: prefix = 'mechFE_'
@ -139,26 +137,26 @@ subroutine FEM_mech_init(fieldBC)
call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr) call DMGetLabel(mech_mesh,'Face Sets',BCLabel,ierr); CHKERRQ(ierr)
call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr) call DMPlexLabelComplete(mech_mesh,BCLabel,ierr); CHKERRQ(ierr)
call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr) call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
allocate(numComp(1), source=dimPlex); pNumComp => numComp allocate(pnumComp(1), source=dimPlex)
allocate(numDof(dimPlex+1), source = 0); pNumDof => numDof allocate(pnumDof(dimPlex+1), source = 0)
do topologDim = 0, dimPlex do topologDim = 0, dimPlex
call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr) call DMPlexGetDepthStratum(mech_mesh,topologDim,cellStart,cellEnd,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call PetscSectionGetDof(section,cellStart,numDof(topologDim+1),ierr) call PetscSectionGetDof(section,cellStart,pnumDof(topologDim+1),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
enddo enddo
numBC = 0 numBC = 0
do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries
if (fieldBC%componentBC(field)%Mask(faceSet)) numBC = numBC + 1 if (fieldBC%componentBC(field)%Mask(faceSet)) numBC = numBC + 1
enddo; enddo enddo; enddo
allocate(bcField(numBC), source=0); pBcField => bcField allocate(pbcField(numBC), source=0)
allocate(bcComps(numBC)); pBcComps => bcComps allocate(pbcComps(numBC))
allocate(bcPoints(numBC)); pBcPoints => bcPoints allocate(pbcPoints(numBC))
numBC = 0 numBC = 0
do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries do field = 1, dimPlex; do faceSet = 1, mesh_Nboundaries
if (fieldBC%componentBC(field)%Mask(faceSet)) then if (fieldBC%componentBC(field)%Mask(faceSet)) then
numBC = numBC + 1 numBC = numBC + 1
call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,bcComps(numBC),ierr) call ISCreateGeneral(PETSC_COMM_WORLD,1,[field-1],PETSC_COPY_VALUES,pbcComps(numBC),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr) call DMGetStratumSize(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcSize,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
@ -166,12 +164,12 @@ subroutine FEM_mech_init(fieldBC)
call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr) call DMGetStratumIS(mech_mesh,'Face Sets',mesh_boundaries(faceSet),bcPoint,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) call ISGetIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr)
call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,bcPoints(numBC),ierr) call ISCreateGeneral(PETSC_COMM_WORLD,bcSize,pBcPoint,PETSC_COPY_VALUES,pbcPoints(numBC),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr) call ISRestoreIndicesF90(bcPoint,pBcPoint,ierr); CHKERRQ(ierr)
call ISDestroy(bcPoint,ierr); CHKERRQ(ierr) call ISDestroy(bcPoint,ierr); CHKERRQ(ierr)
else else
call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,bcPoints(numBC),ierr) call ISCreateGeneral(PETSC_COMM_WORLD,0,[0],PETSC_COPY_VALUES,pbcPoints(numBC),ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
endif endif
endif endif
@ -182,7 +180,7 @@ subroutine FEM_mech_init(fieldBC)
CHKERRQ(ierr) CHKERRQ(ierr)
call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr) call DMSetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
do faceSet = 1, numBC do faceSet = 1, numBC
call ISDestroy(bcPoints(faceSet),ierr); CHKERRQ(ierr) call ISDestroy(pbcPoints(faceSet),ierr); CHKERRQ(ierr)
enddo enddo
!-------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------
@ -213,13 +211,10 @@ subroutine FEM_mech_init(fieldBC)
allocate(nodalWeights(1)) allocate(nodalWeights(1))
nodalPointsP => nodalPoints nodalPointsP => nodalPoints
nodalWeightsP => nodalWeights nodalWeightsP => nodalWeights
allocate(v0(dimPlex)) allocate(pv0(dimPlex))
allocate(cellJ(dimPlex*dimPlex)) allocate(pcellJ(dimPlex*dimPlex))
allocate(invcellJ(dimPlex*dimPlex)) allocate(pinvcellJ(dimPlex*dimPlex))
allocate(cellJMat(dimPlex,dimPlex)) allocate(cellJMat(dimPlex,dimPlex))
pV0 => v0
pCellJ => cellJ
pInvcellJ => invcellJ
call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr) call DMGetSection(mech_mesh,section,ierr); CHKERRQ(ierr)
call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr) call DMGetDS(mech_mesh,mechDS,ierr); CHKERRQ(ierr)
call PetscDSGetDiscretization(mechDS,0,mechFE,ierr) call PetscDSGetDiscretization(mechDS,0,mechFE,ierr)
@ -325,22 +320,19 @@ subroutine FEM_mech_formResidual(dm_local,xx_local,f_local,dummy,ierr)
PetscScalar, dimension(:), pointer :: x_scal, pf_scal PetscScalar, dimension(:), pointer :: x_scal, pf_scal
PetscScalar, target :: f_scal(cellDof) PetscScalar, target :: f_scal(cellDof)
PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) PetscReal :: detJ, IcellJMat(dimPlex,dimPlex)
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), & PetscReal, pointer,dimension(:) :: pV0, pCellJ, pInvcellJ, basisField, basisFieldDer
invcellJ(dimPlex*dimPlex)
PetscReal, pointer :: pV0(:), pCellJ(:), pInvcellJ(:)
PetscReal, pointer :: basisField(:), basisFieldDer(:)
PetscInt :: cellStart, cellEnd, cell, field, face, & PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx qPt, basis, comp, cidx
PetscReal :: detFAvg PetscReal :: detFAvg
PetscReal :: BMat(dimPlex*dimPlex,cellDof) PetscReal :: BMat(dimPlex*dimPlex,cellDof)
PetscObject :: dummy PetscObject,intent(in) :: dummy
PetscInt :: bcSize PetscInt :: bcSize
IS :: bcPoints IS :: bcPoints
PetscErrorCode :: ierr PetscErrorCode :: ierr
pV0 => v0 allocate(pV0(dimPlex))
pCellJ => cellJ allocate(pcellJ(dimPlex**2))
pInvcellJ => invcellJ allocate(pinvcellJ(dimPlex**2))
call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr) call DMGetSection(dm_local,section,ierr); CHKERRQ(ierr)
call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr) call DMGetDS(dm_local,prob,ierr); CHKERRQ(ierr)
call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr) call PetscDSGetTabulation(prob,0,basisField,basisFieldDer,ierr)
@ -460,13 +452,11 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
Vec :: x_local, xx_local Vec :: x_local, xx_local
Mat :: Jac_pre, Jac Mat :: Jac_pre, Jac
PetscSection :: section, gSection PetscSection :: section, gSection
PetscReal :: detJ, IcellJMat(dimPlex,dimPlex) PetscReal :: detJ
PetscReal, target :: v0(dimPlex), cellJ(dimPlex*dimPlex), &
invcellJ(dimPlex*dimPlex)
PetscReal, dimension(:), pointer :: basisField, basisFieldDer, & PetscReal, dimension(:), pointer :: basisField, basisFieldDer, &
pV0, pCellJ, pInvcellJ pV0, pCellJ, pInvcellJ
PetscInt :: cellStart, cellEnd, cell, field, face, & PetscInt :: cellStart, cellEnd, cell, field, face, &
qPt, basis, comp, cidx qPt, basis, comp, cidx,bcSize
PetscScalar,dimension(cellDOF,cellDOF), target :: K_e, & PetscScalar,dimension(cellDOF,cellDOF), target :: K_e, &
K_eA , & K_eA , &
K_eB K_eB
@ -477,14 +467,14 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
MatB (1 ,cellDof) MatB (1 ,cellDof)
PetscScalar, dimension(:), pointer :: pK_e, x_scal PetscScalar, dimension(:), pointer :: pK_e, x_scal
PetscReal, dimension(3,3) :: F, FAvg, FInv PetscReal, dimension(3,3) :: F, FAvg, FInv
PetscObject :: dummy PetscObject, intent(in) :: dummy
PetscInt :: bcSize
IS :: bcPoints IS :: bcPoints
PetscErrorCode :: ierr PetscErrorCode :: ierr
pV0 => v0 allocate(pV0(dimPlex))
pCellJ => cellJ allocate(pcellJ(dimPlex**2))
pInvcellJ => invcellJ allocate(pinvcellJ(dimPlex**2))
call MatSetOption(Jac,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE,ierr); CHKERRQ(ierr) call MatSetOption(Jac,MAT_KEEP_NONZERO_PATTERN,PETSC_TRUE,ierr); CHKERRQ(ierr)
call MatSetOption(Jac,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE,ierr); CHKERRQ(ierr) call MatSetOption(Jac,MAT_NEW_NONZERO_ALLOCATION_ERR,PETSC_FALSE,ierr); CHKERRQ(ierr)
call MatZeroEntries(Jac,ierr); CHKERRQ(ierr) call MatZeroEntries(Jac,ierr); CHKERRQ(ierr)
@ -513,7 +503,6 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr) call DMPlexComputeCellGeometryAffineFEM(dm_local,cell,pV0,pCellJ,pInvcellJ,detJ,ierr)
CHKERRQ(ierr) CHKERRQ(ierr)
IcellJMat = reshape(pInvcellJ, shape = [dimPlex,dimPlex])
K_eA = 0.0 K_eA = 0.0
K_eB = 0.0 K_eB = 0.0
MatB = 0.0 MatB = 0.0
@ -525,7 +514,8 @@ subroutine FEM_mech_formJacobian(dm_local,xx_local,Jac_pre,Jac,dummy,ierr)
do comp = 0, dimPlex-1 do comp = 0, dimPlex-1
cidx = basis*dimPlex+comp cidx = basis*dimPlex+comp
BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = & BMat(comp*dimPlex+1:(comp+1)*dimPlex,basis*dimPlex+comp+1) = &
matmul(IcellJMat,basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: & matmul( reshape(pInvcellJ, shape = [dimPlex,dimPlex]),&
basisFieldDer((((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp )*dimPlex+1: &
(((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex)) (((qPt*nBasis + basis)*dimPlex + comp)*dimPlex+comp+1)*dimPlex))
enddo enddo
enddo enddo