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

Go to the source code of this file.

Functions/Subroutines

subroutine ingrbric_dx (nbric, ibufssg, global_gap, ixs, x, noint, titr, is_gap_computed, pm, ipm, iddlevel, istiff, auto_rho, auto_length, multi_fvm)

Function/Subroutine Documentation

◆ ingrbric_dx()

subroutine ingrbric_dx ( integer, intent(in) nbric,
integer, dimension(*), intent(in) ibufssg,
intent(inout) global_gap,
integer, dimension(nixs,numels), intent(in) ixs,
dimension(3,numnod), intent(in) x,
integer, intent(in) noint,
character(len=nchartitle), intent(in) titr,
logical, intent(inout) is_gap_computed,
dimension(npropm,nummat), intent(in) pm,
integer, dimension(npropmi,nummat), intent(in) ipm,
integer, intent(in) iddlevel,
integer, intent(in) istiff,
intent(inout) auto_rho,
intent(inout) auto_length,
type(multi_fvm_struct), intent(in) multi_fvm )

Definition at line 32 of file ingrbric_dx.F.

36C-----------------------------------------------
37C D e s c r i p t i o n
38C-----------------------------------------------
39C This subroutine is computing mesh size from the brick group which is
40C related to interface type 18. A gap value is then set consequently.
41C
42C A check is also introduced about aspect ratio
43C because
44C - in this case it is not obvious to determine if computed gap is the expected one
45C - it is recommended to use uniform mesh size with colocated scheme : ie law151
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE message_mod
50 USE multi_fvm_mod
51 USE names_and_titles_mod , ONLY : nchartitle
52 use element_mod , only : nixs
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com04_c.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER,INTENT(IN) :: NBRIC, NOINT, IDDLEVEL,ISTIFF
66 INTEGER,INTENT(IN) :: IBUFSSG(*), IXS(NIXS,NUMELS), IPM(NPROPMI,NUMMAT)
67 my_real,INTENT(INOUT) :: global_gap
68 my_real,INTENT(IN) :: x(3,numnod)
69 CHARACTER(LEN=NCHARTITLE) ,INTENT(IN) :: TITR
70 LOGICAL, INTENT(INOUT) :: IS_GAP_COMPUTED
71 my_real , INTENT(IN) :: pm(npropm,nummat)
72 my_real, INTENT(INOUT) :: auto_rho, auto_length
73 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
74C-----------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER :: I, J, J2, IEDG, CONNECT1(12), CONNECT2(12),IE,IMAT, ENUM, ILAW
78 my_real :: min_x,min_y,min_z
79 my_real :: max_x,max_y,max_z
80 my_real :: xx,yy,zz
81 my_real :: xx2,yy2,zz2
82 my_real :: dx,dy,dz
83 my_real :: diag, diag_max , len_edge(12), lmax, lmin, ratio2
84 my_real :: rho_max, rho0
85 LOGICAL :: CHECK_ASPECT
86 CHARACTER(LEN=NCHARTITLE) :: MSGTITL
87 CHARACTER*10 :: CHAR_ID
88C-----------------------------------------------
89C S o u r c e L i n e s
90C-----------------------------------------------
91
92 is_gap_computed = .false.
93
94 !-----------------------------------------
95 ! COMPUTE GLOBAL GAP
96 !-----------------------------------------
97 IF(global_gap == zero)THEN
98 !global gap required to estimate a stiffness value (automatic stiffness value when ISTIFF==2)
99 !global gap also required when a constant gap is not input IGAP=0
100 diag_max = em20
101 DO i=1,nbric
102 ie = ibufssg(i)
103 IF(ie==0)EXIT
104 max_x = -ep20
105 max_y = -ep20
106 max_z = -ep20
107 min_x = ep20
108 min_y = ep20
109 min_z = ep20
110 DO j=2,9
111 IF(ixs(j,ibufssg(i))==0)EXIT
112 xx = x(1,ixs(j,ie))
113 yy = x(2,ixs(j,ie))
114 zz = x(3,ixs(j,ie))
115 IF(xx < min_x)min_x=xx
116 IF(yy < min_y)min_y=yy
117 IF(zz < min_z)min_z=zz
118 IF(xx > max_x)max_x=xx
119 IF(yy > max_y)max_y=yy
120 IF(zz > max_z)max_z=zz
121 ENDDO
122 dx = min_x-max_x
123 dy = min_y-max_y
124 dz = min_z-max_z
125 diag = sqrt(dx*dx+dy*dy+dz*dz)
126 diag = sqrt(three)*diag
127 diag = half*diag ! sqrt(3)/2 * DIAG = ~ 1.5*MESH_SIZE
128 IF(diag > diag_max)diag_max=diag
129 END DO
130 global_gap = diag_max
131 auto_length = sqrt(three)*third*diag_max
132 is_gap_computed = .true.
133 ENDIF
134
135 !-----------------------------------------
136 ! DETERMINE GLOBAL DENSITY
137 !-----------------------------------------
138 rho_max = zero
139 IF(istiff == 2)THEN
140 rho_max=zero
141 DO i=1,nbric
142 ie=ibufssg(i)
143 IF(ie == 0)EXIT
144 imat=ixs(1,ie)
145 rho0=pm(89,imat)
146 ilaw=ipm(2,imat)
147 IF(ilaw == 51 .OR. ilaw == 151)THEN
148 rho_max = max(rho_max,pm(91,imat)) ! use rho_max(1:nsubmat) in case of multi material laws
149 ELSE
150 rho_max = max(rho_max, rho0) ! monomaterial case
151 ENDIF
152 END DO
153 ENDIF
154 auto_rho = rho_max
155
156 !-----------------------------------------
157 ! CHECK ASPECT RATIO
158 !-----------------------------------------
159 check_aspect=.false.
160 IF(iddlevel==1 .AND. multi_fvm%IS_USED)check_aspect=.true.
161 IF (check_aspect)THEN
162 !edge connectivity
163 connect1(1:12)=(/1,1,1,2,2,3,3,4,5,5,6,7/)
164 connect2(1:12)=(/2,4,5,3,6,4,7,8,6,8,7,8/)
165 enum=0
166 DO i=1,nbric
167 DO iedg=1,12
168 j=1+connect1(iedg)
169 j2=1+connect2(iedg)
170 xx = x(1,ixs(j,ibufssg(i)))
171 yy = x(2,ixs(j,ibufssg(i)))
172 zz = x(3,ixs(j,ibufssg(i)))
173 xx2 = x(1,ixs(j2,ibufssg(i)))
174 yy2 = x(2,ixs(j2,ibufssg(i)))
175 zz2 = x(3,ixs(j2,ibufssg(i)))
176 dx = xx-xx2
177 dy = yy-yy2
178 dz = zz-zz2
179 len_edge(iedg) = dx*dx + dy*dy + dz*dz
180 ENDDO
181 lmin=minval(len_edge)
182 lmax=maxval(len_edge)
183 ratio2 = lmax/lmin ! ratio of squared values
184 IF(ratio2 > 6.25 .AND. ENUM < 10)then
185 char_id=' '
186 WRITE(char_id,fmt='(I0)')ixs(11,ibufssg(i))
187 msgtitl='CHECK ASPECT RATIO CELL ID ='//char_id
188 CALL ancmsg(msgid=1826, msgtype=msgwarning, anmode=aninfo, i1=noint, c1=titr, c2=msgtitl)
189 enum=enum+1
190 ENDIF
191 IF(ENUM == 10)exit
192 ENDDO
193 ENDIF
194C------------------------------------------------------------
195 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
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
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:895