OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_r_full.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "scr16_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine stat_r_full (elbuf_tab, iparg, geo, igeo, ixr, wa, wap0, ipartr, ipart_state, stat_indxr, sizp0)

Function/Subroutine Documentation

◆ stat_r_full()

subroutine stat_r_full ( type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
integer, dimension(nparg,*) iparg,
geo,
integer, dimension(npropgi,*) igeo,
integer, dimension(nixr,*) ixr,
double precision, dimension(*) wa,
double precision, dimension(*) wap0,
integer, dimension(*) ipartr,
integer, dimension(*) ipart_state,
integer, dimension(*) stat_indxr,
integer sizp0 )

Definition at line 33 of file stat_r_full.F.

37C-----------------------------------------------
38C M o d u l e s
39C-----------------------------------------------
40 USE elbufdef_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 "param_c.inc"
50#include "units_c.inc"
51#include "task_c.inc"
52#include "scr16_c.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER SIZLOC,SIZP0
57 INTEGER IXR(NIXR,*),IPARG(NPARG,*),IGEO(NPROPGI,*),
58 . IPARTR(*),IPART_STATE(*),STAT_INDXR(*)
59 my_real
60 . geo(npropg,*)
61 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
62 double precision WA(*),WAP0(*)
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J,K,N,II(6),IV,JJ,LEN,IOFF,IE,NG,NEL,NFT,LFT,
67 . LLT,ITY,ID,IPRT0,IPRT,IGTYP,IPROP,NUVAR,J_FIN
68 INTEGER PTWA(STAT_NUMELR),
69 . PTWA_P0(0:MAX(1,STAT_NUMELR_G))
70 CHARACTER*100 DELIMIT,LINE
71 TYPE(G_BUFEL_) ,POINTER :: GBUF
72C-----------------------------------------------
73 DATA delimit(1:60)
74 ./'#---1----|----2----|----3----|----4----|----5----|----6----|'/
75 DATA delimit(61:100)
76 ./'----7----|----8----|----9----|----10---|'/
77C=======================================================================
78C SPRING
79C-----------------------------------------------
80 jj = 0
81C
82 IF (stat_numelr == 0) GOTO 100
83C
84 ie=0
85 DO ng=1,ngroup
86 ity = iparg(5,ng)
87 IF (ity == 6) THEN
88 gbuf => elbuf_tab(ng)%GBUF
89 nel = iparg(2,ng)
90 nft = iparg(3,ng)
91 iprop = ixr(1,nft+1)
92 igtyp = igeo(11,iprop)
93 lft=1
94 llt=nel
95C
96 DO i=lft,llt
97 n = i + nft
98 iprt=ipartr(n)
99 IF (ipart_state(iprt) == 0) cycle
100 wa(jj + 1) = gbuf%OFF(i)
101 wa(jj + 2) = iprt
102 wa(jj + 3) = ixr(nixr,n)
103 wa(jj + 4) = igtyp
104 wa(jj + 5) = 0 ! for NUVAR
105 jj = jj + 5
106C------------
107 IF (igtyp == 4) THEN
108C------------
109 wa(jj + 1) = gbuf%FOR(i)
110 wa(jj + 2) = gbuf%TOTDEPL(i)
111 wa(jj + 3) = gbuf%FOREP(i)
112 wa(jj + 4) = gbuf%DEP_IN_TENS(i)
113 wa(jj + 5) = gbuf%DEP_IN_COMP(i)
114 wa(jj + 6) = gbuf%LENGTH(i)
115 wa(jj + 7) = gbuf%EINT(i)
116cc
117 jj = jj + 7
118C------------
119 ELSEIF (igtyp == 12) THEN
120C------------
121 wa(jj + 1) = gbuf%FOR(i)
122 wa(jj + 2) = gbuf%TOTDEPL(i)
123 wa(jj + 3) = gbuf%FOREP(i)
124 wa(jj + 4) = gbuf%DEP_IN_TENS(i)
125 wa(jj + 5) = gbuf%DEP_IN_COMP(i)
126 wa(jj + 6) = gbuf%LENGTH(i)
127 wa(jj + 7) = gbuf%EINT(i)
128 wa(jj + 8) = gbuf%DFS(i)
129cc
130 jj = jj + 8
131C------------
132 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
133 . .OR. igtyp == 23 ) THEN
134C------------
135 DO j=1,6
136 ii(j) = (j-1)*nel + 1
137 ENDDO
138 DO j=1,3
139 wa(jj + (j-1)*5 + 1) = gbuf%FOR(ii(j) + i - 1)
140 wa(jj + (j-1)*5 + 2) = gbuf%TOTDEPL(ii(j) + i - 1)
141 wa(jj + (j-1)*5 + 3) = gbuf%FOREP(ii(j) + i - 1)
142 wa(jj + (j-1)*5 + 4) = gbuf%DEP_IN_TENS(ii(j) + i - 1)
143 wa(jj + (j-1)*5 + 5) = gbuf%DEP_IN_COMP(ii(j) + i - 1)
144 wa(jj + (j-1)*5 + 16)= gbuf%MOM(ii(j) + i - 1)
145 wa(jj + (j-1)*5 + 17)= gbuf%TOTROT(ii(j) + i - 1)
146 wa(jj + (j-1)*5 + 18)= gbuf%MOMEP(ii(j) + i - 1)
147 wa(jj + (j-1)*5 + 19)= gbuf%ROT_IN_TENS(ii(j) + i - 1)
148 wa(jj + (j-1)*5 + 20)= gbuf%ROT_IN_COMP(ii(j) + i - 1)
149 wa(jj + j + 30) = gbuf%LENGTH(ii(j) + i - 1)
150 ENDDO
151 wa(jj + 34) = gbuf%EINT(i)
152 DO j=1,6
153 wa(jj + j + 34) = gbuf%E6(ii(j) + i - 1) ! E6(1:6)
154 ENDDO
155 jj = jj + 40
156C------------
157 ELSEIF (igtyp == 26) THEN
158C------------
159 wa(jj + 1) = gbuf%FOR(i)
160 wa(jj + 2) = gbuf%TOTDEPL(i)
161 wa(jj + 3) = gbuf%FOREP(i)
162 wa(jj + 4) = gbuf%LENGTH(i)
163 wa(jj + 5) = gbuf%EINT(i)
164 wa(jj + 6) = gbuf%DV(i)
165 jj = jj + 6
166C------------
167 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
168 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
169 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
170 . igtyp == 46) THEN
171C------------
172 nuvar = nint(geo(25,iprop))
173 wa(jj) = nuvar
174 DO j=1,3
175 ii(j) = (j-1)*nel + 1
176 wa(jj + (j-1)*2 + 1) = gbuf%FOR(ii(j) + i - 1)
177 wa(jj + (j-1)*2 + 2) = gbuf%V_REPCVT(ii(j) + i - 1)
178 wa(jj + (j-1)*2 + 7) = gbuf%MOM(ii(j) + i - 1)
179 wa(jj + (j-1)*2 + 8) = gbuf%VR_REPCVT(ii(j) + i - 1)
180 ENDDO
181 wa(jj + 13) = gbuf%EINT(i)
182 jj = jj + 13
183!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
184!! WA(JJ + 1) = GBUF%MOM(II(4) + I - 1) ! MOM1Y
185!! WA(JJ + 2) = GBUF%MOM(II(5) + I - 1) ! MOM1Z
186!! JJ = JJ + 2
187!! ENDIF
188 DO j=1,nuvar
189 iv = nuvar*(i-1) + j
190 wa(jj + j) = gbuf%VAR(iv)
191 ENDDO
192 jj = jj + nuvar
193C------------
194 ENDIF ! IF (IGTYP)
195C
196 ie=ie+1
197C pointeur de fin de zone dans WA
198 ptwa(ie)=jj
199 ENDDO ! DO I=LFT,LLT
200c------- end loop over spring elements
201 ENDIF ! ITY == 6
202 ENDDO ! NG = 1, NGROUP
203C
204 100 CONTINUE
205c-----------------------------------------------------------------------
206c SPRING - WRITE
207c-----------------------------------------------------------------------
208 IF (nspmd == 1) THEN
209C recopies inutiles pour simplification du code.
210 ptwa_p0(0)=0
211 DO n=1,stat_numelr
212 ptwa_p0(n)=ptwa(n)
213 ENDDO
214 len=jj
215 DO j=1,len
216 wap0(j)=wa(j)
217 ENDDO
218 ELSE
219C construit les pointeurs dans le tableau global WAP0
220 CALL spmd_stat_pgather(ptwa,stat_numelr,ptwa_p0,stat_numelr_g)
221 len = 0
222 CALL spmd_rgather9_dp(wa,jj,wap0,sizp0,len)
223 ENDIF
224c-------------------------------------
225 IF (ispmd == 0 .AND. len > 0) THEN
226 iprt0 = 0
227 DO n=1,stat_numelr_g
228C retrouve le nieme elt dans l'ordre d'id croissant
229 k=stat_indxr(n)
230C retrouve l'adresse dans WAP0
231 j=ptwa_p0(k-1)
232C
233 ioff = nint(wap0(j + 1))
234 IF (ioff >= 1) THEN
235 iprt = nint(wap0(j + 2))
236 id = nint(wap0(j + 3))
237 igtyp = nint(wap0(j + 4))
238 nuvar = nint(wap0(j + 5))
239 j = j + 5
240C--------------------------------------
241 IF (igtyp == 4) THEN
242C--------------------------------------
243 IF (iprt /= iprt0) THEN
244 WRITE(iugeo,'(A)') delimit
245 WRITE(iugeo,'(A)')'/INISPRI/FULL'
246 WRITE(iugeo,'(A)')
247 . '#----------------------------------------------------------'
248 WRITE(iugeo,'(A)')'#SPRING_ID PROP_TYPE NUVAR'
249 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(F(I),DL(I),FEP(I),DPL(I),DPL2(I),I=SPRING_ID)'
250 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(XLO(I),EI(I),I=SPRING_ID)'
251 WRITE(iugeo,'(A)')
252 . '#----------------------------------------------------------'
253 iprt0=iprt
254 iprt0=iprt
255 ENDIF ! IF (IPRT /= IPRT0)
256C---
257 WRITE(iugeo,'(3I10)') id,igtyp,nuvar
258!! WRITE(IUGEO,'(1P5E20.13)')(WAP0(J+K),K=1,7)
259 WRITE(iugeo,'(1P5E20.13)')(wap0(j+k),k=1,5)
260 WRITE(iugeo,'(1P2E20.13)')(wap0(j+k),k=6,7)
261C--------------------------------------
262 ELSEIF (igtyp == 12) THEN
263C--------------------------------------
264 IF (iprt /= iprt0) THEN
265 WRITE(iugeo,'(A)') delimit
266 WRITE(iugeo,'(A)')'/INISPRI/FULL'
267 WRITE(iugeo,'(A)')
268 . '#----------------------------------------------------------'
269 WRITE(iugeo,'(A)')
270 . '#SPRING_ID PROP_TYPE NUVAR'
271 WRITE(iugeo,'(A)') '#FORMAT:(1P5E20.13) #(F(I),DL(I),FEP(I),DPL(I),DPL2(I),I=SPRING_ID)'
272 WRITE(iugeo,'(A)') '#FORMAT:(1P3E20.13) #(XL0(I),EI(I),DFS(I),I=SPRING_ID)'
273 WRITE(iugeo,'(A)')
274 . '#----------------------------------------------------------'
275 iprt0=iprt
276 ENDIF ! IF (IPRT /= IPRT0)
277C---
278 WRITE(iugeo,'(3I10)') id,igtyp,nuvar
279!! WRITE(IUGEO,'(1P5E20.13)')(WAP0(J+K),K=1,8)
280 WRITE(iugeo,'(1P5E20.13)')(wap0(j+k),k=1,5)
281 WRITE(iugeo,'(1P3E20.13)')(wap0(j+k),k=6,8)
282C--------------------------------------
283 ELSEIF (igtyp == 8 .OR. igtyp == 13 .OR. igtyp == 25
284 . .OR. igtyp == 23 ) THEN
285C--------------------------------------
286 IF (iprt /= iprt0) THEN
287 WRITE(iugeo,'(A)') delimit
288 WRITE(iugeo,'(A)')'/INISPRI/FULL'
289 WRITE(iugeo,'(A)')
290 . '#----------------------------------------------------------'
291 WRITE(iugeo,'(A)')
292 . '#SPRING_ID PROP_TYPE NUVAR'
293 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(FX(I),DX(I),FXEP(I),DPX(I),DPX2(I),I=SPRING_ID)'
294 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(FY(I),DY(I),FYEP(I),DPX(I),DPX2(I),I=SPRING_ID)'
295 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(FZ(I),DZ(I),FZEP(I),DPX(I),DPX2(I),I=SPRING_ID)'
296 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(XMOM(I),RX(I),XMEP(I),RPX(I),RPX2(I),I=SPRING_ID)'
297 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(YMOM(I),RY(I),YMEP(I),RPY(I),RPY2(I),I=SPRING_ID)'
298 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(ZMOM(I),RZ(I),ZMEP(I),RPZ(I),RPZ2(I),I=SPRING_ID)'
299 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(XLO(I),YL0(I),ZL0(I),EI(I),E1(I),I=SPRING_ID)'
300 WRITE(iugeo,'(2A)')'#FORMAT:(1P5E20.13) #(E2(I),E3(I),E4(I),E5(I),E6(I),I=SPRING_ID)'
301 WRITE(iugeo,'(A)')
302 . '#----------------------------------------------------------'
303 iprt0=iprt
304 ENDIF ! IF (IPRT /= IPRT0)
305C---
306 WRITE(iugeo,'(3I10)') id,igtyp,nuvar
307 WRITE(iugeo,'(1P5E20.13)')(wap0(j+k),k=1,40)
308C--------------------------------------
309 ELSEIF (igtyp == 26) THEN
310C--------------------------------------
311 IF (iprt /= iprt0) THEN
312 WRITE(iugeo,'(A)') delimit
313 WRITE(iugeo,'(A)')'/INISPRI/FULL'
314 WRITE(iugeo,'(A)')
315 . '#----------------------------------------------------------'
316 WRITE(iugeo,'(A)')
317 . '#SPRING_ID PROP_TYPE NUVAR'
318 WRITE(iugeo,'(A)') '#FORMAT:(1P3E20.13) #(F(I),DL(I),FEP(I),I=SPRING_ID)'
319 WRITE(iugeo,'(A)') '#FORMAT:(1P3E20.13) #(XL0(I),EI(I),DV(I),I=SPRING_ID)'
320 WRITE(iugeo,'(A)')
321 . '#----------------------------------------------------------'
322 iprt0=iprt
323 ENDIF ! IF (IPRT /= IPRT0)
324C---
325 WRITE(iugeo,'(3I10)') id,igtyp,nuvar
326 WRITE(iugeo,'(1P3E20.13)')(wap0(j+k),k=1,3)
327 WRITE(iugeo,'(1P3E20.13)')(wap0(j+k),k=4,6)
328C--------------------------------------
329 ELSEIF (igtyp == 29 .OR. igtyp == 30 .OR. igtyp == 31 .OR.
330 . igtyp == 32 .OR. igtyp == 33 .OR. igtyp == 35 .OR.
331 . igtyp == 36 .OR. igtyp == 44 .OR. igtyp == 45 .OR.
332 . igtyp == 46) THEN
333C--------------------------------------
334 IF (iprt /= iprt0) THEN
335 WRITE(iugeo,'(A)') delimit
336 WRITE(iugeo,'(A)')'/INISPRI/FULL'
337 WRITE(iugeo,'(A)')
338 . '#----------------------------------------------------------'
339 WRITE(iugeo,'(A)')
340 . '#SPRING_ID PROP_TYPE NUVAR'
341 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(FX(I),DX(I),I=SPRING_ID)'
342 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(FY(I),DY(I),I=SPRING_ID)'
343 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(FZ(I),DZ(I),I=SPRING_ID)'
344 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(XMOM(I),RX(I),I=SPRING_ID)'
345 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(YMOM(I),RY(I),I=SPRING_ID)'
346 WRITE(iugeo,'(A)')'#FORMAT:(1P2E20.13) #(ZMOM(I),RZ(I),I=SPRING_ID)'
347 WRITE(iugeo,'(A)')'#FORMAT:(1P1E20.13) #(EI(I),I=1,NEL)'
348!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
349!! WRITE(IUGEO,'(A)')'#FORMAT:(1P2E20.13)
350!! . #(MOM1Y(I),MOM1Z(I),I=SPRING_ID)'
351!! ENDIF
352 WRITE(iugeo,'(A)')'#FORMAT:(1P5E20.13) #(UVAR(I,J),J=1,NUVAR),I=SPRING_ID)'
353 WRITE(iugeo,'(A)')
354 . '#----------------------------------------------------------'
355 iprt0=iprt
356 ENDIF ! IF (IPRT /= IPRT0)
357C---
358 WRITE(iugeo,'(3I10)') id,igtyp,nuvar
359!! WRITE(IUGEO,'(1P5E20.13)') (WAP0(J+K),K=1,12)
360 WRITE(iugeo,'(1P2E20.13)') (wap0(j+k),k=1,2)
361 WRITE(iugeo,'(1P2E20.13)') (wap0(j+k),k=3,4)
362 WRITE(iugeo,'(1P2E20.13)') (wap0(j+k),k=5,6)
363 WRITE(iugeo,'(1P2E20.13)') (wap0(j+k),k=7,8)
364 WRITE(iugeo,'(1P2E20.13)') (wap0(j+k),k=9,10)
365 WRITE(iugeo,'(1P2E20.13)') (wap0(j+k),k=11,12)
366 WRITE(iugeo,'(1P1E20.13)') wap0(j+13) ! EINT
367 j_fin = j + 13
368C
369!! IF (IGTYP /= 32 .AND. IGTYP /= 33 .AND. IGTYP /= 45) THEN
370!! WRITE(IUGEO,'(1P2E20.13)') (WAP0(J_FIN+K),K=1,2) ! MOM1Y, MOM1Z
371!! J_FIN = J_FIN + 2
372!! ENDIF
373C ( + NUVAR )
374 WRITE(iugeo,'(1P5E20.13)')(wap0(j_fin+k),k=1,nuvar)
375C--------------------------------------
376 ENDIF ! IF (IGTYP)
377C--------------------------------------
378 ENDIF ! IF (IOFF >= 1)
379 ENDDO ! DO N=1,STAT_NUMELR_G
380 ENDIF ! IF (ISPMD == 0.AND.LEN > 0)
381C---
382 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
spmd_rgather9_dp
subroutine spmd_rgather9_dp(v, len, vp0, lenp0, iad)
Definition spmd_outp.F:1015
spmd_stat_pgather
subroutine spmd_stat_pgather(ptv, ptlen, ptv_p0, ptlen_p0)
Definition spmd_stat.F:53