Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_CheckCouplingInput.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: Check that have coupled boundaries defined for coupled simulations.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! regions Regions data
31 !
32 ! Output: None.
33 !
34 ! Notes: None.
35 !
36 ! ******************************************************************************
37 !
38 ! $Id: RFLU_CheckCouplingInput.F90,v 1.4 2008/12/06 08:44:01 mtcampbe Exp $
39 !
40 ! Copyright: (c) 2003-2005 by the University of Illinois
41 !
42 ! ******************************************************************************
43 
44 SUBROUTINE rflu_checkcouplinginput(regions)
45 
46  USE moddatatypes
47  USE moddatastruct, ONLY: t_region
48  USE modglobal, ONLY: t_global
49  USE modbndpatch, ONLY: t_patch
50  USE moderror
51  USE modparameters
52  USE modmpi
53 
54  IMPLICIT NONE
55 
56 ! ******************************************************************************
57 ! Definitions and declarations
58 ! ******************************************************************************
59 
60 ! ==============================================================================
61 ! Arguments
62 ! ==============================================================================
63 
64  TYPE(t_region), DIMENSION(:) :: regions
65 
66 ! ==============================================================================
67 ! Locals
68 ! ==============================================================================
69 
70  CHARACTER(CHRLEN) :: rcsidentstring
71  INTEGER :: cntrglob,cntrloc,errorflag,ipatch,ireg
72  TYPE(t_patch), POINTER :: ppatch
73  TYPE(t_global), POINTER :: global
74 
75 ! ******************************************************************************
76 ! Start
77 ! ******************************************************************************
78 
79  rcsidentstring = '$RCSfile: RFLU_CheckCouplingInput.F90,v $ $Revision: 1.4 $'
80 
81  global => regions(1)%global
82 
83  CALL registerfunction(global,'RFLU_CheckCouplingInput',&
84  'RFLU_CheckCouplingInput.F90')
85 
86  IF ( global%myProcid == masterproc .AND. &
87  global%verbLevel > verbose_none ) THEN
88  WRITE(stdout,'(A,1X,A)') solver_name,'Checking coupling input...'
89  END IF ! global%verbLevel
90 
91  cntrglob = 0
92  cntrloc = 0
93 
94 ! ******************************************************************************
95 ! Count number of interacting patches on this processor
96 ! ******************************************************************************
97 
98  DO ireg = lbound(regions,1),ubound(regions,1)
99  DO ipatch = 1,regions(ireg)%grid%nPatches
100  ppatch => regions(ireg)%patches(ipatch)
101 
102  IF ( ppatch%bcCoupled /= bc_not_coupled ) THEN
103  cntrloc = cntrloc + 1
104  END IF ! pPatch%bcCoupled
105  END DO ! iPatch
106  END DO ! iReg
107 
108 ! ******************************************************************************
109 ! Reduce to total number of interacting patches, exit if none
110 ! ******************************************************************************
111 
112  CALL mpi_reduce(cntrloc,cntrglob,1,mpi_integer,mpi_sum,masterproc, &
113  global%mpiComm,errorflag)
114  global%error = errorflag
115  IF ( global%error /= err_none ) THEN
116  CALL errorstop(global,err_mpi_trouble,__line__)
117  END IF ! global%errorFlag
118 
119  IF ( global%myProcid == masterproc .AND. cntrglob == 0 ) THEN
120  CALL errorstop(global,err_bccoupled_none,__line__)
121  END IF ! global%myProcid
122 
123 ! ******************************************************************************
124 ! End
125 ! ******************************************************************************
126 
127  IF ( global%myProcid == masterproc .AND. &
128  global%verbLevel > verbose_none ) THEN
129  WRITE(stdout,'(A,1X,A)') solver_name,'Checking coupling input done.'
130  END IF ! global%verbLevel
131 
132  CALL deregisterfunction(global)
133 
134 END SUBROUTINE rflu_checkcouplinginput
135 
136 ! ******************************************************************************
137 !
138 ! RCS Revision history:
139 !
140 ! $Log: RFLU_CheckCouplingInput.F90,v $
141 ! Revision 1.4 2008/12/06 08:44:01 mtcampbe
142 ! Updated license.
143 !
144 ! Revision 1.3 2008/11/19 22:17:15 mtcampbe
145 ! Added Illinois Open Source License/Copyright
146 !
147 ! Revision 1.2 2005/04/15 15:05:58 haselbac
148 ! Converted to MPI, cosmetics
149 !
150 ! Revision 1.1 2003/05/01 14:04:23 haselbac
151 ! Initial revision
152 !
153 ! ******************************************************************************
154 
155 
156 
157 
158 
159 
160 
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine rflu_checkcouplinginput(regions)
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469