MFIX  2016-1
set_increments.f
Go to the documentation of this file.
1 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
2 ! !
3 ! Module name: SET_INCREMENTS !
4 ! Author: M. Syamlal, W. Rogers Date: 10-DEC-91 !
5 ! !
6 ! Purpose: The purpose of this module is to create increments to be !
7 ! stored in the array STORE_INCREMENT which will be added !
8 ! to cell index ijk to find the effective indices of its !
9 ! neighbors. These increments are found using the 'class' !
10 ! of cell ijk. The class is determined based on the !
11 ! neighboring cell type, i.e. wall or fluid. !
12 ! !
13 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
14  SUBROUTINE set_increments
15 
16  USE compar
17  USE cutcell, ONLY: cartesian_grid
18  USE fldvar
19  USE functions
20  USE funits
21  USE geometry
22  USE indices
23  USE param
24  USE param1
25  USE physprop
26 
27 ! Module procedures
28 !---------------------------------------------------------------------//
29  use mpi_utility, only: global_all_sum
30  use error_manager
31 
32  IMPLICIT NONE
33 
34 ! Local Variables:
35 !---------------------------------------------------------------------//
36 ! Indices
37  INTEGER :: I, J, K, IJK
38  INTEGER :: IMJK, IPJK, IJKW, IJKE ! I+, I-, east/west
39  INTEGER :: IJMK, IJPK, IJKS, IJKN ! J+, J-, north/south
40  INTEGER :: IJKM, IJKP, IJKB, IJKT ! K+, K-, top/bottom
41 ! DO-loop index, ranges from 1 to ICLASS
42  INTEGER :: IC
43 ! Index for the solids phase.
44  INTEGER :: M
45 ! Local DO-loop index
46  INTEGER :: L
47 ! Index denoting cell class
48  INTEGER :: ICLASS
49 ! Array of sum of increments to make the class determination faster.
50  INTEGER :: DENOTE_CLASS(max_class)
51 ! Flags for using the 'real' I/J/K value (not cyclic.)
52  LOGICAL :: SHIFT
53 ! Used for checking iteration over core cells
54  LOGICAL, ALLOCATABLE, DIMENSION(:) :: ALREADY_VISITED
55  INTEGER :: interval, j_start(2), j_end(2)
56 !......................................................................!
57 
58 ! Initialize the error manager.
59  CALL init_err_msg("SET_INCREMENTS")
60 
61 ! Allocate increment arrays and report an allocation errors.
63 
64 ! Initialize the default values to Undefined_I
65  ip1(:) = undefined_i
66  im1(:) = undefined_i
67  jp1(:) = undefined_i
68  jm1(:) = undefined_i
69  kp1(:) = undefined_i
70  km1(:) = undefined_i
71 
72  DO i = istart3, iend3
73  shift = .NOT.(i==imin3 .OR. i==imin2 .OR. &
74  i==imax3 .OR. i==imax2)
75 
76  IF(cyclic_x .AND. nodesi.EQ.1 .AND. do_i .AND. shift) THEN
77  ip1(i) = imap_c(imap_c(i)+1)
78  im1(i) = imap_c(imap_c(i)-1)
79  ELSE
80  im1(i) = max(istart3, i - 1)
81  ip1(i) = min(iend3, i + 1)
82  ENDIF
83  ENDDO
84 
85  DO j = jstart3, jend3
86 
87  shift = .NOT.(j==jmin3 .OR. j==jmin2 .OR. &
88  j==jmax3 .OR. j==jmax2)
89 
90  IF (cyclic_y .AND. nodesj.EQ.1 .AND. do_j .AND. shift) THEN
91  jp1(j) = jmap_c(jmap_c(j)+1)
92  jm1(j) = jmap_c(jmap_c(j)-1)
93  ELSE
94  jm1(j) = max(jstart3,j - 1)
95  jp1(j) = min(jend3, j + 1)
96  ENDIF
97  ENDDO
98 
99 
100  DO k = kstart3, kend3
101 
102  shift = .NOT.(k==kmin3 .OR. k==kmin2 .OR. &
103  k==kmax3 .OR. k==kmax2)
104 
105  IF(cyclic_z .AND. nodesk.EQ.1 .AND. do_k .AND. shift) THEN
106  kp1(k) = kmap_c(kmap_c(k)+1)
107  km1(k) = kmap_c(kmap_c(k)-1)
108  ELSE
109  km1(k) = max(kstart3,k - 1)
110  kp1(k) = min(kend3,k + 1)
111  ENDIF
112  ENDDO
113 
114 ! Loop over all cells
115  DO k = kstart3, kend3
116  DO j = jstart3, jend3
117  DO i = istart3, iend3
118 
119  ijk = funijk(i,j,k) ! Find value of IJK
120 
121  i_of(ijk) = i
122  j_of(ijk) = j
123  k_of(ijk) = k
124 
125  ENDDO
126  ENDDO
127  ENDDO
128 
129  iclass = 0
130 
131 ! Loop over all cells (minus the ghost layers)
132  DO k = kstart3, kend3
133  DO j = jstart3, jend3
134  l100: DO i = istart3, iend3
135 
136  ijk = funijk(i,j,k)
137 
138 ! Find the the effective cell-center indices for all neighbor cells
139  CALL set_index1a (i, j, k, ijk, imjk, ipjk, ijmk, ijpk, ijkm, &
140  ijkp, ijkw, ijke, ijks, ijkn, ijkb, ijkt)
141 
142  iclass = iclass + 1 !Increment the ICLASS counter
143  IF(iclass > max_class) THEN
144  WRITE(err_msg, 1200) trim(ival(max_class))
145  CALL flush_err_msg(abort=.true.)
146  ENDIF
147 
148  1200 FORMAT('Error 1200: The number of classes has exceeded the ', &
149  'maximum: ',a,/'Increase the MAX_CLASS parameter in param1', &
150  '_mod.f and recompile.')
151 
152  increment_for_n(iclass) = ijkn - ijk
153  increment_for_s(iclass) = ijks - ijk
154  increment_for_e(iclass) = ijke - ijk
155  increment_for_w(iclass) = ijkw - ijk
156  increment_for_t(iclass) = ijkt - ijk
157  increment_for_b(iclass) = ijkb - ijk
158 
159  increment_for_im(iclass) = imjk - ijk
160  increment_for_ip(iclass) = ipjk - ijk
161  increment_for_jm(iclass) = ijmk - ijk
162  increment_for_jp(iclass) = ijpk - ijk
163  increment_for_km(iclass) = ijkm - ijk
164  increment_for_kp(iclass) = ijkp - ijk
165 
166  increment_for_nb(1,iclass) = increment_for_e(iclass)
167  increment_for_nb(2,iclass) = increment_for_w(iclass)
168  increment_for_nb(3,iclass) = increment_for_s(iclass)
169  increment_for_nb(4,iclass) = increment_for_n(iclass)
170  increment_for_nb(5,iclass) = increment_for_b(iclass)
171  increment_for_nb(6,iclass) = increment_for_t(iclass)
172 
173  increment_for_mp(1,iclass) = increment_for_im(iclass)
174  increment_for_mp(2,iclass) = increment_for_ip(iclass)
175  increment_for_mp(3,iclass) = increment_for_jm(iclass)
176  increment_for_mp(4,iclass) = increment_for_jp(iclass)
177  increment_for_mp(5,iclass) = increment_for_km(iclass)
178  increment_for_mp(6,iclass) = increment_for_kp(iclass)
179 
180 
181  denote_class(iclass) = increment_for_n(iclass) + increment_for_s&
182  (iclass) + increment_for_e(iclass) + increment_for_w(iclass)&
183  + increment_for_t(iclass) + increment_for_b(iclass) + &
184  increment_for_im(iclass) + increment_for_ip(iclass) + &
185  increment_for_jm(iclass) + increment_for_jp(iclass) + &
186  increment_for_km(iclass) + increment_for_kp(iclass)
187 
188  cell_class(ijk) = iclass
189 
190 ! Place the cell in a class based on its DENOTE_CLASS(ICLASS) value
191  DO ic = 1, iclass - 1 !Loop over previous and present classes
192 ! !IF a possible match in cell types
193  IF(denote_class(iclass) == denote_class(ic)) THEN
194 ! !is found, compare all increments
195  IF(increment_for_n(iclass) /= increment_for_n(ic)) cycle
196  IF(increment_for_s(iclass) /= increment_for_s(ic)) cycle
197  IF(increment_for_e(iclass) /= increment_for_e(ic)) cycle
198  IF(increment_for_w(iclass) /= increment_for_w(ic)) cycle
199  IF(increment_for_t(iclass) /= increment_for_t(ic)) cycle
200  IF(increment_for_b(iclass) /= increment_for_b(ic)) cycle
201  IF(increment_for_im(iclass) /= increment_for_im(ic)) cycle
202  IF(increment_for_ip(iclass) /= increment_for_ip(ic)) cycle
203  IF(increment_for_jm(iclass) /= increment_for_jm(ic)) cycle
204  IF(increment_for_jp(iclass) /= increment_for_jp(ic)) cycle
205  IF(increment_for_km(iclass) /= increment_for_km(ic)) cycle
206  IF(increment_for_kp(iclass) /= increment_for_kp(ic)) cycle
207  cell_class(ijk) = ic !Assign cell to a class
208  iclass = iclass - 1
209  cycle l100 !Go to next cell
210  ENDIF
211  END DO
212 
213  ENDDO l100
214  ENDDO
215  ENDDO
216 
217  DO m = 1, mmax
218  DO l = m, mmax
219  IF(l == m) THEN
220  store_lm(l,m) = 0
221  ELSE
222  store_lm(l,m) = m + (l - 2)*(l - 1)/2
223  store_lm(m,l) = m + (l - 2)*(l - 1)/2
224  ENDIF
225  ENDDO
226  ENDDO
227 
229 
230  if (use_corecell_loop) then
231  Allocate( already_visited(dimension_3))
232  already_visited(:) = .false.
233 
234  core_istart = istart+2
235  core_iend = iend-2
236 
237  core_jstart = jstart+2
238  core_jend = jend-2
239 
240  if (do_k) then
241  core_kstart = kstart+2
242  core_kend = kend-2
243  else
244  core_kstart = 1
245  core_kend = 1
246  kstart = 1
247  kend = 1
248  endif
249 
251 
252  outer: do k = core_kstart,core_kend
253  do i = core_istart,core_iend
254  do j = core_jstart,core_jend
255  ijk = funijk(i,j,k)
256  ! this shouldn't happen, but we might as well check
257  if (ijk.ne. (j + c0 + i*c1 + k*c2)) then
258  use_corecell_loop = .false.
259  exit outer
260  endif
261 
262  ijk = (j + c0 + i*c1 + k*c2)
263 
264  if (already_visited(ijk)) then
265  use_corecell_loop = .false.
266  exit outer
267  endif
268  already_visited(ijk) = .true.
269 
270  if (iclass.ne.cell_class(ijk)) then
271  use_corecell_loop = .false.
272  exit outer
273  endif
274  enddo
275  enddo
276  enddo outer
277 
278  j_start(1) = jstart
279  j_end(1) = jend
280  j_start(2) = 0 ! no iterations
281  j_end(2) = -1 ! no iterations
282 
283  outer2: do k = kstart,kend
284  do i = istart,iend
285 
286  if (use_corecell_loop) then
287  if (core_istart<= i .and. i <= core_iend .and. core_kstart <= k .and. k<=core_kend) then
288  j_start(1) = jstart
289  j_end(1) = core_jstart-1
290  j_start(2) = core_jend+1
291  j_end(2) = jend
292  else
293  j_start(1) = jstart
294  j_end(1) = jend
295  j_start(2) = 0 ! no iterations
296  j_end(2) = -1 ! no iterations
297  endif
298  endif
299 
300  do interval=1,2
301  do j = j_start(interval),j_end(interval)
302  if (already_visited(funijk(i,j,k))) then
303  use_corecell_loop = .false.
304  exit outer2
305  endif
306  already_visited(funijk(i,j,k)) = .true.
307  enddo
308  enddo
309  enddo
310  enddo outer2
311 
312  outer3: do k = kstart,kend
313  do i = istart,iend
314  do j = jstart,jend
315  if (.not.already_visited(funijk(i,j,k))) then
316  use_corecell_loop = .false.
317  exit outer3
318  endif
319  enddo
320  enddo
321  enddo outer3
322 
323  deallocate(already_visited)
324 
325  endif
326 
327  IF(.NOT.increment_arrays_allocated) THEN
328  allocate(west_array_of(ijkstart3:ijkend3))
329  allocate(east_array_of(ijkstart3:ijkend3))
330  allocate(south_array_of(ijkstart3:ijkend3))
331  allocate(north_array_of(ijkstart3:ijkend3))
333  allocate(top_array_of(ijkstart3:ijkend3))
334 
335  allocate(im_array_of(ijkstart3:ijkend3))
336  allocate(ip_array_of(ijkstart3:ijkend3))
337  allocate(jm_array_of(ijkstart3:ijkend3))
338  allocate(jp_array_of(ijkstart3:ijkend3))
339  allocate(km_array_of(ijkstart3:ijkend3))
340  allocate(kp_array_of(ijkstart3:ijkend3))
341  ENDIF
342 
344 
345  DO ijk = ijkstart3,ijkend3
346  west_array_of(ijk) = west_of_0(ijk)
347  east_array_of(ijk) = east_of_0(ijk)
348  south_array_of(ijk) = south_of_0(ijk)
349  north_array_of(ijk) = north_of_0(ijk)
350  bottom_array_of(ijk) = bottom_of_0(ijk)
351  top_array_of(ijk) = top_of_0(ijk)
352 
353  im_array_of(ijk) = im_of_0(ijk)
354  ip_array_of(ijk) = ip_of_0(ijk)
355  jm_array_of(ijk) = jm_of_0(ijk)
356  jp_array_of(ijk) = jp_of_0(ijk)
357  km_array_of(ijk) = km_of_0(ijk)
358  kp_array_of(ijk) = kp_of_0(ijk)
359  ENDDO
360 
361  CALL finl_err_msg
362 
363  RETURN
364 
365  END SUBROUTINE set_increments
366 
367 
368 
369 
370 
371 
372 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
373 ! C
374 ! Module name: RE_INDEX_ARRAYS C
375 ! Purpose: Remove dead cells from computation. C
376 ! C
377 ! Author: Jeff Dietiker Date: 04-MAY-11 C
378 ! Reviewer: Date: ##-###-## C
379 ! C
380 ! Revision Number: # C
381 ! Purpose: ########## C
382 ! Author: ########## Date: ##-###-## C
383 ! C
384 ! Literature/Document References: C
385 ! C
386 ! C
387 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
388 !
389  SUBROUTINE re_index_arrays
390 !
391 !-----------------------------------------------
392 ! M o d u l e s
393 !-----------------------------------------------
394  USE bc, only: ijk_p_g
395  USE cdist
396  USE compar
397  USE cutcell
398  USE discretelement, only: discrete_element
399  USE energy
400  USE exit, only: mfix_exit
401  USE fldvar
402  USE functions
403  USE funits
404  USE geometry
405  USE indices
406  USE mpi_utility
407  USE parallel
408  USE param
409  USE param1
410  USE pgcor, only : phase_4_p_g
411  USE physprop
412  USE pscor, only : phase_4_p_s
413  USE run
414  USE scalars
415  USE sendrecv
417  USE stl
418  USE visc_g
419 
420  IMPLICIT NONE
421 !-----------------------------------------------
422 ! G l o b a l P a r a m e t e r s
423 !-----------------------------------------------
424 !-----------------------------------------------
425 ! L o c a l P a r a m e t e r s
426 !-----------------------------------------------
427 !-----------------------------------------------
428 ! L o c a l V a r i a b l e s
429 !-----------------------------------------------
430 !
431 ! Indices
432  INTEGER I, J, K, IJK, NEW_IJK,NN
433 !
434 ! Index for the solids phase.
435  INTEGER M
436 
437  LOGICAL,DIMENSION(DIMENSION_3) :: ANY_CUT_TREATMENT, ANY_STANDARD_CELL
438 
439  LOGICAL :: ANY_GLOBAL_GHOST_CELL,NEED_TO_SKIP_CELL
440 
441  INTEGER,DIMENSION(DIMENSION_3) :: IM_COPY,IP_COPY,JM_COPY,JP_COPY,KM_COPY,KP_COPY
442  INTEGER,DIMENSION(DIMENSION_3) :: WEST_COPY,EAST_COPY,SOUTH_COPY,NORTH_COPY,BOTTOM_COPY,TOP_COPY
443 
444  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: TEMP_IJK_ARRAY_OF
445  INTEGER, ALLOCATABLE, DIMENSION(:) :: TEMP_I_OF,TEMP_J_OF,TEMP_K_OF
446 
447  INTEGER, ALLOCATABLE, DIMENSION(:) :: BACKGROUND_IJKEND3_ALL,NCPP_UNIFORM_ALL
448 
449  INTEGER :: iproc,IERR
450 
451  INTEGER :: I1,I2,J1,J2,K1,K2,jj,sendsize,send_pos,recvsize,recv_pos,n_total, IC
452  INTEGER :: placeholder, new_nsend1, new_nsend2,new_nrecv1,new_nrecv2
453  INTEGER :: nj1,nj2
454 
455  INTEGER, DIMENSION(26) :: new_send_size, new_recv_size
456 
457  integer, pointer, dimension(:) :: new_xsend1, new_sendijk1 , new_sendproc1, new_sendtag1, &
458  new_xsend2, new_sendijk2 , new_sendproc2, new_sendtag2, &
459  new_xrecv1, new_recvijk1 , new_recvproc1, new_recvtag1, &
460  new_xrecv2, new_recvijk2 , new_recvproc2, new_recvtag2
461 
462  integer :: comm
463 
464  DOUBLE PRECISION, DIMENSION(0:NumPEs-1) :: DIFF_NCPP
465 
466  INTEGER :: IJKW,IJKE,IJKS,IJKN,IJKB,IJKT
467  INTEGER :: IMJK,IPJK,IJMK,IJPK,IJKM,IJKP
468 
469 ! Array index denoting a cell class, it is a
470 ! column of the array STORE_INCREMENTS
471  INTEGER ICLASS
472 !
473 ! Array of sum of increments to make the class
474 ! determination faster.
475  INTEGER DENOTE_CLASS(max_class)
476 
477  INTEGER :: I_SIZE,J_SIZE,K_SIZE
478 
479 !======================================================================
480 ! Loop through useful cells and save their index
481 !======================================================================
482 
483  allocate(background_ijk_of(dimension_3))
484  allocate(ijk_of_background(dimension_3))
485 
486  allocate(temp_ijk_array_of(istart3-1:iend3+1,jstart3-1:jend3+1,kstart3-1:kend3+1))
487  temp_ijk_array_of = ijk_array_of
488 
489  allocate(temp_i_of(dimension_3))
490  allocate(temp_j_of(dimension_3))
491  allocate(temp_k_of(dimension_3))
492 
493  allocate(background_ijkend3_all(0:numpes-1))
494 
495  temp_i_of = i_of
496  temp_j_of = j_of
497  temp_k_of = k_of
498 
499  temp_ijk_array_of = ijk_array_of
500 
501  dead_cell_at = .false.
502 
503 
504  IF(mype == pe_io) WRITE(*,*)' Re-indexing: INFO: USE_DOLOOP was set to .TRUE.'
505  use_doloop = .true.
506 
507 
508 ! IF(.NOT.RE_INDEXING) THEN
509 ! print*,'Skipping re-indexing...'
510 ! GOTO 999
511 ! ENDIF
512 
513  new_ijk = ijkstart3
514 
515  ijk_of_background = -999
516 
517 ! Step 0: Indentify dead cells
518 
519  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Indentifying dead cells ...'
520 
521  any_cut_treatment = .false.
522  any_standard_cell = .false.
523 
524  DO ijk = ijkstart3, ijkend3
525 
526  i = i_of(ijk)
527  j = j_of(ijk)
528  k = k_of(ijk)
529 
530 ! IF(MyPE == PE_IO) WRITE(*,*)'IJK progress=',IJK,DBLE(IJK)/IJKEND3
531 
532  any_cut_treatment(ijk) = cut_treatment_at(ijk)&
533  .OR.cut_u_treatment_at(ijk)&
534  .OR.cut_v_treatment_at(ijk)&
535  .OR.cut_w_treatment_at(ijk)
536 
537 
538  any_standard_cell(ijk) = standard_cell_at(ijk)&
539  .OR.standard_u_cell_at(ijk)&
540  .OR.standard_v_cell_at(ijk)&
541  .OR.standard_w_cell_at(ijk)
542 
543  any_global_ghost_cell = (i < imin1).OR.(i > imax1)& ! only along global ghost cells (MIN and MAX indices)
544  .OR.(j < jmin1).OR.(j > jmax1)&
545  .OR.(k < kmin1).OR.(k > kmax1)
546 
547 
548  IF(.NOT.(any_cut_treatment(ijk)&
549  .OR.any_standard_cell(ijk)&
550  .OR.any_global_ghost_cell)) THEN
551 
552  dead_cell_at(i,j,k) = .true.
553 
554  IF(i==imin1) dead_cell_at(imin3:imin2,j,k) = .true. ! Extend dead cells to global ghost layers
555  IF(i==imax1) dead_cell_at(imax2:imax3,j,k) = .true.
556 
557  IF(j==jmin1) dead_cell_at(i,jmin3:jmin2,k) = .true.
558  IF(j==jmax1) dead_cell_at(i,jmax2:jmax3,k) = .true.
559 
560  IF(k==kmin1) dead_cell_at(i,j,kmin3:kmin2) = .true.
561  IF(k==kmax1) dead_cell_at(i,j,kmax2:kmax3) = .true.
562 
563  ENDIF
564 
565 
566 
567  ENDDO
568 
569 
570  IF(.NOT.minimize_send_recv) THEN
571 
572  dead_cell_at(istart3:istart1,jstart3:jend3,kstart3:kend3) = .false. ! Try: Keep all send/recv layers
574 
577 
580 
581  ENDIF
582 
583 
584 
585  IF(no_k) THEN ! Extend dead cells to corners of ghost layers <--------------------- SHOULD IT BE SKIPPED ??
586  DO k = kmin3, kmax3,-1
587  IF(dead_cell_at(imax1 ,jmax1 ,k)) dead_cell_at(imax2:imax3 ,jmax2:jmax3 ,k) = .true.
591  ENDDO
592  ENDIF
593 
594 
595 
596 ! Step 1: Put all send and receive layer cells in a contiguous block, needed for parallel run only
597 
598 
599 
600 
601 
602 
603 
604 
605  IF(nodesi>1.AND.nodesj==1.AND.nodesk==1) THEN ! I-DECOMPOSITION ONLY
606  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize I-decomposition ...'
607 
608 ! POTENTIAL RECEIVE LAYERS AT WEST
609  DO i = istart3,istart2
610  DO j= jstart3,jend3
611  DO k = kstart3, kend3
612  ijk = funijk(i,j,k)
613  IF(.NOT.dead_cell_at(i,j,k)) THEN
614  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
615  ELSE
616  ijk_of_background(ijk) = -999
617  ENDIF
618  ENDDO
619  ENDDO
620  ENDDO
621 
622 ! POTENTIAL SEND LAYERS AT WEST
623  DO i = istart1, istart1+1
624  DO j= jstart3,jend3
625  DO k = kstart3, kend3
626 
627  ijk = funijk(i,j,k)
628 
629  IF( any_cut_treatment(ijk).OR.any_standard_cell(ijk).OR.(.NOT.dead_cell_at(i,j,k))) THEN
630  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
631  ELSE
632  dead_cell_at(i,j,k) = .true.
633  ijk_of_background(ijk) = -999
634  ENDIF
635 
636  ENDDO
637  ENDDO
638  ENDDO
639 
640 ! POTENTIAL SEND LAYERS AT EAST
641  DO i = iend1-1,iend1
642  DO j= jstart3,jend3
643  DO k = kstart3, kend3
644 
645  ijk = funijk(i,j,k)
646 
647  IF( any_cut_treatment(ijk).OR.any_standard_cell(ijk).OR.(.NOT.dead_cell_at(i,j,k))) THEN
648  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
649  ELSE
650  dead_cell_at(i,j,k) = .true.
651  ijk_of_background(ijk) = -999
652  ENDIF
653 
654  ENDDO
655  ENDDO
656  ENDDO
657 
658 ! POTENTIAL RECEIVE LAYERS AT EAST
659  DO i = iend2,iend3
660  DO j= jstart3,jend3
661  DO k = kstart3, kend3
662  ijk = funijk(i,j,k)
663  IF(.NOT.dead_cell_at(i,j,k)) THEN
664  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
665  ELSE
666  ijk_of_background(ijk) = -999
667  ENDIF
668  ENDDO
669  ENDDO
670  ENDDO
671 
672 
673  i1 = istart1 + 2
674  i2 = iend1 - 2
675 
676  j1 = jstart3
677  j2 = jend3
678 
679  k1 = kstart3
680  k2 = kend3
681 
682 
683  ELSEIF(nodesj>1.AND.nodesi==1.AND.nodesk==1) THEN ! J-DECOMPOSITION ONLY
684  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize J-decomposition ...'
685 
686 ! POTENTIAL RECEIVE LAYERS AT SOUTH
687  DO j = jstart3,jstart2
688  DO i= istart3,iend3
689  DO k = kstart3, kend3
690  ijk = funijk(i,j,k)
691  IF(.NOT.dead_cell_at(i,j,k)) THEN
692  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
693  ELSE
694  ijk_of_background(ijk) = -999
695  ENDIF
696  ENDDO
697  ENDDO
698  ENDDO
699 
700 ! POTENTIAL SEND LAYERS AT SOUTH
701  DO j = jstart1, jstart1+1
702  DO i= istart3,iend3
703  DO k = kstart3, kend3
704 
705  ijk = funijk(i,j,k)
706 
707  IF( any_cut_treatment(ijk).OR.any_standard_cell(ijk).OR.(.NOT.dead_cell_at(i,j,k))) THEN
708  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
709  ELSE
710  dead_cell_at(i,j,k) = .true.
711  ijk_of_background(ijk) = -999
712  ENDIF
713 
714  ENDDO
715  ENDDO
716  ENDDO
717 
718 ! POTENTIAL SEND LAYERS AT NORTH
719  DO j = jend1-1,jend1
720  DO i= istart3,iend3
721  DO k = kstart3, kend3
722 
723  ijk = funijk(i,j,k)
724 
725  IF( any_cut_treatment(ijk).OR.any_standard_cell(ijk).OR.(.NOT.dead_cell_at(i,j,k))) THEN
726  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
727  ELSE
728  dead_cell_at(i,j,k) = .true.
729  ijk_of_background(ijk) = -999
730  ENDIF
731 
732  ENDDO
733  ENDDO
734  ENDDO
735 
736 ! POTENTIAL RECEIVE LAYERS AT NORTH
737  DO j = jend2,jend3
738  DO i= istart3,iend3
739  DO k = kstart3, kend3
740  ijk = funijk(i,j,k)
741  IF(.NOT.dead_cell_at(i,j,k)) THEN
742  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
743  ELSE
744  ijk_of_background(ijk) = -999
745  ENDIF
746  ENDDO
747  ENDDO
748  ENDDO
749 
750 
751  i1 = istart3
752  i2 = iend3
753 
754  j1 = jstart1 + 2
755  j2 = jend1 - 2
756 
757  k1 = kstart3
758  k2 = kend3
759 
760  ELSEIF(nodesk>1.AND.nodesi==1.AND.nodesj==1) THEN ! K-DECOMPOSITION ONLY
761  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize K-decomposition ...'
762 
763 ! POTENTIAL RECEIVE LAYERS AT BOTTOM
764  DO k = kstart3,kstart2
765  DO j= jstart3,jend3
766  DO i = istart3, iend3
767  ijk = funijk(i,j,k)
768  IF(.NOT.dead_cell_at(i,j,k)) THEN
769  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
770  ELSE
771  ijk_of_background(ijk) = -999
772  ENDIF
773  ENDDO
774  ENDDO
775  ENDDO
776 
777 ! POTENTIAL SEND LAYERS AT BOTTOM
778  DO k = kstart1, kstart1+1
779  DO j= jstart3,jend3
780  DO i = istart3, iend3
781 
782  ijk = funijk(i,j,k)
783 
784  IF( any_cut_treatment(ijk).OR.any_standard_cell(ijk).OR.(.NOT.dead_cell_at(i,j,k))) THEN
785  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
786  ELSE
787  dead_cell_at(i,j,k) = .true.
788  ijk_of_background(ijk) = -999
789  ENDIF
790 
791  ENDDO
792  ENDDO
793  ENDDO
794 
795 ! POTENTIAL SEND LAYERS AT TOP
796  DO k = kend1-1,kend1
797  DO j= jstart3,jend3
798  DO i = istart3, iend3
799 
800  ijk = funijk(i,j,k)
801 
802  IF( any_cut_treatment(ijk).OR.any_standard_cell(ijk).OR.(.NOT.dead_cell_at(i,j,k))) THEN
803  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
804  ELSE
805  dead_cell_at(i,j,k) = .true.
806  ijk_of_background(ijk) = -999
807  ENDIF
808 
809  ENDDO
810  ENDDO
811  ENDDO
812 
813 ! POTENTIAL RECEIVE LAYERS AT TOP
814  DO k = kend2,kend3
815  DO j= jstart3,jend3
816  DO i = istart3, iend3
817  ijk = funijk(i,j,k)
818  IF(.NOT.dead_cell_at(i,j,k)) THEN
819  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
820  ELSE
821  ijk_of_background(ijk) = -999
822  ENDIF
823  ENDDO
824  ENDDO
825  ENDDO
826 
827 
828  i1 = istart3
829  i2 = iend3
830 
831  j1 = jstart3
832  j2 = jend3
833 
834  k1 = kstart1 + 2
835  k2 = kend1 - 2
836 
837 
838 
839  ELSE ! SERIAL CASE OR DECOMPOSITION IN MORE THAN ONE DIRECTION
840 
841 
842 
843  i1 = istart3
844  i2 = iend3
845 
846  j1 = jstart3
847  j2 = jend3
848 
849  k1 = kstart3
850  k2 = kend3
851 
852 
853  ENDIF
854 
855 
856  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Arranging all interior cells in next contiguous block...'
857 
858 ! Step 2: Put all interior cells in next contiguous block
859 
860  DO ijk = ijkstart3, ijkend3
861 
862  i = i_of(ijk)
863  j = j_of(ijk)
864  k = k_of(ijk)
865 
866 
867  need_to_skip_cell = (i < i1).OR.(i > i2)&
868  .OR.(j < j1).OR.(j > j2)
869 
870  IF(do_k) need_to_skip_cell = (need_to_skip_cell.OR.(k < k1).OR.(k > k2))
871 
872 
873  IF(need_to_skip_cell) cycle
874 
875  IF( .NOT.dead_cell_at(i,j,k)) THEN
876  CALL record_new_ijk_cell(i,j,k,ijk,new_ijk,temp_ijk_array_of,temp_i_of,temp_j_of,temp_k_of)
877  ELSE
878 
879  ijk_of_background(ijk) = -999
880 
881  ENDIF
882 
883  ENDDO
884 
885 
886  ijk_array_of = temp_ijk_array_of
887 
888 ! FUNIJK = IJK_ARRAY_OF
889 
890  i_of = temp_i_of
891  j_of = temp_j_of
892  k_of = temp_k_of
893 
894 
895 ! Save the old value of IJKEND3
897 
898  ijkend3 = new_ijk - 1
899 
900 
901 
902  im_copy = im_array_of
903  ip_copy = ip_array_of
904  jm_copy = jm_array_of
905  jp_copy = jp_array_of
906  km_copy = km_array_of
907  kp_copy = kp_array_of
908 
909  west_copy = west_array_of
910  east_copy = east_array_of
911  south_copy = south_array_of
912  north_copy = north_array_of
913  bottom_copy = bottom_array_of
914  top_copy = top_array_of
915 
916 
917  DO ijk = ijkstart3,ijkend3
918  im_array_of(ijk) = ijk_of_background(im_copy(background_ijk_of(ijk)))
919  ip_array_of(ijk) = ijk_of_background(ip_copy(background_ijk_of(ijk)))
920  jm_array_of(ijk) = ijk_of_background(jm_copy(background_ijk_of(ijk)))
921  jp_array_of(ijk) = ijk_of_background(jp_copy(background_ijk_of(ijk)))
922  km_array_of(ijk) = ijk_of_background(km_copy(background_ijk_of(ijk)))
923  kp_array_of(ijk) = ijk_of_background(kp_copy(background_ijk_of(ijk)))
924 
925  west_array_of(ijk) = ijk_of_background(west_copy(background_ijk_of(ijk)))
926  east_array_of(ijk) = ijk_of_background(east_copy(background_ijk_of(ijk)))
927  south_array_of(ijk) = ijk_of_background(south_copy(background_ijk_of(ijk)))
928  north_array_of(ijk) = ijk_of_background(north_copy(background_ijk_of(ijk)))
929  bottom_array_of(ijk) = ijk_of_background(bottom_copy(background_ijk_of(ijk)))
930  top_array_of(ijk) = ijk_of_background(top_copy(background_ijk_of(ijk)))
931 
932  IF(im_array_of(ijk)==-999) im_array_of(ijk)=ijk
933  IF(ip_array_of(ijk)==-999) ip_array_of(ijk)=ijk
934  IF(jm_array_of(ijk)==-999) jm_array_of(ijk)=ijk
935  IF(jp_array_of(ijk)==-999) jp_array_of(ijk)=ijk
936  IF(km_array_of(ijk)==-999) km_array_of(ijk)=ijk
937  IF(kp_array_of(ijk)==-999) kp_array_of(ijk)=ijk
938 
939  IF(west_array_of(ijk)==-999) west_array_of(ijk)=ijk
940  IF(east_array_of(ijk)==-999) east_array_of(ijk)=ijk
941  IF(south_array_of(ijk)==-999) south_array_of(ijk)=ijk
942  IF(north_array_of(ijk)==-999) north_array_of(ijk)=ijk
943  IF(bottom_array_of(ijk)==-999) bottom_array_of(ijk)=ijk
944  IF(top_array_of(ijk)==-999) top_array_of(ijk)=ijk
945 
946 
947 ! Try to avoid pointing to a cell out of bound
948 
949  IF(im_array_of(ijk)<ijkstart3) im_array_of(ijk)=ijk
950  IF(ip_array_of(ijk)<ijkstart3) ip_array_of(ijk)=ijk
951  IF(jm_array_of(ijk)<ijkstart3) jm_array_of(ijk)=ijk
952  IF(jp_array_of(ijk)<ijkstart3) jp_array_of(ijk)=ijk
953  IF(km_array_of(ijk)<ijkstart3) km_array_of(ijk)=ijk
954  IF(kp_array_of(ijk)<ijkstart3) kp_array_of(ijk)=ijk
955 
956  IF(west_array_of(ijk)<ijkstart3) west_array_of(ijk)=ijk
957  IF(east_array_of(ijk)<ijkstart3) east_array_of(ijk)=ijk
958  IF(south_array_of(ijk)<ijkstart3) south_array_of(ijk)=ijk
959  IF(north_array_of(ijk)<ijkstart3) north_array_of(ijk)=ijk
960  IF(bottom_array_of(ijk)<ijkstart3) bottom_array_of(ijk)=ijk
961  IF(top_array_of(ijk)<ijkstart3) top_array_of(ijk)=ijk
962 
963 
964  IF(im_array_of(ijk)>ijkend3) im_array_of(ijk)=ijk
965  IF(ip_array_of(ijk)>ijkend3) ip_array_of(ijk)=ijk
966  IF(jm_array_of(ijk)>ijkend3) jm_array_of(ijk)=ijk
967  IF(jp_array_of(ijk)>ijkend3) jp_array_of(ijk)=ijk
968  IF(km_array_of(ijk)>ijkend3) km_array_of(ijk)=ijk
969  IF(kp_array_of(ijk)>ijkend3) kp_array_of(ijk)=ijk
970 
971  IF(west_array_of(ijk)>ijkend3) west_array_of(ijk)=ijk
972  IF(east_array_of(ijk)>ijkend3) east_array_of(ijk)=ijk
973  IF(south_array_of(ijk)>ijkend3) south_array_of(ijk)=ijk
974  IF(north_array_of(ijk)>ijkend3) north_array_of(ijk)=ijk
975  IF(bottom_array_of(ijk)>ijkend3) bottom_array_of(ijk)=ijk
976  IF(top_array_of(ijk)>ijkend3) top_array_of(ijk)=ijk
977 
978 
979 
980  ENDDO
981 
982 
983 
984  IF(.NOT.adjust_proc_domain_size) THEN
985  if(.not.allocated(ncpp_uniform)) allocate( ncpp_uniform(0:numpes-1))
986  if(.not.allocated(ncpp_uniform_all)) allocate( ncpp_uniform_all(0:numpes-1))
988  ENDIF
989 
990 #ifdef MPI
991  call mpi_barrier(mpi_comm_world, mpierr)
992 #endif
993 
994  CALL allgather_1i (ncpp_uniform(mype),ncpp_uniform_all,ierr)
995 
996  CALL allgather_1i (background_ijkend3,background_ijkend3_all,ierr)
997 
998 ! WRITE(*,100),'ON MyPE = ', MyPE, ' , &
999 ! THE NUMBER OF ACTIVE CELLS WENT FROM ',BACKGROUND_IJKEND3, ' TO ', IJKEND3 , &
1000 ! ' (', DBLE(IJKEND3-BACKGROUND_IJKEND3)/DBLE(BACKGROUND_IJKEND3)*100.0D0, ' % DIFFERENCE)'
1001 
1002 ! print*,'From set increment: MyPE,NCCP_UNIFORM=',MyPE,NCPP_UNIFORM
1003 
1004 ! WRITE(*,*) 'set increment:',MyPE,NCPP_UNIFORM(MyPE),BACKGROUND_IJKEND3,IJKEND3
1005 
1006  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Shifting arrays...'
1007 
1008  CALL shift_dp_array(ep_g)
1009  CALL shift_dp_array(ep_go)
1010  CALL shift_dp_array(p_g)
1011  CALL shift_dp_array(p_go)
1012  CALL shift_dp_array(ro_g)
1013  CALL shift_dp_array(ro_go)
1014  CALL shift_dp_array(rop_g)
1015  CALL shift_dp_array(rop_go)
1016  CALL shift_dp_array(t_g)
1017  CALL shift_dp_array(t_go)
1018  CALL shift_dp_array(gama_rg)
1019  CALL shift_dp_array(t_rg)
1020  DO nn = 1, nmax(0)
1021  CALL shift_dp_array(x_g(:,nn))
1022  CALL shift_dp_array(x_go(:,nn))
1023  CALL shift_dp_array(dif_g(:,nn))
1024  ENDDO
1025  CALL shift_dp_array(u_g)
1026  CALL shift_dp_array(u_go)
1027  CALL shift_dp_array(v_g)
1028  CALL shift_dp_array(v_go)
1029  CALL shift_dp_array(w_g)
1030  CALL shift_dp_array(w_go)
1031  CALL shift_dp_array(p_s_v)
1032  CALL shift_dp_array(p_s_f)
1033  CALL shift_dp_array(p_s_p)
1034  CALL shift_dp_array(p_star)
1035  CALL shift_dp_array(p_staro)
1036 
1037  CALL shift_dp_array(mu_g)
1038  CALL shift_dp_array(mw_mix_g)
1039 
1040  CALL shift_dp_array(mu_gt)
1042 
1043  CALL shift_dp_array(c_pg)
1044  CALL shift_dp_array(k_g)
1045 
1046  DO m = 1, mmax
1047  CALL shift_dp_array(ro_s(:,m))
1048  CALL shift_dp_array(ro_so(:,m))
1049  CALL shift_dp_array(rop_s(:,m))
1050  CALL shift_dp_array(rop_so(:,m))
1051  CALL shift_dp_array(d_p(:,m))
1052  CALL shift_dp_array(d_po(:,m))
1053  CALL shift_dp_array(t_s(:,m))
1054  CALL shift_dp_array(t_so(:,m))
1055  CALL shift_dp_array(gama_rs(:,m))
1056  CALL shift_dp_array(t_rs(:,m))
1057  DO nn = 1, nmax(m)
1058  CALL shift_dp_array(x_s(:,m,nn))
1059  CALL shift_dp_array(x_so(:,m,nn))
1060  CALL shift_dp_array(dif_s(:,m,nn))
1061  ENDDO
1062  CALL shift_dp_array(u_s(:,m))
1063  CALL shift_dp_array(u_so(:,m))
1064  CALL shift_dp_array(v_s(:,m))
1065  CALL shift_dp_array(v_so(:,m))
1066  CALL shift_dp_array(w_s(:,m))
1067  CALL shift_dp_array(w_so(:,m))
1068  CALL shift_dp_array(p_s(:,m))
1069  CALL shift_dp_array(p_s_c(:,m))
1070  CALL shift_dp_array(theta_m(:,m))
1071  CALL shift_dp_array(theta_mo(:,m))
1072  CALL shift_dp_array(c_ps(:,m))
1073  CALL shift_dp_array(k_s(:,m))
1074  ENDDO
1075 
1076 
1077 
1078  DO nn=1,nscalar
1079  CALL shift_dp_array(scalar(:,nn))
1080  CALL shift_dp_array(scalaro(:,nn))
1081  ENDDO
1082 
1083  IF(k_epsilon) THEN
1084  CALL shift_dp_array(k_turb_g)
1085  CALL shift_dp_array(e_turb_g)
1088  ENDIF
1089 
1090 
1091  CALL shift_dp_array(vol)
1092  CALL shift_dp_array(vol_u)
1093  CALL shift_dp_array(vol_v)
1094  CALL shift_dp_array(vol_w)
1095 
1096  CALL shift_dp_array(axy)
1097  CALL shift_dp_array(axy_u)
1098  CALL shift_dp_array(axy_v)
1099  CALL shift_dp_array(axy_w)
1100 
1101  CALL shift_dp_array(ayz)
1102  CALL shift_dp_array(ayz_u)
1103  CALL shift_dp_array(ayz_v)
1104  CALL shift_dp_array(ayz_w)
1105 
1106  CALL shift_dp_array(axz)
1107  CALL shift_dp_array(axz_u)
1108  CALL shift_dp_array(axz_v)
1109  CALL shift_dp_array(axz_w)
1110 
1111  CALL shift_dp_array(x_u)
1112  CALL shift_dp_array(y_u)
1113  CALL shift_dp_array(z_u)
1114 
1115  CALL shift_dp_array(x_v)
1116  CALL shift_dp_array(y_v)
1117  CALL shift_dp_array(z_v)
1118 
1119  CALL shift_dp_array(x_w)
1120  CALL shift_dp_array(y_w)
1121  CALL shift_dp_array(z_w)
1122 
1123  CALL shift_dp_array(normal_s(:,1))
1124  CALL shift_dp_array(normal_s(:,2))
1125  CALL shift_dp_array(normal_s(:,3))
1126 
1127  CALL shift_dp_array(refp_s(:,1))
1128  CALL shift_dp_array(refp_s(:,2))
1129  CALL shift_dp_array(refp_s(:,3))
1130 
1131 
1132  CALL shift_dp_array(area_cut)
1136 
1137  CALL shift_dp_array(delx_ue)
1138  CALL shift_dp_array(delx_uw)
1139  CALL shift_dp_array(dely_un)
1140  CALL shift_dp_array(dely_us)
1141  CALL shift_dp_array(delz_ut)
1142  CALL shift_dp_array(delz_ub)
1143 
1144  CALL shift_dp_array(delx_ve)
1145  CALL shift_dp_array(delx_vw)
1146  CALL shift_dp_array(dely_vn)
1147  CALL shift_dp_array(dely_vs)
1148  CALL shift_dp_array(delz_vt)
1149  CALL shift_dp_array(delz_vb)
1150 
1151  CALL shift_dp_array(delx_we)
1152  CALL shift_dp_array(delx_ww)
1153  CALL shift_dp_array(dely_wn)
1154  CALL shift_dp_array(dely_ws)
1155  CALL shift_dp_array(delz_wt)
1156  CALL shift_dp_array(delz_wb)
1157 
1158  CALL shift_dp_array(x_u_ec)
1159  CALL shift_dp_array(y_u_ec)
1160  CALL shift_dp_array(z_u_ec)
1161 
1162  CALL shift_dp_array(x_u_nc)
1163  CALL shift_dp_array(y_u_nc)
1164  CALL shift_dp_array(z_u_nc)
1165 
1166  CALL shift_dp_array(x_u_tc)
1167  CALL shift_dp_array(y_u_tc)
1168  CALL shift_dp_array(z_u_tc)
1169 
1170  CALL shift_dp_array(x_v_ec)
1171  CALL shift_dp_array(y_v_ec)
1172  CALL shift_dp_array(z_v_ec)
1173 
1174  CALL shift_dp_array(x_v_nc)
1175  CALL shift_dp_array(y_v_nc)
1176  CALL shift_dp_array(z_v_nc)
1177 
1178  CALL shift_dp_array(x_v_tc)
1179  CALL shift_dp_array(y_v_tc)
1180  CALL shift_dp_array(z_v_tc)
1181 
1182  CALL shift_dp_array(x_w_ec)
1183  CALL shift_dp_array(y_w_ec)
1184  CALL shift_dp_array(z_w_ec)
1185 
1186  CALL shift_dp_array(x_w_nc)
1187  CALL shift_dp_array(y_w_nc)
1188  CALL shift_dp_array(z_w_nc)
1189 
1190  CALL shift_dp_array(x_w_tc)
1191  CALL shift_dp_array(y_w_tc)
1192  CALL shift_dp_array(z_w_tc)
1193 
1194 
1196  CALL shift_dp_array(dwall)
1197 
1198 
1199  CALL shift_dp_array(delh_u)
1200  CALL shift_dp_array(normal_u(:,1))
1201  CALL shift_dp_array(normal_u(:,2))
1202  CALL shift_dp_array(normal_u(:,3))
1203  CALL shift_dp_array(refp_u(:,1))
1204  CALL shift_dp_array(refp_u(:,2))
1205  CALL shift_dp_array(refp_u(:,3))
1206 
1207  CALL shift_dp_array(theta_ue)
1214  CALL shift_dp_array(noc_u_e)
1215  CALL shift_dp_array(theta_un)
1218  CALL shift_dp_array(noc_u_n)
1219  CALL shift_dp_array(theta_ut)
1222  CALL shift_dp_array(noc_u_t)
1223  CALL shift_dp_array(a_upg_e)
1224  CALL shift_dp_array(a_upg_w)
1225 
1226 
1227  CALL shift_dp_array(delh_v)
1228  CALL shift_dp_array(normal_v(:,1))
1229  CALL shift_dp_array(normal_v(:,2))
1230  CALL shift_dp_array(normal_v(:,3))
1231  CALL shift_dp_array(refp_v(:,1))
1232  CALL shift_dp_array(refp_v(:,2))
1233  CALL shift_dp_array(refp_v(:,3))
1234 
1237  CALL shift_dp_array(theta_vn)
1241  CALL shift_dp_array(theta_ve)
1244  CALL shift_dp_array(noc_v_e)
1246  CALL shift_dp_array(noc_v_n)
1247  CALL shift_dp_array(theta_vt)
1250  CALL shift_dp_array(noc_v_t)
1251  CALL shift_dp_array(a_vpg_n)
1252  CALL shift_dp_array(a_vpg_s)
1253 
1254 
1255  CALL shift_dp_array(delh_w)
1256  CALL shift_dp_array(normal_w(:,1))
1257  CALL shift_dp_array(normal_w(:,2))
1258  CALL shift_dp_array(normal_w(:,3))
1259  CALL shift_dp_array(refp_w(:,1))
1260  CALL shift_dp_array(refp_w(:,2))
1261  CALL shift_dp_array(refp_w(:,3))
1262 
1267  CALL shift_dp_array(theta_wt)
1269  CALL shift_dp_array(theta_we)
1272  CALL shift_dp_array(noc_w_e)
1273  CALL shift_dp_array(theta_wn)
1276  CALL shift_dp_array(noc_w_n)
1278  CALL shift_dp_array(noc_w_t)
1279  CALL shift_dp_array(a_wpg_t)
1280  CALL shift_dp_array(a_wpg_b)
1281 
1282 
1286 
1290 
1294 
1295 
1296 
1301 
1302 
1303 
1304  CALL shift_log_array(interior_cell_at,.false.)
1305  CALL shift_log_array(small_cell_at,.false.)
1306  CALL shift_log_array(blocked_cell_at,.true.)
1307  CALL shift_log_array(blocked_u_cell_at,.true.)
1308  CALL shift_log_array(blocked_v_cell_at,.true.)
1309  CALL shift_log_array(blocked_w_cell_at,.true.)
1310  CALL shift_log_array(standard_cell_at,.false.)
1311  CALL shift_log_array(standard_u_cell_at,.false.)
1312  CALL shift_log_array(standard_v_cell_at,.false.)
1313  CALL shift_log_array(standard_w_cell_at,.false.)
1314  CALL shift_log_array(cut_cell_at,.false.)
1315  CALL shift_log_array(cut_u_cell_at,.false.)
1316  CALL shift_log_array(cut_v_cell_at,.false.)
1317  CALL shift_log_array(cut_w_cell_at,.false.)
1318  CALL shift_log_array(cut_treatment_at,.false.)
1319  CALL shift_log_array(cut_u_treatment_at,.false.)
1320  CALL shift_log_array(cut_v_treatment_at,.false.)
1321  CALL shift_log_array(cut_w_treatment_at,.false.)
1322  CALL shift_log_array(wall_u_at,.false.)
1323  CALL shift_log_array(wall_v_at,.false.)
1324  CALL shift_log_array(wall_w_at,.false.)
1325  CALL shift_log_array(snap,.false.)
1326 
1327 
1331 
1332  CALL shift_int_array(bc_id,0)
1333  CALL shift_int_array(bc_u_id,0)
1334  CALL shift_int_array(bc_v_id,0)
1335  CALL shift_int_array(bc_w_id,0)
1336 
1337  CALL shift_int_array(cell_class,0)
1338 
1341 
1342 
1343  CALL shift_log_array(scalar_node_atwall,.false.)
1344 
1349 
1350 
1351 
1353 
1354  IF(stiff_chemistry) CALL shift_log_array(notowner,.false.)
1355 
1357 
1358 
1359 !=====================================================================
1360 ! JFD: Re-assign send and receive arrays
1361 !=====================================================================
1362 
1363  is_serial = numpes==1
1364 
1365  IF(.NOT.is_serial) THEN
1366 
1367  IF(minimize_send_recv) THEN
1368 
1369 
1370  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Minimizing send and receive arrays for Send layer 1...'
1371 
1372 ! Send
1373 
1374 ! Layer 1
1375 
1376  nullify(new_xsend1, new_sendtag1, new_sendproc1, new_sendijk1)
1377 
1378 ! Get array size
1379 
1380  n_total = 0
1381  DO send_pos = lbound(sendijk1,1),ubound(sendijk1,1)
1382  ijk = sendijk1( send_pos )
1383  IF(ijk_of_background(ijk)/=-999) n_total = n_total + 1 ! count active cells
1384  ENDDO
1385 
1386 
1387  allocate( new_sendijk1( max(1,n_total) ) )
1388  allocate( new_xsend1(nsend1+1) )
1389  allocate( new_sendtag1(nsend1+1) )
1390  allocate( new_sendproc1(nsend1+1) )
1391 
1392 ! Fill in arrays
1393 
1394  new_xsend1 = 0
1395  send_pos = 0
1396  placeholder = 1
1397  new_nsend1 = 0
1398 
1399  do nn = 1,nsend1
1400  j1 = xsend1(nn)
1401  j2 = xsend1(nn+1)-1
1402  sendsize = j2-j1+1
1403 
1404  new_send_size(nn) = 0
1405 
1406  DO jj=j1,j2
1407  ijk = sendijk1( jj )
1408 
1409  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1410  new_send_size(nn) = new_send_size(nn) + 1
1411  send_pos = send_pos + 1
1412  new_sendijk1(send_pos) = ijk_of_background(ijk)
1413  ENDIF
1414  ENDDO
1415 
1416  IF(new_send_size(nn)>0) THEN
1417  new_nsend1 = new_nsend1 + 1
1418  new_xsend1(new_nsend1) = placeholder
1419  placeholder = placeholder + new_send_size(nn)
1420 
1421  new_sendtag1(new_nsend1) = sendtag1(nn)
1422  new_sendproc1(new_nsend1) = sendproc1(nn)
1423 
1424  nj1 = new_xsend1(new_nsend1)
1425  nj2 = nj1 + new_send_size(nn) - 1
1426 
1427  CALL bubble_sort_1d_int_array(new_sendijk1(nj1:nj2),nj1,nj2)
1428  ENDIF
1429 
1430  ENDDO
1431 
1432  new_xsend1(new_nsend1+1)= nj2 + 1
1433 
1434 
1435  nsend1 = new_nsend1
1436  sendtag1 => new_sendtag1
1437  sendproc1 => new_sendproc1
1438  xsend1 => new_xsend1
1439  sendijk1 => new_sendijk1
1440 
1441  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 2...'
1442 
1443 ! Layer 2
1444 
1445  nullify(new_xsend2, new_sendtag2, new_sendproc2, new_sendijk2)
1446 
1447 ! Get array size
1448 
1449  n_total = 0
1450  DO send_pos = lbound(sendijk2,1),ubound(sendijk2,1)
1451  ijk = sendijk2( send_pos )
1452  IF(ijk_of_background(ijk)/=-999) n_total = n_total + 1 ! count active cells
1453  ENDDO
1454 
1455  allocate( new_sendijk2( max(1,n_total) ) )
1456  allocate( new_xsend2(nsend2+1) )
1457  allocate( new_sendtag2(nsend2+1) )
1458  allocate( new_sendproc2(nsend2+1) )
1459 
1460 ! Fill in arrays
1461 
1462  new_xsend2 = 0
1463  send_pos = 0
1464  placeholder = 1
1465  new_nsend2 = 0
1466 
1467 
1468 
1469  do nn = 1,nsend2
1470  j1 = xsend2(nn)
1471  j2 = xsend2(nn+1)-1
1472  sendsize = j2-j1+1
1473 
1474  new_send_size(nn) = 0
1475 
1476  DO jj=j1,j2
1477  ijk = sendijk2( jj )
1478 
1479  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1480  new_send_size(nn) = new_send_size(nn) + 1
1481  send_pos = send_pos + 1
1482  new_sendijk2(send_pos) = ijk_of_background(ijk)
1483  ENDIF
1484  ENDDO
1485 
1486  IF(new_send_size(nn)>0) THEN
1487  new_nsend2 = new_nsend2 + 1
1488  new_xsend2(new_nsend2) = placeholder
1489  placeholder = placeholder + new_send_size(nn)
1490 
1491  new_sendtag2(new_nsend2) = sendtag2(nn)
1492  new_sendproc2(new_nsend2) = sendproc2(nn)
1493 
1494  nj1 = new_xsend2(new_nsend2)
1495  nj2 = nj1 + new_send_size(nn) - 1
1496 
1497 ! if (MyPE==6) print*, 'n,new_nsend2,nj1,nj2',n,new_nsend2,nj1,nj2
1498 
1499  CALL bubble_sort_1d_int_array(new_sendijk2(nj1:nj2),nj1,nj2)
1500  ENDIF
1501 
1502  ENDDO
1503 
1504  new_xsend2(new_nsend2+1)= nj2 + 1
1505 
1506 ! print*, 'MyPE, Laxt value of xsend2=',MyPE,new_nsend2,new_xsend2(new_nsend2+1)
1507 
1508  nsend2 = new_nsend2
1509  sendtag2 => new_sendtag2
1510  sendproc2 => new_sendproc2
1511  xsend2 => new_xsend2
1512  sendijk2 => new_sendijk2
1513 
1514  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 1...'
1515 
1516 ! Receive
1517 
1518 ! Layer 1
1519 
1520  nullify(new_xrecv1, new_recvtag1, new_recvproc1, new_recvijk1)
1521 
1522 ! Get array size
1523 
1524  n_total = 0
1525  DO recv_pos = lbound(recvijk1,1),ubound(recvijk1,1)
1526  ijk = recvijk1( recv_pos )
1527  IF(ijk_of_background(ijk)/=-999) n_total = n_total + 1 ! count active cells
1528  ENDDO
1529 
1530  allocate( new_recvijk1( max(1,n_total) ) )
1531  allocate( new_xrecv1(nrecv1+1) )
1532  allocate( new_recvtag1(nrecv1+1) )
1533  allocate( new_recvproc1(nrecv1+1) )
1534 
1535 ! Fill in arrays
1536 
1537  new_xrecv1 = 0
1538  recv_pos = 0
1539 
1540 
1541 
1542 
1543  new_xrecv1 = 0
1544  recv_pos = 0
1545  placeholder = 1
1546  new_nrecv1 = 0
1547 
1548  do nn = 1,nrecv1
1549  j1 = xrecv1(nn)
1550  j2 = xrecv1(nn+1)-1
1551  recvsize = j2-j1+1
1552 
1553  new_recv_size(nn) = 0
1554 
1555  DO jj=j1,j2
1556  ijk = recvijk1( jj )
1557 
1558  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1559  new_recv_size(nn) = new_recv_size(nn) + 1
1560  recv_pos = recv_pos + 1
1561  new_recvijk1(recv_pos) = ijk_of_background(ijk)
1562  ENDIF
1563  ENDDO
1564 
1565  IF(new_recv_size(nn)>0) THEN
1566  new_nrecv1 = new_nrecv1 + 1
1567  new_xrecv1(new_nrecv1) = placeholder
1568  placeholder = placeholder + new_recv_size(nn)
1569 
1570  new_recvtag1(new_nrecv1) = recvtag1(nn)
1571  new_recvproc1(new_nrecv1) = recvproc1(nn)
1572 
1573  nj1 = new_xrecv1(new_nrecv1)
1574  nj2 = nj1 + new_recv_size(nn) - 1
1575 
1576  CALL bubble_sort_1d_int_array(new_recvijk1(nj1:nj2),nj1,nj2)
1577  ENDIF
1578 
1579  ENDDO
1580 
1581  new_xrecv1(new_nrecv1+1)=nj2 + 1
1582 
1583  nrecv1 = new_nrecv1
1584  recvtag1 => new_recvtag1
1585  recvproc1 => new_recvproc1
1586  xrecv1 => new_xrecv1
1587  recvijk1 => new_recvijk1
1588 
1589 
1590  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 2...'
1591 ! Layer 2
1592 
1593  nullify(new_xrecv2, new_recvtag2, new_recvproc2, new_recvijk2)
1594 
1595 ! Get array size
1596 
1597  n_total = 0
1598  DO recv_pos = lbound(recvijk2,1),ubound(recvijk2,1)
1599  ijk = recvijk2( recv_pos )
1600  IF(ijk_of_background(ijk)/=-999) n_total = n_total + 1 ! count active cells
1601  ENDDO
1602 
1603  allocate( new_recvijk2( max(1,n_total) ) )
1604  allocate( new_xrecv2(nrecv2+1) )
1605  allocate( new_recvtag2(nrecv2+1) )
1606  allocate( new_recvproc2(nrecv2+1) )
1607 
1608 ! Fill in arrays
1609 
1610  new_xrecv2 = 0
1611  recv_pos = 0
1612  placeholder = 1
1613  new_nrecv2 = 0
1614 
1615  do nn = 1,nrecv2
1616  j1 = xrecv2(nn)
1617  j2 = xrecv2(nn+1)-1
1618  recvsize = j2-j1+1
1619 
1620  new_recv_size(nn) = 0
1621 
1622  DO jj=j1,j2
1623  ijk = recvijk2( jj )
1624 
1625  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1626  new_recv_size(nn) = new_recv_size(nn) + 1
1627  recv_pos = recv_pos + 1
1628  new_recvijk2(recv_pos) = ijk_of_background(ijk)
1629  ENDIF
1630  ENDDO
1631 
1632  IF(new_recv_size(nn)>0) THEN
1633  new_nrecv2 = new_nrecv2 + 1
1634  new_xrecv2(new_nrecv2) = placeholder
1635  placeholder = placeholder + new_recv_size(nn)
1636 
1637  new_recvtag2(new_nrecv2) = recvtag2(nn)
1638  new_recvproc2(new_nrecv2) = recvproc2(nn)
1639 
1640  nj1 = new_xrecv2(new_nrecv2)
1641  nj2 = nj1 + new_recv_size(nn) - 1
1642 
1643  CALL bubble_sort_1d_int_array(new_recvijk2(nj1:nj2),nj1,nj2)
1644  ENDIF
1645 
1646  ENDDO
1647 
1648 
1649  new_xrecv2(new_nrecv2+1)=nj2 + 1
1650 
1651  nrecv2 = new_nrecv2
1652  recvtag2 => new_recvtag2
1653  recvproc2 => new_recvproc2
1654  xrecv2 => new_xrecv2
1655  recvijk2 => new_recvijk2
1656 
1657 
1658 
1659  ELSE ! Only update IJK values
1660 
1661  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 1...'
1662 
1663 
1664 
1665 ! Send
1666 
1667 ! Layer 1
1668 
1669  nullify(new_sendijk1)
1670 
1671  print *, 'sendijk1=',size(sendijk1)
1672  allocate( new_sendijk1( size(sendijk1) ) )
1673 
1674 ! Fill in arrays
1675 
1676 
1677  do nn = 1,nsend1
1678  j1 = xsend1(nn)
1679  j2 = xsend1(nn+1)-1
1680  sendsize = j2-j1+1
1681 
1682 
1683  DO jj=j1,j2
1684  ijk = sendijk1( jj )
1685 
1686  IF(ijk_of_background(ijk)/=-999) THEN
1687  new_sendijk1(jj) = ijk_of_background(ijk)
1688  ELSE
1689  new_sendijk1(jj) = sendijk1( j1 )
1690  ENDIF
1691  ENDDO
1692 
1693 
1694  ENDDO
1695 
1696  sendijk1 => new_sendijk1
1697 
1698  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 2...'
1699 
1700 ! Layer 2
1701 
1702 
1703  print *, 'sendijk2=',size(sendijk2)
1704  nullify(new_sendijk2)
1705 
1706 
1707  allocate( new_sendijk2( size(sendijk2) ) )
1708 
1709 ! Fill in arrays
1710 
1711 
1712  do nn = 1,nsend2
1713  j1 = xsend2(nn)
1714  j2 = xsend2(nn+1)-1
1715  sendsize = j2-j1+1
1716 
1717  new_send_size(nn) = 0
1718 
1719  DO jj=j1,j2
1720  ijk = sendijk2( jj )
1721 
1722  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1723  new_sendijk2(jj) = ijk_of_background(ijk)
1724  ELSE
1725  new_sendijk2(jj) = sendijk2( j1 )
1726  ENDIF
1727  ENDDO
1728 
1729 
1730  ENDDO
1731 
1732  sendijk2 => new_sendijk2
1733 
1734  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 1...'
1735 
1736 ! Receive
1737 
1738 ! Layer 1
1739 
1740  print *, 'recvijk1=',size(recvijk1)
1741  nullify(new_recvijk1)
1742 
1743 
1744  allocate( new_recvijk1( size(recvijk1) ) )
1745 
1746 ! Fill in arrays
1747 
1748 
1749  do nn = 1,nrecv1
1750  j1 = xrecv1(nn)
1751  j2 = xrecv1(nn+1)-1
1752  recvsize = j2-j1+1
1753 
1754  new_recv_size(nn) = 0
1755 
1756  DO jj=j1,j2
1757  ijk = recvijk1( jj )
1758 
1759  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1760  new_recvijk1(jj) = ijk_of_background(ijk)
1761  ELSE
1762  new_recvijk1(jj) = recvijk1( j1 )
1763  ENDIF
1764  ENDDO
1765 
1766 
1767  ENDDO
1768 
1769  recvijk1 => new_recvijk1
1770 
1771 
1772  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 2...'
1773 ! Layer 2
1774 
1775  print *, 'secvijk2=',size(recvijk2)
1776  nullify(new_recvijk2)
1777 
1778 
1779  allocate( new_recvijk2( size(recvijk2) ) )
1780 
1781 
1782  do nn = 1,nrecv2
1783  j1 = xrecv2(nn)
1784  j2 = xrecv2(nn+1)-1
1785  recvsize = j2-j1+1
1786 
1787  new_recv_size(nn) = 0
1788 
1789  DO jj=j1,j2
1790  ijk = recvijk2( jj )
1791 
1792  IF(ijk_of_background(ijk)/=-999) THEN ! Only keep active cells
1793  new_recvijk2(jj) = ijk_of_background(ijk)
1794  ELSE
1795  new_recvijk2(jj) = recvijk2( j1 )
1796  ENDIF
1797  ENDDO
1798 
1799 
1800  ENDDO
1801 
1802 
1803  recvijk2 => new_recvijk2
1804 
1805  ENDIF
1806 
1807 #ifdef MPI
1808  comm = mpi_comm_world
1809 #endif
1810 
1811 ! INSERT NEW SEND_RECV INIT HERE
1812 
1813  call sendrecv_re_init_after_re_indexing(comm, 0 )
1814 
1815  ENDIF ! IS_SERIAL
1816 
1817 #ifdef MPI
1818  call mpi_barrier(mpi_comm_world, mpierr)
1819 #endif
1820 
1821 !goto 999
1822 
1823 !======================================================================
1824 ! Re-assign cell classes
1825 !======================================================================
1826 
1827  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Re-assigning cell classes...'
1828 
1829 ! print*, 'before class reassignment:, iclass =',iclass
1830 
1831 
1832  iclass = 0
1833 !
1834 ! Loop over all cells (minus the ghost layers)
1835  DO k = kstart3, kend3
1836  DO j = jstart3, jend3
1837  l100: DO i = istart3, iend3
1838  ijk = funijk(i,j,k) !Find value of IJK
1839 !
1840  IF(dead_cell_at(i,j,k)) cycle
1841 
1842 ! Find the the effective cell-center indices for all neighbor cells
1843 ! CALL SET_INDEX1A (I, J, K, IJK, IMJK, IPJK, IJMK, IJPK, IJKM, &
1844 ! IJKP, IJKW, IJKE, IJKS, IJKN, IJKB, IJKT)
1845 
1846  ijkn = north_array_of(ijk)
1847  ijks = south_array_of(ijk)
1848  ijke = east_array_of(ijk)
1849  ijkw = west_array_of(ijk)
1850  ijkt = top_array_of(ijk)
1851  ijkb = bottom_array_of(ijk)
1852 
1853  imjk = im_array_of(ijk)
1854  ipjk = ip_array_of(ijk)
1855  ijmk = jm_array_of(ijk)
1856  ijpk = jp_array_of(ijk)
1857  ijkm = km_array_of(ijk)
1858  ijkp = kp_array_of(ijk)
1859 
1860 !
1861  iclass = iclass + 1 !Increment the ICLASS counter
1862  IF (iclass > max_class) THEN
1863  IF(dmp_log)WRITE (unit_log, 2000) max_class
1864  CALL mfix_exit(mype)
1865  ENDIF
1866  increment_for_n(iclass) = ijkn - ijk
1867  increment_for_s(iclass) = ijks - ijk
1868  increment_for_e(iclass) = ijke - ijk
1869  increment_for_w(iclass) = ijkw - ijk
1870  increment_for_t(iclass) = ijkt - ijk
1871  increment_for_b(iclass) = ijkb - ijk
1872  increment_for_im(iclass) = imjk - ijk
1873  increment_for_ip(iclass) = ipjk - ijk
1874  increment_for_jm(iclass) = ijmk - ijk
1875  increment_for_jp(iclass) = ijpk - ijk
1876  increment_for_km(iclass) = ijkm - ijk
1877  increment_for_kp(iclass) = ijkp - ijk
1878 
1879 
1880  increment_for_nb(1,iclass) = increment_for_e(iclass)
1881  increment_for_nb(2,iclass) = increment_for_w(iclass)
1882  increment_for_nb(3,iclass) = increment_for_s(iclass)
1883  increment_for_nb(4,iclass) = increment_for_n(iclass)
1884  increment_for_nb(5,iclass) = increment_for_b(iclass)
1885  increment_for_nb(6,iclass) = increment_for_t(iclass)
1886 
1887 
1888  increment_for_mp(1,iclass) = increment_for_im(iclass)
1889  increment_for_mp(2,iclass) = increment_for_ip(iclass)
1890  increment_for_mp(3,iclass) = increment_for_jm(iclass)
1891  increment_for_mp(4,iclass) = increment_for_jp(iclass)
1892  increment_for_mp(5,iclass) = increment_for_km(iclass)
1893  increment_for_mp(6,iclass) = increment_for_kp(iclass)
1894 
1895  denote_class(iclass) = increment_for_n(iclass) + increment_for_s&
1896  (iclass) + increment_for_e(iclass) + increment_for_w(iclass)&
1897  + increment_for_t(iclass) + increment_for_b(iclass) + &
1898  increment_for_im(iclass) + increment_for_ip(iclass) + &
1899  increment_for_jm(iclass) + increment_for_jp(iclass) + &
1900  increment_for_km(iclass) + increment_for_kp(iclass)
1901 
1902  cell_class(ijk) = iclass
1903 
1904 ! Place the cell in a class based on its DENOTE_CLASS(ICLASS) value
1905  DO ic = 1, iclass - 1 !Loop over previous and present classes
1906 ! !IF a possible match in cell types
1907  IF (denote_class(iclass) == denote_class(ic)) THEN
1908 ! !is found, compare all increments
1909  IF (increment_for_n(iclass) /= increment_for_n(ic)) cycle
1910  IF (increment_for_s(iclass) /= increment_for_s(ic)) cycle
1911  IF (increment_for_e(iclass) /= increment_for_e(ic)) cycle
1912  IF (increment_for_w(iclass) /= increment_for_w(ic)) cycle
1913  IF (increment_for_t(iclass) /= increment_for_t(ic)) cycle
1914  IF (increment_for_b(iclass) /= increment_for_b(ic)) cycle
1915  IF (increment_for_im(iclass) /= increment_for_im(ic)) &
1916  cycle
1917  IF (increment_for_ip(iclass) /= increment_for_ip(ic)) &
1918  cycle
1919  IF (increment_for_jm(iclass) /= increment_for_jm(ic)) &
1920  cycle
1921  IF (increment_for_jp(iclass) /= increment_for_jp(ic)) &
1922  cycle
1923  IF (increment_for_km(iclass) /= increment_for_km(ic)) &
1924  cycle
1925  IF (increment_for_kp(iclass) /= increment_for_kp(ic)) &
1926  cycle
1927  cell_class(ijk) = ic !Assign cell to a class
1928  iclass = iclass - 1
1929  cycle l100 !Go to next cell
1930  ENDIF
1931  END DO
1932  END DO l100
1933  END DO
1934  END DO
1935 
1936  IF(mype == pe_io) WRITE(*,*)' Re-indexing: New number of classes = ', iclass
1937 
1938  CALL write_ijk_values
1939 
1940 ! IJKEND3 = BACKGROUND_IJKEND3 ! for debugging purpose, will need to be removed
1941 
1942 ! RETURN
1943 
1944  ALLOCATE( new_ijksize3_all(0:numpes-1) )
1945 
1947 
1948 ! print*,'MyPE, NEW_IJKSIZE3_ALL=',MyPE,NEW_IJKSIZE3_ALL
1949 
1950  IF(numpes.GT.1) THEN
1951 
1952 #ifdef MPI
1953  call mpi_barrier(mpi_comm_world, mpierr)
1954 #endif
1955 
1956  IF(mype.EQ.0) THEN
1957  WRITE(*,1000)"============================================================================="
1958  WRITE(*,1000)" PROCESSOR I-SIZE J-SIZE K-SIZE # CELLS # CELLS DIFF."
1959  WRITE(*,1000)" (BCKGRD) (RE-INDEXED) (%)"
1960  WRITE(*,1000)"============================================================================="
1961  ENDIF
1962 
1963 #ifdef MPI
1964  call mpi_barrier(mpi_comm_world, mpierr)
1965 #endif
1966 
1967  DO iproc = 0,numpes-1
1968  IF(mype==iproc) THEN
1969  i_size = iend1 - istart1 + 1
1970  j_size = jend1 - jstart1 + 1
1971  k_size = kend1 - kstart1 + 1
1972  diff_ncpp(iproc) = dble(new_ijksize3_all(iproc)-ncpp_uniform_all(iproc))/dble(ncpp_uniform_all(iproc))*100.0d0
1973  WRITE(*,1060) iproc,i_size,j_size,k_size,background_ijkend3_all(iproc),new_ijksize3_all(iproc),diff_ncpp(iproc)
1974  ENDIF
1975 #ifdef MPI
1976  call mpi_barrier(mpi_comm_world, mpierr)
1977 #endif
1978  ENDDO
1979 
1980  IF(mype.EQ.0) THEN
1981  WRITE(*,1000)"============================================================================="
1982  WRITE(*,1070)'MAX # OF CELLS (BACKGRD) = ',maxval(ncpp_uniform_all),' AT PROCESSOR: ',maxloc(ncpp_uniform_all)-1
1983  WRITE(*,1070)'MAX # OF CELLS (RE-INDEXED) = ',maxval(new_ijksize3_all),' AT PROCESSOR: ',maxloc(new_ijksize3_all)-1
1984  WRITE(*,1080)'DIFFERENCE (%) = ', &
1985  dble(maxval(new_ijksize3_all)-maxval(ncpp_uniform_all))/dble(maxval(ncpp_uniform_all))*100.0
1986  WRITE(*,1000)"============================================================================="
1987  ENDIF
1988 #ifdef MPI
1989  call mpi_barrier(mpi_comm_world, mpierr)
1990 #endif
1991  ENDIF
1992 
1993 1000 FORMAT(1x,a)
1994 1060 FORMAT(1x,6(i10,1x),f8.1)
1995 1070 FORMAT(1x,a,i8,a,i8)
1996 1080 FORMAT(1x,a,f8.1)
1997 !
1998 ! WRITE FOLLOWING IF THERE IS AN ERROR IN MODULE
1999 2000 FORMAT(/70('*')//'From: SET_INCREMENTS'/'Message: The number of',&
2000  'classes has exceeded the maximum allowed (',i8,'). Increase',&
2001  'MAX_CLASS in PARAM1.INC')
2002 !
2003 
2004  END SUBROUTINE re_index_arrays
2005 
2006 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2007 ! C
2008 ! Module name: RECORD_NEW_IJK_CELL C
2009 ! Purpose: Records indices for new IJK cell C
2010 ! C
2011 ! Author: Jeff Dietiker Date: 04-MAY-11 C
2012 ! Reviewer: Date: ##-###-## C
2013 ! C
2014 ! Revision Number: # C
2015 ! Purpose: ########## C
2016 ! Author: ########## Date: ##-###-## C
2017 ! C
2018 ! Literature/Document References: C
2019 ! C
2020 ! C
2021 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
2022 !
2023  SUBROUTINE record_new_ijk_cell(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
2025 !-----------------------------------------------
2026 ! M o d u l e s
2027 !-----------------------------------------------
2028  USE param
2029  USE param1
2030  USE indices
2031  USE geometry
2032  USE compar
2033  USE physprop
2034  USE fldvar
2035  USE funits
2036  USE scalars
2037  USE run
2038 
2039  USE cutcell
2040 
2041  USE sendrecv
2042 
2043  IMPLICIT NONE
2044 !-----------------------------------------------
2045 ! G l o b a l P a r a m e t e r s
2046 !-----------------------------------------------
2047 !-----------------------------------------------
2048 ! L o c a l P a r a m e t e r s
2049 !-----------------------------------------------
2050 !-----------------------------------------------
2051 ! L o c a l V a r i a b l e s
2052 !-----------------------------------------------
2053 !
2054 ! Indices
2055  INTEGER :: I, J, K, IJK, NEW_IJK
2056  INTEGER, DIMENSION(ISTART3-1:IEND3+1,JSTART3-1:JEND3+1,KSTART3-1:KEND3+1) :: TEMP_IJK_ARRAY_OF
2057  INTEGER, DIMENSION(DIMENSION_3) :: TEMP_I_OF,TEMP_J_OF,TEMP_K_OF
2058 
2059 
2060 
2061  background_ijk_of(new_ijk) = ijk
2062 
2063  ijk_of_background(ijk) = new_ijk
2064 
2065  temp_ijk_array_of(i,j,k)=new_ijk
2066 
2067  temp_i_of(new_ijk) = i
2068  temp_j_of(new_ijk) = j
2069  temp_k_of(new_ijk) = k
2070 
2071  new_ijk = new_ijk + 1
2072 
2073 
2074  RETURN
2075 
2076  END SUBROUTINE record_new_ijk_cell
2077 
2078 
2079 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2080 ! C
2081 ! Module name: BUBBLE_SORT_1D_INT_ARRAY C
2082 ! Purpose: Bubble sort a section of a 1D integer array in ascending C
2083 ! order. The section that is sorted out is from I1 to I2 C
2084 ! C
2085 ! Author: Jeff Dietiker Date: 04-MAY-11 C
2086 ! Reviewer: Date: ##-###-## C
2087 ! C
2088 ! Revision Number: # C
2089 ! Purpose: ########## C
2090 ! Author: ########## Date: ##-###-## C
2091 ! C
2092 ! Literature/Document References: C
2093 ! C
2094 ! C
2095 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
2096 !
2097 
2098  SUBROUTINE bubble_sort_1d_int_array(ARRAY,I1,I2)
2100 !-----------------------------------------------
2101 ! M o d u l e s
2102 !-----------------------------------------------
2103  USE indices
2104  USE geometry
2105  USE compar
2106  USE cutcell
2107 
2108  IMPLICIT NONE
2109 
2110 !-----------------------------------------------
2111 ! L o c a l V a r i a b l e s
2112 !-----------------------------------------------
2113 !
2114 ! Indices
2115  INTEGER ::I1,I2,BUFFER,I,J
2116 !
2117  INTEGER, DIMENSION(I1:I2) :: ARRAY
2118 
2119 !-----------------------------------------------
2120 
2121 !======================================================================
2122 ! Bubble sort a section of a 1D integer array in ascending order
2123 ! The section that is sorted out is from I1 to I2
2124 !======================================================================
2125 
2126 ! print*,'Before Bubble sorting from MyPE=',MyPE, I1,I2,ARRAY
2127 
2128 
2129  DO i = i1,i2-1
2130  DO j = i2-1,i,-1
2131  IF(array(j)>array(j+1)) THEN
2132  buffer = array(j)
2133  array(j) = array(j+1)
2134  array(j+1) = buffer
2135  ENDIF
2136  ENDDO
2137  ENDDO
2138 
2139 
2140 ! print*,'After Bubble sorting from MyPE=',MyPE, I1,I2,ARRAY
2141 
2142 
2143  END SUBROUTINE bubble_sort_1d_int_array
2144 
2145 
2146 
2147  SUBROUTINE shift_dp_array(ARRAY)
2149 !-----------------------------------------------
2150 ! M o d u l e s
2151 !-----------------------------------------------
2152  USE compar
2153  USE cutcell
2154  USE functions
2155  USE geometry
2156  USE indices
2157  USE param, only: dimension_3
2158  USE param1, only: undefined
2159 
2160  IMPLICIT NONE
2161 
2162 !-----------------------------------------------
2163 ! L o c a l V a r i a b l e s
2164 !-----------------------------------------------
2165 !
2166 ! Indices
2167  INTEGER ::IJK
2168 !
2169  DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2170 
2171 !======================================================================
2172 ! To remove dead cells, the number of useful cells was calculated in
2173 ! RE_INDEX_ARRAY, and is stored back in IJKEND3
2174 ! Now, the array is shifted such that all useful values are contiguous
2175 ! and are located between IJKSTART3 and IJKEND3
2176 ! The array BACKGROUND_IJK_OF(IJK) points to the original cell
2177 !======================================================================
2178 
2179  buffer = array
2180  array = undefined
2181 
2182  DO ijk = ijkstart3, ijkend3
2183 
2184  array(ijk) = buffer(background_ijk_of(ijk))
2185 
2186  ENDDO
2187 
2188 
2189  END SUBROUTINE shift_dp_array
2190 
2191 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2192 ! C
2193 ! Module name: SHIFT_INT_ARRAY C
2194 ! Purpose: Shifts an Integer array to new IJK range C
2195 ! C
2196 ! Author: Jeff Dietiker Date: 04-MAY-11 C
2197 ! Reviewer: Date: ##-###-## C
2198 ! C
2199 ! Revision Number: # C
2200 ! Purpose: ########## C
2201 ! Author: ########## Date: ##-###-## C
2202 ! C
2203 ! Literature/Document References: C
2204 ! C
2205 ! C
2206 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
2207 !
2208  SUBROUTINE shift_int_array(ARRAY,DEFAULT_VALUE)
2210 !-----------------------------------------------
2211 ! M o d u l e s
2212 !-----------------------------------------------
2213  USE indices
2214  USE geometry
2215  USE compar
2216  USE cutcell
2217  USE functions
2218  USE param, only: dimension_3
2219 
2220  IMPLICIT NONE
2221 
2222 !-----------------------------------------------
2223 ! L o c a l V a r i a b l e s
2224 !-----------------------------------------------
2225 !
2226 ! Indices
2227  INTEGER ::IJK
2228 !
2229  INTEGER, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2230  INTEGER :: DEFAULT_VALUE
2231 
2232 !======================================================================
2233 ! To remove dead cells, the number of useful cells was calculated in
2234 ! RE_INDEX_ARRAY, and is stored back in IJKEND3
2235 ! Now, the array is shifted such that all useful values are contiguous
2236 ! and are located between IJKSTART3 and IJKEND3
2237 ! The array BACKGROUND_IJK_OF(IJK) points to the original cell
2238 !======================================================================
2239 
2240  buffer = array
2241  array = default_value
2242 
2243  DO ijk = ijkstart3, ijkend3
2244 
2245  array(ijk) = buffer(background_ijk_of(ijk))
2246 
2247  ENDDO
2248 
2249 
2250  END SUBROUTINE shift_int_array
2251 
2252 
2253 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2254 ! C
2255 ! Module name: SHIFT_LOG_ARRAY C
2256 ! Purpose: Shifts an Integer array to new IJK range C
2257 ! C
2258 ! Author: Jeff Dietiker Date: 04-MAY-11 C
2259 ! Reviewer: Date: ##-###-## C
2260 ! C
2261 ! Revision Number: # C
2262 ! Purpose: ########## C
2263 ! Author: ########## Date: ##-###-## C
2264 ! C
2265 ! Literature/Document References: C
2266 ! C
2267 ! C
2268 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
2269 !
2270  SUBROUTINE shift_log_array(ARRAY,DEFAULT_VALUE)
2272 !-----------------------------------------------
2273 ! M o d u l e s
2274 !-----------------------------------------------
2275  USE indices
2276  USE geometry
2277  USE compar
2278  USE cutcell
2279  USE functions
2280  USE param, only: dimension_3
2281 
2282  IMPLICIT NONE
2283 
2284 !-----------------------------------------------
2285 ! L o c a l V a r i a b l e s
2286 !-----------------------------------------------
2287 !
2288 ! Indices
2289  INTEGER ::IJK
2290 !
2291  LOGICAL, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2292  LOGICAL :: DEFAULT_VALUE
2293 
2294 !======================================================================
2295 ! To remove dead cells, the number of useful cells was calculated in
2296 ! RE_INDEX_ARRAY, and is stored back in IJKEND3
2297 ! Now, the array is shifted such that all useful values are contiguous
2298 ! and are located between IJKSTART3 and IJKEND3
2299 ! The array BACKGROUND_IJK_OF(IJK) points to the original cell
2300 !======================================================================
2301 
2302  buffer = array
2303  array = default_value
2304 
2305  DO ijk = ijkstart3, ijkend3
2306 
2307  array(ijk) = buffer(background_ijk_of(ijk))
2308 
2309  ENDDO
2310 
2311 
2312  END SUBROUTINE shift_log_array
2313 
2314 
2315 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2316 ! C
2317 ! Module name: UNSHIFT_DP_ARRAY C
2318 ! Purpose: Reverts a shifted Double precision array to C
2319 ! original (background) IJK range C
2320 ! C
2321 ! Author: Jeff Dietiker Date: 04-MAY-11 C
2322 ! Reviewer: Date: ##-###-## C
2323 ! C
2324 ! Revision Number: # C
2325 ! Purpose: ########## C
2326 ! Author: ########## Date: ##-###-## C
2327 ! C
2328 ! Literature/Document References: C
2329 ! C
2330 ! C
2331 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
2332 !
2333  SUBROUTINE unshift_dp_array(ARRAY_1,ARRAY_2)
2335 !-----------------------------------------------
2336 ! M o d u l e s
2337 !-----------------------------------------------
2338  USE indices
2339  USE geometry
2340  USE compar
2341  USE cutcell
2342  USE functions
2343  USE param, only: dimension_3
2344  USE param1, only: undefined
2345 
2346  IMPLICIT NONE
2347 
2348 !-----------------------------------------------
2349 ! L o c a l V a r i a b l e s
2350 !-----------------------------------------------
2351 !
2352 ! Indices
2353  INTEGER ::IJK
2354 
2355  DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: ARRAY_1, ARRAY_2
2356 
2357 !======================================================================
2358 
2359  array_2 = undefined
2360 
2361  DO ijk = ijkstart3,ijkend3
2362 
2363  array_2(background_ijk_of(ijk)) = array_1(ijk)
2364 
2365  ENDDO
2366 
2367 
2368  END SUBROUTINE unshift_dp_array
2369 
2370 
2371 !vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvC
2372 ! C
2373 ! Module name: SHIFT_CONNECTIVITY_FOR_BDIST_IO C
2374 ! Purpose: Shifts connectivity for distributed IO C
2375 ! C
2376 ! Author: Jeff Dietiker Date: 04-MAY-11 C
2377 ! Reviewer: Date: ##-###-## C
2378 ! C
2379 ! Revision Number: # C
2380 ! Purpose: ########## C
2381 ! Author: ########## Date: ##-###-## C
2382 ! C
2383 ! Literature/Document References: C
2384 ! C
2385 ! C
2386 !^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^C
2387 !
2390 !-----------------------------------------------
2391 ! M o d u l e s
2392 !-----------------------------------------------
2393  USE indices
2394  USE geometry
2395  USE compar
2396  USE cutcell
2397  USE functions
2398  USE param, only: dimension_3
2399 
2400  IMPLICIT NONE
2401 
2402 !-----------------------------------------------
2403 ! L o c a l V a r i a b l e s
2404 !-----------------------------------------------
2405 !
2406 ! Indices
2407  INTEGER ::IJK, L, BCK_IJK, NN , CONN
2408 !
2409 
2410  INTEGER, DIMENSION(DIMENSION_3,15) ::TEMP_CONNECTIVITY
2411 
2412 !======================================================================
2413 !
2414 ! The array BACKGROUND_IJK_OF(IJK) points to the original cell
2415 !======================================================================
2416 
2418 
2419  temp_connectivity = connectivity
2420 
2421  DO ijk = 1,ijkend3
2422  IF (interior_cell_at(ijk)) THEN
2423  IF (.NOT.blocked_cell_at(ijk)) THEN
2424 
2425  bck_ijk = background_ijk_of(ijk) ! Get the original IJK
2426 
2427  nn = number_of_nodes(ijk) ! Get the number of nodes for this cell, this was already shifted above
2428 
2429  DO l = 1, nn ! Loop through the connectivity list
2430  ! and reassign each point in the list
2431 
2432  conn = temp_connectivity(bck_ijk,l)
2433 
2434  IF(conn>background_ijkend3) THEN
2435  connectivity(ijk,l) = conn - background_ijkend3 + ijkend3 ! shift new point ID
2436  ELSE
2437  connectivity(ijk,l) = ijk_of_background(conn) ! Points to the new IJK value
2438  ENDIF
2439 
2440  ENDDO
2441 
2442  ENDIF
2443  ENDIF
2444  END DO
2445 
2446 
2447 
2448  END SUBROUTINE shift_connectivity_for_bdist_io
2449 
2450 
2451 
2452 
2453  SUBROUTINE write_int_table(FILE_UNIT,ARRAY, ARRAY_SIZE, LSTART, LEND, NCOL)
2454 !...Translated by Pacific-Sierra Research VAST-90 2.06G5 12:17:31 12/09/98
2455 !...Switches: -xf
2456 !
2457 !-----------------------------------------------
2458 ! M o d u l e s
2459 !-----------------------------------------------
2460  USE param
2461  USE param1
2462  USE funits
2463  IMPLICIT NONE
2464 !-----------------------------------------------
2465 ! D u m m y A r g u m e n t s
2466 !-----------------------------------------------
2467 !
2468 
2469 ! FILE UNIT
2470  INTEGER :: FILE_UNIT
2471 
2472 
2473 
2474 ! Starting array index
2475  INTEGER :: ARRAY_SIZE
2476 
2477 
2478 ! Starting array index
2479  INTEGER :: LSTART
2480 !
2481 ! Ending array index
2482  INTEGER :: LEND
2483 !//EFD Nov/11, avoid use of (*)
2484 !// DOUBLE PRECISION ARRAY(*)
2485  INTEGER :: ARRAY(array_size)
2486 !
2487 !
2488 !-----------------------------------------------
2489 ! L o c a l P a r a m e t e r s
2490 !-----------------------------------------------
2491 !
2492 ! Number of columns in the table. When this is changed
2493 ! remember to change the FORMAT statement also.
2494 !
2495 
2496  INTEGER :: NCOL
2497 !
2498 
2499 !-----------------------------------------------
2500 ! L o c a l V a r i a b l e s
2501 !-----------------------------------------------
2502 !
2503 !
2504 ! Number of rows
2505  INTEGER NROW
2506 !
2507 !
2508 ! Local array indices
2509  INTEGER L, L1, L2, L3
2510 !-----------------------------------------------
2511 !
2512  nrow = (lend - lstart + 1)/ncol
2513 !
2514  l2 = lstart - 1
2515  DO l = 1, nrow
2516  l1 = l2 + 1
2517  l2 = l1 + ncol - 1
2518  WRITE (file_unit, 1020) (array(l3),l3=l1,l2)
2519  END DO
2520  IF (nrow*ncol < lend - lstart + 1) THEN
2521  l1 = l2 + 1
2522  l2 = lend
2523  WRITE (file_unit, 1020) (array(l3),l3=l1,l2)
2524  ENDIF
2525  RETURN
2526 !
2527  1020 FORMAT(14x,50(i12,1x))
2528  END SUBROUTINE write_int_table
2529 
2530 
2531 
2532 
2533 
2534 
2535 
2536  SUBROUTINE write_ijk_values
2538 !-----------------------------------------------
2539 ! M o d u l e s
2540 !-----------------------------------------------
2541  USE param
2542  USE param1
2543  USE indices
2544  USE geometry
2545  USE compar
2546  USE physprop
2547  USE fldvar
2548  USE funits
2549  USE scalars
2550  USE run
2551  USE visc_g
2552 
2553  USE cutcell
2554 
2555  USE sendrecv
2556 
2557  USE mpi_utility
2558  USE parallel
2559 
2560  USE cdist
2561  USE functions
2562  IMPLICIT NONE
2563 !-----------------------------------------------
2564 ! G l o b a l P a r a m e t e r s
2565 !-----------------------------------------------
2566 !-----------------------------------------------
2567 ! L o c a l P a r a m e t e r s
2568 !-----------------------------------------------
2569 !-----------------------------------------------
2570 ! L o c a l V a r i a b l e s
2571 !-----------------------------------------------
2572 !
2573 ! Indices
2574  INTEGER I, J, K, IJK
2575 
2576  INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: TEMP_IJK_ARRAY_OF
2577  INTEGER :: IJK_FILE_UNIT
2578  CHARACTER(LEN=255) :: IJK_FILE_NAME
2579  CHARACTER(LEN=6) :: CHAR_MyPE
2580 
2581  allocate(temp_ijk_array_of(istart3-1:iend3+1,jstart3-1:jend3+1,kstart3-1:kend3+1))
2582  temp_ijk_array_of = ijk_array_of
2583 
2584 !======================================================================
2585 ! Write IJK value in files (for debugging or info)
2586 !======================================================================
2587 
2588 ! IF(NO_K) THEN
2589 
2590  IF(mype == pe_io) WRITE(*,*)' Re-indexing: Writing IJK value in files...'
2591 
2592  ijk_file_unit = 1000 + mype
2593  WRITE(char_mype,'(I6)')mype
2594 
2595  ijk_file_name = 'IJK_INFO_'//char_mype//'.txt'
2596 
2597  DO i=1,len(trim(ijk_file_name))
2598  IF(ijk_file_name(i:i)==' ') ijk_file_name(i:i)='0'
2599  ENDDO
2600 
2601  OPEN(convert='BIG_ENDIAN',unit=ijk_file_unit,file=ijk_file_name)
2602 
2603 
2604  WRITE(ijk_file_unit,200)' MyPE = ',mype
2605  WRITE(ijk_file_unit,200)' ISTART1,IEND1 = ',istart1,iend1
2606  WRITE(ijk_file_unit,200)' JSTART1,JEND1 = ',jstart1,jend1
2607  WRITE(ijk_file_unit,200)' KSTART1,KEND1 = ',kstart1,kend1
2608  WRITE(ijk_file_unit,200)' I-SIZE = ',iend1-istart1+1
2609  WRITE(ijk_file_unit,200)' J-SIZE = ',jend1-jstart1+1
2610  WRITE(ijk_file_unit,200)' K-SIZE = ',kend1-kstart1+1
2611  WRITE(ijk_file_unit,200)' IJKSTART3 = ',ijkstart3
2612  WRITE(ijk_file_unit,200)' IJKEND3 = ',ijkend3
2613  WRITE(ijk_file_unit,*)''
2614 
2615  IF(re_indexing) WRITE(ijk_file_unit,100) 'INFO: AFTER RE-INDEXING CELLS ON MyPE = ', mype, ' , &
2616  &THE NUMBER OF ACTIVE CELLS WENT FROM ',background_ijkend3, ' TO ', ijkend3 , &
2617  ' (', dble(ijkend3-background_ijkend3)/dble(background_ijkend3)*100.0d0, ' % DIFFERENCE)'
2618 
2619  WRITE(ijk_file_unit,*)''
2620 
2621  IF(no_k) THEN
2622  WRITE(ijk_file_unit,210) ('======',i=istart3,iend3)
2623  k=1
2624  DO j=jend3,jstart3,-1
2625  DO i=istart3,iend3
2626  ijk = funijk(i,j,k)
2627 ! TEMP_IJK_ARRAY_OF(I,J,K) = cell_class(IJK)
2628  IF(dead_cell_at(i,j,k)) temp_ijk_array_of(i,j,k) = 0
2629  ENDDO
2630  IF(re_indexing) THEN
2631  WRITE(ijk_file_unit,230) j,(temp_ijk_array_of(i,j,k),i=istart3,iend3)
2632  ELSE
2633  WRITE(ijk_file_unit,230) j,(funijk(i,j,k),i=istart3,iend3)
2634  ENDIF
2635 
2636  ENDDO
2637 
2638  WRITE(ijk_file_unit,210) ('======',i=istart3,iend3)
2639  WRITE(ijk_file_unit,220) (i,i=istart3,iend3)
2640 
2641  ELSE
2642  DO ijk=ijkstart3,ijkend3
2643  WRITE(ijk_file_unit,*) ijk,i_of(ijk),j_of(ijk),k_of(ijk)
2644  ENDDO
2645 
2646  ENDIF
2647 
2648 
2649 100 FORMAT(1x,a,i6,a,i8,a,i8,a,f6.1,a)
2650 200 FORMAT(1x,a30,2(i8))
2651 
2652 210 FORMAT(8x,50(a))
2653 220 FORMAT(1x,' J/I | ',50(i6))
2654 230 FORMAT(1x,i4,' | ',50(i6))
2655 
2656  IF(.NOT.is_serial) THEN
2657 
2658  WRITE(ijk_file_unit,*)''
2659 
2660  WRITE(ijk_file_unit,*)' Layer = ',1
2661  WRITE(ijk_file_unit,*)' nsend1 = ', nsend1
2662  WRITE(ijk_file_unit,*)' sendproc1 = ', sendproc1(1:nsend1)
2663  WRITE(ijk_file_unit,*)' sendtag1 = ', sendtag1(1:nsend1)
2664  WRITE(ijk_file_unit,*)' xsend1 = ', xsend1(1:nsend1)
2665  WRITE(ijk_file_unit,*)' size = ', size(sendijk1)
2666  WRITE(ijk_file_unit,*)' sendijk1 = '
2667  CALL write_int_table(ijk_file_unit,sendijk1, size(sendijk1), 1, size(sendijk1),5)
2668  WRITE(ijk_file_unit,*)''
2669 
2670  WRITE(ijk_file_unit,*)' nrecv1 = ', nrecv1
2671  WRITE(ijk_file_unit,*)' recvproc1 = ', recvproc1(1:nrecv1)
2672  WRITE(ijk_file_unit,*)' recvtag1 = ', recvtag1(1:nrecv1)
2673  WRITE(ijk_file_unit,*)' xrecv1 = ', xrecv1(1:nrecv1)
2674  WRITE(ijk_file_unit,*)' size = ', size(recvijk1)
2675  WRITE(ijk_file_unit,*)' recvijk1 = '
2676  CALL write_int_table(ijk_file_unit,recvijk1, size(recvijk1), 1, size(recvijk1), 5)
2677  WRITE(ijk_file_unit,*)''
2678  WRITE(ijk_file_unit,*)''
2679 
2680  WRITE(ijk_file_unit,*)' Layer = ',2
2681  WRITE(ijk_file_unit,*)' nsend2 = ', nsend2
2682  WRITE(ijk_file_unit,*)' sendproc2 = ', sendproc2(1:nsend2)
2683  WRITE(ijk_file_unit,*)' sendtag2 = ', sendtag2(1:nsend2)
2684  WRITE(ijk_file_unit,*)' xsend2 = ', xsend2(1:nsend2)
2685  WRITE(ijk_file_unit,*)' size = ', size(sendijk2)
2686  WRITE(ijk_file_unit,*)' sendijk2 = '
2687  CALL write_int_table(ijk_file_unit,sendijk2, size(sendijk2), 1, size(sendijk2),5)
2688  WRITE(ijk_file_unit,*)''
2689 
2690  WRITE(ijk_file_unit,*)' nrecv2 = ', nrecv2
2691  WRITE(ijk_file_unit,*)' recvproc2 = ', recvproc2(1:nrecv2)
2692  WRITE(ijk_file_unit,*)' recvtag2 = ', recvtag2(1:nrecv2)
2693  WRITE(ijk_file_unit,*)' xrecv2 = ', xrecv2(1:nrecv2)
2694  WRITE(ijk_file_unit,*)' size = ', size(recvijk2)
2695  WRITE(ijk_file_unit,*)' recvijk2 = '
2696  CALL write_int_table(ijk_file_unit,recvijk2, size(recvijk2), 1, size(recvijk2), 5)
2697  WRITE(ijk_file_unit,*)''
2698 
2699  ENDIF
2700 
2701  CLOSE(ijk_file_unit)
2702 
2703 ! ENDIF
2704 
2705 #ifdef MPI
2706  call mpi_barrier(mpi_comm_world, mpierr)
2707 #endif
2708 
2709 !=====================================================================
2710 ! JFD: End of Print send info
2711 !=====================================================================
2712  END SUBROUTINE write_ijk_values
integer, dimension(max_class) increment_for_jp
Definition: indices_mod.f:23
double precision, dimension(:), allocatable theta_wn
Definition: cutcell_mod.f:302
integer, dimension(:), allocatable ip1
Definition: indices_mod.f:50
integer jend2
Definition: compar_mod.f:80
double precision, dimension(:,:), allocatable scalar_node_xyz
Definition: cutcell_mod.f:469
integer, dimension(:), pointer sendijk2
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable delx_we
Definition: cutcell_mod.f:151
double precision, dimension(:,:), allocatable normal_u
Definition: cutcell_mod.f:203
integer, dimension(:), allocatable jmap_c
Definition: compar_mod.f:78
integer iend3
Definition: compar_mod.f:80
double precision, dimension(:), allocatable theta_un
Definition: cutcell_mod.f:222
double precision, dimension(:,:), allocatable v_s
Definition: fldvar_mod.f:105
logical re_indexing
Definition: cutcell_mod.f:16
double precision, dimension(:,:), allocatable v_so
Definition: fldvar_mod.f:108
integer, dimension(:,:,:), allocatable ijk_array_of
Definition: compar_mod.f:112
double precision, dimension(:,:), allocatable c_ps
Definition: physprop_mod.f:86
integer, dimension(:), pointer recvijk2
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable y_v
Definition: cutcell_mod.f:55
logical dmp_log
Definition: funits_mod.f:6
double precision, dimension(:), allocatable vol_w
Definition: geometry_mod.f:242
double precision, dimension(:), allocatable alpha_ut_c
Definition: cutcell_mod.f:231
double precision, dimension(:), allocatable theta_w_tn
Definition: cutcell_mod.f:290
double precision, dimension(:), allocatable dely_vn
Definition: cutcell_mod.f:146
integer imax2
Definition: geometry_mod.f:61
double precision, dimension(:), allocatable e_turb_go
Definition: fldvar_mod.f:166
double precision, dimension(:), allocatable y_v_nc
Definition: cutcell_mod.f:176
double precision, dimension(:), allocatable z_u
Definition: cutcell_mod.f:51
double precision, dimension(:), allocatable noc_v_t
Definition: cutcell_mod.f:270
integer, dimension(:), allocatable i_of
Definition: indices_mod.f:45
logical, dimension(:), allocatable wall_u_at
Definition: cutcell_mod.f:126
integer, dimension(max_class) increment_for_ip
Definition: indices_mod.f:21
logical, dimension(:), allocatable cut_u_cell_at
Definition: cutcell_mod.f:356
integer, dimension(:), allocatable kmap_c
Definition: compar_mod.f:78
logical, dimension(:), allocatable standard_u_cell_at
Definition: cutcell_mod.f:369
integer, parameter max_class
Definition: param1_mod.f:8
integer c0
Definition: compar_mod.f:104
double precision, dimension(:), allocatable oneodx_e_w
Definition: cutcell_mod.f:324
integer jstart3
Definition: compar_mod.f:80
integer ijkend3
Definition: compar_mod.f:80
integer kend1
Definition: compar_mod.f:80
double precision, dimension(:), allocatable delx_uw
Definition: cutcell_mod.f:138
double precision, dimension(:), allocatable alpha_vt_c
Definition: cutcell_mod.f:269
double precision, dimension(:), allocatable ep_g
Definition: fldvar_mod.f:15
double precision, dimension(:,:), allocatable ro_so
Definition: fldvar_mod.f:48
integer background_ijkend3
Definition: indices_mod.f:70
integer istart1
Definition: compar_mod.f:80
integer, dimension(:), pointer recvtag1
Definition: sendrecv_mod.f:29
logical bdist_io
Definition: cdist_mod.f:4
integer, dimension(6, max_class) increment_for_nb
Definition: indices_mod.f:28
subroutine finl_err_msg
double precision, dimension(:), allocatable theta_u_ne
Definition: cutcell_mod.f:213
double precision, dimension(:), allocatable k_turb_g
Definition: fldvar_mod.f:161
double precision, dimension(:,:), allocatable dif_g
Definition: physprop_mod.f:110
double precision, dimension(:), allocatable oneodx_e_v
Definition: cutcell_mod.f:320
double precision, dimension(:,:,:), allocatable x_so
Definition: fldvar_mod.f:84
integer iend1
Definition: compar_mod.f:80
Definition: pgcor_mod.f:1
integer, dimension(:), allocatable km_array_of
Definition: compar_mod.f:123
integer imax3
Definition: geometry_mod.f:91
integer iend
Definition: compar_mod.f:87
double precision, dimension(:), allocatable dely_ws
Definition: cutcell_mod.f:154
integer dimension_3
Definition: param_mod.f:11
integer nrecv2
Definition: sendrecv_mod.f:40
double precision, dimension(:), allocatable mu_gt
Definition: visc_g_mod.f:8
double precision, dimension(:), allocatable a_wpg_t
Definition: cutcell_mod.f:311
subroutine write_int_table(FILE_UNIT, ARRAY, ARRAY_SIZE, LSTART, LE
integer core_jend
Definition: geometry_mod.f:249
double precision, dimension(:), allocatable x_v_nc
Definition: cutcell_mod.f:175
double precision, dimension(:), allocatable a_vpg_s
Definition: cutcell_mod.f:273
integer, dimension(:), pointer recvproc2
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable z_v_nc
Definition: cutcell_mod.f:177
double precision, dimension(:), allocatable delh_u
Definition: cutcell_mod.f:200
double precision, dimension(:), allocatable axy
Definition: geometry_mod.f:210
double precision, dimension(:), allocatable oneodz_t_w
Definition: cutcell_mod.f:326
double precision, dimension(:), allocatable z_u_nc
Definition: cutcell_mod.f:165
double precision, dimension(:), allocatable noc_w_n
Definition: cutcell_mod.f:306
subroutine record_new_ijk_cell(I, J, K, IJK, NEW_IJK, TEMP_IJK_ARRAY_OF
integer istart2
Definition: compar_mod.f:80
double precision, dimension(:,:), allocatable w_s
Definition: fldvar_mod.f:117
double precision, dimension(:), allocatable x_v_ec
Definition: cutcell_mod.f:171
integer core_jstart
Definition: geometry_mod.f:249
double precision, dimension(:), allocatable theta_u_nw
Definition: cutcell_mod.f:214
double precision, dimension(:), allocatable x_u
Definition: cutcell_mod.f:49
double precision, dimension(:), allocatable noc_v_n
Definition: cutcell_mod.f:264
integer, dimension(:), pointer xsend1
Definition: sendrecv_mod.f:29
integer, dimension(:), allocatable im1
Definition: indices_mod.f:50
double precision, dimension(:), allocatable alpha_ve_c
Definition: cutcell_mod.f:260
logical adjust_proc_domain_size
Definition: cutcell_mod.f:19
integer iend2
Definition: compar_mod.f:80
double precision, dimension(:), allocatable t_g
Definition: fldvar_mod.f:63
double precision, dimension(:), allocatable theta_w_bn
Definition: cutcell_mod.f:291
double precision, dimension(:), allocatable x_w_ec
Definition: cutcell_mod.f:183
logical, dimension(:), allocatable wall_v_at
Definition: cutcell_mod.f:127
double precision, dimension(:), allocatable k_turb_go
Definition: fldvar_mod.f:165
logical, dimension(:), allocatable small_cell_at
Definition: cutcell_mod.f:360
double precision, dimension(:), allocatable p_s_f
Definition: fldvar_mod.f:135
logical, dimension(:), allocatable standard_w_cell_at
Definition: cutcell_mod.f:371
integer, dimension(:), pointer sendijk1
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable delx_ww
Definition: cutcell_mod.f:152
double precision, dimension(:), allocatable theta_wn_bar
Definition: cutcell_mod.f:303
double precision, dimension(:,:), allocatable scalar
Definition: fldvar_mod.f:155
double precision, dimension(:), allocatable theta_wt
Definition: cutcell_mod.f:293
double precision, dimension(:), allocatable delx_ue
Definition: cutcell_mod.f:137
double precision, dimension(:), allocatable x_v_tc
Definition: cutcell_mod.f:179
integer kstart3
Definition: compar_mod.f:80
subroutine set_increments
subroutine allgather_1i(lbuf, gbuf, idebug)
double precision, dimension(:), allocatable p_g
Definition: fldvar_mod.f:26
double precision, dimension(:), allocatable y_w_ec
Definition: cutcell_mod.f:184
double precision, dimension(:), allocatable z_u_ec
Definition: cutcell_mod.f:161
integer, dimension(:), allocatable bottom_array_of
Definition: compar_mod.f:120
logical cyclic_z
Definition: geometry_mod.f:153
integer core_kend
Definition: geometry_mod.f:250
double precision, dimension(:), allocatable ep_go
Definition: fldvar_mod.f:23
double precision, dimension(:), allocatable noc_u_n
Definition: cutcell_mod.f:226
double precision, dimension(:,:), allocatable normal_s
Definition: cutcell_mod.f:120
double precision, dimension(:), allocatable ayz_u
Definition: geometry_mod.f:218
integer, dimension(:), allocatable w_master_of
Definition: cutcell_mod.f:422
logical increment_arrays_allocated
Definition: compar_mod.f:131
double precision, dimension(:), allocatable z_w_nc
Definition: cutcell_mod.f:189
double precision, parameter undefined
Definition: param1_mod.f:18
double precision, dimension(:), allocatable delz_wt
Definition: cutcell_mod.f:155
integer mpierr
Definition: compar_mod.f:27
double precision, dimension(:), allocatable v_go
Definition: fldvar_mod.f:102
double precision, dimension(:), allocatable y_w
Definition: cutcell_mod.f:60
integer, dimension(:,:), allocatable store_lm
Definition: indices_mod.f:39
double precision, dimension(:), allocatable ayz
Definition: geometry_mod.f:206
integer, dimension(max_class) increment_for_b
Definition: indices_mod.f:19
integer kend2
Definition: compar_mod.f:80
double precision, dimension(:), allocatable z_v
Definition: cutcell_mod.f:56
logical, dimension(:), allocatable cut_u_treatment_at
Definition: cutcell_mod.f:350
integer jmin2
Definition: geometry_mod.f:89
integer imin3
Definition: geometry_mod.f:90
double precision, dimension(:,:), allocatable t_so
Definition: fldvar_mod.f:72
double precision, dimension(:), allocatable delh_v
Definition: cutcell_mod.f:238
double precision, dimension(:), allocatable t_go
Definition: fldvar_mod.f:69
double precision, dimension(:), allocatable delz_vt
Definition: cutcell_mod.f:148
double precision, dimension(:), allocatable u_go
Definition: fldvar_mod.f:90
double precision, dimension(:), allocatable oneody_n_u
Definition: cutcell_mod.f:316
double precision, dimension(:), allocatable a
Definition: scalars_mod.f:29
integer kstart2
Definition: compar_mod.f:80
double precision, dimension(:), allocatable alpha_ue_c
Definition: cutcell_mod.f:219
double precision, dimension(:,:), allocatable d_po
Definition: fldvar_mod.f:60
integer kstart
Definition: compar_mod.f:87
double precision, dimension(:,:), allocatable u_s
Definition: fldvar_mod.f:93
integer kstart1
Definition: compar_mod.f:80
integer kend3
Definition: compar_mod.f:80
double precision, dimension(:), allocatable ayz_v
Definition: geometry_mod.f:227
double precision, dimension(:), allocatable theta_we_bar
Definition: cutcell_mod.f:297
subroutine shift_dp_array(ARRAY)
integer numpes
Definition: compar_mod.f:24
double precision, dimension(:), allocatable axz_u
Definition: geometry_mod.f:220
integer, dimension(:), allocatable im_array_of
Definition: compar_mod.f:121
integer, dimension(:), allocatable phase_4_p_s
Definition: pscor_mod.f:28
double precision, dimension(:,:), allocatable scalaro
Definition: fldvar_mod.f:158
double precision, dimension(:), allocatable dely_vs
Definition: cutcell_mod.f:147
double precision, dimension(:), allocatable theta_ut
Definition: cutcell_mod.f:228
double precision, dimension(:), allocatable p_s_v
Definition: fldvar_mod.f:131
double precision, dimension(:,:), allocatable refp_v
Definition: cutcell_mod.f:244
double precision, dimension(:), allocatable x_w_nc
Definition: cutcell_mod.f:187
integer nrecv1
Definition: sendrecv_mod.f:40
double precision, dimension(:), allocatable alpha_wt_c
Definition: cutcell_mod.f:308
subroutine init_err_msg(CALLER)
double precision, dimension(:), allocatable theta_wt_bar
Definition: cutcell_mod.f:294
double precision, dimension(:), allocatable oneodx_e_u
Definition: cutcell_mod.f:315
integer, dimension(:), allocatable k_of
Definition: indices_mod.f:47
double precision, dimension(:), allocatable dely_wn
Definition: cutcell_mod.f:153
integer pe_io
Definition: compar_mod.f:30
Definition: ic_mod.f:9
integer core_kstart
Definition: geometry_mod.f:250
double precision, dimension(:), allocatable alpha_wn_c
Definition: cutcell_mod.f:305
double precision, dimension(:,:), allocatable p_s_c
Definition: fldvar_mod.f:127
logical, dimension(:), allocatable blocked_w_cell_at
Definition: cutcell_mod.f:366
double precision, dimension(:), allocatable theta_u_tw
Definition: cutcell_mod.f:217
double precision, dimension(:,:), allocatable theta_mo
Definition: fldvar_mod.f:152
double precision, dimension(:), allocatable theta_vn_bar
Definition: cutcell_mod.f:252
integer c2
Definition: compar_mod.f:104
double precision, dimension(:,:), allocatable d_p
Definition: fldvar_mod.f:57
integer kmax1
Definition: geometry_mod.f:58
integer, dimension(:), allocatable bc_u_id
Definition: cutcell_mod.f:434
integer, dimension(max_class) increment_for_n
Definition: indices_mod.f:14
double precision, dimension(:), allocatable noc_w_e
Definition: cutcell_mod.f:300
double precision, dimension(:), allocatable x_w
Definition: cutcell_mod.f:59
double precision, dimension(:), allocatable area_v_cut
Definition: cutcell_mod.f:133
double precision, dimension(:), allocatable x_u_tc
Definition: cutcell_mod.f:167
subroutine mfix_exit(myID, normal_termination)
Definition: exit.f:5
integer mmax
Definition: physprop_mod.f:19
logical, dimension(:,:,:), allocatable dead_cell_at
Definition: compar_mod.f:127
double precision, dimension(:), allocatable theta_vt_bar
Definition: cutcell_mod.f:267
double precision, dimension(:,:,:), allocatable x_s
Definition: fldvar_mod.f:78
integer, dimension(:), allocatable j_of
Definition: indices_mod.f:46
double precision, dimension(:), allocatable dely_us
Definition: cutcell_mod.f:140
integer, dimension(:), allocatable jm1
Definition: indices_mod.f:51
double precision, dimension(:), allocatable y_u_tc
Definition: cutcell_mod.f:168
double precision, dimension(:), allocatable y_v_ec
Definition: cutcell_mod.f:172
integer imax1
Definition: geometry_mod.f:54
logical, dimension(:), allocatable wall_w_at
Definition: cutcell_mod.f:128
integer jend3
Definition: compar_mod.f:80
subroutine shift_int_array(ARRAY, DEFAULT_VALUE)
double precision, dimension(:), allocatable theta_v_ne
Definition: cutcell_mod.f:248
double precision, dimension(:), allocatable z_v_ec
Definition: cutcell_mod.f:173
double precision, dimension(:), allocatable axy_v
Definition: geometry_mod.f:231
integer jmax2
Definition: geometry_mod.f:63
double precision, dimension(:,:), allocatable t_s
Definition: fldvar_mod.f:66
double precision, dimension(:,:), allocatable x_g
Definition: fldvar_mod.f:75
double precision, dimension(:), allocatable x_w_tc
Definition: cutcell_mod.f:191
Definition: stl_mod.f:1
double precision, dimension(:), allocatable theta_ut_bar
Definition: cutcell_mod.f:229
integer, dimension(:), allocatable bc_w_id
Definition: cutcell_mod.f:436
integer core_iend
Definition: geometry_mod.f:248
double precision, dimension(:,:), allocatable t_rs
Definition: energy_mod.f:24
Definition: exit.f:2
double precision, dimension(:), allocatable t_rg
Definition: energy_mod.f:21
Definition: cdist_mod.f:2
double precision, dimension(:), allocatable alpha_un_c
Definition: cutcell_mod.f:225
integer jstart2
Definition: compar_mod.f:80
integer, dimension(6, max_class) increment_for_mp
Definition: indices_mod.f:27
integer, dimension(:), allocatable west_array_of
Definition: compar_mod.f:118
double precision, dimension(:), allocatable noc_u_t
Definition: cutcell_mod.f:232
logical cyclic_y
Definition: geometry_mod.f:151
double precision, dimension(:), allocatable delz_wb
Definition: cutcell_mod.f:156
integer, dimension(:), allocatable jp1
Definition: indices_mod.f:51
integer, dimension(max_class) increment_for_w
Definition: indices_mod.f:17
double precision, dimension(:), allocatable z_w_tc
Definition: cutcell_mod.f:193
double precision, dimension(:), allocatable oneody_n_v
Definition: cutcell_mod.f:321
double precision, dimension(:), allocatable theta_un_bar
Definition: cutcell_mod.f:223
double precision, dimension(:), allocatable y_w_nc
Definition: cutcell_mod.f:188
double precision, dimension(:,:), allocatable theta_m
Definition: fldvar_mod.f:149
integer jmax3
Definition: geometry_mod.f:91
double precision, dimension(:), allocatable theta_vn
Definition: cutcell_mod.f:251
logical, dimension(:), allocatable blocked_u_cell_at
Definition: cutcell_mod.f:364
double precision, dimension(:), allocatable alpha_we_c
Definition: cutcell_mod.f:299
double precision, dimension(:), allocatable ovol_around_node
Definition: cutcell_mod.f:471
logical minimize_send_recv
Definition: cutcell_mod.f:492
integer ijk_p_g
Definition: bc_mod.f:304
double precision, dimension(:), allocatable v_g
Definition: fldvar_mod.f:99
double precision, dimension(:), allocatable p_s_p
Definition: fldvar_mod.f:139
logical, dimension(:), allocatable cut_w_cell_at
Definition: cutcell_mod.f:358
double precision, dimension(:), allocatable x_u_ec
Definition: cutcell_mod.f:159
integer, dimension(:), allocatable new_ijksize3_all
Definition: compar_mod.f:161
integer, dimension(:), pointer xsend2
Definition: sendrecv_mod.f:29
double precision, dimension(:,:), allocatable refp_s
Definition: cutcell_mod.f:123
logical do_j
Definition: geometry_mod.f:26
logical, dimension(:), allocatable cut_treatment_at
Definition: cutcell_mod.f:349
subroutine shift_connectivity_for_bdist_io
double precision, dimension(:), allocatable noc_u_e
Definition: cutcell_mod.f:220
double precision, dimension(:), allocatable theta_ue
Definition: cutcell_mod.f:210
integer, dimension(:), pointer xrecv1
Definition: sendrecv_mod.f:29
integer, dimension(:), pointer recvproc1
Definition: sendrecv_mod.f:29
logical is_serial
Definition: parallel_mod.f:11
integer kmax2
Definition: geometry_mod.f:65
integer, dimension(:), allocatable kp1
Definition: indices_mod.f:52
double precision, dimension(:), allocatable w_g
Definition: fldvar_mod.f:111
double precision, dimension(:), allocatable x_v
Definition: cutcell_mod.f:54
double precision, dimension(:,:,:), allocatable dif_s
Definition: physprop_mod.f:116
subroutine shift_log_array(ARRAY, DEFAULT_VALUE)
Definition: pscor_mod.f:1
integer, dimension(:), allocatable number_of_nodes
Definition: cutcell_mod.f:105
integer, dimension(:), pointer xrecv2
Definition: sendrecv_mod.f:29
integer, dimension(:), allocatable background_ijk_of
Definition: indices_mod.f:66
integer nsend2
Definition: sendrecv_mod.f:40
double precision, dimension(:,:), allocatable u_so
Definition: fldvar_mod.f:96
integer jmax1
Definition: geometry_mod.f:56
double precision, dimension(:,:), allocatable rop_so
Definition: fldvar_mod.f:54
integer, parameter unit_log
Definition: funits_mod.f:21
Definition: run_mod.f:13
double precision, dimension(:,:), allocatable refp_u
Definition: cutcell_mod.f:206
double precision, dimension(:), allocatable theta_v_nt
Definition: cutcell_mod.f:254
double precision, dimension(:), allocatable axz
Definition: geometry_mod.f:208
integer, dimension(:), allocatable imap_c
Definition: compar_mod.f:78
double precision, dimension(:), allocatable ayz_w
Definition: geometry_mod.f:236
double precision, dimension(:,:), allocatable refp_w
Definition: cutcell_mod.f:283
logical cyclic_x
Definition: geometry_mod.f:149
double precision, dimension(:,:), allocatable w_so
Definition: fldvar_mod.f:120
integer, dimension(:), allocatable bc_v_id
Definition: cutcell_mod.f:435
double precision, dimension(:), allocatable oneodz_t_u
Definition: cutcell_mod.f:317
double precision, dimension(:), allocatable w_go
Definition: fldvar_mod.f:114
Definition: param_mod.f:2
double precision, dimension(:), allocatable delh_w
Definition: cutcell_mod.f:277
integer jmin3
Definition: geometry_mod.f:90
double precision, dimension(:,:), allocatable ro_s
Definition: fldvar_mod.f:45
logical cartesian_grid
Definition: cutcell_mod.f:13
integer kend
Definition: compar_mod.f:87
double precision, dimension(:), allocatable theta_v_se
Definition: cutcell_mod.f:249
integer, dimension(:), pointer sendtag1
Definition: sendrecv_mod.f:29
logical no_k
Definition: geometry_mod.f:28
logical, dimension(:), allocatable cut_w_treatment_at
Definition: cutcell_mod.f:352
logical, dimension(:), allocatable cut_v_cell_at
Definition: cutcell_mod.f:357
double precision, dimension(:), allocatable delh_scalar
Definition: cutcell_mod.f:196
double precision, dimension(:), allocatable delz_ub
Definition: cutcell_mod.f:142
double precision, dimension(:), allocatable mw_mix_g
Definition: physprop_mod.f:130
integer, dimension(:), allocatable south_array_of
Definition: compar_mod.f:119
integer, dimension(max_class) increment_for_t
Definition: indices_mod.f:18
logical use_corecell_loop
Definition: geometry_mod.f:246
logical, dimension(:), allocatable interior_cell_at
Definition: cutcell_mod.f:40
integer, dimension(0:dim_m) nmax
Definition: physprop_mod.f:119
double precision, dimension(:), allocatable delx_vw
Definition: cutcell_mod.f:145
integer, dimension(:), pointer sendproc1
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable rop_go
Definition: fldvar_mod.f:41
integer, dimension(max_class) increment_for_kp
Definition: indices_mod.f:25
integer jmin1
Definition: geometry_mod.f:42
double precision, dimension(:,:), allocatable normal_w
Definition: cutcell_mod.f:280
integer, dimension(:), allocatable flag_e
Definition: geometry_mod.f:103
integer, dimension(:), allocatable phase_4_p_g
Definition: pgcor_mod.f:22
integer kmax3
Definition: geometry_mod.f:91
integer, dimension(:), pointer recvtag2
Definition: sendrecv_mod.f:29
logical do_k
Definition: geometry_mod.f:30
logical, dimension(:), allocatable cut_cell_at
Definition: cutcell_mod.f:355
integer, dimension(:), allocatable km1
Definition: indices_mod.f:52
double precision, dimension(:,:), allocatable p_s
Definition: fldvar_mod.f:123
logical k_epsilon
Definition: run_mod.f:97
integer jstart
Definition: compar_mod.f:87
integer mype
Definition: compar_mod.f:24
double precision, dimension(:), allocatable p_star
Definition: fldvar_mod.f:142
double precision, dimension(:), allocatable axz_w
Definition: geometry_mod.f:238
logical use_doloop
Definition: parallel_mod.f:10
double precision, dimension(:), allocatable mu_g
Definition: physprop_mod.f:68
double precision, dimension(:), allocatable gama_rg
Definition: energy_mod.f:15
double precision, dimension(:), allocatable lambda_gt
Definition: visc_g_mod.f:17
integer nodesj
Definition: compar_mod.f:37
double precision, dimension(:,:), allocatable x_go
Definition: fldvar_mod.f:81
double precision, dimension(:), allocatable theta_ue_bar
Definition: cutcell_mod.f:211
logical, dimension(:), allocatable cut_v_treatment_at
Definition: cutcell_mod.f:351
integer ijkstart3
Definition: compar_mod.f:80
double precision, dimension(:), allocatable noc_w_t
Definition: cutcell_mod.f:309
integer, dimension(max_class) increment_for_s
Definition: indices_mod.f:15
integer, dimension(:), pointer sendproc2
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable area_cut
Definition: cutcell_mod.f:131
integer, parameter undefined_i
Definition: param1_mod.f:19
double precision, dimension(:), allocatable axy_w
Definition: geometry_mod.f:240
integer kmin3
Definition: geometry_mod.f:90
double precision, dimension(:), allocatable theta_w_te
Definition: cutcell_mod.f:287
character(len=line_length), dimension(line_count) err_msg
integer, dimension(:), allocatable bc_id
Definition: cutcell_mod.f:433
double precision, dimension(:), allocatable u_g
Definition: fldvar_mod.f:87
double precision, dimension(:), allocatable y_w_tc
Definition: cutcell_mod.f:192
integer nodesk
Definition: compar_mod.f:37
integer nscalar
Definition: scalars_mod.f:7
integer, dimension(max_class) increment_for_e
Definition: indices_mod.f:16
integer istart
Definition: compar_mod.f:87
double precision, dimension(:), allocatable z_w_ec
Definition: cutcell_mod.f:185
double precision, dimension(:), allocatable y_u_ec
Definition: cutcell_mod.f:160
integer jend
Definition: compar_mod.f:87
double precision, dimension(:), allocatable a_upg_w
Definition: cutcell_mod.f:235
double precision, dimension(:), allocatable vol_u
Definition: geometry_mod.f:224
double precision, dimension(:), allocatable theta_ve_bar
Definition: cutcell_mod.f:258
double precision, dimension(:), allocatable k_g
Definition: physprop_mod.f:92
double precision, dimension(:), allocatable p_staro
Definition: fldvar_mod.f:146
double precision, dimension(:), allocatable y_u_nc
Definition: cutcell_mod.f:164
integer, dimension(:), pointer recvijk1
Definition: sendrecv_mod.f:29
logical, dimension(:), allocatable standard_cell_at
Definition: cutcell_mod.f:368
logical, dimension(:), allocatable standard_v_cell_at
Definition: cutcell_mod.f:370
integer imin2
Definition: geometry_mod.f:89
subroutine re_index_arrays
integer nodesi
Definition: compar_mod.f:37
double precision, dimension(:), allocatable area_w_cut
Definition: cutcell_mod.f:134
logical do_i
Definition: geometry_mod.f:22
double precision, dimension(:), allocatable theta_w_be
Definition: cutcell_mod.f:288
integer, dimension(max_class) increment_for_im
Definition: indices_mod.f:20
logical, dimension(:), allocatable scalar_node_atwall
Definition: cutcell_mod.f:467
double precision, dimension(:,:), allocatable rop_s
Definition: fldvar_mod.f:51
double precision, dimension(:), allocatable p_go
Definition: fldvar_mod.f:29
double precision, dimension(:), allocatable delz_vb
Definition: cutcell_mod.f:149
subroutine sendrecv_re_init_after_re_indexing(comm, idebug)
subroutine write_ijk_values
subroutine allocate_arrays_increments
double precision, dimension(:), allocatable theta_vt
Definition: cutcell_mod.f:266
double precision, dimension(:), allocatable area_u_cut
Definition: cutcell_mod.f:132
logical, dimension(:), allocatable blocked_v_cell_at
Definition: cutcell_mod.f:365
double precision, dimension(:), allocatable theta_we
Definition: cutcell_mod.f:296
double precision, dimension(:), allocatable dwall
Definition: cutcell_mod.f:488
double precision, dimension(:), allocatable oneodz_t_v
Definition: cutcell_mod.f:322
integer nsend1
Definition: sendrecv_mod.f:40
integer, dimension(:), allocatable u_master_of
Definition: cutcell_mod.f:420
integer, dimension(:), allocatable flag
Definition: geometry_mod.f:99
double precision, dimension(:), allocatable a_vpg_n
Definition: cutcell_mod.f:272
double precision, dimension(:), allocatable z_v_tc
Definition: cutcell_mod.f:181
double precision, dimension(:), allocatable z_w
Definition: cutcell_mod.f:61
double precision, dimension(:), allocatable delz_ut
Definition: cutcell_mod.f:141
logical, dimension(:), allocatable notowner
logical, dimension(:), allocatable blocked_cell_at
Definition: cutcell_mod.f:361
integer imin1
Definition: geometry_mod.f:40
double precision, dimension(:), allocatable oneody_n_w
Definition: cutcell_mod.f:325
double precision, dimension(:), allocatable dely_un
Definition: cutcell_mod.f:139
double precision, dimension(:,:), allocatable normal_v
Definition: cutcell_mod.f:241
double precision, dimension(:,:), allocatable gama_rs
Definition: energy_mod.f:18
subroutine unshift_dp_array(ARRAY_1, ARRAY_2)
double precision, dimension(:), allocatable e_turb_g
Definition: fldvar_mod.f:162
double precision, dimension(:), allocatable vol
Definition: geometry_mod.f:212
integer istart3
Definition: compar_mod.f:80
double precision, dimension(:), allocatable axy_u
Definition: geometry_mod.f:222
double precision, dimension(:), allocatable a_wpg_b
Definition: cutcell_mod.f:312
double precision, dimension(:), allocatable theta_v_st
Definition: cutcell_mod.f:255
integer, dimension(:), allocatable flag_n
Definition: geometry_mod.f:105
double precision, dimension(:), allocatable theta_u_te
Definition: cutcell_mod.f:216
integer, dimension(:), allocatable jm_array_of
Definition: compar_mod.f:122
integer, dimension(max_class) increment_for_km
Definition: indices_mod.f:24
integer, dimension(max_class) increment_for_jm
Definition: indices_mod.f:22
logical stiff_chemistry
double precision, dimension(:,:), allocatable k_s
Definition: physprop_mod.f:98
double precision, dimension(:), allocatable ro_g
Definition: fldvar_mod.f:32
integer kmin1
Definition: geometry_mod.f:44
integer, dimension(:), pointer sendtag2
Definition: sendrecv_mod.f:29
double precision, dimension(:), allocatable rop_g
Definition: fldvar_mod.f:38
double precision, dimension(:), allocatable noc_v_e
Definition: cutcell_mod.f:261
double precision, dimension(:), allocatable theta_ve
Definition: cutcell_mod.f:257
integer, dimension(:), allocatable ncpp_uniform
Definition: compar_mod.f:157
double precision, dimension(:), allocatable axz_v
Definition: geometry_mod.f:229
integer core_istart
Definition: geometry_mod.f:248
double precision, dimension(:), allocatable x
Definition: geometry_mod.f:129
double precision, dimension(:), allocatable y_u
Definition: cutcell_mod.f:50
subroutine set_index1a(I, J, K, IJK, IMJK, IPJK, IJMK, IJPK, IJKM,
Definition: set_index1a.f:35
integer c1
Definition: compar_mod.f:104
integer, dimension(:), allocatable v_master_of
Definition: cutcell_mod.f:421
subroutine bubble_sort_1d_int_array(ARRAY, I1, I2)
integer jend1
Definition: compar_mod.f:80
subroutine flush_err_msg(DEBUG, HEADER, FOOTER, ABORT, LOG, CALL_TREE)
integer jstart1
Definition: compar_mod.f:80
double precision, dimension(:), allocatable alpha_vn_c
Definition: cutcell_mod.f:263
Definition: bc_mod.f:23
double precision, dimension(:), allocatable c_pg
Definition: physprop_mod.f:80
integer, dimension(:,:), allocatable connectivity
Definition: cutcell_mod.f:111
integer, dimension(:), allocatable flag_t
Definition: geometry_mod.f:107
integer, dimension(:), allocatable ijk_of_background
Definition: indices_mod.f:68
double precision, dimension(:), allocatable delx_ve
Definition: cutcell_mod.f:144
integer kmin2
Definition: geometry_mod.f:89
double precision, dimension(:), allocatable vol_v
Definition: geometry_mod.f:233
integer, dimension(:), allocatable cell_class
Definition: indices_mod.f:42
double precision, dimension(:), allocatable z_u_tc
Definition: cutcell_mod.f:169
double precision, dimension(:), allocatable ro_go
Definition: fldvar_mod.f:35
double precision, dimension(:), allocatable a_upg_e
Definition: cutcell_mod.f:234
logical, dimension(:), allocatable snap
Definition: cutcell_mod.f:413
double precision, dimension(:), allocatable x_u_nc
Definition: cutcell_mod.f:163
double precision, dimension(:), allocatable y_v_tc
Definition: cutcell_mod.f:180