OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_activ.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!|| hm_read_activ ../starter/source/tools/activ/hm_read_activ.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
32!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
33!||--- uses -----------------------------------------------------
34!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
35!|| message_mod ../starter/share/message_module/message_mod.F
36!|| submodel_mod ../starter/share/modules1/submodel_mod.F
37!||====================================================================
38 SUBROUTINE hm_read_activ(IACTIV ,FACTIV ,SENSORS,IGRBRIC,
39 . IGRQUAD ,IGRSH4N ,IGRSH3N ,IGRTRUSS ,IGRBEAM,
40 . IGRSPRING,LSUBMODEL,UNITAB)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE message_mod
45 USE groupdef_mod
46 USE hm_option_read_mod
47 USE submodel_mod
48 USE unitab_mod
49 USE sensor_mod
50 USE names_and_titles_mod , ONLY : nchartitle
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55C-----------------------------------------------
56C C o m m o n B l o c k s
57C-----------------------------------------------
58#include "com04_c.inc"
59#include "param_c.inc"
60#include "units_c.inc"
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IACTIV(LACTIV,*)
65 my_real FACTIV(LRACTIV,*)
66C-----------------------------------------------
67 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
68 TYPE (GROUP_) , DIMENSION(NGRQUAD) :: IGRQUAD
69 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
70 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
71 TYPE (GROUP_) , DIMENSION(NGRTRUS) :: IGRTRUSS
72 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
73 TYPE (GROUP_) , DIMENSION(NGRSPRI) :: IGRSPRING
74 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
75 TYPE (UNIT_TYPE_),INTENT(IN) :: UNITAB
76 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I,J,ID,ISEN,IGSH,IGSH3,IGBR,IGQU,IGBM,IGTR,IGSP,IERR1
81 INTEGER IFORM
82 my_real startt, stopt
83 LOGICAL :: IS_AVAILABLE
84 CHARACTER(LEN=NCHARTITLE) :: TITR
85C======================================================================|
86 CALL hm_option_start('/ACTIV')
87 DO i=1,nactiv
88 CALL hm_option_read_key(lsubmodel,
89 . option_id = id,
90 . option_titr = titr)
91
92 CALL hm_get_intv('ISENSOR',isen,is_available,lsubmodel)
93 CALL hm_get_intv('GR_BRICK_SET',igbr,is_available,lsubmodel)
94 CALL hm_get_intv('GR_QUAD_SET',igqu,is_available,lsubmodel)
95 CALL hm_get_intv('GRSHEL_SET',igsh,is_available,lsubmodel)
96 CALL hm_get_intv('GR_TRUSS_SET',igtr,is_available,lsubmodel)
97 CALL hm_get_intv('GR_BEAM_SET',igbm,is_available,lsubmodel)
98 CALL hm_get_intv('GR_SPRING_SET',igsp,is_available,lsubmodel)
99 CALL hm_get_intv('GR_SH3N_SET',igsh3,is_available,lsubmodel)
100 CALL hm_get_intv('ACTIV_Iform',iform,is_available,lsubmodel)
101C
102 IF(iform == 0) iform = 1
103 factiv(1,i) = zero
104 factiv(2,i) = zero
105C
106 iactiv(1,i) = 1 ! activation initiale
107 iactiv(2,i) = isen
108 iactiv(3,i) = igbr
109 iactiv(4,i) = igqu
110 iactiv(5,i) = igsh
111 iactiv(6,i) = igtr
112 iactiv(7,i) = igbm
113 iactiv(8,i) = igsp
114 iactiv(9,i) = igsh3
115 iactiv(10,i) = iform
116C
117 IF (isen > 0) THEN
118 ierr1 = 1
119 DO j=1,sensors%NSENSOR
120 IF (isen == sensors%SENSOR_TAB(j)%SENS_ID) THEN
121 iactiv(2,i) = j
122 ierr1 = 0
123 EXIT
124 ENDIF
125 ENDDO
126 IF (ierr1 == 1) THEN
127 CALL ancmsg(msgid=470,
128 . msgtype=msgerror,
129 . anmode=aninfo,
130 . i1=id,
131 . c1=titr,
132 . i2=isen)
133 ENDIF
134 ENDIF
135C
136 IF (iform == 2) THEN
137 CALL hm_get_floatv('ACTIV_Tstart' ,startt ,is_available ,lsubmodel ,unitab)
138 CALL hm_get_floatv('ACTIV_Tstop' ,stopt ,is_available ,lsubmodel ,unitab)
139 IF (stopt == zero) stopt= infinity
140 IF (isen > 0) THEN
141 j = iactiv(2,i)
142 factiv(1,i) = startt + sensors%SENSOR_TAB(j)%TCRIT
143 factiv(2,i) = stopt + sensors%SENSOR_TAB(j)%TCRIT
144 ELSE
145 factiv(1,i) = startt
146 factiv(2,i) = stopt
147 ENDIF
148 ENDIF
149C
150 IF (igbr > 0) THEN
151 ierr1 = 1
152 DO j=1,ngrbric
153 IF (igbr == igrbric(j)%ID) THEN
154 iactiv(3,i) = j
155 ierr1 = 0
156 EXIT
157 ENDIF
158 ENDDO
159 IF (ierr1 == 1) THEN
160 CALL ancmsg(msgid=471,
161 . msgtype=msgerror,
162 . anmode=aninfo,
163 . i1=id,
164 . c1=titr,
165 . i2=igbr)
166 ENDIF
167 ENDIF
168C
169 IF (igqu > 0) THEN
170 ierr1 = 1
171 DO j=1,ngrquad
172 IF (igqu == igrquad(j)%ID) THEN
173 iactiv(4,i) = j
174 ierr1 = 0
175 EXIT
176 ENDIF
177 ENDDO
178 IF (ierr1 == 1) THEN
179 CALL ancmsg(msgid=471,
180 . msgtype=msgerror,
181 . anmode=aninfo,
182 . i1=id,
183 . c1=titr,
184 . i2=igqu)
185 ENDIF
186 ENDIF
187C
188 IF (igsh > 0) THEN
189 ierr1 = 1
190 DO j=1,ngrshel
191 IF (igsh == igrsh4n(j)%ID) THEN
192 iactiv(5,i) = j
193 ierr1 = 0
194 EXIT
195 ENDIF
196 ENDDO
197 IF (ierr1 == 1) THEN
198 CALL ancmsg(msgid=471,
199 . msgtype=msgerror,
200 . anmode=aninfo,
201 . i1=id,
202 . c1=titr,
203 . i2=igsh)
204 ENDIF
205 ENDIF
206C
207 IF (igtr > 0) THEN
208 ierr1 = 1
209 DO j=1,ngrtrus
210 IF (igtr == igrtruss(j)%ID) THEN
211 iactiv(6,i) = j
212 ierr1 = 0
213 EXIT
214 ENDIF
215 ENDDO
216 IF (ierr1 == 1) THEN
217 CALL ancmsg(msgid=471,
218 . msgtype=msgerror,
219 . anmode=aninfo,
220 . i1=id,
221 . c1=titr,
222 . i2=igtr)
223 ENDIF
224 ENDIF
225C
226 IF (igbm > 0) THEN
227 ierr1 = 1
228 DO j=1,ngrbeam
229 IF (igbm == igrbeam(j)%ID) THEN
230 iactiv(7,i) = j
231 ierr1 = 0
232 EXIT
233 ENDIF
234 ENDDO
235 IF (ierr1 == 1) THEN
236 CALL ancmsg(msgid=471,
237 . msgtype=msgerror,
238 . anmode=aninfo,
239 . i1=id,
240 . c1=titr,
241 . i2=igbm)
242 ENDIF
243 ENDIF
244C
245 IF (igsp > 0) THEN
246 ierr1 = 1
247 DO j=1,ngrspri
248 IF (igsp == igrspring(j)%ID) THEN
249 iactiv(8,i) = j
250 ierr1 = 0
251 EXIT
252 ENDIF
253 ENDDO
254 IF (ierr1 == 1) THEN
255 CALL ancmsg(msgid=471,
256 . msgtype=msgerror,
257 . anmode=aninfo,
258 . i1=id,
259 . c1=titr,
260 . i2=igsp)
261 ENDIF
262 ENDIF
263C
264 IF (igsh3 > 0) THEN
265 ierr1 = 1
266 DO j=1,ngrsh3n
267 IF (igsh3 == igrsh3n(j)%ID) THEN
268 iactiv(9,i) = j
269 ierr1 = 0
270 EXIT
271 ENDIF
272 ENDDO
273 IF (ierr1 == 1) THEN
274 CALL ancmsg(msgid=471,
275 . msgtype=msgerror,
276 . anmode=aninfo,
277 . i1=id,
278 . c1=titr,
279 . i2=igsh3)
280 ENDIF
281 ENDIF
282C
283 IF(mod(i,50) == 1) WRITE(iout,1000)
284 IF(iform == 1) THEN
285 WRITE(iout,'(1X,10(1X,I10))')
286 . id,isen,igbr,igqu,igsh,igtr,igbm,igsp,igsh3,iform
287 ELSEIF(iform == 2) THEN
288 WRITE(iout,'(1X,10(1X,I10),1X,G20.13,1X,G20.13)')
289 . id,isen,igbr,igqu,igsh,igtr,igbm,igsp,igsh3,iform,startt,stopt
290 ENDIF
291 ENDDO
292C
293 RETURN
294C
295 1000 FORMAT(//
296 . ' ELEMENT ACTIVATION-DEACTIVATION '/
297 . ' ------------------------------- '/ 4x,
298 . ' OPTION-NB SENSOR',
299 . ' BRICK-GR QUAD-GR SHELL-GR TRUSS-GR',
300 . ' BEAM-GR SPRING-GR SH3N-GR FORM-FLAG',2x,
301 . ' START-TIME STOP-TIME')
302C
303 RETURN
304 END
305
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_activ
subroutine hm_read_activ(iactiv, factiv, sensors, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, lsubmodel, unitab)
Definition hm_read_activ.F:41
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889