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