Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_ResidualNorm.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: Compute the L2-norm of the density changes.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! regions Array of regions
31 !
32 ! Output: None.
33 !
34 ! Notes: None.
35 !
36 ! ******************************************************************************
37 !
38 ! $Id: RFLU_ResidualNorm.F90,v 1.8 2008/12/06 08:44:30 mtcampbe Exp $
39 !
40 ! Copyright: (c) 2002-2005 by the University of Illinois
41 !
42 ! ******************************************************************************
43 
44 SUBROUTINE rflu_residualnorm(regions)
45 
46  USE moddatatypes
47  USE moddatastruct, ONLY: t_region
48  USE modglobal, ONLY: t_global
49  USE moderror
50  USE modmpi
51  USE modparameters
52 
53  IMPLICIT NONE
54 
55 ! ******************************************************************************
56 ! Declarations and definitions
57 ! ******************************************************************************
58 
59 ! ==============================================================================
60 ! Arguments
61 ! ==============================================================================
62 
63  TYPE(t_region), POINTER :: regions(:)
64 
65 ! ==============================================================================
66 ! Locals
67 ! ==============================================================================
68 
69  CHARACTER(CHRLEN) :: rcsidentstring
70  INTEGER :: errorflag,icg,ireg
71  REAL(RFREAL) :: dr,drsum,drsumtot
72  REAL(RFREAL), DIMENSION(:,:), POINTER :: pcv,pcvold
73  TYPE(t_global), POINTER :: global
74 
75 ! ******************************************************************************
76 ! Start
77 ! ******************************************************************************
78 
79  rcsidentstring = '$RCSfile: RFLU_ResidualNorm.F90,v $ $Revision: 1.8 $'
80 
81  global => regions(1)%global
82 
83  CALL registerfunction(global,'RFLU_ResidualNorm',&
84  'RFLU_ResidualNorm.F90')
85 
86 ! ******************************************************************************
87 ! Sum density changes over local regions
88 ! ******************************************************************************
89 
90  drsum = 0.0_rfreal
91 
92  DO ireg = 1,global%nRegionsLocal
93  pcv => regions(ireg)%mixt%cv
94  pcvold => regions(ireg)%mixt%cvOld
95 
96  DO icg = 1,regions(ireg)%grid%nCells
97  dr = pcv(cv_mixt_dens,icg) - pcvold(cv_mixt_dens,icg)
98  drsum = drsum + dr*dr
99  END DO ! icg
100  END DO ! iReg
101 
102 ! ******************************************************************************
103 ! Reduce across processes
104 ! ******************************************************************************
105 
106  IF ( global%nRegions > 1 ) THEN
107  CALL mpi_allreduce(drsum,drsumtot,1,mpi_rfreal,mpi_sum,global%mpiComm, &
108  errorflag)
109  global%error = errorflag
110  IF ( global%error /= err_none ) THEN
111  CALL errorstop(global,err_mpi_output,__line__)
112  END IF ! global%error
113  ELSE
114  drsumtot = drsum
115  END IF ! global%nRegions
116 
117 ! ******************************************************************************
118 ! Finalize
119 ! ******************************************************************************
120 
121  global%residual = sqrt(drsumtot)
122 
123  IF ( global%currentIter == 1 ) THEN
124  global%resInit = global%residual
125  END IF ! global
126 
127 ! ******************************************************************************
128 ! End
129 ! ******************************************************************************
130 
131  CALL deregisterfunction(global)
132 
133 END SUBROUTINE rflu_residualnorm
134 
135 ! ******************************************************************************
136 !
137 ! RCS Revision history:
138 !
139 ! $Log: RFLU_ResidualNorm.F90,v $
140 ! Revision 1.8 2008/12/06 08:44:30 mtcampbe
141 ! Updated license.
142 !
143 ! Revision 1.7 2008/11/19 22:17:43 mtcampbe
144 ! Added Illinois Open Source License/Copyright
145 !
146 ! Revision 1.6 2006/04/07 15:19:22 haselbac
147 ! Removed tabs
148 !
149 ! Revision 1.5 2005/04/15 15:07:24 haselbac
150 ! Converted to MPI
151 !
152 ! Revision 1.4 2002/09/09 15:51:56 haselbac
153 ! global now under region
154 !
155 ! Revision 1.3 2002/07/25 14:30:40 haselbac
156 ! Added FEM call to find proper residual norm for parallel runs
157 !
158 ! Revision 1.2 2002/06/14 20:19:59 haselbac
159 ! Deleted ModLocal, changed local%nRegions to global%nRegionsLocal
160 !
161 ! Revision 1.1 2002/05/04 17:01:59 haselbac
162 ! Initial revision
163 !
164 ! ******************************************************************************
165 
166 
167 
168 
169 
170 
171 
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
double sqrt(double d)
Definition: double.h:73
subroutine rflu_residualnorm(regions)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469