phd-scripts/Unpublished/3D_Voxel_Assign/GrainMask.f90

751 lines
22 KiB
Fortran
Raw Normal View History

2024-05-13 19:50:21 +00:00
! This program generates a micro-strucutre mask and applies it to
! an existing mesh.
! J.Grogan 05/08/11
program Voronoi3DPost
!
! Parameters
parameter(max_elements=100000,max_cells=20000,max_fc=100,max_faces=10000)
parameter(max_elem_in_cell=50000,max_neigh_per_elem=6,max_neighbours=50)
!
! Variables
character(len=256)input
character(len=256)input2(2)
integer cell_stat(20000)
integer,allocatable,dimension(:)::closest
integer,allocatable,dimension(:)::num_ele_cell
integer,allocatable,dimension(:)::num_faces
integer,allocatable,dimension(:)::cell_status
integer,allocatable,dimension(:,:)::cell_ele
integer,dimension(max_elements)::num_neighbours
integer,dimension(max_elements,max_neighbours)::neighbour
integer mesh_type,mask_type,num_x,num_y,num_z,num_grains
double precision grain_length,rad_hard,rscale
double precision,allocatable,dimension(:,:)::distance
double precision,allocatable,dimension(:,:)::nbr_dist
double precision,allocatable,dimension(:,:)::cor_faces
double precision,dimension(max_elements)::cor_dist
double precision,allocatable,dimension(:,:)::ele_centroid
double precision,allocatable,dimension(:,:)::cell_centroid
double precision,allocatable,dimension(:,:,:)::face
!
! Mesh Type: 2 = 2D, 3 = 3D
mesh_type=3
! Mask Type: 1= Square, 2= Hexagon, 3= Dodec, 4=2D Voronoi, 5=3D Voronoi
mask_type=5
! Grain Length
Grain_length=0.025
! Num grains x
num_x=10
! Num grains y
num_y=10
! Num grains z
num_z=1
! Hardcore Voronoi Radius
rad_hard=0.00
num_grains=num_x*num_y*num_z
if(mask_type>3)then
! Create Tessellation
allocate(face(max_cells,max_fc,4),num_faces(max_cells),cell_centroid(max_cells,3))
call make_voronoi(mask_type,mesh_type,num_grains,num_x,rad_hard,grain_length)
call process_voronoi(face,num_faces,cell_centroid,num_cells,cell_stat)
else
! Generate Centroids and faces for other geometries
icount=1
num_cells=num_grains
allocate(face(num_cells,6,4),num_faces(num_cells),cell_centroid(num_cells,3))
do i=1,num_x
do j=1,num_y
do k=1,num_z
if(mask_type==1)then
call make_square(i,j,k,grain_length,num_faces(icount), &
& face(icount,:,:),cell_centroid(icount,:),mesh_type)
elseif(mask_type==2)then
call make_hexagon(i,j,k,grain_length,num_faces(icount), &
& face(icount,:,:),cell_centroid(icount,:),mesh_type)
else
if(mod(j,2)==0)then
cell_centroid(icount,1)=2.*(i-1)*Grain_length*sqrt(2.)+&
&sqrt(2.)*Grain_length
cell_centroid(icount,3)=2.*(k-1)*Grain_length*sqrt(2.)+&
&Grain_length*sqrt(2.)
else
cell_centroid(icount,1)=2.*(i-1)*Grain_length*sqrt(2.)
cell_centroid(icount,3)=2.*(k-1)*Grain_length*sqrt(2.)
endif
cell_centroid(icount,2)=2.*(j-1)*Grain_length
endif
icount=icount+1
enddo
enddo
enddo
endif
!
allocate(ele_centroid(max_elements,3))
! Get element centroids
call elem_centroids(num_elements,ele_centroid,mesh_type)
!
! Get neighbouring elements
allocate(nbr_dist(max_elements,max_neighbours))
do i=1,num_elements
icount=1
do j=1,num_elements
if(icount>max_neighbours)then
rmaxdist=0.
do k=1,max_neighbours
if(nbr_dist(i,k)>rmaxdist)then
rmaxdist=nbr_dist(i,k)
index_max_dist=k
endif
enddo
endif
cent1x=ele_centroid(i,1)
cent1y=ele_centroid(i,2)
cent1z=ele_centroid(i,3)
cent2x=ele_centroid(j,1)
cent2y=ele_centroid(j,2)
cent2z=ele_centroid(j,3)
dist=sqrt((cent1x-cent2x)*(cent1x-cent2x)+(cent1y-cent2y)*(cent1y-cent2y)&
&+(cent1z-cent2z)*(cent1z-cent2z))
if(icount>max_neighbours)then
if(dist<rmaxdist)then
nbr_dist(i,index_max_dist)=dist
neighbour(i,index_max_dist)=j
endif
else
nbr_dist(i,j)=dist
neighbour(i,j)=j
endif
icount=icount+1
enddo
print *,float(i)/float(num_elements)
enddo
deallocate(nbr_dist)
!
! Get corrosion surface distances
open(unit=22,file='CorSurf.dat',status='unknown')
allocate(cor_faces(max_faces,3))
ierr=0
inum_faces=1
do while (ierr==0)
read(22,*,iostat=ierr)cor_faces(inum_faces,1),cor_faces(inum_faces,2),&
&cor_faces(inum_faces,3)
if(ierr==0)inum_faces=inum_faces+1
enddo
close(unit=22)
do i=1,num_elements
centx=ele_centroid(i,1)
centy=ele_centroid(i,2)
centz=ele_centroid(i,3)
distmin=1000.
do j=1,inum_faces-1
facex=cor_faces(j,1)
facey=cor_faces(j,2)
facez=cor_faces(j,3)
dist=sqrt((centx-facex)*(centx-facex)+(centy-facey)*(centy-facey)&
&+(centz-facez)*(centz-facez))
if(dist<distmin)distmin=dist
enddo
cor_dist(i)=distmin
enddo
deallocate(cor_faces)
!
! Find closest cell to element centroid
allocate(closest(max_elements))
if(mask_type==5)then
do i=1,num_elements
centx=ele_centroid(i,1)
centy=ele_centroid(i,2)
centz=ele_centroid(i,3)
do j=1,num_cells
if(num_faces(j)<3)then
print *,'warning',i,j,num_faces(j)
cycle
endif
if(cell_stat(j)==1)cycle
icheck=0
do k=1,num_faces(j)
rnorx=face(j,k,1)
rnory=face(j,k,2)
rnorz=face(j,k,3)
roff=face(j,k,4)
dotprod=centx*rnorx+centy*rnory+centz*rnorz+roff
if(dotprod<0.)then
icheck=1
exit
endif
enddo
if(icheck==0)then
closest(i)=j
endif
enddo
enddo
else
do i=1,num_elements
centx=ele_centroid(i,1)
centy=ele_centroid(i,2)
do j=1,num_cells
if(cell_stat(j)==1)cycle
cellx=cell_centroid(j,1)
celly=cell_centroid(j,2)
icheck=0
do k=1,num_faces(j)
fx1=face(j,k,1)
fx2=face(j,k,2)
fy1=face(j,k,3)
fy2=face(j,k,4)
dcell=(fx2-fx1)*(celly-fy1)-(fy2-fy1)*(cellx-fx1)
dele=(fx2-fx1)*(centy-fy1)-(fy2-fy1)*(centx-fx1)
if(dcell<0.)then
if(dele>=0.)icheck=1
else
if(dele<0.)icheck=1
endif
if(icheck==1)exit
enddo
if(icheck==0)then
closest(i)=j
endif
enddo
enddo
endif
!
allocate(num_ele_cell(num_cells),cell_ele(num_cells,max_elem_in_cell))
! Find each element in a cell
do i=1,num_cells
num_ele_cell(i)=0
do j=1,num_elements
if(closest(j)==i)then
num_ele_cell(i)=num_ele_cell(i)+1
cell_ele(i,num_ele_cell(i))=j
endif
enddo
enddo
!
!
allocate(distance(num_cells,num_elements))
! Find min distance between element centroid and cell faces/hyperplanes
do i=1,num_cells
if(i==1406) print *,num_faces(i)
do j=1,num_ele_cell(i)
centx=ele_centroid(cell_ele(i,j),1)
centy=ele_centroid(cell_ele(i,j),2)
centz=ele_centroid(cell_ele(i,j),3)
distmin=1000.
if(mask_type==5)then
do k=1,num_faces(i)
rnorx=face(i,k,1)
rnory=face(i,k,2)
rnorz=face(i,k,3)
roff=face(i,k,4)
dotprod=abs(centx*rnorx+centy*rnory+centz*rnorz+roff)
if(dotprod<distmin)distmin=dotprod
enddo
else
do k=1,num_faces(i)
x1=face(i,k,1)
x2=face(i,k,2)
y1=face(i,k,3)
y2=face(i,k,4)
dotprod=abs((x2-x1)*(y1-centy)-(x1-centx)*(y2-y1))
dotprod=dotprod/(sqrt((x2-x1)*(x2-x1)+(y2-y1)*(y2-y1)))
if(dotprod<distmin)distmin=dotprod
enddo
endif
distance(i,j)=distmin
enddo
enddo
!
! Write Element Sets
rewind(10)
open(unit=13,file='GeomGenINP.inp',status='unknown')
input2(1)='**'
do while (index(input2(1),'*End Part')==0)
read(10,'(a)')input2(2)
write(13,'(a)')input2(1)
input2(1)=input2(2)
enddo
do i=1,num_cells
if(num_ele_cell(i)==0)cycle
write(13,*)'*Elset,elset=ele',i
icheck=1
do j=1,num_ele_cell(i)
if(icheck==1)then
if(num_ele_cell(i)>1)then
write(13,'(i6)',advance='no')cell_ele(i,j)
else
write(13,'(i6)')cell_ele(i,j)
endif
elseif(icheck==num_ele_cell(i))then
write(13,'(a1,i6)')',',cell_ele(i,j)
else
if(mod(icheck,15)==0)then
write(13,'(a1,i6)')',',cell_ele(i,j)
else
write(13,'(a1,i6)',advance='no')',',cell_ele(i,j)
endif
endif
icheck=icheck+1
enddo
if(iana_type==1)write(19,*)'*Solid Section,elset=ele',i,'Boundary,material=Mat',i
enddo
write(13,*)'**'
do while (index(input2(1),'*End Assembly')==0)
read(10,'(a)')input2(2)
write(13,'(a)')input2(1)
input2(1)=input2(2)
enddo
write(13,'(a)')'*End Assembly'
write(13,*)'*INITIAL CONDITIONS,TYPE=SOLUTION'
do i=1,num_cells
if(num_ele_cell(i)==0)cycle
do j=1,num_ele_cell(i)
write(13,'(3(a,i6),2(a,f18.6),3(i6,a))')'Assembly.CorPart.',cell_ele(i,j),',' &
& ,cell_ele(i,j),',',max_neighbours,',',distance(i,j),',',cor_dist(cell_ele(i,j)) &
& ,0,',',0,',',0,','
write(13,'(8(i6,a))')0,',',0,',',0,',',0,',',0,',',0,',',0,',',1,','
do k=1, max_neighbours
if(mod(k,8)/=0)then
if(k/=max_neighbours)then
write(13,'(i6,a)',advance='no')neighbour(cell_ele(i,j),k),','
else
write(13,'(i6)')neighbour(cell_ele(i,j),k)
endif
else
if(k/=max_neighbours)then
write(13,'(i6,a)')neighbour(cell_ele(i,j),k),','
else
write(13,'(i6)')neighbour(cell_ele(i,j),k)
endif
endif
enddo
enddo
enddo
ierr=0
do while (ierr==0)
read(10,'(a)',iostat=ierr)input2(1)
if(ierr==0)write(13,'(a)')input2(1)
enddo
end program
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Generate Voronoi Tesselation Using QHULL
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
subroutine make_voronoi(mask_type,mesh_type,num_grains,num_x,rad_hard,grain_length)
integer mesh_type,mask_type,num_grains
integer seed(1)
double precision grain_length,rad_hard,rscale
if(mesh_type==2)mask_type=4
! Write QHull input file
open(unit=20,file='qhullin.dat',status='unknown')
write(20,*)mask_type-2
if(mask_type==5)write(20,*)num_grains*27
if(mask_type==4)write(20,*)num_grains*9
seed=1557
rscale=float(num_x)*Grain_Length
call random_seed(put=seed)
do i=1,num_grains
call random_number(xcor)
call random_number(ycor)
if(mask_type==5)call random_number(zcor)
xcor=xcor*rscale
ycor=ycor*rscale
if(mask_type==5)zcor=zcor*rscale
if(mask_type==4)then
write(20,*)xcor,ycor
write(20,*)xcor,ycor+rscale
write(20,*)xcor,ycor-rscale
write(20,*)xcor+rscale,ycor
write(20,*)xcor-rscale,ycor
write(20,*)xcor+rscale,ycor+rscale
write(20,*)xcor-rscale,ycor-rscale
write(20,*)xcor+rscale,ycor-rscale
write(20,*)xcor-rscale,ycor+rscale
elseif(mask_type==5)then
write(20,*)xcor,ycor,zcor
write(20,*)xcor+rscale,ycor,zcor
write(20,*)xcor-rscale,ycor,zcor
write(20,*)xcor,ycor+rscale,zcor
write(20,*)xcor,ycor-rscale,zcor
write(20,*)xcor+rscale,ycor+rscale,zcor
write(20,*)xcor-rscale,ycor-rscale,zcor
write(20,*)xcor+rscale,ycor-rscale,zcor
write(20,*)xcor-rscale,ycor+rscale,zcor
write(20,*)xcor,ycor,zcor+rscale
write(20,*)xcor+rscale,ycor,zcor+rscale
write(20,*)xcor-rscale,ycor,zcor+rscale
write(20,*)xcor,ycor+rscale,zcor+rscale
write(20,*)xcor,ycor-rscale,zcor+rscale
write(20,*)xcor+rscale,ycor+rscale,zcor+rscale
write(20,*)xcor-rscale,ycor-rscale,zcor+rscale
write(20,*)xcor+rscale,ycor-rscale,zcor+rscale
write(20,*)xcor-rscale,ycor+rscale,zcor+rscale
write(20,*)xcor,ycor,zcor-rscale
write(20,*)xcor+rscale,ycor,zcor-rscale
write(20,*)xcor-rscale,ycor,zcor-rscale
write(20,*)xcor,ycor+rscale,zcor-rscale
write(20,*)xcor,ycor-rscale,zcor-rscale
write(20,*)xcor+rscale,ycor+rscale,zcor-rscale
write(20,*)xcor-rscale,ycor-rscale,zcor-rscale
write(20,*)xcor+rscale,ycor-rscale,zcor-rscale
write(20,*)xcor-rscale,ycor+rscale,zcor-rscale
endif
enddo
close(20)
call system('qvoronoi.exe TI qhullin.dat o Fi TO qhullout.dat')
end subroutine
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Process Voronoi Tesselation - Return Arrays of Cell Faces and Centroids
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
subroutine process_voronoi(face_sub,num_faces_sub,cell_centroid,num_cells,cell_stat)
!
! Variables
character(len=320)full_line
character(len=320)test_string
character(len=256)input
character(len=256)input2(2)
integer seed (1)
integer cell_stat(20000)
integer,allocatable,dimension(:)::num_verts
integer,allocatable,dimension(:)::num_cell_hyp
integer,allocatable,dimension(:)::numverts
integer,dimension(20000)::num_faces_sub
integer,allocatable,dimension(:,:)::num_hyp_verts
integer,allocatable,dimension(:,:)::vert_list
integer,allocatable,dimension(:,:)::hyp_list
integer,allocatable,dimension(:,:)::facet
integer max_vc,max_hc,max_vh
double precision,allocatable,dimension(:)::xv_cor
double precision,allocatable,dimension(:)::yv_cor
double precision,allocatable,dimension(:)::zv_cor
double precision,allocatable,dimension(:)::offset
double precision,allocatable,dimension(:,:)::cor
double precision,allocatable,dimension(:,:)::ele_centroid
double precision,dimension(20000,3)::cell_centroid
double precision,dimension(20000,100,4)::face_sub
!
! Parameters
parameter(max_vc=100,max_hc=100,max_vh=50)
!
open(unit=21,file='qhullout.dat',status='unknown')
!
! Allocate Arrays
read(21,*)idimension
read(21,*)num_total_verts,num_cells
allocate(num_verts(num_cells))
allocate(xv_cor(num_total_verts),yv_cor(num_total_verts))
if(idimension==3)allocate(zv_cor(num_total_verts))
allocate(vert_list(num_cells,max_vc))
!
! Read in all vertice co-ordinates
do i=1,num_total_verts
if(idimension==2)read(21,*)xv_cor(i),yv_cor(i)
if(idimension==3)read(21,*)xv_cor(i),yv_cor(i),zv_cor(i)
enddo
!
! Read in vertice labels for each voronoi cell
do i=1,num_cells
read(21,*)num_verts(i)
backspace(21)
if(num_verts(i)>9)then
read(21,'(i3,a320)')idummy,full_line
else
read(21,'(i2,a320)')idummy,full_line
endif
ileft=1
num_points=1
do iright=1,320
test_string=full_line(iright:iright)
if((test_string==' ').or.(iright==320))then
read(full_line(ileft:iright-1),'(i6)')vert_list(i,num_points)
if(num_points==num_verts(i))exit
ileft=iright+1
num_points=num_points+1
endif
enddo
do j=1,num_points-1
if(vert_list(i,j)==0)cell_stat(i)=1
enddo
enddo
if(idimension==3)then
!
! Read in bounded hyperplane cell labels and co-ordinates
read(21,*)num_hyp
allocate(facet(2,num_hyp),cor(3,num_hyp),offset(num_hyp))
allocate(hyp_list(num_cells,num_hyp),num_cell_hyp(num_cells))
!
do i=1,num_hyp
read(21,*)dummy,facet(1,i),facet(2,i),cor(1,i),cor(2,i),cor(3,i),offset(i)
enddo
!
! Determine hyperplanes of each cell
do i=1,num_cells
num_hy=1
do j=1,num_hyp
if((facet(1,j)==i-1).or.(facet(2,j)==i-1))then
hyp_list(i,num_hy)=j
num_cell_hyp(i)=num_hy
num_hy=num_hy+1
endif
enddo
enddo
!
! Store hyperplane info in convenient format
do i=1,num_cells
num_faces_sub(i)=num_cell_hyp(i)
do j=1,num_cell_hyp(i)
face_sub(i,j,1)=cor(1,hyp_list(i,j))
face_sub(i,j,2)=cor(2,hyp_list(i,j))
face_sub(i,j,3)=cor(3,hyp_list(i,j))
face_sub(i,j,4)=offset(hyp_list(i,j))
enddo
enddo
else
do i=1,num_cells
num_faces_sub(i)=num_verts(i)
do j=1,num_verts(i)
x2=xv_cor(vert_list(i,j)+1)
y2=yv_cor(vert_list(i,j)+1)
if(j==1)then
x1=xv_cor(vert_list(i,num_verts(i))+1)
y1=yv_cor(vert_list(i,num_verts(i))+1)
else
x1=xv_cor(vert_list(i,j-1)+1)
y1=yv_cor(vert_list(i,j-1)+1)
endif
face_sub(i,j,1)=x1
face_sub(i,j,2)=x2
face_sub(i,j,3)=y1
face_sub(i,j,4)=y2
enddo
enddo
endif
!
! Get cell centroid
do i=1,num_cells
centroidx=0.
centroidy=0.
centroidz=0.
do j=1,num_verts(i)
centroidx=centroidx+xv_cor(vert_list(i,j)+1)
centroidy=centroidy+yv_cor(vert_list(i,j)+1)
if(idimension==3)centroidz=centroidz+zv_cor(vert_list(i,j)+1)
enddo
cell_centroid(i,1)=centroidx/float(num_verts(i))
cell_centroid(i,2)=centroidy/float(num_verts(i))
if(idimension==3)then
cell_centroid(i,3)=centroidz/float(num_verts(i))
else
cell_centroid(i,3)=0.d0
endif
enddo
if(idimension==3)then
! Flip hyperplane normal if it points away from cell centroid
do i=1,num_cells
centx=cell_centroid(i,1)
centy=cell_centroid(i,2)
centz=cell_centroid(i,3)
distmin=1000.
do k=1,num_faces_sub(i)
rnorx=face_sub(i,k,1)
rnory=face_sub(i,k,2)
rnorz=face_sub(i,k,3)
roff=face_sub(i,k,4)
dotprod=centx*rnorx+centy*rnory+centz*rnorz+roff
if(dotprod<0.)then
face_sub(i,k,1)=-face_sub(i,k,1)
face_sub(i,k,2)=-face_sub(i,k,2)
face_sub(i,k,3)=-face_sub(i,k,3)
face_sub(i,k,4)=-face_sub(i,k,4)
endif
enddo
enddo
endif
close(unit=21)
deallocate(num_verts,xv_cor,yv_cor)
if(idimension==3)deallocate(zv_cor,facet,cor,offset,hyp_list,num_cell_hyp)
end subroutine
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Make Squares - Return Arrays of Cell Faces and Centroids
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
subroutine make_square(i,j,k,grain_length,num_faces,face,cell_centroid,mesh_type)
!
integer num_faces,m
double precision grain_length,centrex,centrey,centrez,rsign,xnor,ynor,znor
double precision rdist
double precision,dimension(3)::cell_centroid
double precision,dimension(6,4)::face
!
!
num_faces=4
centrex=(i-1)*Grain_length+Grain_length/2.d0
centrey=(j-1)*Grain_length+Grain_length/2.d0
if(mesh_type==3)then
centrez=(k-1)*Grain_length+Grain_length/2.d0
else
centrez=0.d0
endif
!
! Centroid
cell_centroid(1)=centrex
cell_centroid(2)=centrey
cell_centroid(3)=centrez
!
! Faces
do m=1,num_faces
rsign=1.d0
xnor=0.d0
ynor=0.d0
znor=0.d0
unitx=grain_length/2.d0
unity=grain_length/2.d0
if(mod(m,2)==0)rsign=-1.d0
if(m<=2)then
x1=centrex+rsign*unitx
x2=centrex+rsign*unitx
y1=centrey+unity
y2=centrey-unity
else
x1=centrex+unitx
x2=centrex-unitx
y1=centrey+rsign*unity
y2=centrey+rsign*unity
endif
face(m,1)=x1
face(m,2)=x2
face(m,3)=y1
face(m,4)=y2
enddo
end Subroutine
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Make Hexagons - Return Arrays of Cell Faces and Centroids
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
subroutine make_hexagon(i,j,k,grain_length,num_faces,face,cell_centroid,mesh_type)
integer num_faces,m
double precision grain_length,centrex,centrey,centrez,rsign,xnor,ynor,znor
double precision rdist
double precision,dimension(3)::cell_centroid
double precision,dimension(6,4)::face
!
!
num_faces=6
if(mod(j,2)==0)then
centrex=(i-1)*sqrt(3.d0)*Grain_length+sqrt(3.d0)*Grain_length/2.d0
else
centrex=(i-1)*sqrt(3.)*Grain_length
endif
centrey=(j-1)*1.5d0*Grain_length
if(mesh_type==3)then
centrez=(k-1)*Grain_length
else
centrez=0.d0
endif
!
! Centroid
cell_centroid(1)=centrex
cell_centroid(2)=centrey
cell_centroid(3)=centrez
!
! Faces
do m=1,num_faces
rsign=1.d0
rsign2=1.d0
xnor=0.d0
ynor=0.d0
znor=0.d0
unity=0.5d0*grain_length
unitx=(sqrt(3.d0)/2.d0)*grain_length
if(mod(m,2)==0)rsign=-1.d0
if(m<=2)then
x1=centrex+rsign*unitx
x2=centrex+rsign*unitx
y1=centrey+unity
y2=centrey-unity
elseif(m>2.and.m<=4)then
x1=centrex
x2=centrex+unitx
y1=centrey+rsign*unity*2.d0
y2=centrey+rsign*unity
else
x1=centrex
x2=centrex-unitx
y1=centrey+rsign*unity*2.d0
y2=centrey+rsign*unity
endif
face(m,1)=x1
face(m,2)=x2
face(m,3)=y1
face(m,4)=y2
enddo
end Subroutine
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
! Get Element Centroids
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
subroutine elem_centroids(ne,ele_centroid,mesh_type)
!
! Parameters
parameter(max_nodes=1000000,max_elements=100000,max_node_in_elem=8)
!
! Variables
character(len=256)input
integer,dimension(max_elements,max_node_in_elem)::elements
double precision,dimension(max_nodes,3)::nodes
double precision,dimension(max_elements,3)::ele_centroid
!
! Open Input File and read node and element co-ordinates
open(unit=10,file='GeomGenTemp.inp',status='unknown')
do while (index(input,'*Node')==0)
read(10,'(a)')input
end do
nn=0
do while(1==1)
read(10,'(a)')input
if(index(input,'*')==0)then
backspace(10)
nn=nn+1
if(mesh_type==3)then
read(10,*)dummy,nodes(nn,1),nodes(nn,2),nodes(nn,3)
else
read(10,*)dummy,nodes(nn,1),nodes(nn,2)
endif
else
if(mesh_type==2)then
nele_type=4
else
if(index(input,'C3D8')/=0)nele_type=8
if(index(input,'C3D4')/=0)nele_type=4
endif
exit
endif
end do
ne=0
do while(1==1)
read(10,'(a)')input
if(index(input,'*')==0)then
backspace(10)
ne=ne+1
if(nele_type==8)then
read(10,*)dummy,elements(ne,1),elements(ne,2),elements(ne,3),elements(ne,4)&
& ,elements(ne,5),elements(ne,6),elements(ne,7),elements(ne,8)
elseif(nele_type==4)then
read(10,*)dummy,elements(ne,1),elements(ne,2),elements(ne,3),elements(ne,4)
endif
else
exit
endif
end do
!
! Get element centroid
do i=1,ne
centroidx=0.d0
centroidy=0.d0
centroidz=0.d0
do j=1,nele_type
centroidx=centroidx+nodes(elements(i,j),1)
centroidy=centroidy+nodes(elements(i,j),2)
if(mesh_type==3)centroidz=centroidz+nodes(elements(i,j),3)
enddo
ele_centroid(i,1)=centroidx/float(nele_type)
ele_centroid(i,2)=centroidy/float(nele_type)
if(mesh_type==3)ele_centroid(i,3)=centroidz/float(nele_type)
enddo
end subroutine