OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i7pwr3.F File Reference
#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "units_c.inc"
#include "vect07_c.inc"
#include "scr03_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ i7pwr3()

subroutine i7pwr3 ( integer, dimension(*) itab,
integer inacti,
integer, dimension(*) cand_e,
integer, dimension(*) cand_n,
stfn,
stf,
x,
integer, dimension(*) nsv,
integer iwpene,
cand_p,
integer, dimension(*) cand_en,
integer, dimension(*) cand_nn,
integer, dimension(*) tag,
integer noint,
gapv,
integer nty,
integer itied,
fpenmax,
integer id,
character(len=nchartitle) titr,
integer iddlevel,
integer iremnode,
integer, dimension(*) kremnode,
integer, dimension(*) remnode,
integer istok,
integer, dimension(mvsiz), intent(in) ix1,
integer, dimension(mvsiz), intent(in) ix2,
integer, dimension(mvsiz), intent(in) ix3,
integer, dimension(mvsiz), intent(in) ix4,
integer, dimension(mvsiz), intent(in) nsvg,
intent(inout) x1,
intent(inout) x2,
intent(inout) x3,
intent(inout) x4,
intent(inout) y1,
intent(inout) y2,
intent(inout) y3,
intent(inout) y4,
intent(inout) z1,
intent(inout) z2,
intent(inout) z3,
intent(inout) z4,
intent(inout) xi,
intent(inout) yi,
intent(inout) zi,
intent(inout) n1,
intent(inout) n2,
intent(inout) n3,
intent(inout) pene )

Definition at line 33 of file i7pwr3.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
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
tagnod
subroutine tagnod(ix, nix, nix1, nix2, numel, iparte, tagbuf, npart)
Definition tagnod.F:29