OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
anioffc.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!|| anioffc ../engine/source/output/anim/generate/anioffc.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| spmd_iget_partn ../engine/source/mpi/anim/spmd_iget_partn.F
29!|| write_c_c ../common_source/tools/input_output/write_routtines.c
30!||--- uses -----------------------------------------------------
31!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
32!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
33!||====================================================================
34 SUBROUTINE anioffc(ELBUF_TAB,IPARG ,IOFF ,EL2FA,NBF ,
35 . IADD ,NBF_L ,NBPART ,IADG ,NODGLOB,
36 . IPART,IPARTC,IPARTTG)
37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_mod
41 USE my_alloc_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 "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "remesh_c.inc"
53#include "scr17_c.inc"
54#include "spmd_c.inc"
55#include "task_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59C REAL
60 INTEGER IPARG(NPARG,*),EL2FA(*),NBF,IOFF(*),
61 . IADD(*),NBF_L,NBPART, IADG(NSPMD,*),NODGLOB(*),
62 . ipart(lipart1,*), ipartc(*), iparttg(*)
63 TYPE (ELBUF_STRUCT_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67C REAL
68 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, NPT,
69 . N, J, LLT, MLW, NBX, IP,
70 . nn, k1, k2,mt,jale, imid,
71 . n1,n2,n3,n4,
72 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,
73 . n_fa, ihbe, sh_ih, istrain, iexpan, iseatbelt
74 INTEGER RBUF,ISROT
75 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFBUF
76 REAL R4
77 TYPE(g_bufel_) ,POINTER :: GBUF
78C---+----1----+----2----+----3----+----4----+----5----+----6----+----7--
79 CALL my_alloc(ioffbuf,nbf_l)
80 nn1 = 1
81 nn2 = 1
82 nn3 = 1
83 nn4 = nn3 + numelq
84 nn5 = nn4 + numelc
85 nn6 = nn5 + numeltg
86 nn7 = nn6
87 nn8 = nn7
88 nn9 = nn8
89 nn10= nn9
90C-----------------------------------------------
91C
92 DO ng=1,ngroup
93 mlw =iparg(1,ng)
94 nel =iparg(2,ng)
95 ity =iparg(5,ng)
96 nft =iparg(3,ng)
97 iad =iparg(4,ng)
98 iseatbelt = iparg(91,ng)
99 lft=1
100 llt=nel
101 nbx = iad - 1
102 gbuf => elbuf_tab(ng)%GBUF
103C-----------------------------------------------
104C QUAD
105C-----------------------------------------------
106 IF (ity == 2) THEN
107 n_fa = nn3 + nft
108C-----------------------------------------------
109C COQUES 4 N
110C-----------------------------------------------
111 ELSEIF(ity == 3)THEN
112 ihbe = iparg(23,ng)
113 npt =iparg(6,ng)
114 istrain=iparg(44,ng)
115 iexpan=iparg(49,ng)
116 n_fa = nn4 + nft
117C-----------------------------------------------
118C COQUES 3 N
119C-----------------------------------------------
120 ELSEIF(ity == 7)THEN
121 npt =iparg(6,ng)
122 istrain=iparg(44,ng)
123 iexpan=iparg(49,ng)
124 n_fa = nn5 + nft
125C-----------------------------------------------
126C RNUR
127C-----------------------------------------------
128 ELSEIF(ity == 50)THEN
129 n_fa = nn9 + nft
130 ELSE
131 ity=0
132 ENDIF
133C-----------------------------------------------
134 IF (ity /= 0) THEN
135 IF (mlw == 0 .OR. mlw == 13 .OR. iseatbelt == 1)THEN
136C-----------------------------------------------
137C DUMMY ELEMENTS
138C-----------------------------------------------
139 DO i=lft,llt
140 ioff(el2fa(n_fa+i)) = 1
141 ENDDO
142 ELSE
143C-----------------------------------------------
144C OFF
145C-----------------------------------------------
146 IF (ity == 2) THEN
147 DO i=lft,llt
148 ioff(el2fa(n_fa+i)) = nint(min(gbuf%OFF(i),one))
149 ENDDO
150 ELSEIF (nadmesh==0 .AND. (ity==3 .OR. ity==7)) THEN
151 DO i=lft,llt
152 ioff(el2fa(n_fa+i)) = nint(min(gbuf%OFF(i),one))
153 ENDDO
154 ELSEIF (ity == 3) THEN
155 DO i=lft,llt
156 ip=ipartc(nft+i)
157 IF(ipart(10,ip)>0)THEN
158 ioff(el2fa(n_fa+i))=nint(max(zero,min(gbuf%OFF(i),one)))
159 ELSE
160 ioff(el2fa(n_fa+i))=nint(min(gbuf%OFF(i),one))
161 END IF
162 ENDDO
163 ELSEIF (ity ==7 ) THEN
164 DO i=lft,llt
165 ip=iparttg(nft+i)
166 IF(ipart(10,ip)>0)THEN
167 ioff(el2fa(n_fa+i))=nint(max(zero,min(gbuf%OFF(i),one)))
168 ELSE
169 ioff(el2fa(n_fa+i))=nint(min(gbuf%OFF(i),one))
170 END IF
171 ENDDO
172 ENDIF
173 ENDIF
174 ENDIF
175C-----------------------------------------------
176 ENDDO
177C-----------------------------------------------
178 IF (nspmd == 1) THEN
179 CALL write_c_c(ioff,nbf)
180 ELSE
181 DO i = 1, nbf_l
182 ioffbuf(i) = ioff(i)
183 ENDDO
184 IF (ispmd == 0) THEN
185 rbuf = (numelqg+numelcg+numeltgg)
186 CALL spmd_iget_partn(1,nbf_l,ioffbuf,nbpart,iadg,rbuf,2)
187 ELSE
188 rbuf = 1
189 CALL spmd_iget_partn(1,nbf_l,ioffbuf,nbpart,iadg,rbuf,2)
190 END IF
191 ENDIF
192C-----------
193 DEALLOCATE(ioffbuf)
194 RETURN
195 END
anioffc
subroutine anioffc(elbuf_tab, iparg, ioff, el2fa, nbf, iadd, nbf_l, nbpart, iadg, nodglob, ipart, ipartc, iparttg)
Definition anioffc.F:37
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
spmd_iget_partn
subroutine spmd_iget_partn(size, nbf_l, np, nbpart, iadg, srbuf, iflag)
Definition spmd_iget_partn.F:50
write_c_c
void write_c_c(int *w, int *len)
Definition write_routtines.c:591