OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_friction.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 ../starter/source/interfaces/friction/reader/hm_read_friction.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_friction_models ../starter/source/interfaces/friction/reader/hm_read_friction_models.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.F
31!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
32!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
34!||--- uses -----------------------------------------------------
35!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.f
36!|| message_mod ../starter/share/message_module/message_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE hm_read_friction(
40 1 NIF ,NOM_OPT ,TITR ,UNITAB ,IGRPART ,
41 2 IPART ,NSET ,TAGPRT_FRIC,TABCOUPLEPARTS_FRIC_TMP ,
42 . TABCOEF_FRIC_TMP ,
43 3 MFROT ,IFQ ,XFILTR ,FRICFORM ,
44 4 IFLAG ,ORTHFRIC ,IFRICORTH_TMP,NGRPF ,
45 4 LENGRPF ,LENG ,NOINTF ,LSUBMODEL )
46
47C============================================================================
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE unitab_mod
52 USE message_mod
53 USE groupdef_mod
54 USE submodel_mod
55 USE hm_option_read_mod
56 USE names_and_titles_mod , ONLY : nchartitle
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "scr17_c.inc"
65C-----------------------------------------------
66C D u m m y A r g u m e n t s
67C-----------------------------------------------
68 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
69 INTEGER NOM_OPT(LNOPT1,*)
70 INTEGER NIF ,IFLAG ,MFROT ,IFQ ,FRICFORM ,NSET ,ORTHFRIC , NGRPF,LENG,NOINTF
71 INTEGER IPART(LIPART1,*) ,TAGPRT_FRIC(*),
72 . TABCOUPLEPARTS_FRIC_TMP(NINTERFRIC,*),IFRICORTH_TMP(NINTERFRIC,*),
73 . LENGRPF(*)
74 my_real xfiltr
75 my_real tabcoef_fric_tmp(ninterfric,*)
76 CHARACTER(LEN=NCHARTITLE)::TITR
77C-----------------------------------------------
78 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
79 TYPE (SUBMODEL_DATA), DIMENSION(*),INTENT(IN) :: LSUBMODEL
80C-----------------------------------------------
81C C o m m o n B l o c k s
82C-----------------------------------------------
83#include "com04_c.inc"
84#include "units_c.inc"
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I ,J ,L ,IP ,IP1 ,IP2 ,N ,N1 ,N2 ,KK ,NL ,
89 . GRPART1 ,GRPART2 ,IPART1 ,IPART2 ,FLAGP1 ,FLAGP2,FLAGGRP1,
90 . FLAGGRP2 ,IDTGRS1 ,IGRPART1 ,IDTGRS2 ,IGRPART2 ,NCOUPLE ,
91 . IPP ,IPP1 ,IPP2 ,IDIR ,NTAB ,LENF ,GRPN ,GRPN1 ,GRPN2 ,
92 . NP0 ,NGR0 ,K ,NGR ,J1 ,J2 ,STAT ,WORK(70000),NINPUT
93 INTEGER, DIMENSION(:), ALLOCATABLE ::
94 . trigrpt ,index ,newgrp ,tagg1 ,tagg2
95 my_real
96 . c1 ,c2 ,c3 ,c4 ,c5 ,c6 ,alpha ,c11 ,c22 ,c33 ,c44 ,c55 ,c66 ,
97 . fric ,viscf ,fric2 ,viscf2
98 LOGICAL IS_AVAILABLE
99
100C=======================================================================
101C READING FRICTION Model /FRICTION
102C=======================================================================
103 ip = -huge(ip)
104 idtgrs1 = -huge(idtgrs1)
105 idtgrs2 = -huge(idtgrs2)
106
107 is_available = .false.
108
109 ALLOCATE (trigrpt(leng),stat=stat)
110 ALLOCATE (index(2*leng),stat=stat)
111 ALLOCATE (newgrp(leng+1),stat=stat)
112 ALLOCATE (tagg1(leng),stat=stat)
113 ALLOCATE (tagg2(leng),stat=stat)
114
115 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,nif),ltitr)
116C
117 nom_opt(1,nif)=nointf
118C
119 nset = 0
120 ncouple = 0
121C
122 lenf = 0
123 IF(iflag==0 ) THEN
124 orthfric = 0
125 ELSE
126 IF(orthfric ==0) THEN
127 lenf= 1
128 ELSE
129 lenf = 2
130 ENDIF
131 ENDIF
132
133C--------------------------------------------------
134C DEFAULT VALUES
135C--------------------------------------------------
136
137C EXTRACT DATAS (INTEGER VALUES)
138 CALL hm_get_intv('ifric',mfrot,is_available,lsubmodel)
139 CALL hm_get_intv('ifiltr',ifq,is_available,lsubmodel)
140 CALL hm_get_intv('iform',fricform,is_available,lsubmodel)
141C
142C EXTRACT DATAS (REAL VALUES)
143 CALL hm_get_floatv('xfreq',alpha,is_available,lsubmodel,unitab)
144 CALL hm_get_floatv('c1',c1,is_available,lsubmodel,unitab)
145 CALL hm_get_floatv('c2',c2,is_available,lsubmodel,unitab)
146 CALL hm_get_floatv('c3',c3,is_available,lsubmodel,unitab)
147 CALL hm_get_floatv('c4',c4,is_available,lsubmodel,unitab)
148
149 CALL hm_get_floatv('c5',c5,is_available,lsubmodel,unitab)
150 CALL hm_get_floatv('c6',C6,IS_AVAILABLE,LSUBMODEL,UNITAB)
151 CALL HM_GET_FLOATV('fric',FRIC,IS_AVAILABLE,LSUBMODEL,UNITAB)
152 CALL HM_GET_FLOATV('vis_f',VISCF,IS_AVAILABLE,LSUBMODEL,UNITAB)
153C
154C CHECKS
155C
156 IF (ALPHA==0.) IFQ = 0
157 ALPHA = ALPHA
158
159 IF (FRICFORM==0) FRICFORM = 1
160.AND. IF (FRICFORM==2IFQ<10) IFQ = IFQ + 10
161C
162 IF (IFQ>0) THEN
163 IF (IFQ==10) XFILTR = ONE
164 IF (MOD(IFQ,10)==1) XFILTR = ALPHA
165 IF (MOD(IFQ,10)==2) XFILTR=FOUR*ATAN2(ONE,ZERO) / ALPHA
166 IF (MOD(IFQ,10)==3) XFILTR=FOUR*ATAN2(ONE,ZERO) * ALPHA
167 IF (XFILTR<ZERO) THEN
168 CALL ANCMSG(MSGID=1591, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND_1, I1=NOINTF, C1=TITR, R1=ALPHA)
169.AND. ELSEIF (XFILTR>1MOD(IFQ,10)<=2) THEN
170 CALL ANCMSG(MSGID=1591, MSGTYPE=MSGERROR, ANMODE=ANINFO_BLIND_1, I1=NOINTF, C1=TITR, R1=ALPHA)
171 ENDIF
172 ELSE
173 XFILTR = ZERO
174 ENDIF
175
176C
177C STORAGE IN TEMPORARY INTBUF_FRIC_TAB
178C
179 IF(IFLAG == 1 ) THEN
180
181.OR..AND. IF((FRIC/=ZEROMFROT/=0)VISCF==ZERO)VISCF=ONE
182
183 IF (FRICFORM==2)VISCF=ZERO
184
185 TABCOEF_FRIC_TMP(NIF,1) = FRIC
186 TABCOEF_FRIC_TMP(NIF,2) = VISCF
187 IF( MFROT > 0) THEN
188 TABCOEF_FRIC_TMP(NIF,3) = C1
189 TABCOEF_FRIC_TMP(NIF,4) = C2
190 TABCOEF_FRIC_TMP(NIF,5) = C3
191 TABCOEF_FRIC_TMP(NIF,6) = C4
192 TABCOEF_FRIC_TMP(NIF,7) = C5
193 TABCOEF_FRIC_TMP(NIF,8) = C6
194 ENDIF
195 ENDIF
196C
197C- OUTPUT DESCRIPTION OF THE MODEL
198C 1st defaults
199
200 IF(IFLAG==1) THEN
201 WRITE(IOUT,1500) NOINTF, TRIM(TITR)
202 IF(FRICFORM ==2) THEN
203 WRITE(IOUT,1508)
204 ELSE
205 WRITE(IOUT,1509)
206 ENDIF
207 IF(MFROT==0)THEN
208 WRITE(IOUT,1503)
209 ELSEIF(MFROT==1)THEN
210 WRITE(IOUT,3505)
211 ELSEIF(MFROT==2)THEN
212 WRITE(IOUT,3506)
213 ELSEIF(MFROT==3)THEN
214 WRITE(IOUT,3507)
215 ELSEIF(MFROT==4)THEN
216 WRITE(IOUT,3508)
217 ENDIF
218 WRITE(IOUT,1502)MOD(IFQ,10), XFILTR
219 WRITE(IOUT,1501)
220
221 IF(MFROT==0)THEN
222 WRITE(IOUT,3503) FRIC
223 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
224 ELSEIF(MFROT==1)THEN
225 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
226 ELSEIF(MFROT==2)THEN
227 WRITE(IOUT,1505) FRIC,C1,C2,C3,C4,C5,C6
228 ELSEIF(MFROT==3)THEN
229 WRITE(IOUT,1506) C1,C2,C3,C4,C5,C6
230 ELSEIF(MFROT==4)THEN
231 WRITE(IOUT,1514) FRIC,C1,C2
232 ENDIF
233 ENDIF
234C
235
236C--------------------------------------------------
237C FRICION COEFFICIENTS TABLE FOR CONNECTED PARTS
238C--------------------------------------------------
239
240
241C- OUTPUT DESCRIPTION OF THE MODEL
242C Coefficients table
243
244 IF(IFLAG==1) WRITE(IOUT,1507)
245
246C EXTRACT DATAS (INTEGER VALUES) : Number of connected parts as defined by user
247 CALL HM_GET_INTV('n',NINPUT,IS_AVAILABLE,LSUBMODEL)
248
249 DO NL=1,NINPUT
250
251C EXTRACT DATAS (INTEGER VALUES)
252
253 CALL HM_GET_INT_ARRAY_INDEX('grpart_id1',GRPART1,NL,IS_AVAILABLE,LSUBMODEL)
254 CALL HM_GET_INT_ARRAY_INDEX('grpart_id2',GRPART2,NL,IS_AVAILABLE,LSUBMODEL)
255 CALL HM_GET_INT_ARRAY_INDEX('part_id1',IPART1,NL,IS_AVAILABLE,LSUBMODEL)
256 CALL HM_GET_INT_ARRAY_INDEX('part_id2',IPART2,NL,IS_AVAILABLE,LSUBMODEL)
257 CALL HM_GET_INT_ARRAY_INDEX('idir',IDIR,NL,IS_AVAILABLE,LSUBMODEL)
258
259C EXTRACT DATAS (REAL VALUES)
260
261 CALL HM_GET_FLOAT_ARRAY_INDEX('c1_part',C1,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
262 CALL HM_GET_FLOAT_ARRAY_INDEX('c2_part',C2,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
263 CALL HM_GET_FLOAT_ARRAY_INDEX('c3_part',C3,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
264 CALL HM_GET_FLOAT_ARRAY_INDEX('c4_part',C4,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
265 CALL HM_GET_FLOAT_ARRAY_INDEX('c5_part',C5,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
266 CALL HM_GET_FLOAT_ARRAY_INDEX('c6_part',C6,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
267 CALL HM_GET_FLOAT_ARRAY_INDEX('fric_part',FRIC,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
268 CALL HM_GET_FLOAT_ARRAY_INDEX('vis_f_part',VISCF,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
269
270 IF(IDIR ==1) THEN
271 ORTHFRIC =1
272 CALL HM_GET_FLOAT_ARRAY_INDEX('c1_2',C11,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
273 CALL HM_GET_FLOAT_ARRAY_INDEX('c2_2',C22,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
274 CALL HM_GET_FLOAT_ARRAY_INDEX('c3_2',C33,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
275 CALL HM_GET_FLOAT_ARRAY_INDEX('c4_2',C44,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
276 CALL HM_GET_FLOAT_ARRAY_INDEX('c5_2',C55,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
277 CALL HM_GET_FLOAT_ARRAY_INDEX('c6_2',C66,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
278 CALL HM_GET_FLOAT_ARRAY_INDEX('fric_2',FRIC2,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
279 CALL HM_GET_FLOAT_ARRAY_INDEX('vis_f_2',VISCF2,NL,IS_AVAILABLE,LSUBMODEL,UNITAB)
280
281 ENDIF
282
283C
284C----CHECKS PARTS
285C
286 FLAGP1 = 0
287 FLAGP2 = 0
288 FLAGGRP1 = 0
289 FLAGGRP2 = 0
290 N1 = -HUGE(N1)
291 IF(IPART1/=0)THEN
292 DO N=1,NPART
293 IF(IPART1 == IPART(4,N))THEN
294 FLAGP1 = 1
295 N1 = N
296 EXIT
297 ENDIF
298 ENDDO
299
300 IF(FLAGP1 == 0)THEN
301 CALL ANCMSG(MSGID=1590,
302 . MSGTYPE=MSGERROR,
303 . ANMODE=ANINFO_BLIND_1,
304 . I1=NOINTF,
305 . C1=TITR,
306 . I2=IPART1)
307 ENDIF
308 ENDIF
309C
310 N2 = -HUGE(N2)
311 IF(IPART2/=0)THEN
312 DO N=1,NPART
313 IF(IPART2 == IPART(4,N))THEN
314 FLAGP2 = 1
315 N2 = N
316 EXIT
317 ENDIF
318 ENDDO
319
320 IF(FLAGP2 == 0)THEN
321 CALL ANCMSG(MSGID=1590,
322 . MSGTYPE=MSGERROR,
323 . ANMODE=ANINFO_BLIND_1,
324 . I1=NOINTF,
325 . C1=TITR,
326 . I2=IPART2)
327 ENDIF
328 ENDIF
329C
330C----CHECK PARTS group
331C
332 IF(GRPART1/=0)THEN
333 FLAGGRP1 = 0
334 KK=NGRNOD+
335 + NGRBRIC+NGRQUAD+NGRSHEL+NGRSH3N+NGRTRUS+NGRBEAM+NGRSPRI
336 DO N=1,NGRPART
337 IF (IGRPART(N)%ID == GRPART1) THEN
338 IDTGRS1=N
339 FLAGGRP1 = 1
340 EXIT
341 END IF
342 END DO
343 IF(FLAGGRP1 == 0) THEN
344 CALL ANCMSG(MSGID=1590,
345 . MSGTYPE=MSGERROR,
346 . ANMODE=ANINFO_BLIND_1,
347 . I1=NOINTF,
348 . C1=TITR,
349 . I2=GRPART1)
350 ENDIF
351 ENDIF
352C
353 IF(GRPART2/=0)THEN
354 FLAGGRP2 = 0
355 KK=NGRNOD+
356 + NGRBRIC+NGRQUAD+NGRSHEL+NGRSH3N+NGRTRUS+NGRBEAM+NGRSPRI
357 DO N=1,NGRPART
358 IF (IGRPART(N)%ID == GRPART2) THEN
359 IDTGRS2=N
360 FLAGGRP2 = 1
361 EXIT
362 END IF
363 END DO
364 IF(FLAGGRP2 == 0) THEN
365 CALL ANCMSG(MSGID=1590,
366 . MSGTYPE=MSGERROR,
367 . ANMODE=ANINFO_BLIND_1,
368 . I1=NOINTF,
369 . C1=TITR,
370 . I2=GRPART2)
371 ENDIF
372 ENDIF
373
374C
375C----CHECK coefficient values
376C
377 IF(IFLAG == 1 ) THEN
378.OR..AND. IF((FRIC/=ZEROMFROT/=0)VISCF==ZERO)VISCF=ONE
379
380 IF (FRICFORM==2)VISCF=ZERO
381
382 IF(IDIR > 0) THEN
383
384.OR..AND. IF((FRIC2/=ZEROMFROT/=0)VISCF2==ZERO)VISCF2=ONE
385
386 IF (FRICFORM==2)VISCF2=ZERO
387
388.OR..AND. IF((FRIC2/=ZEROMFROT/=0)VISCF2==ZERO)VISCF2=ONE
389
390 IF (FRICFORM==2)VISCF2=ZERO
391
392 ENDIF
393 ENDIF
394
395C
396C COUNTING AND STORAGE IN TEMPORARY INTBUF_FRIC_TAB
397C
398.AND. IF(FLAGP1 /= 0FLAGP2 /= 0)THEN
399C
400 IF(IFLAG ==0 ) THEN
401 IF(TAGPRT_FRIC(N1) ==0 ) THEN
402 NGRPF = NGRPF + 1
403 TAGPRT_FRIC(N1)=NGRPF ! tag parts
404 LENGRPF(NGRPF) = 1
405 ELSE
406! If part is already read : look to group of parts belonging and it and split it to ensure group of parts are not lapped
407 GRPN = TAGPRT_FRIC(N1)
408 IF(LENGRPF(GRPN)/=1) THEN
409 NGRPF = NGRPF + 1
410 TAGPRT_FRIC(N1)=NGRPF ! tag parts
411 LENGRPF(NGRPF) = 1
412 LENGRPF(GRPN) =LENGRPF(GRPN) - 1
413 ENDIF
414 ENDIF
415 IF(TAGPRT_FRIC(N2) ==0 ) THEN
416 NGRPF = NGRPF + 1
417 TAGPRT_FRIC(N2)=NGRPF ! tag parts
418 LENGRPF(NGRPF) = 1
419 ELSE
420! If part is already read : look to group of parts belonging and it and split it to ensure group of parts are not lapped
421 GRPN = TAGPRT_FRIC(N2)
422 IF(LENGRPF(GRPN)/=1) THEN
423 NGRPF = NGRPF + 1
424 TAGPRT_FRIC(N2)=NGRPF ! tag parts
425 LENGRPF(NGRPF) = 1
426 LENGRPF(GRPN) =LENGRPF(GRPN) - 1
427 ENDIF
428 ENDIF
429 ENDIF
430C
431 IF(IFLAG == 1 ) THEN
432C
433 GRPN1 = TAGPRT_FRIC(N1)
434 GRPN2 = TAGPRT_FRIC(N2)
435
436 IF(GRPN1 > GRPN2 ) THEN
437 N = GRPN1
438 GRPN1 = GRPN2
439 GRPN2 = N
440 ENDIF
441 NSET = NSET + 1
442 NCOUPLE = NCOUPLE + 1
443 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = GRPN1
444 NCOUPLE = NCOUPLE + 1
445 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = GRPN2
446
447 NTAB = LENF*8*(NSET-1)+8
448 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC
449 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF
450 IF(MFROT > 0) THEN
451 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C1
452 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C2
453 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C3
454 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C4
455 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C5
456 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C6
457 ENDIF
458 IFRICORTH_TMP(NIF,NSET) = IDIR
459 IF(IDIR > 0) THEN
460 NTAB = 16*NSET
461 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC2
462 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF2
463 IF(MFROT > 0) THEN
464 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C11
465 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C22
466 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C33
467 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C44
468 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C55
469 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C66
470 ENDIF
471 ENDIF
472
473C--Output--
474C
475 WRITE (IOUT,2001) IPART(4,N1),IPART(4,N2)
476 IF(IDIR==0) THEN
477 WRITE(IOUT,1510)
478 IF(MFROT==0)THEN
479 WRITE(IOUT,3503) FRIC
480 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
481 ELSEIF(MFROT==1)THEN
482 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
483 ELSEIF(MFROT==2)THEN
484 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
485 ELSEIF(MFROT==3)THEN
486 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
487 ELSEIF(MFROT==4)THEN
488 WRITE(IOUT,1514) FRIC,C1,C2
489 ENDIF
490 ELSE
491 WRITE(IOUT,1511)
492 WRITE(IOUT,1512)
493 IF(MFROT==0)THEN
494 WRITE(IOUT,3503) FRIC
495 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
496 ELSEIF(MFROT==1)THEN
497 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
498 ELSEIF(MFROT==2)THEN
499 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
500 ELSEIF(MFROT==3)THEN
501 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
502 ELSEIF(MFROT==4)THEN
503 WRITE(IOUT,1514) FRIC,C1,C2
504 ENDIF
505 WRITE(IOUT,1513)
506 IF(MFROT==0)THEN
507 WRITE(IOUT,3503) FRIC2
508 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF2
509 ELSEIF(MFROT==1)THEN
510 WRITE(IOUT,1504) FRIC2,C11,C22,C33,C44,C55,C66
511 ELSEIF(MFROT==2)THEN
512 WRITE(IOUT,1505)FRIC2,C11,C22,C33,C44,C55,C66
513 ELSEIF(MFROT==3)THEN
514 WRITE(IOUT,1506)C11,C22,C33,C44,C55,C66
515 ELSEIF(MFROT==4)THEN
516 WRITE(IOUT,1514) FRIC2,C11,C22
517 ENDIF
518 ENDIF
519C
520 ENDIF
521C
522 ENDIF
523C
524.AND. IF(FLAGP1 /= 0FLAGGRP2 /= 0)THEN
525C
526 IF(IFLAG ==0 ) THEN
527 IF(TAGPRT_FRIC(N1) ==0 ) THEN
528 NGRPF = NGRPF + 1
529 TAGPRT_FRIC(N1)=NGRPF ! tag parts
530 LENGRPF(NGRPF) = 1
531 ELSE
532 GRPN = TAGPRT_FRIC(N1)
533 IF(LENGRPF(GRPN)/=1) THEN
534 NGRPF = NGRPF + 1
535 LENGRPF(NGRPF) = 1
536 TAGPRT_FRIC(N1)=NGRPF ! tag parts
537 LENGRPF(GRPN) =LENGRPF(GRPN) - 1
538 ENDIF
539 ENDIF
540
541 NP0 = 0
542 DO I=1,IGRPART(IDTGRS2)%NENTITY
543 IP=IGRPART(IDTGRS2)%ENTITY(I)
544 IF(TAGPRT_FRIC(IP) ==0 ) THEN
545 NP0 = NP0 +1
546 ENDIF
547 ENDDO
548 IF(NP0 == IGRPART(IDTGRS2)%NENTITY) THEN
549 NGRPF = NGRPF + 1
550 LENGRPF(NGRPF) = NP0
551 DO I=1,IGRPART(IDTGRS2)%NENTITY
552 IP=IGRPART(IDTGRS2)%ENTITY(I)
553 TAGPRT_FRIC(IP)=NGRPF ! tag parts
554 ENDDO
555
556 J2 = 1
557 TAGG2(1) = NGRPF
558 ELSE
559 IF(NP0 >0 ) THEN
560 NGRPF = NGRPF + 1
561 LENGRPF(NGRPF) = NP0
562 DO I=1,IGRPART(IDTGRS2)%NENTITY
563 IP=IGRPART(IDTGRS2)%ENTITY(I)
564 IF(TAGPRT_FRIC(IP) ==0 ) TAGPRT_FRIC(IP) = NGRPF
565 ENDDO
566 ENDIF
567 INDEX(1:2*LENG) = 0
568 TRIGRPT(1:LENG) = 0
569 DO I=1,IGRPART(IDTGRS2)%NENTITY
570 IP=IGRPART(IDTGRS2)%ENTITY(I)
571 IF(TAGPRT_FRIC(IP)==0) TAGPRT_FRIC(IP)=NGRPF ! tag parts
572 TRIGRPT(I) = TAGPRT_FRIC(IP)
573 INDEX(I) = I
574 ENDDO
575 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS2)%NENTITY , 1)
576
577 NGR0 = TRIGRPT(INDEX(1))
578 J= 1
579 NEWGRP(1:LENG+1) = 0
580 TAGG2(1:LENG) = 0
581
582 DO I=2,IGRPART(IDTGRS2)%NENTITY
583 NGR = TRIGRPT(INDEX(I))
584 IF(NGR/=NGR0) THEN
585 IF(LENGRPF(NGR0) /= I-NEWGRP(J)-1) THEN
586 TAGG2(J) =1
587 ENDIF
588 J = J +1
589 NGR0 = NGR
590 NEWGRP( J) = I-1
591 ENDIF
592 ENDDO
593 IF(LENGRPF(NGR0) /= IGRPART(IDTGRS2)%NENTITY-NEWGRP(J)) THEN
594 TAGG2(J) =1
595 ENDIF
596 NEWGRP( J+1) = I-1
597 DO K=1,J
598 IF(TAGG2(K)==1) THEN
599 NGRPF = NGRPF + 1
600 LENGRPF(NGRPF) = NEWGRP( K+1) - NEWGRP( K)
601 IP=IGRPART(IDTGRS2)%ENTITY(INDEX(NEWGRP( K)+1))
602 NGR0 = TAGPRT_FRIC(IP)
603 LENGRPF(NGR0) =LENGRPF(NGR0) -LENGRPF(NGRPF)
604 DO I =NEWGRP( K)+1,NEWGRP( K+1)
605 IP=IGRPART(IDTGRS2)%ENTITY(INDEX(I))
606 TAGPRT_FRIC(IP) =NGRPF
607 ENDDO
608 ENDIF
609 ENDDO
610
611 ENDIF
612 ENDIF
613
614
615 IF(IFLAG == 1 ) THEN
616C
617 GRPN1 = TAGPRT_FRIC(N1)
618C
619! If part or group of parts is already read : look to group of parts belonging and it and split it to ensure group of parts are not lapped
620 INDEX(1:2*LENG) = 0
621 TRIGRPT(1:LENG) = 0
622 TAGG2(1:LENG) = 0
623 DO I=1,IGRPART(IDTGRS2)%NENTITY
624 IP=IGRPART(IDTGRS2)%ENTITY(I)
625 TRIGRPT(I) = TAGPRT_FRIC(IP)
626 INDEX(I) = I
627 ENDDO
628 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS2)%NENTITY , 1)
629
630 NGR0 = TRIGRPT(INDEX(1))
631 J= 1
632 TAGG2(1) = NGR0
633 DO I=2,IGRPART(IDTGRS2)%NENTITY
634 NGR = TRIGRPT(INDEX(I))
635 IF(NGR/=NGR0) THEN
636 J = J +1
637 NGR0 = NGR
638 TAGG2(J) = NGR0
639 ENDIF
640 ENDDO
641 J2 = J
642C
643 DO K=1,J2
644 GRPN2 = TAGG2(K)
645
646 IF(N1 > GRPN2 ) THEN
647 N = GRPN1
648 IPP = GRPN2
649 IP = GRPN1
650 ELSE
651 IPP = GRPN1
652 IP = GRPN2
653 ENDIF
654
655 NSET = NSET + 1
656 NCOUPLE = NCOUPLE + 1
657 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = IPP
658 NCOUPLE = NCOUPLE + 1
659 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = IP
660C
661 NTAB = LENF*8*(NSET-1)+8
662 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC
663 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF
664 IF(MFROT > 0) THEN
665 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C1
666 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C2
667 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C3
668 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C4
669 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C5
670 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C6
671 ENDIF
672 IFRICORTH_TMP(NIF,NSET) = IDIR
673
674c
675 IF(IDIR==1) THEN
676
677 NTAB = 16*NSET
678 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC2
679 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF2
680 IF(MFROT > 0) THEN
681 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C11
682 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C22
683 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C33
684 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C44
685 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C55
686 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C66
687 ENDIF
688
689 ENDIF
690 ENDDO
691 ENDIF
692
693c
694
695C--Output--
696 IF(IFLAG == 1 ) THEN
697 WRITE (IOUT,2003)
698 . IPART(4,N1),GRPART2
699 IF(IDIR==0) THEN
700 WRITE(IOUT,1510)
701 IF(MFROT==0)THEN
702 WRITE(IOUT,3503) FRIC
703 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
704 ELSEIF(MFROT==1)THEN
705 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
706 ELSEIF(MFROT==2)THEN
707 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
708 ELSEIF(MFROT==3)THEN
709 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
710 ELSEIF(MFROT==4)THEN
711 WRITE(IOUT,1514) FRIC,C1,C2
712 ENDIF
713 ELSE
714 WRITE(IOUT,1511)
715 WRITE(IOUT,1512)
716 IF(MFROT==0)THEN
717 WRITE(IOUT,3503) FRIC
718 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
719 ELSEIF(MFROT==1)THEN
720 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
721 ELSEIF(MFROT==2)THEN
722 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
723 ELSEIF(MFROT==3)THEN
724 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
725 ELSEIF(MFROT==4)THEN
726 WRITE(IOUT,1514) FRIC,C1,C2
727 ENDIF
728 WRITE(IOUT,1513)
729 IF(MFROT==0)THEN
730 WRITE(IOUT,3503) FRIC2
731 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF2
732 ELSEIF(MFROT==1)THEN
733 WRITE(IOUT,1504) FRIC2,C11,C22,C33,C44,C55,C66
734 ELSEIF(MFROT==2)THEN
735 WRITE(IOUT,1505)FRIC2,C11,C22,C33,C44,C55,C66
736 ELSEIF(MFROT==3)THEN
737 WRITE(IOUT,1506)C11,C22,C33,C44,C55,C66
738 ELSEIF(MFROT==4)THEN
739 WRITE(IOUT,1514) FRIC2,C11,C22
740 ENDIF
741 ENDIF
742 ENDIF
743
744 ENDIF
745C
746.AND. IF(FLAGP2 /= 0FLAGGRP1 /= 0)THEN
747
748 IF(IFLAG==0) THEN
749 IF(TAGPRT_FRIC(N2) ==0 ) THEN
750 NGRPF = NGRPF + 1
751 TAGPRT_FRIC(N2)=NGRPF ! tag parts
752 LENGRPF(NGRPF) = 1
753 ELSE
754 GRPN = TAGPRT_FRIC(N2)
755 IF(LENGRPF(GRPN)/=1) THEN
756 NGRPF = NGRPF + 1
757 LENGRPF(NGRPF) = 1
758 TAGPRT_FRIC(N2)=NGRPF ! tag parts
759 LENGRPF(GRPN) =LENGRPF(GRPN) - 1
760 ENDIF
761 ENDIF
762
763 NP0 = 0
764 DO I=1,IGRPART(IDTGRS1)%NENTITY
765 IP=IGRPART(IDTGRS1)%ENTITY(I)
766 IF(TAGPRT_FRIC(IP) ==0 ) THEN
767 NP0 = NP0 +1
768 ENDIF
769 ENDDO
770
771
772
773 IF(NP0 == IGRPART(IDTGRS1)%NENTITY) THEN
774 NGRPF = NGRPF + 1
775 LENGRPF(NGRPF) = NP0
776 DO I=1,IGRPART(IDTGRS1)%NENTITY
777 IP=IGRPART(IDTGRS1)%ENTITY(I)
778 TAGPRT_FRIC(IP)=NGRPF ! tag parts
779 ENDDO
780
781 ELSE
782 IF(NP0 >0 ) THEN
783 NGRPF = NGRPF + 1
784 LENGRPF(NGRPF) = NP0
785 DO I=1,IGRPART(IDTGRS1)%NENTITY
786 IP=IGRPART(IDTGRS1)%ENTITY(I)
787 IF(TAGPRT_FRIC(IP) ==0 ) TAGPRT_FRIC(IP) = NGRPF
788 ENDDO
789 ENDIF
790 INDEX(1:2*LENG) = 0
791 TRIGRPT(1:LENG) = 0
792 DO I=1,IGRPART(IDTGRS1)%NENTITY
793 IP=IGRPART(IDTGRS1)%ENTITY(I)
794 IF(TAGPRT_FRIC(IP)==0) TAGPRT_FRIC(IP)=NGRPF ! tag parts
795 TRIGRPT(I) = TAGPRT_FRIC(IP)
796 INDEX(I) = I
797 ENDDO
798 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS1)%NENTITY , 1)
799
800 NGR0 = TRIGRPT(INDEX(1))
801 J= 1
802 NEWGRP(1:LENG+1) = 0
803 TAGG1(1:LENG) = 0
804 DO I=2,IGRPART(IDTGRS1)%NENTITY
805 NGR = TRIGRPT(INDEX(I))
806 IF(NGR/=NGR0) THEN
807 IF(LENGRPF(NGR0) /= I-NEWGRP(J)-1) THEN
808 TAGG1(J) =1
809 ENDIF
810 J = J +1
811 NGR0 = NGR
812 NEWGRP( J) = I-1
813 ENDIF
814 ENDDO
815
816 IF(LENGRPF(NGR0) /= IGRPART(IDTGRS1)%NENTITY-NEWGRP(J)) THEN
817 TAGG1(J) =1
818 ENDIF
819 NEWGRP( J+1) = I-1
820
821
822 DO K=1,J
823 IF(TAGG1(K)==1) THEN
824 NGRPF = NGRPF + 1
825 LENGRPF(NGRPF) = NEWGRP( K+1) - NEWGRP( K)
826 IP=IGRPART(IDTGRS1)%ENTITY(INDEX(NEWGRP( K)+1))
827 NGR0 = TAGPRT_FRIC(IP)
828 LENGRPF(NGR0) =LENGRPF(NGR0) -LENGRPF(NGRPF)
829 DO I =NEWGRP( K)+1,NEWGRP( K+1)
830 IP=IGRPART(IDTGRS1)%ENTITY(INDEX(I))
831 TAGPRT_FRIC(IP) =NGRPF
832 ENDDO
833 ENDIF
834 ENDDO
835 ENDIF
836 ENDIF
837C
838 IF(IFLAG == 1 ) THEN
839C
840 GRPN2 = TAGPRT_FRIC(N2)
841C
842 INDEX(1:2*LENG) = 0
843 TRIGRPT(1:LENG) = 0
844 TAGG1(1:LENG) = 0
845 DO I=1,IGRPART(IDTGRS1)%NENTITY
846 IP=IGRPART(IDTGRS1)%ENTITY(I)
847 TRIGRPT(I) = TAGPRT_FRIC(IP)
848 INDEX(I) = I
849 ENDDO
850 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS1)%NENTITY , 1)
851
852 NGR0 = TRIGRPT(INDEX(1))
853 J= 1
854 TAGG1(1) = NGR0
855 DO I=2,IGRPART(IDTGRS1)%NENTITY
856 NGR = TRIGRPT(INDEX(I))
857 IF(NGR/=NGR0) THEN
858 J = J +1
859 NGR0 = NGR
860 TAGG1(J) = NGR0
861 ENDIF
862 ENDDO
863 J1 = J
864C
865 DO K=1,J1
866 GRPN1 = TAGG1(K)
867 IF(GRPN1 > N2 ) THEN
868 N = N2
869 IPP = GRPN1
870 IP = N2
871 ELSE
872 IPP = GRPN1
873 ENDIF
874
875 NSET = NSET + 1
876 NCOUPLE = NCOUPLE + 1
877 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = IPP
878 NCOUPLE = NCOUPLE + 1
879 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = IP
880C
881 NTAB = LENF*8*(NSET-1)+8
882 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC
883 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF
884 IF(MFROT > 0 ) THEN
885 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C1
886 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C2
887 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C3
888 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C4
889 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C5
890 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C6
891 ENDIF
892 IFRICORTH_TMP(NIF,NSET) = IDIR
893c
894 IF(IDIR==1) THEN
895
896 NTAB = 2*8*NSET
897 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC2
898 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF2
899 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C11
900 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C22
901 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C33
902 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C44
903 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C55
904 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C66
905
906 ENDIF
907c
908 ENDDO
909
910 ENDIF
911
912C--Output--
913 IF(IFLAG == 1 ) THEN
914 WRITE (IOUT,2002)
915 . GRPART1,IPART(4,N2)
916 IF(IDIR==0) THEN
917 WRITE(IOUT,1510)
918 IF(MFROT==0)THEN
919 WRITE(IOUT,3503) FRIC
920 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
921 ELSEIF(MFROT==1)THEN
922 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
923 ELSEIF(MFROT==2)THEN
924 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
925 ELSEIF(MFROT==3)THEN
926 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
927 ELSEIF(MFROT==4)THEN
928 WRITE(IOUT,1514) FRIC,C1,C2
929 ENDIF
930 ELSE
931 WRITE(IOUT,1511)
932 WRITE(IOUT,1512)
933 IF(MFROT==0)THEN
934 WRITE(IOUT,3503) FRIC
935 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
936 ELSEIF(MFROT==1)THEN
937 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
938 ELSEIF(MFROT==2)THEN
939 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
940 ELSEIF(MFROT==3)THEN
941 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
942 ELSEIF(MFROT==4)THEN
943 WRITE(IOUT,1514) FRIC,C1,C2
944 ENDIF
945 WRITE(IOUT,1513)
946 IF(MFROT==0)THEN
947 WRITE(IOUT,3503) FRIC2
948 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF2
949 ELSEIF(MFROT==1)THEN
950 WRITE(IOUT,1504) FRIC2,C11,C22,C33,C44,C55,C66
951 ELSEIF(MFROT==2)THEN
952 WRITE(IOUT,1505)FRIC2,C11,C22,C33,C44,C55,C66
953 ELSEIF(MFROT==3)THEN
954 WRITE(IOUT,1506)C11,C22,C33,C44,C55,C66
955 ELSEIF(MFROT==4)THEN
956 WRITE(IOUT,1514) FRIC2,C11,C22
957 ENDIF
958 ENDIF
959 ENDIF
960
961 ENDIF
962C
963.AND. IF(FLAGGRP1 /= 0FLAGGRP2 /=0)THEN
964
965 IF(IFLAG==0) THEN
966 NP0 = 0
967 DO I=1,IGRPART(IDTGRS1)%NENTITY
968 IP=IGRPART(IDTGRS1)%ENTITY(I)
969 IF(TAGPRT_FRIC(IP) ==0 ) THEN
970 NP0 = NP0 +1
971 ENDIF
972 ENDDO
973
974
975
976 IF(NP0 == IGRPART(IDTGRS1)%NENTITY) THEN
977 NGRPF = NGRPF + 1
978 LENGRPF(NGRPF) = NP0
979 DO I=1,IGRPART(IDTGRS1)%NENTITY
980 IP=IGRPART(IDTGRS1)%ENTITY(I)
981 TAGPRT_FRIC(IP)=NGRPF ! tag parts
982 ENDDO
983
984 ELSE
985 IF(NP0 >0 ) THEN
986 NGRPF = NGRPF + 1
987 LENGRPF(NGRPF) = NP0
988 DO I=1,IGRPART(IDTGRS1)%NENTITY
989 IP=IGRPART(IDTGRS1)%ENTITY(I)
990 IF(TAGPRT_FRIC(IP) ==0 ) TAGPRT_FRIC(IP) = NGRPF
991 ENDDO
992 ENDIF
993 INDEX(1:2*LENG) = 0
994 TRIGRPT(1:LENG) = 0
995 DO I=1,IGRPART(IDTGRS1)%NENTITY
996 IP=IGRPART(IDTGRS1)%ENTITY(I)
997 IF(TAGPRT_FRIC(IP)==0) TAGPRT_FRIC(IP)=NGRPF ! tag parts
998 TRIGRPT(I) = TAGPRT_FRIC(IP)
999 INDEX(I) = I
1000 ENDDO
1001 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS1)%NENTITY , 1)
1002
1003 NGR0 = TRIGRPT(INDEX(1))
1004 J= 1
1005 NEWGRP(1:LENG+1) = 0
1006 TAGG1(1:LENG) = 0
1007 DO I=2,IGRPART(IDTGRS1)%NENTITY
1008 NGR = TRIGRPT(INDEX(I))
1009 IF(NGR/=NGR0) THEN
1010 IF(LENGRPF(NGR0) /= I-NEWGRP(J)-1) THEN
1011 TAGG1(J) =1
1012 ENDIF
1013 J = J +1
1014 NGR0 = NGR
1015 NEWGRP( J) = I-1
1016 ENDIF
1017 ENDDO
1018
1019 IF(LENGRPF(NGR0) /= IGRPART(IDTGRS1)%NENTITY-NEWGRP(J)) THEN
1020 TAGG1(J) =1
1021 ENDIF
1022 NEWGRP( J+1) = I-1
1023
1024
1025 DO K=1,J
1026 IF(TAGG1(K)==1) THEN
1027 NGRPF = NGRPF + 1
1028 LENGRPF(NGRPF) = NEWGRP( K+1) - NEWGRP( K)
1029 IP=IGRPART(IDTGRS1)%ENTITY(INDEX(NEWGRP( K)+1))
1030 NGR0 = TAGPRT_FRIC(IP)
1031 LENGRPF(NGR0) =LENGRPF(NGR0) -LENGRPF(NGRPF)
1032 DO I =NEWGRP( K)+1,NEWGRP( K+1)
1033 IP=IGRPART(IDTGRS1)%ENTITY(INDEX(I))
1034 TAGPRT_FRIC(IP) =NGRPF
1035 ENDDO
1036 ENDIF
1037 ENDDO
1038 ENDIF
1039
1040 NP0 = 0
1041 DO I=1,IGRPART(IDTGRS2)%NENTITY
1042 IP=IGRPART(IDTGRS2)%ENTITY(I)
1043 IF(TAGPRT_FRIC(IP) ==0 ) THEN
1044 NP0 = NP0 +1
1045 ENDIF
1046 ENDDO
1047 IF(NP0 == IGRPART(IDTGRS2)%NENTITY) THEN
1048 NGRPF = NGRPF + 1
1049 LENGRPF(NGRPF) = NP0
1050 DO I=1,IGRPART(IDTGRS2)%NENTITY
1051 IP=IGRPART(IDTGRS2)%ENTITY(I)
1052 TAGPRT_FRIC(IP)=NGRPF ! tag parts
1053 ENDDO
1054
1055
1056 J2 = 1
1057 TAGG2(1) = NGRPF
1058 ELSE
1059 IF(NP0 >0 ) THEN
1060 NGRPF = NGRPF + 1
1061 LENGRPF(NGRPF) = NP0
1062 DO I=1,IGRPART(IDTGRS2)%NENTITY
1063 IP=IGRPART(IDTGRS2)%ENTITY(I)
1064 IF(TAGPRT_FRIC(IP) ==0 ) TAGPRT_FRIC(IP) = NGRPF
1065 ENDDO
1066 ENDIF
1067 INDEX(1:2*LENG) = 0
1068 TRIGRPT(1:LENG) = 0
1069 DO I=1,IGRPART(IDTGRS2)%NENTITY
1070 IP=IGRPART(IDTGRS2)%ENTITY(I)
1071 IF(TAGPRT_FRIC(IP)==0) TAGPRT_FRIC(IP)=NGRPF ! tag parts
1072 TRIGRPT(I) = TAGPRT_FRIC(IP)
1073 INDEX(I) = I
1074 ENDDO
1075 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS2)%NENTITY , 1)
1076
1077 NGR0 = TRIGRPT(INDEX(1))
1078 J= 1
1079 NEWGRP(1:LENG+1) = 0
1080 TAGG2(1:LENG) = 0
1081
1082 DO I=2,IGRPART(IDTGRS2)%NENTITY
1083 NGR = TRIGRPT(INDEX(I))
1084 IF(NGR/=NGR0) THEN
1085 IF(LENGRPF(NGR0) /= I-NEWGRP(J)-1) THEN
1086 TAGG2(J) =1
1087 ENDIF
1088 J = J +1
1089 NGR0 = NGR
1090 NEWGRP( J) = I-1
1091 ENDIF
1092 ENDDO
1093 IF(LENGRPF(NGR0) /= IGRPART(IDTGRS2)%NENTITY-NEWGRP(J)) THEN
1094 TAGG2(J) =1
1095 ENDIF
1096 NEWGRP( J+1) = I-1
1097 DO K=1,J
1098 IF(TAGG2(K)==1) THEN
1099 NGRPF = NGRPF + 1
1100 LENGRPF(NGRPF) = NEWGRP( K+1) - NEWGRP( K)
1101 IP=IGRPART(IDTGRS2)%ENTITY(INDEX(NEWGRP( K)+1))
1102 NGR0 = TAGPRT_FRIC(IP)
1103 LENGRPF(NGR0) =LENGRPF(NGR0) -LENGRPF(NGRPF)
1104 DO I =NEWGRP( K)+1,NEWGRP( K+1)
1105 IP=IGRPART(IDTGRS2)%ENTITY(INDEX(I))
1106 TAGPRT_FRIC(IP) =NGRPF
1107 ENDDO
1108 ENDIF
1109 ENDDO
1110
1111 ENDIF
1112 ENDIF
1113
1114 IF(IFLAG == 1 ) THEN
1115
1116C
1117 INDEX(1:2*LENG) = 0
1118 TRIGRPT(1:LENG) = 0
1119 TAGG1(1:LENG) = 0
1120 DO I=1,IGRPART(IDTGRS1)%NENTITY
1121 IP=IGRPART(IDTGRS1)%ENTITY(I)
1122 TRIGRPT(I) = TAGPRT_FRIC(IP)
1123 INDEX(I) = I
1124 ENDDO
1125 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS1)%NENTITY , 1)
1126
1127 NGR0 = TRIGRPT(INDEX(1))
1128 J= 1
1129 TAGG1(1) = NGR0
1130 DO I=2,IGRPART(IDTGRS1)%NENTITY
1131 NGR = TRIGRPT(INDEX(I))
1132 IF(NGR/=NGR0) THEN
1133 J = J +1
1134 NGR0 = NGR
1135 TAGG1(J) = NGR0
1136 ENDIF
1137 ENDDO
1138 J1 = J
1139C
1140 INDEX(1:2*LENG) = 0
1141 TRIGRPT(1:LENG) = 0
1142 TAGG2(1:LENG) = 0
1143 DO I=1,IGRPART(IDTGRS2)%NENTITY
1144 IP=IGRPART(IDTGRS2)%ENTITY(I)
1145 TRIGRPT(I) = TAGPRT_FRIC(IP)
1146 INDEX(I) = I
1147 ENDDO
1148 CALL MY_ORDERS( 0, WORK, TRIGRPT, INDEX, IGRPART(IDTGRS2)%NENTITY , 1)
1149
1150 NGR0 = TRIGRPT(INDEX(1))
1151 J= 1
1152 TAGG2(1) = NGR0
1153 DO I=2,IGRPART(IDTGRS2)%NENTITY
1154 NGR = TRIGRPT(INDEX(I))
1155 IF(NGR/=NGR0) THEN
1156 J = J +1
1157 NGR0 = NGR
1158 TAGG2(J) = NGR0
1159 ENDIF
1160 ENDDO
1161 J2 = J
1162C
1163 DO K=1,J1
1164 GRPN1 = TAGG1(K)
1165 DO J=1,J2
1166 GRPN2 = TAGG2(J)
1167 IF(GRPN1 > GRPN2 ) THEN
1168 N = GRPN2
1169 IPP2 = GRPN1
1170 IPP1 = N
1171 ELSE
1172 IPP1 = GRPN1
1173 IPP2 = GRPN2
1174 ENDIF
1175 NSET = NSET + 1
1176
1177 NCOUPLE = NCOUPLE + 1
1178 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = IPP1
1179 NCOUPLE = NCOUPLE + 1
1180 TABCOUPLEPARTS_FRIC_TMP(NIF,NCOUPLE) = IPP2
1181C
1182 NTAB = LENF*8*(NSET-1)+8
1183 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC
1184 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF
1185 IF(MFROT >0) THEN
1186 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C1
1187 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C2
1188 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C3
1189 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C4
1190 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C5
1191 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C6
1192 ENDIF
1193 IFRICORTH_TMP(NIF,NSET) = IDIR
1194c
1195 IF(IDIR==1) THEN
1196
1197 NTAB = 16*NSET
1198 TABCOEF_FRIC_TMP(NIF,NTAB+1) = FRIC2
1199 TABCOEF_FRIC_TMP(NIF,NTAB+2) = VISCF2
1200 IF(MFROT >0) THEN
1201 TABCOEF_FRIC_TMP(NIF,NTAB+3) = C11
1202 TABCOEF_FRIC_TMP(NIF,NTAB+4) = C22
1203 TABCOEF_FRIC_TMP(NIF,NTAB+5) = C33
1204 TABCOEF_FRIC_TMP(NIF,NTAB+6) = C44
1205 TABCOEF_FRIC_TMP(NIF,NTAB+7) = C55
1206 TABCOEF_FRIC_TMP(NIF,NTAB+8) = C66
1207 ENDIF
1208 ENDIF
1209c
1210 ENDDO
1211c
1212 END DO
1213
1214 ENDIF
1215
1216C--Output--
1217 IF(IFLAG == 1 ) THEN
1218 WRITE (IOUT,2004)
1219 . GRPART1,GRPART2
1220 IF(IDIR==0) THEN
1221 WRITE(IOUT,1510)
1222 IF(MFROT==0)THEN
1223 WRITE(IOUT,3503) FRIC
1224 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
1225 ELSEIF(MFROT==1)THEN
1226 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
1227 ELSEIF(MFROT==2)THEN
1228 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
1229 ELSEIF(MFROT==3)THEN
1230 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
1231 ELSEIF(MFROT==4)THEN
1232 WRITE(IOUT,1514) FRIC,C1,C2
1233 ENDIF
1234 ELSE
1235 WRITE(IOUT,1511)
1236 WRITE(IOUT,1512)
1237 IF(MFROT==0)THEN
1238 WRITE(IOUT,3503) FRIC
1239 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF
1240 ELSEIF(MFROT==1)THEN
1241 WRITE(IOUT,1504) FRIC,C1,C2,C3,C4,C5,C6
1242 ELSEIF(MFROT==2)THEN
1243 WRITE(IOUT,1505)FRIC,C1,C2,C3,C4,C5,C6
1244 ELSEIF(MFROT==3)THEN
1245 WRITE(IOUT,1506)C1,C2,C3,C4,C5,C6
1246 ELSEIF(MFROT==4)THEN
1247 WRITE(IOUT,1514) FRIC,C1,C2
1248 ENDIF
1249 WRITE(IOUT,1513)
1250 IF(MFROT==0)THEN
1251 WRITE(IOUT,3503) FRIC2
1252 IF(FRICFORM /= 2) WRITE(IOUT,3504) VISCF2
1253 ELSEIF(MFROT==1)THEN
1254 WRITE(IOUT,1504) FRIC2,C11,C22,C33,C44,C55,C66
1255 ELSEIF(MFROT==2)THEN
1256 WRITE(IOUT,1505)FRIC2,C11,C22,C33,C44,C55,C66
1257 ELSEIF(MFROT==3)THEN
1258 WRITE(IOUT,1506)C11,C22,C33,C44,C55,C66
1259 ELSEIF(MFROT==4)THEN
1260 WRITE(IOUT,1514) FRIC2,C11,C22
1261 ENDIF
1262 ENDIF
1263 ENDIF
1264
1265c ENDDO
1266c
1267 ENDIF
1268C
1269
1270 ENDDO ! N=1,NLINE
1271
1272 DEALLOCATE (TRIGRPT,INDEX,NEWGRP,TAGG1,TAGG2)
1273
1274C
1275 RETURN
1276
1277
1278
1279 1500 FORMAT(/1X,' friction INTERFACE model number :',I10,1X,A/
1280 . 1X,' ------------------------------- '/)
1281 1501 FORMAT( /1X,' default values ' /
1282 . 1X,' -------------- ' )
1283
1284 1502 FORMAT(
1285 . ' friction filtering flag. . . . . . . . . ',I10/,
1286 . ' filtering factor . . . . . . . . . . . . ',1PG20.13/)
1287 1503 FORMAT(/
1288 . ' friction model 0 (coulomb law) ')
1289 3503 FORMAT(/
1290 . ' friction coefficient . . . . . . . . . . ',1PG20.13/)
1291 3504 FORMAT(
1292 . ' friction critical damping factor. . . . .',1PG20.13/)
1293 3505 FORMAT(//
1294 . ' friction model 1 (viscous polynomial)'/
1295 . ' mu = muo + c1 p + c2 v + c3 pv + c4 p^2 + c5 v^2'/)
1296 1504 FORMAT(//
1297 . ' muo. . . . . . . . . . . . . . . . . . . ',1PG20.13/,
1298 . ' c1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1299 . ' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1300 . ' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1301 . ' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1302 . ' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1303 . ' TANGENTIAL PRESSURE LIMIT. . .. . . . . .',1pg20.13/)
1304 3506 FORMAT(/
1305 . ' FRICTION MODEL 2 (Darmstad Law) :'/
1306 . ' MU = MUo+c1*exp(c2*v)*p^2+c3*exp(c4*v)*p+c5*exp(c6*v)')
1307 1505 FORMAT(/
1308 . ' Muo. . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1309 . ' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1310 . ' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1311 . ' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1312 . ' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1313 . ' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1314 . ' C6 . . . . . . . . . . . . . . . . . . . ',1pg20.13/)
1315 3507 FORMAT(/
1316 . ' FRICTION MODEL 3 (Renard law) ')
1317 1506 FORMAT(/
1318 . ' C1 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1319 . ' C2 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1320 . ' C3 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1321 . ' C4 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1322 . ' C5 . . . . . . . . . . . . . . . . . . . ',1pg20.13/,
1323 . ' C6 . . . . . . . . . . . . . . . . . . . ',1pg20.13/)
1324 3508 FORMAT(/
1325 . ' EXPONENTIAL DECAY FRICTION LAW '/
1326 . ' MU = c1+(MUo-c1)*exp(-c2*v)')
1327 1514 FORMAT(/
1328 . ' STATIC COEFFICIENT MUo . . . . . . . . . ',1pg20.13/,
1329 . ' DYNAMIC COEFFICIENT C1 . . . . . . . . . ',1pg20.13/,
1330 . ' EXPONENTIAL DECAY COEFFICIENT C2 . . . . ',1pg20.13/)
1331c 2503 FORMAT(/
1332c . ' FRICTION COEFFICIENT . . . . . . . . . . . ',1PG20.13/
1333c . ' FRICTION CRITICAL DAMPING FACTOR. . . . . . ',1PG20.13)
1334
1335 2001 FORMAT(/
1336 . ' PART 1 . . . . . . . . . . . . . . . . . ',i10/,
1337 . ' PART 2 . . . . . . . . . . . . . . . . . ',i10)
1338 2002 FORMAT(/
1339 . ' GR_PART 1 . . . . . . . . . . . . . . . .',i10/,
1340 . ' PART 2 . . . . . . . . . . . . . . . . . ',i10)
1341 2003 FORMAT(/
1342 . ' PART 1 . . . . . . . . . . . . . . . . . ',i10/,
1343 . ' GR_PART 2 . . . . . . . . . . . . . . . .',i10)
1344 2004 FORMAT(/
1345 . ' GR_PART 1 . . . . . . . . . . . . . . . . ',i10/,
1346 . ' GR_PART 2 . . . . . . . . . . . . . . . . ',i10)
1347
1348
1349 1507 FORMAT( /1x,' FRICTION COEFFICIENTS TABLE ' /
1350 . 1x,' --------------------------- '/)
1351
1352 1508 FORMAT( ' FRICTION FORMULATION: INCREMENTAL (STIFFNESS) ',
1353 . 'FORMULATION')
1354 1509 FORMAT( ' FRICTION FORMULATION: TOTAL (VISCOUS) ',
1355 . 'formulation')
1356 1510 FORMAT(/
1357 . ' isotropic friction ')
1358 1511 FORMAT(/
1359 . ' orthotropic friction ')
1360 1512 FORMAT(/
1361 . ' friction direction 1 : ')
1362 1513 FORMAT(/
1363 . ' friction direction 2 : ')
1364
1365 END SUBROUTINE HM_READ_FRICTION
1366
my_real
#define my_real
Definition cppsort.cpp:32
damping
subroutine damping(nodft, nodlt, v, vr, a, ar, damp, ms, in, igrnod, dim, itask, weight, tagslv_rby, wfext)
Definition damping.F:882
alpha
#define alpha
Definition eval.h:35
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_friction
subroutine hm_read_friction(nif, nom_opt, titr, unitab, igrpart, ipart, nset, tagprt_fric, tabcoupleparts_fric_tmp, tabcoef_fric_tmp, mfrot, ifq, xfiltr, fricform, iflag, orthfric, ifricorth_tmp, ngrpf, lengrpf, leng, nointf, lsubmodel)
Definition hm_read_friction.F:46
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
starter
program starter
Definition starter.F:39