SPEED
WRITE_FILE_FACES.f90
Go to the documentation of this file.
1! Copyright (C) 2012 The SPEED FOUNDATION
2! Author: Ilario Mazzieri
3!
4! This file is part of SPEED.
5!
6! SPEED is free software; you can redistribute it and/or modify it
7! under the terms of the GNU Affero General Public License as
8! published by the Free Software Foundation, either version 3 of the
9! License, or (at your option) any later version.
10!
11! SPEED is distributed in the hope that it will be useful, but
12! WITHOUT ANY WARRANTY; without even the implied warranty of
13! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14! Affero General Public License for more details.
15!
16! You should have received a copy of the GNU Affero General Public License
17! along with SPEED. If not, see <http://www.gnu.org/licenses/>.
18
35
36
37 subroutine write_file_faces(mpi_file,filename, faces, nodes, n, ng, mpi_id, mpi_com, cfaces, np)
38
39
40 implicit none
41
42 include 'SPEED.MPI'
43
44 CHARACTER*70 :: filename, file_mpi, mpi_file, file_mpi_new
45 CHARACTER(LEN=1000) :: Format
46
47 INTEGER*4 :: i,j
48 INTEGER*4 :: mpierror, unit_mpi, dim2, jstart, unitname
49
50 INTEGER*4, INTENT(IN) :: n, mpi_id, mpi_com, np, ng
51 INTEGER*4, DIMENSION(np), INTENT(INOUT) :: cfaces
52
53 INTEGER*4, DIMENSION(3,n) :: faces
54 INTEGER*4, DIMENSION(:,:), ALLOCATABLE :: faces_glo
55
56 real*8, DIMENSION(25,n) :: nodes
57 real*8, DIMENSION(:,:), ALLOCATABLE :: nodes_glo
58
59
60
61 file_mpi = 'FACS000000.mpi'
62 unit_mpi = 40
63 if (mpi_id .lt. 10) then
64 write(file_mpi(10:10),'(i1)') mpi_id
65 else if (mpi_id .lt. 100) then
66 write(file_mpi(9:10),'(i2)') mpi_id
67 else if (mpi_id .lt. 1000) then
68 write(file_mpi(8:10),'(i3)') mpi_id
69 else if (mpi_id .lt. 10000) then
70 write(file_mpi(7:10),'(i4)') mpi_id
71 else if (mpi_id .lt. 100000) then
72 write(file_mpi(6:10),'(i5)') mpi_id
73 else if (mpi_id .lt. 1000000) then
74 write(file_mpi(5:10),'(i6)') mpi_id
75 endif
76
77 if(len_trim(mpi_file) .ne. 70) then
78 file_mpi_new = mpi_file(1:len_trim(mpi_file)) // '/' // file_mpi
79 else
80 file_mpi_new = file_mpi
81 endif
82
83 open(unit_mpi,file=file_mpi_new)
84 write(unit_mpi,*) n
85 do i = 1, n
86 write(unit_mpi,"(1I2,1X,1I12,1X,1I2,25(2X,ES16.9))") &
87 faces(1,i), faces(2,i), faces(3,i), &
88 nodes(1,i), nodes(2,i), nodes(3,i), &
89 nodes(4,i), nodes(5,i), nodes(6,i), &
90 nodes(7,i), nodes(8,i), nodes(9,i), &
91 nodes(10,i), nodes(11,i), nodes(12,i), &
92 nodes(13,i), nodes(14,i), nodes(15,i), &
93 nodes(16,i), nodes(17,i), nodes(18,i), &
94 nodes(19,i), nodes(20,i), nodes(21,i), &
95 nodes(22,i), nodes(23,i), nodes(24,i), &
96 nodes(25,i)
97 enddo
98 close(unit_mpi)
99
100! write(*,*) cfaces
101
102
103 call mpi_barrier(mpi_com, mpierror)
104
105
106
107
108 if(mpi_id .eq. 0) then
109
110 allocate(faces_glo(3,ng), nodes_glo(25,ng))
111
112 do i = 1, np
113
114 if (cfaces(i) .ne. 0) then
115
116 file_mpi = 'FACS000000.mpi'
117 unit_mpi = 40
118 if (i-1 .lt. 10) then
119 write(file_mpi(10:10),'(i1)') i-1
120 else if (i-1 .lt. 100) then
121 write(file_mpi(9:10),'(i2)') i-1
122 else if (i-1 .lt. 1000) then
123 write(file_mpi(8:10),'(i3)') i-1
124 else if (i-1 .lt. 10000) then
125 write(file_mpi(7:10),'(i4)') i-1
126 else if (i-1 .lt. 100000) then
127 write(file_mpi(6:10),'(i5)') i-1
128 else if (i-1 .lt. 1000000) then
129 write(file_mpi(5:10),'(i6)') i-1
130 endif
131
132 if(len_trim(mpi_file) .ne. 70) then
133 file_mpi_new = mpi_file(1:len_trim(mpi_file)) // '/' // file_mpi
134 else
135 file_mpi_new = file_mpi
136 endif
137
138 open(unit_mpi,file=file_mpi_new)
139 read(unit_mpi,*) dim2
140
141 if(i.eq. 1) then
142 jstart = 0
143 else
144 jstart = sum(cfaces(1:i-1))
145 endif
146
147 do j = 1, dim2
148
149 read(unit_mpi,*) &
150 faces_glo(1,j+jstart), faces_glo(2,j+jstart), faces_glo(3,j+jstart), &
151 nodes_glo(1,j+jstart), nodes_glo(2,j+jstart), nodes_glo(3,j+jstart), &
152 nodes_glo(4,j+jstart), nodes_glo(5,j+jstart), nodes_glo(6,j+jstart), &
153 nodes_glo(7,j+jstart), nodes_glo(8,j+jstart), nodes_glo(9,j+jstart), &
154 nodes_glo(10,j+jstart), nodes_glo(11,j+jstart), nodes_glo(12,j+jstart), &
155 nodes_glo(13,j+jstart), nodes_glo(14,j+jstart), nodes_glo(15,j+jstart), &
156 nodes_glo(16,j+jstart), nodes_glo(17,j+jstart), nodes_glo(18,j+jstart), &
157 nodes_glo(19,j+jstart), nodes_glo(20,j+jstart), nodes_glo(21,j+jstart), &
158 nodes_glo(22,j+jstart), nodes_glo(23,j+jstart), nodes_glo(24,j+jstart), &
159 nodes_glo(25,j+jstart)
160
161
162
163 enddo
164
165 close(unit_mpi)
166
167 endif
168
169 enddo
170
171
172 unitname = 400
173 open(unitname,file=filename)
174
175 do j = 1, ng
176
177 write(unitname,"(1I2,1X,1I12,1X,1I2,25(2X,ES16.9))") &
178 faces_glo(1,j), faces_glo(2,j), faces_glo(3,j), &
179 nodes_glo(1,j), nodes_glo(2,j), nodes_glo(3,j), &
180 nodes_glo(4,j), nodes_glo(5,j), nodes_glo(6,j), &
181 nodes_glo(7,j), nodes_glo(8,j), nodes_glo(9,j), &
182 nodes_glo(10,j), nodes_glo(11,j), nodes_glo(12,j), &
183 nodes_glo(13,j), nodes_glo(14,j), nodes_glo(15,j), &
184 nodes_glo(16,j), nodes_glo(17,j), nodes_glo(18,j), &
185 nodes_glo(19,j), nodes_glo(20,j), nodes_glo(21,j), &
186 nodes_glo(22,j), nodes_glo(23,j), nodes_glo(24,j), &
187 nodes_glo(25,j)
188
189
190
191 enddo
192
193 close(unitname)
194 deallocate(faces_glo, nodes_glo)
195
196
197 endif
198
199
200 call mpi_barrier(mpi_com, mpierror)
201
202
203 return
204
205 end subroutine write_file_faces
write_file_faces
subroutine write_file_faces(mpi_file, filename, faces, nodes, n, ng, mpi_id, mpi_com, cfaces, np)
Writes file FACSXXXXX.mpi and stores info about DG surfaces.
Definition WRITE_FILE_FACES.f90:38