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 ../starter/source/interfaces/inter3d1/i25cor3t.F
25!||--- called by ------------------------------------------------------
26!|| i25sto ../starter/source/interfaces/inter3d1/i25sto.F
27!||--- uses -----------------------------------------------------
28!|| tri7box ../starter/share/modules1/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 ,NRTM ,
36 6 MARGE ,GAP_S ,GAP_M ,GAPV ,ITYP ,
37 7 IGAP ,GAP_S_L ,GAP_M_L ,EDGE_L2,MSEGTYP,
38 8 ETYP ,ICODE ,ISKEW ,IBC ,DRAD ,
39 9 DGAPLOAD,NRTMT)
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE tri7box
44C-----------------------------------------------
45C I m p l i c i t T y p e s
46C-----------------------------------------------
47#include "implicit_f.inc"
48C-----------------------------------------------
49C G l o b a l P a r a m e t e r s
50C-----------------------------------------------
51#include "mvsiz_p.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
56 . JLT,IDT, NOINT, NSN , NRTM,ITYP, IGAP, MSEGTYP(*), ICODE(*), ISKEW(*)
57 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
58 . ETYP(MVSIZ), IBC(MVSIZ)
59 INTEGER , INTENT(IN) :: NRTMT
60C REAL
61 my_real
62 . X(3,*), GAPV(*), GAP_S(*), GAP_M(*),
63 . GAP_S_L(*), GAP_M_L(*), EDGE_L2(*)
64 my_real
65 . marge
66 my_real , INTENT(IN) :: drad, dgapload
67C REAL ou REAL*8
68 my_real
69 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
70 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
71 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
72 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER I ,J ,IL, L, NN, IG,JFT,IADD,
77 . ibcs, isks, ibcm(4), iskm(4)
78C-----------------------------------------------
79C
80 IF(igap /= 3)THEN
81 DO i=1,jlt
82 j = cand_n(i)
83 l = cand_e(i)
84 gapv(i)=gap_s(j) + gap_m(l)
85 IF(msegtyp(l)==0.OR.msegtyp(l)>nrtmt)THEN
86 gapv(i)=max(gapv(i)+marge,gapv(i)+edge_l2(j))
87 ELSE
88 gapv(i)=gapv(i)+marge
89 END IF
90 gapv(i)=max(gapv(i)+dgapload,drad)
91 END DO
92 ELSE
93 DO i=1,jlt
94 j = cand_n(i)
95 l = cand_e(i)
96 gapv(i)=gap_s(j) + gap_m(l)
97 gapv(i)=min(gap_s_l(j)+gap_m_l(l),gapv(i))
98 IF(msegtyp(l)==0.OR.msegtyp(l)>nrtmt)THEN
99 gapv(i)=max(gapv(i)+marge,gapv(i)+edge_l2(j))
100 ELSE
101 gapv(i)=gapv(i)+marge
102 END IF
103 gapv(i)=max(gapv(i)+dgapload,drad)
104 END DO
105 END IF
106 DO i=1,jlt
107 j = cand_n(i)
108 ig = nsv(j)
109 xi(i) = x(1,ig)
110 yi(i) = x(2,ig)
111 zi(i) = x(3,ig)
112C
113 l = cand_e(i)
114 etyp(i) =msegtyp(l)
115C
116 ix1(i)=irect(1,l)
117 x1(i)=x(1,ix1(i))
118 y1(i)=x(2,ix1(i))
119 z1(i)=x(3,ix1(i))
120C
121 ix2(i)=irect(2,l)
122 x2(i)=x(1,ix2(i))
123 y2(i)=x(2,ix2(i))
124 z2(i)=x(3,ix2(i))
125C
126 ix3(i)=irect(3,l)
127 x3(i)=x(1,ix3(i))
128 y3(i)=x(2,ix3(i))
129 z3(i)=x(3,ix3(i))
130C
131 ix4(i)=irect(4,l)
132 x4(i)=x(1,ix4(i))
133 y4(i)=x(2,ix4(i))
134 z4(i)=x(3,ix4(i))
135C
136 ENDDO
137C
138 ibc(1:jlt)=0
139 DO i=1,jlt
140
141 j=cand_n(i)
142 ibcs =icode(nsv(j))/512
143 ibcm(1)=icode(ix1(i))/512
144 ibcm(2)=icode(ix2(i))/512
145 ibcm(3)=icode(ix3(i))/512
146 ibcm(4)=icode(ix4(i))/512
147
148 IF((ibcs ==1.OR.ibcs ==3.OR.ibcs ==5.OR.ibcs ==7).AND.
149 . (ibcm(1)==1.OR.ibcm(1)==3.OR.ibcm(1)==5.OR.ibcm(1)==7).AND.
150 . (ibcm(2)==1.OR.ibcm(2)==3.OR.ibcm(2)==5.OR.ibcm(2)==7).AND.
151 . (ibcm(3)==1.OR.ibcm(3)==3.OR.ibcm(3)==5.OR.ibcm(3)==7).AND.
152 . (ibcm(4)==1.OR.ibcm(4)==3.OR.ibcm(4)==5.OR.ibcm(4)==7))THEN
153 ibc(i)=ibc(i)+1
154 END IF
155 IF((ibcs ==2.OR.ibcs ==3.OR.ibcs ==6.OR.ibcs ==7).AND.
156 . (ibcm(1)==2.OR.ibcm(1)==3.OR.ibcm(1)==6.OR.ibcm(1)==7).AND.
157 . (ibcm(2)==2.OR.ibcm(2)==3.OR.ibcm(2)==6.OR.ibcm(2)==7).AND.
158 . (ibcm(3)==2.OR.ibcm(3)==3.OR.ibcm(3)==6.OR.ibcm(3)==7).AND.
159 . (ibcm(4)==2.OR.ibcm(4)==3.OR.ibcm(4)==6.OR.ibcm(4)==7))THEN
160 ibc(i)=ibc(i)+2
161 END IF
162 IF((ibcs ==4.OR.ibcs ==5.OR.ibcs ==6.OR.ibcs ==7).AND.
163 . (ibcm(1)==4.OR.ibcm(1)==5.OR.ibcm(1)==6.OR.ibcm(1)==7).AND.
164 . (ibcm(2)==4.OR.ibcm(2)==5.OR.ibcm(2)==6.OR.ibcm(2)==7).AND.
165 . (ibcm(3)==4.OR.ibcm(3)==5.OR.ibcm(3)==6.OR.ibcm(3)==7).AND.
166 . (ibcm(4)==4.OR.ibcm(4)==5.OR.ibcm(4)==6.OR.ibcm(4)==7))THEN
167 ibc(i)=ibc(i)+4
168 END IF
169 END DO
170
171 RETURN
172 END
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
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, nrtm, marge, gap_s, gap_m, gapv, ityp, igap, gap_s_l, gap_m_l, edge_l2, msegtyp, etyp, icode, iskew, ibc, drad, dgapload, nrtmt)
Definition i25cor3t.F:40