751 lines
22 KiB
Fortran
751 lines
22 KiB
Fortran
|
! 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
|