File: RELATIVE:/../../../mfix.git/model/set_increments.f
1
2
3
4
5
6
7
8
9
10
11
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
28
29 use mpi_utility, only: GLOBAL_ALL_SUM
30 use error_manager
31
32 IMPLICIT NONE
33
34
35
36
37 INTEGER :: I, J, K, IJK
38 INTEGER :: IMJK, IPJK, IJKW, IJKE
39 INTEGER :: IJMK, IJPK, IJKS, IJKN
40 INTEGER :: IJKM, IJKP, IJKB, IJKT
41
42 INTEGER :: IC
43
44 INTEGER :: M
45
46 INTEGER :: L
47
48 INTEGER :: ICLASS
49
50 INTEGER :: DENOTE_CLASS(MAX_CLASS)
51
52 LOGICAL :: SHIFT
53
54 LOGICAL, ALLOCATABLE, DIMENSION(:) :: ALREADY_VISITED
55 INTEGER :: interval, j_start(2), j_end(2)
56
57
58
59 CALL INIT_ERR_MSG("SET_INCREMENTS")
60
61
62 CALL ALLOCATE_ARRAYS_INCREMENTS
63
64
65 (:) = 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
115 DO K = KSTART3, KEND3
116 DO J = JSTART3, JEND3
117 DO I = ISTART3, IEND3
118
119 IJK = FUNIJK(I,J,K)
120
121 (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
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
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
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
191 DO IC = 1, ICLASS - 1
192
193 IF(DENOTE_CLASS(ICLASS) == DENOTE_CLASS(IC)) THEN
194
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
208 = ICLASS - 1
209 CYCLE L100
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
228 USE_CORECELL_LOOP = .not.CARTESIAN_GRID
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
250 iclass = cell_class(funijk(core_istart,core_jstart,core_kstart))
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
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
281 (2) = -1
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
296 (2) = -1
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))
332 allocate(BOTTOM_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
343 INCREMENT_ARRAYS_ALLOCATED = .TRUE.
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
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389 SUBROUTINE RE_INDEX_ARRAYS
390
391
392
393
394 USE param
395 USE param1
396 USE indices
397 USE geometry
398 USE compar
399 USE physprop
400 USE fldvar
401 USE funits
402 USE scalars
403 USE run
404 USE visc_g
405 USE energy
406
407 USE pgcor, only : PHASE_4_P_G
408 USE pscor, only : PHASE_4_P_S
409
410
411 USE cutcell
412
413 USE stl
414
415 USE sendrecv
416
417 USE mpi_utility
418 USE parallel
419
420 use bc, only: IJK_P_G
421 use discretelement, only: DISCRETE_ELEMENT
422
423 USE cdist
424 USE functions
425
426 use stiff_chem, only: STIFF_CHEMISTRY,notOwner
427
428 IMPLICIT NONE
429
430
431
432
433
434
435
436
437
438
439
440 INTEGER I, J, K, IJK, NEW_IJK,N
441
442
443 INTEGER M
444
445 LOGICAL,DIMENSION(DIMENSION_3) :: ANY_CUT_TREATMENT, ANY_STANDARD_CELL
446
447 LOGICAL :: ANY_GLOBAL_GHOST_CELL,NEED_TO_SKIP_CELL
448
449 INTEGER,DIMENSION(DIMENSION_3) :: IM_COPY,IP_COPY,JM_COPY,JP_COPY,KM_COPY,KP_COPY
450 INTEGER,DIMENSION(DIMENSION_3) :: WEST_COPY,EAST_COPY,SOUTH_COPY,NORTH_COPY,BOTTOM_COPY,TOP_COPY
451
452 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: TEMP_IJK_ARRAY_OF
453 INTEGER, ALLOCATABLE, DIMENSION(:) :: TEMP_I_OF,TEMP_J_OF,TEMP_K_OF
454
455 INTEGER, ALLOCATABLE, DIMENSION(:) :: BACKGROUND_IJKEND3_ALL,NCPP_UNIFORM_ALL
456
457 INTEGER :: iproc,IERR
458
459 INTEGER :: I1,I2,J1,J2,K1,K2,jj,sendsize,send_pos,recvsize,recv_pos,n_total, IC
460 INTEGER :: placeholder, new_nsend1, new_nsend2,new_nrecv1,new_nrecv2
461 INTEGER :: nj1,nj2
462
463 INTEGER, DIMENSION(26) :: new_send_size, new_recv_size
464
465 integer, pointer, dimension(:) :: new_xsend1, new_sendijk1 , new_sendproc1, new_sendtag1, &
466 new_xsend2, new_sendijk2 , new_sendproc2, new_sendtag2, &
467 new_xrecv1, new_recvijk1 , new_recvproc1, new_recvtag1, &
468 new_xrecv2, new_recvijk2 , new_recvproc2, new_recvtag2
469
470 integer :: comm
471
472 DOUBLE PRECISION, DIMENSION(0:NumPEs-1) :: DIFF_NCPP
473
474 INTEGER :: IJKW,IJKE,IJKS,IJKN,IJKB,IJKT
475 INTEGER :: IMJK,IPJK,IJMK,IJPK,IJKM,IJKP
476
477
478
479 INTEGER ICLASS
480
481
482
483 INTEGER DENOTE_CLASS(MAX_CLASS)
484
485 INTEGER :: I_SIZE,J_SIZE,K_SIZE
486
487
488
489
490
491 allocate(BACKGROUND_IJK_OF(DIMENSION_3))
492 allocate(IJK_OF_BACKGROUND(DIMENSION_3))
493
494 allocate(TEMP_IJK_ARRAY_OF(ISTART3-1:IEND3+1,JSTART3-1:JEND3+1,KSTART3-1:KEND3+1))
495 TEMP_IJK_ARRAY_OF = IJK_ARRAY_OF
496
497 allocate(TEMP_I_OF(DIMENSION_3))
498 allocate(TEMP_J_OF(DIMENSION_3))
499 allocate(TEMP_K_OF(DIMENSION_3))
500
501 allocate(BACKGROUND_IJKEND3_ALL(0:NumPEs-1))
502
503 TEMP_I_OF = I_OF
504 TEMP_J_OF = J_OF
505 TEMP_K_OF = K_OF
506
507 TEMP_IJK_ARRAY_OF = IJK_ARRAY_OF
508
509 DEAD_CELL_AT = .FALSE.
510
511
512 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: INFO: USE_DOLOOP was set to .TRUE.'
513 USE_DOLOOP = .TRUE.
514
515
516
517
518
519
520
521 = IJKSTART3
522
523
524
525 IJK_OF_BACKGROUND = -999
526
527
528
529 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Indentifying dead cells ...'
530
531 ANY_CUT_TREATMENT = .FALSE.
532 ANY_STANDARD_CELL = .FALSE.
533
534 DO IJK = IJKSTART3, IJKEND3
535
536 I = I_OF(IJK)
537 J = J_OF(IJK)
538 K = K_OF(IJK)
539
540
541
542
543
544
545 (IJK) = CUT_TREATMENT_AT(IJK)&
546 .OR.CUT_U_TREATMENT_AT(IJK)&
547 .OR.CUT_V_TREATMENT_AT(IJK)&
548 .OR.CUT_W_TREATMENT_AT(IJK)
549
550
551 ANY_STANDARD_CELL(IJK) = STANDARD_CELL_AT(IJK)&
552 .OR.STANDARD_U_CELL_AT(IJK)&
553 .OR.STANDARD_V_CELL_AT(IJK)&
554 .OR.STANDARD_W_CELL_AT(IJK)
555
556 ANY_GLOBAL_GHOST_CELL = (I < IMIN1).OR.(I > IMAX1)&
557 .OR.(J < JMIN1).OR.(J > JMAX1)&
558 .OR.(K < KMIN1).OR.(K > KMAX1)
559
560
561 IF(.NOT.(ANY_CUT_TREATMENT(IJK)&
562 .OR.ANY_STANDARD_CELL(IJK)&
563 .OR.ANY_GLOBAL_GHOST_CELL)) THEN
564
565 DEAD_CELL_AT(I,J,K) = .TRUE.
566
567 IF(I==IMIN1) DEAD_CELL_AT(IMIN3:IMIN2,J,K) = .TRUE.
568 IF(I==IMAX1) DEAD_CELL_AT(IMAX2:IMAX3,J,K) = .TRUE.
569
570 IF(J==JMIN1) DEAD_CELL_AT(I,JMIN3:JMIN2,K) = .TRUE.
571 IF(J==JMAX1) DEAD_CELL_AT(I,JMAX2:JMAX3,K) = .TRUE.
572
573 IF(K==KMIN1) DEAD_CELL_AT(I,J,KMIN3:KMIN2) = .TRUE.
574 IF(K==KMAX1) DEAD_CELL_AT(I,J,KMAX2:KMAX3) = .TRUE.
575
576 ENDIF
577
578
579
580 ENDDO
581
582
583 IF(.NOT.MINIMIZE_SEND_RECV) THEN
584
585 DEAD_CELL_AT(ISTART3:ISTART1,JSTART3:JEND3,KSTART3:KEND3) = .FALSE.
586 (IEND1:IEND3,JSTART3:JEND3,KSTART3:KEND3) = .FALSE.
587
588 DEAD_CELL_AT(ISTART3:IEND3,JSTART3:JSTART1,KSTART3:KEND3) = .FALSE.
589 DEAD_CELL_AT(ISTART3:IEND3,JEND1:JEND3,KSTART3:KEND3) = .FALSE.
590
591 DEAD_CELL_AT(ISTART3:IEND3,JSTART3:JEND3,KSTART3:KSTART1) = .FALSE.
592 DEAD_CELL_AT(ISTART3:IEND3,JSTART3:JEND3,KEND1:KEND3) = .FALSE.
593
594 ENDIF
595
596
597
598 IF(NO_K) THEN
599 DO K = KMIN3, KMAX3,-1
600 IF(DEAD_CELL_AT(IMAX1 ,JMAX1 ,K)) DEAD_CELL_AT(IMAX2:IMAX3 ,JMAX2:JMAX3 ,K) = .TRUE.
601 IF(DEAD_CELL_AT(IMAX1 ,JMIN1,K)) DEAD_CELL_AT(IMAX2:IMAX3 ,JMIN3:JMIN2,K) = .TRUE.
602 IF(DEAD_CELL_AT(IMIN1,JMAX1 ,K)) DEAD_CELL_AT(IMIN3:IMIN2,JMAX2:JMAX3 ,K) = .TRUE.
603 IF(DEAD_CELL_AT(IMIN1,JMIN1,K)) DEAD_CELL_AT(IMIN3:IMIN2,JMIN3:JMIN2,K) = .TRUE.
604 ENDDO
605 ENDIF
606
607
608
609
610
611
612
613
614
615
616
617
618 IF(NODESI>1.AND.NODESJ==1.AND.NODESK==1) THEN
619 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize I-decomposition ...'
620
621
622 DO I = ISTART3,ISTART2
623 DO J= JSTART3,JEND3
624 DO K = KSTART3, KEND3
625 IJK = FUNIJK(I,J,K)
626 IF(.NOT.DEAD_CELL_AT(I,J,K)) THEN
627 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
628 ELSE
629 IJK_OF_BACKGROUND(IJK) = -999
630 ENDIF
631 ENDDO
632 ENDDO
633 ENDDO
634
635
636 DO I = ISTART1, ISTART1+1
637 DO J= JSTART3,JEND3
638 DO K = KSTART3, KEND3
639
640 IJK = FUNIJK(I,J,K)
641
642 IF( ANY_CUT_TREATMENT(IJK).OR.ANY_STANDARD_CELL(IJK).OR.(.NOT.DEAD_CELL_AT(I,J,K))) THEN
643 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
644 ELSE
645 DEAD_CELL_AT(I,J,K) = .TRUE.
646 IJK_OF_BACKGROUND(IJK) = -999
647 ENDIF
648
649 ENDDO
650 ENDDO
651 ENDDO
652
653
654 DO I = IEND1-1,IEND1
655 DO J= JSTART3,JEND3
656 DO K = KSTART3, KEND3
657
658 IJK = FUNIJK(I,J,K)
659
660 IF( ANY_CUT_TREATMENT(IJK).OR.ANY_STANDARD_CELL(IJK).OR.(.NOT.DEAD_CELL_AT(I,J,K))) THEN
661 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
662 ELSE
663 DEAD_CELL_AT(I,J,K) = .TRUE.
664 IJK_OF_BACKGROUND(IJK) = -999
665 ENDIF
666
667 ENDDO
668 ENDDO
669 ENDDO
670
671
672 DO I = IEND2,IEND3
673 DO J= JSTART3,JEND3
674 DO K = KSTART3, KEND3
675 IJK = FUNIJK(I,J,K)
676 IF(.NOT.DEAD_CELL_AT(I,J,K)) THEN
677 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
678 ELSE
679 IJK_OF_BACKGROUND(IJK) = -999
680 ENDIF
681 ENDDO
682 ENDDO
683 ENDDO
684
685
686 I1 = ISTART1 + 2
687 I2 = IEND1 - 2
688
689 J1 = JSTART3
690 J2 = JEND3
691
692 K1 = KSTART3
693 K2 = KEND3
694
695
696 ELSEIF(NODESJ>1.AND.NODESI==1.AND.NODESK==1) THEN
697 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize J-decomposition ...'
698
699
700 DO J = JSTART3,JSTART2
701 DO I= ISTART3,IEND3
702 DO K = KSTART3, KEND3
703 IJK = FUNIJK(I,J,K)
704 IF(.NOT.DEAD_CELL_AT(I,J,K)) THEN
705 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
706 ELSE
707 IJK_OF_BACKGROUND(IJK) = -999
708 ENDIF
709 ENDDO
710 ENDDO
711 ENDDO
712
713
714 DO J = JSTART1, JSTART1+1
715 DO I= ISTART3,IEND3
716 DO K = KSTART3, KEND3
717
718 IJK = FUNIJK(I,J,K)
719
720 IF( ANY_CUT_TREATMENT(IJK).OR.ANY_STANDARD_CELL(IJK).OR.(.NOT.DEAD_CELL_AT(I,J,K))) THEN
721 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
722 ELSE
723 DEAD_CELL_AT(I,J,K) = .TRUE.
724 IJK_OF_BACKGROUND(IJK) = -999
725 ENDIF
726
727 ENDDO
728 ENDDO
729 ENDDO
730
731
732 DO J = JEND1-1,JEND1
733 DO I= ISTART3,IEND3
734 DO K = KSTART3, KEND3
735
736 IJK = FUNIJK(I,J,K)
737
738 IF( ANY_CUT_TREATMENT(IJK).OR.ANY_STANDARD_CELL(IJK).OR.(.NOT.DEAD_CELL_AT(I,J,K))) THEN
739 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
740 ELSE
741 DEAD_CELL_AT(I,J,K) = .TRUE.
742 IJK_OF_BACKGROUND(IJK) = -999
743 ENDIF
744
745 ENDDO
746 ENDDO
747 ENDDO
748
749
750 DO J = JEND2,JEND3
751 DO I= ISTART3,IEND3
752 DO K = KSTART3, KEND3
753 IJK = FUNIJK(I,J,K)
754 IF(.NOT.DEAD_CELL_AT(I,J,K)) THEN
755 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
756 ELSE
757 IJK_OF_BACKGROUND(IJK) = -999
758 ENDIF
759 ENDDO
760 ENDDO
761 ENDDO
762
763
764 I1 = ISTART3
765 I2 = IEND3
766
767 J1 = JSTART1 + 2
768 J2 = JEND1 - 2
769
770 K1 = KSTART3
771 K2 = KEND3
772
773 ELSEIF(NODESK>1.AND.NODESI==1.AND.NODESJ==1) THEN
774 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize K-decomposition ...'
775
776
777 DO K = KSTART3,KSTART2
778 DO J= JSTART3,JEND3
779 DO I = ISTART3, IEND3
780 IJK = FUNIJK(I,J,K)
781 IF(.NOT.DEAD_CELL_AT(I,J,K)) THEN
782 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
783 ELSE
784 IJK_OF_BACKGROUND(IJK) = -999
785 ENDIF
786 ENDDO
787 ENDDO
788 ENDDO
789
790
791 DO K = KSTART1, KSTART1+1
792 DO J= JSTART3,JEND3
793 DO I = ISTART3, IEND3
794
795 IJK = FUNIJK(I,J,K)
796
797 IF( ANY_CUT_TREATMENT(IJK).OR.ANY_STANDARD_CELL(IJK).OR.(.NOT.DEAD_CELL_AT(I,J,K))) THEN
798 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
799 ELSE
800 DEAD_CELL_AT(I,J,K) = .TRUE.
801 IJK_OF_BACKGROUND(IJK) = -999
802 ENDIF
803
804 ENDDO
805 ENDDO
806 ENDDO
807
808
809 DO K = KEND1-1,KEND1
810 DO J= JSTART3,JEND3
811 DO I = ISTART3, IEND3
812
813 IJK = FUNIJK(I,J,K)
814
815 IF( ANY_CUT_TREATMENT(IJK).OR.ANY_STANDARD_CELL(IJK).OR.(.NOT.DEAD_CELL_AT(I,J,K))) THEN
816 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
817 ELSE
818 DEAD_CELL_AT(I,J,K) = .TRUE.
819 IJK_OF_BACKGROUND(IJK) = -999
820 ENDIF
821
822 ENDDO
823 ENDDO
824 ENDDO
825
826
827 DO K = KEND2,KEND3
828 DO J= JSTART3,JEND3
829 DO I = ISTART3, IEND3
830 IJK = FUNIJK(I,J,K)
831 IF(.NOT.DEAD_CELL_AT(I,J,K)) THEN
832 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
833 ELSE
834 IJK_OF_BACKGROUND(IJK) = -999
835 ENDIF
836 ENDDO
837 ENDDO
838 ENDDO
839
840
841 I1 = ISTART3
842 I2 = IEND3
843
844 J1 = JSTART3
845 J2 = JEND3
846
847 K1 = KSTART1 + 2
848 K2 = KEND1 - 2
849
850
851
852 ELSE
853
854
855
856 = ISTART3
857 I2 = IEND3
858
859 J1 = JSTART3
860 J2 = JEND3
861
862 K1 = KSTART3
863 K2 = KEND3
864
865
866 ENDIF
867
868
869 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all interior cells in next contiguous block...'
870
871
872
873 DO IJK = IJKSTART3, IJKEND3
874
875 I = I_OF(IJK)
876 J = J_OF(IJK)
877 K = K_OF(IJK)
878
879
880 NEED_TO_SKIP_CELL = (I < I1).OR.(I > I2)&
881 .OR.(J < J1).OR.(J > J2)
882
883 IF(DO_K) NEED_TO_SKIP_CELL = (NEED_TO_SKIP_CELL.OR.(K < K1).OR.(K > K2))
884
885
886 IF(NEED_TO_SKIP_CELL) CYCLE
887
888 IF( .NOT.DEAD_CELL_AT(I,J,K)) THEN
889 CALL RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
890 ELSE
891
892 IJK_OF_BACKGROUND(IJK) = -999
893
894 ENDIF
895
896 ENDDO
897
898
899 IJK_ARRAY_OF = TEMP_IJK_ARRAY_OF
900
901
902
903 = TEMP_I_OF
904 J_OF = TEMP_J_OF
905 K_OF = TEMP_K_OF
906
907
908
909 = IJKEND3
910
911 IJKEND3 = NEW_IJK - 1
912
913
914
915 IM_COPY = IM_ARRAY_OF
916 IP_COPY = IP_ARRAY_OF
917 JM_COPY = JM_ARRAY_OF
918 JP_COPY = JP_ARRAY_OF
919 KM_COPY = KM_ARRAY_OF
920 KP_COPY = KP_ARRAY_OF
921
922 WEST_COPY = WEST_ARRAY_OF
923 EAST_COPY = EAST_ARRAY_OF
924 SOUTH_COPY = SOUTH_ARRAY_OF
925 NORTH_COPY = NORTH_ARRAY_OF
926 BOTTOM_COPY = BOTTOM_ARRAY_OF
927 TOP_COPY = TOP_ARRAY_OF
928
929
930 DO IJK = IJKSTART3,IJKEND3
931 IM_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(IM_COPY(BACKGROUND_IJK_OF(IJK)))
932 IP_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(IP_COPY(BACKGROUND_IJK_OF(IJK)))
933 JM_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(JM_COPY(BACKGROUND_IJK_OF(IJK)))
934 JP_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(JP_COPY(BACKGROUND_IJK_OF(IJK)))
935 KM_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(KM_COPY(BACKGROUND_IJK_OF(IJK)))
936 KP_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(KP_COPY(BACKGROUND_IJK_OF(IJK)))
937
938 WEST_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(WEST_COPY(BACKGROUND_IJK_OF(IJK)))
939 EAST_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(EAST_COPY(BACKGROUND_IJK_OF(IJK)))
940 SOUTH_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(SOUTH_COPY(BACKGROUND_IJK_OF(IJK)))
941 NORTH_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(NORTH_COPY(BACKGROUND_IJK_OF(IJK)))
942 BOTTOM_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(BOTTOM_COPY(BACKGROUND_IJK_OF(IJK)))
943 TOP_ARRAY_OF(IJK) = IJK_OF_BACKGROUND(TOP_COPY(BACKGROUND_IJK_OF(IJK)))
944
945 IF(IM_ARRAY_OF(IJK)==-999) IM_ARRAY_OF(IJK)=IJK
946 IF(IP_ARRAY_OF(IJK)==-999) IP_ARRAY_OF(IJK)=IJK
947 IF(JM_ARRAY_OF(IJK)==-999) JM_ARRAY_OF(IJK)=IJK
948 IF(JP_ARRAY_OF(IJK)==-999) JP_ARRAY_OF(IJK)=IJK
949 IF(KM_ARRAY_OF(IJK)==-999) KM_ARRAY_OF(IJK)=IJK
950 IF(KP_ARRAY_OF(IJK)==-999) KP_ARRAY_OF(IJK)=IJK
951
952 IF(WEST_ARRAY_OF(IJK)==-999) WEST_ARRAY_OF(IJK)=IJK
953 IF(EAST_ARRAY_OF(IJK)==-999) EAST_ARRAY_OF(IJK)=IJK
954 IF(SOUTH_ARRAY_OF(IJK)==-999) SOUTH_ARRAY_OF(IJK)=IJK
955 IF(NORTH_ARRAY_OF(IJK)==-999) NORTH_ARRAY_OF(IJK)=IJK
956 IF(BOTTOM_ARRAY_OF(IJK)==-999) BOTTOM_ARRAY_OF(IJK)=IJK
957 IF(TOP_ARRAY_OF(IJK)==-999) TOP_ARRAY_OF(IJK)=IJK
958
959
960
961
962 IF(IM_ARRAY_OF(IJK)<IJKSTART3) IM_ARRAY_OF(IJK)=IJK
963 IF(IP_ARRAY_OF(IJK)<IJKSTART3) IP_ARRAY_OF(IJK)=IJK
964 IF(JM_ARRAY_OF(IJK)<IJKSTART3) JM_ARRAY_OF(IJK)=IJK
965 IF(JP_ARRAY_OF(IJK)<IJKSTART3) JP_ARRAY_OF(IJK)=IJK
966 IF(KM_ARRAY_OF(IJK)<IJKSTART3) KM_ARRAY_OF(IJK)=IJK
967 IF(KP_ARRAY_OF(IJK)<IJKSTART3) KP_ARRAY_OF(IJK)=IJK
968
969 IF(WEST_ARRAY_OF(IJK)<IJKSTART3) WEST_ARRAY_OF(IJK)=IJK
970 IF(EAST_ARRAY_OF(IJK)<IJKSTART3) EAST_ARRAY_OF(IJK)=IJK
971 IF(SOUTH_ARRAY_OF(IJK)<IJKSTART3) SOUTH_ARRAY_OF(IJK)=IJK
972 IF(NORTH_ARRAY_OF(IJK)<IJKSTART3) NORTH_ARRAY_OF(IJK)=IJK
973 IF(BOTTOM_ARRAY_OF(IJK)<IJKSTART3) BOTTOM_ARRAY_OF(IJK)=IJK
974 IF(TOP_ARRAY_OF(IJK)<IJKSTART3) TOP_ARRAY_OF(IJK)=IJK
975
976
977 IF(IM_ARRAY_OF(IJK)>IJKEND3) IM_ARRAY_OF(IJK)=IJK
978 IF(IP_ARRAY_OF(IJK)>IJKEND3) IP_ARRAY_OF(IJK)=IJK
979 IF(JM_ARRAY_OF(IJK)>IJKEND3) JM_ARRAY_OF(IJK)=IJK
980 IF(JP_ARRAY_OF(IJK)>IJKEND3) JP_ARRAY_OF(IJK)=IJK
981 IF(KM_ARRAY_OF(IJK)>IJKEND3) KM_ARRAY_OF(IJK)=IJK
982 IF(KP_ARRAY_OF(IJK)>IJKEND3) KP_ARRAY_OF(IJK)=IJK
983
984 IF(WEST_ARRAY_OF(IJK)>IJKEND3) WEST_ARRAY_OF(IJK)=IJK
985 IF(EAST_ARRAY_OF(IJK)>IJKEND3) EAST_ARRAY_OF(IJK)=IJK
986 IF(SOUTH_ARRAY_OF(IJK)>IJKEND3) SOUTH_ARRAY_OF(IJK)=IJK
987 IF(NORTH_ARRAY_OF(IJK)>IJKEND3) NORTH_ARRAY_OF(IJK)=IJK
988 IF(BOTTOM_ARRAY_OF(IJK)>IJKEND3) BOTTOM_ARRAY_OF(IJK)=IJK
989 IF(TOP_ARRAY_OF(IJK)>IJKEND3) TOP_ARRAY_OF(IJK)=IJK
990
991
992
993 ENDDO
994
995
996
997 IF(.NOT.ADJUST_PROC_DOMAIN_SIZE) THEN
998 if(.not.allocated(NCPP_UNIFORM)) allocate( NCPP_UNIFORM(0:NumPEs-1))
999 if(.not.allocated(NCPP_UNIFORM_ALL)) allocate( NCPP_UNIFORM_ALL(0:NumPEs-1))
1000 NCPP_UNIFORM(MyPE) = BACKGROUND_IJKEND3
1001 ENDIF
1002
1003 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
1004
1005 CALL ALLGATHER_1i (NCPP_UNIFORM(MyPE),NCPP_UNIFORM_ALL,IERR)
1006
1007 CALL ALLGATHER_1i (BACKGROUND_IJKEND3,BACKGROUND_IJKEND3_ALL,IERR)
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Shifting arrays...'
1020
1021 CALL SHIFT_DP_ARRAY(EP_G)
1022 CALL SHIFT_DP_ARRAY(EP_GO)
1023 CALL SHIFT_DP_ARRAY(P_G)
1024 CALL SHIFT_DP_ARRAY(P_GO)
1025 CALL SHIFT_DP_ARRAY(RO_G)
1026 CALL SHIFT_DP_ARRAY(RO_GO)
1027 CALL SHIFT_DP_ARRAY(ROP_G)
1028 CALL SHIFT_DP_ARRAY(ROP_GO)
1029 CALL SHIFT_DP_ARRAY(T_G)
1030 CALL SHIFT_DP_ARRAY(T_GO)
1031 CALL SHIFT_DP_ARRAY(GAMA_RG)
1032 CALL SHIFT_DP_ARRAY(T_RG)
1033 DO N = 1, NMAX(0)
1034 CALL SHIFT_DP_ARRAY(X_G(:,N))
1035 CALL SHIFT_DP_ARRAY(X_GO(:,N))
1036 CALL SHIFT_DP_ARRAY(DIF_G(:,N))
1037 ENDDO
1038 CALL SHIFT_DP_ARRAY(U_G)
1039 CALL SHIFT_DP_ARRAY(U_GO)
1040 CALL SHIFT_DP_ARRAY(V_G)
1041 CALL SHIFT_DP_ARRAY(V_GO)
1042 CALL SHIFT_DP_ARRAY(W_G)
1043 CALL SHIFT_DP_ARRAY(W_GO)
1044 CALL SHIFT_DP_ARRAY(P_s_v)
1045 CALL SHIFT_DP_ARRAY(P_s_f)
1046 CALL SHIFT_DP_ARRAY(P_s_p)
1047 CALL SHIFT_DP_ARRAY(P_star)
1048 CALL SHIFT_DP_ARRAY(P_staro)
1049
1050
1051 CALL SHIFT_DP_ARRAY(MU_G)
1052 CALL SHIFT_DP_ARRAY(MW_MIX_G)
1053
1054 CALL SHIFT_DP_ARRAY(MU_GT)
1055 CALL SHIFT_DP_ARRAY(LAMBDA_GT)
1056
1057 CALL SHIFT_DP_ARRAY(C_pg)
1058 CALL SHIFT_DP_ARRAY(K_g)
1059
1060
1061
1062 DO M = 1, MMAX
1063 CALL SHIFT_DP_ARRAY(RO_S(:,M))
1064 CALL SHIFT_DP_ARRAY(RO_SO(:,M))
1065 CALL SHIFT_DP_ARRAY(ROP_S(:,M))
1066 CALL SHIFT_DP_ARRAY(ROP_SO(:,M))
1067 CALL SHIFT_DP_ARRAY(D_P(:,M))
1068 CALL SHIFT_DP_ARRAY(D_PO(:,M))
1069 CALL SHIFT_DP_ARRAY(T_S(:,M))
1070 CALL SHIFT_DP_ARRAY(T_SO(:,M))
1071 CALL SHIFT_DP_ARRAY(GAMA_RS(:,M))
1072 CALL SHIFT_DP_ARRAY(T_RS(:,M))
1073 DO N = 1, NMAX(M)
1074 CALL SHIFT_DP_ARRAY(X_S(:,M,N))
1075 CALL SHIFT_DP_ARRAY(X_SO(:,M,N))
1076 CALL SHIFT_DP_ARRAY(DIF_S(:,M,N))
1077 ENDDO
1078 CALL SHIFT_DP_ARRAY(U_S(:,M))
1079 CALL SHIFT_DP_ARRAY(U_SO(:,M))
1080 CALL SHIFT_DP_ARRAY(V_S(:,M))
1081 CALL SHIFT_DP_ARRAY(V_SO(:,M))
1082 CALL SHIFT_DP_ARRAY(W_S(:,M))
1083 CALL SHIFT_DP_ARRAY(W_SO(:,M))
1084 CALL SHIFT_DP_ARRAY(P_s(:,M))
1085 CALL SHIFT_DP_ARRAY(P_s_c(:,M))
1086 CALL SHIFT_DP_ARRAY(THETA_M(:,M))
1087 CALL SHIFT_DP_ARRAY(THETA_MO(:,M))
1088 CALL SHIFT_DP_ARRAY(C_ps(:,M))
1089 CALL SHIFT_DP_ARRAY(K_s(:,M))
1090 ENDDO
1091
1092
1093
1094 DO N=1,Nscalar
1095 CALL SHIFT_DP_ARRAY(SCALAR(:,N))
1096 CALL SHIFT_DP_ARRAY(SCALARO(:,N))
1097 ENDDO
1098
1099 IF(K_Epsilon) THEN
1100 CALL SHIFT_DP_ARRAY(K_TURB_G)
1101 CALL SHIFT_DP_ARRAY(E_TURB_G)
1102 CALL SHIFT_DP_ARRAY(K_TURB_GO)
1103 CALL SHIFT_DP_ARRAY(E_TURB_GO)
1104 ENDIF
1105
1106
1107 CALL SHIFT_DP_ARRAY(VOL)
1108 CALL SHIFT_DP_ARRAY(VOL_U)
1109 CALL SHIFT_DP_ARRAY(VOL_V)
1110 CALL SHIFT_DP_ARRAY(VOL_W)
1111
1112 CALL SHIFT_DP_ARRAY(AXY)
1113 CALL SHIFT_DP_ARRAY(AXY_U)
1114 CALL SHIFT_DP_ARRAY(AXY_V)
1115 CALL SHIFT_DP_ARRAY(AXY_W)
1116
1117 CALL SHIFT_DP_ARRAY(AYZ)
1118 CALL SHIFT_DP_ARRAY(AYZ_U)
1119 CALL SHIFT_DP_ARRAY(AYZ_V)
1120 CALL SHIFT_DP_ARRAY(AYZ_W)
1121
1122 CALL SHIFT_DP_ARRAY(AXZ)
1123 CALL SHIFT_DP_ARRAY(AXZ_U)
1124 CALL SHIFT_DP_ARRAY(AXZ_V)
1125 CALL SHIFT_DP_ARRAY(AXZ_W)
1126
1127 CALL SHIFT_DP_ARRAY(X_U)
1128 CALL SHIFT_DP_ARRAY(Y_U)
1129 CALL SHIFT_DP_ARRAY(Z_U)
1130
1131 CALL SHIFT_DP_ARRAY(X_V)
1132 CALL SHIFT_DP_ARRAY(Y_V)
1133 CALL SHIFT_DP_ARRAY(Z_V)
1134
1135 CALL SHIFT_DP_ARRAY(X_W)
1136 CALL SHIFT_DP_ARRAY(Y_W)
1137 CALL SHIFT_DP_ARRAY(Z_W)
1138
1139 CALL SHIFT_DP_ARRAY(NORMAL_S(:,1))
1140 CALL SHIFT_DP_ARRAY(NORMAL_S(:,2))
1141 CALL SHIFT_DP_ARRAY(NORMAL_S(:,3))
1142
1143 CALL SHIFT_DP_ARRAY(REFP_S(:,1))
1144 CALL SHIFT_DP_ARRAY(REFP_S(:,2))
1145 CALL SHIFT_DP_ARRAY(REFP_S(:,3))
1146
1147
1148 CALL SHIFT_DP_ARRAY(AREA_CUT)
1149 CALL SHIFT_DP_ARRAY(AREA_U_CUT)
1150 CALL SHIFT_DP_ARRAY(AREA_V_CUT)
1151 CALL SHIFT_DP_ARRAY(AREA_W_CUT)
1152
1153 CALL SHIFT_DP_ARRAY(DELX_Ue)
1154 CALL SHIFT_DP_ARRAY(DELX_Uw)
1155 CALL SHIFT_DP_ARRAY(DELY_Un)
1156 CALL SHIFT_DP_ARRAY(DELY_Us)
1157 CALL SHIFT_DP_ARRAY(DELZ_Ut)
1158 CALL SHIFT_DP_ARRAY(DELZ_Ub)
1159
1160 CALL SHIFT_DP_ARRAY(DELX_Ve)
1161 CALL SHIFT_DP_ARRAY(DELX_Vw)
1162 CALL SHIFT_DP_ARRAY(DELY_Vn)
1163 CALL SHIFT_DP_ARRAY(DELY_Vs)
1164 CALL SHIFT_DP_ARRAY(DELZ_Vt)
1165 CALL SHIFT_DP_ARRAY(DELZ_Vb)
1166
1167 CALL SHIFT_DP_ARRAY(DELX_We)
1168 CALL SHIFT_DP_ARRAY(DELX_Ww)
1169 CALL SHIFT_DP_ARRAY(DELY_Wn)
1170 CALL SHIFT_DP_ARRAY(DELY_Ws)
1171 CALL SHIFT_DP_ARRAY(DELZ_Wt)
1172 CALL SHIFT_DP_ARRAY(DELZ_Wb)
1173
1174 CALL SHIFT_DP_ARRAY(X_U_ec)
1175 CALL SHIFT_DP_ARRAY(Y_U_ec)
1176 CALL SHIFT_DP_ARRAY(Z_U_ec)
1177
1178 CALL SHIFT_DP_ARRAY(X_U_nc)
1179 CALL SHIFT_DP_ARRAY(Y_U_nc)
1180 CALL SHIFT_DP_ARRAY(Z_U_nc)
1181
1182 CALL SHIFT_DP_ARRAY(X_U_tc)
1183 CALL SHIFT_DP_ARRAY(Y_U_tc)
1184 CALL SHIFT_DP_ARRAY(Z_U_tc)
1185
1186 CALL SHIFT_DP_ARRAY(X_V_ec)
1187 CALL SHIFT_DP_ARRAY(Y_V_ec)
1188 CALL SHIFT_DP_ARRAY(Z_V_ec)
1189
1190 CALL SHIFT_DP_ARRAY(X_V_nc)
1191 CALL SHIFT_DP_ARRAY(Y_V_nc)
1192 CALL SHIFT_DP_ARRAY(Z_V_nc)
1193
1194 CALL SHIFT_DP_ARRAY(X_V_tc)
1195 CALL SHIFT_DP_ARRAY(Y_V_tc)
1196 CALL SHIFT_DP_ARRAY(Z_V_tc)
1197
1198 CALL SHIFT_DP_ARRAY(X_W_ec)
1199 CALL SHIFT_DP_ARRAY(Y_W_ec)
1200 CALL SHIFT_DP_ARRAY(Z_W_ec)
1201
1202 CALL SHIFT_DP_ARRAY(X_W_nc)
1203 CALL SHIFT_DP_ARRAY(Y_W_nc)
1204 CALL SHIFT_DP_ARRAY(Z_W_nc)
1205
1206 CALL SHIFT_DP_ARRAY(X_W_tc)
1207 CALL SHIFT_DP_ARRAY(Y_W_tc)
1208 CALL SHIFT_DP_ARRAY(Z_W_tc)
1209
1210
1211 CALL SHIFT_DP_ARRAY(DELH_Scalar)
1212 CALL SHIFT_DP_ARRAY(DWALL)
1213
1214
1215 CALL SHIFT_DP_ARRAY(DELH_U)
1216 CALL SHIFT_DP_ARRAY(NORMAL_U(:,1))
1217 CALL SHIFT_DP_ARRAY(NORMAL_U(:,2))
1218 CALL SHIFT_DP_ARRAY(NORMAL_U(:,3))
1219 CALL SHIFT_DP_ARRAY(REFP_U(:,1))
1220 CALL SHIFT_DP_ARRAY(REFP_U(:,2))
1221 CALL SHIFT_DP_ARRAY(REFP_U(:,3))
1222
1223 CALL SHIFT_DP_ARRAY(Theta_Ue)
1224 CALL SHIFT_DP_ARRAY(Theta_Ue_bar)
1225 CALL SHIFT_DP_ARRAY(Theta_U_ne)
1226 CALL SHIFT_DP_ARRAY(Theta_U_nw)
1227 CALL SHIFT_DP_ARRAY(Theta_U_te)
1228 CALL SHIFT_DP_ARRAY(Theta_U_tw)
1229 CALL SHIFT_DP_ARRAY(Alpha_Ue_c)
1230 CALL SHIFT_DP_ARRAY(NOC_U_E)
1231 CALL SHIFT_DP_ARRAY(Theta_Un)
1232 CALL SHIFT_DP_ARRAY(Theta_Un_bar)
1233 CALL SHIFT_DP_ARRAY(Alpha_Un_c)
1234 CALL SHIFT_DP_ARRAY(NOC_U_N)
1235 CALL SHIFT_DP_ARRAY(Theta_Ut)
1236 CALL SHIFT_DP_ARRAY(Theta_Ut_bar)
1237 CALL SHIFT_DP_ARRAY(Alpha_Ut_c)
1238 CALL SHIFT_DP_ARRAY(NOC_U_T)
1239 CALL SHIFT_DP_ARRAY(A_UPG_E)
1240 CALL SHIFT_DP_ARRAY(A_UPG_W)
1241
1242
1243 CALL SHIFT_DP_ARRAY(DELH_V)
1244 CALL SHIFT_DP_ARRAY(NORMAL_V(:,1))
1245 CALL SHIFT_DP_ARRAY(NORMAL_V(:,2))
1246 CALL SHIFT_DP_ARRAY(NORMAL_V(:,3))
1247 CALL SHIFT_DP_ARRAY(REFP_V(:,1))
1248 CALL SHIFT_DP_ARRAY(REFP_V(:,2))
1249 CALL SHIFT_DP_ARRAY(REFP_V(:,3))
1250
1251 CALL SHIFT_DP_ARRAY(Theta_V_ne)
1252 CALL SHIFT_DP_ARRAY(Theta_V_se)
1253 CALL SHIFT_DP_ARRAY(Theta_Vn)
1254 CALL SHIFT_DP_ARRAY(Theta_Vn_bar)
1255 CALL SHIFT_DP_ARRAY(Theta_V_nt)
1256 CALL SHIFT_DP_ARRAY(Theta_V_st)
1257 CALL SHIFT_DP_ARRAY(Theta_Ve)
1258 CALL SHIFT_DP_ARRAY(Theta_Ve_bar)
1259 CALL SHIFT_DP_ARRAY(Alpha_Ve_c)
1260 CALL SHIFT_DP_ARRAY(NOC_V_E)
1261 CALL SHIFT_DP_ARRAY(Alpha_Vn_c)
1262 CALL SHIFT_DP_ARRAY(NOC_V_N)
1263 CALL SHIFT_DP_ARRAY(Theta_Vt)
1264 CALL SHIFT_DP_ARRAY(Theta_Vt_bar)
1265 CALL SHIFT_DP_ARRAY(Alpha_Vt_c)
1266 CALL SHIFT_DP_ARRAY(NOC_V_T)
1267 CALL SHIFT_DP_ARRAY(A_VPG_N)
1268 CALL SHIFT_DP_ARRAY(A_VPG_S)
1269
1270
1271 CALL SHIFT_DP_ARRAY(DELH_W)
1272 CALL SHIFT_DP_ARRAY(NORMAL_W(:,1))
1273 CALL SHIFT_DP_ARRAY(NORMAL_W(:,2))
1274 CALL SHIFT_DP_ARRAY(NORMAL_W(:,3))
1275 CALL SHIFT_DP_ARRAY(REFP_W(:,1))
1276 CALL SHIFT_DP_ARRAY(REFP_W(:,2))
1277 CALL SHIFT_DP_ARRAY(REFP_W(:,3))
1278
1279 CALL SHIFT_DP_ARRAY(Theta_W_te)
1280 CALL SHIFT_DP_ARRAY(Theta_W_be)
1281 CALL SHIFT_DP_ARRAY(Theta_W_tn)
1282 CALL SHIFT_DP_ARRAY(Theta_W_bn)
1283 CALL SHIFT_DP_ARRAY(Theta_Wt)
1284 CALL SHIFT_DP_ARRAY(Theta_Wt_bar)
1285 CALL SHIFT_DP_ARRAY(Theta_We)
1286 CALL SHIFT_DP_ARRAY(Theta_We_bar)
1287 CALL SHIFT_DP_ARRAY(Alpha_We_c)
1288 CALL SHIFT_DP_ARRAY(NOC_W_E)
1289 CALL SHIFT_DP_ARRAY(Theta_Wn)
1290 CALL SHIFT_DP_ARRAY(Theta_Wn_bar)
1291 CALL SHIFT_DP_ARRAY(Alpha_Wn_c)
1292 CALL SHIFT_DP_ARRAY(NOC_W_N)
1293 CALL SHIFT_DP_ARRAY(Alpha_Wt_c)
1294 CALL SHIFT_DP_ARRAY(NOC_W_T)
1295 CALL SHIFT_DP_ARRAY(A_WPG_T)
1296 CALL SHIFT_DP_ARRAY(A_WPG_B)
1297
1298
1299 CALL SHIFT_DP_ARRAY(ONEoDX_E_U)
1300 CALL SHIFT_DP_ARRAY(ONEoDY_N_U)
1301 CALL SHIFT_DP_ARRAY(ONEoDZ_T_U)
1302
1303 CALL SHIFT_DP_ARRAY(ONEoDX_E_V)
1304 CALL SHIFT_DP_ARRAY(ONEoDY_N_V)
1305 CALL SHIFT_DP_ARRAY(ONEoDZ_T_V)
1306
1307 CALL SHIFT_DP_ARRAY(ONEoDX_E_W)
1308 CALL SHIFT_DP_ARRAY(ONEoDY_N_W)
1309 CALL SHIFT_DP_ARRAY(ONEoDZ_T_W)
1310
1311
1312
1313 CALL SHIFT_INT_ARRAY(FLAG,UNDEFINED_I)
1314 CALL SHIFT_INT_ARRAY(FLAG_E,UNDEFINED_I)
1315 CALL SHIFT_INT_ARRAY(FLAG_N,UNDEFINED_I)
1316 CALL SHIFT_INT_ARRAY(FLAG_T,UNDEFINED_I)
1317
1318
1319
1320 CALL SHIFT_LOG_ARRAY(INTERIOR_CELL_AT,.FALSE.)
1321 CALL SHIFT_LOG_ARRAY(SMALL_CELL_AT,.FALSE.)
1322 CALL SHIFT_LOG_ARRAY(BLOCKED_CELL_AT,.TRUE.)
1323 CALL SHIFT_LOG_ARRAY(BLOCKED_U_CELL_AT,.TRUE.)
1324 CALL SHIFT_LOG_ARRAY(BLOCKED_V_CELL_AT,.TRUE.)
1325 CALL SHIFT_LOG_ARRAY(BLOCKED_W_CELL_AT,.TRUE.)
1326 CALL SHIFT_LOG_ARRAY(STANDARD_CELL_AT,.FALSE.)
1327 CALL SHIFT_LOG_ARRAY(STANDARD_U_CELL_AT,.FALSE.)
1328 CALL SHIFT_LOG_ARRAY(STANDARD_V_CELL_AT,.FALSE.)
1329 CALL SHIFT_LOG_ARRAY(STANDARD_W_CELL_AT,.FALSE.)
1330 CALL SHIFT_LOG_ARRAY(CUT_CELL_AT,.FALSE.)
1331 CALL SHIFT_LOG_ARRAY(CUT_U_CELL_AT,.FALSE.)
1332 CALL SHIFT_LOG_ARRAY(CUT_V_CELL_AT,.FALSE.)
1333 CALL SHIFT_LOG_ARRAY(CUT_W_CELL_AT,.FALSE.)
1334 CALL SHIFT_LOG_ARRAY(CUT_TREATMENT_AT,.FALSE.)
1335 CALL SHIFT_LOG_ARRAY(CUT_U_TREATMENT_AT,.FALSE.)
1336 CALL SHIFT_LOG_ARRAY(CUT_V_TREATMENT_AT,.FALSE.)
1337 CALL SHIFT_LOG_ARRAY(CUT_W_TREATMENT_AT,.FALSE.)
1338 CALL SHIFT_LOG_ARRAY(WALL_U_AT,.FALSE.)
1339 CALL SHIFT_LOG_ARRAY(WALL_V_AT,.FALSE.)
1340 CALL SHIFT_LOG_ARRAY(WALL_W_AT,.FALSE.)
1341 CALL SHIFT_LOG_ARRAY(SNAP,.FALSE.)
1342
1343
1344 CALL SHIFT_INT_ARRAY(U_MASTER_OF,0)
1345 CALL SHIFT_INT_ARRAY(V_MASTER_OF,0)
1346 CALL SHIFT_INT_ARRAY(W_MASTER_OF,0)
1347
1348 CALL SHIFT_INT_ARRAY(BC_ID,0)
1349 CALL SHIFT_INT_ARRAY(BC_U_ID,0)
1350 CALL SHIFT_INT_ARRAY(BC_V_ID,0)
1351 CALL SHIFT_INT_ARRAY(BC_W_ID,0)
1352
1353 CALL SHIFT_INT_ARRAY(CELL_CLASS,0)
1354
1355 CALL SHIFT_INT_ARRAY(PHASE_4_P_G,UNDEFINED_I)
1356 CALL SHIFT_INT_ARRAY(PHASE_4_P_S,UNDEFINED_I)
1357
1358
1359 CALL SHIFT_LOG_ARRAY(SCALAR_NODE_ATWALL,.FALSE.)
1360
1361 CALL SHIFT_DP_ARRAY(SCALAR_NODE_XYZ)
1362 CALL SHIFT_DP_ARRAY(SCALAR_NODE_XYZ)
1363 CALL SHIFT_DP_ARRAY(SCALAR_NODE_XYZ)
1364 CALL SHIFT_DP_ARRAY(Ovol_around_node)
1365
1366
1367 IF(DISCRETE_ELEMENT) THEN
1368 CALL SHIFT_LOG_ARRAY(NO_NEIGHBORING_FACET_DES,.FALSE.)
1369 CALL SHIFT_LIST_OF_FACETS_DES
1370 ENDIF
1371
1372 IF (IJK_P_G /= UNDEFINED_I) IJK_P_G = IJK_OF_BACKGROUND(IJK_P_G)
1373
1374 IF(STIFF_CHEMISTRY) CALL SHIFT_LOG_ARRAY(notOwner,.FALSE.)
1375
1376 IF(BDIST_IO) CALL SHIFT_CONNECTIVITY_FOR_BDIST_IO
1377
1378
1379
1380
1381
1382
1383 = numPEs==1
1384
1385 IF(.NOT.IS_SERIAL) THEN
1386
1387 IF(MINIMIZE_SEND_RECV) THEN
1388
1389
1390 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Minimizing send and receive arrays for Send layer 1...'
1391
1392
1393
1394
1395
1396 nullify(new_xsend1, new_sendtag1, new_sendproc1, new_sendijk1)
1397
1398
1399
1400 = 0
1401 DO send_pos = lbound(sendijk1,1),ubound(sendijk1,1)
1402 IJK = sendijk1( send_pos )
1403 IF(IJK_OF_BACKGROUND(IJK)/=-999) n_total = n_total + 1
1404 ENDDO
1405
1406
1407 allocate( new_sendijk1( max(1,n_total) ) )
1408 allocate( new_xsend1(nsend1+1) )
1409 allocate( new_sendtag1(nsend1+1) )
1410 allocate( new_sendproc1(nsend1+1) )
1411
1412
1413
1414 = 0
1415 send_pos = 0
1416 placeholder = 1
1417 new_nsend1 = 0
1418
1419 DO n = 1,nsend1
1420 j1 = xsend1(n)
1421 j2 = xsend1(n+1)-1
1422 sendsize = j2-j1+1
1423
1424 new_send_size(n) = 0
1425
1426 DO jj=j1,j2
1427 ijk = sendijk1( jj )
1428
1429 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1430 (n) = new_send_size(n) + 1
1431 send_pos = send_pos + 1
1432 new_sendijk1(send_pos) = IJK_OF_BACKGROUND(IJK)
1433 ENDIF
1434 ENDDO
1435
1436 IF(new_send_size(n)>0) THEN
1437 new_nsend1 = new_nsend1 + 1
1438 new_xsend1(new_nsend1) = placeholder
1439 placeholder = placeholder + new_send_size(n)
1440
1441 new_sendtag1(new_nsend1) = sendtag1(n)
1442 new_sendproc1(new_nsend1) = sendproc1(n)
1443
1444 nj1 = new_xsend1(new_nsend1)
1445 nj2 = nj1 + new_send_size(n) - 1
1446
1447 CALL BUBBLE_SORT_1D_INT_ARRAY(new_sendijk1(nj1:nj2),nj1,nj2)
1448 ENDIF
1449
1450 ENDDO
1451
1452 new_xsend1(new_nsend1+1)= nj2 + 1
1453
1454
1455 nsend1 = new_nsend1
1456 sendtag1 => new_sendtag1
1457 sendproc1 => new_sendproc1
1458 xsend1 => new_xsend1
1459 sendijk1 => new_sendijk1
1460
1461 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 2...'
1462
1463
1464
1465 nullify(new_xsend2, new_sendtag2, new_sendproc2, new_sendijk2)
1466
1467
1468
1469 = 0
1470 DO send_pos = lbound(sendijk2,1),ubound(sendijk2,1)
1471 IJK = sendijk2( send_pos )
1472 IF(IJK_OF_BACKGROUND(IJK)/=-999) n_total = n_total + 1
1473 ENDDO
1474
1475 allocate( new_sendijk2( max(1,n_total) ) )
1476 allocate( new_xsend2(nsend2+1) )
1477 allocate( new_sendtag2(nsend2+1) )
1478 allocate( new_sendproc2(nsend2+1) )
1479
1480
1481
1482 = 0
1483 send_pos = 0
1484 placeholder = 1
1485 new_nsend2 = 0
1486
1487
1488
1489 DO n = 1,nsend2
1490 j1 = xsend2(n)
1491 j2 = xsend2(n+1)-1
1492 sendsize = j2-j1+1
1493
1494 new_send_size(n) = 0
1495
1496 DO jj=j1,j2
1497 ijk = sendijk2( jj )
1498
1499 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1500 (n) = new_send_size(n) + 1
1501 send_pos = send_pos + 1
1502 new_sendijk2(send_pos) = IJK_OF_BACKGROUND(IJK)
1503 ENDIF
1504 ENDDO
1505
1506 IF(new_send_size(n)>0) THEN
1507 new_nsend2 = new_nsend2 + 1
1508 new_xsend2(new_nsend2) = placeholder
1509 placeholder = placeholder + new_send_size(n)
1510
1511 new_sendtag2(new_nsend2) = sendtag2(n)
1512 new_sendproc2(new_nsend2) = sendproc2(n)
1513
1514 nj1 = new_xsend2(new_nsend2)
1515 nj2 = nj1 + new_send_size(n) - 1
1516
1517
1518
1519 CALL BUBBLE_SORT_1D_INT_ARRAY(new_sendijk2(nj1:nj2),nj1,nj2)
1520 ENDIF
1521
1522 ENDDO
1523
1524 new_xsend2(new_nsend2+1)= nj2 + 1
1525
1526
1527
1528 = new_nsend2
1529 sendtag2 => new_sendtag2
1530 sendproc2 => new_sendproc2
1531 xsend2 => new_xsend2
1532 sendijk2 => new_sendijk2
1533
1534 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 1...'
1535
1536
1537
1538
1539
1540 nullify(new_xrecv1, new_recvtag1, new_recvproc1, new_recvijk1)
1541
1542
1543
1544 = 0
1545 DO recv_pos = lbound(recvijk1,1),ubound(recvijk1,1)
1546 IJK = recvijk1( recv_pos )
1547 IF(IJK_OF_BACKGROUND(IJK)/=-999) n_total = n_total + 1
1548 ENDDO
1549
1550 allocate( new_recvijk1( max(1,n_total) ) )
1551 allocate( new_xrecv1(nrecv1+1) )
1552 allocate( new_recvtag1(nrecv1+1) )
1553 allocate( new_recvproc1(nrecv1+1) )
1554
1555
1556
1557 = 0
1558 recv_pos = 0
1559
1560
1561
1562
1563 new_xrecv1 = 0
1564 recv_pos = 0
1565 placeholder = 1
1566 new_nrecv1 = 0
1567
1568 DO n = 1,nrecv1
1569 j1 = xrecv1(n)
1570 j2 = xrecv1(n+1)-1
1571 recvsize = j2-j1+1
1572
1573 new_recv_size(n) = 0
1574
1575 DO jj=j1,j2
1576 ijk = recvijk1( jj )
1577
1578 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1579 (n) = new_recv_size(n) + 1
1580 recv_pos = recv_pos + 1
1581 new_recvijk1(recv_pos) = IJK_OF_BACKGROUND(IJK)
1582 ENDIF
1583 ENDDO
1584
1585 IF(new_recv_size(n)>0) THEN
1586 new_nrecv1 = new_nrecv1 + 1
1587 new_xrecv1(new_nrecv1) = placeholder
1588 placeholder = placeholder + new_recv_size(n)
1589
1590 new_recvtag1(new_nrecv1) = recvtag1(n)
1591 new_recvproc1(new_nrecv1) = recvproc1(n)
1592
1593 nj1 = new_xrecv1(new_nrecv1)
1594 nj2 = nj1 + new_recv_size(n) - 1
1595
1596 CALL BUBBLE_SORT_1D_INT_ARRAY(new_recvijk1(nj1:nj2),nj1,nj2)
1597 ENDIF
1598
1599 ENDDO
1600
1601 new_xrecv1(new_nrecv1+1)=nj2 + 1
1602
1603 nrecv1 = new_nrecv1
1604 recvtag1 => new_recvtag1
1605 recvproc1 => new_recvproc1
1606 xrecv1 => new_xrecv1
1607 recvijk1 => new_recvijk1
1608
1609
1610 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 2...'
1611
1612
1613 nullify(new_xrecv2, new_recvtag2, new_recvproc2, new_recvijk2)
1614
1615
1616
1617 = 0
1618 DO recv_pos = lbound(recvijk2,1),ubound(recvijk2,1)
1619 IJK = recvijk2( recv_pos )
1620 IF(IJK_OF_BACKGROUND(IJK)/=-999) n_total = n_total + 1
1621 ENDDO
1622
1623 allocate( new_recvijk2( max(1,n_total) ) )
1624 allocate( new_xrecv2(nrecv2+1) )
1625 allocate( new_recvtag2(nrecv2+1) )
1626 allocate( new_recvproc2(nrecv2+1) )
1627
1628
1629
1630 = 0
1631 recv_pos = 0
1632 placeholder = 1
1633 new_nrecv2 = 0
1634
1635 DO n = 1,nrecv2
1636 j1 = xrecv2(n)
1637 j2 = xrecv2(n+1)-1
1638 recvsize = j2-j1+1
1639
1640 new_recv_size(n) = 0
1641
1642 DO jj=j1,j2
1643 ijk = recvijk2( jj )
1644
1645 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1646 (n) = new_recv_size(n) + 1
1647 recv_pos = recv_pos + 1
1648 new_recvijk2(recv_pos) = IJK_OF_BACKGROUND(IJK)
1649 ENDIF
1650 ENDDO
1651
1652 IF(new_recv_size(n)>0) THEN
1653 new_nrecv2 = new_nrecv2 + 1
1654 new_xrecv2(new_nrecv2) = placeholder
1655 placeholder = placeholder + new_recv_size(n)
1656
1657 new_recvtag2(new_nrecv2) = recvtag2(n)
1658 new_recvproc2(new_nrecv2) = recvproc2(n)
1659
1660 nj1 = new_xrecv2(new_nrecv2)
1661 nj2 = nj1 + new_recv_size(n) - 1
1662
1663 CALL BUBBLE_SORT_1D_INT_ARRAY(new_recvijk2(nj1:nj2),nj1,nj2)
1664 ENDIF
1665
1666 ENDDO
1667
1668
1669 new_xrecv2(new_nrecv2+1)=nj2 + 1
1670
1671 nrecv2 = new_nrecv2
1672 recvtag2 => new_recvtag2
1673 recvproc2 => new_recvproc2
1674 xrecv2 => new_xrecv2
1675 recvijk2 => new_recvijk2
1676
1677
1678
1679 ELSE
1680
1681 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 1...'
1682
1683
1684
1685
1686
1687
1688
1689 nullify(new_sendijk1)
1690
1691 print *, 'sendijk1=',size(sendijk1)
1692 allocate( new_sendijk1( size(sendijk1) ) )
1693
1694
1695
1696
1697 DO n = 1,nsend1
1698 j1 = xsend1(n)
1699 j2 = xsend1(n+1)-1
1700 sendsize = j2-j1+1
1701
1702
1703 DO jj=j1,j2
1704 ijk = sendijk1( jj )
1705
1706 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1707 new_sendijk1(jj) = IJK_OF_BACKGROUND(IJK)
1708 ELSE
1709 new_sendijk1(jj) = sendijk1( j1 )
1710 ENDIF
1711 ENDDO
1712
1713
1714 ENDDO
1715
1716 sendijk1 => new_sendijk1
1717
1718 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 2...'
1719
1720
1721
1722
1723 print *, 'sendijk2=',size(sendijk2)
1724 nullify(new_sendijk2)
1725
1726
1727 allocate( new_sendijk2( size(sendijk2) ) )
1728
1729
1730
1731
1732 DO n = 1,nsend2
1733 j1 = xsend2(n)
1734 j2 = xsend2(n+1)-1
1735 sendsize = j2-j1+1
1736
1737 new_send_size(n) = 0
1738
1739 DO jj=j1,j2
1740 ijk = sendijk2( jj )
1741
1742 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1743 (jj) = IJK_OF_BACKGROUND(IJK)
1744 ELSE
1745 new_sendijk2(jj) = sendijk2( j1 )
1746 ENDIF
1747 ENDDO
1748
1749
1750 ENDDO
1751
1752 sendijk2 => new_sendijk2
1753
1754 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 1...'
1755
1756
1757
1758
1759
1760 print *, 'recvijk1=',size(recvijk1)
1761 nullify(new_recvijk1)
1762
1763
1764 allocate( new_recvijk1( size(recvijk1) ) )
1765
1766
1767
1768
1769 DO n = 1,nrecv1
1770 j1 = xrecv1(n)
1771 j2 = xrecv1(n+1)-1
1772 recvsize = j2-j1+1
1773
1774 new_recv_size(n) = 0
1775
1776 DO jj=j1,j2
1777 ijk = recvijk1( jj )
1778
1779 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1780 (jj) = IJK_OF_BACKGROUND(IJK)
1781 ELSE
1782 new_recvijk1(jj) = recvijk1( j1 )
1783 ENDIF
1784 ENDDO
1785
1786
1787 ENDDO
1788
1789 recvijk1 => new_recvijk1
1790
1791
1792 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Receive layer 2...'
1793
1794
1795 print *, 'secvijk2=',size(recvijk2)
1796 nullify(new_recvijk2)
1797
1798
1799 allocate( new_recvijk2( size(recvijk2) ) )
1800
1801
1802 DO n = 1,nrecv2
1803 j1 = xrecv2(n)
1804 j2 = xrecv2(n+1)-1
1805 recvsize = j2-j1+1
1806
1807 new_recv_size(n) = 0
1808
1809 DO jj=j1,j2
1810 ijk = recvijk2( jj )
1811
1812 IF(IJK_OF_BACKGROUND(IJK)/=-999) THEN
1813 (jj) = IJK_OF_BACKGROUND(IJK)
1814 ELSE
1815 new_recvijk2(jj) = recvijk2( j1 )
1816 ENDIF
1817 ENDDO
1818
1819
1820 ENDDO
1821
1822
1823 recvijk2 => new_recvijk2
1824
1825
1826
1827 ENDIF
1828
1829 comm = MPI_COMM_WORLD
1830
1831
1832
1833
1834 call sendrecv_re_init_after_re_indexing(comm, 0 )
1835
1836
1837 ENDIF
1838
1839
1840 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning cell classes...'
1851
1852
1853
1854
1855 = 0
1856
1857
1858 DO K = KSTART3, KEND3
1859 DO J = JSTART3, JEND3
1860 L100: DO I = ISTART3, IEND3
1861 IJK = FUNIJK(I,J,K)
1862
1863 IF(DEAD_CELL_AT(I,J,K)) CYCLE
1864
1865
1866
1867
1868
1869 = NORTH_ARRAY_OF(IJK)
1870 IJKS = SOUTH_ARRAY_OF(IJK)
1871 IJKE = EAST_ARRAY_OF(IJK)
1872 IJKW = WEST_ARRAY_OF(IJK)
1873 IJKT = TOP_ARRAY_OF(IJK)
1874 IJKB = BOTTOM_ARRAY_OF(IJK)
1875
1876 IMJK = IM_ARRAY_OF(IJK)
1877 IPJK = IP_ARRAY_OF(IJK)
1878 IJMK = JM_ARRAY_OF(IJK)
1879 IJPK = JP_ARRAY_OF(IJK)
1880 IJKM = KM_ARRAY_OF(IJK)
1881 IJKP = KP_ARRAY_OF(IJK)
1882
1883
1884 = ICLASS + 1
1885 IF (ICLASS > MAX_CLASS) THEN
1886 IF(DMP_LOG)WRITE (UNIT_LOG, 2000) MAX_CLASS
1887 CALL MFIX_EXIT(myPE)
1888 ENDIF
1889 INCREMENT_FOR_N(ICLASS) = IJKN - IJK
1890 INCREMENT_FOR_S(ICLASS) = IJKS - IJK
1891 INCREMENT_FOR_E(ICLASS) = IJKE - IJK
1892 INCREMENT_FOR_W(ICLASS) = IJKW - IJK
1893 INCREMENT_FOR_T(ICLASS) = IJKT - IJK
1894 INCREMENT_FOR_B(ICLASS) = IJKB - IJK
1895 INCREMENT_FOR_IM(ICLASS) = IMJK - IJK
1896 INCREMENT_FOR_IP(ICLASS) = IPJK - IJK
1897 INCREMENT_FOR_JM(ICLASS) = IJMK - IJK
1898 INCREMENT_FOR_JP(ICLASS) = IJPK - IJK
1899 INCREMENT_FOR_KM(ICLASS) = IJKM - IJK
1900 INCREMENT_FOR_KP(ICLASS) = IJKP - IJK
1901
1902
1903 INCREMENT_FOR_NB(1,ICLASS) = INCREMENT_FOR_E(ICLASS)
1904 INCREMENT_FOR_NB(2,ICLASS) = INCREMENT_FOR_W(ICLASS)
1905 INCREMENT_FOR_NB(3,ICLASS) = INCREMENT_FOR_S(ICLASS)
1906 INCREMENT_FOR_NB(4,ICLASS) = INCREMENT_FOR_N(ICLASS)
1907 INCREMENT_FOR_NB(5,ICLASS) = INCREMENT_FOR_B(ICLASS)
1908 INCREMENT_FOR_NB(6,ICLASS) = INCREMENT_FOR_T(ICLASS)
1909
1910
1911 INCREMENT_FOR_MP(1,ICLASS) = INCREMENT_FOR_IM(ICLASS)
1912 INCREMENT_FOR_MP(2,ICLASS) = INCREMENT_FOR_IP(ICLASS)
1913 INCREMENT_FOR_MP(3,ICLASS) = INCREMENT_FOR_JM(ICLASS)
1914 INCREMENT_FOR_MP(4,ICLASS) = INCREMENT_FOR_JP(ICLASS)
1915 INCREMENT_FOR_MP(5,ICLASS) = INCREMENT_FOR_KM(ICLASS)
1916 INCREMENT_FOR_MP(6,ICLASS) = INCREMENT_FOR_KP(ICLASS)
1917
1918
1919 (ICLASS) = INCREMENT_FOR_N(ICLASS) + INCREMENT_FOR_S&
1920 (ICLASS) + INCREMENT_FOR_E(ICLASS) + INCREMENT_FOR_W(ICLASS)&
1921 + INCREMENT_FOR_T(ICLASS) + INCREMENT_FOR_B(ICLASS) + &
1922 INCREMENT_FOR_IM(ICLASS) + INCREMENT_FOR_IP(ICLASS) + &
1923 INCREMENT_FOR_JM(ICLASS) + INCREMENT_FOR_JP(ICLASS) + &
1924 INCREMENT_FOR_KM(ICLASS) + INCREMENT_FOR_KP(ICLASS)
1925
1926 (IJK) = ICLASS
1927
1928
1929
1930 DO IC = 1, ICLASS - 1
1931
1932 IF (DENOTE_CLASS(ICLASS) == DENOTE_CLASS(IC)) THEN
1933
1934 IF (INCREMENT_FOR_N(ICLASS) /= INCREMENT_FOR_N(IC)) CYCLE
1935 IF (INCREMENT_FOR_S(ICLASS) /= INCREMENT_FOR_S(IC)) CYCLE
1936 IF (INCREMENT_FOR_E(ICLASS) /= INCREMENT_FOR_E(IC)) CYCLE
1937 IF (INCREMENT_FOR_W(ICLASS) /= INCREMENT_FOR_W(IC)) CYCLE
1938 IF (INCREMENT_FOR_T(ICLASS) /= INCREMENT_FOR_T(IC)) CYCLE
1939 IF (INCREMENT_FOR_B(ICLASS) /= INCREMENT_FOR_B(IC)) CYCLE
1940 IF (INCREMENT_FOR_IM(ICLASS) /= INCREMENT_FOR_IM(IC)) &
1941 CYCLE
1942 IF (INCREMENT_FOR_IP(ICLASS) /= INCREMENT_FOR_IP(IC)) &
1943 CYCLE
1944 IF (INCREMENT_FOR_JM(ICLASS) /= INCREMENT_FOR_JM(IC)) &
1945 CYCLE
1946 IF (INCREMENT_FOR_JP(ICLASS) /= INCREMENT_FOR_JP(IC)) &
1947 CYCLE
1948 IF (INCREMENT_FOR_KM(ICLASS) /= INCREMENT_FOR_KM(IC)) &
1949 CYCLE
1950 IF (INCREMENT_FOR_KP(ICLASS) /= INCREMENT_FOR_KP(IC)) &
1951 CYCLE
1952 CELL_CLASS(IJK) = IC
1953 = ICLASS - 1
1954 CYCLE L100
1955 ENDIF
1956 END DO
1957 END DO L100
1958 END DO
1959 END DO
1960
1961
1962 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: New number of classes = ', ICLASS
1963
1964 CALL WRITE_IJK_VALUES
1965
1966
1967
1968
1969
1970
1971
1972
1973 ALLOCATE( NEW_IJKSIZE3_ALL(0:NUMPES-1) )
1974
1975
1976 CALL ALLGATHER_1I (IJKEND3,NEW_IJKSIZE3_ALL,IERR)
1977
1978
1979
1980
1981
1982
1983
1984 IF(NUMPES.GT.1) THEN
1985
1986 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
1987
1988 IF(MyPE.EQ.0) THEN
1989 WRITE(*,1000)"============================================================================="
1990 WRITE(*,1000)" PROCESSOR I-SIZE J-SIZE K-SIZE # CELLS # CELLS DIFF."
1991 WRITE(*,1000)" (BCKGRD) (RE-INDEXED) (%)"
1992 WRITE(*,1000)"============================================================================="
1993 ENDIF
1994
1995 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
1996
1997 DO IPROC = 0,NumPes-1
1998 IF(MyPE==IPROC) THEN
1999 I_SIZE = IEND1 - ISTART1 + 1
2000 J_SIZE = JEND1 - JSTART1 + 1
2001 K_SIZE = KEND1 - KSTART1 + 1
2002 DIFF_NCPP(IPROC) = DBLE(NEW_IJKSIZE3_ALL(IPROC)-NCPP_UNIFORM_ALL(IPROC))/DBLE(NCPP_UNIFORM_ALL(IPROC))*100.0D0
2003 WRITE(*,1060) IPROC,I_SIZE,J_SIZE,K_SIZE,BACKGROUND_IJKEND3_ALL(IPROC),NEW_IJKSIZE3_ALL(IPROC),DIFF_NCPP(IPROC)
2004 ENDIF
2005 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
2006 ENDDO
2007
2008 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
2009 IF(MyPE.EQ.0) THEN
2010 WRITE(*,1000)"============================================================================="
2011 WRITE(*,1070)'MAX # OF CELLS (BACKGRD) = ',MAXVAL(NCPP_UNIFORM_ALL),' AT PROCESSOR: ',MAXLOC(NCPP_UNIFORM_ALL)-1
2012 WRITE(*,1070)'MAX # OF CELLS (RE-INDEXED) = ',MAXVAL(NEW_IJKSIZE3_ALL),' AT PROCESSOR: ',MAXLOC(NEW_IJKSIZE3_ALL)-1
2013 WRITE(*,1080)'DIFFERENCE (%) = ', &
2014 DBLE(MAXVAL(NEW_IJKSIZE3_ALL)-MAXVAL(NCPP_UNIFORM_ALL))/DBLE(MAXVAL(NCPP_UNIFORM_ALL))*100.0
2015 WRITE(*,1000)"============================================================================="
2016 ENDIF
2017 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
2018 ENDIF
2019
2020 1000 FORMAT(1x,A)
2021 1060 FORMAT(1X,6(I10,1X),F8.1)
2022 1070 FORMAT(1X,A,I8,A,I8)
2023 1080 FORMAT(1X,A,F8.1)
2024
2025
2026 FORMAT(/70('*')//'From: SET_INCREMENTS'/'Message: The number of',&
2027 'classes has exceeded the maximum allowed (',I8,'). Increase',&
2028 'MAX_CLASS in PARAM1.INC')
2029
2030
2031 END SUBROUTINE RE_INDEX_ARRAYS
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052 SUBROUTINE RECORD_NEW_IJK_CELL(I,J,K,IJK,NEW_IJK,TEMP_IJK_ARRAY_OF,TEMP_I_OF,TEMP_J_OF,TEMP_K_OF)
2053
2054
2055
2056
2057 USE param
2058 USE param1
2059 USE indices
2060 USE geometry
2061 USE compar
2062 USE physprop
2063 USE fldvar
2064 USE funits
2065 USE scalars
2066 USE run
2067
2068 USE cutcell
2069
2070 USE sendrecv
2071
2072 IMPLICIT NONE
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084 INTEGER :: I, J, K, IJK, NEW_IJK
2085 INTEGER, DIMENSION(ISTART3-1:IEND3+1,JSTART3-1:JEND3+1,KSTART3-1:KEND3+1) :: TEMP_IJK_ARRAY_OF
2086 INTEGER, DIMENSION(DIMENSION_3) :: TEMP_I_OF,TEMP_J_OF,TEMP_K_OF
2087
2088
2089
2090 BACKGROUND_IJK_OF(NEW_IJK) = IJK
2091
2092 IJK_OF_BACKGROUND(IJK) = NEW_IJK
2093
2094 TEMP_IJK_ARRAY_OF(I,J,K)=NEW_IJK
2095
2096 TEMP_I_OF(NEW_IJK) = I
2097 TEMP_J_OF(NEW_IJK) = J
2098 TEMP_K_OF(NEW_IJK) = K
2099
2100 NEW_IJK = NEW_IJK + 1
2101
2102
2103 RETURN
2104
2105 END SUBROUTINE RECORD_NEW_IJK_CELL
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127 SUBROUTINE BUBBLE_SORT_1D_INT_ARRAY(ARRAY,I1,I2)
2128
2129
2130
2131
2132 USE indices
2133 USE geometry
2134 USE compar
2135 USE cutcell
2136
2137 IMPLICIT NONE
2138
2139
2140
2141
2142
2143
2144 INTEGER ::I1,I2,BUFFER,I,J
2145
2146 INTEGER, DIMENSION(I1:I2) :: ARRAY
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158 DO I = I1,I2-1
2159 DO J = I2-1,I,-1
2160 IF(ARRAY(J)>ARRAY(J+1)) THEN
2161 BUFFER = ARRAY(J)
2162 ARRAY(J) = ARRAY(J+1)
2163 ARRAY(J+1) = BUFFER
2164 ENDIF
2165 ENDDO
2166 ENDDO
2167
2168
2169
2170
2171
2172 END SUBROUTINE BUBBLE_SORT_1D_INT_ARRAY
2173
2174
2175
2176 SUBROUTINE SHIFT_DP_ARRAY(ARRAY)
2177
2178
2179
2180
2181 USE indices
2182 USE geometry
2183 USE compar
2184 USE cutcell
2185 USE functions
2186
2187 IMPLICIT NONE
2188
2189
2190
2191
2192
2193
2194 INTEGER ::IJK
2195
2196 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206 = ARRAY
2207 ARRAY = UNDEFINED
2208
2209 DO IJK = IJKSTART3, IJKEND3
2210
2211 ARRAY(IJK) = BUFFER(BACKGROUND_IJK_OF(IJK))
2212
2213 ENDDO
2214
2215
2216 END SUBROUTINE SHIFT_DP_ARRAY
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235 SUBROUTINE SHIFT_INT_ARRAY(ARRAY,DEFAULT_VALUE)
2236
2237
2238
2239
2240 USE indices
2241 USE geometry
2242 USE compar
2243 USE cutcell
2244 USE functions
2245
2246 IMPLICIT NONE
2247
2248
2249
2250
2251
2252
2253 INTEGER ::IJK
2254
2255 INTEGER, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2256 INTEGER :: DEFAULT_VALUE
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266 = ARRAY
2267 ARRAY = DEFAULT_VALUE
2268
2269 DO IJK = IJKSTART3, IJKEND3
2270
2271 ARRAY(IJK) = BUFFER(BACKGROUND_IJK_OF(IJK))
2272
2273 ENDDO
2274
2275
2276 END SUBROUTINE SHIFT_INT_ARRAY
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296 SUBROUTINE SHIFT_LOG_ARRAY(ARRAY,DEFAULT_VALUE)
2297
2298
2299
2300
2301 USE indices
2302 USE geometry
2303 USE compar
2304 USE cutcell
2305 USE functions
2306
2307 IMPLICIT NONE
2308
2309
2310
2311
2312
2313
2314 INTEGER ::IJK
2315
2316 LOGICAL, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2317 LOGICAL :: DEFAULT_VALUE
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327 = ARRAY
2328 ARRAY = DEFAULT_VALUE
2329
2330 DO IJK = IJKSTART3, IJKEND3
2331
2332 ARRAY(IJK) = BUFFER(BACKGROUND_IJK_OF(IJK))
2333
2334 ENDDO
2335
2336
2337 END SUBROUTINE SHIFT_LOG_ARRAY
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358 SUBROUTINE UNSHIFT_DP_ARRAY(ARRAY_1,ARRAY_2)
2359
2360
2361
2362
2363 USE indices
2364 USE geometry
2365 USE compar
2366 USE cutcell
2367 USE functions
2368
2369 IMPLICIT NONE
2370
2371
2372
2373
2374
2375
2376 INTEGER ::IJK
2377
2378 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: ARRAY_1, ARRAY_2
2379
2380
2381
2382 = UNDEFINED
2383
2384 DO IJK = IJKSTART3,IJKEND3
2385
2386 ARRAY_2(BACKGROUND_IJK_OF(IJK)) = ARRAY_1(IJK)
2387
2388 ENDDO
2389
2390
2391 END SUBROUTINE UNSHIFT_DP_ARRAY
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411 SUBROUTINE SHIFT_CONNECTIVITY_FOR_BDIST_IO
2412
2413
2414
2415
2416 USE indices
2417 USE geometry
2418 USE compar
2419 USE cutcell
2420 USE functions
2421
2422 IMPLICIT NONE
2423
2424
2425
2426
2427
2428
2429 INTEGER ::IJK, L, BCK_IJK, NN , CONN
2430
2431
2432 INTEGER, DIMENSION(DIMENSION_3,15) ::TEMP_CONNECTIVITY
2433
2434
2435
2436
2437
2438
2439 CALL SHIFT_INT_ARRAY(NUMBER_OF_NODES,0)
2440
2441 TEMP_CONNECTIVITY = CONNECTIVITY
2442
2443 DO IJK = 1,IJKEND3
2444 IF (INTERIOR_CELL_AT(IJK)) THEN
2445 IF (.NOT.BLOCKED_CELL_AT(IJK)) THEN
2446
2447 BCK_IJK = BACKGROUND_IJK_OF(IJK)
2448
2449 = NUMBER_OF_NODES(IJK)
2450
2451 DO L = 1, NN
2452
2453
2454 = TEMP_CONNECTIVITY(BCK_IJK,L)
2455
2456 IF(CONN>BACKGROUND_IJKEND3) THEN
2457 CONNECTIVITY(IJK,L) = CONN - BACKGROUND_IJKEND3 + IJKEND3
2458 ELSE
2459 CONNECTIVITY(IJK,L) = IJK_OF_BACKGROUND(CONN)
2460 ENDIF
2461
2462 ENDDO
2463
2464 ENDIF
2465 ENDIF
2466 END DO
2467
2468
2469
2470 END SUBROUTINE SHIFT_CONNECTIVITY_FOR_BDIST_IO
2471
2472
2473 SUBROUTINE SHIFT_LIST_OF_FACETS_DES
2474
2475
2476
2477
2478 USE indices
2479 USE geometry
2480 USE compar
2481 USE cutcell
2482 USE stl
2483 USE functions
2484
2485 IMPLICIT NONE
2486
2487
2488
2489
2490
2491
2492 INTEGER ::IJK, BCK_IJK,NF
2493
2494 TYPE (FACETS_TO_CELL), DIMENSION (:), ALLOCATABLE :: COPY_OF_LIST_FACET_AT_DES
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505 ALLOCATE(COPY_OF_LIST_FACET_AT_DES(DIMENSION_3))
2506
2507 DO IJK = 1,DIMENSION_3
2508
2509 IF(ALLOCATED(LIST_FACET_AT_DES(IJK)%FACET_LIST)) THEN
2510 NF = LIST_FACET_AT_DES(IJK)%COUNT_FACETS
2511
2512 COPY_OF_LIST_FACET_AT_DES(IJK)%COUNT_FACETS = NF
2513 ALLOCATE(COPY_OF_LIST_FACET_AT_DES(IJK)%FACET_LIST(NF))
2514 COPY_OF_LIST_FACET_AT_DES(IJK)%FACET_LIST(1:NF) = LIST_FACET_AT_DES(IJK)%FACET_LIST(1:NF)
2515
2516 ELSE
2517
2518 COPY_OF_LIST_FACET_AT_DES(IJK)%COUNT_FACETS = 0
2519
2520 ENDIF
2521
2522
2523 ENDDO
2524
2525
2526 DO IJK = IJKSTART3, IJKEND3
2527
2528 BCK_IJK = BACKGROUND_IJK_OF(IJK)
2529
2530
2531 = COPY_OF_LIST_FACET_AT_DES(BCK_IJK)%COUNT_FACETS
2532
2533
2534 IF(ALLOCATED(LIST_FACET_AT_DES(IJK)%FACET_LIST)) DEALLOCATE(LIST_FACET_AT_DES(IJK)%FACET_LIST)
2535
2536 LIST_FACET_AT_DES(IJK)%COUNT_FACETS = NF
2537
2538 IF(NF>0) THEN
2539
2540 ALLOCATE(LIST_FACET_AT_DES(IJK)%FACET_LIST(NF))
2541 LIST_FACET_AT_DES(IJK)%FACET_LIST(1:NF) = COPY_OF_LIST_FACET_AT_DES(BCK_IJK)%FACET_LIST(1:NF)
2542
2543 ENDIF
2544
2545
2546 ENDDO
2547
2548 DEALLOCATE(COPY_OF_LIST_FACET_AT_DES)
2549
2550
2551 END SUBROUTINE SHIFT_LIST_OF_FACETS_DES
2552
2553
2554 SUBROUTINE WRITE_INT_TABLE(FILE_UNIT,ARRAY, ARRAY_SIZE, LSTART, LEND, NCOL)
2555
2556
2557
2558
2559
2560
2561 USE param
2562 USE param1
2563 USE funits
2564 IMPLICIT NONE
2565
2566
2567
2568
2569
2570
2571 INTEGER :: FILE_UNIT
2572
2573
2574
2575
2576 INTEGER :: ARRAY_SIZE
2577
2578
2579
2580 INTEGER :: LSTART
2581
2582
2583 INTEGER :: LEND
2584
2585
2586 INTEGER :: ARRAY(ARRAY_SIZE)
2587
2588
2589
2590
2591
2592
2593
2594
2595
2596
2597 INTEGER :: NCOL
2598
2599
2600
2601
2602
2603
2604
2605
2606 INTEGER NROW
2607
2608
2609
2610 INTEGER L, L1, L2, L3
2611
2612
2613 = (LEND - LSTART + 1)/NCOL
2614
2615 = LSTART - 1
2616 DO L = 1, NROW
2617 L1 = L2 + 1
2618 L2 = L1 + NCOL - 1
2619 WRITE (FILE_UNIT, 1020) (ARRAY(L3),L3=L1,L2)
2620 END DO
2621 IF (NROW*NCOL < LEND - LSTART + 1) THEN
2622 L1 = L2 + 1
2623 L2 = LEND
2624 WRITE (FILE_UNIT, 1020) (ARRAY(L3),L3=L1,L2)
2625 ENDIF
2626 RETURN
2627
2628 FORMAT(14X,50(I12,1X))
2629 END SUBROUTINE WRITE_INT_TABLE
2630
2631
2632
2633
2634
2635
2636
2637 SUBROUTINE WRITE_IJK_VALUES
2638
2639
2640
2641
2642 USE param
2643 USE param1
2644 USE indices
2645 USE geometry
2646 USE compar
2647 USE physprop
2648 USE fldvar
2649 USE funits
2650 USE scalars
2651 USE run
2652 USE visc_g
2653
2654 USE cutcell
2655
2656 USE sendrecv
2657
2658 USE mpi_utility
2659 USE parallel
2660
2661 USE cdist
2662 USE functions
2663 IMPLICIT NONE
2664
2665
2666
2667
2668
2669
2670
2671
2672
2673
2674
2675 INTEGER I, J, K, IJK
2676
2677 INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: TEMP_IJK_ARRAY_OF
2678 INTEGER :: IJK_FILE_UNIT
2679 CHARACTER(LEN=255) :: IJK_FILE_NAME
2680 CHARACTER(LEN=6) :: CHAR_MyPE
2681
2682 allocate(TEMP_IJK_ARRAY_OF(ISTART3-1:IEND3+1,JSTART3-1:JEND3+1,KSTART3-1:KEND3+1))
2683 TEMP_IJK_ARRAY_OF = IJK_ARRAY_OF
2684
2685
2686
2687
2688
2689
2690
2691 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Writing IJK value in files...'
2692
2693 IJK_FILE_UNIT = 1000 + MyPE
2694 WRITE(CHAR_MyPE,'(I6)')MyPE
2695
2696 IJK_FILE_NAME = 'IJK_INFO_'//CHAR_MyPE//'.txt'
2697
2698 DO I=1,LEN(TRIM(IJK_FILE_NAME))
2699 IF(IJK_FILE_NAME(I:I)==' ') IJK_FILE_NAME(I:I)='0'
2700 ENDDO
2701
2702 OPEN(CONVERT='BIG_ENDIAN',UNIT=IJK_FILE_UNIT,FILE=IJK_FILE_NAME)
2703
2704
2705 WRITE(IJK_FILE_UNIT,200)' MyPE = ',MyPE
2706 WRITE(IJK_FILE_UNIT,200)' ISTART1,IEND1 = ',ISTART1,IEND1
2707 WRITE(IJK_FILE_UNIT,200)' JSTART1,JEND1 = ',JSTART1,JEND1
2708 WRITE(IJK_FILE_UNIT,200)' KSTART1,KEND1 = ',KSTART1,KEND1
2709 WRITE(IJK_FILE_UNIT,200)' I-SIZE = ',IEND1-ISTART1+1
2710 WRITE(IJK_FILE_UNIT,200)' J-SIZE = ',JEND1-JSTART1+1
2711 WRITE(IJK_FILE_UNIT,200)' K-SIZE = ',KEND1-KSTART1+1
2712 WRITE(IJK_FILE_UNIT,200)' IJKSTART3 = ',IJKSTART3
2713 WRITE(IJK_FILE_UNIT,200)' IJKEND3 = ',IJKEND3
2714 WRITE(IJK_FILE_UNIT,*)''
2715
2716 IF(RE_INDEXING) WRITE(IJK_FILE_UNIT,100) 'INFO: AFTER RE-INDEXING CELLS ON MyPE = ', MyPE, ' , &
2717 &THE NUMBER OF ACTIVE CELLS WENT FROM ',BACKGROUND_IJKEND3, ' TO ', IJKEND3 , &
2718 ' (', DBLE(IJKEND3-BACKGROUND_IJKEND3)/DBLE(BACKGROUND_IJKEND3)*100.0D0, ' % DIFFERENCE)'
2719
2720 WRITE(IJK_FILE_UNIT,*)''
2721
2722 IF(NO_K) THEN
2723 WRITE(IJK_FILE_UNIT,210) ('======',I=ISTART3,IEND3)
2724 K=1
2725 DO J=JEND3,JSTART3,-1
2726 DO I=ISTART3,IEND3
2727 IJK = funijk(I,J,K)
2728
2729 IF(DEAD_CELL_AT(I,J,K)) TEMP_IJK_ARRAY_OF(I,J,K) = 0
2730 ENDDO
2731 IF(RE_INDEXING) THEN
2732 WRITE(IJK_FILE_UNIT,230) J,(TEMP_IJK_ARRAY_OF(I,J,K),I=ISTART3,IEND3)
2733 ELSE
2734 WRITE(IJK_FILE_UNIT,230) J,(FUNIJK(I,J,K),I=ISTART3,IEND3)
2735 ENDIF
2736
2737 ENDDO
2738
2739 WRITE(IJK_FILE_UNIT,210) ('======',I=ISTART3,IEND3)
2740 WRITE(IJK_FILE_UNIT,220) (I,I=ISTART3,IEND3)
2741
2742 ELSE
2743 DO IJK=IJKSTART3,IJKEND3
2744 WRITE(IJK_FILE_UNIT,*) IJK,I_OF(IJK),J_OF(IJK),K_OF(IJK)
2745 ENDDO
2746
2747 ENDIF
2748
2749
2750 100 FORMAT(1X,A,I6,A,I8,A,I8,A,F6.1,A)
2751 200 FORMAT(1x,A30,2(I8))
2752
2753 210 FORMAT(8x,50(A))
2754 220 FORMAT(1x,' J/I | ',50(I6))
2755 230 FORMAT(1x,I4,' | ',50(I6))
2756
2757 IF(.NOT.IS_SERIAL) THEN
2758
2759 WRITE(IJK_FILE_UNIT,*)''
2760
2761 WRITE(IJK_FILE_UNIT,*)' Layer = ',1
2762 WRITE(IJK_FILE_UNIT,*)' nsend1 = ', nsend1
2763 WRITE(IJK_FILE_UNIT,*)' sendproc1 = ', sendproc1(1:nsend1)
2764 WRITE(IJK_FILE_UNIT,*)' sendtag1 = ', sendtag1(1:nsend1)
2765 WRITE(IJK_FILE_UNIT,*)' xsend1 = ', xsend1(1:nsend1)
2766 WRITE(IJK_FILE_UNIT,*)' size = ', size(sendijk1)
2767 WRITE(IJK_FILE_UNIT,*)' sendijk1 = '
2768 CALL WRITE_INT_TABLE(IJK_FILE_UNIT,sendijk1, size(sendijk1), 1, size(sendijk1),5)
2769 WRITE(IJK_FILE_UNIT,*)''
2770
2771 WRITE(IJK_FILE_UNIT,*)' nrecv1 = ', nrecv1
2772 WRITE(IJK_FILE_UNIT,*)' recvproc1 = ', recvproc1(1:nrecv1)
2773 WRITE(IJK_FILE_UNIT,*)' recvtag1 = ', recvtag1(1:nrecv1)
2774 WRITE(IJK_FILE_UNIT,*)' xrecv1 = ', xrecv1(1:nrecv1)
2775 WRITE(IJK_FILE_UNIT,*)' size = ', size(recvijk1)
2776 WRITE(IJK_FILE_UNIT,*)' recvijk1 = '
2777 CALL WRITE_INT_TABLE(IJK_FILE_UNIT,recvijk1, size(recvijk1), 1, size(recvijk1), 5)
2778 WRITE(IJK_FILE_UNIT,*)''
2779 WRITE(IJK_FILE_UNIT,*)''
2780
2781 WRITE(IJK_FILE_UNIT,*)' Layer = ',2
2782 WRITE(IJK_FILE_UNIT,*)' nsend2 = ', nsend2
2783 WRITE(IJK_FILE_UNIT,*)' sendproc2 = ', sendproc2(1:nsend2)
2784 WRITE(IJK_FILE_UNIT,*)' sendtag2 = ', sendtag2(1:nsend2)
2785 WRITE(IJK_FILE_UNIT,*)' xsend2 = ', xsend2(1:nsend2)
2786 WRITE(IJK_FILE_UNIT,*)' size = ', size(sendijk2)
2787 WRITE(IJK_FILE_UNIT,*)' sendijk2 = '
2788 CALL WRITE_INT_TABLE(IJK_FILE_UNIT,sendijk2, size(sendijk2), 1, size(sendijk2),5)
2789 WRITE(IJK_FILE_UNIT,*)''
2790
2791 WRITE(IJK_FILE_UNIT,*)' nrecv2 = ', nrecv2
2792 WRITE(IJK_FILE_UNIT,*)' recvproc2 = ', recvproc2(1:nrecv2)
2793 WRITE(IJK_FILE_UNIT,*)' recvtag2 = ', recvtag2(1:nrecv2)
2794 WRITE(IJK_FILE_UNIT,*)' xrecv2 = ', xrecv2(1:nrecv2)
2795 WRITE(IJK_FILE_UNIT,*)' size = ', size(recvijk2)
2796 WRITE(IJK_FILE_UNIT,*)' recvijk2 = '
2797 CALL WRITE_INT_TABLE(IJK_FILE_UNIT,recvijk2, size(recvijk2), 1, size(recvijk2), 5)
2798 WRITE(IJK_FILE_UNIT,*)''
2799
2800 ENDIF
2801
2802 CLOSE(IJK_FILE_UNIT)
2803
2804
2805
2806 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
2807
2808
2809
2810
2811
2812
2813 END SUBROUTINE WRITE_IJK_VALUES
2814