File: N:\mfix\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 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
416 USE stiff_chem, only: STIFF_CHEMISTRY,notOwner
417 USE stl
418 USE visc_g
419
420 IMPLICIT NONE
421
422
423
424
425
426
427
428
429
430
431
432 INTEGER I, J, K, IJK, NEW_IJK,NN
433
434
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
470
471 INTEGER ICLASS
472
473
474
475 INTEGER DENOTE_CLASS(MAX_CLASS)
476
477 INTEGER :: I_SIZE,J_SIZE,K_SIZE
478
479
480
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
509
510
511
512
513 = IJKSTART3
514
515 IJK_OF_BACKGROUND = -999
516
517
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
531
532 (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)&
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.
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.
573 (IEND1:IEND3,JSTART3:JEND3,KSTART3:KEND3) = .FALSE.
574
575 DEAD_CELL_AT(ISTART3:IEND3,JSTART3:JSTART1,KSTART3:KEND3) = .FALSE.
576 DEAD_CELL_AT(ISTART3:IEND3,JEND1:JEND3,KSTART3:KEND3) = .FALSE.
577
578 DEAD_CELL_AT(ISTART3:IEND3,JSTART3:JEND3,KSTART3:KSTART1) = .FALSE.
579 DEAD_CELL_AT(ISTART3:IEND3,JSTART3:JEND3,KEND1:KEND3) = .FALSE.
580
581 ENDIF
582
583
584
585 IF(NO_K) THEN
586 DO K = KMIN3, KMAX3,-1
587 IF(DEAD_CELL_AT(IMAX1 ,JMAX1 ,K)) DEAD_CELL_AT(IMAX2:IMAX3 ,JMAX2:JMAX3 ,K) = .TRUE.
588 IF(DEAD_CELL_AT(IMAX1 ,JMIN1,K)) DEAD_CELL_AT(IMAX2:IMAX3 ,JMIN3:JMIN2,K) = .TRUE.
589 IF(DEAD_CELL_AT(IMIN1,JMAX1 ,K)) DEAD_CELL_AT(IMIN3:IMIN2,JMAX2:JMAX3 ,K) = .TRUE.
590 IF(DEAD_CELL_AT(IMIN1,JMIN1,K)) DEAD_CELL_AT(IMIN3:IMIN2,JMIN3:JMIN2,K) = .TRUE.
591 ENDDO
592 ENDIF
593
594
595
596
597
598
599
600
601
602
603
604
605 IF(NODESI>1.AND.NODESJ==1.AND.NODESK==1) THEN
606 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize I-decomposition ...'
607
608
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
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
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
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
684 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize J-decomposition ...'
685
686
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
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
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
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
761 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Arranging all send and receive layer cells to optimize K-decomposition ...'
762
763
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
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
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
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
840
841
842
843 = 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
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
889
890 = TEMP_I_OF
891 J_OF = TEMP_J_OF
892 K_OF = TEMP_K_OF
893
894
895
896 = 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
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))
987 NCPP_UNIFORM(MyPE) = BACKGROUND_IJKEND3
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
999
1000
1001
1002
1003
1004
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)
1041 CALL SHIFT_DP_ARRAY(LAMBDA_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)
1086 CALL SHIFT_DP_ARRAY(K_TURB_GO)
1087 CALL SHIFT_DP_ARRAY(E_TURB_GO)
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)
1133 CALL SHIFT_DP_ARRAY(AREA_U_CUT)
1134 CALL SHIFT_DP_ARRAY(AREA_V_CUT)
1135 CALL SHIFT_DP_ARRAY(AREA_W_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
1195 CALL SHIFT_DP_ARRAY(DELH_Scalar)
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)
1208 CALL SHIFT_DP_ARRAY(Theta_Ue_bar)
1209 CALL SHIFT_DP_ARRAY(Theta_U_ne)
1210 CALL SHIFT_DP_ARRAY(Theta_U_nw)
1211 CALL SHIFT_DP_ARRAY(Theta_U_te)
1212 CALL SHIFT_DP_ARRAY(Theta_U_tw)
1213 CALL SHIFT_DP_ARRAY(Alpha_Ue_c)
1214 CALL SHIFT_DP_ARRAY(NOC_U_E)
1215 CALL SHIFT_DP_ARRAY(Theta_Un)
1216 CALL SHIFT_DP_ARRAY(Theta_Un_bar)
1217 CALL SHIFT_DP_ARRAY(Alpha_Un_c)
1218 CALL SHIFT_DP_ARRAY(NOC_U_N)
1219 CALL SHIFT_DP_ARRAY(Theta_Ut)
1220 CALL SHIFT_DP_ARRAY(Theta_Ut_bar)
1221 CALL SHIFT_DP_ARRAY(Alpha_Ut_c)
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
1235 CALL SHIFT_DP_ARRAY(Theta_V_ne)
1236 CALL SHIFT_DP_ARRAY(Theta_V_se)
1237 CALL SHIFT_DP_ARRAY(Theta_Vn)
1238 CALL SHIFT_DP_ARRAY(Theta_Vn_bar)
1239 CALL SHIFT_DP_ARRAY(Theta_V_nt)
1240 CALL SHIFT_DP_ARRAY(Theta_V_st)
1241 CALL SHIFT_DP_ARRAY(Theta_Ve)
1242 CALL SHIFT_DP_ARRAY(Theta_Ve_bar)
1243 CALL SHIFT_DP_ARRAY(Alpha_Ve_c)
1244 CALL SHIFT_DP_ARRAY(NOC_V_E)
1245 CALL SHIFT_DP_ARRAY(Alpha_Vn_c)
1246 CALL SHIFT_DP_ARRAY(NOC_V_N)
1247 CALL SHIFT_DP_ARRAY(Theta_Vt)
1248 CALL SHIFT_DP_ARRAY(Theta_Vt_bar)
1249 CALL SHIFT_DP_ARRAY(Alpha_Vt_c)
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
1263 CALL SHIFT_DP_ARRAY(Theta_W_te)
1264 CALL SHIFT_DP_ARRAY(Theta_W_be)
1265 CALL SHIFT_DP_ARRAY(Theta_W_tn)
1266 CALL SHIFT_DP_ARRAY(Theta_W_bn)
1267 CALL SHIFT_DP_ARRAY(Theta_Wt)
1268 CALL SHIFT_DP_ARRAY(Theta_Wt_bar)
1269 CALL SHIFT_DP_ARRAY(Theta_We)
1270 CALL SHIFT_DP_ARRAY(Theta_We_bar)
1271 CALL SHIFT_DP_ARRAY(Alpha_We_c)
1272 CALL SHIFT_DP_ARRAY(NOC_W_E)
1273 CALL SHIFT_DP_ARRAY(Theta_Wn)
1274 CALL SHIFT_DP_ARRAY(Theta_Wn_bar)
1275 CALL SHIFT_DP_ARRAY(Alpha_Wn_c)
1276 CALL SHIFT_DP_ARRAY(NOC_W_N)
1277 CALL SHIFT_DP_ARRAY(Alpha_Wt_c)
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
1283 CALL SHIFT_DP_ARRAY(ONEoDX_E_U)
1284 CALL SHIFT_DP_ARRAY(ONEoDY_N_U)
1285 CALL SHIFT_DP_ARRAY(ONEoDZ_T_U)
1286
1287 CALL SHIFT_DP_ARRAY(ONEoDX_E_V)
1288 CALL SHIFT_DP_ARRAY(ONEoDY_N_V)
1289 CALL SHIFT_DP_ARRAY(ONEoDZ_T_V)
1290
1291 CALL SHIFT_DP_ARRAY(ONEoDX_E_W)
1292 CALL SHIFT_DP_ARRAY(ONEoDY_N_W)
1293 CALL SHIFT_DP_ARRAY(ONEoDZ_T_W)
1294
1295
1296
1297 CALL SHIFT_INT_ARRAY(FLAG,UNDEFINED_I)
1298 CALL SHIFT_INT_ARRAY(FLAG_E,UNDEFINED_I)
1299 CALL SHIFT_INT_ARRAY(FLAG_N,UNDEFINED_I)
1300 CALL SHIFT_INT_ARRAY(FLAG_T,UNDEFINED_I)
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
1328 CALL SHIFT_INT_ARRAY(U_MASTER_OF,0)
1329 CALL SHIFT_INT_ARRAY(V_MASTER_OF,0)
1330 CALL SHIFT_INT_ARRAY(W_MASTER_OF,0)
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
1339 CALL SHIFT_INT_ARRAY(PHASE_4_P_G,UNDEFINED_I)
1340 CALL SHIFT_INT_ARRAY(PHASE_4_P_S,UNDEFINED_I)
1341
1342
1343 CALL SHIFT_LOG_ARRAY(SCALAR_NODE_ATWALL,.FALSE.)
1344
1345 CALL SHIFT_DP_ARRAY(SCALAR_NODE_XYZ)
1346 CALL SHIFT_DP_ARRAY(SCALAR_NODE_XYZ)
1347 CALL SHIFT_DP_ARRAY(SCALAR_NODE_XYZ)
1348 CALL SHIFT_DP_ARRAY(Ovol_around_node)
1349
1350
1351
1352 IF (IJK_P_G /= UNDEFINED_I) IJK_P_G = IJK_OF_BACKGROUND(IJK_P_G)
1353
1354 IF(STIFF_CHEMISTRY) CALL SHIFT_LOG_ARRAY(notOwner,.FALSE.)
1355
1356 IF(BDIST_IO) CALL SHIFT_CONNECTIVITY_FOR_BDIST_IO
1357
1358
1359
1360
1361
1362
1363 = 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
1373
1374
1375
1376 nullify(new_xsend1, new_sendtag1, new_sendproc1, new_sendijk1)
1377
1378
1379
1380 = 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
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
1393
1394 = 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
1410 (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
1444
1445 nullify(new_xsend2, new_sendtag2, new_sendproc2, new_sendijk2)
1446
1447
1448
1449 = 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
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
1461
1462 = 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
1480 (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
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
1507
1508 = 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
1517
1518
1519
1520 nullify(new_xrecv1, new_recvtag1, new_recvproc1, new_recvijk1)
1521
1522
1523
1524 = 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
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
1536
1537 = 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
1559 (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
1592
1593 nullify(new_xrecv2, new_recvtag2, new_recvproc2, new_recvijk2)
1594
1595
1596
1597 = 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
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
1609
1610 = 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
1626 (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
1660
1661 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning send and receive arrays for Send layer 1...'
1662
1663
1664
1665
1666
1667
1668
1669 nullify(new_sendijk1)
1670
1671 print *, 'sendijk1=',size(sendijk1)
1672 allocate( new_sendijk1( size(sendijk1) ) )
1673
1674
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
1701
1702
1703 print *, 'sendijk2=',size(sendijk2)
1704 nullify(new_sendijk2)
1705
1706
1707 allocate( new_sendijk2( size(sendijk2) ) )
1708
1709
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
1723 (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
1737
1738
1739
1740 print *, 'recvijk1=',size(recvijk1)
1741 nullify(new_recvijk1)
1742
1743
1744 allocate( new_recvijk1( size(recvijk1) ) )
1745
1746
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
1760 (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
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
1793 (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
1812
1813 call sendrecv_re_init_after_re_indexing(comm, 0 )
1814
1815 ENDIF
1816
1817 #ifdef MPI
1818 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
1819 #endif
1820
1821
1822
1823
1824
1825
1826
1827 IF(MyPE == PE_IO) WRITE(*,*)' Re-indexing: Re-assigning cell classes...'
1828
1829
1830
1831
1832 = 0
1833
1834
1835 DO K = KSTART3, KEND3
1836 DO J = JSTART3, JEND3
1837 L100: DO I = ISTART3, IEND3
1838 IJK = FUNIJK(I,J,K)
1839
1840 IF(DEAD_CELL_AT(I,J,K)) CYCLE
1841
1842
1843
1844
1845
1846 = 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 + 1
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
1905 DO IC = 1, ICLASS - 1
1906
1907 IF (DENOTE_CLASS(ICLASS) == DENOTE_CLASS(IC)) THEN
1908
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
1928 = ICLASS - 1
1929 CYCLE L100
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
1941
1942
1943
1944 ALLOCATE( NEW_IJKSIZE3_ALL(0:NUMPES-1) )
1945
1946 CALL ALLGATHER_1I (IJKEND3,NEW_IJKSIZE3_ALL,IERR)
1947
1948
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
1999 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
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
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)
2024
2025
2026
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
2046
2047
2048
2049
2050
2051
2052
2053
2054
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
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098 SUBROUTINE BUBBLE_SORT_1D_INT_ARRAY(ARRAY,I1,I2)
2099
2100
2101
2102
2103 USE indices
2104 USE geometry
2105 USE compar
2106 USE cutcell
2107
2108 IMPLICIT NONE
2109
2110
2111
2112
2113
2114
2115 INTEGER ::I1,I2,BUFFER,I,J
2116
2117 INTEGER, DIMENSION(I1:I2) :: ARRAY
2118
2119
2120
2121
2122
2123
2124
2125
2126
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
2141
2142
2143 END SUBROUTINE BUBBLE_SORT_1D_INT_ARRAY
2144
2145
2146
2147 SUBROUTINE SHIFT_DP_ARRAY(ARRAY)
2148
2149
2150
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
2164
2165
2166
2167 INTEGER ::IJK
2168
2169 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179 = 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
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208 SUBROUTINE SHIFT_INT_ARRAY(ARRAY,DEFAULT_VALUE)
2209
2210
2211
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
2224
2225
2226
2227 INTEGER ::IJK
2228
2229 INTEGER, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2230 INTEGER :: DEFAULT_VALUE
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240 = 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
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270 SUBROUTINE SHIFT_LOG_ARRAY(ARRAY,DEFAULT_VALUE)
2271
2272
2273
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
2286
2287
2288
2289 INTEGER ::IJK
2290
2291 LOGICAL, DIMENSION(DIMENSION_3) :: ARRAY, BUFFER
2292 LOGICAL :: DEFAULT_VALUE
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302 = 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
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333 SUBROUTINE UNSHIFT_DP_ARRAY(ARRAY_1,ARRAY_2)
2334
2335
2336
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
2350
2351
2352
2353 INTEGER ::IJK
2354
2355 DOUBLE PRECISION, DIMENSION(DIMENSION_3) :: ARRAY_1, ARRAY_2
2356
2357
2358
2359 = 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
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388 SUBROUTINE SHIFT_CONNECTIVITY_FOR_BDIST_IO
2389
2390
2391
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
2404
2405
2406
2407 INTEGER ::IJK, L, BCK_IJK, NN , CONN
2408
2409
2410 INTEGER, DIMENSION(DIMENSION_3,15) ::TEMP_CONNECTIVITY
2411
2412
2413
2414
2415
2416
2417 CALL SHIFT_INT_ARRAY(NUMBER_OF_NODES,0)
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)
2426
2427 = NUMBER_OF_NODES(IJK)
2428
2429 DO L = 1, NN
2430
2431
2432 = TEMP_CONNECTIVITY(BCK_IJK,L)
2433
2434 IF(CONN>BACKGROUND_IJKEND3) THEN
2435 CONNECTIVITY(IJK,L) = CONN - BACKGROUND_IJKEND3 + IJKEND3
2436 ELSE
2437 CONNECTIVITY(IJK,L) = IJK_OF_BACKGROUND(CONN)
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
2455
2456
2457
2458
2459
2460 USE param
2461 USE param1
2462 USE funits
2463 IMPLICIT NONE
2464
2465
2466
2467
2468
2469
2470 INTEGER :: FILE_UNIT
2471
2472
2473
2474
2475 INTEGER :: ARRAY_SIZE
2476
2477
2478
2479 INTEGER :: LSTART
2480
2481
2482 INTEGER :: LEND
2483
2484
2485 INTEGER :: ARRAY(ARRAY_SIZE)
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496 INTEGER :: NCOL
2497
2498
2499
2500
2501
2502
2503
2504
2505 INTEGER NROW
2506
2507
2508
2509 INTEGER L, L1, L2, L3
2510
2511
2512 = (LEND - LSTART + 1)/NCOL
2513
2514 = 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 FORMAT(14X,50(I12,1X))
2528 END SUBROUTINE WRITE_INT_TABLE
2529
2530
2531
2532
2533
2534
2535
2536 SUBROUTINE WRITE_IJK_VALUES
2537
2538
2539
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
2565
2566
2567
2568
2569
2570
2571
2572
2573
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
2586
2587
2588
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
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
2704
2705 #ifdef MPI
2706 call MPI_BARRIER(MPI_COMM_WORLD, mpierr)
2707 #endif
2708
2709
2710
2711
2712 END SUBROUTINE WRITE_IJK_VALUES
2713