OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7cor3t.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!|| i7cor3t ../engine/source/interfaces/int07/i7cor3t.F
25!||--- called by ------------------------------------------------------
26!|| i10sto ../engine/source/interfaces/intsort/i10sto.F
27!|| i7sto ../engine/source/interfaces/intsort/i7sto.F
28!||--- uses -----------------------------------------------------
29!|| tri7box ../engine/share/modules/tri7box.F
30!||====================================================================
31 SUBROUTINE i7cor3t(JLT ,X ,IRECT ,NSV ,CAND_E ,
32 1 CAND_N ,IGAP ,GAP ,X1 ,X2 ,
33 2 X3 ,X4 ,Y1 ,Y2 ,Y3 ,
34 3 Y4 ,Z1 ,Z2 ,Z3 ,Z4 ,
35 4 XI ,YI ,ZI ,STIF ,IX1 ,
36 5 IX2 ,IX3 ,IX4 ,NSN ,GAP_S ,
37 6 GAP_M ,GAPV ,GAPMAX,GAPMIN,CURV_MAX,
38 7 ITYP ,NIN ,GAP_S_L,GAP_M_L,INTTH,
39 8 DRAD ,DGAPLOAD)
40C============================================================================
41C cette routine est appelee par : I10STO(/int10/i10sto.F)
42C I7STO(/int7/i7sto.F)
43C----------------------------------------------------------------------------
44C cette routine appelle : -
45C============================================================================
46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE tri7box
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C G l o b a l P a r a m e t e r s
56C-----------------------------------------------
57#include "mvsiz_p.inc"
58C-----------------------------------------------
59C C o m m o n B l o c k s
60C-----------------------------------------------
61C-----------------------------------------------
62C D u m m y A r g u m e n t s
63C-----------------------------------------------
64 INTEGER IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
65 . JLT,IDT, NOINT, NSN, IGAP ,ITYP, NIN, INTTH
66 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
67 my_real
68 . X(3,*), GAPV(*), GAP_S(*), GAP_M(*),CURV_MAX(*),
69 . GAP, GAPMAX, GAPMIN
70 my_real , INTENT(IN) :: DGAPLOAD ,DRAD
71 my_real
72 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
73 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
74 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
75 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
76 . gap_s_l(*),gap_m_l(*)
77C-----------------------------------------------
78C L o c a l V a r i a b l e s
79C-----------------------------------------------
80 INTEGER I ,J ,IL, L, NN, IG,JFT,IADD
81C-----------------------------------------------
82C
83 IF(IGAP==0)then
84 DO i=1,jlt
85 gapv(i)=max(gap+dgapload,drad)
86 END DO
87 ELSEIF(igap == 3)THEN
88 iadd = 9
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 gapv(i)=min(gap_s_l(j)+gap_m_l(cand_e(i)),gapv(i))
94 ELSE
95 ig = j-nsn
96 gapv(i)=xrem(9,ig)+gap_m(cand_e(i))
97 gapv(i)=min(xrem(10,ig)+gap_m_l(cand_e(i)),gapv(i))
98 END IF
99 gapv(i)=min(gapv(i),gapmax)
100 gapv(i)=max(gapmin,gapv(i))
101 gapv(i)=max(drad,gapv(i)+dgapload)
102 END DO
103 ELSE
104 DO i=1,jlt
105 j = cand_n(i)
106 IF(j<=nsn) THEN
107 gapv(i)=gap_s(j)+gap_m(cand_e(i))
108 ELSE
109 ig = j-nsn
110 gapv(i)=xrem(9,ig)+gap_m(cand_e(i))
111 END IF
112 gapv(i)=min(gapv(i),gapmax)
113 gapv(i)=max(gapmin,gapv(i))
114 gapv(i)=max(drad,gapv(i)+dgapload)
115 END DO
116 END IF
117 DO i=1,jlt
118 j = cand_n(i)
119 IF(j<=nsn) THEN
120 ig = nsv(j)
121 xi(i) = x(1,ig)
122 yi(i) = x(2,ig)
123 zi(i) = x(3,ig)
124 ELSE
125 ig = j-nsn
126 xi(i) = xrem(1,ig)
127 yi(i) = xrem(2,ig)
128 zi(i) = xrem(3,ig)
129 ENDIF
130C
131 l = cand_e(i)
132C
133 ix1(i)=irect(1,l)
134 x1(i)=x(1,ix1(i))
135 y1(i)=x(2,ix1(i))
136 z1(i)=x(3,ix1(i))
137C
138 ix2(i)=irect(2,l)
139 x2(i)=x(1,ix2(i))
140 y2(i)=x(2,ix2(i))
141 z2(i)=x(3,ix2(i))
142C
143 ix3(i)=irect(3,l)
144 x3(i)=x(1,ix3(i))
145 y3(i)=x(2,ix3(i))
146 z3(i)=x(3,ix3(i))
147C
148 ix4(i)=irect(4,l)
149 x4(i)=x(1,ix4(i))
150 y4(i)=x(2,ix4(i))
151 z4(i)=x(3,ix4(i))
152 ENDDO
153
154 IF(ityp == 7)THEN
155 DO i=1,jlt
156 gapv(i) = gapv(i) + curv_max(cand_e(i))
157 END DO
158 ENDIF
159C
160 RETURN
161 END
i7cor3t
subroutine i7cor3t(jlt, x, irect, nsv, cand_e, cand_n, igap, gap, 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, gapmax, gapmin, curv_max, ityp, nin, gap_s_l, gap_m_l, intth, drad, dgapload)
Definition i7cor3t.F:40
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21