48
49
50
51 USE elbufdef_mod
54 use glob_therm_mod
55 use element_mod , only : nixp
56
57
58
59#include "implicit_f.inc"
60
61
62
63#include "mvsiz_p.inc"
64
65
66
67#include "param_c.inc"
68#include "com01_c.inc"
69#include "com04_c.inc"
70
71
72
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)
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)
83
84 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
85 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
86 type (glob_therm_) ,intent(in) :: glob_therm
87
88
89
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)
95 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
96 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
97 . z1(mvsiz),z2(mvsiz),z3(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/
105
106 TYPE(G_BUFEL_),POINTER :: GBUF
107
108 gbuf => elbuf_str%GBUF
109 ipid = ic(5,1+nft)
110 igtyp = igeo(11,ipid)
111
112
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)
119
120 CALL peveci(gbuf%SKEW,x1,x3,y1,y3,z1,z3,x2,y2,z2,nc2,nc3,
121 . ivect,vect)
122
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
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)
148
149
150
151 ipid = ic(5,1+nft)
152 igtyp = igeo(11,ipid)
153
154 IF (isigi /= 0)
156 . igtyp ,nel ,nsigbeam ,sigbeam ,ptbeam,
157 . ic(1,nft+1),igeo )
158 IF (iuser /= 0)
160 . ic(1,nft+1),sigbeam ,nsigbeam ,ptbeam ,igeo ,
161 . nel )
162
163
164
165 DO i=1,nel
166 IF (igtyp /= 3 .AND. igtyp /= 18) THEN
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
181
182 CALL dt1lawp(pm,geo,mxt,mxg,deltax,dtx,igtyp)
183 ndepar=numels+numelc+numelt+nft
184
185 DO i=1,nel
186 dtelem(ndepar+i)=dtx(i)
187 ENDDO
188
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
197
198 RETURN
subroutine bsigini(elbuf_str, igtyp, nel, nsigbeam, sigbeam, ptbeam, ixp, igeo)
subroutine buserini(elbuf_str, ixp, sigbeam, nsigbeam, ptbeam, igeo, nel)
subroutine dt1lawp(pm, geo, mat, mxg, deltax, dtx, igtyp)
subroutine area(d1, x, x2, y, y2, eint, stif0)
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)
subroutine peveci(rloc, x1, x3, y1, y3, z1, z3, x2, y2, z2, nc2, nc3, ivect, vect)
subroutine pibuf3(geo, off, tl, deltax, mxg, irel)
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)
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)