34
35
36
37
38
39
40 USE my_alloc_mod
42 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
43
44
45
46#include "implicit_f.inc"
47
48
49
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "sphcom.inc"
53#include "scr23_c.inc"
54#include "param_c.inc"
55#include "units_c.inc"
56
57
58
59 INTEGER IXS(NIXS,*), IXQ(NIXQ,*), IXC(NIXC,*), IXT(NIXT,*)
60 INTEGER IXP(NIXP,*), IXR(NIXR,*), IXTG(NIXTG,*)
61 INTEGER KXX(NIXX,*), KXSP(NISP,*) ,KXIG3D(NIXIG3D,*),
62 . IGEO(NPROPGI,*)
64 . dtelem(2*numel)
65 INTEGER,INTENT(IN) :: NUMEL
66
67
68
69 INTEGER NUM2, I, NUMIMP, NUMELO, NUM1, IS_PROP45
70 real*4 vingtr4, tempo
71 INTEGER ::
72 INTEGER, DIMENSION(:), ALLOCATABLE ::
73 DATA vingtr4 /20./
74
75
76
77 CALL my_alloc(perm,numel)
78
79
80 num2 = 0
81 DO i=1,numels+numelq
82 perm(num2+i)=i
83 ENDDO
84
85
86 num2=numels+numelq
87 DO i=1,numelc
88 perm(num2+i)=i
89 ENDDO
90
91
92 num2=num2+numelc
93 DO i=1,numelt
94 perm(num2+i)=i
95 ENDDO
96
97
98 num2=num2+numelt
99 DO i=1,numelp
100 perm(num2+i)=i
101 ENDDO
102
103
104 num2=num2+numelp
105 DO i=1,numelr
106 perm(num2+i)=i
107 ENDDO
108
109
110 num2=num2+numelr
111 DO i=1,numeltg
112 perm(num2+i)=i
113 ENDDO
114
115
116 num2=num2+numeltg
117 DO i=1,numelx
118 perm(num2+i)=i
119 ENDDO
120
121
122 num2=num2+numelx
123 DO i=1,numsph
124 perm(num2+i)=i
125 ENDDO
126
127
128 num2=num2+numsph
129 DO i=1,numelig3d
130 perm(num2+i)=i
131 ENDDO
132
133
134
135
136 IF (numels>1) THEN
137 num2 = 1
138 CALL myqsort(numels,dtelem(num2),perm(num2),ierror)
139 ENDIF
140 IF (numelq>1) THEN
141 num2 = 1
142 CALL myqsort(numelq,dtelem(num2),perm(num2),ierror)
143 ENDIF
144 IF (numelc>1) THEN
145 num2 = numels+1
146 CALL myqsort(numelc,dtelem(num2),perm(num2),ierror)
147 ENDIF
148 IF (numelt>1) THEN
149 num2 = numels+numelc+1
150 CALL myqsort(numelt,dtelem(num2),perm(num2),ierror)
151 ENDIF
152 IF (numelp>1) THEN
153 num2 = numels+numelc+numelt+1
154 CALL myqsort(numelp,dtelem(num2),perm(num2),ierror)
155 ENDIF
156 IF (numelr>1) THEN
157 num2 = numels+numelc+numelt+numelp+1
158 CALL myqsort(numelr,dtelem(num2),perm(num2),ierror)
159 ENDIF
160 IF (numeltg>1) THEN
161 num2=numels+numelc+numelt+numelp+numelr+1
162 CALL myqsort(numeltg,dtelem(num2),perm(num2),ierror)
163 ENDIF
164 IF (numelx>1) THEN
165 num2=numels+numelc+numelt+numelp+numelr+numeltg+1
166 CALL myqsort(numelx,dtelem(num2),perm(num2),ierror)
167 ENDIF
168 IF (numsph>1) THEN
169 num2=numels+numelc+numelt+numelp+numelr+numeltg+numelx+1
170 CALL myqsort(numsph,dtelem(num2),perm(num2),ierror)
171 ENDIF
172 IF (numelig3d>1) THEN
173 num2=numels+numelc+numelt+numelp+numelr+numeltg+numelx+
174 . numsph+1
175 CALL myqsort(numelig3d,dtelem(num2),perm(num2),ierror)
176 ENDIF
177
178 dtelem(numel+1:2*numel) = perm(1:numel)
179
180
181
182
183 IF (numels>0) THEN
184 tempo = numels*twoem2
185 numimp=min0(numels,max1(vingtr4,tempo))
186 WRITE(iout,1000)
187 WRITE(iout,1001)
188 DO i=1,numimp
189 numelo=nint(dtelem(numel+i))
190 WRITE(iout,1002)dtelem(i),ixs(11,numelo)
191 END DO
192 ENDIF
193
194 IF (numelq>0) THEN
195 tempo = numelq*twoem2
196 numimp=min0(numelq,max1(vingtr4,tempo))
197 WRITE(iout,1000)
198 WRITE(iout,1001)
199 DO i=1,numimp
200 numelo=nint(dtelem(numel+i))
201 WRITE(iout,1002)dtelem(i),ixq(7,numelo)
202 END DO
203 ENDIF
204
205 IF(numelc>0) THEN
206 tempo = numelc*twoem2
207 numimp=min0(numelc,max1(vingtr4,tempo))
208 num2=numel+numels
209 WRITE(iout,2000)
210 WRITE(iout,1001)
211
212
213
214 DO i=1,numimp
215 numelo=nint(dtelem(num2+i))
216 WRITE(iout,1002)dtelem(numels+i),ixc(7,numelo)
217 END DO
218 ENDIF
219
220 IF(numelt>0) THEN
221 tempo = numelt*twoem2
222 numimp=min0(numelt,max1(vingtr4,tempo))
223 num1=numels+numelq+numelc
224 num2=num1+numel
225 WRITE(iout,3000)
226 WRITE(iout,1001)
227
228 DO i=1,numimp
229 numelo=nint(dtelem(num2+i))
230 WRITE(iout,1002)dtelem(num1+i),
231 . ixt(5,numelo)
232 END DO
233 ENDIF
234
235 IF(numelp>0) THEN
236 tempo = numelp*twoem2
237 numimp=min0(numelp,max1(vingtr4,tempo))
238 num1=numels+numelc+numelt
239 num2=num1+numel
240 WRITE(iout,4000)
241 WRITE(iout,1001)
242 DO i=1,numimp
243 numelo=nint(dtelem(num2+i))
244 WRITE(iout,1002)dtelem(num1+i),ixp(6,numelo)
245 END DO
246 ENDIF
247
248 is_prop45 = 0
249 IF(numelr>0) THEN
250 tempo = numelr*twoem2
251 numimp=min0(numelr,max1(vingtr4,tempo))
252 num1=numels+numelc+numelt+numelp
253 num2=num1+numel
254 WRITE(iout,5000)
255 WRITE(iout,1001)
256
257 DO i=1,numimp
258 numelo=nint(dtelem(num2+i))
259 IF( igeo(11,ixr(1,numelo)) == 45) THEN
260 is_prop45 = 1
261 ELSE
262 WRITE(iout,1002)dtelem(num1+i),ixr(6,numelo)
263 ENDIF
264 END DO
265 IF (is_prop45 == 1)
266 . WRITE(iout,5001)
267 ENDIF
268
269 IF(numeltg>0 .AND. n2d == 0) THEN
270 tempo = numeltg*twoem2
271 numimp=min0(numeltg,max1(vingtr4,tempo))
272 num1=numels+numelc+numelt+numelp+numelr
273 num2=num1+numel
274 WRITE(iout,6000)
275 WRITE(iout,1001)
276
277 DO i=1,numimp
278 numelo=nint(dtelem(num2+i))
279 WRITE(iout,1002)dtelem(num1+i),ixtg(6,numelo)
280 END DO
281 ENDIF
282
283 IF(numeltg>0 .AND. n2d /= 0) THEN
284 tempo = numeltg*twoem2
285 numimp=min0(numeltg,max1(vingtr4,tempo))
286 num1=numels+numelc+numelt+numelp+numelr
287 num2=num1+numel
288 WRITE(iout,10000)
289 WRITE(iout,1001)
290
291 DO i=1,numimp
292 numelo=nint(dtelem(num2+i))
293 WRITE(iout,1002)dtelem(num1+i),ixtg(6,numelo)
294 END DO
295 ENDIF
296
297 IF(numelx>0) THEN
298 tempo = numelx*twoem2
299 numimp=min0(numelx,max1(vingtr4,tempo))
300 num1=numels+numelc+numelt+numelp+numelr+numeltg
301 num2=num1+numel
302 WRITE(iout,7000)
303 WRITE(iout,1001)
304 DO i=1,numimp
305 numelo=nint(dtelem(num2+i))
306 WRITE(iout,1002)dtelem(num1+i),kxx(5,numelo)
307 END DO
308 ENDIF
309
310 IF(numsph>0) THEN
311 tempo = numsph*twoem2
312 numimp=min0(numsph,max1(vingtr4,tempo))
313 num1=numels+numelc+numelt+numelp+numelr+numeltg+numelx
314 num2=num1+numel
315 WRITE(iout,8000)
316 WRITE(iout,1001)
317 DO i=1,numimp
318 numelo=nint(dtelem(num2+i))
319 WRITE(iout,1002)dtelem(num1+i),kxsp(nisp,numelo)
320 END DO
321 ENDIF
322
323 IF(numelig3d>0) THEN
324 tempo = numelig3d*twoem2
325 numimp=min0(numelig3d,max1(vingtr4,tempo))
326 num1=numels+numelc+numelt+numelp+numelr+numeltg+numelx+
327 . numsph
328 num2=num1+numel
329 WRITE(iout,9000)
330 WRITE(iout,1001)
331 DO i=1,numimp
332 numelo=nint(dtelem(num2+i))
333 WRITE(iout,1002)dtelem(num1+i),kxig3d(5,numelo)
334 END DO
335 ENDIF
336 DEALLOCATE( perm )
337
338 1000 FORMAT(//,' SOLID ELEMENTS TIME STEP')
339 1001 FORMAT( ' ------------------------',//,
340 . ' TIME STEP ELEMENT NUMBER')
341 1002 FORMAT(1x,1pg20.13,5x,i10)
342 2000 FORMAT(/,' SHELL ELEMENTS TIME STEP')
343 3000 FORMAT(/,' TRUSS ELEMENTS TIME STEP')
344 4000 FORMAT(/,' BEAM ELEMENTS TIME STEP')
345 5000 FORMAT(/,' SPRING ELEMENTS TIME STEP')
346 5001 FORMAT(/,' Info : spring TYPE45 (KJOINT2) time step is evaluated at the beginning of the engine')
347 6000 FORMAT(/,' TRIANGULAR SHELL ELEMENTS TIME STEP')
34850000 FORMAT(/,' USER RNUR ELEMENTS TIME STEP')
349 7000 FORMAT(/,' MULTI-PURPOSE ELEMENTS TIME STEP')
350 8000 FORMAT(/,' SMOOTH PARTICLES TIME STEP')
351 9000 FORMAT(/,' ISO GEOMETRIC ELEMENTS TIME STEP')
35210000 FORMAT(/,' 2D TRIA ELEMENTS TIME STEP')
353
354
355 RETURN
subroutine myqsort(n, a, perm, error)