OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
reordr.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "tablen_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine reordr (ix, nx, nel, pm, ipoint, iparts, ngrele, igrelem, nummat)

Function/Subroutine Documentation

◆ reordr()

subroutine reordr ( integer, dimension(nx,nel) ix,
integer nx,
integer nel,
pm,
integer, dimension(2,*) ipoint,
integer, dimension(*) iparts,
integer ngrele,
type (group_), dimension(ngrele) igrelem,
integer, intent(in) nummat )

Definition at line 30 of file reordr.F.

31C-----------------------------------------------
32C M o d u l e s
33C-----------------------------------------------
34 USE groupdef_mod
35C-----------------------------------------------
36C I m p l i c i t T y p e s
37C-----------------------------------------------
38#include "implicit_f.inc"
39C-----------------------------------------------
40C C o m m o n B l o c k s
41C-----------------------------------------------
42#include "param_c.inc"
43#include "tablen_c.inc"
44C-----------------------------------------------
45C D u m m y A r g u m e n t s
46C-----------------------------------------------
47 INTEGER :: NX, NEL,NGRELE
48 INTEGER :: IX(NX,NEL), IPOINT(2,*),IPARTS(*)
49 INTEGER, INTENT(IN) :: NUMMAT
50 my_real :: pm(npropm,nummat)
51C-----------------------------------------------
52 TYPE (GROUP_) , DIMENSION(NGRELE) :: IGRELEM
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER IADR(0:MAXLAW+1), NL, M, I, MLAWP1, MT, MLAW, J,K,N,IAD
57C-----------------------------------------------
58C S o u r c e L i n e s
59C-----------------------------------------------
60 nl=maxlaw
61 DO m=0,nl+1
62 iadr(m)=0
63 ENDDO
64C---------------------------------------
65C NUMBER OF ELEMS FOR EACH MATERIAL LAW
66C---------------------------------------
67 DO i=1,nel
68 IF(ix(1,i)<0) THEN
69 mlawp1=17+1
70 ELSE
71 mt=ix(1,i)
72 mlawp1=nint(pm(19,mt))+1
73 ENDIF
74 iadr(mlawp1)=iadr(mlawp1)+1
75 ENDDO
76C------------------------------------------
77C ELEM ADDRESSE FOR EACH MATERIAL LAW
78C SKIPPING LAW11
79C------------------------------------------
80 iadr(11+1)=0
81 DO m=1,nl
82 iadr(m)=iadr(m)+iadr(m-1)
83 ENDDO
84 iadr(11)=iadr(nl+1)+iadr(nl)
85C--------------------------------------------------
86C CALL POINTER FOR EACH MLW
87C--------------------------------------------------
88 DO i=1,nel
89 IF(ix(1,i)<0) THEN
90 mlaw=17
91 ELSE
92 mt=ix(1,i)
93 mlaw=nint(pm(19,mt))
94 ENDIF
95 iadr(mlaw)=iadr(mlaw)+1
96 ipoint(1,i)=iadr(mlaw)
97 END DO
98C------------------------------------------
99C PERUMTATING ELEMS USING LAWS
100C------------------------------------------
101 DO j=1,nx
102 DO i=1,nel
103 ipoint(2,i)=ix(j,i)
104 END DO
105 DO i=1,nel
106 ix(j,ipoint(1,i))=ipoint(2,i)
107 END DO
108 ENDDO
109C------------------------------------------
110C PERMUTATING PARTS
111C------------------------------------------
112 DO i=1,nel
113 ipoint(2,i)=iparts(i)
114 ENDDO
115 DO i=1,nel
116 iparts(ipoint(1,i))=ipoint(2,i)
117 ENDDO
118C------------------------------------------
119C RRENUMBERING ELEMS INSIDE GROUPS
120C------------------------------------------
121 DO k=1,ngrele
122 n = igrelem(k)%NENTITY
123 DO i=1,n
124 IF (igrelem(k)%ENTITY(i)<=nel)igrelem(k)%ENTITY(i) = ipoint(1,igrelem(k)%ENTITY(i))
125 ENDDO
126 ENDDO
127C------------------------------------------
128 RETURN
#define my_real
Definition cppsort.cpp:32
character *2 function nl()
Definition message.F:2354