OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
torseur.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/.
23C | SPMD_R4GATHER_PART /spe/spmd_anim.F
24!||====================================================================
25!|| torseur ../engine/source/output/anim/generate/torseur.F
26!||--- called by ------------------------------------------------------
27!|| genani ../engine/source/output/anim/generate/genani.F
28!||--- calls -----------------------------------------------------
29!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
30!|| write_r_c ../common_source/tools/input_output/write_routines.c
31!||--- uses -----------------------------------------------------
32!|| element_mod ../common_source/modules/elements/element_mod.F90
33!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
34!||====================================================================
35 SUBROUTINE torseur(IADG ,IPARG,ITENS,IXT ,IXP ,
36 . IXR ,EL2FA,NBF ,TENS ,TORS ,
37 . NBPART)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE my_alloc_mod
42 use element_mod , only : nixt,nixr,nixp
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "com04_c.inc"
52#include "param_c.inc"
53#include "task_c.inc"
54#include "spmd_c.inc"
55C-----------------------------------------------
56C D u m m y A r g u m e n t s
57C-----------------------------------------------
58C REAL
59 my_real
60 . tens(9,*),tors(15,*)
61 INTEGER IPARG(NPARG,*),ITENS,
62 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),EL2FA(*),
63 . nbf,nbpart,iadg(nspmd,*)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67C REAL
68 REAL R4(18)
69 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, M,
70 . n, j, llt, mlw, nb1,
71 . nn1,nn2,nn3,nn4,nn5,nn6,nn7,nn8,nn9,nn10,
72 . buf
73 REAL,DIMENSION(:),ALLOCATABLE :: WAL
74C-----------------------------------------------
75 CALL my_alloc(wal,9*nbf)
76 DO 5 j=1,18
77 r4(j) = zero
78 5 CONTINUE
79C
80C
81 nn1 = 1
82 nn2 = nn1
83 nn3 = nn2
84 nn4 = nn3
85 nn5 = nn4
86 nn6 = nn5
87 nn7 = nn6 + numelt
88 nn8 = nn7 + numelp
89 nn9 = nn8 + numelr
90 nn10= nn9
91C
92 DO 490 ng=1,ngroup
93C IF(ANIM_K==0.AND.IPARG(8,NG)==1)GOTO 490
94 mlw =iparg(1,ng)
95 nel =iparg(2,ng)
96 nft =iparg(3,ng)
97 iad =iparg(4,ng)
98 ity =iparg(5,ng)
99 nb1 =iad - 1
100 lft=1
101 llt=nel
102C-----------------------------------------------
103C TRUSS
104C-----------------------------------------------
105 IF(ity==4)THEN
106 DO i=lft,llt
107 n = i + nft
108 tens(1,el2fa(nn6+n)) = tors(1,n)
109 tens(2,el2fa(nn6+n)) = tors(2,n)
110 tens(3,el2fa(nn6+n)) = tors(3,n)
111 tens(4,el2fa(nn6+n)) = tors(4,n)
112 tens(5,el2fa(nn6+n)) = tors(5,n)
113 tens(6,el2fa(nn6+n)) = tors(6,n)
114 tens(7,el2fa(nn6+n)) = tors(7,n)
115 tens(8,el2fa(nn6+n)) = tors(8,n)
116 tens(9,el2fa(nn6+n)) = tors(9,n)
117 ENDDO
118C-----------------------------------------------
119C POUTRES
120C-----------------------------------------------
121 ELSEIF(ity==5)THEN
122 DO i=lft,llt
123 n = i + nft
124 m = n+numelt
125 tens(1,el2fa(nn7+n)) = tors(1,m)
126 tens(2,el2fa(nn7+n)) = tors(2,m)
127 tens(3,el2fa(nn7+n)) = tors(3,m)
128 tens(4,el2fa(nn7+n)) = tors(4,m)
129 tens(5,el2fa(nn7+n)) = tors(5,m)
130 tens(6,el2fa(nn7+n)) = tors(6,m)
131 tens(7,el2fa(nn7+n)) = tors(7,m)
132 tens(8,el2fa(nn7+n)) = tors(8,m)
133 tens(9,el2fa(nn7+n)) = tors(9,m)
134 ENDDO
135C-----------------------------------------------
136C RESSORTS
137C-----------------------------------------------
138 ELSEIF(ity==6)THEN
139 DO i=lft,llt
140 n = i + nft
141 m = n+numelt+numelp
142 tens(1,el2fa(nn8+n)) = tors(1,m)
143 tens(2,el2fa(nn8+n)) = tors(2,m)
144 tens(3,el2fa(nn8+n)) = tors(3,m)
145 IF(mlw==3)THEN
146 tens(4,el2fa(nn8+n)) = zero
147 tens(5,el2fa(nn8+n)) = zero
148 tens(6,el2fa(nn8+n)) = zero
149 tens(7,el2fa(nn8+n)) = zero
150 tens(8,el2fa(nn8+n)) = zero
151 tens(9,el2fa(nn8+n)) = zero
152 tens(1,el2fa(nn8+n)+1) = tors(4,m)
153 tens(2,el2fa(nn8+n)+1) = tors(5,m)
154 tens(3,el2fa(nn8+n)+1) = tors(6,m)
155 tens(4,el2fa(nn8+n)+1) = zero
156 tens(5,el2fa(nn8+n)+1) = zero
157 tens(6,el2fa(nn8+n)+1) = zero
158 tens(7,el2fa(nn8+n)+1) = zero
159 tens(8,el2fa(nn8+n)+1) = zero
160 tens(9,el2fa(nn8+n)+1) = zero
161 ELSE
162 tens(4,el2fa(nn8+n)) = tors(4,m)
163 tens(5,el2fa(nn8+n)) = tors(5,m)
164 tens(6,el2fa(nn8+n)) = tors(6,m)
165 tens(7,el2fa(nn8+n)) = tors(7,m)
166 tens(8,el2fa(nn8+n)) = tors(8,m)
167 tens(9,el2fa(nn8+n)) = tors(9,m)
168 ENDIF
169 ENDDO
170C-----------------------------------------------
171 ELSE
172 ENDIF
173 490 CONTINUE
174 500 CONTINUE
175C-----------------------------------------------
176 IF (nspmd == 1)THEN
177 DO n=1,nbf
178 r4(1) = tens(1,n)
179 r4(2) = tens(2,n)
180 r4(3) = tens(3,n)
181 r4(4) = tens(4,n)
182 r4(5) = tens(5,n)
183 r4(6) = tens(6,n)
184 r4(7) = tens(7,n)
185 r4(8) = tens(8,n)
186 r4(9) = tens(9,n)
187 CALL write_r_c(r4,9)
188 ENDDO
189 ELSE
190 DO n = 1, nbf
191 wal(9*n-8) = tens(1,n)
192 wal(9*n-7) = tens(2,n)
193 wal(9*n-6) = tens(3,n)
194 wal(9*n-5) = tens(4,n)
195 wal(9*n-4) = tens(5,n)
196 wal(9*n-3) = tens(6,n)
197 wal(9*n-2) = tens(7,n)
198 wal(9*n-1) = tens(8,n)
199 wal(9*n ) = tens(9,n)
200 ENDDO
201 IF (ispmd==0) THEN
202 buf = 9*nb1dg
203 ELSE
204 buf = 1
205 ENDIF
206 CALL spmd_r4get_partn(9,9*nbf,nbpart,iadg,wal,buf)
207 ENDIF
208C
209C-----------------------------------------------
210 DEALLOCATE(wal)
211 RETURN
212 END
my_real
#define my_real
Definition cppsort.cpp:32
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
torseur
subroutine torseur(iadg, iparg, itens, ixt, ixp, ixr, el2fa, nbf, tens, tors, nbpart)
Definition torseur.F:38
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519