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_routines.c
32!||--- uses -----------------------------------------------------
33!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
34!|| element_mod ../common_source/modules/elements/element_mod.F90
35!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
36!||====================================================================
37 SUBROUTINE parsorc(X ,D ,XNORM,IADD ,CDG ,
38 . BUFEL,IPARG,IXQ ,IXC ,IXTG ,
39 . ELBUF_TAB,INVERT,EL2FA,IADG,
40 . MATER,IPARTQ,IPARTC,IPARTUR,IPARTTG,
41 . NODGLOB)
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE elbufdef_mod
46 USE my_alloc_mod
47 use element_mod , only : nixq,nixc,nixtg
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "task_c.inc"
59#include "spmd_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63C REAL
64 my_real
65 . x(*),d(*),xnorm(3,*),cdg(*),bufel(*)
66 INTEGER IXC(NIXC,*),IXTG(NIXTG,*),IADD(*),IPARG(NPARG,*),
67 . IXQ(NIXQ,*),
68 . invert(*), el2fa(*),mater(*),
69 . iadg(nspmd,*),
70 . ipartq(*),ipartc(*),iparttg(*),ipartur(*),nodglob(*)
71 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
72C-----------------------------------------------
73C REAL
74 my_real
75 . off
76 INTEGER II(4),IE,NG, ITY, LFT, LLT, N, I, J,
77 . IPRT, NEL, IAD, NPAR, NFT,MTN,
78 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,
79 . jj, k, buf
80 INTEGER,DIMENSION(:),ALLOCATABLE::NP
81C-----------------------------------------------
82 CALL MY_ALLOC(NP,(NUMELQ + NUMELC + NUMELTG)*4)
83C-----------------------------------------------
84C NORMALE
85C-----------------------------------------------
86C DO 5 I=1,NUMNOD
87
88 DO k=1,numnod
89 DO j=1,3
90 xnorm(j,k) = zero
91 ENDDO
92 ENDDO
93
94 ie = 0
95C
96 nn1 = 1
97 nn2 = 1
98 nn3 = 1
99 nn4 = nn3 + numelq
100 nn5 = nn4 + numelc
101 nn6 = nn5 + numeltg
102 nn7 = nn6
103 nn8 = nn7
104 nn9 = nn8
105 nn10= nn9
106C-----------------------------------------------
107 npar = 0
108C
109C-----------------------------------------------
110C PART
111C-----------------------------------------------
112 jj = 0
113
114 DO 500 iprt=1,npart
115 IF(mater(iprt) == 0)GOTO 500
116 npar = npar + 1
117 DO 490 ng=1,ngroup
118 mtn =iparg(1,ng)
119 nel =iparg(2,ng)
120 nft =iparg(3,ng)
121 iad =iparg(4,ng)
122 ity =iparg(5,ng)
123 lft=1
124 llt=nel
125C-----------------------------------------------
126C QUAD
127C-----------------------------------------------
128 IF(ity == 2)THEN
129 DO 20 i=lft,llt
130 n = i + nft
131 IF(ipartq(n)/=iprt) GOTO 20
132 IF (mtn/=0 .AND. mtn/=13) off=elbuf_tab(ng)%GBUF%OFF(i)
133 ii(1) = ixq(2,n)
134 ii(2) = ixq(3,n)
135 ii(3) = ixq(4,n)
136 ii(4) = ixq(5,n)
137
138 xnorm(1,ii(1)) = one
139 xnorm(2,ii(1)) = zero
140 xnorm(3,ii(1)) = zero
141 IF (nspmd == 1) THEN
142 ii(1) = ii(1)-1
143 ii(2) = ii(2)-1
144 ii(3) = ii(3)-1
145 ii(4) = ii(4)-1
146 CALL write_i_c(ii,4)
147 ELSE
148 np(jj+1) = nodglob(ii(1))-1
149 np(jj+2) = nodglob(ii(2))-1
150 np(jj+3) = nodglob(ii(3))-1
151 np(jj+4) = nodglob(ii(4))-1
152
153 END IF
154 ie = ie + 1
155 invert(ie) = 1
156 el2fa(nn3+n) = ie
157 jj = jj + 4
158 20 CONTINUE
159C-----------------------------------------------
160C COQUES
161C-----------------------------------------------
162 ELSEIF(ity == 3)THEN
163 DO 130 i=lft,llt
164 n = i + nft
165 IF(ipartc(n)/=iprt)GOTO 130
166 IF (mtn /= 0 .AND. mtn /= 13) off=elbuf_tab(ng)%GBUF%OFF(i)
167 ii(1) = ixc(2,n)
168 ii(2) = ixc(3,n)
169 ii(3) = ixc(4,n)
170 ii(4) = ixc(5,n)
171 ie = ie + 1
172
173 CALL facnor(x,d,ii,xnorm,cdg,invert(ie))
174
175 IF (nspmd == 1) THEN
176 ii(1) = ii(1)-1
177 ii(2) = ii(2)-1
178 ii(3) = ii(3)-1
179 ii(4) = ii(4)-1
180 CALL write_i_c(ii,4)
181 ELSE
182 np(jj+1) = nodglob(ii(1))-1
183 np(jj+2) = nodglob(ii(2))-1
184 np(jj+3) = nodglob(ii(3))-1
185 np(jj+4) = nodglob(ii(4))-1
186
187 END IF
188C IE = IE + 1
189 el2fa(nn4+n) = ie
190 jj = jj + 4
191 130 CONTINUE
192C-----------------------------------------------
193C COQUES 3 NOEUDS
194C-----------------------------------------------
195 ELSEIF(ity == 7)THEN
196 DO 170 i=lft,llt
197 n = i + nft
198 IF(iparttg(n)/=iprt)GOTO 170
199 IF (mtn /= 0 .AND. mtn /= 13) off=elbuf_tab(ng)%GBUF%OFF(i)
200 ii(1) = ixtg(2,n)
201 ii(2) = ixtg(3,n)
202 ii(3) = ixtg(4,n)
203 ii(4) = ii(3)
204 ie = ie + 1
205 CALL facnor(x,d,ii,xnorm,cdg,invert(ie))
206 IF (nspmd == 1) THEN
207 ii(1) = ii(1)-1
208 ii(2) = ii(2)-1
209 ii(3) = ii(3)-1
210 ii(4) = ii(4)-1
211 CALL write_i_c(ii,4)
212 ELSE
213 np(jj+1) = nodglob(ii(1))-1
214 np(jj+2) = nodglob(ii(2))-1
215 np(jj+3) = nodglob(ii(3))-1
216 np(jj+4) = nodglob(ii(4))-1
217
218 END IF
219 el2fa(nn5+n) = ie
220 jj = jj + 4
221 170 CONTINUE
222 ELSE
223 ENDIF
224 490 CONTINUE
225C
226
227C-----------------------------------------------
228C PART ADRESS
229C-----------------------------------------------
230 iadd(npar) = ie
231 500 CONTINUE
232c ENDIF
233 IF (nspmd > 1) THEN
234C build global part array on proc 0
235
236 IF (ispmd == 0) THEN
237
238 CALL spmd_iglob_partn(iadd,npar,iadg,npart)
239
240 buf = (numelqg+numelcg+numeltgg)*4
241 CALL spmd_iget_partn(4,jj,np,npar,iadg,buf,1)
242
243 ELSE
244 buf = 1
245 CALL spmd_iglob_partn(iadd,npar,iadg,1)
246 CALL spmd_iget_partn(4,jj,np,npar,iadg,buf,1)
247
248 ENDIF
249 ELSE ! IADG filling for mono/multi compatibility
250 DO i = 1, npart
251 iadg(1,i) = iadd(i)
252 END DO
253 ENDIF
254 DEALLOCATE(np)
255C-----------------------------------------------
256 RETURN
257 END
258
259
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:42
genani
subroutine genani(x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, igrsurf, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connectivity, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, h3d_data, subset, multi_fvm, knotlocpc, knotlocel, fcont_max, fncontp2, ftcontp2, glob_therm, drape_sh4n, drape_sh3n, drapeg, output)
Definition genani.F:240
invert
subroutine invert(matrix, inverse, n, errorflag)
Definition hm_read_rbe3.F:1368
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_routines.c:645