OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
anim_build_index_all.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr06_c.inc"
#include "scr14_c.inc"
#include "scr25_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine anim_build_index_all (ispmd, mcheck, sensors, igeo, geo)

Function/Subroutine Documentation

◆ anim_build_index_all()

subroutine anim_build_index_all ( integer ispmd,
integer mcheck,
type (sensors_), intent(inout) sensors,
integer, dimension(npropgi,*) igeo,
geo )

Definition at line 35 of file anim_build_index_all.F.

36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE message_mod
40 USE stack_mod
41 USE sensor_mod
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com04_c.inc"
50#include "param_c.inc"
51#include "scr06_c.inc"
52#include "scr14_c.inc"
53#include "scr25_c.inc"
54C-----------------------------------------------
55C D u m m y A r g u m e n t s
56C-----------------------------------------------
57 INTEGER ISPMD, MCHECK, IGEO(NPROPGI,*)
58 my_real
59 . geo(npropg,*)
60 TYPE (SENSORS_) ,INTENT(INOUT) :: SENSORS
61C-----------------------------------------------
62C L o c a l V a r i a b l e s
63C-----------------------------------------------
64 INTEGER I, J, K, IOK, IANIS0, NIPMAX, IHBE,
65 . IUS,IPT,IGTYP,NPT,NPTS,NPTR,NPTT,NPTT_PLY,CPtPLY,NMAX,IGTYP15,
66 . IDX,NIPMAX_BEAM, NIPMAX_SOL,ICSTR,N14R,N14S,N14T
67C-------------------------------------------
68 nipmax = 0
69 nipmax_beam = 0
70 nipmax_sol = 0
71 npts = 1
72 nptt = 0
73 nptr= 1
74 nptt_ply = 0
75 IF (mcheck == 0) THEN
76 ALLOCATE (sensors%ANIM(sensors%NANIM))
77 sensors%ANIM(:) = 0
78 END IF
79
80 IF (ispmd == 0 .AND. mcheck == 0) THEN
81C-----------------------
82C /ANIM/SENSOR and /ANIM/LSENSOR Initializations
83C-----------------------
84 ianis0 = sensors%ANIM_ID
85 IF (ianis0 /= 0) THEN
86 DO i=1,sensors%NSENSOR
87 IF (ianis0 == sensors%SENSOR_TAB(i)%SENS_ID) sensors%ANIM_ID=i
88 ENDDO
89 ENDIF
90c
91 DO k=1,sensors%NANIM
92 iok = 0
93 ianis0 = sensors%ANIM_TMP(k)
94 IF (ianis0 > 0) THEN
95 DO i=1,sensors%NSENSOR
96 IF (ianis0 == sensors%SENSOR_TAB(i)%SENS_ID) THEN
97 sensors%ANIM(k)=i
98 iok = 1
99 EXIT
100 ENDIF
101 ENDDO
102 ENDIF
103 IF (iok == 0) THEN
104 CALL ancmsg(msgid=228,msgtype=msgerror,anmode=aninfo,i1=ianis0)
105 CALL arret(2)
106 ENDIF
107 ENDDO
108 END IF !(ISPMD==0.AND.MCHECK==0)
109C-------------------------------------------
110 IF (mcheck == 0 ) THEN
111 IF( istresall == 1 .OR. istraiall == 1 .OR.
112 . iepsdoall == 1 .OR. iepspall == 1 .OR.
113 . iphiall == 1 .OR.
114 . idamaall == 1 .OR.
115 . iepspfull > 0 .OR.
116 . istresfull > 0 .OR.
117 . iplyall > 0 .OR.
118 . istresall_ply>0 .OR.
119 . istrainall_ply>0 .OR.
120 . iepsdotall_ply>0 .OR.
121 . iepspall_ply>0 .OR.
122 . idamaall_ply>0 .OR.
123 . iphiall_ply > 0 .OR.
124 . ibrick_stressall > 0 .OR.
125 . ibrick_strainall > 0 .OR.
126 . ibrick_epspall > 0 .OR.
127 . idamafull > 0 .OR.
128 . istrainfull > 0 .OR.
129 . iepsdofull > 0 .OR.
130 . iwplaall > 0 .OR.
131 . iwplafull > 0 .OR.
132 . ibeam_epspall > 0 .OR.
133 . iepspnlall == 1 .OR.
134 . iepsdnlall == 1 .OR.
135 . itsaiwuall > 0 .OR.
136 . itsaiwufull > 0) THEN
137 nipmax = 0
138 DO i=1,numgeo
139 nipmax = max(nipmax,nint(geo(6,i)))
140 ENDDO
141 IF(nipmax ==0) nipmax=1
142!
143 nipmax_beam = 0
144 DO i=1,numgeo
145 igtyp = igeo(11,i)
146 IF (igtyp == 18) THEN ! integrated beam
147 nipmax_beam = max(nipmax_beam,igeo(3,i))
148 ENDIF
149 ENDDO
150 IF(nipmax_beam == 0) nipmax_beam=1
151!
152 IF (istresall == 1)THEN
153 IF (anim_ct(3) == 0) THEN
154 anim_ct(3) = 1
155 nct_ani = nct_ani + 1
156 ENDIF
157 IF (anim_ct(4) == 0) THEN
158 anim_ct(4) = 1
159 nct_ani = nct_ani + 1
160 ENDIF
161c IF(NIPMAX<=100)THEN
162 DO i=1,nipmax
163 anim_ct(100+i) = 1
164 nct_ani = nct_ani + 1
165 ENDDO
166c ENDIF
167 ENDIF
168 IF (istraiall == 1)THEN
169 IF (anim_ct(7) == 0) THEN
170 anim_ct(7) = 1
171 nct_ani = nct_ani + 1
172 ENDIF
173 IF (anim_ct(8) == 0) THEN
174 anim_ct(8) = 1
175 nct_ani = nct_ani + 1
176 ENDIF
177 IF(nipmax<=100)THEN
178 DO i=1,nipmax
179 anim_ct(200+i) = 1
180 nct_ani = nct_ani + 1
181 ENDDO
182 ENDIF
183 ENDIF
184 IF (iepsdoall == 1)THEN
185 IF (anim_ct(93) == 0) THEN
186 anim_ct(93) = 1
187 nct_ani = nct_ani + 1
188 ENDIF
189 IF (anim_ct(94) == 0) THEN
190 anim_ct(94) = 1
191 nct_ani = nct_ani + 1
192 ENDIF
193 IF(nipmax<=100)THEN
194 DO i=1,nipmax
195 anim_ct(300+i) = 1
196 nct_ani = nct_ani + 1
197 ENDDO
198 ENDIF
199 ENDIF
200 IF (iepspall == 1)THEN
201 IF (anim_ce(2040) == 0) THEN
202 anim_ce(2040) = 1
203 nce_ani = nce_ani + 1
204 ENDIF
205 IF (anim_ce(2041) == 0) THEN
206 anim_ce(2041) = 1
207 nce_ani = nce_ani + 1
208 ENDIF
209 IF(nipmax<=100)THEN
210 DO i=1,nipmax
211 IF (anim_ce(2041+i) == 0) THEN
212 anim_ce(2041+i) = 1
213 nce_ani = nce_ani + 1
214 ENDIF
215 ENDDO
216 ENDIF
217 ENDIF
218!---
219 IF (iepspfull == 1) THEN
220! ...EPSP/N1/ALL
221 IF (nipmax <= 100) THEN
222 DO i=1,nipmax
223 DO j=1,10
224 ius = 10*i+j
225 IF (anim_ce(10877 + ius) == 0 .AND. anim_epsp(i) > 0) THEN
226 anim_ce(10877 + ius) = 1
227 nce_ani = nce_ani + 1
228 ENDIF
229 ENDDO
230 ENDDO
231 ENDIF
232 ELSEIF (iepspfull == 2) THEN
233! ...EPSP/ALL/ALL
234 IF (nipmax <= 100) THEN
235 DO i=1,nipmax
236 DO j=1,10
237 ius = 10*i+j
238 IF (anim_ce(10877 + ius) == 0) THEN
239 anim_ce(10877 + ius) = 1
240 nce_ani = nce_ani + 1
241 ENDIF
242 ENDDO
243 ENDDO
244 ENDIF
245 ENDIF ! IF (IEPSPFULL == 1)
246!---
247 IF (istresfull == 1) THEN
248! ...STRESS/N1/ALL
249 IF (nipmax <= 100) THEN
250 DO i=1,nipmax
251 DO j=1,10
252 ius = 10*i+j
253 IF (anim_ct(600 + ius) == 0 .AND. anim_stress(i) > 0) THEN
254 anim_ct(600 + ius) = 1
255 nct_ani = nct_ani + 1
256 ENDIF
257 ENDDO
258 ENDDO
259 ENDIF
260 ELSEIF (istresfull == 2) THEN
261! ...STRESS/ALL/ALL
262 IF (nipmax <= 100) THEN
263 DO i=1,nipmax
264 DO j=1,10
265 ius = 10*i+j
266 IF (anim_ct(600 + ius) == 0) THEN
267 anim_ct(600 + ius) = 1
268 nct_ani = nct_ani + 1
269 ENDIF
270 ENDDO
271 ENDDO
272 ENDIF
273 ENDIF ! IF (ISTRESFULL == 1)
274C-------------
275 IF (iphiall == 1)THEN
276 IF(nipmax<=100)THEN
277 DO i=1,nipmax
278 anim_ce(10139+i) = 1
279 nce_ani = nce_ani + 1
280 ENDDO
281 ENDIF
282 ENDIF
283 ENDIF ! IF( ISTRESALL == 1 .OR. ISTRAIALL == 1 .OR.
284C
285 IF( iorthdall == 1 )THEN
286 nipmax_sol = 1
287 DO i=1,numgeo
288 nipmax_sol = max(nipmax_sol,igeo(30,i))
289 ENDDO
290 DO i=1,nipmax_sol
291 anim_se(286+3*(i-1)+1) = 1
292 anim_se(286+3*(i-1)+2) = 1
293 anim_se(286+3*(i-1)+3) = 1
294 nse_ani = nse_ani + 3
295 ENDDO
296 ENDIF !
297C
298 IF (idamaall == 1)THEN
299 IF(nipmax<=100)THEN
300 DO i=1,nipmax
301 anim_ce(10259+i) = 1
302 nce_ani = nce_ani + 1
303 ENDDO
304 ENDIF
305 ENDIF
306C
307 IF (inxtfall == 1)THEN
308 IF(nipmax<=100)THEN
309 DO i=1,nipmax
310 anim_ce(10362+i) = 1
311 nce_ani = nce_ani + 1
312 ENDDO
313 ENDIF
314 ENDIF
315C
316 IF (sigh1all == 1)THEN
317 IF(nipmax<=100)THEN
318 DO i=1,nipmax
319 anim_ce(10465+i) = 1
320 nce_ani = nce_ani + 1
321 ENDDO
322 ENDIF
323 ENDIF
324C
325 IF (sigh2all == 1)THEN
326 IF(nipmax<=100)THEN
327 DO i=1,nipmax
328 anim_ce(10568+i) = 1
329 nce_ani = nce_ani + 1
330 ENDDO
331 ENDIF
332 ENDIF
333C
334 IF( iplyall == 1 )THEN
335 cptply = 0
336 DO i=1,numgeo
337 IF(igeo(11,i) == 19) THEN
338 cptply = cptply + 1
339 ply_anim( 3 * (cptply - 1) + 1) = igeo(1,i)
340 ply_anim( 3 * (cptply - 1) + 2) = 1
341 IF(cptply < mx_ply_anim) THEN
342 anim_ce(11925 + cptply) = 1
343 nce_ani = nce_ani + 1
344 ELSE
345 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
346 ENDIF
347 ENDIF
348 ENDDO
349c
350 DO i=1,numply
351 cptply = cptply + 1
352 ply_anim( 3 * (cptply - 1) + 1) = ply_info(1,i)
353 ply_anim( 3 * (cptply - 1) + 2) = 1
354 IF(cptply < mx_ply_anim) THEN
355 anim_ce(11925 + cptply) = 1
356 nce_ani = nce_ani + 1
357 ELSE
358 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
359 ENDIF
360 ENDDO
361 ENDIF !
362C
363 IF( istresall_ply == 1 )THEN
364 cptply = 0
365 DO i=1,numgeo
366 IF(igeo(11,i) == 19) THEN
367 DO ipt=1,igeo(44,i)
368 cptply = cptply + 1
369 ply_anim_stress( 3 * (cptply - 1) + 1) = igeo(1,i)
370 ply_anim_stress( 3 * (cptply - 1) + 2) = 2
371 ply_anim_stress( 3 * (cptply - 1) + 3) = ipt
372 IF( cptply < mx_ply_anim) THEN
373 anim_ct(1610 + cptply) = 1
374 nct_ani = nct_ani + 1
375 ELSE
376 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
377 ENDIF
378 ENDDO
379 ENDIF
380 ENDDO
381c
382 DO i=1,numply
383 DO ipt=1,ply_info(2,i)
384 cptply = cptply + 1
385 ply_anim_stress( 3 * (cptply - 1) + 1) = ply_info(1,i)
386 ply_anim_stress( 3 * (cptply - 1) + 2) = 2
387 ply_anim_stress( 3 * (cptply - 1) + 3) = ipt
388 IF(cptply < mx_ply_anim) THEN
389 anim_ct(1610 + cptply) = 1
390 nct_ani = nct_ani + 1
391 ELSE
392 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
393 ENDIF
394 ENDDO
395 ENDDO
396 ENDIF !
397C
398 IF( istrainall_ply == 1 )THEN
399 cptply = 0
400 DO i=1,numgeo
401 IF(igeo(11,i) == 19) THEN
402 DO ipt=1,igeo(44,i)
403 cptply = cptply + 1
404 ply_anim_strain( 3 * (cptply - 1) + 1) = igeo(1,i)
405 ply_anim_strain( 3 * (cptply - 1) + 2) = 3
406 ply_anim_strain( 3 * (cptply - 1) + 3) = ipt
407 IF(cptply < mx_ply_anim) THEN
408 anim_ct( (1610+mx_ply_anim) + cptply) = 1
409 nct_ani = nct_ani + 1
410 ELSE
411 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
412 ENDIF
413 ENDDO
414 ENDIF
415 ENDDO
416c
417 DO i=1,numply
418 DO ipt=1,ply_info(2,i)
419 cptply = cptply + 1
420 ply_anim_strain( 3 * (cptply - 1) + 1) = ply_info(1,i)
421 ply_anim_strain( 3 * (cptply - 1) + 2) = 3
422 ply_anim_strain( 3 * (cptply - 1) + 3) = ipt
423 IF(cptply < mx_ply_anim) THEN
424 anim_ct( (1610 + mx_ply_anim) + cptply) = 1
425 nct_ani = nct_ani + 1
426 ELSE
427 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
428 ENDIF
429 ENDDO
430 ENDDO
431 ENDIF !
432C
433 IF( iepsdotall_ply == 1 )THEN
434 cptply = 0
435 DO i=1,numgeo
436 IF(igeo(11,i) == 19) THEN
437 DO ipt=1,igeo(44,i)
438 cptply = cptply + 1
439 ply_anim_epsdot( 3 * (cptply - 1) + 1) = igeo(1,i)
440 ply_anim_epsdot( 3 * (cptply - 1) + 2) = 6
441 ply_anim_epsdot( 3 * (cptply - 1) + 3) = ipt
442 IF(cptply < mx_ply_anim) THEN
443 anim_ct( (1610+ 2*mx_ply_anim) + cptply) = 1
444 nct_ani = nct_ani + 1
445 ELSE
446 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
447 ENDIF
448 ENDDO
449 ENDIF
450 ENDDO
451c
452 DO i=1,numply
453 DO ipt=1,ply_info(2,i)
454 cptply = cptply + 1
455 ply_anim_epsdot( 3 * (cptply - 1) + 1) = ply_info(1,i)
456 ply_anim_epsdot( 3 * (cptply - 1) + 2) = 6
457 ply_anim_epsdot( 3 * (cptply - 1) + 3) = ipt
458 IF(cptply < mx_ply_anim) THEN
459 anim_ct( (1610 + 2*mx_ply_anim) + cptply) = 1
460 nct_ani = nct_ani + 1
461 ELSE
462 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
463 ENDIF
464 ENDDO
465 ENDDO
466 ENDIF !
467!---
468 IF (istrainfull == 1) THEN
469 idx = 1810 + 3*mx_ply_anim
470! ...STRAIN/N1/ALL
471 IF (nipmax <= 100) THEN
472 DO i=1,nipmax
473 DO j=1,10
474 ius = 10*i+j
475 IF (anim_ct(idx + ius) == 0 .AND. anim_strain(i) > 0) THEN
476 anim_ct(idx + ius) = 1
477 nct_ani = nct_ani + 1
478 ENDIF
479 ENDDO
480 ENDDO
481 ENDIF
482 ELSEIF (istrainfull == 2) THEN
483 idx = 1810 + 3*mx_ply_anim
484! ...STRAIN/ALL/ALL
485 IF (nipmax <= 100) THEN
486 DO i=1,nipmax
487 DO j=1,10
488 ius = 10*i+j
489 IF (anim_ct(idx + ius) == 0) THEN
490 anim_ct(idx + ius) = 1
491 nct_ani = nct_ani + 1
492 ENDIF
493 ENDDO
494 ENDDO
495 ENDIF
496 ENDIF ! IF (ISTRAINFULL == 1)
497!---
498 IF (iepsdofull == 1) THEN
499 idx = 2820 + 3*mx_ply_anim
500! ...EPSPDOT/N1/ALL
501 IF (nipmax <= 100) THEN
502 DO i=1,nipmax
503 DO j=1,10
504 ius = 10*i+j
505 IF (anim_ct(idx + ius) == 0 .AND. anim_epsdot(i) > 0) THEN
506 anim_ct(idx + ius) = 1
507 nct_ani = nct_ani + 1
508 ENDIF
509 ENDDO
510 ENDDO
511 ENDIF
512 ELSEIF (iepsdofull == 2) THEN
513 idx = 2820 + 3*mx_ply_anim
514! ...EPSPDOT/ALL/ALL
515 IF (nipmax <= 100) THEN
516 DO i=1,nipmax
517 DO j=1,10
518 ius = 10*i+j
519 IF (anim_ct(idx + ius) == 0) THEN
520 anim_ct(idx + ius) = 1
521 nct_ani = nct_ani + 1
522 ENDIF
523 ENDDO
524 ENDDO
525 ENDIF
526 ENDIF ! IF (IEPSDOFULL == 1)
527!---
528c
529 IF( iphiall_ply == 1 )THEN
530 cptply = 0
531 DO i=1,numgeo
532 IF(igeo(11,i) == 19) THEN
533 DO ipt=1,igeo(44,i)
534 cptply = cptply + 1
535 ply_anim_phi( 3 * (cptply - 1) + 1) = igeo(1,i)
536 ply_anim_phi( 3 * (cptply - 1) + 2) = 4
537 ply_anim_phi( 3 * (cptply - 1) + 3) = ipt
538 IF( cptply < mx_ply_anim) THEN
539 anim_ce( (11925 + mx_ply_anim) + cptply) = 1
540 nce_ani = nce_ani + 1
541 ELSE
542 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
543 ENDIF
544 ENDDO
545 ENDIF
546 ENDDO
547c
548 DO i=1,numply
549 DO ipt=1,ply_info(2,i)
550 cptply = cptply + 1
551 ply_anim_phi( 3 * (cptply - 1) + 1) = ply_info(1,i)
552 ply_anim_phi( 3 * (cptply - 1) + 2) = 4
553 ply_anim_phi( 3 * (cptply - 1) + 3) = ipt
554 IF( cptply < 11925) THEN
555 anim_ce( (11925 + mx_ply_anim) + cptply) = 1
556 nce_ani = nce_ani + 1
557 ELSE
558 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
559 ENDIF
560 ENDDO
561 ENDDO
562 ENDIF !
563C
564 IF( iepspall_ply == 1 )THEN
565 cptply = 0
566 DO i=1,numgeo
567 IF(igeo(11,i) == 19) THEN
568 DO ipt=1,igeo(44,i)
569 cptply = cptply + 1
570 ply_anim_epsp( 3 * (cptply - 1) + 1) = igeo(1,i)
571 ply_anim_epsp( 3 * (cptply - 1) + 2) = 5
572 ply_anim_epsp( 3 * (cptply - 1) + 3) = ipt
573 IF( cptply < mx_ply_anim) THEN
574 anim_ce( (11925 + ( 2*mx_ply_anim ) ) + cptply) = 1
575 nce_ani = nce_ani + 1
576 ELSE
577 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
578 ENDIF
579 ENDDO
580 ENDIF
581 ENDDO
582c
583 DO i=1,numply
584 DO ipt=1,ply_info(2,i)
585 cptply = cptply + 1
586 ply_anim_epsp( 3 * (cptply - 1) + 1) = ply_info(1,i)
587 ply_anim_epsp( 3 * (cptply - 1) + 2) = 5
588 ply_anim_epsp( 3 * (cptply - 1) + 3) = ipt
589 IF( cptply < mx_ply_anim) THEN
590 anim_ce( (11925 + (2*mx_ply_anim)) + cptply) = 1
591 nce_ani = nce_ani + 1
592 ELSE
593 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
594 ENDIF
595 ENDDO
596 ENDDO
597 ENDIF !
598C
599 IF( idamaall_ply == 1 )THEN
600 cptply = 0
601 DO i=1,numgeo
602 IF(igeo(11,i) == 19) THEN
603 DO ipt=1,igeo(44,i)
604 cptply = cptply + 1
605 ply_anim_dama( 3 * (cptply - 1) + 1) = igeo(1,i)
606 ply_anim_dama( 3 * (cptply - 1) + 2) = 5
607 ply_anim_dama( 3 * (cptply - 1) + 3) = ipt
608 IF( cptply < mx_ply_anim) THEN
609 anim_ce( (11925 + ( 3*mx_ply_anim ) ) + cptply) = 1
610 nce_ani = nce_ani + 1
611 ELSE
612 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
613 ENDIF
614 ENDDO
615 ENDIF
616 ENDDO
617c
618 DO i=1,numply
619 DO ipt=1,ply_info(2,i)
620 cptply = cptply + 1
621 ply_anim_dama( 3 * (cptply - 1) + 1) = ply_info(1,i)
622 ply_anim_dama( 3 * (cptply - 1) + 2) = 7
623 ply_anim_dama( 3 * (cptply - 1) + 3) = ipt
624 IF( cptply < mx_ply_anim) THEN
625 anim_ce( (11925 + (3*mx_ply_anim)) + cptply) = 1
626 nce_ani = nce_ani + 1
627 ELSE
628 CALL ancmsg(msgid=268,msgtype=msgwarning,i1=mx_ply_anim,anmode=aninfo)
629 ENDIF
630 ENDDO
631 ENDDO
632 ENDIF !
633!---
634 IF (idamafull == 1) THEN
635 idx = 11931 + 4*mx_ply_anim
636! ...DAMA/N1/ALL
637 IF (nipmax <= 100) THEN
638 DO i=1,nipmax
639 DO j=1,10
640 ius = 10*i+j
641 IF (anim_ce(idx + 300 + ius) == 0 .AND. anim_dama(i) > 0) THEN
642 anim_ce(idx + 300 + ius) = 1
643 nce_ani = nce_ani + 1
644 ENDIF
645 ENDDO
646 ENDDO
647 ENDIF
648 ELSEIF (idamafull == 2) THEN
649 idx = 11931 + 4*mx_ply_anim
650! ...DAMS/ALL/ALL
651 IF (nipmax <= 100) THEN
652 DO i=1,nipmax
653 DO j=1,10
654 ius = 10*i+j
655 IF (anim_ce(idx + 300 + ius) == 0) THEN
656 anim_ce(idx + 300 + ius) = 1
657 nce_ani = nce_ani + 1
658 ENDIF
659 ENDDO
660 ENDDO
661 ENDIF
662 ENDIF ! IF (IDAMAFULL == 1)
663!---
664 IF (ibrick_stressall == 1 .OR. ibrick_strainall == 1 . or.
665 . ibrick_epspall == 1) THEN
666 nptr= 1
667 npts= 1
668 nptt= 1
669 igtyp15 = 0
670 DO i=1,numgeo
671 npt = igeo(44,i)
672 ihbe = igeo(10,i)
673 igtyp = igeo(11,i)
674 icstr= igeo(14,i)
675 IF(igtyp == 6 .OR. igtyp == 14 ) THEN
676 SELECT CASE (ihbe)
677 CASE(14,16,222)
678 IF (npt == 0) npt = 222
679 nptr= max(nptr,npt/100)
680 npts= max(npts,mod(npt/10,10))
681 nptt= max(nptt,mod(npt,10))
682 CASE(1,2,101,102,24)
683 nptr= max(nptr,1)
684 npts= max(npts,1)
685 nptt= max(nptt,1)
686 CASE(12,112,13,17,18)
687 nptr= max(nptr,2)
688 npts= max(npts,2)
689 nptt= max(nptt,2)
690 END SELECT
691 ELSE IF(igtyp == 20 .OR. igtyp == 21 .OR. igtyp == 22) THEN
692 SELECT CASE (ihbe)
693C--------due to existing Anim designs: fix thickness dir to J and limite other dirs to 2
694 CASE(14)
695 n14r=npt/100
696 n14s=mod(npt/10,10)
697 n14t=mod(npt,10)
698 SELECT CASE (icstr)
699 CASE(100)
700 IF (n14t==0) n14t= igeo(15,i)
701 CASE(10)
702 IF (n14s==0) n14s= igeo(15,i)
703 CASE(1)
704 IF (n14r==0) n14r= igeo(15,i)
705 END SELECT
706c NPTR= MAX(NPTR,N14R)
707c NPTS= MAX(NPTS,N14S)
708c NPTT= MAX(NPTT,N14T)
709 n14s=max(n14r,n14s,n14t)
710 nptr= max(nptr,2)
711 npts= max(npts,igeo(15,i),n14s)
712 nptt= max(nptt,2)
713 CASE(15)
714C ---------- Isolid=15 will be treated as the same than Isolid=14:
715C----------- /1j1/ or /101/j instead of /0j0/ and consisting to H3d output
716C IGTYP15 = 1
717 npts= max(npts,npt)
718 CASE(16)
719 IF (npt == 0) npt = 222
720 nptr= max(nptr,npt/100)
721 npts= max(npts,mod(npt/10,10))
722 nptt= max(nptt,mod(npt,10))
723 END SELECT
724 ENDIF
725 ENDDO
726!----special case for tet10 :
727 IF (numels10>0) THEN
728 nptr= max(nptr,2)
729 npts= max(npts,2)
730 nptt= max(nptt,2)
731 END IF
732 ENDIF !---
733C
734 nptt_ply = 0
735 DO i=1,numgeo
736 igtyp = igeo(11,i)
737 IF(igtyp == 19) nptt_ply = max(nptt_ply, igeo(44,i))
738 ENDDO
739 DO i=1,numply
740 nptt_ply = max( nptt_ply, ply_info(2,i))
741 ENDDO
742C
743 IF (iwplaall == 1)THEN
744 idx = 13247 + 4*mx_ply_anim
745 nmax = min(100,nipmax)
746 DO i=1,nmax
747 IF (anim_ce(idx + i) == 0) THEN
748 anim_ce(idx + i) = 1
749 nce_ani = nce_ani + 1
750 ENDIF
751 ENDDO
752 ENDIF
753 IF (iwplafull == 1) THEN
754! ...WPLA/N1/ALL
755 idx = 13547 + 4*mx_ply_anim
756 nmax = min(100,nipmax)
757 DO i=1,nmax
758 DO j=1,nptt_ply
759 ius = 10*(i-1) + j
760 IF (anim_ce(idx + ius) == 0 .AND. anim_wpla(i) > 0) THEN
761 anim_ce(idx + ius) = 1
762 nce_ani = nce_ani + 1
763 ENDIF
764 ENDDO
765 ENDDO
766 ELSEIF (iwplafull == 2) THEN
767! ...WPLA/ALL/ALL
768 idx = 13547 + 4*mx_ply_anim
769 nmax = min(100,nipmax)
770 DO i=1,nmax
771 DO j=1,nptt_ply
772 ius = 10*(i-1) + j
773 IF (anim_ce(idx + ius) == 0) THEN
774 anim_ce(idx + ius) = 1
775 nce_ani = nce_ani + 1
776 ENDIF
777 ENDDO
778 ENDDO
779 ENDIF ! IF (IWPLAFULL == 1)
780C to see case Isolid14, iint<=100
781 IF( ibrick_stressall == 1 )THEN
782 IF( npts < 10 )THEN
783C------121:1009
784 DO i=1,nptr
785 DO j=1,npts
786 DO k=1,nptt
787 anim_st(10+ (i*100) + (j*10) + k)=1
788 nst_ani = nst_ani + 1
789 ENDDO
790 ENDDO
791 ENDDO
792 ELSE
793C------(2010+2021):(2010+9*2010+)
794 DO i=1,nptr
795 DO j=1,npts
796 DO k=1,nptt
797 anim_st(2010+ k + (j*10) + (i*2010) ) = 1
798 nst_ani = nst_ani + 1
799 ENDDO
800 ENDDO
801 ENDDO
802 ENDIF !
803c--- 2020-4010
804 IF( igtyp15 == 1 )THEN
805 DO j=1,npts
806 anim_st(2010+ (j*10) ) = 1
807 nst_ani = nst_ani + 1
808 ENDDO
809 ENDIF !
810 ENDIF !
811C
812 IF( ibrick_strainall == 1 )THEN
813 IF( npts < 10 )THEN
814C------(1010+111):(1010+999)
815 DO i=1,nptr
816 DO j=1,npts
817 DO k=1,nptt
818 anim_st(1010+ (i*100) + (j*10) + k)=1
819 nst_ani = nst_ani + 1
820 ENDDO
821 ENDDO
822 ENDDO
823 ELSE
824C------(22110+2021):(22110+9*2010+1009)
825 DO i=1,nptr
826 DO j=1,npts
827 DO k=1,nptt
828 anim_st(22110+ k + (j*10) + (i*2010) ) = 1
829 nst_ani = nst_ani + 1
830 ENDDO
831 ENDDO
832 ENDDO
833 ENDIF !
834c
835 IF( igtyp15 == 1 )THEN
836 DO j=1,npts
837 anim_st(22110+ (j*10) ) = 1
838 nst_ani = nst_ani + 1
839 ENDDO
840 ENDIF !
841 ENDIF !
842!---
843 IF( ibrick_epspall == 1) THEN
844 IF (npts < 10) THEN
845 DO i=1,nptr
846 DO j=1,npts
847 DO k=1,nptt
848 anim_st(42210 + (i*100) + (j*10) + k) = 1
849 nst_ani = nst_ani + 1
850 ENDDO
851 ENDDO
852 ENDDO
853 ELSE
854 DO i=1,nptr
855 DO j=1,npts
856 DO k=1,nptt
857 anim_st(43210 + k + (j*10) + (i*2010)) = 1
858 nst_ani = nst_ani + 1
859 ENDDO
860 ENDDO
861 ENDDO
862 ENDIF ! IF (NPTS < 10)
863c
864 IF (igtyp15 == 1) THEN
865 DO j=1,npts
866 anim_st(43210 + (j*10)) = 1
867 nst_ani = nst_ani + 1
868 ENDDO
869 ENDIF ! IF (IGTYP15 == 1)
870 ENDIF ! IF( IBRICK_EPSPALL == 1)
871!---
872 IF ( ibeam_epspall > 0 ) THEN
873 IF (nipmax_beam <= 100) THEN
874 DO i=1,nipmax_beam
875 anim_fe(22+i) = 1
876 nfe_ani = nfe_ani + 1
877 ENDDO
878 ENDIF
879 ENDIF
880!---
881 ! NON-LOCAL PLASTIC STRAIN FOR SHELLS
882 IF (iepspnlall == 1) THEN
883 idx = 4*mx_ply_anim + 14567
884 IF (anim_ce(idx) == 0) THEN
885 anim_ce(idx) = 1
886 nce_ani = nce_ani + 1
887 ENDIF
888 IF (anim_ce(idx+1) == 0) THEN
889 anim_ce(idx+1) = 1
890 nce_ani = nce_ani + 1
891 ENDIF
892 IF (anim_ce(idx+2) == 0) THEN
893 anim_ce(idx+2) = 1
894 nce_ani = nce_ani + 1
895 ENDIF
896 IF (nipmax <= 11)THEN
897 DO i=1,nipmax
898 IF (anim_ce(idx+2+i) == 0) THEN
899 anim_ce(idx+2+i) = 1
900 nce_ani = nce_ani + 1
901 ENDIF
902 ENDDO
903 ENDIF
904 ENDIF
905!---
906 ! NON-LOCAL PLASTIC STRAIN RATE FOR SHELLS
907 IF (iepsdnlall == 1) THEN
908 idx = 4*mx_ply_anim + 14581
909 IF (anim_ce(idx) == 0) THEN
910 anim_ce(idx) = 1
911 nce_ani = nce_ani + 1
912 ENDIF
913 IF (anim_ce(idx+1) == 0) THEN
914 anim_ce(idx+1) = 1
915 nce_ani = nce_ani + 1
916 ENDIF
917 IF (anim_ce(idx+2) == 0) THEN
918 anim_ce(idx+2) = 1
919 nce_ani = nce_ani + 1
920 ENDIF
921 IF (nipmax <= 11)THEN
922 DO i=1,nipmax
923 IF (anim_ce(idx+2+i) == 0) THEN
924 anim_ce(idx+2+i) = 1
925 nce_ani = nce_ani + 1
926 ENDIF
927 ENDDO
928 ENDIF
929 ENDIF
930C
931! ...TSAIWU/ALL
932 IF (itsaiwuall == 1)THEN
933 idx = 14597 + 4*mx_ply_anim
934 nmax = min(100,nipmax)
935 DO i=1,nmax
936 IF (anim_ce(idx + i) == 0) THEN
937 anim_ce(idx + i) = 1
938 nce_ani = nce_ani + 1
939 ENDIF
940 ENDDO
941 ELSEIF (itsaiwuall == 2) THEN
942! ...TSAIWU/ALL/ALL
943 idx = 14897 + 4*mx_ply_anim
944 nmax = min(100,nipmax)
945 DO i=1,nmax
946 DO j=1,nptt_ply
947 ius = 10*(i-1) + j
948 IF (anim_ce(idx + ius) == 0) THEN
949 anim_ce(idx + ius) = 1
950 nce_ani = nce_ani + 1
951 ENDIF
952 ENDDO
953 ENDDO
954 ENDIF
955
956 IF (itsaiwufull > 0) THEN
957! ...TSAIWU/N1/ALL
958 idx = 14897 + 4*mx_ply_anim
959 itsaiwufull = min(100,itsaiwufull)
960 DO j=1,nptt_ply
961 ius = 10*(itsaiwufull-1) + j
962 IF (anim_ce(idx + ius) == 0) THEN
963 anim_ce(idx + ius) = 1
964 nce_ani = nce_ani + 1
965 ENDIF
966 ENDDO
967 ENDIF
968C
969 ELSE ! IF(MCHECK == 0 ) THEN
970 DO i = 1,mx_ani
971 nv_ani = nv_ani + anim_v(i)
972 nt_ani = nt_ani + anim_t(i)
973 ne_ani = ne_ani + anim_e(i)
974 nn_ani = nn_ani + anim_n(i)
975 nst_ani = nst_ani + anim_st(i)
976 nse_ani = nse_ani + anim_se(i)
977 nct_ani = nct_ani + anim_ct(i)
978 nce_ani = nce_ani + anim_ce(i)
979 nft_ani = nft_ani + anim_ft(i)
980 nfe_ani = nfe_ani + anim_fe(i)
981 ENDDO
982 IF(anim_v(12) == 1)nv_ani=nv_ani+1
983 IF(anim_v(4)==1.AND.animcont == 0) nv_ani=nv_ani-1
984 IF(anim_v(27)==1)nv_ani=nv_ani+1
985 ENDIF
986C-----
987 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1249
stack_mod
Definition stack_mod.F:72
stack_mod::ply_info
integer, dimension(:,:), allocatable ply_info
Definition stack_mod.F:133
ancmsg
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)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87