OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i11pwr3.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!|| i11pwr3 ../starter/source/interfaces/inter3d1/i11pwr3.F
25!||--- called by ------------------------------------------------------
26!|| inint3 ../starter/source/interfaces/inter3d1/inint3.F
27!||--- uses -----------------------------------------------------
28!|| format_mod ../starter/share/modules1/format_mod.F90
29!||====================================================================
30 SUBROUTINE i11pwr3(ITAB ,INACTI,CAND_M,CAND_S,
31 2 STFS ,STFM ,X ,NSV ,IWPENE,
32 3 N1 ,N2 ,M1 ,M2 ,NX ,
33 4 NY ,NZ ,GAPV ,GAP_S ,GAP_M ,
34 5 PENIS ,PENIM ,IGAP ,PRINT_WARNING)
35C-----------------------------------------------
36C M o d u l e s
37C-----------------------------------------------
38 USE format_mod , ONLY : fmw_4i, fmw_i_3f
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C G l o b a l P a r a m e t e r s
45C-----------------------------------------------
46#include "mvsiz_p.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 INTEGER ITAB(*),CAND_M(*),CAND_S(*),INACTI,IGAP, N1(*) ,N2(*) ,M1(*) ,M2(*)
51 INTEGER NSV(*),IWPENE
52 LOGICAL PRINT_WARNING
53 my_real STFS(*),STFM(*),X(3,*),GAP_S(*) ,GAP_M(*),PENIS(2,*), PENIM(2,*),NX(MVSIZ), NY(MVSIZ), NZ(MVSIZ),GAPV(*)
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "units_c.inc"
58#include "vect07_c.inc"
59#include "scr03_c.inc"
60C-----------------------------------------------
61C L o c a l V a r i a b l e s
62C-----------------------------------------------
63 INTEGER I, IS, IM,JWARN
64 my_real PENE(MVSIZ), PENEOLD, S2, D, PPLUS
65C-----------------------------------------------
66C
67 jwarn = 0
68 DO i=1,llt
69 s2 = sqrt(nx(i)**2 + ny(i)**2 + nz(i)**2)
70 gapv(i) = sqrt(gapv(i))
71 pene(i) = gapv(i) - s2
72 s2 = 1./max(em30,s2)
73 nx(i) = nx(i)*s2
74 ny(i) = ny(i)*s2
75 nz(i) = nz(i)*s2
76 ENDDO
77C
78 DO 100 i=lft,llt
79 IF(ipri>=1)THEN
80 WRITE(iout,fmt=fmw_4i)
81 2 itab(n1(i)),itab(n2(i)),itab(m1(i)),itab(m2(i))
82 ENDIF
83 IF(pene(i)>zero)THEN
84 IF(ipri>=5)THEN
85 WRITE(iout,1000)pene(i)
86 WRITE(iout,fmt=fmw_i_3f)itab(n1(i)),
87 . x(1,n1(i))+pene(i)*nx(i),
88 . x(2,n1(i))+pene(i)*ny(i),
89 . x(3,n1(i))+pene(i)*nz(i)
90 WRITE(iout,fmt=fmw_i_3f)itab(n2(i)),
91 . x(1,n2(i))+pene(i)*nx(i),
92 . x(2,n2(i))+pene(i)*ny(i),
93 . x(3,n2(i))+pene(i)*nz(i)
94 ENDIF
95C
96 IF(inacti/=6)THEN
97 pene(i) = pene(i) + em8*pene(i)
98 IF(inacti==1) THEN
99C DESACTIVATION DES NOEUDS
100 WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
101 stfs(cand_s(i)) = zero
102 ELSE IF(inacti==2) THEN
103C DESACTIVATION DES ELEMENTS
104 WRITE(iout,'(A)')'MAIN STIFFNESS IS SET TO ZERO'
105 stfm(cand_m(i)) = zero
106 ELSE IF(inacti==5) THEN
107C REDUCTION DU GAP
108 IF(pene(i)>=gapv(i)*zep995)THEN
109 WRITE(iout,'(A)')' *** PENETRATION > GAP - 0.5% !! '
110 WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
111 pene(i)=gapv(i)
112 stfs(cand_s(i)) =zero
113 ELSE
114 jwarn = 1
115 is=cand_s(i)
116 im=cand_m(i)
117 penis(2,is)=max(penis(2,is),half*pene(i))
118 penim(2,im)=max(penim(2,im),half*pene(i))
119 penis(1,is)=penis(2,is)
120 penim(1,im)=penim(2,im)
121 ENDIF
122 ENDIF
123C
124 ELSE
125C INACTI==6
126 IF(pene(i)>=gapv(i)*zep995)THEN
127 WRITE(iout,'(A)')' *** PENETRATION > GAP - 0.5% !! '
128 WRITE(iout,'(A)')'SECONDARY STIFFNESS IS SET TO ZERO'
129 pene(i)=gapv(i)
130 stfs(cand_s(i)) = zero
131 ELSE
132 jwarn = 1
133 is=cand_s(i)
134 im=cand_m(i)
135 pplus=half*(pene(i)+zep05*(gapv(i)-pene(i)))
136 penis(2,is)=max(penis(2,is),pplus)
137 penim(2,im)=max(penim(2,im),pplus)
138 penis(1,is)=penis(2,is)
139 penim(1,im)=penim(2,im)
140 ENDIF
141 END IF
142C
143 iwpene=iwpene+1
144 ENDIF
145 100 CONTINUE
146 IF (jwarn==1 .AND. print_warning ) THEN
147 WRITE(iout,'(A)')'REDUCE INITIAL GAP'
148 print_warning = .false.
149 ENDIF
150C
151 1000 FORMAT(2x,'** initial penetration =',1PG20.13,
152 . ' possible new coordinates of secondary nodes')
153 RETURN
154 END
i11pwr3
subroutine i11pwr3(itab, inacti, cand_m, cand_s, stfs, stfm, x, nsv, iwpene, n1, n2, m1, m2, nx, ny, nz, gapv, gap_s, gap_m, penis, penim, igap, print_warning)
Definition i11pwr3.F:35
max
#define max(a, b)
Definition macros.h:21