Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
SourceIMP/utilities/RocfracPrep/2DmeshOverlay.f90
Go to the documentation of this file.
1 !*********************************************************************
2 !* Illinois Open Source License *
3 !* *
4 !* University of Illinois/NCSA *
5 !* Open Source License *
6 !* *
7 !* Copyright@2008, University of Illinois. All rights reserved. *
8 !* *
9 !* Developed by: *
10 !* *
11 !* Center for Simulation of Advanced Rockets *
12 !* *
13 !* University of Illinois *
14 !* *
15 !* www.csar.uiuc.edu *
16 !* *
17 !* Permission is hereby granted, free of charge, to any person *
18 !* obtaining a copy of this software and associated documentation *
19 !* files (the "Software"), to deal with the Software without *
20 !* restriction, including without limitation the rights to use, *
21 !* copy, modify, merge, publish, distribute, sublicense, and/or *
22 !* sell copies of the Software, and to permit persons to whom the *
23 !* Software is furnished to do so, subject to the following *
24 !* conditions: *
25 !* *
26 !* *
27 !* @ Redistributions of source code must retain the above copyright *
28 !* notice, this list of conditions and the following disclaimers. *
29 !* *
30 !* @ Redistributions in binary form must reproduce the above *
31 !* copyright notice, this list of conditions and the following *
32 !* disclaimers in the documentation and/or other materials *
33 !* provided with the distribution. *
34 !* *
35 !* @ Neither the names of the Center for Simulation of Advanced *
36 !* Rockets, the University of Illinois, nor the names of its *
37 !* contributors may be used to endorse or promote products derived *
38 !* from this Software without specific prior written permission. *
39 !* *
40 !* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
41 !* EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
42 !* OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
43 !* NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
44 !* COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
45 !* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
46 !* ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
47 !* USE OR OTHER DEALINGS WITH THE SOFTWARE. *
48 !*********************************************************************
49 !* Please acknowledge The University of Illinois Center for *
50 !* Simulation of Advanced Rockets in works and publications *
51 !* resulting from this software or its derivatives. *
52 !*********************************************************************
53 SUBROUTINE mesh2doverlay(nprocs,iProcs,ichr4)
54 
55  use meshdata
56  USE linked_list2
57 
58  IMPLICIT NONE
59 
60  include 'roccomf90.h'
61 
62  CHARACTER*4 :: ichr4
63  INTEGER :: new
64  INTEGER :: i,k
65  INTEGER :: icounter
66  INTEGER :: iprocs
67  INTEGER :: nprocs
68  INTEGER :: numnpnew
69  INTEGER :: glbndnum
70  LOGICAL :: surfaceelonproc
71  INTEGER :: testnumsurfel
72  INTEGER, POINTER, DIMENSION(:,:) :: nodeflag2d
73  INTEGER :: itestcnt
74 
75 ! User-defined list element
76 ! The Link_Type field MUST be the FIRST in the user-defined list element
77 ! Note pointer to data so as to easily create sublists
78 
79  TYPE user_type_surfndlist
80  TYPE(link_type) :: link
81  TYPE(user_data_type_procnodelist), POINTER :: data
82  END TYPE user_type_surfndlist
83 
84  TYPE user_data_type_surfndlist
85  INTEGER :: glbndnum
86  END TYPE user_data_type_surfndlist
87 
88 ! Auxilliary data type required for the transfer function
89  TYPE user_ptr_type_surfndlist
90  TYPE(user_type_surfndlist), POINTER :: p
91  END TYPE user_ptr_type_surfndlist
92 
93  TYPE(user_ptr_type_surfndlist) :: user_surfndlist
94  TYPE(list_type) :: surfndlist
95 
96  TYPE(link_ptr_type) :: link
97 
98  TYPE(surfmesh_tri3_ptr),POINTER :: ptrtri3
99  TYPE(surfmesh_tri6_ptr), POINTER :: ptrtri6
100  TYPE(surfmesh_hex8_ptr), POINTER :: ptrhex8
101 
102  INTEGER, POINTER, DIMENSION(:) :: bcsurfflagzero,bcsurfflagone,bcsurfflagtwo
103 
104 
105  CHARACTER(*), PARAMETER :: surwin = "sfrac"
106 
107  REAL*8, POINTER, DIMENSION(:,:) :: meshcoor
108 
109  INTEGER, POINTER, DIMENSION(:) :: elflag_list
110  INTEGER, POINTER, DIMENSION(:) :: faceoncell
111 
112  INTEGER :: write_attr, set_option, ierrflg, sur_all
113 
114  INTEGER :: inb, ibu, ini
115 
116 ! INTEGER :: NodeFlagOrg(1:numnp_prmry)
117 
118  ini = iprocs*100 + 3
119 
120 ! obtain function handle ------------------------------------------------------
121 
122  write_attr = com_get_function_handle( 'OUT.write_attribute')
123  set_option = com_get_function_handle( 'OUT.set_option')
124 
125 
126 
127  print*,'Overlay processor', iprocs - 1
128  WRITE(456,*) iprocs - 1
129 
130 ! NodeFlagOrg(1:numnp_prmry) = NodeFlag(1:numnp_prmry)
131 
132 
133 ! --------------------------------------------------
134 ! ------------------------------------------------
135 ! (1) Non Fluid/Structure Overlay
136 ! ---------------------------------------
137 ! -------------------------------------
138 
139 ! renumber elements nodes
140 
141  CALL com_new_window( surwin)
142 
143 !!$ IF(MeshType2D.EQ.6)THEN
144 !!$
145 !!$ NumNpNew = 0
146 !!$ NULLIFY(ptrtri6)
147 !!$! renumber elements nodes
148 !!$ ptrtri6 => SurfMesh_tri6_S_head
149 !!$
150 !!$ DO WHILE(ASSOCIATED(ptrtri6))
151 !!$! mark that changed surface mesh by changing it to a negative
152 !!$ DO i = 1, 6
153 !!$ glbNdNum = ptrtri6%ElemData(i)
154 !!$ IF( NodeFlag(glbNdNum).GT.0) THEN ! if zero means not on this processor
155 !!$ NumNpNew = NumNpNew + 1
156 !!$ NodeFlag(glbNdNum) = -NodeFlag(glbNdNum)
157 !!$ ENDIF
158 !!$ ENDDO
159 !!$ ptrtri6 => ptrtri6%next
160 !!$ ENDDO
161 !!$
162 !!$
163 !!$! check for special situation where there is just an edge on the surface
164 !!$
165 !!$ ptrtri6 => SurfMesh_tri6_S_head
166 !!$ do while(associated(ptrtri6))
167 !!$ DO i = 1, 6
168 !!$ glbNdNum = ptrtri6%ElemData(i)
169 !!$ DO k = 1,MaxNumberOfProcsToShareNode
170 !!$ IF(ProcNdList(glbNdNum,k).EQ.iProcs.AND.NodeFlag(glbNdNum).GT.0)THEN
171 !!$ PRINT*,'Dectected surface sliver for pressure'
172 !!$ NumNpNew = NumNpNew + 1
173 !!$ NodeFlag(glbNdNum) = -NodeFlag(glbNdNum)
174 !!$ ENDIF
175 !!$ ENDDO
176 !!$ ENDDO
177 !!$ ptrtri6 => ptrtri6%next
178 !!$ ENDDO
179 !!$
180 !!$! WRITE(4002,'(2i10)') NumNpNew, NumEltet2D(2,iProcs)
181 !!$! write(4003,*) 'ZONE N=', NumNPNew, 'E=',NumEltet2D(2,iProcs),'F=FEPOINT, ET=TRIANGLE'
182 !!$
183 !!$ NodeFlag(:)= ABS( NodeFlag(:)) ! reset
184 !!$
185 !!$ ALLOCATE(NodeFlag2D(1:2,1:NumNpNew)) ! for storing what I'm overwriting
186 !!$
187 !!$ NumNpNew = 0
188 !!$! renumber elements nodes
189 !!$
190 !!$ ptrtri6 => SurfMesh_tri6_S_head
191 !!$
192 !!$ do while(associated(ptrtri6))
193 !!$! mark that changed surface mesh by changing it to a negative
194 !!$ DO i = 1, 6
195 !!$ glbNdNum = ptrtri6%ElemData(i)
196 !!$ IF( NodeFlag(glbNdNum).GT.0) THEN ! if zero means not on this processor
197 !!$ NumNpNew = NumNpNew + 1
198 !!$! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
199 !!$! write(4003,*) coor(1:3,glbNdNum)
200 !!$ NodeFlag2D(1,NumNpNew) = glbNdNum
201 !!$ NodeFlag2D(2,NumNpNew) = NodeFlag(glbNdNum)
202 !!$ NodeFlag(ptrtri6%ElemData(i)) = - NumNpNew
203 !!$ endif
204 !!$ enddo
205 !!$ ptrtri6 => ptrtri6%next
206 !!$ ENDDO
207 !!$ ptrtri6 => SurfMesh_tri6_S_head
208 !!$ do while(associated(ptrtri6))
209 !!$ DO i = 1, 6
210 !!$ glbNdNum = ptrtri6%ElemData(i)
211 !!$ DO k = 1,MaxNumberOfProcsToShareNode
212 !!$ IF(ProcNdList(glbNdNum,k).EQ.iProcs.AND.NodeFlag(glbNdNum).GT.0)THEN
213 !!$ PRINT*,'Dectected surface sliver for pressure'
214 !!$ NumNpNew = NumNpNew + 1
215 !!$! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
216 !!$ NodeFlag2D(1,NumNpNew) = glbNdNum
217 !!$ NodeFlag2D(2,NumNpNew) = NodeFlag(glbNdNum)
218 !!$ NodeFlag(glbNdNum) = - NumNpNew
219 !!$ ENDIF
220 !!$ ENDDO
221 !!$ ENDDO
222 !!$ ptrtri6 => ptrtri6%next
223 !!$ ENDDO
224 !!$
225 !!$
226 !!$ CALL COM_new_attribute( surWin//'.nc', 'n', COM_DOUBLE, 3, 'm')
227 !!$ CALL COM_set_size( surWin//'.nc', iNI, NumNpNew )
228 !!$ CALL COM_allocate_array(surWin//'.nc', iNI, MeshCoor, 3)
229 !!$
230 !!$ DO i = 1, NumNpNew
231 !!$ MeshCoor(1:3,i) = coor(1:3,NodeFlag2D(1,i))
232 !!$ END DO
233 !!$
234 !!$
235 !!$ CALL COM_new_attribute( surWin//'.bv', 'n', COM_INTEGER, 1, '')
236 !!$! CALL COM_set_size( surWin//'.bv', iNI, NumNpNew )
237 !!$ CALL COM_set_array( surWin//'.bv', iNI, NodeFlag2D(2,1), 2)
238 !!$
239 !!$
240 !!$! connectiveity
241 !!$ TestNumSurfEl = NumEltet2D(2,iProcs)
242 !!$ PRINT*,'Number of Non-Interacting nodes and elements',NumNpNew,TestNumSurfEl
243 !!$
244 !!$ CALL COM_set_size( surWin//'.:t6', iNI, TestNumSurfEl)
245 !!$ CALL COM_allocate_array( surWin//'.:t6', iNI, ElConnTable, 6)
246 !!$
247 !!$
248 !!$ CALL COM_new_attribute( surWin//'.bf2c', 'e', COM_INTEGER, 1, '')
249 !!$ CALL COM_allocate_array(surWin//'.bf2c', iNI, ElFlag_List, 1)
250 !!$
251 !!$ CALL COM_new_attribute( surWin//'.bcflag', 'p', COM_INTEGER, 1, '')
252 !!$ CALL COM_set_size( surWin//'.bcflag', iNI, 1)
253 !!$ CALL COM_allocate_array(surWin//'.bcflag', iNI, BCSurfFlagTwo, 1)
254 !!$
255 !!$ BCSurfFlagTwo(1) = 2
256 !!$
257 !!$ TestNumSurfEl = 0
258 !!$ ptrtri6 => SurfMesh_tri6_S_head
259 !!$ do while(associated(ptrtri6))
260 !!$ SurfaceElOnProc = .false.
261 !!$ IF(epart(ptrtri6%ElemData(7)).EQ.iProcs) SurfaceElOnProc = .TRUE.
262 !!$ TestNumSurfEl = TestNumSurfEl + 1
263 !!$ ElConnTable(1:6,TestNumSurfEl) = ABS(NodeFlag(ptrtri6%ElemData(1:6)))
264 !!$ ENDIF
265 !!$ ptrtri6 => ptrtri6%next
266 !!$ ENDDO
267 !!$
268 !!$ IF(TestNumSurfEl.NE.NumEltet2D(2,iProcs))THEN
269 !!$ PRINT*,'ERROR, number of triangles from link list in Mesh2d'
270 !!$ PRINT*,' different then that in read_patran'
271 !!$ PRINT*,TestNumSurfEl,NumEltet2D(2,iProcs)
272 !!$ STOP
273 !!$ ENDIF
274 !!$
275 !!$ NULLIFY(ptrtri6) ! obtain function handle ------------------------------------------------------
276 
277 ! write_attr = COM_get_function_handle( 'OUT.write_attribute')
278 ! set_option = COM_get_function_handle( 'OUT.set_option')
279 
280 ! IF(iProcs.EQ.1)THEN
281 
282 ! CALL COM_call_function( set_option, 2, 'mode', 'w')
283 
284 ! ELSE
285 
286 ! CALL COM_call_function( set_option, 2, 'mode', 'a')
287 
288 ! ENDIF
289 
290 ! do not append process rank -----------------
291 
292 ! CALL COM_call_function( set_option, 2, 'rankwidth', '0')
293 
294 ! write surface window ------------------------
295 
296 ! sur_all = Com_get_attribute_handle( surWin//'.all')
297 ! CALL COM_call_function( write_attr, 4, 'Rocin/SurfMesh_S.hdf', sur_all,&
298 ! "solid_surf","00.000000")
299 
300 
301 
302 
303 !!$ ELSE IF(MeshType2D.EQ.4)THEN
304 !!$
305 !!$
306 !!$ NumNpNew = 0
307 !!$ NULLIFY(ptrhex8)
308 !!$! renumber elements nodes
309 !!$
310 !!$ ptrhex8 => SurfMesh_hex8_S_head
311 !!$
312 !!$ DO WHILE(ASSOCIATED(ptrhex8))
313 !!$! mark that changed surface mesh by changing it to a negative
314 !!$ DO i = 1, 4
315 !!$ glbNdNum = ptrhex8%ElemData(i)
316 !!$ IF( NodeFlag(glbNdNum).GT.0) THEN ! if zero means not on this processor, neg means already renumber node
317 !!$ NumNpNew = NumNpNew + 1
318 !!$ NodeFlag(glbNdNum) = -NodeFlag(glbNdNum) ! overwrite nodeflag here but i need it for non S/F interface
319 !!$ ENDIF
320 !!$ ENDDO
321 !!$ ptrhex8 => ptrhex8%next
322 !!$ ENDDO
323 !!$
324 !!$
325 !!$ IF(NumElhex2D(2,iProcs).NE.0.AND.NumNpNew.EQ.0)THEN
326 !!$ PRINT*,'ERROR, found in surface mesh for Solid/Fluid interface'
327 !!$ PRINT*,'Found ',NumElhex2D(2,iProcs),'quads but no nodes'
328 !!$ PRINT*,'Stopping'
329 !!$ STOP
330 !!$ ENDIF
331 !!$
332 !!$ IF(NumElhex2D(2,iProcs).EQ.0.AND.NumNpNew.NE.0)THEN
333 !!$ PRINT*,'Warning: found in sufrace mesh for Solid/Fluid interface'
334 !!$ PRINT*,'Found ',NumNpNew,' nodes but no quads'
335 !!$ ENDIF
336 !!$
337 !!$! write the surface mesh files
338 !!$
339 !!$! WRITE(4002,'(2i10)') NumNpNew, NumElhex2D(2,iProcs)
340 !!$
341 !!$ NodeFlag(:)= ABS( NodeFlag(:)) ! reset
342 !!$
343 !!$ ALLOCATE(NodeFlag2D(1:2,1:NumNpNew)) ! for storing what I'm overwriting
344 !!$ NumNpNew = 0
345 !!$! renumber elements nodes
346 !!$
347 !!$ ptrhex8 => SurfMesh_hex8_S_head
348 !!$ do while(associated(ptrhex8))
349 !!$! mark that changed surface mesh by changing it to a negative
350 !!$ DO i = 1, 4
351 !!$ glbNdNum = ptrhex8%ElemData(i)
352 !!$ IF( NodeFlag(glbNdNum).GT.0) THEN ! if zero means not on this processor
353 !!$ NumNpNew = NumNpNew + 1
354 !!$! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
355 !!$ NodeFlag2D(1,NumNpNew) = glbNdNum
356 !!$ NodeFlag2D(2,NumNpNew) = NodeFlag(glbNdNum)
357 !!$ NodeFlag(glbNdNum) = - NumNpNew
358 !!$ endif
359 !!$ enddo
360 !!$ ptrhex8 => ptrhex8%next
361 !!$ ENDDO
362 !!$
363 !!$ CALL COM_new_attribute( surWin//'.nc', 'n', COM_DOUBLE, 3, 'm')
364 !!$ CALL COM_set_size( surWin//'.nc', iNI, NumNpNew )
365 !!$ CALL COM_allocate_array(surWin//'.nc', iNI, MeshCoor, 3)
366 !!$
367 !!$ DO i = 1, NumNpNew
368 !!$ MeshCoor(1:3,i) = coor(1:3,NodeFlag2D(1,i))
369 !!$ END DO
370 !!$
371 !!$
372 !!$ CALL COM_new_attribute( surWin//'.bv', 'n', COM_INTEGER, 1, '')
373 !!$! CALL COM_set_size( surWin//'.bv', iNI, NumNpNew )
374 !!$ CALL COM_set_array( surWin//'.bv', iNI, NodeFlag2D(2,1), 2)
375 !!$
376 !!$
377 !!$! connectivity
378 !!$ TestNumSurfEl = NumElhex2D(2,iProcs)
379 !!$ PRINT*,'Number of Non-Interacting nodes and elements',NumNpNew,TestNumSurfEl
380 !!$
381 !!$ CALL COM_set_size( surWin//'.:q4', iNI, TestNumSurfEl)
382 !!$ CALL COM_allocate_array( surWin//'.:q4', iNI, ElConnTable, 4)
383 !!$
384 !!$
385 !!$ CALL COM_new_attribute( surWin//'.bf2c', 'e', COM_INTEGER, 1, '')
386 !!$ CALL COM_allocate_array(surWin//'.bf2c', iNI, ElFlag_List, 1)
387 !!$
388 !!$ CALL COM_new_attribute( surWin//'.bcflag', 'p', COM_INTEGER, 1, '')
389 !!$ CALL COM_set_size( surWin//'.bcflag', iNI, 1)
390 !!$ CALL COM_allocate_array(surWin//'.bcflag', iNI, BCSurfFlagTwo, 1)
391 !!$
392 !!$
393 !!$ BCSurfFlagTwo(1) = 2
394 !!$! connectivity
395 !!$ NULLIFY(ptrhex8)
396 !!$ TestNumSurfEl = 0
397 !!$
398 !!$ ptrhex8 => SurfMesh_hex8_S_head
399 !!$ do while(associated(ptrhex8))
400 !!$ SurfaceElOnProc = .false.
401 !!$ IF(epart(ptrhex8%ElemData(5)).EQ.iProcs) SurfaceElOnProc = .TRUE.
402 !!$ IF(SurfaceElOnProc)THEN
403 !!$! WRITE(4002,'(10i10)') ABS(NodeFlag(ptrhex8%ElemData(1:4))),&
404 !!$! ElFlag(ptrhex8%ElemData(5)),1,1 ! last two are not really used
405 !!$ TestNumSurfEl = TestNumSurfEl + 1
406 !!$
407 !!$ ElConnTable(1:4,TestNumSurfEl) = ABS(NodeFlag(ptrhex8%ElemData(1:4)))
408 !!$ ENDIF
409 !!$ ptrhex8 => ptrhex8%next
410 !!$ ENDDO
411 !!$
412 !!$ IF(TestNumSurfEl.NE.NumElhex2D(2,iProcs))THEN
413 !!$ PRINT*,'Error: Number of Solid Surface hex elements in linked list'
414 !!$ PRINT*,' does not match that given by NumElhex2D(2,iProcs)'
415 !!$ PRINT*,' In linked list =',TestNumSurfEl
416 !!$ PRINT*,' NumElhex2D(2,iProcs) =',NumElhex2D(2,iProcs)
417 !!$ PRINT*,'Stopping'
418 !!$ ENDIF
419 !!$
420 !!$ NULLIFY(ptrhex8)
421 !!$
422 !!$ IF(associated(NodeFlag2D)) deallocate(NodeFlag2D)
423 !!$
424 !!$ ENDIF
425 
426  ! write surface window ------------------------
427 !!$ CALL COM_call_function( set_option, 2, 'mode', 'a')
428 !!$
429 !!$ sur_all = Com_get_attribute_handle( SurWin//'.all')
430 !!$
431 !!$ CALL COM_call_function( write_attr, 4, 'Rocin/SurfMesh.'//ichr4, sur_all,&
432 !!$ "isolid","00.000000")
433 
434  IF(meshtype2d.EQ.3)THEN
435 
436  numnpnew = 0
437  nullify(ptrtri3)
438 ! renumber elements nodes
439 
440  ptrtri3 => surfmesh_tri3_ov1_head
441 
442  do while(associated(ptrtri3))
443 ! mark that changed surface mesh by changing it to a negative
444  DO i = 1, 3
445  glbndnum = ptrtri3%ElemData(i)
446  IF( nodeflag(glbndnum).GT.0) THEN ! if zero means not on this processor
447  numnpnew = numnpnew + 1
448  nodeflag(glbndnum) = -nodeflag(glbndnum)
449  endif
450  enddo
451  ptrtri3 => ptrtri3%next
452  ENDDO
453 
454 
455 ! check for special situation where there is just an edge on the surface
456 
457  ptrtri3 => surfmesh_tri3_ov1_head
458  do while(associated(ptrtri3))
459  DO i = 1, 3
460  glbndnum = ptrtri3%ElemData(i)
461  DO k = 1,maxnumberofprocstosharenode
462  IF(procndlist(glbndnum,k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)THEN
463  print*,'Dectected surface sliver for pressure'
464  numnpnew = numnpnew + 1
465  nodeflag(glbndnum) = -nodeflag(glbndnum)
466  ENDIF
467  ENDDO
468  ENDDO
469  ptrtri3 => ptrtri3%next
470  ENDDO
471 ! WRITE(4002,'(2i10)') NumNpNew, NumEltet2D(2,iProcs)
472 ! write(4003,*) 'ZONE N=', NumNPNew, 'E=',NumEltet2D(2,iProcs),'F=FEPOINT, ET=TRIANGLE'
473 
474  nodeflag(:)= abs( nodeflag(:)) ! reset
475 
476  ALLOCATE(nodeflag2d(1:2,1:numnpnew)) ! for storing what I'm overwriting
477 
478  numnpnew = 0
479 ! renumber elements nodes
480 
481  ptrtri3 => surfmesh_tri3_ov1_head
482 
483  do while(associated(ptrtri3))
484 ! mark that changed surface mesh by changing it to a negative
485  DO i = 1, 3
486  glbndnum = ptrtri3%ElemData(i)
487  IF( nodeflag(glbndnum).GT.0) THEN ! if zero means not on this processor
488  numnpnew = numnpnew + 1
489 ! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
490 ! write(4003,*) coor(1:3,glbNdNum)
491  nodeflag2d(1,numnpnew) = glbndnum
492  nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
493  nodeflag(ptrtri3%ElemData(i)) = - numnpnew
494  endif
495  enddo
496  ptrtri3 => ptrtri3%next
497  ENDDO
498  ptrtri3 => surfmesh_tri3_ov1_head
499  do while(associated(ptrtri3))
500  DO i = 1, 3
501  glbndnum = ptrtri3%ElemData(i)
502  DO k = 1,maxnumberofprocstosharenode
503  IF(procndlist(glbndnum,k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)THEN
504  print*,'Dectected surface sliver for pressure'
505  numnpnew = numnpnew + 1
506 ! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
507  nodeflag2d(1,numnpnew) = glbndnum
508  nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
509  nodeflag(ptrtri3%ElemData(i)) = - numnpnew
510  ENDIF
511  ENDDO
512  ENDDO
513  ptrtri3 => ptrtri3%next
514  ENDDO
515 
516 
517  CALL com_new_attribute( surwin//'.nc', 'n', com_double, 3, 'm')
518  CALL com_set_size( surwin//'.nc', ini, numnpnew )
519  CALL com_allocate_array(surwin//'.nc', ini, meshcoor, 3)
520 
521  DO i = 1, numnpnew
522  meshcoor(1:3,i) = coor(1:3,nodeflag2d(1,i))
523  END DO
524 
525 !!$ CALL COM_new_attribute( surWin//'.bv', 'n', COM_INTEGER, 1, '')
526 !!$ CALL COM_set_size( surWin//'.bv', iNI, NumNpNew )
527 !!$ CALL COM_set_array( surWin//'.bv', iNI, NodeFlag2D(2,1), 2)
528 
529 
530 ! connectiveity
531  testnumsurfel = numeltet2d(4,iprocs) !0
532 
533 
534  CALL com_set_size( surwin//'.:t3', ini, testnumsurfel)
535  CALL com_allocate_array( surwin//'.:t3', ini, elconntable, 3)
536 
537 !!$ CALL COM_new_attribute( surWin//'.bf2c', 'e', COM_INTEGER, 1, '')
538 !!$ CALL COM_allocate_array(surWin//'.bf2c', iNI, ElFlag_List, 1)
539 !!$
540 !!$ CALL COM_new_attribute( surWin//'.faceOnCell', 'e', COM_INTEGER, 1, '')
541 !!$ CALL COM_allocate_array(surWin//'.faceOnCell', iNI, FaceOnCell, 1)
542 
543  WRITE(456,*) numeltet2d(4,iprocs)
544 
545  testnumsurfel = 0
546  ptrtri3 => surfmesh_tri3_ov1_head
547  do while(associated(ptrtri3))
548  surfaceelonproc = .false.
549 !!$ do i = 1, 3
550 !!$ IF(NodeFlag(ptrtri3%ElemData(i)).eq.0)THEN
551 !!$ SurfaceElOnProc = .false.
552 !!$ exit
553 !!$ endif
554 !!$ enddo
555  IF(epart(ptrtri3%ElemData(4)).EQ.iprocs) surfaceelonproc = .true.
556  IF(surfaceelonproc) THEN
557  ! WRITE(4002,'(10i10)') ABS(NodeFlag(ptrtri3%ElemData(1:3))),&
558  ! ElFlag(ptrtri3%ElemData(4)),2,1 ! last two are not really used
559 !!$ IF(SurfaceElOnProc) THEN
560 !!$ write(4003,*) ABS(NodeFlag(ptrtri3%ElemData(1:6)))
561 !!$ ENDIF
562  testnumsurfel = testnumsurfel + 1
563  elconntable(1:3,testnumsurfel) = abs(nodeflag(ptrtri3%ElemData(1:3)))
564 
565  WRITE(456,*) elflag(ptrtri3%ElemData(4)),ptrtri3%ElemData(5)
566 ! ElFlag_List(TestNumSurfEl) = ElFlag(ptrtri3%ElemData(4))
567 ! FaceOnCell(TestNumSurfEl) = ElFlag(ptrtri3%ElemData(5))
568  ENDIF
569  ptrtri3 => ptrtri3%next
570  ENDDO
571 
572  IF(testnumsurfel.NE.numeltet2d(4,iprocs))THEN
573  print*,'ERROR, number of triangles from link list in Mesh2d'
574  print*,' different then that in read_patran'
575  print*,testnumsurfel,numeltet2d(4,iprocs)
576  stop
577  ENDIF
578 
579 
580 
581  IF(iprocs.EQ.1)THEN
582 
583  CALL com_call_function( set_option, 2, 'mode', 'w')
584 
585  ELSE
586 
587  CALL com_call_function( set_option, 2, 'mode', 'a')
588 
589  ENDIF
590 
591 
592 ! do not append process rank -----------------
593 
594  CALL com_call_function( set_option, 2, 'rankwidth', '0')
595 
596 ! write surface window ------------------------
597 
598  sur_all = com_get_attribute_handle( surwin//'.all')
599  CALL com_call_function( write_attr, 4, 'Rocin/A_SurfMesh_Ov.hdf', sur_all,&
600  "solid_surf","00.000000")
601 
602 
603  ! Correct the NodeFlag values that were over written
604 
605  numnpnew = 0
606 ! renumber elements nodes
607 
608  ptrtri3 => surfmesh_tri3_ov1_head
609 
610  DO WHILE(ASSOCIATED(ptrtri3))
611  DO i = 1, 3
612  glbndnum = ptrtri3%ElemData(i)
613  IF( nodeflag(glbndnum).LT.0) THEN ! if zero means not on this processor
614  numnpnew = numnpnew + 1
615  nodeflag(ptrtri3%ElemData(i)) = nodeflag2d(2,numnpnew)
616  endif
617  enddo
618  ptrtri3 => ptrtri3%next
619  ENDDO
620 
621 ! fix you need to but silever here if keeping that section
622 
623  IF(ASSOCIATED(nodeflag2d)) DEALLOCATE(nodeflag2d)
624  ENDIF
625 
626  ! write surface window ------------------------
627 !!$ CALL COM_call_function( set_option, 2, 'mode', 'a')
628 !!$
629 !!$ sur_all = Com_get_attribute_handle( SurWin//'.all')
630 !!$
631 !!$ CALL COM_call_function( write_attr, 4, 'Rocin/SurfMesh_ov.'//ichr4, sur_all,&
632 !!$ "isolid","00.000000")
633 
634  CALL com_delete_window( surwin)
635 
636 
637  CALL com_new_window( surwin)
638 
639 !!$ DO i = 1, numnp_prmry
640 !!$ IF(NodeFlag(i).NE.NodeFlagOrg(i)) PRINT*,'lkjlk',NodeFlag(i), NodeFlagOrg(i)
641 !!$ stop
642 !!$ ENDDO
643 
644  IF(meshtype2d.EQ.3)THEN
645 
646  numnpnew = 0
647  nullify(ptrtri3)
648 ! renumber elements nodes
649 
650  ptrtri3 => surfmesh_tri3_ov2_head
651 
652  DO WHILE(ASSOCIATED(ptrtri3))
653 ! mark that changed surface mesh by changing it to a negative
654  DO i = 1, 3
655  glbndnum = ptrtri3%ElemData(i)
656  print*,glbndnum
657  IF( nodeflag(glbndnum).GT.0) THEN ! if zero means not on this processor
658  numnpnew = numnpnew + 1
659  nodeflag(glbndnum) = -nodeflag(glbndnum)
660  endif
661  enddo
662  ptrtri3 => ptrtri3%next
663  ENDDO
664 
665  print*,'NumNpNew',numnpnew
666 
667 
668 ! check for special situation where there is just an edge on the surface
669 
670  ptrtri3 => surfmesh_tri3_ov2_head
671  do while(associated(ptrtri3))
672  DO i = 1, 3
673  glbndnum = ptrtri3%ElemData(i)
674  DO k = 1,maxnumberofprocstosharenode
675  IF(procndlist(glbndnum,k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)THEN
676  print*,'Dectected surface sliver for pressure'
677  numnpnew = numnpnew + 1
678  nodeflag(glbndnum) = -nodeflag(glbndnum)
679  ENDIF
680  ENDDO
681  ENDDO
682  ptrtri3 => ptrtri3%next
683  ENDDO
684 
685 ! WRITE(4002,'(2i10)') NumNpNew, NumEltet2D(2,iProcs)
686 ! write(4003,*) 'ZONE N=', NumNPNew, 'E=',NumEltet2D(2,iProcs),'F=FEPOINT, ET=TRIANGLE'
687 
688  nodeflag(:)= abs( nodeflag(:)) ! reset
689  ALLOCATE(nodeflag2d(1:2,1:numnpnew)) ! for storing what I'm overwriting
690 
691  numnpnew = 0
692 ! renumber elements nodes
693 
694  ptrtri3 => surfmesh_tri3_ov2_head
695 
696  DO WHILE(ASSOCIATED(ptrtri3))
697 ! mark that changed surface mesh by changing it to a negative
698  DO i = 1, 3
699  glbndnum = ptrtri3%ElemData(i)
700  IF( nodeflag(glbndnum).GT.0) THEN ! if zero means not on this processor
701  numnpnew = numnpnew + 1
702 ! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
703 ! write(4003,*) coor(1:3,glbNdNum)
704  nodeflag2d(1,numnpnew) = glbndnum
705  nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
706  nodeflag(ptrtri3%ElemData(i)) = - numnpnew
707  endif
708  enddo
709  ptrtri3 => ptrtri3%next
710  ENDDO
711  ptrtri3 => surfmesh_tri3_ov2_head
712  do while(associated(ptrtri3))
713  DO i = 1, 3
714  glbndnum = ptrtri3%ElemData(i)
715  DO k = 1,maxnumberofprocstosharenode
716  IF(procndlist(glbndnum,k).EQ.iprocs.AND.nodeflag(glbndnum).GT.0)THEN
717  print*,'Dectected surface sliver for pressure'
718  numnpnew = numnpnew + 1
719 ! WRITE(4002,'(3(x,e16.9),1i10)') coor(1:3,glbNdNum),NodeFlag(glbNdNum)
720  nodeflag2d(1,numnpnew) = glbndnum
721  nodeflag2d(2,numnpnew) = nodeflag(glbndnum)
722  nodeflag(ptrtri3%ElemData(i)) = - numnpnew
723  ENDIF
724  ENDDO
725  ENDDO
726  ptrtri3 => ptrtri3%next
727  ENDDO
728 
729 
730 
731  CALL com_new_attribute( surwin//'.nc', 'n', com_double, 3, 'm')
732  CALL com_set_size( surwin//'.nc', ini, numnpnew )
733  CALL com_allocate_array(surwin//'.nc', ini, meshcoor, 3)
734 
735  DO i = 1, numnpnew
736  print*,coor(1:3,nodeflag2d(1,i))
737  meshcoor(1:3,i) = coor(1:3,nodeflag2d(1,i))
738  END DO
739 
740 
741 ! connectiveity
742  testnumsurfel = numeltet2d(5,iprocs) !0
743 
744  CALL com_set_size( surwin//'.:t3', ini, testnumsurfel)
745  CALL com_allocate_array( surwin//'.:t3', ini, elconntable, 3)
746 
747  WRITE(456,*) numeltet2d(5,iprocs)
748 
749  testnumsurfel = 0
750  ptrtri3 => surfmesh_tri3_ov2_head
751 
752  DO WHILE(ASSOCIATED(ptrtri3))
753  surfaceelonproc = .false.
754  IF(epart(ptrtri3%ElemData(4)).EQ.iprocs) surfaceelonproc = .true.
755  IF(surfaceelonproc) THEN
756  testnumsurfel = testnumsurfel + 1
757  elconntable(1:3,testnumsurfel) = abs(nodeflag(ptrtri3%ElemData(1:3)))
758  WRITE(456,*) elflag(ptrtri3%ElemData(4)),ptrtri3%ElemData(5)
759 !!$ ! ElFlag_List(TestNumSurfEl) = ElFlag(ptrtri3%ElemData(4))
760 !!$ ! FaceOnCell(TestNumSurfEl) = ElFlag(ptrtri3%ElemData(5))
761  ENDIF
762  ptrtri3 => ptrtri3%next
763  ENDDO
764 
765  IF(testnumsurfel.NE.numeltet2d(5,iprocs))THEN
766  print*,'ERROR, number of triangles from link list in Mesh2d'
767  print*,' different then that in read_patran'
768  print*,testnumsurfel,numeltet2d(5,iprocs)
769  stop
770  ENDIF
771 
772  IF(iprocs.EQ.1)THEN
773 
774  CALL com_call_function( set_option, 2, 'mode', 'w')
775 
776  ELSE
777 
778  CALL com_call_function( set_option, 2, 'mode', 'a')
779 
780  ENDIF
781 
782 
783 ! do not append process rank -----------------
784 
785  CALL com_call_function( set_option, 2, 'rankwidth', '0')
786 
787 ! write surface window ------------------------
788 
789  sur_all = com_get_attribute_handle( surwin//'.all')
790 
791 
792  CALL com_call_function( write_attr, 4, 'Rocin/B_SurfMesh_Ov.hdf', sur_all,&
793  "solid_surf","00.000000")
794 
795 
796  ENDIF
797 
798 
799  CALL com_delete_window( surwin)
800 
801 
802  IF(ASSOCIATED(nodeflag2d)) DEALLOCATE(nodeflag2d)
803 
804 END SUBROUTINE mesh2doverlay
805 
Rocout::set_option
void set_option(const char *option_name, const char *option_val)
Set an option for Rocout, such as controlling the output format.
Definition: Rocout.C:552
k
j indices k indices k
Definition: Indexing.h:6
linked_list2
Definition: SourceIMP/utilities/RocfracPrep/Linked_List2.f90:53
write_attr
static void write_attr(std::ostream &os, const COM::Attribute *attr, int i)
Definition: RFC_Window_base_IO_tecplot.C:55
i
blockLoc i
Definition: read.cpp:79
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
mesh2doverlay
subroutine mesh2doverlay(nprocs, iProcs, ichr4)
Definition: SourceIMP/utilities/RocfracPrep/2DmeshOverlay.f90:53
meshdata::user_data_type_procnodelist
Definition: SourceIMP/utilities/RocfracPrep/meshdata.f90:299