Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_RFLU_ModComm.F90
Go to the documentation of this file.
1 ! *********************************************************************
2 ! * Rocstar Simulation Suite *
3 ! * Copyright@2015, Illinois Rocstar LLC. All rights reserved. *
4 ! * *
5 ! * Illinois Rocstar LLC *
6 ! * Champaign, IL *
7 ! * www.illinoisrocstar.com *
8 ! * sales@illinoisrocstar.com *
9 ! * *
10 ! * License: See LICENSE file in top level of distribution package or *
11 ! * http://opensource.org/licenses/NCSA *
12 ! *********************************************************************
13 ! *********************************************************************
14 ! * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, *
15 ! * EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES *
16 ! * OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND *
17 ! * NONINFRINGEMENT. IN NO EVENT SHALL THE CONTRIBUTORS OR *
18 ! * COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER *
19 ! * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, *
20 ! * Arising FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE *
21 ! * USE OR OTHER DEALINGS WITH THE SOFTWARE. *
22 ! *********************************************************************
23 ! ******************************************************************************
24 !
25 ! Purpose: Suite of routines for communication between regions with RFLU solver.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: PLAG_RFLU_ModComm.F90,v 1.11 2008/12/06 08:44:35 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2005 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
39 MODULE plag_rflu_modcomm
40 
41  USE modglobal, ONLY: t_global
42  USE moddatatypes
43  USE modparameters
44  USE moderror
45  USE moddatastruct, ONLY: t_region
46  USE modgrid, ONLY: t_grid
47  USE modmixture, ONLY: t_mixt_input
48  USE modborder, ONLY: t_border,t_border_data
49  USE modpartlag, ONLY: t_plag,t_plag_input
50  USE modmpi
51 
52  USE plag_modparameters
53  USE modinterfaces, ONLY: rflu_decideprint
54  USE plag_modinterfaces, ONLY: plag_updatedatastruct
55  USE plag_modreallocatememory
56  USE plag_rflu_modfindcells
57 
58 ! TEMPORARY
59  USE plag_modinterfaces, ONLY: plag_calcderivedvariables
60 ! END TEMPORARY
61 
62  IMPLICIT NONE
63 
64  PRIVATE
65  PUBLIC :: plag_rflu_commdriver, &
66  plag_rflu_initsendcounters
67 
68 ! ******************************************************************************
69 ! Declarations and definitions
70 ! ******************************************************************************
71 
72  CHARACTER(CHRLEN) :: &
73  RCSIdentString = '$RCSfile: PLAG_RFLU_ModComm.F90,v $ $Revision: 1.11 $'
74 
75  INTEGER, PARAMETER, PRIVATE :: REQUEST_TYPE_COUNTER = 1, &
76  REQUEST_TYPE_DATA = 2
77 
78 ! ******************************************************************************
79 ! Routines
80 ! ******************************************************************************
81 
82  CONTAINS
83 
84 
85 
86 
87 
88 
89 ! ******************************************************************************
90 !
91 ! Purpose: Clearing send requests.
92 !
93 ! Description: None.
94 !
95 ! Input:
96 ! global Pointer to global data
97 ! request Request (to be cleared)
98 !
99 ! Output:
100 ! request Request (cleared)
101 !
102 ! Notes: None.
103 !
104 ! ******************************************************************************
105 
106  SUBROUTINE plag_rflu_clearrequest(global,request)
107 
108  IMPLICIT NONE
109 
110 ! ******************************************************************************
111 ! Declarations and definitions
112 ! ******************************************************************************
113 
114 ! ==============================================================================
115 ! Arguments
116 ! ==============================================================================
117 
118  INTEGER, INTENT(INOUT) :: request
119  TYPE(t_global), POINTER :: global
120 
121 ! ==============================================================================
122 ! Local variables
123 ! ==============================================================================
124 
125  INTEGER :: errorflag
126  INTEGER :: status(mpi_status_size)
127 
128 ! ******************************************************************************
129 ! Start
130 ! ******************************************************************************
131 
132  CALL registerfunction(global,'PLAG_RFLU_ClearRequest',&
133  'PLAG_RFLU_ModComm.F90')
134 
135 ! ******************************************************************************
136 ! Set pointers
137 ! ******************************************************************************
138 
139  CALL mpi_wait(request,status,errorflag)
140  global%error = errorflag
141  IF ( global%error /= err_none ) THEN
142  CALL errorstop(global,err_mpi_output,__line__)
143  END IF ! global%error
144 
145 ! ******************************************************************************
146 ! End
147 ! ******************************************************************************
148 
149  CALL deregisterfunction(global)
150 
151  END SUBROUTINE plag_rflu_clearrequest
152 
153 
154 
155 
156 
157 
158 
159 
160 
161 ! ******************************************************************************
162 !
163 ! Purpose: Wrapper for clearing send requests.
164 !
165 ! Description: None.
166 !
167 ! Input:
168 ! pRegion Pointer to region
169 ! iReqFlag Request flag
170 !
171 ! Output: None.
172 !
173 ! Notes:
174 ! 1. When clearing the data request, the sending side initiates
175 ! communication; hence, we need to check if nPclsSend is not null.
176 !
177 ! ******************************************************************************
178 
179  SUBROUTINE plag_rflu_clearrequestwrapper(pRegion,iReqFlag)
180 
181  IMPLICIT NONE
182 
183 ! ******************************************************************************
184 ! Declarations and definitions
185 ! ******************************************************************************
186 
187 ! ==============================================================================
188 ! Arguments
189 ! ==============================================================================
190 
191  INTEGER, INTENT(IN) :: ireqflag
192  TYPE(t_region), POINTER :: pregion
193 
194 ! ==============================================================================
195 ! Local variables
196 ! ==============================================================================
197 
198  INTEGER :: errorflag,iborder
199  TYPE(t_border), POINTER :: pborder
200  TYPE(t_global), POINTER :: global
201  TYPE(t_grid), POINTER :: pgrid
202 
203 ! ******************************************************************************
204 ! Start
205 ! ******************************************************************************
206 
207  global => pregion%global
208 
209  CALL registerfunction(global,'PLAG_RFLU_ClearRequestWrapper',&
210  'PLAG_RFLU_ModComm.F90')
211 
212 ! ******************************************************************************
213 ! Set pointers
214 ! ******************************************************************************
215 
216  pgrid => pregion%grid
217 
218 ! ******************************************************************************
219 ! Loop over borders
220 ! ******************************************************************************
221 
222  DO iborder = 1,pgrid%nBorders
223  pborder => pgrid%borders(iborder)
224 
225 ! ==============================================================================
226 ! Send data if not on same process
227 ! ==============================================================================
228 
229  IF ( pborder%iProc /= global%myProcid ) THEN
230  SELECT CASE (ireqflag)
231  CASE(request_type_counter)
232  CALL plag_rflu_clearrequest(global,pborder%plag%sendRequestCount)
233 
234  CASE(request_type_data)
235  IF ( pborder%nPclsSend == 0 ) cycle
236  CALL plag_rflu_clearrequest(global,pborder%plag%sendRequest)
237  CALL plag_rflu_clearrequest(global,pborder%plag%sendRequestInt)
238  END SELECT ! iReqFlag
239  END IF ! pBorder
240 
241  END DO ! iBorder
242 
243 ! ******************************************************************************
244 ! End
245 ! ******************************************************************************
246 
247  CALL deregisterfunction(global)
248 
249  END SUBROUTINE plag_rflu_clearrequestwrapper
250 
251 
252 
253 
254 
255 
256 
257 
258 
259 ! ******************************************************************************
260 !
261 ! Purpose: Driver routine for communication.
262 !
263 ! Description: None.
264 !
265 ! Input:
266 ! regions Pointer to all regions
267 !
268 ! Output: None.
269 !
270 ! Notes: None.
271 !
272 ! ******************************************************************************
273 
274  SUBROUTINE plag_rflu_commdriver(regions)
275 
276  IMPLICIT NONE
277 
278 ! ******************************************************************************
279 ! Declarations and definitions
280 ! ******************************************************************************
281 
282 ! ==============================================================================
283 ! Arguments
284 ! ==============================================================================
285 
286  TYPE(t_region), DIMENSION(:), POINTER :: regions
287 
288 ! ==============================================================================
289 ! Local variables
290 ! ==============================================================================
291 
292  LOGICAL :: doprint
293  INTEGER :: errorflag,ipclbeg,ipclend,ireg,istage,loopcounter
294 
295  TYPE(t_border), POINTER :: pborder
296  TYPE(t_global), POINTER :: global
297  TYPE(t_grid), POINTER :: pgrid
298  TYPE(t_region), POINTER :: pregion
299 
300 ! ******************************************************************************
301 ! Start
302 ! ******************************************************************************
303 
304  global => regions(0)%global
305 
306  CALL registerfunction(global,'PLAG_RFLU_CommDriver',&
307  'PLAG_RFLU_ModComm.F90')
308 
309 ! ******************************************************************************
310 ! Initialize variables
311 ! ******************************************************************************
312 
313 #ifdef ROCPROF
314  CALL fprofiler_begins("PLAG_RFLU::PLAG_RFLU_CommDriver")
315 #endif
316 
317  loopcounter = 0
318 
319 ! ******************************************************************************
320 ! Loop till all particles have been communicated
321 ! ******************************************************************************
322 
323  commloop: DO
324 
325 ! ==============================================================================
326 ! Find if any region need to communicate particles
327 ! and exit commLoop if null
328 ! ==============================================================================
329 
330 #ifdef ROCPROF
331  CALL fprofiler_begins("PLAG_RFLU::TotalnPclsComm")
332 #endif
333 
334  CALL plag_rflu_totalnpclscomm(regions)
335 
336  IF ( global%myProcid == masterproc .AND. &
337  global%verbLevel > verbose_low .AND. &
338  global%nPclsCommTot /= 0 ) THEN
339  WRITE(stdout,'(A,3X,A,1X,1PE12.5,2(1X,I10))') &
340  solver_name,'Current Loop Counter & nPclsComm:',&
341  global%currentTime,loopcounter,global%nPclsCommTot
342  END IF ! global%myProcid
343 
344 #ifdef ROCPROF
345  CALL fprofiler_ends("PLAG_RFLU::TotalnPclsComm")
346 #endif
347 
348  IF ( global%nPclsCommTot == 0 ) THEN
349  EXIT commloop
350  END IF ! nPclsSendTot
351 
352 ! ------------------------------------------------------------------------------
353 ! Initialize receive counters
354 ! ------------------------------------------------------------------------------
355 
356 #ifdef ROCPROF
357  CALL fprofiler_begins("PLAG_RFLU::InitRecvCount")
358 #endif
359 
360  DO ireg = 1,global%nRegionsLocal
361  pregion => regions(ireg)
362  CALL plag_rflu_initrecvcounters(pregion)
363  END DO ! iReg
364 
365 #ifdef ROCPROF
366  CALL fprofiler_ends("PLAG_RFLU::InitRecvCount")
367 #endif
368 
369 ! ------------------------------------------------------------------------------
370 ! Send counters
371 ! ------------------------------------------------------------------------------
372 
373 #ifdef ROCPROF
374  CALL fprofiler_begins("PLAG_RFLU::ISendCount")
375 #endif
376 
377  DO ireg = 1,global%nRegionsLocal
378  pregion => regions(ireg)
379  CALL plag_rflu_isendcounters(pregion)
380  END DO ! iReg
381 
382 #ifdef ROCPROF
383  CALL fprofiler_ends("PLAG_RFLU::ISendCount")
384 #endif
385 
386 ! ------------------------------------------------------------------------------
387 ! Copy counters on same processors
388 ! ------------------------------------------------------------------------------
389 
390 #ifdef ROCPROF
391  CALL fprofiler_begins("PLAG_RFLU::CopyCount")
392 #endif
393 
394  CALL plag_rflu_copycounters(regions)
395 
396 #ifdef ROCPROF
397  CALL fprofiler_ends("PLAG_RFLU::CopyCount")
398 #endif
399 
400 ! ------------------------------------------------------------------------------
401 ! Create and fill send data buffers
402 ! ------------------------------------------------------------------------------
403 
404 #ifdef ROCPROF
405  CALL fprofiler_begins("PLAG_RFLU::CreateBuffSend")
406 #endif
407 
408  DO ireg = 1,global%nRegionsLocal
409  pregion => regions(ireg)
410  CALL plag_rflu_createbufferssend(pregion)
411  CALL plag_rflu_loadbufferssend(pregion)
412  END DO ! iReg
413 
414 #ifdef ROCPROF
415  CALL fprofiler_ends("PLAG_RFLU::CreateBuffSend")
416 #endif
417 
418 ! ------------------------------------------------------------------------------
419 ! Receive counters
420 ! Note: separate from clear requests due MPI issues on uP
421 ! ------------------------------------------------------------------------------
422 
423 #ifdef ROCPROF
424  CALL fprofiler_begins("PLAG_RFLU::RecvCount")
425 #endif
426 
427  DO ireg = 1,global%nRegionsLocal
428  pregion => regions(ireg)
429  CALL plag_rflu_recvcounters(pregion)
430  END DO ! iReg
431 
432 #ifdef ROCPROF
433  CALL fprofiler_ends("PLAG_RFLU::RecvCount")
434 #endif
435 
436 ! ------------------------------------------------------------------------------
437 ! Clear requests and create receive data buffers
438 ! ------------------------------------------------------------------------------
439 
440 #ifdef ROCPROF
441  CALL fprofiler_begins("PLAG_RFLU::CreateBuffRecv")
442 #endif
443 
444  DO ireg = 1,global%nRegionsLocal
445  pregion => regions(ireg)
446  CALL plag_rflu_clearrequestwrapper(pregion,request_type_counter)
447  CALL plag_rflu_createbuffersrecv(pregion)
448  END DO ! iReg
449 
450 #ifdef ROCPROF
451  CALL fprofiler_ends("PLAG_RFLU::CreateBuffRecv")
452 #endif
453 
454 ! ------------------------------------------------------------------------------
455 ! Send communication buffers
456 ! ------------------------------------------------------------------------------
457 
458 #ifdef ROCPROF
459  CALL fprofiler_begins("PLAG_RFLU::ISendData")
460 #endif
461 
462  DO ireg = 1,global%nRegionsLocal
463  pregion => regions(ireg)
464  CALL plag_rflu_isenddata(pregion)
465  END DO ! iReg
466 
467 #ifdef ROCPROF
468  CALL fprofiler_ends("PLAG_RFLU::ISendData")
469 #endif
470 
471 ! ------------------------------------------------------------------------------
472 ! Communicate data buffers for borders on same processor
473 ! ------------------------------------------------------------------------------
474 
475 #ifdef ROCPROF
476  CALL fprofiler_begins("PLAG_RFLU::CopyData")
477 #endif
478 
479  CALL plag_rflu_copydata(regions)
480 
481 #ifdef ROCPROF
482  CALL fprofiler_ends("PLAG_RFLU::CopyData")
483 #endif
484 
485 ! ------------------------------------------------------------------------------
486 ! Update datastructure after buffers have been sent
487 ! ------------------------------------------------------------------------------
488 
489 #ifdef ROCPROF
490  CALL fprofiler_begins("PLAG_RFLU::UpdateDataPar")
491 #endif
492 
493  DO ireg = 1,global%nRegionsLocal
494  pregion => regions(ireg)
495 
496  IF ( pregion%plag%nPcls > 0 ) THEN
497  CALL plag_updatedatastruct(pregion)
498  END IF ! nPcls
499  END DO ! iReg
500 
501 #ifdef ROCPROF
502  CALL fprofiler_ends("PLAG_RFLU::UpdateDataPar")
503 #endif
504 
505 ! ------------------------------------------------------------------------------
506 ! Receive data buffers
507 ! ------------------------------------------------------------------------------
508 
509 #ifdef ROCPROF
510  CALL fprofiler_begins("PLAG_RFLU::RecvData")
511 #endif
512 
513  DO ireg = 1,global%nRegionsLocal
514  pregion => regions(ireg)
515  CALL plag_rflu_recvdata(pregion)
516  END DO ! iReg
517 
518 #ifdef ROCPROF
519  CALL fprofiler_ends("PLAG_RFLU::RecvData")
520 #endif
521 
522 ! ------------------------------------------------------------------------------
523 ! Clear requests for data buffers
524 ! ------------------------------------------------------------------------------
525 
526 #ifdef ROCPROF
527  CALL fprofiler_begins("PLAG_RFLU::ClearReqsData")
528 #endif
529 
530  DO ireg = 1,global%nRegionsLocal
531  pregion => regions(ireg)
532  CALL plag_rflu_clearrequestwrapper(pregion,request_type_data)
533  END DO ! iReg
534 
535 #ifdef ROCPROF
536  CALL fprofiler_ends("PLAG_RFLU::ClearReqsData")
537 #endif
538 
539 ! ------------------------------------------------------------------------------
540 ! Unload receive buffers, deallocate buffers, and reallocate memory
541 ! ------------------------------------------------------------------------------
542 
543 #ifdef ROCPROF
544  CALL fprofiler_begins("PLAG_RFLU::UnloadBuffRecv")
545 #endif
546 
547  DO ireg = 1,global%nRegionsLocal
548  pregion => regions(ireg)
549 
550  pregion%plag%nPclsPrev = pregion%plag%nPcls
551 
552  CALL plag_rflu_unloadbuffersrecv(pregion)
553  CALL plag_rflu_destroybufferssend(pregion)
554  CALL plag_rflu_destroybuffersrecv(pregion)
555  CALL plag_reallocmemwrapper(pregion)
556  END DO ! iReg
557 
558 #ifdef ROCPROF
559  CALL fprofiler_ends("PLAG_RFLU::UnloadBuffRecv")
560 #endif
561 
562 ! ------------------------------------------------------------------------------
563 ! Initialize send counters
564 ! ------------------------------------------------------------------------------
565 
566 #ifdef ROCPROF
567  CALL fprofiler_begins("PLAG_RFLU::InitSendCountPar")
568 #endif
569 
570  DO ireg = 1,global%nRegionsLocal
571  pregion => regions(ireg)
572  CALL plag_rflu_initsendcounters(pregion)
573  END DO ! iReg
574 
575 #ifdef ROCPROF
576  CALL fprofiler_ends("PLAG_RFLU::InitSendCountPar")
577 #endif
578 
579 ! ------------------------------------------------------------------------------
580 ! Continue tracking particles if remaining trajectory distance is not zero
581 ! Tracking performed when particles are added to datastructure, i.e.
582 ! iPclEnd greater or equal to iPclBeg.
583 ! ------------------------------------------------------------------------------
584 
585 #ifdef ROCPROF
586  CALL fprofiler_begins("PLAG_RFLU::FindCellsPar")
587 #endif
588 
589  DO ireg = 1,global%nRegionsLocal
590  pregion => regions(ireg)
591  pgrid => pregion%grid
592 
593  ipclbeg = pregion%plag%nPclsPrev +1
594  ipclend = pregion%plag%nPcls
595 
596  IF ( ipclend < ipclbeg ) cycle
597 
598 ! TEMPORARY
599  CALL plag_calcderivedvariables(pregion)
600 ! END TEMPORARY
601 
602  SELECT CASE ( pregion%plagInput%findPclMethod )
603  CASE ( find_pcl_method_traj_fast )
604  CALL plag_rflu_findcellstrajfast(pregion,ipclbeg,ipclend)
605  CASE ( find_pcl_method_traj_safe )
606  CALL plag_rflu_findcellstrajsafe(pregion,ipclbeg,ipclend)
607  CASE default
608  CALL errorstop(global,err_reached_default,__line__)
609  END SELECT ! pRegion%plagInput%findPclMethod
610  END DO ! iReg
611 
612 #ifdef ROCPROF
613  CALL fprofiler_ends("PLAG_RFLU::FindCellsPar")
614 #endif
615 
616 ! ==============================================================================
617 ! Update loopCounter
618 ! ==============================================================================
619 
620  loopcounter = loopcounter + 1
621 
622 ! ==============================================================================
623 ! Guard against infinite loop
624 ! ==============================================================================
625 
626  IF ( loopcounter >= limit_infinite_loop ) THEN
627  CALL errorstop(global,err_infinite_loop,__line__)
628  END IF ! loopCounter
629  END DO commloop
630 
631 ! ******************************************************************************
632 ! Update datastructure after communication is completed
633 ! ******************************************************************************
634 
635 #ifdef ROCPROF
636  CALL fprofiler_begins("PLAG_RFLU::UpdateDataPar2")
637 #endif
638 
639  DO ireg = 1,global%nRegionsLocal
640  pregion => regions(ireg)
641 
642  IF ( pregion%plag%nPcls > 0 ) THEN
643  CALL plag_updatedatastruct(pregion)
644  END IF ! nPcls
645  END DO ! iReg
646 
647 #ifdef ROCPROF
648  CALL fprofiler_ends("PLAG_RFLU::UpdateDataPar2")
649 #endif
650 
651 ! ******************************************************************************
652 ! Print number of particles in each region
653 ! ******************************************************************************
654 
655 ! DO iReg = 1,global%nRegionsLocal
656 ! pRegion => regions(iReg)
657 ! istage = pRegion%irkStep
658 !
659 !! IF ( istage == global%nrkSteps ) THEN
660 ! doPrint = RFLU_DecidePrint(global)
661 ! IF ( (global%verbLevel > VERBOSE_NONE) .AND. (doPrint .EQV. .TRUE.) ) &
662 ! WRITE(STDOUT,'(A,I4,I8)') 'iRegGlobal: nPcls = ',pRegion%iRegionGlobal,pRegion%plag%nPcls
663 !! END IF ! istage
664 ! END DO ! iReg
665 
666 #ifdef ROCPROF
667  CALL fprofiler_ends("PLAG_RFLU::PLAG_RFLU_CommDriver")
668 #endif
669 
670 ! ******************************************************************************
671 ! End
672 ! ******************************************************************************
673 
674  CALL deregisterfunction(global)
675 
676  END SUBROUTINE plag_rflu_commdriver
677 
678 
679 
680 
681 
682 
683 
684 
685 
686 ! ******************************************************************************
687 !
688 ! Purpose: Copy counters.
689 !
690 ! Description: None.
691 !
692 ! Input:
693 ! regions Pointer to all regions
694 !
695 ! Output: None.
696 !
697 ! Notes: None.
698 !
699 ! ******************************************************************************
700 
701  SUBROUTINE plag_rflu_copycounters(regions)
702 
703  IMPLICIT NONE
704 
705 ! ******************************************************************************
706 ! Declarations and definitions
707 ! ******************************************************************************
708 
709 ! ==============================================================================
710 ! Arguments
711 ! ==============================================================================
712 
713  TYPE(t_region), DIMENSION(:), POINTER :: regions
714 
715 ! ==============================================================================
716 ! Local variables
717 ! ==============================================================================
718 
719  INTEGER :: errorflag,iborder,iborder2,ireg,ireg2
720  TYPE(t_border), POINTER :: pborder,pborder2
721  TYPE(t_global), POINTER :: global
722  TYPE(t_grid), POINTER :: pgrid
723  TYPE(t_region), POINTER :: pregion,pregion2
724 
725 ! ******************************************************************************
726 ! Start
727 ! ******************************************************************************
728 
729  global => regions(0)%global
730 
731  CALL registerfunction(global,'PLAG_RFLU_CopyCounters',&
732  'PLAG_RFLU_ModComm.F90')
733 
734 ! ******************************************************************************
735 ! Loop over borders
736 ! ******************************************************************************
737 
738  DO ireg = 1,global%nRegionsLocal
739  pregion => regions(ireg)
740  pgrid => pregion%grid
741 
742  DO iborder = 1,pgrid%nBorders
743  pborder => pgrid%borders(iborder)
744 
745  IF ( pborder%iProc == global%myProcid ) THEN
746  ireg2 = pborder%iRegionLocal
747  iborder2 = pborder%iBorder
748 
749  pregion2 => regions(ireg2)
750  pborder2 => pregion2%grid%borders(iborder2)
751 
752  pborder2%nPclsRecv = pborder%nPclsSend
753 
754  END IF ! pBorder
755  END DO ! iBorder
756  END DO ! iReg
757 
758 ! ******************************************************************************
759 ! End
760 ! ******************************************************************************
761 
762  CALL deregisterfunction(global)
763 
764  END SUBROUTINE plag_rflu_copycounters
765 
766 
767 
768 
769 
770 
771 
772 
773 
774 ! ******************************************************************************
775 !
776 ! Purpose: Copy data buffers for regions on same processor.
777 !
778 ! Description: None.
779 !
780 ! Input:
781 ! regions Pointer to all regions
782 !
783 ! Output: None.
784 !
785 ! Notes: None.
786 !
787 ! ******************************************************************************
788 
789  SUBROUTINE plag_rflu_copydata(regions)
790 
791  IMPLICIT NONE
792 
793 ! ******************************************************************************
794 ! Declarations and definitions
795 ! ******************************************************************************
796 
797 ! ==============================================================================
798 ! Arguments
799 ! ==============================================================================
800 
801  TYPE(t_region), DIMENSION(:), POINTER :: regions
802 
803 ! ==============================================================================
804 ! Local variables
805 ! ==============================================================================
806 
807  INTEGER :: errorflag,iborder,iborder2,ireg,ireg2
808  TYPE(t_border), POINTER :: pborder,pborder2
809  TYPE(t_global), POINTER :: global
810  TYPE(t_grid), POINTER :: pgrid
811  TYPE(t_region), POINTER :: pregion,pregion2
812 
813 ! ******************************************************************************
814 ! Start
815 ! ******************************************************************************
816 
817  global => regions(0)%global
818 
819  CALL registerfunction(global,'PLAG_RFLU_CopyData',&
820  'PLAG_RFLU_ModComm.F90')
821 
822 ! ******************************************************************************
823 ! Set pointers
824 ! ******************************************************************************
825 
826 ! ******************************************************************************
827 ! Loop over borders
828 ! ******************************************************************************
829 
830  DO ireg = 1,global%nRegionsLocal
831  pregion => regions(ireg)
832  pgrid => pregion%grid
833 
834  DO iborder = 1,pgrid%nBorders
835  pborder => pgrid%borders(iborder)
836 
837 ! ==============================================================================
838 ! Copy data if on same process
839 ! ==============================================================================
840 
841  IF ( pborder%iProc == global%myProcid ) THEN
842  ireg2 = pborder%iRegionLocal
843  iborder2 = pborder%iBorder
844 
845  pregion2 => regions(ireg2)
846  pborder2 => pregion2%grid%borders(iborder2)
847 
848 ! ------------------------------------------------------------------------------
849 ! Check dimensions
850 ! ------------------------------------------------------------------------------
851 
852  IF ( pborder%nPclsSend /= pborder2%nPclsRecv ) THEN
853  CALL errorstop(global,err_bufferdim_mismatch,__line__)
854  END IF ! pBorder%nPclsSend
855 
856  IF ( pborder%nPclsSend == 0 ) cycle
857 
858 ! ------------------------------------------------------------------------------
859 ! Real data
860 ! ------------------------------------------------------------------------------
861 
862  CALL plag_rflu_copydatareal(global,pborder%plag%sendBuff, &
863  pborder2%plag%recvBuff)
864 
865 ! ------------------------------------------------------------------------------
866 ! Integer data
867 ! ------------------------------------------------------------------------------
868 
869  CALL plag_rflu_copydataint(global,pborder%plag%sendBuffInt, &
870  pborder2%plag%recvBuffInt)
871 
872  END IF ! pBorder
873  END DO ! iBorder
874  END DO ! iReg
875 
876 ! ******************************************************************************
877 ! End
878 ! ******************************************************************************
879 
880  CALL deregisterfunction(global)
881 
882  END SUBROUTINE plag_rflu_copydata
883 
884 
885 
886 
887 
888 
889 
890 
891 ! ******************************************************************************
892 !
893 ! Purpose: Copy particle data for integer variables.
894 !
895 ! Description: None.
896 !
897 ! Input:
898 ! global Pointer to global data
899 ! pclData Integer array with particle data
900 !
901 ! Output:
902 ! pclData2 Integer array with particle data
903 !
904 ! Notes: None.
905 !
906 ! ******************************************************************************
907 
908  SUBROUTINE plag_rflu_copydataint(global,pclData,pclData2)
909 
910  IMPLICIT NONE
911 
912 ! ******************************************************************************
913 ! Declarations and definitions
914 ! ******************************************************************************
915 
916 ! ==============================================================================
917 ! Arguments
918 ! ==============================================================================
919 
920  INTEGER, DIMENSION(:,:), INTENT(IN) :: pcldata
921  INTEGER, DIMENSION(:,:), INTENT(OUT) :: pcldata2
922  TYPE(t_global), POINTER :: global
923 
924 ! ==============================================================================
925 ! Local variables
926 ! ==============================================================================
927 
928  INTEGER :: errorflag,ipcl,ivar,npclssend,nvars
929 
930 ! ******************************************************************************
931 ! Start
932 ! ******************************************************************************
933 
934  CALL registerfunction(global,'PLAG_RFLU_CopyDataInt',&
935  'PLAG_RFLU_ModComm.F90')
936 
937 ! ******************************************************************************
938 ! Set variables
939 ! ******************************************************************************
940 
941  nvars = SIZE(pcldata,1)
942 
943  IF ( nvars /= SIZE(pcldata2,1) ) THEN
944  CALL errorstop(global,err_datadim_mismatch,__line__)
945  END IF ! nVars
946 
947  npclssend = SIZE(pcldata,2)
948 
949  IF ( npclssend /= SIZE(pcldata2,2) ) THEN
950  CALL errorstop(global,err_datadim_mismatch,__line__)
951  END IF ! nVars
952 
953 ! ******************************************************************************
954 ! Copy data
955 ! ******************************************************************************
956 
957  DO ipcl = 1,npclssend
958  DO ivar = 1,nvars
959  pcldata2(ivar,ipcl) = pcldata(ivar,ipcl)
960  END DO ! iVar
961  END DO ! iPcl
962 
963 ! ******************************************************************************
964 ! End
965 ! ******************************************************************************
966 
967  CALL deregisterfunction(global)
968 
969  END SUBROUTINE plag_rflu_copydataint
970 
971 
972 
973 
974 
975 
976 
977 
978 
979 ! ******************************************************************************
980 !
981 ! Purpose: Copy particle data for real variables.
982 !
983 ! Description: None.
984 !
985 ! Input:
986 ! global Pointer to global data
987 ! pclData Real array with particle data
988 !
989 ! Output:
990 ! pclData2 Real array with particle data
991 !
992 ! Notes: None.
993 !
994 ! ******************************************************************************
995 
996  SUBROUTINE plag_rflu_copydatareal(global,pclData,pclData2)
997 
998  IMPLICIT NONE
999 
1000 ! ******************************************************************************
1001 ! Declarations and definitions
1002 ! ******************************************************************************
1003 
1004 ! ==============================================================================
1005 ! Arguments
1006 ! ==============================================================================
1007 
1008  REAL(RFREAL), DIMENSION(:,:), INTENT(IN) :: pcldata
1009  REAL(RFREAL), DIMENSION(:,:), INTENT(OUT) :: pcldata2
1010  TYPE(t_border), POINTER :: pborder
1011  TYPE(t_global), POINTER :: global
1012 
1013 ! ==============================================================================
1014 ! Local variables
1015 ! ==============================================================================
1016 
1017  INTEGER :: errorflag,ipcl,ivar,npclssend,nvars
1018 
1019 ! ******************************************************************************
1020 ! Start
1021 ! ******************************************************************************
1022 
1023  CALL registerfunction(global,'PLAG_RFLU_CopyDataReal',&
1024  'PLAG_RFLU_ModComm.F90')
1025 
1026 ! ******************************************************************************
1027 ! Set variables
1028 ! ******************************************************************************
1029 
1030  nvars = SIZE(pcldata,1)
1031 
1032  IF ( nvars /= SIZE(pcldata2,1) ) THEN
1033  CALL errorstop(global,err_datadim_mismatch,__line__)
1034  END IF ! nVars
1035 
1036  npclssend = SIZE(pcldata,2)
1037 
1038  IF ( npclssend /= SIZE(pcldata2,2) ) THEN
1039  CALL errorstop(global,err_datadim_mismatch,__line__)
1040  END IF ! nVars
1041 
1042 ! ******************************************************************************
1043 ! Copy data
1044 ! ******************************************************************************
1045 
1046  DO ipcl = 1,npclssend
1047  DO ivar = 1,nvars
1048  pcldata2(ivar,ipcl) = pcldata(ivar,ipcl)
1049  END DO ! iVar
1050  END DO ! iPcl
1051 
1052 ! ******************************************************************************
1053 ! End
1054 ! ******************************************************************************
1055 
1056  CALL deregisterfunction(global)
1057 
1058  END SUBROUTINE plag_rflu_copydatareal
1059 
1060 
1061 
1062 
1063 
1064 
1065 
1066 
1067 
1068 
1069 
1070 ! ******************************************************************************
1071 !
1072 ! Purpose: Create receive buffers.
1073 !
1074 ! Description: None.
1075 !
1076 ! Input:
1077 ! pRegion Pointer to region
1078 !
1079 ! Output: None.
1080 !
1081 ! Notes:
1082 ! 1. aiv, arv cv, cvOld and rhsSum arrays are communicated.
1083 ! 2. cvOld array needs to be communicated for proper trajectory tracking.
1084 !
1085 ! ******************************************************************************
1086 
1087  SUBROUTINE plag_rflu_createbuffersrecv(pRegion)
1088 
1089  IMPLICIT NONE
1090 
1091 ! ******************************************************************************
1092 ! Declarations and definitions
1093 ! ******************************************************************************
1094 
1095 ! ==============================================================================
1096 ! Arguments
1097 ! ==============================================================================
1098 
1099  TYPE(t_region), POINTER :: pregion
1100 
1101 ! ==============================================================================
1102 ! Local variables
1103 ! ==============================================================================
1104 
1105  INTEGER :: errorflag,iborder,nvals,nvarsint,nvarsreal
1106  TYPE(t_border), POINTER :: pborder
1107  TYPE(t_global), POINTER :: global
1108  TYPE(t_grid), POINTER :: pgrid
1109 
1110 ! ******************************************************************************
1111 ! Start
1112 ! ******************************************************************************
1113 
1114  global => pregion%global
1115 
1116  CALL registerfunction(global,'PLAG_RFLU_CreateBuffersRecv',&
1117  'PLAG_RFLU_ModComm.F90')
1118 
1119 ! ******************************************************************************
1120 ! Set pointers
1121 ! ******************************************************************************
1122 
1123  pgrid => pregion%grid
1124 
1125 ! ******************************************************************************
1126 ! Set dimensions
1127 ! Add for the integer variable an additional value
1128 ! to account for cell mapping
1129 ! ******************************************************************************
1130 
1131  nvarsreal = 3*pregion%plag%nCv +pregion%plag%nArv
1132  nvarsint = pregion%plag%nAiv +1
1133 
1134 ! ******************************************************************************
1135 ! Loop over borders
1136 ! ******************************************************************************
1137 
1138  DO iborder = 1,pgrid%nBorders
1139  pborder => pgrid%borders(iborder)
1140 
1141  nvals = pborder%nPclsRecv
1142 
1143  IF ( pborder%nPclsRecv == 0 ) cycle
1144 
1145 ! ==============================================================================
1146 ! Allocate memory
1147 ! ==============================================================================
1148 
1149  ALLOCATE(pborder%plag%recvBuff(nvarsreal,nvals),stat=errorflag)
1150  global%error = errorflag
1151  IF ( global%error /= err_none ) THEN
1152  CALL errorstop(global,err_allocate,__line__,'pBorder%plag%recvBuff')
1153  END IF ! global%error
1154 
1155  ALLOCATE(pborder%plag%recvBuffInt(nvarsint,nvals),stat=errorflag)
1156  global%error = errorflag
1157  IF ( global%error /= err_none ) THEN
1158  CALL errorstop(global,err_allocate,__line__,'pBorder%plag%recvBuffInt')
1159  END IF ! global%error
1160 
1161  END DO ! iBorder
1162 
1163 ! ******************************************************************************
1164 ! End
1165 ! ******************************************************************************
1166 
1167  CALL deregisterfunction(global)
1168 
1169  END SUBROUTINE plag_rflu_createbuffersrecv
1170 
1171 
1172 
1173 
1174 
1175 
1176 
1177 
1178 
1179 ! ******************************************************************************
1180 !
1181 ! Purpose: Create send buffers.
1182 !
1183 ! Description: None.
1184 !
1185 ! Input:
1186 ! pRegion Pointer to region
1187 !
1188 ! Output: None.
1189 !
1190 ! Notes:
1191 ! 1. aiv, arv cv, cvOld and rhsSum arrays are communicated.
1192 ! 2. cvOld array needs to be communicated for proper trajectory tracking.
1193 !
1194 ! ******************************************************************************
1195 
1196  SUBROUTINE plag_rflu_createbufferssend(pRegion)
1197 
1198  IMPLICIT NONE
1199 
1200 ! ******************************************************************************
1201 ! Declarations and definitions
1202 ! ******************************************************************************
1203 
1204 ! ==============================================================================
1205 ! Arguments
1206 ! ==============================================================================
1207 
1208  TYPE(t_region), POINTER :: pregion
1209 
1210 ! ==============================================================================
1211 ! Local variables
1212 ! ==============================================================================
1213 
1214  INTEGER :: errorflag,iborder,nvals,nvarsint,nvarsreal
1215  TYPE(t_border), POINTER :: pborder
1216  TYPE(t_global), POINTER :: global
1217  TYPE(t_grid), POINTER :: pgrid
1218 
1219 ! ******************************************************************************
1220 ! Start
1221 ! ******************************************************************************
1222 
1223  global => pregion%global
1224 
1225  CALL registerfunction(global,'PLAG_RFLU_CreateBuffersSend',&
1226  'PLAG_RFLU_ModComm.F90')
1227 
1228 ! ******************************************************************************
1229 ! Set pointers
1230 ! ******************************************************************************
1231 
1232  pgrid => pregion%grid
1233 
1234 ! ******************************************************************************
1235 ! Set dimensions
1236 ! Note: Add for the integer variable an additional value
1237 ! to account for cell mapping
1238 ! ******************************************************************************
1239 
1240  nvarsreal = 3*pregion%plag%nCv +pregion%plag%nArv
1241  nvarsint = pregion%plag%nAiv +1
1242 
1243 ! ******************************************************************************
1244 ! Loop over borders
1245 ! ******************************************************************************
1246 
1247  DO iborder = 1,pgrid%nBorders
1248  pborder => pgrid%borders(iborder)
1249 
1250  nvals = pborder%nPclsSend
1251 
1252  IF ( pborder%nPclsSend == 0 ) cycle
1253 
1254 ! ==============================================================================
1255 ! Allocate memory
1256 ! ==============================================================================
1257 
1258  ALLOCATE(pborder%plag%sendBuff(nvarsreal,nvals),stat=errorflag)
1259  global%error = errorflag
1260  IF ( global%error /= err_none ) THEN
1261  CALL errorstop(global,err_allocate,__line__,'pBorder%plag%sendBuff')
1262  END IF ! global%error
1263 
1264  ALLOCATE(pborder%plag%sendBuffInt(nvarsint,nvals),stat=errorflag)
1265  global%error = errorflag
1266  IF ( global%error /= err_none ) THEN
1267  CALL errorstop(global,err_allocate,__line__,'pBorder%plag%sendBuffInt')
1268  END IF ! global%error
1269 
1270  END DO ! iBorder
1271 
1272 ! ******************************************************************************
1273 ! End
1274 ! ******************************************************************************
1275 
1276  CALL deregisterfunction(global)
1277 
1278  END SUBROUTINE plag_rflu_createbufferssend
1279 
1280 
1281 
1282 
1283 
1284 
1285 
1286 
1287 
1288 ! ******************************************************************************
1289 !
1290 ! Purpose: Destroy receive buffers.
1291 !
1292 ! Description: None.
1293 !
1294 ! Input:
1295 ! pRegion Pointer to region
1296 !
1297 ! Output: None.
1298 !
1299 ! Notes: None.
1300 !
1301 ! ******************************************************************************
1302 
1303  SUBROUTINE plag_rflu_destroybuffersrecv(pRegion)
1304 
1305  IMPLICIT NONE
1306 
1307 ! ******************************************************************************
1308 ! Declarations and definitions
1309 ! ******************************************************************************
1310 
1311 ! ==============================================================================
1312 ! Arguments
1313 ! ==============================================================================
1314 
1315  TYPE(t_region), POINTER :: pregion
1316 
1317 ! ==============================================================================
1318 ! Local variables
1319 ! ==============================================================================
1320 
1321  INTEGER :: errorflag,iborder
1322  TYPE(t_border), POINTER :: pborder
1323  TYPE(t_global), POINTER :: global
1324  TYPE(t_grid), POINTER :: pgrid
1325 
1326 ! ******************************************************************************
1327 ! Start
1328 ! ******************************************************************************
1329 
1330  global => pregion%global
1331 
1332  CALL registerfunction(global,'PLAG_RFLU_DestroyBuffersRecv',&
1333  'PLAG_RFLU_ModComm.F90')
1334 
1335 ! IF ( global%myProcid == MASTERPROC .AND. &
1336 ! global%verbLevel > VERBOSE_NONE ) THEN
1337 ! WRITE(STDOUT,'(A,1X,A)') SOLVER_NAME,'Destroying receive buffers...'
1338 ! WRITE(STDOUT,'(A,3X,A,1X,I5.5)') SOLVER_NAME,'Global region:', &
1339 ! pRegion%iRegionGlobal
1340 ! END IF ! global%verbLevel
1341 
1342 ! ******************************************************************************
1343 ! Set pointers
1344 ! ******************************************************************************
1345 
1346  pgrid => pregion%grid
1347 
1348 ! ******************************************************************************
1349 ! Loop over borders
1350 ! ******************************************************************************
1351 
1352  DO iborder = 1,pgrid%nBorders
1353  pborder => pgrid%borders(iborder)
1354 
1355  IF ( pborder%nPclsRecv == 0 ) cycle
1356 
1357 ! ==============================================================================
1358 ! Deallocate memory
1359 ! ==============================================================================
1360 
1361  DEALLOCATE(pborder%plag%recvBuff,stat=errorflag)
1362  global%error = errorflag
1363  IF ( global%error /= err_none ) THEN
1364  CALL errorstop(global,err_deallocate,__line__,'pBorder%plag%recvBuff')
1365  END IF ! global%error
1366 
1367  DEALLOCATE(pborder%plag%recvBuffInt,stat=errorflag)
1368  global%error = errorflag
1369  IF ( global%error /= err_none ) THEN
1370  CALL errorstop(global,err_deallocate,__line__,'pBorder%plag%recvBuffInt')
1371  END IF ! global%error
1372 
1373  END DO ! iBorder
1374 
1375 ! ******************************************************************************
1376 ! End
1377 ! ******************************************************************************
1378 
1379  CALL deregisterfunction(global)
1380 
1381 ! IF ( global%myProcid == MASTERPROC .AND. &
1382 ! global%verbLevel > VERBOSE_NONE ) THEN
1383 ! WRITE(STDOUT,'(A,1X,A)') SOLVER_NAME,'Destroying receive buffers done.'
1384 ! END IF ! global%verbLevel
1385 
1386  END SUBROUTINE plag_rflu_destroybuffersrecv
1387 
1388 
1389 
1390 
1391 
1392 
1393 
1394 
1395 
1396 ! ******************************************************************************
1397 !
1398 ! Purpose: Destroy send buffers.
1399 !
1400 ! Description: None.
1401 !
1402 ! Input:
1403 ! pRegion Pointer to region
1404 !
1405 ! Output: None.
1406 !
1407 ! Notes: None.
1408 !
1409 ! ******************************************************************************
1410 
1411  SUBROUTINE plag_rflu_destroybufferssend(pRegion)
1412 
1413  IMPLICIT NONE
1414 
1415 ! ******************************************************************************
1416 ! Declarations and definitions
1417 ! ******************************************************************************
1418 
1419 ! ==============================================================================
1420 ! Arguments
1421 ! ==============================================================================
1422 
1423  TYPE(t_region), POINTER :: pregion
1424 
1425 ! ==============================================================================
1426 ! Local variables
1427 ! ==============================================================================
1428 
1429  INTEGER :: errorflag,iborder
1430  TYPE(t_border), POINTER :: pborder
1431  TYPE(t_global), POINTER :: global
1432  TYPE(t_grid), POINTER :: pgrid
1433 
1434 ! ******************************************************************************
1435 ! Start
1436 ! ******************************************************************************
1437 
1438  global => pregion%global
1439 
1440  CALL registerfunction(global,'PLAG_RFLU_DestroyBuffersSend',&
1441  'PLAG_RFLU_ModComm.F90')
1442 
1443 ! ******************************************************************************
1444 ! Set pointers
1445 ! ******************************************************************************
1446 
1447  pgrid => pregion%grid
1448 
1449 ! ******************************************************************************
1450 ! Loop over borders
1451 ! ******************************************************************************
1452 
1453  DO iborder = 1,pgrid%nBorders
1454  pborder => pgrid%borders(iborder)
1455 
1456  IF ( pborder%nPclsSend == 0 ) cycle
1457 
1458 ! ==============================================================================
1459 ! Deallocate memory
1460 ! ==============================================================================
1461 
1462  DEALLOCATE(pborder%plag%sendBuff,stat=errorflag)
1463  global%error = errorflag
1464  IF ( global%error /= err_none ) THEN
1465  CALL errorstop(global,err_deallocate,__line__,'pBorder%plag%sendBuff')
1466  END IF ! global%error
1467 
1468  DEALLOCATE(pborder%plag%sendBuffInt,stat=errorflag)
1469  global%error = errorflag
1470  IF ( global%error /= err_none ) THEN
1471  CALL errorstop(global,err_deallocate,__line__,'pBorder%plag%sendBuffInt')
1472  END IF ! global%error
1473 
1474  END DO ! iBorder
1475 
1476 ! ******************************************************************************
1477 ! End
1478 ! ******************************************************************************
1479 
1480  CALL deregisterfunction(global)
1481 
1482  END SUBROUTINE plag_rflu_destroybufferssend
1483 
1484 
1485 
1486 
1487 
1488 
1489 
1490 
1491 
1492 ! ******************************************************************************
1493 !
1494 ! Purpose: Initialize receive counter.
1495 !
1496 ! Description: None.
1497 !
1498 ! Input:
1499 ! pRegion Pointer to region
1500 !
1501 ! Output: None.
1502 !
1503 ! Notes: None.
1504 !
1505 ! ******************************************************************************
1506 
1507  SUBROUTINE plag_rflu_initrecvcounters(pRegion)
1508 
1509  IMPLICIT NONE
1510 
1511 ! ******************************************************************************
1512 ! Declarations and definitions
1513 ! ******************************************************************************
1514 
1515 ! ==============================================================================
1516 ! Arguments
1517 ! ==============================================================================
1518 
1519  TYPE(t_region), POINTER :: pregion
1520 
1521 ! ==============================================================================
1522 ! Local variables
1523 ! ==============================================================================
1524 
1525  INTEGER :: errorflag,iborder
1526  TYPE(t_border), POINTER :: pborder
1527  TYPE(t_global), POINTER :: global
1528  TYPE(t_grid), POINTER :: pgrid
1529 
1530 ! ******************************************************************************
1531 ! Start
1532 ! ******************************************************************************
1533 
1534  global => pregion%global
1535 
1536  CALL registerfunction(global,'PLAG_RFLU_InitRecvCounters',&
1537  'PLAG_RFLU_ModComm.F90')
1538 
1539 ! ******************************************************************************
1540 ! Set pointers
1541 ! ******************************************************************************
1542 
1543  pgrid => pregion%grid
1544 
1545 ! ******************************************************************************
1546 ! Initialize counter
1547 ! ******************************************************************************
1548 
1549  DO iborder = 1,pgrid%nBorders
1550  pborder => pgrid%borders(iborder)
1551  pborder%nPclsRecv = 0
1552  END DO ! iBorder
1553 
1554 ! ******************************************************************************
1555 ! End
1556 ! ******************************************************************************
1557 
1558  CALL deregisterfunction(global)
1559 
1560  END SUBROUTINE plag_rflu_initrecvcounters
1561 
1562 
1563 
1564 
1565 
1566 
1567 
1568 
1569 
1570 
1571 ! ******************************************************************************
1572 !
1573 ! Purpose: Initialize send counter.
1574 !
1575 ! Description: None.
1576 !
1577 ! Input:
1578 ! pRegion Pointer to region
1579 !
1580 ! Output: None.
1581 !
1582 ! Notes: None.
1583 !
1584 ! ******************************************************************************
1585 
1586  SUBROUTINE plag_rflu_initsendcounters(pRegion)
1587 
1588  IMPLICIT NONE
1589 
1590 ! ******************************************************************************
1591 ! Declarations and definitions
1592 ! ******************************************************************************
1593 
1594 ! ==============================================================================
1595 ! Arguments
1596 ! ==============================================================================
1597 
1598  TYPE(t_region), POINTER :: pregion
1599 
1600 ! ==============================================================================
1601 ! Local variables
1602 ! ==============================================================================
1603 
1604  INTEGER :: errorflag,iborder
1605  TYPE(t_border), POINTER :: pborder
1606  TYPE(t_global), POINTER :: global
1607  TYPE(t_grid), POINTER :: pgrid
1608 
1609 ! ******************************************************************************
1610 ! Start
1611 ! ******************************************************************************
1612 
1613  global => pregion%global
1614 
1615  CALL registerfunction(global,'PLAG_RFLU_InitSendCounters',&
1616  'PLAG_RFLU_ModComm.F90')
1617 
1618 ! ******************************************************************************
1619 ! Set pointers
1620 ! ******************************************************************************
1621 
1622  pgrid => pregion%grid
1623 
1624 ! ******************************************************************************
1625 ! Initialize counter
1626 ! ******************************************************************************
1627 
1628  DO iborder = 1,pgrid%nBorders
1629  pborder => pgrid%borders(iborder)
1630  pborder%nPclsSend = 0
1631  END DO ! iBorder
1632 
1633 ! ******************************************************************************
1634 ! End
1635 ! ******************************************************************************
1636 
1637  CALL deregisterfunction(global)
1638 
1639  END SUBROUTINE plag_rflu_initsendcounters
1640 
1641 
1642 
1643 
1644 
1645 
1646 
1647 
1648 
1649 ! ******************************************************************************
1650 !
1651 ! Purpose: Send counters.
1652 !
1653 ! Description: None.
1654 !
1655 ! Input:
1656 ! pRegion Pointer to region
1657 !
1658 ! Output: None.
1659 !
1660 ! Notes: None.
1661 !
1662 ! ******************************************************************************
1663 
1664  SUBROUTINE plag_rflu_isendcounters(pRegion)
1665 
1666  IMPLICIT NONE
1667 
1668 ! ******************************************************************************
1669 ! Declarations and definitions
1670 ! ******************************************************************************
1671 
1672 ! ==============================================================================
1673 ! Arguments
1674 ! ==============================================================================
1675 
1676  TYPE(t_region), POINTER :: pregion
1677 
1678 ! ==============================================================================
1679 ! Local variables
1680 ! ==============================================================================
1681 
1682  INTEGER :: errorflag,iborder,nvars,tag
1683 
1684  TYPE(t_border), POINTER :: pborder
1685  TYPE(t_global), POINTER :: global
1686  TYPE(t_grid), POINTER :: pgrid
1687 
1688 ! ******************************************************************************
1689 ! Start
1690 ! ******************************************************************************
1691 
1692  global => pregion%global
1693 
1694  CALL registerfunction(global,'PLAG_RFLU_ISendCounters',&
1695  'PLAG_RFLU_ModComm.F90')
1696 
1697 ! ******************************************************************************
1698 ! Set pointers
1699 ! ******************************************************************************
1700 
1701  pgrid => pregion%grid
1702 
1703  nvars = 1
1704 
1705 ! ******************************************************************************
1706 ! Loop over borders
1707 ! ******************************************************************************
1708 
1709  DO iborder = 1,pgrid%nBorders
1710  pborder => pgrid%borders(iborder)
1711 
1712 ! ==============================================================================
1713 ! Send counter if not on same processor
1714 ! ==============================================================================
1715 
1716  IF ( pborder%iProc /= global%myProcid ) THEN
1717  tag = pborder%plag%tagCount
1718 
1719  CALL mpi_isend(pborder%nPclsSend,nvars,mpi_integer,pborder%iProc,tag, &
1720  global%mpiComm,pborder%plag%sendRequestCount,errorflag)
1721 
1722  global%error = errorflag
1723  IF ( global%error /= err_none ) THEN
1724  CALL errorstop(global,err_mpi_output,__line__)
1725  END IF ! global%error
1726  END IF ! pBorder
1727  END DO ! iBorder
1728 
1729 ! ******************************************************************************
1730 ! End
1731 ! ******************************************************************************
1732 
1733  CALL deregisterfunction(global)
1734 
1735  END SUBROUTINE plag_rflu_isendcounters
1736 
1737 
1738 
1739 
1740 
1741 
1742 
1743 
1744 
1745 ! ******************************************************************************
1746 !
1747 ! Purpose: Send data buffers.
1748 !
1749 ! Description: None.
1750 !
1751 ! Input:
1752 ! pRegion Pointer to region
1753 !
1754 ! Output: None.
1755 !
1756 ! Notes: None.
1757 !
1758 ! ******************************************************************************
1759 
1760  SUBROUTINE plag_rflu_isenddata(pRegion)
1761 
1762  IMPLICIT NONE
1763 
1764 ! ******************************************************************************
1765 ! Declarations and definitions
1766 ! ******************************************************************************
1767 
1768 ! ==============================================================================
1769 ! Arguments
1770 ! ==============================================================================
1771 
1772  TYPE(t_region), POINTER :: pregion
1773 
1774 ! ==============================================================================
1775 ! Local variables
1776 ! ==============================================================================
1777 
1778  INTEGER :: errorflag,iborder,nbuffsint,nbuffsreal,nvals,nvarsint, &
1779  nvarsreal,tagint,tagreal
1780 
1781  TYPE(t_border), POINTER :: pborder
1782  TYPE(t_global), POINTER :: global
1783  TYPE(t_grid), POINTER :: pgrid
1784 
1785 ! ******************************************************************************
1786 ! Start
1787 ! ******************************************************************************
1788 
1789  global => pregion%global
1790 
1791  CALL registerfunction(global,'PLAG_RFLU_ISendData',&
1792  'PLAG_RFLU_ModComm.F90')
1793 
1794 ! ******************************************************************************
1795 ! Set pointers
1796 ! ******************************************************************************
1797 
1798  pgrid => pregion%grid
1799 
1800 ! ******************************************************************************
1801 ! Loop over borders
1802 ! ******************************************************************************
1803 
1804  DO iborder = 1,pgrid%nBorders
1805  pborder => pgrid%borders(iborder)
1806 
1807  IF ( pborder%nPclsSend == 0 ) cycle
1808 
1809  nvarsreal = SIZE(pborder%plag%sendBuff,1)
1810  nvarsint = SIZE(pborder%plag%sendBuffInt,1)
1811  nvals = SIZE(pborder%plag%sendBuff,2)
1812 
1813  nbuffsreal = nvarsreal *nvals
1814  nbuffsint = nvarsint *nvals
1815 
1816  IF ( nvals /= pborder%nPclsSend ) THEN
1817  CALL errorstop(global,err_datadim_mismatch,__line__)
1818  END IF ! nVarsSend
1819 
1820 ! ==============================================================================
1821 ! Send data if not on same processor and none null size
1822 ! ==============================================================================
1823 
1824  IF ( pborder%iProc /= global%myProcid ) THEN
1825 
1826 ! ------------------------------------------------------------------------------
1827 ! Integer data buffers
1828 ! ------------------------------------------------------------------------------
1829 
1830  tagint = pborder%plag%tagInt
1831 
1832  CALL mpi_isend(pborder%plag%sendBuffInt,nbuffsint,mpi_integer, &
1833  pborder%iProc,tagint,global%mpiComm, &
1834  pborder%plag%sendRequestInt,errorflag )
1835  global%error = errorflag
1836  IF ( global%error /= err_none ) THEN
1837  CALL errorstop(global,err_mpi_output,__line__)
1838  END IF ! global%error
1839 
1840 ! ------------------------------------------------------------------------------
1841 ! Real data buffers
1842 ! ------------------------------------------------------------------------------
1843 
1844  tagreal = pborder%plag%tag
1845 
1846  CALL mpi_isend(pborder%plag%sendBuff,nbuffsreal,mpi_rfreal, &
1847  pborder%iProc,tagreal,global%mpiComm, &
1848  pborder%plag%sendRequest,errorflag )
1849  global%error = errorflag
1850  IF ( global%error /= err_none ) THEN
1851  CALL errorstop(global,err_mpi_output,__line__)
1852  END IF ! global%error
1853 
1854  END IF ! pBorder
1855  END DO ! iBorder
1856 
1857 ! ******************************************************************************
1858 ! End
1859 ! ******************************************************************************
1860 
1861  CALL deregisterfunction(global)
1862 
1863  END SUBROUTINE plag_rflu_isenddata
1864 
1865 
1866 
1867 
1868 
1869 
1870 
1871 
1872 
1873 
1874 ! ******************************************************************************
1875 !
1876 ! Purpose: Load particle data into communication buffers
1877 !
1878 ! Description: None.
1879 !
1880 ! Input:
1881 ! pRegion Pointer to region
1882 !
1883 ! Output: None.
1884 !
1885 ! Notes: None.
1886 !
1887 ! ******************************************************************************
1888 
1889  SUBROUTINE plag_rflu_loadbufferssend(pRegion)
1890 
1891  IMPLICIT NONE
1892 
1893 ! ******************************************************************************
1894 ! Declarations and definitions
1895 ! ******************************************************************************
1896 
1897 ! ==============================================================================
1898 ! Arguments
1899 ! ==============================================================================
1900 
1901  TYPE(t_region), POINTER :: pregion
1902 
1903 ! ==============================================================================
1904 ! Local variables
1905 ! ==============================================================================
1906 
1907  INTEGER :: errorflag,iborder,icg,iloc,ipcl,ipcl2,ivar,ivarbuff,&
1908  naiv,narv,ncv
1909 
1910  TYPE(t_border), POINTER :: pborder
1911  TYPE(t_global), POINTER :: global
1912  TYPE(t_grid), POINTER :: pgrid
1913  TYPE(t_plag), POINTER :: pplag
1914 
1915 ! ******************************************************************************
1916 ! Start
1917 ! ******************************************************************************
1918 
1919  global => pregion%global
1920 
1921  CALL registerfunction(global,'PLAG_RFLU_LoadBuffersSend',&
1922  'PLAG_RFLU_ModComm.F90')
1923 
1924 ! ******************************************************************************
1925 ! Set pointers
1926 ! ******************************************************************************
1927 
1928  pgrid => pregion%grid
1929  pplag => pregion%plag
1930 
1931 ! ******************************************************************************
1932 ! Set dimensions
1933 ! Add for the integer variable an additional value
1934 ! to account for cell mapping
1935 ! ******************************************************************************
1936 
1937  naiv = pregion%plag%nAiv
1938  narv = pregion%plag%nArv
1939  ncv = pregion%plag%nCv
1940 
1941 ! ******************************************************************************
1942 ! Loop over borders
1943 ! ******************************************************************************
1944 
1945  DO iborder = 1,pgrid%nBorders
1946  pborder => pgrid%borders(iborder)
1947 
1948  IF ( pborder%nPclsSend == 0 ) cycle
1949 
1950 ! ==============================================================================
1951 ! Load send buffers from particle datastructure
1952 ! ==============================================================================
1953 
1954  DO ipcl = 1,pborder%nPclsSend
1955 
1956 ! ------------------------------------------------------------------------------
1957 ! Get particle and cell mappings
1958 ! ------------------------------------------------------------------------------
1959 
1960  ipcl2 = pborder%iPclSend(1,ipcl)
1961 
1962  IF ( pplag%aiv(aiv_plag_status,ipcl2) /= plag_status_comm ) THEN
1963  WRITE(*,*) ' PLAG_RFLU_LoadBuffersSend: PLAG_STATUS Mismatch'
1964  WRITE(*,*) ' iPcl2 = ',ipcl2
1965  WRITE(*,*) ' aivStatus = ' , pplag%aiv(aiv_plag_status,ipcl2)
1966 !TO DO CALL ErrorStop(global,ERR_STATUS_MISMATCH,__LINE__)
1967  ENDIF ! aiv
1968 
1969  icg = pplag%aiv(aiv_plag_icells,ipcl2)
1970 
1971  IF ( icg < pgrid%nCells+1 ) THEN
1972  WRITE(*,*) ' PLAG_RFLU_LoadBuffersSend: Cell Bound Mismatch'
1973  WRITE(*,*) ' icg = ',icg
1974  WRITE(*,*) ' nCells+1 = ' , pgrid%nCells+1
1975  stop
1976 !TO DO CALL ErrorStop(global,ERR_CELLBOUND_MISMATCH,__LINE__)
1977  ENDIF ! icg
1978 
1979 ! ------------------------------------------------------------------------------
1980 ! Load array location
1981 ! ------------------------------------------------------------------------------
1982 
1983  iloc = pborder%iPclSend(2,ipcl)
1984 
1985  IF ( iloc > pborder%nCellsRecv ) THEN
1986  WRITE(*,*) ' PLAG_RFLU_LoadBuffersSend: Cell Bound Mismatch on Recv Side'
1987  WRITE(*,*) ' iLoc = ',iloc
1988  WRITE(*,*) ' nCellsRecv = ' , pborder%nCellsRecv
1989  stop
1990 !TO DO CALL ErrorStop(global,ERR_CELLBOUND_MISMATCH,__LINE__)
1991  ENDIF ! iLoc
1992 
1993 ! ------------------------------------------------------------------------------
1994 ! Load communication buffers for real data
1995 ! ------------------------------------------------------------------------------
1996 
1997  ivarbuff = 0
1998 
1999  DO ivar = 1,ncv
2000  ivarbuff = ivarbuff+1
2001  pborder%plag%sendBuff(ivarbuff,ipcl) = pplag%cv(ivar,ipcl2)
2002  END DO ! iVar
2003 
2004  DO ivar = 1,ncv
2005  ivarbuff = ivarbuff+1
2006  pborder%plag%sendBuff(ivarbuff,ipcl) = pplag%cvOld(ivar,ipcl2)
2007  END DO ! iVar
2008 
2009  DO ivar = 1,ncv
2010  ivarbuff = ivarbuff+1
2011  pborder%plag%sendBuff(ivarbuff,ipcl) = pplag%rhsSum(ivar,ipcl2)
2012  END DO ! iVar
2013 
2014  DO ivar = 1,narv
2015  ivarbuff = ivarbuff+1
2016  pborder%plag%sendBuff(ivarbuff,ipcl) = pplag%arv(ivar,ipcl2)
2017  END DO ! iVar
2018 
2019 ! ------------------------------------------------------------------------------
2020 ! Load communication buffers for integer data
2021 ! ------------------------------------------------------------------------------
2022 
2023  DO ivar = 1,naiv
2024  pborder%plag%sendBuffInt(ivar,ipcl) = pplag%aiv(ivar,ipcl2)
2025  END DO ! iVar
2026 
2027  pborder%plag%sendBuffInt(naiv+1,ipcl) = iloc
2028 
2029 ! ------------------------------------------------------------------------------
2030 ! Overwrite status arrays
2031 ! ------------------------------------------------------------------------------
2032 
2033  pborder%plag%sendBuffInt(aiv_plag_status,ipcl ) = plag_status_keep
2034  pplag%aiv(aiv_plag_status,ipcl2) = plag_status_delete
2035 
2036  END DO ! iPcl
2037  END DO ! iBorder
2038 
2039 ! ******************************************************************************
2040 ! End
2041 ! ******************************************************************************
2042 
2043  CALL deregisterfunction(global)
2044 
2045  END SUBROUTINE plag_rflu_loadbufferssend
2046 
2047 
2048 
2049 
2050 
2051 
2052 
2053 
2054 
2055 
2056 
2057 ! ******************************************************************************
2058 !
2059 ! Purpose: Receive counters.
2060 !
2061 ! Description: None.
2062 !
2063 ! Input:
2064 ! pRegion Pointer to region
2065 !
2066 ! Output: None.
2067 !
2068 ! Notes: None.
2069 !
2070 ! ******************************************************************************
2071 
2072  SUBROUTINE plag_rflu_recvcounters(pRegion)
2073 
2074  IMPLICIT NONE
2075 
2076 ! ******************************************************************************
2077 ! Declarations and definitions
2078 ! ******************************************************************************
2079 
2080 ! ==============================================================================
2081 ! Arguments
2082 ! ==============================================================================
2083 
2084  TYPE(t_region), POINTER :: pregion
2085 
2086 ! ==============================================================================
2087 ! Local variables
2088 ! ==============================================================================
2089 
2090  INTEGER :: errorflag,iborder,nvars,tag
2091  INTEGER :: status(mpi_status_size)
2092 
2093  TYPE(t_border), POINTER :: pborder
2094  TYPE(t_global), POINTER :: global
2095  TYPE(t_grid), POINTER :: pgrid
2096 
2097 ! ******************************************************************************
2098 ! Start
2099 ! ******************************************************************************
2100 
2101  global => pregion%global
2102 
2103  CALL registerfunction(global,'PLAG_RFLU_RecvCounters',&
2104  'PLAG_RFLU_ModComm.F90')
2105 
2106 ! ******************************************************************************
2107 ! Set pointers
2108 ! ******************************************************************************
2109 
2110  pgrid => pregion%grid
2111 
2112  nvars = 1
2113 
2114 ! ******************************************************************************
2115 ! Loop over borders
2116 ! ******************************************************************************
2117 
2118  DO iborder = 1,pgrid%nBorders
2119  pborder => pgrid%borders(iborder)
2120 
2121 ! ==============================================================================
2122 ! Receive data if not on same process
2123 ! ==============================================================================
2124 
2125  IF ( pborder%iProc /= global%myProcid ) THEN
2126  tag = pborder%plag%tagCount
2127 
2128  CALL mpi_recv(pborder%nPclsRecv,nvars,mpi_integer,pborder%iProc,tag, &
2129  global%mpiComm,status,errorflag)
2130  global%error = errorflag
2131  IF ( global%error /= err_none ) THEN
2132  CALL errorstop(global,err_mpi_output,__line__)
2133  END IF ! global%error
2134 
2135  END IF ! pBorder
2136  END DO ! iBorder
2137 
2138 ! ******************************************************************************
2139 ! End
2140 ! ******************************************************************************
2141 
2142  CALL deregisterfunction(global)
2143 
2144  END SUBROUTINE plag_rflu_recvcounters
2145 
2146 
2147 
2148 
2149 
2150 
2151 ! ******************************************************************************
2152 !
2153 ! Purpose: Receive data buffers.
2154 !
2155 ! Description: None.
2156 !
2157 ! Input:
2158 ! pRegion Pointer to region
2159 !
2160 ! Output: None.
2161 !
2162 ! Notes: None.
2163 !
2164 ! ******************************************************************************
2165 
2166  SUBROUTINE plag_rflu_recvdata(pRegion)
2167 
2168  IMPLICIT NONE
2169 
2170 ! ******************************************************************************
2171 ! Declarations and definitions
2172 ! ******************************************************************************
2173 
2174 ! ==============================================================================
2175 ! Arguments
2176 ! ==============================================================================
2177 
2178  TYPE(t_region), POINTER :: pregion
2179 
2180 ! ==============================================================================
2181 ! Local variables
2182 ! ==============================================================================
2183 
2184  INTEGER :: errorflag,iborder,nbuffsint,nbuffsreal,nvals,nvarsint, &
2185  nvarsreal,tagint,tagreal
2186  INTEGER :: status(mpi_status_size),statusint(mpi_status_size)
2187 
2188  TYPE(t_border), POINTER :: pborder
2189  TYPE(t_global), POINTER :: global
2190  TYPE(t_grid), POINTER :: pgrid
2191 
2192 ! ******************************************************************************
2193 ! Start
2194 ! ******************************************************************************
2195 
2196  global => pregion%global
2197 
2198  CALL registerfunction(global,'PLAG_RFLU_RecvData',&
2199  'PLAG_RFLU_ModComm.F90')
2200 
2201 ! ******************************************************************************
2202 ! Set pointers
2203 ! ******************************************************************************
2204 
2205  pgrid => pregion%grid
2206 
2207 ! ******************************************************************************
2208 ! Loop over borders
2209 ! ******************************************************************************
2210 
2211  DO iborder = 1,pgrid%nBorders
2212  pborder => pgrid%borders(iborder)
2213 
2214  IF ( pborder%nPclsRecv == 0 ) cycle
2215 
2216  nvarsreal = SIZE(pborder%plag%recvBuff,1)
2217  nvarsint = SIZE(pborder%plag%recvBuffInt,1)
2218  nvals = SIZE(pborder%plag%recvBuff,2)
2219 
2220  nbuffsreal = nvarsreal *nvals
2221  nbuffsint = nvarsint *nvals
2222 
2223  IF ( nvals /= pborder%nPclsRecv ) THEN
2224  CALL errorstop(global,err_datadim_mismatch,__line__)
2225  END IF ! nVarsSend
2226 
2227 ! ==============================================================================
2228 ! Receive data if not on same process
2229 ! ==============================================================================
2230 
2231  IF ( pborder%iProc /= global%myProcid ) THEN
2232 
2233 ! ------------------------------------------------------------------------------
2234 ! Integer data buffers
2235 ! ------------------------------------------------------------------------------
2236 
2237  tagint = pborder%plag%tagInt
2238 
2239  CALL mpi_recv(pborder%plag%recvBuffInt,nbuffsint,mpi_integer, &
2240  pborder%iProc,tagint,global%mpiComm,statusint,errorflag )
2241  global%error = errorflag
2242  IF ( global%error /= err_none ) THEN
2243  CALL errorstop(global,err_mpi_output,__line__)
2244  END IF ! global%error
2245 
2246 ! ------------------------------------------------------------------------------
2247 ! Real data buffers
2248 ! ------------------------------------------------------------------------------
2249 
2250  tagreal = pborder%plag%tag
2251 
2252  CALL mpi_recv(pborder%plag%recvBuff,nbuffsreal,mpi_rfreal, &
2253  pborder%iProc,tagreal,global%mpiComm,status,errorflag )
2254  global%error = errorflag
2255  IF ( global%error /= err_none ) THEN
2256  CALL errorstop(global,err_mpi_output,__line__)
2257  END IF ! global%error
2258 
2259  END IF ! pBorder
2260  END DO ! iBorder
2261 
2262 ! ******************************************************************************
2263 ! End
2264 ! ******************************************************************************
2265 
2266  CALL deregisterfunction(global)
2267 
2268  END SUBROUTINE plag_rflu_recvdata
2269 
2270 
2271 
2272 
2273 
2274 
2275 
2276 ! ******************************************************************************
2277 !
2278 ! Purpose: Calculate the total number of particles to be communicated
2279 ! for all regions on all processors.
2280 !
2281 ! Description: First determine the total number of particles for all regions
2282 ! on the same processors.
2283 !
2284 ! Input:
2285 ! regions Data of all regions
2286 !
2287 ! Output: None.
2288 !
2289 ! Notes: None.
2290 !
2291 ! ******************************************************************************
2292 
2293  SUBROUTINE plag_rflu_totalnpclscomm(regions)
2294 
2295  IMPLICIT NONE
2296 
2297 ! ******************************************************************************
2298 ! Declarations and definitions
2299 ! ******************************************************************************
2300 
2301 ! ==============================================================================
2302 ! Arguments
2303 ! ==============================================================================
2304 
2305  TYPE(t_region), POINTER :: regions(:)
2306 
2307 ! ==============================================================================
2308 ! Local variables
2309 ! ==============================================================================
2310 
2311  INTEGER :: errorflag,iborder,ireg,iregglobal,npclscommglobal,&
2312  npclscommlocal,npclscommtot
2313 
2314  TYPE(t_border), POINTER :: pborder
2315  TYPE(t_global), POINTER :: global
2316  TYPE(t_grid), POINTER :: pgrid
2317  TYPE(t_region), POINTER :: pregion
2318 
2319 ! ******************************************************************************
2320 ! Start
2321 ! ******************************************************************************
2322 
2323  global => regions(0)%global
2324 
2325  CALL registerfunction(global,'PLAG_RFLU_TotalnPclsComm',&
2326  'PLAG_RFLU_ModComm.F90')
2327 
2328 ! ******************************************************************************
2329 ! Initialize variables
2330 ! ******************************************************************************
2331 
2332  npclscommlocal = 0
2333 
2334  DO ireg = 0,global%nRegionsLocal
2335  pregion => regions(ireg)
2336  pregion%global%nPclsCommTot = 0
2337  END DO ! iReg
2338 
2339 ! ******************************************************************************
2340 ! Compute sum of communicated particle for all regions on the same processor
2341 ! ******************************************************************************
2342 
2343  DO ireg = 0,global%nRegionsLocal
2344  pregion => regions(ireg)
2345  pgrid => pregion%grid
2346 
2347  iregglobal = pregion%iRegionGlobal
2348 
2349  DO iborder = 1,pgrid%nBorders
2350  pborder => pgrid%borders(iborder)
2351 
2352  npclscommlocal = npclscommlocal + pborder%nPclsSend
2353  END DO ! iBorder
2354  END DO ! iReg
2355 
2356 ! ******************************************************************************
2357 ! Determine global sum of particle communicated over all processors
2358 ! ******************************************************************************
2359 
2360 ! ==============================================================================
2361 ! Perform reduction operation. NOTE need to include region index 0
2362 ! to make sure that this works properly for serial runs.
2363 ! ==============================================================================
2364 
2365  CALL mpi_allreduce(npclscommlocal,npclscommglobal,1, &
2366  mpi_integer,mpi_sum,global%mpiComm,errorflag )
2367  global%error = errorflag
2368  IF ( global%error /= err_none ) THEN
2369  CALL errorstop(global,err_mpi_trouble,__line__)
2370  END IF ! global%errorFlag
2371 
2372 ! ==============================================================================
2373 ! Store the global sum of communicated particles
2374 ! ==============================================================================
2375 
2376  DO ireg = 0,global%nRegionsLocal
2377  pregion => regions(ireg)
2378 
2379  pregion%global%nPclsCommTot = npclscommglobal
2380  global%nPclsCommTot = npclscommglobal
2381  END DO ! iReg
2382 
2383 ! ******************************************************************************
2384 ! Print information
2385 ! ******************************************************************************
2386 
2387 ! TEMPORARY
2388 ! IF ( global%myProcid == MASTERPROC .AND. &
2389 ! global%verbLevel > VERBOSE_LOW .AND. &
2390 ! global%nPclsCommTot /= 0 ) THEN
2391 ! WRITE(STDOUT,'(A,1X,A)') &
2392 ! SOLVER_NAME,'Printing total communicated particles information...'
2393 ! WRITE(STDOUT,'(A,3X,A,1X,I8)') &
2394 ! SOLVER_NAME,'Total communicated particles:',global%nPclsCommTot
2395 ! WRITE(STDOUT,'(A,1X,A)') &
2396 ! SOLVER_NAME,'Printing total communicated particles information done.'
2397 ! END IF ! global%myProcid
2398 ! END TEMPORARY
2399 
2400 ! ******************************************************************************
2401 ! End
2402 ! ******************************************************************************
2403 
2404  CALL deregisterfunction(global)
2405 
2406  END SUBROUTINE plag_rflu_totalnpclscomm
2407 
2408 
2409 
2410 
2411 
2412 
2413 
2414 ! ******************************************************************************
2415 !
2416 ! Purpose: Unload communication buffers into particle datastructure.
2417 !
2418 ! Description: None.
2419 !
2420 ! Input:
2421 ! pRegion Pointer to region
2422 !
2423 ! Output: None.
2424 !
2425 ! Notes: None.
2426 !
2427 ! ******************************************************************************
2428 
2429  SUBROUTINE plag_rflu_unloadbuffersrecv(pRegion)
2430 
2431  IMPLICIT NONE
2432 
2433 ! ******************************************************************************
2434 ! Declarations and definitions
2435 ! ******************************************************************************
2436 
2437 ! ==============================================================================
2438 ! Arguments
2439 ! ==============================================================================
2440 
2441  TYPE(t_region), POINTER :: pregion
2442 
2443 ! ==============================================================================
2444 ! Local variables
2445 ! ==============================================================================
2446 
2447  INTEGER :: errorflag,iborder,icg,iloc,ipcl,ipcl2,ivar,ivarbuff,naiv,narv,&
2448  ncv,npclssend
2449 
2450  TYPE(t_border), POINTER :: pborder
2451  TYPE(t_global), POINTER :: global
2452  TYPE(t_grid), POINTER :: pgrid
2453  TYPE(t_plag), POINTER :: pplag
2454 
2455 ! ******************************************************************************
2456 ! Start
2457 ! ******************************************************************************
2458 
2459  global => pregion%global
2460 
2461  CALL registerfunction(global,'PLAG_RFLU_UnloadBuffersRecv',&
2462  'PLAG_RFLU_ModComm.F90')
2463 
2464 ! ******************************************************************************
2465 ! Set pointers
2466 ! ******************************************************************************
2467 
2468  pgrid => pregion%grid
2469  pplag => pregion%plag
2470 
2471 ! ******************************************************************************
2472 ! Set dimensions
2473 ! Add for the integer variable an additional value
2474 ! to account for cell mapping
2475 ! ******************************************************************************
2476 
2477  naiv = pregion%plag%nAiv
2478  narv = pregion%plag%nArv
2479  ncv = pregion%plag%nCv
2480 
2481  ipcl2 = pplag%nPcls
2482 
2483 ! ******************************************************************************
2484 ! Loop over borders
2485 ! ******************************************************************************
2486 
2487  DO iborder = 1,pgrid%nBorders
2488  pborder => pgrid%borders(iborder)
2489 
2490  IF ( pborder%nPclsRecv == 0 ) cycle
2491 
2492 ! ==============================================================================
2493 ! Append particle datastructure with receive buffers
2494 ! ==============================================================================
2495 
2496  DO ipcl = 1,pborder%nPclsRecv
2497  ipcl2 = ipcl2 +1
2498 
2499 ! ------------------------------------------------------------------------------
2500 ! Load array location and get mapping
2501 ! ------------------------------------------------------------------------------
2502 
2503  iloc = pborder%plag%recvBuffInt(naiv+1,ipcl)
2504 
2505  IF ( iloc > pborder%nCellsSend ) THEN
2506  WRITE(*,*) ' PLAG_RFLU_UnloadBuffersRecv: Cell Bound Mismatch on Send Side'
2507  WRITE(*,*) ' iLoc = ',iloc
2508  WRITE(*,*) ' nCellsSend = ' , pborder%nCellsSend
2509  stop
2510 !TO DO CALL ErrorStop(global,ERR_CELLBOUND_MISMATCH,__LINE__)
2511  ENDIF ! iLoc
2512 
2513  icg = pborder%icgSend(iloc)
2514 
2515 ! ------------------------------------------------------------------------------
2516 ! Load data structure from communication buffers for real data
2517 ! ------------------------------------------------------------------------------
2518 
2519  ivarbuff = 0
2520 
2521  DO ivar = 1,ncv
2522  ivarbuff = ivarbuff+1
2523  pplag%cv(ivar,ipcl2) = pborder%plag%recvBuff(ivarbuff,ipcl)
2524  END DO ! iVar
2525 
2526  DO ivar = 1,ncv
2527  ivarbuff = ivarbuff+1
2528  pplag%cvOld(ivar,ipcl2) = pborder%plag%recvBuff(ivarbuff,ipcl)
2529  END DO ! iVar
2530 
2531  DO ivar = 1,ncv
2532  ivarbuff = ivarbuff+1
2533  pplag%rhsSum(ivar,ipcl2) = pborder%plag%recvBuff(ivarbuff,ipcl)
2534  END DO ! iVar
2535 
2536  DO ivar = 1,narv
2537  ivarbuff = ivarbuff+1
2538  pplag%arv(ivar,ipcl2) = pborder%plag%recvBuff(ivarbuff,ipcl)
2539  END DO ! iVar
2540 
2541 ! ------------------------------------------------------------------------------
2542 ! Load data structure from communication buffers for integer data
2543 ! aivOld is needed for proper trajectory tracking
2544 ! ------------------------------------------------------------------------------
2545 
2546  DO ivar = 1,naiv
2547  pplag%aiv(ivar,ipcl2) = pborder%plag%recvBuffInt(ivar,ipcl)
2548  END DO ! iVar
2549 
2550  pplag%aiv(aiv_plag_icells,ipcl2) = icg
2551  pplag%aivOld(aiv_plag_icells,ipcl2) = icg
2552  END DO ! iPcl
2553  END DO ! iBorder
2554 
2555 ! ******************************************************************************
2556 ! Update particle size
2557 ! ******************************************************************************
2558 
2559  pregion%plag%nPcls = ipcl2
2560 
2561 ! ******************************************************************************
2562 ! End
2563 ! ******************************************************************************
2564 
2565  CALL deregisterfunction(global)
2566 
2567  END SUBROUTINE plag_rflu_unloadbuffersrecv
2568 
2569 
2570 
2571 
2572 
2573 
2574 
2575 
2576 ! ******************************************************************************
2577 ! End
2578 ! ******************************************************************************
2579 
2580 END MODULE plag_rflu_modcomm
2581 
2582 
2583 ! ******************************************************************************
2584 !
2585 ! RCS Revision history:
2586 !
2587 ! $Log: PLAG_RFLU_ModComm.F90,v $
2588 ! Revision 1.11 2008/12/06 08:44:35 mtcampbe
2589 ! Updated license.
2590 !
2591 ! Revision 1.10 2008/11/19 22:17:48 mtcampbe
2592 ! Added Illinois Open Source License/Copyright
2593 !
2594 ! Revision 1.9 2006/08/18 21:10:34 fnajjar
2595 ! Added PROF calls, enabled serial periodicity, cosmetics
2596 !
2597 ! Revision 1.8 2006/04/07 15:19:24 haselbac
2598 ! Removed tabs
2599 !
2600 ! Revision 1.7 2005/12/30 16:29:02 fnajjar
2601 ! Cosmetic cleanups, streamlined nPclsTotComm routine and added call to CalcDv for proper datastruc defs
2602 !
2603 ! Revision 1.6 2005/12/19 16:46:31 fnajjar
2604 ! Bug fix for proper calling of PLAG_UpdateDataStruc
2605 !
2606 ! Revision 1.5 2005/12/13 23:10:47 fnajjar
2607 ! Major bugs fixes for clear requests, tags and computing communicated particles, and removed debug statements
2608 !
2609 ! Revision 1.4 2005/11/10 22:24:27 fnajjar
2610 ! Removed DEBUG STOP
2611 !
2612 ! Revision 1.3 2005/07/18 20:48:54 fnajjar
2613 ! Added MPI routines and started initial testing
2614 !
2615 ! Revision 1.2 2005/05/27 00:57:43 haselbac
2616 ! Fixed bug in clearing requests
2617 !
2618 ! Revision 1.1 2005/05/18 22:27:45 fnajjar
2619 ! Initial revision
2620 !
2621 ! ******************************************************************************
2622 
2623 
2624 
2625 
2626 
2627 
2628 
2629 
2630 
2631 
2632 
2633 
2634 
2635 
2636 
2637 
2638 
2639 
2640 
2641 
2642 
2643 
2644 
2645 
2646 
2647 
plag_rflu_modcomm::plag_rflu_copycounters
subroutine plag_rflu_copycounters(regions)
Definition: PLAG_RFLU_ModComm.F90:701
plag_rflu_modcomm::plag_rflu_destroybufferssend
subroutine plag_rflu_destroybufferssend(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1411
plag_rflu_modcomm::plag_rflu_clearrequest
subroutine plag_rflu_clearrequest(global, request)
Definition: PLAG_RFLU_ModComm.F90:106
plag_rflu_modfindcells::plag_rflu_findcellstrajfast
subroutine, public plag_rflu_findcellstrajfast(pRegion, iPclBeg, iPclEnd)
Definition: PLAG_RFLU_ModFindCells.F90:1286
plag_rflu_modcomm::plag_rflu_initrecvcounters
subroutine plag_rflu_initrecvcounters(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1507
plag_rflu_modcomm::plag_rflu_destroybuffersrecv
subroutine plag_rflu_destroybuffersrecv(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1303
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Attribute::status
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
plag_rflu_modcomm::plag_rflu_recvdata
subroutine plag_rflu_recvdata(pRegion)
Definition: PLAG_RFLU_ModComm.F90:2166
modgrid::t_grid
Definition: ModGrid.F90:56
plag_rflu_modcomm::plag_rflu_unloadbuffersrecv
subroutine plag_rflu_unloadbuffersrecv(pRegion)
Definition: PLAG_RFLU_ModComm.F90:2429
plag_rflu_modcomm::plag_rflu_totalnpclscomm
subroutine plag_rflu_totalnpclscomm(regions)
Definition: PLAG_RFLU_ModComm.F90:2293
plag_rflu_modcomm::plag_rflu_copydataint
subroutine plag_rflu_copydataint(global, pclData, pclData2)
Definition: PLAG_RFLU_ModComm.F90:908
plag_rflu_modfindcells
Definition: PLAG_RFLU_ModFindCells.F90:39
plag_rflu_modcomm::plag_rflu_initsendcounters
subroutine, public plag_rflu_initsendcounters(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1586
plag_rflu_modcomm::plag_rflu_copydatareal
subroutine plag_rflu_copydatareal(global, pclData, pclData2)
Definition: PLAG_RFLU_ModComm.F90:996
RFC_Data_const::tag
Tag tag() const
Definition: RFC_Window_transfer.h:271
modpartlag::t_plag
Definition: ModPartLag.F90:124
plag_rflu_modcomm::plag_rflu_createbuffersrecv
subroutine plag_rflu_createbuffersrecv(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1087
plag_rflu_modcomm::plag_rflu_clearrequestwrapper
subroutine plag_rflu_clearrequestwrapper(pRegion, iReqFlag)
Definition: PLAG_RFLU_ModComm.F90:179
plag_rflu_modcomm::plag_rflu_isendcounters
subroutine plag_rflu_isendcounters(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1664
plag_rflu_modcomm::plag_rflu_commdriver
subroutine, public plag_rflu_commdriver(regions)
Definition: PLAG_RFLU_ModComm.F90:274
plag_rflu_modcomm::plag_rflu_recvcounters
subroutine plag_rflu_recvcounters(pRegion)
Definition: PLAG_RFLU_ModComm.F90:2072
plag_rflu_modcomm::plag_rflu_createbufferssend
subroutine plag_rflu_createbufferssend(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1196
modmixture::t_mixt_input
Definition: ModMixture.F90:46
plag_calcderivedvariables
subroutine plag_calcderivedvariables(region)
Definition: PLAG_CalcDerivedVariables.F90:43
plag_modinterfaces
Definition: PLAG_ModInterfaces.F90:39
plag_modreallocatememory
Definition: PLAG_ModReallocateMemory.F90:39
modborder::t_border
Definition: ModBorder.F90:55
rflu_decideprint
LOGICAL function rflu_decideprint(global)
Definition: RFLU_DecidePrint.F90:46
nvals
**********************************************************************Rocstar Simulation Suite Illinois Rocstar LLC All rights reserved ****Illinois Rocstar LLC IL **www illinoisrocstar com **sales illinoisrocstar com WITHOUT WARRANTY OF ANY **EXPRESS OR INCLUDING BUT NOT LIMITED TO THE WARRANTIES **OF FITNESS FOR A PARTICULAR PURPOSE AND **NONINFRINGEMENT IN NO EVENT SHALL THE CONTRIBUTORS OR **COPYRIGHT HOLDERS BE LIABLE FOR ANY DAMAGES OR OTHER WHETHER IN AN ACTION OF TORT OR **Arising OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE **USE OR OTHER DEALINGS WITH THE SOFTWARE **********************************************************************INTERFACE USE ModDataTypes USE nvals
Definition: ReadPatchSection.h:3
modglobal::t_global
Definition: ModGlobal.F90:50
plag_rflu_modcomm::plag_rflu_loadbufferssend
subroutine plag_rflu_loadbufferssend(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1889
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
modborder::t_border_data
Definition: ModBorder.F90:49
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
plag_modparameters
Definition: PLAG_ModParameters.F90:44
plag_rflu_modcomm
Definition: PLAG_RFLU_ModComm.F90:39
plag_rflu_modcomm::plag_rflu_isenddata
subroutine plag_rflu_isenddata(pRegion)
Definition: PLAG_RFLU_ModComm.F90:1760
plag_rflu_modcomm::plag_rflu_copydata
subroutine plag_rflu_copydata(regions)
Definition: PLAG_RFLU_ModComm.F90:789
plag_modreallocatememory::plag_reallocmemwrapper
subroutine, public plag_reallocmemwrapper(pRegion)
Definition: PLAG_ModReallocateMemory.F90:485
modpartlag::t_plag_input
Definition: ModPartLag.F90:59
plag_rflu_modfindcells::plag_rflu_findcellstrajsafe
subroutine, public plag_rflu_findcellstrajsafe(pRegion, iPclBeg, iPclEnd)
Definition: PLAG_RFLU_ModFindCells.F90:1659