OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7pwr3.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!|| i7pwr3 ../starter/source/interfaces/inter3d1/i7pwr3.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!||--- uses -----------------------------------------------------
30!|| format_mod ../starter/share/modules1/format_mod.F90
31!|| message_mod ../starter/share/message_module/message_mod.F
32!||====================================================================
33 SUBROUTINE i7pwr3(ITAB,INACTI,CAND_E,CAND_N,STFN,
34 1 STF ,X ,NSV ,IWPENE,CAND_P,
35 2 CAND_EN,CAND_NN,TAG,NOINT,GAPV ,
36 3 NTY ,ITIED ,FPENMAX,ID,TITR,
37 4 IDDLEVEL,IREMNODE,KREMNODE,REMNODE,ISTOK,
38 5 IX1,IX2,IX3,IX4,NSVG,
39 6 X1 ,X2 ,X3 ,X4 ,Y1 ,
40 7 Y2 ,Y3 ,Y4 ,Z1 ,Z2 ,
41 8 Z3 ,Z4 ,XI ,YI ,ZI ,
42 9 N1 ,N2 ,N3 ,PENE)
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE message_mod
47 USE names_and_titles_mod , ONLY : nchartitle
48 USE format_mod , ONLY : fmw_5i
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C G l o b a l P a r a m e t e r s
55C-----------------------------------------------
56#include "mvsiz_p.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "units_c.inc"
61#include "vect07_c.inc"
62#include "scr03_c.inc"
63#include "com04_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER ITAB(*),CAND_E(*),CAND_N(*),CAND_EN(*),CAND_NN(*),KREMNODE(*),REMNODE(*)
68 INTEGER NSV(*),TAG(*),IWPENE,INACTI,NOINT,NTY,ITIED, ISTOK
69 my_real STF(*),STFN(*),X(3,*),CAND_P(*),GAPV(*), FPENMAX
70 INTEGER ID,IDDLEVEL,IREMNODE
71 CHARACTER(LEN=NCHARTITLE) :: TITR
72 INTEGER, DIMENSION(MVSIZ), INTENT(IN) :: IX1,IX2,IX3,IX4,NSVG
73 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: X1,X2,X3,X4
74 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Y1,Y2,Y3,Y4
75 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: Z1,Z2,Z3,Z4
76 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: xi,yi,zi
77 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: n1,n2,n3
78 my_real, DIMENSION(MVSIZ), INTENT(INOUT) :: pene
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER I,JWARN,J,K,L,TAGNOD
83 my_real peneold, penmax, pene0
84 my_real dn
85C-----------------------------------------------
86C S o u r c e L i n e s
87C-----------------------------------------------
88 jwarn = 0
89 DO i=lft,llt
90 tagnod = 0
91 IF(iremnode == 3)THEN
92 k = kremnode(cand_e(i))+1
93 l = kremnode(cand_e(i)+1)
94 DO j=k,l
95 IF( remnode(j) == nsvg(i) ) tagnod = 1
96 ENDDO
97 ENDIF
98 IF(ipri>=1 .AND. pene(i)>zero .AND. tagnod == 0)THEN
99 IF(ix1(i)<=numnod) THEN
100 WRITE(iout,fmt=fmw_5i)itab(nsvg(i)),itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
101 ELSE
102 WRITE(iout,fmt=fmw_5i)nsvg(i),ix1(i),ix2(i),ix3(i),ix4(i)
103 ENDIF
104 ELSEIF(ipri>=6 .AND. tagnod == 0)THEN
105 IF(ix1(i)<=numnod) THEN
106 WRITE(iout,fmt=fmw_5i)itab(nsvg(i)),itab(ix1(i)),itab(ix2(i)),itab(ix3(i)),itab(ix4(i))
107 ELSE
108 WRITE(iout,fmt=fmw_5i)nsvg(i),ix1(i),ix2(i),ix3(i),ix4(i)
109 ENDIF
110 ENDIF
111 IF(pene(i)>zero .AND. tagnod == 0)THEN
112 tag(nsvg(i))=tag(nsvg(i))+1
113 dn=n1(i)*n1(i)+n2(i)*n2(i)+n3(i)*n3(i)
114 IF(dn<=em30) THEN
115 IF(ix1(i)<=numnod) THEN
116 WRITE(iout,1100)pene(i),itab(nsvg(i))
117 IF(nty/=24.AND.(nty/=10.OR.itied==0))THEN
118 IF(inacti/=1.AND.inacti/=2.AND.fpenmax==zero) THEN
119
120 IF (inacti==0) THEN
121 CALL ancmsg(msgid=612,
122 . msgtype=msgerror,
123 . anmode=aninfo_blind_1,
124 . i1=id,
125 . c1=titr,
126 . i2=inacti,
127 . i3=itab(nsvg(i)))
128 ELSE
129 CALL ancmsg(msgid=611,
130 . msgtype=msgerror,
131 . anmode=aninfo_blind_1,
132 . i1=id,
133 . c1=titr,
134 . i2=inacti,
135 . i3=itab(nsvg(i)))
136 ENDIF
137 ENDIF
138 END IF
139 ELSE
140 WRITE(iout,1100)pene(i),nsvg(i)
141 IF(nty/=24.AND.(nty/=10.OR.itied==0))THEN
142 IF(inacti/=1.AND.inacti/=2.AND.fpenmax==zero) THEN
143
144 IF (inacti==0) THEN
145 CALL ancmsg(msgid=612,
146 . msgtype=msgerror,
147 . anmode=aninfo_blind_1,
148 . i1=id,
149 . c1=titr,
150 . i2=inacti,
151 . i3=nsvg(i))
152 ELSE
153 CALL ancmsg(msgid=611,
154 . msgtype=msgerror,
155 . anmode=aninfo_blind_1,
156 . i1=id,
157 . c1=titr,
158 . i2=inacti,
159 . i3=nsvg(i))
160 ENDIF
161 ENDIF
162 END IF
163 ENDIF
164 ELSE
165 pene0 = pene(i)
166 pene(i) = pene(i) + em8*pene(i)
167 IF(ipri>=5) THEN
168 IF(ix1(i)<=numnod) THEN
169 CALL ancmsg(msgid=1164,
170 . msgtype=msgwarning,
171 . anmode=aninfo_blind_1,
172 . i1=itab(nsvg(i)),
173 . i2=itab(ix1(i)),
174 . i3=itab(ix2(i)),
175 . i4=itab(ix3(i)),
176 . i5=itab(ix4(i)),
177 . r1=pene0,
178 . prmod=msg_cumu)
179 ELSE
180 CALL ancmsg(msgid=1164,
181 . msgtype=msgwarning,
182 . anmode=aninfo_blind_1,
183 . i1=nsvg(i),
184 . i2=ix1(i),
185 . i3=ix2(i),
186 . i4=ix3(i),
187 . i5=ix4(i),
188 . r1=pene0,
189 . prmod=msg_cumu)
190 ENDIF
191 ENDIF
192 ENDIF
193 penmax = fpenmax*gapv(i)
194 IF(.NOT.((inacti==5.OR.inacti==6).AND.(fpenmax /= zero .AND. pene(i) > penmax)))istok=istok+1
195 IF(fpenmax /= zero .AND. pene(i) > penmax) THEN
196 !DESACTIVATION DES NOEUDS
197 WRITE(iout,'(A,1PG20.13,A)')' MAX INITIAL PENETRATION ',penmax,' IS REACHED'
198 WRITE(iout,'(A)')'NODE STIFFNESS IS SET TO ZERO'
199 stfn(cand_n(i)) = zero
200 ELSE IF(inacti==1) THEN
201 !DESACTIVATION DES NOEUDS
202 WRITE(iout,'(A)')'NODE STIFFNESS IS SET TO ZERO'
203 stfn(cand_n(i)) = zero
204 ELSE IF(inacti==2) THEN
205 !DESACTIVATION DES ELEMENTS
206 WRITE(iout,'(A)')'ELEMENT STIFFNESS IS SET TO ZERO'
207 stf(cand_e(i)) = zero
208 ELSE IF(inacti==3) THEN
209 !CHANGE LES COORDONNEES DES NOEUDS SECONDARY
210 WRITE(iout,'(A)')'NODE COORD IS CHANGED AS PROPOSED'
211 peneold = sqrt( (x(1,nsv(cand_n(i)))-xi(i))**2 +(x(2,nsv(cand_n(i)))-yi(i))**2 +(x(3,nsv(cand_n(i)))-zi(i))**2 )
212 IF(pene(i)>peneold) THEN
213 x(1,nsv(cand_n(i))) = xi(i)+pene(i)*n1(i)
214 x(2,nsv(cand_n(i))) = yi(i)+pene(i)*n2(i)
215 x(3,nsv(cand_n(i))) = zi(i)+pene(i)*n3(i)
216 ENDIF
217 ELSE IF(inacti==4) THEN
218 !CHANGE LES COORDONNEES DES NOEUDS MAIN
219 WRITE(iout,'(A)')'SEG. COORD IS CHANGED AS PROPOSED'
220 peneold = sqrt( (x(1,ix1(i))-x1(i))**2 +(x(2,ix1(i))-y1(i))**2 +(x(3,ix1(i))-z1(i))**2 )
221 IF(pene(i)>peneold) THEN
222 x(1,ix1(i)) = x1(i)-pene(i)*n1(i)
223 x(2,ix1(i)) = y1(i)-pene(i)*n2(i)
224 x(3,ix1(i)) = z1(i)-pene(i)*n3(i)
225 ENDIF
226 peneold = sqrt( (x(1,ix2(i))-x2(i))**2 +(x(2,ix2(i))-y2(i))**2 +(x(3,ix2(i))-z2(i))**2 )
227 IF(pene(i)>peneold) THEN
228 x(1,ix2(i)) = x2(i)-pene(i)*n1(i)
229 x(2,ix2(i)) = y2(i)-pene(i)*n2(i)
230 x(3,ix2(i)) = z2(i)-pene(i)*n3(i)
231 ENDIF
232 peneold = sqrt( (x(1,ix3(i))-x3(i))**2 +(x(2,ix3(i))-y3(i))**2 +(x(3,ix3(i))-z3(i))**2 )
233 IF(pene(i)>peneold) THEN
234 x(1,ix3(i)) = x3(i)-pene(i)*n1(i)
235 x(2,ix3(i)) = y3(i)-pene(i)*n2(i)
236 x(3,ix3(i)) = z3(i)-pene(i)*n3(i)
237 ENDIF
238 peneold = sqrt( (x(1,ix4(i))-x4(i))**2 +(x(2,ix4(i))-y4(i))**2 +(x(3,ix4(i))-z4(i))**2 )
239 IF(pene(i)>peneold) THEN
240 x(1,ix4(i)) = x4(i)-pene(i)*n1(i)
241 x(2,ix4(i)) = y4(i)-pene(i)*n2(i)
242 x(3,ix4(i)) = z4(i)-pene(i)*n3(i)
243 ENDIF
244 ELSE IF(inacti==5) THEN
245 !REDUCTION DU GAP
246 jwarn = 1
247 cand_p(istok) = pene(i)
248 cand_nn(istok) = cand_n(i)
249 cand_en(istok) = cand_e(i)
250 ELSE IF(inacti==6) THEN
251 !INACTI==6
252 !REDUCTION DU GAP
253 jwarn = 1
254 pene(i)=pene(i)+zep05*(gapv(i)-pene(i))
255 cand_p(istok) = pene(i)
256 cand_nn(istok) = cand_n(i)
257 cand_en(istok) = cand_e(i)
258 END IF
259 iwpene=iwpene+1
260 ENDIF
261
262 enddo!NEXT I
263
264 IF (jwarn /= 0) WRITE(iout,'(A)')'REDUCE INITIAL GAP'
265
266 1000 FORMAT(2x,'** INITIAL PENETRATION =',1pg20.13,' POSSIBLE NEW COORDINATES OF SECONDARY NODE')
267 1100 FORMAT(2x,'** INITIAL PENETRATION =',e14.7 ,' IMPOSSIBLE TO CALCULATE NEW COORDINATES OF SECONDARY NODE',i8)
268
269C-----------------------------------------------
270 RETURN
271 END
272
i7pwr3
subroutine i7pwr3(itab, inacti, cand_e, cand_n, stfn, stf, x, nsv, iwpene, cand_p, cand_en, cand_nn, tag, noint, gapv, nty, itied, fpenmax, id, titr, iddlevel, iremnode, kremnode, remnode, istok, ix1, ix2, ix3, ix4, nsvg, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, n1, n2, n3, pene)
Definition i7pwr3.F:43
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
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:889