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