Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModCopyData.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 to copy data from and to partitioned regions.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModCopyData.F90,v 1.7 2008/12/06 08:44:20 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2005 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
40 
41  USE modglobal, ONLY: t_global
42  USE moddatatypes
43  USE modparameters
44  USE moderror
45  USE modgrid, ONLY: t_grid
46  USE modmpi
47 
48  IMPLICIT NONE
49 
50  PRIVATE
51  PUBLIC :: rflu_copy_celldatap2s_r2d, &
55 
56 ! ******************************************************************************
57 ! Declarations and definitions
58 ! ******************************************************************************
59 
60  CHARACTER(CHRLEN) :: &
61  RCSIdentString = '$RCSfile: RFLU_ModCopyData.F90,v $ $Revision: 1.7 $'
62 
63 
64 ! ******************************************************************************
65 ! Routines
66 ! ******************************************************************************
67 
68  CONTAINS
69 
70 
71 
72 
73 
74 
75 
76 ! ******************************************************************************
77 !
78 ! Purpose: Copy real cell data from a partitioned region to serial region for
79 ! 2d arrays.
80 !
81 ! Description: None.
82 !
83 ! Input:
84 ! global Pointer to global data
85 ! pGrid Pointer to grid of partitioned region
86 ! var Data on partitioned region
87 ! varSerial Data on serial region
88 !
89 ! Output: None.
90 !
91 ! Notes: None.
92 !
93 ! ******************************************************************************
94 
95  SUBROUTINE rflu_copy_celldatap2s_r2d(global,pGrid,var,varSerial)
96 
97  IMPLICIT NONE
98 
99 ! ******************************************************************************
100 ! Declarations and definitions
101 ! ******************************************************************************
102 
103 ! ==============================================================================
104 ! Arguments
105 ! ==============================================================================
106 
107  REAL(RFREAL), DIMENSION(:,:) :: var,varserial
108  TYPE(t_global), POINTER :: global
109  TYPE(t_grid), POINTER :: pgrid
110 
111 ! ==============================================================================
112 ! Locals
113 ! ==============================================================================
114 
115  INTEGER :: icg,icg2,ivar,ivarbeg,ivarend
116 
117 ! ******************************************************************************
118 ! Start
119 ! ******************************************************************************
120 
121  CALL registerfunction(global,'RFLU_COPY_CellDataP2S_R2D',&
122  'RFLU_ModCopyData.F90')
123 
124 ! ******************************************************************************
125 ! Set pointers
126 ! ******************************************************************************
127 
128  ivarbeg = lbound(var,1)
129  ivarend = ubound(var,1)
130 
131  IF ( (ivarbeg /= lbound(varserial,1)) .OR. &
132  (ivarend /= ubound(varserial,1)) ) THEN
133  CALL errorstop(global,err_lubound_mismatch,__line__)
134  END IF ! iVarBeg
135 
136  DO icg = 1,pgrid%nCellsTot
137  icg2 = pgrid%pc2sc(icg)
138 
139  DO ivar = ivarbeg,ivarend
140  varserial(ivar,icg2) = var(ivar,icg)
141  END DO ! iVar
142  END DO ! icg
143 
144 ! ******************************************************************************
145 ! End
146 ! ******************************************************************************
147 
148  CALL deregisterfunction(global)
149 
150  END SUBROUTINE rflu_copy_celldatap2s_r2d
151 
152 
153 
154 
155 
156 
157 
158 
159 ! ******************************************************************************
160 !
161 ! Purpose: Copy real cell data from a partitioned region to serial region for
162 ! 2d arrays.
163 !
164 ! Description: None.
165 !
166 ! Input:
167 ! global Pointer to global data
168 ! pGrid Pointer to grid of partitioned region
169 ! var Data on partitioned region
170 ! varSerial Data on serial region
171 !
172 ! Output: None.
173 !
174 ! Notes: None.
175 !
176 ! ******************************************************************************
177 
178  SUBROUTINE rflu_copy_celldatap2s_r3d(global,pGrid,var,varSerial)
179 
180  IMPLICIT NONE
181 
182 ! ******************************************************************************
183 ! Declarations and definitions
184 ! ******************************************************************************
185 
186 ! ==============================================================================
187 ! Arguments
188 ! ==============================================================================
189 
190  REAL(RFREAL), DIMENSION(:,:,:) :: var,varserial
191  TYPE(t_global), POINTER :: global
192  TYPE(t_grid), POINTER :: pgrid
193 
194 ! ==============================================================================
195 ! Locals
196 ! ==============================================================================
197 
198  INTEGER :: icg,icg2,icmp,icmpbeg,icmpend,ivar,ivarbeg,ivarend
199 
200 ! ******************************************************************************
201 ! Start
202 ! ******************************************************************************
203 
204  CALL registerfunction(global,'RFLU_COPY_CellDataP2S_R3D',&
205  'RFLU_ModCopyData.F90')
206 
207 ! ******************************************************************************
208 ! Set pointers
209 ! ******************************************************************************
210 
211  icmpbeg = lbound(var,1)
212  icmpend = ubound(var,1)
213 
214  ivarbeg = lbound(var,2)
215  ivarend = ubound(var,2)
216 
217  IF ( (icmpbeg /= lbound(varserial,1)) .OR. &
218  (icmpend /= ubound(varserial,1)) ) THEN
219  CALL errorstop(global,err_lubound_mismatch,__line__)
220  END IF ! iCmpBeg
221 
222  IF ( (ivarbeg /= lbound(varserial,2)) .OR. &
223  (ivarend /= ubound(varserial,2)) ) THEN
224  CALL errorstop(global,err_lubound_mismatch,__line__)
225  END IF ! iVarBeg
226 
227  DO icg = 1,pgrid%nCellsTot
228  icg2 = pgrid%pc2sc(icg)
229 
230  DO icmp = icmpbeg,icmpend
231  DO ivar = ivarbeg,ivarend
232  varserial(icmp,ivar,icg2) = var(icmp,ivar,icg)
233  END DO ! iVar
234  END DO ! iCmp
235  END DO ! icg
236 
237 ! ******************************************************************************
238 ! End
239 ! ******************************************************************************
240 
241  CALL deregisterfunction(global)
242 
243  END SUBROUTINE rflu_copy_celldatap2s_r3d
244 
245 
246 
247 
248 
249 
250 ! ******************************************************************************
251 !
252 ! Purpose: Copy integer cell data from serial region to a partitioned region
253 ! for 1d arrays.
254 !
255 ! Description: None.
256 !
257 ! Input:
258 ! global Pointer to global data
259 ! pGrid Pointer to grid of partitioned region
260 ! var Data on partitioned region
261 ! varSerial Data on serial region
262 !
263 ! Output: None.
264 !
265 ! Notes: None.
266 !
267 ! ******************************************************************************
268 
269  SUBROUTINE rflu_copy_celldatas2p_i1d(global,pGrid,var,varSerial)
270 
271  IMPLICIT NONE
272 
273 ! ******************************************************************************
274 ! Declarations and definitions
275 ! ******************************************************************************
276 
277 ! ==============================================================================
278 ! Arguments
279 ! ==============================================================================
280 
281  INTEGER, DIMENSION(:) :: var,varserial
282  TYPE(t_global), POINTER :: global
283  TYPE(t_grid), POINTER :: pgrid
284 
285 ! ==============================================================================
286 ! Locals
287 ! ==============================================================================
288 
289  INTEGER :: icg,icg2
290 
291 ! ******************************************************************************
292 ! Start
293 ! ******************************************************************************
294 
295  CALL registerfunction(global,'RFLU_COPY_CellDataS2P_I1D',&
296  'RFLU_ModCopyData.F90')
297 
298 ! ******************************************************************************
299 ! Set pointers
300 ! ******************************************************************************
301 
302  DO icg = 1,pgrid%nCellsTot
303  icg2 = pgrid%pc2sc(icg)
304 
305  var(icg) = varserial(icg2)
306  END DO ! icg
307 
308 ! ******************************************************************************
309 ! End
310 ! ******************************************************************************
311 
312  CALL deregisterfunction(global)
313 
314  END SUBROUTINE rflu_copy_celldatas2p_i1d
315 
316 
317 
318 
319 
320 
321 
322 
323 ! ******************************************************************************
324 !
325 ! Purpose: Copy real cell data from serial region to a partitioned region for
326 ! 2d arrays.
327 !
328 ! Description: None.
329 !
330 ! Input:
331 ! global Pointer to global data
332 ! pGrid Pointer to grid of partitioned region
333 ! var Data on partitioned region
334 ! varSerial Data on serial region
335 !
336 ! Output: None.
337 !
338 ! Notes: None.
339 !
340 ! ******************************************************************************
341 
342  SUBROUTINE rflu_copy_celldatas2p_r2d(global,pGrid,var,varSerial)
343 
344  IMPLICIT NONE
345 
346 ! ******************************************************************************
347 ! Declarations and definitions
348 ! ******************************************************************************
349 
350 ! ==============================================================================
351 ! Arguments
352 ! ==============================================================================
353 
354  REAL(RFREAL), DIMENSION(:,:) :: var,varserial
355  TYPE(t_global), POINTER :: global
356  TYPE(t_grid), POINTER :: pgrid
357 
358 ! ==============================================================================
359 ! Locals
360 ! ==============================================================================
361 
362  INTEGER :: icg,icg2,ivar,ivarbeg,ivarend
363 
364 ! ******************************************************************************
365 ! Start
366 ! ******************************************************************************
367 
368  CALL registerfunction(global,'RFLU_COPY_CellDataS2P_R2D',&
369  'RFLU_ModCopyData.F90')
370 
371 ! ******************************************************************************
372 ! Set pointers
373 ! ******************************************************************************
374 
375  ivarbeg = lbound(var,1)
376  ivarend = ubound(var,1)
377 
378  IF ( (ivarbeg /= lbound(varserial,1)) .OR. &
379  (ivarend /= ubound(varserial,1)) ) THEN
380  CALL errorstop(global,err_lubound_mismatch,__line__)
381  END IF ! iVarBeg
382 
383  DO icg = 1,pgrid%nCellsTot
384  icg2 = pgrid%pc2sc(icg)
385 
386  DO ivar = ivarbeg,ivarend
387  var(ivar,icg) = varserial(ivar,icg2)
388  END DO ! iVar
389  END DO ! icg
390 
391 ! ******************************************************************************
392 ! End
393 ! ******************************************************************************
394 
395  CALL deregisterfunction(global)
396 
397  END SUBROUTINE rflu_copy_celldatas2p_r2d
398 
399 
400 
401 
402 
403 
404 
405 ! ******************************************************************************
406 ! End
407 ! ******************************************************************************
408 
409 END MODULE rflu_modcopydata
410 
411 
412 ! ******************************************************************************
413 !
414 ! RCS Revision history:
415 !
416 ! $Log: RFLU_ModCopyData.F90,v $
417 ! Revision 1.7 2008/12/06 08:44:20 mtcampbe
418 ! Updated license.
419 !
420 ! Revision 1.6 2008/11/19 22:17:32 mtcampbe
421 ! Added Illinois Open Source License/Copyright
422 !
423 ! Revision 1.5 2006/12/18 16:18:44 haselbac
424 ! Bug fix: Merging of cases with sype patches needs nCellsTot copied
425 !
426 ! Revision 1.4 2006/04/07 15:19:19 haselbac
427 ! Removed tabs
428 !
429 ! Revision 1.3 2005/11/27 01:51:00 haselbac
430 ! Added routine RFLU_COPY_CellDataP2S_R3D
431 !
432 ! Revision 1.2 2005/08/19 02:33:18 haselbac
433 ! Renamed routines and added new routine
434 !
435 ! Revision 1.1 2005/04/15 15:06:42 haselbac
436 ! Initial revision
437 !
438 ! ******************************************************************************
439 
440 
441 
442 
443 
444 
445 
446 
447 
448 
subroutine, public rflu_copy_celldatap2s_r3d(global, pGrid, var, varSerial)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine, public rflu_copy_celldatas2p_r2d(global, pGrid, var, varSerial)
subroutine, public rflu_copy_celldatap2s_r2d(global, pGrid, var, varSerial)
subroutine, public rflu_copy_celldatas2p_i1d(global, pGrid, var, varSerial)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469