! 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