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