Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModDifferentiationBFaces.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 differentiate functions at boundary face
26 ! centroids.
27 !
28 ! Description: None.
29 !
30 ! Notes: None.
31 !
32 ! ******************************************************************************
33 !
34 ! $Id: RFLU_ModDifferentiationBFaces.F90,v 1.6 2008/12/06 08:44:21 mtcampbe Exp $
35 !
36 ! Copyright: (c) 2005-2006 by the University of Illinois
37 !
38 ! ******************************************************************************
39 
40 MODULE rflu_moddifferentiationbfaces
41 
42  USE modglobal, ONLY: t_global
43  USE modparameters
44  USE moddatatypes
45  USE moderror
46  USE moddatastruct, ONLY: t_region
47  USE modgrid, ONLY: t_grid
48  USE modbndpatch, ONLY: t_patch
49  USE modmpi
50 
51  USE rflu_modconstraintutils
52 
53  IMPLICIT NONE
54 
55  PRIVATE
56  PUBLIC :: rflu_computegradbfaces_1d, &
57  rflu_computegradbfaces, &
58  rflu_computegradbfaceswrapper, &
59  rflu_computebfgradconstrwrapper
60 
61 ! ******************************************************************************
62 ! Declarations and definitions
63 ! ******************************************************************************
64 
65  CHARACTER(CHRLEN) :: RCSIdentString = &
66  '$RCSfile: RFLU_ModDifferentiationBFaces.F90,v $ $Revision: 1.6 $'
67 
68 ! ******************************************************************************
69 ! Routines
70 ! ******************************************************************************
71 
72  CONTAINS
73 
74 
75 
76 
77 
78 
79 ! ******************************************************************************
80 !
81 ! Purpose: Compute 1D gradients of any vector or scalar at boundary face
82 ! centers.
83 !
84 ! Description: None.
85 !
86 ! Input:
87 ! pRegion Pointer to region data
88 ! pPatch Pointer to patch data
89 ! iBegVar Beginning index of data in var
90 ! iEndVar Ending index of data in var
91 ! iBegGrad Beginning index of data in grad
92 ! iEndGrad Ending index of data in grad
93 ! var Variables of which gradients are to be determined
94 !
95 ! Output:
96 ! grad Gradients of variables at cell centers
97 !
98 ! Notes: None.
99 !
100 ! ******************************************************************************
101 
102 SUBROUTINE rflu_computegradbfaces_1d(pRegion,pPatch,iBegVar,iEndVar, &
103  ibeggrad,iendgrad,var,grad)
104 
105  USE rflu_modpatchutils, ONLY: rflu_getpatchnormaldirection
106  USE rflu_modweights, ONLY: rflu_computewtsx2c_1d
107 
108  IMPLICIT NONE
109 
110 ! ******************************************************************************
111 ! Definitions and declarations
112 ! ******************************************************************************
113 
114 ! ==============================================================================
115 ! Arguments
116 ! ==============================================================================
117 
118  INTEGER, INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
119  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
120  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
121  TYPE(t_patch), POINTER :: ppatch
122  TYPE(t_region), POINTER :: pregion
123 
124 ! ==============================================================================
125 ! Locals
126 ! ==============================================================================
127 
128  LOGICAL :: fndirflag,ifgincludeflag
129  INTEGER :: errorflag,fndir,icg,ifg,igrad,isl,ivar,nmembsmax,nmembs,order
130  REAL(RFREAL), DIMENSION(:), ALLOCATABLE :: locs,wts
131  TYPE(t_global), POINTER :: global
132  TYPE(t_grid), POINTER :: pgrid
133 
134 ! *****************************************************************************
135 ! Start, set pointers and variables
136 ! *****************************************************************************
137 
138  global => pregion%global
139 
140  CALL registerfunction(global,'RFLU_ComputeGradBFaces_1D',&
141  'RFLU_ModDifferentiationBFaces.F90' )
142 
143 #ifdef ROCPROF
144  CALL fprofiler_begins("RFLU::ComputeGradBFaces_1D")
145 #endif
146 
147  IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) ) THEN
148  CALL errorstop(global,err_grad_mismatch,__line__)
149  END IF ! iEndVar
150 
151  pgrid => pregion%grid
152 
153 ! ******************************************************************************
154 ! Compute gradients
155 ! ******************************************************************************
156 
157  IF ( ppatch%bcType /= bc_virtual ) THEN
158  nmembsmax = ppatch%bf2cs1DInfo%nCellMembsMax
159  order = 1 ! Order of derivative
160 
161  ifgincludeflag = .false.
162 
163 ! ==============================================================================
164 ! Check patch geometry
165 ! ==============================================================================
166 
167  IF ( ppatch%flatFlag .EQV. .false. ) THEN
168  CALL errorstop(global,err_patch_not_flat,__line__)
169  ELSE
170  CALL rflu_getpatchnormaldirection(global,ppatch,fndir,fndirflag)
171 
172  IF ( fndirflag .EQV. .false. ) THEN
173  CALL errorstop(global,err_patch_not_aligned,__line__)
174  END IF ! FloatEqual
175  END IF ! pPatch%flatFlag
176 
177 ! ==============================================================================
178 ! Allocate temporary memory
179 ! ==============================================================================
180 
181  ALLOCATE(wts(0:nmembsmax),stat=errorflag)
182  global%error = errorflag
183  IF ( global%error /= err_none ) THEN
184  CALL errorstop(global,err_allocate,__line__,'wts')
185  END IF ! global%error
186 
187  ALLOCATE(locs(0:nmembsmax),stat=errorflag)
188  global%error = errorflag
189  IF ( global%error /= err_none ) THEN
190  CALL errorstop(global,err_allocate,__line__,'locs')
191  END IF ! global%error
192 
193 ! ==============================================================================
194 ! Loop over faces, compute gradients
195 ! ==============================================================================
196 
197 ! ------------------------------------------------------------------------------
198 ! Include face ifg in stencil
199 ! ------------------------------------------------------------------------------
200 
201  IF ( ifgincludeflag .EQV. .true. ) THEN
202  DO ifg = 1,ppatch%nBFaces
203  DO igrad = ibeggrad,iendgrad
204  grad(xcoord,igrad,ifg) = 0.0_rfreal
205  grad(ycoord,igrad,ifg) = 0.0_rfreal
206  grad(zcoord,igrad,ifg) = 0.0_rfreal
207  END DO ! iGrad
208 
209  nmembs = ppatch%bf2cs1D(ifg)%nCellMembs
210 
211  locs(0) = ppatch%fc(fndir,ifg)
212 
213  DO isl = 1,nmembs
214  icg = ppatch%bf2cs1D(ifg)%cellMembs(isl)
215 
216  locs(isl) = pgrid%cofg(fndir,icg)
217  END DO ! isl
218 
219  CALL rflu_computewtsx2c_1d(global,order,nmembs+1,locs(0:nmembs), &
220  ppatch%fc(fndir,ifg),wts(0:nmembs))
221 
222  igrad = ibeggrad
223 
224  DO ivar = ibegvar,iendvar
225 ! TEMPORARY
226 ! Can only include ifg in stencil if have values on boundary. For the moment,
227 ! that is not the case, but once NSCBC works, we can include values on
228 ! boundary
229 ! grad(fnDir,iGrad,ifg) = wts(0)*
230 ! END TEMPORARY
231 
232  DO isl = 1,nmembs
233  icg = ppatch%bf2cs1D(ifg)%cellMembs(isl)
234 
235  grad(fndir,igrad,ifg) = grad(fndir,igrad,ifg) &
236  + wts(isl)*var(ivar,icg)
237  END DO ! isl
238 
239  igrad = igrad + 1
240  END DO ! iVar
241  END DO ! ifg
242 
243 ! ------------------------------------------------------------------------------
244 ! Do not include face ifg in stencil
245 ! ------------------------------------------------------------------------------
246 
247  ELSE
248  DO ifg = 1,ppatch%nBFaces
249  DO igrad = ibeggrad,iendgrad
250  grad(xcoord,igrad,ifg) = 0.0_rfreal
251  grad(ycoord,igrad,ifg) = 0.0_rfreal
252  grad(zcoord,igrad,ifg) = 0.0_rfreal
253  END DO ! iGrad
254 
255  nmembs = ppatch%bf2cs1D(ifg)%nCellMembs
256 
257  DO isl = 1,nmembs
258  icg = ppatch%bf2cs1D(ifg)%cellMembs(isl)
259 
260  locs(isl) = pgrid%cofg(fndir,icg)
261  END DO ! isl
262 
263  CALL rflu_computewtsx2c_1d(global,order,nmembs,locs(1:nmembs), &
264  ppatch%fc(fndir,ifg),wts(1:nmembs))
265 
266  igrad = ibeggrad
267 
268  DO ivar = ibegvar,iendvar
269  DO isl = 1,nmembs
270  icg = ppatch%bf2cs1D(ifg)%cellMembs(isl)
271 
272  grad(fndir,igrad,ifg) = grad(fndir,igrad,ifg) &
273  + wts(isl)*var(ivar,icg)
274  END DO ! isl
275 
276  igrad = igrad + 1
277  END DO ! iVar
278  END DO ! ifg
279  END IF ! ifgIncludeFlag
280 
281 ! ==============================================================================
282 ! Deallocate temporary memory
283 ! ==============================================================================
284 
285  DEALLOCATE(wts,stat=errorflag)
286  global%error = errorflag
287  IF ( global%error /= err_none ) THEN
288  CALL errorstop(global,err_deallocate,__line__,'wts')
289  END IF ! global%error
290 
291  DEALLOCATE(locs,stat=errorflag)
292  global%error = errorflag
293  IF ( global%error /= err_none ) THEN
294  CALL errorstop(global,err_deallocate,__line__,'locs')
295  END IF ! global%error
296  END IF ! pPatch%bcType
297 
298 ! ******************************************************************************
299 ! End
300 ! ******************************************************************************
301 
302 #ifdef ROCPROF
303  CALL fprofiler_ends("RFLU::ComputeGradBFaces_1D")
304 #endif
305 
306  CALL deregisterfunction(global)
307 
308 END SUBROUTINE rflu_computegradbfaces_1d
309 
310 
311 
312 
313 
314 
315 ! ******************************************************************************
316 !
317 ! Purpose: Compute gradients of any vector or scalar at boundary faces.
318 !
319 ! Description: None.
320 !
321 ! Input:
322 ! pRegion Pointer to region data
323 ! pPatch Pointer to patch data
324 ! iBegVar Beginning index of data in var
325 ! iEndVar Ending index of data in var
326 ! iBegGrad Beginning index of data in grad
327 ! iEndGrad Ending index of data in grad
328 ! var Variables of which gradients are to be determined
329 !
330 ! Output:
331 ! grad Gradients of variables at boundary face centers
332 !
333 ! Notes:
334 ! 1. The face gradients differ from the cell gradients in that they are
335 ! computed as weighted sums of variables rather than variable differences
336 ! because there are no variables located at faces.
337 ! 2. If the weighting is changed from inverse-distance to none, then the
338 ! routine RFLU_ComputeStencilMomentsX in RFLU_ModWeights must also be
339 ! adapted.
340 !
341 ! ******************************************************************************
342 
343 SUBROUTINE rflu_computegradbfaces(pRegion,pPatch,iBegVar,iEndVar,iBegGrad, &
344  iendgrad,var,grad)
345 
346  USE modinterfaces, ONLY: rflu_invertmatrixsvd
347 
348  IMPLICIT NONE
349 
350 ! ******************************************************************************
351 ! Definitions and declarations
352 ! ******************************************************************************
353 
354 ! ==============================================================================
355 ! Arguments
356 ! ==============================================================================
357 
358  INTEGER, INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
359  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
360  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
361  TYPE(t_patch), POINTER :: ppatch
362  TYPE(t_region), POINTER :: pregion
363 
364 ! ==============================================================================
365 ! Locals
366 ! ==============================================================================
367 
368  INTEGER :: errorflag,icg,ifg,ifgbeg,ifgend,ifl,igrad,isl,ivar
369  REAL(RFREAL) :: c11,c12,c13,c14,c22,c23,c24,c33,c34,c44,dx,dy,dz,r11, &
370  r12,r13,r14,r22,r23,r24,r33,r34,r44,term,term1,term2, &
371  term3,term4,wx,wy,wz
372  REAL(RFREAL) :: fc(xcoord:zcoord)
373  TYPE(t_global), POINTER :: global
374  TYPE(t_grid), POINTER :: pgrid
375 
376 ! ******************************************************************************
377 ! Start
378 ! ******************************************************************************
379 
380  global => pregion%global
381 
382  CALL registerfunction(global,'RFLU_ComputeGradBFaces',&
383  'RFLU_ModDifferentiationBFaces.F90' )
384 
385  IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) ) THEN
386  CALL errorstop(global,err_grad_mismatch,__line__)
387  END IF ! nVar
388 
389 ! ******************************************************************************
390 ! Set pointers and variables
391 ! ******************************************************************************
392 
393  pgrid => pregion%grid
394 
395 ! ******************************************************************************
396 ! Compute gradients
397 ! ******************************************************************************
398 
399  IF ( ppatch%bcType /= bc_virtual ) THEN
400 
401 ! DEBUG
402 ! DO icg = 1,pGrid%nCellsTot
403 ! DO iVar = iBegVar,iEndVar
404 ! var(iVar,icg) = &
405 ! + REAL(4*(iVar-1) ,RFREAL) &
406 ! - REAL(4*(iVar-1)+1,RFREAL)*pGrid%cofg(XCOORD,icg) &
407 ! + REAL(4*(iVar-1)+2,RFREAL)*pGrid%cofg(YCOORD,icg) &
408 ! - REAL(4*(iVar-1)+3,RFREAL)*pGrid%cofg(ZCOORD,icg)
409 ! END DO ! iVar
410 ! END DO ! icg
411 ! END DEBUG
412 
413 ! ==============================================================================
414 ! Loop over faces and compute gradients
415 ! Linear Interpolation Least Square Formulation
416 ! ==============================================================================
417 
418 ! ------------------------------------------------------------------------------
419 ! Select appropriate dimensionality
420 ! ------------------------------------------------------------------------------
421 
422  SELECT CASE ( pregion%mixtInput%dimens )
423 
424 ! --- Two dimensions -----------------------------------------------------------
425 
426  CASE ( 2 )
427 
428  DO ifl = 1,ppatch%nBFaces
429  r11 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_11)
430  r12 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_12)
431  r22 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_22)
432  r13 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_13)
433  r23 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_23)
434  r33 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_33)
435 
436  c11 = 1.0_rfreal/r11
437  c22 = 1.0_rfreal/r22
438  c33 = 1.0_rfreal/r33
439 
440  c12 = - c11*r12
441  c13 = -(c11*r13 + c12*c22*r23)
442 
443  c23 = - c22*r23
444 
445  fc(xcoord) = ppatch%fc(xcoord,ifl)
446  fc(ycoord) = ppatch%fc(ycoord,ifl)
447 
448  DO igrad = ibeggrad,iendgrad
449  grad(xcoord,igrad,ifl) = 0.0_rfreal
450  grad(ycoord,igrad,ifl) = 0.0_rfreal
451  grad(zcoord,igrad,ifl) = 0.0_rfreal
452  END DO ! iVar
453 
454  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
455  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
456 
457  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
458  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
459 
460  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
461 
462  dx = term*dx
463  dy = term*dy
464 
465  term1 = c11*c11*( dx)
466  term2 = c22*c22*( dy + c12*dx)
467  term3 = c33*c33*(term + c23*dy + c13*dx)
468 
469 ! TEMPORARY
470  wx = term*(term1 + c12*term2 + c13*term3)
471  wy = term*( term2 + c23*term3)
472 
473 ! wx = term*(term1 + c12*term2)
474 ! wy = term*( term2)
475 ! END TEMPORARY
476 
477  igrad = ibeggrad
478 
479  DO ivar = ibegvar,iendvar
480 ! TEMPORARY
481  grad(xcoord,igrad,ifl) = grad(xcoord,igrad,ifl) + wx*var(ivar,icg)
482  grad(ycoord,igrad,ifl) = grad(ycoord,igrad,ifl) + wy*var(ivar,icg)
483 
484 ! dVar = var(iVar,icg) - pPatch%mixt%cv(iVar,ifl)
485 ! grad(XCOORD,iGrad,ifl) = grad(XCOORD,iGrad,ifl) + wx*dVar
486 ! grad(YCOORD,iGrad,ifl) = grad(YCOORD,iGrad,ifl) + wy*dVar
487 ! END TEMPORARY
488 
489  igrad = igrad + 1
490  END DO ! iVar
491  END DO ! isl
492 
493  END DO ! ifl
494 
495 ! --- Three dimensions ---------------------------------------------------------
496 
497  CASE ( 3 )
498  DO ifl = 1,ppatch%nBFaces
499 
500  r11 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_11)
501  r12 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_12)
502  r22 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_22)
503  r13 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_13)
504  r23 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_23)
505  r33 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_33)
506  r14 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_14)
507  r24 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_24)
508  r34 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_34)
509  r44 = ppatch%bf2cs(ifl)%xyzMoms(xyz_mom_44)
510 
511  c11 = 1.0_rfreal/r11
512  c22 = 1.0_rfreal/r22
513  c33 = 1.0_rfreal/r33
514  c44 = 1.0_rfreal/r44
515 
516  c12 = - c11*r12
517  c13 = -(c11*r13 + c12*c22*r23)
518  c14 = -(c11*r14 + c12*c22*r24 + c13*c33*r34)
519 
520  c23 = - c22*r23
521  c24 = -(c22*r24 + c23*c33*r34)
522 
523  c34 = - c33*r34
524 
525  fc(xcoord) = ppatch%fc(xcoord,ifl)
526  fc(ycoord) = ppatch%fc(ycoord,ifl)
527  fc(zcoord) = ppatch%fc(zcoord,ifl)
528 
529  DO igrad = ibeggrad,iendgrad
530  grad(xcoord,igrad,ifl) = 0.0_rfreal
531  grad(ycoord,igrad,ifl) = 0.0_rfreal
532  grad(zcoord,igrad,ifl) = 0.0_rfreal
533  END DO ! iVar
534 
535  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
536  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
537 
538  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
539  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
540  dz = pgrid%cofg(zcoord,icg) - fc(zcoord)
541 
542  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
543 
544  dx = term*dx
545  dy = term*dy
546  dz = term*dz
547 
548  term1 = c11*c11*( dx)
549  term2 = c22*c22*( dy + c12*dx)
550  term3 = c33*c33*( dz + c23*dy + c13*dx)
551  term4 = c44*c44*(term + c34*dz + c24*dy + c14*dx)
552 
553  wx = term*(term1 + c12*term2 + c13*term3 + c14*term4)
554  wy = term*( term2 + c23*term3 + c24*term4)
555  wz = term*( term3 + c34*term4)
556 
557  igrad = ibeggrad
558 
559  DO ivar = ibegvar,iendvar
560  grad(xcoord,igrad,ifl) = grad(xcoord,igrad,ifl) + wx*var(ivar,icg)
561  grad(ycoord,igrad,ifl) = grad(ycoord,igrad,ifl) + wy*var(ivar,icg)
562  grad(zcoord,igrad,ifl) = grad(zcoord,igrad,ifl) + wz*var(ivar,icg)
563 
564  igrad = igrad + 1
565  END DO ! iVar
566  END DO ! isl
567 
568  END DO ! ifl
569 
570 ! --- Default ------------------------------------------------------------------
571 
572  CASE default
573  CALL errorstop(global,err_reached_default,__line__)
574  END SELECT ! pRegion%mixtInput%dimens
575 
576 ! DEBUG
577 ! ifgBeg = 1
578 ! ifgEnd = pPatch%nBFaces
579 ! DO iGrad = iBegGrad,iEndGrad
580 ! WRITE(*,*) iGrad,MINVAL(grad(XCOORD,iGrad,ifgBeg:ifgEnd)), &
581 ! MINVAL(grad(YCOORD,iGrad,ifgBeg:ifgEnd)), &
582 ! MINVAL(grad(ZCOORD,iGrad,ifgBeg:ifgEnd)), &
583 ! MAXVAL(grad(XCOORD,iGrad,ifgBeg:ifgEnd)), &
584 ! MAXVAL(grad(YCOORD,iGrad,ifgBeg:ifgEnd)), &
585 ! MAXVAL(grad(ZCOORD,iGrad,ifgBeg:ifgEnd))
586 ! END DO ! iGrad
587 ! END DEBUG
588 
589  END IF ! pPatch%bcType
590 
591 ! ******************************************************************************
592 ! End
593 ! ******************************************************************************
594 
595  CALL deregisterfunction(global)
596 
597 END SUBROUTINE rflu_computegradbfaces
598 
599 
600 
601 
602 
603 
604 
605 
606 
607 ! ******************************************************************************
608 !
609 ! Purpose: Compute constrained gradients of any vector or scalar at boundary
610 ! faces.
611 !
612 ! Description: None.
613 !
614 ! Input:
615 ! pRegion Pointer to region data
616 ! pPatch Pointer to patch data
617 ! iBegVar Beginning index of data in var
618 ! iEndVar Ending index of data in var
619 ! iBegGrad Beginning index of data in grad
620 ! iEndGrad Ending index of data in grad
621 ! varInfo Variable information
622 ! var Variables of which gradients are to be determined
623 !
624 ! Output:
625 ! grad Gradients of variables at boundary face centers
626 !
627 ! Notes:
628 ! 1. The face gradients differ from the cell gradients in that they are
629 ! computed as weighted sums of variables rather than variable differences
630 ! because there are no variables located at faces.
631 ! 2. If the weighting is changed from inverse-distance to none, then the
632 ! routine RFLU_ComputeStencilMomentsX in RFLU_ModWeights must also be
633 ! adapted.
634 !
635 ! ******************************************************************************
636 
637 SUBROUTINE rflu_computebfgradconstr(pRegion,pPatch,iBegVar,iEndVar,iBegGrad, &
638  iendgrad,varinfo,var,grad)
639 
640  USE modinterfaces, ONLY: rflu_invertmatrixsvd
641 
642  IMPLICIT NONE
643 
644 ! ******************************************************************************
645 ! Definitions and declarations
646 ! ******************************************************************************
647 
648 ! ==============================================================================
649 ! Arguments
650 ! ==============================================================================
651 
652  INTEGER, INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
653  INTEGER, INTENT(IN) :: varinfo(ibegvar:iendvar)
654  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
655  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
656  TYPE(t_patch), POINTER :: ppatch
657  TYPE(t_region), POINTER :: pregion
658 
659 ! ==============================================================================
660 ! Locals
661 ! ==============================================================================
662 
663  INTEGER :: errorflag,icg,icol,ifg,ifgbeg,ifgend,ifl,ifl2,igrad, &
664  ipatch2,irow,isl,ivar,ix,iy,iz,ncols,nconstr,nrows,scount
665  INTEGER, DIMENSION(:), ALLOCATABLE :: constrtype
666  REAL(RFREAL) :: c11,c12,c13,c14,c22,c23,c24,c33,c34,c44,dx,dy,dz,gx,gy, &
667  gz,r11,r12,r13,r14,r22,r23,r24,r33,r34,r44,term,term1, &
668  term2,term3,term4,varf,varc
669  REAL(RFREAL) :: colmax(4)
670  REAL(RFREAL) :: fc(xcoord:zcoord)
671  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: a,ainv
672  TYPE(t_global), POINTER :: global
673  TYPE(t_grid), POINTER :: pgrid
674  TYPE(t_patch), POINTER :: ppatch2
675 
676 ! ******************************************************************************
677 ! Start
678 ! ******************************************************************************
679 
680  global => pregion%global
681 
682  CALL registerfunction(global,'RFLU_ComputeBFGradConstr',&
683  'RFLU_ModDifferentiationBFaces.F90' )
684 
685  IF ( (iendvar - ibegvar) /= (iendgrad - ibeggrad) ) THEN
686  CALL errorstop(global,err_grad_mismatch,__line__)
687  END IF ! nVar
688 
689 ! ******************************************************************************
690 ! Set pointers and variables
691 ! ******************************************************************************
692 
693  pgrid => pregion%grid
694 
695 ! ******************************************************************************
696 ! Compute gradients
697 ! ******************************************************************************
698 
699  IF ( ppatch%bcType /= bc_virtual ) THEN
700 
701 ! DEBUG
702 ! DO icg = 1,pGrid%nCellsTot
703 ! DO iVar = iBegVar,iEndVar
704 ! var(iVar,icg) = &
705 ! + REAL(4*(iVar-1) ,RFREAL) &
706 ! - REAL(4*(iVar-1)+1,RFREAL)*pGrid%cofg(XCOORD,icg) &
707 ! + REAL(4*(iVar-1)+2,RFREAL)*pGrid%cofg(YCOORD,icg)
708 ! - REAL(4*(iVar-1)+3,RFREAL)*pGrid%cofg(ZCOORD,icg)
709 ! END DO ! iVar
710 ! END DO ! icg
711 ! END DEBUG
712 
713 ! ==============================================================================
714 ! Loop over faces and compute gradients
715 ! ==============================================================================
716 
717  DO ifl = 1,ppatch%nBFaces
718 
719 ! ------------------------------------------------------------------------------
720 ! Initialize gradients
721 ! ------------------------------------------------------------------------------
722 
723  DO igrad = ibeggrad,iendgrad
724  grad(xcoord,igrad,ifl) = 0.0_rfreal
725  grad(ycoord,igrad,ifl) = 0.0_rfreal
726  grad(zcoord,igrad,ifl) = 0.0_rfreal
727  END DO ! iGrad
728 
729  fc(xcoord) = ppatch%fc(xcoord,ifl)
730  fc(ycoord) = ppatch%fc(ycoord,ifl)
731  fc(zcoord) = ppatch%fc(zcoord,ifl)
732 
733  ALLOCATE(constrtype(0:ppatch%bf2cs(ifl)%nBFaceMembs),stat=errorflag)
734  global%error = errorflag
735  IF ( global%error /= err_none ) THEN
736  CALL errorstop(global,err_allocate,__line__,'constrType')
737  END IF ! global%error
738 
739 ! ------------------------------------------------------------------------------
740 ! Compute gradients
741 ! ------------------------------------------------------------------------------
742 
743  igrad = ibeggrad
744 
745  DO ivar = ibegvar,iendvar
746 
747 ! ----- Determine whether bface itself is constrained --------------------------
748 
749  constrtype(0) = rflu_getconstrtype(pregion,ppatch,varinfo(ivar),ifl)
750 
751  IF ( constrtype(0) /= constr_type_dirichlet ) THEN
752  constrtype(0) = constr_type_none
753 
754  varf = 0.0_rfreal ! IMPORTANT
755  ELSE
756  varf = rflu_getconstrvalue(pregion,ppatch,varinfo(ivar),ifl)
757  END IF ! constrType
758 
759 ! ----- Determine number of constraints ----------------------------------------
760 
761  nconstr = 0
762 
763  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
764  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
765  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
766 
767  ppatch2 => pregion%patches(ipatch2)
768 
769  constrtype(isl) = rflu_getconstrtype(pregion,ppatch2,varinfo(ivar), &
770  ifl2)
771 
772  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
773  nconstr = nconstr + 1
774  ELSE
775  constrtype(isl) = constr_type_none
776  END IF ! constrType
777  END DO ! isl
778 
779 ! ------------------------------------------------------------------------------
780 ! Gradients constrained by Dirichlet boundary conditions. Treated as
781 ! soft constraints. NOTE do not need to treat case of unconstrained
782 ! gradients here because they should already have been computed. If
783 ! they have not been computed at this stage, they will be set to zero
784 ! by initialization above.
785 ! ------------------------------------------------------------------------------
786 
787  IF ( (constrtype(0) == constr_type_dirichlet) .OR. (nconstr > 0) ) THEN
788 
789 ! ------- Allocate temporary memory
790 
791  nrows = ppatch%bf2cs(ifl)%nCellMembs + nconstr
792 
793  SELECT CASE ( constrtype(0) )
794  CASE ( constr_type_dirichlet )
795  ncols = pregion%mixtInput%dimens
796  CASE ( constr_type_none )
797  ncols = pregion%mixtInput%dimens + 1
798  CASE default
799  CALL errorstop(global,err_reached_default,__line__)
800  END SELECT ! constrType(0)
801 
802  ALLOCATE(a(nrows,ncols),stat=errorflag)
803  global%error = errorflag
804  IF ( global%error /= err_none ) THEN
805  CALL errorstop(global,err_allocate,__line__,'a')
806  END IF ! global%error
807 
808  ALLOCATE(ainv(ncols,nrows),stat=errorflag)
809  global%error = errorflag
810  IF ( global%error /= err_none ) THEN
811  CALL errorstop(global,err_allocate,__line__,'aInv')
812  END IF ! global%error
813 
814 ! ------- Define left-hand side matrix
815 
816  SELECT CASE ( pregion%mixtInput%dimens )
817  CASE ( 2 )
818  SELECT CASE ( constrtype(0) )
819  CASE ( constr_type_dirichlet )
820  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
821  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
822 
823  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
824  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
825 
826  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
827 
828  a(isl,1) = term*dx
829  a(isl,2) = term*dy
830  END DO ! isl
831 
832  irow = ppatch%bf2cs(ifl)%nCellMembs
833 
834  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
835  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
836  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
837  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
838 
839  ppatch2 => pregion%patches(ipatch2)
840 
841  dx = ppatch2%fc(xcoord,ifl2) - fc(xcoord)
842  dy = ppatch2%fc(ycoord,ifl2) - fc(ycoord)
843 
844  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
845 
846  irow = irow + 1
847 
848  a(irow,1) = term*dx
849  a(irow,2) = term*dy
850  END IF ! constrType
851  END DO ! isl
852  CASE ( constr_type_none )
853  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
854  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
855 
856  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
857  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
858 
859  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
860 
861  a(isl,1) = term
862  a(isl,2) = term*dx
863  a(isl,3) = term*dy
864  END DO ! isl
865 
866  irow = ppatch%bf2cs(ifl)%nCellMembs
867 
868  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
869  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
870  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
871  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
872 
873  ppatch2 => pregion%patches(ipatch2)
874 
875  dx = ppatch2%fc(xcoord,ifl2) - fc(xcoord)
876  dy = ppatch2%fc(ycoord,ifl2) - fc(ycoord)
877 
878  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
879 
880  irow = irow + 1
881 
882  a(irow,1) = term
883  a(irow,2) = term*dx
884  a(irow,3) = term*dy
885  END IF ! constrType
886  END DO ! isl
887  CASE default
888  CALL errorstop(global,err_reached_default,__line__)
889  END SELECT ! constrType(0)
890  CASE ( 3 )
891  SELECT CASE ( constrtype(0) )
892  CASE ( constr_type_dirichlet )
893  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
894  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
895 
896  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
897  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
898  dz = pgrid%cofg(zcoord,icg) - fc(zcoord)
899 
900  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
901 
902  a(isl,1) = term*dx
903  a(isl,2) = term*dy
904  a(isl,3) = term*dz
905  END DO ! isl
906 
907  irow = ppatch%bf2cs(ifl)%nCellMembs
908 
909  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
910  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
911  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
912  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
913 
914  ppatch2 => pregion%patches(ipatch2)
915 
916  dx = ppatch2%fc(xcoord,ifl2) - fc(xcoord)
917  dy = ppatch2%fc(ycoord,ifl2) - fc(ycoord)
918  dz = ppatch2%fc(zcoord,ifl2) - fc(zcoord)
919 
920  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
921 
922  irow = irow + 1
923 
924  a(irow,1) = term*dx
925  a(irow,2) = term*dy
926  a(irow,3) = term*dz
927  END IF ! constrType
928  END DO ! isl
929  CASE ( constr_type_none )
930  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
931  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
932 
933  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
934  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
935  dz = pgrid%cofg(zcoord,icg) - fc(zcoord)
936 
937  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
938 
939  a(isl,1) = term
940  a(isl,2) = term*dx
941  a(isl,3) = term*dy
942  a(isl,4) = term*dz
943  END DO ! isl
944 
945  irow = ppatch%bf2cs(ifl)%nCellMembs
946 
947  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
948  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
949  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
950  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
951 
952  ppatch2 => pregion%patches(ipatch2)
953 
954  dx = ppatch2%fc(xcoord,ifl2) - fc(xcoord)
955  dy = ppatch2%fc(ycoord,ifl2) - fc(ycoord)
956  dz = ppatch2%fc(zcoord,ifl2) - fc(zcoord)
957 
958  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
959 
960  irow = irow + 1
961 
962  a(irow,1) = term
963  a(irow,2) = term*dx
964  a(irow,3) = term*dy
965  a(irow,4) = term*dz
966  END IF ! constrType
967  END DO ! isl
968  CASE default
969  CALL errorstop(global,err_reached_default,__line__)
970  END SELECT ! constrType(0)
971  CASE default
972  CALL errorstop(global,err_reached_default,__line__)
973  END SELECT ! pRegion%mixtInput%dimens
974 
975 ! ------- Compute constrained gradient weights
976 
977  DO icol = 1,ncols
978  colmax(icol) = -huge(1.0_rfreal)
979 
980  DO irow = 1,nrows
981  colmax(icol) = max(colmax(icol),abs(a(irow,icol)))
982  END DO ! iRow
983 
984  DO irow = 1,nrows
985  a(irow,icol) = a(irow,icol)/colmax(icol)
986  END DO ! iRow
987  END DO ! iCol
988 
989  CALL rflu_invertmatrixsvd(global,nrows,ncols,a,ainv,scount)
990 
991  DO icol = 1,ncols
992  DO irow = 1,nrows
993  ainv(icol,irow) = ainv(icol,irow)/colmax(icol)
994  END DO ! iRow
995  END DO ! iCol
996 
997 ! TEMPORARY
998  IF ( scount /= 0 ) THEN
999  WRITE(*,*) 'ERROR - Singular matrix in RFLU_ComputeGradBFacesConstr!'
1000  stop
1001  END IF ! sCount
1002 ! END TEMPORARY
1003 
1004 ! ------- Compute constrained gradients
1005 
1006  SELECT CASE ( pregion%mixtInput%dimens )
1007  CASE ( 2 )
1008  gx = 0.0_rfreal
1009  gy = 0.0_rfreal
1010 
1011  SELECT CASE ( constrtype(0) )
1012  CASE ( constr_type_dirichlet )
1013  ix = 1
1014  iy = 2
1015  CASE ( constr_type_none )
1016  ix = 2
1017  iy = 3
1018  CASE default
1019  CALL errorstop(global,err_reached_default,__line__)
1020  END SELECT ! constrType(0)
1021 
1022  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
1023  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
1024 
1025  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
1026  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
1027 
1028  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
1029 
1030  gx = gx + term*ainv(ix,isl)*(var(ivar,icg) - varf)
1031  gy = gy + term*ainv(iy,isl)*(var(ivar,icg) - varf)
1032  END DO ! isl
1033 
1034  irow = ppatch%bf2cs(ifl)%nCellMembs
1035 
1036  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
1037  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
1038  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
1039  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
1040 
1041  ppatch2 => pregion%patches(ipatch2)
1042 
1043  dx = ppatch2%fc(xcoord,ifl2) - fc(xcoord)
1044  dy = ppatch2%fc(ycoord,ifl2) - fc(ycoord)
1045 
1046  term = 1.0_rfreal/sqrt(dx*dx + dy*dy)
1047 
1048  varc = rflu_getconstrvalue(pregion,ppatch2,varinfo(ivar),ifl2)
1049 
1050  irow = irow + 1
1051 
1052  gx = gx + term*ainv(ix,irow)*(varc - varf)
1053  gy = gy + term*ainv(iy,irow)*(varc - varf)
1054  END IF ! constrType
1055  END DO ! isl
1056 
1057  grad(xcoord,igrad,ifl) = gx
1058  grad(ycoord,igrad,ifl) = gy
1059  grad(zcoord,igrad,ifl) = 0.0_rfreal
1060 
1061  CASE ( 3 )
1062  gx = 0.0_rfreal
1063  gy = 0.0_rfreal
1064  gz = 0.0_rfreal
1065 
1066  SELECT CASE ( constrtype(0) )
1067  CASE ( constr_type_dirichlet )
1068  ix = 1
1069  iy = 2
1070  iz = 3
1071  CASE ( constr_type_none )
1072  ix = 2
1073  iy = 3
1074  iz = 4
1075  CASE default
1076  CALL errorstop(global,err_reached_default,__line__)
1077  END SELECT ! constrType(0)
1078 
1079  DO isl = 1,ppatch%bf2cs(ifl)%nCellMembs
1080  icg = ppatch%bf2cs(ifl)%cellMembs(isl)
1081 
1082  dx = pgrid%cofg(xcoord,icg) - fc(xcoord)
1083  dy = pgrid%cofg(ycoord,icg) - fc(ycoord)
1084  dz = pgrid%cofg(zcoord,icg) - fc(zcoord)
1085 
1086  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
1087 
1088  gx = gx + term*ainv(ix,isl)*(var(ivar,icg) - varf)
1089  gy = gy + term*ainv(iy,isl)*(var(ivar,icg) - varf)
1090  gz = gz + term*ainv(iz,isl)*(var(ivar,icg) - varf)
1091  END DO ! isl
1092 
1093  irow = ppatch%bf2cs(ifl)%nCellMembs
1094 
1095  DO isl = 1,ppatch%bf2cs(ifl)%nBFaceMembs
1096  IF ( constrtype(isl) == constr_type_dirichlet ) THEN
1097  ipatch2 = ppatch%bf2cs(ifl)%bFaceMembs(1,isl)
1098  ifl2 = ppatch%bf2cs(ifl)%bFaceMembs(2,isl)
1099 
1100  ppatch2 => pregion%patches(ipatch2)
1101 
1102  dx = ppatch2%fc(xcoord,ifl2) - fc(xcoord)
1103  dy = ppatch2%fc(ycoord,ifl2) - fc(ycoord)
1104  dz = ppatch2%fc(zcoord,ifl2) - fc(zcoord)
1105 
1106  term = 1.0_rfreal/sqrt(dx*dx + dy*dy + dz*dz)
1107 
1108  varc = rflu_getconstrvalue(pregion,ppatch2,varinfo(ivar),ifl2)
1109 
1110  irow = irow + 1
1111 
1112  gx = gx + term*ainv(ix,irow)*(varc - varf)
1113  gy = gy + term*ainv(iy,irow)*(varc - varf)
1114  gz = gz + term*ainv(iz,irow)*(varc - varf)
1115  END IF ! constrType
1116  END DO ! isl
1117 
1118  grad(xcoord,igrad,ifl) = gx
1119  grad(ycoord,igrad,ifl) = gy
1120  grad(zcoord,igrad,ifl) = gz
1121  CASE default
1122  CALL errorstop(global,err_reached_default,__line__)
1123  END SELECT ! pRegion%mixtInput%dimens
1124 
1125 ! ------- Deallocate temporary memory
1126 
1127  DEALLOCATE(a,stat=errorflag)
1128  global%error = errorflag
1129  IF ( global%error /= err_none ) THEN
1130  CALL errorstop(global,err_deallocate,__line__,'a')
1131  END IF ! global%error
1132 
1133  DEALLOCATE(ainv,stat=errorflag)
1134  global%error = errorflag
1135  IF ( global%error /= err_none ) THEN
1136  CALL errorstop(global,err_deallocate,__line__,'aInv')
1137  END IF ! global%error
1138  END IF ! nConstr
1139 
1140  igrad = igrad + 1
1141  END DO ! iVar
1142 
1143  DEALLOCATE(constrtype,stat=errorflag)
1144  global%error = errorflag
1145  IF ( global%error /= err_none ) THEN
1146  CALL errorstop(global,err_deallocate,__line__,'constrType')
1147  END IF ! global%error
1148 
1149  END DO ! ifl
1150 
1151 ! DEBUG
1152 ! DO iGrad = iBegGrad,iEndGrad
1153 ! WRITE(*,*) iGrad,MINVAL(grad(XCOORD,iGrad,ifgBeg:ifgEnd)), &
1154 ! MINVAL(grad(YCOORD,iGrad,ifgBeg:ifgEnd)), &
1155 ! MINVAL(grad(ZCOORD,iGrad,ifgBeg:ifgEnd)), &
1156 ! MAXVAL(grad(XCOORD,iGrad,ifgBeg:ifgEnd)), &
1157 ! MAXVAL(grad(YCOORD,iGrad,ifgBeg:ifgEnd)), &
1158 ! MAXVAL(grad(ZCOORD,iGrad,ifgBeg:ifgEnd))
1159 ! END DO ! iGrad
1160 ! END DEBUG
1161 
1162  END IF ! pPatch%bcType
1163 
1164 ! ******************************************************************************
1165 ! End
1166 ! ******************************************************************************
1167 
1168  CALL deregisterfunction(global)
1169 
1170 END SUBROUTINE rflu_computebfgradconstr
1171 
1172 
1173 
1174 
1175 
1176 
1177 ! ******************************************************************************
1178 !
1179 ! Purpose: Compute gradients of any vector or scalar at boundary face centroids.
1180 !
1181 ! Description: None.
1182 !
1183 ! Input:
1184 ! pRegion Pointer to region data
1185 ! pPatch Pointer to patch data
1186 ! iBegVar Beginning index of data in var
1187 ! iEndVar Ending index of data in var
1188 ! iBegGrad Beginning index of data in grad
1189 ! iEndGrad Ending index of data in grad
1190 ! var Variables of which gradients are to be determined
1191 !
1192 ! Output:
1193 ! grad Gradients of variables at cell centers
1194 !
1195 ! Notes: None.
1196 !
1197 ! ******************************************************************************
1198 
1199 SUBROUTINE rflu_computebfgradconstrwrapper(pRegion,pPatch,iBegVar,iEndVar, &
1200  ibeggrad,iendgrad,varinfo,var,grad)
1201 
1202  IMPLICIT NONE
1203 
1204 ! ******************************************************************************
1205 ! Definitions and declarations
1206 ! ******************************************************************************
1207 
1208 ! ==============================================================================
1209 ! Arguments
1210 ! ==============================================================================
1211 
1212  INTEGER, INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
1213  INTEGER, INTENT(IN) :: varinfo(ibegvar:iendvar)
1214  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
1215  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
1216  TYPE(t_patch), POINTER :: ppatch
1217  TYPE(t_region), POINTER :: pregion
1218 
1219 ! ==============================================================================
1220 ! Locals
1221 ! ==============================================================================
1222 
1223  TYPE(t_global), POINTER :: global
1224  TYPE(t_grid), POINTER :: pgrid
1225 
1226 ! *****************************************************************************
1227 ! Start
1228 ! *****************************************************************************
1229 
1230  global => pregion%global
1231 
1232  CALL registerfunction(global,'RFLU_ComputeBFGradConstrWrapper',&
1233  'RFLU_ModDifferentiationBFaces.F90' )
1234 
1235 ! ******************************************************************************
1236 ! Call gradient routines
1237 ! ******************************************************************************
1238 
1239  SELECT CASE ( pregion%mixtInput%stencilDimensBFaces )
1240  CASE ( 1 )
1241 ! TO DO
1242 ! END TO DO
1243  CASE ( 2,3 )
1244  CALL rflu_computebfgradconstr(pregion,ppatch,ibegvar,iendvar, &
1245  ibeggrad,iendgrad,varinfo,var,grad)
1246  CASE default
1247  CALL errorstop(global,err_reached_default,__line__)
1248  END SELECT ! pMixtInput%stencilDimensBFaces
1249 
1250 ! ******************************************************************************
1251 ! End
1252 ! ******************************************************************************
1253 
1254  CALL deregisterfunction(global)
1255 
1256 END SUBROUTINE rflu_computebfgradconstrwrapper
1257 
1258 
1259 
1260 
1261 
1262 
1263 ! ******************************************************************************
1264 !
1265 ! Purpose: Compute gradients of any vector or scalar at boundary face centroids.
1266 !
1267 ! Description: None.
1268 !
1269 ! Input:
1270 ! pRegion Pointer to region data
1271 ! pPatch Pointer to patch data
1272 ! iBegVar Beginning index of data in var
1273 ! iEndVar Ending index of data in var
1274 ! iBegGrad Beginning index of data in grad
1275 ! iEndGrad Ending index of data in grad
1276 ! var Variables of which gradients are to be determined
1277 !
1278 ! Output:
1279 ! grad Gradients of variables at cell centers
1280 !
1281 ! Notes: None.
1282 !
1283 ! ******************************************************************************
1284 
1285  SUBROUTINE rflu_computegradbfaceswrapper(pRegion,pPatch,iBegVar,iEndVar, &
1286  ibeggrad,iendgrad,var,grad)
1287 
1288  IMPLICIT NONE
1289 
1290 ! ******************************************************************************
1291 ! Definitions and declarations
1292 ! ******************************************************************************
1293 
1294 ! ==============================================================================
1295 ! Arguments
1296 ! ==============================================================================
1297 
1298  INTEGER, INTENT(IN) :: ibegvar,iendvar,ibeggrad,iendgrad
1299  REAL(RFREAL), DIMENSION(:,:), POINTER :: var
1300  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: grad
1301  TYPE(t_patch), POINTER :: ppatch
1302  TYPE(t_region), POINTER :: pregion
1303 
1304 ! ==============================================================================
1305 ! Locals
1306 ! ==============================================================================
1307 
1308  TYPE(t_global), POINTER :: global
1309  TYPE(t_grid), POINTER :: pgrid
1310 
1311 ! *****************************************************************************
1312 ! Start
1313 ! *****************************************************************************
1314 
1315  global => pregion%global
1316 
1317  CALL registerfunction(global,'RFLU_ComputeGradBFacesWrapper',&
1318  'RFLU_ModDifferentiationBFaces.F90' )
1319 
1320 ! ******************************************************************************
1321 ! Call gradient routines
1322 ! ******************************************************************************
1323 
1324  SELECT CASE ( pregion%mixtInput%stencilDimensBFaces )
1325  CASE ( 1 )
1326  CALL rflu_computegradbfaces_1d(pregion,ppatch,ibegvar,iendvar, &
1327  ibeggrad,iendgrad,var,grad)
1328  CASE ( 2,3 )
1329  CALL rflu_computegradbfaces(pregion,ppatch,ibegvar,iendvar,ibeggrad, &
1330  iendgrad,var,grad)
1331  CASE default
1332  CALL errorstop(global,err_reached_default,__line__)
1333  END SELECT ! pMixtInput%stencilDimensBFaces
1334 
1335 ! ******************************************************************************
1336 ! End
1337 ! ******************************************************************************
1338 
1339  CALL deregisterfunction(global)
1340 
1341  END SUBROUTINE rflu_computegradbfaceswrapper
1342 
1343 
1344 
1345 
1346 
1347 
1348 
1349 ! ******************************************************************************
1350 ! End
1351 ! ******************************************************************************
1352 
1353 END MODULE rflu_moddifferentiationbfaces
1354 
1355 
1356 ! ******************************************************************************
1357 !
1358 ! RCS Revision history:
1359 !
1360 ! $Log: RFLU_ModDifferentiationBFaces.F90,v $
1361 ! Revision 1.6 2008/12/06 08:44:21 mtcampbe
1362 ! Updated license.
1363 !
1364 ! Revision 1.5 2008/11/19 22:17:32 mtcampbe
1365 ! Added Illinois Open Source License/Copyright
1366 !
1367 ! Revision 1.4 2006/08/19 15:39:05 mparmar
1368 ! Removed bf2bg
1369 !
1370 ! Revision 1.3 2006/04/07 15:19:19 haselbac
1371 ! Removed tabs
1372 !
1373 ! Revision 1.2 2006/04/07 14:46:21 haselbac
1374 ! Rewrite in terms of wrapper funcs bcos of 1D routines
1375 !
1376 ! Revision 1.1 2005/10/27 19:31:35 haselbac
1377 ! Initial revision
1378 !
1379 ! ******************************************************************************
1380 
1381 
1382 
1383 
1384 
1385 
1386 
1387 
1388 
1389 
1390 
1391 
rflu_modweights::rflu_computewtsx2c_1d
subroutine, public rflu_computewtsx2c_1d(global, m, nMembs, x, z, w)
Definition: RFLU_ModWeights.F90:1497
rflu_modweights
Definition: RFLU_ModWeights.F90:39
dx
NT dx
Definition: rational_rotation.h:81
Kdtree_d::ExtPoint::term
void term()
Definition: kdtree_d.h:237
max
Vector_n max(const Array_n_const &v1, const Array_n_const &v2)
Definition: Vector_n.h:354
ainv
subroutine ainv(ajac, ajacin, det, ndim)
Definition: ainv.f90:53
Generic_element_2::order
Size order() const
Degree of the element. 1 for linear and 2 for quadratic.
Definition: Generic_element_2.h:117
rflu_invertmatrixsvd
subroutine rflu_invertmatrixsvd(global, nRows, nCols, a, aInv, sCount)
Definition: RFLU_InvertMatrixSVD.F90:50
rflu_moddifferentiationbfaces::rflu_computebfgradconstrwrapper
subroutine, public rflu_computebfgradconstrwrapper(pRegion, pPatch, iBegVar, iEndVar, iBegGrad, iEndGrad, varInfo, var, grad)
Definition: RFLU_ModDifferentiationBFaces.F90:1199
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
rflu_modpatchutils::rflu_getpatchnormaldirection
subroutine, public rflu_getpatchnormaldirection(global, pPatch, pnDir, pnDirFlag)
Definition: RFLU_ModPatchUtils.F90:1096
modgrid::t_grid
Definition: ModGrid.F90:56
sqrt
double sqrt(double d)
Definition: double.h:73
rflu_moddifferentiationbfaces::rflu_computebfgradconstr
subroutine rflu_computebfgradconstr(pRegion, pPatch, iBegVar, iEndVar, iBegGrad, iEndGrad, varInfo, var, grad)
Definition: RFLU_ModDifferentiationBFaces.F90:637
rflu_moddifferentiationbfaces::rflu_computegradbfaces
subroutine, public rflu_computegradbfaces(pRegion, pPatch, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
Definition: RFLU_ModDifferentiationBFaces.F90:343
rflu_moddifferentiationbfaces::rflu_computegradbfaceswrapper
subroutine, public rflu_computegradbfaceswrapper(pRegion, pPatch, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
Definition: RFLU_ModDifferentiationBFaces.F90:1285
rflu_moddifferentiationbfaces
Definition: RFLU_ModDifferentiationBFaces.F90:40
rflu_modconstraintutils::rflu_getconstrtype
INTEGER function, public rflu_getconstrtype(pRegion, pPatch, var, ifl)
Definition: RFLU_ModConstraintUtils.F90:92
rflu_moddifferentiationbfaces::rflu_computegradbfaces_1d
subroutine, public rflu_computegradbfaces_1d(pRegion, pPatch, iBegVar, iEndVar, iBegGrad, iEndGrad, var, grad)
Definition: RFLU_ModDifferentiationBFaces.F90:102
rflu_modpatchutils
Definition: RFLU_ModPatchUtils.F90:39
rflu_modconstraintutils
Definition: RFLU_ModConstraintUtils.F90:39
Direction_3::dz
RT dz() const
Definition: Direction_3.h:133
dy
NT dy
Definition: rational_rotation.h:82
rflu_modconstraintutils::rflu_getconstrvalue
real(rfreal) function, public rflu_getconstrvalue(pRegion, pPatch, var, ifl)
Definition: RFLU_ModConstraintUtils.F90:345
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
Line_2::a
RT a() const
Definition: Line_2.h:140
modbndpatch::t_patch
Definition: ModBndPatch.F90:91