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 ../engine/source/output/anim/generate/parsorc.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| facnor ../engine/source/output/anim/generate/facnor.F
29!|| spmd_iget_partn ../engine/source/mpi/anim/spmd_iget_partn.F
30!|| spmd_iglob_partn ../engine/source/mpi/anim/spmd_iglob_partn.F
31!|| write_i_c ../common_source/tools/input_output/write_routtines.c
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
34!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
35!||====================================================================
36 SUBROUTINE parsorc(X ,D ,XNORM,IADD ,CDG ,
37 . BUFEL,IPARG,IXQ ,IXC ,IXTG ,
38 . ELBUF_TAB,INVERT,EL2FA,IADG,
39 . MATER,IPARTQ,IPARTC,IPARTUR,IPARTTG,
40 . NODGLOB)
41C-----------------------------------------------
42C M o d u l e s
43C-----------------------------------------------
44 USE elbufdef_mod
45 USE my_alloc_mod
46C-----------------------------------------------
47C I m p l i c i t T y p e s
48C-----------------------------------------------
49#include "implicit_f.inc"
50C-----------------------------------------------
51C C o m m o n B l o c k s
52C-----------------------------------------------
53#include "com01_c.inc"
54#include "com04_c.inc"
55#include "param_c.inc"
56#include "task_c.inc"
57#include "spmd_c.inc"
58C-----------------------------------------------
59C D u m m y A r g u m e n t s
60C-----------------------------------------------
61C REAL
62 my_real
63 . x(*),d(*),xnorm(3,*),cdg(*),bufel(*)
64 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IADD(*),IPARG(NPARG,*),
65 . IXQ(NIXQ,*),
66 . invert(*), el2fa(*),mater(*),
67 . iadg(nspmd,*),
68 . ipartq(*),ipartc(*),iparttg(*),ipartur(*),nodglob(*)
69 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
70C-----------------------------------------------
71C REAL
72 my_real
73 . off
74 INTEGER II(4),IE,NG, ITY, LFT, LLT, N, I, J,
75 . IPRT, NEL, IAD, NPAR, NFT, IMID,IALEL,MTN,
76 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,
77 . jj, k, sh_ih, buf
78 INTEGER,DIMENSION(:),ALLOCATABLE::NP
79C-----------------------------------------------
80 CALL MY_ALLOC(NP,(NUMELQ + NUMELC + NUMELTG)*4)
81C-----------------------------------------------
82C NORMALE
83C-----------------------------------------------
84C DO 5 I=1,NUMNOD
85
86 DO k=1,numnod
87 DO j=1,3
88 xnorm(j,k) = zero
89 ENDDO
90 ENDDO
91
92 ie = 0
93C
94 nn1 = 1
95 nn2 = 1
96 nn3 = 1
97 nn4 = nn3 + numelq
98 nn5 = nn4 + numelc
99 nn6 = nn5 + numeltg
100 nn7 = nn6
101 nn8 = nn7
102 nn9 = nn8
103 nn10= nn9
104C-----------------------------------------------
105 npar = 0
106C
107C-----------------------------------------------
108C PART
109C-----------------------------------------------
110 jj = 0
111
112 DO 500 iprt=1,npart
113 IF(mater(iprt) == 0)GOTO 500
114 npar = npar + 1
115 DO 490 ng=1,ngroup
116 mtn =iparg(1,ng)
117 nel =iparg(2,ng)
118 nft =iparg(3,ng)
119 iad =iparg(4,ng)
120 ity =iparg(5,ng)
121 lft=1
122 llt=nel
123C-----------------------------------------------
124C QUAD
125C-----------------------------------------------
126 IF(ity == 2)THEN
127 DO 20 i=lft,llt
128 n = i + nft
129 IF(ipartq(n)/=iprt) GOTO 20
130 IF (mtn/=0 .AND. mtn/=13) off=elbuf_tab(ng)%GBUF%OFF(i)
131 ii(1) = ixq(2,n)
132 ii(2) = ixq(3,n)
133 ii(3) = ixq(4,n)
134 ii(4) = ixq(5,n)
135
136 xnorm(1,ii(1)) = one
137 xnorm(2,ii(1)) = zero
138 xnorm(3,ii(1)) = zero
139 IF (nspmd == 1) THEN
140 ii(1) = ii(1)-1
141 ii(2) = ii(2)-1
142 ii(3) = ii(3)-1
143 ii(4) = ii(4)-1
144 CALL write_i_c(ii,4)
145 ELSE
146 np(jj+1) = nodglob(ii(1))-1
147 np(jj+2) = nodglob(ii(2))-1
148 np(jj+3) = nodglob(ii(3))-1
149 np(jj+4) = nodglob(ii(4))-1
150
151 END IF
152 ie = ie + 1
153 invert(ie) = 1
154 el2fa(nn3+n) = ie
155 jj = jj + 4
156 20 CONTINUE
157C-----------------------------------------------
158C COQUES
159C-----------------------------------------------
160 ELSEIF(ity == 3)THEN
161 DO 130 i=lft,llt
162 n = i + nft
163 IF(ipartc(n)/=iprt)GOTO 130
164 IF (mtn /= 0 .AND. mtn /= 13) off=elbuf_tab(ng)%GBUF%OFF(i)
165 ii(1) = ixc(2,n)
166 ii(2) = ixc(3,n)
167 ii(3) = ixc(4,n)
168 ii(4) = ixc(5,n)
169 ie = ie + 1
170
171 CALL facnor(x,d,ii,xnorm,cdg,invert(ie))
172
173 IF (nspmd == 1) THEN
174 ii(1) = ii(1)-1
175 ii(2) = ii(2)-1
176 ii(3) = ii(3)-1
177 ii(4) = ii(4)-1
178 CALL write_i_c(ii,4)
179 ELSE
180 np(jj+1) = nodglob(ii(1))-1
181 np(jj+2) = nodglob(ii(2))-1
182 np(jj+3) = nodglob(ii(3))-1
183 np(jj+4) = nodglob(ii(4))-1
184
185 END IF
186C IE = IE + 1
187 el2fa(nn4+n) = ie
188 jj = jj + 4
189 130 CONTINUE
190C-----------------------------------------------
191C COQUES 3 NOEUDS
192C-----------------------------------------------
193 ELSEIF(ity == 7)THEN
194 DO 170 i=lft,llt
195 n = i + nft
196 IF(iparttg(n)/=iprt)GOTO 170
197 IF (mtn /= 0 .AND. mtn /= 13) off=elbuf_tab(ng)%GBUF%OFF(i)
198 ii(1) = ixtg(2,n)
199 ii(2) = ixtg(3,n)
200 ii(3) = ixtg(4,n)
201 ii(4) = ii(3)
202 ie = ie + 1
203 CALL facnor(x,d,ii,xnorm,cdg,invert(ie))
204 IF (nspmd == 1) THEN
205 ii(1) = ii(1)-1
206 ii(2) = ii(2)-1
207 ii(3) = ii(3)-1
208 ii(4) = ii(4)-1
209 CALL write_i_c(ii,4)
210 ELSE
211 np(jj+1) = nodglob(ii(1))-1
212 np(jj+2) = nodglob(ii(2))-1
213 np(jj+3) = nodglob(ii(3))-1
214 np(jj+4) = nodglob(ii(4))-1
215
216 END IF
217 el2fa(nn5+n) = ie
218 jj = jj + 4
219 170 CONTINUE
220 ELSE
221 ENDIF
222 490 CONTINUE
223C
224
225C-----------------------------------------------
226C PART ADRESS
227C-----------------------------------------------
228 iadd(npar) = ie
229 500 CONTINUE
230c ENDIF
231 IF (nspmd > 1) THEN
232C construction tableau global des parts sur p0
233
234 IF (ispmd == 0) THEN
235
236 CALL spmd_iglob_partn(iadd,npar,iadg,npart)
237
238 buf = (numelqg+numelcg+numeltgg)*4
239 CALL spmd_iget_partn(4,jj,np,npar,iadg,buf,1)
240
241 ELSE
242 buf = 1
243 CALL spmd_iglob_partn(iadd,npar,iadg,1)
244 CALL spmd_iget_partn(4,jj,np,npar,iadg,buf,1)
245
246 ENDIF
247 ELSE ! remplissage IADG pour compatibilite mono/multi
248 DO i = 1, npart
249 iadg(1,i) = iadd(i)
250 END DO
251 ENDIF
252 DEALLOCATE(np)
253C-----------------------------------------------
254 RETURN
255 END
256
257
my_real
#define my_real
Definition cppsort.cpp:32
parsorc
subroutine parsorc(x, d, xnorm, iadd, cdg, bufel, iparg, ixq, ixc, ixtg, elbuf_tab, invert, el2fa, iadg, mater, ipartq, ipartc, ipartur, iparttg, nodglob)
Definition parsorc.F:41
invert
subroutine invert(matrix, inverse, n, errorflag)
Definition hm_read_rbe3.F:1354
spmd_iget_partn
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
Definition spmd_iget_partn.F:50
spmd_iglob_partn
subroutine spmd_iglob_partn(iad, nbpart, iadg, sbuf)
Definition spmd_iglob_partn.F:39
facnor
subroutine facnor(x, d, ii, xnorm, cdg, invert)
Definition facnor.F:30
write_i_c
void write_i_c(int *w, int *len)
Definition write_routtines.c:645