OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25cor3t.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!|| i25cor3t ../engine/source/interfaces/intsort/i25cor3t.F
25!||--- called by ------------------------------------------------------
26!|| i25sto ../engine/source/interfaces/intsort/i25sto.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../engine/share/modules/tri7box.F
29!||====================================================================
30 SUBROUTINE i25cor3t(JLT ,X ,IRECT ,NSV ,CAND_E ,
31 1 CAND_N ,X1 ,X2 ,
32 2 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
33 3 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
34 4 XI ,YI ,ZI ,STIF ,IX1 ,
35 5 IX2 ,IX3 ,IX4 ,NSN ,GAP_S ,
36 6 GAP_M ,GAPV ,CURV_MAX,ITYP ,NIN ,
37 7 V ,IGAP ,GAP_S_L ,GAP_M_L,MSEGTYP,
38 8 ETYP ,ICODT ,ISKEW ,IBC ,DRAD ,
39 9 DGAPLOAD)
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
220 END
i25cor3t
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)
Definition i25cor3t.F:40
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