OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hist2.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!|| hist2_mod ../engine/source/output/th/hist2.F
25!||--- called by ------------------------------------------------------
26!|| sortie_main ../engine/source/output/sortie_main.F
27!||====================================================================
28 MODULE hist2_mod
29 CONTAINS
30!||====================================================================
31!|| hist2 ../engine/source/output/th/hist2.F
32!||--- called by ------------------------------------------------------
33!|| sortie_main ../engine/source/output/sortie_main.F
34!||--- calls -----------------------------------------------------
35!|| bufmonv ../engine/source/output/th/hist2.F
36!|| cur_fil_c ../common_source/tools/input_output/write_routines.c
37!|| flu_fil_c ../common_source/tools/input_output/write_routines.c
38!|| fseek_c_rd ../common_source/tools/input_output/write_routines.c
39!|| spmd_collect_seatbelt ../engine/source/mpi/output/spmd_collect_seatbelt.F
40!|| spmd_gatherv ../engine/source/mpi/generic/spmd_gatherv.F
41!|| spmd_glob_dsum9 ../engine/source/mpi/interfaces/spmd_th.F
42!|| spmd_glob_rsum_poff ../engine/source/mpi/generic/spmd_glob_rsum_poff.F
43!|| spmd_sd_acc ../engine/source/mpi/output/spmd_sd_acc.F
44!|| spmd_sd_gau ../engine/source/mpi/output/spmd_sd_gau.F
45!|| surf_area ../engine/source/output/th/surf_area.F
46!|| surf_mass_monv ../engine/source/output/th/surf_mass.F
47!|| thcluster ../engine/source/output/th/thcluster.F
48!|| thcoq ../engine/source/output/th/thcoq.f
49!|| thkin ../engine/source/output/th/thkin.F
50!|| thmonv ../engine/source/output/th/thmonv.F
51!|| thnod ../engine/source/output/th/thnod.F
52!|| thnst ../engine/source/output/th/thnst.F
53!|| thpout ../engine/source/output/th/thpout.F
54!|| thquad ../engine/source/output/th/thquad.F
55!|| thres ../engine/source/output/th/thres.F
56!|| thrnur ../engine/source/output/th/thrnur.F
57!|| thsechecksum ../engine/source/output/th/thchecksum.F90
58!|| thsens ../engine/source/output/th/thsens.F
59!|| thsol ../engine/source/output/th/thsol.F
60!|| thsph ../engine/source/output/th/thsph.F
61!|| thsurf ../engine/source/output/th/thsurf.F
62!|| thtrus ../engine/source/output/th/thtrus.F
63!|| write_th ../engine/source/output/th/write_th.F
64!|| wrtdes ../engine/source/output/th/wrtdes.F
65!|| wrtdes0 ../engine/source/output/th/wrtdes0.f
66!||--- uses -----------------------------------------------------
67!|| cluster_mod ../engine/share/modules/cluster_mod.f
68!|| ebcs_mod ../common_source/modules/boundary_conditions/ebcs_mod.f90
69!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
70!|| element_mod ../common_source/modules/elements/element_mod.F90
71!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
72!|| groupdef_mod ../common_source/modules/groupdef_mod.F
73!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.f90
74!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
75!|| output_mod ../common_source/modules/output/output_mod.F90
76!|| pinchtype_mod ../common_source/modules/pinchtype_mod.F
77!|| seatbelt_mod ../common_source/modules/seatbelt_mod.F
78!|| sensor_mod ../common_source/modules/sensor_mod.F90
79!|| stack_mod ../engine/share/modules/stack_mod.F
80!|| th_mod ../engine/share/modules/th_mod.F
81!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.F
82!|| thsechecksum_mod ../engine/source/output/th/thchecksum.F90
83!||====================================================================
84 SUBROUTINE hist2(PM ,D ,X ,V ,A ,
85 2 IXS ,BUFEL ,WA ,IPARG ,SENSOR_TAB,
86 4 FSAV ,FLSW ,SKEW ,ELBUF_TAB ,CLUSTER ,
87 5 PARTSAV ,ACCELM ,NSENSOR ,MATPARAM_TAB,
88 6 WEIGHT ,IPART ,IGRSURF ,EBCS_TAB ,
89 7 ITHGRP ,ITHBUF ,SUBSET ,GEO ,
90 8 KXX ,IXR ,
91 9 KXSP ,NOD2SP ,SPBUF ,
92 B AR ,VR ,DR ,
93 D LRIVET ,RIVET ,IXP ,
94 E ISKWN ,IFRAME ,XFRAME ,IXC ,IXQ ,
95 F DTHIS0 ,THIS0 ,IFIL ,NTHGRP2 ,IXTG ,
96 G IGEO ,IPM ,
97 H IPARTL ,NPARTL ,IACCP ,NACCP ,
98 I IPARTH ,NPARTH ,NVPARTH ,
99 J MONVOL ,VOLMON ,FR_MV ,TEMP,INOD ,
100 K FTHREAC ,NODREAC ,GRESAV ,GAUGE ,
101 L IGAUP ,NGAUP ,ITTYP ,SIZE_MES ,
102 M RTHBUF ,THKE ,STACK ,ISPHIO ,VSPHIO ,
103 N ITHFLAG ,PINCH_DATA,MULTI_FVM,W ,SITHBUF ,
104 Q FSAVSURF,NEED_TO_REINIT_FSAV ,GLOB_THERM ,OUTPUT ,
105 P MASS0_START)
106C-----------------------------------------------
107C M o d u l e s
108C-----------------------------------------------
109 USE elbufdef_mod
110 USE cluster_mod
111 USE stack_mod
112 USE groupdef_mod
113 USE th_mod
114 USE pinchtype_mod
115 USE multi_fvm_mod
116 USE seatbelt_mod
117 USE sensor_mod
118 USE matparam_def_mod
119 USE ebcs_mod , only : t_ebcs_tab
120 USE th_surf_mod , only : th_surf_num_channel
121 use glob_therm_mod
122 USE output_mod , ONLY : output_
123 use thsechecksum_mod
124 use element_mod , only : nixs,nixq,nixc,nixp,nixr,nixt,nixtg
125C-----------------------------------------------
126C I m p l i c i t T y p e s
127C-----------------------------------------------
128#include "implicit_f.inc"
129C-----------------------------------------------
130C C o m m o n B l o c k s
131C-----------------------------------------------
132#include "com01_c.inc"
133#include "com04_c.inc"
134#include "com06_c.inc"
135#include "com08_c.inc"
136#include "sphcom.inc"
137#include "units_c.inc"
138#include "param_c.inc"
139#include "scr05_c.inc"
140#include "scr07_c.inc"
141#include "scr11_c.inc"
142#include "scr12_c.inc"
143#include "scr13_c.inc"
144#include "scr17_c.inc"
145#include "scr23_c.inc"
146#include "scrfs_c.inc"
147#include "task_c.inc"
148#include "impl1_c.inc"
149#include "rad2r_c.inc"
150#include "tabsiz_c.inc"
151C-----------------------------------------------
152C D u m m y A r g u m e n t s
153C-----------------------------------------------
154 TYPE(t_ebcs_tab), TARGET, INTENT(IN) :: EBCS_TAB
155 INTEGER,INTENT(IN) :: SITHBUF,NSENSOR
156 INTEGER NPARTL
157 INTEGER IXS(NIXS,NUMELS),IPARG(NPARG,NGROUP),
158 . IGEO(NPROPGI,NUMGEO),
159 . WEIGHT(NUMNOD),IPART(LIPART1,*),
160 . ITHGRP(NITHGR,*),ITHBUF(*),
161 . IXR(NIXR,*),KXSP(NISP,*),NOD2SP(*),LRIVET(4,*),IPM(NPROPMI,NUMMAT),
162 . ISKWN(LISKN,*),IFRAME(LISKN,*),IXC(NIXC,NUMELC),IXQ(NIXQ,NUMELQ),
163 . IXTG(NIXTG,*),IFIL,NTHGRP2,IPARTL(*),IACCP(*),
164 . NACCP(*),NPARTH,IPARTH(NPARTH,*),NVPARTH,
165 . MONVOL(*), FR_MV(*),INOD(*),
166 . NODREAC(*),KXX(NIXX,*),IGAUP(*),NGAUP(*),ITTYP,
167 . SIZE_MES,ISPHIO(NISPHIO,*),ITHFLAG
168 my_real
169 . PM(NPROPM,NUMMAT), D(3,NUMNOD), X(3,NUMNOD), V(3,NUMNOD), A(3,NUMNOD), BUFEL(*), WA(*),
170 . FSAV(NTHVKI,*), FLSW(9,*), SKEW(LSKEW,*), PARTSAV(NPSAV,*),
171 . ACCELM(LLACCELM,*), GEO(NPROPG,*),SPBUF(*),XFRAME(NXFRAME,*),
172 . AR(3,NUMNOD),VR(3,NUMNOD),DR(3,NUMNOD),
173 . RIVET(NRIVF,*), THKE(*),
174 . RIVOFF(NRIVET), VOLMON(*),
175 . temp(*),fthreac(*),gresav(npsav,*), gauge(llgauge,nbgauge),rthbuf(*),
176 . vsphio(*), w(3,numnod)
177 my_real, INTENT(IN ) :: mass0_start
178 REAL(KIND=8), intent(inout) :: this0, dthis0
179 INTEGER, DIMENSION(NIXP,NUMELP) ,INTENT(IN):: IXP
180 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
181 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
182 TYPE (STACK_PLY) :: STACK
183 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
184 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
185 TYPE (PINCH) :: PINCH_DATA
186 TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
187 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) ,INTENT(IN) :: SENSOR_TAB
188 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MATPARAM_TAB
189 TYPE (glob_therm_), INTENT(IN) :: glob_therm
190 my_real, INTENT(INOUT) :: FSAVSURF(TH_SURF_NUM_CHANNEL,NSURF)
191 LOGICAL, INTENT(INOUT) :: NEED_TO_REINIT_FSAV !< boolean to re-initialize PARTSAV array
192 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
193C-----------------------------------------------
194C L o c a l V a r i a b l e s
195C-----------------------------------------------
196 LOGICAL ICOND,RIVET_BOOL,HAS_TH
197
198 INTEGER I,J,K,L,M,N,II,JJ,NP,NN,N1,NRWA,
199 . jale,fsavmax,nvar,iad,ityp,iadv,krbhol,id_hist, seek_id,
200 . imid,ipid,jale_from_mat,jale_from_prop,surf_id
201
202 my_real xx,yy,zz,det,xxmom,yymom,zzmom,
203 . xcg, ycg, zcg, ixx, iyy, izz,ixy, iyz, izx,
204 . jxx, jyy, jzz, jxy, jyz, jzx, aa, thisc,
205 . fsavint(nthvki,ninter+nintsub),fsavvent(5,nventtot),
206 . fac,array(5)
207 my_real, DIMENSION(100) :: subsav
208 my_real, DIMENSION(1) :: wa_local
209 REAL(KIND=8) :: this0_double,tt_double
210 REAL(KIND=8) :: dthis0_double,dt1_double,thisc_double
211C-----------------------------------------------
212C S o u r c e L i n e s
213C-----------------------------------------------
214 id_hist = ithflag
215 thisc = this0
216 thisc_double = this0
217 seek_id = iunit-29
218 ixx = zero
219 iyy = zero
220 izz = zero
221 ixy = zero
222 iyz = zero
223 izx = zero
224 jxx = zero
225 jyy = zero
226 jzz = zero
227 izx = zero
228 jxy = zero
229 jzx = zero
230 xxmom = zero
231 yymom = zero
232 zzmom = zero
233 xcg = zero
234 ycg = zero
235 zcg = zero
236 aa = zero
237
238 IF (iunit == 3) seek_id = 1
239C--------Multidomains : control of time history for subdomains-----------
240 IF ((irad2r==1).AND.(r2r_siu==1)) THEN
241 r2r_th_flag(seek_id) = 0
242 IF (iddom == 0) THEN
243 r2r_th_main(seek_id) = 0
244 ELSE
245 IF (r2r_th_main(seek_id)==0) THEN
246 thisc = ep30
247 size_mes = 0
248 ELSEIF (r2r_th_main(seek_id)==1) THEN
249 thisc_double = tt
250 thisc_double = thisc_double - em20
251 thisc = thisc_double
252 size_mes = 1
253 ENDIF
254 ENDIF
255 ENDIF
256 tt_double = tt
257
258C-----------------------------------------------------------------------
259 IF (tt>=thisc_double) THEN
260 need_to_reinit_fsav = .true.
261C---------------------------
262 IF (iddom == 0) r2r_th_main(seek_id) = 1
263 r2r_th_flag(seek_id) = 1
264C---------------------------
265 this0_double = this0
266 dthis0_double = dthis0
267 IF (impl_s>0) THEN
268 dt1_double = dt1
269 this0_double=max(tt_double,this0_double+max(dthis0_double,dt1_double))
270 this0_double=min(tstop,this0_double)
271 this0 = this0_double
272 ELSE
273 this0_double=max(tt_double,this0_double+dthis0_double)
274 this0_double=min(tstop,this0_double)
275 this0 = this0_double
276 ENDIF
277C---------------------------
278 IF(ittyp==3) CALL cur_fil_c(ifil)
279C Heat Outputs
280 array(1) = glob_therm%HEAT_FFLUX
281 array(2) = glob_therm%HEAT_STORED
282 array(3) = glob_therm%HEAT_CONV
283 array(4) = glob_therm%HEAT_RADIA
284 array(5) = glob_therm%HEAT_MECA
285 IF(nspmd > 1) CALL spmd_glob_rsum_poff(array,5)
286C SPMD: only process 0 is writing
287 IF (ispmd==0) THEN
288C--------Multidomains : offset for th file------------------------------
289 IF ((irad2r==1).AND.(r2r_siu==1)) THEN
290 IF (seek_flag(seek_id)==1) THEN
291 CALL fseek_c_rd(seek0(seek_id))
292 seek_flag(seek_id) = 0
293 ELSE
294 CALL fseek_c_rd(seekc(seek_id))
295 ENDIF
296 ENDIF
297C-----------------------------------------------------------------------
298 wa_local(1) = tt
299 CALL wrtdes(wa_local,wa_local,1,ittyp,1)
300C------------------------
301C VARIABLES GLOBALES
302C------------------------
303 ii=0
304 wa(ii+1) =enint
305 wa(ii+2) =encin
306 wa(ii+3) =xmomt
307 wa(ii+4) =ymomt
308 wa(ii+5) =zmomt
309 wa(ii+6) =xmass
310 wa(ii+7) =dt2
311 wa(ii+8) =enrot
312 wa(ii+9) =output%TH%WFEXT
313 wa(ii+10)=reint
314 wa(ii+11)=econt+econt_cumu+econtv+econtd ! Global contact energy : Sum of contact energies
315 wa(ii+12)=ehour
316 wa(ii+13)= econt+econt_cumu !Contact Elastic Energy
317 wa(ii+14)= econtv ! Contact Frictional Energy
318 wa(ii+15)= econtd ! Damping Frictional Energy
319 wa(ii+16)= wplast ! Plastic Work
320 wa(ii+17)= xmass-mass0_start ! Added mass
321 wa(ii+18)= ep02*(xmass - mass0_start) / max(mass0,em20) ! Added mass %
322 wa(ii+19)= output%DATA%INOUT%DM_IN !inlet mass
323 wa(ii+20)= output%DATA%INOUT%DM_OUT !outlet mass
324 wa(ii+21)= output%DATA%INOUT%DE_IN !inlet energy
325 wa(ii+22)= output%DATA%INOUT%DE_OUT !outlet energy
326 IF(iunit==iuhis) CALL wrtdes(wa,wa,nglobth,ittyp,1)
327 ENDIF ! ISPMD==0
328C-----------------------------
329C VARIABLES FOR EACH PART
330C-----------------------------
331 IF(npart>0) THEN
332 IF(nspmd > 1 .AND. nthpart > 0) CALL spmd_glob_dsum9(gresav,npsav*ngpe)
333 IF(nspmd>1) CALL spmd_glob_dsum9(partsav,npsav*(npart+nthpart))
334 IF(ispmd/=0) THEN
335 DO m=1,npsav
336 DO i=1,npart+nthpart
337 partsav(m,i) = zero
338 ENDDO
339 DO i=1,nthpart
340 gresav(m,i) = zero
341 ENDDO
342 ENDDO
343 ELSE
344 ii=0
345 DO i=1,npart+nthpart
346 nvar=iparth(nvparth,i)
347 iad =iparth(nvparth+1,i)
348 IF (i > npart) THEN
349 DO j=1,npsav
350 partsav(j,i) = gresav(j,i-npart)
351 ENDDO
352 ENDIF
353 IF(nvar>0)THEN
354 IF(npsav>=22)THEN
355C---------------------------------------
356C GRAVITY CENTER
357C MOMENTUM / CG
358C INERTIA / CG
359C---------------------------------------
360 aa = one/max(em20,partsav(6,i))
361 xcg = partsav(9,i)*aa
362 ycg = partsav(10,i)*aa
363 zcg = partsav(11,i)*aa
364 xxmom = partsav(12,i)-partsav(5,i)*ycg+partsav(4,i)*zcg
365 yymom = partsav(13,i)-partsav(3,i)*zcg+partsav(5,i)*xcg
366 zzmom = partsav(14,i)-partsav(4,i)*xcg+partsav(3,i)*ycg
367 xx = partsav( 9,i)*xcg
368 yy = partsav(10,i)*ycg
369 zz = partsav(11,i)*zcg
370 ixx = partsav(15,i)-yy-zz
371 iyy = partsav(16,i)-zz-xx
372 izz = partsav(17,i)-xx-yy
373 ixy = partsav(18,i)+partsav( 9,i)*ycg
374 iyz = partsav(19,i)+partsav(10,i)*zcg
375 izx = partsav(20,i)+partsav(11,i)*xcg
376 ENDIF ! NPSAV>=22
377 DO n=iad,iad+nvar-1
378 ii=ii+1
379 IF(n <= sithbuf) THEN
380 k=ithbuf(n)
381 ELSE
382 k=0
383 ENDIF
384 IF(k==1)THEN
385 wa(ii)=partsav(1,i)+partsav(24,i)+partsav(26,i)
386 ELSEIF(k==2)THEN
387 wa(ii)=partsav(k,i)
388 ELSEIF(k==3)THEN
389 wa(ii)=partsav(k,i)
390 ELSEIF(k==4)THEN
391 wa(ii)=partsav(k,i)
392 ELSEIF(k==5)THEN
393 wa(ii)=partsav(k,i)
394 ELSEIF(k==6)THEN
395 wa(ii)=partsav(6,i)
396 ELSEIF(k==7)THEN
397 wa(ii)=partsav(8,i)
398 ELSEIF(k==8)THEN
399 wa(ii)=partsav(7,i)
400 ELSEIF(k==9)THEN
401 wa(ii)=xcg
402 ELSEIF(k==10)THEN
403 wa(ii)=ycg
404 ELSEIF(k==11)THEN
405 wa(ii)=zcg
406 ELSEIF(k==12)THEN
407 wa(ii)=xxmom
408 ELSEIF(k==13)THEN
409 wa(ii)=yymom
410 ELSEIF(k==14)THEN
411 wa(ii)=zzmom
412 ELSEIF(k==15)THEN
413 wa(ii)=ixx
414 ELSEIF(k==16)THEN
415 wa(ii)=iyy
416 ELSEIF(k==17)THEN
417 wa(ii)=izz
418 ELSEIF(k==18)THEN
419 wa(ii)=ixy
420 ELSEIF(k==19)THEN
421 wa(ii)=iyz
422 ELSEIF(k==20)THEN
423 wa(ii)=izx
424 ELSEIF(k==21)THEN
425 wa(ii)=partsav(21,i)+partsav(23,i)
426 ELSEIF(k==22)THEN
427 wa(ii)= half
428 . *( partsav(3,i)*partsav(3,i)
429 . + partsav(4,i)*partsav(4,i)
430 . + partsav(5,i)*partsav(5,i) )
431 . /max(em20,partsav(6,i))
432 ELSEIF(k==23)THEN
433C [Ixx Ixy Izx]-1 {XXMOM}
434C RKErigid = 1/2 {XXMOM,YYMOM,ZZMOM} [Ixy Iyy Iyz] {YYMOM}
435C [Izx Iyz Izz] {ZZMOM}
436
437 jxx=iyy*izz-iyz*iyz
438 jyy=izz*ixx-izx*izx
439 jzz=ixx*iyy-ixy*ixy
440 jxy=iyz*izx-ixy*izz
441 jyz=izx*ixy-iyz*ixx
442 jzx=ixy*iyz-izx*iyy
443 det = one/ max(em20,
444 . ixx * jxx + ixy * jxy + izx * jzx)
445 wa(ii)=det *
446 . (half*(jxx*xxmom*xxmom+jyy*yymom*yymom+jzz*zzmom*zzmom)
447 . + jxy*xxmom*yymom+jyz*yymom*zzmom+jzx*xxmom*zzmom )
448 ELSEIF(k==24)THEN
449 wa(ii)=partsav(22,i)
450 ELSEIF(k==25) THEN
451 wa(ii)=partsav(25,i)
452 ELSEIF(k==29) THEN
453 wa(ii)=partsav(3,i)/max(partsav(6,i),em20)
454 ELSEIF(k==30) THEN
455 wa(ii)=partsav(4,i)/max(partsav(6,i),em20)
456 ELSEIF(k==31) THEN
457 wa(ii)=partsav(5,i)/max(partsav(6,i),em20)
458 ELSEIF(k==32) THEN
459 wa(ii)=partsav(29,i)
460 ELSEIF(k > 0 .AND. SIZE(partsav,1) >= k) THEN
461 wa(ii)=partsav(k,i)
462 ELSE
463 wa(ii) = 0
464 ENDIF ! k ==
465 ENDDO ! N=IAD,IAD+NVAR-1
466 ENDIF ! NVAR>0
467 ENDDO ! I=1,NPART+NTHPART
468 IF (ii/=0) CALL wrtdes(wa,wa,ii,ittyp,1)
469 ENDIF ! ISPMD/=0
470 ENDIF ! NPART>0
471C-----------------------------
472C VARIABLES FOR EACH SUBSET
473C-----------------------------
474 IF(nsubs>0.AND.ispmd==0) THEN
475 ii=0
476 DO i=1,nsubs
477 nvar=subset(i)%NVARTH(ithflag)
478 iad =subset(i)%THIAD
479 np = subset(i)%NTPART
480 IF(nvar>0)THEN
481 DO k=1,npsav
482 subsav(k)=zero
483 ENDDO
484 DO j=1,np
485 jj=subset(i)%TPART(j)
486 DO k=1,npsav
487 subsav(k)=subsav(k)+partsav(k,jj)
488 ENDDO
489 ENDDO
490 IF(npsav>=22)THEN
491 aa = one/max(em20,subsav(6))
492 xcg = subsav( 9)*aa
493 ycg = subsav(10)*aa
494 zcg = subsav(11)*aa
495 xxmom = subsav(12)-subsav(5)*ycg+subsav(4)*zcg
496 yymom = subsav(13)-subsav(3)*zcg+subsav(5)*xcg
497 zzmom = subsav(14)-subsav(4)*xcg+subsav(3)*ycg
498 xx = subsav( 9)*xcg
499 yy = subsav(10)*ycg
500 zz = subsav(11)*zcg
501 ixx = subsav(15)-yy-zz
502 iyy = subsav(16)-zz-xx
503 izz = subsav(17)-xx-yy
504 ixy = subsav(18)+subsav( 9)*ycg
505 iyz = subsav(19)+subsav(10)*zcg
506 izx = subsav(20)+subsav(11)*xcg
507 IF ((irad2r==1).AND.(r2r_siu==1)) THEN
508 xxmom = subsav(12)
509 yymom = subsav(13)
510 zzmom = subsav(14)
511 ixx = subsav(15)
512 iyy = subsav(16)
513 izz = subsav(17)
514 ixy = subsav(18)
515 iyz = subsav(19)
516 izx = subsav(20)
517 ENDIF
518 ENDIF
519 DO n=iad,iad+nvar-1
520 k=ithbuf(n)
521 ii=ii+1
522 IF(k==1)THEN
523 wa(ii)=subsav(1)+subsav(24)+subsav(26)
524 ELSEIF(k==6)THEN
525 wa(ii)=subsav(6)
526 ELSEIF(k==7)THEN
527 wa(ii)=subsav(8)
528 ELSEIF(k==8)THEN
529 wa(ii)=subsav(7)
530 wa(ii)=subsav(8)
531 ELSEIF(k==8)THEN
532 wa(ii)=subsav(7)
533 ELSEIF(k==9)THEN
534 wa(ii)=xcg
535 ELSEIF(k==10)THEN
536 wa(ii)=ycg
537 ELSEIF(k==11)THEN
538 wa(ii)=zcg
539 ELSEIF(k==12)THEN
540 wa(ii)=xxmom
541 ELSEIF(k==13)THEN
542 wa(ii)=yymom
543 ELSEIF(k==14)THEN
544 wa(ii)=zzmom
545 ELSEIF(k==15)THEN
546 wa(ii)=ixx
547 ELSEIF(k==16)THEN
548 wa(ii)=iyy
549 ELSEIF(k==17)THEN
550 wa(ii)=izz
551 ELSEIF(k==18)THEN
552 wa(ii)=ixy
553 ELSEIF(k==19)THEN
554 wa(ii)=iyz
555 ELSEIF(k==20)THEN
556 wa(ii)=izx
557 ELSEIF(k==21)THEN
558 wa(ii)=subsav(21)+subsav(23)
559 ELSEIF(k==22)THEN
560 wa(ii)= half
561 . *( subsav(3)*subsav(3)
562 . + subsav(4)*subsav(4)
563 . + subsav(5)*subsav(5) )
564 . /max(em20,subsav(6))
565 ELSEIF(k==23)THEN
566C [Ixx Ixy Izx]-1 {XXMOM}
567C RKErigid = 1/2 {XXMOM,YYMOM,ZZMOM} [Ixy Iyy Iyz] {YYMOM}
568C [Izx Iyz Izz] {ZZMOM}
569
570 jxx=iyy*izz-iyz*iyz
571 jyy=izz*ixx-izx*izx
572 jzz=ixx*iyy-ixy*ixy
573 jxy=iyz*izx-ixy*izz
574 jyz=izx*ixy-iyz*ixx
575 jzx=ixy*iyz-izx*iyy
576 det = one/ max(em20,ixx * jxx + ixy * jxy + izx * jzx)
577 wa(ii)=det * (half*(ixx*xxmom*xxmom+iyy*yymom*yymom+izz*zzmom*zzmom)
578 . + ixy*xxmom*yymom+iyz*yymom*zzmom+izx*xxmom*zzmom )
579 ELSEIF(k==24)THEN
580 wa(ii)=subsav(22)
581 ELSEIF(k==25) THEN
582 wa(ii)=subsav(25)
583 ELSEIF(k==29) THEN
584 wa(ii)=subsav(3)/max(subsav(6),em20)
585 ELSEIF(k==30) THEN
586 wa(ii)=subsav(4)/max(subsav(6),em20)
587 ELSEIF(k==31) THEN
588 wa(ii)=subsav(5)/max(subsav(6),em20)
589 ELSEIF(k==32) THEN
590 wa(ii)=subsav(29)
591 ELSEIF(k > 0) THEN
592 wa(ii)=subsav(k)
593 ELSE
594 wa(ii) = 0
595 ENDIF
596 ENDDO
597 ENDIF
598 ENDDO
599 IF(ii/=0)CALL wrtdes(wa,wa,ii,ittyp,1)
600 ENDIF
601C-------------------------------------------------------
602C TH GROUP KINE SPMD
603C ( FSAV(NTHVKI,*), with NTHVKI = 18 )
604C-------------------------------------------------------
605 fsavmax = nvolu+nrbag+njoint+nsect+nrbody+nrwall+ninter+nintsub
606
607 IF (nspmd > 1) THEN
608 CALL spmd_glob_dsum9(fsav,nthvki*(ninter+nrwall+nrbody+nsect+njoint))
609 IF((nvolu+nrbag)>0)CALL spmd_glob_dsum9(fsav(1,1+ninter+nrwall+nrbody+nsect+njoint),nthvki*(nvolu+nrbag))
610 IF(nintsub>0)CALL spmd_glob_dsum9(fsav(1,1+ninter+nrwall+nrbody+nsect+njoint+nvolu+nrbag),nthvki*nintsub)
611 ENDIF
612 IF(fsavmax>0) THEN
613 IF (ispmd/=0) THEN
614 DO i=1,fsavmax
615 DO j=1,nthvki
616 fsav(j,i) = zero
617 ENDDO
618 ENDDO
619 ENDIF
620 ENDIF
621C
622 IF(ninter+nintsub/=0.AND.ispmd==0)THEN
623 DO j=1,nthvki
624 DO n=1,ninter
625 fsavint(j,n)=fsav(j,n)
626 END DO
627 DO n=1,nintsub
628 fsavint(j,ninter+n)=fsav(j,(ninter+nrwall+nrbody+nsect+njoint+nvolu+nrbag)+n)
629 END DO
630 END DO
631 END IF
632 IF(nventtot>0)THEN
633 ! Volmon dumped into Fsavvent.
634 DO i=1,nventtot
635 DO j=1,5
636 fsavvent(j,i) = zero
637 END DO
638 END DO
639 krbhol =1 + nrvolu * nvolu + lrcbag + lrbagjet
640 CALL bufmonv(fsavvent,monvol,volmon(krbhol),fr_mv)
641 IF(nspmd > 1)CALL spmd_glob_dsum9(fsavvent,5*nventtot)
642 END IF
643
644C---------------------------------------------------------
645C /Th/surfing: 6 output channels
646C---------------------------------------------------------
647 !FSAVSURF(1, 1:NSURF) : area (ebcs + monvol + ploads)
648 !FSAVSURF(2, 1:NSURF) : massflow (ebcs + monvol )
649 !FSAVSURF(3, 1:NSURF) : velocity (ebcs + monvol + ploads)
650 !FSAVSURF(4, 1:NSURF) : pressure (ebcs + monvol + ploads)
651 !FSAVSURF(5, 1:NSURF) : area with applied pressure ( ploads)
652 !FSAVSURF(6, 1:NSURF) : cumulated mass (ebcs + monvol )
653C-----------------------------------
654C /TH/SURF (AREA) if not already computed
655C-----------------------------------
656 DO i=1,nsurf
657 IF(igrsurf(i)%TH_SURF == 1 .AND. fsavsurf(1,i) == zero) THEN
658 nn = igrsurf(i)%NSEG
659 CALL surf_area(x, nn, igrsurf(i)%NODES, fsavsurf(1,i), numnod, n2d)
660 ENDIF
661 ENDDO
662
663C---------------------------------------------------------
664C /TH/SURF (cumulated mass from AIRBAGS)
665C---------------------------------------------------------
666 IF(nsurf > 0)THEN
667 CALL surf_mass_monv(fsavsurf,igrsurf,monvol,volmon,fr_mv)
668 ENDIF !NSURF > 0
669
670C---------------------------------------------------------
671C /TH/SURF : SPMD EXCHANGE
672C---------------------------------------------------------
673 IF(nspmd > 1)CALL spmd_glob_dsum9(fsavsurf,5*nsurf)
674
675C---------------------------------------------------------
676C /TH/SURF (PRESSURE mean velues)
677C---------------------------------------------------------
678 IF(ispmd ==0 ) THEN
679 DO i=1,nsurf
680 IF(igrsurf(i)%TH_SURF == 1) THEN
681 IF( fsavsurf(5,i) > zero )THEN
682 fsavsurf(4,i) = fsavsurf(4,i) / fsavsurf(5,i) ! The pressure in an average pressure
683 ELSE
684 fsavsurf(4,i) = zero
685 ENDIF
686 ENDIF
687 ENDDO
688 ENDIF
689
690C---------------------------------------------------------
691C /TH/SURF (EBCS mean values)
692C total surface FSAVSURF(1,:) are here gathered and
693C they can be used here to divide
694C---------------------------------------------------------
695 IF (ebcs_tab%nebcs > 0)THEN
696 DO k=1,ebcs_tab%nebcs
697 IF(.NOT.ebcs_tab%need_to_compute(k)) cycle
698 has_th = ebcs_tab%TAB(k)%poly%has_th
699 IF(has_th) THEN
700 surf_id = ebcs_tab%TAB(k)%poly%surf_id
701 nn = igrsurf(surf_id)%NSEG
702 IF(fsavsurf(1,surf_id) > zero)THEN
703 fsavsurf(3,surf_id) = fsavsurf(3,surf_id) / fsavsurf(1,surf_id) !mean velocity
704 fsavsurf(4,surf_id) = fsavsurf(4,surf_id) / fsavsurf(1,surf_id) !mean pressure
705 ENDIF
706 ENDIF
707 enddo!next K
708 ENDIF
709
710C--------------------------------------------
711C PRE-TREATMENT RIVETS (SPMD ONLY)
712C--------------------------------------------
713 IF(nrivf>1 .AND. nspmd > 1 .AND. nrivet>0) THEN
714 DO k = 1, nrivet
715 i = abs(lrivet(2,k))
716C beckup : flag off
717 rivoff(k) = rivet(1,k)
718 rivet_bool=.false.
719 IF(lrivet(2,k) <1) rivet_bool=.true.
720 IF(rivet_bool.EQV..false.) THEN
721 IF (weight(i)/=1) rivet_bool=.true.
722 ENDIF
723 IF(rivet_bool) THEN
724 DO n = 1, nrivf
725 rivet(n,k) = zero
726 ENDDO
727 ENDIF
728 END DO
729 CALL spmd_glob_dsum9(rivet,nrivf*nrivet)
730C retrieve : flag off
731 DO k = 1, nrivet
732 rivet(1,k) = rivoff(k)
733 END DO
734 ENDIF
735C--------------------------------------------
736C PRE-TREATMENT ACCELEROMETERS (SPMD ONLY)
737C--------------------------------------------
738 IF(naccelm>0 .AND. nspmd > 1)THEN
739C gather on proc 0 of up-to-date values for the accelerometers
740 CALL spmd_sd_acc(accelm,iaccp,naccp)
741 END IF
742C--------------------------------------------
743C PRE-TREATMENT GAUGES (SPMD ONLY)
744C--------------------------------------------
745 IF(nbgauge>0 .AND. nspmd > 1)THEN
746C gather on proc 0 of up-to-date values for the gauges
747 CALL spmd_sd_gau(gauge,igaup,ngaup)
748 END IF
749C--------------------------------------------
750C PRE-TREATMENT SEATBELTS
751C--------------------------------------------
752 IF(nslipring_g + nretractor_g > 0) THEN
753C
754 IF (ispmd == 0) THEN
755 DO k = 1,nslipring
756 th_slipring(slipring(k)%IDG,1:6) = zero
757 DO l=1,slipring(k)%NFRAM
758C-- IF NFRAM > 1 - RINGLSIP and BETA are average of the 1d sliprings - FORCE is the sum - GAMMA = ZERO
759 fac = one/slipring(k)%NFRAM
760 th_slipring(slipring(k)%IDG,1) = th_slipring(slipring(k)%IDG,1) + fac*slipring(k)%FRAM(l)%RINGSLIP
761 th_slipring(slipring(k)%IDG,2) = th_slipring(slipring(k)%IDG,2) + slipring(k)%FRAM(l)%SLIP_FORCE(3)
762 th_slipring(slipring(k)%IDG,3) = th_slipring(slipring(k)%IDG,3) + slipring(k)%FRAM(l)%SLIP_FORCE(1)
763 th_slipring(slipring(k)%IDG,4) = th_slipring(slipring(k)%IDG,4) + slipring(k)%FRAM(l)%SLIP_FORCE(2)
764 th_slipring(slipring(k)%IDG,5) = th_slipring(slipring(k)%IDG,5) + fac*slipring(k)%FRAM(l)%BETA
765 th_slipring(slipring(k)%IDG,6) = th_slipring(slipring(k)%IDG,6) + fac*slipring(k)%FRAM(l)%ORIENTATION_ANGLE
766 ENDDO
767 ENDDO
768C
769 DO k = 1,nretractor
770 th_retractor(retractor(k)%IDG,1) = retractor(k)%RINGSLIP
771 th_retractor(retractor(k)%IDG,2) = retractor(k)%RET_FORCE
772 th_retractor(retractor(k)%IDG,3) = retractor(k)%LOCKED
773 ENDDO
774 ENDIF
775C
776 IF (nspmd > 1) THEN
777C gather on proc0 for seatblets
778 CALL spmd_collect_seatbelt()
779 ENDIF
780C
781 END IF
782C-------------------------------------------------------
783C TH GROUP
784C-------------------------------------------------------
785
786! -------------------------------------
787! SPRING ELEMENT
788! TH optimization for spring elements
789 ! initialization of local array
790 wa_spring(id_hist)%WA_REAL( 1:wa_spring_size(id_hist) ) = zero
791 CALL thres(iparg,ithbuf,elbuf_tab,wa_spring(id_hist)%WA_REAL,igeo,
792 . ixr,nthgrp2,ithgrp,x)
793 IF(nspmd>1) THEN
794 ! send WA_SPRING to PROC0
795 CALL spmd_gatherv(wa_spring(id_hist)%WA_REAL,wa_spring_p0(id_hist)%WA_REAL,0,
796 . wa_spring_size(id_hist),total_wa_spring_size(id_hist),
797 . wa_spring_comm(id_hist)%TH_SIZE,wa_spring_comm(id_hist)%TH_DIPLS)
798 ELSE
799 wa_spring_p0(id_hist)%WA_REAL(1:wa_spring_size(id_hist) ) = wa_spring(id_hist)%WA_REAL( 1:wa_spring_size(id_hist) )
800 ENDIF
801 ! end of SPRING treatment
802! -------------------------------------
803! node element
804! TH optimization for node elements
805 ! initialization of local array
806 wa_nod(id_hist)%WA_REAL( 1:wa_nod_size(id_hist) ) = zero
807 CALL thnod(output, ithbuf ,
808 2 wa_nod(id_hist)%WA_REAL,x ,d ,v ,a ,
809 3 vr ,ar ,iskwn ,iframe ,skew ,
810 4 xframe ,weight ,temp ,inod ,fthreac,
811 5 nodreac, cptreac ,dr ,ittyp ,nthgrp2,
812 6 ithgrp ,pinch_data,glob_therm%ITHERM_FE)
813 ! send WA_NOD to PROC0
814 IF(nspmd>1) THEN
815 CALL spmd_gatherv(wa_nod(id_hist)%WA_REAL,wa_nod_p0(id_hist)%WA_REAL,0,
816 . wa_nod_size(id_hist),total_wa_nod_size(id_hist),
817 . wa_nod_comm(id_hist)%TH_SIZE,wa_nod_comm(id_hist)%TH_DIPLS)
818 ELSE
819 wa_nod_p0(id_hist)%WA_REAL(1:wa_nod_size(id_hist) ) = wa_nod(id_hist)%WA_REAL( 1:wa_nod_size(id_hist) )
820 ENDIF
821 ! end of NOD treatment
822 ! ----------------------------------
823! -------------------------------------
824! SOL ELEMENT
825! TH optimization for solid elements
826 ! initialization of local array
827 wa_sol(id_hist)%WA_REAL( 1:wa_sol_size(id_hist) ) = zero
828 CALL thsol( elbuf_tab, nthgrp2, ithgrp ,
829 . iparg , ithbuf , wa_sol(id_hist)%WA_REAL ,
830 . ixs , x , ipm ,pm ,igeo ,
831 . multi_fvm, v , w ,glob_therm%ITHERM,
832 . numels , nummat , numgeo , numnod,sithbuf)
833
834 ! send WA_SOL to PROC0
835 IF(nspmd>1) THEN
836 CALL spmd_gatherv(wa_sol(id_hist)%WA_REAL,wa_sol_p0(id_hist)%WA_REAL,0,
837 . wa_sol_size(id_hist),total_wa_sol_size(id_hist),
838 . wa_sol_comm(id_hist)%TH_SIZE,wa_sol_comm(id_hist)%TH_DIPLS)
839 ELSE
840 wa_sol_p0(id_hist)%WA_REAL(1:wa_sol_size(id_hist) ) = wa_sol(id_hist)%WA_REAL( 1:wa_sol_size(id_hist) )
841 ENDIF
842 ! end of SOL treatment
843 ! ----------------------------------
844! -------------------------------------
845! QUAD ELEMENT
846! TH optimization for quad/tria elements
847 ! initialization of local array
848 wa_quad(id_hist)%WA_REAL( 1:wa_quad_size(id_hist) ) = zero
849 CALL thquad(elbuf_tab,nthgrp2 ,ithgrp ,
850 1 iparg ,ithbuf ,wa_quad(id_hist)%WA_REAL ,
851 2 ipm ,ixq ,ixtg ,x ,multi_fvm ,
852 3 v ,w ,glob_therm%ITHERM ,pm ,
853 . numelq ,nummat ,numnod ,sithbuf ,numeltg)
854 ! send WA_QUAD to PROC0
855 IF(nspmd>1) THEN
856 CALL spmd_gatherv(wa_quad(id_hist)%WA_REAL,wa_quad_p0(id_hist)%WA_REAL,0,
857 . wa_quad_size(id_hist),total_wa_quad_size(id_hist),
858 . wa_quad_comm(id_hist)%TH_SIZE,wa_quad_comm(id_hist)%TH_DIPLS)
859 ELSE
860 wa_quad_p0(id_hist)%WA_REAL(1:wa_quad_size(id_hist) ) = wa_quad(id_hist)%WA_REAL( 1:wa_quad_size(id_hist) )
861 ENDIF
862 ! end of QUAD treatment
863 ! ----------------------------------
864! -------------------------------------
865! shell element
866! th optimization for shell/shell3n elements
867 ! initialization of local array
868 wa_coq(id_hist)%WA_REAL( 1:wa_coq_size(id_hist) ) = zero
869 CALL thcoq(elbuf_tab,matparam_tab,nthgrp2 , ithgrp ,
870 . iparg,ithbuf,wa_coq(id_hist)%WA_REAL,
871 . ipm,igeo,ixc,ixtg ,pm,
872 . rthbuf ,thke ,stack)
873 ! send WA_COQ to PROC0
874 IF(nspmd>1) THEN
875 CALL spmd_gatherv(wa_coq(id_hist)%WA_REAL,wa_coq_p0(id_hist)%WA_REAL,0,
876 . wa_coq_size(id_hist),total_wa_coq_size(id_hist),
877 . wa_coq_comm(id_hist)%TH_SIZE,wa_coq_comm(id_hist)%TH_DIPLS)
878 ELSE
879 wa_coq_p0(id_hist)%WA_REAL(1:wa_coq_size(id_hist) ) = wa_coq(id_hist)%WA_REAL( 1:wa_coq_size(id_hist) )
880 ENDIF
881 ! end of SHELL treatment
882 ! ----------------------------------
883! -------------------------------------
884! TRUSS ELEMENT
885! TH optimization for truss elements
886 ! initialization of local array
887 wa_trus(id_hist)%WA_REAL( 1:wa_trus_size(id_hist) ) = zero
888 CALL thtrus(iparg,nthgrp2 , ithgrp ,
889 . ithbuf ,elbuf_tab,wa_trus(id_hist)%WA_REAL )
890 ! send WA_TRUS to PROC0
891 IF(nspmd>1) THEN
892 CALL spmd_gatherv(wa_trus(id_hist)%WA_REAL,wa_trus_p0(id_hist)%WA_REAL,0,
893 . wa_trus_size(id_hist),total_wa_trus_size(id_hist),
894 . wa_trus_comm(id_hist)%TH_SIZE,wa_trus_comm(id_hist)%TH_DIPLS)
895 ELSE
896 wa_trus_p0(id_hist)%WA_REAL(1:wa_trus_size(id_hist) ) = wa_trus(id_hist)%WA_REAL( 1:wa_trus_size(id_hist) )
897 ENDIF
898 ! end of TRUSS treatment
899 ! ----------------------------------
900! -------------------------------------
901! BEAM ELEMENT
902! TH optimization for beam elements
903 ! initialization of local array
904 wa_pout(id_hist)%WA_REAL( 1:wa_pout_size(id_hist) ) = zero
905 CALL thpout(iparg , nthgrp2 , ithgrp , geo, ixp,
906 . ithbuf, elbuf_tab, wa_pout(id_hist)%WA_REAL )
907 ! send WA_POUT to PROC0
908 IF(nspmd>1) THEN
909 CALL spmd_gatherv(wa_pout(id_hist)%WA_REAL,wa_pout_p0(id_hist)%WA_REAL,0,
910 . wa_pout_size(id_hist),total_wa_pout_size(id_hist),
911 . wa_pout_comm(id_hist)%TH_SIZE,wa_pout_comm(id_hist)%TH_DIPLS)
912 ELSE
913 wa_pout_p0(id_hist)%WA_REAL(1:wa_pout_size(id_hist) ) = wa_pout(id_hist)%WA_REAL( 1:wa_pout_size(id_hist) )
914 ENDIF
915 ! end of BEAM treatment
916 ! ----------------------------------
917! -------------------------------------
918! SPH ELEMENT
919! TH optimization for sph elements
920 ! initialization of local array
921 wa_sph(id_hist)%WA_REAL( 1:wa_sph_size(id_hist) ) = zero
922 CALL thsph(elbuf_tab, nthgrp2, ithgrp, iparg, ithbuf,
923 1 spbuf ,kxsp ,nod2sp,pm,wa_sph(id_hist)%WA_REAL )
924 ! send WA_SPH to PROC0
925 IF(nspmd>1) THEN
926 CALL spmd_gatherv(wa_sph(id_hist)%WA_REAL,wa_sph_p0(id_hist)%WA_REAL,0,
927 . wa_sph_size(id_hist),total_wa_sph_size(id_hist),
928 . wa_sph_comm(id_hist)%TH_SIZE,wa_sph_comm(id_hist)%TH_DIPLS)
929 ELSE
930 wa_sph_p0(id_hist)%WA_REAL(1:wa_sph_size(id_hist) ) = wa_sph(id_hist)%WA_REAL( 1:wa_sph_size(id_hist) )
931 ENDIF
932 ! end of SPH treatment
933 ! ----------------------------------
934! -------------------------------------
935! NSTRAND ELEMENT
936! TH optimization for nstrand elements
937 ! initialization of local array
938 wa_nst(id_hist)%WA_REAL( 1:wa_nst_size(id_hist) ) = zero
939 CALL thnst(elbuf_tab,iparg,nthgrp2, ithgrp,ithbuf,
940 . geo ,kxx,wa_nst(id_hist)%WA_REAL)
941 ! send WA_NST to PROC0
942 IF(nspmd>1) THEN
943 CALL spmd_gatherv(wa_nst(id_hist)%WA_REAL,wa_nst_p0(id_hist)%WA_REAL,0,
944 . wa_nst_size(id_hist),total_wa_nst_size(id_hist),
945 . wa_nst_comm(id_hist)%TH_SIZE,wa_nst_comm(id_hist)%TH_DIPLS)
946 ELSE
947 wa_nst_p0(id_hist)%WA_REAL(1:wa_nst_size(id_hist) ) = wa_nst(id_hist)%WA_REAL( 1:wa_nst_size(id_hist) )
948 ENDIF
949 ! end of NSTRAND treatment
950 ! ----------------------------------
951! -------------------------------------
952 nrwa=nrwall
953 DO n=1,nthgrp2
954 ityp=ithgrp(2,n)
955 nn =ithgrp(4,n)
956 iad =ithgrp(5,n)
957 nvar=ithgrp(6,n)
958 iadv=ithgrp(7,n)
959 IF(ityp==0)THEN
960 ! all the stuff already done, PROC0 writes its data
961 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
962 1 nod_struct(id_hist),wa_nod_p0(id_hist))
963 ELSEIF(ityp==1)THEN
964 ! all the stuff already done, PROC0 writes its data
965 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
966 1 sol_struct(id_hist),wa_sol_p0(id_hist))
967 ELSEIF( nanaly /= 0 .AND. (ityp==2.OR.ityp==117) )THEN
968 ! all the stuff already done, PROC0 writes its data
969 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
970 1 quad_struct(id_hist),wa_quad_p0(id_hist))
971 ELSEIF(ityp==3.OR.ityp==7)THEN
972 ! all the stuff already done, PROC0 writes its data
973 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
974 1 coq_struct(id_hist),wa_coq_p0(id_hist))
975 ELSEIF(ityp==4)THEN
976 ! all the stuff already done, PROC0 writes its data
977 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
978 1 trus_struct(id_hist),wa_trus_p0(id_hist))
979 ELSEIF(ityp==5)THEN
980 ! all the stuff already done, PROC0 writes its data
981 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
982 1 pout_struct(id_hist),wa_pout_p0(id_hist))
983 ELSEIF(ityp==6)THEN
984 ! all the stuff already done, PROC0 writes its data
985 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
986 1 spring_struct(id_hist),wa_spring_p0(id_hist))
987 ELSEIF(ityp==50)THEN
988 CALL thrnur(iad,nn,iadv,nvar,iparg,
989 . ithbuf,bufel, wa)
990 CALL wrtdes0(ngroup,wa,nn*nvar,ittyp)
991 ELSEIF(ityp==51)THEN
992C-----------------------------
993C SMOOTH PARTICLES.
994C-----------------------------
995 ! all the stuff already done, PROC0 writes its data
996 IF(ispmd==0) CALL write_th(n,nspmd,nn,nvar,ittyp,
997 1 sph_struct(id_hist),wa_sph_p0(id_hist))
998 ELSEIF(ityp==100)THEN
999C-----------------------------
1000C NSTRAND ELEMENTS.
1001C-----------------------------
1002 ! all the stuff already done, PROC0 writes its data
1003 IF(ispmd==0) CALL write_th(n,nspmd,1,nn*nvar,ittyp,
1004 1 nst_struct(id_hist),wa_nst_p0(id_hist))
1005 ELSEIF(ityp==101)THEN
1006C-----------------------------
1007C INTERFACE
1008C-----------------------------
1009 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,
1010 . wa,fsavint,ittyp)
1011 ELSEIF(ityp==102)THEN
1012C-----------------------------
1013C RWALL
1014C-----------------------------
1015 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,
1016 . wa,fsav(1,1+ninter),ittyp)
1017 ELSEIF(ityp==103)THEN
1018C-----------------------------
1019C RBODY
1020C-----------------------------
1021 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,
1022 . wa,fsav(1,1+ninter+nrwall),ittyp)
1023 ELSEIF(ityp==104)THEN
1024C-----------------------------
1025C SECTION
1026C-----------------------------
1027 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,
1028 . wa,fsav(1,1+ninter+nrwall+nrbody),
1029 . ittyp)
1030 ELSEIF(ityp==105)THEN
1031C-----------------------------
1032C CYL JOINT
1033C-----------------------------
1034 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,wa,
1035 . fsav(1,1+ninter+nrwall+nrbody+nsect),ittyp)
1036 ELSEIF(ityp==106)THEN
1037C-----------------------------
1038C AIRBAG
1039C-----------------------------
1040 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,wa,
1041 . fsav(1,1+ninter+nrwall+nrbody+nsect+njoint),
1042 . ittyp)
1043 ELSEIF(ityp==107)THEN
1044C-----------------------------
1045C MON VOLUME
1046C-----------------------------
1047 CALL thmonv(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,wa,
1048 . fsav(1,1+ninter+nrwall+nrbody+nsect+njoint+nrbag),
1049 . fsavvent,monvol,ittyp)
1050 ELSEIF(ityp==108)THEN
1051C-----------------------------
1052C ACCELEROMETRE
1053C-----------------------------
1054C en spmd seul p0 ecrit accelerometres
1055 IF (ispmd==0) THEN
1056 ii = 0
1057 DO j=iad,iad+nn-1
1058 i=ithbuf(j)
1059 DO l=iadv,iadv+nvar-1
1060 k=ithbuf(l)
1061 ii=ii+1
1062 wa(ii)=accelm(19+k,i)
1063 ENDDO
1064 ENDDO
1065 IF(ii>0)CALL wrtdes(wa,wa,ii,ittyp,1)
1066 ENDIF
1067 ELSEIF(ityp==109.AND.nrivf>1) THEN
1068C-----------------------------
1069C RIVET
1070C-----------------------------
1071 IF (ispmd==0) THEN
1072 ii = 0
1073 DO j=iad,iad+nn-1
1074 i=ithbuf(j)
1075 DO l=iadv,iadv+nvar-1
1076 k=ithbuf(l)
1077 ii=ii+1
1078 wa(ii)=rivet(k,i)
1079 ENDDO
1080 ENDDO
1081 IF(ii>0)CALL wrtdes(wa,wa,ii,ittyp,1)
1082 ENDIF
1083 ELSEIF(ityp==110) THEN
1084C-----------------------------
1085C FRAMES
1086C-----------------------------
1087 IF (ispmd==0) THEN
1088 ii = 0
1089 DO j=iad,iad+nn-1
1090 i=ithbuf(j)
1091 n1 = iframe(1,i)
1092 IF(n1==0)THEN
1093C fixed frame
1094 DO l=iadv,iadv+nvar-1
1095 k=ithbuf(l)
1096 ii=ii+1
1097 IF(k==1)THEN
1098 wa(ii)=xframe(10,i)
1099 ELSEIF(k==2)THEN
1100 wa(ii)=xframe(11,i)
1101 ELSEIF(k==3)THEN
1102 wa(ii)=xframe(12,i)
1103 ELSEIF(k==4)THEN
1104 wa(ii)=xframe(1,i)
1105 ELSEIF(k==5)THEN
1106 wa(ii)=xframe(4,i)
1107 ELSEIF(k==6)THEN
1108 wa(ii)=xframe(7,i)
1109 ELSEIF(k==7)THEN
1110 wa(ii)=xframe(2,i)
1111 ELSEIF(k==8)THEN
1112 wa(ii)=xframe(5,i)
1113 ELSEIF(k==9)THEN
1114 wa(ii)=xframe(8,i)
1115 ELSEIF(k==10)THEN
1116 wa(ii)=xframe(3,i)
1117 ELSEIF(k==11)THEN
1118 wa(ii)=xframe(6,i)
1119 ELSEIF(k==12)THEN
1120 wa(ii)=xframe(9,i)
1121 ELSEIF(k==13)THEN
1122 wa(ii)=zero
1123 ELSEIF(k==14)THEN
1124 wa(ii)=zero
1125 ELSEIF(k==15)THEN
1126 wa(ii)=zero
1127 ELSEIF(k==16)THEN
1128 wa(ii)=zero
1129 ELSEIF(k==17)THEN
1130 wa(ii)=zero
1131 ELSEIF(k==18)THEN
1132 wa(ii)=zero
1133 ELSEIF(k==19)THEN
1134 wa(ii)=zero
1135 ELSEIF(k==20)THEN
1136 wa(ii)=zero
1137 ELSEIF(k==21)THEN
1138 wa(ii)=zero
1139 ELSEIF(k==22)THEN
1140 wa(ii)=zero
1141 ELSEIF(k==23)THEN
1142 wa(ii)=zero
1143 ELSEIF(k==24)THEN
1144 wa(ii)=zero
1145 ENDIF
1146 ENDDO
1147 ELSE
1148C moving frame
1149 IF(nxframe<36)THEN
1150 DO l=iadv,iadv+nvar-1
1151 k=ithbuf(l)
1152 ii=ii+1
1153 IF(k==1)THEN
1154 wa(ii)=xframe(10,i)
1155 ELSEIF(k==2)THEN
1156 wa(ii)=xframe(11,i)
1157 ELSEIF(k==3)THEN
1158 wa(ii)=xframe(12,i)
1159 ELSEIF(k==4)THEN
1160 wa(ii)=xframe(1,i)
1161 ELSEIF(k==5)THEN
1162 wa(ii)=xframe(4,i)
1163 ELSEIF(k==6)THEN
1164 wa(ii)=xframe(7,i)
1165 ELSEIF(k==7)THEN
1166 wa(ii)=xframe(2,i)
1167 ELSEIF(k==8)THEN
1168 wa(ii)=xframe(5,i)
1169 ELSEIF(k==9)THEN
1170 wa(ii)=xframe(8,i)
1171 ELSEIF(k==10)THEN
1172 wa(ii)=xframe(3,i)
1173 ELSEIF(k==11)THEN
1174 wa(ii)=xframe(6,i)
1175 ELSEIF(k==12)THEN
1176 wa(ii)=xframe(9,i)
1177 ELSEIF(k==13)THEN
1178 wa(ii)=v(1,n1)
1179 ELSEIF(k==14)THEN
1180 wa(ii)=v(2,n1)
1181 ELSEIF(k==15)THEN
1182 wa(ii)=v(3,n1)
1183 ELSEIF(k==16)THEN
1184 wa(ii)=xframe(13,i)
1185 ELSEIF(k==17)THEN
1186 wa(ii)=xframe(14,i)
1187 ELSEIF(k==18)THEN
1188 wa(ii)=xframe(15,i)
1189 ELSEIF(k==19)THEN
1190 wa(ii)=a(1,n1)
1191 ELSEIF(k==20)THEN
1192 wa(ii)=a(2,n1)
1193 ELSEIF(k==21)THEN
1194 wa(ii)=a(3,n1)
1195 ELSEIF(k==22)THEN
1196 wa(ii)=xframe(16,i)
1197 ELSEIF(k==23)THEN
1198 wa(ii)=xframe(17,i)
1199 ELSEIF(k==24)THEN
1200 wa(ii)=xframe(18,i)
1201 ENDIF
1202 ENDDO
1203 ELSE
1204 DO l=iadv,iadv+nvar-1
1205 k=ithbuf(l)
1206 ii=ii+1
1207 IF(k==1)THEN
1208 wa(ii)=xframe(10,i)
1209 ELSEIF(k==2)THEN
1210 wa(ii)=xframe(11,i)
1211 ELSEIF(k==3)THEN
1212 wa(ii)=xframe(12,i)
1213 ELSEIF(k==4)THEN
1214 wa(ii)=xframe(1,i)
1215 ELSEIF(k==5)THEN
1216 wa(ii)=xframe(4,i)
1217 ELSEIF(k==6)THEN
1218 wa(ii)=xframe(7,i)
1219 ELSEIF(k==7)THEN
1220 wa(ii)=xframe(2,i)
1221 ELSEIF(k==8)THEN
1222 wa(ii)=xframe(5,i)
1223 ELSEIF(k==9)THEN
1224 wa(ii)=xframe(8,i)
1225 ELSEIF(k==10)THEN
1226 wa(ii)=xframe(3,i)
1227 ELSEIF(k==11)THEN
1228 wa(ii)=xframe(6,i)
1229 ELSEIF(k==12)THEN
1230 wa(ii)=xframe(9,i)
1231 ELSEIF(k==13)THEN
1232 wa(ii)=xframe(31,i)
1233 ELSEIF(k==14)THEN
1234 wa(ii)=xframe(32,i)
1235 ELSEIF(k==15)THEN
1236 wa(ii)=xframe(33,i)
1237 ELSEIF(k==16)THEN
1238 wa(ii)=xframe(13,i)
1239 ELSEIF(k==17)THEN
1240 wa(ii)=xframe(14,i)
1241 ELSEIF(k==18)THEN
1242 wa(ii)=xframe(15,i)
1243 ELSEIF(k==19)THEN
1244 wa(ii)=xframe(28,i)
1245 ELSEIF(k==20)THEN
1246 wa(ii)=xframe(29,i)
1247 ELSEIF(k==21)THEN
1248 wa(ii)=xframe(30,i)
1249 ELSEIF(k==22)THEN
1250 wa(ii)=xframe(16,i)
1251 ELSEIF(k==23)THEN
1252 wa(ii)=xframe(17,i)
1253 ELSEIF(k==24)THEN
1254 wa(ii)=xframe(18,i)
1255 ENDIF
1256 ENDDO
1257 ENDIF
1258 ENDIF
1259 ENDDO
1260 IF(ii>0)CALL wrtdes(wa,wa,ii,ittyp,1)
1261 ENDIF
1262 ELSEIF(ityp==111)THEN
1263C-----------------------------
1264C FXBODY
1265C-----------------------------
1266 CALL thkin(iad,iad+nn-1,ithbuf,iadv,iadv+nvar-1,wa,
1267 . fsav(1,1+ninter+nrwall+nrbody+nsect+njoint+nrbag+nvolu),
1268 . ittyp)
1269 ELSEIF (ityp==112) THEN
1270
1271 ELSEIF (ityp==113) THEN
1272C-----------------------------
1273C GAUGE
1274C-----------------------------
1275 IF (ispmd==0) THEN
1276 ii = 0
1277 DO j=iad,iad+nn-1
1278 i=ithbuf(j)
1279 DO l=iadv,iadv+nvar-1
1280 k=ithbuf(l)
1281 ii=ii+1
1282 IF(k==1)THEN
1283 wa(ii)= gauge(30,i)
1284 ELSEIF(k==2)THEN
1285 wa(ii)= gauge(33,i)
1286 ELSEIF(k==3)THEN
1287 wa(ii)= gauge(32,i)
1288 ELSEIF(k==4)THEN
1289 wa(ii)= zero
1290 ELSEIF(k==5)THEN
1291 wa(ii)= zero
1292 ELSEIF(k==6)THEN
1293 wa(ii)= zero
1294 ELSEIF(k==7)THEN
1295 wa(ii)= zero
1296 ELSEIF(k==8)THEN
1297 wa(ii)= zero
1298 ENDIF
1299 ENDDO
1300 ENDDO
1301 IF(ii>0)CALL wrtdes(wa,wa,ii,ittyp,1)
1302 ENDIF
1303 ELSEIF (ityp==114) THEN
1304C-----------------------------
1305C ELEMENT CLUSTER
1306C-----------------------------
1307 CALL thcluster(wa ,iad ,iadv ,nn ,nvar ,
1308 . ittyp,ithbuf,cluster,skew,x ,
1309 . ixs ,iparg )
1310 ELSEIF (ityp==115) THEN
1311C-----------------------------
1312C SPH FLOW
1313C-----------------------------
1314 ii = 0
1315 DO j=iad,iad+nn-1
1316 i=ithbuf(j)
1317 ii=ii+1
1318 wa(ii)=vsphio(isphio(4,i)+16)
1319 ENDDO
1320 IF(nspmd>1) CALL spmd_glob_dsum9(wa,ii)
1321 IF((ispmd==0).AND.(ii>0)) CALL wrtdes(wa,wa,ii,ittyp,1)
1322 ELSEIF (ityp==116) THEN
1323C-----------------------------
1324C /TH/SURF
1325C-----------------------------
1326 CALL thsurf(iad,iad+nn-1,iadv,iadv+nvar-1,ithbuf,wa ,fsavsurf,ittyp,nsurf)
1327C
1328 ELSEIF (ityp==118) THEN
1329C-----------------------------
1330C SLIPRING
1331C-----------------------------
1332 IF (ispmd==0) THEN
1333 ii = 0
1334 DO j=iad,iad+nn-1
1335 i=ithbuf(j)
1336 DO l=iadv,iadv+nvar-1
1337 k=ithbuf(l)
1338 ii=ii+1
1339 IF(k==1)THEN
1340 wa(ii)= th_slipring(i,1)
1341 ELSEIF(k==2)THEN
1342 wa(ii)= th_slipring(i,2)
1343 ELSEIF(k==3)THEN
1344 wa(ii)= th_slipring(i,3)
1345 ELSEIF(k==4)THEN
1346 wa(ii)= th_slipring(i,4)
1347 ELSEIF(k==5)THEN
1348 wa(ii)= th_slipring(i,5)
1349 ELSEIF(k==6)THEN
1350 wa(ii)= th_slipring(i,6)
1351 ENDIF
1352 ENDDO
1353 ENDDO
1354 IF(ii>0)CALL wrtdes(wa,wa,ii,ittyp,1)
1355 ENDIF
1356C
1357 ELSEIF (ityp==119) THEN
1358C-----------------------------
1359C RETRACTORS
1360C-----------------------------
1361 IF (ispmd==0) THEN
1362 ii = 0
1363 DO j=iad,iad+nn-1
1364 i=ithbuf(j)
1365 DO l=iadv,iadv+nvar-1
1366 k=ithbuf(l)
1367 ii=ii+1
1368 IF(k==1)THEN
1369 wa(ii)= th_retractor(i,1)
1370 ELSEIF(k==2)THEN
1371 wa(ii)= th_retractor(i,2)
1372 ELSEIF(k==3)THEN
1373 wa(ii)= th_retractor(i,3)
1374 ENDIF
1375 ENDDO
1376 ENDDO
1377 IF(ii>0)CALL wrtdes(wa,wa,ii,ittyp,1)
1378 ENDIF
1379c
1380 ELSEIF (ityp == 120) THEN
1381C-----------------------------
1382C SENSORS
1383C-----------------------------
1384 CALL thsens (sensor_tab,nsensor,
1385 . iad ,iad+nn-1 ,iadv ,iadv+nvar-1,ithbuf ,
1386 . wa ,ittyp ,sithbuf)
1387C
1388c
1389 ELSEIF (ityp == 121) THEN
1390C-----------------------------
1391C SENSORS
1392C-----------------------------
1393 CALL thsechecksum (
1394 . iad ,iad+nn-1 ,iadv ,iadv+nvar-1,ithbuf ,
1395 . wa ,ittyp ,sithbuf,swa,ispmd)
1396C
1397c----
1398c----
1399 ENDIF ! ITYP
1400 ENDDO
1401C-------------------------------------------------------
1402C SECTIONS OF FLUIDS
1403C-------------------------------------------------------
1404 IF (nsflsw> 0 .AND. nabfile==0)THEN
1405 IF (nspmd > 1)CALL spmd_glob_dsum9(flsw,9*nsflsw)
1406 IF (ispmd/=0) THEN
1407 DO i=1,nsflsw
1408 flsw(1,i) = zero
1409 flsw(2,i) = zero
1410 flsw(3,i) = zero
1411 flsw(4,i) = zero
1412 flsw(5,i) = zero
1413 flsw(6,i) = zero
1414 flsw(7,i) = zero
1415 flsw(8,i) = zero
1416 flsw(9,i) = zero
1417 ENDDO
1418 ELSE
1419 DO i=1,nsflsw
1420 wa(ii+1)=flsw(1,i)
1421 wa(ii+2)=flsw(2,i)
1422 wa(ii+3)=flsw(3,i)
1423 wa(ii+4)=flsw(4,i)
1424 wa(ii+5)=flsw(5,i)
1425 wa(ii+6)=flsw(6,i)
1426 wa(ii+7)=flsw(7,i)
1427 wa(ii+8)=flsw(8,i)
1428 wa(ii+9)=flsw(9,i)
1429 ii=ii+9
1430 ENDDO
1431 CALL wrtdes(wa,wa,9*nsflsw,ittyp,1)
1432 END IF
1433 ENDIF
1434C---------------------------------------
1435 IF(ittyp==3) CALL flu_fil_c
1436C---------------------------------------
1437 IF(ispmd==0)THEN
1438 IF(iunit==3)THEN
1439 DO m=1,npart+nthpart
1440C Reset after gather on all partitions where no accumulation occurs
1441 DO i=1,npsav
1442 IF((i<23.OR.i>26.OR.i==25).AND.i/=8 .AND. nabfile==0
1443 . .AND. (mstop /= 1 .OR. ictlstop == 1) ) then
1444 partsav(i,m)=0
1445 ENDIF
1446 END DO
1447 END DO
1448 END IF
1449 END IF
1450 END IF
1451C-------------------------
1452 reint=zero
1453 IF(iunit==3)THEN
1454 icond = tt+2.*dt2>=t1s+dt2s
1455 DO ii=1,npartl
1456 ! zeroing on current PART on local domain
1457 m = ipartl(ii) !local parts (present on current domain)
1458 imid = ipart(1,m)
1459 ipid = ipart(2,m)
1460 jale_from_mat = nint(pm(72,imid))
1461 jale_from_prop = igeo(62,ipid)
1462 jale = max(jale_from_mat, jale_from_prop)
1463 IF(jale == 0 .OR. (jale > 0 .AND. icond))THEN
1464 DO i=1,npsav
1465 IF((i < 23.OR.i > 26.OR.i==25) .AND. i /= 8 .AND. nabfile==0 .AND.(mstop /= 1 .OR. ictlstop == 1) ) THEN
1466 partsav(i,m)=0
1467 ENDIF
1468 END DO
1469 END IF
1470 END DO
1471 END IF
1472
1473C reset GRESAV array
1474 IF (nthpart > 0) THEN
1475 DO i=1,npsav
1476 DO j = 1,nthpart
1477 gresav(i,j) = zero
1478 ENDDO
1479 ENDDO
1480 ENDIF
1481C-----------
1482 RETURN
1483 END SUBROUTINE hist2
1484 END MODULE hist2_mod
1485C
1486!||====================================================================
1487!|| bufmonv ../engine/source/output/th/hist2.F
1488!||--- called by ------------------------------------------------------
1489!|| hist2 ../engine/source/output/th/hist2.F
1490!||====================================================================
1491 SUBROUTINE bufmonv(FSAVVENT,IVOLU,RBAGHOL,FR_MV)
1492C-----------------------------------------------
1493C I m p l i c i t T y p e s
1494C-----------------------------------------------
1495#include "implicit_f.inc"
1496C-----------------------------------------------
1497C C o m m o n B l o c k s
1498C-----------------------------------------------
1499#include "com01_c.inc"
1500#include "com04_c.inc"
1501#include "param_c.inc"
1502#include "task_c.inc"
1503C-----------------------------------------------
1504C D u m m y A r g u m e n t s
1505C-----------------------------------------------
1506 INTEGER IVOLU(NIMV,*),FR_MV(NSPMD+2,NVOLU)
1507 my_real FSAVVENT(5,*),RBAGHOL(*)
1508C-----------------------------------------------
1509C L o c a l V a r i a b l e s
1510C-----------------------------------------------
1511 INTEGER N,ITYP,NVENT,IVENTTOT,RADHOL,IV,PMAIN
1512C-----------------------------------------------
1513 DO n=1,nvolu
1514 ityp =ivolu(2,n)
1515 IF(ityp>=4.AND.ityp<=9)THEN
1516 pmain = fr_mv(nspmd+2,n)
1517 IF(ispmd+1==pmain)THEN
1518 nvent =ivolu(11,n)
1519 iventtot=ivolu(16,n)
1520 radhol =ivolu(13,n)
1521 DO iv=1,nvent
1522C Aout, Aout1, Uout, Mout, Hout
1523 fsavvent(1,iventtot+iv)=rbaghol(radhol+16)
1524 fsavvent(2,iventtot+iv)=rbaghol(radhol+17)
1525 fsavvent(3,iventtot+iv)=rbaghol(radhol+18)
1526 fsavvent(4,iventtot+iv)=rbaghol(radhol+19)
1527 fsavvent(5,iventtot+iv)=rbaghol(radhol+20)
1528 radhol=radhol+nrbhol
1529 END DO
1530 END IF
1531 END IF
1532 END DO
1533 RETURN
1534 END SUBROUTINE bufmonv
1535
bufmonv
subroutine bufmonv(fsavvent, ivolu, rbaghol, fr_mv)
Definition hist2.F:1492
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
cluster_mod
Definition cluster_mod.F:40
groupdef_mod
Definition groupdef_mod.F:668
hist2_mod
Definition hist2.F:28
hist2_mod::hist2
subroutine hist2(pm, d, x, v, a, ixs, bufel, wa, iparg, sensor_tab, fsav, flsw, skew, elbuf_tab, cluster, partsav, accelm, nsensor, matparam_tab, weight, ipart, igrsurf, ebcs_tab, ithgrp, ithbuf, subset, geo, kxx, ixr, kxsp, nod2sp, spbuf, ar, vr, dr, lrivet, rivet, ixp, iskwn, iframe, xframe, ixc, ixq, dthis0, this0, ifil, nthgrp2, ixtg, igeo, ipm, ipartl, npartl, iaccp, naccp, iparth, nparth, nvparth, monvol, volmon, fr_mv, temp, inod, fthreac, nodreac, gresav, gauge, igaup, ngaup, ittyp, size_mes, rthbuf, thke, stack, isphio, vsphio, ithflag, pinch_data, multi_fvm, w, sithbuf, fsavsurf, need_to_reinit_fsav, glob_therm, output, mass0_start)
Definition hist2.F:106
pinchtype_mod
Definition pinchtype_mod.F:69
seatbelt_mod
Definition seatbelt_mod.F:55
seatbelt_mod::retractor
type(retractor_struct), dimension(:), allocatable retractor
Definition seatbelt_mod.F:155
seatbelt_mod::slipring
type(slipring_struct), dimension(:), allocatable slipring
Definition seatbelt_mod.F:110
stack_mod
Definition stack_mod.F:75
th_mod
Definition th_mod.F:42
th_mod::wa_sol
type(th_wa_real), dimension(10), target wa_sol
Definition th_mod.F:88
th_mod::wa_trus
type(th_wa_real), dimension(10), target wa_trus
Definition th_mod.F:103
th_mod::wa_coq_p0
type(th_wa_real), dimension(10), target wa_coq_p0
Definition th_mod.F:98
th_mod::total_wa_sol_size
integer, dimension(10), target total_wa_sol_size
Definition th_mod.F:85
th_mod::total_wa_nst_size
integer, dimension(10), target total_wa_nst_size
Definition th_mod.F:116
th_mod::coq_struct
type(th_proc_type), dimension(10), target coq_struct
Definition th_mod.F:96
th_mod::wa_nod
type(th_wa_real), dimension(10), target wa_nod
Definition th_mod.F:83
th_mod::wa_sph
type(th_wa_real), dimension(10), target wa_sph
Definition th_mod.F:113
th_mod::wa_coq
type(th_wa_real), dimension(10), target wa_coq
Definition th_mod.F:98
th_mod::nst_struct
type(th_proc_type), dimension(10), target nst_struct
Definition th_mod.F:117
th_mod::wa_sol_comm
type(th_comm), dimension(10), target wa_sol_comm
Definition th_mod.F:87
th_mod::wa_sol_p0
type(th_wa_real), dimension(10), target wa_sol_p0
Definition th_mod.F:88
th_mod::wa_sph_comm
type(th_comm), dimension(10), target wa_sph_comm
Definition th_mod.F:112
th_mod::wa_nod_p0
type(th_wa_real), dimension(10), target wa_nod_p0
Definition th_mod.F:83
th_mod::wa_spring_size
integer, dimension(10), target wa_spring_size
Definition th_mod.F:75
th_mod::total_wa_nod_size
integer, dimension(10), target total_wa_nod_size
Definition th_mod.F:80
th_mod::wa_spring_comm
type(th_comm), dimension(10), target wa_spring_comm
Definition th_mod.F:77
th_mod::total_wa_quad_size
integer, dimension(10), target total_wa_quad_size
Definition th_mod.F:90
th_mod::sph_struct
type(th_proc_type), dimension(10), target sph_struct
Definition th_mod.F:111
th_mod::wa_spring
type(th_wa_real), dimension(10), target wa_spring
Definition th_mod.F:78
th_mod::wa_pout_p0
type(th_wa_real), dimension(10), target wa_pout_p0
Definition th_mod.F:108
th_mod::wa_quad_size
integer, dimension(10), target wa_quad_size
Definition th_mod.F:90
th_mod::wa_nst
type(th_wa_real), dimension(10), target wa_nst
Definition th_mod.F:119
th_mod::total_wa_trus_size
integer, dimension(10), target total_wa_trus_size
Definition th_mod.F:100
th_mod::wa_nod_comm
type(th_comm), dimension(10), target wa_nod_comm
Definition th_mod.F:82
th_mod::total_wa_sph_size
integer, dimension(10), target total_wa_sph_size
Definition th_mod.F:110
th_mod::quad_struct
type(th_proc_type), dimension(10), target quad_struct
Definition th_mod.F:91
th_mod::wa_nst_size
integer, dimension(10), target wa_nst_size
Definition th_mod.F:116
th_mod::spring_struct
type(th_proc_type), dimension(10), target spring_struct
Definition th_mod.F:76
th_mod::wa_trus_size
integer, dimension(10), target wa_trus_size
Definition th_mod.F:100
th_mod::wa_coq_comm
type(th_comm), dimension(10), target wa_coq_comm
Definition th_mod.F:97
th_mod::wa_spring_p0
type(th_wa_real), dimension(10), target wa_spring_p0
Definition th_mod.F:78
th_mod::wa_pout_comm
type(th_comm), dimension(10), target wa_pout_comm
Definition th_mod.F:107
th_mod::total_wa_pout_size
integer, dimension(10), target total_wa_pout_size
Definition th_mod.F:105
th_mod::wa_pout
type(th_wa_real), dimension(10), target wa_pout
Definition th_mod.F:108
th_mod::wa_nst_p0
type(th_wa_real), dimension(10), target wa_nst_p0
Definition th_mod.F:119
th_mod::wa_sph_size
integer, dimension(10), target wa_sph_size
Definition th_mod.F:110
th_mod::total_wa_spring_size
integer, dimension(10), target total_wa_spring_size
Definition th_mod.F:75
th_mod::total_wa_coq_size
integer, dimension(10), target total_wa_coq_size
Definition th_mod.F:95
th_mod::sol_struct
type(th_proc_type), dimension(10), target sol_struct
Definition th_mod.F:86
th_mod::wa_trus_p0
type(th_wa_real), dimension(10), target wa_trus_p0
Definition th_mod.F:103
th_mod::nod_struct
type(th_proc_type), dimension(10), target nod_struct
Definition th_mod.F:81
th_mod::wa_nst_comm
type(th_comm), dimension(10), target wa_nst_comm
Definition th_mod.F:118
th_mod::wa_trus_comm
type(th_comm), dimension(10), target wa_trus_comm
Definition th_mod.F:102
th_mod::wa_quad_p0
type(th_wa_real), dimension(10), target wa_quad_p0
Definition th_mod.F:93
th_mod::wa_pout_size
integer, dimension(10), target wa_pout_size
Definition th_mod.F:105
th_mod::wa_sol_size
integer, dimension(10), target wa_sol_size
Definition th_mod.F:85
th_mod::wa_quad_comm
type(th_comm), dimension(10), target wa_quad_comm
Definition th_mod.F:92
th_mod::wa_nod_size
integer, dimension(10), target wa_nod_size
Definition th_mod.F:80
th_mod::trus_struct
type(th_proc_type), dimension(10), target trus_struct
Definition th_mod.F:101
th_mod::wa_coq_size
integer, dimension(10), target wa_coq_size
Definition th_mod.F:95
th_mod::wa_quad
type(th_wa_real), dimension(10), target wa_quad
Definition th_mod.F:93
th_mod::pout_struct
type(th_proc_type), dimension(10), target pout_struct
Definition th_mod.F:106
th_mod::wa_sph_p0
type(th_wa_real), dimension(10), target wa_sph_p0
Definition th_mod.F:113
th_surf_mod
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:61
th_surf_mod::th_surf_num_channel
integer, parameter th_surf_num_channel
number of /TH/SURF channels : AREA, VELOCITY, MASSFLOW, P A, MASS
Definition th_surf_mod.F:100
nvar
integer function nvar(text)
Definition nvar.F:32
spmd_collect_seatbelt
subroutine spmd_collect_seatbelt()
Definition spmd_collect_seatbelt.F:34
spmd_gatherv
subroutine spmd_gatherv(sendbuf, recvbuf, proc, send_size, total_rcv_size, rcv_size, dipls)
Definition spmd_gatherv.F:32
spmd_glob_rsum_poff
subroutine spmd_glob_rsum_poff(array, length)
Definition spmd_glob_rsum_poff.F:34
spmd_sd_acc
subroutine spmd_sd_acc(accelm, iaccp, naccp)
Definition spmd_sd_acc.F:34
spmd_sd_gau
subroutine spmd_sd_gau(gauge, igaup, ngaup)
Definition spmd_sd_gau.F:34
spmd_glob_dsum9
subroutine spmd_glob_dsum9(v, len)
Definition spmd_th.F:379
surf_area
subroutine surf_area(x, nn, surf_nodes, area, numnod, n2d)
Definition surf_area.F:29
surf_mass_monv
subroutine surf_mass_monv(fsavsurf, igrsurf, monvol, volmon, fr_mv)
Definition surf_mass.F:35
thcluster
subroutine thcluster(wa, iad, iadv, nn, nvar, ittyp, ithbuf, cluster, skew, x, ixs, iparg)
Definition thcluster.F:42
thcoq
subroutine thcoq(elbuf_tab, matparam_tab, nthgrp2, ithgrp, iparg, ithbuf, wa, ipm, igeo, ixc, ixtg, pm, rthbuf, thke, stack)
Definition thcoq.F:38
thkin
subroutine thkin(j1, j2, ithbuf, l1, l2, wa, fsav, iform)
Definition thkin.F:31
thmonv
subroutine thmonv(j1, j2, ithbuf, l1, l2, wa, fsav, fsavvent, ivolu, iform)
Definition thmonv.F:33
thnod
subroutine thnod(output, ithbuf, wa, x, d, v, a, vr, ar, iskwn, iframe, skew, xframe, weight, temp, inod, fthreac, nodreac, cptreac, dr, iform, nthgrp2, ithgrp, pinch_data, itherm_fe)
Definition thnod.F:42
thnst
subroutine thnst(elbuf_tab, iparg, nthgrp2, ithgrp, ithbuf, geo, kxx, wa)
Definition thnst.F:34
thpout
subroutine thpout(iparg, nthgrp2, ithgrp, geo, ixp, ithbuf, elbuf_tab, wa)
Definition thpout.F:33
thquad
subroutine thquad(elbuf_tab, nthgrp2, ithgrp, iparg, ithbuf, wa, ipm, ixq, ixtg, x, multi_fvm, v, w, itherm, pm, numelq, nummat, numnod, sithbuf, numeltg)
Definition thquad.F:43
thres
subroutine thres(iparg, ithbuf, elbuf_tab, wa, igeo, ixr, nthgrp2, ithgrp, x)
Definition thres.F:33
thrnur
subroutine thrnur(iad, nn, iadv, nvar, iparg, ithbuf, bufel, wa)
Definition thrnur.F:30
thsens
subroutine thsens(sensor_tab, nsensor, j1, j2, l1, l2, ithbuf, wa, iform, sithbuf)
Definition thsens.F:35
thsol
subroutine thsol(elbuf_tab, nthgrp2, ithgrp, iparg, ithbuf, wa, ixs, x, ipm, pm, igeo, multi_fvm, v, w, itherm, numels, nummat, numgeo, numnod, sithbuf)
Definition thsol.F:45
thsph
subroutine thsph(elbuf_tab, nthgrp2, ithgrp, iparg, ithbuf, spbuf, kxsp, nod2sp, pm, wa)
Definition thsph.F:35
thsurf
subroutine thsurf(j1, j2, l1, l2, ithbuf, wa, fsavsurf, iform, nsurf)
Definition thsurf.F:33
thtrus
subroutine thtrus(iparg, nthgrp2, ithgrp, ithbuf, elbuf_tab, wa)
Definition thtrus.F:32
flu_fil_c
void flu_fil_c()
Definition write_routines.c:901
cur_fil_c
void cur_fil_c(int *nf)
Definition write_routines.c:477
fseek_c_rd
void fseek_c_rd(int *lseek)
Definition write_routines.c:323
write_th
subroutine write_th(n, nspmd, nn, nvar, ittyp, eltype_struct, wa_eltype_p0)
Definition write_th.F:34
wrtdes0
subroutine wrtdes0(ng, wa, ii, iform)
Definition wrtdes0.F:32
wrtdes
subroutine wrtdes(a, ia, l, iform, ir)
Definition wrtdes.F:45