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

commenting and discussing with Franz

This commit is contained in:
Martin Diehl 2019-06-12 19:08:38 +02:00
parent ecda57e29a
commit ac493adc5c
1 changed files with 113 additions and 106 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
src/mesh_marc.f90
View File

@ -872,25 +872,27 @@ subroutine calcCells(thisMesh,elem,connectivity_elem)
class(tMesh) :: thisMesh class(tMesh) :: thisMesh
type(tElement) :: elem type(tElement) :: elem
integer(pInt),dimension(:,:), intent(in) :: connectivity_elem integer,dimension(:,:), intent(in) :: connectivity_elem
integer(pInt),dimension(:,:), allocatable :: con_elem,temp,con,parentsAndWeights,candidates_global integer,dimension(:,:), allocatable :: con_elem,temp,con,parentsAndWeights,candidates_global
integer(pInt),dimension(:), allocatable :: l, nodes, candidates_local integer,dimension(:), allocatable :: l, nodes, candidates_local
integer(pInt),dimension(:,:,:), allocatable :: con_cell,connectivity_cell integer,dimension(:,:,:), allocatable :: con_cell,connectivity_cell
integer(pInt),dimension(:,:), allocatable :: sorted,test,connectivity_cell_reshape integer,dimension(:,:), allocatable :: sorted,test,connectivity_cell_reshape
real(pReal), dimension(:,:), allocatable :: coordinates,nodes5 real(pReal), dimension(:,:), allocatable :: coordinates,nodes5
integer(pInt) :: e, n, c, p, s,u,i,m,j,nParentNodes,nCellNode,ierr integer :: e, n, c, p, s,u,i,m,j,nParentNodes,nCellNode,ierr,Nelem,candidateID
Nelem = thisMesh%Nelems
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
! initialize global connectivity to negative local connectivity ! initialize global connectivity to negative local connectivity
allocate(connectivity_cell(thisMesh%elem%NcellNodesPerCell,thisMesh%elem%nIPs,thisMesh%Nelems)) allocate(connectivity_cell(elem%NcellNodesPerCell,elem%nIPs,Nelem))
connectivity_cell = -spread(thisMesh%elem%cell,3,thisMesh%Nelems) ! local cell node ID connectivity_cell = -spread(elem%cell,3,Nelem) ! local cell node ID
!--------------------------------------------------------------------------------------------------- !---------------------------------------------------------------------------------------------------
! set connectivity of cell nodes that conincide with FE nodes (defined by 1 parent node) ! set connectivity of cell nodes that coincide with FE nodes (defined by 1 parent node)
! change to global node ID ! and renumber local (negative) to global (positive) node ID
do e = 1, thisMesh%Nelems do e = 1, Nelem
do c = 1, thisMesh%elem%NcellNodes do c = 1, elem%NcellNodes
realNode: if (count(thisMesh%elem%cellNodeParentNodeWeights(:,c) /= 0_pInt) == 1_pInt) then realNode: if (count(elem%cellNodeParentNodeWeights(:,c) /= 0) == 1) then
where(connectivity_cell(:,:,e) == -c) where(connectivity_cell(:,:,e) == -c)
connectivity_cell(:,:,e) = connectivity_elem(c,e) connectivity_cell(:,:,e) = connectivity_elem(c,e)
end where end where
@ -900,48 +902,54 @@ subroutine calcCells(thisMesh,elem,connectivity_elem)
nCellNode = thisMesh%nNodes nCellNode = thisMesh%nNodes
do nParentNodes = 2, thisMesh%elem%nNodes !---------------------------------------------------------------------------------------------------
! set connectivity of cell nodes that are defined by 2,...,nNodes real nodes
do nParentNodes = 2, elem%nNodes
! get IDs of local cell nodes that are defined by the current number of parent nodes ! get IDs of local cell nodes that are defined by the current number of parent nodes
candidates_local = [integer(pInt)::] candidates_local = [integer::]
do c = 1, thisMesh%elem%NcellNodes do c = 1, elem%NcellNodes
if (count(thisMesh%elem%cellNodeParentNodeWeights(:,c) /= 0_pInt) == nParentNodes) & if (count(elem%cellNodeParentNodeWeights(:,c) /= 0) == nParentNodes) &
candidates_local = [candidates_local,c] candidates_local = [candidates_local,c]
enddo enddo
s = size(candidates_local) s = size(candidates_local)
if (allocated(candidates_global)) deallocate(candidates_global) if (allocated(candidates_global)) deallocate(candidates_global)
allocate(candidates_global(nParentNodes*2_pInt+2_pInt,s*thisMesh%Nelems)) allocate(candidates_global(nParentNodes*2+2,s*Nelem)) ! stores parent node ID + weight together with element ID and cellnode id (local)
parentsAndWeights = reshape([(0, i = 1,2*nParentNodes)],[nParentNodes,2]) ! allocate without deallocate
parentsAndWeights = reshape([(0_pInt, i = 1_pInt,2_pInt*nParentNodes)],[nParentNodes,2]) do e = 1, Nelem
do e = 1_pInt, thisMesh%Nelems do i = 1, size(candidates_local)
do i = 1_pInt, s candidateID = (e-1)*size(candidates_local)+i ! including duplicates (Nelem*size(candidates_local))
c = candidates_local(i) c = candidates_local(i) ! c is local cellnode ID for connectivity
m = 0_pInt p = 0
do p = 1_pInt, size(thisMesh%elem%cellNodeParentNodeWeights(:,c)) do j = 1, size(elem%cellNodeParentNodeWeights(:,c))
if (thisMesh%elem%cellNodeParentNodeWeights(p,c) /= 0_pInt) then ! real node 'c' partly defines cell node 'n' if (elem%cellNodeParentNodeWeights(j,c) /= 0) then ! real node 'j' partly defines cell node 'c'
m = m + 1_pInt p = p + 1
parentsAndWeights(m,1:2) = [connectivity_elem(p,e),thisMesh%elem%cellNodeParentNodeWeights(p,c)] parentsAndWeights(p,1:2) = [connectivity_elem(j,e),elem%cellNodeParentNodeWeights(j,c)]
endif endif
enddo enddo
! store (and order) real nodes and their weights together with the element number and local ID ! store (and order) real node IDs and their weights together with the element number and local ID
do p = 1_pInt, nParentNodes do p = 1, nParentNodes
m = maxloc(parentsAndWeights(:,1),1) m = maxloc(parentsAndWeights(:,1),1)
candidates_global(p, (e-1)*s+i) = parentsAndWeights(m,1)
parentsAndWeights(m,1) = -huge(i) ! out of the competition candidates_global(p, candidateID) = parentsAndWeights(m,1)
candidates_global(p+nParentNodes,(e-1)*s+i) = parentsAndWeights(m,2) candidates_global(p+nParentNodes, candidateID) = parentsAndWeights(m,2)
candidates_global(nParentNodes*2+1:nParentNodes*2+2,(e-1)*s+i) = [e,c] candidates_global(nParentNodes*2+1:nParentNodes*2+2,candidateID) = [e,c]
parentsAndWeights(m,1) = -huge(parentsAndWeights(m,1)) ! out of the competition
enddo enddo
enddo enddo
enddo enddo
! sort according to real node IDs (from left to right) ! sort according to real node IDs + weight (from left to right)
call math_sort(candidates_global,sortDim=1) call math_sort(candidates_global,sortDim=1) ! sort according to first column
do p = 2, nParentNodes-1 ! why -1?
do p = 2, nParentNodes*2
n = 1 n = 1
do while(n <= s*thisMesh%Nelems) do while(n <= size(candidates_local)*Nelem)
j=0 j=0
do while (n+j<= s*thisMesh%Nelems) do while (n+j<= size(candidates_local)*Nelem)
if (candidates_global(p-1,n+j)/=candidates_global(p-1,n)) exit if (candidates_global(p-1,n+j)/=candidates_global(p-1,n)) exit
j = j + 1 j = j + 1
enddo enddo
@ -953,42 +961,41 @@ subroutine calcCells(thisMesh,elem,connectivity_elem)
enddo enddo
! find duplicates (trivial for sorted IDs) ! count unique cell nodes (trivial for sorted IDs + weights)
i = 0 i = 0 ! counts unique cell nodes (defined by current number of parents)
n = 1 n = 1
do while(n <= s*thisMesh%Nelems) do while(n <= size(candidates_local)*Nelem)
j=0 j=0
do while (n+j<= s*thisMesh%Nelems) do while (n+j<= size(candidates_local)*Nelem)
if (any(candidates_global(1:2*nParentNodes,n+j)/=candidates_global(1:2*nParentNodes,n))) exit if (any(candidates_global(1:2*nParentNodes,n+j)/=candidates_global(1:2*nParentNodes,n))) exit
j = j + 1 j = j + 1
enddo enddo
i=i+1 i = i+1
n = n+j n = n+j
enddo enddo
p = i ! ToDo: Hack
! calculate coordinates of cell nodes and insert their ID into the cell conectivity ! calculate coordinates of cell nodes and insert their ID into the cell conectivity
coordinates = reshape([(0.0_pReal,i = 1, 3*s*thisMesh%Nelems)], [3,i]) coordinates = reshape([(0.0_pReal,j = 1, 3*i)], [3,i])
i = 0 i = 1
n = 1 n = 1
do while(n <= s*thisMesh%Nelems) do while(n <= size(candidates_local)*Nelem)
j=0 j=0
parentsAndWeights(:,1) = candidates_global(1:nParentNodes,n+j) parentsAndWeights(:,1) = candidates_global(1:nParentNodes,n+j)
parentsAndWeights(:,2) = candidates_global(nParentNodes+1:nParentNodes*2,n+j) parentsAndWeights(:,2) = candidates_global(nParentNodes+1:nParentNodes*2,n+j)
e = candidates_global(nParentNodes*2+1,n+j) e = candidates_global(nParentNodes*2+1,n+j)
c = candidates_global(nParentNodes*2+2,n+j) c = candidates_global(nParentNodes*2+2,n+j)
do m = 1, nParentNodes do m = 1, nParentNodes
coordinates(:,i+1) = coordinates(:,i+1) & coordinates(:,i) = coordinates(:,i) &
+ thisMesh%node_0(:,parentsAndWeights(m,1)) * real(parentsAndWeights(m,2),pReal) + thisMesh%node_0(:,parentsAndWeights(m,1)) * real(parentsAndWeights(m,2),pReal)
enddo enddo
coordinates(:,i+1) = coordinates(:,i+1)/real(sum(parentsAndWeights(:,2)),pReal) coordinates(:,i) = coordinates(:,i)/real(sum(parentsAndWeights(:,2)),pReal)
do while (n+j<= s*thisMesh%Nelems) do while (n+j<= size(candidates_local)*Nelem)
if (any(candidates_global(1:2*nParentNodes,n+j)/=candidates_global(1:2*nParentNodes,n))) exit if (any(candidates_global(1:2*nParentNodes,n+j)/=candidates_global(1:2*nParentNodes,n))) exit
where (connectivity_cell(:,:,candidates_global(nParentNodes*2+1,n+j)) == -candidates_global(nParentNodes*2+2,n+j)) where (connectivity_cell(:,:,candidates_global(nParentNodes*2+1,n+j)) == -candidates_global(nParentNodes*2+2,n+j)) ! still locally defined
connectivity_cell(:,:,candidates_global(nParentNodes*2+1,n+j)) = i+1+nCellNode connectivity_cell(:,:,candidates_global(nParentNodes*2+1,n+j)) = nCellNode + i ! gets current new cell node id
end where end where
j = j + 1 j = j + 1
@ -997,12 +1004,12 @@ subroutine calcCells(thisMesh,elem,connectivity_elem)
n = n+j n = n+j
enddo enddo
nCellNode = nCellNode + p nCellNode = nCellNode + i
if (p/=0) nodes5 = reshape([nodes5,coordinates],[3,nCellNode]) if (i/=0) nodes5 = reshape([nodes5,coordinates],[3,nCellNode])
enddo enddo
thisMesh%node_0 = nodes5 thisMesh%node_0 = nodes5
mesh_cell2 = connectivity_cell mesh_cell2 = connectivity_cell
connectivity_cell_reshape = reshape(connectivity_cell,[thisMesh%elem%NcellNodesPerCell,thisMesh%elem%nIPs*thisMesh%Nelems]) connectivity_cell_reshape = reshape(connectivity_cell,[elem%NcellNodesPerCell,elem%nIPs*thisMesh%Nelems])
#if defined(DAMASK_HDF5) #if defined(DAMASK_HDF5)
call results_openJobFile call results_openJobFile