OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
intbufFric_ini_starter.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine intbuf_fric_ini_starter (intbuf_fric_tab)

Function/Subroutine Documentation

◆ intbuf_fric_ini_starter()

subroutine intbuf_fric_ini_starter ( type(intbuf_fric_struct_), dimension(*) intbuf_fric_tab)

Definition at line 31 of file intbufFric_ini_starter.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE my_alloc_mod
36 USE intbuf_fric_mod
37 USE message_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com04_c.inc"
46C-----------------------------------------------
47C M y A l l o c a t e
48C-----------------------------------------------
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52c my_real
53c .
54 TYPE(INTBUF_FRIC_STRUCT_) :: INTBUF_FRIC_TAB(*)
55C-----------------------------------------------
56C L o c a l V a r i a b l e s
57C-----------------------------------------------
58 INTEGER NINF , NSET ,S_TABPARTS_FRIC ,IORTH ,MFROT ,LENC
59C-----------------------------------------------
60
61 DO ninf = 1,ninterfric
62
63 nset = intbuf_fric_tab(ninf)%NSETPRTS
64 s_tabparts_fric = intbuf_fric_tab(ninf)%S_TABPARTS_FRIC
65 iorth = intbuf_fric_tab(ninf)%IORTHFRIC
66 mfrot = intbuf_fric_tab(ninf)%FRICMOD
67 IF(mfrot ==0 ) THEN
68 lenc =2
69 ELSE
70 lenc = 8
71 ENDIF
72C=======================================================================
73c ALLOCATIONS
74C=======================================================================
75
76 CALL my_alloc(intbuf_fric_tab(ninf)%TABCOUPLEPARTS_FRIC,nset)
77 intbuf_fric_tab(ninf)%TABCOUPLEPARTS_FRIC(1:nset) = 0
78
79 CALL my_alloc(intbuf_fric_tab(ninf)%TABPARTS_FRIC,s_tabparts_fric)
80 intbuf_fric_tab(ninf)%TABPARTS_FRIC(1:s_tabparts_fric) = 0
81
82 CALL my_alloc(intbuf_fric_tab(ninf)%ADPARTS_FRIC,s_tabparts_fric+1)
83 intbuf_fric_tab(ninf)%ADPARTS_FRIC(1:s_tabparts_fric+1) = 0
84
85 CALL my_alloc(intbuf_fric_tab(ninf)%IFRICORTH,nset)
86 intbuf_fric_tab(ninf)%IFRICORTH(1:nset) = 0
87
88 IF (iorth == 0 ) THEN
89 CALL my_alloc(intbuf_fric_tab(ninf)%TABCOEF_FRIC,lenc*(nset+1))
90 intbuf_fric_tab(ninf)%TABCOEF_FRIC(1:lenc*(nset+1)) = zero
91 ELSE
92 CALL my_alloc(intbuf_fric_tab(ninf)%TABCOEF_FRIC,lenc+2*lenc*nset)
93 intbuf_fric_tab(ninf)%TABCOEF_FRIC(1:2*lenc*nset+lenc) = zero
94 ENDIF
95
96C=======================================================================
97c END ALLOCATIONS
98C=======================================================================
99 ENDDO ! NINF = 1,NINTERFRIC
100C-----
101 RETURN
102