OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
pinit3.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!|| pinit3 ../starter/source/elements/beam/pinit3.F
25!||--- called by ------------------------------------------------------
26!|| initia ../starter/source/elements/initia/initia.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| bsigini ../starter/source/elements/beam/bsigini.F
30!|| buserini ../starter/source/elements/beam/buserini.F
31!|| dt1lawp ../starter/source/elements/beam/dt1lawp.F
32!|| pcoori ../starter/source/elements/beam/pcoori.F
33!|| peveci ../starter/source/elements/beam/peveci.F
34!|| pibuf3 ../starter/source/elements/beam/pibuf3.F
35!|| pmass ../starter/source/elements/beam/pmass.F
36!||--- uses -----------------------------------------------------
37!|| bpreload_mod ../starter/share/modules1/bpreload_mod.F
38!|| message_mod ../starter/share/message_module/message_mod.F
39!||====================================================================
40 SUBROUTINE pinit3(ELBUF_STR,
41 1 STP ,IC ,PM ,X ,GEO ,
42 2 DTELEM ,NFT ,NEL ,
43 3 STIFN ,STIFR ,PARTSAV ,V ,IPART ,
44 4 MSP ,INP ,IGEO ,STRP ,
45 5 NSIGBEAM ,SIGBEAM ,PTBEAM ,IUSER ,
46 6 MCPP ,TEMP ,PRELOAD_A,IPRELD,NPRELOAD_A,
47 7 GLOB_THERM,IBEAM_VECTOR,RBEAM_VECTOR)
48C-----------------------------------------------
49C M o d u l e s
50C-----------------------------------------------
51 USE elbufdef_mod
52 USE message_mod
53 USE bpreload_mod
54 use glob_therm_mod
55 use element_mod , only : nixp
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C G l o b a l P a r a m e t e r s
62C-----------------------------------------------
63#include "mvsiz_p.inc"
64C-----------------------------------------------
65C C o m m o n B l o c k s
66C-----------------------------------------------
67#include "param_c.inc"
68#include "com01_c.inc"
69#include "com04_c.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 INTEGER :: NEL,NSIGBEAM,IUSER,NFT
74 INTEGER :: IC(NIXP,*),IPART(*),IGEO(NPROPGI,*),PTBEAM(*)
75 INTEGER , INTENT (IN ) :: IPRELD,NPRELOAD_A
76 INTEGER , INTENT (IN ) :: IBEAM_VECTOR(NUMELP)
77 my_real
78 . PM(*),X(*),GEO(NPROPG,*),
79 . DTELEM(*),STIFN(*),STIFR(*),PARTSAV(20,*),V(*),MSP(*),INP(*),
80 . stp(*),strp(*),sigbeam(nsigbeam,*),mcpp(*),
81 . temp(*)
82 my_real , INTENT (IN ) :: rbeam_vector(3,numelp)
83C
84 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
85 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
86 type (glob_therm_) ,intent(in) :: glob_therm
87C-----------------------------------------------
88C L o c a l V a r i a b l e s
89C-----------------------------------------------
90 INTEGER I,IPT,IGTYP,NDEPAR,IPID,IMAT,NIP
91 INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),MXT(MVSIZ),MXG(MVSIZ),
92 . irel(6,mvsiz),ivect(mvsiz)
93 my_real :: temp0
94 my_real
95 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
96 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
97 . z1(mvsiz),z2(mvsiz),z3(mvsiz),
98 . area(mvsiz) ,
99 . deltax(mvsiz),dtx(mvsiz),
100 . vect(3,mvsiz)
101 INTEGER IDMIN,IDMAX
102 DATA IDMIN /-1/,IDMAX /-1/
103 my_real :: LGTHMIN,LGTHMAX,CC1,UNDAMP
104 DATA LGTHMIN /-1/,LGTHMAX /-1/
105C
106 TYPE(G_BUFEL_),POINTER :: GBUF
107C-----------------------------------------------
108 gbuf => elbuf_str%GBUF
109 ipid = ic(5,1+nft)
110 igtyp = igeo(11,ipid)
111
112C
113 CALL pcoori(x,ic(1,nft+1),
114 . mxt,mxg ,nc1,nc2,nc3,deltax,
115 . x1,x2,x3,y1,y2,y3,z1,z2,z3,
116 . ibeam_vector(nft+1),rbeam_vector(1,nft+1),ivect,vect)
117
118 imat = mxt(1)
119c
120 CALL peveci(gbuf%SKEW,x1,x3,y1,y3,z1,z3,x2,y2,z2,nc2,nc3,
121 . ivect,vect)
122C
123 IF (glob_therm%NINTEMP > 0) THEN
124 IF (igtyp == 18) THEN
125 IF (elbuf_str%BUFLY(1)%L_TEMP > 0) THEN
126 nip = igeo(3,mxg(1))
127 DO i = 1,nel
128 temp0 = half * (temp(nc1(i)) + temp(nc2(i)))
129 DO ipt=1,nip
130 elbuf_str%BUFLY(1)%LBUF(1,1,ipt)%TEMP(i) = temp0
131 ENDDO
132 ENDDO
133 END IF
134 ELSE IF (igtyp == 3 .and. elbuf_str%GBUF%G_TEMP > 0) THEN
135 DO i = 1,nel
136 elbuf_str%GBUF%TEMP(i) = half * (temp(nc1(i)) + temp(nc2(i)))
137 ENDDO
138 END IF
139 END IF
140!
141 CALL pmass(geo,pm,
142 . stifn,stifr,partsav,v,ipart(nft+1),
143 . msp(nft+1),inp(nft+1),igeo , stp(nft+1),
144 . x1,x2, y1,y2, z1,z2,
145 . nc1,nc2,imat,mxg,area,deltax,strp(nft+1),
146 . mcpp(nft+1) , temp ,glob_therm%NINTEMP)
147 CALL pibuf3(geo,gbuf%OFF,gbuf%LENGTH,deltax,mxg,irel)
148C------------------------------------------
149C Beam initialization
150C------------------------------------------
151 ipid = ic(5,1+nft)
152 igtyp = igeo(11,ipid)
153C
154 IF (isigi /= 0)
155 . CALL bsigini(elbuf_str,
156 . igtyp ,nel ,nsigbeam ,sigbeam ,ptbeam,
157 . ic(1,nft+1),igeo )
158 IF (iuser /= 0)
159 . CALL buserini(elbuf_str,
160 . ic(1,nft+1),sigbeam ,nsigbeam ,ptbeam ,igeo ,
161 . nel )
162C------------------------------------------
163C Compute beam element time step
164C------------------------------------------
165 DO i=1,nel
166 IF (igtyp /= 3 .AND. igtyp /= 18) THEN
167 CALL ancmsg(msgid=225,
168 . msgtype=msgerror,
169 . anmode=aninfo_blind_1,
170 . i1=igtyp)
171 ENDIF
172 IF (lgthmin == -1 .OR. deltax(i) < lgthmin) THEN
173 lgthmin = deltax(i)
174 idmin = ic(5,i+nft)
175 ENDIF
176 IF (lgthmax == -1 .OR. deltax(i) > lgthmax) THEN
177 lgthmax = deltax(i)
178 idmax = ic(5,i+nft)
179 ENDIF
180 ENDDO
181C-----------
182 CALL dt1lawp(pm,geo,mxt,mxg,deltax,dtx,igtyp)
183 ndepar=numels+numelc+numelt+nft
184C-----------
185 DO i=1,nel
186 dtelem(ndepar+i)=dtx(i)
187 ENDDO
188!--- /PRELOAD/AXIAL
189 IF (ipreld>0) THEN
190 cc1 =two*sqrt(two)
191 DO i=1,nel
192 undamp = cc1*msp(nft+i)*gbuf%LENGTH(i)/dtx(i)
193 gbuf%BPRELD(i) = preload_a(ipreld)%preload
194 gbuf%BPRELD(i+nel) = undamp*preload_a(ipreld)%damp
195 ENDDO
196 END IF
197C-----------
198 RETURN
199 END
bsigini
subroutine bsigini(elbuf_str, igtyp, nel, nsigbeam, sigbeam, ptbeam, ixp, igeo)
Definition bsigini.F:36
buserini
subroutine buserini(elbuf_str, ixp, sigbeam, nsigbeam, ptbeam, igeo, nel)
Definition buserini.F:36
dt1lawp
subroutine dt1lawp(pm, geo, mat, mxg, deltax, dtx, igtyp)
Definition dt1lawp.F:29
area
subroutine area(d1, x, x2, y, y2, eint, stif0)
Definition hm_read_prop32.F:567
bpreload_mod
Definition bpreload_mod.F:40
message_mod
Definition message_mod.F:1257
pcoori
subroutine pcoori(x, ncp, mxt, mxg, nc1, nc2, nc3, deltax, x1, x2, x3, y1, y2, y3, z1, z2, z3, ibeam_vector, rbeam_vector, ivect, vect)
Definition pcoori.F:37
peveci
subroutine peveci(rloc, x1, x3, y1, y3, z1, z3, x2, y2, z2, nc2, nc3, ivect, vect)
Definition peveci.F:30
pibuf3
subroutine pibuf3(geo, off, tl, deltax, mxg, irel)
Definition pibuf3.F:29
pinit3
subroutine pinit3(elbuf_str, stp, ic, pm, x, geo, dtelem, nft, nel, stifn, stifr, partsav, v, ipart, msp, inp, igeo, strp, nsigbeam, sigbeam, ptbeam, iuser, mcpp, temp, preload_a, ipreld, npreload_a, glob_therm, ibeam_vector, rbeam_vector)
Definition pinit3.F:48
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
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:895