Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
PLAG_RFLU_InitSolutionScratch.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: Initialize particle solution in a region from scratch.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! pRegion Pointer to region
31 !
32 ! Output: None.
33 !
34 ! Notes: None.
35 !
36 ! ******************************************************************************
37 !
38 ! $Id: PLAG_RFLU_InitSolutionScratch.F90,v 1.16 2008/12/06 08:44:35 mtcampbe Exp $
39 !
40 ! Copyright: (c) 2004-2005 by the University of Illinois
41 !
42 ! ******************************************************************************
43 
44 SUBROUTINE plag_rflu_initsolutionscratch(pRegion)
45 
46  USE moddatatypes
47  USE moderror
48  USE moddatastruct, ONLY: t_region
49  USE modglobal, ONLY: t_global
50  USE modparameters
51 
53 
55 
56  IMPLICIT NONE
57 
58 ! ******************************************************************************
59 ! Declarations and definitions
60 ! ******************************************************************************
61 
62 ! ==============================================================================
63 ! Arguments
64 ! ==============================================================================
65 
66  TYPE(t_region), POINTER :: pregion
67 
68 ! ==============================================================================
69 ! Locals
70 ! ==============================================================================
71 
72  CHARACTER(CHRLEN) :: rcsidentstring
73  INTEGER :: icont,ipcl
74  INTEGER, POINTER, DIMENSION(:) :: pcvplagmass
75  INTEGER, POINTER, DIMENSION(:,:) :: paiv
76  REAL(RFREAL) :: heatcapsum,masssum,massratio,massfluxratiolimit, &
77  massfluxratiosum,massfluxratiosumr
78  REAL(RFREAL), POINTER, DIMENSION(:) :: pdens,pinjcmassfluxratio,pspcheat
79  REAL(RFREAL), POINTER, DIMENSION(:,:) :: parv, pcv
80  TYPE(t_global), POINTER :: global
81 
82 ! ******************************************************************************
83 ! Start
84 ! ******************************************************************************
85 
86  rcsidentstring = &
87  '$RCSfile: PLAG_RFLU_InitSolutionScratch.F90,v $ $Revision: 1.16 $'
88 
89  global => pregion%global
90 
91  CALL registerfunction(global,'PLAG_RFLU_InitSolutionScratch', &
92  'PLAG_RFLU_InitSolutionScratch.F90')
93 
94  IF ( global%verbLevel > verbose_none ) THEN
95  WRITE(stdout,'(A,1X,A)') solver_name, &
96  'Initializing particle solution from scratch...'
97  END IF ! global%verbLevel
98 
99 ! ******************************************************************************
100 ! Set pointers and values
101 ! ******************************************************************************
102 
103  pregion%plag%nextIdNumber = pregion%plag%nPcls
104 
105  pdens => pregion%plagInput%dens
106  pspcheat => pregion%plagInput%spht
107  pinjcmassfluxratio => pregion%plagInput%injcMassFluxRatio
108 
109  pcvplagmass => pregion%plag%cvPlagMass
110  paiv => pregion%plag%aiv
111  parv => pregion%plag%arv
112  pcv => pregion%plag%cv
113 
114  massfluxratiolimit = 1.0e-10_rfreal
115  massfluxratiosum = sum(pinjcmassfluxratio)
116 
117 ! ==============================================================================
118 ! Set inverse of massFluxRatioSum to avoid division by zero
119 ! ==============================================================================
120 
121  IF ( massfluxratiosum > massfluxratiolimit ) THEN
122  massfluxratiosumr = 1.0_rfreal/massfluxratiosum
123  ELSE
124  massfluxratiosumr = 1.0_rfreal
125  END IF ! massFluxRatioSum
126 
127 ! ******************************************************************************
128 ! Define initial solution
129 ! ******************************************************************************
130 
131  DO ipcl = 1,pregion%plag%nPcls
132  pcv(cv_plag_xpos,ipcl) = pregion%plagInput%iniPosX(ipcl)
133  pcv(cv_plag_ypos,ipcl) = pregion%plagInput%iniPosY(ipcl)
134  pcv(cv_plag_zpos,ipcl) = pregion%plagInput%iniPosZ(ipcl)
135 
136  DO icont = 1,pregion%plagInput%nCont
137  massratio = pinjcmassfluxratio(icont)*massfluxratiosumr
138  pcv(pcvplagmass(icont),ipcl) = pdens(icont)*massratio*global%pi/ &
139  6.0_rfreal*pregion%plagInput%iniDiam(ipcl)**3
140  END DO ! iCont
141 
142  heatcapsum = sum(pcv(pcvplagmass(:),ipcl)*pspcheat(:))
143  masssum = sum(pcv(pcvplagmass(:),ipcl))
144 
145  pcv(cv_plag_xmom,ipcl) = masssum*pregion%plagInput%iniVelX(ipcl)
146  pcv(cv_plag_ymom,ipcl) = masssum*pregion%plagInput%iniVelY(ipcl)
147  pcv(cv_plag_zmom,ipcl) = masssum*pregion%plagInput%iniVelZ(ipcl)
148  pcv(cv_plag_ener,ipcl) = heatcapsum*pregion%plagInput%iniTemp(ipcl)
149 
150  parv(arv_plag_spload,ipcl) = pregion%plagInput%iniSpLoad(ipcl)
151  paiv(aiv_plag_pidini,ipcl) = ipcl
152  paiv(aiv_plag_icells,ipcl) = crazy_value_int ! Value used in initialization
153  paiv(aiv_plag_regini,ipcl) = crazy_value_int
154  END DO ! iPcl
155 
156 ! ******************************************************************************
157 ! End
158 ! ******************************************************************************
159 
160  IF ( global%verbLevel > verbose_none ) THEN
161  WRITE(stdout,'(A,1X,A)') solver_name, &
162  'Initializing particle solution from scratch done.'
163  END IF ! global%verbLevel
164 
165  CALL deregisterfunction(global)
166 
167 END SUBROUTINE plag_rflu_initsolutionscratch
168 
169 ! ******************************************************************************
170 !
171 ! RCS Revision history:
172 !
173 ! $Log: PLAG_RFLU_InitSolutionScratch.F90,v $
174 ! Revision 1.16 2008/12/06 08:44:35 mtcampbe
175 ! Updated license.
176 !
177 ! Revision 1.15 2008/11/19 22:17:47 mtcampbe
178 ! Added Illinois Open Source License/Copyright
179 !
180 ! Revision 1.14 2007/03/08 15:04:19 fnajjar
181 ! Fixed bug for massFluxRatioSum being zero and avoiding division by zero
182 !
183 ! Revision 1.13 2006/05/05 18:05:26 haselbac
184 ! Added init of ICELLS and REGINI
185 !
186 ! Revision 1.12 2005/04/27 14:57:58 fnajjar
187 ! Included module call to PLAG_RFLU_ModFindCells
188 !
189 ! Revision 1.11 2005/03/31 20:25:59 fnajjar
190 ! Added initial particle velocities for scratch solution
191 !
192 ! Revision 1.10 2005/03/11 02:27:29 haselbac
193 ! Simplified locating particles
194 !
195 ! Revision 1.9 2004/11/04 16:29:19 fnajjar
196 ! Deleted nPcls definition
197 !
198 ! Revision 1.8 2004/10/11 22:11:27 haselbac
199 ! Bug fix and renamed procedures
200 !
201 ! Revision 1.7 2004/10/10 17:05:54 fnajjar
202 ! Cleanup of duplicate variables
203 !
204 ! Revision 1.6 2004/10/09 21:22:07 haselbac
205 ! Bug fix: Brute force approach also requires c2f data structure
206 !
207 ! Revision 1.5 2004/10/08 22:10:30 haselbac
208 ! Added brute-force search option for finding particle positions
209 !
210 ! Revision 1.4 2004/08/20 23:28:46 fnajjar
211 ! Aligned with Plag prep tool
212 !
213 ! Revision 1.3 2004/03/15 21:08:48 haselbac
214 ! Changed name of particle location routine
215 !
216 ! Revision 1.2 2004/03/08 22:18:30 fnajjar
217 ! Commented off section specific to CFVEL test case
218 !
219 ! Revision 1.1 2004/02/26 21:00:47 haselbac
220 ! Initial revision
221 !
222 ! ******************************************************************************
223 
224 
225 
226 
227 
228 
229 
Tfloat sum() const
Return the sum of all the pixel values in an image.
Definition: CImg.h:13022
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine plag_rflu_initsolutionscratch(pRegion)