OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
aniskewf.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!|| aniskewf ../engine/source/output/anim/generate/aniskewf.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| rad_spmd_recv ../engine/source/mpi/generic/rad_spmd_recv.F
29!|| rad_spmd_send ../engine/source/mpi/generic/rad_spmd_send.F
30!|| spmd_igath ../engine/source/mpi/anim/spmd_igath.F
31!|| write_i_c ../common_source/tools/input_output/write_routines.c
32!||--- uses -----------------------------------------------------
33!|| element_mod ../common_source/modules/elements/element_mod.F90
34!||====================================================================
35 SUBROUTINE aniskewf(GEO,SKEW,IPARG,IXR,DD_IAD,LRBUF)
36 use element_mod , only : nixr
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com01_c.inc"
45#include "com04_c.inc"
46#include "param_c.inc"
47#include "task_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51C REAL
52 my_real
53 . geo(npropg,*), skew(lskew,*)
54 INTEGER IXR(NIXR,*),IPARG(NPARG,*),LRBUF,
55 . DD_IAD(NSPMD+1,*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I,ISK,
60 . NEL,LFT,LLT,NG,
61 . ITY,IAD,MLW,NFT,N,II,ISKK,MSGTAG,LEN,IGTYP
62 INTEGER SRBUF(LRBUF)
63 INTEGER, PARAMETER :: INTSIZE = 4
64c
65C-----------------------------------------------
66C SKEW
67C-----------------------------------------------
68 isk=numskw-1
69C spmd
70 ii = 0
71C problem on ISK: incremented by for all elements!
72 msgtag = 1000
73 IF (nspmd > 1 .AND. ispmd/=0) THEN
74
75 CALL rad_spmd_recv(isk,intsize,ispmd-1,
76 . it_spmd,msgtag+ispmd,intsize)
77
78 ENDIF
79C-----------------------------------------------
80C SKEW ELEMENT 1D
81C-----------------------------------------------
82C
83 DO ng=1,ngroup
84 mlw =iparg(1,ng)
85 nel =iparg(2,ng)
86 ity =iparg(5,ng)
87 nft =iparg(3,ng)
88 iad =iparg(4,ng)
89 igtyp =iparg(38,ng)
90 lft = 1
91 llt = nel
92C-----------------------------------------------
93C TRUSS
94C-----------------------------------------------
95 IF(ity==4)THEN
96 DO i=lft,llt
97 isk=isk+1
98 ii = ii + 1
99 srbuf(ii) = isk
100 ENDDO
101C-----------------------------------------------
102C POUTRES
103C-----------------------------------------------
104 ELSEIF(ity==5)THEN
105 DO i=lft,llt
106 isk=isk+1
107 ii = ii + 1
108 srbuf(ii) = isk
109 ENDDO
110C-----------------------------------------------
111C RESSORTS
112C-----------------------------------------------
113 ELSEIF(ity==6)THEN
114 IF(mlw==1.OR.mlw==7)THEN
115 DO i=lft,llt
116 isk=isk+1
117 ii = ii + 1
118 srbuf(ii) = isk
119 ENDDO
120 ELSEIF(mlw==2)THEN
121 DO i=lft,llt
122 n=i+nft
123 iskk=nint(geo(2,ixr(1,n)))-1
124 ii = ii + 1
125 srbuf(ii) = iskk
126 ENDDO
127 ELSEIF(mlw==3)THEN
128 DO i=lft,llt
129 isk=isk+1
130 ii = ii + 1
131 srbuf(ii) = isk
132 isk=isk+1
133 ii = ii + 1
134 srbuf(ii) = isk
135 ENDDO
136 ELSEIF((mlw >= 4 .AND. mlw <= 6 ) .OR. igtyp == 23)THEN
137 DO i=lft,llt
138 isk=isk+1
139 ii = ii + 1
140 srbuf(ii) = isk
141 ENDDO
142 ENDIF
143 ELSE
144 ENDIF
145 ENDDO
146
147 IF (nspmd > 1) THEN
148 IF (ispmd/=nspmd-1) THEN
149 CALL rad_spmd_send(isk,intsize,ispmd+1,
150 . it_spmd,msgtag+ispmd+1,intsize)
151 ENDIF
152
153 CALL spmd_igath(srbuf,ii,len)
154 ELSE
155 len = ii
156 END IF
157 IF (ispmd==0) THEN
158 CALL write_i_c(srbuf,len)
159 ENDIF
160C ENDIF
161
162C
163 RETURN
164 END
165
166!||====================================================================
167!|| cntskew ../engine/source/output/anim/generate/aniskewf.F
168!||--- called by ------------------------------------------------------
169!|| genani ../engine/source/output/anim/generate/genani.F
170!||--- calls -----------------------------------------------------
171!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
172!||====================================================================
173 SUBROUTINE cntskew(IPARG,CNT,CNTG)
174C-----------------------------------------------
175C I m p l i c i t T y p e s
176C-----------------------------------------------
177#include "implicit_f.inc"
178C-----------------------------------------------
179C C o m m o n B l o c k s
180C-----------------------------------------------
181#include "com01_c.inc"
182#include "param_c.inc"
183C-----------------------------------------------
184C D u m m y A r g u m e n t s
185C-----------------------------------------------
186 INTEGER IPARG(NPARG,*),CNT,CNTG
187
188C-----------------------------------------------
189C L o c a l V a r i a b l e s
190C-----------------------------------------------
191 INTEGER NG,MLW,NEL,ITY
192 cnt = 0
193 DO ng=1,ngroup
194 mlw =iparg(1,ng)
195 nel =iparg(2,ng)
196 ity =iparg(5,ng)
197
198 IF (ity==4.OR.ity==5.OR.ity==6) THEN
199 IF (mlw==3) THEN
200 cnt=cnt+2*nel
201 ELSE
202 cnt = cnt+nel
203 ENDIF
204 ENDIF
205 ENDDO
206
207 cntg = cnt
208 IF (nspmd > 1) CALL spmd_glob_isum9(cntg,1)
209 END
my_real
#define my_real
Definition cppsort.cpp:32
cntskew
subroutine cntskew(iparg, cnt, cntg)
Definition aniskewf.F:174
aniskewf
subroutine aniskewf(geo, skew, iparg, ixr, dd_iad, lrbuf)
Definition aniskewf.F:36
rad_spmd_recv
subroutine rad_spmd_recv(a, siz, ispmd, it_spmd, msgtag, intsize)
Definition rad_spmd_recv.F:34
rad_spmd_send
subroutine rad_spmd_send(a, siz, ispmd, it_spmd, msgtag, intsize)
Definition rad_spmd_send.F:34
spmd_igath
subroutine spmd_igath(srbuf, len, lrecv)
Definition spmd_igath.F:34
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645