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