OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
read_sensor_energy.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| read_sensor_energy ../starter/source/tools/sensor/read_sensor_energy.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_sensors ../starter/source/tools/sensor/hm_read_sensors.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
29!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
30!||--- uses -----------------------------------------------------
31!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
32!|| message_mod ../starter/share/message_module/message_mod.F
33!|| submodel_mod ../starter/share/modules1/submodel_mod.F
34!||====================================================================
35 SUBROUTINE read_sensor_energy(SENSOR_PTR,SENS_ID ,TITR ,
36 . IPART ,SUBSET ,UNITAB ,LSUBMODEL )
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE unitab_mod
41 USE message_mod
42 USE groupdef_mod
43 USE submodel_mod
44 USE sensor_mod
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "scr17_c.inc"
55#include "com04_c.inc"
56#include "units_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER ,INTENT(IN) :: SENS_ID
61 INTEGER ,DIMENSION(LIPART1,*),INTENT(IN) :: IPART
62 CHARACTER(LEN=NCHARTITLE)::TITR
63 TYPE (SENSOR_STR_) :: SENSOR_PTR
64 TYPE (SUBMODEL_DATA) ,DIMENSION(NSUBMOD) :: LSUBMODEL
65 TYPE (SUBSET_) ,DIMENSION(NSUBS) :: SUBSET
66 TYPE (UNIT_TYPE_) ,INTENT(IN) :: UNITAB
67C-----------------------------------------------
68C L o c a l V a r i a b l e s
69C-----------------------------------------------
70 INTEGER :: J,ICONST,SENS_TYPE,PART_ID,SUB_ID,PARTN,SUBN,ISELECT,
71 . nparis,nparrs,nvar
72 my_real :: tdel,tmin,iemin,iemax,kemin,kemax,ietol,ietime,ketol,ketime
73 LOGICAL :: IS_AVAILABLE
74C--------------------------------
75C SENSOR BASED ON PART ENERGY
76C=======================================================================
77 is_available = .false.
78 sens_type = 14
79 iconst = 0 ! const energy option
80c--------------------------------------------------
81card1
82 CALL hm_get_floatv('Tdelay' ,tdel ,is_available,lsubmodel,unitab)
83card2
84 CALL hm_get_intv ('Part_Id' ,part_id ,is_available,lsubmodel)
85 CALL hm_get_intv ('Subset_ID' ,sub_id ,is_available,lsubmodel)
86 CALL hm_get_intv ('Iselect' ,iselect ,is_available,lsubmodel)
87card3
88 CALL hm_get_floatv('iemin' ,IEMIN ,IS_AVAILABLE,LSUBMODEL,UNITAB)
89 CALL HM_GET_FLOATV('iemax' ,IEMAX ,IS_AVAILABLE,LSUBMODEL,UNITAB)
90 CALL HM_GET_FLOATV('kemin' ,KEMIN ,IS_AVAILABLE,LSUBMODEL,UNITAB)
91 CALL HM_GET_FLOATV('kemax' ,KEMAX ,IS_AVAILABLE,LSUBMODEL,UNITAB)
92 CALL HM_GET_FLOATV('tmin' ,TMIN ,IS_AVAILABLE,LSUBMODEL,UNITAB)
93card4
94 CALL HM_GET_FLOATV('ietol' ,IETOL ,IS_AVAILABLE,LSUBMODEL,UNITAB)
95 CALL HM_GET_FLOATV('ietime' ,IETIME ,IS_AVAILABLE,LSUBMODEL,UNITAB)
96 CALL HM_GET_FLOATV('ketol' ,KETOL ,IS_AVAILABLE,LSUBMODEL,UNITAB)
97 CALL HM_GET_FLOATV('ketime' ,KETIME ,IS_AVAILABLE,LSUBMODEL,UNITAB)
98c--------------------------------------------------
99c Defaults
100c--------------------------------------------------
101.and..or..and. IF (IETOL > ZERO IETIME > ZERO KETOL > ZERO KETIME > ZERO) THEN
102 ICONST = 1 ! constant energy option active
103 END IF
104 IF (IEMAX == ZERO) IEMAX = INFINITY
105 IF (KEMAX == ZERO) KEMAX = INFINITY
106 IF (IEMIN == ZERO) IEMIN =-INFINITY
107 IF (KEMIN == ZERO) KEMIN =-INFINITY
108 IF (IETIME == ZERO) IETIME = INFINITY
109 IF (KETIME == ZERO) KETIME = INFINITY
110 IF (ISELECT == 0) ISELECT= 1 ! sum of Part energy by default
111c--------------------------------------------------
112c Check Part_ID, Sub_ID
113c--------------------------------------------------
114 PARTN = 0
115 SUBN = 0
116 IS_AVAILABLE = .FALSE.
117 DO J=1,NPART
118 IF (IPART(4,J) == PART_ID) THEN
119 IS_AVAILABLE = .TRUE.
120 PARTN = J
121 EXIT
122 ENDIF
123 ENDDO
124.NOT. IF ( IS_AVAILABLE) THEN
125 PART_ID = 0
126 ELSE ! ignore subset_id
127 SUB_ID = 0
128 ENDIF
129c
130.NOT. IF ( IS_AVAILABLE) THEN
131 DO J=1,NSUBS-1
132 IF (SUBSET(J)%ID == SUB_ID) THEN
133 IS_AVAILABLE = .TRUE.
134 SUBN = J
135 EXIT
136 ENDIF
137 ENDDO
138.NOT. IF ( IS_AVAILABLE) SUB_ID = 0
139 ENDIF
140c
141.NOT..and. IF ( IS_AVAILABLE ISELECT == 1) THEN
142 ! we take global subset including all parts
143 SUB_ID = SUBSET(NSUBS)%ID
144 SUBN = NSUBS
145 ELSE IF (IS_AVAILABLE) THEN
146 ISELECT = 1
147 ENDIF
148c------------------------------------------------------------
149 WRITE (IOUT, 1000) SENS_ID,TDEL
150 IF (ISELECT == 2) THEN
151 WRITE (IOUT, 2400)
152 ELSE IF (PART_ID > 0) THEN
153 WRITE (IOUT, 2100) PART_ID
154 ELSE IF (SUB_ID > 0) THEN
155 WRITE (IOUT, 2200) SUB_ID
156 ELSE
157 WRITE (IOUT, 2300)
158 END IF
159 WRITE (IOUT ,3000) IEMIN,IEMAX,KEMIN,KEMAX,
160 . IETOL,KETOL,TMIN,IETIME,KETIME
161c--------------------------------------------------
162 IF (IETIME == INFINITY) THEN
163 IETIME = ZERO
164 IETOL = ZERO
165 END IF
166 IF (KETIME == INFINITY) THEN
167 KETIME = ZERO
168 KETOL = ZERO
169 END IF
170c---------------------------
171c sensor data structure
172c--------------------------------------------------
173 NPARIS = 4
174 NPARRS = 8
175 IF (ISELECT == 2) THEN
176 NVAR = 10 ! additional terms to save total system internal and linetic energy
177 ELSE
178 NVAR = 8
179 END IF
180c
181 ALLOCATE (SENSOR_PTR%IPARAM(NPARIS))
182 ALLOCATE (SENSOR_PTR%RPARAM(NPARRS))
183 ALLOCATE (SENSOR_PTR%VAR(NVAR))
184 SENSOR_PTR%VAR(:) = ZERO
185
186 SENSOR_PTR%NVAR = NVAR
187 SENSOR_PTR%NPARI = NPARIS
188 SENSOR_PTR%NPARR = NPARRS
189 SENSOR_PTR%TYPE = SENS_TYPE
190 SENSOR_PTR%SENS_ID = SENS_ID
191 SENSOR_PTR%STATUS = 0 ! status = deactivated
192 SENSOR_PTR%TSTART = INFINITY
193 SENSOR_PTR%TCRIT = INFINITY
194 SENSOR_PTR%TMIN = TMIN
195 SENSOR_PTR%TDELAY = TDEL ! time delay before activation
196 SENSOR_PTR%VALUE = ZERO
197c
198 SENSOR_PTR%IPARAM(1) = PARTN ! PART number
199 SENSOR_PTR%IPARAM(2) = SUBN ! SUBSET number
200 SENSOR_PTR%IPARAM(3) = ICONST ! const energy option
201 SENSOR_PTR%IPARAM(4) = ISELECT ! global system energy vs PART/SUBSET energy selector
202c
203 SENSOR_PTR%RPARAM(1) = IEMIN
204 SENSOR_PTR%RPARAM(2) = IEMAX
205 SENSOR_PTR%RPARAM(3) = KEMIN
206 SENSOR_PTR%RPARAM(4) = KEMAX
207 SENSOR_PTR%RPARAM(5) = IETOL
208 SENSOR_PTR%RPARAM(6) = KETOL
209 SENSOR_PTR%RPARAM(7) = IETIME
210 SENSOR_PTR%RPARAM(8) = KETIME
211c------------------------------------------------------------
212 1000 FORMAT(
213 . 5X,' sensor TYPE 14: part energy '/,
214 . 5X,' --------------------------- '/,
215 . 5X,'sensor id. . . . . . . . . . . . . . . . . =',I10/
216 . 5X,'time delay before activation . . . . . . . =',E12.4)
217 2100 FORMAT(
218 . 5X,' part id. . . . . . . . . . . . . . . . . =',I10)
219 2200 FORMAT(
220 . 5X,' subset id. . . . . . . . . . . . . . . . =',I10)
221 2300 FORMAT(
222 . 5X,' global subset energy(all parts) . . . . .')
223 2400 FORMAT(
224 . 5X,' total system energy(entire model) . . . .')
225 3000 FORMAT(
226 . 5X,' minimum internal energy. . . . . . . . . =',E12.4/
227 . 5X,' maximum internal energy. . . . . . . . . =',E12.4/
228 . 5X,' minimum kinetic energy . . . . . . . . . =',E12.4/
229 . 5X,' maximum kinetic energy . . . . . . . . . =',E12.4/
230 . 5X,' tolerance of constant internal energy. . =',E12.4/
231 . 5X,' tolerance of constant kinetic energy . . =',E12.4/
232 . 5X,' duration limit of max/min energy . . . . =',E12.4/
233 . 5X,' duration limit of constant int energy. . =',E12.4/
234 . 5X,' duration limit of constant kin energy. . =',E12.4//)
235c-----------
236 RETURN
237 END
#define my_real
Definition cppsort.cpp:32
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
#define min(a, b)
Definition macros.h:20
#define max(a, b)
Definition macros.h:21
initmumps id
integer, parameter nchartitle
integer function nvar(text)
Definition nvar.F:32
subroutine read_sensor_energy(sensor_ptr, sens_id, titr, ipart, subset, unitab, lsubmodel)