Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModForcesMoments.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: Collection of routines to compute force and moment coefficients.
26 !
27 ! Description: None.
28 !
29 ! Notes: None.
30 !
31 ! ******************************************************************************
32 !
33 ! $Id: RFLU_ModForcesMoments.F90,v 1.11 2008/12/06 08:44:21 mtcampbe Exp $
34 !
35 ! Copyright: (c) 2004-2005 by the University of Illinois
36 !
37 ! ******************************************************************************
38 
40 
41  USE modparameters
42  USE moddatatypes
43  USE modglobal, ONLY: t_global
44  USE modgrid, ONLY: t_grid
45  USE modbndpatch, ONLY: t_patch
46  USE moddatastruct, ONLY: t_region
47  USE moderror
48  USE modmpi
49 
50  IMPLICIT NONE
51 
52 ! ******************************************************************************
53 ! Declarations and definitions
54 ! ******************************************************************************
55 
56 ! ==============================================================================
57 ! Private data
58 ! ==============================================================================
59 
60  CHARACTER(CHRLEN), PRIVATE :: &
61  RCSIdentString = '$RCSfile: RFLU_ModForcesMoments.F90,v $ $Revision: 1.11 $'
62 
63 ! ==============================================================================
64 ! Public functions
65 ! ==============================================================================
66 
76 
77 ! ==============================================================================
78 ! Private functions
79 ! ==============================================================================
80 
81  PRIVATE :: rflu_initforcesmoments, &
85 
86 ! ******************************************************************************
87 ! Routines
88 ! ******************************************************************************
89 
90  CONTAINS
91 
92 
93 
94 
95 
96 
97 
98 ! *******************************************************************************
99 !
100 ! Purpose: Compute global force, moment and mass coefficients.
101 !
102 ! Description: None.
103 !
104 ! Input:
105 ! regions Region data
106 !
107 ! Output: None.
108 !
109 ! Notes: None.
110 !
111 ! ******************************************************************************
112 
114 
115  IMPLICIT NONE
116 
117 ! ******************************************************************************
118 ! Declarations and definitions
119 ! ******************************************************************************
120 
121 ! ==============================================================================
122 ! Arguments
123 ! ==============================================================================
124 
125  TYPE(t_region), DIMENSION(:), POINTER :: regions
126 
127 ! ==============================================================================
128 ! Locals
129 ! ==============================================================================
130 
131  INTEGER :: errorflag,icomp,ipatch,ipatchglobal,ireg,ixyz,nvals2,nvals3
132  REAL(RFREAL) :: fact
133  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: globalvals2,localvals2
134  REAL(RFREAL), DIMENSION(:,:,:), ALLOCATABLE :: globalvals3,localvals3
135  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: pcoeff
136  TYPE(t_global), POINTER :: global
137  TYPE(t_grid), POINTER :: pgrid
138  TYPE(t_patch), POINTER :: ppatch
139  TYPE(t_region), POINTER :: pregion
140 
141 ! ******************************************************************************
142 ! Start, set pointers and variables
143 ! ******************************************************************************
144 
145  global => regions(1)%global
146 
147  CALL registerfunction(global,'RFLU_ComputeGlobalForcesMoments',&
148  'RFLU_ModForcesMoments.F90')
149 
150  nvals2 = (mass_out-mass_in+1)*global%nPatches
151  nvals3 = (zcoord-xcoord+1)*(comp_visc-comp_mom+1)*global%nPatches
152 
153 ! ******************************************************************************
154 ! Allocate temporary memory
155 ! ******************************************************************************
156 
157  ALLOCATE(globalvals3(xcoord:zcoord,comp_mom:comp_visc,global%nPatches), &
158  stat=errorflag)
159  global%error = errorflag
160  IF ( global%error /= err_none ) THEN
161  CALL errorstop(global,err_allocate,__line__,'globalVals3')
162  END IF ! global%error
163 
164  ALLOCATE(localvals3(xcoord:zcoord,comp_mom:comp_visc,global%nPatches), &
165  stat=errorflag)
166  global%error = errorflag
167  IF ( global%error /= err_none ) THEN
168  CALL errorstop(global,err_allocate,__line__,'localVals3')
169  END IF ! global%error
170 
171 ! ******************************************************************************
172 ! Compute global force coefficients
173 ! ******************************************************************************
174 
175  DO ipatch = 1,global%nPatches
176  globalvals3(xcoord,comp_mom ,ipatch) = 0.0_rfreal
177  globalvals3(xcoord,comp_pres,ipatch) = 0.0_rfreal
178  globalvals3(xcoord,comp_visc,ipatch) = 0.0_rfreal
179  globalvals3(ycoord,comp_mom ,ipatch) = 0.0_rfreal
180  globalvals3(ycoord,comp_pres,ipatch) = 0.0_rfreal
181  globalvals3(ycoord,comp_visc,ipatch) = 0.0_rfreal
182  globalvals3(zcoord,comp_mom ,ipatch) = 0.0_rfreal
183  globalvals3(zcoord,comp_pres,ipatch) = 0.0_rfreal
184  globalvals3(zcoord,comp_visc,ipatch) = 0.0_rfreal
185 
186  localvals3(xcoord,comp_mom ,ipatch) = 0.0_rfreal
187  localvals3(xcoord,comp_pres,ipatch) = 0.0_rfreal
188  localvals3(xcoord,comp_visc,ipatch) = 0.0_rfreal
189  localvals3(ycoord,comp_mom ,ipatch) = 0.0_rfreal
190  localvals3(ycoord,comp_pres,ipatch) = 0.0_rfreal
191  localvals3(ycoord,comp_visc,ipatch) = 0.0_rfreal
192  localvals3(zcoord,comp_mom ,ipatch) = 0.0_rfreal
193  localvals3(zcoord,comp_pres,ipatch) = 0.0_rfreal
194  localvals3(zcoord,comp_visc,ipatch) = 0.0_rfreal
195  END DO ! iPatch
196 
197 ! ==============================================================================
198 ! Set local force coefficients
199 ! ==============================================================================
200 
201  DO ireg = 1,global%nRegionsLocal
202  pregion => regions(ireg)
203  pgrid => pregion%grid
204 
205  DO ipatch = 1,pgrid%nPatches
206  ppatch => pregion%patches(ipatch)
207 
208  ipatchglobal = ppatch%iPatchGlobal
209 
210  localvals3(xcoord,comp_mom ,ipatchglobal) &
211  = localvals3(xcoord,comp_mom ,ipatchglobal) &
212  + ppatch%forceCoeffs(xcoord,comp_mom )
213 
214  localvals3(xcoord,comp_pres,ipatchglobal) &
215  = localvals3(xcoord,comp_pres,ipatchglobal) &
216  + ppatch%forceCoeffs(xcoord,comp_pres)
217 
218  localvals3(xcoord,comp_visc,ipatchglobal) &
219  = localvals3(xcoord,comp_visc,ipatchglobal) &
220  + ppatch%forceCoeffs(xcoord,comp_visc)
221 
222  localvals3(ycoord,comp_mom ,ipatchglobal) &
223  = localvals3(ycoord,comp_mom ,ipatchglobal) &
224  + ppatch%forceCoeffs(ycoord,comp_mom )
225 
226  localvals3(ycoord,comp_pres,ipatchglobal) &
227  = localvals3(ycoord,comp_pres,ipatchglobal) &
228  + ppatch%forceCoeffs(ycoord,comp_pres)
229 
230  localvals3(ycoord,comp_visc,ipatchglobal) &
231  = localvals3(ycoord,comp_visc,ipatchglobal) &
232  + ppatch%forceCoeffs(ycoord,comp_visc)
233 
234  localvals3(zcoord,comp_mom ,ipatchglobal) &
235  = localvals3(zcoord,comp_mom ,ipatchglobal) &
236  + ppatch%forceCoeffs(zcoord,comp_mom )
237 
238  localvals3(zcoord,comp_pres,ipatchglobal) &
239  = localvals3(zcoord,comp_pres,ipatchglobal) &
240  + ppatch%forceCoeffs(zcoord,comp_pres)
241 
242  localvals3(zcoord,comp_visc,ipatchglobal) &
243  = localvals3(zcoord,comp_visc,ipatchglobal) &
244  + ppatch%forceCoeffs(zcoord,comp_visc)
245  END DO ! iPatch
246  END DO ! iReg
247 
248 ! ==============================================================================
249 ! Compute global force coefficients
250 ! ==============================================================================
251 
252  CALL mpi_allreduce(localvals3,globalvals3,nvals3,mpi_rfreal,mpi_sum, &
253  global%mpiComm,errorflag)
254  global%error = errorflag
255  IF ( global%error /= err_none ) THEN
256  CALL errorstop(global,err_mpi_output,__line__)
257  END IF ! global%error
258 
259  DO ireg = 1,global%nRegionsLocal
260  pcoeff => regions(ireg)%forceCoeffsGlobal
261 
262  DO ipatch = 1,pregion%global%nPatches
263  pcoeff(xcoord,comp_mom ,ipatch) = globalvals3(xcoord,comp_mom ,ipatch)
264  pcoeff(xcoord,comp_pres,ipatch) = globalvals3(xcoord,comp_pres,ipatch)
265  pcoeff(xcoord,comp_visc,ipatch) = globalvals3(xcoord,comp_visc,ipatch)
266  pcoeff(ycoord,comp_mom ,ipatch) = globalvals3(ycoord,comp_mom ,ipatch)
267  pcoeff(ycoord,comp_pres,ipatch) = globalvals3(ycoord,comp_pres,ipatch)
268  pcoeff(ycoord,comp_visc,ipatch) = globalvals3(ycoord,comp_visc,ipatch)
269  pcoeff(zcoord,comp_mom ,ipatch) = globalvals3(zcoord,comp_mom ,ipatch)
270  pcoeff(zcoord,comp_pres,ipatch) = globalvals3(zcoord,comp_pres,ipatch)
271  pcoeff(zcoord,comp_visc,ipatch) = globalvals3(zcoord,comp_visc,ipatch)
272  END DO ! iPatch
273  END DO ! iReg
274 
275 ! ==============================================================================
276 ! Normalize force coefficients
277 ! ==============================================================================
278 
279  fact = 1.0_rfreal/global%forceRefArea
280 
281  DO ireg = 1,global%nRegionsLocal
282  pcoeff => regions(ireg)%forceCoeffsGlobal
283 
284  DO ipatch = 1,pregion%global%nPatches
285  pcoeff(xcoord,comp_mom ,ipatch) = fact*pcoeff(xcoord,comp_mom ,ipatch)
286  pcoeff(xcoord,comp_pres,ipatch) = fact*pcoeff(xcoord,comp_pres,ipatch)
287  pcoeff(xcoord,comp_visc,ipatch) = fact*pcoeff(xcoord,comp_visc,ipatch)
288  pcoeff(ycoord,comp_mom ,ipatch) = fact*pcoeff(ycoord,comp_mom ,ipatch)
289  pcoeff(ycoord,comp_pres,ipatch) = fact*pcoeff(ycoord,comp_pres,ipatch)
290  pcoeff(ycoord,comp_visc,ipatch) = fact*pcoeff(ycoord,comp_visc,ipatch)
291  pcoeff(zcoord,comp_mom ,ipatch) = fact*pcoeff(zcoord,comp_mom ,ipatch)
292  pcoeff(zcoord,comp_pres,ipatch) = fact*pcoeff(zcoord,comp_pres,ipatch)
293  pcoeff(zcoord,comp_visc,ipatch) = fact*pcoeff(zcoord,comp_visc,ipatch)
294  END DO ! iPatch
295  END DO ! iReg
296 
297 ! ******************************************************************************
298 ! Compute global vacuum force coefficients
299 ! ******************************************************************************
300 
301  DO ipatch = 1,global%nPatches
302  globalvals3(xcoord,comp_mom ,ipatch) = 0.0_rfreal
303  globalvals3(xcoord,comp_pres,ipatch) = 0.0_rfreal
304  globalvals3(xcoord,comp_visc,ipatch) = 0.0_rfreal
305  globalvals3(ycoord,comp_mom ,ipatch) = 0.0_rfreal
306  globalvals3(ycoord,comp_pres,ipatch) = 0.0_rfreal
307  globalvals3(ycoord,comp_visc,ipatch) = 0.0_rfreal
308  globalvals3(zcoord,comp_mom ,ipatch) = 0.0_rfreal
309  globalvals3(zcoord,comp_pres,ipatch) = 0.0_rfreal
310  globalvals3(zcoord,comp_visc,ipatch) = 0.0_rfreal
311 
312  localvals3(xcoord,comp_mom ,ipatch) = 0.0_rfreal
313  localvals3(xcoord,comp_pres,ipatch) = 0.0_rfreal
314  localvals3(xcoord,comp_visc,ipatch) = 0.0_rfreal
315  localvals3(ycoord,comp_mom ,ipatch) = 0.0_rfreal
316  localvals3(ycoord,comp_pres,ipatch) = 0.0_rfreal
317  localvals3(ycoord,comp_visc,ipatch) = 0.0_rfreal
318  localvals3(zcoord,comp_mom ,ipatch) = 0.0_rfreal
319  localvals3(zcoord,comp_pres,ipatch) = 0.0_rfreal
320  localvals3(zcoord,comp_visc,ipatch) = 0.0_rfreal
321  END DO ! iPatch
322 
323 ! ==============================================================================
324 ! Set local vacuum force coefficients
325 ! ==============================================================================
326 
327  DO ireg = 1,global%nRegionsLocal
328  pregion => regions(ireg)
329  pgrid => pregion%grid
330 
331  DO ipatch = 1,pgrid%nPatches
332  ppatch => pregion%patches(ipatch)
333 
334  ipatchglobal = ppatch%iPatchGlobal
335 
336  localvals3(xcoord,comp_mom ,ipatchglobal) &
337  = localvals3(xcoord,comp_mom ,ipatchglobal) &
338  + ppatch%forceVacCoeffs(xcoord,comp_mom )
339 
340  localvals3(xcoord,comp_pres,ipatchglobal) &
341  = localvals3(xcoord,comp_pres,ipatchglobal) &
342  + ppatch%forceVacCoeffs(xcoord,comp_pres)
343 
344  localvals3(xcoord,comp_visc,ipatchglobal) &
345  = localvals3(xcoord,comp_visc,ipatchglobal) &
346  + ppatch%forceVacCoeffs(xcoord,comp_visc)
347 
348  localvals3(ycoord,comp_mom ,ipatchglobal) &
349  = localvals3(ycoord,comp_mom ,ipatchglobal) &
350  + ppatch%forceVacCoeffs(ycoord,comp_mom )
351 
352  localvals3(ycoord,comp_pres,ipatchglobal) &
353  = localvals3(ycoord,comp_pres,ipatchglobal) &
354  + ppatch%forceVacCoeffs(ycoord,comp_pres)
355 
356  localvals3(ycoord,comp_visc,ipatchglobal) &
357  = localvals3(ycoord,comp_visc,ipatchglobal) &
358  + ppatch%forceVacCoeffs(ycoord,comp_visc)
359 
360  localvals3(zcoord,comp_mom ,ipatchglobal) &
361  = localvals3(zcoord,comp_mom ,ipatchglobal) &
362  + ppatch%forceVacCoeffs(zcoord,comp_mom )
363 
364  localvals3(zcoord,comp_pres,ipatchglobal) &
365  = localvals3(zcoord,comp_pres,ipatchglobal) &
366  + ppatch%forceVacCoeffs(zcoord,comp_pres)
367 
368  localvals3(zcoord,comp_visc,ipatchglobal) &
369  = localvals3(zcoord,comp_visc,ipatchglobal) &
370  + ppatch%forceVacCoeffs(zcoord,comp_visc)
371  END DO ! iPatch
372  END DO ! iReg
373 
374 ! ==============================================================================
375 ! Compute global vacuum force coefficients
376 ! ==============================================================================
377 
378  CALL mpi_allreduce(localvals3,globalvals3,nvals3,mpi_rfreal,mpi_sum, &
379  global%mpiComm,errorflag)
380  global%error = errorflag
381  IF ( global%error /= err_none ) THEN
382  CALL errorstop(global,err_mpi_output,__line__)
383  END IF ! global%error
384 
385  DO ireg = 1,global%nRegionsLocal
386  pcoeff => regions(ireg)%forceVacCoeffsGlobal
387 
388  DO ipatch = 1,pregion%global%nPatches
389  pcoeff(xcoord,comp_mom ,ipatch) = globalvals3(xcoord,comp_mom ,ipatch)
390  pcoeff(xcoord,comp_pres,ipatch) = globalvals3(xcoord,comp_pres,ipatch)
391  pcoeff(xcoord,comp_visc,ipatch) = globalvals3(xcoord,comp_visc,ipatch)
392  pcoeff(ycoord,comp_mom ,ipatch) = globalvals3(ycoord,comp_mom ,ipatch)
393  pcoeff(ycoord,comp_pres,ipatch) = globalvals3(ycoord,comp_pres,ipatch)
394  pcoeff(ycoord,comp_visc,ipatch) = globalvals3(ycoord,comp_visc,ipatch)
395  pcoeff(zcoord,comp_mom ,ipatch) = globalvals3(zcoord,comp_mom ,ipatch)
396  pcoeff(zcoord,comp_pres,ipatch) = globalvals3(zcoord,comp_pres,ipatch)
397  pcoeff(zcoord,comp_visc,ipatch) = globalvals3(zcoord,comp_visc,ipatch)
398  END DO ! iPatch
399  END DO ! iReg
400 
401 ! ==============================================================================
402 ! Normalize vacuum force coefficients
403 ! ==============================================================================
404 
405  fact = 1.0_rfreal/global%forceRefArea
406 
407  DO ireg = 1,global%nRegionsLocal
408  pcoeff => regions(ireg)%forceVacCoeffsGlobal
409 
410  DO ipatch = 1,pregion%global%nPatches
411  pcoeff(xcoord,comp_mom ,ipatch) = fact*pcoeff(xcoord,comp_mom ,ipatch)
412  pcoeff(xcoord,comp_pres,ipatch) = fact*pcoeff(xcoord,comp_pres,ipatch)
413  pcoeff(xcoord,comp_visc,ipatch) = fact*pcoeff(xcoord,comp_visc,ipatch)
414  pcoeff(ycoord,comp_mom ,ipatch) = fact*pcoeff(ycoord,comp_mom ,ipatch)
415  pcoeff(ycoord,comp_pres,ipatch) = fact*pcoeff(ycoord,comp_pres,ipatch)
416  pcoeff(ycoord,comp_visc,ipatch) = fact*pcoeff(ycoord,comp_visc,ipatch)
417  pcoeff(zcoord,comp_mom ,ipatch) = fact*pcoeff(zcoord,comp_mom ,ipatch)
418  pcoeff(zcoord,comp_pres,ipatch) = fact*pcoeff(zcoord,comp_pres,ipatch)
419  pcoeff(zcoord,comp_visc,ipatch) = fact*pcoeff(zcoord,comp_visc,ipatch)
420  END DO ! iPatch
421  END DO ! iReg
422 
423 ! ******************************************************************************
424 ! Compute global moment coefficients
425 ! ******************************************************************************
426 
427  DO ipatch = 1,global%nPatches
428  globalvals3(xcoord,comp_mom ,ipatch) = 0.0_rfreal
429  globalvals3(xcoord,comp_pres,ipatch) = 0.0_rfreal
430  globalvals3(xcoord,comp_visc,ipatch) = 0.0_rfreal
431  globalvals3(ycoord,comp_mom ,ipatch) = 0.0_rfreal
432  globalvals3(ycoord,comp_pres,ipatch) = 0.0_rfreal
433  globalvals3(ycoord,comp_visc,ipatch) = 0.0_rfreal
434  globalvals3(zcoord,comp_mom ,ipatch) = 0.0_rfreal
435  globalvals3(zcoord,comp_pres,ipatch) = 0.0_rfreal
436  globalvals3(zcoord,comp_visc,ipatch) = 0.0_rfreal
437 
438  localvals3(xcoord,comp_mom ,ipatch) = 0.0_rfreal
439  localvals3(xcoord,comp_pres,ipatch) = 0.0_rfreal
440  localvals3(xcoord,comp_visc,ipatch) = 0.0_rfreal
441  localvals3(ycoord,comp_mom ,ipatch) = 0.0_rfreal
442  localvals3(ycoord,comp_pres,ipatch) = 0.0_rfreal
443  localvals3(ycoord,comp_visc,ipatch) = 0.0_rfreal
444  localvals3(zcoord,comp_mom ,ipatch) = 0.0_rfreal
445  localvals3(zcoord,comp_pres,ipatch) = 0.0_rfreal
446  localvals3(zcoord,comp_visc,ipatch) = 0.0_rfreal
447  END DO ! iPatch
448 
449 ! ==============================================================================
450 ! Set local moment coefficients
451 ! ==============================================================================
452 
453  DO ireg = 1,global%nRegionsLocal
454  pregion => regions(ireg)
455  pgrid => pregion%grid
456 
457  DO ipatch = 1,pgrid%nPatches
458  ppatch => pregion%patches(ipatch)
459 
460  ipatchglobal = ppatch%iPatchGlobal
461 
462  localvals3(xcoord,comp_mom ,ipatchglobal) &
463  = localvals3(xcoord,comp_mom ,ipatchglobal) &
464  + ppatch%momentCoeffs(xcoord,comp_mom )
465 
466  localvals3(xcoord,comp_pres,ipatchglobal) &
467  = localvals3(xcoord,comp_pres,ipatchglobal) &
468  + ppatch%momentCoeffs(xcoord,comp_pres)
469 
470  localvals3(xcoord,comp_visc,ipatchglobal) &
471  = localvals3(xcoord,comp_visc,ipatchglobal) &
472  + ppatch%momentCoeffs(xcoord,comp_visc)
473 
474  localvals3(ycoord,comp_mom ,ipatchglobal) &
475  = localvals3(ycoord,comp_mom ,ipatchglobal) &
476  + ppatch%momentCoeffs(ycoord,comp_mom )
477 
478  localvals3(ycoord,comp_pres,ipatchglobal) &
479  = localvals3(ycoord,comp_pres,ipatchglobal) &
480  + ppatch%momentCoeffs(ycoord,comp_pres)
481 
482  localvals3(ycoord,comp_visc,ipatchglobal) &
483  = localvals3(ycoord,comp_visc,ipatchglobal) &
484  + ppatch%momentCoeffs(ycoord,comp_visc)
485 
486  localvals3(zcoord,comp_mom ,ipatchglobal) &
487  = localvals3(zcoord,comp_mom ,ipatchglobal) &
488  + ppatch%momentCoeffs(zcoord,comp_mom )
489 
490  localvals3(zcoord,comp_pres,ipatchglobal) &
491  = localvals3(zcoord,comp_pres,ipatchglobal) &
492  + ppatch%momentCoeffs(zcoord,comp_pres)
493 
494  localvals3(zcoord,comp_visc,ipatchglobal) &
495  = localvals3(zcoord,comp_visc,ipatchglobal) &
496  + ppatch%momentCoeffs(zcoord,comp_visc)
497  END DO ! iPatch
498  END DO ! iReg
499 
500 ! ==============================================================================
501 ! Compute global moment coefficients
502 ! ==============================================================================
503 
504  CALL mpi_allreduce(localvals3,globalvals3,nvals3,mpi_rfreal,mpi_sum, &
505  global%mpiComm,errorflag)
506  global%error = errorflag
507  IF ( global%error /= err_none ) THEN
508  CALL errorstop(global,err_mpi_output,__line__)
509  END IF ! global%error
510 
511  DO ireg = 1,global%nRegionsLocal
512  pcoeff => regions(ireg)%momentCoeffsGlobal
513 
514  DO ipatch = 1,pregion%global%nPatches
515  pcoeff(xcoord,comp_mom ,ipatch) = globalvals3(xcoord,comp_mom ,ipatch)
516  pcoeff(xcoord,comp_pres,ipatch) = globalvals3(xcoord,comp_pres,ipatch)
517  pcoeff(xcoord,comp_visc,ipatch) = globalvals3(xcoord,comp_visc,ipatch)
518  pcoeff(ycoord,comp_mom ,ipatch) = globalvals3(ycoord,comp_mom ,ipatch)
519  pcoeff(ycoord,comp_pres,ipatch) = globalvals3(ycoord,comp_pres,ipatch)
520  pcoeff(ycoord,comp_visc,ipatch) = globalvals3(ycoord,comp_visc,ipatch)
521  pcoeff(zcoord,comp_mom ,ipatch) = globalvals3(zcoord,comp_mom ,ipatch)
522  pcoeff(zcoord,comp_pres,ipatch) = globalvals3(zcoord,comp_pres,ipatch)
523  pcoeff(zcoord,comp_visc,ipatch) = globalvals3(zcoord,comp_visc,ipatch)
524  END DO ! iPatch
525  END DO ! iReg
526 
527 ! ==============================================================================
528 ! Normalize moment coefficients
529 ! ==============================================================================
530 
531  fact = 1.0_rfreal/(global%forceRefArea*global%forceRefLength)
532 
533  DO ireg = 1,global%nRegionsLocal
534  pcoeff => regions(ireg)%momentCoeffsGlobal
535 
536  DO ipatch = 1,pregion%global%nPatches
537  pcoeff(xcoord,comp_mom ,ipatch) = fact*pcoeff(xcoord,comp_mom ,ipatch)
538  pcoeff(xcoord,comp_pres,ipatch) = fact*pcoeff(xcoord,comp_pres,ipatch)
539  pcoeff(xcoord,comp_visc,ipatch) = fact*pcoeff(xcoord,comp_visc,ipatch)
540  pcoeff(ycoord,comp_mom ,ipatch) = fact*pcoeff(ycoord,comp_mom ,ipatch)
541  pcoeff(ycoord,comp_pres,ipatch) = fact*pcoeff(ycoord,comp_pres,ipatch)
542  pcoeff(ycoord,comp_visc,ipatch) = fact*pcoeff(ycoord,comp_visc,ipatch)
543  pcoeff(zcoord,comp_mom ,ipatch) = fact*pcoeff(zcoord,comp_mom ,ipatch)
544  pcoeff(zcoord,comp_pres,ipatch) = fact*pcoeff(zcoord,comp_pres,ipatch)
545  pcoeff(zcoord,comp_visc,ipatch) = fact*pcoeff(zcoord,comp_visc,ipatch)
546  END DO ! iPatch
547  END DO ! iReg
548 
549 ! ******************************************************************************
550 ! Deallocate temporary memory
551 ! ******************************************************************************
552 
553  DEALLOCATE(globalvals3,stat=errorflag)
554  global%error = errorflag
555  IF ( global%error /= err_none ) THEN
556  CALL errorstop(global,err_deallocate,__line__,'globalVals3')
557  END IF ! global%error
558 
559  DEALLOCATE(localvals3,stat=errorflag)
560  global%error = errorflag
561  IF ( global%error /= err_none ) THEN
562  CALL errorstop(global,err_deallocate,__line__,'localVals3')
563  END IF ! global%error
564 
565 ! ******************************************************************************
566 ! Allocate temporary memory
567 ! ******************************************************************************
568 
569  ALLOCATE(globalvals2(mass_in:mass_out,global%nPatches),stat=errorflag)
570  global%error = errorflag
571  IF ( global%error /= err_none ) THEN
572  CALL errorstop(global,err_allocate,__line__,'globalVals2')
573  END IF ! global%error
574 
575  ALLOCATE(localvals2(mass_in:mass_out,global%nPatches),stat=errorflag)
576  global%error = errorflag
577  IF ( global%error /= err_none ) THEN
578  CALL errorstop(global,err_allocate,__line__,'localVals2')
579  END IF ! global%error
580 
581 ! ******************************************************************************
582 ! Compute global mass coefficients
583 ! ******************************************************************************
584 
585  DO ipatch = 1,global%nPatches
586  globalvals2(mass_in ,ipatch) = 0.0_rfreal
587  globalvals2(mass_out,ipatch) = 0.0_rfreal
588 
589  localvals2(mass_in ,ipatch) = 0.0_rfreal
590  localvals2(mass_out,ipatch) = 0.0_rfreal
591  END DO ! iPatch
592 
593 ! ==============================================================================
594 ! Set local mass coefficients
595 ! ==============================================================================
596 
597  DO ireg = 1,global%nRegionsLocal
598  pregion => regions(ireg)
599  pgrid => pregion%grid
600 
601  DO ipatch = 1,pgrid%nPatches
602  ppatch => pregion%patches(ipatch)
603 
604  ipatchglobal = ppatch%iPatchGlobal
605 
606  localvals2(mass_in ,ipatchglobal) = localvals2(mass_in ,ipatchglobal) &
607  + ppatch%massCoeffs(mass_in)
608  localvals2(mass_out,ipatchglobal) = localvals2(mass_out,ipatchglobal) &
609  + ppatch%massCoeffs(mass_out)
610  END DO ! iPatch
611  END DO ! iReg
612 
613 ! ==============================================================================
614 ! Compute global mass coefficients
615 ! ==============================================================================
616 
617  CALL mpi_allreduce(localvals2,globalvals2,nvals2,mpi_rfreal,mpi_sum, &
618  global%mpiComm,errorflag)
619  global%error = errorflag
620  IF ( global%error /= err_none ) THEN
621  CALL errorstop(global,err_mpi_output,__line__)
622  END IF ! global%error
623 
624  DO ireg = 1,global%nRegionsLocal
625  DO ipatch = 1,pregion%global%nPatches
626  regions(ireg)%massCoeffsGlobal(mass_in,ipatch) &
627  = globalvals2(mass_in,ipatch)
628  regions(ireg)%massCoeffsGlobal(mass_out,ipatch) &
629  = globalvals2(mass_out,ipatch)
630  END DO ! iPatch
631  END DO ! iReg
632 
633 ! ==============================================================================
634 ! Normalize mass coefficients
635 ! ==============================================================================
636 
637  fact = 1.0_rfreal/global%forceRefArea
638 
639  DO ireg = 1,global%nRegionsLocal
640  DO ipatch = 1,pregion%global%nPatches
641  regions(ireg)%massCoeffsGlobal(mass_in,ipatch) &
642  = fact*regions(ireg)%massCoeffsGlobal(mass_in,ipatch)
643  regions(ireg)%massCoeffsGlobal(mass_out,ipatch) &
644  = fact*regions(ireg)%massCoeffsGlobal(mass_out,ipatch)
645  END DO ! iPatch
646  END DO ! iReg
647 
648 ! ******************************************************************************
649 ! Deallocate temporary memory
650 ! ******************************************************************************
651 
652  DEALLOCATE(globalvals2,stat=errorflag)
653  global%error = errorflag
654  IF ( global%error /= err_none ) THEN
655  CALL errorstop(global,err_deallocate,__line__,'globalVals2')
656  END IF ! global%error
657 
658  DEALLOCATE(localvals2,stat=errorflag)
659  global%error = errorflag
660  IF ( global%error /= err_none ) THEN
661  CALL errorstop(global,err_deallocate,__line__,'localVals2')
662  END IF ! global%error
663 
664 ! ******************************************************************************
665 ! End
666 ! ******************************************************************************
667 
668  CALL deregisterfunction(global)
669 
670  END SUBROUTINE rflu_computeglobalforcesmoments
671 
672 
673 
674 
675 
676 
677 
678 
679 ! *******************************************************************************
680 !
681 ! Purpose: Compute local force, moment and coefficients.
682 !
683 ! Description: None.
684 !
685 ! Input:
686 ! pRegion Pointer to region
687 !
688 ! Output: None.
689 !
690 ! Notes: None.
691 !
692 ! ******************************************************************************
693 
694  SUBROUTINE rflu_computelocalforcesmoments(pRegion)
695 
696  IMPLICIT NONE
697 
698 ! ******************************************************************************
699 ! Declarations and definitions
700 ! ******************************************************************************
701 
702 ! ==============================================================================
703 ! Arguments
704 ! ==============================================================================
705 
706  TYPE(t_region), POINTER :: pregion
707 
708 ! ==============================================================================
709 ! Locals
710 ! ==============================================================================
711 
712  INTEGER :: ifl,ipatch
713  REAL(RFREAL) :: cfx,cfy,cfz,ch,cmass,cmomx,cmomy,cmomz,cp,cpref,fmx,fpx, &
714  fpx_vac,fmy,fpy,fpy_vac,fmz,fpz,fpz_vac,fvx,fvy,fvz,mc_in, &
715  mc_out,mpx,mpy,mpz,mvx,mvy,mvz,nm,nx,ny,nz,xc,xref,yc, &
716  yref,zc,zref
717  TYPE(t_global), POINTER :: global
718  TYPE(t_grid), POINTER :: pgrid
719  TYPE(t_patch), POINTER :: ppatch
720 
721 ! ******************************************************************************
722 ! Start, set pointers and variables
723 ! ******************************************************************************
724 
725  global => pregion%global
726 
727  CALL registerfunction(global,'RFLU_ComputeLocalForcesMoments',&
728  'RFLU_ModForcesMoments.F90')
729 
730  pgrid => pregion%grid
731 
732  xref = global%forceRefXCoord
733  yref = global%forceRefYCoord
734  zref = global%forceRefZCoord
735 
736  cpref = global%refPressure/ &
737  (0.5_rfreal*global%refDensity*global%refVelocity*global%refVelocity)
738 
739 ! ******************************************************************************
740 ! Loop over patches
741 ! ******************************************************************************
742 
743  DO ipatch = 1,pgrid%nPatches
744  ppatch => pregion%patches(ipatch)
745 
746  fpx = 0.0_rfreal
747  fpy = 0.0_rfreal
748  fpz = 0.0_rfreal
749 
750  fpx_vac = 0.0_rfreal
751  fpy_vac = 0.0_rfreal
752  fpz_vac = 0.0_rfreal
753 
754  fvx = 0.0_rfreal
755  fvy = 0.0_rfreal
756  fvz = 0.0_rfreal
757 
758  fmx = 0.0_rfreal
759  fmy = 0.0_rfreal
760  fmz = 0.0_rfreal
761 
762  mpx = 0.0_rfreal
763  mpy = 0.0_rfreal
764  mpz = 0.0_rfreal
765 
766  mvx = 0.0_rfreal
767  mvy = 0.0_rfreal
768  mvz = 0.0_rfreal
769 
770  mc_in = 0.0_rfreal
771  mc_out = 0.0_rfreal
772 
773 ! ==============================================================================
774 ! Loop over faces
775 ! ==============================================================================
776 
777  DO ifl = 1,ppatch%nBFaces
778 
779 ! ------------------------------------------------------------------------------
780 ! Get geometry
781 ! ------------------------------------------------------------------------------
782 
783  nx = ppatch%fn(xcoord,ifl)
784  ny = ppatch%fn(ycoord,ifl)
785  nz = ppatch%fn(zcoord,ifl)
786  nm = ppatch%fn(xyzmag,ifl)
787 
788  xc = ppatch%fc(xcoord,ifl)
789  yc = ppatch%fc(ycoord,ifl)
790  zc = ppatch%fc(zcoord,ifl)
791 
792 ! ------------------------------------------------------------------------------
793 ! Get coefficients
794 ! ------------------------------------------------------------------------------
795 
796  cp = ppatch%cp(ifl)
797  cfx = ppatch%cf(xcoord,ifl)
798  cfy = ppatch%cf(ycoord,ifl)
799  cfz = ppatch%cf(zcoord,ifl)
800  ch = ppatch%ch(ifl)
801 
802  cmass = ppatch%cmass(ifl)
803  cmomx = ppatch%cmom(xcoord,ifl)
804  cmomy = ppatch%cmom(ycoord,ifl)
805  cmomz = ppatch%cmom(zcoord,ifl)
806 
807 ! ------------------------------------------------------------------------------
808 ! Compute contributions to force and moment coefficients
809 ! ------------------------------------------------------------------------------
810 
811  fpx = fpx + cp*nx*nm
812  fpy = fpy + cp*ny*nm
813  fpz = fpz + cp*nz*nm
814 
815  fpx_vac = fpx_vac + (cp+cpref)*nx*nm
816  fpy_vac = fpy_vac + (cp+cpref)*ny*nm
817  fpz_vac = fpz_vac + (cp+cpref)*nz*nm
818 
819  fvx = fvx + cfx*nm
820  fvy = fvy + cfy*nm
821  fvz = fvz + cfz*nm
822 
823  fmx = fmx + cmomx*nm
824  fmy = fmy + cmomy*nm
825  fmz = fmz + cmomz*nm
826 
827  mpx = mpx - cp*(ny*(zc - zref) + nz*(yc - yref))*nm
828  mpy = mpy + cp*(nx*(zc - zref) - nz*(xc - xref))*nm
829  mpz = mpz + cp*(ny*(xc - xref) - nx*(yc - yref))*nm
830 
831  mvx = mvx - (cfy*(zc - zref) + cfz*(yc - yref))*nm
832  mvy = mvy + (cfx*(zc - zref) - cfz*(xc - xref))*nm
833  mvz = mvz + (cfy*(xc - xref) - cfx*(yc - yref))*nm
834 
835  mc_in = mc_in - 0.5_rfreal*(cmass-abs(cmass))*nm
836  mc_out = mc_out + 0.5_rfreal*(cmass+abs(cmass))*nm
837  END DO ! ifl
838 
839 ! ==============================================================================
840 ! Normalize and store coefficients
841 ! ==============================================================================
842 
843  ppatch%forceCoeffs(xcoord,comp_mom ) = fmx
844  ppatch%forceCoeffs(ycoord,comp_mom ) = fmy
845  ppatch%forceCoeffs(zcoord,comp_mom ) = fmz
846 
847  ppatch%forceCoeffs(xcoord,comp_pres) = fpx
848  ppatch%forceCoeffs(ycoord,comp_pres) = fpy
849  ppatch%forceCoeffs(zcoord,comp_pres) = fpz
850 
851  ppatch%forceCoeffs(xcoord,comp_visc) = fvx
852  ppatch%forceCoeffs(ycoord,comp_visc) = fvy
853  ppatch%forceCoeffs(zcoord,comp_visc) = fvz
854 
855  ppatch%forceVacCoeffs(xcoord,comp_mom ) = fmx
856  ppatch%forceVacCoeffs(ycoord,comp_mom ) = fmy
857  ppatch%forceVacCoeffs(zcoord,comp_mom ) = fmz
858 
859  ppatch%forceVacCoeffs(xcoord,comp_pres) = fpx_vac
860  ppatch%forceVacCoeffs(ycoord,comp_pres) = fpx_vac
861  ppatch%forceVacCoeffs(zcoord,comp_pres) = fpx_vac
862 
863  ppatch%forceVacCoeffs(xcoord,comp_visc) = fvx
864  ppatch%forceVacCoeffs(ycoord,comp_visc) = fvy
865  ppatch%forceVacCoeffs(zcoord,comp_visc) = fvz
866 
867  ppatch%momentCoeffs(xcoord,comp_pres) = mpx
868  ppatch%momentCoeffs(ycoord,comp_pres) = mpy
869  ppatch%momentCoeffs(zcoord,comp_pres) = mpz
870 
871  ppatch%momentCoeffs(xcoord,comp_visc) = mvx
872  ppatch%momentCoeffs(ycoord,comp_visc) = mvy
873  ppatch%momentCoeffs(zcoord,comp_visc) = mvz
874 
875  ppatch%massCoeffs(mass_in) = mc_in
876  ppatch%massCoeffs(mass_out) = mc_out
877  END DO ! iPatch
878 
879 ! ******************************************************************************
880 ! End
881 ! ******************************************************************************
882 
883  CALL deregisterfunction(global)
884 
885  END SUBROUTINE rflu_computelocalforcesmoments
886 
887 
888 
889 
890 
891 
892 
893 
894 ! *******************************************************************************
895 !
896 ! Purpose: Create force,moment and mass coefficients.
897 !
898 ! Description: None.
899 !
900 ! Input:
901 ! pRegion Pointer to region
902 !
903 ! Output: None.
904 !
905 ! Notes: None.
906 !
907 ! ******************************************************************************
908 
909  SUBROUTINE rflu_createforcesmoments(pRegion)
910 
911  IMPLICIT NONE
912 
913 ! ******************************************************************************
914 ! Declarations and definitions
915 ! ******************************************************************************
916 
917 ! ==============================================================================
918 ! Arguments
919 ! ==============================================================================
920 
921  TYPE(t_region), POINTER :: pregion
922 
923 ! ==============================================================================
924 ! Locals
925 ! ==============================================================================
926 
927  INTEGER :: errorflag,ipatch
928  TYPE(t_global), POINTER :: global
929  TYPE(t_grid), POINTER :: pgrid
930  TYPE(t_patch), POINTER :: ppatch
931 
932 ! ******************************************************************************
933 ! Start, set pointers and variables
934 ! ******************************************************************************
935 
936  global => pregion%global
937 
938  CALL registerfunction(global,'RFLU_CreateForcesMoments',&
939  'RFLU_ModForcesMoments.F90')
940 
941  pgrid => pregion%grid
942 
943 ! ******************************************************************************
944 ! Allocate memory
945 ! ******************************************************************************
946 
947  DO ipatch = 1,pgrid%nPatches
948  ppatch => pregion%patches(ipatch)
949 
950  ALLOCATE(ppatch%forceCoeffs(xcoord:zcoord,comp_mom :comp_visc), &
951  stat=errorflag)
952  global%error = errorflag
953  IF ( global%error /= err_none ) THEN
954  CALL errorstop(global,err_allocate,__line__,'pPatch%forceCoeffs')
955  END IF ! global%error
956 
957  ALLOCATE(ppatch%forceVacCoeffs(xcoord:zcoord,comp_mom :comp_visc), &
958  stat=errorflag)
959  global%error = errorflag
960  IF ( global%error /= err_none ) THEN
961  CALL errorstop(global,err_allocate,__line__,'pPatch%forceVacCoeffs')
962  END IF ! global%error
963 
964  ALLOCATE(ppatch%momentCoeffs(xcoord:zcoord,comp_mom :comp_visc), &
965  stat=errorflag)
966  global%error = errorflag
967  IF ( global%error /= err_none ) THEN
968  CALL errorstop(global,err_allocate,__line__,'pPatch%momentCoeffs')
969  END IF ! global%error
970 
971  ALLOCATE(ppatch%massCoeffs(mass_in:mass_out),stat=errorflag)
972  global%error = errorflag
973  IF ( global%error /= err_none ) THEN
974  CALL errorstop(global,err_allocate,__line__,'pPatch%massCoeffs')
975  END IF ! global%error
976  END DO ! iPatch
977 
978  ALLOCATE(pregion%forceCoeffsGlobal(xcoord:zcoord, &
979  comp_mom:comp_visc,global%nPatches),stat=errorflag)
980  global%error = errorflag
981  IF ( global%error /= err_none ) THEN
982  CALL errorstop(global,err_allocate,__line__,'pRegion%forceCoeffsGlobal')
983  END IF ! global%error
984 
985  ALLOCATE(pregion%forceVacCoeffsGlobal(xcoord:zcoord, &
986  comp_mom:comp_visc,global%nPatches),stat=errorflag)
987  global%error = errorflag
988  IF ( global%error /= err_none ) THEN
989  CALL errorstop(global,err_allocate,__line__,'pRegion%forceVacCoeffsGlobal')
990  END IF ! global%error
991 
992  ALLOCATE(pregion%momentCoeffsGlobal(xcoord:zcoord, &
993  comp_mom:comp_visc,global%nPatches),stat=errorflag)
994  global%error = errorflag
995  IF ( global%error /= err_none ) THEN
996  CALL errorstop(global,err_allocate,__line__, &
997  'pRegion%momentCoeffsGlobal')
998  END IF ! global%error
999 
1000  ALLOCATE(pregion%massCoeffsGlobal(mass_in:mass_out, &
1001  global%nPatches),stat=errorflag)
1002  global%error = errorflag
1003  IF ( global%error /= err_none ) THEN
1004  CALL errorstop(global,err_allocate,__line__,'pRegion%massCoeffsGlobal')
1005  END IF ! global%error
1006 
1007  ALLOCATE(pregion%specImpulseGlobal(xcoord:zcoord, &
1008  global%nPatches),stat=errorflag)
1009  global%error = errorflag
1010  IF ( global%error /= err_none ) THEN
1011  CALL errorstop(global,err_allocate,__line__,'pRegion%specImpulseGlobal')
1012  END IF ! global%error
1013 
1014  ALLOCATE(pregion%specImpulseVacGlobal(xcoord:zcoord, &
1015  global%nPatches),stat=errorflag)
1016  global%error = errorflag
1017  IF ( global%error /= err_none ) THEN
1018  CALL errorstop(global,err_allocate,__line__,'pRegion%specImpulseVacGlobal')
1019  END IF ! global%error
1020 
1021  ALLOCATE(pregion%thrustGlobal(xcoord:zcoord, &
1022  global%nPatches),stat=errorflag)
1023  global%error = errorflag
1024  IF ( global%error /= err_none ) THEN
1025  CALL errorstop(global,err_allocate,__line__,'pRegion%thrustGlobal')
1026  END IF ! global%error
1027 
1028  ALLOCATE(pregion%thrustVacGlobal(xcoord:zcoord, &
1029  global%nPatches),stat=errorflag)
1030  global%error = errorflag
1031  IF ( global%error /= err_none ) THEN
1032  CALL errorstop(global,err_allocate,__line__,'pRegion%thrustVacGlobal')
1033  END IF ! global%error
1034 
1035 ! ******************************************************************************
1036 ! Initialize memory
1037 ! ******************************************************************************
1038 
1039  CALL rflu_initforcesmoments(pregion)
1040 
1041 ! ******************************************************************************
1042 ! End
1043 ! ******************************************************************************
1044 
1045  CALL deregisterfunction(global)
1046 
1047  END SUBROUTINE rflu_createforcesmoments
1048 
1049 
1050 
1051 
1052 
1053 
1054 
1055 
1056 
1057 ! *******************************************************************************
1058 !
1059 ! Purpose: Create global thrust flags.
1060 !
1061 ! Description: None.
1062 !
1063 ! Input:
1064 ! pRegion Pointer to region
1065 !
1066 ! Output: None.
1067 !
1068 ! Notes: None.
1069 !
1070 ! ******************************************************************************
1071 
1072  SUBROUTINE rflu_createglobalthrustflags(pRegion)
1073 
1074  IMPLICIT NONE
1075 
1076 ! ******************************************************************************
1077 ! Declarations and definitions
1078 ! ******************************************************************************
1079 
1080 ! ==============================================================================
1081 ! Arguments
1082 ! ==============================================================================
1083 
1084  TYPE(t_region), POINTER :: pregion
1085 
1086 ! ==============================================================================
1087 ! Locals
1088 ! ==============================================================================
1089 
1090  INTEGER :: errorflag
1091  TYPE(t_global), POINTER :: global
1092 
1093 ! ******************************************************************************
1094 ! Start, set pointers and variables
1095 ! ******************************************************************************
1096 
1097  global => pregion%global
1098 
1099  CALL registerfunction(global,'RFLU_CreateGlobalThrustFlags',&
1100  'RFLU_ModForcesMoments.F90')
1101 
1102 ! ******************************************************************************
1103 ! Allocate memory
1104 ! ******************************************************************************
1105 
1106  ALLOCATE(pregion%thrustFlagsGlobal(global%nPatches),stat=errorflag)
1107  global%error = errorflag
1108  IF ( global%error /= err_none ) THEN
1109  CALL errorstop(global,err_allocate,__line__,'pRegion%thrustFlagsGlobal')
1110  END IF ! global%error
1111 
1112 ! ******************************************************************************
1113 ! Initialize memory
1114 ! ******************************************************************************
1115 
1116  CALL rflu_initglobalthrustflags(pregion)
1117 
1118 ! ******************************************************************************
1119 ! End
1120 ! ******************************************************************************
1121 
1122  CALL deregisterfunction(global)
1123 
1124  END SUBROUTINE rflu_createglobalthrustflags
1125 
1126 
1127 
1128 
1129 
1130 
1131 
1132 
1133 ! *******************************************************************************
1134 !
1135 ! Purpose: Destroy force, moment and mass coefficients.
1136 !
1137 ! Description: None.
1138 !
1139 ! Input:
1140 ! pRegion Pointer to region
1141 !
1142 ! Output: None.
1143 !
1144 ! Notes: None.
1145 !
1146 ! ******************************************************************************
1147 
1148  SUBROUTINE rflu_destroyforcesmoments(pRegion)
1149 
1150  IMPLICIT NONE
1151 
1152 ! ******************************************************************************
1153 ! Declarations and definitions
1154 ! ******************************************************************************
1155 
1156 ! ==============================================================================
1157 ! Arguments
1158 ! ==============================================================================
1159 
1160  TYPE(t_region), POINTER :: pregion
1161 
1162 ! ==============================================================================
1163 ! Locals
1164 ! ==============================================================================
1165 
1166  INTEGER :: errorflag,ipatch
1167  TYPE(t_global), POINTER :: global
1168  TYPE(t_grid), POINTER :: pgrid
1169  TYPE(t_patch), POINTER :: ppatch
1170 
1171 ! ******************************************************************************
1172 ! Start, set pointers and variables
1173 ! ******************************************************************************
1174 
1175  global => pregion%global
1176 
1177  CALL registerfunction(global,'RFLU_DestroyForcesMoments',&
1178  'RFLU_ModForcesMoments.F90')
1179 
1180  pgrid => pregion%grid
1181 
1182 ! ******************************************************************************
1183 ! Deallocate memory
1184 ! ******************************************************************************
1185 
1186  DO ipatch = 1,pgrid%nPatches
1187  ppatch => pregion%patches(ipatch)
1188 
1189  DEALLOCATE(ppatch%forceCoeffs,stat=errorflag)
1190  global%error = errorflag
1191  IF ( global%error /= err_none ) THEN
1192  CALL errorstop(global,err_deallocate,__line__,'pPatch%forceCoeffs')
1193  END IF ! global%error
1194 
1195  DEALLOCATE(ppatch%forceVacCoeffs,stat=errorflag)
1196  global%error = errorflag
1197  IF ( global%error /= err_none ) THEN
1198  CALL errorstop(global,err_deallocate,__line__,'pPatch%forceVacCoeffs')
1199  END IF ! global%error
1200 
1201  DEALLOCATE(ppatch%momentCoeffs,stat=errorflag)
1202  global%error = errorflag
1203  IF ( global%error /= err_none ) THEN
1204  CALL errorstop(global,err_deallocate,__line__,'pPatch%momentCoeffs')
1205  END IF ! global%error
1206 
1207  DEALLOCATE(ppatch%massCoeffs,stat=errorflag)
1208  global%error = errorflag
1209  IF ( global%error /= err_none ) THEN
1210  CALL errorstop(global,err_deallocate,__line__,'pPatch%massCoeffs')
1211  END IF ! global%error
1212  END DO ! iPatch
1213 
1214  DEALLOCATE(pregion%forceCoeffsGlobal,stat=errorflag)
1215  global%error = errorflag
1216  IF ( global%error /= err_none ) THEN
1217  CALL errorstop(global,err_deallocate,__line__, &
1218  'pRegion%forceCoeffsGlobal')
1219  END IF ! global%error
1220 
1221  DEALLOCATE(pregion%forceVacCoeffsGlobal,stat=errorflag)
1222  global%error = errorflag
1223  IF ( global%error /= err_none ) THEN
1224  CALL errorstop(global,err_deallocate,__line__, &
1225  'pRegion%forceVacCoeffsGlobal')
1226  END IF ! global%error
1227 
1228  DEALLOCATE(pregion%momentCoeffsGlobal,stat=errorflag)
1229  global%error = errorflag
1230  IF ( global%error /= err_none ) THEN
1231  CALL errorstop(global,err_deallocate,__line__, &
1232  'pRegion%momentCoeffsGlobal')
1233  END IF ! global%error
1234 
1235  DEALLOCATE(pregion%massCoeffsGlobal,stat=errorflag)
1236  global%error = errorflag
1237  IF ( global%error /= err_none ) THEN
1238  CALL errorstop(global,err_deallocate,__line__,'pRegion%massCoeffsGlobal')
1239  END IF ! global%error
1240 
1241  DEALLOCATE(pregion%specImpulseGlobal,stat=errorflag)
1242  global%error = errorflag
1243  IF ( global%error /= err_none ) THEN
1244  CALL errorstop(global,err_deallocate,__line__,'pRegion%specImpulseGlobal')
1245  END IF ! global%error
1246 
1247  DEALLOCATE(pregion%specImpulseVacGlobal,stat=errorflag)
1248  global%error = errorflag
1249  IF ( global%error /= err_none ) THEN
1250  CALL errorstop(global,err_deallocate,__line__,'pRegion%specImpulseVacGlobal')
1251  END IF ! global%error
1252 
1253  DEALLOCATE(pregion%thrustGlobal,stat=errorflag)
1254  global%error = errorflag
1255  IF ( global%error /= err_none ) THEN
1256  CALL errorstop(global,err_deallocate,__line__,'pRegion%thrustGlobal')
1257  END IF ! global%error
1258 
1259  DEALLOCATE(pregion%thrustVacGlobal,stat=errorflag)
1260  global%error = errorflag
1261  IF ( global%error /= err_none ) THEN
1262  CALL errorstop(global,err_deallocate,__line__,'pRegion%thrustVacGlobal')
1263  END IF ! global%error
1264 
1265 ! ******************************************************************************
1266 ! Nullify memory
1267 ! ******************************************************************************
1268 
1269  CALL rflu_nullifyforcesmoments(pregion)
1270 
1271 ! ******************************************************************************
1272 ! End
1273 ! ******************************************************************************
1274 
1275  CALL deregisterfunction(global)
1276 
1277  END SUBROUTINE rflu_destroyforcesmoments
1278 
1279 
1280 
1281 
1282 
1283 
1284 
1285 
1286 
1287 ! *******************************************************************************
1288 !
1289 ! Purpose: Destroy global thrust flags
1290 !
1291 ! Description: None.
1292 !
1293 ! Input:
1294 ! pRegion Pointer to region
1295 !
1296 ! Output: None.
1297 !
1298 ! Notes: None.
1299 !
1300 ! ******************************************************************************
1301 
1302  SUBROUTINE rflu_destroyglobalthrustflags(pRegion)
1303 
1304  IMPLICIT NONE
1305 
1306 ! ******************************************************************************
1307 ! Declarations and definitions
1308 ! ******************************************************************************
1309 
1310 ! ==============================================================================
1311 ! Arguments
1312 ! ==============================================================================
1313 
1314  TYPE(t_region), POINTER :: pregion
1315 
1316 ! ==============================================================================
1317 ! Locals
1318 ! ==============================================================================
1319 
1320  INTEGER :: errorflag
1321  TYPE(t_global), POINTER :: global
1322 
1323 ! ******************************************************************************
1324 ! Start, set pointers and variables
1325 ! ******************************************************************************
1326 
1327  global => pregion%global
1328 
1329  CALL registerfunction(global,'RFLU_DestroyGlobalThrustFlag',&
1330  'RFLU_ModForcesMoments.F90')
1331 
1332 ! ******************************************************************************
1333 ! Deallocate memory
1334 ! ******************************************************************************
1335 
1336  DEALLOCATE(pregion%thrustFlagsGlobal,stat=errorflag)
1337  global%error = errorflag
1338  IF ( global%error /= err_none ) THEN
1339  CALL errorstop(global,err_deallocate,__line__,'pRegion%thrustFlagsGlobal')
1340  END IF ! global%error
1341 
1342 ! ******************************************************************************
1343 ! Nullify memory
1344 ! ******************************************************************************
1345 
1346  CALL rflu_nullifyglobalthrustflags(pregion)
1347 
1348 ! ******************************************************************************
1349 ! End
1350 ! ******************************************************************************
1351 
1352  CALL deregisterfunction(global)
1353 
1354  END SUBROUTINE rflu_destroyglobalthrustflags
1355 
1356 
1357 
1358 
1359 
1360 
1361 
1362 ! *******************************************************************************
1363 !
1364 ! Purpose: Initialize force, moment and mass coefficients.
1365 !
1366 ! Description: None.
1367 !
1368 ! Input:
1369 ! pRegion Pointer to region
1370 !
1371 ! Output: None.
1372 !
1373 ! Notes: None.
1374 !
1375 ! ******************************************************************************
1376 
1377  SUBROUTINE rflu_initforcesmoments(pRegion)
1378 
1379  IMPLICIT NONE
1380 
1381 ! ******************************************************************************
1382 ! Declarations and definitions
1383 ! ******************************************************************************
1384 
1385 ! ==============================================================================
1386 ! Arguments
1387 ! ==============================================================================
1388 
1389  TYPE(t_region), POINTER :: pregion
1390 
1391 ! ==============================================================================
1392 ! Locals
1393 ! ==============================================================================
1394 
1395  INTEGER :: ipatch
1396  TYPE(t_global), POINTER :: global
1397  TYPE(t_grid), POINTER :: pgrid
1398  TYPE(t_patch), POINTER :: ppatch
1399 
1400 ! ******************************************************************************
1401 ! Start, set pointers and variables
1402 ! ******************************************************************************
1403 
1404  global => pregion%global
1405 
1406  CALL registerfunction(global,'RFLU_InitForcesMoments',&
1407  'RFLU_ModForcesMoments.F90')
1408 
1409  pgrid => pregion%grid
1410 
1411 ! ******************************************************************************
1412 ! Allocate memory
1413 ! ******************************************************************************
1414 
1415  DO ipatch = 1,pgrid%nPatches
1416  ppatch => pregion%patches(ipatch)
1417 
1418  ppatch%forceCoeffs(xcoord,comp_mom ) = 0.0_rfreal
1419  ppatch%forceCoeffs(xcoord,comp_pres) = 0.0_rfreal
1420  ppatch%forceCoeffs(xcoord,comp_visc) = 0.0_rfreal
1421  ppatch%forceCoeffs(ycoord,comp_mom ) = 0.0_rfreal
1422  ppatch%forceCoeffs(ycoord,comp_pres) = 0.0_rfreal
1423  ppatch%forceCoeffs(ycoord,comp_visc) = 0.0_rfreal
1424  ppatch%forceCoeffs(zcoord,comp_mom ) = 0.0_rfreal
1425  ppatch%forceCoeffs(zcoord,comp_pres) = 0.0_rfreal
1426  ppatch%forceCoeffs(zcoord,comp_visc) = 0.0_rfreal
1427 
1428  ppatch%forceVacCoeffs(xcoord,comp_mom ) = 0.0_rfreal
1429  ppatch%forceVacCoeffs(xcoord,comp_pres) = 0.0_rfreal
1430  ppatch%forceVacCoeffs(xcoord,comp_visc) = 0.0_rfreal
1431  ppatch%forceVacCoeffs(ycoord,comp_mom ) = 0.0_rfreal
1432  ppatch%forceVacCoeffs(ycoord,comp_pres) = 0.0_rfreal
1433  ppatch%forceVacCoeffs(ycoord,comp_visc) = 0.0_rfreal
1434  ppatch%forceVacCoeffs(zcoord,comp_mom ) = 0.0_rfreal
1435  ppatch%forceVacCoeffs(zcoord,comp_pres) = 0.0_rfreal
1436  ppatch%forceVacCoeffs(zcoord,comp_visc) = 0.0_rfreal
1437 
1438  ppatch%momentCoeffs(xcoord,comp_mom ) = 0.0_rfreal
1439  ppatch%momentCoeffs(xcoord,comp_pres) = 0.0_rfreal
1440  ppatch%momentCoeffs(xcoord,comp_visc) = 0.0_rfreal
1441  ppatch%momentCoeffs(ycoord,comp_mom ) = 0.0_rfreal
1442  ppatch%momentCoeffs(ycoord,comp_pres) = 0.0_rfreal
1443  ppatch%momentCoeffs(ycoord,comp_visc) = 0.0_rfreal
1444  ppatch%momentCoeffs(zcoord,comp_mom ) = 0.0_rfreal
1445  ppatch%momentCoeffs(zcoord,comp_pres) = 0.0_rfreal
1446  ppatch%momentCoeffs(zcoord,comp_visc) = 0.0_rfreal
1447 
1448  ppatch%massCoeffs(mass_in) = 0.0_rfreal
1449  ppatch%massCoeffs(mass_out) = 0.0_rfreal
1450  END DO ! iPatch
1451 
1452  DO ipatch = 1,pregion%global%nPatches
1453  pregion%forceCoeffsGlobal(xcoord,comp_mom ,ipatch) = 0.0_rfreal
1454  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch) = 0.0_rfreal
1455  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch) = 0.0_rfreal
1456  pregion%forceCoeffsGlobal(ycoord,comp_mom ,ipatch) = 0.0_rfreal
1457  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch) = 0.0_rfreal
1458  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch) = 0.0_rfreal
1459  pregion%forceCoeffsGlobal(zcoord,comp_mom ,ipatch) = 0.0_rfreal
1460  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch) = 0.0_rfreal
1461  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch) = 0.0_rfreal
1462 
1463  pregion%forceVacCoeffsGlobal(xcoord,comp_mom ,ipatch) = 0.0_rfreal
1464  pregion%forceVacCoeffsGlobal(xcoord,comp_pres,ipatch) = 0.0_rfreal
1465  pregion%forceVacCoeffsGlobal(xcoord,comp_visc,ipatch) = 0.0_rfreal
1466  pregion%forceVacCoeffsGlobal(ycoord,comp_mom ,ipatch) = 0.0_rfreal
1467  pregion%forceVacCoeffsGlobal(ycoord,comp_pres,ipatch) = 0.0_rfreal
1468  pregion%forceVacCoeffsGlobal(ycoord,comp_visc,ipatch) = 0.0_rfreal
1469  pregion%forceVacCoeffsGlobal(zcoord,comp_mom ,ipatch) = 0.0_rfreal
1470  pregion%forceVacCoeffsGlobal(zcoord,comp_pres,ipatch) = 0.0_rfreal
1471  pregion%forceVacCoeffsGlobal(zcoord,comp_visc,ipatch) = 0.0_rfreal
1472 
1473  pregion%momentCoeffsGlobal(xcoord,comp_mom ,ipatch) = 0.0_rfreal
1474  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch) = 0.0_rfreal
1475  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch) = 0.0_rfreal
1476  pregion%momentCoeffsGlobal(ycoord,comp_mom ,ipatch) = 0.0_rfreal
1477  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch) = 0.0_rfreal
1478  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch) = 0.0_rfreal
1479  pregion%momentCoeffsGlobal(zcoord,comp_mom ,ipatch) = 0.0_rfreal
1480  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch) = 0.0_rfreal
1481  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch) = 0.0_rfreal
1482 
1483  pregion%massCoeffsGlobal(mass_in ,ipatch) = 0.0_rfreal
1484  pregion%massCoeffsGlobal(mass_out,ipatch) = 0.0_rfreal
1485 
1486  pregion%specImpulseGlobal(xcoord,ipatch) = 0.0_rfreal
1487  pregion%specImpulseGlobal(ycoord,ipatch) = 0.0_rfreal
1488  pregion%specImpulseGlobal(zcoord,ipatch) = 0.0_rfreal
1489 
1490  pregion%specImpulseVacGlobal(xcoord,ipatch) = 0.0_rfreal
1491  pregion%specImpulseVacGlobal(ycoord,ipatch) = 0.0_rfreal
1492  pregion%specImpulseVacGlobal(zcoord,ipatch) = 0.0_rfreal
1493 
1494  pregion%thrustGlobal(xcoord,ipatch) = 0.0_rfreal
1495  pregion%thrustGlobal(ycoord,ipatch) = 0.0_rfreal
1496  pregion%thrustGlobal(zcoord,ipatch) = 0.0_rfreal
1497 
1498  pregion%thrustVacGlobal(xcoord,ipatch) = 0.0_rfreal
1499  pregion%thrustVacGlobal(ycoord,ipatch) = 0.0_rfreal
1500  pregion%thrustVacGlobal(zcoord,ipatch) = 0.0_rfreal
1501  END DO ! iPatch
1502 
1503 ! ******************************************************************************
1504 ! End
1505 ! ******************************************************************************
1506 
1507  CALL deregisterfunction(global)
1508 
1509  END SUBROUTINE rflu_initforcesmoments
1510 
1511 
1512 
1513 
1514 
1515 
1516 
1517 ! *******************************************************************************
1518 !
1519 ! Purpose: Initialize global thrust flags.
1520 !
1521 ! Description: None.
1522 !
1523 ! Input:
1524 ! pRegion Pointer to region
1525 !
1526 ! Output: None.
1527 !
1528 ! Notes: None.
1529 !
1530 ! ******************************************************************************
1531 
1532  SUBROUTINE rflu_initglobalthrustflags(pRegion)
1533 
1534  IMPLICIT NONE
1535 
1536 ! ******************************************************************************
1537 ! Declarations and definitions
1538 ! ******************************************************************************
1539 
1540 ! ==============================================================================
1541 ! Arguments
1542 ! ==============================================================================
1543 
1544  TYPE(t_region), POINTER :: pregion
1545 
1546 ! ==============================================================================
1547 ! Locals
1548 ! ==============================================================================
1549 
1550  INTEGER :: ipatch
1551  TYPE(t_global), POINTER :: global
1552 
1553 ! ******************************************************************************
1554 ! Start, set pointers and variables
1555 ! ******************************************************************************
1556 
1557  global => pregion%global
1558 
1559  CALL registerfunction(global,'RFLU_InitGlobalThrustFlags',&
1560  'RFLU_ModForcesMoments.F90')
1561 
1562 ! ******************************************************************************
1563 ! Allocate memory
1564 ! ******************************************************************************
1565 
1566  DO ipatch = 1,pregion%global%nPatches
1567  pregion%thrustFlagsGlobal(ipatch) = .false.
1568  END DO ! iPatch
1569 
1570 ! ******************************************************************************
1571 ! End
1572 ! ******************************************************************************
1573 
1574  CALL deregisterfunction(global)
1575 
1576  END SUBROUTINE rflu_initglobalthrustflags
1577 
1578 
1579 
1580 
1581 
1582 
1583 
1584 
1585 ! *******************************************************************************
1586 !
1587 ! Purpose: Nullify force, moment and mass coefficients.
1588 !
1589 ! Description: None.
1590 !
1591 ! Input:
1592 ! pRegion Pointer to region
1593 !
1594 ! Output: None.
1595 !
1596 ! Notes: None.
1597 !
1598 ! ******************************************************************************
1599 
1600  SUBROUTINE rflu_nullifyforcesmoments(pRegion)
1601 
1602  IMPLICIT NONE
1603 
1604 ! ******************************************************************************
1605 ! Declarations and definitions
1606 ! ******************************************************************************
1607 
1608 ! ==============================================================================
1609 ! Arguments
1610 ! ==============================================================================
1611 
1612  TYPE(t_region), POINTER :: pregion
1613 
1614 ! ==============================================================================
1615 ! Locals
1616 ! ==============================================================================
1617 
1618  INTEGER :: ipatch
1619  TYPE(t_global), POINTER :: global
1620  TYPE(t_grid), POINTER :: pgrid
1621  TYPE(t_patch), POINTER :: ppatch
1622 
1623 ! ******************************************************************************
1624 ! Start, set pointers and variables
1625 ! ******************************************************************************
1626 
1627  global => pregion%global
1628 
1629  CALL registerfunction(global,'RFLU_NullifyForcesMoments',&
1630  'RFLU_ModForcesMoments.F90')
1631 
1632  pgrid => pregion%grid
1633 
1634 ! ******************************************************************************
1635 ! Deallocate memory
1636 ! ******************************************************************************
1637 
1638  DO ipatch = 1,pgrid%nPatches
1639  ppatch => pregion%patches(ipatch)
1640 
1641  nullify(ppatch%forceCoeffs)
1642  nullify(ppatch%forceVacCoeffs)
1643  nullify(ppatch%momentCoeffs)
1644  nullify(ppatch%massCoeffs)
1645  END DO ! iPatch
1646 
1647  nullify(pregion%forceCoeffsGlobal)
1648  nullify(pregion%forceVacCoeffsGlobal)
1649  nullify(pregion%momentCoeffsGlobal)
1650  nullify(pregion%massCoeffsGlobal)
1651  nullify(pregion%specImpulseGlobal)
1652  nullify(pregion%specImpulseVacGlobal)
1653  nullify(pregion%thrustGlobal)
1654  nullify(pregion%thrustVacGlobal)
1655 
1656 ! ******************************************************************************
1657 ! End
1658 ! ******************************************************************************
1659 
1660  CALL deregisterfunction(global)
1661 
1662  END SUBROUTINE rflu_nullifyforcesmoments
1663 
1664 
1665 
1666 
1667 
1668 
1669 
1670 ! *******************************************************************************
1671 !
1672 ! Purpose: Nullify global thrust flags
1673 !
1674 ! Description: None.
1675 !
1676 ! Input:
1677 ! pRegion Pointer to region
1678 !
1679 ! Output: None.
1680 !
1681 ! Notes: None.
1682 !
1683 ! ******************************************************************************
1684 
1685  SUBROUTINE rflu_nullifyglobalthrustflags(pRegion)
1686 
1687  IMPLICIT NONE
1688 
1689 ! ******************************************************************************
1690 ! Declarations and definitions
1691 ! ******************************************************************************
1692 
1693 ! ==============================================================================
1694 ! Arguments
1695 ! ==============================================================================
1696 
1697  TYPE(t_region), POINTER :: pregion
1698 
1699 ! ==============================================================================
1700 ! Locals
1701 ! ==============================================================================
1702 
1703  TYPE(t_global), POINTER :: global
1704 
1705 ! ******************************************************************************
1706 ! Start, set pointers and variables
1707 ! ******************************************************************************
1708 
1709  global => pregion%global
1710 
1711  CALL registerfunction(global,'RFLU_NullifyGlobalThrustFlag',&
1712  'RFLU_ModForcesMoments.F90')
1713 
1714 ! ******************************************************************************
1715 ! Deallocate memory
1716 ! ******************************************************************************
1717 
1718  nullify(pregion%thrustFlagsGlobal)
1719 
1720 ! ******************************************************************************
1721 ! End
1722 ! ******************************************************************************
1723 
1724  CALL deregisterfunction(global)
1725 
1726  END SUBROUTINE rflu_nullifyglobalthrustflags
1727 
1728 
1729 
1730 
1731 
1732 
1733 
1734 ! *******************************************************************************
1735 !
1736 ! Purpose: Print global force and moment coefficients.
1737 !
1738 ! Description: None.
1739 !
1740 ! Input:
1741 ! pRegion Pointer to region
1742 !
1743 ! Output: None.
1744 !
1745 ! Notes:
1746 ! 1. This routine should only be called for the master process. It will not
1747 ! do anything if called by any other process (safeguard).
1748 !
1749 ! ******************************************************************************
1750 
1751  SUBROUTINE rflu_printglobalforcesmoments(pRegion)
1752 
1753  IMPLICIT NONE
1754 
1755 ! ******************************************************************************
1756 ! Declarations and definitions
1757 ! ******************************************************************************
1758 
1759 ! ==============================================================================
1760 ! Arguments
1761 ! ==============================================================================
1762 
1763  TYPE(t_region), POINTER :: pregion
1764 
1765 ! ==============================================================================
1766 ! Locals
1767 ! ==============================================================================
1768 
1769  INTEGER :: ipatch
1770  TYPE(t_global), POINTER :: global
1771 
1772 ! ******************************************************************************
1773 ! Start, set pointers and variables
1774 ! ******************************************************************************
1775 
1776  global => pregion%global
1777 
1778  CALL registerfunction(global,'RFLU_PrintGlobalForcesMoments',&
1779  'RFLU_ModForcesMoments.F90')
1780 
1781 ! ******************************************************************************
1782 ! Print global force coefficients
1783 ! ******************************************************************************
1784 
1785  IF ( global%myProcid == masterproc .AND. &
1786  global%verbLevel > verbose_low ) THEN
1787  WRITE(stdout,'(A,1X,A)') solver_name,'Printing global force and '// &
1788  'moment coefficients...'
1789  WRITE(stdout,'(A,3X,A)') solver_name,'Force coefficients:'
1790 
1791  DO ipatch = 1,global%nPatches
1792  WRITE(stdout,'(A,5X,A,1X,I2)') solver_name,'Patch:',ipatch
1793  WRITE(stdout,'(A,7X,A,7X,A,6X,A,8X,A)') solver_name, &
1794  'Component','Pressure','Viscous','Total'
1795  WRITE(stdout,'(A,7X,A,3(1X,E13.6))') solver_name,'x-direction:', &
1796  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch), &
1797  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch), &
1798  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch)+ &
1799  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch)
1800  WRITE(stdout,'(A,7X,A,3(1X,E13.6))') solver_name,'y-direction:', &
1801  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch), &
1802  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch), &
1803  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch)+ &
1804  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch)
1805  WRITE(stdout,'(A,7X,A,3(1X,E13.6))') solver_name,'z-direction:', &
1806  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch), &
1807  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch), &
1808  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch)+ &
1809  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch)
1810  END DO ! iPatch
1811 
1812  WRITE(stdout,'(A,3X,A)') solver_name,'Moment coefficients:'
1813 
1814  DO ipatch = 1,global%nPatches
1815  WRITE(stdout,'(A,5X,A,1X,I2)') solver_name,'Patch:',ipatch
1816  WRITE(stdout,'(A,7X,A,7X,A,6X,A,8X,A)') solver_name, &
1817  'Component','Pressure','Viscous','Total'
1818  WRITE(stdout,'(A,7X,A,3(1X,E13.6))') solver_name,'x-direction:', &
1819  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch), &
1820  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch), &
1821  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch)+ &
1822  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch)
1823  WRITE(stdout,'(A,7X,A,3(1X,E13.6))') solver_name,'y-direction:', &
1824  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch), &
1825  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch), &
1826  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch)+ &
1827  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch)
1828  WRITE(stdout,'(A,7X,A,3(1X,E13.6))') solver_name,'z-direction:', &
1829  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch), &
1830  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch), &
1831  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch)+ &
1832  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch)
1833  END DO ! iPatch
1834 
1835  WRITE(stdout,'(A,1X,A)') solver_name,'Printing global force and '// &
1836  'moment coefficients done.'
1837  END IF ! global%myProcid
1838 
1839 ! ******************************************************************************
1840 ! End
1841 ! ******************************************************************************
1842 
1843  CALL deregisterfunction(global)
1844 
1845  END SUBROUTINE rflu_printglobalforcesmoments
1846 
1847 
1848 
1849 
1850 
1851 
1852 
1853 ! *******************************************************************************
1854 !
1855 ! Purpose: Set global thrust flags.
1856 !
1857 ! Description: None.
1858 !
1859 ! Input:
1860 ! regions Region data
1861 !
1862 ! Output: None.
1863 !
1864 ! Notes: None.
1865 !
1866 ! ******************************************************************************
1867 
1868  SUBROUTINE rflu_setglobalthrustflags(regions)
1869 
1870  IMPLICIT NONE
1871 
1872 ! ******************************************************************************
1873 ! Declarations and definitions
1874 ! ******************************************************************************
1875 
1876 ! ==============================================================================
1877 ! Arguments
1878 ! ==============================================================================
1879 
1880  TYPE(t_region), DIMENSION(:), POINTER :: regions
1881 
1882 ! ==============================================================================
1883 ! Locals
1884 ! ==============================================================================
1885 
1886  INTEGER :: errorflag,ipatch,ipatchglobal,ireg,nvals
1887  INTEGER, DIMENSION(:), ALLOCATABLE :: globalvals,localvals
1888  TYPE(t_global), POINTER :: global
1889  TYPE(t_grid), POINTER :: pgrid
1890  TYPE(t_patch), POINTER :: ppatch
1891  TYPE(t_region), POINTER :: pregion
1892 
1893 ! ******************************************************************************
1894 ! Start, set pointers and variables
1895 ! ******************************************************************************
1896 
1897  global => regions(1)%global
1898 
1899  CALL registerfunction(global,'RFLU_SetGlobalThrustFlags',&
1900  'RFLU_ModForcesMoments.F90')
1901 
1902 ! ******************************************************************************
1903 ! Set variables
1904 ! ******************************************************************************
1905 
1906  nvals = global%nPatches
1907 
1908 ! ******************************************************************************
1909 ! Allocate temporary memory
1910 ! ******************************************************************************
1911 
1912  ALLOCATE(globalvals(global%nPatches),stat=errorflag)
1913  global%error = errorflag
1914  IF ( global%error /= err_none ) THEN
1915  CALL errorstop(global,err_allocate,__line__,'globalVals')
1916  END IF ! global%error
1917 
1918  ALLOCATE(localvals(global%nPatches),stat=errorflag)
1919  global%error = errorflag
1920  IF ( global%error /= err_none ) THEN
1921  CALL errorstop(global,err_allocate,__line__,'localVals')
1922  END IF ! global%error
1923 
1924 ! ******************************************************************************
1925 ! Compute global thrust coefficients flags
1926 ! ******************************************************************************
1927 
1928  DO ipatch = 1,global%nPatches
1929  globalvals(ipatch) = 0 ! NOTE must be zero
1930  localvals(ipatch) = 0
1931  END DO ! iPatch
1932 
1933 ! ==============================================================================
1934 ! Set local thrust coefficients flags
1935 ! ==============================================================================
1936 
1937  DO ireg = 1,global%nRegionsLocal
1938  pregion => regions(ireg)
1939  pgrid => pregion%grid
1940 
1941  DO ipatch = 1,pgrid%nPatches
1942  ppatch => pregion%patches(ipatch)
1943 
1944  ipatchglobal = ppatch%iPatchGlobal
1945 
1946  IF ( ppatch%thrustFlag .EQV. .true. ) THEN
1947  localvals(ipatchglobal) = localvals(ipatchglobal) + 1
1948  END IF ! pPatch%thrustFlag
1949  END DO ! iPatch
1950  END DO ! iReg
1951 
1952 ! ==============================================================================
1953 ! Compute global thrust coefficients flags
1954 ! ==============================================================================
1955 
1956  CALL mpi_allreduce(localvals,globalvals,nvals,mpi_integer,mpi_sum, &
1957  global%mpiComm,errorflag)
1958  global%error = errorflag
1959  IF ( global%error /= err_none ) THEN
1960  CALL errorstop(global,err_mpi_output,__line__)
1961  END IF ! global%error
1962 
1963  DO ireg = 1,global%nRegionsLocal
1964  DO ipatch = 1,pregion%global%nPatches
1965  IF ( globalvals(ipatch) > 0 ) THEN
1966  regions(ireg)%thrustFlagsGlobal(ipatch) = .true.
1967  END IF ! pPatch%thrustFlag
1968  END DO ! iPatch
1969  END DO ! iReg
1970 
1971 ! ******************************************************************************
1972 ! Deallocate temporary memory
1973 ! ******************************************************************************
1974 
1975  DEALLOCATE(globalvals,stat=errorflag)
1976  global%error = errorflag
1977  IF ( global%error /= err_none ) THEN
1978  CALL errorstop(global,err_deallocate,__line__,'globalVals')
1979  END IF ! global%error
1980 
1981  DEALLOCATE(localvals,stat=errorflag)
1982  global%error = errorflag
1983  IF ( global%error /= err_none ) THEN
1984  CALL errorstop(global,err_deallocate,__line__,'localVals')
1985  END IF ! global%error
1986 
1987 ! ******************************************************************************
1988 ! End
1989 ! ******************************************************************************
1990 
1991  CALL deregisterfunction(global)
1992 
1993  END SUBROUTINE rflu_setglobalthrustflags
1994 
1995 
1996 
1997 
1998 
1999 
2000 
2001 
2002 ! *******************************************************************************
2003 !
2004 ! Purpose: Write global force and moment coefficients to file.
2005 !
2006 ! Description: None.
2007 !
2008 ! Input:
2009 ! pRegion Pointer to region
2010 !
2011 ! Output: None.
2012 !
2013 ! Notes:
2014 ! 1. This routine should only be called for the master process. It will not
2015 ! do anything if called by any other process (safeguard).
2016 ! 2. At present, each patch is written to separate file. This may change in
2017 ! future with definition of superpatches which are treated together.
2018 !
2019 ! ******************************************************************************
2020 
2021  SUBROUTINE rflu_writeglobalforcesmoments(pRegion)
2022 
2023  IMPLICIT NONE
2024 
2025 ! ******************************************************************************
2026 ! Declarations and definitions
2027 ! ******************************************************************************
2028 
2029 ! ==============================================================================
2030 ! Arguments
2031 ! ==============================================================================
2032 
2033  TYPE(t_region), POINTER :: pregion
2034 
2035 ! ==============================================================================
2036 ! Locals
2037 ! ==============================================================================
2038 
2039  LOGICAL :: fileexists
2040  CHARACTER(CHRLEN) :: ifilename
2041  INTEGER :: errorflag,ifile,ipatch
2042  TYPE(t_global), POINTER :: global
2043 
2044 ! ******************************************************************************
2045 ! Start, set pointers and variables
2046 ! ******************************************************************************
2047 
2048  global => pregion%global
2049 
2050  CALL registerfunction(global,'RFLU_WriteGlobalForcesMoments',&
2051  'RFLU_ModForcesMoments.F90')
2052 
2053 ! ******************************************************************************
2054 ! Increment counter
2055 ! ******************************************************************************
2056 
2057  global%forceWriteCntr = global%forceWriteCntr + 1
2058 
2059 ! ******************************************************************************
2060 ! Write global force coefficients
2061 ! ******************************************************************************
2062 
2063  ifile = if_formom
2064 
2065  IF ( global%myProcid == masterproc ) THEN
2066  IF ( global%verbLevel > verbose_low ) THEN
2067  WRITE(stdout,'(A,1X,A)') solver_name,'Writing global force and '// &
2068  'moment coefficients...'
2069  END IF ! global%verbLevel
2070 
2071 ! ==============================================================================
2072 ! Loop over patches
2073 ! ==============================================================================
2074 
2075  DO ipatch = 1,global%nPatches
2076  IF ( global%verbLevel > verbose_low ) THEN
2077  WRITE(stdout,'(A,3X,A,1X,I2)') solver_name,'Patch:',ipatch
2078  END IF ! global%verbLevel
2079 
2080 ! ------------------------------------------------------------------------------
2081 ! Build file name
2082 ! ------------------------------------------------------------------------------
2083 
2084  WRITE(ifilename,'(A,I4.4)') trim(global%outDir)// &
2085  trim(global%casename)//'.fom_',ipatch
2086 
2087 ! ------------------------------------------------------------------------------
2088 ! Open file
2089 ! ------------------------------------------------------------------------------
2090 
2091  IF ( global%restartFromScratch .EQV. .false. ) THEN
2092  INQUIRE(file=ifilename,exist=fileexists)
2093 
2094  IF ( fileexists .EQV. .true. ) THEN
2095  OPEN(ifile,file=ifilename,form='FORMATTED',status='OLD', &
2096  position='APPEND',iostat=errorflag)
2097  ELSE
2098  OPEN(ifile,file=ifilename,form='FORMATTED',status='NEW', &
2099  iostat=errorflag)
2100  END IF ! fileExists
2101  ELSE
2102  IF ( global%forceWriteCntr == 1 ) THEN
2103  OPEN(ifile,file=ifilename,form='FORMATTED',status='UNKNOWN', &
2104  iostat=errorflag)
2105  ELSE
2106  OPEN(ifile,file=ifilename,form='FORMATTED',status='OLD', &
2107  position='APPEND',iostat=errorflag)
2108  END IF ! global%forceWriteCntr
2109  END IF ! global
2110 
2111  global%error = errorflag
2112 
2113  IF ( global%error /= err_none ) THEN
2114  CALL errorstop(global,err_file_open,__line__,'File: '// &
2115  trim(ifilename))
2116  END IF ! global%error
2117 
2118 ! ------------------------------------------------------------------------------
2119 ! Write to file
2120 ! ------------------------------------------------------------------------------
2121 
2122  IF ( global%flowType == flow_steady ) THEN
2123  WRITE(ifile,'(I6,18(1X,E13.6))') global%currentIter, &
2124  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch), &
2125  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch), &
2126  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch)+ &
2127  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch), &
2128 
2129  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch), &
2130  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch), &
2131  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch)+ &
2132  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch), &
2133 
2134  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch), &
2135  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch), &
2136  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch)+ &
2137  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch), &
2138 
2139  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch), &
2140  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch), &
2141  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch)+ &
2142  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch), &
2143 
2144  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch), &
2145  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch), &
2146  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch)+ &
2147  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch), &
2148 
2149  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch), &
2150  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch), &
2151  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch)+ &
2152  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch)
2153  ELSE
2154  WRITE(ifile,'(1PE12.5,18(1X,E13.6))') global%currentTime, &
2155  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch), &
2156  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch), &
2157  pregion%forceCoeffsGlobal(xcoord,comp_pres,ipatch)+ &
2158  pregion%forceCoeffsGlobal(xcoord,comp_visc,ipatch), &
2159 
2160  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch), &
2161  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch), &
2162  pregion%forceCoeffsGlobal(ycoord,comp_pres,ipatch)+ &
2163  pregion%forceCoeffsGlobal(ycoord,comp_visc,ipatch), &
2164 
2165  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch), &
2166  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch), &
2167  pregion%forceCoeffsGlobal(zcoord,comp_pres,ipatch)+ &
2168  pregion%forceCoeffsGlobal(zcoord,comp_visc,ipatch), &
2169 
2170  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch), &
2171  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch), &
2172  pregion%momentCoeffsGlobal(xcoord,comp_pres,ipatch)+ &
2173  pregion%momentCoeffsGlobal(xcoord,comp_visc,ipatch), &
2174 
2175  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch), &
2176  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch), &
2177  pregion%momentCoeffsGlobal(ycoord,comp_pres,ipatch)+ &
2178  pregion%momentCoeffsGlobal(ycoord,comp_visc,ipatch), &
2179 
2180  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch), &
2181  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch), &
2182  pregion%momentCoeffsGlobal(zcoord,comp_pres,ipatch)+ &
2183  pregion%momentCoeffsGlobal(zcoord,comp_visc,ipatch)
2184  END IF ! global%flowType
2185 
2186 ! ------------------------------------------------------------------------------
2187 ! Close file
2188 ! ------------------------------------------------------------------------------
2189 
2190  CLOSE(ifile,iostat=errorflag)
2191  IF (global%error /= err_none ) THEN
2192  CALL errorstop(global,err_file_close,__line__,'File: '// &
2193  trim(ifilename))
2194  END IF ! global%error
2195  END DO ! iPatch
2196 
2197  IF ( global%verbLevel > verbose_low ) THEN
2198  WRITE(stdout,'(A,1X,A)') solver_name,'Writing global force and '// &
2199  'moment coefficients done.'
2200  END IF ! global%verbLevel
2201  END IF ! global%myProcid
2202 
2203 ! ******************************************************************************
2204 ! End
2205 ! ******************************************************************************
2206 
2207  CALL deregisterfunction(global)
2208 
2209  END SUBROUTINE rflu_writeglobalforcesmoments
2210 
2211 
2212 
2213 
2214 
2215 
2216 END MODULE rflu_modforcesmoments
2217 
2218 ! ******************************************************************************
2219 !
2220 ! RCS Revision history:
2221 !
2222 ! $Log: RFLU_ModForcesMoments.F90,v $
2223 ! Revision 1.11 2008/12/06 08:44:21 mtcampbe
2224 ! Updated license.
2225 !
2226 ! Revision 1.10 2008/11/19 22:17:32 mtcampbe
2227 ! Added Illinois Open Source License/Copyright
2228 !
2229 ! Revision 1.9 2007/12/19 19:13:42 rfiedler
2230 ! Increased verbosity level required for writing to screen dump to > VERBOSE_LOW.
2231 !
2232 ! Revision 1.8 2006/11/02 21:08:34 mparmar
2233 ! Bug fix in storing local force-coeffs and normalizing global mass-coeffs
2234 !
2235 ! Revision 1.7 2006/10/20 21:18:05 mparmar
2236 ! Added code for thrust and specific impulse computation
2237 !
2238 ! Revision 1.6 2006/04/07 15:19:19 haselbac
2239 ! Removed tabs
2240 !
2241 ! Revision 1.5 2005/04/15 15:06:53 haselbac
2242 ! Converted to MPI
2243 !
2244 ! Revision 1.4 2005/01/05 01:43:32 haselbac
2245 ! Added init of global coeffs, now also defined for all regions
2246 !
2247 ! Revision 1.3 2004/07/06 15:14:40 haselbac
2248 ! Cosmetics only
2249 !
2250 ! Revision 1.2 2004/06/25 20:07:47 haselbac
2251 ! Various improvements, fixed bug in file output format statements
2252 !
2253 ! Revision 1.1 2004/06/16 20:00:59 haselbac
2254 ! Initial revision
2255 !
2256 ! ******************************************************************************
2257 
2258 
2259 
2260 
2261 
2262 
2263 
2264 
2265 
2266 
2267 
2268 
2269 
2270 
2271 
2272 
2273 
2274 
2275 
subroutine, private rflu_nullifyforcesmoments(pRegion)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
subroutine, private rflu_initforcesmoments(pRegion)
subroutine, public rflu_destroyforcesmoments(pRegion)
subroutine, public rflu_createforcesmoments(pRegion)
subroutine, public rflu_setglobalthrustflags(regions)
subroutine, private rflu_initglobalthrustflags(pRegion)
subroutine, public rflu_writeglobalforcesmoments(pRegion)
**********************************************************************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 SUBROUTINE form
subroutine, public rflu_computeglobalforcesmoments(regions)
subroutine, public rflu_computelocalforcesmoments(pRegion)
**********************************************************************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
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine, public rflu_destroyglobalthrustflags(pRegion)
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine, private rflu_nullifyglobalthrustflags(pRegion)
subroutine, public rflu_printglobalforcesmoments(pRegion)
subroutine, public rflu_createglobalthrustflags(pRegion)