OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_friction_orientations.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_friction_orientations ../starter/source/interfaces/friction/reader/hm_read_friction_orientations.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| friction_parts_search ../starter/source/interfaces/inter3d1/i7sti3.F
30!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.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_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| subrotvect ../starter/source/model/submodel/subrot.F
36!||--- uses -----------------------------------------------------
37!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!|| r2r_mod ../starter/share/modules1/r2r_mod.F
40!|| submodel_mod ../starter/share/modules1/submodel_mod.F
41!||====================================================================
42 SUBROUTINE hm_read_friction_orientations (
43 1 INTBUF_FRIC_TAB,NPFRICORTH,IGRPART ,IPART ,PFRICORTH ,
44 2 IREPFORTH ,ISKN ,PHIFORTH ,VFORTH ,SKEW ,
45 3 IFLAG ,TAGPRT_FRIC ,RTRANS ,LSUBMODEL ,UNITAB )
46
47C============================================================================
48C M o d u l e s
49C-----------------------------------------------
50 USE r2r_mod
51 USE message_mod
52 USE intbuf_fric_mod
53 USE groupdef_mod
54 USE submodel_mod
55 USE unitab_mod
56 USE hm_option_read_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 "com04_c.inc"
66#include "units_c.inc"
67#include "param_c.inc"
68#include "scr17_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
73 INTEGER IFLAG ,NPFRICORTH
74 INTEGER IPART(LIPART1,*) ,PFRICORTH(*),IREPFORTH(*),TAGPRT_FRIC(*),
75 . iskn(liskn,*) !,IDFRICORIENT(*)
76
77 my_real
78 . phiforth(*) ,vforth(3,*) ,skew(lskew,*) ,rtrans(ntransf,*)
79
80c CHARACTER*ncharline , TITFRICORIENT(*)
81 TYPE(intbuf_fric_struct_) INTBUF_FRIC_TAB(*)
82C-----------------------------------------------
83 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
84 TYPE(submodel_data) LSUBMODEL(*)
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER NIF ,NIN ,ISK ,IERRR ,IREP ,NOINTFORTH ,IDSK ,
89 . FLAGP ,FLAGGRP ,GRPART ,IDPART ,N ,KK ,IDTGRS ,IPL ,J ,IP ,
90 . IPG ,SUB_ID ,NINPUT ,NL
91 my_real an ,vx ,vy ,vz ,phi
92 CHARACTER(LEN=NCHARTITLE) :: TITR
93 LOGICAL IS_AVAILABLE
94C
95C=======================================================================
96C READING /FRIC_ORIENT
97C=======================================================================
98 is_available = .false.
99C
100C--------------------------------------------------
101C WRITE TITLE IN OUT FILE
102C--------------------------------------------------
103
104 IF(iflag==1) WRITE(iout,1000)
105
106 npfricorth = 0
107
108C--------------------------------------------------
109C START BROWSING FRICTION ORIENTATIONS
110C--------------------------------------------------
111 CALL hm_option_start('/FRIC_ORIENT')
112C--------------------------------------------------
113C BROWSING FRICTION ORIENTATIONS MODELS 1->NFRIC_ORIENT
114C--------------------------------------------------
115 DO nin=1,nfric_orient
116c
117C--------------------------------------------------
118C EXTRACT DATAS OF /FRIC_ORIENT
119C--------------------------------------------------
120 CALL hm_option_read_key(lsubmodel,
121 . option_id = nointforth,
122 . submodel_id = sub_id,
123 . option_titr = titr)
124
125c KFRICORIENT = KFRICORIENT + 1
126
127C--Output ---
128
129 IF(iflag==1) THEN
130 WRITE(iout,1500) nointforth, trim(titr)
131 ENDIF
132
133
134C EXTRACT DATAS (INTEGER VALUES) : Number of connected parts as defined by user
135 CALL hm_get_intv('n_orient',ninput,is_available,lsubmodel)
136
137 DO nl=1,ninput
138
139C EXTRACT DATAS (INTEGER VALUES) :
140
141 CALL hm_get_int_array_index('grpart_ID1',grpart,nl,is_available,lsubmodel)
142 CALL hm_get_int_array_index('part_ID1',idpart,nl,is_available,lsubmodel)
143 CALL hm_get_int_array_index('skew_id',IDSK,NL,IS_AVAILABLE,LSUBMODEL)
144 CALL HM_GET_INT_ARRAY_INDEX('iorth',IREP,NL,IS_AVAILABLE,LSUBMODEL)
145
146C EXTRACT DATAS (REAL VALUES) :
147
148 CALL HM_GET_FLOAT_ARRAY_INDEX('vx',VX,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
149 CALL HM_GET_FLOAT_ARRAY_INDEX('vy',VY,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
150 CALL HM_GET_FLOAT_ARRAY_INDEX('vz',VZ,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
151 CALL HM_GET_FLOAT_ARRAY_INDEX('phi',PHI,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
152C--------------------
153 IF (SUB_ID /= 0)
154 . CALL SUBROTVECT(VX,VY,VZ,RTRANS,SUB_ID,LSUBMODEL)
155
156C
157C----CHECK PARTS
158C
159 FLAGP = 0
160 FLAGGRP = 0
161 IF(IDPART/=0)THEN
162 DO N=1,NPART
163 IF(IDPART == IPART(4,N))THEN
164 FLAGP = 1
165 IP = N
166 EXIT
167 ENDIF
168 ENDDO
169
170 IF(FLAGP == 0)THEN
171 CALL ANCMSG(MSGID=1642,
172 . MSGTYPE=MSGERROR,
173 . ANMODE=ANINFO_BLIND_1,
174 . I1=NOINTFORTH,
175 . C1=TITR,
176 . I2=IDPART)
177
178 ENDIF
179 ENDIF
180C
181C----CHECK PARTS group
182C
183 IF(GRPART/=0)THEN
184 FLAGGRP = 0
185 KK=NGRNOD+
186 + NGRBRIC+NGRQUAD+NGRSHEL+NGRSH3N+NGRTRUS+NGRBEAM+NGRSPRI
187 DO N=1,NGRPART
188 IF (IGRPART(N)%ID == GRPART) THEN
189 IDTGRS=N
190 FLAGGRP = 1
191 EXIT
192 END IF
193 END DO
194 IF(FLAGGRP == 0) THEN
195 CALL ANCMSG(MSGID=1642,
196 . MSGTYPE=MSGERROR,
197 . ANMODE=ANINFO_BLIND_1,
198 . I1=NOINTFORTH,
199 . C1=TITR,
200 . I2=GRPART)
201 ENDIF
202 ENDIF
203C
204C----CHECK Values
205C
206
207C Vect orhotrope
208
209 AN=SQRT(VX*VX+VY*VY+VZ*VZ)
210 IF(AN < EM10)THEN
211 VX=ONE
212 VY=ZERO
213 VZ=ZERO
214 ELSE
215 VX=VX/AN
216 VY=VY/AN
217 VZ=VZ/AN
218 ENDIF
219
220 ISK = 0
221 IF (IDSK/=0) THEN
222 IERRR = 0
223 DO J=0,NUMSKW+NSUBMOD
224 IF(IDSK == ISKN(4,J+1)) THEN
225 ISK=J+1
226 IERRR = 1
227 EXIT
228 ENDIF
229 END DO
230 IF(IERRR == 0 ) THEN
231 CALL ANCMSG(MSGID=184,
232 . MSGTYPE=MSGERROR,
233 . ANMODE=ANINFO,
234 . C1='friction orientation part',
235 . I1=NOINTFORTH,
236 . C2='friction orientation part',
237 . C3=TITR,
238 . I2=IDSK)
239 ENDIF
240 ENDIF
241
242C
243C COUNTING AND STORAGE IN TEMPORARY TABLES
244C
245
246 IF(FLAGP > 0) THEN
247 IPG = TAGPRT_FRIC(IP)
248 IF(IPG > 0) THEN
249 DO NIF =1,NINTERFRIC
250 CALL FRICTION_PARTS_SEARCH (
251 . IPG,INTBUF_FRIC_TAB(NIF)%S_TABPARTS_FRIC,
252 . INTBUF_FRIC_TAB(NIF)%TABPARTS_FRIC,IPL )
253 IF(IPL >0) THEN
254 NPFRICORTH = NPFRICORTH + 1
255 IF(IFLAG ==1 ) THEN
256 PFRICORTH(IP) = NPFRICORTH
257 PHIFORTH(NPFRICORTH) = PHI
258 IREPFORTH(NPFRICORTH) = IREP
259 IF(ISK == 0) THEN
260 VFORTH(1,NPFRICORTH) = VX
261 VFORTH(2,NPFRICORTH) = VY
262 VFORTH(3,NPFRICORTH) = VZ
263 ELSE
264 VFORTH(1,NPFRICORTH) = SKEW(1,ISK)
265 VFORTH(2,NPFRICORTH) = SKEW(2,ISK)
266 VFORTH(3,NPFRICORTH) = SKEW(3,ISK)
267 ENDIF
268 ENDIF
269 ENDIF
270 ENDDO
271 ENDIF
272
273 IF(IFLAG==1) THEN
274 WRITE(IOUT,1501) IDPART
275 IF(ISK==0) THEN
276 WRITE(IOUT,1503) IREP,VX,VY,VZ
277 ELSE
278 WRITE(IOUT,1504) IREP,IDSK
279 ENDIF
280 ENDIF
281 ENDIF
282
283 IF(FLAGGRP > 0) THEN
284 DO J=1,IGRPART(IDTGRS)%NENTITY
285 IP=IGRPART(IDTGRS)%ENTITY(J)
286 IPG = TAGPRT_FRIC(IP)
287 IF(IPG > 0) THEN
288 DO NIF =1,NINTERFRIC
289 CALL FRICTION_PARTS_SEARCH (
290 . IPG,INTBUF_FRIC_TAB(NIF)%S_TABPARTS_FRIC,
291 . INTBUF_FRIC_TAB(NIF)%TABPARTS_FRIC,IPL )
292 IF(IPL > 0) THEN
293 NPFRICORTH = NPFRICORTH + 1
294 IF(IFLAG ==1 ) THEN
295 PFRICORTH(IP) = NPFRICORTH
296 PHIFORTH(NPFRICORTH) = PHI
297 IREPFORTH(NPFRICORTH) = IREP
298 IF(ISK == 0) THEN
299 VFORTH(1,NPFRICORTH) = VX
300 VFORTH(2,NPFRICORTH) = VY
301 VFORTH(3,NPFRICORTH) = VZ
302 ELSE
303 VFORTH(1,NPFRICORTH) = SKEW(1,ISK)
304 VFORTH(2,NPFRICORTH) = SKEW(2,ISK)
305 VFORTH(3,NPFRICORTH) = SKEW(3,ISK)
306 ENDIF
307 ENDIF
308 ENDIF
309 ENDDO
310 ENDIF
311 ENDDO
312 IF(IFLAG==1) THEN
313 WRITE(IOUT,1502) GRPART
314 IF(ISK==0) THEN
315 WRITE(IOUT,1503) IREP,VX,VY,VZ
316 ELSE
317 WRITE(IOUT,1504) IREP,IDSK
318 ENDIF
319 ENDIF
320 ENDIF
321C
322
323 ENDDO ! N=1,NLINE
324 ENDDO !NIN=1,NFRIC_ORIENT
325C
326C=======================================================================
327 RETURN
328C-----
329 1000 FORMAT( /1X,' friction orientations ' /
330 . 1X,' -------------- '// )
331
332 1500 FORMAT(/1X,' friction orientations card number :',I10,1X,A/
333 . 1X,' ------------------------------- '/)
334 1501 FORMAT(/
335 . ' part . . . . . . . . . . . . . . . . . . ',I10)
336 1502 FORMAT(/
337 . ' gr_part . . . . . . . . . . . . . . . . .',I10)
338 1503 FORMAT(
339 . ' local ortothropy system flag. . . . . . =',I10/,
340 . ' x component of dir 1 of orthotropy. . . =',1PG20.13/,
341 . ' y component of dir 1 of orthotropy. . . =',1PG20.13/,
342 . ' z component of dir 1 of orthotropy. . . =',1PG20.13/)
343 1504 FORMAT(
344 . ' local ortothropy system flag. . . . . . =',I10/,
345 . ' skew of the first orthotropy direction. =',I10/)
346
347 END SUBROUTINE HM_READ_FRICTION_ORIENTATIONS
my_real
#define my_real
Definition cppsort.cpp:32
the
end diagonal values have been computed in the(sparse) matrix id.SOL
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
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:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_friction_orientations
subroutine hm_read_friction_orientations(intbuf_fric_tab, npfricorth, igrpart, ipart, pfricorth, irepforth, iskn, phiforth, vforth, skew, iflag, tagprt_fric, rtrans, lsubmodel, unitab)
Definition hm_read_friction_orientations.F:46
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
r2r_mod
Definition r2r_mod.F:125
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723