48
49
50
51 USE elbufdef_mod
54 use glob_therm_mod
55
56
57
58#include "implicit_f.inc"
59
60
61
62#include "mvsiz_p.inc"
63
64
65
66#include "param_c.inc"
67#include "com01_c.inc"
68#include "com04_c.inc"
69
70
71
72 INTEGER :: NEL,NSIGBEAM,IUSER,NFT
73 INTEGER :: IC(NIXP,*),IPART(*),IGEO(NPROPGI,*),(*)
74 INTEGER , INTENT (IN ) :: IPRELD,NPRELOAD_A
75 INTEGER , INTENT (IN ) :: (NUMELP)
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)
82
83 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
84 TYPE(PREL1D_) ,DIMENSION(NPRELOAD_A), TARGET :: PRELOAD_A
85 type (glob_therm_) ,intent(in) :: glob_therm
86
87
88
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)
94 . x1(mvsiz),x2(mvsiz),x3(mvsiz),
95 . y1(mvsiz),y2(mvsiz),y3(mvsiz),
96 . z1(mvsiz),z2(mvsiz),z3(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/
104
105 TYPE(G_BUFEL_),POINTER :: GBUF
106
107 gbuf => elbuf_str%GBUF
108 ipid = ic(5,1+nft)
109 igtyp = igeo(11,ipid)
110
111
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)
118
119 CALL peveci(gbuf%SKEW,x1,x3,y1,y3,z1,z3,x2,y2,z2,nc2,nc3,
120 . ivect,vect)
121
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
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)
147
148
149
150 ipid = ic(5,1+nft)
151 igtyp = igeo(11,ipid)
152
153 IF (isigi /= 0)
155 . igtyp ,nel ,nsigbeam ,sigbeam ,ptbeam,
156 . ic(1,nft+1),igeo )
157 IF (iuser /= 0)
159 . ic(1,nft+1),sigbeam ,nsigbeam ,ptbeam ,igeo ,
160 . nel )
161
162
163
164 DO i=1,nel
165 IF (igtyp /= 3 .AND. igtyp /= 18) THEN
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
180
181 CALL dt1lawp(pm,geo,mxt,mxg,deltax,dtx,igtyp)
182 ndepar=numels+numelc+numelt+nft
183
184 DO i=1,nel
185 dtelem(ndepar+i)=dtx(i
186 ENDDO
187
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
196
197 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)