OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inter_type18.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_inter_type18 ../starter/source/interfaces/int18/hm_read_inter_type18.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_inter_fsi ../starter/source/interfaces/reader/hm_read_inter_fsi.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!|| ngr2usr ../starter/source/system/nintrr.F
32!||--- uses -----------------------------------------------------
33!|| message_mod ../starter/share/message_module/message_mod.F
34!|| submodel_mod ../starter/share/modules1/submodel_mod.F
35!||====================================================================
36 SUBROUTINE hm_read_inter_type18(
37 1 IPARI ,STFAC ,FRIGAP ,NOINT ,
38 3 IGRNOD ,IGRSURF ,IGRBRIC ,XFILTR ,FRIC_P ,
39 3 TITR ,UNITAB ,LSUBMODEL ,MULTI_FVM ,NPARI ,
40 4 NPARIR)
41C============================================================================
42C-----------------------------------------------
43C D e s c r i p t i o n
44C-----------------------------------------------
45C This subroutine is reading user input file.
46C Parameters are checked and default values are introduced.
47C Parameter and flags are stored in working buffer (IPARI:integer; FRIGAP:real)
48C Buffer arrays are later written in restart file to be read by Engine program.
49C-----------------------------------------------
50C M o d u l e s
51C-----------------------------------------------
52 USE message_mod
53 USE groupdef_mod
54 USE submodel_mod
55 USE unitab_mod
56 USE multi_fvm_mod
57 USE names_and_titles_mod , ONLY : nchartitle
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "scr06_c.inc"
66#include "com04_c.inc"
67#include "units_c.inc"
68#include "inter18.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER,INTENT(IN) :: NPARI, NPARIR !< array sizes
73 INTEGER ISU1,ISU2,IS1,IS2,NOINT
74 INTEGER IPARI(NPARI)
75 my_real FRIGAP(NPARIR),FRIC_P(10),STFAC,XFILTR
76 CHARACTER(LEN=NCHARTITLE),INTENT(IN) :: TITR
77 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
78C-----------------------------------------------
79 TYPE(group_),TARGET, DIMENSION(NGRNOD) :: IGRNOD
80 TYPE(surf_),TARGET ,DIMENSION(NSURF) :: IGRSURF
81 TYPE(group_),TARGET, DIMENSION(NGRBRIC) :: IGRBRIC
82 TYPE(SUBMODEL_DATA), DIMENSION(NSUBMOD), INTENT(IN) :: LSUBMODEL
83 TYPE(unit_type_), INTENT(IN) :: UNITAB
84C-----------------------------------------------
85C L o c a l V a r i a b l e s
86C-----------------------------------------------
87 INTEGER GRBRIC_ID,IBAG,IDEL7N,IGAP,IGAP0,NTYP,INACTI,
88 . IDELKEEP,ISU1_user,ISU2_user,ISU3_user,ISTIFF
89 my_real GAP,STARTT,STOPT,BUMULT,VISC,FRIC,VREF,SCALE
90 CHARACTER(LEN=NCHARTITLE)::MSGTITL
91 INTEGER, DIMENSION(:), POINTER :: INGR2USR
92 INTEGER,EXTERNAL :: NGR2USR
93 LOGICAL :: IS_AVAILABLE,
94 . is_available_visc,
95 . is_available_bumult
96C-----------------------------------------------
97C S o u r c e L i n e s
98C-----------------------------------------------
99C /INTER/TYPE18 READING
100C-----------------------------------------------
101C Initializations
102 msgtitl(1:nchartitle)=' '
103 is1=0
104 is2=0
105 igap=0
106 fric=zero
107 idelkeep=0
108 xfiltr=zero
109 bumult=zero
110 visc=zero
111 istiff=0
112 vref=zero
113 startt=zero
114 stopt=ep30
115!Interface 18 <=> NTYP=7 &INACTI=7
116 ntyp = 7
117 inacti = 7
118 ipari(15)=noint
119 ipari(7)=ntyp
120C------------------------------------------------------------
121C Line1
122C------------------------------------------------------------
123 CALL hm_get_intv('ALEnodesEntityids', isu1, is_available, lsubmodel)
124 IF (.NOT. is_available) THEN
125 isu1 = 0
126 ENDIF
127 CALL hm_get_intv('mainentityids', isu2, is_available, lsubmodel)
128 CALL hm_get_intv('ALEelemsEntityids', grbric_id, is_available, lsubmodel)
129 CALL hm_get_intv('Igap', igap, is_available, lsubmodel)
130 CALL hm_get_intv('Idel', idel7n, is_available, lsubmodel)
131 CALL hm_get_intv('Iauto', istiff, is_available, lsubmodel)
132C------------------------------------------------------------
133C Line2
134C------------------------------------------------------------
135 CALL hm_get_floatv('STFAC', stfac, is_available, lsubmodel, unitab)
136 CALL hm_get_floatv('VREF', vref, is_available, lsubmodel, unitab)
137 CALL hm_get_floatv('GAP', gap, is_available, lsubmodel, unitab)
138 CALL hm_get_floatv('TSTART', startt, is_available, lsubmodel, unitab)
139 CALL hm_get_floatv('TSTOP', stopt, is_available, lsubmodel, unitab)
140C------------------------------------------------------------
141C Line3
142C------------------------------------------------------------
143 CALL hm_get_floatv('STIFF_DC', visc, is_available_visc, lsubmodel, unitab)
144 CALL hm_get_floatv('SORT_FACT', bumult, is_available_bumult, lsubmodel, unitab)
145
146!===BACKUP TO BE ABLE TO OUTPUT USER ids
147 isu1_user=isu1
148 isu2_user=isu2
149 isu3_user=grbric_id
150
151!===CHECK USER FLAG FOR GAP VALUE
152 IF(igap == 0)igap=1000 !default (constant gap)
153 IF(igap /= 1000 .AND. igap /= 1)igap = 1000 !unexpected value => default value
154 IF(igap == 1)inter18_is_variable_gap_defined = .true.
155 igap0=igap
156
157!===CHECK USER FLAG FOR STIFFNESS VALUE
158 IF(istiff==0)istiff=1 !default
159 IF(istiff <= -1 .OR. istiff >2)istiff = 1 !default
160 IF(istiff == 2) inter18_autoparam = 1
161
162!===check structure identifier :isu2=surf_id
163 IF(isu2 == 0) THEN
164 msgtitl='LAGRANGIAN SURFACE IS EMPTY (SURF_ID)'
165 CALL ancmsg(msgid=1115,msgtype=msgerror,anmode=aninfo, i1=noint,c1=titr,c2=msgtitl)
166 is2=0
167 ELSE
168 is2=1
169 ingr2usr => igrsurf(1:nsurf)%ID
170 isu2=ngr2usr(isu2,ingr2usr,nsurf)
171 msgtitl='SURFACE CANNOT BE FOUND (SURF_ID)'
172 IF(isu2 == 0)CALL ancmsg(msgid=1115, msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
173 ENDIF
174
175!===CHECK ALE GROUP IDENTIFIER:ISU1=GRNOD_ID (old format) otherwise use Group of solids (GRBRIC_ID,GRQUAD_ID,GRTRIA_ID
176 IF(isu1 /= 0 .AND. grbric_id /= 0)grbric_id=0 ! Possible Istf flag defined in input (was removed from manuabecause Istf is always 1)
177c IF(ISU1 /= 0 .AND. GRBRIC_ID /= 0)THEN
178c MSGTITL='YOU CANNOT DEFINE BOTH GRNOD_ID and GRBRIC_ID'
179c CALL ANCMSG(MSGID=1115,
180c . MSGTYPE=MSGERROR,
181c . ANMODE=ANINFO,
182c . I1=NOINT,
183c . C1=TITR,
184c . C2=MSGTITL)
185c ENDIF
186 IF(isu1 /= 0)THEN
187 ingr2usr => igrnod(1:ngrnod)%ID
188 isu1=ngr2usr(isu1,ingr2usr,ngrnod)
189 is1 =2
190 IF(isu1 == 0)THEN
191 msgtitl='GROUP OF NODES CANNOT BE FOUND (GRNOD_ID)'
192 CALL ancmsg(msgid=1115,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
193 ELSEIF(multi_fvm%IS_USED)THEN
194 msgtitl='GRBRIC_id (COLUMN 3) MUST BE PROVIDED INSTEAD OF GRNOD_id (COLUMN 1)'
195 CALL ancmsg(msgid=1115,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
196 ENDIF
197 ELSE
198 !GRBRIC_ID,GRQUAD_ID,GRTRIA_ID
199 IF(grbric_id /= 0)THEN
200 ingr2usr => igrbric(1:ngrbric)%ID
201 grbric_id = ngr2usr(grbric_id,ingr2usr,ngrbric)
202 is1 = 5
203 ENDIF
204 IF(grbric_id == 0) THEN
205 msgtitl='GROUP OF ALE CELLS IS EMPTY (GRBRIC_ID)'
206 CALL ancmsg(msgid=1115,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
207 ELSE
208 isu1=grbric_id !ISU1 outgoing argument used to get nodes in grbrick
209 ENDIF
210 ENDIF
211
212!===CHECK GRBRIC_ID IS PROVIDED TO CALL LATER LECINT > INGRBRIC_DX (automatic gap)
213
214 !Variable gap (Igap=1) requires a Group of Bricks
215 IF(igap == 1 .AND. grbric_id == 0)THEN
216 msgtitl='GRBRIC_ID MUST BE DEFINED TO ENABLE VARIABLE GAP'
217 CALL ancmsg(msgid=1115,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
218 ENDIF
219
220 !Constant gap with Gap=0.0 requires a Group of Bricks
221 IF(igap == 1000 .AND. grbric_id == 0 .AND. gap == zero)THEN
222 msgtitl='GRBRIC_ID MUST BE DEFINED TO ESTIMATE CONSTANT GAP VALUE'
223 CALL ancmsg(msgid=1115,msgtype=msgerror,anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
224 ENDIF
225
226!===CHECK STFAC VALUE
227 IF(stfac <= zero .AND. istiff==1)THEN
228 msgtitl='STIFFNESS VALUE MUST BE DEFINED (STFVAL)'
229 CALL ancmsg(msgid=1115,msgtype=msgerror, anmode=aninfo,i1=noint,c1=titr,c2=msgtitl)
230 ENDIF
231 scale = one
232 IF(istiff==2)THEN
233 IF(stfac == zero)stfac=one
234 scale = stfac
235 ENDIF
236
237 IF(istiff == 2 .AND. grbric_id == 0)THEN
238 msgtitl='GROUP OF ALE CELLS (GRBRIC_ID) MUST BE DEFINED WHEN ISTIFF=2'
239 CALL ancmsg(msgid=1115, msgtype=msgerror, anmode=aninfo, i1=noint, c1=titr, c2=msgtitl)
240 ENDIF
241
242!===DEFAULT
243 IF(idel7n <= -1 .OR. idel7n >= 3)idel7n=0
244 IF(stfac == zero)stfac=one
245 stfac=-stfac
246
247 !IF DEFINTER IS CALLED IN A FURTHER VERSION : remove this line
248 IF(igap==1000)igap=0
249
250 IF (stopt == zero) stopt = ep30
251 IF(bumult == zero) bumult = bmul0
252 IF(istiff==2)THEN
253 stfac=stfac*vref*vref ! will be updated in lecint.F
254 ENDIF
255
256!===BUFFER STORAGE
257 frigap(1)=fric
258 frigap(2)=gap
259 frigap(3)=startt
260 frigap(4)=bumult
261 frigap(10)=float(0) !FRIGAP(10) is initialized but used only in engine for storing number of couples candidates
262 frigap(11)=stopt
263 frigap(13)=one !GAPSCALE
264 frigap(14)=visc
265 frigap(15)=zero
266 frigap(16)=ep30 !GAPMAX
267 frigap(17)=zero !STMIN
268 frigap(18)=zero !STMAX
269
270 fric_p(1:6) = zero !C1..C6
271
272 ipari(7) = ntyp
273 ipari(12) = 0
274 ipari(13) = is1*10+is2
275 ipari(14) = 0 ! tag for collocated scheme
276 ipari(17) = idel7n
277 ipari(18) = inacti
278 ipari(20) = 0
279 ipari(21) = igap
280 ipari(22) = inacti
281 ipari(23) = 4 !MULTIMP
282 ipari(29) = istiff
283 ipari(30) = 0 !MFROT
284 ipari(31) = 0 !IFQ
285 ipari(32) = 0 !IBAG
286 ipari(34) = 0 !ILAGM
287 ipari(39) = 0 !ICURV
288 ipari(40) = 0 !NA1
289 ipari(41) = 0 !NA2
290 ipari(45) = isu1
291 ipari(46) = isu2
292 ipari(61) = 0 !IDELKEEP
293 ipari(65) = 0
294 ipari(83) = grbric_id
295
296C------------------------------------------------------------
297C PRINTOUT
298C------------------------------------------------------------
299 !==OUTPUTS USER IDS FOR MAIN/SECONDARY DEFINITION
300 WRITE(iout,3017)
301 IF(grbric_id > 0)THEN
302 WRITE(iout,6002)isu3_user !SECONDARY side from grbrick_id
303 ELSE
304 WRITE(iout,6001)isu1_user !SECONDARY side from grnod_id
305 ENDIF
306 WRITE(iout,6003) isu2_user !MAIN side from surf_id
307
308 WRITE(iout,3018)igap0,istiff
309
310 !stiffness output
311 ! USER INTERNAL
312 ! ISTIFF=0,1 -> 1 (constant)
313 ! ISTIFF=2 -> 2 (calculated from Vref & scale factor)
314 WRITE(iout,3015)
315 IF(istiff==1)THEN
316 !constant user value
317 WRITE(iout,3024)-stfac
318 ELSE
319 !automatic constat value (needs VREF to be calculated)
320 WRITE(iout,3025)
321 WRITE(iout,3020)scale !scale factor
322 WRITE(iout,3021)vref
323 ENDIF
324
325 !gap output
326 WRITE(iout,3014)
327 ! USER INTERNAL
328 ! IGAP=0,1000 -> 0 (constant gap : defaut = auto)
329 ! IGAP=1 -> 1 (variable gap)
330 IF(igap == 0)THEN
331 !CONSTANT GAP
332 IF(gap > zero)THEN
333 !user value
334 WRITE(iout,3024)gap
335 ELSE
336 !computed value
337 WRITE(iout,3025)
338 ENDIF
339 ELSE
340 !VARIABLE GAP
341 WRITE(iout,3026)
342 ENDIF
343
344 IF(is_available_visc .OR. is_available_bumult)THEN
345 !VISC & BUMULT may be available with old input version
346 WRITE(iout,3028)startt,stopt,visc,bumult
347 ELSE
348 WRITE(iout,3029)startt,stopt
349 ENDIF
350
351 IF(idel7n /= 0) THEN
352 WRITE(iout,'(A,A,I5/)')' DELETION FLAG ON FAILURE OF MAIN ELEMENT',' (1:YES-ALL/2:YES-ANY) : ',idel7n
353 IF(idelkeep == 1)THEN
354 WRITE(iout,'(A)') ' IDEL: DO NOT REMOVE NON-CONNECTED NODES FROM SECONDARY SURFACE'
355 ENDIF
356 ENDIF
357
358C--------------------------------------------------------------
359C 1000 FORMAT(/1X,' INTERFACE NUMBER :',I10,1X,A)
360C------------
361 RETURN
362
363
364 3014 FORMAT(' --- GAP ---' )
365 3015 FORMAT(' --- STIFFNESS ---' )
366
367 3017 FORMAT(' TYPE == 18 ALE-LAGRANGE COUPLING' /)
368 3018 FORMAT(
369 . ' IGAP FLAG FORMULATION . . . . . . . . . . . ',i10/,
370 . ' ISTF FLAG FORMULATION . . . . . . . . . . . ',i10/)
371
372 3020 FORMAT(
373 . ' SCALE FACTOR. . . . . . . . . . . . . . . . ',1pg20.13)
374 3021 FORMAT(
375 . ' REFERENCE VELOCITY. . . . . . . . . . . . . ',1pg20.13)
376 3024 FORMAT(
377 . ' CONSTANT USER VALUE . . . . . . . . . . . . ',1pg20.13)
378 3025 FORMAT(
379 . ' AUTOMATIC CONSTANT VALUE')
380 3026 FORMAT(
381 . ' AUTOMATIC VARIABLE VALUE')
382 3028 FORMAT(
383 . /' START TIME. . . . . . . . . . . . . . . . . ',1pg20.13/,
384 . ' STOP TIME . . . . . . . . . . . . . . . . . ',1pg20.13/,
385 . ' CRITICAL DAMPING FACTOR . . . . . . . . . . ',1pg20.13/,
386 . ' SORTING FACTOR. . . . . . . . . . . . . . . ',1pg20.13)
387 3029 FORMAT(
388 . /' START TIME. . . . . . . . . . . . . . . . . ',1pg20.13/,
389 . ' STOP TIME . . . . . . . . . . . . . . . . . ',1pg20.13)
390
391 6001 FORMAT(
392 . ' NODE GROUP IDENTIFIER. . . . . . . . . ',i10)
393 6002 FORMAT(
394 . ' BRICK GROUP IDENTIFIER . . . . . . . . ',i10)
395 6003 FORMAT(
396 . ' SURFACE GROUP IDENTIFIER. . . . . . . . ',i10/)
397
398 END
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_read_inter_type18
subroutine hm_read_inter_type18(ipari, stfac, frigap, noint, igrnod, igrsurf, igrbric, xfiltr, fric_p, titr, unitab, lsubmodel, multi_fvm, npari, nparir)
Definition hm_read_inter_type18.F:41
groupdef_mod
Definition groupdef_mod.F:662
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
groupdef_mod::group_
Definition groupdef_mod.F:700
groupdef_mod::surf_
Definition groupdef_mod.F:745
unitab_mod::unit_type_
Definition unitab_mod.F:520