OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pmass.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!|| pmass ../starter/source/elements/beam/pmass.F
25!||--- called by ------------------------------------------------------
26!|| inivoid ../starter/source/elements/initia/inivoid.F
27!|| pinit3 ../starter/source/elements/beam/pinit3.F
28!||====================================================================
29 SUBROUTINE pmass(GEO ,PM ,
30 . STIFN ,STIFR ,PARTSAV ,V ,IPART ,
31 . MSP ,INP ,IGEO ,STP ,
32 . X1,X2,Y1,Y2,Z1,Z2,
33 . NC1,NC2,IMAT,MXG,AREA,AL,STRP ,
34 . MCPP ,TEMP ,NINTEMP)
35C----------------------------------------------
36C INITIALISATION DES MASSES NODALES
37C----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C G l o b a l P a r a m e t e r s
43C-----------------------------------------------
44#include "mvsiz_p.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "param_c.inc"
49#include "vect01_c.inc"
50#include "scr12_c.inc"
51#include "com04_c.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER IPART(*),IGEO(NPROPGI,*),
56 . NC1(MVSIZ), NC2(MVSIZ), IMAT, MXG(MVSIZ)
57 INTEGER, INTENT(IN) :: NINTEMP
58 my_real
59 . GEO(NPROPG,*), PM(NPROPM,*),
60 . stifn(*),stifr(*),v(3,*),partsav(20,*),msp(*),inp(*),
61 . stp(*),
62 . x1(mvsiz), x2(mvsiz),
63 . y1(mvsiz), y2(mvsiz),
64 . z1(mvsiz), z2(mvsiz), area(mvsiz), al(mvsiz), strp(*),
65 . mcpp(*),temp(*)
66C-----------------------------------------------
67C L o c a l V a r i a b l e s
68C-----------------------------------------------
69 INTEGER I,IP,I1,I2,J,K,IPY,IPZ,IPA,IGTYP,NIP
70 my_real
71 . XX,YY,ZZ,XY,YZ,ZX,
72 . STI, E, G, AA, BB, DX,DY,DZ, ARI,INI,RYI,RZI,
73 . STIR, PHI, SHF, DSH, DMP, SL2I, FAC,LL,TEMP0
74 my_real
75 . rho(mvsiz), ems(mvsiz),coefi(mvsiz),
76 . tin(mvsiz), tixx(mvsiz), tiyy(mvsiz), tizz(mvsiz),rhocp(mvsiz)
77 my_real
78 . facdt(mvsiz), phii(mvsiz),kphi(mvsiz),cst,phmax,phmin,fsh(mvsiz)
79C=======================================================================
80 ipy = 200
81 ipz = 300
82 ipa = 400
83 igtyp = 0
84 temp0 = pm(79,imat)
85 DO i=lft,llt
86 igtyp = nint(geo(12,mxg(i)))
87 IF (igtyp == 18) THEN
88 rho(i) = pm(89,imat)
89 area(i)= zero
90 tiyy(i)= zero
91 tizz(i)= zero
92 nip = igeo(3,mxg(i))
93 DO j=1,nip
94 ari = geo(ipa+j,mxg(i))
95 ini = ari*ari*one_over_12
96 ryi = geo(ipy+j,mxg(i))
97 rzi = geo(ipz+j,mxg(i))
98 area(i) = area(i) + ari
99 tiyy(i) = tiyy(i) + ini + ari * ryi*ryi
100 tizz(i) = tizz(i) + ini + ari * rzi*rzi
101 ENDDO
102 tixx(i) = tiyy(i) + tizz(i)
103 geo( 1,mxg(i)) = area(i)
104 geo( 4,mxg(i)) = tixx(i)
105 geo( 2,mxg(i)) = tiyy(i)
106 geo(18,mxg(i)) = tizz(i)
107 ELSE
108 area(i)=geo(1,mxg(i))
109 tixx(i)=geo(4,mxg(i))
110 tiyy(i)=geo(2,mxg(i))
111 tizz(i)=geo(18,mxg(i))
112 rho(i) =pm(89,imat)
113 ENDIF
114 ENDDO
115C----------------------------------------------
116C for dt
117C----------------------------------------------
118 DO i=lft,llt
119 e = pm(20,imat)
120 g = pm(22,imat)
121 cst = six_over_5*e/g
122 bb = max(tiyy(i),tizz(i),em30)
123 sl2i= area(i)*al(i)**2 /bb
124 facdt(i) = one_over_12*sl2i
125 phmax = cst/facdt(i)
126 phmin = min(tiyy(i),tizz(i))*phmax/bb
127 kphi(i) = (four+phmin)/(one+phmin)
128 phii(i) = kphi(i)/(one+facdt(i))
129 phii(i) = max(one,phii(i))
130 fsh(i) = al(i)/(facdt(i)+cst)
131 fsh(i) = max(one,fsh(i))
132 coefi(i) =one_over_12
133 ENDDO
134 IF (igtyp == 18) THEN
135 DO i=lft,llt
136 fsh(i) = one
137 kphi(i) = max(one,twelve*facdt(i))
138 IF (kphi(i) > twelve ) coefi(i) =one
139 ENDDO
140 END IF
141C----------------------------------------------
142C MASSE ELEMENT /2
143C----------------------------------------------
144 DO i=lft,llt
145 ll = onep2*al(i)
146 ems(i)=rho(i)*al(i)*area(i)* half
147 tin(i)=onep2*ems(i)*ll**2*coefi(i) + rho(i)*(al(i)*half)
148 . * max(tiyy(i),tizz(i))
149 IF (facdt(i)<one) tin(i)=phii(i)*tin(i)
150 tin(i)= max(tin(i),rho(i)*al(i)/two*tixx(i))
151 ENDDO
152 IF( jthe > 0 ) THEN
153 DO i=lft,llt
154 rhocp(i) = pm(69,imat)
155 mcpp(i) = rhocp(i)*al(i)*area(i)* half
156 ENDDO
157 ENDIF
158C----------------------------------------------
159C INITIALISATION DES MASSES NODALES + RHOCP
160C----------------------------------------------
161 DO i=lft,llt
162 msp(i) = ems(i)
163 ENDDO
164C----------------------------------------------
165C INERTIES SPHERIQUES
166C----------------------------------------------
167 DO i=lft,llt
168 inp(i) = tin(i)
169 ENDDO
170C----------------------------------------------
171C INITIALISATION DES RIGIDITES NODALES POUR INTERFACES
172C----------------------------------------------
173 IF(i7stifs/=0)THEN
174 DO i=lft,llt
175 e = pm(20,imat)
176 sti = e * area(i) / al(i)
177 stp(i) = sti
178 ENDDO
179 ENDIF
180C----------------------------------------------
181C INITIALISATION DES RIGIDITES NODALES
182C----------------------------------------------
183 DO i=lft,llt
184 e = pm(20,imat)
185 g = pm(22,imat)
186C
187 dmp =max(geo(16,mxg(i)),geo(17,mxg(i)))
188 dmp =dmp*sqrt(two)
189 aa =(sqrt(one +dmp*dmp)-dmp)
190 aa = al(i) * aa * aa
191 bb = max(tiyy(i),tizz(i))
192 stir = max(g*tixx(i),kphi(i)*e*bb) / aa
193 sti = fsh(i)*area(i) * e / aa
194C
195 stifn(nc1(i))=stifn(nc1(i))+sti
196 stifn(nc2(i))=stifn(nc2(i))+sti
197 stifr(nc1(i))=stifr(nc1(i))+stir
198 stifr(nc2(i))=stifr(nc2(i))+stir
199 strp(i)=stir
200 ENDDO
201C
202 DO i=lft,llt
203 i1 = nc1(i)
204 i2 = nc2(i)
205C
206 ip=ipart(i)
207 partsav(1,ip)=partsav(1,ip) + two*ems(i)
208 partsav(2,ip)=partsav(2,ip) + ems(i)*(x1(i)+x2(i))
209 partsav(3,ip)=partsav(3,ip) + ems(i)*(y1(i)+y2(i))
210 partsav(4,ip)=partsav(4,ip) + ems(i)*(z1(i)+z2(i))
211 xx = (x1(i)*x1(i)+x2(i)*x2(i))
212 xy = (x1(i)*y1(i)+x2(i)*y2(i))
213 yy = (y1(i)*y1(i)+y2(i)*y2(i))
214 yz = (y1(i)*z1(i)+y2(i)*z2(i))
215 zz = (z1(i)*z1(i)+z2(i)*z2(i))
216 zx = (z1(i)*x1(i)+z2(i)*x2(i))
217 partsav(5,ip) =partsav(5,ip) + two*tin(i) + ems(i) * (yy+zz)
218 partsav(6,ip) =partsav(6,ip) + two*tin(i) + ems(i) * (zz+xx)
219 partsav(7,ip) =partsav(7,ip) + two*tin(i) + ems(i) * (xx+yy)
220 partsav(8,ip) =partsav(8,ip) - ems(i) * xy
221 partsav(9,ip) =partsav(9,ip) - ems(i) * yz
222 partsav(10,ip)=partsav(10,ip) - ems(i) * zx
223C
224 partsav(11,ip)=partsav(11,ip) + ems(i)*(v(1,i1)+v(1,i2))
225 partsav(12,ip)=partsav(12,ip) + ems(i)*(v(2,i1)+v(2,i2))
226 partsav(13,ip)=partsav(13,ip) + ems(i)*(v(3,i1)+v(3,i2))
227 partsav(14,ip)=partsav(14,ip) + half * ems(i) *
228 . (v(1,i1)*v(1,i1)+v(2,i1)*v(2,i1)+v(3,i1)*v(3,i1)
229 . +v(1,i2)*v(1,i2)+v(2,i2)*v(2,i2)+v(3,i2)*v(3,i2))
230 ENDDO
231 IF (jthe > 0) THEN
232 IF (nintemp > 0 ) THEN
233 DO i= lft,llt
234 IF(temp(nc1(i))== zero) temp(nc1(i)) = temp0
235 IF(temp(nc2(i))== zero) temp(nc2(i)) = temp0
236 ENDDO
237 ELSE
238 DO i=lft,llt
239 temp(nc1(i)) = pm(79,imat)
240 temp(nc2(i)) = pm(79,imat)
241 ENDDO
242 ENDIF
243 ENDIF
244C-----------
245 RETURN
246 END
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
pmass
subroutine pmass(geo, pm, stifn, stifr, partsav, v, ipart, msp, inp, igeo, stp, x1, x2, y1, y2, z1, z2, nc1, nc2, imat, mxg, area, al, strp, mcpp, temp, nintemp)
Definition pmass.F:35