OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_thgrki_vent.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_thgrki_vent ../starter/source/output/th/hm_thgrki_vent.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_thgrou ../starter/source/output/th/hm_read_thgrou.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| fretitl2 ../starter/source/starter/freform.F
31!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.f
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.f
34!|| hm_thvarc ../starter/source/output/th/hm_read_thvarc.F
35!|| hm_thvarvent ../starter/source/output/th/hm_thvarent.F
36!|| hord ../starter/source/output/th/hord.F
37!|| name_fvbag ../starter/source/output/th/hm_thgrki_vent.F
38!|| nintrn ../starter/source/system/nintrn.F
39!|| r2r_exist ../starter/source/coupling/rad2rad/routines_r2r.F
40!|| r2r_listcnt ../starter/source/coupling/rad2rad/routines_r2r.F
41!|| ulist2s ../starter/source/system/sysfus.F
42!|| usr2sys ../starter/source/system/sysfus.F
43!|| zeroin ../starter/source/system/zeroin.F
44!||--- uses -----------------------------------------------------
45!|| format_mod ../starter/share/modules1/format_mod.F90
46!|| fvbag_mod ../starter/share/modules1/fvbag_mod.F
47!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
48!|| message_mod ../starter/share/message_module/message_mod.F
49!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
50!|| submodel_mod ../starter/share/modules1/submodel_mod.F
51!||====================================================================
52 SUBROUTINE hm_thgrki_vent(
53 1 ITYP ,KEY ,INOPT1,
54 3 IAD ,IFI ,ITHGRP,ITHBUF ,
55 4 NV ,VARE ,NUM ,VARG ,NVG ,
56 5 IVARG ,NSNE,NV0,ITHVAR,FLAGABF,NVARABF,
57 6 NOM_OPT,IGS,T_MONVOL,NVARMVENT,LSUBMODEL)
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE fvbag_mod
62 USE message_mod
63 USE monvol_struct_mod
64 USE submodel_mod
65 USE hm_option_read_mod
66 USE names_and_titles_mod , ONLY : nchartitle
67 USE format_mod , ONLY : fmw_i_a
68 USE user_id_mod , ONLY : id_limit
69C-----------------------------------------------
70C I m p l i c i t T y p e s
71C-----------------------------------------------
72#include "implicit_f.inc"
73C-----------------------------------------------
74C C o m m o n B l o c k s
75C-----------------------------------------------
76#include "scr03_c.inc"
77#include "scr17_c.inc"
78#include "com01_c.inc"
79#include "com04_c.inc"
80#include "units_c.inc"
81#include "param_c.inc"
82#include "r2r_c.inc"
83C-----------------------------------------------
84C D u m m y A r g u m e n t s
85C-----------------------------------------------
86 INTEGER ITYP,INOPT1,
87 . ITHGRP(NITHGR),ITHBUF(*),
88 . IFI,IAD,NV,NUM,NVG,NSNE ,IVARG(18,*),
89 . NV0,ITHVAR(*),FLAGABF,NVARABF,ID_VENT(10)
90 CHARACTER*10 VARE(NV),KEY,VARG(NVG)
91 INTEGER NOM_OPT(LNOPT1,*),NVARMVENT
92 TYPE(MONVOL_STRUCT_), DIMENSION(NVOLU), INTENT(IN) :: T_MONVOL
93 TYPE(SUBMODEL_DATA) :: LSUBMODEL(NSUBMOD)
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER J,JJ, I,ISU,ID,NNE,NOSYS,NTOT,KK,IER,
98 . ok,igs,igrs,nsu,k,l,cont,iad0,iadv,ntri,
99 . ifitmp,iadfin,nvar,m,n,iad1,iad2,isk,iproc,varvent(nvarmvent),
100 . nbmonvol,nbvent,nvar_tmp,ityp_monv,
101 . nvent(nvolu),nbvent_max,n_bak,idsmax,
102 . k1,k2,kibjet,kibhol
103 CHARACTER(LEN=NCHARTITLE) :: TITR,TITR1
104 CHARACTER MESS*40,TMP_CHAR*40
105 CHARACTER*20 VENT_NAME(10,NVOLU)
106 LOGICAL IS_AVAILABLE
107C-----------------------------------------------
108C E x t e r n a l F u n c t i o n s
109C-----------------------------------------------
110 INTEGER USR2SYS,ULIST2S,LISTCNT,NINTRN,THVARC
111 INTEGER,EXTERNAL :: HM_THVARC
112 INTEGER R2R_LISTCNT,R2R_EXIST
113 DATA MESS/'TH GROUP DEFINITION '/
114C-----------------------------------------------
115C
116C
117C-----------------------------------------------
118 vent_name(1:10,1:nvolu) = ''
119
120 nvent(1:nvolu) = 0
121 varvent(1:nvarmvent) = 0
122 id=ithgrp(1)
123 id_vent(1:10) = 0
124 nbvent_max = 0
125 CALL fretitl2(titr1,ithgrp(nithgr-ltitr+1),ltitr)
126 ithgrp(2)=ityp
127 ithgrp(3)=0
128 ifitmp=ifi+1000
129
130 CALL hm_get_intv('idsmax',nbmonvol,is_available,lsubmodel)
131 CALL hm_get_intv('number_of_variables',NVAR,IS_AVAILABLE,LSUBMODEL)
132 IF(NVAR>0)NVAR=HM_THVARC(VARE,NV,ITHBUF(IAD),VARG,NVG,IVARG,NV0,ID,TITR1,LSUBMODEL)
133
134 K1=1
135 K2=1+NIMV*NVOLU
136 KIBJET=K2+LICBAG
137 KIBHOL=KIBJET+LIBAGJET
138 DO N=1,NVOLU
139 ITYP_MONV=T_MONVOL(N)%TYPE
140 NVENT(N)=T_MONVOL(N)%NVENT
141 IF (NVENT(N) /= 0) THEN
142 CALL NAME_FVBAG(T_MONVOL(N)%IBAGHOL,VENT_NAME(1,N),NVENT(N))
143 ENDIF
144 ENDDO
145
146 CALL HM_GET_INTV('idsmax',IDSMAX,IS_AVAILABLE,LSUBMODEL)
147
148 ! Loop over Objects IDs
149 DO K = 1,IDSMAX
150 CALL HM_GET_INT_ARRAY_INDEX('ids',N,K,IS_AVAILABLE,LSUBMODEL)
151 CALL HM_GET_INT_ARRAY_INDEX('skew_array',ISK,K,IS_AVAILABLE,LSUBMODEL)
152 CALL HM_GET_STRING_INDEX('name_array',TITR,K,40,IS_AVAILABLE)
153 IF (NSUBDOM>0) THEN
154C-----------> Multidomatic-we jump if the entity no longer exists -----------------------
155 IF(R2R_EXIST(ITYP,N)==0) CYCLE
156C----------------------------------------------------------------------
157 ENDIF
158 N_BAK=N
159 N=0
160 DO J=1,NUM
161 IF(N_BAK==NOM_OPT(1,INOPT1+J))THEN
162 N=J
163 EXIT
164 ENDIF
165 ENDDO
166 IF(N==0)THEN
167 CALL FRETITL2(TITR1,ITHGRP(NITHGR-LTITR+1),LTITR)
168 CALL ANCMSG(MSGID=257,
169 . MSGTYPE=MSGWARNING,
170 . ANMODE=ANINFO_BLIND_1,
171 . I1=ITHGRP(1),
172 . C1=TITR1,
173 . C2=KEY,
174 . I2=N_BAK)
175 ELSE
176 NBVENT_MAX = MAX(NBVENT_MAX,NVENT(N))
177 ENDIF
178 ENDDO
179c
180 CALL HM_THVARVENT(VARE,NV,ITHBUF(IAD),VARG,NVG,IVARG,NV0,ID,TITR1,VARVENT,NBVENT_MAX,LSUBMODEL)
181c
182 NBVENT = 0
183 DO I=1,10
184 DO J=1,5
185 IF (VARVENT( 5*(I-1) + J ) == 1) THEN
186 NBVENT = NBVENT + 1
187 ID_VENT(NBVENT) = I
188 EXIT
189 ENDIF
190 ENDDO
191 ENDDO
192c
193.OR. IF (NBVENT == 0 NBVENT_MAX == 0) THEN
194 IGS = IGS - 1
195 ITHGRP(1:NITHGR)=0
196 ELSE
197c
198 NNE = NBVENT * NBMONVOL
199c
200 NVAR = 0
201 DO I=1,10
202 NVAR_TMP = 0
203 DO J=1,5
204 IF (VARVENT((I-1)*5+J) == 1) THEN
205 NVAR_TMP = NVAR_TMP + 1
206 ENDIF
207 ENDDO
208 NVAR = MAX(NVAR,NVAR_TMP)
209 ENDDO
210c
211 IF(NVAR == 0) CALL ANCMSG(MSGID=1109,
212 . MSGTYPE=MSGERROR,
213 . ANMODE=ANINFO_BLIND_1,
214 . I1=ID,
215 . C1=TITR1 )
216c
217 ITHGRP(6)=NVAR
218 ITHGRP(7)=IAD
219 IAD=IAD+NVAR
220 IFI=IFI+NVAR
221 ITHGRP(4)=NNE
222 ITHGRP(5)=IAD
223 IAD2=IAD+3*NNE
224 ITHGRP(8)=IAD2
225 IFI=IFI+3*NNE+40*NNE
226 CALL ZEROIN(IAD,IAD+43*NNE-1,ITHBUF)
227
228C
229 DO KK = 1,IDSMAX
230 CALL HM_GET_INT_ARRAY_INDEX('ids',N,KK,IS_AVAILABLE,LSUBMODEL)
231 CALL HM_GET_INT_ARRAY_INDEX('skew_array',ISK,KK,IS_AVAILABLE,LSUBMODEL)
232 CALL HM_GET_STRING_INDEX('name_array',TITR,KK,40,IS_AVAILABLE)
233 IF(N/=0)THEN
234 IF (NSUBDOM>0) THEN
235C-----------> Multidomatic-we jump if the entity no longer exists -----------------------
236 IF(R2R_EXIST(ITYP,N)==0) CYCLE
237 ENDIF
238C----------------------------------------------------------------------
239 ENDIF
240 N_BAK = N
241 N=0
242 DO J=1,NUM
243 IF(N_BAK==NOM_OPT(1,INOPT1+J))THEN
244 N=J
245 EXIT
246 ENDIF
247 ENDDO
248 IF(N==0)THEN
249 CALL FRETITL2(TITR1,ITHGRP(NITHGR-LTITR+1),LTITR)
250 CALL ANCMSG(MSGID=257,
251 . MSGTYPE=MSGWARNING,
252 . ANMODE=ANINFO_BLIND_1,
253 . I1=ITHGRP(1),
254 . C1=TITR1,
255 . C2=KEY,
256 . I2=N_BAK)
257 ENDIF
258 DO J=1,NBVENT
259 NSNE=NSNE+1
260 ITHBUF(IAD)=N
261 IAD=IAD+1
262 ENDDO
263 ENDDO
264C
265 IAD = ITHGRP(5)
266 CALL HORD(ITHBUF(IAD),NNE)
267C
268 N=ITHBUF(IAD)
269 DO K=1,NBMONVOL
270 DO I=1,NBVENT
271 N=ITHBUF(IAD)
272 ITHBUF(IAD+2*NNE)=ID_LIMIT%TH
273 ID_LIMIT%TH = ID_LIMIT%TH + 1
274
275 DO J=1,20
276 ITHBUF(IAD2+J-1)=NOM_OPT(J+LNOPT1-LTITR,INOPT1+N)
277 ENDDO
278 CALL FRETITL2(TITR1,ITHBUF(IAD2),40)
279
280 IF (I <= NVENT(K)) THEN
281 WRITE(TMP_CHAR,FMT='(i2,a)') ID_VENT(I),VENT_NAME(I,K)
282 ELSE
283 WRITE(TMP_CHAR,FMT='(i2,a)') ID_VENT(I),''
284 ENDIF
285 TITR1(21:40) = TMP_CHAR(1:20)
286 CALL FRETITL(TITR1,ITHBUF(IAD2),40)
287
288 IAD=IAD+1
289 IAD2=IAD2+40
290 ENDDO
291 ENDDO
292C
293 IAD=IAD2
294C
295C=======================================================================
296C ABF FILES
297C=======================================================================
298 NVAR=ITHGRP(6)
299 IAD0=ITHGRP(7)
300 ITHGRP(9)=NVARABF
301 DO J=IAD0,IAD0+NVAR-1
302 DO K=1,10
303 ITHVAR((ITHGRP(9)+(J-IAD0)-1)*10+K)=
304 . ICHAR(VARE(ITHBUF(J))(K:K))
305 ENDDO
306 ENDDO
307 NVARABF = NVARABF + NVAR
308C=======================================================================
309C PRINTOUT
310C=======================================================================
311 IF(IPRI<1)RETURN
312C
313 N=ITHGRP(4)
314 IAD1=ITHGRP(5)
315 NVAR=ITHGRP(6)
316 IAD0=ITHGRP(7)
317 IAD2=ITHGRP(8)
318 WRITE(IOUT,'(//)')
319 CALL FRETITL2(TITR1,ITHGRP(NITHGR-LTITR+1),LTITR)
320 WRITE(IOUT,'(a,i10,3a,i3,a,i5,2a)')' th group:',ITHGRP(1),
321 . ',',TITR1,',',NVAR,' var',N, KEY,':'
322 WRITE(IOUT,'(a)')' -------------------'
323 WRITE(IOUT,'(10a10)')(VARE(ITHBUF(J)),J=IAD0,IAD0+NVAR-1)
324 WRITE(IOUT,'(3a)')' ',KEY,' name '
325 DO K=IAD1,IAD1+N-1
326 CALL FRETITL2(TITR1,ITHBUF(IAD2),40)
327 IAD2=IAD2+40
328 WRITE(IOUT,FMT=FMW_I_A)NOM_OPT(1,INOPT1+ITHBUF(K)),TITR1(1:40)
329 ENDDO
330 ENDIF
331 RETURN
332 END
333C
334!||====================================================================
335!|| name_fvbag ../starter/source/output/th/hm_thgrki_vent.F
336!||--- called by ------------------------------------------------------
337!|| hm_thgrki_vent ../starter/source/output/th/hm_thgrki_vent.F
338!||--- uses -----------------------------------------------------
339!|| fvbag_mod ../starter/share/modules1/fvbag_mod.F
340!||====================================================================
341 SUBROUTINE NAME_FVBAG(IBAGHOL, VENT_NAME, NVENT )
342C-----------------------------------------------
343C M o d u l e s
344C-----------------------------------------------
345 USE FVBAG_MOD
346C-----------------------------------------------
347C I m p l i c i t T y p e s
348C-----------------------------------------------
349#include "implicit_f.inc"
350C-----------------------------------------------
351C C o m m o n B l o c k s
352C-----------------------------------------------
353#include "param_c.inc"
354C-----------------------------------------------
355C D u m m y A r g u m e n t s
356C-----------------------------------------------
357 INTEGER IBAGHOL(NIBHOL,*),NVENT
358C-----------------------------------------------
359C L o c a l V a r i a b l e s
360C-----------------------------------------------
361 INTEGER K,IVENT,TITREVENT(20)
362 CHARACTER*20 VENTTITLE,VENT_NAME(*)
363C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
364 DO IVENT=1,NVENT
365 DO K=1,20
366 TITREVENT(K)=IBAGHOL(14+K,IVENT)
367 VENTTITLE(K:K) = ACHAR(TITREVENT(K))
368 ENDDO
369 VENT_NAME(IVENT)=VENTTITLE
370 ENDDO
371C
372 RETURN
373 END
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_thgrki_vent
subroutine hm_thgrki_vent(ityp, key, inopt1, iad, ifi, ithgrp, ithbuf, nv, vare, num, varg, nvg, ivarg, nsne, nv0, ithvar, flagabf, nvarabf, nom_opt, igs, t_monvol, nvarmvent, lsubmodel)
Definition hm_thgrki_vent.F:58
fvbag_mod
Definition fvbag_mod.F:44
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
monvol_struct_mod
Definition monvol_struct_mod.F:66
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
submodel_mod
Definition submodel_mod.F:717
nvar
integer function nvar(text)
Definition nvar.F:32
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
starter
program starter
Definition starter.F:39