OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
torseur.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "spmd_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine torseur (iadg, iparg, itens, ixt, ixp, ixr, el2fa, nbf, tens, tors, nbpart)

Function/Subroutine Documentation

◆ torseur()

subroutine torseur ( integer, dimension(nspmd,*) iadg,
integer, dimension(nparg,*) iparg,
integer itens,
integer, dimension(nixt,*) ixt,
integer, dimension(nixp,*) ixp,
integer, dimension(nixr,*) ixr,
integer, dimension(*) el2fa,
integer nbf,
tens,
tors,
integer nbpart )

Definition at line 35 of file torseur.F.

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
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
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519