OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3t.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine i25cor3t (jlt, x, irect, nsv, cand_e, cand_n, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsn, gap_s, gap_m, gapv, curv_max, ityp, nin, v, igap, gap_s_l, gap_m_l, msegtyp, etyp, icodt, iskew, ibc, drad, dgapload)

Function/Subroutine Documentation

◆ i25cor3t()

subroutine i25cor3t ( integer jlt,
x,
integer, dimension(4,*) irect,
integer, dimension(*) nsv,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
x1,
x2,
x3,
x4,
y1,
y2,
y3,
y4,
z1,
z2,
z3,
z4,
xi,
yi,
zi,
stif,
integer, dimension(mvsiz) ix1,
integer, dimension(mvsiz) ix2,
integer, dimension(mvsiz) ix3,
integer, dimension(mvsiz) ix4,
integer nsn,
gap_s,
gap_m,
gapv,
curv_max,
integer ityp,
integer nin,
v,
integer igap,
gap_s_l,
gap_m_l,
integer, dimension(*) msegtyp,
integer, dimension(mvsiz) etyp,
integer, dimension(*) icodt,
integer, dimension(*) iskew,
integer, dimension(mvsiz) ibc,
intent(in) drad,
intent(in) dgapload )

Definition at line 30 of file i25cor3t.F.

40C============================================================================
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE tri7box
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com08_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
61 . JLT,IDT, NOINT, NSN ,ITYP, NIN, IGAP, MSEGTYP(*), ICODT(*), ISKEW(*)
62 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
63 . ETYP(MVSIZ), IBC(MVSIZ)
64C REAL
65 my_real , INTENT(IN) :: dgapload ,drad
66 my_real
67 . x(3,*), v(3,*), gapv(*), gap_s(*), gap_m(*),curv_max(*),
68 . gap_s_l(*), gap_m_l(*)
69C REAL
70 my_real
71 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
72 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
73 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
74 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz)
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 INTEGER I ,J ,IL, L, NN, IG,JFT,IADD,
79 . IBCS, ISKS, IBCM(4), ISKM(4)
80 my_real
81 . vdt(mvsiz)
82 my_real
83 . vx,vy,vz,vxi,vyi,vzi,
84 . vx1,vx2,vx3,vx4,vy1,vy2,vy3,vy4,vz1,vz2,vz3,vz4,pmax
85C-----------------------------------------------
86C
87 vdt = zero
88 IF(igap /= 3)THEN
89 DO i=1,jlt
90 j = cand_n(i)
91 IF(j<=nsn) THEN
92 gapv(i)=gap_s(j) + gap_m(cand_e(i))
93 ELSE
94 ig = j-nsn
95 gapv(i)=xrem(9,ig) + gap_m(cand_e(i))
96 END IF
97 gapv(i)=max(drad,gapv(i)+dgapload)
98 END DO
99 ELSE
100 DO i=1,jlt
101 j = cand_n(i)
102 IF(j<=nsn) THEN
103 gapv(i)=gap_s(j) + gap_m(cand_e(i))
104 gapv(i)=min(gap_s_l(j)+gap_m_l(cand_e(i)),gapv(i))
105 ELSE
106 ig = j-nsn
107 gapv(i)=xrem(9,ig) + gap_m(cand_e(i))
108 gapv(i)=min(xrem(10,ig)+gap_m_l(cand_e(i)),gapv(i))
109 END IF
110 gapv(i)=max(drad,gapv(i)+dgapload)
111 END DO
112 END IF
113 DO i=1,jlt
114 j = cand_n(i)
115 IF(j<=nsn) THEN
116 ig = nsv(j)
117 xi(i) = x(1,ig)
118 yi(i) = x(2,ig)
119 zi(i) = x(3,ig)
120 vxi = v(1,ig)
121 vyi = v(2,ig)
122 vzi = v(3,ig)
123 ELSE
124 ig = j-nsn
125 xi(i) = xrem(1,ig)
126 yi(i) = xrem(2,ig)
127 zi(i) = xrem(3,ig)
128 vxi = xrem(4,ig)
129 vyi = xrem(5,ig)
130 vzi = xrem(6,ig)
131 ENDIF
132C
133 l = cand_e(i)
134 etyp(i) =msegtyp(l)
135C
136 ix1(i)=irect(1,l)
137 x1(i)=x(1,ix1(i))
138 y1(i)=x(2,ix1(i))
139 z1(i)=x(3,ix1(i))
140C
141 ix2(i)=irect(2,l)
142 x2(i)=x(1,ix2(i))
143 y2(i)=x(2,ix2(i))
144 z2(i)=x(3,ix2(i))
145C
146 ix3(i)=irect(3,l)
147 x3(i)=x(1,ix3(i))
148 y3(i)=x(2,ix3(i))
149 z3(i)=x(3,ix3(i))
150C
151 ix4(i)=irect(4,l)
152 x4(i)=x(1,ix4(i))
153 y4(i)=x(2,ix4(i))
154 z4(i)=x(3,ix4(i))
155C
156 vx1 = v(1,ix1(i))
157 vx2 = v(1,ix2(i))
158 vx3 = v(1,ix3(i))
159 vx4 = v(1,ix4(i))
160 vx=max(max(vx1,vx2,vx3,vx4)-vxi,vxi-min(vx1,vx2,vx3,vx4))
161 vy1 = v(2,ix1(i))
162 vy2 = v(2,ix2(i))
163 vy3 = v(2,ix3(i))
164 vy4 = v(2,ix4(i))
165 vy=max(max(vy1,vy2,vy3,vy4)-vyi,vyi-min(vy1,vy2,vy3,vy4))
166 vz1 = v(3,ix1(i))
167 vz2 = v(3,ix2(i))
168 vz3 = v(3,ix3(i))
169 vz4 = v(3,ix4(i))
170 vz=max(max(vz1,vz2,vz3,vz4)-vzi,vzi-min(vz1,vz2,vz3,vz4))
171 vdt(i) = (vx+vy+vz)*dt1
172 ENDDO
173
174 DO i=1,jlt
175 gapv(i) = gapv(i) + curv_max(cand_e(i)) + vdt(i)
176 gapv(i) = onep01*gapv(i)
177 END DO
178C
179 ibc(1:jlt)=0
180 DO i=1,jlt
181
182 j = cand_n(i)
183 IF(j <= nsn)THEN
184 ibcs =icodt(nsv(j))
185 ELSE
186 ig = j - nsn
187 ! ICODT
188 ibcs = irem(7,ig)
189 END IF
190
191 ibcm(1)=icodt(ix1(i))
192 ibcm(2)=icodt(ix2(i))
193 ibcm(3)=icodt(ix3(i))
194 ibcm(4)=icodt(ix4(i))
195
196 IF((ibcs ==1.OR.ibcs ==3.OR.ibcs ==5.OR.ibcs ==7).AND.
197 . (ibcm(1)==1.OR.ibcm(1)==3.OR.ibcm(1)==5.OR.ibcm(1)==7).AND.
198 . (ibcm(2)==1.OR.ibcm(2)==3.OR.ibcm(2)==5.OR.ibcm(2)==7).AND.
199 . (ibcm(3)==1.OR.ibcm(3)==3.OR.ibcm(3)==5.OR.ibcm(3)==7).AND.
200 . (ibcm(4)==1.OR.ibcm(4)==3.OR.ibcm(4)==5.OR.ibcm(4)==7))THEN
201 ibc(i)=ibc(i)+1
202 END IF
203 IF((ibcs ==2.OR.ibcs ==3.OR.ibcs ==6.OR.ibcs ==7).AND.
204 . (ibcm(1)==2.OR.ibcm(1)==3.OR.ibcm(1)==6.OR.ibcm(1)==7).AND.
205 . (ibcm(2)==2.OR.ibcm(2)==3.OR.ibcm(2)==6.OR.ibcm(2)==7).AND.
206 . (ibcm(3)==2.OR.ibcm(3)==3.OR.ibcm(3)==6.OR.ibcm(3)==7).AND.
207 . (ibcm(4)==2.OR.ibcm(4)==3.OR.ibcm(4)==6.OR.ibcm(4)==7))THEN
208 ibc(i)=ibc(i)+2
209 END IF
210 IF((ibcs ==4.OR.ibcs ==5.OR.ibcs ==6.OR.ibcs ==7).AND.
211 . (ibcm(1)==4.OR.ibcm(1)==5.OR.ibcm(1)==6.OR.ibcm(1)==7).AND.
212 . (ibcm(2)==4.OR.ibcm(2)==5.OR.ibcm(2)==6.OR.ibcm(2)==7).AND.
213 . (ibcm(3)==4.OR.ibcm(3)==5.OR.ibcm(3)==6.OR.ibcm(3)==7).AND.
214 . (ibcm(4)==4.OR.ibcm(4)==5.OR.ibcm(4)==6.OR.ibcm(4)==7))THEN
215 ibc(i)=ibc(i)+4
216 END IF
217 END DO
218C
219 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
tri7box::irem
integer, dimension(:,:), allocatable irem
Definition tri7box.F:339