Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_GetDeformation.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: Obtain deformation to boundary nodes from GENX.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! region grid dimensions and topology
31 !
32 ! Output: None.
33 !
34 ! Notes:
35 ! 1. Get deformation for ALL boundaries, not just coupled ones!
36 !
37 ! ******************************************************************************
38 !
39 ! $Id: RFLU_GetDeformation.F90,v 1.10 2008/12/06 08:44:01 mtcampbe Exp $
40 !
41 ! Copyright: (c) 2002-2005 by the University of Illinois
42 !
43 ! ******************************************************************************
44 
45 SUBROUTINE rflu_getdeformation(region)
46 
47  USE moddatatypes
48  USE modbndpatch, ONLY: t_patch
49  USE moddatastruct, ONLY: t_region
50  USE modglobal, ONLY: t_global
51  USE moderror
52  USE modparameters
53  USE modmpi
54 
55  IMPLICIT NONE
56 
57 ! ******************************************************************************
58 ! Definitions and declarations
59 ! ******************************************************************************
60 
61 ! ==============================================================================
62 ! Arguments
63 ! ==============================================================================
64 
65  TYPE(t_region) :: region
66 
67 ! ==============================================================================
68 ! Locals
69 ! ==============================================================================
70 
71  CHARACTER(CHRLEN) :: rcsidentstring
72  INTEGER :: ipatch,ibv
73  TYPE(t_global), POINTER :: global
74  TYPE(t_patch), POINTER :: ppatch
75 
76 ! ******************************************************************************
77 ! Start
78 ! ******************************************************************************
79 
80  rcsidentstring = '$RCSfile: RFLU_GetDeformation.F90,v $ $Revision: 1.10 $'
81 
82  global => region%global
83 
84  CALL registerfunction(global,'RFLU_GetDeformation',&
85  'RFLU_GetDeformation.F90')
86 
87 ! ******************************************************************************
88 ! Loop over ALL boundaries
89 ! ******************************************************************************
90 
91  IF ( global%myProcid == masterproc .AND. &
92  global%verbLevel >= verbose_high ) THEN
93  WRITE(stdout,'(A,1X,A,1X,I3)') solver_name, &
94  'Getting displacements from Rocstar...'
95  END IF ! global%myProcid
96 
97  DO ipatch=1,region%grid%nPatches
98  ppatch => region%patches(ipatch)
99 
100  DO ibv = 1,ppatch%nBVert
101  ppatch%dXyz(xcoord,ibv) = ppatch%duAlp(xcoord,ibv)
102  ppatch%dXyz(ycoord,ibv) = ppatch%duAlp(ycoord,ibv)
103  ppatch%dXyz(zcoord,ibv) = ppatch%duAlp(zcoord,ibv)
104  END DO ! ibv
105 
106  DO ibv = ppatch%nBVert+1,ppatch%nBVertTot
107  ppatch%dXyz(xcoord,ibv) = REAL(crazy_value_int,kind=rfreal)
108  ppatch%dXyz(ycoord,ibv) = REAL(CRAZY_VALUE_INT,KIND=RFREAL)
109  ppatch%dXyz(zcoord,ibv) = REAL(crazy_value_int,kind=rfreal)
110  END DO ! ibv
111 
112  IF ( global%myProcid == masterproc .AND. &
113  global%verbLevel >= verbose_high ) THEN
114  IF ( ppatch%nBVert > 0 ) THEN
115  WRITE(stdout,'(A,3X,A,1X,I3)') solver_name,'Patch:',ipatch
116  WRITE(stdout,'(A,5X,A)') solver_name,'Minimum/maximum values:'
117  WRITE(stdout,'(A,7X,A,2(1X,E15.8))') solver_name,'dXyz.x:', &
118  minval(ppatch%dXyz(xcoord,1:ppatch%nBVert)), &
119  maxval(ppatch%dXyz(xcoord,1:ppatch%nBVert))
120  WRITE(stdout,'(A,7X,A,2(1X,E15.8))') solver_name,'dXyz.y:', &
121  minval(ppatch%dXyz(ycoord,1:ppatch%nBVert)), &
122  maxval(ppatch%dXyz(ycoord,1:ppatch%nBVert))
123  WRITE(stdout,'(A,7X,A,2(1X,E15.8))') solver_name,'dXyz.z:', &
124  minval(ppatch%dXyz(zcoord,1:ppatch%nBVert)), &
125  maxval(ppatch%dXyz(zcoord,1:ppatch%nBVert))
126  END IF ! pPatch%nBVert
127  END IF ! global%myProcid
128  END DO ! iPatch
129 
130 ! ******************************************************************************
131 ! End
132 ! ******************************************************************************
133 
134  IF ( global%myProcid == masterproc .AND. &
135  global%verbLevel >= verbose_high ) THEN
136  WRITE(stdout,'(A,1X,A,1X,I3)') solver_name, &
137  'Getting displacements from Rocstar done.'
138  END IF ! global%myProcid
139 
140  CALL deregisterfunction(global)
141 
142 END SUBROUTINE rflu_getdeformation
143 
144 ! ******************************************************************************
145 !
146 ! RCS Revision history:
147 !
148 ! $Log: RFLU_GetDeformation.F90,v $
149 ! Revision 1.10 2008/12/06 08:44:01 mtcampbe
150 ! Updated license.
151 !
152 ! Revision 1.9 2008/11/19 22:17:15 mtcampbe
153 ! Added Illinois Open Source License/Copyright
154 !
155 ! Revision 1.8 2005/06/09 20:17:06 haselbac
156 ! Cosmetics only
157 !
158 ! Revision 1.7 2004/10/19 19:35:06 haselbac
159 ! Cosmetics only
160 !
161 ! Revision 1.6 2003/08/20 02:09:58 haselbac
162 ! Changed verbosity conditions to reduce solver output in GENx runs
163 !
164 ! Revision 1.5 2003/05/13 23:42:02 haselbac
165 ! Added init of dummy vertices
166 !
167 ! Revision 1.4 2003/04/12 21:33:22 haselbac
168 ! Made parallel: Added MASTERPROC checks
169 !
170 ! Revision 1.3 2002/10/27 18:43:21 haselbac
171 ! Mainly cosmetic changes to output
172 !
173 ! Revision 1.2 2002/10/07 14:09:32 haselbac
174 ! Changed ModBndpatch to ModBndPatch
175 !
176 ! Revision 1.1 2002/10/05 18:28:18 haselbac
177 ! Initial revision
178 !
179 ! ******************************************************************************
180 
181 
182 
183 
184 
185 
186 
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine rflu_getdeformation(region)