Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_ClearSizeSendRequests.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: wait until data is received by other processors
26 ! communicating with the current region.
27 !
28 ! Description: none.
29 !
30 ! Input: regions = data of all regions
31 ! iReg = index of current region.
32 !
33 ! Output: None.
34 !
35 ! Notes: None.
36 !
37 !******************************************************************************
38 !
39 ! $Id: PLAG_ClearSizeSendRequests.F90,v 1.3 2008/12/06 08:44:33 mtcampbe Exp $
40 !
41 ! Copyright: (c) 2003 by the University of Illinois
42 !
43 !******************************************************************************
44 
45 SUBROUTINE plag_clearsizesendrequests( regions, iReg )
46 
47  USE moddatatypes
48  USE modpartlag, ONLY : t_buffer_plag
49  USE modbndpatch, ONLY : t_patch
50  USE moddatastruct, ONLY : t_region
51  USE modglobal, ONLY : t_global
52  USE modpartlag, ONLY : t_plag
53  USE moderror
54  USE modmpi
55  USE modparameters
56  IMPLICIT NONE
57 
58 ! ... parameters
59  TYPE(t_region), POINTER :: regions(:)
60 
61  INTEGER :: ireg
62 
63 ! ... loop variables
64  INTEGER :: ipatch
65 
66 ! ... local variables
67  CHARACTER(CHRLEN) :: rcsidentstring
68 
69 #ifdef MPI
70  INTEGER :: statusplag(mpi_status_size)
71 #endif
72 
73  INTEGER :: bctype, ilev, iregdes, irequestplag, npatches
74 
75  LOGICAL :: dowait
76 
77  TYPE(t_patch), POINTER :: patch
78  TYPE(t_plag), POINTER :: pplag
79  TYPE(t_global), POINTER :: global
80 
81 !******************************************************************************
82 
83  rcsidentstring = '$RCSfile: PLAG_ClearSizeSendRequests.F90,v $ $Revision: 1.3 $'
84 
85  global => regions(1)%global
86 
87  CALL registerfunction( global,'PLAG_ClearSizeSendRequests',&
88  'PLAG_ClearSizeSendRequests.F90' )
89 
90 #ifdef MPI
91 
92 ! get dimensions --------------------------------------------------------------
93 
94  ilev = regions(ireg)%currLevel
95  npatches = regions(ireg)%nPatches
96 
97  pplag => regions(ireg)%levels(ilev)%plag
98 
99  DO ipatch = 1, npatches
100  patch => regions(ireg)%levels(ilev)%patches(ipatch)
101 
102  bctype = patch%bcType
103  iregdes = patch%srcRegion
104  irequestplag = patch%bufferPlag%iRequest
105 
106 ! - region interface, periodic boundary ---------------------------------------
107 
108  dowait = ((bctype>=bc_regionconf .AND. bctype<=bc_regionconf+bc_range) .OR. &
109  (bctype>=bc_regionint .AND. bctype<=bc_regionint +bc_range) .OR. &
110  (bctype>=bc_regnonconf .AND. bctype<=bc_regnonconf+bc_range) .OR. &
111  (bctype>=bc_tra_peri .AND. bctype<=bc_tra_peri +bc_range) .OR. &
112  (bctype>=bc_rot_peri .AND. bctype<=bc_rot_peri +bc_range))
113 
114  IF (iregdes > 0) THEN
115  IF (dowait .AND. (regions(iregdes)%procid /= global%myProcid)) THEN
116  CALL mpi_wait( pplag%requests(irequestplag), statusplag, global%mpierr )
117  IF (global%mpierr /= err_none) &
118  CALL errorstop( global,err_mpi_trouble,__line__ )
119  ENDIF ! doWait
120  ENDIF ! iRegDes
121 
122  ENDDO ! iPatch
123 
124 #endif
125 
126 ! finalize --------------------------------------------------------------------
127 
128  CALL deregisterfunction( global )
129 
130 END SUBROUTINE plag_clearsizesendrequests
131 
132 !******************************************************************************
133 !
134 ! RCS Revision history:
135 !
136 ! $Log: PLAG_ClearSizeSendRequests.F90,v $
137 ! Revision 1.3 2008/12/06 08:44:33 mtcampbe
138 ! Updated license.
139 !
140 ! Revision 1.2 2008/11/19 22:17:45 mtcampbe
141 ! Added Illinois Open Source License/Copyright
142 !
143 ! Revision 1.1 2004/12/01 20:57:24 fnajjar
144 ! Initial revision after changing case
145 !
146 ! Revision 1.1 2003/02/21 17:46:47 fnajjar
147 ! Renamed from PLAG_clearRequests.F90
148 !
149 !******************************************************************************
150 
151 
152 
153 
154 
155 
156 
subroutine plag_clearsizesendrequests(regions, iReg)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Definition: patch.h:74
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469