Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
rocburn_2D.f90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 MODULE m_rocburn_2d
24 
25 !
26 ! ---------------------------------------------------------------------------
27 !
28 ! This module contains INITIALIZE, UPDATE, and FINALIZE
29 ! to be registered with Roccom.
30 !
31 ! Author: K-C Tang, L. Massa, X. Jiao
32 !
33 ! ---------------------------------------------------------------------------
34 !
35 
36  USE m_rocburn_interface_data
37  USE m_calcdist
38 
39  IMPLICIT NONE
40  include 'roccomf90.h'
41  include 'mpif.h'
42 
43  INTEGER, PARAMETER :: MODEL_APN = 1, MODEL_PY = 2, MODEL_ZN = 3
44  INTEGER, PARAMETER :: NO_TBL = 0
45 
46  CHARACTER(*), PARAMETER :: ioWin = "Burn"
47  CHARACTER(*), PARAMETER :: intWin = "BurnInt"
48 
49 ! ---------------------------------------------------------------------------
50 
51 CONTAINS
52 
53  SUBROUTINE check_alloc( ierr)
54  INTEGER, INTENT(IN) :: ierr
55  IF(ierr /= 0) THEN
56  print *, "ROCBRUN ERROR: unable to allocate memory"
57  CALL mpi_abort( mpi_comm_world, -1)
58  END IF
59  END SUBROUTINE check_alloc
60 
61  SUBROUTINE init_wrapper(G_b, initial_time, comm, MAN_INIT, inSurf, &
62  inint, in_obt_attr)
63 
64  TYPE(list_block), POINTER :: g_b
65  REAL(DBL), INTENT(IN) :: initial_time
66  INTEGER, INTENT(IN) :: comm, man_init
67  CHARACTER(*), INTENT(IN) :: insurf, inint
68  INTEGER, INTENT(IN) :: in_obt_attr
69 
70  g_b%MPI_COMM_ROCBURN = comm
71  g_b%pseudo_time = initial_time
72 
73  CALL com_call_function(g_b%INIT,6,man_init,insurf,inint, &
74  g_b%INIT_0D, g_b%INIT_1D, in_obt_attr)
75 
76  END SUBROUTINE init_wrapper
77 
78 !
79 ! ------------------------------------------------------------------------
80 ! INTERNAL PROCEDURES
81 ! ------------------------------------------------------------------------
82 
83  SUBROUTINE initialize( G_b, MAN_INIT, inSurf, inInt, INIT_0D, INIT_1D, &
84  in_obt_attr)
85 
86  TYPE(list_block), POINTER :: g_b
87  INTEGER, INTENT(IN) :: man_init, in_obt_attr
88  CHARACTER(*), INTENT(IN) :: insurf, inint
89 !
90 ! INIT_0D and INIT_1D are external subroutine arguments.
91 ! Their dummy arguments are described as follow:
92 !
93 
94  INTERFACE
95  SUBROUTINE init_0d( g_1d, comm, Indir, nxmax, To_read)
96  USE m_rocburn_interface_data, ONLY : g_burn_1d, dbl
97  TYPE (g_burn_1d), POINTER :: g_1d
98  INTEGER, INTENT(IN) :: comm
99  CHARACTER(*), INTENT(IN) :: indir
100  INTEGER, INTENT(OUT) :: nxmax
101  REAL(DBL), INTENT (OUT) :: to_read
102  END SUBROUTINE init_0d
103 
104  SUBROUTINE init_1d( g_1d, bflag, P, To, rhoc, p_coor, rb, &
105  toa, fr, tn, tflame)
106  USE m_rocburn_interface_data, ONLY : g_burn_1d, dbl
107  TYPE (g_burn_1d), POINTER :: g_1d
108  INTEGER, INTENT(INOUT) :: bflag
109  REAL(DBL), INTENT (IN) :: p, to, rhoc, p_coor(3)
110  REAL(DBL), INTENT (OUT) :: rb, toa, fr
111  REAL(DBL), INTENT (OUT) :: tn(:)
112  REAL(DBL), INTENT (OUT) :: tflame
113  END SUBROUTINE init_1d
114  END INTERFACE
115 
116 
117 ! ---------------------------------------------------------------------------
118 ! local variables
119 !
120  INTEGER :: nxmax
121  INTEGER :: ierror, ib, ic, nblks, bid,n_cell
122  INTEGER, POINTER :: blk_ids(:)
123  TYPE(block), POINTER :: blk
124  LOGICAL :: is_apn, comp_filmcoeff
125  REAL(DBL) :: zero, zerov(3)
126 !-----------------------------------------------------------------------------
127 
128  g_b%burn_iter = 0 !start with zero also in case of restart
129  CALL mpi_comm_rank(g_b%MPI_COMM_ROCBURN, g_b%rank, ierror)
130 
131 ! IF(G_b%rank == 0 .AND. G_b%verbosity .gt. 1) THEN
132 ! WRITE(*,*) 'Rocburn: received initial_time= ',G_b%pseudo_time
133 ! END IF
134 
135 !
136 ! Decode model_code
137 !
138  is_apn = g_b%burn_model == model_apn
139  comp_filmcoeff = g_b%TBL_flag == no_tbl
140 
141 ! IF(G_b%rank == 0 .AND. G_b%verbosity .gt. 1) THEN
142 ! WRITE(*,*) 'Rocburn: TBL_flag = ', G_b%TBL_flag
143 ! WRITE(*,*) 'Rocburn: burn_model = ', G_b%burn_model
144 ! END IF
145 
146 !
147 ! initialize global vairables (0D level) for inidividual
148 ! combustion model
149 !
150  CALL init_0d(g_b%g_1d, g_b%MPI_COMM_ROCBURN, trim(g_b%mname)//"/", nxmax, g_b%To_read)
151  ALLOCATE (g_b%Tn( nxmax), stat=ierror); CALL check_alloc( ierror)
152 
153 !
154 ! Create interface data in Roccom and allocate memory for them
155 !
156  CALL com_new_window( iowin)
157 ! Use the subset of fluid or solid mesh.
158 ! It must use ghost nodes/cells as well in order to visualize.
159  CALL com_clone_attribute( iowin//".mesh", insurf//".mesh")
160  CALL com_clone_attribute( iowin//'.bflag', insurf//'.bflag')
161 
162 !
163 ! Incoming data
164 !
165 
166  CALL com_new_attribute( iowin//".pf_alp", 'e', com_double, 1, "Pa")
167  CALL com_resize_array( iowin//".pf_alp")
168 
169  IF ( .NOT. is_apn) THEN
170 !RAF CALL COM_new_attribute( ioWin//".centers", 'e', COM_DOUBLE, 3, "m")
171  CALL com_new_attribute( iowin//".qr_alp", 'e', com_double, 1, "W/m^2")
172  CALL com_new_attribute( iowin//".qc_alp", 'e', com_double, 1, "W/m^2")
173  CALL com_new_attribute( iowin//".rhos_alp", 'e', com_double, 1, "kg/m^3")
174  CALL com_new_attribute( iowin//".Tf_alp", 'e', com_double, 1, "K")
175 !!! CALL COM_new_attribute( ioWin//".To_alp", 'e', COM_DOUBLE, 1, "K")
176 
177 !RAF CALL COM_resize_array(ioWin//".centers")
178  CALL com_resize_array(iowin//".qr_alp")
179  CALL com_resize_array(iowin//".qc_alp")
180  CALL com_resize_array(iowin//".rhos_alp")
181  CALL com_resize_array(iowin//".Tf_alp")
182  END IF
183  CALL com_new_attribute( iowin//".centers", 'e', com_double, 3, "m")
184  CALL com_resize_array(iowin//".centers")
185 !
186 ! Outgoing data
187 !
188  CALL com_new_attribute( iowin//".rb", 'e', com_double, 1, "m/s")
189  CALL com_new_attribute( iowin//".Tflm", 'e', com_double, 1, "K")
190  CALL com_resize_array(iowin//".rb")
191  CALL com_resize_array(iowin//".Tflm")
192 
193  CALL com_window_init_done( iowin)
194 
195 !
196 ! Create internal data that need to be saved for predictor-corrector
197 ! iterations or restart in Roccom and allocate memory for them.
198 !
199  CALL com_new_window( intwin)
200  CALL com_use_attribute( intwin//".mesh", iowin//".mesh") ! Same mesh
201 
202 !
203 ! Data for interpolation if subcycling for individual cells are needed
204 !
205  IF ( .NOT. is_apn) THEN
206  CALL com_clone_attribute( intwin//".pf_old", iowin//".pf_alp")
207  CALL com_clone_attribute( intwin//".qc_old", iowin//".qc_alp")
208  CALL com_clone_attribute( intwin//".qr_old", iowin//".qr_alp")
209  CALL com_clone_attribute( intwin//".rhos_old", iowin//".rhos_alp")
210  CALL com_clone_attribute( intwin//".Tf_old", iowin//".Tf_alp")
211 !!! CALL COM_clone_attribute( intWin//".To_old", ioWin//".To_alp")
212  END IF
213 
214 !
215 ! Profile history
216 !
217  IF ( .NOT. is_apn) THEN
218  CALL com_clone_attribute( intwin//".Toa", iowin//".Tflm")
219  IF ( comp_filmcoeff) THEN
220  CALL com_new_attribute( intwin//".dist", 'e', com_double, 1, "m")
221  CALL com_resize_array(intwin//".dist")
222  ENDIF
223  CALL com_new_attribute( intwin//".temp", 'e', com_double, nxmax, "K")
224  CALL com_new_attribute( intwin//".fr", 'e', com_double, 1, "")
225  CALL com_resize_array(intwin//".temp")
226  CALL com_resize_array(intwin//".fr")
227  END IF
228 
229  CALL com_window_init_done( intwin)
230 
231 !
232 ! Get size information from Roccom
233 !
234  CALL com_get_panes( iowin, nblks, blk_ids)
235  ALLOCATE (g_b%blocks( nblks), stat=ierror); CALL check_alloc( ierror)
236 
237 !
238 ! Obtain memory address from Roccom and build up the blocks
239 !
240  DO ib = 1, nblks
241  blk => g_b%blocks(ib)
242  blk%iblock = blk_ids(ib)
243  bid = blk_ids(ib)
244 
245 !
246 ! incoming data
247 !
248  CALL com_get_size( iowin//".pf_alp", bid, blk%nfaces)
249  CALL com_get_array( iowin//".pf_alp", bid, blk%pres)
250  CALL com_get_array( iowin//".bflag", bid, blk%burn_flag)
251 
252  IF ( .NOT. is_apn) THEN
253 !RAF CALL COM_get_array( ioWin//".centers", bid, blk%coor)
254 
255  CALL com_get_array( iowin//".qr_alp", bid, blk%qr)
256  CALL com_get_array( iowin//".qc_alp", bid, blk%qc)
257  CALL com_get_array( iowin//".rhos_alp", bid, blk%rhoc)
258  CALL com_get_array( iowin//".Tf_alp", bid, blk%Tg)
259 !!! CALL COM_get_array( ioWin//".To_alp", bid, blk%To)
260  END IF
261  CALL com_get_array( iowin//".centers", bid, blk%coor)
262 
263 !
264 ! outgoing data
265 !
266 
267  CALL com_get_array( iowin//".rb", bid, blk%rb)
268  CALL com_get_array( iowin//".Tflm", bid, blk%Tf)
269  ! The above attributes need be initialized by INIT_1D
270 
271 !
272 ! Stored internal data
273 !
274 ! Data for interpolation if subcycling for individual cells are needed
275 !
276 !
277  IF ( .NOT. is_apn) THEN
278  CALL com_get_array( intwin//".pf_old", bid, blk%pres_old)
279  CALL com_get_array( intwin//".qc_old", bid, blk%qc_old)
280  CALL com_get_array( intwin//".qr_old", bid, blk%qr_old)
281  CALL com_get_array( intwin//".rhos_old", bid, blk%rhoc_old)
282  CALL com_get_array( intwin//".Tf_old", bid, blk%Tg_old)
283 !!! CALL COM_get_array( intWin//".To_old", bid, blk%To_old)
284  END IF
285 
286 !
287 ! Profile history
288 !
289  IF ( .NOT. is_apn) THEN
290  CALL com_get_array( intwin//".temp", bid, blk%temp)
291  CALL com_get_array( intwin//".Toa", bid, blk%Toa)
292  CALL com_get_array( intwin//".fr", bid, blk%fr)
293  ! The above attributes need be initialized by INIT_1D
294 
295  IF ( comp_filmcoeff) THEN
296  CALL com_get_array( intwin//".dist", bid, blk%dist)
297  ! blk%dist should be initialized by CALCDIST_2D
298  END IF
299  END IF
300  END DO ! ib
301 
302 ! Call Rocin to copy attributes (without the mesh) into the new windows.
303  CALL com_call_function( in_obt_attr,2, &
304  com_get_attribute_handle_const(trim(insurf)//".all"), &
305  com_get_attribute_handle(trim(iowin)//".all" ))
306  CALL com_call_function( in_obt_attr,2, &
307  com_get_attribute_handle_const(trim(inint)//".atts"), &
308  com_get_attribute_handle(trim(intwin)//".atts" ))
309 
310 ! Call Rocman to prepare for data transfer, predictor-corrector iterations,
311 ! and restart. If initial_time is nonzero, Rocman will load data buffers
312 ! from restart files; if initial_time is zero, Rocman will initialize bflag,
313 ! pressure, qr, and qc.
314  CALL com_call_function( man_init, 3, iowin, intwin, g_b%TBL_flag)
315 
316 !
317 ! initialize 1D level vairables for inidividual combustion model
318 !
319 !
320  n_cell = 0
321  IF ( g_b%pseudo_time == 0.0 .or. is_apn) THEN
322  zero = 0.0
323  zerov = zero
324 
325  DO ib = 1, nblks
326  blk => g_b%blocks(ib)
327 
328  IF ( .NOT. is_apn) THEN
329  DO ic = 1, blk%nfaces
330  n_cell = n_cell + 1
331  CALL init_1d( g_b%g_1d, blk%burn_flag(ic), &
332  blk%pres(ic), g_b%To_read, blk%rhoc(ic), blk%coor(1:3,ic), &
333  blk%rb(ic), blk%Toa(ic), blk%fr(ic), blk%temp(:, ic), blk%Tf(ic))
334  END DO ! ic
335  IF ( blk%nfaces>0) THEN
336  blk%qr_old = blk%qr
337  blk%qc_old = blk%qc
338  blk%rhoc_old = blk%rhoc
339  blk%Tg_old = blk%Tg
340  blk%pres_old = blk%pres
341  END IF
342  ELSE
343  DO ic = 1, blk%nfaces
344  blk%burn_flag(ic) = 1
345  CALL init_1d( g_b%g_1d, blk%burn_flag(ic), &
346  blk%pres(ic), zero, zero, blk%coor(1:3,ic), &
347  blk%rb(ic), zero, zero, g_b%Tn(:), blk%Tf(ic))
348  END DO ! ic
349  END IF !APN
350 
351  END DO ! ib
352 
353  ELSE
354 
355  DO ib = 1, nblks
356  blk => g_b%blocks(ib)
357 
358  n_cell = n_cell + blk%nfaces
359  ENDDO
360 
361  END IF !initial_time == 0.0
362 
363  CALL mpi_allreduce(n_cell,g_b%total_cell,1,mpi_integer,&
364  mpi_sum, g_b%MPI_COMM_ROCBURN,ierror)
365 
366 
367 ! Deallocate temporary buffer space
368  CALL com_free_buffer(blk_ids)
369 
370  END SUBROUTINE initialize
371 !*****************************************************************************
372 
373 
374  SUBROUTINE finalize( G_b)
375  TYPE(list_block), POINTER :: g_b
376 
377  INTERFACE
378  SUBROUTINE finalize_0d( g_1d)
379  USE m_rocburn_interface_data, ONLY : g_burn_1d
380  TYPE (g_burn_1d), POINTER :: g_1d
381  END SUBROUTINE finalize_0d
382  END INTERFACE
383 
384  CALL com_delete_window( intwin) ! Automaticall deallocate all the buffers
385  CALL com_delete_window( iowin) ! Automaticall deallocate all the buffers
386 
387  ! CALL FINALIZE_0D( G_b%g_1d) ! Disabled because of error on Origin 2K
388 
389  ! Deallocate buffer space
390  DEALLOCATE( g_b%Tn)
391  DEALLOCATE( g_b%blocks)
392 
393  END SUBROUTINE finalize
394 
395 !
396 ! ==========================================================================
397 !
398 
399  SUBROUTINE update_wrapper(G_b, timestamp, dt, MAN_UPDATE)
400 
401 
402  TYPE(list_block), POINTER :: g_b
403  REAL(DBL), INTENT(IN) :: timestamp, dt
404  INTEGER, INTENT(IN) :: man_update
405 
406 
407  CALL com_call_function(g_b%UPDATE,6,timestamp,dt, man_update, &
408  g_b%GET_FILM_COEFF, g_b%GET_TIME_STEP, g_b%GET_BURN_RATE)
409 
410  END SUBROUTINE update_wrapper
411 
412  SUBROUTINE update( G_b, timestamp, dt, MAN_UPDATE, GET_FILM_COEFF_1D, &
413  get_time_step_1d, get_burning_rate_1d)
414 
415 
416 !!!-------------------------------------------------
417  TYPE(list_block), POINTER :: g_b
418  REAL(DBL), INTENT (IN) :: timestamp, dt
419  INTEGER, INTENT(IN) :: man_update
420 
421 !!!
422 !!! get_film_coeff_1d, get_time_step1d, and get_burning_rate1d
423 !!! are subroutine arguments. Their dummy arguments are described as follow:
424 
425  INTERFACE
426  SUBROUTINE get_film_coeff_1d( g_1d, p_coor, Ts, T_euler, P, Qc, Qcprime)
427  USE m_rocburn_interface_data, ONLY : g_burn_1d, dbl
428  TYPE (g_burn_1d), POINTER :: g_1d
429  REAL(DBL), INTENT (IN) :: p_coor(3), ts, t_euler, p
430  REAL(DBL), INTENT (OUT) :: qc,qcprime
431  END SUBROUTINE get_film_coeff_1d
432 
433  SUBROUTINE get_time_step_1d( g_1d, rb, Toa, dt_max)
434  USE m_rocburn_interface_data, ONLY : g_burn_1d, dbl
435  TYPE (g_burn_1d), POINTER :: g_1d
436  REAL(DBL), INTENT (IN) :: rb, toa
437  REAL(DBL), INTENT (OUT) :: dt_max
438  END SUBROUTINE get_time_step_1d
439 
440  SUBROUTINE get_burning_rate_1d ( g_1d, delt, P, To, Tn, &
441  qc, qc_old, qr, qr_old, rhoc, &
442  toa, rb, fr, bflag, tnp1, tflame, p_coor)
443  USE m_rocburn_interface_data, ONLY : g_burn_1d, dbl
444  TYPE (g_burn_1d), POINTER :: g_1d
445  REAL(DBL), INTENT (IN) :: delt, p, to
446  REAL(DBL), INTENT (IN) :: tn(:)
447  REAL(DBL), INTENT (IN) :: qc, qc_old, qr, qr_old
448  REAL(DBL), INTENT (IN) :: rhoc
449  REAL(DBL), INTENT (INOUT) :: toa, rb, fr
450  INTEGER, INTENT (INOUT) :: bflag
451  REAL(DBL), INTENT (OUT) :: tnp1(:)
452  REAL(DBL), INTENT (OUT) :: tflame
453  REAL(DBL), INTENT (IN) :: p_coor(3)
454  END SUBROUTINE get_burning_rate_1d
455  END INTERFACE
456 
457 !!!
458 !!! local variables
459 !!!
460  TYPE(block), POINTER :: blk
461  INTEGER :: ic, ib, one_int, ierror !Dummy indexes
462  LOGICAL :: is_apn, comp_filmcoeff
463  REAL(DBL) :: zero, one, ten
464  REAL(DBL) :: dt_max, dt_mks
465  INTEGER :: nblks, n_subcycle_0d, i_subcycle_0d
466  INTEGER :: i_pseudo_iter, max_pseudo_iter, n_cell_ignited
467  REAL(DBL) :: inv_n_subcycle_0d, alpha
468  REAL(DBL) :: delta_p, delta_qc, delta_qr, delta_tg, delta_rhoc
469  REAL(DBL) :: qr_old_mks, qc_old_mks, qr_mks, qc_mks, p_mks, rhoc_mks
470  REAL(DBL) :: tflame_apn,pre_apn,exp_apn,out_apn
471 !!!-----------------------------------------------------------------------------------------
472 !!!
473 !!! point blk to first data patch
474 !!!
475 
476  IF ( ASSOCIATED( g_b%blocks)) THEN
477  nblks = ubound( g_b%blocks, 1)
478  ELSE
479  nblks = 0
480  END IF
481 
482  is_apn = g_b%burn_model == model_apn
483  comp_filmcoeff = g_b%TBL_flag == no_tbl
484  zero=0.0
485  one = 1.0
486  ten = 10.0
487 
488  alpha=1.0d0
489  CALL com_call_function( man_update, 1, alpha)
490 
491 
492  g_b%pseudo_time = timestamp
493  g_b%burn_iter = g_b%burn_iter + 1
494  n_cell_ignited = 0
495 
496  IF (is_apn) THEN !0D MODEL
497 !RAF
498 !RAF For best speed, we could use this optimization if nmat = 1
499 !RAF
500 !RAF one_int = 1
501 !RAF CALL GET_BURNING_RATE_1D ( G_b%g_1d, zero, one, &
502 !RAF zero, G_b%Tn, zero, zero, zero, zero, zero, zero, &
503 !RAF pre_APN, zero, one_int, G_b%Tn, Tflame_APN) !get the prexponential term
504 !RAF
505 !RAF CALL GET_BURNING_RATE_1D ( G_b%g_1d, zero, ten, &
506 !RAF zero, G_b%Tn, zero, zero, zero, zero, zero, zero, &
507 !RAF out_APN, zero, one_int, G_b%Tn, Tflame_APN) !A*10^n
508 !RAF IF ( out_APN == 0) THEN
509 !RAF exp_APN = 0
510 !RAF ELSE
511 !RAF exp_APN = log10(out_APN/pre_APN) !get the exponent
512 !RAF END IF
513 
514  DO ib=1, nblks
515  blk => g_b%blocks(ib)
516  DO ic =1, blk%nfaces
517  blk%burn_flag(ic) = 1
518 
519 !RAF blk%rb(ic) = pre_APN*blk%pres(ic)**exp_APN
520 !RAF blk%Tf(ic) = Tflame_APN !This assumes no ignition model for APN
521 
522  CALL get_burning_rate_1d( g_b%g_1d, zero, blk%pres(ic), &
523  zero, g_b%Tn, &
524  zero, zero, &
525  zero, zero, &
526  zero, zero, &
527  blk%rb(ic), zero, &
528  blk%burn_flag(ic), g_b%Tn, blk%Tf(ic), blk%coor(1:3,ic))
529 
530 
531  ENDDO
532  ENDDO
533 
534  ELSE ! 1D MODELS
535 
536 
537  DO ib = 1, nblks
538  blk => g_b%blocks(ib)
539 
540  IF( comp_filmcoeff .AND. blk%nfaces>0) &
541  CALL calcdist_2d( g_b, blk%coor, blk%dist)
542 
543  DO ic = 1, blk%nfaces
544 
545  CALL get_time_step_1d( g_b%g_1d, blk%rb(ic), blk%Toa(ic), dt_max)
546 !!! G_b%To_read = G_b%To(ic)
547 
548  n_subcycle_0d = int(dt/dt_max) + 1
549 
550  IF ( n_subcycle_0d == 1) THEN ! no subcycling needed
551 
552  g_b%Tn = blk%temp(:,ic) !condensed phase temperature profile (K)
553 
554  IF( comp_filmcoeff) THEN
555  CALL get_film_coeff_1d( g_b%g_1d, blk%coor(1:3,ic), g_b%Tn(1), &
556  blk%Tg(ic), blk%pres(ic), blk%qc(ic),blk%qr(ic))
557  END IF
558  CALL get_burning_rate_1d( g_b%g_1d, dt, blk%pres(ic), &
559  g_b%To_read, g_b%Tn, &
560  blk%qc(ic), blk%qc_old(ic), &
561  blk%qr(ic), blk%qr_old(ic), &
562  blk%rhoc(ic), blk%Toa(ic), &
563  blk%rb(ic), blk%fr(ic), &
564  blk%burn_flag(ic), blk%temp(:,ic), blk%Tf(ic), &
565  blk%coor(1:3,ic))
566 
567  ELSE
568 !!!
569 !!! local subcycling needed
570 !!!
571  g_b%Tn = blk%temp(:,ic) ! condensed phase temperature profile
572 
573  IF( comp_filmcoeff ) THEN
574  CALL get_film_coeff_1d( g_b%g_1d, blk%coor(1:3,ic), g_b%Tn(1), &
575  blk%Tg(ic), blk%pres_old(ic), blk%qc(ic),blk%qr(ic))
576  END IF
577 
578  inv_n_subcycle_0d = 1.0/float(n_subcycle_0d)
579  dt_mks = dt*inv_n_subcycle_0d
580  delta_p = blk%pres(ic) - blk%pres_old(ic)
581 
582 
583 !!$ delta_qc = blk%qc(ic) - blk%qc_old(ic)
584 !!$ delta_qr = blk%qr(ic) - blk%qr_old(ic)
585  delta_tg = blk%Tg(ic) - blk%Tg_old(ic)
586  delta_rhoc = blk%rhoc(ic) - blk%rhoc_old(ic)
587 
588  qr_old_mks = blk%qr_old(ic)
589  qc_old_mks = blk%qc_old(ic)
590 
591 
592  DO i_subcycle_0d = 1, n_subcycle_0d
593  alpha = float(i_subcycle_0d)*inv_n_subcycle_0d
594  p_mks = blk%pres_old(ic) + delta_p*alpha
595 
596  qr_mks = blk%qr(ic)
597  qc_mks = blk%qc(ic)
598  rhoc_mks = blk%rhoc_old(ic) + delta_rhoc*alpha
599 
600  CALL get_burning_rate_1d( g_b%g_1d, dt_mks, p_mks, &
601  g_b%To_read, g_b%Tn, &
602  qc_mks, qc_old_mks, qr_mks, qr_old_mks, &
603  rhoc_mks, blk%Toa(ic), blk%rb(ic), blk%fr(ic), &
604  blk%burn_flag(ic), blk%temp(:,ic), blk%Tf(ic), &
605  blk%coor(1:3,ic))
606 
607 !!$ qr_old_mks = qr_mks
608 !!$ qc_old_mks = qc_mks
609  g_b%Tn = blk%temp(:,ic)
610 
611  END DO ! i_subcycle_0d
612 
613  END IF ! if n_subcycle_0d ==1
614 
615  n_cell_ignited = n_cell_ignited + blk%burn_flag(ic)
616 
617  END DO ! Cells
618 
619  IF ( blk%nfaces>0) THEN
620  blk%pres_old = blk%pres
621  !! blk%To_old = blk%To
622  blk%qc_old = blk%qc
623  blk%qr_old = blk%qr
624  blk%Tg_old = blk%Tg
625  blk%rhoc_old = blk%rhoc
626  END IF
627  END DO ! blocks
628 !
629 ! ROCBURNPY STD OUTPUT
630 !
631  CALL mpi_allreduce(n_cell_ignited,g_b%burn_cell,1,mpi_integer,&
632  mpi_sum, g_b%MPI_COMM_ROCBURN,ierror)
633  ! This statement needs access to the verbosity
634  IF(g_b%rank == 0) &
635  write(*,*)'ROCBURN iter :: ',g_b%burn_iter,'CELLS IGNITED',g_b%burn_cell,'PERCENT',&
636  dble(g_b%burn_cell)/dble(g_b%total_cell)*100.0d0,g_b%total_cell
637 
638  END IF !IF is_APN
639 
640 
641 
642  END SUBROUTINE update
643 
644 
645 ! -------------------------------------------------------------------
646 ! END OF INTERNAL PROCEDURES
647 ! -------------------------------------------------------------------
648 
649 END MODULE m_rocburn_2d
650 
651 
652 
653 
654 
655 
m_calcdist
Definition: calcdist.f90:23
Mesquite::Matrix3D::zero
void zero()
Sets all entries to zero (more efficient than assignement).
Definition: includeLinks/Matrix3D.hpp:167
m_rocburn_1d_apn::get_burning_rate_1d
subroutine get_burning_rate_1d(G_APN, delt, P_mks, To, Tn, qc_mks, qc_old_mks, qr_mks, qr_old_mks, rhoc_mks, Toa, rb_mks, fr, bflag, Tnp1, Tflame, p_coor)
Definition: Rocburn_1D_APN.f90:182
m_rocburn_2d::initialize
subroutine initialize(G_b, MAN_INIT, inSurf, inInt, INIT_0D, INIT_1D, IN_obt_attr)
Definition: rocburn_2D.f90:83
m_rocburn_2d::update_wrapper
subroutine update_wrapper(G_b, timestamp, dt, MAN_UPDATE)
Definition: rocburn_2D.f90:399
setup_py::get_time_step_1d
subroutine get_time_step_1d(bp, rb, Toa, dt_max)
Definition: setup_py.f90:30
m_rocburn_interface_data::list_block
Definition: 01.burn_interface_data.f90:122
ic
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE SUBROUTINE ic
Definition: RFLO_FindSourceCell.h:27
m_rocburn_1d_zn::get_film_coeff_1d
subroutine get_film_coeff_1d(G_ZN, p_coor, Ts, T_euler, P, qc, qcPrime)
Definition: Rocburn_1D_ZN.f90:205
m_rocburn_2d
Definition: rocburn_2D.f90:23
block
Definition: adj.h:203
m_rocburn_2d::update
subroutine update(G_b, timestamp, dt, MAN_UPDATE, GET_FILM_COEFF_1D, GET_TIME_STEP_1D, GET_BURNING_RATE_1D)
Definition: rocburn_2D.f90:412
m_rocburn_2d::finalize
subroutine finalize(G_b)
Definition: rocburn_2D.f90:374
m_calcdist::calcdist_2d
subroutine calcdist_2d(G_b, xyz_2d, dist_2d)
Definition: calcdist.f90:31
Aff_transformation_repS2::print
virtual std::ostream & print(std::ostream &os) const
Definition: Aff_transformationS2.h:277
m_rocburn_interface_data
Definition: 01.burn_interface_data.f90:23
Color::alpha
unsigned char alpha() const
Definition: Color.h:75
m_rocburn_1d_apn::finalize_0d
subroutine finalize_0d(G_APN)
Definition: Rocburn_1D_APN.f90:239
m_rocburn_2d::init_wrapper
subroutine init_wrapper(G_b, initial_time, comm, MAN_INIT, inSurf, inInt, IN_obt_attr)
Definition: rocburn_2D.f90:61
m_rocburn_interface_data::g_burn_1d
Definition: 01.burn_interface_data.f90:113
m_rocburn_2d::check_alloc
subroutine check_alloc(ierr)
Definition: rocburn_2D.f90:53