Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
MP/Source/RocFracSubInterface.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 MODULE rocfracsubinterface
54 
55  USE rocstar_rocfracinterp
56  USE rocstar_rocfrac
57 
58  PUBLIC :: rocfracinterfaceinitial, rocfracinterfaceupdate,readsdv
59 
60 CONTAINS
61 
62  SUBROUTINE rocfracinterfaceinitial( glb,obtain_attr,surfIn)
63 
64  IMPLICIT NONE
65  include 'mpif.h'
66  include 'roccomf90.h'
67  TYPE(rocfrac_global) :: glb
68  INTEGER :: myid, numprocs, ierror
69  CHARACTER(*), INTENT(IN) :: surfin
70  INTEGER, INTENT(IN) :: obtain_attr
71  INTEGER :: npanes
72  INTEGER, POINTER, DIMENSION(:) :: paneids
73 
74  CHARACTER*9 :: timelevel
75  CHARACTER*120 :: frachdffname, meshfile
76 
77  INTEGER, POINTER :: zero, one, two
78  integer :: i,j, ierr
79  integer :: numeltypes2d
80  character(LEN=1), POINTER, DIMENSION(:) :: names
81  character(LEN=4) :: chreltype
82  integer :: endpt, startpt, chrlngth
83  integer :: pane, bcflag
84 
85  CALL mpi_comm_rank( glb%MPI_COMM_ROCFRAC, myid, ierror)
86  CALL mpi_comm_size( glb%MPI_COMM_ROCFRAC, numprocs, ierror)
87 
88 ! Subroutine to register interface data.
89 
90  WRITE (*,*) ' Calling RocFrac Register...'
91 
92 ! Get propellant density from Rocburn ! fix if more then one material
93  WRITE (*,*) 'Propellant density rho(1) is ', glb%rho(1)
94 
95 !!$ CALL COM_create_window(surWin)
96  CALL com_new_window(surwin)
97 
98 ! fix, should not this be allocated NumMaterials instead of 1 for more then one material
99  CALL com_new_attribute(surwin//'.rhos', 'w', com_double, 1, 'kg/m^3')
100  CALL com_set_array( surwin//'.rhos', 0, glb%rho,1 )
101 
102  CALL com_new_attribute(surwin//'.u', 'n', com_double, 3, 'm')
103  CALL com_new_attribute(surwin//'.vs', 'n', com_double, 3, 'm/s')
104  CALL com_new_attribute(surwin//'.uhat', 'n', com_double, 3, 'm')
105  CALL com_new_attribute(surwin//'.accel', 'n', com_double, 3, 'm/s^2')
106 
107  CALL com_new_attribute(surwin//'.ts_alp', 'e', com_double, 1, 'Pa')
108  CALL com_new_attribute(surwin//'.bv','n',com_integer, 1, '')
109  CALL com_new_attribute( surwin//'.bf2c', 'e', com_integer, 1, '')
110  CALL com_new_attribute( surwin//'.bcflag', 'p', com_integer, 1, '')
111 
112  IF (glb%HeatTransSoln) THEN
113  CALL com_new_attribute(surwin//'.qs', 'e', com_double, 1, 'W/m^2')
114  CALL com_new_attribute(surwin//'.Ts', 'n', com_double, 1, 'K')
115  ENDIF
116 
117 !!$ #OLD CALL COM_new_attribute(surWin//'.ts_alp', 'e', &
118 !!$ #OLD COM_DOUBLE_PRECISION, 3, 'Pa')
119 
120  IF ( glb%ALEenabled) CALL com_new_attribute( surwin//'.vbar_alp', 'n', com_double, 3, 'm/s')
121 
122  CALL com_get_panes( surfin, npanes, paneids)
123 
124 
125 
126  DO j = 1, npanes
127 
128  pane = paneids(j)
129 
130  CALL com_copy_array( surfin//'.bcflag', pane, bcflag)
131 
132 !!!!!!!!!!!!!!!!!!!!!! Burning Surface !!!!!!!!!!!!!!!!!!
133  IF(bcflag.EQ.1)THEN
134 
135  CALL com_get_size( surfin//".nc", pane, glb%InterfaceSFNumNodes)
136  CALL com_set_size( surwin//".nc", pane, glb%InterfaceSFNumNodes)
137  CALL com_set_size( surwin//'.bcflag', pane, 1)
138  CALL com_resize_array(surwin//'.bcflag', pane)
139 
140  CALL com_get_connectivities(surfin,pane,numeltypes2d,names)
141 
142  startpt = 1
143  DO i = 1, numeltypes2d
144  ! Search for the next attribute name
145  endpt = startpt
146  chrlngth = 0
147  DO WHILE (endpt .LE. ubound(names,1))
148  IF (names(endpt) .NE. ' ') THEN
149  chrlngth = chrlngth + 1
150  chreltype(chrlngth:chrlngth) = names(endpt)
151  endpt = endpt + 1
152  ELSE
153  EXIT
154  END IF
155  END DO
156 
157  startpt = endpt + 1
158 
159  IF(chreltype(1:chrlngth).EQ.':t6')THEN
160  CALL com_get_size( surfin//".:t6", pane, glb%InterfaceSFNumElems)
161  CALL com_set_size( surwin//".:t6", pane, glb%InterfaceSFNumElems)
162  glb%iElType2D = 6
163  ELSE IF(chreltype(1:chrlngth).EQ.':t3')THEN
164  CALL com_get_size( surfin//".:t3", pane, glb%InterfaceSFNumElems)
165  CALL com_set_size( surwin//".:t3", pane, glb%InterfaceSFNumElems)
166  glb%iElType2D = 3
167  ELSE IF(chreltype(1:chrlngth).EQ.':q4')THEN
168  CALL com_get_size( surfin//".:q4", pane, glb%InterfaceSFNumElems)
169  CALL com_set_size( surwin//".:q4", pane, glb%InterfaceSFNumElems)
170  glb%iElType2D = 4
171  ELSE
172  print*,'ROCFRAC ERROR: Surface mesh type element not supported'
173  print*,'Read in Element Type :: ', chreltype(1:chrlngth)
174  CALL mpi_finalize(glb%MPI_COMM_ROCFRAC,ierr)
175  ENDIF
176 
177  print*,'Element type', glb%iElType2D
178  END DO
179 
180  CALL com_free_buffer(names)
181 ! Fluids/Solids Interface Mesh
182 
183  ALLOCATE(glb%InterfaceSFNodalCoors(1:3,1:glb%InterfaceSFNumNodes))
184  ALLOCATE(glb%MapNodeSF(1:glb%InterfaceSFNumNodes))
185 
186  ALLOCATE(glb%InterfaceSFElemConn(1:glb%iElType2D,1:glb%InterfaceSFNumElems))
187  ALLOCATE(glb%MapSFElVolEl(1:glb%InterfaceSFNumElems))
188 
189 
190 ! -- The array's containing fluid-solid values
191 
192  ALLOCATE(glb%InterfaceSFNodalDisps(1:3,1:glb%InterfaceSFNumNodes))
193  ALLOCATE(glb%InterfaceSFNodalAccel(1:3,1:glb%InterfaceSFNumNodes))
194  ALLOCATE(glb%InterfaceSFTotalNodalDisps(1:3,1:glb%InterfaceSFNumNodes))
195  ALLOCATE(glb%InterfaceSFNodalVels(1:3,1:glb%InterfaceSFNumNodes))
196 !#OLD ALLOCATE(glb%InterfaceSFElemTract(1:3,1:glb%InterfaceSFNumElems))
197  ALLOCATE(glb%InterfaceSFElemTract(1:glb%InterfaceSFNumElems))
198 ! IF(glb%ALEenabled)THEN
199  ALLOCATE(glb%InterfaceSFVbar(1:3,1:glb%InterfaceSFNumNodes))
200 
201  IF(glb%HeatTransSoln)THEN
202  ALLOCATE(glb%InterfaceSFHeatFlux(1:glb%InterfaceSFNumElems))
203  glb%InterfaceSFHeatFlux(:) = glb%DummyFlux
204 
205  ALLOCATE(glb%InterfaceSFNodalTemp(1:glb%InterfaceSFNumNodes))
206  glb%InterfaceSFNodalTemp(:) = glb%Temperature0
207  ENDIF
208 ! ENDIF
209 
210  IF(glb%ipstatic)THEN
211  ALLOCATE(glb%pstatic(1:3,1:glb%InterfaceSFNumElems))
212  glb%pstatic(1:3,1:glb%InterfaceSFNumElems) = 0.d0
213  ENDIF
214  glb%InterfaceSFNodalDisps(:,:) = 0.d0
215  glb%InterfaceSFNodalAccel(:,:) = 0.d0
216  glb%InterfaceSFTotalNodalDisps(:,:) = 0.d0
217  glb%InterfaceSFNodalVels(:,:) = 0.d0
218  glb%InterfaceSFElemTract(:) = 0.d0
219 !#OLD glb%InterfaceSFElemTract(:,:) = 0.d0
220  glb%InterfaceSFVbar = 0.d0
221 
222  IF ( glb%InterfaceSFNumNodes > 0) THEN ! Fluid-solid interface
223 
224 ! Register Coordinates of 2D Fluid-solid interface
225 
226 !!$ CALL COM_init_mesh( surWin//'.nc', MyId+1, glb%InterfaceSFNodalCoors, glb%InterfaceSFNumNodes)
227 
228 
229 ! print*,'glb%InterfaceSFNumNodes', glb%InterfaceSFNumNodes
230 
231  CALL com_set_array( surwin//'.nc', pane, glb%InterfaceSFNodalCoors,3 )
232 !
233 ! Registering 2D Element Connectivity of Fluid-solid interface
234 !
235  IF(glb%iElType2D.EQ.3)THEN
236 !!$ CALL COM_init_mesh( surWin//'.t3', MyId+1, glb%InterfaceSFElemConn, glb%InterfaceSFNumElems)
237 
238 
239  CALL com_set_array( surwin//'.:t3', pane, glb%InterfaceSFElemConn,3)
240 
241  ELSE IF(glb%iElType2D.EQ.6)THEN
242 !!$ CALL COM_init_mesh( surWin//'.t6', MyId+1, glb%InterfaceSFElemConn, glb%InterfaceSFNumElems)
243  CALL com_set_array( surwin//'.:t6', pane, glb%InterfaceSFElemConn,6)
244 
245  ELSE IF(glb%iElType2D.EQ.4)THEN
246 !!$ CALL COM_init_mesh( surWin//'.q4', MyId+1, glb%InterfaceSFElemConn, glb%InterfaceSFNumElems)
247 
248  CALL com_set_array( surwin//'.:q4', pane, glb%InterfaceSFElemConn,4)
249 
250  ENDIF
251 
252  CALL com_set_array( surwin//'.bv', pane, glb%MapNodeSF,1)
253  CALL com_set_array(surwin//'.bf2c', pane, glb%MapSFElVolEl, 1)
254 
255  CALL com_set_array( surwin//'.accel',pane, glb%InterfaceSFNodalAccel,3)
256  CALL com_set_array( surwin//'.u',pane, glb%InterfaceSFNodalDisps,3)
257  CALL com_set_array( surwin//'.vs', pane, glb%InterfaceSFNodalVels,3)
258  CALL com_set_array( surwin//'.uhat', pane, glb%InterfaceSFTotalNodalDisps,3)
259 
260  CALL com_set_array( surwin//'.ts_alp', pane, glb%InterfaceSFElemTract, 1)
261 
262  IF (glb%ALEenabled) CALL com_set_array( surwin//'.vbar_alp', pane, glb%InterfaceSFVbar,3)
263 
264  IF (glb%HeatTransSoln)THEN
265  CALL com_set_array( surwin//'.qs', pane, glb%InterfaceSFHeatFlux, 1)
266  CALL com_set_array( surwin//'.Ts', pane, glb%InterfaceSFNodalTemp, 1)
267  ENDIF
268 
269  ENDIF
270 
271 !!!!!!!!!!!!!!!!!!!!!! Non-Interacting Surface !!!!!!!!!!!!!!!!!!
272  ELSE IF(bcflag.EQ.2)THEN
273 
274  CALL com_get_size( surfin//".nc", pane, glb%InterfaceSNumNodes)
275  CALL com_set_size( surwin//".nc", pane, glb%InterfaceSNumNodes)
276 
277  CALL com_set_size( surwin//'.bcflag', pane, 1)
278  CALL com_resize_array(surwin//'.bcflag', pane)
279 
280  CALL com_get_connectivities(surfin,pane,numeltypes2d,names)
281  startpt = 1
282  DO i = 1, numeltypes2d
283  ! Search for the next attribute name
284  endpt = startpt
285  chrlngth = 0
286  DO WHILE (endpt .LE. ubound(names,1))
287  IF (names(endpt) .NE. ' ') THEN
288  chrlngth = chrlngth + 1
289  chreltype(chrlngth:chrlngth) = names(endpt)
290  endpt = endpt + 1
291  ELSE
292  EXIT
293  END IF
294  END DO
295 
296  startpt = endpt + 1
297 
298  IF(chreltype(1:chrlngth).EQ.':t6')THEN
299  CALL com_get_size( surfin//".:t6", pane, glb%InterfaceSNumElems)
300  CALL com_set_size( surwin//".:t6", pane, glb%InterfaceSNumElems)
301  glb%iElType2D = 6
302  ELSE IF(chreltype(1:chrlngth).EQ.':t3')THEN
303  CALL com_get_size( surfin//".:t3", pane, glb%InterfaceSNumElems)
304  CALL com_set_size( surwin//".:t3", pane, glb%InterfaceSNumElems)
305  glb%iElType2D = 3
306  ELSE IF(chreltype(1:chrlngth).EQ.':q4')THEN
307  CALL com_get_size( surfin//".:q4", pane, glb%InterfaceSNumElems)
308  CALL com_set_size( surwin//".:q4", pane, glb%InterfaceSNumElems)
309  glb%iElType2D = 4
310  ELSE
311  print*,'ROCFRAC ERROR: Surface mesh type element not supported'
312  print*,'Read in Element Type :: ', chreltype(1:chrlngth)
313  CALL mpi_finalize(glb%MPI_COMM_ROCFRAC,ierr)
314  ENDIF
315 
316  END DO
317 !
318 ! Read No Solid/Fluid mesh
319 !
320  CALL com_free_buffer(names)
321 
322  ALLOCATE(glb%InterfaceSNodalCoors(1:3,1:glb%InterfaceSNumNodes))
323  ALLOCATE(glb%MapNodeS(1:glb%InterfaceSNumNodes))
324 
325  ALLOCATE(glb%InterfaceSVbar(1:3,1:glb%InterfaceSNumNodes))
326  glb%InterfaceSVbar = 0.d0
327 
328  ALLOCATE(glb%InterfaceSElemConn(1:glb%iElType2D,1:glb%InterfaceSNumElems))
329  IF(glb%EnforceTractionS)THEN
330  ALLOCATE(glb%MapSElVolEl(1:glb%InterfaceSNumElems))
331  ENDIF
332 
333  IF ( glb%InterfaceSNumNodes > 0) THEN ! Non-fluid-solid interface
334 
335 ! Register Coordinates of 2D Non-Fluid-solid interface
336 
337  CALL com_set_array( surwin//'.nc', pane, glb%InterfaceSNodalCoors,3)
338  IF(glb%iElType2D.EQ.3)THEN
339 
340  CALL com_set_array( surwin//'.:t3', pane, glb%InterfaceSElemConn,3)
341 
342  ELSE IF(glb%iElType2D.EQ.6)THEN
343 
344  CALL com_set_array( surwin//'.:t6', pane, glb%InterfaceSElemConn,6)
345 
346  ELSE IF(glb%iElType2D.EQ.4)THEN
347 
348  CALL com_set_array( surwin//'.:q4', pane, glb%InterfaceSElemConn,4)
349 
350  ENDIF
351  !fix, why was this numprocs+myid+1
352 ! IF(glb%ALEenabled) CALL COM_set_array( surWin//'.vbar_alp', NumProcs+pane, glb%InterfaceSVbar,3)
353 
354 
355  IF(glb%EnforceTractionS)THEN
356  CALL com_set_array(surwin//'.bf2c', pane, glb%MapSElVolEl, 1)
357  ENDIF
358 
359 !!$ CALL COM_set_array( surWin//'.u',pane, glb%InterfaceSNodalDisps,3)
360 !!$ CALL COM_set_array( surWin//'.vs', pane, glb%InterfaceSNodalVels,3)
361 !!$ CALL COM_set_array( surWin//'.uhat', pane, glb%InterfaceSTotalNodalDisps,3)
362 
363  CALL com_set_array( surwin//'.bv', pane, glb%MapNodeS,1)
364 
365  IF( glb%ALEenabled) CALL com_set_array( surwin//'.vbar_alp', pane, glb%InterfaceSVbar,3)
366 
367  ENDIF
368 
369 
370 !!!!!!!!!!!!!!!!!!!!!! Non-Burning Interacting Surface !!!!!!!!!!!!!!!!!!
371  else if ( bcflag.eq.0 )THEN
372 
373  CALL com_get_size( surfin//".nc", pane, glb%InterfaceSFnbNumNodes)
374  CALL com_set_size( surwin//".nc", pane, glb%InterfaceSFnbNumNodes)
375 
376  CALL com_set_size( surwin//'.bcflag', pane, 1)
377  CALL com_resize_array(surwin//'.bcflag', pane)
378 
379  CALL com_get_connectivities(surfin,pane,numeltypes2d,names)
380 
381  startpt = 1
382  DO i = 1, numeltypes2d
383  ! Search for the next attribute name
384  endpt = startpt
385  chrlngth = 0
386  DO WHILE (endpt .LE. ubound(names,1))
387  IF (names(endpt) .NE. ' ') THEN
388  chrlngth = chrlngth + 1
389  chreltype(chrlngth:chrlngth) = names(endpt)
390  endpt = endpt + 1
391  ELSE
392  EXIT
393  END IF
394  END DO
395 
396  startpt = endpt + 1
397 
398  IF(chreltype(1:chrlngth).EQ.':t6')THEN
399  CALL com_get_size( surfin//".:t6", pane, glb%InterfaceSFnbNumElems)
400  CALL com_set_size( surwin//".:t6", pane, glb%InterfaceSFnbNumElems)
401  glb%iElType2D = 6
402  ELSE IF(chreltype(1:chrlngth).EQ.':t3')THEN
403  CALL com_get_size( surfin//".:t3", pane, glb%InterfaceSFnbNumElems)
404  CALL com_set_size( surwin//".:t3", pane, glb%InterfaceSFnbNumElems)
405  glb%iElType2D = 3
406  ELSE IF(chreltype(1:chrlngth).EQ.':q4')THEN
407  CALL com_get_size( surfin//".:q4", pane, glb%InterfaceSFnbNumElems)
408  CALL com_set_size( surwin//".:q4", pane, glb%InterfaceSFnbNumElems)
409  glb%iElType2D = 4
410  ELSE
411  print*,'ROCFRAC ERROR: Surface mesh type element not supported'
412  print*,'Read in Element Type :: ', chreltype(1:chrlngth)
413  CALL mpi_finalize(glb%MPI_COMM_ROCFRAC,ierr)
414  ENDIF
415 
416  END DO
417 
418  CALL com_free_buffer(names)
419 ! Fluids/Solids Interface Mesh
420 
421  ALLOCATE(glb%InterfaceSFnbNodalCoors(1:3,1:glb%InterfaceSFnbNumNodes))
422  ALLOCATE(glb%MapNodeSFnb(1:glb%InterfaceSFnbNumNodes))
423 
424  ALLOCATE(glb%InterfaceSFnbElemConn(1:glb%iElType2D,1:glb%InterfaceSFnbNumElems))
425  ALLOCATE(glb%MapSFnbElVolEl(1:glb%InterfaceSFnbNumElems))
426 
427 
428 ! -- The array's containing fluid-solid values
429 
430  ALLOCATE(glb%InterfaceSFnbNodalDisps(1:3,1:glb%InterfaceSFnbNumNodes))
431  ALLOCATE(glb%InterfaceSFnbTotalNodalDisps(1:3,1:glb%InterfaceSFnbNumNodes))
432  ALLOCATE(glb%InterfaceSFnbNodalAccel(1:3,1:glb%InterfaceSFnbNumNodes))
433  ALLOCATE(glb%InterfaceSFnbNodalVels(1:3,1:glb%InterfaceSFnbNumNodes))
434 !#OLD ALLOCATE(glb%InterfaceSFElemTract(1:3,1:glb%InterfaceSFNumElems))
435  ALLOCATE(glb%InterfaceSFnbElemTract(1:glb%InterfaceSFnbNumElems))
436 ! IF(glb%ALEenabled)THEN
437  ALLOCATE(glb%InterfaceSFnbVbar(1:3,1:glb%InterfaceSFnbNumNodes))
438 ! ALLOCATE(glb%InterfaceSVbar(1:3,1:glb%InterfaceSNumNodes)) ! needed?
439 ! ENDIF
440  IF(glb%HeatTransSoln)THEN
441  ALLOCATE(glb%InterfaceSFnbHeatFlux(1:glb%InterfaceSFnbNumElems))
442  glb%InterfaceSFnbHeatFlux(:) = glb%DummyFlux
443 
444  ALLOCATE(glb%InterfaceSFnbNodalTemp(1:glb%InterfaceSFnbNumNodes))
445  glb%InterfaceSFnbNodalTemp(:) = glb%Temperature0
446  ENDIF
447 
448  IF(glb%ipstatic)THEN
449  ALLOCATE(glb%pstatic(1:3,1:glb%InterfaceSFNumElems))
450  glb%pstatic(1:3,1:glb%InterfaceSFNumElems) = 0.d0
451  ALLOCATE(glb%pstaticnb(1:3,1:glb%InterfaceSFnbNumElems))
452  glb%pstaticnb(1:3,1:glb%InterfaceSFnbNumElems) = 0.d0
453  ENDIF
454 
455  glb%InterfaceSFnbNodalAccel(:,:) = 0.d0
456  glb%InterfaceSFnbNodalDisps(:,:) = 0.d0
457  glb%InterfaceSFnbTotalNodalDisps(:,:) = 0.d0
458  glb%InterfaceSFnbNodalVels(:,:) = 0.d0
459  glb%InterfaceSFnbElemTract(:) = 0.d0
460 !#OLD glb%InterfaceSFElemTract(:,:) = 0.d0
461  glb%InterfaceSFnbVbar = 0.d0
462 
463  IF ( glb%InterfaceSFnbNumNodes > 0) THEN ! Fluid-solid interface
464 
465 ! Register Coordinates of 2D Fluid-solid interface
466 
467 !!$ CALL COM_init_mesh( surWin//'.nc', MyId+1, glb%InterfaceSFNodalCoors, glb%InterfaceSFNumNodes)
468 
469 
470 ! print*,'glb%InterfaceSFNumNodes', glb%InterfaceSFNumNodes
471 
472  CALL com_set_array(surwin//'.nc', pane, glb%InterfaceSFnbNodalCoors,3 )
473 !
474 ! Registering 2D Element Connectivity of Fluid-solid interface
475 !
476  IF(glb%iElType2D.EQ.3)THEN
477 !!$ CALL COM_init_mesh( surWin//'.t3', MyId+1, glb%InterfaceSFElemConn, glb%InterfaceSFNumElems)
478 
479 
480  CALL com_set_array( surwin//'.:t3', pane, glb%InterfaceSFnbElemConn,3)
481 
482  ELSE IF(glb%iElType2D.EQ.6)THEN
483 !!$ CALL COM_init_mesh( surWin//'.t6', MyId+1, glb%InterfaceSFElemConn, glb%InterfaceSFNumElems)
484  CALL com_set_array( surwin//'.:t6', pane, glb%InterfaceSFnbElemConn,6)
485 
486  ELSE IF(glb%iElType2D.EQ.4)THEN
487 !!$ CALL COM_init_mesh( surWin//'.q4', MyId+1, glb%InterfaceSFElemConn, glb%InterfaceSFNumElems)
488 
489  CALL com_set_array( surwin//'.:q4', pane, glb%InterfaceSFnbElemConn,4)
490 
491  ENDIF
492 
493  CALL com_set_array( surwin//'.bv', pane, glb%MapNodeSFnb,1)
494  CALL com_set_array(surwin//'.bf2c', pane, glb%MapSFnbElVolEl, 1)
495 
496  CALL com_set_array( surwin//'.accel',pane, glb%InterfaceSFnbNodalAccel,3)
497  CALL com_set_array( surwin//'.u',pane, glb%InterfaceSFnbNodalDisps,3)
498  CALL com_set_array( surwin//'.vs', pane, glb%InterfaceSFnbNodalVels,3)
499  CALL com_set_array( surwin//'.uhat', pane, glb%InterfaceSFnbTotalNodalDisps,3)
500 
501  CALL com_set_array( surwin//'.ts_alp', pane, glb%InterfaceSFnbElemTract, 1)
502 
503  IF (glb%HeatTransSoln)THEN
504  CALL com_set_array( surwin//'.qs', pane, glb%InterfaceSFnbHeatFlux, 1)
505  CALL com_set_array( surwin//'.Ts', pane, glb%InterfaceSFnbNodalTemp, 1)
506  ENDIF
507 
508 
509  IF ( glb%ALEenabled) CALL com_set_array( surwin//'.vbar_alp', pane, glb%InterfaceSFnbVbar,3)
510 
511  endif
512 
513  ELSE
514  WRITE(*,*) 'Rocfrac: Invalid bcflag',bcflag,' on surface pane',pane
515  stop
516  ENDIF
517 
518 
519  enddo
520 !!$ IF ( glb%NumNdsBC > 0) THEN ! Non-fluid-solid interface
521 !!$
522 !!$ ! CALL COM_init_mesh( surWin//'.nc', 2*NumProcs+MyId+1, glb%NumNdsBC)
523 !!$
524 !!$ CALL COM_set_size( surWin//'.nc',, MyId+1, glb%NumNdsBC)
525 !!$
526 !!$ CALL COM_set_array( surWin//'.vs', 2*NumProcs+MyId+1, glb%VeloBndry)
527 !!$ CALL COM_set_array( surWin//'.u', 2*NumProcs+MyId+1, glb%AccelBndry)
528 !!$ ENDIF
529 
530 ! No longer needed
531 !!$ CALL COM_new_attribute( surWin//'.bcflag', 'p', COM_INTEGER, 1, '')
532 !!$ CALL COM_allocate_array( surWin//'.bcflag', MyId+1)
533 !!$
534 !!$ stop
535 !!$
536 !!$ IF ( glb%InterfaceSFNumNodes > 0) THEN ! Fluid-solid interface
537 !!$ CALL COM_get_array( surWin//'.bcflag', MyId+1, one)
538 !!$ one = 1
539 !!$ END IF
540 !!$
541 !!$ IF ( glb%InterfaceSNumNodes > 0) THEN ! Non-fluid-solid interface
542 !!$ CALL COM_get_array( surWin//'.bcflag', NumProcs+MyId+1, two)
543 !!$ two = 2
544 !!$ ENDIF
545 ! put into volume mesh
546 
547 !!$ IF ( glb%NumNdsBC > 0) THEN ! Surface Boundary Condition flags
548 !!$ CALL COM_get_array( surWin//'.bcflag', 2*NumProcs+MyId+1, two)
549 !!$ two = 2
550 !!$ ENDIF
551 
552 
553  CALL com_window_init_done( surwin)
554 
555  CALL com_free_buffer(paneids)
556 
557  CALL com_call_function( obtain_attr, 2, &
558  com_get_attribute_handle_const( surfin//".all"), &
559  com_get_attribute_handle( surwin//".all"))
560 
561 
562  WRITE (*,*) ' Calling RocFrac Register... Done'
563 11 FORMAT(a,'_',a,a1)
564 !---------------------------------------------------------------------------------------------------
565 
566 
567  END SUBROUTINE rocfracinterfaceinitial
568 
569 
570  SUBROUTINE rocfracinterfaceupdate( glb, CurrentTime, &
571  currenttimestep, man_update_inbuff)
572  IMPLICIT NONE
573 
574  TYPE(rocfrac_global), POINTER :: glb
575  REAL*8, INTENT(IN) :: currenttime, currenttimestep
576  INTEGER, INTENT(IN) :: man_update_inbuff
577 
578 ! Subroutine to gather current interface position computed by the solids code into
579 ! the database used by the interpolation procedures.
580 
581  ! Local variables:
582 
583  REAL*8 :: solidsdisp, solidscoor
584 
585  INTEGER :: iinterfacenode, solidsnodenum
586 
587 ! Update ALL the surface mesh coordinates
588 
589 ! Burning/Interacting surfaces
590 
591  DO iinterfacenode = 1, glb%InterfaceSFNumNodes
592 
593  solidsnodenum = abs(glb%MapNodeSF(iinterfacenode))
594 
595  glb%InterfaceSFNodalCoors(1,iinterfacenode) = glb%MeshCoor(1,solidsnodenum )
596  glb%InterfaceSFNodalCoors(2,iinterfacenode) = glb%MeshCoor(2,solidsnodenum )
597  glb%InterfaceSFNodalCoors(3,iinterfacenode) = glb%MeshCoor(3,solidsnodenum )
598 
599  END DO
600 
601 ! Non-Burning/Interacting surfaces
602 
603  DO iinterfacenode = 1, glb%InterfaceSFnbNumNodes
604 
605  solidsnodenum = abs(glb%MapNodeSFnb(iinterfacenode))
606 
607  glb%InterfaceSFnbNodalCoors(1,iinterfacenode) = glb%MeshCoor(1,solidsnodenum )
608  glb%InterfaceSFnbNodalCoors(2,iinterfacenode) = glb%MeshCoor(2,solidsnodenum )
609  glb%InterfaceSFnbNodalCoors(3,iinterfacenode) = glb%MeshCoor(3,solidsnodenum )
610 
611  END DO
612 
613 ! Non-Interacting surfaces
614 
615  DO iinterfacenode = 1, glb%InterfaceSNumNodes
616 
617  solidsnodenum = abs(glb%MapNodeS(iinterfacenode))
618 
619  glb%InterfaceSNodalCoors(1,iinterfacenode) = glb%MeshCoor(1,solidsnodenum )
620  glb%InterfaceSNodalCoors(2,iinterfacenode) = glb%MeshCoor(2,solidsnodenum )
621  glb%InterfaceSNodalCoors(3,iinterfacenode) = glb%MeshCoor(3,solidsnodenum )
622 
623  END DO
624 !---------------------------------------------------------------------------------------------------
625 
626  END SUBROUTINE rocfracinterfaceupdate
627 
628 
629  SUBROUTINE readsdv(glb,myid)
630 
631  IMPLICIT NONE
632 
633  include 'roccomf90.h'
634  include 'mpif.h'
635 
636  INTEGER :: myid
637 
638  TYPE(rocfrac_global),POINTER :: glb
639 
640  INTEGER :: pid
641 
642 
643  INTEGER :: hdl_read, hdl_obtain, hdl_all
644 
645  CHARACTER(*), PARAMETER :: overlaywin = "Overlay"
646  CHARACTER(*), PARAMETER :: overlaywin2 = "Overlay2"
647 
648 
649  INTEGER :: comm_self
650  CHARACTER(*), PARAMETER :: prefix1 = "A"
651  CHARACTER(*), PARAMETER :: prefix2 = "B"
652 
653  CHARACTER(LEN=5) :: sdv_material
654  CHARACTER(LEN=12) :: sdv_wname
655  CHARACTER(LEN=27) :: fname1, fname2
656  CHARACTER(LEN=3) :: ichr3
657  INTEGER :: i,j
658 
659 
660  INTEGER, POINTER, DIMENSION(:) :: mapfaceel2vol1a, faceofvolel1a
661 
662  INTEGER :: iprocs,ios, iaux
663 ! obtain function handle ------------------------------------------------------
664 
665 
666 ! IF(myid.eq.1) THEN
667 
668  pid = (myid+1)*100 + 3
669 
670 
671  WRITE(ichr3,'(I3.3)') pid ! problem if over 999 processors, fix
672 
673  fname1 = 'Rocfrac/Rocin/A_'//ichr3//'_sdv.hdf'
674  fname2 = 'Rocfrac/Rocin/B_'//ichr3//'_sdv.hdf'
675 
676 
677  CALL rocin_load_module( "SDV_IN")
678 
679  hdl_read = com_get_function_handle( 'SDV_IN.read_windows')
680  hdl_obtain = com_get_function_handle( 'SDV_IN.obtain_attribute')
681 
682 
683 
684 
685 ! Define the base-window and sdv-window names
686 
687  sdv_material = prefix1//'_sdv'
688  sdv_wname = overlaywin//sdv_material
689  CALL com_new_window( overlaywin )
690 
691 ! // Read the pane from the given file. Note that the file contains both
692 ! // the parent and the subdivided windows. Read only the subdivided one.
693  comm_self = mpi_comm_self
694  CALL com_call_function( hdl_read, 4, fname1, overlaywin, &
695  sdv_material, comm_self)
696  hdl_all = com_get_attribute_handle( sdv_wname//".all")
697  CALL com_call_function( hdl_obtain, 3, hdl_all, hdl_all, pid)
698 ! // Obtain number of sub-nodes, sub-faces, nodes, and faces
699 
700  CALL com_get_size( sdv_wname//'.sn_parent_fcID', pid, glb%nsubn1)
701 
702 ! PRINT*,'Number of sub-nodes =',glb%nsubn1
703 
704  CALL com_get_size( sdv_wname//'.:t3', pid, glb%nsubf1)
705 
706 ! PRINT*,'Number of sub-faces =', glb%nsubf1
707 
708  ALLOCATE(glb%Sthresh1(1:3, 1:glb%nsubf1))
709  glb%Sthresh1(1:3, 1:glb%nsubf1) = glb%Sinit(1) ! fix, this should be read-in
710 
711 
712 ! // Obtain the connectivity
713 
714  ALLOCATE( glb%sd_subfaces1(1:3,1:glb%nsubf1) )
715 
716  CALL com_copy_array( sdv_wname//".:t3", pid, glb%sd_subfaces1, 3)
717 
718 !!$ DO i = 1, glb%nsubf1
719 !!$ PRINT*,glb%sd_subfaces1(1:3,i)
720 !!$ ENDDO
721 
722  ALLOCATE(glb%sd_coor1(1:3,1:glb%nsubn1))
723 
724  CALL com_copy_array( sdv_wname//".nc", pid, glb%sd_coor1, 3)
725 
726 !!$ DO i = 1, glb%nsubn1
727 !!$ PRINT*,glb%sd_coor1(1:3,i)
728 !!$ ENDDO
729 
730  ALLOCATE(glb%sd_subface_parents1(1:glb%nsubf1))
731 
732  CALL com_copy_array( sdv_wname//".sf_parent", pid, glb%sd_subface_parents1)
733 
734 !!$ DO i = 1, glb%nsubf1
735 !!$ PRINT*,'sd_subface_parents',glb%sd_subface_parents1(i)
736 !!$ ENDDO
737 
738 
739  ALLOCATE(glb%sd_subface_nat_coors1(1:6,1:glb%nsubf1))
740 
741 
742 
743  CALL com_copy_array( sdv_wname//".sf_ncs", pid, &
744  glb%sd_subface_nat_coors1, 6)
745 
746 !
747 ! // NOTE: The last argument (6) indicates that the local coordinates are
748 ! // stored consecutively (xi1, eta1, xi2, eta2, xi3, eta3). Use the number
749 ! // one (1) if the xi1 for all nodes are stored together and then xi2, etc..
750 
751 !!$ DO i = 1, glb%nsubf1
752 !!$ PRINT*, i,glb%nsubf1,glb%sd_subface_nat_coors1(1:6,i)
753 !!$ END DO
754  ALLOCATE(glb%sd_subface_counterparts1(1:glb%nsubf1) )
755 
756 
757  CALL com_copy_array( sdv_wname//".sf_cntpt_fcID", pid, glb%sd_subface_counterparts1)
758 
759 
760 
761 !!$ DO i = 1, glb%nsubf1
762 !!$ PRINT*,glb%sd_subface_counterparts1(i)
763 !!$ ENDDO
764 
765 
766 
767 !!$ PRINT*,'finished readsdv',myid
768 !!$ CALL MPI_BARRIER(glb%MPI_COMM_ROCFRAC,i)
769 !!$ stop
770 
771 ! // Delete the window created by Rocin.
772 
773 !!$ CALL COM_delete_window( sdv_wname)
774 !!$
775 !!$
776 !!$ CALL Rocin_unload_module( "SDV_IN")
777 !!$
778 !!$
779 !!$ CALL Rocin_load_module( "SDV_IN")
780 
781 ! Define the base-window and sdv-window names
782 
783  sdv_material = prefix2//'_sdv'
784  sdv_wname = overlaywin//sdv_material
785 
786 ! CALL COM_new_window( OverlayWin )
787 
788 
789 
790 
791 
792 ! // Read the pane from the given file. Note that the file contains both
793 ! // the parent and the subdivided windows. Read only the subdivided one.
794  comm_self = mpi_comm_self
795  CALL com_call_function( hdl_read, 4, fname2, overlaywin, &
796  sdv_material, comm_self)
797  hdl_all = com_get_attribute_handle( sdv_wname//".all")
798  CALL com_call_function( hdl_obtain, 3, hdl_all, hdl_all, pid)
799  CALL com_get_size( sdv_wname//'.sn_parent_fcID', pid, glb%nsubn2)
800 
801 
802 
803 
804 ! PRINT*,'Number of sub-nodes =',glb%nsubn2
805 
806  CALL com_get_size( sdv_wname//'.:t3', pid, glb%nsubf2)
807 
808 
809 
810 ! PRINT*,'Number of sub-faces =', glb%nsubf2
811 
812  ALLOCATE(glb%sd_subface_counterparts2(1:glb%nsubf2) )
813 
814  CALL com_copy_array( sdv_wname//".sf_cntpt_fcID", pid, glb%sd_subface_counterparts2)
815 
816 
817 ! // Obtain the connectivity
818 
819  ALLOCATE( glb%sd_subfaces2(1:3,1:glb%nsubf1) ) ! GETS STUCK HERE FOR more then ONE processor
820 
821 !!$ PRINT*,'finished readsdv!!!!!!!!!',myid,glb%nsubn2,glb%nsubf2
822 !!$ CALL MPI_BARRIER(glb%MPI_COMM_ROCFRAC,i)
823 
824  CALL com_copy_array( sdv_wname//".:t3", pid, glb%sd_subfaces2, 3)
825 
826 !!$ DO i = 1, glb%nsubf2
827 !!$ PRINT*,glb%sd_subfaces2(1:3,i)
828 !!$ ENDDO
829 
830  ALLOCATE(glb%sd_coor2(1:3,1:glb%nsubn2))
831  CALL com_copy_array( sdv_wname//".nc", pid, glb%sd_coor2, 3)
832 
833 
834 !!$ DO i = 1, glb%nsubn2
835 !!$ PRINT*,glb%sd_coor2(1:3,i)
836 !!$ ENDDO
837 
838 
839 
840 ! PRINT*,'ldfdfkjsdflkj'
841  ALLOCATE(glb%sd_subface_nat_coors2(1:6,1:glb%nsubf2))
842 ! PRINT*,'dsflkjsdflkj'
843  CALL com_copy_array( sdv_wname//".sf_ncs", pid, &
844  glb%sd_subface_nat_coors2, 6)
845 !
846 ! PRINT*,'lkjsdflkj'
847 
848 !
849 ! // NOTE: The last argument (6) indicates that the local coordinates are
850 ! // stored consecutively (xi1, eta1, xi2, eta2, xi3, eta3). Use the number
851 ! // one (1) if the xi1 for all nodes are stored together and then xi2, etc..
852 
853 !!$ DO i = 1, glb%nsubf2
854 !!$ PRINT*, i,glb%nsubf2,glb%sd_subface_nat_coors2(1:6,i)
855 !!$ END DO
856 
857 
858 
859 !!$ DO i = 1, glb%nsubf2
860 !!$ PRINT*,i,glb%nsubf2,glb%sd_subface_counterparts2(i)
861 !!$ ENDDO
862 
863 ! PRINT*,'lkjsdflkj',glb%nsubf2,myid
864  ALLOCATE(glb%sd_subface_parents2(1:glb%nsubf2))
865 ! PRINT*,'copy',myid
866  CALL com_copy_array( sdv_wname//".sf_parent", pid, glb%sd_subface_parents2)
867 ! PRINT*,'sdfsdflkjsdflkj',myid
868 !!$ DO i = 1, glb%nsubf2
869 !!$ PRINT*,'sd_subface_parents',glb%sd_subface_parents2(i)
870 !!$ ENDDO
871 
872 
873 ! // Delete the window created by Rocin.
874  CALL com_delete_window( sdv_wname)
875 ! PRINT*,'sdfsdflkjsdflkj',myid
876 
877 ! // Unload Rocin from Roccom.
878 
879  CALL rocin_unload_module( "SDV_IN")
880 
881 
882 
883 ! CALL COM_new_attribute( surWin//'.bf2c', 'e', COM_INTEGER, 1, '')
884 ! CALL COM_allocate_array(surWin//'.bf2c', iNI, ElFlag_List, 1)
885 ! CALL COM_new_attribute( surWin//'.faceOnCell', 'e', COM_INTEGER, 1, '')
886 ! CALL COM_allocate_array(surWin//'.faceOnCell', iNI, FaceOnCell, 1)
887 
888 
889 ! ENDIF
890 
891 ! stop
892 
893 
894 
895 END SUBROUTINE readsdv
896 
897 END MODULE rocfracsubinterface
898 
Mesquite::Matrix3D::zero
void zero()
Sets all entries to zero (more efficient than assignement).
Definition: includeLinks/Matrix3D.hpp:167
rocstar_rocfrac
Definition: ROCSTAR_RocFrac.f90:53
rocfracsubinterface::rocfracinterfaceupdate
subroutine, public rocfracinterfaceupdate(glb, CurrentTime, CurrentTimeStep, MAN_update_inbuff)
Definition: RocFracSubInterface.f90:564
rocstar_rocfracinterp
Definition: ROCSTAR_RocFracInterp.f90:53
i
blockLoc i
Definition: read.cpp:79
rocstar_rocfrac::rocfrac_global
Definition: ROCSTAR_RocFrac.f90:80
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
Attribute::pane
const Pane * pane() const
Obtain a constant pointer to the owner pane of the attribute.
Definition: Attribute.h:172
j
j indices j
Definition: Indexing.h:6
rocfracsubinterface::rocfracinterfaceinitial
subroutine, public rocfracinterfaceinitial(glb, obtain_attr, surfIn)
Definition: RocFracSubInterface.f90:63
readsdv
program readsdv
Definition: readsdv.f90:23
Line_2::a
RT a() const
Definition: Line_2.h:140