OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
parsorc.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| parsorc ../starter/source/output/anim/parsorc.F
25!||--- called by ------------------------------------------------------
26!|| genani1 ../starter/source/output/anim/genani1.F
27!||--- calls -----------------------------------------------------
28!|| facnor ../starter/source/output/anim/facnor.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE parsorc(X ,D ,XNORM,IADD ,CDG ,
32 . BUFEL,IPARG,IXQ ,IXC ,IXTG ,
33 . INVERT,EL2FA,
34 . MATER,IPARTQ,IPARTC,IPARTTG,
35 . ELBUF_TAB)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
40 use element_mod , only : nixq,nixc,nixtg
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54C REAL
55 my_real
56 . x(*),d(*),xnorm(3,*),cdg(*),bufel(*)
57 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IADD(*),IPARG(NPARG,*),
58 . IXQ(NIXQ,*),
59 . invert(*), el2fa(*),mater(*),
60 . ipartq(*),ipartc(*),iparttg(*)
61 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
62C-----------------------------------------------
63C REAL
64 my_real
65 . off
66 INTEGER II(4),IE,NG, ITY, LFT, LLT, KPT, N, I, J,
67 . IPRT, NEL, IAD, NPAR, NFT, IMID,IALEL,MTN,
68 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,
69 . jj, k, sh_ih, ihbe,buf
70 INTEGER NP((NUMELQ + NUMELC + NUMELTG )*4)
71C-----------------------------------------------
72C NORMALE
73C-----------------------------------------------
74 DO k=1,numnod
75 DO j=1,3
76 xnorm(j,k) = zero
77 ENDDO
78 ENDDO
79 ie = 0
80C
81 nn1 = 1
82 nn2 = 1
83 nn3 = 1
84 nn4 = nn3 + numelq
85 nn5 = nn4 + numelc
86 nn6 = nn5 + numeltg
87 nn7 = nn6
88 nn8 = nn7
89 nn9 = nn8
90C-----------------------------------------------
91 npar = 0
92C
93C-----------------------------------------------
94C PART
95C-----------------------------------------------
96 IF(numelq + numelc + numeltg/=0)THEN
97 jj = 0
98
99 DO 500 iprt=1,npart
100 IF(mater(iprt)==0)GOTO 500
101 npar = npar + 1
102 DO 490 ng=1,ngroup
103 mtn =iparg(1,ng)
104 nel =iparg(2,ng)
105 nft =iparg(3,ng)
106 iad =iparg(4,ng)
107 ity =iparg(5,ng)
108 lft=1
109 llt=nel
110C-----------------------------------------------
111C QUAD
112C-----------------------------------------------
113 IF(ity==2)THEN
114 DO 20 i=lft,llt
115 n = i + nft
116 IF(ipartq(n)/=iprt) GOTO 20
117 IF (mtn/=0 .AND. mtn/=13) off=elbuf_tab(ng)%GBUF%OFF(i)
118 ii(1) = ixq(2,n)
119 ii(2) = ixq(3,n)
120 ii(3) = ixq(4,n)
121 ii(4) = ixq(5,n)
122
123 xnorm(1,ii(1)) = one
124 xnorm(2,ii(1)) = zero
125 xnorm(3,ii(1)) = zero
126 ii(1) = ii(1)-1
127 ii(2) = ii(2)-1
128 ii(3) = ii(3)-1
129 ii(4) = ii(4)-1
130 CALL write_i_c(ii,4)
131 ie = ie + 1
132 invert(ie) = 1
133 el2fa(nn3+n) = ie
134 jj = jj + 4
135 20 CONTINUE
136C-----------------------------------------------
137C COQUES
138C-----------------------------------------------
139 ELSEIF(ity==3)THEN
140 kpt =iparg(6,ng)
141 ihbe = iparg(23,ng)
142 sh_ih = 16
143 IF (ihbe>=21.AND.ihbe<=29) sh_ih = 17
144 IF (ihbe==22) sh_ih = sh_ih + 6
145 DO 130 i=lft,llt
146 n = i + nft
147 IF(ipartc(n)/=iprt)GOTO 130
148 IF (mtn/=0 .AND. mtn/=13) off=elbuf_tab(ng)%GBUF%OFF(i)
149 ii(1) = ixc(2,n)
150 ii(2) = ixc(3,n)
151 ii(3) = ixc(4,n)
152 ii(4) = ixc(5,n)
153 ie = ie + 1
154
155 CALL facnor(x,d,ii,xnorm,cdg,invert(ie))
156
157 ii(1) = ii(1)-1
158 ii(2) = ii(2)-1
159 ii(3) = ii(3)-1
160 ii(4) = ii(4)-1
161 CALL write_i_c(ii,4)
162 el2fa(nn4+n) = ie
163 jj = jj + 4
164 130 CONTINUE
165C-----------------------------------------------
166C COQUES 3 NOEUDS
167C-----------------------------------------------
168 ELSEIF(ity==7)THEN
169 kpt =iparg(6,ng)
170 DO 170 i=lft,llt
171 n = i + nft
172 IF(iparttg(n)/=iprt)GOTO 170
173 IF (mtn/=0 .AND. mtn/=13) off=elbuf_tab(ng)%GBUF%OFF(i)
174 ii(1) = ixtg(2,n)
175 ii(2) = ixtg(3,n)
176 ii(3) = ixtg(4,n)
177 ii(4) = ii(3)
178 ie = ie + 1
179 CALL facnor(x,d,ii,xnorm,cdg,invert(ie))
180 ii(1) = ii(1)-1
181 ii(2) = ii(2)-1
182 ii(3) = ii(3)-1
183 ii(4) = ii(4)-1
184 CALL write_i_c(ii,4)
185 el2fa(nn5+n) = ie
186 jj = jj + 4
187 170 CONTINUE
188
189 ELSE
190 ENDIF
191 490 CONTINUE
192C
193
194C-----------------------------------------------
195C PART ADRESS
196C-----------------------------------------------
197 iadd(npar) = ie
198 500 CONTINUE
199 ENDIF
200C-----------------------------------------------
201 RETURN
202 END
my_real
#define my_real
Definition cppsort.cpp:32
invert
subroutine invert(matrix, inverse, n, errorflag)
Definition hm_read_rbe3.F:1368
facnor
subroutine facnor(x, d, ii, xnorm, cdg, invert)
Definition facnor.F:30
parsorc
subroutine parsorc(x, d, xnorm, iadd, cdg, bufel, iparg, ixq, ixc, ixtg, invert, el2fa, mater, ipartq, ipartc, iparttg, elbuf_tab)
Definition parsorc.F:36
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645