Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ModExtractFlowData.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: Collect routines to extract data from flow solution.
26 !
27 ! Description: None.
28 !
29 ! Input: None.
30 !
31 ! Output: None.
32 !
33 ! Notes:
34 ! 1. These routines are hardcoded to extract data for particular flows on
35 ! particular grids. This means that one CANNOT use these routines for any
36 ! grid.
37 !
38 ! ******************************************************************************
39 !
40 ! $Id: RFLU_ModExtractFlowData.F90,v 1.24 2008/12/06 08:45:06 mtcampbe Exp $
41 !
42 ! Copyright: (c) 2004-2007 by the University of Illinois
43 !
44 ! ******************************************************************************
45 
46 MODULE rflu_modextractflowdata
47 
48  USE moddatatypes
49  USE modparameters
50  USE moderror
51  USE modglobal, ONLY: t_global
52  USE modgrid, ONLY: t_grid
53  USE modbndpatch, ONLY: t_patch
54  USE moddatastruct, ONLY: t_region
55 
56 #ifdef PLAG
57  USE plag_modparameters
58 #endif
59 
60  USE rflu_modextractflowdatautils
61 
62  IMPLICIT NONE
63 
64 ! ******************************************************************************
65 ! Definitions and declarations
66 ! ******************************************************************************
67 
68 ! ==============================================================================
69 ! Private data
70 ! ==============================================================================
71 
72  CHARACTER(CHRLEN), PARAMETER, PRIVATE :: &
73  RCSIdentString = '$RCSfile: RFLU_ModExtractFlowData.F90,v $ $Revision: 1.24 $'
74 
75 ! ==============================================================================
76 ! Public functions
77 ! ==============================================================================
78 
79  PUBLIC :: rflu_extractflowdata
80 
81 ! ==============================================================================
82 ! Private functions
83 ! ==============================================================================
84 
85  PRIVATE :: rflu_extractflowdatablasius, &
86  rflu_extractflowdatanscbc, &
87  rflu_extractflowdatalinefarf, &
88  rflu_extractflowdataproudman, &
89  rflu_extractflowdatasod, &
90  rflu_extractflowdatastg2d, &
91  rflu_extractflowdataskews, &
92  rflu_writemeshbump
93 
94 ! ******************************************************************************
95 ! Subroutines and functions
96 ! ******************************************************************************
97 
98  CONTAINS
99 
100 
101 
102 
103 
104 
105 
106 
107 ! ******************************************************************************
108 !
109 ! Purpose: Extract data from flow solution.
110 !
111 ! Description: None.
112 !
113 ! Input:
114 ! pRegion Pointer to region
115 !
116 ! Output: None.
117 !
118 ! Notes: None.
119 !
120 ! ******************************************************************************
121 
122 SUBROUTINE rflu_extractflowdata(pRegion)
123 
124  IMPLICIT NONE
125 
126 ! ******************************************************************************
127 ! Declarations and definitions
128 ! ******************************************************************************
129 
130 ! ==============================================================================
131 ! Arguments
132 ! ==============================================================================
133 
134  TYPE(t_region), POINTER :: pregion
135 
136 ! ==============================================================================
137 ! Locals
138 ! ==============================================================================
139 
140  CHARACTER(CHRLEN) :: rcsidentstring
141  TYPE(t_global), POINTER :: global
142  TYPE(t_grid), POINTER :: pgrid
143 
144 ! ******************************************************************************
145 ! Start
146 ! ******************************************************************************
147 
148  global => pregion%global
149 
150  CALL registerfunction(global,'RFLU_ExtractFlowData', &
151  'RFLU_ModExtractFlowData.F90')
152 
153  IF ( global%verbLevel > verbose_none ) THEN
154  WRITE(stdout,'(A,1X,A)') solver_name,'Extracting data from flow solution...'
155 
156  IF ( global%verbLevel > verbose_low ) THEN
157  WRITE(stdout,'(A,3X,A,A)') solver_name,'Case: ',trim(global%casename)
158  END IF ! global%verbLevel
159  END IF ! global%verbLevel
160 
161 ! ******************************************************************************
162 ! Initialize flow field based on user input
163 ! ******************************************************************************
164 
165  SELECT CASE ( global%casename )
166 
167 ! ==============================================================================
168 ! Incompressible laminar flat plate
169 ! ==============================================================================
170 
171  CASE ( "lfpbli-16.48x8.8x3" ,"lfpbli-32.96x16.16x3", &
172  "lfpbli-64.192x32.32x3","lfpbli-128.384x32.32x3" )
173  CALL rflu_extractflowdatablasius(pregion)
174  CASE( "lfpblim-64x16x1" , "lfpblim-128x32x1", &
175  "lfpblim-256x64x1", "lfpblim-512x128x1" )
176  CALL rflu_extractflowdatablasius(pregion)
177 
178 ! ==============================================================================
179 ! ONERA C0
180 ! ==============================================================================
181 
182  CASE ( "onera_c0_2d_100x50" )
183  CALL rflu_extractflowdataproudman(pregion)
184 
185 ! ==============================================================================
186 ! Skews diffracting shock
187 ! ==============================================================================
188 
189  CASE ( "skews_ms2p0","skews_ms3p0","skews_ms4p0" )
190  CALL rflu_extractflowdataskews(pregion)
191 
192 ! ==============================================================================
193 ! Shock tubes
194 ! ==============================================================================
195 
196  CASE ( "st_sod1","st_sod1_mp2","st_sod2","st_sod2_mp2" )
197  CALL rflu_extractflowdatasod(pregion)
198  CASE ( "stg1d" )
199  CALL rflu_extractflowdatastg1d(pregion)
200  CASE ( "stg2d" )
201  CALL rflu_extractflowdatastg2d(pregion)
202 
203 ! ==============================================================================
204 ! Sommerfeld shock-particle interaction
205 ! ==============================================================================
206 
207  CASE ( "somm_spi" )
208  CALL rflu_extractflowdatasommspi(pregion)
209 
210 ! ==============================================================================
211 ! NSCBC test cases 'nscbcX'
212 ! ==============================================================================
213 
214  CASE ( "nscbc1","nscbc2","nscbc3","nscbc4","nscbc5","nscbc6","nscbc7", &
215  "nscbc8" )
216  CALL rflu_extractflowdatanscbc(pregion)
217 
218 ! ==============================================================================
219 ! NSCBC farfield
220 ! ==============================================================================
221 
222  CASE ( "farf" )
223  CALL rflu_extractflowdatalinefarf(pregion)
224 
225 ! ==============================================================================
226 ! Bump test case 'bumpq10'
227 ! ==============================================================================
228 
229  CASE ( "bumpq10" )
230  CALL rflu_writemeshbump(pregion)
231 
232 ! ==============================================================================
233 ! Default - due to input error or missing CALL in this routine
234 ! ==============================================================================
235 
236  CASE default
237  global%warnCounter = global%warnCounter + 1
238 
239  IF ( global%verbLevel > verbose_none ) THEN
240  WRITE(stdout,'(A,3X,A,2(1X,A))') solver_name,'*** WARNING ***', &
241  'Extraction of data not available.', &
242  'Returning to calling procedure.'
243  END IF ! global%verbLevel
244  END SELECT ! global%casename
245 
246 ! ******************************************************************************
247 ! End
248 ! ******************************************************************************
249 
250  IF ( global%verbLevel > verbose_none ) THEN
251  WRITE(stdout,'(A,1X,A)') solver_name, &
252  'Extracting data from flow solution done.'
253  END IF ! global%verbLevel
254 
255  CALL deregisterfunction(global)
256 
257 END SUBROUTINE rflu_extractflowdata
258 
259 
260 
261 
262 
263 
264 
265 
266 
267 ! ******************************************************************************
268 !
269 ! Purpose: Extract data for Blasius flow
270 !
271 ! Description: None.
272 !
273 ! Input:
274 ! pRegion Pointer to region
275 !
276 ! Output: None.
277 !
278 ! Notes:
279 ! 1. Many assumptions are made, most of which are documented directly in the
280 ! code below. Others are listed in the following:
281 ! 2. Plate is assumed to lie on x-z plane, with the plate leading edge at x=0,
282 ! and plate being defined by plane y=0.
283 ! 3. Plate length is assumed to be unity, so that x-stations at which
284 ! velocity profiles are extracted are equally spaced in [0,1].
285 !
286 ! ******************************************************************************
287 
288 SUBROUTINE rflu_extractflowdatablasius(pRegion)
289 
290  IMPLICIT NONE
291 
292 ! ******************************************************************************
293 ! Declarations and definitions
294 ! ******************************************************************************
295 
296 ! ==============================================================================
297 ! Arguments
298 ! ==============================================================================
299 
300  TYPE(t_region), POINTER :: pregion
301 
302 ! ==============================================================================
303 ! Locals
304 ! ==============================================================================
305 
306  CHARACTER(CHRLEN) :: ifilename1,ifilename2
307  INTEGER, PARAMETER :: npoints = 18
308  INTEGER :: errorflag,i,icg,ifl,ile,ite,ivp,j,jbl,jfs,k,nvp
309  INTEGER, DIMENSION(:), ALLOCATABLE :: iloc
310  REAL(RFREAL) :: cf,cftheory,delta0,delta0theory,delta1,delta1theory,delta2, &
311  delta2theory,delta3,delta3theory,dist1,dist2,dy,eta,inter, &
312  ir,lref,r,reref,rex,ru,rv,slope,term1,term2,u,unorm,uref, &
313  v,vnorm,x,y
314  REAL(RFREAL), DIMENSION(NPOINTS), PARAMETER :: etablas = &
315  (/0.0000_rfreal,0.1000_rfreal,0.2000_rfreal,0.3000_rfreal,0.4000_rfreal, &
316  0.5000_rfreal,0.6000_rfreal,0.8000_rfreal,1.0000_rfreal,1.2000_rfreal, &
317  1.4000_rfreal,1.6000_rfreal,1.8000_rfreal,2.0000_rfreal,2.5000_rfreal, &
318  3.0000_rfreal,3.5000_rfreal,4.0000_rfreal/)
319  REAL(RFREAL), DIMENSION(NPOINTS), PARAMETER :: unormblas = &
320  (/0.0000_rfreal,0.0664_rfreal,0.1328_rfreal,0.1989_rfreal,0.2647_rfreal, &
321  0.3298_rfreal,0.3938_rfreal,0.5168_rfreal,0.6298_rfreal,0.7290_rfreal, &
322  0.8115_rfreal,0.8761_rfreal,0.9233_rfreal,0.9555_rfreal,0.9916_rfreal, &
323  0.9990_rfreal,0.9999_rfreal,1.0000_rfreal/)
324  REAL(RFREAL), DIMENSION(NPOINTS), PARAMETER :: vnormblas = &
325  (/0.0000_rfreal,0.0033_rfreal,0.0133_rfreal,0.0298_rfreal,0.0528_rfreal, &
326  0.0821_rfreal,0.1173_rfreal,0.2033_rfreal,0.3048_rfreal,0.4136_rfreal, &
327  0.5206_rfreal,0.6172_rfreal,0.6972_rfreal,0.7581_rfreal,0.8373_rfreal, &
328  0.8482_rfreal,0.8600_rfreal,0.8604_rfreal/)
329  REAL(RFREAL), DIMENSION(:,:), ALLOCATABLE :: yu
330  TYPE(t_global), POINTER :: global
331  TYPE(t_grid), POINTER :: pgrid
332  TYPE(t_patch), POINTER :: ppatch
333 
334 ! ******************************************************************************
335 ! Start
336 ! ******************************************************************************
337 
338  global => pregion%global
339 
340  CALL registerfunction(global,'RFLU_ExtractFlowDataBlasius', &
341  'RFLU_ModExtractFlowData.F90')
342 
343  IF ( global%verbLevel > verbose_none ) THEN
344  WRITE(stdout,'(A,1X,A)') solver_name, &
345  'Extract data for Blasius flow...'
346  END IF ! global%verbLevel
347 
348 ! ******************************************************************************
349 ! Set pointers and variables
350 ! ******************************************************************************
351 
352  pgrid => pregion%grid
353 
354  nvp = 9 ! Number of equally-spaced stations at which profiles are extracted
355 
356 ! ******************************************************************************
357 ! Get data about freestream conditions
358 ! ******************************************************************************
359 
360  uref = global%refVelocity
361  reref = global%refREnum
362  lref = global%refLength
363 
364 ! ******************************************************************************
365 ! Get data about dimensions
366 ! ile i-index of first cell on plate (leading edge)
367 ! ite i-index of last cell on plate (trailing edge)
368 ! jbl j-index of (nominally) last cell in boundary layer
369 ! jfs j-index of cell abutting freestream boundary
370 ! k k-index of middle layer of cells
371 ! ******************************************************************************
372 
373  SELECT CASE ( global%casename )
374  CASE ( "lfpbli-16.48x8.8x3" )
375  ile = 17
376  ite = 64
377  jbl = 8
378  jfs = 16
379  k = 2
380  CASE ( "lfpbli-32.96x16.16x3" )
381  ile = 33
382  ite = 128
383  jbl = 16
384  jfs = 32
385  k = 2
386  CASE ( "lfpbli-64.192x32.32x3" )
387  ile = 65
388  ite = 256
389  jbl = 32
390  jfs = 64
391  k = 2
392  CASE ( "lfpbli-128.384x64.64x3" )
393  ile = 129
394  ite = 512
395  jbl = 64
396  jfs = 128
397  k = 2
398  CASE ( "lfpblim-64x16x1" )
399  ile = 17
400  ite = 64
401  jbl = 8
402  jfs = 16
403  k = 1
404  CASE ( "lfpblim-128x32x1" )
405  ile = 33
406  ite = 128
407  jbl = 16
408  jfs = 32
409  k = 1
410  CASE ( "lfpblim-256x64x1" )
411  ile = 65
412  ite = 256
413  jbl = 32
414  jfs = 64
415  k = 1
416  CASE ( "lfpblim-512x128x1" )
417  ile = 129
418  ite = 512
419  jbl = 64
420  jfs = 128
421  k = 1
422  CASE default
423  CALL errorstop(global,err_reached_default,__line__)
424  END SELECT ! global%casename
425 
426 ! ******************************************************************************
427 ! Allocate temporary memory
428 ! ******************************************************************************
429 
430  ALLOCATE(yu(2,0:jfs),stat=errorflag)
431  global%error = errorflag
432  IF ( global%error /= err_none ) THEN
433  CALL errorstop(global,err_allocate,__line__,'yu')
434  END IF ! global%error
435 
436  ALLOCATE(iloc(nvp),stat=errorflag)
437  global%error = errorflag
438  IF ( global%error /= err_none ) THEN
439  CALL errorstop(global,err_allocate,__line__,'iloc')
440  END IF ! global%error
441 
442 ! ******************************************************************************
443 ! Find i-indices of x-stations at which data about velocity profiles is to be
444 ! extracted. NOTE assume that the cell preceding a given cell in the stream-
445 ! wise direction has i-index smaller by one.
446 ! ******************************************************************************
447 
448  IF ( global%verbLevel > verbose_none ) THEN
449  WRITE(stdout,'(A,3X,A)') solver_name, &
450  'Determining stations at which velocity data is extracted...'
451  END IF ! global%verbLevel
452 
453  i = ile
454 
455  DO ivp = 1,nvp
456  x = ivp*0.1_rfreal
457 
458  emptyloop: DO
459  icg = i + (k-1)*ite*jfs ! NOTE no j-term because always zero here
460 
461  dist1 = pgrid%cofg(xcoord,icg ) - x
462  dist2 = pgrid%cofg(xcoord,icg-1) - x
463 
464  IF ( (dist1 > 0.0_rfreal) .AND. (dist2 < 0.0_rfreal) ) THEN
465  IF ( abs(dist1) < abs(dist2) ) THEN
466  iloc(ivp) = i
467  icg = i + (k-1)*ite*jfs
468  ELSE
469  iloc(ivp) = i-1
470  icg = i - 1 + (k-1)*ite*jfs
471  END IF ! ABS
472 
473  IF ( global%verbLevel > verbose_none ) THEN
474  WRITE(stdout,'(A,5X,A,1X,I2,1X,A,1X,I3,A,1X,E13.6)') solver_name, &
475  'Station',ivp,'located at i=',iloc(ivp),', x=',pgrid%cofg(xcoord,icg)
476  END IF ! global%verbLevel
477 
478  EXIT emptyloop
479  ELSE
480  i = i + 1
481  END IF ! dist1
482  END DO emptyloop
483  END DO ! ivp
484 
485  IF ( global%verbLevel > verbose_none ) THEN
486  WRITE(stdout,'(A,3X,A)') solver_name, &
487  'Determining stations at which velocity data is extracted done.'
488  END IF ! global%verbLevel
489 
490 ! ******************************************************************************
491 ! Extract velocity profiles
492 ! ******************************************************************************
493 
494  DO ivp = 1,nvp
495  i = iloc(ivp)
496 
497  yu(1,0) = 0.0_rfreal
498  yu(2,0) = 0.0_rfreal
499 
500 ! ==============================================================================
501 ! Open file
502 ! ==============================================================================
503 
504  WRITE(ifilename2,'(A,I2.2,A)') 'blasius-vel',ivp,'.dat'
505 
506  OPEN(if_extr_data2,file=ifilename2,form='FORMATTED',status='UNKNOWN', &
507  iostat=errorflag)
508  global%error = errorflag
509  IF ( global%error /= err_none ) THEN
510  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename2))
511  END IF ! global%error
512 
513  IF ( global%verbLevel > verbose_none ) THEN
514  WRITE(stdout,'(A,3X,A)') solver_name, &
515  'Writing velocity-profile data to file: '// &
516  trim(ifilename2)
517  END IF ! global%verbLevel
518 
519 ! ==============================================================================
520 ! Normalize velocity and write to file at selected stations
521 ! ==============================================================================
522 
523  DO j = 1,jfs
524  icg = i + (j-1)*ite + (k-1)*ite*jfs
525 
526  x = pgrid%cofg(xcoord,icg)
527  y = pgrid%cofg(ycoord,icg)
528 
529  rex = reref*x/lref
530  eta = y/(2.0_rfreal*x)*sqrt(rex)
531 
532  r = pregion%mixt%cv(cv_mixt_dens,icg)
533  ru = pregion%mixt%cv(cv_mixt_xmom,icg)
534  rv = pregion%mixt%cv(cv_mixt_ymom,icg)
535 
536  ir = 1.0_rfreal/r
537  u = ir*ru
538  v = ir*rv
539 
540  unorm = u/uref
541  vnorm = v/uref
542 
543  yu(1,j) = y
544  yu(2,j) = unorm
545 
546  WRITE(if_extr_data2,'(3(1X,E13.6))') eta,unorm,vnorm*sqrt(rex)
547  END DO ! j
548 
549 ! ==============================================================================
550 ! Close file
551 ! ==============================================================================
552 
553  CLOSE(if_extr_data2,iostat=errorflag)
554  global%error = errorflag
555  IF ( global%error /= err_none ) THEN
556  CALL errorstop(global,err_file_close,__line__,'File: '// &
557  trim(ifilename2))
558  END IF ! global%error
559  END DO ! ivp
560 
561 ! ******************************************************************************
562 ! Extract thicknesses
563 ! ******************************************************************************
564 
565 ! ==============================================================================
566 ! Open file
567 ! ==============================================================================
568 
569  ifilename1 = 'blasius-thick.dat'
570 
571  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
572  iostat=errorflag)
573  global%error = errorflag
574  IF ( global%error /= err_none ) THEN
575  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
576  END IF ! global%error
577 
578  IF ( global%verbLevel > verbose_none ) THEN
579  WRITE(stdout,'(A,3X,A)') solver_name, &
580  'Writing thickness data to file: '// &
581  trim(ifilename1)
582  END IF ! global%verbLevel
583 
584 ! ==============================================================================
585 ! Extract data
586 ! ==============================================================================
587 
588  DO i = ile,ite
589  icg = i + (k-1)*ite*jfs ! NOTE no j-term because always zero here
590 
591  x = pgrid%cofg(xcoord,icg)
592 
593  rex = reref*x/lref
594 
595 ! ------------------------------------------------------------------------------
596 ! Compute normalized velocity profile
597 ! ------------------------------------------------------------------------------
598 
599  yu(1,0) = 0.0_rfreal
600  yu(2,0) = 0.0_rfreal
601 
602  DO j = 1,jfs
603  icg = i + (j-1)*ite + (k-1)*ite*jfs
604 
605  y = pgrid%cofg(ycoord,icg)
606 
607  r = pregion%mixt%cv(cv_mixt_dens,icg)
608  ru = pregion%mixt%cv(cv_mixt_xmom,icg)
609 
610  ir = 1.0_rfreal/r
611  u = ir*ru
612 
613  unorm = u/uref
614 
615  yu(1,j) = y
616  yu(2,j) = unorm
617  END DO ! j
618 
619 ! ------------------------------------------------------------------------------
620 ! Determine boundary layer thickness (indicated by normalized streamwise
621 ! velocity of 0.99).
622 ! ------------------------------------------------------------------------------
623 
624  delta0 = crazy_value_int
625  delta0theory = 5.0_rfreal*x/sqrt(rex)
626 
627  DO j = 1,jfs
628  IF ( yu(2,j-1) < 0.99_rfreal .AND. yu(2,j) >= 0.99_rfreal ) THEN
629  slope = (yu(2,j ) - yu(2,j-1) )/(yu(1,j) - yu(1,j-1))
630  inter = (yu(2,j-1)*yu(1,j) - yu(2,j )*yu(1,j-1))/(yu(1,j) - yu(1,j-1))
631  delta0 = (0.99_rfreal - inter)/slope
632  END IF ! yu
633  END DO ! j
634 
635 ! ------------------------------------------------------------------------------
636 ! Integrate normalized velocity to get displacement, momentum, and energy
637 ! thicknesses and write thicknesses to file. For the moment, use simple
638 ! trapezoidal rule.
639 ! ------------------------------------------------------------------------------
640 
641  delta1 = 0.0_rfreal
642  delta2 = 0.0_rfreal
643  delta3 = 0.0_rfreal
644 
645  delta1theory = 1.720_rfreal*x/sqrt(rex)
646  delta2theory = 0.664_rfreal*x/sqrt(rex)
647  delta3theory = 1.044_rfreal*x/sqrt(rex)
648 
649  DO j = 1,jbl
650  dy = yu(1,j) - yu(1,j-1)
651 
652  term1 = yu(2,j-1)
653  term2 = yu(2,j )
654 
655  delta1 = delta1 &
656  + 0.5_rfreal*dy*( (1.0_rfreal- term1) &
657  + (1.0_rfreal- term2))
658  delta2 = delta2 &
659  + 0.5_rfreal*dy*( term1*(1.0_rfreal- term1) &
660  + term2*(1.0_rfreal- term2))
661  delta3 = delta3 &
662  + 0.5_rfreal*dy*( term1*(1.0_rfreal-term1*term1) &
663  + term2*(1.0_rfreal-term2*term2))
664  END DO ! j
665 
666  WRITE(if_extr_data1,'(9(1X,E13.6))') rex,delta0/x, &
667  delta1/delta0, &
668  delta2/delta0, &
669  delta3/delta0, &
670  delta0theory/x, &
671  delta1theory/delta0theory, &
672  delta2theory/delta0theory, &
673  delta3theory/delta0theory
674  END DO ! i
675 
676 ! ==============================================================================
677 ! Close file
678 ! ==============================================================================
679 
680  CLOSE(if_extr_data1,iostat=errorflag)
681  global%error = errorflag
682  IF ( global%error /= err_none ) THEN
683  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
684  END IF ! global%error
685 
686 ! ******************************************************************************
687 ! Deallocate temporary memory
688 ! ******************************************************************************
689 
690  DEALLOCATE(yu,stat=errorflag)
691  global%error = errorflag
692  IF ( global%error /= err_none ) THEN
693  CALL errorstop(global,err_deallocate,__line__,'yu')
694  END IF ! global%error
695 
696  DEALLOCATE(iloc,stat=errorflag)
697  global%error = errorflag
698  IF ( global%error /= err_none ) THEN
699  CALL errorstop(global,err_deallocate,__line__,'iloc')
700  END IF ! global%error
701 
702 ! ******************************************************************************
703 ! Write file with skin-friction data. NOTE assume that flat plate is always on
704 ! patch 2.
705 ! ******************************************************************************
706 
707 ! ==============================================================================
708 ! Open file
709 ! ==============================================================================
710 
711  ifilename1 = 'blasius-cf.dat'
712 
713  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
714  iostat=errorflag)
715  global%error = errorflag
716  IF ( global%error /= err_none ) THEN
717  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
718  END IF ! global%error
719 
720  IF ( global%verbLevel > verbose_none ) THEN
721  WRITE(stdout,'(A,3X,A)') solver_name, &
722  'Writing skin-friction data to file: '// &
723  trim(ifilename1)
724  END IF ! global%verbLevel
725 
726 ! ==============================================================================
727 ! Write data
728 ! ==============================================================================
729 
730  ppatch => pregion%patches(2) ! NOTE assumption
731 
732  DO ifl = 1+(k-1)*(ite-ile+1),k*(ite-ile+1)
733  x = ppatch%fc(xcoord,ifl)
734 
735  rex = reref*x/lref
736 
737  cftheory = 0.664_rfreal/sqrt(rex)
738  cf = ppatch%cf(xcoord,ifl)
739 
740  WRITE(if_extr_data1,'(3(1X,E13.6))') rex,cftheory,cf
741  END DO ! ifl
742 
743 ! ==============================================================================
744 ! Close file
745 ! ==============================================================================
746 
747  CLOSE(if_extr_data1,iostat=errorflag)
748  global%error = errorflag
749  IF ( global%error /= err_none ) THEN
750  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
751  END IF ! global%error
752 
753 ! ******************************************************************************
754 ! Write file with exact velocity profile data for comparison purposes
755 ! ******************************************************************************
756 
757 ! ==============================================================================
758 ! Open file
759 ! ==============================================================================
760 
761  ifilename1 = 'blasius-vel-exact.dat'
762 
763  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
764  iostat=errorflag)
765  global%error = errorflag
766  IF ( global%error /= err_none ) THEN
767  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
768  END IF ! global%error
769 
770 ! ==============================================================================
771 ! Write data
772 ! ==============================================================================
773 
774  IF ( global%verbLevel > verbose_none ) THEN
775  WRITE(stdout,'(A,3X,A)') solver_name, &
776  'Writing exact velocity-profile data to file: '// &
777  trim(ifilename1)
778  END IF ! global%verbLevel
779 
780  DO j = 1,npoints
781  WRITE(if_extr_data1,'(3(1X,E11.4))') etablas(j),unormblas(j),vnormblas(j)
782  END DO ! j
783 
784 ! ==============================================================================
785 ! Close file
786 ! ==============================================================================
787 
788  CLOSE(if_extr_data1,iostat=errorflag)
789  global%error = errorflag
790  IF ( global%error /= err_none ) THEN
791  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
792  END IF ! global%error
793 
794 ! ******************************************************************************
795 ! End
796 ! ******************************************************************************
797 
798  IF ( global%verbLevel > verbose_none ) THEN
799  WRITE(stdout,'(A,1X,A)') solver_name,'Extract data for Blasius flow done.'
800  END IF ! global%verbLevel
801 
802  CALL deregisterfunction(global)
803 
804 END SUBROUTINE rflu_extractflowdatablasius
805 
806 
807 
808 
809 
810 
811 
812 
813 
814 ! ******************************************************************************
815 !
816 ! Purpose: Extract Line data for NSCBC case.
817 !
818 ! Description: None.
819 !
820 ! Input:
821 ! pRegion Pointer to region
822 !
823 ! Output: None.
824 !
825 ! Notes:
826 ! 1. Assume domain to lie in z=constant plane.
827 !
828 ! ******************************************************************************
829 
830 SUBROUTINE rflu_extractflowdatanscbc(pRegion)
831 
832  IMPLICIT NONE
833 
834 ! ******************************************************************************
835 ! Declarations and definitions
836 ! ******************************************************************************
837 ! ==============================================================================
838 ! Arguments
839 ! ==============================================================================
840 
841  TYPE(t_region), POINTER :: pregion
842 
843 ! ==============================================================================
844 ! Locals
845 ! ==============================================================================
846 
847  CHARACTER(CHRLEN) :: ifilename1
848  INTEGER :: nextract
849  INTEGER :: errorflag,icg,ix
850  REAL(RFREAL) :: a,p,r,u,v,w,m,xx,yy,angle
851  TYPE(t_grid), POINTER :: pgrid
852  TYPE(t_patch), POINTER :: ppatch
853  TYPE(t_global), POINTER :: global
854 
855 ! ******************************************************************************
856 ! Start
857 ! ******************************************************************************
858 
859  global => pregion%global
860 
861  CALL registerfunction(global,'RFLU_ExtractFlowDataNSCBC', &
862  'RFLU_ModExtractFlowData.F90')
863 
864  IF ( global%verbLevel > verbose_none ) THEN
865  WRITE(stdout,'(A,1X,A)') solver_name, &
866  'Extract Line data:'
867  END IF ! global%verbLevel
868 
869 ! ******************************************************************************
870 ! Set pointers and variables
871 ! ******************************************************************************
872 
873  pgrid => pregion%grid
874  ppatch => pregion%patches(1)
875 
876 ! ******************************************************************************
877 ! Open file for data
878 ! ******************************************************************************
879 
880  WRITE(ifilename1,'(A,1PE11.5,A)') trim(global%outDir)// &
881  trim(global%casename)// &
882  '.line_',global%currentTime,'.plt'
883 
884  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
885  iostat=errorflag)
886  global%error = errorflag
887  IF ( global%error /= 0 ) THEN
888  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
889  END IF ! global%error
890 
891  IF ( global%verbLevel > verbose_none ) THEN
892  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to '// &
893  trim(ifilename1)
894  END IF ! global%verbLevel
895 
896 ! ******************************************************************************
897 ! Compute number of cells
898 ! ******************************************************************************
899 
900  nextract = ppatch%nBFaces
901 
902 ! ******************************************************************************
903 ! Extract along cylinder surface
904 ! ******************************************************************************
905  DO ix = 1,nextract
906  icg = ppatch%bf2c(ix)
907 
908  xx = pgrid%cofg(xcoord,icg)
909  yy = pgrid%cofg(ycoord,icg)
910 
911  r = pregion%mixt%cv(cv_mixt_dens,icg)
912  u = pregion%mixt%cv(cv_mixt_xmom,icg)/r
913  v = pregion%mixt%cv(cv_mixt_ymom,icg)/r
914  p = pregion%mixt%dv(dv_mixt_pres,icg)
915 
916  WRITE(if_extr_data1,'(6(1X,E23.16))') xx,yy,r,u,v,p
917  END DO ! ix
918 
919 ! ******************************************************************************
920 ! Close file
921 ! ******************************************************************************
922 
923  CLOSE(if_extr_data1,iostat=errorflag)
924  global%error = errorflag
925  IF ( global%error /= 0 ) THEN
926  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
927  END IF ! global%error
928 
929 ! ******************************************************************************
930 ! End
931 ! ******************************************************************************
932 
933  IF ( global%verbLevel > verbose_none ) THEN
934  WRITE(stdout,'(A,1X,A)') solver_name,'Extract Line data for NSCBC case done.'
935  END IF ! global%verbLevel
936 
937  CALL deregisterfunction(global)
938 
939 END SUBROUTINE rflu_extractflowdatanscbc
940 
941 
942 
943 
944 
945 
946 
947 
948 ! ******************************************************************************
949 !
950 ! Purpose: Extract Surf data for Farfield
951 !
952 ! Description: None.
953 !
954 ! Input:
955 ! pRegion Pointer to region
956 !
957 ! Output: None.
958 !
959 ! Notes:
960 ! 1. Assume domain to lie in z=constant plane.
961 !
962 ! ******************************************************************************
963 
964 SUBROUTINE rflu_extractflowdatalinefarf(pRegion)
965 
966  IMPLICIT NONE
967 
968 ! ******************************************************************************
969 ! Declarations and definitions
970 ! ******************************************************************************
971 ! ==============================================================================
972 ! Arguments
973 ! ==============================================================================
974 
975  TYPE(t_region), POINTER :: pregion
976 
977 ! ==============================================================================
978 ! Locals
979 ! ==============================================================================
980 
981  CHARACTER(CHRLEN) :: ifilename1,ifilename2,ifilename3,ifilename4
982  INTEGER :: nextract
983  INTEGER :: errorflag,icg,ix,icg1,icg2,icg3,icg4
984  REAL(RFREAL) :: a,p,r,u,v,w,m,xx,yy,angle,radius,distance
985  TYPE(t_grid), POINTER :: pgrid
986  TYPE(t_patch), POINTER :: ppatch
987  TYPE(t_global), POINTER :: global
988 
989 ! ******************************************************************************
990 ! Start
991 ! ******************************************************************************
992 
993  global => pregion%global
994 
995  CALL registerfunction(global,'RFLU_ExtractFlowDataLineFarf', &
996  'RFLU_ModExtractFlowData.F90')
997 
998  IF ( global%verbLevel > verbose_none ) THEN
999  WRITE(stdout,'(A,1X,A)') solver_name, &
1000  'Extract Surf data:'
1001  END IF ! global%verbLevel
1002 
1003 ! ******************************************************************************
1004 ! Set pointers and variables
1005 ! ******************************************************************************
1006 
1007  pgrid => pregion%grid
1008  ppatch => pregion%patches(1)
1009 
1010 ! ******************************************************************************
1011 ! Open file for data
1012 ! ******************************************************************************
1013 
1014  WRITE(ifilename1,'(A,1PE11.5,A)') trim(global%outDir)// &
1015  trim(global%casename)// &
1016  '.line1_',global%currentTime,'.plt'
1017 
1018  WRITE(ifilename2,'(A,1PE11.5,A)') trim(global%outDir)// &
1019  trim(global%casename)// &
1020  '.line2_',global%currentTime,'.plt'
1021 
1022  WRITE(ifilename3,'(A,1PE11.5,A)') trim(global%outDir)// &
1023  trim(global%casename)// &
1024  '.line3_',global%currentTime,'.plt'
1025 
1026  WRITE(ifilename4,'(A,1PE11.5,A)') trim(global%outDir)// &
1027  trim(global%casename)// &
1028  '.line4_',global%currentTime,'.plt'
1029 
1030  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1031  iostat=errorflag)
1032  global%error = errorflag
1033  IF ( global%error /= 0 ) THEN
1034  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1035  END IF ! global%error
1036 
1037  OPEN(if_extr_data2,file=ifilename2,form='FORMATTED',status='UNKNOWN', &
1038  iostat=errorflag)
1039  global%error = errorflag
1040  IF ( global%error /= 0 ) THEN
1041  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename2))
1042  END IF ! global%error
1043 
1044  OPEN(50,file=ifilename3,form='FORMATTED',status='UNKNOWN', &
1045  iostat=errorflag)
1046  global%error = errorflag
1047  IF ( global%error /= 0 ) THEN
1048  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename3))
1049  END IF ! global%error
1050 
1051  OPEN(51,file=ifilename4,form='FORMATTED',status='UNKNOWN', &
1052  iostat=errorflag)
1053  global%error = errorflag
1054  IF ( global%error /= 0 ) THEN
1055  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename4))
1056  END IF ! global%error
1057 
1058  IF ( global%verbLevel > verbose_none ) THEN
1059  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to file: '// &
1060  trim(ifilename1)
1061  END IF ! global%verbLevel
1062 
1063 ! ******************************************************************************
1064 ! Compute number of cells
1065 ! ******************************************************************************
1066 
1067  nextract = 95
1068  radius = 0.006125_rfreal
1069 
1070 ! ******************************************************************************
1071 ! Extract along cylinder surface
1072 ! ******************************************************************************
1073 
1074  DO ix = 1,nextract
1075  icg = ppatch%bf2c(ix)
1076  icg1 = 1 + (ix-1)*258
1077  icg2 = 65 + (ix-1)*258
1078  icg3 = 130 + (ix-1)*258
1079  icg4 = 195 + (ix-1)*258
1080 
1081  xx = pgrid%cofg(xcoord,icg1)
1082  yy = pgrid%cofg(ycoord,icg1)
1083  distance = sqrt(xx*xx + yy*yy)
1084 
1085  r = pregion%mixt%cv(cv_mixt_dens,icg1)
1086  u = pregion%mixt%cv(cv_mixt_xmom,icg1)/r
1087  v = pregion%mixt%cv(cv_mixt_ymom,icg1)/r
1088  p = pregion%mixt%dv(dv_mixt_pres,icg1)
1089  WRITE(if_extr_data1,'(6(1X,E23.16))') distance-radius,r,u,v,p
1090 
1091  xx = pgrid%cofg(xcoord,icg2)
1092  yy = pgrid%cofg(ycoord,icg2)
1093  distance = sqrt(xx*xx + yy*yy)
1094 
1095  r = pregion%mixt%cv(cv_mixt_dens,icg2)
1096  u = pregion%mixt%cv(cv_mixt_xmom,icg2)/r
1097  v = pregion%mixt%cv(cv_mixt_ymom,icg2)/r
1098  p = pregion%mixt%dv(dv_mixt_pres,icg2)
1099  WRITE(if_extr_data2,'(6(1X,E23.16))') distance-radius,r,u,v,p
1100 
1101  xx = pgrid%cofg(xcoord,icg3)
1102  yy = pgrid%cofg(ycoord,icg3)
1103  distance = sqrt(xx*xx + yy*yy)
1104 
1105  r = pregion%mixt%cv(cv_mixt_dens,icg3)
1106  u = pregion%mixt%cv(cv_mixt_xmom,icg3)/r
1107  v = pregion%mixt%cv(cv_mixt_ymom,icg3)/r
1108  p = pregion%mixt%dv(dv_mixt_pres,icg3)
1109  WRITE(50,'(6(1X,E23.16))') distance-radius,r,u,v,p
1110 
1111  xx = pgrid%cofg(xcoord,icg4)
1112  yy = pgrid%cofg(ycoord,icg4)
1113  distance = sqrt(xx*xx + yy*yy)
1114 
1115  r = pregion%mixt%cv(cv_mixt_dens,icg4)
1116  u = pregion%mixt%cv(cv_mixt_xmom,icg4)/r
1117  v = pregion%mixt%cv(cv_mixt_ymom,icg4)/r
1118  p = pregion%mixt%dv(dv_mixt_pres,icg4)
1119  WRITE(51,'(6(1X,E23.16))') distance-radius,r,u,v,p
1120  END DO ! ix
1121 
1122 ! ******************************************************************************
1123 ! Close file
1124 ! ******************************************************************************
1125 
1126  CLOSE(if_extr_data1,iostat=errorflag)
1127  global%error = errorflag
1128  IF ( global%error /= 0 ) THEN
1129  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1130  END IF ! global%error
1131 
1132  CLOSE(if_extr_data2,iostat=errorflag)
1133  global%error = errorflag
1134  IF ( global%error /= 0 ) THEN
1135  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename2))
1136  END IF ! global%error
1137 
1138  CLOSE(50,iostat=errorflag)
1139  global%error = errorflag
1140  IF ( global%error /= 0 ) THEN
1141  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename3))
1142  END IF ! global%error
1143 
1144  CLOSE(51,iostat=errorflag)
1145  global%error = errorflag
1146  IF ( global%error /= 0 ) THEN
1147  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename4))
1148  END IF ! global%error
1149 
1150 ! ******************************************************************************
1151 ! End
1152 ! ******************************************************************************
1153 
1154  IF ( global%verbLevel > verbose_none ) THEN
1155  WRITE(stdout,'(A,1X,A)') solver_name,'Extract Surface data for Farf case done.'
1156  END IF ! global%verbLevel
1157 
1158  CALL deregisterfunction(global)
1159 
1160 END SUBROUTINE rflu_extractflowdatalinefarf
1161 
1162 
1163 
1164 
1165 
1166 
1167 
1168 
1169 
1170 
1171 ! ******************************************************************************
1172 !
1173 ! Purpose: Extract data for Proudman flow
1174 !
1175 ! Description: None.
1176 !
1177 ! Input:
1178 ! pRegion Pointer to region
1179 !
1180 ! Output: None.
1181 !
1182 ! Notes:
1183 ! 1. Many assumptions are made, most of which are documented directly in the
1184 ! code below, otherwise also assume that case satisfies same restrictions
1185 ! as those for defining exact solution.
1186 !
1187 ! ******************************************************************************
1188 
1189 SUBROUTINE rflu_extractflowdataproudman(pRegion)
1190 
1191  USE rflu_modexactflow, ONLY: rflu_computeexactflowproudman
1192  USE rflu_modflowhardcode, ONLY: rflu_getparamshardcodeproudman
1193 
1194  IMPLICIT NONE
1195 
1196 ! ******************************************************************************
1197 ! Declarations and definitions
1198 ! ******************************************************************************
1199 
1200 ! ==============================================================================
1201 ! Arguments
1202 ! ==============================================================================
1203 
1204  TYPE(t_region), POINTER :: pregion
1205 
1206 ! ==============================================================================
1207 ! Locals
1208 ! ==============================================================================
1209 
1210  CHARACTER(CHRLEN) :: ifilename1
1211  INTEGER :: errorflag,i,icg,ivp,j,nvp,nx,ny
1212  INTEGER, DIMENSION(:), ALLOCATABLE :: iloc
1213  REAL(RFREAL) :: dinc,height,ir,minj,vinj,p,ptot,r,ru,rv,u,unorm,v,vnorm,w,x,y
1214  TYPE(t_global), POINTER :: global
1215  TYPE(t_grid), POINTER :: pgrid
1216  TYPE(t_patch), POINTER :: ppatch
1217 
1218 ! ******************************************************************************
1219 ! Start
1220 ! ******************************************************************************
1221 
1222  global => pregion%global
1223 
1224  CALL registerfunction(global,'RFLU_ExtractFlowDataProudman', &
1225  'RFLU_ModExtractFlowData.F90')
1226 
1227  IF ( global%verbLevel > verbose_none ) THEN
1228  WRITE(stdout,'(A,1X,A)') solver_name, &
1229  'Extract data for Blasius flow...'
1230  END IF ! global%verbLevel
1231 
1232 ! ******************************************************************************
1233 ! Set pointers and variables
1234 ! ******************************************************************************
1235 
1236  pgrid => pregion%grid
1237 
1238  nvp = 9
1239 
1240 ! ******************************************************************************
1241 ! Get data about flow and geometry
1242 ! ******************************************************************************
1243 
1244  CALL rflu_getparamshardcodeproudman(dinc,minj,vinj,ptot)
1245 
1246  height = minval(pgrid%xyz(ycoord,1:pgrid%nVertTot))
1247 
1248 ! ******************************************************************************
1249 ! Get data about dimensions
1250 ! ******************************************************************************
1251 
1252  SELECT CASE ( global%casename )
1253  CASE ( "onera_c0_2d_100x50" )
1254  nx = 100
1255  ny = 50
1256  CASE default
1257  CALL errorstop(global,err_reached_default,__line__)
1258  END SELECT ! global%casename
1259 
1260 ! ******************************************************************************
1261 ! Extract data at selected stations
1262 ! ******************************************************************************
1263 
1264  DO ivp = 1,nvp
1265  i = nx/(nvp+1)*ivp
1266 
1267 ! ==============================================================================
1268 ! Open file
1269 ! ==============================================================================
1270 
1271  WRITE(ifilename1,'(A,I2.2,A)') 'onera_c0-vel',ivp,'.dat'
1272 
1273  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1274  iostat=errorflag)
1275  global%error = errorflag
1276  IF ( global%error /= err_none ) THEN
1277  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1278  END IF ! global%error
1279 
1280  IF ( global%verbLevel > verbose_none ) THEN
1281  WRITE(stdout,'(A,3X,A)') solver_name, &
1282  'Writing velocity-profile data to file: '// &
1283  trim(ifilename1)
1284  END IF ! global%verbLevel
1285 
1286 ! ==============================================================================
1287 ! Normalize velocity and write to file at selected stations. NOTE assume grid
1288 ! is uniform in x-direction so that stations are equally spaced.
1289 ! ==============================================================================
1290 
1291  DO j = 1,ny
1292  icg = i + (j-1)*nx ! NOTE assumption about cell numbering
1293 
1294  x = pgrid%cofg(xcoord,icg)
1295  y = pgrid%cofg(ycoord,icg)
1296 
1297  IF ( global%verbLevel > verbose_none .AND. j == 1 ) THEN
1298  WRITE(stdout,'(A,5X,A,1X,I2,1X,A,1X,E13.6)') solver_name,'Station', &
1299  ivp,'located at x=',x
1300  END IF ! global%verbLevel
1301 
1302  r = pregion%mixt%cv(cv_mixt_dens,icg)
1303  ru = pregion%mixt%cv(cv_mixt_xmom,icg)
1304  rv = pregion%mixt%cv(cv_mixt_ymom,icg)
1305 
1306  ir = 1.0_rfreal/r
1307  u = ir*ru
1308  v = ir*rv
1309 
1310  unorm = -u/(0.5_rfreal*global%pi*x/height*vinj)
1311  vnorm = v/vinj
1312 
1313  WRITE(if_extr_data1,'(3(1X,E13.6))') (height-y)/height,unorm,vnorm
1314  END DO ! j
1315 
1316 ! ==============================================================================
1317 ! Close file
1318 ! ==============================================================================
1319 
1320  CLOSE(if_extr_data1,iostat=errorflag)
1321  global%error = errorflag
1322  IF ( global%error /= err_none ) THEN
1323  CALL errorstop(global,err_file_close,__line__,'File: '// &
1324  trim(ifilename1))
1325  END IF ! global%error
1326  END DO ! ivp
1327 
1328 ! ******************************************************************************
1329 ! Write file with exact velocity profile data for comparison purposes
1330 ! ******************************************************************************
1331 
1332 ! ==============================================================================
1333 ! Open file
1334 ! ==============================================================================
1335 
1336  ifilename1 = 'onera_c0-vel-exact.dat'
1337 
1338  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1339  iostat=errorflag)
1340  global%error = errorflag
1341  IF ( global%error /= err_none ) THEN
1342  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1343  END IF ! global%error
1344 
1345 ! ==============================================================================
1346 ! Write data
1347 ! ==============================================================================
1348 
1349  IF ( global%verbLevel > verbose_none ) THEN
1350  WRITE(stdout,'(A,3X,A)') solver_name, &
1351  'Writing exact velocity-profile data to file: '// &
1352  trim(ifilename1)
1353  END IF ! global%verbLevel
1354 
1355  DO j = 1,ny
1356  icg = 1 + (j-1)*nx ! NOTE set i to 1 as only need y-coordinate variation
1357 
1358  x = pgrid%cofg(xcoord,icg)
1359  y = pgrid%cofg(ycoord,icg)
1360 
1361  CALL rflu_computeexactflowproudman(global,x,y,height,dinc,vinj,ptot, &
1362  r,u,v,w,p)
1363 
1364  unorm = -u/(0.5_rfreal*global%pi*x/height*vinj)
1365  vnorm = v/vinj
1366 
1367  WRITE(if_extr_data1,'(3(1X,E13.6))') (height-y)/height,unorm,vnorm
1368  END DO ! j
1369 
1370 ! ==============================================================================
1371 ! Close file
1372 ! ==============================================================================
1373 
1374  CLOSE(if_extr_data1,iostat=errorflag)
1375  global%error = errorflag
1376  IF ( global%error /= err_none ) THEN
1377  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1378  END IF ! global%error
1379 
1380 ! ******************************************************************************
1381 ! End
1382 ! ******************************************************************************
1383 
1384  IF ( global%verbLevel > verbose_none ) THEN
1385  WRITE(stdout,'(A,1X,A)') solver_name,'Extract data for Proudman flow done.'
1386  END IF ! global%verbLevel
1387 
1388  CALL deregisterfunction(global)
1389 
1390 END SUBROUTINE rflu_extractflowdataproudman
1391 
1392 
1393 
1394 
1395 
1396 
1397 ! ******************************************************************************
1398 !
1399 ! Purpose: Extract data for Sod shocktube case.
1400 !
1401 ! Description: None.
1402 !
1403 ! Input:
1404 ! pRegion Pointer to region
1405 !
1406 ! Output: None.
1407 !
1408 ! Notes:
1409 ! 1. Assume domain to lie along x-axis.
1410 ! 2. Assume cross-section to have 3x3 cells, so can find number of cells
1411 ! along x-axis by dividing total number of cells by 9.
1412 !
1413 ! ******************************************************************************
1414 
1415 SUBROUTINE rflu_extractflowdatasod(pRegion)
1416 
1417  IMPLICIT NONE
1418 
1419 ! ******************************************************************************
1420 ! Declarations and definitions
1421 ! ******************************************************************************
1422 
1423 ! ==============================================================================
1424 ! Arguments
1425 ! ==============================================================================
1426 
1427  TYPE(t_global), POINTER :: global
1428  TYPE(t_region), POINTER :: pregion
1429 
1430 ! ==============================================================================
1431 ! Locals
1432 ! ==============================================================================
1433 
1434  CHARACTER(CHRLEN) :: ifilename1
1435  INTEGER :: errorflag,icg,icgbeg,icgend,ncellsx
1436  REAL(RFREAL) :: a,cp,mw,p,r,t,u,v
1437  TYPE(t_grid), POINTER :: pgrid
1438 
1439 ! ******************************************************************************
1440 ! Start
1441 ! ******************************************************************************
1442 
1443  global => pregion%global
1444 
1445  CALL registerfunction(global,'RFLU_ExtractFlowDataSod', &
1446  'RFLU_ModExtractFlowData.F90')
1447 
1448  IF ( global%verbLevel > verbose_none ) THEN
1449  WRITE(stdout,'(A,1X,A)') solver_name, &
1450  'Extract data for Sod shocktube case...'
1451  END IF ! global%verbLevel
1452 
1453 ! ******************************************************************************
1454 ! Set pointers and variables
1455 ! ******************************************************************************
1456 
1457  pgrid => pregion%grid
1458 
1459 ! ******************************************************************************
1460 ! Open file for data
1461 ! ******************************************************************************
1462 
1463  ifilename1 = 'sodst.dat'
1464 
1465  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1466  iostat=errorflag)
1467  global%error = errorflag
1468  IF ( global%error /= err_none ) THEN
1469  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1470  END IF ! global%error
1471 
1472  IF ( global%verbLevel > verbose_none ) THEN
1473  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to file: '// &
1474  trim(ifilename1)
1475  END IF ! global%verbLevel
1476 
1477 ! ******************************************************************************
1478 ! Find cell indices for extraction
1479 ! ******************************************************************************
1480 
1481  ncellsx = pgrid%nCellsTot/9 ! NOTE integer division
1482 
1483  icgbeg = 4*ncellsx + 1
1484  icgend = 5*ncellsx
1485 
1486 ! ******************************************************************************
1487 ! Extract along line of cells
1488 ! ******************************************************************************
1489 
1490  SELECT CASE ( pregion%mixtInput%gasModel )
1491  CASE ( gas_model_tcperf )
1492  DO icg = icgbeg,icgend
1493  r = pregion%mixt%cv(cv_mixt_dens,icg)
1494  u = pregion%mixt%cv(cv_mixt_xmom,icg)/r
1495  p = pregion%mixt%dv(dv_mixt_pres,icg)
1496  t = pregion%mixt%dv(dv_mixt_temp,icg)
1497  a = pregion%mixt%dv(dv_mixt_soun,icg)
1498 
1499  WRITE(if_extr_data1,'(6(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1500  r,u,p,t,a
1501  END DO ! icg
1502  CASE ( gas_model_mixt_tcperf,gas_model_mixt_pseudo )
1503  DO icg = icgbeg,icgend
1504  r = pregion%mixt%cv(cv_mixt_dens,icg)
1505  u = pregion%mixt%cv(cv_mixt_xmom,icg)/r
1506  p = pregion%mixt%dv(dv_mixt_pres,icg)
1507  t = pregion%mixt%dv(dv_mixt_temp,icg)
1508  a = pregion%mixt%dv(dv_mixt_soun,icg)
1509  mw = pregion%mixt%gv(gv_mixt_mol ,icg)
1510  cp = pregion%mixt%gv(gv_mixt_cp ,icg)
1511 
1512  WRITE(if_extr_data1,'(8(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1513  r,u,p,t,a,mw,cp
1514  END DO ! icg
1515  CASE default
1516  CALL errorstop(global,err_reached_default,__line__)
1517  END SELECT ! pRegion%mixtInput%gasModel
1518 
1519 ! ******************************************************************************
1520 ! Close file
1521 ! ******************************************************************************
1522 
1523  CLOSE(if_extr_data1,iostat=errorflag)
1524  global%error = errorflag
1525  IF ( global%error /= err_none ) THEN
1526  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1527  END IF ! global%error
1528 
1529 ! ******************************************************************************
1530 ! End
1531 ! ******************************************************************************
1532 
1533  IF ( global%verbLevel > verbose_none ) THEN
1534  WRITE(stdout,'(A,1X,A)') solver_name,'Extracting data for shocktube done.'
1535  END IF ! global%verbLevel
1536 
1537  CALL deregisterfunction(global)
1538 
1539 END SUBROUTINE rflu_extractflowdatasod
1540 
1541 
1542 
1543 
1544 
1545 ! ******************************************************************************
1546 !
1547 ! Purpose: Extract data for Sommerfeld shock-particle-interaction case.
1548 !
1549 ! Description: None.
1550 !
1551 ! Input:
1552 ! pRegion Pointer to region
1553 !
1554 ! Output: None.
1555 !
1556 ! Notes:
1557 ! 1. Assume domain to lie along x-axis.
1558 ! 2. Assume cross-section to have 1 cell layer in z.
1559 ! 3. Assume patches 1 and 2 to be for x=xlow and x=xhigh boundaries.
1560 ! 4. Assumptions 2 and 3 mean that number of y-layers can be determined by
1561 ! number of faces on patch 1 or 2.
1562 !
1563 ! ******************************************************************************
1564 
1565 SUBROUTINE rflu_extractflowdatasommspi(pRegion)
1566 
1567  IMPLICIT NONE
1568 
1569 ! ******************************************************************************
1570 ! Declarations and definitions
1571 ! ******************************************************************************
1572 
1573 ! ==============================================================================
1574 ! Arguments
1575 ! ==============================================================================
1576 
1577  TYPE(t_global), POINTER :: global
1578  TYPE(t_region), POINTER :: pregion
1579 
1580 ! ==============================================================================
1581 ! Locals
1582 ! ==============================================================================
1583 
1584  CHARACTER(CHRLEN) :: ifilename1
1585  INTEGER :: errorflag,icg,icgbeg,icgend,ncelllayersy,ncellsx
1586  REAL(RFREAL) :: a,cp,idx,ir,lx,mw,p,r,t,u,v,xs
1587  TYPE(t_grid), POINTER :: pgrid
1588 #ifdef PLAG
1589  LOGICAL :: plagflag
1590  INTEGER :: iloctp,ilocup
1591  REAL(RFREAL) :: tp,up
1592 #endif
1593 
1594 ! ******************************************************************************
1595 ! Start
1596 ! ******************************************************************************
1597 
1598  global => pregion%global
1599 
1600  CALL registerfunction(global,'RFLU_ExtractFlowDataSommSPI', &
1601  'RFLU_ModExtractFlowData.F90')
1602 
1603  IF ( global%verbLevel > verbose_none ) THEN
1604  WRITE(stdout,'(A,1X,A)') solver_name, &
1605  'Extracting data for Sommerfeld SPI case...'
1606  END IF ! global%verbLevel
1607 
1608 ! ******************************************************************************
1609 ! Set pointers and variables
1610 ! ******************************************************************************
1611 
1612  pgrid => pregion%grid
1613 
1614 ! ******************************************************************************
1615 ! Find number of cell layers in y, cell indices, and grid spacing for extraction
1616 ! ******************************************************************************
1617 
1618  ncelllayersy = pregion%patches(1)%nBFaces
1619  ncellsx = pgrid%nCellsTot/ncelllayersy ! NOTE integer division
1620 
1621  IF ( global%verbLevel > verbose_none ) THEN
1622  WRITE(stdout,'(A,3X,A,1X,I5)') solver_name,'Number of cell layers in y:', &
1623  ncelllayersy
1624  WRITE(stdout,'(A,3X,A,1X,I5)') solver_name,'Number of cells in x: ', &
1625  ncellsx
1626  END IF ! global%verbLevel
1627 
1628  icgbeg = (ncelllayersy-1)*ncellsx + 1
1629  icgend = ncelllayersy*ncellsx
1630 
1631  lx = maxval(pgrid%xyz(xcoord,1:pgrid%nCellsTot)) &
1632  - minval(pgrid%xyz(xcoord,1:pgrid%nCellsTot))
1633  idx = REAL(ncellsx,kind=rfreal)/lx
1634 
1635 #ifdef PLAG
1636  plagflag = .false.
1637 
1638  IF ( (global%plagUsed .EQV. .true.) .AND. &
1639  (global%postLag2EulFlag .EQV. .true.) ) THEN
1640  ilocup = pregion%plot%pv2pvi(pv_plag_xvel)
1641  iloctp = pregion%plot%pv2pvi(pv_plag_temp)
1642 
1643  IF ( (ilocup /= crazy_value_int) .AND. &
1644  (iloctp /= crazy_value_int) ) THEN
1645  plagflag = .true.
1646  END IF ! iLocUp
1647  END IF ! global%plagUsed
1648 #endif
1649 
1650 ! ******************************************************************************
1651 ! Write usual data
1652 ! ******************************************************************************
1653 
1654 ! ==============================================================================
1655 ! Open file
1656 ! ==============================================================================
1657 
1658  WRITE(ifilename1,'(A,1PE11.5)') 'somm_spi.dat_',global%currentTime
1659 
1660  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1661  iostat=errorflag)
1662  global%error = errorflag
1663  IF ( global%error /= err_none ) THEN
1664  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1665  END IF ! global%error
1666 
1667 ! ==============================================================================
1668 ! Extract usual data along line of cells
1669 ! ==============================================================================
1670 
1671  IF ( global%verbLevel > verbose_none ) THEN
1672  WRITE(stdout,'(A,3X,A)') solver_name,'Writing solution data to file: '// &
1673  trim(ifilename1)
1674  END IF ! global%verbLevel
1675 
1676  SELECT CASE ( pregion%mixtInput%gasModel )
1677  CASE ( gas_model_tcperf )
1678  DO icg = icgbeg,icgend
1679  r = pregion%mixt%cv(cv_mixt_dens,icg)
1680  ir = 1.0_rfreal/r
1681 
1682  u = ir*pregion%mixt%cv(cv_mixt_xmom,icg)
1683  p = pregion%mixt%dv(dv_mixt_pres,icg)
1684  t = pregion%mixt%dv(dv_mixt_temp,icg)
1685  a = pregion%mixt%dv(dv_mixt_soun,icg)
1686 #ifndef PLAG
1687  WRITE(if_extr_data1,'(6(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1688  r,u,p,t,a
1689 #else
1690  IF ( plagflag .EQV. .true. ) THEN
1691  up = pregion%plot%pv(ilocup,icg)
1692  tp = pregion%plot%pv(iloctp,icg)
1693 
1694  WRITE(if_extr_data1,'(8(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1695  r,u,p,t,a,up,tp
1696  ELSE
1697  WRITE(if_extr_data1,'(6(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1698  r,u,p,t,a
1699  END IF ! plagFlag
1700 #endif
1701  END DO ! icg
1702  CASE default
1703  CALL errorstop(global,err_reached_default,__line__)
1704  END SELECT ! pRegion%mixtInput%gasModel
1705 
1706 ! ==============================================================================
1707 ! Close file
1708 ! ==============================================================================
1709 
1710  CLOSE(if_extr_data1,iostat=errorflag)
1711  global%error = errorflag
1712  IF ( global%error /= err_none ) THEN
1713  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1714  END IF ! global%error
1715 
1716 ! ******************************************************************************
1717 ! Find shock position and write to file
1718 ! ******************************************************************************
1719 
1720 ! ==============================================================================
1721 ! Open file
1722 ! ==============================================================================
1723 
1724  WRITE(ifilename1,'(A,1PE11.5)') 'somm_spi_xs.dat_',global%currentTime
1725 
1726  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1727  iostat=errorflag)
1728  global%error = errorflag
1729  IF ( global%error /= err_none ) THEN
1730  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1731  END IF ! global%error
1732 
1733 ! ==============================================================================
1734 ! Extract data and write to file
1735 ! ==============================================================================
1736 
1737  IF ( global%verbLevel > verbose_none ) THEN
1738  WRITE(stdout,'(A,3X,A)') solver_name,'Writing shock position to file: '// &
1739  trim(ifilename1)
1740  END IF ! global%verbLevel
1741 
1742  CALL rflu_extractshocklocation1d(pregion,icgbeg,icgend,ncellsx,xs)
1743 
1744  WRITE(if_extr_data1,'(2(1X,E23.16))') global%currentTime,xs
1745 
1746 ! ==============================================================================
1747 ! Close file
1748 ! ==============================================================================
1749 
1750  CLOSE(if_extr_data1,iostat=errorflag)
1751  global%error = errorflag
1752  IF ( global%error /= err_none ) THEN
1753  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1754  END IF ! global%error
1755 
1756 ! ******************************************************************************
1757 ! End
1758 ! ******************************************************************************
1759 
1760  IF ( global%verbLevel > verbose_none ) THEN
1761  WRITE(stdout,'(A,1X,A)') solver_name, &
1762  'Extracting data for Sommerfeld SPI case done.'
1763  END IF ! global%verbLevel
1764 
1765  CALL deregisterfunction(global)
1766 
1767 END SUBROUTINE rflu_extractflowdatasommspi
1768 
1769 
1770 
1771 
1772 
1773 
1774 ! ******************************************************************************
1775 !
1776 ! Purpose: Extract data for generic 1d shocktube case.
1777 !
1778 ! Description: None.
1779 !
1780 ! Input:
1781 ! pRegion Pointer to region
1782 !
1783 ! Output: None.
1784 !
1785 ! Notes:
1786 ! 1. Assume domain to lie along x-axis.
1787 ! 2. Assume have 2 species if running with mixture gas models.
1788 !
1789 ! ******************************************************************************
1790 
1791 SUBROUTINE rflu_extractflowdatastg1d(pRegion)
1792 
1793 #ifdef SPEC
1794  USE modspecies, ONLY: t_spec_type
1795 #endif
1796 
1797  IMPLICIT NONE
1798 
1799 ! ******************************************************************************
1800 ! Declarations and definitions
1801 ! ******************************************************************************
1802 
1803 ! ==============================================================================
1804 ! Arguments
1805 ! ==============================================================================
1806 
1807  TYPE(t_global), POINTER :: global
1808  TYPE(t_region), POINTER :: pregion
1809 
1810 ! ==============================================================================
1811 ! Locals
1812 ! ==============================================================================
1813 
1814  CHARACTER(CHRLEN) :: ifilename1
1815  INTEGER :: errorflag,icg,icgshock
1816  REAL(RFREAL) :: a,cp,ir,mw,p,r,t,u,v,xs
1817  TYPE(t_grid), POINTER :: pgrid
1818 #ifdef SPEC
1819  INTEGER :: ispec,ispeceev
1820  REAL(RFREAL) :: y1,y2
1821  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: peev
1822  TYPE(t_spec_type), POINTER :: pspectype
1823 #endif
1824 
1825 ! ******************************************************************************
1826 ! Start
1827 ! ******************************************************************************
1828 
1829  global => pregion%global
1830 
1831  CALL registerfunction(global,'RFLU_ExtractFlowDataSTG1D', &
1832  'RFLU_ModExtractFlowData.F90')
1833 
1834  IF ( global%verbLevel > verbose_none ) THEN
1835  WRITE(stdout,'(A,1X,A)') solver_name, &
1836  'Extract data for generic 1d shocktube case...'
1837  END IF ! global%verbLevel
1838 
1839 ! ******************************************************************************
1840 ! Set pointers and variables
1841 ! ******************************************************************************
1842 
1843  pgrid => pregion%grid
1844 
1845 ! ******************************************************************************
1846 ! Write usual data
1847 ! ******************************************************************************
1848 
1849 ! ==============================================================================
1850 ! Open file
1851 ! ==============================================================================
1852 
1853  WRITE(ifilename1,'(A,1PE11.5)') 'stg1d.dat_',global%currentTime
1854 
1855  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1856  iostat=errorflag)
1857  global%error = errorflag
1858  IF ( global%error /= err_none ) THEN
1859  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1860  END IF ! global%error
1861 
1862  IF ( global%verbLevel > verbose_none ) THEN
1863  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to file: '// &
1864  trim(ifilename1)
1865  END IF ! global%verbLevel
1866 
1867 ! ==============================================================================
1868 ! Extract usual data along line of cells
1869 ! ==============================================================================
1870 
1871  SELECT CASE ( pregion%mixtInput%gasModel )
1872  CASE ( gas_model_tcperf )
1873  DO icg = 1,pgrid%nCellsTot
1874  r = pregion%mixt%cv(cv_mixt_dens,icg)
1875  ir = 1.0_rfreal/r
1876 
1877  u = ir*pregion%mixt%cv(cv_mixt_xmom,icg)
1878  p = pregion%mixt%dv(dv_mixt_pres,icg)
1879  t = pregion%mixt%dv(dv_mixt_temp,icg)
1880  a = pregion%mixt%dv(dv_mixt_soun,icg)
1881 
1882  WRITE(if_extr_data1,'(6(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1883  r,u,p,t,a
1884  END DO ! icg
1885  CASE ( gas_model_mixt_tcperf,gas_model_mixt_pseudo )
1886  DO icg = 1,pgrid%nCellsTot
1887  r = pregion%mixt%cv(cv_mixt_dens,icg)
1888  ir = 1.0_rfreal/r
1889 
1890  u = ir*pregion%mixt%cv(cv_mixt_xmom,icg)
1891  p = pregion%mixt%dv(dv_mixt_pres,icg)
1892  t = pregion%mixt%dv(dv_mixt_temp,icg)
1893  a = pregion%mixt%dv(dv_mixt_soun,icg)
1894  mw = pregion%mixt%gv(gv_mixt_mol ,icg)
1895  cp = pregion%mixt%gv(gv_mixt_cp ,icg)
1896 #ifdef SPEC
1897  y1 = ir*pregion%spec%cv(1,icg)
1898  y2 = ir*pregion%spec%cv(2,icg)
1899 
1900  WRITE(if_extr_data1,'(10(1X,E23.16))') pgrid%cofg(xcoord,icg), &
1901  r,u,p,t,a,y1,y2,mw,cp
1902 #endif
1903  END DO ! icg
1904  CASE default
1905  CALL errorstop(global,err_reached_default,__line__)
1906  END SELECT ! pRegion%mixtInput%gasModel
1907 
1908 ! ==============================================================================
1909 ! Close file
1910 ! ==============================================================================
1911 
1912  CLOSE(if_extr_data1,iostat=errorflag)
1913  global%error = errorflag
1914  IF ( global%error /= err_none ) THEN
1915  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1916  END IF ! global%error
1917 
1918 ! ******************************************************************************
1919 ! Find shock position and write to file
1920 ! ******************************************************************************
1921 
1922 ! ==============================================================================
1923 ! Open file
1924 ! ==============================================================================
1925 
1926  WRITE(ifilename1,'(A,1PE11.5)') 'stg1d_xs.dat_',global%currentTime
1927 
1928  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1929  iostat=errorflag)
1930  global%error = errorflag
1931  IF ( global%error /= err_none ) THEN
1932  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
1933  END IF ! global%error
1934 
1935 ! ==============================================================================
1936 ! Extract data and write to file
1937 ! ==============================================================================
1938 
1939  IF ( global%verbLevel > verbose_none ) THEN
1940  WRITE(stdout,'(A,3X,A)') solver_name,'Writing shock position to file: '// &
1941  trim(ifilename1)
1942  END IF ! global%verbLevel
1943 
1944  CALL rflu_extractshocklocation1d(pregion,1,pgrid%nCells,pgrid%nCells,xs)
1945 
1946  WRITE(if_extr_data1,'(2(1X,E23.16))') global%currentTime,xs
1947 
1948 ! ==============================================================================
1949 ! Close file
1950 ! ==============================================================================
1951 
1952  CLOSE(if_extr_data1,iostat=errorflag)
1953  global%error = errorflag
1954  IF ( global%error /= err_none ) THEN
1955  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
1956  END IF ! global%error
1957 
1958 #ifdef SPEC
1959 ! ******************************************************************************
1960 ! Write EE data
1961 ! ******************************************************************************
1962 
1963  IF ( pregion%specInput%nSpeciesEE > 0 ) THEN
1964 
1965 ! ==============================================================================
1966 ! Loop over species
1967 ! ==============================================================================
1968 
1969  DO ispec = 1,pregion%specInput%nSpecies
1970  pspectype => pregion%specInput%specType(ispec)
1971 
1972 ! ------------------------------------------------------------------------------
1973 ! Write EE data if species evolved with EE approach
1974 ! ------------------------------------------------------------------------------
1975 
1976  IF ( pspectype%velocityMethod == spec_methv_eqeul ) THEN
1977  ispeceev = pspectype%iSpec2iSpecEEv
1978 
1979  peev => pregion%spec%eev
1980 
1981 ! ----- Open file --------------------------------------------------------------
1982 
1983  WRITE(ifilename1,'(A,I2.2,A)') 'stg1d',ispeceev,'.dat'
1984 
1985  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
1986  iostat=errorflag)
1987  global%error = errorflag
1988  IF ( global%error /= err_none ) THEN
1989  CALL errorstop(global,err_file_open,__line__,'File: '// &
1990  trim(ifilename1))
1991  END IF ! global%error
1992 
1993  IF ( global%verbLevel > verbose_none ) THEN
1994  WRITE(stdout,'(A,3X,A,1X,I2,1X,A)') solver_name, &
1995  'Writing eev data for species',ispec,'to file: '// &
1996  trim(ifilename1)
1997  END IF ! global%verbLevel
1998 
1999 ! ----- Write data -------------------------------------------------------------
2000 
2001  DO icg = 1,pgrid%nCellsTot
2002  WRITE(if_extr_data1,'(5(1X,E23.16))') &
2003  pgrid%cofg(xcoord,icg), &
2004 ! pEEv(EEV_SPEC_XVEL,iSpecEEv,icg), &
2005 ! pEEv(EEV_SPEC_YVEL,iSpecEEv,icg), &
2006 ! pEEv(EEV_SPEC_ZVEL,iSpecEEv,icg), &
2007 ! pEEv(EEV_SPEC_TEMP,iSpecEEv,icg)
2008  peev(1,ispeceev,icg), &
2009  peev(2,ispeceev,icg), &
2010  peev(3,ispeceev,icg), &
2011  peev(4,ispeceev,icg)
2012  END DO ! icg
2013 
2014 ! ----- Close file -------------------------------------------------------------
2015 
2016  CLOSE(if_extr_data1,iostat=errorflag)
2017  global%error = errorflag
2018  IF ( global%error /= err_none ) THEN
2019  CALL errorstop(global,err_file_close,__line__,'File: '// &
2020  trim(ifilename1))
2021  END IF ! global%error
2022  END IF ! pSpecType%velocityMethod
2023  END DO ! iSpecEE
2024  END IF ! pRegion%specInput%nSpeciesEE
2025 #endif
2026 
2027 ! ******************************************************************************
2028 ! End
2029 ! ******************************************************************************
2030 
2031  IF ( global%verbLevel > verbose_none ) THEN
2032  WRITE(stdout,'(A,1X,A)') solver_name, &
2033  'Extracting data for generic 1d shocktube case done.'
2034  END IF ! global%verbLevel
2035 
2036  CALL deregisterfunction(global)
2037 
2038 END SUBROUTINE rflu_extractflowdatastg1d
2039 
2040 
2041 
2042 
2043 ! ******************************************************************************
2044 !
2045 ! Purpose: Extract data for generic 2d shocktube case.
2046 !
2047 ! Description: None.
2048 !
2049 ! Input:
2050 ! pRegion Pointer to region
2051 !
2052 ! Output: None.
2053 !
2054 ! Notes:
2055 ! 1. Assume domain to lie along x-axis.
2056 ! 2. Assume cross-section to have 3 cells, so can find number of cells
2057 ! along x-axis by dividing total number of cells by 3.
2058 ! 3. Assume have 2 species if running with mixture gas models.
2059 !
2060 ! ******************************************************************************
2061 
2062 SUBROUTINE rflu_extractflowdatastg2d(pRegion)
2063 
2064 #ifdef SPEC
2065  USE modspecies, ONLY: t_spec_type
2066 #endif
2067 
2068  IMPLICIT NONE
2069 
2070 ! ******************************************************************************
2071 ! Declarations and definitions
2072 ! ******************************************************************************
2073 
2074 ! ==============================================================================
2075 ! Arguments
2076 ! ==============================================================================
2077 
2078  TYPE(t_global), POINTER :: global
2079  TYPE(t_region), POINTER :: pregion
2080 
2081 ! ==============================================================================
2082 ! Locals
2083 ! ==============================================================================
2084 
2085  CHARACTER(CHRLEN) :: ifilename1
2086  INTEGER :: errorflag,icg,icgbeg,icgend,ncellsx
2087  REAL(RFREAL) :: a,cp,ir,mw,p,r,t,u,v
2088  TYPE(t_grid), POINTER :: pgrid
2089 #ifdef SPEC
2090  INTEGER :: ispec,ispeceev
2091  REAL(RFREAL) :: y1,y2
2092  REAL(RFREAL), DIMENSION(:,:,:), POINTER :: peev
2093  TYPE(t_spec_type), POINTER :: pspectype
2094 #endif
2095 
2096 ! ******************************************************************************
2097 ! Start
2098 ! ******************************************************************************
2099 
2100  global => pregion%global
2101 
2102  CALL registerfunction(global,'RFLU_ExtractFlowDataSTG2D', &
2103  'RFLU_ModExtractFlowData.F90')
2104 
2105  IF ( global%verbLevel > verbose_none ) THEN
2106  WRITE(stdout,'(A,1X,A)') solver_name, &
2107  'Extract data for generic 2d shocktube case...'
2108  END IF ! global%verbLevel
2109 
2110 ! ******************************************************************************
2111 ! Set pointers and variables
2112 ! ******************************************************************************
2113 
2114  pgrid => pregion%grid
2115 
2116 ! ******************************************************************************
2117 ! Find cell indices for extraction
2118 ! ******************************************************************************
2119 
2120  ncellsx = pgrid%nCellsTot/3 ! NOTE integer division
2121 
2122  icgbeg = ncellsx + 1
2123  icgend = 2*ncellsx
2124 
2125 ! ******************************************************************************
2126 ! Write usual data
2127 ! ******************************************************************************
2128 
2129 ! ==============================================================================
2130 ! Open file
2131 ! ==============================================================================
2132 
2133  ifilename1 = 'stg2d.dat'
2134 
2135  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
2136  iostat=errorflag)
2137  global%error = errorflag
2138  IF ( global%error /= err_none ) THEN
2139  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
2140  END IF ! global%error
2141 
2142  IF ( global%verbLevel > verbose_none ) THEN
2143  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to file: '// &
2144  trim(ifilename1)
2145  END IF ! global%verbLevel
2146 
2147 ! ==============================================================================
2148 ! Extract usual data along line of cells
2149 ! ==============================================================================
2150 
2151  SELECT CASE ( pregion%mixtInput%gasModel )
2152  CASE ( gas_model_tcperf )
2153  DO icg = icgbeg,icgend
2154  r = pregion%mixt%cv(cv_mixt_dens,icg)
2155  ir = 1.0_rfreal/r
2156 
2157  u = ir*pregion%mixt%cv(cv_mixt_xmom,icg)
2158  p = pregion%mixt%dv(dv_mixt_pres,icg)
2159  t = pregion%mixt%dv(dv_mixt_temp,icg)
2160  a = pregion%mixt%dv(dv_mixt_soun,icg)
2161 
2162  WRITE(if_extr_data1,'(6(1X,E23.16))') pgrid%cofg(xcoord,icg), &
2163  r,u,p,t,a
2164  END DO ! icg
2165  CASE ( gas_model_mixt_tcperf,gas_model_mixt_pseudo )
2166  DO icg = icgbeg,icgend
2167  r = pregion%mixt%cv(cv_mixt_dens,icg)
2168  ir = 1.0_rfreal/r
2169 
2170  u = ir*pregion%mixt%cv(cv_mixt_xmom,icg)
2171  p = pregion%mixt%dv(dv_mixt_pres,icg)
2172  t = pregion%mixt%dv(dv_mixt_temp,icg)
2173  a = pregion%mixt%dv(dv_mixt_soun,icg)
2174  mw = pregion%mixt%gv(gv_mixt_mol ,icg)
2175  cp = pregion%mixt%gv(gv_mixt_cp ,icg)
2176 #ifdef SPEC
2177  y1 = ir*pregion%spec%cv(1,icg)
2178  y2 = ir*pregion%spec%cv(2,icg)
2179 
2180  WRITE(if_extr_data1,'(10(1X,E23.16))') pgrid%cofg(xcoord,icg), &
2181  r,u,p,t,a,y1,y2,mw,cp
2182 #endif
2183  END DO ! icg
2184  CASE default
2185  CALL errorstop(global,err_reached_default,__line__)
2186  END SELECT ! pRegion%mixtInput%gasModel
2187 
2188 ! ==============================================================================
2189 ! Close file
2190 ! ==============================================================================
2191 
2192  CLOSE(if_extr_data1,iostat=errorflag)
2193  global%error = errorflag
2194  IF ( global%error /= err_none ) THEN
2195  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
2196  END IF ! global%error
2197 
2198 #ifdef SPEC
2199 ! ******************************************************************************
2200 ! Write EE data
2201 ! ******************************************************************************
2202 
2203  IF ( pregion%specInput%nSpeciesEE > 0 ) THEN
2204 
2205 ! ==============================================================================
2206 ! Loop over species
2207 ! ==============================================================================
2208 
2209  DO ispec = 1,pregion%specInput%nSpecies
2210  pspectype => pregion%specInput%specType(ispec)
2211 
2212 ! ------------------------------------------------------------------------------
2213 ! Write EE data if species evolved with EE approach
2214 ! ------------------------------------------------------------------------------
2215 
2216  IF ( pspectype%velocityMethod == spec_methv_eqeul ) THEN
2217  ispeceev = pspectype%iSpec2iSpecEEv
2218 
2219  peev => pregion%spec%eev
2220 
2221 ! ----- Open file --------------------------------------------------------------
2222 
2223  WRITE(ifilename1,'(A,I2.2,A)') 'stg2d',ispeceev,'.dat'
2224 
2225  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
2226  iostat=errorflag)
2227  global%error = errorflag
2228  IF ( global%error /= err_none ) THEN
2229  CALL errorstop(global,err_file_open,__line__,'File: '// &
2230  trim(ifilename1))
2231  END IF ! global%error
2232 
2233  IF ( global%verbLevel > verbose_none ) THEN
2234  WRITE(stdout,'(A,3X,A,1X,I2,1X,A)') solver_name, &
2235  'Writing eev data for species',ispec,'to file: '// &
2236  trim(ifilename1)
2237  END IF ! global%verbLevel
2238 
2239 ! ----- Write data -------------------------------------------------------------
2240 
2241  DO icg = icgbeg,icgend
2242  WRITE(if_extr_data1,'(5(1X,E23.16))') &
2243  pgrid%cofg(xcoord,icg), &
2244 ! pEEv(EEV_SPEC_XVEL,iSpecEEv,icg), &
2245 ! pEEv(EEV_SPEC_YVEL,iSpecEEv,icg), &
2246 ! pEEv(EEV_SPEC_ZVEL,iSpecEEv,icg), &
2247 ! pEEv(EEV_SPEC_TEMP,iSpecEEv,icg)
2248  peev(1,ispeceev,icg), &
2249  peev(2,ispeceev,icg), &
2250  peev(3,ispeceev,icg), &
2251  peev(4,ispeceev,icg)
2252  END DO ! icg
2253 
2254 ! ----- Close file -------------------------------------------------------------
2255 
2256  CLOSE(if_extr_data1,iostat=errorflag)
2257  global%error = errorflag
2258  IF ( global%error /= err_none ) THEN
2259  CALL errorstop(global,err_file_close,__line__,'File: '// &
2260  trim(ifilename1))
2261  END IF ! global%error
2262  END IF ! pSpecType%velocityMethod
2263  END DO ! iSpecEE
2264  END IF ! pRegion%specInput%nSpeciesEE
2265 #endif
2266 
2267 ! ******************************************************************************
2268 ! End
2269 ! ******************************************************************************
2270 
2271  IF ( global%verbLevel > verbose_none ) THEN
2272  WRITE(stdout,'(A,1X,A)') solver_name, &
2273  'Extracting data for generic 2d shocktube case done.'
2274  END IF ! global%verbLevel
2275 
2276  CALL deregisterfunction(global)
2277 
2278 END SUBROUTINE rflu_extractflowdatastg2d
2279 
2280 
2281 
2282 
2283 
2284 
2285 
2286 ! ******************************************************************************
2287 !
2288 ! Purpose: Extract data for Skews shock diffraction case.
2289 !
2290 ! Description: None.
2291 !
2292 ! Input:
2293 ! pRegion Pointer to region
2294 !
2295 ! Output: None.
2296 !
2297 ! Notes:
2298 ! 1. Assume domain to lie in z=constant plane.
2299 ! 2. Assume domain to be divided into two pieces, a chamber (into which the
2300 ! shock diffracts) and a tube (from which the shock emanates).
2301 ! 3. Assume that the chamber is bounded by (xMin,xMax) x (yMin,yMax) and tube
2302 ! by (xMin,0) x (0,yMax).
2303 ! 4. Assume that grid is uniform and that cells in tube are numbered in
2304 ! y-direction fastest.
2305 ! 5. All these assumptions are satisfied by grids generated by gg_skews.f90
2306 ! grid generator...
2307 !
2308 ! ******************************************************************************
2309 
2310 SUBROUTINE rflu_extractflowdataskews(pRegion)
2311 
2312  IMPLICIT NONE
2313 
2314 ! ******************************************************************************
2315 ! Declarations and definitions
2316 ! ******************************************************************************
2317 
2318 ! ==============================================================================
2319 ! Arguments
2320 ! ==============================================================================
2321 
2322  TYPE(t_global), POINTER :: global
2323  TYPE(t_region), POINTER :: pregion
2324 
2325 ! ==============================================================================
2326 ! Locals
2327 ! ==============================================================================
2328 
2329  CHARACTER(CHRLEN) :: ifilename1
2330  INTEGER :: errorflag,icg,icgoffs,ix,iy,nx,ny
2331  REAL(RFREAL) :: a,h,p,r,t,u,v,xmax,xmin,ymax,ymin
2332  TYPE(t_grid), POINTER :: pgrid
2333 
2334 ! ******************************************************************************
2335 ! Start
2336 ! ******************************************************************************
2337 
2338  global => pregion%global
2339 
2340  CALL registerfunction(global,'RFLU_ExtractFlowDataSkews', &
2341  'RFLU_ModExtractFlowData.F90')
2342 
2343  IF ( global%verbLevel > verbose_none ) THEN
2344  WRITE(stdout,'(A,1X,A)') solver_name, &
2345  'Extracting data for Skews case...'
2346  END IF ! global%verbLevel
2347 
2348 ! ******************************************************************************
2349 ! Set pointers and variables
2350 ! ******************************************************************************
2351 
2352  pgrid => pregion%grid
2353 
2354 ! ******************************************************************************
2355 ! Open file for data
2356 ! ******************************************************************************
2357 
2358  ifilename1 = 'skews.dat'
2359 
2360  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
2361  iostat=errorflag)
2362  global%error = errorflag
2363  IF ( global%error /= err_none ) THEN
2364  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
2365  END IF ! global%error
2366 
2367  IF ( global%verbLevel > verbose_none ) THEN
2368  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to file: '// &
2369  trim(ifilename1)
2370  END IF ! global%verbLevel
2371 
2372 ! ******************************************************************************
2373 ! Find cell from which to start extracting
2374 ! ******************************************************************************
2375 
2376 ! ==============================================================================
2377 ! Compute spacing from coordinate extrema
2378 ! ==============================================================================
2379 
2380  xmax = maxval(pgrid%xyz(xcoord,1:pgrid%nVert))
2381  xmin = minval(pgrid%xyz(xcoord,1:pgrid%nVert))
2382  ymax = maxval(pgrid%xyz(ycoord,1:pgrid%nVert))
2383  ymin = minval(pgrid%xyz(ycoord,1:pgrid%nVert))
2384 
2385  h = sqrt((xmax*(ymax-ymin)-xmin*ymax)/dble(pgrid%nCells))
2386 
2387 ! ==============================================================================
2388 ! Compute number of cells in duct portion of domain
2389 ! ==============================================================================
2390 
2391  nx = int(-xmin/h+0.5_rfreal)
2392  ny = int( ymax/h+0.5_rfreal)
2393 
2394 ! ==============================================================================
2395 ! Compute number of cells in chamber portion of domain and use as offset
2396 ! ==============================================================================
2397 
2398  icgoffs = int(xmax/h+0.5_rfreal)*int((ymax-ymin)/h+0.5_rfreal)
2399 
2400 ! ******************************************************************************
2401 ! Extract along line of cells halfway up duct portion of domain
2402 ! ******************************************************************************
2403 
2404  iy = nx/2 + 1
2405 
2406  DO ix = 1,nx
2407  icg = icgoffs + iy + (ix - 1)*ny
2408 
2409  r = pregion%mixt%cv(cv_mixt_dens,icg)
2410  u = pregion%mixt%cv(cv_mixt_xmom,icg)/r
2411  p = pregion%mixt%dv(dv_mixt_pres,icg)
2412  t = pregion%mixt%dv(dv_mixt_temp,icg)
2413  a = pregion%mixt%dv(dv_mixt_soun,icg)
2414 
2415  WRITE(if_extr_data1,'(7(1X,E23.16))') pgrid%cofg(xcoord,icg), &
2416  pgrid%cofg(ycoord,icg), &
2417  r,u,p,t,a
2418  END DO ! ix
2419 
2420 ! ******************************************************************************
2421 ! Close file
2422 ! ******************************************************************************
2423 
2424  CLOSE(if_extr_data1,iostat=errorflag)
2425  global%error = errorflag
2426  IF ( global%error /= err_none ) THEN
2427  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
2428  END IF ! global%error
2429 
2430 ! ******************************************************************************
2431 ! End
2432 ! ******************************************************************************
2433 
2434  IF ( global%verbLevel > verbose_none ) THEN
2435  WRITE(stdout,'(A,1X,A)') solver_name,'Extracting data for Skews case done.'
2436  END IF ! global%verbLevel
2437 
2438  CALL deregisterfunction(global)
2439 
2440 END SUBROUTINE rflu_extractflowdataskews
2441 
2442 
2443 
2444 
2445 
2446 
2447 
2448 
2449 ! ******************************************************************************
2450 !
2451 ! Purpose: Extract Mesh boundaries for Bump case.
2452 !
2453 ! Description: None.
2454 !
2455 ! Input:
2456 ! pRegion Pointer to region
2457 !
2458 ! Output: None.
2459 !
2460 ! Notes:
2461 ! 1. Assume domain to lie in z=constant plane.
2462 !
2463 ! ******************************************************************************
2464 
2465 SUBROUTINE rflu_writemeshbump(pRegion)
2466 
2467  IMPLICIT NONE
2468 
2469 ! ******************************************************************************
2470 ! Declarations and definitions
2471 ! ******************************************************************************
2472 ! ==============================================================================
2473 ! Arguments
2474 ! ==============================================================================
2475 
2476  TYPE(t_region), POINTER :: pregion
2477 
2478 ! ==============================================================================
2479 ! Locals
2480 ! ==============================================================================
2481 
2482  CHARACTER(CHRLEN) :: ifilename1
2483  INTEGER :: ipatch,iv1,iv2
2484  INTEGER :: errorflag,icg,ix
2485  REAL(RFREAL) :: a,p,r,u,v,w,m,xx,yy,angle
2486  TYPE(t_grid), POINTER :: pgrid
2487  TYPE(t_patch), POINTER :: ppatch
2488  TYPE(t_global), POINTER :: global
2489 
2490 ! ******************************************************************************
2491 ! Start
2492 ! ******************************************************************************
2493 
2494  global => pregion%global
2495 
2496  CALL registerfunction(global,'RFLU_WriteMeshBump',&
2497  'RFLU_ModExtractFlowData.F90')
2498 
2499  IF ( global%verbLevel > verbose_none ) THEN
2500  WRITE(stdout,'(A,1X,A)') solver_name, &
2501  'Extract boundary grid points data:'
2502  END IF ! global%verbLevel
2503 
2504 ! ******************************************************************************
2505 ! Open file for data
2506 ! ******************************************************************************
2507 
2508  WRITE(ifilename1,'(A,A)') trim(global%outDir)// &
2509  trim(global%casename)// &
2510  '_bdry','.dat'
2511 
2512  OPEN(if_extr_data1,file=ifilename1,form='FORMATTED',status='UNKNOWN', &
2513  iostat=errorflag)
2514  global%error = errorflag
2515  IF ( global%error /= 0 ) THEN
2516  CALL errorstop(global,err_file_open,__line__,'File: '//trim(ifilename1))
2517  END IF ! global%error
2518 
2519  IF ( global%verbLevel > verbose_none ) THEN
2520  WRITE(stdout,'(A,3X,A)') solver_name,'Writing data to '// &
2521  trim(ifilename1)
2522  END IF ! global%verbLevel
2523 
2524 ! ******************************************************************************
2525 ! Set pointers and variables
2526 ! ******************************************************************************
2527 
2528  pgrid => pregion%grid
2529 
2530 ! ******************************************************************************
2531 ! Extract along cylinder surface
2532 ! ******************************************************************************
2533 
2534 ! DO iPatch = 1,pGrid%nPatches
2535  DO ipatch = 1,4
2536  ppatch => pregion%patches(ipatch)
2537 
2538  WRITE(if_extr_data1,*) ppatch%nBFaces+1
2539 
2540  IF ( ipatch < 3 ) THEN
2541  ix = 1
2542  iv1 = ppatch%bv(ppatch%bf2v(1,ix))
2543  xx = pgrid%xyz(xcoord,iv1)
2544  yy = pgrid%xyz(ycoord,iv1)
2545  WRITE(if_extr_data1,'(2(1X,E23.16))') xx,yy
2546 
2547  DO ix = 1,ppatch%nBFaces
2548  iv2 = ppatch%bv(ppatch%bf2v(2,ix))
2549  xx = pgrid%xyz(xcoord,iv2)
2550  yy = pgrid%xyz(ycoord,iv2)
2551  WRITE(if_extr_data1,'(2(1X,E23.16))') xx,yy
2552  END DO ! ix
2553  ELSE
2554  ix = ppatch%nBFaces
2555  iv1 = ppatch%bv(ppatch%bf2v(1,ix))
2556  xx = pgrid%xyz(xcoord,iv1)
2557  yy = pgrid%xyz(ycoord,iv1)
2558  WRITE(if_extr_data1,'(2(1X,E23.16))') xx,yy
2559 
2560  DO ix = ppatch%nBFaces,1,-1
2561  iv2 = ppatch%bv(ppatch%bf2v(2,ix))
2562  xx = pgrid%xyz(xcoord,iv2)
2563  yy = pgrid%xyz(ycoord,iv2)
2564  WRITE(if_extr_data1,'(2(1X,E23.16))') xx,yy
2565  END DO ! ix
2566  END IF
2567  END DO ! iPatch
2568 
2569 ! ******************************************************************************
2570 ! Close file
2571 ! ******************************************************************************
2572 
2573  CLOSE(if_extr_data1,iostat=errorflag)
2574  global%error = errorflag
2575  IF ( global%error /= 0 ) THEN
2576  CALL errorstop(global,err_file_close,__line__,'File: '//trim(ifilename1))
2577  END IF ! global%error
2578 
2579 ! ******************************************************************************
2580 ! End
2581 ! ******************************************************************************
2582 
2583  IF ( global%verbLevel > verbose_none ) THEN
2584  WRITE(stdout,'(A,1X,A)') solver_name,'Extract boundary grid points for Bump case done.'
2585  END IF ! global%verbLevel
2586 
2587  CALL deregisterfunction(global)
2588 
2589 END SUBROUTINE rflu_writemeshbump
2590 
2591 
2592 
2593 
2594 
2595 
2596 
2597 END MODULE rflu_modextractflowdata
2598 
2599 ! ******************************************************************************
2600 !
2601 ! RCS Revision history:
2602 !
2603 ! $Log: RFLU_ModExtractFlowData.F90,v $
2604 ! Revision 1.24 2008/12/06 08:45:06 mtcampbe
2605 ! Updated license.
2606 !
2607 ! Revision 1.23 2008/11/19 22:18:16 mtcampbe
2608 ! Added Illinois Open Source License/Copyright
2609 !
2610 ! Revision 1.22 2007/04/12 00:29:56 haselbac
2611 ! Updates to take into account changes to shock location routine
2612 !
2613 ! Revision 1.21 2007/04/05 01:14:28 haselbac
2614 ! Added USE of new extract module, added xs extraction for stg1d
2615 !
2616 ! Revision 1.20 2007/03/27 00:47:27 haselbac
2617 ! Added extraction of particle data to Sommerfeld case
2618 !
2619 ! Revision 1.19 2007/03/19 21:43:28 haselbac
2620 ! Fixed typo in somm_spi write statement
2621 !
2622 ! Revision 1.18 2007/03/02 17:56:33 haselbac
2623 ! Updated SommSPI data extraction to allow for 1d/2d cases
2624 !
2625 ! Revision 1.17 2007/02/27 13:23:40 haselbac
2626 ! Added stg1d case
2627 !
2628 ! Revision 1.16 2007/02/17 20:57:20 haselbac
2629 ! Added shock-position extraction to Sommerfeld case
2630 !
2631 ! Revision 1.15 2007/02/16 20:01:29 haselbac
2632 ! Added code for somm_spi case
2633 !
2634 ! Revision 1.14 2006/08/19 15:41:17 mparmar
2635 ! Added data extractions for nscbc[1-8], farf, bumpq10
2636 !
2637 ! Revision 1.13 2006/04/07 15:19:26 haselbac
2638 ! Removed tabs
2639 !
2640 ! Revision 1.12 2006/01/04 15:48:54 haselbac
2641 ! Changed computation of thicknesses for lfp
2642 !
2643 ! Revision 1.11 2005/11/27 02:00:22 haselbac
2644 ! Added extraction for EEv, bug fix
2645 !
2646 ! Revision 1.10 2005/11/17 14:50:48 haselbac
2647 ! Added extraction of mass fractions for STG
2648 !
2649 ! Revision 1.9 2005/11/14 17:05:24 haselbac
2650 ! Added support for pseudo-gas model
2651 !
2652 ! Revision 1.8 2005/11/11 17:21:04 haselbac
2653 ! Added extraction for generic 2d shocktube
2654 !
2655 ! Revision 1.7 2005/11/10 02:51:30 haselbac
2656 ! Added support for MP sod cases, clean-up
2657 !
2658 ! Revision 1.6 2005/10/09 15:11:40 haselbac
2659 ! Added ONERA C0 data extraction
2660 !
2661 ! Revision 1.5 2005/07/19 19:19:25 haselbac
2662 ! Added new lfp cases, generalized and fixed extraction for lfp
2663 !
2664 ! Revision 1.4 2005/06/14 01:09:50 haselbac
2665 ! Adapted to new case names for Skews case
2666 !
2667 ! Revision 1.3 2005/03/18 23:09:34 haselbac
2668 ! Added routine to extract data for Skews case
2669 !
2670 ! Revision 1.2 2004/10/27 18:08:51 haselbac
2671 ! Cosmetics only
2672 !
2673 ! Revision 1.1 2004/10/26 15:19:11 haselbac
2674 ! Initial revision
2675 !
2676 ! ******************************************************************************
2677 
2678 
2679 
2680 
2681 
2682 
2683 
2684 
2685 
2686 
2687 
2688 
2689 
2690 
2691 
2692 
2693 
rflu_modextractflowdata::rflu_extractflowdatasommspi
subroutine rflu_extractflowdatasommspi(pRegion)
Definition: RFLU_ModExtractFlowData.F90:1565
rflu_modextractflowdata::rflu_extractflowdatastg1d
subroutine rflu_extractflowdatastg1d(pRegion)
Definition: RFLU_ModExtractFlowData.F90:1791
Color::r
unsigned char r() const
Definition: Color.h:68
Aff_transformation_2::m
FT m(int i, int j) const
Definition: Aff_transformation_2.h:228
rflu_modextractflowdata::rflu_extractflowdata
subroutine, public rflu_extractflowdata(pRegion)
Definition: RFLU_ModExtractFlowData.F90:122
Bbox_2::ymin
double ymin() const
Definition: CGAL/include/CGAL/Bbox_2.h:101
rflu_modextractflowdata::rflu_extractflowdatalinefarf
subroutine, private rflu_extractflowdatalinefarf(pRegion)
Definition: RFLU_ModExtractFlowData.F90:964
Bbox_2::xmax
double xmax() const
Definition: CGAL/include/CGAL/Bbox_2.h:106
k
j indices k indices k
Definition: Indexing.h:6
y
void int int REAL REAL * y
Definition: read.cpp:74
rflu_modextractflowdatautils::rflu_extractshocklocation1d
subroutine, public rflu_extractshocklocation1d(pRegion, icgBeg, icgEnd, nCellsX, xs)
Definition: RFLU_ModExtractFlowDataUtils.F90:114
Bbox_2::xmin
double xmin() const
Definition: CGAL/include/CGAL/Bbox_2.h:96
moderror::registerfunction
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
Attribute::status
int status() const
Obtain the status of the attribute.
Definition: Attribute.h:240
modgrid::t_grid
Definition: ModGrid.F90:56
sqrt
double sqrt(double d)
Definition: double.h:73
modspecies::t_spec_type
Definition: ModSpecies.F90:64
rflu_modexactflow
Definition: RFLU_ModExactFlow.F90:42
rflu_modextractflowdata::rflu_extractflowdatastg2d
subroutine, private rflu_extractflowdatastg2d(pRegion)
Definition: RFLU_ModExtractFlowData.F90:2062
v
*********************************************************************Illinois Open Source License ****University of Illinois NCSA **Open Source License University of Illinois All rights reserved ****Developed free of to any person **obtaining a copy of this software and associated documentation to deal with the Software without including without limitation the rights to and or **sell copies of the and to permit persons to whom the **Software is furnished to do subject to the following this list of conditions and the following disclaimers ****Redistributions in binary form must reproduce the above **copyright this list of conditions and the following **disclaimers in the documentation and or other materials **provided with the distribution ****Neither the names of the Center for Simulation of Advanced the University of nor the names of its **contributors may be used to endorse or promote products derived **from this Software without specific prior written permission ****THE SOFTWARE IS PROVIDED AS 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 v
Definition: roccomf90.h:20
rflu_modextractflowdata::rflu_extractflowdataskews
subroutine, private rflu_extractflowdataskews(pRegion)
Definition: RFLU_ModExtractFlowData.F90:2310
rflu_modextractflowdata
Definition: RFLU_ModExtractFlowData.F90:46
i
blockLoc i
Definition: read.cpp:79
angle
double angle(Vector_3< double > v1, Vector_3< double > v2)
Compute the angle between two vectors.
Definition: geometry.C:61
x
void int int REAL * x
Definition: read.cpp:74
rflu_modextractflowdata::rflu_extractflowdataproudman
subroutine, private rflu_extractflowdataproudman(pRegion)
Definition: RFLU_ModExtractFlowData.F90:1189
form
**********************************************************************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
Definition: RFLO_ReadDataFileInt.h:26
rflu_modextractflowdata::rflu_extractflowdatanscbc
subroutine, private rflu_extractflowdatanscbc(pRegion)
Definition: RFLU_ModExtractFlowData.F90:830
Bbox_2::ymax
double ymax() const
Definition: CGAL/include/CGAL/Bbox_2.h:111
rflu_modflowhardcode
Definition: RFLU_ModFlowHardCode.F90:42
rflu_modextractflowdata::rflu_writemeshbump
subroutine, private rflu_writemeshbump(pRegion)
Definition: RFLU_ModExtractFlowData.F90:2465
GeoPrim::CLine::slope
CVector & slope()
Definition: GeoPrimitives.H:1041
rflu_modextractflowdatautils
Definition: RFLU_ModExtractFlowDataUtils.F90:43
rflu_modextractflowdata::rflu_extractflowdatasod
subroutine, private rflu_extractflowdatasod(pRegion)
Definition: RFLU_ModExtractFlowData.F90:1415
j
j indices j
Definition: Indexing.h:6
dy
NT dy
Definition: rational_rotation.h:82
rflu_modflowhardcode::rflu_getparamshardcodeproudman
subroutine, public rflu_getparamshardcodeproudman(dInc, mInj, vInj, pTot)
Definition: RFLU_ModFlowHardCode.F90:115
modglobal::t_global
Definition: ModGlobal.F90:50
moderror::errorstop
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
cimg_library::CImg::distance
CImg< T > & distance(const T isovalue, const float sizex=1, const float sizey=1, const float sizez=1, const bool compute_sqrt=true)
Compute the Euclidean distance map to a shape of specified isovalue.
Definition: CImg.h:20441
moderror::deregisterfunction
subroutine deregisterfunction(global)
Definition: ModError.F90:469
rflu_modextractflowdata::rflu_extractflowdatablasius
subroutine, private rflu_extractflowdatablasius(pRegion)
Definition: RFLU_ModExtractFlowData.F90:288
plag_modparameters
Definition: PLAG_ModParameters.F90:44
Line_2::a
RT a() const
Definition: Line_2.h:140
modbndpatch::t_patch
Definition: ModBndPatch.F90:91
rflu_modexactflow::rflu_computeexactflowproudman
subroutine, public rflu_computeexactflowproudman(global, x, y, height, dInc, vInj, pTot, d, u, v, w, p)
Definition: RFLU_ModExactFlow.F90:309