-
Notifications
You must be signed in to change notification settings - Fork 12
/
mod_write_vtk.f90
162 lines (127 loc) · 5.54 KB
/
mod_write_vtk.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
module mod_write_vtk
use mod_read_gmsh
use mod_cell_2D
implicit none
type :: obj_msh_vis
class(obj_cell_2D), pointer :: smart_pointer
contains
procedure :: write_vtk => write_mesh_vtk
procedure :: write_tecplot => write_mesh_tecplot
end type
interface obj_msh_vis
module procedure obj_msh_vis_constructor
end interface obj_msh_vis
contains
!----------------------------------------------------------------------
type(obj_msh_vis) function obj_msh_vis_constructor(obj_cell_2D_container)
implicit none
type(obj_cell_2D), target :: obj_cell_2D_container
obj_msh_vis_constructor%smart_pointer => obj_cell_2D_container
end function obj_msh_vis_constructor
!----------------------------------------------------------------------
subroutine write_mesh_vtk(this)
implicit none
class(obj_msh_vis), intent(in) :: this
integer(4) :: i
character(300) :: foutput
foutput = trim(fname)//'.vtk'
open(unit = 21, file = foutput, status = 'replace')
write(21,'(a)') '# vtk DataFile Version 2.0'
write(21,'(a)') 'VTK format for unstructured mesh'
write(21,'(a)') 'ASCII'
write(21,'(a)') 'DATASET POLYDATA'
write(21,1) this%smart_pointer%nbnode
do i = 1, this%smart_pointer%nbnode
write(21,*) this%smart_pointer%coord_nodes(i)%p%x, this%smart_pointer%coord_nodes(i)%p%y, this%smart_pointer%coord_nodes(i)%p%z
end do
write(21,2) this%smart_pointer%nbelm, 5*this%smart_pointer%nbelm
do i = 1, this%smart_pointer%nbelm
write(21,*) 4,this%smart_pointer%id_nodes(i)%pn%id_node(6:9)-1
end do
write(21,3) this%smart_pointer%nbelm
write(21,'(a)') 'SCALARS CELL_IDENT integer 1'
write(21,'(a)') 'LOOKUP_TABLE default '
do i = 1, this%smart_pointer%nbelm
write(21,*) this%smart_pointer%id_nodes(i)%pn%id_node(1)
end do
write(21,'(a)') 'SCALARS NEIGHBOR1 integer 1'
write(21,'(a)') 'LOOKUP_TABLE default '
do i = 1, this%smart_pointer%nbelm
if (associated(this%smart_pointer%cell(i)%p%neighbor1)) then
write(21,*) this%smart_pointer%cell(i)%p%neighbor1%ident
else
write(21,*) 0
endif
end do
write(21,'(a)') 'SCALARS NEIGHBOR2 integer 1'
write(21,'(a)') 'LOOKUP_TABLE default '
do i = 1, this%smart_pointer%nbelm
if (associated(this%smart_pointer%cell(i)%p%neighbor2)) then
write(21,*) this%smart_pointer%cell(i)%p%neighbor2%ident
else
write(21,*) 0
endif
end do
write(21,'(a)') 'SCALARS NEIGHBOR3 integer 1'
write(21,'(a)') 'LOOKUP_TABLE default '
do i = 1, this%smart_pointer%nbelm
if (associated(this%smart_pointer%cell(i)%p%neighbor3)) then
write(21,*) this%smart_pointer%cell(i)%p%neighbor3%ident
else
write(21,*) 0
endif
end do
write(21,'(a)') 'SCALARS NEIGHBOR4 integer 1'
write(21,'(a)') 'LOOKUP_TABLE default '
do i = 1, this%smart_pointer%nbelm
if (associated(this%smart_pointer%cell(i)%p%neighbor4)) then
write(21,*) this%smart_pointer%cell(i)%p%neighbor4%ident
else
write(21,*) 0
endif
end do
close(unit = 21)
1 format('POINTS',i9,' float')
2 format('POLYGONS ',2i9)
3 format('CELL_DATA',i9)
end subroutine
!----------------------------------------------------------------------
subroutine write_mesh_tecplot(this)
implicit none
class(obj_msh_vis), intent(in) :: this
integer(4) :: i
character(300) :: foutput
foutput = trim(fname)//'.dat'
open(unit = 21, file = foutput, status = 'replace')
!write(21,'(a)') 'VARIABLES=X,Y,CELL_IDENT,NEIGHBOR1,NEIGHBOR2,NEIGHBOR3,NEIGHBOR4' ! coming soon
write(21,'(a)') 'VARIABLES=X,Y'
write(21,'(a)') 'ZONE T="UNSTRUCTURED-COUNTOUR"'
write(21,'(a)') 'ZONETYPE=FEPOLYGON'
write(21,*) 'NODES=',this%smart_pointer%nbnode
write(21,*) 'ELEMENTS=',this%smart_pointer%nbelm
write(21,*) 'FACES=',this%smart_pointer%nbelm*4
write(21,*) 'NumConnectedBoundaryFaces=0'
write(21,*) 'TotalNumBoundaryConnections=0'
do i = 1, this%smart_pointer%nbnode
write(21,*) this%smart_pointer%coord_nodes(i)%p%x
end do
do i = 1, this%smart_pointer%nbnode
write(21,*) this%smart_pointer%coord_nodes(i)%p%y
end do
! Node indexes
do i = 1, this%smart_pointer%nbelm
write(21,*) this%smart_pointer%id_nodes(i)%pn%id_node(6), this%smart_pointer%id_nodes(i)%pn%id_node(7)
write(21,*) this%smart_pointer%id_nodes(i)%pn%id_node(7), this%smart_pointer%id_nodes(i)%pn%id_node(8)
write(21,*) this%smart_pointer%id_nodes(i)%pn%id_node(8), this%smart_pointer%id_nodes(i)%pn%id_node(9)
write(21,*) this%smart_pointer%id_nodes(i)%pn%id_node(9), this%smart_pointer%id_nodes(i)%pn%id_node(6)
enddo
do i = 1, this%smart_pointer%nbelm
write(21,*) i,i,i,i
enddo
do i = 1, this%smart_pointer%nbelm
write(21,*) 0,0,0,0
enddo
close(unit = 21)
end subroutine
!----------------------------------------------------------------------
end module