Rocstar  1.0
Rocstar multiphysics simulation application
 All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Friends Macros Groups Pages
INRT_SetMaterial.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: searches list of materials for one with the given name
26 !
27 ! Description: none.
28 !
29 ! Input: name = input name of material
30 !
31 ! Output: material points to the correct element of global%materials(:)
32 !
33 ! Notes: none.
34 !
35 !******************************************************************************
36 !
37 ! $Id: INRT_SetMaterial.F90,v 1.3 2008/12/06 08:44:32 mtcampbe Exp $
38 !
39 ! Copyright: (c) 2003 by the University of Illinois
40 !
41 !******************************************************************************
42 
43 SUBROUTINE inrt_setmaterial(global,material,name)
44 
45  USE moddatatypes
46  USE modglobal, ONLY : t_global
47  USE modmaterials, ONLY : t_material
48  USE moderror
49  IMPLICIT NONE
50 
51 ! ... parameters
52  TYPE(t_global), POINTER :: global
53  TYPE(t_material), POINTER :: material
54  CHARACTER(*), INTENT(in) :: name
55 
56 ! ... loop variables
57  INTEGER :: imat
58 
59 ! ... local variables
60  LOGICAL :: found
61 
62  CHARACTER(CHRLEN) :: rcsidentstring
63 
64 !******************************************************************************
65 
66  rcsidentstring = '$RCSfile: INRT_SetMaterial.F90,v $ $Revision: 1.3 $'
67 
68  CALL registerfunction( global,'INRT_SetMaterial',&
69  'INRT_SetMaterial.F90' )
70 
71 ! begin -----------------------------------------------------------------------
72 
73  found = .false.
74 
75  DO imat = 1,global%nMaterials
76 
77  IF (trim(name) == trim(global%materials(imat)%name)) THEN
78  material => global%materials(imat)
79  found = .true.
80  EXIT
81  END IF ! name
82 
83  END DO ! iMat
84 
85  IF (.NOT.found) CALL errorstop( global,err_inrt_badmat,__line__,trim(name))
86 
87 ! finalize --------------------------------------------------------------------
88 
89  CALL deregisterfunction( global )
90 
91 END SUBROUTINE inrt_setmaterial
92 
93 !******************************************************************************
94 !
95 ! RCS Revision history:
96 !
97 ! $Log: INRT_SetMaterial.F90,v $
98 ! Revision 1.3 2008/12/06 08:44:32 mtcampbe
99 ! Updated license.
100 !
101 ! Revision 1.2 2008/11/19 22:17:44 mtcampbe
102 ! Added Illinois Open Source License/Copyright
103 !
104 ! Revision 1.1 2004/12/01 21:56:42 fnajjar
105 ! Initial revision after changing case
106 !
107 ! Revision 1.1 2003/03/24 23:23:25 jferry
108 ! converted from libfloflu routine to rocinteract routine
109 !
110 !******************************************************************************
111 
112 
113 
114 
115 
116 
117 
subroutine inrt_setmaterial(global, material, name)
subroutine registerfunction(global, funName, fileName)
Definition: ModError.F90:449
const std::string & name() const
Obtain the name of the attribute.
Definition: Attribute.h:113
subroutine errorstop(global, errorCode, errorLine, addMessage)
Definition: ModError.F90:483
subroutine deregisterfunction(global)
Definition: ModError.F90:469