Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
RFLU_PickRegionsManual.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: Pick regions.
26 !
27 ! Description: None.
28 !
29 ! Input:
30 ! regions Region data
31 !
32 ! Output: None.
33 !
34 ! Notes:
35 ! 1. If selecting some regions, initialize postActiveFlag to FALSE only if
36 ! coordinate-activation not selected.
37 !
38 !******************************************************************************
39 !
40 ! $Id: RFLU_PickRegionsManual.F90,v 1.4 2008/12/06 08:45:04 mtcampbe Exp $
41 !
42 ! Copyright: (c) 2003 by the University of Illinois
43 !
44 !******************************************************************************
45 
46 SUBROUTINE rflu_pickregionsmanual(regions)
47 
48  USE moddatatypes
49  USE modglobal, ONLY: t_global
50  USE moddatastruct, ONLY: t_region
51  USE moderror
52  USE modmpi
53  USE modparameters
54 
55  IMPLICIT NONE
56 
57 ! ******************************************************************************
58 ! Declarations and definitions
59 ! ******************************************************************************
60 
61 ! ==============================================================================
62 ! Arguments
63 ! ==============================================================================
64 
65  TYPE(t_region), DIMENSION(:), POINTER :: regions
66 
67 ! ==============================================================================
68 ! Local variables
69 ! ==============================================================================
70 
71  CHARACTER :: infotype
72  CHARACTER(CHRLEN) :: rcsidentstring
73  INTEGER :: ireg
74  TYPE(t_global), POINTER :: global
75 
76 ! ******************************************************************************
77 ! Start
78 ! ******************************************************************************
79 
80  rcsidentstring = '$RCSfile: RFLU_PickRegionsManual.F90,v $ $Revision: 1.4 $'
81 
82  global => regions(1)%global
83 
84  CALL registerfunction(global,'RFLU_PickRegionsManual',&
85  'RFLU_PickRegionsManual.F90')
86 
87  IF ( global%myProcid == masterproc .AND. &
88  global%verbLevel > verbose_none ) THEN
89  WRITE(stdout,'(A,1X,A)') solver_name,'Picking regions manually...'
90  END IF ! global%verbLevel
91 
92 ! ******************************************************************************
93 ! Enter information
94 ! ******************************************************************************
95 
96  WRITE(stdout,'(A,3X,A)') solver_name,'Enter information on regions:'
97  WRITE(stdout,'(A,5X,A)') solver_name,'a - Pick all regions'
98  WRITE(stdout,'(A,5X,A)') solver_name,'s - Pick some regions'
99  WRITE(stdout,'(A,5X,A)') solver_name,'n - Pick no regions'
100  WRITE(stdout,'(A,3X,A)') solver_name,'Enter information type:'
101  READ(stdin,'(A)') infotype
102 
103  SELECT CASE ( infotype )
104 
105 ! ==============================================================================
106 ! All regions
107 ! ==============================================================================
108 
109  CASE ( 'a' )
110  DO ireg = 1,global%nRegionsLocal
111  regions(ireg)%postActiveFlag = .true.
112  END DO ! iReg
113 
114 ! ==============================================================================
115 ! Some regions
116 ! ==============================================================================
117 
118  CASE ( 's' )
119  IF ( global%pickCoordFlag .EQV. .false. ) THEN
120  DO ireg = 1,global%nRegionsLocal
121  regions(ireg)%postActiveFlag = .false.
122  END DO ! iReg
123  END IF ! global%pickCoordFlag
124 
125  DO
126  WRITE(stdout,'(A,3X,A)') solver_name, &
127  'Enter global region index (< 1 to exit):'
128  READ(stdin,*) ireg
129 
130  IF ( ireg < 1 ) THEN
131  EXIT
132  ELSE IF ( ireg > global%nRegionsLocal ) THEN
133  global%warnCounter = global%warnCounter + 1
134 
135  WRITE(stdout,'(A,5X,A,1X,A,I7,1X,A)') solver_name, &
136  '*** WARNING *** Invalid input.', &
137  'There are only ',global%nRegionsLocal,'regions.'
138  ELSE IF ( regions(ireg)%postActiveFlag .EQV. .true. ) THEN
139  global%warnCounter = global%warnCounter + 1
140 
141  WRITE(stdout,'(A,5X,A)') solver_name, &
142  '*** WARNING *** Region already active.'
143  END IF ! iReg
144 
145  regions(ireg)%postActiveFlag = .true.
146  END DO ! <empty>
147 
148 ! ==============================================================================
149 ! No regions
150 ! ==============================================================================
151 
152  CASE ( 'n' )
153 
154 ! ==============================================================================
155 ! Default
156 ! ==============================================================================
157 
158  CASE default
159  global%warnCounter = global%warnCounter + 1
160 
161  WRITE(stdout,'(A,5X,A,1X,A)') solver_name, &
162  '*** WARNING *** Invalid input.', &
163  'No regions selected.'
164  END SELECT ! infoType
165 
166 ! ******************************************************************************
167 ! End
168 ! ******************************************************************************
169 
170  IF ( (global%myProcid == masterproc) .AND. &
171  (global%verbLevel > verbose_none) ) THEN
172  WRITE(stdout,'(A,1X,A)') solver_name,'Picking regions manually done.'
173  END IF ! global%verbLevel
174 
175  CALL deregisterfunction(global)
176 
177 END SUBROUTINE rflu_pickregionsmanual
178 
179 !******************************************************************************
180 !
181 ! RCS Revision history:
182 !
183 ! $Log: RFLU_PickRegionsManual.F90,v $
184 ! Revision 1.4 2008/12/06 08:45:04 mtcampbe
185 ! Updated license.
186 !
187 ! Revision 1.3 2008/11/19 22:18:15 mtcampbe
188 ! Added Illinois Open Source License/Copyright
189 !
190 ! Revision 1.2 2005/12/10 23:30:01 haselbac
191 ! Renamed postCoordFlag
192 !
193 ! Revision 1.1 2003/08/07 15:15:04 haselbac
194 ! Used to be called RFLU_PickRegions
195 !
196 ! Revision 1.2 2003/07/22 02:08:33 haselbac
197 ! Added global%warnCounter
198 !
199 ! Revision 1.1.1.1 2003/06/04 22:31:20 haselbac
200 ! Initial revision
201 !
202 !******************************************************************************
203 
204 
205 
206 
207 
208 
209 
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
subroutine deregisterfunction(global)
Definition: ModError.F90:469
subroutine rflu_pickregionsmanual(regions)