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
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C G l o b a l P a r a m e t e r s
61C-----------------------------------------------
62#include "mvsiz_p.inc"
63C-----------------------------------------------
64C C o m m o n B l o c k s
65C-----------------------------------------------
66#include "param_c.inc"
67#include "com01_c.inc"
68#include "com04_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER :: NEL,NSIGBEAM,IUSER,NFT
73 INTEGER :: IC(NIXP,*),IPART(*),IGEO(NPROPGI,*),PTBEAM(*)
74 INTEGER , INTENT (IN ) :: IPRELD,NPRELOAD_A
75 INTEGER , INTENT (IN ) :: IBEAM_VECTOR(NUMELP)
76 my_real
77 . PM(*),X(*),GEO(NPROPG,*),
78 . DTELEM(*),STIFN(*),STIFR(*),PARTSAV(20,*),V(*),MSP(*),INP(*),
79 . stp(*),strp(*),sigbeam(nsigbeam,*),mcpp(*),
80 . temp(*)
81 my_real , INTENT (IN ) :: rbeam_vector(3,numelp)
82C
83 TYPE(elbuf_struct_), TARGET :: ELBUF_STR
84 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
85 type (glob_therm_) ,intent(in) :: glob_therm
86C-----------------------------------------------
87C L o c a l V a r i a b l e s
88C-----------------------------------------------
89 INTEGER I,IPT,IGTYP,NDEPAR,IPID,IMAT,NIP
90 INTEGER NC1(MVSIZ),NC2(MVSIZ),NC3(MVSIZ),MXT(MVSIZ),MXG(MVSIZ),
91 . irel(6,mvsiz),ivect(mvsiz)
92 my_real :: temp0
93 my_real
94 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
95 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
96 . z1(mvsiz),z2(mvsiz),z3(mvsiz),
97 . area(mvsiz) ,
98 . deltax(mvsiz),dtx(mvsiz),
99 . vect(3,mvsiz)
100 INTEGER IDMIN,IDMAX
101 DATA IDMIN /-1/,IDMAX /-1/
102 my_real :: LGTHMIN,LGTHMAX,CC1,UNDAMP
103 DATA LGTHMIN /-1/,LGTHMAX /-1/
104C
105 TYPE(G_BUFEL_),POINTER :: GBUF
106C-----------------------------------------------
107 gbuf => elbuf_str%GBUF
108 ipid = ic(5,1+nft)
109 igtyp = igeo(11,ipid)
110
111C
112 CALL pcoori(x,ic(1,nft+1),
113 . mxt,mxg ,nc1,nc2,nc3,deltax,
114 . x1,x2,x3,y1,y2,y3,z1,z2,z3,
115 . ibeam_vector(nft+1),rbeam_vector(1,nft+1),ivect,vect)
116
117 imat = mxt(1)
118c
119 CALL peveci(gbuf%SKEW,x1,x3,y1,y3,z1,z3,x2,y2,z2,nc2,nc3,
120 . ivect,vect)
121C
122 IF (glob_therm%NINTEMP > 0) THEN
123 IF (igtyp == 18) THEN
124 IF (elbuf_str%BUFLY(1)%L_TEMP > 0) THEN
125 nip = igeo(3,mxg(1))
126 DO i = 1,nel
127 temp0 = half * (temp(nc1(i)) + temp(nc2(i)))
128 DO ipt=1,nip
129 elbuf_str%BUFLY(1)%LBUF(1,1,ipt)%TEMP(i) = temp0
130 ENDDO
131 ENDDO
132 END IF
133 ELSE IF (igtyp == 3 .and. elbuf_str%GBUF%G_TEMP > 0) THEN
134 DO i = 1,nel
135 elbuf_str%GBUF%TEMP(i) = half * (temp(nc1(i)) + temp(nc2(i)))
136 ENDDO
137 END IF
138 END IF
139!
140 CALL pmass(geo,pm,
141 . stifn,stifr,partsav,v,ipart(nft+1),
142 . msp(nft+1),inp(nft+1),igeo , stp(nft+1),
143 . x1,x2, y1,y2, z1,z2,
144 . nc1,nc2,imat,mxg,area,deltax,strp(nft+1),
145 . mcpp(nft+1) , temp ,glob_therm%NINTEMP)
146 CALL pibuf3(geo,gbuf%OFF,gbuf%LENGTH,deltax,mxg,irel)
147C------------------------------------------
148C Beam initialization
149C------------------------------------------
150 ipid = ic(5,1+nft)
151 igtyp = igeo(11,ipid)
152C
153 IF (isigi /= 0)
154 . CALL bsigini(elbuf_str,
155 . igtyp ,nel ,nsigbeam ,sigbeam ,ptbeam,
156 . ic(1,nft+1),igeo )
157 IF (iuser /= 0)
158 . CALL buserini(elbuf_str,
159 . ic(1,nft+1),sigbeam ,nsigbeam ,ptbeam ,igeo ,
160 . nel )
161C------------------------------------------
162C Compute beam element time step
163C------------------------------------------
164 DO i=1,nel
165 IF (igtyp /= 3 .AND. igtyp /= 18) THEN
166 CALL ancmsg(msgid=225,
167 . msgtype=msgerror,
168 . anmode=aninfo_blind_1,
169 . i1=igtyp)
170 ENDIF
171 IF (lgthmin == -1 .OR. deltax(i) < lgthmin) THEN
172 lgthmin = deltax(i)
173 idmin = ic(5,i+nft)
174 ENDIF
175 IF (lgthmax == -1 .OR. deltax(i) > lgthmax) THEN
176 lgthmax = deltax(i)
177 idmax = ic(5,i+nft)
178 ENDIF
179 ENDDO
180C-----------
181 CALL dt1lawp(pm,geo,mxt,mxg,deltax,dtx,igtyp)
182 ndepar=numels+numelc+numelt+nft
183C-----------
184 DO i=1,nel
185 dtelem(ndepar+i)=dtx(i)
186 ENDDO
187!--- /PRELOAD/AXIAL
188 IF (ipreld>0) THEN
189 cc1 =two*sqrt(two)
190 DO i=1,nel
191 undamp = cc1*msp(nft+i)*gbuf%LENGTH(i)/dtx(i)
192 gbuf%BPRELD(i) = preload_a(ipreld)%preload
193 gbuf%BPRELD(i+nel) = undamp*preload_a(ipreld)%damp
194 ENDDO
195 END IF
196C-----------
197 RETURN
198 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
initia
subroutine initia(iparg, elbuf, ms, in, v, x, ixs, ixq, ixc, ixt, ixp, ixr, detonators, geo, pm, rby, npby, lpby, npc, npts, pld, veul, ale_connectivity, skew, fill, ipart, itab, sensors, skvol, ixtg, thk, nloc_dmg, group_param_tab, glob_therm, igrnod, igrsurf, bufsf, vr, bufmat, xlas, las, dtelem, mss, msq, msc, mst, msp, msr, mstg, ptg, inc, nod2eltg, knod2eltg, inp, inr, intg, index, itri, kxx, ixx, xelemwa, iwa, nod2elq, knod2elq, nod2els, knod2els, kxsp, ixsp, nod2sp, ispcond, icode, iskew, iskn, ispsym, xframe, isptag, spbuf, mssx, nsigi, npbyl, lpbyl, rbyl, msnf, mssf, nsigsh, igeo, ipm, nsigs, nsigsph, vns, vnsx, stc, stt, stp, str, sttg, stur, bns, bnsx, volnod, bvolnod, etnod, nshnod, stifint, fxbdep, fxbvit, fxbacc, fxbipm, fxbrpm, fxbelm, fxbsig, fxbmod, ins, ptshel, ptsh3n, ptsol, ptquad, wma, ptsph, fxbnod, mbufel, mdepl, fxani, numel, nsigrs, sh4tree, sh3tree, mcp, temp, imerge2, iadmerge2, slnrbm, nslnrbm, rmstifn, rmstifr, ms_layer, zi_layer, itag, itagel, mcpc, mcptg, xrefc, xreftg, xrefs, mssa, msrt, irbe2, lrbe2, inivol, kvol, nbsubmat, ixs10, ixs16, ixs20, totaddmas, ipmas, stifn, msz2, itagn, sitage, itage, ixr_kj, elbuf_tab, nom_opt, ptr_nopt_rbe2, ptr_nopt_adm, ptr_nopt_fun, sol2sph, irst, sh3trim, xfem_tab, kxig3d, ixig3d, msig3d, knot, nctrlmax, wige, stack, rnoise, drape, sh4ang, sh3ang, geo_stack, igeo_stack, stifintr, strc, strp, strr, strtg, perturb, itagnd, nativ_sms, iloadp, facload, ptspri, nsigbeam, ptbeam, nsigtruss, pttruss, multi_fvm, sigi, sigsh, sigsp, sigsph, sigrs, sigbeam, sigtruss, strsglob, straglob, orthoglob, isigsh, iyldini, ksigsh3, fail_ini, iusolyld, iuser, iddlevel, inimap1d, inimap2d, func2d, fvm_inivel, tagprt_sms, igrbric, igrquad, igrsh4n, igrsh3n, igrpart, totmas, knotlocpc, knotlocel, vnige, bnige, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxb_matrix, fxb_matrix_add, fxb_last_adress, ptr_nopt_fxb, r_skew, knod2el1d, nod2el1d, ebcs_tab, rby_iniaxis, alea, knod2elc, nod2elc, dr, slrbody, drapeg, ipari, intbuf_tab, interfaces, mat_param, npreload_a, preload_a, fail_fractal, fail_brokmann, defaults, ndamp_freq_range, dampr, ibeam_vector, rbeam_vector, ikine)
Definition initia.F:188
bpreload_mod
Definition bpreload_mod.F:40
message_mod
Definition message_mod.F:1249
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:889
starter
program starter
Definition starter.F:39