46
47
48
49 USE elbufdef_mod
52
53
54
55#include "implicit_f.inc"
56
57
58
59#include "param_c.inc"
60#include "com04_c.inc"
61#include "units_c.inc"
62#include "scr17_c.inc"
63#include "scr23_c.inc"
64
65
66
67 INTEGER KXX(NIXX,*), IXX(*), IPARTX(*),ITAB(*),
68 . NEL, UIX(*),IGEO(NPROPGI,*), NFT
69
70 TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
71
73 . x(3,*), v(*), vr(*), xmas(*), xin(*),
74 . skew(lskew,*), dtelem(*),stifn(*),stifr(*),partsav(20,*),
75 . geo(npropg,*),xusr(3,*), vusr(3,*),vrusr(3,*),
76 . umass(*) ,uiner(*) ,ustifm(*) ,ustifr(*) ,uvism(*) ,uvisr(*)
77
78
79
80 INTEGER I, J, IGTYP, NDEPAR, I1,
81 . NUVAR, NUVARN, NUPARAM, IADBUF, NFUNC, IADFUN,
82 . NMAT,IADMAT,NJPID,IADPID,
83 . IADNOD, IMAT, IPROP, NX, K, UID,
84 . NAX1D, NAX2D, NAX3D,IPID1,KVAR,KVARN
85 INTEGER ID
86 CHARACTER(LEN=NCHARTITLE)::TITR
87
89 . dt, dtc, xk, xc, xkr, xcr, xm, xine, a,
90 . dte, massele
91
92 TYPE(G_BUFEL_),POINTER :: GBUF
93
94 gbuf => elbuf_str%GBUF
95
96 ndepar=numelc+numels+numelt+numelq+numelp+numelr+numeltg
97 . +nft
98
99 ipid1=kxx(2,nft+1)
101 CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
102 DO i=1,nel
103 j=i+nft
104
105 imat =kxx(1,j)
106 iprop=kxx(2,j)
107 nx =kxx(3,j)
108
109 igtyp = nint(geo(12,iprop))
110 nuvar = nint(geo(25,iprop))
111 nuvarn= nint(geo(35,iprop))
112
113 kvar = nuvar*(i-1)+1
114 kvarn = nuvarn*nx*(i-1)+1
115
117 2 gbuf%OFF(i) ,kxx(1,j),ixx ,itab ,nx ,
118 3 uid ,uix ,xusr ,vusr ,vrusr )
119
120 nuparam = nint(geo(26,iprop))
121 iadbuf = nint(geo(27,iprop))
122
123 IF (igtyp == 28) THEN
124 CALL xini28 (nx ,nax1d ,nax2d ,nax3d ,
125 1 xusr ,vusr ,vrusr ,
126 3 iout ,iprop ,imat ,
127 4 uix ,uid ,umass ,
128 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
129 6 gbuf%VAR(kvar),nuvar ,gbuf%VARN(kvarn),nuvarn ,dte )
130 ELSEIF (igtyp == 29) THEN
131 dte=ep20
132 DO k=1,nx
133 umass(k)=zero
134 uiner(k)=zero
135 ustifm(k)=zero
136 ustifr(k)=zero
137 uvism(k)=zero
138 uvisr(k)=zero
139 ENDDO
140 nax1d=0
141 nax2d=0
142 nax3d=0
143 CALL xini29 (nx ,nax1d ,nax2d ,nax3d ,
144 1 xusr ,vusr ,vrusr ,
145 3 iout ,iprop ,imat ,
146 4 uix ,uid ,umass ,
147 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
148 6 gbuf%VAR(kvar),nuvar ,gbuf%VARN(kvarn) ,nuvarn ,dte )
149 ELSEIF (igtyp == 30) THEN
150 dte=ep20
151 DO k=1,nx
152 umass(k)=zero
153 uiner(k)=zero
154 ustifm(k)=zero
155 ustifr(k)=zero
156 uvism(k)=zero
157 uvisr(k)=zero
158 ENDDO
159 nax1d=0
160 nax2d=0
161 nax3d=0
162 CALL xini30 (nx ,nax1d ,nax2d ,nax3d ,
163 1 xusr ,vusr ,vrusr ,
164 3 iout ,iprop ,imat ,
165 4 uix ,uid ,umass ,
166 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
167 6 gbuf%VAR(kvar) ,nuvar ,gbuf%VARN(kvarn) ,nuvarn ,dte )
168 ELSEIF (igtyp == 31) THEN
169 dte=ep20
170 DO k=1,nx
171 umass(k)=zero
172 uiner(k)=zero
173 ustifm(k)=zero
174 ustifr(k)=zero
175 uvism(k)=zero
176 uvisr(k)=zero
177 ENDDO
178 nax1d=0
179 nax2d=0
180 nax3d=0
181 CALL xini31 (nx ,nax1d ,nax2d ,nax3d ,
182 1 xusr ,vusr ,vrusr ,
183 3 iout ,iprop ,imat ,
184 4 uix ,uid ,umass ,
185 5 uiner ,ustifm ,ustifr ,uvism ,uvisr ,
186 6 gbuf%VAR(kvar) ,nuvar ,gbuf%VARN(kvarn) ,nuvarn ,dte )
187 ELSE
189 . msgtype=msgerror,
190 . anmode=aninfo_blind_1,
191 . i1=kxx(5,k),
192 . c1='PROPERTY',
193 . i2=igeo(1,iprop),
194 . c2='PROPERTY',
195 . i3=igtyp)
196 ENDIF
197
198
199 massele=zero
200 DO k=1,nx
201 massele=massele+umass(k)
202 ENDDO
203 gbuf%MASS(i) = massele
204
205 nanim1d=nanim1d+nax1d
206 nanim2d=nanim2d+nax2d
207 nanim3d=nanim3d+nax3d
208
209
210 dtelem(ndepar+i)= dte
211
212
213 iadnod=kxx(4,j)
214 DO k=1,nx
215 i1=ixx(iadnod+k-1)
216 stifn(i1)=stifn(i1)+ustifm(k)
217 stifr(i1)=stifr(i1)+ustifr(k)
218 ENDDO
219
220
221 CALL xini2u(kxx(1,j),ixx,umass,uiner,xmas,
222 . xin,partsav,x,v,ipartx(j)
223 ENDDO
224
225 RETURN
integer, parameter nchartitle
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)
subroutine xini28(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
subroutine xini29(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
subroutine xini30(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
subroutine xini31(nx, nax1d, nax2d, nax3d, xel, vel, vrel, iout, iprop, imat, ix, ids, mass, xiner, stifm, stifr, viscm, viscr, uvar, nuvar, uvarn, nuvarn, dte)
subroutine xini2u(kxx, ixx, umass, uiner, ms, xin, partsav, x, v, ipart)
subroutine xini1u(x, v, vr, off, kxx, ixx, itab, nx, uid, uix, xusr, vusr, vrusr)