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 34 of file torseur.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE my_alloc_mod
41C-----------------------------------------------
42C I m p l i c i t T y p e s
43C-----------------------------------------------
44#include "implicit_f.inc"
45C-----------------------------------------------
46C C o m m o n B l o c k s
47C-----------------------------------------------
48#include "com01_c.inc"
49#include "com04_c.inc"
50#include "param_c.inc"
51#include "task_c.inc"
52#include "spmd_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56C REAL
57 my_real
58 . tens(9,*),tors(15,*)
59 INTEGER IPARG(NPARG,*),ITENS,
60 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),EL2FA(*),
61 . NBF,NBPART,IADG(NSPMD,*)
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65C REAL
66 my_real
67 . off, fac, a1, a2, a3, thk
68 REAL R4(18)
69 INTEGER I, NG, NEL, NFT, IAD, ITY, LFT, NPT, IPT,M,
70 . IADD, N, J, LLT, MLW, NB1, NB2, NB3, NB4, NB5,
71 . NB6, NB7, NB8, NB9, NB10, NB11, NB12, ISTRAIN,
72 . IPID, I1, I2, IAD2, NS1, NS2 , IALEL, ISTRE,
73 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,NNI,N0,
74 . IHBE,BUF
75 REAL,DIMENSION(:),ALLOCATABLE :: WAL
76C-----------------------------------------------
77 CALL my_alloc(wal,9*nbf)
78 DO 5 j=1,18
79 r4(j) = zero
80 5 CONTINUE
81C
82C
83 nn1 = 1
84 nn2 = nn1
85 nn3 = nn2
86 nn4 = nn3
87 nn5 = nn4
88 nn6 = nn5
89 nn7 = nn6 + numelt
90 nn8 = nn7 + numelp
91 nn9 = nn8 + numelr
92 nn10= nn9
93C
94 DO 490 ng=1,ngroup
95C IF(ANIM_K==0.AND.IPARG(8,NG)==1)GOTO 490
96 mlw =iparg(1,ng)
97 nel =iparg(2,ng)
98 nft =iparg(3,ng)
99 iad =iparg(4,ng)
100 ity =iparg(5,ng)
101 nb1 =iad - 1
102 lft=1
103 llt=nel
104C-----------------------------------------------
105C TRUSS
106C-----------------------------------------------
107 IF(ity==4)THEN
108 DO i=lft,llt
109 n = i + nft
110 tens(1,el2fa(nn6+n)) = tors(1,n)
111 tens(2,el2fa(nn6+n)) = tors(2,n)
112 tens(3,el2fa(nn6+n)) = tors(3,n)
113 tens(4,el2fa(nn6+n)) = tors(4,n)
114 tens(5,el2fa(nn6+n)) = tors(5,n)
115 tens(6,el2fa(nn6+n)) = tors(6,n)
116 tens(7,el2fa(nn6+n)) = tors(7,n)
117 tens(8,el2fa(nn6+n)) = tors(8,n)
118 tens(9,el2fa(nn6+n)) = tors(9,n)
119 ENDDO
120C-----------------------------------------------
121C POUTRES
122C-----------------------------------------------
123 ELSEIF(ity==5)THEN
124 DO i=lft,llt
125 n = i + nft
126 m = n+numelt
127 tens(1,el2fa(nn7+n)) = tors(1,m)
128 tens(2,el2fa(nn7+n)) = tors(2,m)
129 tens(3,el2fa(nn7+n)) = tors(3,m)
130 tens(4,el2fa(nn7+n)) = tors(4,m)
131 tens(5,el2fa(nn7+n)) = tors(5,m)
132 tens(6,el2fa(nn7+n)) = tors(6,m)
133 tens(7,el2fa(nn7+n)) = tors(7,m)
134 tens(8,el2fa(nn7+n)) = tors(8,m)
135 tens(9,el2fa(nn7+n)) = tors(9,m)
136 ENDDO
137C-----------------------------------------------
138C RESSORTS
139C-----------------------------------------------
140 ELSEIF(ity==6)THEN
141 DO i=lft,llt
142 n = i + nft
143 m = n+numelt+numelp
144 tens(1,el2fa(nn8+n)) = tors(1,m)
145 tens(2,el2fa(nn8+n)) = tors(2,m)
146 tens(3,el2fa(nn8+n)) = tors(3,m)
147 IF(mlw==3)THEN
148 tens(4,el2fa(nn8+n)) = zero
149 tens(5,el2fa(nn8+n)) = zero
150 tens(6,el2fa(nn8+n)) = zero
151 tens(7,el2fa(nn8+n)) = zero
152 tens(8,el2fa(nn8+n)) = zero
153 tens(9,el2fa(nn8+n)) = zero
154 tens(1,el2fa(nn8+n)+1) = tors(4,m)
155 tens(2,el2fa(nn8+n)+1) = tors(5,m)
156 tens(3,el2fa(nn8+n)+1) = tors(6,m)
157 tens(4,el2fa(nn8+n)+1) = zero
158 tens(5,el2fa(nn8+n)+1) = zero
159 tens(6,el2fa(nn8+n)+1) = zero
160 tens(7,el2fa(nn8+n)+1) = zero
161 tens(8,el2fa(nn8+n)+1) = zero
162 tens(9,el2fa(nn8+n)+1) = zero
163 ELSE
164 tens(4,el2fa(nn8+n)) = tors(4,m)
165 tens(5,el2fa(nn8+n)) = tors(5,m)
166 tens(6,el2fa(nn8+n)) = tors(6,m)
167 tens(7,el2fa(nn8+n)) = tors(7,m)
168 tens(8,el2fa(nn8+n)) = tors(8,m)
169 tens(9,el2fa(nn8+n)) = tors(9,m)
170 ENDIF
171 ENDDO
172C-----------------------------------------------
173 ELSE
174 ENDIF
175 490 CONTINUE
176 500 CONTINUE
177C-----------------------------------------------
178 IF (nspmd == 1)THEN
179 DO n=1,nbf
180 r4(1) = tens(1,n)
181 r4(2) = tens(2,n)
182 r4(3) = tens(3,n)
183 r4(4) = tens(4,n)
184 r4(5) = tens(5,n)
185 r4(6) = tens(6,n)
186 r4(7) = tens(7,n)
187 r4(8) = tens(8,n)
188 r4(9) = tens(9,n)
189 CALL write_r_c(r4,9)
190 ENDDO
191 ELSE
192 DO n = 1, nbf
193 wal(9*n-8) = tens(1,n)
194 wal(9*n-7) = tens(2,n)
195 wal(9*n-6) = tens(3,n)
196 wal(9*n-5) = tens(4,n)
197 wal(9*n-4) = tens(5,n)
198 wal(9*n-3) = tens(6,n)
199 wal(9*n-2) = tens(7,n)
200 wal(9*n-1) = tens(8,n)
201 wal(9*n ) = tens(9,n)
202 ENDDO
203 IF (ispmd==0) THEN
204 buf = 9*nb1dg
205 ELSE
206 buf = 1
207 ENDIF
208 CALL spmd_r4get_partn(9,9*nbf,nbpart,iadg,wal,buf)
209 ENDIF
210C
211C-----------------------------------------------
212 DEALLOCATE(wal)
213 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_routtines.c:519