OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
genani.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!|| genani ../engine/source/output/anim/generate/genani.F
25!||--- called by ------------------------------------------------------
26!|| imp_buck ../engine/source/implicit/imp_buck.F
27!|| sortie_main ../engine/source/output/sortie_main.F
28!||--- calls -----------------------------------------------------
29!|| alevec ../engine/source/output/anim/generate/monvol_anim.F90
30!|| alevflu ../engine/source/output/anim/generate/monvol_anim.F90
31!|| ancmsg ../engine/source/output/message/message.F
32!|| ani_txt ../engine/source/output/anim/generate/ani_txt.F
33!|| ani_txt50 ../engine/source/output/anim/generate/ani_txt.F
34!|| animbale ../engine/source/output/anim/generate/monvol_anim.F90
35!|| animcale ../engine/source/output/anim/generate/monvol_anim.F90
36!|| animig3d ../engine/source/output/anim/generate/animig3d.F
37!|| animx ../engine/source/output/anim/generate/animx.F
38!|| anioff0 ../engine/source/output/anim/generate/anioff0.F
39!|| anioffc ../engine/source/output/anim/generate/anioffc.F
40!|| anioffc_crk ../engine/source/output/anim/generate/anioffc_crk.F
41!|| anioffc_ply ../engine/source/output/anim/generate/anioffc_ply.F
42!|| aniofff ../engine/source/output/anim/generate/aniofff.F
43!|| anioffs ../engine/source/output/anim/generate/anioff6.F
44!|| aniskew ../engine/source/output/anim/generate/aniskew.F
45!|| aniskewf ../engine/source/output/anim/generate/aniskewf.F
46!|| anivflowp ../engine/source/output/anim/generate/monvol_anim.F90
47!|| arret ../engine/source/system/arret.F
48!|| close_c ../common_source/tools/input_output/write_routines.c
49!|| cntskew ../engine/source/output/anim/generate/aniskewf.F
50!|| compute_binary_checksum ../common_source/output/checksum/checksum.cpp
51!|| cur_fil_c ../common_source/tools/input_output/write_routines.c
52!|| cutcnt ../engine/source/tools/sect/cutcnt.F
53!|| cutfunc ../engine/source/tools/sect/cutfunc.F
54!|| cutfunce ../engine/source/tools/sect/cutfunce.F
55!|| cutmain ../engine/source/tools/sect/cutmain.f
56!|| cutmass ../engine/source/tools/sect/cutmass.F
57!|| delnumb0 ../engine/source/output/anim/generate/delnumb0.F
58!|| delnumbc ../engine/source/output/anim/generate/delnumbc.F
59!|| delnumbc_crk ../engine/source/output/anim/generate/delnumbc_crk.F
60!|| delnumbc_ply ../engine/source/output/anim/generate/delnumbc_ply.f
61!|| delnumbf ../engine/source/output/anim/generate/delnumbf.F
62!|| delnumbs ../engine/source/output/anim/generate/delnumb6.F
63!|| dfunc0 ../engine/source/output/anim/generate/dfunc0.F
64!|| dfuncc ../engine/source/output/anim/generate/dfuncc.F
65!|| dfuncc_crk ../engine/source/output/anim/generate/dfuncc_crk.F
66!|| dfuncc_ply ../engine/source/output/anim/generate/dfuncc_ply.F
67!|| dfuncf ../engine/source/output/anim/generate/dfuncf.F
68!|| dfuncs ../engine/source/output/anim/generate/dfunc6.F
69!|| dfungps1 ../engine/source/output/anim/generate/dfuncf.F
70!|| dfungps2 ../engine/source/output/anim/generate/dfuncf.F
71!|| dmasani0 ../engine/source/output/anim/generate/dmasani0.F
72!|| dmasanic ../engine/source/output/anim/generate/dmasanic.F
73!|| dmasanif ../engine/source/output/anim/generate/dmasanif.F
74!|| dmasanis ../engine/source/output/anim/generate/dmasani6.F
75!|| donerbe2 ../engine/source/output/anim/generate/donerbe2.F
76!|| donerbe3 ../engine/source/output/anim/generate/donerbe3.F
77!|| donerby ../engine/source/output/anim/generate/donerby.F
78!|| donerwl ../engine/source/output/anim/generate/donerwl.F
79!|| donesec ../engine/source/output/anim/generate/donesec.F
80!|| donesrg ../engine/source/output/anim/generate/donesrg.F
81!|| dparrbe2 ../engine/source/output/anim/generate/dparrbe2.F
82!|| dparrbe3 ../engine/source/output/anim/generate/dparrbe3.F
83!|| dparrby ../engine/source/output/anim/generate/dparrby.F
84!|| dparrws ../engine/source/output/anim/generate/dparrws.F
85!|| dparsrg ../engine/source/output/anim/generate/dparsrg.F
86!|| drbe2cnt ../engine/source/output/anim/generate/drbe2cnt.F
87!|| drbe3cnt ../engine/source/output/anim/generate/drbe3cnt.F
88!|| drbycnt ../engine/source/output/anim/generate/drbycnt.F
89!|| dseccnt ../engine/source/output/anim/generate/dseccnt.f
90!|| dsecnor ../engine/source/output/anim/generate/dsecnor.F
91!|| dsphcnt ../engine/source/output/anim/generate/dsphcnt.F
92!|| dsphnor ../engine/source/output/anim/generate/dsphnor.F
93!|| dsrgcnt ../engine/source/output/anim/generate/dsrgcnt.F
94!|| dsrgnor ../engine/source/output/anim/generate/dsrgnor.F
95!|| dxyzsect ../engine/source/output/anim/generate/dxyzsect.F
96!|| dxyzsph ../engine/source/output/anim/generate/dxyzsph.F
97!|| dxyzsrg ../engine/source/output/anim/generate/dxyzsrg.F
98!|| file_size ../common_source/tools/input_output/write_routines.c
99!|| fretitl2 ../engine/source/input/freform.F
100!|| nodal_schlieren ../engine/source/output/anim/generate/nodal_schlieren.F
101!|| nodald ../engine/source/output/anim/generate/nodald.f
102!|| nodalp ../engine/source/output/anim/generate/nodalp.F
103!|| nodalssp ../engine/source/output/anim/generate/nodalssp.F
104!|| nodalt ../engine/source/output/anim/generate/nodalt.F
105!|| nodalvfrac ../engine/source/output/anim/generate/nodalvfrac.F
106!|| nodalzvol ../engine/source/output/anim/generate/nodalzvol.F
107!|| norcut ../engine/source/tools/sect/norcut.F
108!|| open_c ../common_source/tools/input_output/write_routines.c
109!|| parcut ../engine/source/tools/sect/parcut.F
110!|| parsor0 ../engine/source/output/anim/generate/parsor0.F
111!|| parsor_crk ../engine/source/output/anim/generate/parsor_crk.F
112!|| parsor_ply ../engine/source/output/anim/generate/parsor_ply.F
113!|| parsorc ../engine/source/output/anim/generate/parsorc.F
114!|| parsorf ../engine/source/output/anim/generate/parsorf.F
115!|| parsors ../engine/source/output/anim/generate/parsors.F
116!|| scanor ../engine/source/output/anim/generate/scanor.F
117!|| spmd_crk_idmax ../engine/source/mpi/anim/spmd_crk_idmax.F
118!|| spmd_dparrbe2 ../engine/source/mpi/anim/spmd_dparrbe2.F
119!|| spmd_dparrbe3 ../engine/source/mpi/anim/spmd_dparrbe3.F
120!|| spmd_dparrby ../engine/source/mpi/anim/spmd_dparrby.F
121!|| spmd_exch_n ../engine/source/mpi/generic/spmd_exch_n.F
122!|| spmd_exch_nodarea ../engine/source/mpi/anim/spmd_exch_nodarea.F
123!|| spmd_exch_nodarea2 ../engine/source/mpi/anim/spmd_exch_nodarea2.F
124!|| spmd_exch_nodareai ../engine/source/mpi/anim/spmd_exch_nodareai.F
125!|| spmd_fvb_adim ../engine/source/mpi/anim/spmd_fvb_adim.F
126!|| spmd_fvb_aelf ../engine/source/mpi/anim/spmd_fvb_aelf.F
127!|| spmd_fvb_amon ../engine/source/mpi/anim/spmd_fvb_amon.F
128!|| spmd_fvb_anod ../engine/source/mpi/anim/spmd_fvb_anod.F
129!|| spmd_fvb_anum ../engine/source/mpi/anim/spmd_fvb_anum.F
130!|| spmd_fvb_aoff ../engine/source/mpi/anim/spmd_fvb_aoff.F
131!|| spmd_fvb_apar ../engine/source/mpi/anim/spmd_fvb_apar.F
132!|| spmd_fvb_asub1 ../engine/source/mpi/anim/spmd_fvb_asub1.F
133!|| spmd_fvb_asub2 ../engine/source/mpi/anim/spmd_fvb_asub2.F
134!|| spmd_fvb_atit ../engine/source/mpi/anim/spmd_fvb_atit.F
135!|| spmd_fvb_atr ../engine/source/mpi/anim/spmd_fvb_atr.F
136!|| spmd_fvb_avec ../engine/source/mpi/anim/spmd_fvb_avec.F
137!|| spmd_gatherf ../engine/source/mpi/anim/spmd_gatherf.F
138!|| spmd_gatheritab ../engine/source/mpi/anim/spmd_gatheritab.F
139!|| spmd_gatheritab_crk ../engine/source/mpi/anim/spmd_gatheritab_crk.f
140!|| spmd_glob_imax9 ../engine/source/mpi/generic/spmd_glob_imax9.F
141!|| spmd_glob_isum9 ../engine/source/mpi/interfaces/spmd_th.F
142!|| spmd_ibcast ../engine/source/mpi/generic/spmd_ibcast.F
143!|| spmd_max_xfe_i ../engine/source/mpi/elements/spmd_xfem.F
144!|| spmd_r4get_partn ../engine/source/mpi/anim/spmd_r4get_partn.F
145!|| tencgps1 ../engine/source/output/anim/generate/tensorc.F
146!|| tencgps2 ../engine/source/output/anim/generate/tensorc.F
147!|| tensgps1 ../engine/source/output/anim/generate/tensor6.F
148!|| tensgps2 ../engine/source/output/anim/generate/tensor6.F
149!|| tensgps3 ../engine/source/output/anim/generate/tensor6.F
150!|| tensgpstrain ../engine/source/output/anim/generate/tensgpstrain.F
151!|| tensor0 ../engine/source/output/anim/generate/tensor0.F
152!|| tensorc ../engine/source/output/anim/generate/tensorc.F
153!|| tensorc_crk ../engine/source/output/anim/generate/tensorc_crk.F
154!|| tensorc_ply ../engine/source/output/anim/generate/tensorc_ply.F
155!|| tensors ../engine/source/output/anim/generate/tensor6.F
156!|| torseur ../engine/source/output/anim/generate/torseur.F
157!|| velvec ../engine/source/output/anim/generate/velvec.F
158!|| velvec2 ../engine/source/output/anim/generate/velvec.F
159!|| velvec3 ../engine/source/output/anim/generate/velvec.F
160!|| velvecc ../engine/source/output/anim/generate/velvec.F
161!|| velvecc21 ../engine/source/output/anim/generate/velvec.F
162!|| velvecc22 ../engine/source/output/anim/generate/velvec.F
163!|| velvecc_max ../engine/source/output/anim/generate/velvec.F
164!|| velvecz22 ../engine/source/output/anim/generate/velvecz22.F
165!|| write_c_c ../common_source/tools/input_output/write_routines.c
166!|| write_i_c ../common_source/tools/input_output/write_routines.c
167!|| write_r_c ../common_source/tools/input_output/write_routines.c
168!|| write_s_c ../common_source/tools/input_output/write_routines.c
169!|| xfecut ../engine/source/output/anim/generate/xfecut.F
170!|| xyz16 ../engine/source/output/anim/generate/monvol_anim.F90
171!|| xyzcut ../engine/source/tools/sect/xyzcut.F
172!|| xyznod ../engine/source/output/anim/generate/xyznod.F
173!|| xyznod_crk ../engine/source/output/anim/generate/xyznod_crk.F
174!|| xyznod_crk0 ../engine/source/output/anim/generate/xyznod_crk.F
175!|| xyznod_ply ../engine/source/output/anim/generate/xyznod_ply.F
176!|| xyznor ../engine/source/output/anim/generate/xyznor.F
177!|| xyznor16 ../engine/source/output/anim/generate/monvol_anim.F90
178!|| xyznor_crk ../engine/source/output/anim/generate/xyznor_crk.F
179!|| xyznor_ply ../engine/source/output/anim/generate/xyznor_ply.F
180!||--- uses -----------------------------------------------------
181!|| ale_connectivity_mod ../common_source/modules/ale/ale_connectivity_mod.F
182!|| aleanim_mod ../common_source/modules/aleanim_mod.F
183!|| anim_monvol_mod ../engine/source/output/anim/generate/monvol_anim.f90
184!|| checksum_output_option_mod ../common_source/modules/output/checksum_mod.F90
185!|| cluster_mod ../engine/share/modules/cluster_mod.F
186!|| crackxfem_mod ../engine/share/modules/crackxfem_mod.F
187!|| drape_mod ../engine/share/modules/drape_mod.F
188!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
189!|| element_mod ../common_source/modules/elements/element_mod.F90
190!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
191!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
192!|| groupdef_mod ../common_source/modules/groupdef_mod.F
193!|| h3d_mod ../engine/share/modules/h3d_mod.F
194!|| inoutfile_mod ../common_source/modules/inoutfile_mod.F
195!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
196!|| message_mod ../engine/share/message_module/message_mod.F
197!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
198!|| my_alloc_mod ../common_source/tools/memory/my_alloc.F90
199!|| output_mod ../common_source/modules/output/output_mod.F90
200!|| plyxfem_mod ../engine/share/modules/plyxfem_mod.F
201!|| stack_mod ../engine/share/modules/stack_mod.F
202!||====================================================================
203 SUBROUTINE genani(X ,D ,V ,A ,BUFEL ,
204 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
205 3 IXR ,IXTG ,SWAFT ,SMAS ,SXNORM ,
206 4 SIAD ,IPARG ,PM ,GEO ,MS ,
207 5 SINVERT ,CONT ,SMATER ,ICUT ,SKEW ,
208 6 XCUT ,FINT ,ITAB ,SEL2FA ,FEXT ,
209 7 FOPT ,LPBY ,NPBY ,NSTRF ,
210 8 RWBUF ,NPRW ,TANI ,ELBUF_TAB ,MAT_PARAM,
211 A DD_IAD ,WEIGHT ,EANI ,IPART ,CLUSTER ,
212 B IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,
213 C IPARTR ,IPARTUR ,IPARTTG ,
214 D RBY ,SWA4 ,TORS ,NOM_OPT ,IGRSURF ,
215 E BUFSF ,IDATA ,RDATA ,SIADG ,BUFMAT ,
216 F BUFGEO ,KXX ,IXX ,IPARTX ,SUIX ,
217 G SXUSR ,SNFACPTX ,SIXEDGE ,SIXFACET ,SIXSOLID ,
218 H SNUMX1 ,SNUMX2 ,SNUMX3 ,SOFFX1 ,SOFFX2 ,
219 I SOFFX3 ,SMASS1 ,SMASS2 ,SMASS3 ,SFUNC1 ,
220 J SFUNC2 ,SFUNC3 ,KXSP ,IXSP ,NOD2SP ,
221 K IPARTSP ,SPBUF ,IXS10 ,IXS20 ,IXS16 ,
222 L VR ,MONVOL ,VOLMON ,IPM ,IGEO ,NODGLOB,
223 M IAD_ELEM ,FR_ELEM ,FR_SEC ,FR_RBY2 ,IAD_RBY2 ,
224 N FR_WALL ,IFLOW ,RFLOW ,FNCONT ,FTCONT ,
225 O TEMP ,THKE ,ERR_THK_SH4 ,ERR_THK_SH3 ,DIAG_SMS ,
226 P IPARI ,FNCONT2 ,DR ,ALE_CONNECTIVITY ,
227 Q IRBE2 ,IRBE3 ,LRBE2 ,LRBE3 ,FR_RBE2,
228 R FR_RBE3M ,IAD_RBE2 ,DXANCG ,NOD_PXFEM ,IEL_PXFEM,
229 S ZI_PLY ,VGAZ ,FCONTG ,FNCONTG ,FTCONTG ,
230 T FANREAC ,INOD_CRK ,IEL_CRK ,ELCUTC ,IADC_CRK ,
231 U PDAMA2 ,RES_SMS ,WEIGHT_MD ,NODGLOBXFE ,NODEDGE ,
232 V FCLUSTER ,MCLUSTER ,XFEM_TAB ,W ,
233 W NV46 ,IPARTIG3D,KXIG3D ,IXIG3D ,SIG3DSOLID,
234 X KNOT ,WIGE ,NERCVOIS ,NESDVOIS ,LERCVOIS ,
235 Y LESDVOIS ,CRKEDGE ,INDX_CRK ,XEDGE4N ,XEDGE3N ,
236 Z STACK ,SPH2SOL ,STIFN ,STIFR ,IGRNOD ,
237 1 H3D_DATA ,SUBSET ,MULTI_FVM ,KNOTLOCPC ,KNOTLOCEL ,
238 2 FCONT_MAX,FNCONTP2 ,FTCONTP2 ,GLOB_THERM ,
239 . DRAPE_SH4N, DRAPE_SH3N, DRAPEG,OUTPUT )
240C-----------------------------------------------
241C M o d u l e s
242C-----------------------------------------------
243 USE checksum_output_option_mod
244 USE fvbag_mod
245 USE plyxfem_mod
246 USE message_mod
247 USE elbufdef_mod
248 USE crackxfem_mod
249 USE cluster_mod
250 USE stack_mod
251 USE aleanim_mod
252 USE h3d_mod
253 USE groupdef_mod
254 USE multi_fvm_mod
255 USE inoutfile_mod
256 USE ale_connectivity_mod
257 USE matparam_def_mod
258 use glob_therm_mod
259 use my_alloc_mod
260 use drape_mod
261 USE output_mod , ONLY : output_
262 USE anim_monvol_mod
263 use element_mod , only : nixs,nixq,nixc,nixtg,nixr,nixt,nixp
264C-----------------------------------------------
265C I m p l i c i t T y p e s
266C-----------------------------------------------
267#include "implicit_f.inc"
268C-----------------------------------------------
269C C o m m o n B l o c k s
270C-----------------------------------------------
271#include "com01_c.inc"
272#include "com04_c.inc"
273#include "com08_c.inc"
274#include "com09_c.inc"
275#include "com_xfem1.inc"
276#include "sphcom.inc"
277#include "param_c.inc"
278#include "units_c.inc"
279#include "scr03_c.inc"
280#include "scr06_c.inc"
281#include "scr14_c.inc"
282#include "scr16_c.inc"
283#include "scr17_c.inc"
284#include "scr23_c.inc"
285#include "scr25_c.inc"
286#include "chara_c.inc"
287#include "scrcut_c.inc"
288#include "task_c.inc"
289#include "spmd_c.inc"
290#include "flowcom.inc"
291#include "impl1_c.inc"
292#include "sms_c.inc"
293#include "filescount_c.inc"
294#include "intstamp_c.inc"
295C-----------------------------------------------
296C D u m m y A r g u m e n t s
297C-----------------------------------------------
298 INTEGER SWAFT,SMAS,SXNORM,SIAD,SINVERT,SMATER,SEL2FA,SWA4,
299 . siadg,nercvois(*),nesdvois(*),lercvois(*),
300 . lesdvois(*),sph2sol(*)
301 integer
302 . suix, sxusr ,sfacptx,sixedge,sixfacet,sixsolid,snumx1,
303 . snumx2,snumx3,soffx1,soffx2,soffx3,smass1,smass2,
304 . smass3,sfunc1,sfunc2,sfunc3,sfin,snfacptx
305
306 INTEGER IGEO(NPROPGI,*),IPM(NPROPMI,*),INDX_CRK(*),
307 . LRBE2(*),LRBE3(*),FR_RBE2(3,*),FR_RBE3M(3,*),
308 . NOD_PXFEM(*), IEL_PXFEM(*),NODEDGE(2,*),XEDGE4N(4,*),XEDGE3N(3,*),
309 . INOD_CRK(*),IEL_CRK(*),ELCUTC(2,*),IADC_CRK(*)
310 my_real
311 . X(3*NUMNOD), D(3*NUMNOD), V(3*NUMNOD), A(3,NUMNOD), BUFEL(*),
312 . PM(NPROPM,NUMMAT), GEO(NPROPG,*),CONT(*),
313 . XCUT(*) , FINT(3,*),MS(*),RWBUF(NRWLP,*),SKEW(LSKEW,*),
314 . RBY(NRBY,*),FEXT(3,*) ,FOPT(6,*),TANI(6,*),EANI(*),
315 . TORS(15,*),BUFSF(*), RDATA(*),
316 . BUFMAT(*),BUFGEO(*),
317 . SPBUF(*), VR(*),VOLMON(*), RFLOW(*), FNCONT(3,*), FTCONT(3,*),
318 . TEMP(*), THKE(*), ERR_THK_SH4(*), ERR_THK_SH3(*), DIAG_SMS(*),
319 . FNCONT2(3,*), DR(3,*),DXANCG(3,*),ZI_PLY(*),VGAZ(*),
320 . FCONTG(*), FNCONTG(*), FTCONTG(*),FANREAC(6,*),PDAMA2(2,*),
321 . RES_SMS(*),FCLUSTER(3,*),MCLUSTER(3,*),W(*),
322 . WIGE(*),KNOT(*),STIFN(*),STIFR(*),KNOTLOCPC(*),KNOTLOCEL(*),
323 . FCONT_MAX(*),FNCONTP2(3,*) ,FTCONTP2(3,*)
324 INTEGER IPARG(NPARG,*),NSTRF(*),LPBY(*),
325 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*),IXTG(NIXTG,*),
326 . IXT(NIXT,*),IXP(NIXP,*),IXR(NIXR,*),MONVOL(*) ,
327 . IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*) ,
328 . ICUT(*), ITAB(*),NPBY(NNPBY,*),NPRW(*),
329 . WEIGHT(*),IPART(LIPART1,*),IPARTS(*),IPARTQ(*),IPARTC(*),
330 . IPARTT(*),IPARTP(*),IPARTR(*),IPARTUR(*),IPARTTG(*),
331 . NOM_OPT(*),
332 . IDATA(*),KXX(NIXX,*), IXX(*), IPARTX(*),
333 . KXSP(NISP,*), IXSP(KVOISPH,*), NOD2SP(*), IPARTSP(*),
334 . nodglob(*),iad_elem(2,*),fr_elem(*),fr_wall(*), iflow(*),
335 . ipari(npari,*),irbe2(nrbe2l,*),irbe3(nrbe3l,*),
336 . weight_md(*),nodglobxfe(*),ipartig3d(*)
337 INTEGER CTEXT(2159), IB
338 INTEGER DD_IAD(NSPMD+1,*),
339 . NN1,NN2,NN3,NN4,NN5,NN6,NN7,NN8,NN9,NN10,
340 . N1,N2,N3
341 INTEGER FR_SEC(NSPMD+1,*),FR_RBY2(3,*),IAD_RBY2(4,*),
342 . nerbt(nrbody),loc_proc,proc,nerbe2t(nrbe2g),
343 . nerbe3t(nrbe3g),iad_rbe2(4,*),nv46,kxig3d(*),
344 . ixig3d(*),sig3dsolid
345 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
346 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP,NXEL) :: XFEM_TAB
347 TYPE (CLUSTER_) ,DIMENSION(NCLUSTER) :: CLUSTER
348 TYPE (XFEM_EDGE_) , DIMENSION(*) :: CRKEDGE
349 TYPE (STACK_PLY) :: STACK
350 TYPE(H3D_DATABASE) :: H3D_DATA
351 TYPE (SUBSET_) , DIMENSION(NSUBS) :: SUBSET
352!
353 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
354 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
355 TYPE(MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
356 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
357 TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
358 type (glob_therm_) ,intent(in) :: glob_therm
359 TYPE (DRAPE_) ,INTENT(IN) :: DRAPE_SH4N(NUMELC_DRAPE)
360 TYPE (DRAPE_) ,INTENT(IN) :: DRAPE_SH3N(NUMELTG_DRAPE)
361 TYPE (DRAPEG_) ,INTENT(IN) :: DRAPEG
362 TYPE(OUTPUT_),INTENT(INOUT) :: OUTPUT
363C-----------------------------------------------
364C L o c a l V a r i a b l e s
365C-----------------------------------------------
366 INTEGER ANIMSIZE
367 my_real, DIMENSION(:), ALLOCATABLE :: WAFT , MAS , XNORM,
368 . XMASS1, XMASS2, XMASS3,
369 . XFUNC1, XFUNC2, XFUNC3,
370 . XUSR
371 INTEGER,DIMENSION(:),ALLOCATABLE :: IAD
372 INTEGER,DIMENSION(:),ALLOCATABLE :: INVERT
373 INTEGER,DIMENSION(:),ALLOCATABLE :: MATER
374 INTEGER,DIMENSION(:),ALLOCATABLE :: EL2FA
375 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG
376 INTEGER,DIMENSION(:,:),ALLOCATABLE :: IADG_TPR
377 !
378 INTEGER,DIMENSION(:),ALLOCATABLE :: UIX
379 INTEGER,DIMENSION(:,:),ALLOCATABLE :: NFACPTX
380 INTEGER,DIMENSION(:),ALLOCATABLE :: IXEDGE
381 INTEGER,DIMENSION(:),ALLOCATABLE :: IXFACET
382 INTEGER,DIMENSION(:),ALLOCATABLE :: IXSOLID
383 INTEGER,DIMENSION(:),ALLOCATABLE :: INUMX1
384 INTEGER,DIMENSION(:),ALLOCATABLE :: INUMX2
385 INTEGER,DIMENSION(:),ALLOCATABLE :: INUMX3
386 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFX1
387 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFX2
388 INTEGER,DIMENSION(:),ALLOCATABLE :: IOFFX3
389 INTEGER,DIMENSION(:),ALLOCATABLE :: IG3DSOLID
390 INTEGER SZ16,SHFT16,IADGPS,NSN,IADISO,FIRST_NODE_IG3D,IADCHKSUM
391
392 real
393 . , DIMENSION(:), ALLOCATABLE :: wa4, mas4, wa4_fvm
394 my_real
395 . x_temp(3,64*numelig3d),d_temp(3,64*numelig3d),
396 . v_temp(3,64*numelig3d),a_temp(3,64*numelig3d),tabstresl(6,64*numelig3d),
397 . bid_temp(3,64*numelig3d),cont_temp(3,64*numelig3d),fint_temp(3,64*numelig3d),
398 . fext_temp(3,64*numelig3d),fanreact_temp(3,64*numelig3d)
399
400
401 my_real ,DIMENSION (:), ALLOCATABLE :: cbuf
402 INTEGER ,DIMENSION (:), ALLOCATABLE :: ICBUF
403 SAVE cbuf,icbuf
404
405 CHARACTER*80 STR, MES*30, CAUX,TITL*100
406 CHARACTER CHANIM*9,FILNAM*100, CHANIM1*4
407 INTEGER I, IDX,IDX0,IDX1,IDX2,NBF, NBPART, MAGIC, J, IFUNC, FILEN, NPSOL,
408 . nodcut,nelcut,lenr,leni,lencut,lencuto,ixel,
409 . mic1,mic2,mic3,mic4,mic5,mac1,mac2,mac3,npspr,n,k,
410 . i3000, nesct,nerby,nerwl,nnwl,tmpnbf,isk(6),
411 . nesbw2,nel,nft,ity,ng,oui,ipt
412 INTEGER II,II_L,INC,P,NSLARB_L,NDMA2,NUMELS_T,NSKEWA,NB1D,
413 . M1,M2,M3,M,M01,NB1D_T, NBF_L, LEN, NUMELT_T,
414 . numelr_t, numelp_t
415 INTEGER ISECT,NESCT1,IRBY,NERBY1,IRWL,NERWL1,NERBE2,NERBE3,
416 . nerbe2_1,nerbe3_1
417 INTEGER NSURG,NESRG, NNSRG, NESRG1, NNSRG1,ISRG,ISRF,ISRK
418 INTEGER NSMAD,NESMD, NNSMD, NESMD1, NNSMD1,ISMD
419 INTEGER NENT,OFFSI,OFFSRF,OFFSRV
420 INTEGER NESPH,NNSPH,INSPH,NESPHG,NNSPHG,SNNSPHG,SZNNSPH,SHFTSPH
421 INTEGER I161,I16A,I16B,I16C,I16D,I16E,I16F,I16G,I16H,I16I,I16J,
422 . i16k,i16l,i16m,i16n
423 INTEGER MXSUBS,NSECTSA
424 INTEGER IPRT, IAUX
425 INTEGER IFLAG1D,NNNSRG,NNN,BUF
426 INTEGER NANIM1D_L,IUS,NANIM3D_L
427 INTEGER ISPH3D,M4,N0
428 INTEGER LTITL
429 INTEGER LRBUF,BUFL,BUFFERP(NPART),SBUFSPM,SBUFRECVM,SBUFSPO,
430 . sporby,numsph_t,numels16_t,lrbufg,nnng
431 my_real
432 . cdg(3), s3000,xmin,ymin,zmin,xmax,ymax,zmax, scale,
433 . rval
434 INTEGER K1, KK1, K2, KIBJET, KIBHOL, IADHOL, KK2, KRBJET, KRBHOL,
435 . RADHOL, ITYP, KI1, KR1, NCA, NTG, NJET, NVENT, NTGI
436 my_real
437 . , DIMENSION(:,:), ALLOCATABLE :: vflu , vvar1 , aflu,
438 . vflu_ale, fanreact, fanreacr
439
440 INTEGER IADI, IADR, NINOUT, NNO, II1, II2, IR1, NNO_L, NNN_L,
441 . ii3, ii4
442 INTEGER NNS, NNI, NNT, NNA, NBA, KI2, KR2
443 INTEGER FVOFF(2,NFVBAG), INOD(4), INORM(3), NFVTR, NFVNOD,
444 . NFVPART, NFVSUBS, IDMAX, KK, NN, FVIAD, JJ, OFFPART,
445 . ELOFF, IDCMAX, NND, NBID1, NBID2, NBID3, NFVNODT, IDP,
446 . NBPART2D,NRBE2T,NRBE3T,EMPSIZPL
447 my_real
448 . gama, ssp, fac
449 INTEGER, DIMENSION(:), ALLOCATABLE :: OFFTR, ITAGT, FVEL2FA,
450 . FVINUM, FVPBUF,EL2FA_PLY,
451 . iad_ply,itab_ply
452
453 my_real
454 . , DIMENSION(:), ALLOCATABLE :: fvmass, fvpres, fvqx, fvqy,
455 . fvqz, fvrho, fvener, fvcson,
456 . fvgama, fvvisu,waft_ply,
457 . waft_crk
458
459 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_PLYG
460 INTEGER IUL,IAD_GP2,IFIRST,
461 . nel_ply, nfnod_pxfem,idply,nbf_pxfem_l,
462 . iply,nplysubs,id_part,nbf_pxfem,swaft_pxfem,maxpart,
463 . nbf_pxfemg,nfnod_pxfemg,plynumc,
464 . sel2fa_ply,iadpc,ifv,iad_gp3,iad_iso,iad_gp4
465 INTEGER, DIMENSION(:), ALLOCATABLE :: NFSHSZ
466 INTEGER, DIMENSION(:), ALLOCATABLE :: NFNODSZ
467 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAGPS
468 my_real
469 . , DIMENSION(:), ALLOCATABLE :: WGPS , VGPS
470
471 REAL R4
472 SAVE lencuto
473 DATA lencuto/0/
474 INTEGER IERROR
475 INTEGER ITG,NPLYPARTW,ILAY,ILEV,IANIM_TMP,CPT,KKT
476C
477 INTEGER NFNOD_CRKXFEM,IDCRK,ICRK,NCRKSUBS,
478 . nbf_crkxfem,len_crkx,nbf_crkxfemg,nfnod_crkxfemg,
479 . nfshszcrk(nlevmax),sel2fa_crk,ncrkpartw,nxfenodg2(nlevmax),
480 . idmaxnod,swaft_crk
481 INTEGER, DIMENSION(:), ALLOCATABLE :: EL2FA_CRK,IAD_CRK,ITAB_CRK,
482 . IAD_LAY
483 INTEGER, DIMENSION(:,:), ALLOCATABLE :: IAD_CRKG
484
485 INTEGER :: LEN_TMP_NAME
486 CHARACTER(len=2048),TARGET :: TMP_NAME
487 LOGICAL :: CONDITION
488 INTEGER :: IS_WRITTEN_NODE_FVM(AIRBAGS_TOTAL_FVM_IN_H3D)
489 INTEGER,DIMENSION(:),ALLOCATABLE :: IS_WRITTEN_NODE
490 INTEGER :: DEFAULT_OUTPUT
491C=======================================================================
492 ALLOCATE(WAFT(SWAFT) , MAS(SMAS) , XNORM(SXNORM) ,
493 . XMASS1(SMASS1), XMASS2(SMASS2), XMASS3(SMASS3),
494 . XFUNC1(SFUNC1), XFUNC2(SFUNC2), XFUNC3(SFUNC3),
495 . xusr(sxusr) )
496 waft(1:swaft) = zero
497
498 ALLOCATE (wa4(swa4), mas4(smas))
499 ALLOCATE (wa4_fvm(airbags_total_fvm_in_h3d))
500
501 ALLOCATE(vflu(3,numnod), vvar1(3,numnod), aflu(3,numnod),
502 . vflu_ale(3,numnod),fanreact(3,numnod),fanreacr(3,numnod))
503
504 ALLOCATE(wgps(numnod), vgps(numnod), itagps(numnod))
505
506 CALL my_alloc(is_written_node,numnod)
507 CALL my_alloc(iad,siad)
508 IF(siad >0) iad(1:siad) = -huge(iad(1))
509 CALL my_alloc(invert,sinvert)
510 CALL my_alloc(mater,smater)
511 CALL my_alloc(el2fa,sel2fa)
512 CALL my_alloc(iadg,nspmd,siadg)
513 CALL my_alloc(iadg_tpr,nspmd,siadg)
514 CALL my_alloc(nfshsz,nplymax)
515 CALL my_alloc(nfnodsz,nplymax)
516 CALL my_alloc(uix,suix)
517 CALL my_alloc(nfacptx,3,snfacptx)
518 CALL my_alloc(ixedge,sixedge)
519 CALL my_alloc(ixfacet,sixfacet)
520 CALL my_alloc(ixsolid,sixsolid)
521 CALL my_alloc(inumx1,snumx1)
522 CALL my_alloc(inumx2,snumx2)
523 CALL my_alloc(inumx3,snumx3)
524 CALL my_alloc(ioffx1,soffx1)
525 CALL my_alloc(ioffx2,soffx2)
526 CALL my_alloc(ioffx3,soffx3)
527 CALL my_alloc(ig3dsolid,sig3dsolid)
528C=======================================================================
529 iadg(1:nspmd,1:siadg) = 0
530 IF (anim_ply > 0)THEN
531 nplypartw=nplypart
532 ELSE
533 nplypartw=0
534 ENDIF
535 IF (anim_crk > 0 .and. icrack3d > 0 .and. nxel > 0) THEN
536 ncrkpartw = int(ncrkpart/nxel)
537 ELSE
538 ncrkpartw = 0
539 ENDIF
540 nrbe2t = nrbe2g
541 nrbe3t = nrbe3g
542
543 loc_proc = ispmd+1
544 IF(anim_vers>=47)THEN
545 ltitl = 80
546 ELSE
547 ltitl = 40
548 ENDIF
549 IF(anim_vers<44)THEN
550 isph3d=1
551 ELSE
552 isph3d=0
553 ENDIF
554 i161=1
555 i16a=i161+lnopt1*nrbody0
556 i16b=i16a+lnopt1*naccelm
557 i16c=i16b+lnopt1*nvolu
558 i16d=i16c+lnopt1*(ninter+nintsub)
559 i16e=i16d+lnopt1*nrwall
560 i16f=i16e !obsolete option removed
561 i16g=i16f+lnopt1*njoint
562 i16h=i16g+lnopt1*nsect
563 i16i=i16h+lnopt1*nlink
564 i16j=i16i+lnopt1*(numskw+1+numfram+1)
565 i16k=i16j+lnopt1*nfxbody
566 i16l=i16k+lnopt1*nflow
567 i16m=i16l+lnopt1*nrbe2t
568 i16n=i16m+lnopt1*nrbe3t
569C-----------------------------------------------
570 s3000 = three1000
571 i3000 = s3000
572C-----------------------------------------------
573C OPEN FILE
574C-----------------------------------------------
575 IF(ispmd==0) THEN
576 IF(anim_vers<50)THEN
577 IF(ianim>=1000)THEN
578 ianim_tmp = ianim
579 cpt = 1
580 DO WHILE(ianim_tmp /= 0)
581 ianim_tmp = ianim_tmp / 10
582 cpt = cpt + 1
583 ENDDO
584 IF (cpt == 5)THEN
585 WRITE(chanim,'(I4.4)')ianim
586 filnam=rootnam(1:rootlen)//'A'//chanim
587 filen = rootlen + 5
588 ELSEIF (cpt == 6)THEN
589 WRITE(chanim,'(I5.5)')ianim
590 filnam=rootnam(1:rootlen)//'A'//chanim
591 filen = rootlen + 6
592 ELSEIF (cpt == 7)THEN
593 WRITE(chanim,'(I6.6)')ianim
594 filnam=rootnam(1:rootlen)//'a'//CHANIM
595 FILEN = ROOTLEN + 7
596 ELSEIF (CPT == 8)THEN
597 WRITE(CHANIM,'(i7.7)')IANIM
598 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
599 FILEN = ROOTLEN + 8
600 ELSEIF (CPT == 9)THEN
601 WRITE(CHANIM,'(i8.8)')IANIM
602 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
603 FILEN = ROOTLEN + 9
604 ELSE
605 IANIM = 1
606 WRITE(CHANIM,'(i3.3)')IANIM
607 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
608 FILEN = ROOTLEN + 4
609 ENDIF
610 ELSE
611 WRITE(CHANIM,'(i3.3)')IANIM
612 FILNAM=ROOTNAM(1:ROOTLEN)//'a'//CHANIM
613 FILEN = ROOTLEN + 4
614 ENDIF
615 ENDIF
616 IF(ANIM_VERS>=50)THEN
617 IF(IANIM>=10000)IANIM=1
618 WRITE(CHANIM1,'(i4.4)')IANIM
619 FILNAM=ROOTNAM(1:ROOTLEN)//'_'//CHANIM1//'.ani'
620 FILEN = ROOTLEN + 9
621 ENDIF
622C
623 LEN_TMP_NAME = OUTFILE_NAME_LEN + FILEN
624 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:FILEN)
625 DO I=1,LEN_TMP_NAME
626 CTEXT(I)=ICHAR(TMP_NAME(I:I))
627 ENDDO
628 CALL CUR_FIL_C(0)
629 IF(IZIP==0)THEN
630 CALL OPEN_C(CTEXT,LEN_TMP_NAME,0)
631 ELSEIF(IZIP==1)THEN
632 CALL OPEN_C(CTEXT,LEN_TMP_NAME,3)
633 ELSEIF(IZIP==2)THEN
634 CALL OPEN_C(CTEXT,LEN_TMP_NAME,6)
635 ENDIF
636 ENDIF
637C-----------------------------------------------
638C USER ROUTINE RETURNS ALL NEEDED INFORMATION FOR ALL X-ELEMENTS.
639C-----------------------------------------------
640C NFACPTX must not be accessed to if NUMELX==0.
641 NANIM1D_L = 0
642 IF (NUMELXG>0) THEN
643
644 DO I=1,NPART
645 NFACPTX(1,I)=0
646 NFACPTX(2,I)=0
647 NFACPTX(3,I)=0
648 ENDDO
649 CALL ANIMX(ELBUF_TAB,
650 . IPARG ,ITAB ,X ,KXX ,IXX ,
651 . IPARTX ,PM ,GEO ,BUFMAT ,BUFGEO ,
652 . UIX ,XUSR ,NFACPTX ,IXEDGE ,IXFACET,
653 . IXSOLID ,INUMX1 ,INUMX2 ,INUMX3 ,IOFFX1 ,
654 . IOFFX2 ,IOFFX3 ,XMASS1 ,XMASS2 ,XMASS3 ,
655 . XFUNC1 ,XFUNC2 ,XFUNC3 ,NANIM1D_L)
656 ENDIF
657C-----------------------------------------------
658C ISO GEO ELEMS __1.
659C-----------------------------------------------
660 NANIM3D_L = 0
661 IF (NUMELIG3D>0) THEN
662 BID_TEMP(:,:) = ZERO ! set to zero for vector values that are not computed
663 FIRST_NODE_IG3D = 1000000000 ! warning: if points are created elsewhere, there is a risk of exceeding 1000000000
664 CALL ANIMIG3D(ELBUF_TAB,IPARG ,X ,D ,V ,A ,
665 . WIGE ,KXIG3D ,IXIG3D,IG3DSOLID,NANIM3D_L,
666 . X_TEMP ,D_TEMP ,V_TEMP,A_TEMP, TABSTRESL,IGEO ,
667 . KNOT ,ITAB ,IPARTIG3D,IPART ,CONT, CONT_TEMP,
668 . FINT ,FINT_TEMP,FEXT ,FEXT_TEMP, FANREAC, FANREACT_TEMP,
669 . KNOTLOCPC,KNOTLOCEL)
670 ENDIF
671C-----------------------------------------------
672C SKEW + NB1D
673C-----------------------------------------------
674C in the starter, nb1dg and nskewag are computed
675 NSKEWA=NUMELP + NUMELT + NUMSKW
676 NB1D =NUMELP + NUMELT + NUMELR
677C
678 DO I=1,NUMELR
679 IF(IGEO(11,IXR(1,I))==12)THEN
680 NB1D = NB1D+1
681 ENDIF
682 ENDDO
683 NSKEWA = NSKEWAG
684.AND. IF(NSPMD>1NFVBAG>0)
685 . CALL SPMD_FVB_AMON(MONVOL, VOLMON)
686C
687 IF (ANIM_V(10)>0) THEN
688 DO I=1,3
689 DO J=1,NUMNOD
690 VFLU_ALE(I,J)=ZERO
691 ENDDO
692 ENDDO
693 K1=1
694 KK1=1
695 K2=1+NIMV*NVOLU
696 KIBJET=K2+LICBAG
697 KIBHOL=KIBJET+LIBAGJET
698 IADHOL=KIBHOL+LIBAGHOL
699 KK2=1+NRVOLU*NVOLU
700 KRBJET=KK2+LRCBAG
701 KRBHOL=KRBJET+LRBAGJET
702 RADHOL=KRBHOL+LRBAGHOL
703 IFV=0
704 DO I=1,NVOLU
705 ITYP=MONVOL(K1+1)
706 NCA=MONVOL(K1+2)
707 NJET=MONVOL(K1+7)
708 NVENT=MONVOL(K1+10)
709.OR. IF (ITYP==6ITYP==8) THEN
710 IFV=MONVOL(K1-1+45)
711 NNS=MONVOL(K1-1+32)
712 NTG=MONVOL(K1-1+33)
713 NBA=MONVOL(K1-1+62)
714 NNA=MONVOL(K1-1+64)
715 NNI =MONVOL(K1-1+68)
716 NTGI=MONVOL(K1-1+69)
717 NNT =NNS+NNI
718 KI1=IADHOL+MONVOL(K1-1+31)
719 KI2=KI1+MONVOL(K1-1+20)-1
720 KR1=RADHOL+MONVOL(K1-1+34)+3*NNT
721 KR2=KR1+3*NNT+4*(NTG+NTGI)+3*NNA
722 CALL ALEVFLU(
723 . VFLU_ALE, NNT, VOLMON(KR1), NNA,
724 . VOLMON(KR2), IFV,NSPMD)
725 ENDIF
726 K1=K1+NIMV
727 KK1=KK1+NRVOLU
728 K2=K2+NICBAG*NCA
729 KK2=KK2+NRCBAG*NCA
730 ENDDO
731 ENDIF
732 DO I=1,3
733 DO J=1,NUMNOD
734 VFLU(I,J)=ZERO
735 ENDDO
736 ENDDO
737 IADI=0
738 IADR=0
739 DO I=1,NFLOW
740 ITYP=IFLOW(IADI+2)
741 IF (ITYP==1) THEN
742 NINOUT=IFLOW(IADI+4)
743 NNO=IFLOW(IADI+5)
744 NEL=IFLOW(IADI+6)
745 NNN=IFLOW(IADI+7)
746 NNO_L=IFLOW(IADI+16)
747 NNN_L=IFLOW(IADI+22)
748 II1=1+NIFLOW
749 II2=II1+NNO+3*NEL+NINOUT*NIIOFLOW
750 IF(NSPMD == 1) THEN
751 II3=II2+NNN+NEL
752 II4=II3+NNO
753 ELSE
754 II3=II2+NNN+NEL+2*NNO
755 II4=II3+2*NNO
756 ENDIF
757 IR1=1+NRFLOW+2*(NNO+NNN)
758 CALL ANIVFLOWP(
759 . VFLU, NNO, NNO_L, NNN_L,
760 . IFLOW(II1), IFLOW(II2), IFLOW(II3), IFLOW(II4), RFLOW(IR1))
761 ENDIF
762C
763 IADR=IADR+IFLOW(IADI+15)
764 IADI=IADI+IFLOW(IADI+14)
765 ENDDO
766C=======================================================================
767C
768C COQUE 3N 4N
769C
770C=======================================================================
771C-----------------------------------------------
772C PART COUNT
773C-----------------------------------------------
774 DO I=1,NPART
775 MATER(I)=0
776 ENDDO
777 DO NG = 1, NGROUP
778 NEL =IPARG(2,NG)
779 NFT =IPARG(3,NG)
780 ITY =IPARG(5,NG)
781 IF(ITY==2)THEN
782 DO I = 1, NEL
783 N = I + NFT
784 MATER(IPARTQ(N)) = 1
785 ENDDO
786 ELSEIF(ITY==3)THEN
787 DO I = 1, NEL
788 N = I + NFT
789 MATER(IPARTC(N)) = 1
790 ENDDO
791 ELSEIF(ITY==7)THEN
792 DO I = 1, NEL
793 N = I + NFT
794 MATER(IPARTTG(N)) = 1
795 ENDDO
796 ELSEIF(ITY==50)THEN
797 DO I = 1, NEL
798 N = I + NFT
799 MATER(IPARTUR(N)) = 1
800 ENDDO
801 ENDIF
802C 2D geometry is not yet treated.
803 ENDDO
804C
805 IF(NSPMD > 1)CALL SPMD_GLOB_ISUM9(MATER,NPART)
806 DO I=1,NPART
807 IF(MATER(I)>1)MATER(I) = 1
808 ENDDO
809 IF(NSPMD > 1)CALL SPMD_IBCAST(MATER,MATER,NPART,1,0,2)
810C
811 NBPART = 0
812 DO I=1,NPART
813 NBPART = NBPART + MATER(I)
814 ENDDO
815C
816 NBF = NUMELQ + NUMELC + NUMELTG
817 NBF_L = NBF
818 NBF = NUMELQG+NUMELCG+NUMELTGG
819 DO I=1,NUMELQ + NUMELC + NUMELTG + 1
820 EL2FA(I)=0
821 ENDDO
822C
823C --- ply xfem
824C
825 NBF_PXFEM = 0
826 NFNOD_PXFEM = 0
827
828 NBF_PXFEMG = 0
829 NFNOD_PXFEMG = 0
830
831 IF (ANIM_PLY > 0 ) THEN
832
833 IF (NSPMD > 1) THEN
834C Xfem init for NSPMD > 1
835
836C Ply Elements Elements
837 DO I=1,NPLYMAX
838 NFSHSZ(I) = PLYSHELL(I)%PLYNUMSHELL
839 ENDDO
840 CALL SPMD_GLOB_ISUM9(NFSHSZ,NPLYMAX)
841 IF (ISPMD == 0)THEN
842 DO I=1,NPLYMAX
843 NBF_PXFEMG = NBF_PXFEMG + NFSHSZ(I)
844 ENDDO
845 NFNOD_PXFEMG = NPLYNODG
846 SWAFT_PXFEM = MAX(3*NFNOD_PXFEMG,3*NBF_PXFEMG)
847 SEL2FA_PLY = NBF_PXFEMG
848
849 ELSE
850 DO I=1,NPLYMAX
851 NFNOD_PXFEM = NFNOD_PXFEM + PLYNOD(I)%PLYNUMNODS
852 NBF_PXFEM = NBF_PXFEM + PLYSHELL(I)%PLYNUMSHELL
853 ENDDO
854 SWAFT_PXFEM = MAX(3*NFNOD_PXFEM,3*NBF_PXFEM)
855 SEL2FA_PLY = NBF_PXFEM
856 ENDIF
857 ALLOCATE(EL2FA_PLY(SEL2FA_PLY), WAFT_PLY(SWAFT_PXFEM),
858 . IAD_PLY(NPLYMAX),IAD_PLYG(NSPMD,NPLYMAX))
859 EL2FA_PLY = 0
860 WAFT_PLY = ZERO
861 IAD_PLY = 0
862 IAD_PLYG = 0
863 ELSE
864C Xfem init for NSPMD = 1
865
866cc NBF_PXFEM = EPLYXFE*NPLYPART
867 DO I=1,NPLYMAX
868 NFNOD_PXFEM = NFNOD_PXFEM + PLYNOD(I)%PLYNUMNODS
869 NBF_PXFEM = NBF_PXFEM + PLYSHELL(I)%PLYNUMSHELL
870 ENDDO
871
872 SWAFT_PXFEM = MAX(3*NFNOD_PXFEM,3*NBF_PXFEM)
873 ALLOCATE(EL2FA_PLY(NBF_PXFEM), WAFT_PLY(SWAFT_PXFEM),
874 . IAD_PLY(NPLYMAX),IAD_PLYG(NSPMD,NPLYMAX))
875 EL2FA_PLY = 0
876 WAFT_PLY = ZERO
877 IAD_PLY = 0
878 IAD_PLYG = 0
879
880C
881 NFNOD_PXFEMG = NFNOD_PXFEM
882 NBF_PXFEMG = NBF_PXFEM
883 ENDIF
884 ENDIF
885c --- plyxfem
886c--------------------------------------------------------------------
887c xfem crack for layered shells
888c--------------------------------------------------------------------
889 NBF_CRKXFEM = 0
890 NFNOD_CRKXFEM = 0
891 NBF_CRKXFEMG = 0
892 NFNOD_CRKXFEMG = 0
893 NXFENODG = 0
894C
895 IF (ANIM_CRK > 0) THEN
896 IF (NSPMD > 1) THEN
897 DO I=1,NLEVMAX
898 NFSHSZCRK(I) = CRKSHELL(I)%CRKNUMSHELL
899 ENDDO
900 CALL SPMD_GLOB_ISUM9(NFSHSZCRK,NLEVMAX)
901 CALL SPMD_IBCAST(NFSHSZCRK,NFSHSZCRK,NLEVMAX,1,0,2)
902C
903 DO I=1,NLEVMAX
904 NXFENODG2(I) = CRKNOD(I)%CRKNUMNODS
905 ENDDO
906 CALL SPMD_GLOB_ISUM9(NXFENODG2,NLEVMAX)
907C
908 IF (ISPMD == 0) THEN
909 DO I=1,NLEVMAX
910 NBF_CRKXFEMG = NBF_CRKXFEMG + NFSHSZCRK(I)
911 ENDDO
912C
913 DO I=1,NLEVMAX
914 NXFENODG = NXFENODG + NXFENODG2(I)
915 NBF_CRKXFEM = NBF_CRKXFEM + CRKSHELL(I)%CRKNUMSHELL
916 ENDDO
917C
918 NFNOD_CRKXFEMG = NXFENODG
919 LEN_CRKX = MAX(NFNOD_CRKXFEMG,NBF_CRKXFEMG) ! max of phantom nodes and elements
920 SEL2FA_CRK = NBF_CRKXFEMG + 1
921 SWAFT_CRK = MAX(3*NFNOD_CRKXFEMG,3*NBF_CRKXFEMG)
922 ELSE
923 DO I=1,NLEVMAX
924 NFNOD_CRKXFEM = NFNOD_CRKXFEM + CRKNOD(I)%CRKNUMNODS
925 NBF_CRKXFEM = NBF_CRKXFEM + CRKSHELL(I)%CRKNUMSHELL
926 ENDDO
927 LEN_CRKX = MAX(NFNOD_CRKXFEM,NBF_CRKXFEM)
928 SEL2FA_CRK = NBF_CRKXFEM + 1
929 SWAFT_CRK = MAX(3*NFNOD_CRKXFEM,3*NBF_CRKXFEM)
930 ENDIF
931 ALLOCATE(EL2FA_CRK(SEL2FA_CRK),WAFT_CRK(SWAFT_CRK),
932 . IAD_CRK(NLEVMAX),IAD_CRKG(NSPMD,NLEVMAX))
933 IF (NXEL > 0) THEN
934 ALLOCATE(IAD_LAY(INT(NLEVMAX/NXEL)))
935 ELSE
936 ALLOCATE(IAD_LAY(0))
937 ENDIF
938 EL2FA_CRK = 0
939 IAD_CRK = 0
940 IAD_CRKG = 0
941 IAD_LAY = 0
942 WAFT_CRK = ZERO
943 ELSE ! NSPMD = 1
944 DO I=1,NLEVMAX
945 NFNOD_CRKXFEM = NFNOD_CRKXFEM + CRKNOD(I)%CRKNUMNODS
946 NBF_CRKXFEM = NBF_CRKXFEM + CRKSHELL(I)%CRKNUMSHELL
947 ENDDO
948C
949 LEN_CRKX = MAX(NFNOD_CRKXFEM,NBF_CRKXFEM)
950 SWAFT_CRK = MAX(3*NFNOD_CRKXFEM,3*NBF_CRKXFEM)
951 ALLOCATE(EL2FA_CRK(NBF_CRKXFEM))
952 ALLOCATE(WAFT_CRK(SWAFT_CRK))
953 ALLOCATE(IAD_CRK(NLEVMAX))
954 ALLOCATE(IAD_CRKG(NSPMD,NLEVMAX))
955 ALLOCATE(IAD_LAY(INT(NLEVMAX/NXEL)))
956 EL2FA_CRK = 0
957 IAD_CRK = 0
958 IAD_CRKG = 0
959 IAD_LAY = 0
960 WAFT_CRK = ZERO
961C
962 NFNOD_CRKXFEMG = NFNOD_CRKXFEM
963 NBF_CRKXFEMG = NBF_CRKXFEM
964 ENDIF
965 ELSE
966 ALLOCATE(EL2FA_CRK(0),IAD_CRK(0),IAD_CRKG(0,0),IAD_LAY(0),
967 . WAFT_CRK(0))
968 ENDIF
969C-----------------------------------------------
970C cuts in solids
971C-----------------------------------------------
972 NODCUT=0
973 NELCUT=0
974 MIC1=1
975 MIC2=1
976 MIC3=1
977 MIC4=1
978 MIC5=1
979 MAC1=1
980 MAC2=1
981 MAC3=1
982 IF(NCUTS>0)THEN
983 CALL CUTCNT(output,ICUT,XCUT,IXS,X,D,LENCUT)
984 LENCUT = MAX(LENCUT,NCUTS)
985 IF(LENCUT>LENCUTO)THEN
986 IF(ALLOCATED(CBUF))THEN
987 DEALLOCATE(CBUF)
988 DEALLOCATE(ICBUF)
989 ENDIF
990 LENR=42*LENCUT
991 LENI=28*LENCUT+2*NCUTS
992 ALLOCATE(CBUF(LENR),STAT=oui)
993 ALLOCATE(ICBUF(LENI),STAT=oui)
994 IF(oui/=0) THEN
995 CALL ANCMSG(MSGID=29,ANMODE=ANINFO)
996 CALL ARRET(2)
997 ENDIF
998 LENCUTO=LENCUT
999 ENDIF
1000 CALL CUTMAIN(ICUT ,XCUT ,IXS ,X ,D ,
1001 . NODCUT,NELCUT,ICBUF,CBUF,LENCUTO,NBF)
1002 MIC1=1
1003 MIC2=MIC1+10*LENCUTO
1004 MIC3=MIC2+12*LENCUTO
1005 MIC4=MIC3+6*LENCUTO
1006 MIC5=MIC4+NCUTS
1007 MAC1=1
1008 MAC2=MAC1+18*LENCUTO
1009 MAC3=MAC2+6*LENCUTO
1010 ENDIF
1011C IF(.NOT.(ALLOCATED(CBUF))) ALLOCATE(CBUF(1),STAT=oui)
1012C IF(.NOT.(ALLOCATED(ICBUF))) ALLOCATE(ICBUF(1),STAT=oui)
1013
1014C-----------------------------------------------
1015C to have unified tests in sph
1016 NUMSPH_T = NUMSPHG
1017
1018 NESCT = 0
1019 NERWL = 0
1020 NNWL = 0
1021 NESBW2= 0
1022 IF(NSECT+NRWALL>0) THEN
1023 CALL DSECCNT(NESCT,NERWL,NESBW2,NSTRF,
1024 1 RWBUF ,NPRW,NNWL,IXS)
1025 END IF
1026
1027 NESRG=0
1028 NNSRG=0
1029 NSURG=0
1030 IF (NSURF>0)
1031 . CALL DSRGCNT(IGRSURF, NSURG,NESRG,NNSRG,NESBW2)
1032 NESMD=0
1033 NNSMD=0
1034 NSMAD=0
1035 NESPH=0
1036 NNSPH=0
1037 NNSPHG = 0
1038.AND. IF (ISPH3D==1NUMSPH_T+MAXPJET>0)
1039 . CALL DSPHCNT(NESPH,NNSPH,NESPHG,NNSPHG)
1040C-----------------------------------------------
1041C MAILLAGE VOLUMES FINIS POUR FVMBAG
1042C-----------------------------------------------
1043 IDMAX=0
1044 NFVNOD=0
1045 NFVTR=0
1046 NFVPART=0
1047 NFVSUBS=0
1048C Equivalent treatment in mono
1049 IF (ANIM_PLY > 0) THEN
1050 IDMAX=0
1051 DO I=1,NUMNOD
1052 IDMAX=MAX(IDMAX,ITAB(I))
1053 ENDDO
1054 IF (NSPMD > 1) CALL SPMD_GLOB_IMAX9(IDMAX,1)
1055 ENDIF
1056C
1057 IF (NSPMD == 1) THEN
1058.OR. IF (NFVBAG>0 ANIM_PLY > 0) THEN
1059 IDMAX=0
1060 DO I=1,NUMNOD
1061 IDMAX=MAX(IDMAX,ITAB(I))
1062 ENDDO
1063 ENDIF
1064C
1065 IF (IFVANI==1) THEN
1066 DO I=1,NFVBAG
1067 NFVTR=NFVTR+FVDATA(I)%NNTR
1068 FVOFF(1,I)=NUMNOD+NODCUT+NSECT+NRWALL+NNWL
1069 . +NNSRG+NNSMD+NNSPH+2*NUMELS16+NFVNOD
1070 FVOFF(2,I)=IDMAX+NFVNOD
1071 NFVNOD=NFVNOD+FVDATA(I)%NNS_ANIM
1072 NFVPART=NFVPART+FVDATA(I)%NPOLH_ANIM
1073 NFVSUBS=NFVSUBS+1
1074 ENDDO
1075 ENDIF
1076 ELSE
1077 IF (IFVANI==1)
1078 . CALL SPMD_FVB_ADIM(NFVTR, FVOFF, NFVNOD, NFVPART, NFVSUBS,
1079 . IDMAX, ITAB, NODCUT, NNWL, NNSRG,
1080 . NNSMD, NNSPHG)
1081 ENDIF
1082.AND. IF (ISPMD==0NFVTR>0)
1083 . ALLOCATE(FVEL2FA(NFVTR), FVINUM(NFVTR))
1084C
1085c--------------------------------------------------------------------
1086c xfem crack for layered shells
1087 IF (ANIM_CRK > 0) THEN
1088 IF (NSPMD == 1) THEN
1089 DO I=1,NUMNOD
1090 IDMAX = MAX(IDMAX,ITAB(I)) ! max id of all standard nodes
1091 ENDDO
1092 ELSE
1093 CALL SPMD_CRK_IDMAX(IDMAX,ITAB)
1094 CALL SPMD_MAX_XFE_I(IDMAX)
1095 ENDIF
1096 ENDIF
1097 IDMAXNOD = IDMAX
1098C-----------------------------------------------
1099C WRITE CONTROL
1100C-----------------------------------------------
1101C
1102 NUMELS_T = NUMELSG
1103 NUMELS16_T = NUMELS16G
1104 NUMELT_T = NUMELTRG
1105 NUMELR_T = NUMELRG
1106 NUMELP_T = NUMELPG
1107
1108 IF (ISPMD==0) THEN
1109C 0x542b
1110 MAGIC = 21548
1111 CALL WRITE_I_C(MAGIC,1)
1112C
1113 R4 = TT
1114 IF (NEIG==0) THEN
1115 CALL WRITE_R_C(R4,1)
1116 CALL ANI_TXT('time=',5)
1117 KKT=0
1118 DO K=1,NLTITLE
1119 IF(NTITLETAB(K)==IANIM) THEN
1120 KKT=K
1121 TITL = TITLETAB(K)
1122 ENDIF
1123 ENDDO
1124 IF(KKT/= 0) THEN
1125 CALL ANI_TXT(TITL,81)
1126 ELSE
1127 CALL ANI_TXT('modanim',7)
1128 ENDIF
1129 ELSE
1130 IF (R4>=ZERO) THEN
1131 CALL WRITE_R_C(R4,1)
1132 CALL ANI_TXT('frequency=',10)
1133 CALL ANI_TXT('eigenmode',9)
1134 ELSE
1135 CALL WRITE_R_C(ZERO,1)
1136 CALL ANI_TXT('frequency=',10)
1137 CALL ANI_TXT('static mode',11)
1138 ENDIF
1139 ENDIF
1140 CALL ANI_TXT('radioss run=',12)
1141C
1142 CALL WRITE_I_C(ANIM_M,1)
1143 CALL WRITE_I_C(1,1)
1144
1145 IF(NUMELS_T+ISPH3D*(NUMSPH_T+MAXPJET)+NUMELIG3D==0) THEN
1146 CALL WRITE_I_C(0,1)
1147 ELSE
1148 CALL WRITE_I_C(1,1)
1149 ENDIF
1150
1151 IFLAG1D = NUMELT_T+NUMELP_T+NUMELR_T+NANIM1D+NRBODY+
1152 . NRBE2T+NRBE3T
1153 IF (IFLAG1D/=0) IFLAG1D = 1
1154 CALL WRITE_I_C(IFLAG1D,1)
1155
1156C HIERARCHY
1157 CALL WRITE_I_C(1,1)
1158C TH
1159 CALL WRITE_I_C(0,1)
1160C REP. SHELL
1161
1162 IF(ISHFRAM==1)THEN
1163 CALL WRITE_I_C(0,1)
1164 ELSE
1165 CALL WRITE_I_C(1,1)
1166 ENDIF
1167
1168.AND. IF(ISPH3D==0
1169 . (NUMSPH_T+MAXPJET/=0))THEN
1170 CALL WRITE_I_C(1,1)
1171 ELSE
1172 CALL WRITE_I_C(0,1)
1173 ENDIF
1174
1175 IF(ANIM_VERS>=47)THEN
1176 CALL WRITE_I_C(1,1)
1177 ELSE
1178 CALL WRITE_I_C(0,1)
1179 ENDIF
1180 CALL WRITE_I_C(0,1)
1181 IF (NFVNOD>0) THEN
1182 NFVNODT=NFVNOD+3
1183 ELSE
1184 NFVNODT=0
1185 ENDIF
1186 CALL WRITE_I_C(NUMNODG+NODCUT+NSECT+NRWALL+NNWL
1187 . +NNSRG+NNSMD+NNSPHG+2*NUMELS16G+NFVNODT+NFNOD_PXFEMG
1188 . +NFNOD_CRKXFEMG+64*NUMELIG3D,1)
1189c
1190 CALL WRITE_I_C(NBF+NELCUT+NESBW2+NFVTR+NBF_PXFEMG
1191 . +NBF_CRKXFEMG,1)
1192 NBPART2D=NBPART+NCUTS+NSECT+NRWALL+NSURG+NSMAD
1193Cplyxfem
1194 NBPART2D = NBPART2D + NPLYPARTW
1195C crack xfem
1196 NBPART2D = NBPART2D + NCRKPARTW
1197 CALL WRITE_I_C(NBPART+NCUTS
1198 . +NSECT+NRWALL+NSURG+NSMAD+NFVPART+NPLYPARTW
1199 . +NCRKPARTW,1)
1200 CALL WRITE_I_C(NN_ANI,1)
1201 IF(NBF+NELCUT+NESBW2+NFVTR+NBF_PXFEMG
1202 . +NBF_CRKXFEMG==0)THEN
1203 CALL WRITE_I_C(0,1)
1204 ELSE
1205 CALL WRITE_I_C(NCE_ANI,1)
1206 ENDIF
1207 CALL WRITE_I_C(NV_ANI,1)
1208 IF(NBF+NELCUT+NESBW2+NFVTR+NBF_PXFEMG
1209 . +NBF_CRKXFEMG==0)THEN
1210 CALL WRITE_I_C(0,1)
1211 ELSE
1212 CALL WRITE_I_C(NCT_ANI,1)
1213 ENDIF
1214 CALL WRITE_I_C(NSKEWA,1)
1215 ENDIF
1216
1217C-----------------------------------------------
1218C SKEW
1219C-----------------------------------------------
1220 IF (ISPMD==0) THEN
1221 BUFL = NB1DG*6
1222 ELSE
1223 BUFL = NB1D*6
1224 ENDIF
1225 CALL ANISKEW(ELBUF_TAB,SKEW ,IPARG,X ,IXT ,
1226 2 IXP ,IXR ,GEO ,DD_IAD,BUFL)
1227C-----------------------------------------------
1228C NODE X Y Z
1229C-----------------------------------------------
1230 CALL SCANOR(X,D,CDG,XMIN,YMIN,ZMIN,XMAX,YMAX,ZMAX,SCALE,
1231 . WEIGHT)
1232C
1233 CALL XYZNOD(X,X_TEMP,NODGLOB,WEIGHT)
1234
1235 IF(NODCUT>0)CALL XYZCUT(CBUF,NODCUT)
1236C
1237 IF(NSECT+NRWALL>0) CALL DXYZSECT(
1238 2 NSTRF,RWBUF,NPRW ,X,XMIN,
1239 3 YMIN,ZMIN,XMAX,YMAX,ZMAX,
1240 4 FR_SEC,FR_WALL,WEIGHT,ITAB)
1241
1242 IF (NSURG>0) CALL DXYZSRG(NESRG,IGRSURF,BUFSF)
1243
1244 SNNSPHG = NNSPHG
1245 IF (ISPH3D*(NUMSPH_T+MAXPJET)>0)
1246 . CALL DXYZSPH(NESPH,KXSP,X,SPBUF,SNNSPHG,NNSPH)
1247 SZ16 = NUMELS16G
1248 IF (SZ16>0) CALL XYZ16(IXS,IXS16,X,ISPMD,NSPMD,NUMELS16,NUMELS8,NUMELS10,
1249 . NUMELS20,NUMELS16G)
1250
1251C ply xfem
1252 IF(ANIM_PLY > 0)THEN
1253 IDPLY = NUMNODG+NODCUT+NSECT+NRWALL+NNWL
1254 . +NNSRG+NNSMD+NNSPHG+2*SZ16
1255c
1256 EMPSIZPL=0
1257 DO I = 1,NPLYPART
1258 IPLY = INDX_PLY(I)
1259 CALL XYZNOD_PLY(IPLY,IDPLY,NOD_PXFEM,X,ZI_PLY,NODGLOB,
1260 * EMPSIZPL )
1261 ENDDO
1262 ENDIF
1263c--------------------------------------------------------------------
1264c xfem crack for layered shells
1265 IF (ANIM_CRK > 0) THEN
1266 IDCRK = NUMNODG+NODCUT+NSECT+NRWALL+NNWL
1267 . +NNSRG+NNSMD+NNSPHG+2*SZ16
1268 IF (NSPMD > 1) CALL SPMD_MAX_XFE_I(IDCRK)
1269 DO I = 1,NCRKPART
1270 ICRK = INDX_CRK(I) ! = ILEV
1271 CALL XYZNOD_CRK0(ICRK)
1272 CALL XFECUT(IPARG ,IXC ,IXTG ,ICRK ,ELCUTC ,
1273 . IEL_CRK ,IADC_CRK ,NODEDGE,CRKEDGE,XEDGE4N,
1274 . XEDGE3N )
1275 CALL XYZNOD_CRK(ICRK,NFNOD_CRKXFEMG,NODGLOBXFE)
1276 ENDDO
1277 ENDIF
1278c--------------------------------------------------------------------
1279c
1280 IF (NFVNOD>0) THEN
1281C Mono Equivalent Treatment
1282 IF (NSPMD == 1) THEN
1283 DO I=1,NFVBAG
1284 DO J=1,FVDATA(I)%NNS_ANIM
1285 R4=FVDATA(I)%NOD_ANIM(1,J)
1286 CALL WRITE_R_C(R4,1)
1287 R4=FVDATA(I)%NOD_ANIM(2,J)
1288 CALL WRITE_R_C(R4,1)
1289 R4=FVDATA(I)%NOD_ANIM(3,J)
1290 CALL WRITE_R_C(R4,1)
1291 ENDDO
1292 ENDDO
1293 ELSE
1294 CALL SPMD_FVB_ANOD()
1295 ENDIF
1296 IF (ISPMD==0) THEN
1297 R4=EM10
1298 CALL WRITE_R_C(R4,1)
1299 R4=ZERO
1300 CALL WRITE_R_C(R4,1)
1301 R4=ZERO
1302 CALL WRITE_R_C(R4,1)
1303 R4=ZERO
1304 CALL WRITE_R_C(R4,1)
1305 R4=EM10
1306 CALL WRITE_R_C(R4,1)
1307 R4=ZERO
1308 CALL WRITE_R_C(R4,1)
1309 R4=ZERO
1310 CALL WRITE_R_C(R4,1)
1311 R4=ZERO
1312 CALL WRITE_R_C(R4,1)
1313 R4=EM10
1314 CALL WRITE_R_C(R4,1)
1315 NBID1=NUMNODG+NODCUT+NSECT+NRWALL+NNWL
1316 . +NNSRG+NNSMD+NNSPHG+2*NUMELS16G+NFVNOD+NFNOD_PXFEMG
1317 . +NFNOD_CRKXFEMG+1
1318 NBID2=NBID1+1
1319 NBID3=NBID2+1
1320 ENDIF
1321 ENDIF
1322C-----------------------------------------------
1323C PART SORT
1324C-----------------------------------------------
1325 CALL PARSORC(X ,D ,XNORM,IAD ,CDG ,
1326 . BUFEL,IPARG,IXQ ,IXC ,IXTG ,
1327 . ELBUF_TAB,INVERT,EL2FA,IADG ,
1328 . MATER,IPARTQ,IPARTC,IPARTUR,IPARTTG,
1329 . NODGLOB)
1330C
1331
1332C For the SPMD version you have to update XNORM
1333
1334 IF (NSPMD>1) THEN
1335 LENR = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
1336 CALL SPMD_EXCH_N(XNORM,IAD_ELEM,FR_ELEM,LENR)
1337 ENDIF
1338
1339 BUF = SECTIOM*4
1340
1341 IF(NCUTS>0)CALL PARCUT(ICBUF,NELCUT)
1342
1343 IF(NSECT+NRWALL>0) CALL DPARRWS(
1344 1 NESBW2,NSTRF, IXC ,
1345 2 IXTG ,X ,NODCUT,RWBUF,NPRW,
1346 3 NODGLOB,BUF,IXS)
1347
1348 IF (NSURG>0) CALL DPARSRG(NSURG,NNWL,NODCUT)
1349
1350C ply xfem
1351 IF (ANIM_PLY > 0) THEN
1352 PLYNUMC = 0
1353 DO I=1,NPLYMAX
1354 PLYNUMC=PLYNUMC+PLYSHELL(I)%PLYNUMSHELL
1355 ENDDO
1356 CALL PARSOR_PLY(NEL_PLY, X, D, XNORM, CDG,
1357 . IPARG, IXC, IXTG, INVERT, EL2FA_PLY,
1358 . MATER, IPARTC, NODGLOB, IDPLY, IAD_PLY,
1359 . IAD_PLYG, PLYNUMC, NBF_PXFEMG )
1360 ENDIF
1361c--------------------------------------------------------------------
1362c xfem crack for layered shells
1363 IF (ANIM_CRK > 0) THEN ! part xfem
1364 CALL PARSOR_CRK(
1365 . IPARG ,IXC ,IXTG ,EL2FA_CRK ,IDCRK ,
1366 . IAD_CRK,IAD_CRKG,NBF_CRKXFEM,NBF_CRKXFEMG,IEL_CRK ,
1367 . NODGLOBXFE,INDX_CRK,ITAB )
1368 ENDIF
1369c--------------------------------------------------------------------
1370C Mono Equivalent Treatment
1371 IF (NSPMD == 1) THEN
1372 II=0
1373 IF (IFVANI==1) THEN
1374 ELOFF=0
1375 DO I=1,NFVBAG
1376 ALLOCATE(ITAGT(FVDATA(I)%NNTR))
1377 DO J=1,FVDATA(I)%NNTR
1378 ITAGT(J)=0
1379 ENDDO
1380C
1381 DO J=1,FVDATA(I)%NPOLH_ANIM
1382 DO K=FVDATA(I)%IFVPADR_ANIM(J),
1383 . FVDATA(I)%IFVPADR_ANIM(J+1)-1
1384 KK=FVDATA(I)%IFVPOLH_ANIM(K)
1385 DO N=FVDATA(I)%IFVTADR_ANIM(KK),
1386 . FVDATA(I)%IFVTADR_ANIM(KK+1)-1
1387 NN=FVDATA(I)%IFVPOLY_ANIM(N)
1388 IF (ITAGT(NN)==1) CYCLE
1389 INOD(1)=FVOFF(1,I)+FVDATA(I)%IFVTRI_ANIM(1,NN)-1
1390 INOD(2)=FVOFF(1,I)+FVDATA(I)%IFVTRI_ANIM(2,NN)-1
1391 INOD(3)=FVOFF(1,I)+FVDATA(I)%IFVTRI_ANIM(3,NN)-1
1392 INOD(4)=INOD(3)
1393 II=II+1
1394C number of distinct shell nodes (after merging in FVMESH)
1395 NND=1
1396 IF (INOD(2)/=INOD(1)) NND=NND+1
1397.AND. IF (INOD(3)/=INOD(1)
1398 . INOD(3)/=INOD(2)) NND=NND+1
1399 IF (NND/=3) THEN
1400 INOD(1)=NBID1-1
1401 INOD(2)=NBID2-1
1402 INOD(3)=NBID3-1
1403 INOD(4)=INOD(3)
1404 ENDIF
1405C
1406 CALL WRITE_I_C(INOD,4)
1407 ITAGT(NN)=1
1408 FVEL2FA(ELOFF+NN)=II
1409 FVINUM(II)=ELOFF+NN
1410 ENDDO
1411 ENDDO
1412 ENDDO
1413 ELOFF=ELOFF+FVDATA(I)%NNTR
1414 DEALLOCATE(ITAGT)
1415 ENDDO
1416 ENDIF
1417 ELSE
1418 IF (IFVANI==1)
1419 . CALL SPMD_FVB_ATR(NBID1, NBID2, NBID3, FVEL2FA, FVINUM,
1420 . FVOFF)
1421 ENDIF
1422C-----------------------------------------------
1423C OFF
1424C-----------------------------------------------
1425 CALL ANIOFFC(ELBUF_TAB,IPARG,WAFT ,EL2FA,NBF ,
1426 . IAD ,NBF_L,NBPART,IADG,NODGLOB ,
1427 . IPART,IPARTC,IPARTTG)
1428
1429 IF (ISPMD==0) THEN
1430 DO J=1,NESBW2+NELCUT
1431 CALL WRITE_C_C(1,1)
1432 ENDDO
1433 ENDIF
1434Cplyxfem
1435 NEL_PLY = 0
1436 IF(ANIM_PLY > 0) THEN
1437 CALL ANIOFFC_PLY( IPLY, NEL_PLY, ELBUF_TAB, IPARG,
1438 . WAFT_PLY, EL2FA_PLY, NBF_PXFEM, IAD_PLY,
1439 . PLYNUMC, NBPART, IAD_PLYG, NODGLOB,
1440 . IPART, IPARTC, IPARTTG, NBF_PXFEMG,
1441 . IPM, IGEO, IXC , STACK )
1442 ENDIF
1443cplyxfem
1444C
1445 IF (ANIM_CRK > 0) THEN
1446 CALL ANIOFFC_CRK(
1447 . XFEM_TAB ,IPARG ,IPART ,IPARTC ,IPARTTG ,
1448 . WAFT_CRK ,EL2FA_CRK ,NBF_CRKXFEMG,NBF_CRKXFEM,IAD_CRKG,
1449 . IEL_CRK ,INDX_CRK)
1450 ENDIF
1451C
1452 IF (NSPMD == 1) THEN
1453 IF (IFVANI==1) THEN
1454 ALLOCATE(OFFTR(NFVTR))
1455 DO I=1,NFVTR
1456 OFFTR(I)=0
1457 ENDDO
1458 ELOFF=0
1459 DO I=1,NFVBAG
1460 DO J=1,FVDATA(I)%NPOLH
1461 DO K=FVDATA(I)%IFVPADR(J),FVDATA(I)%IFVPADR(J+1)-1
1462 KK=FVDATA(I)%IFVPOLH(K)
1463 DO N=FVDATA(I)%IFVTADR(KK),
1464 . FVDATA(I)%IFVTADR(KK+1)-1
1465 NN=FVDATA(I)%IFVPOLY(N)
1466 IF (NN>0) THEN
1467 N1=FVDATA(I)%IFVTRI_ANIM(1,NN)
1468 N2=FVDATA(I)%IFVTRI_ANIM(2,NN)
1469 N3=FVDATA(I)%IFVTRI_ANIM(3,NN)
1470 NND=1
1471 IF (N2/=N1) NND=NND+1
1472.AND. IF (N3/=N2N3/=N1) NND=NND+1
1473C
1474 NN=FVEL2FA(ELOFF+NN)
1475 IF (NND==3) OFFTR(NN)=1
1476 ENDIF
1477 ENDDO
1478 ENDDO
1479 ENDDO
1480 ELOFF=ELOFF+FVDATA(I)%NNTR
1481 ENDDO
1482C
1483 CALL WRITE_C_C(OFFTR,NFVTR)
1484 DEALLOCATE(OFFTR)
1485 ENDIF
1486 ELSE
1487 IF (IFVANI==1) CALL SPMD_FVB_AOFF(FVEL2FA)
1488 ENDIF
1489C-----------------------------------------------
1490C PART ADD
1491C-----------------------------------------------
1492 IF (ISPMD==0) THEN
1493 DO I = 1, NBPART
1494 BUFFERP(I) = 0
1495 DO K = 1, NSPMD
1496 BUFFERP(I) = BUFFERP(I) + IADG(K,I)
1497 ENDDO
1498 ENDDO
1499 CALL WRITE_I_C(BUFFERP,NBPART)
1500 ENDIF
1501 IF (ISPMD==0) THEN
1502 IF(NCUTS>0)THEN
1503 CALL WRITE_I_C(ICBUF(MIC4),NCUTS)
1504 ENDIF
1505 ENDIF
1506
1507C to be done on all processors in spmd
1508
1509 NESCT1=0
1510 DO ISECT=1,NSECT
1511 CALL DONESEC(ISECT,NESCT1,NSTRF,IXS)
1512
1513 IF (ISPMD==0) THEN
1514 CALL WRITE_I_C(NELCUT+NBF+NESCT1,1)
1515 endif
1516 END DO
1517 IF (NFVPART>0) THEN
1518 IF (ISPMD==0) ALLOCATE(FVPBUF(NFVPART))
1519 NESMD1=0
1520 IF(NSPMD > 1)
1521 . CALL SPMD_FVB_APAR(NELCUT, NBF, NESCT, NERWL, NESRG,
1522 . NESMD1, FVPBUF)
1523 ENDIF
1524C
1525 IF (ISPMD==0) THEN
1526 NERWL1=0
1527 DO IRWL=1,NRWALL
1528 CALL DONERWL(IRWL,NERWL1,NPRW)
1529 CALL WRITE_I_C(NELCUT+NBF+NESCT+NERWL1,1)
1530 END DO
1531 NESRG1=0
1532
1533 DO ISRG=1,NSURG
1534 CALL DONESRG(ISRG,NESRG1)
1535 CALL WRITE_I_C(NELCUT+NBF+NESCT+NERWL+NESRG1,1)
1536 END DO
1537 NESMD1=0
1538C
1539 IF(ANIM_PLY > 0 )THEN
1540 IF (NSPMD==1)THEN
1541 DO I = 1,NPLYPART
1542 IPLY = INDX_PLY(I)
1543 IAD_PLY(IPLY) = IAD_PLY(IPLY)
1544 . + NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1545 CALL WRITE_I_C(IAD_PLY(IPLY) ,1)
1546 ENDDO
1547cc CALL WRITE_I_C(IAD_PLY ,NPLYPART)
1548 ELSE
1549 DO I = 1,NPLYPART
1550 IPLY = INDX_PLY(I)
1551 IADPC=0
1552 DO P=1,NSPMD
1553 IADPC = IADPC + IAD_PLYG(P,I)
1554 ENDDO
1555 IADPC = IADPC
1556 * + NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1557 CALL WRITE_I_C(IADPC ,1)
1558 ENDDO
1559 ENDIF
1560 DEALLOCATE(IAD_PLY)
1561 ENDIF
1562c------------------------------------------------------------------
1563C xfem crack for layered shells
1564c------------------------------------------------------------------
1565 IF (ANIM_CRK > 0) THEN ! xfem part addresses by layer
1566 IF(NSPMD==1)THEN
1567 DO ILAY = 1,NXLAYMAX
1568 ILEV = ILAY*NXEL
1569 ICRK = INDX_CRK(ILEV)
1570 IAD_LAY(ILAY) = IAD_LAY(ILAY) + IAD_CRK(ICRK)
1571 END DO
1572 DO ILAY=1,NCRKPARTW
1573 IAD_LAY(ILAY) = IAD_LAY(ILAY)
1574 . + NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1575 CALL WRITE_I_C(IAD_LAY(ILAY),1)
1576 ENDDO
1577c---
1578 ELSE ! NSPMD > 1
1579 DO ILAY = 1,NXLAYMAX
1580 ILEV = ILAY*NXEL
1581 ICRK = INDX_CRK(ILEV)
1582 DO P=1,NSPMD
1583 IAD_LAY(ILAY) = IAD_LAY(ILAY) + IAD_CRKG(P,ICRK)
1584 ENDDO
1585 END DO
1586 DO ILAY=1,NCRKPARTW
1587 IAD_LAY(ILAY) = IAD_LAY(ILAY)
1588 . + NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1589 CALL WRITE_I_C(IAD_LAY(ILAY),1)
1590 ENDDO
1591 ENDIF
1592c---
1593 ENDIF
1594c------------------------------------------------------------------
1595c DO I = 1,NCRKPART
1596c ICRK = INDX_CRK(I)
1597c IXEL = MOD(ICRK-1, NXEL) + 1
1598c ILAY = (ICRK-IXEL)/NXEL + 1
1599c IAD_LAY(ILAY) = IAD_CRK(ICRK)
1600c IAD_LAY(ILAY) = IAD_LAY(ILAY) + IAD_CRK(ICRK)
1601c DO ILAY=1,NCRKPARTW
1602c IAD_LAY(ILAY) = IAD_LAY(ILAY)
1603c . + NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1604c CALL WRITE_I_C(IAD_LAY(ILAY),1)
1605c
1606c DO I = 1,NCRKPART
1607c ICRK = INDX_CRK(I)
1608c IXEL = MOD(ICRK-1, NXEL) + 1
1609c ILAY = (ICRK-IXEL)/NXEL + 1
1610c DO P=1,NSPMD
1611c IAD_LAY(ILAY) = IAD_LAY(ILAY) + IAD_CRKG(P,ICRK)
1612c DO ILAY=1,NCRKPARTW
1613c IAD_LAY(ILAY) = IAD_LAY(ILAY)
1614c . + NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1615c CALL WRITE_I_C(IAD_LAY(ILAY),1)
1616c------------------------------------------------------------------
1617C
1618 IF (NSPMD == 1 ) THEN
1619 IF (IFVANI==1) THEN
1620 FVIAD=NELCUT+NBF+NESCT+NERWL+NESRG+NESMD1
1621 DO I=1,NFVBAG
1622 ALLOCATE(ITAGT(FVDATA(I)%NNTR))
1623 DO J=1,FVDATA(I)%NNTR
1624 ITAGT(J)=0
1625 ENDDO
1626ccC
1627 DO J=1,FVDATA(I)%NPOLH_ANIM
1628 DO K=FVDATA(I)%IFVPADR_ANIM(J),
1629 . FVDATA(I)%IFVPADR_ANIM(J+1)-1
1630 KK=FVDATA(I)%IFVPOLH_ANIM(K)
1631 DO N=FVDATA(I)%IFVTADR_ANIM(KK),
1632 . FVDATA(I)%IFVTADR_ANIM(KK+1)-1
1633 NN=FVDATA(I)%IFVPOLY_ANIM(N)
1634 IF (ITAGT(NN)==0) THEN
1635 FVIAD=FVIAD+1
1636 ITAGT(NN)=1
1637 ENDIF
1638 ENDDO
1639 ENDDO
1640 CALL WRITE_I_C(FVIAD,1)
1641 ENDDO
1642 DEALLOCATE(ITAGT)
1643 ENDDO
1644 DEALLOCATE(FVPBUF)
1645 ENDIF
1646 ELSE
1647.AND. IF (IFVANI==1NFVPART>0) THEN
1648 DO I=1,NFVPART
1649 FVIAD=FVPBUF(I)
1650 CALL WRITE_I_C(FVIAD,1)
1651 ENDDO
1652 DEALLOCATE(FVPBUF)
1653 ENDIF
1654 ENDIF
1655C-----------------------------------------------
1656C PART HEAD
1657C-----------------------------------------------
1658 MAXPART = 0
1659 DO I=1,NPART
1660 IF(MATER(I)/=0)THEN
1661 WRITE(STR,'(i9,a1)')IPART(4,I),':'
1662 DO J=1,10
1663 CTEXT(J)=ICHAR(STR(J:J))
1664 ENDDO
1665 IB = 10
1666 CALL FRETITL2(TITL,IPART(LIPART1-LTITR+1,I),40)
1667 DO J=1,LTITL
1668 IF(TITL(J:J)/=' ') IB = J+10
1669 CTEXT(J+10)=ICHAR(TITL(J:J))
1670 ENDDO
1671 CTEXT(IB+1)=0
1672 CALL WRITE_C_C(CTEXT,10+LTITL)
1673 ENDIF
1674 MAXPART = MAX(MAXPART,IPART(4,I))
1675 ENDDO
1676C-----------------------------------------------
1677C CUTS PART
1678C-----------------------------------------------
1679 IF(NCUTS>0)THEN
1680 DO I=1,NCUTS
1681 WRITE(STR,'(9h cut:)')
1682 DO J=1,9
1683 CTEXT(J)=ICHAR(STR(J:J))
1684 ENDDO
1685 IB=9
1686 DO J=1,40
1687 IAUX = ICUT(44*(I-1)+J)
1688 CAUX(1:1) = CHAR(IAUX)
1689 IF(CAUX(1:1)/=' ') IB = J+9
1690 CTEXT(J+9)=ICUT(44*(I-1)+4+J)
1691 ENDDO
1692 CTEXT(IB+1)=0
1693 CALL WRITE_C_C(CTEXT,10+LTITL)
1694 ENDDO
1695 ENDIF
1696 IF (INVSTR<40) THEN
1697 DO ISECT=1,NSECT
1698 WRITE(STR,'(i9,a2,a7)') ISECT,': ','section'
1699 DO J=1,18
1700 CTEXT(J)=ICHAR(STR(J:J))
1701 ENDDO
1702 IB = 18
1703 CTEXT(IB+1)=0
1704 CALL WRITE_C_C(CTEXT,10+LTITL)
1705 END DO
1706 ELSE
1707 DO ISECT=1,NSECT
1708 WRITE(STR,'(i9,a2)') NOM_OPT(I16G+LNOPT1*(ISECT-1)),': '
1709 DO J=1,11
1710 CTEXT(J)=ICHAR(STR(J:J))
1711 ENDDO
1712 CALL FRETITL2(TITL,NOM_OPT(I16G+LNOPT1*(ISECT-1)
1713 & +LNOPT1-LTITR),40)
1714 IB = LTITL+10
1715 DO J=1,LTITL
1716 CTEXT(J+11)=ICHAR(TITL(J:J))
1717 ENDDO
1718 CTEXT(IB+1)=0
1719 CALL WRITE_C_C(CTEXT,10+LTITL)
1720 END DO
1721 END IF
1722 IF (INVSTR<40) THEN
1723 DO IRWL=1,NRWALL
1724 WRITE(STR,'(i9,a2,a10)') IRWL,': ','rigid wall'
1725 DO J=1,21
1726 CTEXT(J)=ICHAR(STR(J:J))
1727 ENDDO
1728 IB = 21
1729 CTEXT(IB+1)=0
1730 CALL WRITE_C_C(CTEXT,10+LTITL)
1731 END DO
1732 ELSE
1733 DO IRWL=1,NRWALL
1734 WRITE(STR,'(i9,a2)') NOM_OPT(I16D+LNOPT1*(IRWL-1)),': '
1735 DO J=1,11
1736 CTEXT(J)=ICHAR(STR(J:J))
1737 ENDDO
1738 IB = LTITL+10
1739 CALL FRETITL2(TITL,NOM_OPT(I16D+LNOPT1*(IRWL-1)
1740 & +LNOPT1-LTITR),40)
1741 DO J=1,LTITL
1742 CTEXT(J+11)=ICHAR(TITL(J:J))
1743 END DO
1744 CTEXT(IB+1)=0
1745 CALL WRITE_C_C(CTEXT,10+LTITL)
1746 END DO
1747 ENDIF
1748C
1749 ISRG=1
1750 DO ISRF=1,NSURF
1751 IF (IGRSURF(ISRF)%TYPE==101) THEN
1752C RADIOSS'S ellipsoid.
1753 WRITE(STR,'(i9,a1)') ISRG,':'
1754 DO J=1,10
1755 CTEXT(J)=ICHAR(STR(J:J))
1756 ENDDO
1757 IB=10
1758 TITL = IGRSURF(ISRF)%TITLE
1759 DO J=1,LTITL
1760 IF(TITL(J:J)/=' ') IB = J+10
1761 CTEXT(J+10)=ICHAR(TITL(J:J))
1762 END DO
1763 CTEXT(IB+1)=0
1764 CALL WRITE_C_C(CTEXT,10+LTITL)
1765 ISRG=ISRG+1
1766 END IF
1767 END DO
1768
1769 ENDIF
1770C
1771 MAXPART = MAXPART + NSECT + NRWALL + NSURF + NCUTS
1772 IF(ANIM_PLY > 0 ) THEN
1773 IF (ISPMD==0)THEN
1774 DO I=1,NPLYPART
1775 WRITE(STR,'(i8,a15)') IDPID_PLY(I),': ply composite'
1776 DO J=1,24
1777 CTEXT(J)=ICHAR(STR(J:J))
1778 ENDDO
1779 IB=24
1780 CTEXT(IB+1)=0
1781 CALL WRITE_C_C(CTEXT,10+LTITL)
1782 END DO
1783 MAXPART = MAXPART + NPLYPART
1784 ENDIF
1785 ENDIF
1786C xfem crack for layered shells +++
1787 IF(ANIM_CRK > 0) THEN
1788 IF (ISPMD==0)THEN
1789 DO I=1,NCRKPARTW
1790 ILAY = I
1791 WRITE(STR,'(i9,a1)') MAXPART + I,':'
1792 DO K=1,10
1793 CTEXT(K)=ICHAR(STR(K:K))
1794 ENDDO
1795 TITL=' '
1796 WRITE(TITL,'(a20,i9)') 'cracked shell layer ',ILAY
1797 DO K=1,LTITL
1798 CTEXT(K+10)=ICHAR(TITL(K:K))
1799 ENDDO
1800 CTEXT(40)=0
1801 CALL WRITE_C_C(CTEXT,10+LTITL)
1802 END DO
1803 MAXPART = MAXPART + NCRKPARTW
1804 ENDIF
1805 ENDIF
1806C xfem crack for layered shells ---
1807 IF (NSPMD == 1) THEN
1808 IF (IFVANI==1) THEN
1809 DO I=1,NFVBAG
1810 DO J=1,FVDATA(I)%NPOLH_ANIM
1811 WRITE(STR,'(i9,a1)') MAXPART + J,':'
1812 DO K=1,10
1813 CTEXT(K)=ICHAR(STR(K:K))
1814 ENDDO
1815 TITL=' '
1816 WRITE(titl,'(A11,I9)') 'POLYHEDRON ',j
1817 DO k=1,ltitl
1818 ctext(k+10)=ichar(titl(k:k))
1819 ENDDO
1820 ctext(31)=0
1821 CALL write_c_c(ctext,10+ltitl)
1822 ENDDO
1823 ENDDO
1824 ENDIF
1825 ELSE
1826 IF (ifvani==1) CALL spmd_fvb_atit(ctext, str, titl, ltitl,
1827 * maxpart )
1828 ENDIF
1829C
1830C-----------------------------------------------
1831C NORMAL
1832C-----------------------------------------------
1833 CALL xyznor(xnorm,nodglob,weight)
1834
1835 IF(nodcut>0)THEN
1836 CALL norcut(xcut,icbuf(mic5))
1837 ENDIF
1838 CALL dsecnor(x ,rwbuf,nprw)
1839 IF (nsurg>0) CALL dsrgnor(igrsurf,bufsf)
1840
1841 IF (ispmd==0) THEN
1842 snnsphg= nnsphg
1843 ELSE
1844 snnsphg= nnsph
1845 ENDIF
1846
1847 IF (isph3d*(numsph_t+maxpjet)>0)
1848 . CALL dsphnor(kxsp,x,spbuf,nnsphg)
1849 IF (ispmd==0.AND.numels16g>0)
1850 . CALL xyznor16(numels16g)
1851
1852 IF(anim_ply > 0) THEN
1853 empsizpl=0
1854 DO i = 1,nplypart
1855 iply = indx_ply(i)
1856 CALL xyznor_ply(iply,xnorm,nodglob,weight,empsizpl)
1857 ENDDO
1858 ENDIF
1859C
1860 IF (anim_crk > 0) THEN
1861 DO i = 1,ncrkpart
1862 icrk = indx_crk(i)
1863 CALL xyznor_crk(icrk,xnorm,nfnod_crkxfemg)
1864 ENDDO
1865 END IF
1866C
1867 IF (ispmd==0) THEN
1868 IF (ifvani==1) THEN
1869 DO i=1,nfvnod
1870 inorm(1) = 0
1871 inorm(2) = 0
1872 inorm(3) = 0
1873 CALL write_s_c(inorm,3)
1874 ENDDO
1875 IF (nfvnod>0) THEN
1876 DO i=1,3
1877 inorm(1) = 0
1878 inorm(2) = 0
1879 inorm(3) = 0
1880 CALL write_s_c(inorm,3)
1881 ENDDO
1882 ENDIF
1883 ENDIF
1884 ENDIF
1885C-----------------------------------------------
1886C ELEMENT MASS FOR MAS & FUNC
1887C-----------------------------------------------
1888 IF(anim_m==1.OR.anim_ce(3)==1.OR.
1889 . anim_ce(25)==1)THEN
1890 CALL dmasanic(elbuf_tab,x ,d ,geo ,iparg,
1891 . ixq ,ixc ,ixtg ,mas ,pm ,
1892 . el2fa,nbf ,igeo , stack )
1893 ENDIF
1894C-----------------------------------------------
1895C N FUNC TEXT
1896C-----------------------------------------------
1897 ! All spmd domains need to have the ANIM_N set
1898 iadchksum = iad_gps+500
1899 DO i=1,output%CHECKSUM%CHECKSUM_COUNT
1900 anim_n(iadchksum+i) = 1
1901 ENDDO
1902
1903 IF (ispmd==0) THEN
1904 ctext(81)=0
1905 IF(anim_n(01)==1) CALL ani_txt('Time Step',9)
1906 IF(anim_n(02)==1) CALL ani_txt('Mass Change',11)
1907 IF(anim_n(03)==1) CALL ani_txt('Nodal Pressure',14)
1908 IF(anim_n(04)==1) CALL ani_txt('Nodal Density',13)
1909 IF(anim_n(05)==1) CALL ani_txt('Nodal Specific Energy',21)
1910 IF(anim_n(06)==1) CALL ani_txt('Nodal Temperature',17)
1911 IF(anim_n(07)==1) CALL ani_txt('Nodal Variable 1',16)
1912 IF(anim_n(08)==1) CALL ani_txt('Nodal Variable 2',16)
1913 IF(anim_n(09)==1) CALL ani_txt('Nodal Variable 3',16)
1914 IF(anim_n(10)==1) CALL ani_txt('Nodal Variable 4',16)
1915 IF(anim_n(11)==1) CALL ani_txt('Nodal Variable 5',16)
1916 IF(anim_n(12)==1) CALL ani_txt('Inertia Change',14)
1917 IF(anim_n(13)==1) CALL ani_txt('Nodal Potential',15)
1918 IF(anim_n(14)==1) CALL ani_txt('Non Diagonal Mass Change',24)
1919 IF(anim_n(15)==1) CALL ani_txt('%damage(type2 interface) / Normal',33)
1920 IF(anim_n(16)==1) CALL ani_txt('%damage(type2 interface) / Tangent',34)
1921 IF(anim_n(17)==1) CALL ani_txt('Nodal Schlieren',15)
1922 IF(anim_n(18)==1) CALL ani_txt('Nodal Rotational Stiffness',26)
1923 IF(anim_n(19)==1) CALL ani_txt('Nodal Stiffness',15)
1924 IF(anim_n(20)==1) CALL ani_txt('Nodal Volumetric Fraction - 1',29)
1925 IF(anim_n(21)==1) CALL ani_txt('Nodal Volumetric Fraction - 2',29)
1926 IF(anim_n(22)==1) CALL ani_txt('Nodal Volumetric Fraction - 3',29)
1927 IF(anim_n(23)==1) CALL ani_txt('Nodal Volumetric Fraction - 4',29)
1928 IF(anim_n(24)==1) CALL ani_txt('Centroid Volumetric Fraction - 1',32) !inter22
1929 IF(anim_n(25)==1) CALL ani_txt('Centroid Volumetric Fraction - 2',32) !inter22
1930 IF(anim_n(26)==1) CALL ani_txt('Centroid Volumetric Fraction - 3',32) !inter22
1931 IF(anim_n(27)==1) CALL ani_txt('Centroid Volumetric Fraction - 4',32) !inter22
1932 IF(anim_n(28)==1) CALL ani_txt('Centroid New Volume',19) !inter22
1933 IF(anim_n(29)==1) CALL ani_txt('Centroid Old Volume',19) !inter22
1934 IF(anim_n(30)==1) CALL ani_txt('Nodal Sound Speed',17) !FVMBAG
1935 IF(anim_n(31)==1) CALL ani_txt('Nodal External Pressure',23) !Pressure applied by load case (/LOAD/PFLUID, /LOAD/PBLAST , etc...)
1936C----------------------------
1937C GPS TEXT
1938C----------------------------
1939 iadgps = iad_gps
1940 IF(anim_n(iadgps+1)==1) CALL ani_txt('GPS1 Pressure',13)
1941 IF(anim_n(iadgps+2)==1) CALL ani_txt('GPS1 Von Mises',14)
1942 IF(anim_n(iadgps+3)==1) CALL ani_txt('GPS1 SIGXX',10)
1943 IF(anim_n(iadgps+4)==1) CALL ani_txt('GPS1 SIGYY',10)
1944 IF(anim_n(iadgps+5)==1) CALL ani_txt('GPS1 SIGZZ',10)
1945 IF(anim_n(iadgps+6)==1) CALL ani_txt('GPS1 SIGXY',10)
1946 IF(anim_n(iadgps+7)==1) CALL ani_txt('GPS1 SIGZY',10)
1947 IF(anim_n(iadgps+8)==1) CALL ani_txt('GPS1 SIGXZ',10)
1948 IF(anim_n(iadgps+9)==1) CALL ani_txt('GPS1 SIGXX_U',12)
1949 IF(anim_n(iadgps+10)==1) CALL ani_txt('GPS1 SIGYY_U',12)
1950 IF(anim_n(iadgps+11)==1) CALL ani_txt('GPS1 SIGZZ_U',12)
1951 IF(anim_n(iadgps+12)==1) CALL ani_txt('GPS1 SIGXY_U',12)
1952 IF(anim_n(iadgps+13)==1) CALL ani_txt('GPS1 SIGZY_U',12)
1953 IF(anim_n(iadgps+14)==1) CALL ani_txt('GPS1 SIGXZ_U',12)
1954 IF(anim_n(iadgps+15)==1) CALL ani_txt('GPS1 SIGXX_L',12)
1955 IF(anim_n(iadgps+16)==1) CALL ani_txt('GPS1 SIGYY_L',12)
1956 IF(anim_n(iadgps+17)==1) CALL ani_txt('GPS1 SIGZZ_L',12)
1957 IF(anim_n(iadgps+18)==1) CALL ani_txt('GPS1 SIGXY_L',12)
1958 IF(anim_n(iadgps+19)==1) CALL ani_txt('GPS1 SIGZY_L',12)
1959 IF(anim_n(iadgps+20)==1) CALL ani_txt('GPS1 SIGXZ_L',12)
1960 iadgps = iad_gps+100
1961 IF(anim_n(iadgps+1)==1) CALL ani_txt('GPS2 Pressure',13)
1962 IF(anim_n(iadgps+2)==1) CALL ani_txt('GPS2 Von Mises',14)
1963 IF(anim_n(iadgps+3)==1) CALL ani_txt('GPS2 SIGXX',10)
1964 IF(anim_n(iadgps+4)==1) CALL ani_txt('GPS2 SIGYY',10)
1965 IF(anim_n(iadgps+5)==1) CALL ani_txt('GPS2 SIGZZ',10)
1966 IF(anim_n(iadgps+6)==1) CALL ani_txt('GPS2 SIGXY',10)
1967 IF(anim_n(iadgps+7)==1) CALL ani_txt('GPS2 SIGZY',10)
1968 IF(anim_n(iadgps+8)==1) CALL ani_txt('GPS2 SIGXZ',10)
1969 IF(anim_n(iadgps+9)==1) CALL ani_txt('GPS2 SIGXX_U',12)
1970 IF(anim_n(iadgps+10)==1) CALL ani_txt('GPS2 SIGYY_U',12)
1971 IF(anim_n(iadgps+11)==1) CALL ani_txt('GPS2 SIGZZ_U',12)
1972 IF(anim_n(iadgps+12)==1) CALL ani_txt('GPS2 SIGXY_U',12)
1973 IF(anim_n(iadgps+13)==1) CALL ani_txt('GPS2 SIGZY_U',12)
1974 IF(anim_n(iadgps+14)==1) CALL ani_txt('GPS2 SIGXZ_U',12)
1975 IF(anim_n(iadgps+15)==1) CALL ani_txt('GPS2 SIGXX_L',12)
1976 IF(anim_n(iadgps+16)==1) CALL ani_txt('GPS2 SIGYY_L',12)
1977 IF(anim_n(iadgps+17)==1) CALL ani_txt('GPS2 SIGZZ_L',12)
1978 IF(anim_n(iadgps+18)==1) CALL ani_txt('gps2 sigxy_l',12)
1979 IF(ANIM_N(IADGPS+19)==1) CALL ANI_TXT('gps2 sigzy_l',12)
1980 IF(ANIM_N(IADGPS+20)==1) CALL ANI_TXT('gps2 sigxz_l',12)
1981c stress gps
1982 IADGPS = IAD_GPS+200
1983 IF(ANIM_N(IADGPS+1)==1) CALL ANI_TXT('gps sigxx',9)
1984 IF(ANIM_N(IADGPS+2)==1) CALL ANI_TXT('gps sigyy',9)
1985 IF(ANIM_N(IADGPS+3)==1) CALL ANI_TXT('gps sigzz',9)
1986 IF(ANIM_N(IADGPS+4)==1) CALL ANI_TXT('gps sigxy',9)
1987 IF(ANIM_N(IADGPS+5)==1) CALL ANI_TXT('gps sigzy',9)
1988 IF(ANIM_N(IADGPS+6)==1) CALL ANI_TXT('gps sigxz',9)
1989c stress isogeo
1990 IADISO = IAD_GPS+300
1991 IF(ANIM_N(IADISO+1)==1) CALL ANI_TXT('stress isogeo sigxx',19)
1992 IF(ANIM_N(IADISO+2)==1) CALL ANI_TXT('stress isogeo sigyy',19)
1993 IF(ANIM_N(IADISO+3)==1) CALL ANI_TXT('stress isogeo sigzz',19)
1994 IF(ANIM_N(IADISO+4)==1) CALL ANI_TXT('stress isogeo sigxy',19)
1995 IF(ANIM_N(IADISO+5)==1) CALL ANI_TXT('stress isogeo sigzy',19)
1996 IF(ANIM_N(IADISO+6)==1) CALL ANI_TXT('stress isogeo sigxz',19)
1997c strain gps
1998 IADGPS = IAD_GPS+400
1999 IF(ANIM_N(IADGPS+1)==1) CALL ANI_TXT('gpstrain epsxx',14)
2000 IF(ANIM_N(IADGPS+2)==1) CALL ANI_TXT('gpstrain epsyy',14)
2001 IF(ANIM_N(IADGPS+3)==1) CALL ANI_TXT('gpstrain epszz',14)
2002 IF(ANIM_N(IADGPS+4)==1) CALL ANI_TXT('gpstrain epsxy',14)
2003 IF(ANIM_N(IADGPS+5)==1) CALL ANI_TXT('gpstrain epszy',14)
2004 IF(ANIM_N(IADGPS+6)==1) CALL ANI_TXT('gpstrain epsxz',14)
2005C-----------------------------------------------
2006 IADCHKSUM = IAD_GPS+500
2007 IF(OUTPUT%CHECKSUM%CHECKSUM_COUNT > 0) THEN
2008 ! print *,'output%CHECKSUM%CHECKSUM_COUNT = ',OUTPUT%CHECKSUM%CHECKSUM_COUNT
2009 DO I=1,OUTPUT%CHECKSUM%CHECKSUM_COUNT
2010 CALL ANI_TXT('zchksm_'//OUTPUT%CHECKSUM%CHECKSUMS(I), 7+LEN_TRIM(OUTPUT%CHECKSUM%CHECKSUMS(I)))
2011 ! print *, 'anim_n(iadchksum+i) = ', ANIM_N(IADCHKSUM+I)
2012 ! print *, 'output%CHECKSUM%CHECKSUMS(i) = ', OUTPUT%CHECKSUM%CHECKSUMS(I)
2013 ENDDO
2014 ENDIF
2015C-----------------------------------------------
2016C E(quad+shell+truss+..) FUNC TEXT
2017C-----------------------------------------------
2018 IF(NBF+NELCUT+NESBW2/=0)THEN
2019 IF(ANIM_CE(1)==1) CALL ANI_TXT('plastic strain',14)
2020 IF(ANIM_CE(2)==1) CALL ANI_TXT('density',7)
2021 IF(ANIM_CE(3)==1) CALL ANI_TXT('specific energy',15)
2022 IF(ANIM_CE(4)==1) CALL ANI_TXT('temperature',11)
2023 IF(ANIM_CE(5)==1) CALL ANI_TXT('thickness',9)
2024 IF(ANIM_CE(6)==1) CALL ANI_TXT('pressure',8)
2025 IF(ANIM_CE(7)==1) CALL ANI_TXT('von mises',9)
2026 IF(ANIM_CE(8)==1) CALL ANI_TXT('turbulent energy',16)
2027 IF(ANIM_CE(9)==1) CALL ANI_TXT('turbulent viscosity',19)
2028 IF(ANIM_CE(10)==1) CALL ANI_TXT('vorticity-x',11)
2029 IF(ANIM_CE(11)==1) CALL ANI_TXT('damage 1',8)
2030 IF(ANIM_CE(12)==1) CALL ANI_TXT('damage 2',8)
2031 IF(ANIM_CE(13)==1) CALL ANI_TXT('damage 3',8)
2032 IF(ANIM_CE(14)==1) CALL ANI_TXT('stress x ',9)
2033 IF(ANIM_CE(15)==1) CALL ANI_TXT('stress y ',9)
2034 IF(ANIM_CE(16)==1) CALL ANI_TXT('stress z ',9)
2035 IF(ANIM_CE(17)==1) CALL ANI_TXT('stress xy',9)
2036 IF(ANIM_CE(18)==1) CALL ANI_TXT('stress yz',9)
2037 IF(ANIM_CE(19)==1) CALL ANI_TXT('stress zx',9)
2038 IF(ANIM_CE(20)==1) CALL ANI_TXT('user var 1',10)
2039 IF(ANIM_CE(21)==1) CALL ANI_TXT('user var 2',10)
2040 IF(ANIM_CE(22)==1) CALL ANI_TXT('user var 3',10)
2041 IF(ANIM_CE(23)==1) CALL ANI_TXT('user var 4',10)
2042 IF(ANIM_CE(24)==1) CALL ANI_TXT('user var 5',10)
2043 IF(ANIM_CE(25)==1) CALL ANI_TXT('hourglass energy per unit mass',30)
2044 IF(ANIM_CE(26)==1) CALL ANI_TXT('strain rate',11)
2045 IF(ANIM_CE(27)==1) CALL ANI_TXT('user var 6',10)
2046 IF(ANIM_CE(28)==1) CALL ANI_TXT('user var 7',10)
2047 IF(ANIM_CE(29)==1) CALL ANI_TXT('user var 8',10)
2048 IF(ANIM_CE(30)==1) CALL ANI_TXT('user var 9',10)
2049 IF(ANIM_CE(31)==1) CALL ANI_TXT('user var 10',11)
2050 IF(ANIM_CE(32)==1) CALL ANI_TXT('user var 11',11)
2051 IF(ANIM_CE(33)==1) CALL ANI_TXT('user var 12',11)
2052 IF(ANIM_CE(34)==1) CALL ANI_TXT('user var 13',11)
2053 IF(ANIM_CE(35)==1) CALL ANI_TXT('user var 14',11)
2054 IF(ANIM_CE(36)==1) CALL ANI_TXT('user var 15',11)
2055 IF(ANIM_CE(37)==1) CALL ANI_TXT('user var 16',11)
2056 IF(ANIM_CE(38)==1) CALL ANI_TXT('user var 17',11)
2057 IF(ANIM_CE(39)==1) CALL ANI_TXT('user var 18',11)
2058 DO I=40,2039
2059 IF(ANIM_CE(I)==1)THEN
2060 II = (I - 39)/100 + 1
2061 IUS = MOD ((I - 39), 100)
2062 IF(IUS==0)THEN
2063 IUS = 100
2064 II = II -1
2065 ENDIF
2066 WRITE(MES,'(a,i2,a,i3,a)')
2067 . 'user var',II,'(layer',IUS,')'
2068 CALL ANI_TXT(MES,20)
2069 ENDIF
2070 ENDDO
2071 IF(ANIM_CE(2040)==1) CALL ANI_TXT('plastic strain upper',20)
2072 IF(ANIM_CE(2041)==1) CALL ANI_TXT('plastic strain lower',20)
2073 DO I=2042,2141
2074 IF(ANIM_CE(I)==1)THEN
2075 IUS = MOD ((I - 2041), 100)
2076 IF(IUS==0)IUS = 100
2077 WRITE(MES,'(a,i3,a)')
2078 . 'plast strn layer ',IUS, ' '
2079 CALL ANI_TXT(MES,21)
2080 END IF
2081 END DO
2082 IF(ANIM_CE(2142)==1) CALL ANI_TXT('nb of failed layers',19)
2083 IF(ANIM_CE(2143)==1) CALL ANI_TXT('airbag crossing mass',20)
2084 IF(ANIM_CE(2144)==1)
2085 . CALL ANI_TXT('airbag crossing velocity',24)
2086 IF(ANIM_CE(2145)==1) CALL ANI_TXT('fvmbag - mass',13)
2087 IF(ANIM_CE(2146)==1) CALL ANI_TXT('fvmbag - pressure',17)
2088 IF(ANIM_CE(2147)==1)
2089 . CALL ANI_TXT('fvmbag - fluid velocity x',25)
2090 IF(ANIM_CE(2148)==1)
2091 . CALL ANI_TXT('fvmbag - fluid velocity y',25)
2092 IF(ANIM_CE(2149)==1)
2093 . CALL ANI_TXT('fvmbag - fluid velocity z',25)
2094 IF(ANIM_CE(2150)==1) CALL ANI_TXT('fvmbag - density',16)
2095 IF(ANIM_CE(2151)==1)
2096 . CALL ANI_TXT('fvmbag - specific energy',24)
2097 IF(ANIM_CE(2152)==1) CALL ANI_TXT('fvmbag - sound speed',20)
2098 IF(ANIM_CE(2153)==1) CALL ANI_TXT('fvmbag - gama',13)
2099 IF(ANIM_CE(2154)==1)
2100 . CALL ANI_TXT('fvmbag - visu polyhedra',23)
2101 IF(ANIM_CE(2155)==1) CALL ANI_TXT('thinning percentage',19)
2102 IF(ANIM_CE(2156)==1)
2103 . CALL ANI_TXT('estimated error on thickness',28)
2104 DO I=2240,10139
2105 IF(ANIM_CE(I)==1)THEN
2106 II = (I - 2239)/100 + 21
2107 IUS = MOD ((I - 2239), 100)
2108 IF(IUS==0)THEN
2109 IUS = 100
2110 II = II -1
2111 ENDIF
2112 WRITE(MES,'(a,i2,a,i3,a)')
2113 . 'user var',II,'(layer',IUS,')'
2114 CALL ANI_TXT(MES,20)
2115 ENDIF
2116 ENDDO
2117C
2118 DO I=10140,10239
2119 IF(ANIM_CE(I)==1)THEN
2120 II = I - 10139
2121 WRITE(MES,'(a,i3,a)')
2122 . 'phi,(layer ',II,')'
2123 CALL ANI_TXT(MES,16)
2124 ENDIF
2125 ENDDO
2126 IF(ANIM_CE(10240)==1) CALL ANI_TXT('inter ply - min-damage',22)
2127 IF(ANIM_CE(10241)==1) CALL ANI_TXT('inter ply -sigzz',16)
2128 IF(ANIM_CE(10242)==1) CALL ANI_TXT('inter ply -sigyz',16)
2129 IF(ANIM_CE(10243)==1) CALL ANI_TXT('inter ply -sigxz',16)
2130 IF(ANIM_CE(10244)==1) CALL ANI_TXT('inter ply -epszz',16)
2131 IF(ANIM_CE(10245)==1) CALL ANI_TXT('inter ply -epsyz',16)
2132 IF(anim_ce(10246)==1) CALL ani_txt('INTER PLY -EPSXZ',16)
2133 IF(anim_ce(10247)==1) CALL ani_txt('INTER PLY -EINT',15)
2134 IF(anim_ce(10248)==1) CALL ani_txt('Volumetric Fraction 1',21)
2135 IF(anim_ce(10249)==1) CALL ani_txt('Volumetric Fraction 2',21)
2136 IF(anim_ce(10250)==1) CALL ani_txt('Volumetric Fraction 3',21)
2137 IF(anim_ce(10251)==1) CALL ani_txt('Volumetric Fraction 4',21)
2138 IF(anim_ce(10252)==1) CALL ani_txt('Burn Fraction',13)
2139C-----------------------------------------------
2140C ELEMENT FAILURE COEFFECIENT : NXT CRITRIA
2141C-----------------------------------------------
2142 IF(anim_ce(10253)==1) CALL ani_txt('NXT FAILURE FACTOR',18)
2143 IF(anim_ce(10254)==1) CALL ani_txt('SIGMA1/h',8)
2144 IF(anim_ce(10255)==1) CALL ani_txt('SIGMA2/h',8)
2145C-----------------------------------------------
2146C DAMAGE FACTOR : MAX of ALL CRITRIA BY LAYER
2147C-----------------------------------------------
2148 IF(anim_ce(10256)==1) CALL ani_txt('MAX DAMAGE ELEMENT',18)
2149 IF(anim_ce(10257)==1) CALL ani_txt('MAX DAMAGE UPPER',16)
2150 IF(anim_ce(10258)==1) CALL ani_txt('MAX DAMAGE LOWER',16)
2151 IF(anim_ce(10259)==1) CALL ani_txt('MAX DAMAGE MEMBRANE',19)
2152 DO i=10260,10359
2153 IF(anim_ce(i)==1)THEN
2154 ii = i - 10259
2155 WRITE(mes,'(A,I3,A)')
2156 . 'DAMAGE,(Layer ',ii,')'
2157 CALL ani_txt(mes,20)
2158 ENDIF
2159 ENDDO
2160 IF(anim_ce(10360)==1) CALL ani_txt('NXT FAILURE FACTOR UPPER',24)
2161 IF(anim_ce(10361)==1) CALL ani_txt('NXT FAILURE FACTOR LOWER',24)
2162 IF(anim_ce(10362)==1) CALL ani_txt('NXT FAILURE FACTOR MEMBRANE',27)
2163 DO i=10363,10462
2164 IF(anim_ce(i)==1)THEN
2165 ii = i - 10362
2166 WRITE(mes,'(A,I3,A)')
2167 . 'NXT FAILURE FACTOR,(Layer ',ii,')'
2168 CALL ani_txt(mes,32)
2169 ENDIF
2170 ENDDO
2171 IF(anim_ce(10463)==1) CALL ani_txt('SIGMA1/h UPPER',14)
2172 IF(anim_ce(10464)==1) CALL ani_txt('SIGMA1/h LOWER',14)
2173 IF(anim_ce(10465)==1) CALL ani_txt('SIGMA1/h MEMBRANE',17)
2174 DO i=10466,10565
2175 IF(anim_ce(i)==1)THEN
2176 ii = i - 10465
2177 WRITE(mes,'(A,I3,A)')
2178 . 'SIGMA1/h,(Layer ',ii,')'
2179 CALL ani_txt(mes,22)
2180 ENDIF
2181 ENDDO
2182 IF(anim_ce(10566)==1) CALL ani_txt('SIGMA2/h UPPER',14)
2183 IF(anim_ce(10567)==1) CALL ani_txt('SIGMA2/h LOWER',14)
2184 IF(anim_ce(10568)==1) CALL ani_txt('SIGMA2/h MEMBRANE',17)
2185 DO i=10569,10668
2186 IF(anim_ce(i)==1)THEN
2187 ii = i - 10568
2188 WRITE(mes,'(A,I3,A)')
2189 . 'SIGMA2/h,(Layer ',ii,')'
2190 CALL ani_txt(mes,22)
2191 ENDIF
2192 ENDDO
2193 IF(anim_ce(10669)==1)CALL ani_txt('INTER PLY - MAX-DAMAGE',22)
2194 IF(anim_ce(10670)==1)CALL ani_txt('TIME DELETION ELEMENT',21)
2195 IF(anim_ce(10671)==1)CALL ani_txt('Sound Speed',11)
2196 IF(anim_ce(10672)==1)CALL ani_txt('Schlieren',9)
2197 IF(anim_ce(10673)==1)CALL ani_txt('phi MEMBRANE',12)
2198 IF(anim_ce(10674)==1)CALL ani_txt('phi UPPER',9)
2199 IF(anim_ce(10675)==1)CALL ani_txt('phi LOWER',9)
2200 IF(anim_ce(10676)==1)CALL ani_txt('Domain',6)
2201C-----------------------------------------------
2202C element equivalent stress criteria
2203C-----------------------------------------------
2204 IF(anim_ce(10677)==1)CALL ani_txt('Equiv stress',12)
2205C-----------------------------------------------
2206C Plastic Strain output (all NPTT) for new PID51 composite shell
2207C-----------------------------------------------
2208C upper for PID51
2209 DO i=10678,10777
2210 IF (anim_ce(i) == 1) THEN
2211 ius = mod((i - 10677), 100)
2212 IF(ius==0) ius = 100
2213 WRITE(mes,'(A,I3,A)')
2214 . 'Plastic Strain Upper Layer',ius, ' '
2215 CALL ani_txt(mes,30)
2216 END IF
2217 END DO
2218C lower for PID51
2219 DO i=10778,10877
2220 IF (anim_ce(i) == 1) THEN
2221 ius = mod((i - 10777), 100)
2222 IF(ius==0) ius = 100
2223 WRITE(mes,'(A,I3,A)')
2224 . 'Plastic Strain Lower Layer',ius, ' '
2225 CALL ani_txt(mes,30)
2226 END IF
2227 END DO
2228C all NPTT for PID51
2229 DO i=1,100
2230 DO j=1,10
2231 ius = 10*i+j
2232 IF (anim_ce(ius + 10877) == 1) THEN
2233 ilay = i
2234 ipt = j
2235 WRITE(mes,'(A,I4,I3,A)')
2236 . 'Plast Strn Layer/IPT ',ilay,ipt, ' '
2237 CALL ani_txt(mes,29)
2238 END IF
2239 ENDDO
2240 ENDDO
2241C-----------------------------------------------
2242C Artificial Viscosity
2243C-----------------------------------------------
2244 IF(anim_ce(11888)==1)CALL ani_txt('Artificial Viscosity',20) !previous PID uses ANIM_CE(10678:11887)
2245 IF(anim_ce(11889)==1)CALL ani_txt('Detonation Time',15)
2246
2247 !multumaterial law 20 ouptus
2248 IF(anim_ce(11890)==1)CALL ani_txt('Density-1',9)
2249 IF(anim_ce(11891)==1)CALL ani_txt('Density-2',9)
2250 IF(anim_ce(11892)==1)CALL ani_txt('Density-3',9)
2251 IF(anim_ce(11893)==1)CALL ani_txt('Density-4',9)
2252
2253 IF(anim_ce(11894)==1)CALL ani_txt('Specific Energy-1',17)
2254 IF(anim_ce(11895)==1)CALL ani_txt('Specific Energy-2',17)
2255 IF(anim_ce(11896)==1)CALL ani_txt('Specific Energy-3',17)
2256 IF(anim_ce(11897)==1)CALL ani_txt('Specific Energy-4',17)
2257
2258 IF(anim_ce(11898)==1)CALL ani_txt('Temperature-1',13)
2259 IF(anim_ce(11899)==1)CALL ani_txt('Temperature-2',13)
2260 IF(anim_ce(11900)==1)CALL ani_txt('Temperature-3',13)
2261 IF(anim_ce(11901)==1)CALL ani_txt('Temperature-4',13)
2262
2263 IF(anim_ce(11902)==1)CALL ani_txt('Pressure-1',10)
2264 IF(anim_ce(11903)==1)CALL ani_txt('Pressure-2',10)
2265 IF(anim_ce(11904)==1)CALL ani_txt('Pressure-3',10)
2266 IF(anim_ce(11905)==1)CALL ani_txt('Pressure-4',10)
2267
2268 IF(anim_ce(11906)==1)CALL ani_txt('Plastic Strain-1',16)
2269 IF(anim_ce(11907)==1)CALL ani_txt('Plastic Strain-2',16)
2270 IF(anim_ce(11908)==1)CALL ani_txt('Plastic Strain-3',16)
2271 IF(anim_ce(11909)==1)CALL ani_txt('Plastic Strain-4',16)
2272
2273 IF(anim_ce(11910)==1)CALL ani_txt('Sound Speed-1',13)
2274 IF(anim_ce(11911)==1)CALL ani_txt('Sound Speed-2',13)
2275 IF(anim_ce(11912)==1)CALL ani_txt('Sound Speed-3',13)
2276 IF(anim_ce(11913)==1)CALL ani_txt('Sound Speed-4',13)
2277
2278 IF(anim_ce(11914)==1)CALL ani_txt('Volume-1',8)
2279 IF(anim_ce(11915)==1)CALL ani_txt('Volume-2',8)
2280 IF(anim_ce(11916)==1)CALL ani_txt('Volume-3',8)
2281 IF(anim_ce(11917)==1)CALL ani_txt('Volume-4',8)
2282
2283 IF(anim_ce(11918)==1)CALL ani_txt('Mass-1',6)
2284 IF(anim_ce(11919)==1)CALL ani_txt('Mass-2',6)
2285 IF(anim_ce(11920)==1)CALL ani_txt('Mass-3',6)
2286 IF(anim_ce(11921)==1)CALL ani_txt('Mass-4',6)
2287
2288 IF(anim_ce(11922)==1)CALL ani_txt('Artificial Viscosity-1',22)
2289 IF(anim_ce(11923)==1)CALL ani_txt('Artificial Viscosity-2',22)
2290 IF(anim_ce(11924)==1)CALL ani_txt('Artificial Viscosity-3',22)
2291 IF(anim_ce(11925)==1)CALL ani_txt('Artificial Viscosity-4',22)
2292
2293
2294C
2295C /ANIM/SHELL/IDPLY/
2296C
2297 DO i=1,mx_ply_anim
2298 IF(anim_ce(11925+i) == 1) THEN
2299 WRITE(mes,'(A,I10)')
2300 . 'PLY_ID ',ply_anim( 3 * (i - 1) + 1)
2301 CALL ani_txt(mes,17)
2302 ENDIF
2303 ENDDO
2304C
2305C /ANIM/SHELL/IDPLY/PHI
2306C
2307 DO i=1,mx_ply_anim
2308 IF(anim_ce( (11925+mx_ply_anim) +i) == 1) THEN
2309 WRITE(mes,'(A,I10,A)')
2310 . 'PHI,(Ply_id ',ply_anim_phi( 3 * (i - 1) + 1),')'
2311 CALL ani_txt(mes,23)
2312 ENDIF
2313 ENDDO
2314C
2315C /ANIM/SHELL/IDPLY/EPSP
2316C
2317 DO i=1,mx_ply_anim
2318 IF(anim_ce( (11925+2*mx_ply_anim) +i) == 1) THEN
2319 WRITE(mes,'(A,I10,A,I3)')
2320 . 'Plas Str PLY/IPT',ply_anim_epsp( 3 * (i - 1) + 1),
2321 . ' ',ply_anim_epsp( 3 * (i - 1) + 3)
2322 CALL ani_txt(mes,30)
2323 ENDIF
2324 ENDDO
2325C
2326C /ANIM/SHELL/IDPLY/DAMA
2327C
2328 DO i=1,mx_ply_anim
2329 IF(anim_ce( (11925+3*mx_ply_anim) +i) == 1) THEN
2330 WRITE(mes,'(A,I10,A,I3)')
2331 . 'DAMAGE PLY/IPT',ply_anim_dama( 3 * (i - 1) + 1),
2332 . ' ',ply_anim_dama( 3 * (i - 1) + 3)
2333 CALL ani_txt(mes,28)
2334 ENDIF
2335 ENDDO
2336C
2337C /ANIM/SHELL/FLDF/
2338C
2339 idx = 11925+4*mx_ply_anim
2340 IF(anim_ce(idx+1) == 1) CALL ani_txt('FLD FAILURE FACTOR UPPER',24)
2341 IF(anim_ce(idx+2) == 1) CALL ani_txt('FLD FAILURE FACTOR LOWER',24)
2342 IF(anim_ce(idx+3) == 1) CALL ani_txt('FLD FAILURE FACTOR MEMBRANE',27)
2343C
2344C /ANIM/SHELL/FLDZON/
2345C
2346 idx = 11925+4*mx_ply_anim+3
2347 IF(anim_ce(idx+1) == 1) CALL ani_txt('FLD ZONE INDEX UPPER',20)
2348 IF(anim_ce(idx+2) == 1) CALL ani_txt('FLD ZONE INDEX LOWER',20)
2349 IF(anim_ce(idx+3) == 1) CALL ani_txt('FLD ZONE INDEX MEMBRANE',23)
2350
2351C-----------------------------------------------
2352C DAMAGE FACTOR : MAX of ALL CRITRIA BY LAYER AND BY IPT
2353C-----------------------------------------------
2354C upper for PID_51, 52
2355 idx = 11931+4*mx_ply_anim
2356 DO i=idx+1,idx+100
2357 IF (anim_ce(i) == 1) THEN
2358 ius = mod((i - idx), 100)
2359 IF (ius == 0) ius = 100
2360 WRITE(mes,'(A,I3,A)')
2361 . 'MAX DAMAGE UPPER Layer',ius, ' '
2362 CALL ani_txt(mes,26)
2363 ENDIF
2364 ENDDO
2365C lower for PID_51, 52
2366 idx = 12031+4*mx_ply_anim
2367 DO i=idx+1,idx+100
2368 IF (anim_ce(i) == 1) THEN
2369 ius = mod((i - idx), 100)
2370 IF (ius == 0) ius = 100
2371 WRITE(mes,'(A,I3,A)')
2372 . 'MAX DAMAGE LOWER Layer',ius, ' '
2373 CALL ani_txt(mes,26)
2374 ENDIF
2375 ENDDO
2376C membrane for PID_51, 52
2377 idx = 12131+4*mx_ply_anim
2378 DO i=idx+1,idx+100
2379 IF (anim_ce(i) == 1) THEN
2380 ius = mod((i - idx), 100)
2381 IF (ius == 0) ius = 100
2382 WRITE(mes,'(A,I3,A)')
2383 . 'MAX DAMAGE MEMBRANE Layer',ius, ' '
2384 CALL ani_txt(mes,29)
2385 ENDIF
2386 ENDDO
2387C all NPTT through all layers for PID_51, 52
2388 idx = 12231+4*mx_ply_anim
2389 DO i=1,100
2390 DO j=1,10
2391 ius = 10*i+j
2392 IF (anim_ce(ius + idx) == 1) THEN
2393 ilay = i
2394 ipt = j
2395 WRITE(mes,'(A,I4,I3,A)')
2396 . 'MAX DAMAGE Layer/IPT ',ilay,ipt, ' '
2397 CALL ani_txt(mes,29)
2398 END IF
2399 ENDDO
2400 ENDDO
2401C
2402 !/ANIM/ELEM/DT
2403 idx = 4*mx_ply_anim
2404 IF(anim_ce(idx+13242)==1)CALL ani_txt('Element Time Step',17)
2405C
2406 !/ANIM/ELEM/AMS
2407 idx = 4*mx_ply_anim
2408 IF(anim_ce(idx+13242+1)==1)CALL ani_txt('AMS selection',13)
2409C
2410 !/ANIM/ELEM/EINT
2411 idx = 4*mx_ply_anim
2412 IF(anim_ce(idx+13242+2)==1)CALL ani_txt('Internal Energy',15)
2413 !/ANIM/ELEM/WPLA
2414 idx = 4*mx_ply_anim
2415 IF(anim_ce(idx+13242+3)==1)CALL ani_txt('Plastic Work',12)
2416!!!
2417 idx = 13245 + 4*mx_ply_anim
2418 IF(anim_ce(idx + 1)==1) CALL ani_txt('Plastic Work Upper',18)
2419 IF(anim_ce(idx + 2)==1) CALL ani_txt('Plastic Work Lower',18)
2420 idx = 13247 + 4*mx_ply_anim
2421 DO i=1,100
2422 IF(anim_ce(idx + i)==1)THEN
2423 ius = i
2424 IF(ius==0)ius = 100
2425 WRITE(mes,'(A,I3,A)')
2426 . 'Plast Work Layer ',ius, ' '
2427 CALL ani_txt(mes,21)
2428 END IF
2429 END DO
2430C
2431C-----------------------------------------------
2432C Plastic WORK output (all NPTT) for new PID51 composite shell
2433C-----------------------------------------------
2434C upper for PID51
2435 idx = 13347 + 4*mx_ply_anim
2436 DO i=1,100
2437 IF (anim_ce(idx + i) == 1) THEN
2438 ius = i
2439 IF(ius==0) ius = 100
2440 WRITE(mes,'(A,I3,A)')
2441 . 'Plastic Work Upper Layer',ius, ' '
2442 CALL ani_txt(mes,28)
2443 END IF
2444 END DO
2445C lower for PID51
2446 idx = 13447 + 4*mx_ply_anim
2447 DO i=1,100
2448 IF (anim_ce(idx + i) == 1) THEN
2449 ius = i
2450 IF(ius==0) ius = 100
2451 WRITE(mes,'(A,I3,A)')
2452 . 'Plastic Work Lower Layer',ius, ' '
2453 CALL ani_txt(mes,28)
2454 END IF
2455 END DO
2456C all NPTT for PID51
2457 idx = 13547 + 4*mx_ply_anim
2458 DO i=1,100
2459 DO j=1,10
2460 ius = 10*(i-1)+j
2461 IF (anim_ce(idx + ius) == 1) THEN
2462 ilay = i
2463 ipt = j
2464 WRITE(mes,'(A,I4,I3,A)')
2465 . 'Plast Work Layer/IPT ',ilay,ipt, ' '
2466 CALL ani_txt(mes,29)
2467 END IF
2468 ENDDO
2469 ENDDO
2470
2471 !-----------------------------------------------
2472 ! Element status ( OFF value in buffer :
2473 ! 0.0:deleted 1.0:activated 0.to1.0 under failure <0:Standby
2474 !-----------------------------------------------
2475 idx = 13547 + 4*mx_ply_anim +1000 +1
2476 IF(anim_ce(idx) == 1) CALL ani_txt('Element Status',14)
2477
2478 idx = 13547 + 4*mx_ply_anim +1000 +2
2479 IF(anim_ce(idx) == 1) CALL ani_txt('Mach Number',11)
2480
2481 idx = 13547 + 4*mx_ply_anim +1000 +3
2482 IF(anim_ce(idx) == 1) CALL ani_txt('Color Function',14)
2483
2484 idx = 13547 + 4*mx_ply_anim +1000 +4
2485 IF(anim_ce(idx)==1) CALL ani_txt('Damage (Mean value)',19)
2486 IF(anim_ce(idx+1)==1) CALL ani_txt('Damage (Upper value)',20)
2487 IF(anim_ce(idx+2)==1) CALL ani_txt('Damage (Lower value)',20)
2488 IF(anim_ce(idx+3)==1) CALL ani_txt('Damage (Membrane value)',23)
2489 DO i=idx+3+1,idx+3+11
2490 IF(anim_ce(i)==1)THEN
2491 ii = i - (idx+3)
2492 WRITE(mes,'(A,I3,A)')
2493 . 'Damage (Thck. point ',ii,' value)'
2494 CALL ani_txt(mes,30)
2495 ENDIF
2496 ENDDO
2497
2498 !---QUAD VOLUME
2499 idx = idx+3+11
2500 idx = idx+1 ! => IDX = 4*MX_PLY_ANIM + 14566
2501 IF(anim_ce(idx) == 1) THEN
2502 CALL ani_txt('Volume',6)
2503 ENDIF
2504
2505 !---NON LOCAL PLASTIC STRAIN
2506 idx = 14567 + 4*mx_ply_anim
2507 IF(anim_ce(idx) == 1) CALL ani_txt('Non-local plastic strain',24)
2508 IF(anim_ce(idx+1) == 1) CALL ani_txt('Non-local plastic strain (Upper)',32)
2509 IF(anim_ce(idx+2) == 1) CALL ani_txt('Non-local plastic strain (Lower)',32)
2510 DO i=idx+2+1,idx+2+11
2511 IF (anim_ce(i) == 1) THEN
2512 ii = i - (idx+2)
2513 WRITE(mes,'(A,I3,A)')
2514 . 'Nloc plast at point ',ii,' '
2515 CALL ani_txt(mes,30)
2516 ENDIF
2517 ENDDO
2518
2519 !---NON LOCAL PLASTIC STRAIN RATE
2520 idx = 14581 + 4*mx_ply_anim
2521 IF(anim_ce(idx) == 1) CALL ani_txt('Non-local plastic strain rate',29)
2522 IF(anim_ce(idx+1) == 1) CALL ani_txt('Non-local plastic strain rate (Upper)',37)
2523 IF(anim_ce(idx+2) == 1) CALL ani_txt('Non-local plastic strain rate (Lower)',37)
2524 DO i=idx+2+1,idx+2+11
2525 IF (anim_ce(i) == 1) THEN
2526 ii = i - (idx+2)
2527 WRITE(mes,'(A,I3,A)')'Nloc rate at point ',ii,' '
2528 CALL ani_txt(mes,30)
2529 ENDIF
2530 ENDDO
2531
2532C----------------------------------------------------------------------
2533C Tsai-Wu criterion output for composites
2534C----------------------------------------------------------------------
2535!/ANIM/ELEM/TSAIWU
2536 idx = 14595 + 4*mx_ply_anim
2537 IF(anim_ce(idx )==1) CALL ani_txt('Tsai-Wu Criterion' ,17)
2538 IF(anim_ce(idx + 1)==1) CALL ani_txt('Tsai-Wu Crit. Upper',19)
2539 IF(anim_ce(idx + 2)==1) CALL ani_txt('Tsai-Wu Crit. Lower',19)
2540 DO i=1,100
2541 IF(anim_ce(idx + 2 + i)==1)THEN
2542 ius = i
2543 IF(ius==0) ius = 100
2544 WRITE(mes,'(A,I3,A)')'Tsai-Wu Crit. Layer ',ius, ' '
2545 CALL ani_txt(mes,24)
2546 END IF
2547 END DO
2548c
2549C upper for PID51
2550 idx = 14697 + 4*mx_ply_anim
2551 DO i=1,100
2552 IF (anim_ce(idx + i) == 1) THEN
2553 ius = i
2554 IF(ius==0) ius = 100
2555 WRITE(mes,'(A,I3,A)')'Tsai-Wu Crit. Upper Layer',ius, ' '
2556 CALL ani_txt(mes,29)
2557 END IF
2558 END DO
2559C lower for PID51
2560 idx = 14797 + 4*mx_ply_anim
2561 DO i=1,100
2562 IF (anim_ce(idx + i) == 1) THEN
2563 ius = i
2564 IF(ius==0) ius = 100
2565 WRITE(mes,'(A,I3,A)')'Tsai-Wu Crit. Lower Layer',ius, ' '
2566 CALL ani_txt(mes,29)
2567 END IF
2568 END DO
2569C all NPTT for PID51
2570 idx = 14897 + 4*mx_ply_anim
2571 DO i=1,100
2572 DO j=1,10
2573 ius = 10*(i-1)+j
2574 IF (anim_ce(idx + ius) == 1) THEN
2575 ilay = i
2576 ipt = j
2577 WRITE(mes,'(A,I4,I3,A)')'Tsai-Wu Crit. Lay/IPT ',ilay,ipt, ' '
2578 CALL ani_txt(mes,30)
2579 END IF
2580 ENDDO
2581 ENDDO
2582
2583 !---TILLOTSON EoS
2584 idx = 15898 + 4*mx_ply_anim
2585 IF(anim_ce(idx) == 1) CALL ani_txt('Region identifier in p,v diagram',32)
2586
2587 !---Volumetric Strain EoS
2588 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain',17)
2589 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 1',21)
2590 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 2',21)
2591 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 3',21)
2592 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 4',21)
2593 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 5',21)
2594 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 6',21)
2595 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 7',21)
2596 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 8',21)
2597 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 9',21)
2598 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Volumetric Strain - 10',22)
2599
2600 idx0 = 15921 + 4*mx_ply_anim ! VEL-Y 0:10
2601 idx1 = idx0+10+1 ! VEL-Z 0:10
2602 idx2 = idx1+10+1 ! VEL 0:10
2603
2604 idx = idx0-1
2605 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude',18)
2606 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 1',22) !phase 1 (multimat)
2607 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 2',22)
2608 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 3',22)
2609 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 4',22)
2610 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 5',22)
2611 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 6',22)
2612 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 7',22)
2613 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 8',22)
2614 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 9',22)
2615 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Magnitude - 10',23)
2616
2617 idx = idx1-1
2618 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y',10)
2619 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 1',14) !phase 1 (multimat)
2620 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 2',14)
2621 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 3',14)
2622 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 4',14)
2623 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 5',14)
2624 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 6',14)
2625 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 7',14)
2626 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 8',14)
2627 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 9',14)
2628 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Y - 10',15)
2629
2630 idx = idx2-1
2631 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z',10)
2632 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 1',14) !phase 1 (multimat)
2633 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 2',14)
2634 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 3',14)
2635 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 4',14)
2636 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 5',14)
2637 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 6',14)
2638 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 7',14)
2639 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 8',14)
2640 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 9',14)
2641 idx=idx+1; IF(anim_ce(idx) == 1) CALL ani_txt('Velocity Z - 10',15)
2642
2643 !---NEXT ANIM
2644 !IDX=IDX+1
2645
2646 ENDIF ! (NBF+NELCUT+NESBW2/=0)
2647!
2648 ENDIF ! IF (ISPMD==0)
2649C-----------------------------------------------
2650C NODAL FUNC
2651C-----------------------------------------------
2652 k = 0
2653 iad_gp2=iad_gps+100
2654 iad_gp3=iad_gp2+100
2655 iad_iso=iad_gp3+100
2656 iad_gp4=iad_iso+100
2657 DO i = 1,mx_ani
2658 ifunc = i
2659 IF (i==(iad_gps+3).OR.i==(iad_gps+9).OR.i==(iad_gps+15)
2660 . .OR.i==(iad_gp2+3).OR.i==(iad_gp2+9)
2661 . .OR.i==(iad_gp2+15) .OR.i==(iad_gp3+1).OR.i==(iad_iso+1) )
2662 . ifirst=0
2663 IF(anim_n(i)/=1) cycle
2664 DO n=1,numnod
2665 wa4(n) = zero
2666 ENDDO
2667 IF(i<3.OR.i==12)THEN
2668! really unsure of this part of the code
2669 IF(i == 1) THEN
2670 wa4(1:numnod)=output%DATA%SCAL_DT(1:numnod)
2671 ENDIF
2672 IF(i == 2) then
2673 wa4(1:numnod) = output%DATA%SCAL_DMAS(1:numnod)
2674 ENDIF
2675 IF(i == 12) then
2676 wa4(1:numnod) = output%DATA%SCAL_DINER(1:numnod)
2677 ENDIF
2678 !IF(K == 3*NUMNOD) WA(1:NUMNOD) = OUTPUT%SCAL_SPRING(1:NUMNOD)
2679 ! IF(I == 12) then
2680 ! WA4(1:NUMNOD) = OUTPUT%DATA%SCAL_DAMA2(1:NUMNOD)
2681 ! ENDIF
2682! DO N=1,NUMNOD
2683! WA4(N)=ANIN(N+K)
2684! ENDDO
2685 k = k + numnod
2686 ELSEIF(i>=3.AND.i<=11 .OR. i==30) THEN
2687 IF(i == 6 .AND. (glob_therm%ITHERM_FE > 0 )) THEN
2688 DO n=1,numnod
2689 wa4(n)=temp(n)
2690 ENDDO
2691 ELSE
2692 ! Nodal Pressure (from elems ; ANIM not compatible with fvmbag centroids)
2693 IF (i==3) THEN
2694 IF(n2d==0)CALL nodalp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2695 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2696 IF(n2d/=0)CALL nodalp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2697 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2698 ENDIF
2699 ! Nodal Density (from elems ; ANIM not compatible with fvmbag centroids)
2700 IF (i==4) THEN
2701 IF(n2d==0)CALL nodald(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2702 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2703 IF(n2d/=0)CALL nodald(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2704 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2705 ENDIF
2706 ! Nodal Temperature (from elems ; ANIM not compatible with fvmbag centroids)
2707 IF (i==6) THEN
2708 IF(n2d==0)CALL nodalt(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2709 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2710 IF(n2d/=0)CALL nodalt(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2711 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2712 ENDIF
2713 ! Nodal sound speed (from elems ; ANIM not compatible with fvmbag centroids)
2714 IF (i==30) THEN
2715 IF(n2d==0)CALL nodalssp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2716 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0, multi_fvm)
2717 IF(n2d/=0)CALL nodalssp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixq,nixq,numelq,itab,nv46,monvol,volmon,
2718 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0, multi_fvm)
2719 ENDIF
2720
2721
2722 !Then Monitored Volumes (Pressure,Density,Temperature,Sound Speed)
2723 CALL animbale(i, wa4,is_written_node, monvol, volmon ,2,
2724 . numnod, nimv, nvolu, nrvolu, licbag, libagjet,
2725 . libaghol, lrcbag, lrbagjet, lrbaghol, nspmd)
2726C
2727 ENDIF
2728
2729 !Nodal Potential (/BEM/FLOW)
2730 ELSEIF (i==13) THEN
2731 CALL nodalp(i, wa4, wa4_fvm, iflow, rflow,iparg,elbuf_tab,ixs,nixs,numels,itab,nv46,monvol,volmon,
2732 . 0, is_written_node, is_written_node_fvm, ispmd, fvdata, swa4, 0)
2733
2734C------------ams : diagonale mass change
2735 ELSEIF(i==14)THEN
2736 IF(idtmins==0)THEN
2737 DO n=1,numnod
2738 wa4(n)=zero
2739 ENDDO
2740 ELSE
2741 DO n=1,numnod
2742 wa4(n)=max(zero,diag_sms(n)/max(em20,ms(n))-one)
2743 ENDDO
2744 END IF
2745C------------dama type2 : % damage inter type2 with pena
2746 ELSEIF(i==15)THEN
2747 DO n=1,numnod
2748 wa4(n)=pdama2(1,n)
2749 ENDDO
2750 ELSEIF(i==16)THEN
2751 DO n=1,numnod
2752 wa4(n)=pdama2(2,n)
2753 ENDDO
2754 ELSEIF(i==17)THEN
2755 CALL nodal_schlieren(wa4,x,ixs,ixq,itab,iparg,0,elbuf_tab,ale_connectivity)
2756 ELSEIF(i==18)THEN
2757 IF(iroddl/=0)THEN
2758 DO n=1,numnod
2759 wa4(n)=stifr(n)
2760 ENDDO
2761 ELSE
2762 DO n=1,numnod
2763 wa4(n)=zero
2764 ENDDO
2765 ENDIF
2766C checksum
2767C
2768 ELSEIF (i > iadchksum .AND. i < iadchksum + 256 -1) THEN
2769 DO j=1,256
2770 IF (i == iadchksum + j) THEN
2771 ! print *, 'ANIM_N(IADCHKSUM + J) == 1',IADCHKSUM + J
2772 DO n=1,numnod
2773 wa4(n) = zero
2774 ENDDO
2775 ENDIF
2776 ENDDO
2777C
2778 ELSEIF(i==19)THEN
2779 DO n=1,numnod
2780 wa4(n)=stifn(n)
2781 ENDDO
2782 ELSEIF(i>=20 .AND. i<=23)THEN
2783 !ALE Nodal Volumetric Fraction (multimaterial only)
2784 IF(n2d==0)CALL nodalvfrac(i, wa4, iflow, rflow,iparg,elbuf_tab,ixs,nixs,itab,nv46)
2785 IF(n2d/=0)CALL nodalvfrac(i, wa4, iflow, rflow,iparg,elbuf_tab,ixq,nixq,itab,nv46)
2786 ELSEIF(i>=24 .AND. i<=27)THEN
2787 !ALE Nodal Volumetric Fraction (multimaterial only)
2788 !IF(N2D==0)CALL NODALZVFRAC(I, WA4, IFLOW, RFLOW,IPARG,ELBUF_TAB,IXS,NIXS,ITAB,NV46)
2789 ELSEIF(i==28.OR.i==29)THEN
2790 !inter22 polyhedra volumes (new & old)
2791 IF(n2d==0)CALL nodalzvol(i, wa4, iflow, rflow,iparg,elbuf_tab,ixs,nixs,itab,nv46)
2792 ELSEIF(i==31)THEN
2793 !Averaged external pressure (PEXT)
2794 IF(n2d == 0)THEN
2795 IF(output%DATA%ANIM_HAS_NODA_PEXT == 1)THEN
2796 DO n=1,numnod
2797 IF(output%DATA%NODA_SURF(n) > zero)THEN
2798 wa4(n) = output%DATA%NODA_PEXT(n) / output%DATA%NODA_SURF(n)
2799 ENDIF
2800 ENDDO
2801 ENDIF
2802 ENDIF
2803C------------gps1 part
2804 ELSEIF (i>iad_gps.AND.i<(iad_gps+3)) THEN
2805 DO n=1,numnod
2806 itagps(n) = 0
2807 wgps(n) = zero
2808 ENDDO
2809 j = i - iad_gps
2810
2811 CALL dfungps1(elbuf_tab ,wgps ,j ,iparg ,geo ,
2812 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2813 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2814 . itagps )
2815
2816 ! --------------------------
2817 IF(nspmd > 1)THEN
2818 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2819 CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
2820 CALL spmd_exch_nodarea(wgps,iad_elem,fr_elem,lenr,weight)
2821 ENDIF
2822 ! --------------------------
2823
2824 DO n=1,numnod
2825 IF (itagps(n)>0) wa4(n)=wgps(n)/itagps(n)
2826 ENDDO
2827 ELSEIF (i>(iad_gps+2).AND.i<(iad_gps+9)) THEN
2828 ifirst=ifirst+1
2829 IF (ifirst==1) THEN
2830 DO n=1,numnod
2831 itagps(n) = 0
2832 ENDDO
2833 DO j=1,3
2834 DO n=1,numnod
2835 vflu(j,n) = zero
2836 aflu(j,n) = zero
2837 ENDDO
2838 ENDDO
2839 CALL tensgps1(vflu ,aflu ,iparg ,geo ,
2840 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2841 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2842 . x ,itagps ,elbuf_tab)
2843 ENDIF
2844 j = i-(iad_gps+2)
2845 ! --------------------------
2846 IF(nspmd > 1)THEN
2847 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2848 IF (ifirst==1) CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
2849 IF (j<=3) THEN
2850 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
2851 ELSE
2852 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
2853 ENDIF
2854 ENDIF
2855 ! --------------------------
2856
2857 IF (j<=3) THEN
2858 DO n=1,numnod
2859 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
2860 ENDDO
2861 ELSE
2862 DO n=1,numnod
2863 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
2864 ENDDO
2865 ENDIF
2866C
2867 ELSEIF (i>(iad_gps+8).AND.i<(iad_gps+15)) THEN
2868 ifirst=ifirst+1
2869 IF (ifirst==1) THEN
2870 iul = 1
2871 DO n=1,numnod
2872 itagps(n) = 0
2873 ENDDO
2874 DO j=1,3
2875 DO n=1,numnod
2876 vflu(j,n) = zero
2877 aflu(j,n) = zero
2878 ENDDO
2879 ENDDO
2880 CALL tencgps1(elbuf_tab ,iparg,iul ,vflu ,aflu ,
2881 . x ,ixc ,igeo ,ixtg ,itagps )
2882 ENDIF
2883 j = i-(iad_gps+8)
2884 ! --------------------------
2885 IF(nspmd > 1)THEN
2886 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2887 IF (ifirst==1) CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
2888 IF (j<=3) THEN
2889 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
2890 ELSE
2891 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
2892 ENDIF
2893 ENDIF
2894 ! --------------------------
2895
2896 IF (j<=3) THEN
2897 DO n=1,numnod
2898 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
2899 ENDDO
2900 ELSE
2901 DO n=1,numnod
2902 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
2903 ENDDO
2904 ENDIF
2905 ELSEIF (i>(iad_gps+14).AND.i<(iad_gps+21)) THEN
2906 ifirst=ifirst+1
2907 IF (ifirst==1) THEN
2908 iul = 2
2909 DO n=1,numnod
2910 itagps(n) = 0
2911 ENDDO
2912 DO j=1,3
2913 DO n=1,numnod
2914 vflu(j,n) = zero
2915 aflu(j,n) = zero
2916 ENDDO
2917 ENDDO
2918 CALL tencgps1(elbuf_tab ,iparg,iul ,vflu ,aflu ,
2919 . x ,ixc ,igeo ,ixtg ,itagps )
2920 ENDIF
2921 j = i-(iad_gps+14)
2922 ! --------------------------
2923 IF(nspmd > 1)THEN
2924 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2925 IF (ifirst==1) CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
2926 IF (j<=3) THEN
2927 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
2928 ELSE
2929 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
2930 ENDIF
2931 ENDIF
2932 ! --------------------------
2933
2934 IF (j<=3) THEN
2935 DO n=1,numnod
2936 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
2937 ENDDO
2938 ELSE
2939 DO n=1,numnod
2940 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
2941 ENDDO
2942 ENDIF
2943C------------gps2 part
2944 ELSEIF (i>iad_gp2.AND.i<(iad_gp2+3)) THEN
2945 DO n=1,numnod
2946 vgps(n) = zero
2947 wgps(n) = zero
2948 ENDDO
2949 j = i - iad_gp2
2950 CALL dfungps2(elbuf_tab ,wgps ,j ,iparg ,geo ,
2951 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2952 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2953 . x ,vgps )
2954
2955 ! --------------------------
2956 IF(nspmd > 1)THEN
2957 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2958 CALL spmd_exch_nodarea(vgps,iad_elem,fr_elem,lenr,weight)
2959 CALL spmd_exch_nodarea(wgps,iad_elem,fr_elem,lenr,weight)
2960 ENDIF
2961 ! --------------------------
2962
2963 DO n=1,numnod
2964 IF (vgps(n)>zero) wa4(n)=wgps(n)/vgps(n)
2965 ENDDO
2966 ELSEIF (i>(iad_gp2+2).AND.i<(iad_gp2+9)) THEN
2967 ifirst=ifirst+1
2968 IF (ifirst==1) THEN
2969 DO n=1,numnod
2970 vgps(n) = zero
2971 ENDDO
2972 DO j=1,3
2973 DO n=1,numnod
2974 vflu(j,n) = zero
2975 aflu(j,n) = zero
2976 ENDDO
2977 ENDDO
2978 CALL tensgps2(vflu ,aflu ,iparg ,geo ,
2979 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
2980 . ixc ,ixtg ,ixt ,ixp ,ixr ,
2981 . x ,vgps ,elbuf_tab )
2982 ENDIF
2983 j = i-(iad_gp2+2)
2984
2985 ! --------------------------
2986 IF(nspmd > 1)THEN
2987 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
2988 IF (ifirst==1) CALL spmd_exch_nodarea(vgps,iad_elem,fr_elem,lenr,weight)
2989 IF (j<=3) THEN
2990 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
2991 ELSE
2992 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
2993 ENDIF
2994 ENDIF
2995 ! --------------------------
2996
2997 IF (j<=3) THEN
2998 DO n=1,numnod
2999 IF (vgps(n)>zero) wa4(n)=vflu(j,n)/vgps(n)
3000 ENDDO
3001 ELSE
3002 DO n=1,numnod
3003 IF (vgps(n)>zero) wa4(n)=aflu(j-3,n)/vgps(n)
3004 ENDDO
3005 ENDIF
3006C
3007 ELSEIF (i>(iad_gp2+8).AND.i<(iad_gp2+15)) THEN
3008 ifirst=ifirst+1
3009 IF (ifirst==1) THEN
3010 iul = 1
3011 DO n=1,numnod
3012 vgps(n) = zero
3013 ENDDO
3014 DO j=1,3
3015 DO n=1,numnod
3016 vflu(j,n) = zero
3017 aflu(j,n) = zero
3018 ENDDO
3019 ENDDO
3020 CALL tencgps2(elbuf_tab ,iparg,iul ,vflu ,aflu ,
3021 . x ,ixc ,igeo ,ixtg ,geo ,
3022 . vgps )
3023 ENDIF
3024 j = i-(iad_gp2+8)
3025 ! --------------------------
3026 IF(nspmd > 1)THEN
3027 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3028 IF (ifirst==1) CALL spmd_exch_nodareai(vgps,iad_elem,fr_elem,lenr,weight)
3029 IF (j<=3) THEN
3030 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
3031 ELSE
3032 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
3033 ENDIF
3034 ENDIF
3035 ! --------------------------
3036 IF (j<=3) THEN
3037 DO n=1,numnod
3038 IF (vgps(n)>zero) wa4(n)=vflu(j,n)/vgps(n)
3039 ENDDO
3040 ELSE
3041 DO n=1,numnod
3042 IF (vgps(n)>zero) wa4(n)=aflu(j-3,n)/vgps(n)
3043 ENDDO
3044 ENDIF
3045 ELSEIF (i>(iad_gp2+14).AND.i<(iad_gp2+21)) THEN
3046 ifirst=ifirst+1
3047 IF (ifirst==1) THEN
3048 iul = 2
3049 DO n=1,numnod
3050 vgps(n) = zero
3051 ENDDO
3052 DO j=1,3
3053 DO n=1,numnod
3054 vflu(j,n) = zero
3055 aflu(j,n) = zero
3056 ENDDO
3057 ENDDO
3058 CALL tencgps2(elbuf_tab ,iparg,iul ,vflu ,aflu ,
3059 . x ,ixc ,igeo ,ixtg ,geo ,
3060 . vgps )
3061 ENDIF
3062 j = i-(iad_gp2+14)
3063 ! --------------------------
3064 IF(nspmd > 1)THEN
3065 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3066 IF (ifirst==1) CALL spmd_exch_nodarea(vgps,iad_elem,fr_elem,lenr,weight)
3067 IF (j<=3) THEN
3068 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
3069 ELSE
3070 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
3071 ENDIF
3072 ENDIF
3073 ! --------------------------
3074
3075 IF (j<=3) THEN
3076 DO n=1,numnod
3077 IF (vgps(n)>zero) wa4(n)=vflu(j,n)/vgps(n)
3078 ENDDO
3079 ELSE
3080 DO n=1,numnod
3081 IF (vgps(n)>zero) wa4(n)=aflu(j-3,n)/vgps(n)
3082 ENDDO
3083 ENDIF
3084 ELSEIF (i>(iad_gp3).AND.i<(iad_gp3+7)) THEN
3085
3086C------------gps part
3087 ifirst=ifirst+1
3088 IF (ifirst==1) THEN
3089 DO n=1,numnod
3090 itagps(n) = 0
3091 ENDDO
3092 DO j=1,3
3093 DO n=1,numnod
3094 vflu(j,n) = zero
3095 aflu(j,n) = zero
3096 ENDDO
3097 ENDDO
3098 CALL tensgps3(elbuf_tab,vflu ,aflu ,iparg ,geo ,
3099 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
3100 . ixc ,ixtg ,ixt ,ixp ,ixr ,
3101 . x ,itagps ,pm)
3102 ENDIF
3103 j = i-iad_gp3
3104 ! --------------------------
3105 IF(nspmd > 1)THEN
3106 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3107 IF (ifirst==1) CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
3108 IF (j<=3) THEN
3109 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
3110 ELSE
3111 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
3112 ENDIF
3113 ENDIF
3114 ! --------------------------
3115
3116 IF (j<=3) THEN
3117 DO n=1,numnod
3118 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
3119 ENDDO
3120 ELSE
3121 DO n=1,numnod
3122 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
3123 ENDDO
3124 ENDIF
3125 ELSEIF (i>(iad_iso).AND.i<(iad_iso+7)) THEN
3126C------------iso geo stress
3127 DO n=1,64*numelig3d
3128 wa4(numnod + n)=tabstresl(i-iad_iso,n)
3129 ENDDO
3130 ELSEIF (i>(iad_gp4).AND.i<(iad_gp4+7)) THEN
3131
3132C------------gps part
3133 ifirst=ifirst+1
3134 IF (ifirst==1) THEN
3135 DO n=1,numnod
3136 itagps(n) = 0
3137 ENDDO
3138 DO j=1,3
3139 DO n=1,numnod
3140 vflu(j,n) = zero
3141 aflu(j,n) = zero
3142 ENDDO
3143 ENDDO
3144 CALL tensgpstrain(elbuf_tab,vflu ,aflu ,iparg ,geo ,
3145 . ixs ,ixs10 ,ixs16 ,ixs20 ,ixq ,
3146 . ixc ,ixtg ,ixt ,ixp ,ixr ,
3147 . x ,itagps ,pm )
3148
3149
3150 ENDIF
3151
3152 j = i-iad_gp4
3153 ! --------------------------
3154 IF(nspmd > 1)THEN
3155 lenr = iad_elem(1,nspmd+1)-iad_elem(1,1)
3156 IF (ifirst==1) CALL spmd_exch_nodareai(itagps,iad_elem,fr_elem,lenr,weight)
3157 IF (j<=3) THEN
3158 CALL spmd_exch_nodarea2(vflu,iad_elem,fr_elem,lenr,weight,j)
3159 ELSE
3160 CALL spmd_exch_nodarea2(aflu,iad_elem,fr_elem,lenr,weight,j-3)
3161 ENDIF
3162 ENDIF
3163 ! --------------------------
3164
3165 IF (j<=3) THEN
3166 DO n=1,numnod
3167 IF (itagps(n)>0) wa4(n)=vflu(j,n)/itagps(n)
3168 ENDDO
3169 ELSE
3170 DO n=1,numnod
3171 IF (itagps(n)>0) wa4(n)=aflu(j-3,n)/itagps(n)
3172 ENDDO
3173 ENDIF
3174c----------------------------------------
3175
3176 ENDIF
3177
3178c----------------------------------------
3179 IF (nspmd == 1) THEN
3180 IF (numelig3d /= 0) THEN
3181 DO j=1,numnod + 64*numelig3d
3182 CALL write_r_c(wa4(j),1)
3183 ENDDO
3184 ELSE
3185 DO j=1,numnod
3186 CALL write_r_c(wa4(j),1)
3187 ENDDO
3188 ENDIF
3189 ELSE
3190 IF (ispmd==0) THEN
3191 CALL spmd_gatherf(wa4,weight,nodglob,numnodg)
3192 ELSE
3193 CALL spmd_gatherf(wa4,weight,nodglob,1)
3194 END IF
3195 END IF
3196 r4 = zero
3197 IF(ncuts>0) THEN
3198 IF (i<3.OR.i==12) THEN
3199 ! really not sure, ask Sebastien
3200 IF(i ==1) CALL cutfunc(output%DATA%SCAL_DT,icbuf(mic2),cbuf(mac2),nodcut)
3201 IF(i ==2) CALL cutfunc(output%DATA%SCAL_DMAS,icbuf(mic2),cbuf(mac2),nodcut)
3202 IF(i ==12) CALL cutfunc(output%DATA%SCAL_DINER,icbuf(mic2),cbuf(mac2),nodcut)
3203 ELSE
3204 DO n=1,nodcut
3205 CALL write_r_c(r4,1)
3206 ENDDO
3207 ENDIF
3208 ENDIF
3209 IF (ispmd==0) THEN
3210 DO n=1,nsect+nrwall+nnwl+nnsrg+nnsmd+nnsphg+2*numels16g
3211 CALL write_r_c(r4,1)
3212 ENDDO
3213 ENDIF
3214C nodal ply dmass = zero (is not computed for anim)
3215 IF(ispmd == 0. and. anim_ply >0 ) THEN
3216 r4 = zero
3217 DO n=1,nfnod_pxfemg
3218 CALL write_r_c(r4,1)
3219 ENDDO
3220 ENDIF
3221C xfem crack for layered shells +++
3222 IF(ispmd == 0 .AND. anim_crk > 0)THEN
3223 r4 = zero
3224 DO n=1,nfnod_crkxfemg
3225 CALL write_r_c(r4,1)
3226 ENDDO
3227 ENDIF
3228C xfem crack for layered shells ---
3229C
3230 IF (ispmd==0.AND.nfvnod>0) THEN
3231 r4=zero
3232 DO n=1,nfvnod+3
3233 CALL write_r_c(r4,1)
3234 ENDDO
3235 ENDIF
3236 ENDDO
3237C-----------------------------------------------
3238C ELEMENT FUNC (quad+coque)
3239C-----------------------------------------------
3240 ndma2= numnod*(min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
3241 . +min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
3242 . +min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
3243C Monoproc Equivalent Treatment
3244 IF (nspmd == 1 .AND. nfvtr>0) THEN
3245 ALLOCATE(fvmass(nfvtr),fvpres(nfvtr), fvqx(nfvtr),
3246 . fvqy(nfvtr), fvqz(nfvtr), fvrho(nfvtr),
3247 . fvener(nfvtr), fvcson(nfvtr), fvgama(nfvtr),
3248 . fvvisu(nfvtr))
3249 DO i=1,nfvtr
3250 fvmass(i)=zero
3251 fvpres(i)=zero
3252 fvqx(i)=zero
3253 fvqy(i)=zero
3254 fvqz(i)=zero
3255 fvrho(i)=zero
3256 fvener(i)=zero
3257 fvcson(i)=zero
3258 fvgama(i)=zero
3259 fvvisu(i)=zero
3260 ENDDO
3261C
3262 eloff=0
3263 DO i=1,nfvbag
3264 IF (fvdata(i)%NPOLH_ANIM>0) THEN
3265C
3266 DO j=1,fvdata(i)%NPOLH
3267 gama=fvdata(i)%GPOLH(j)
3268 ssp=sqrt((gama-one)*gama*fvdata(i)%EPOLH(j)/
3269 . fvdata(i)%MPOLH(j))
3270 DO k=fvdata(i)%IFVPADR(j),fvdata(i)%IFVPADR(j+1)-1
3271 kk=fvdata(i)%IFVPOLH(k)
3272 DO n=fvdata(i)%IFVTADR(kk),
3273 . fvdata(i)%IFVTADR(kk+1)-1
3274 nn=fvdata(i)%IFVPOLY(n)
3275 fac=one
3276 IF (fvdata(i)%IFVTRI(4,nn)>0) THEN
3277 idp=fvdata(i)%IDPOLH(j)
3278 fvvisu(fvel2fa(eloff+nn))=idp-(idp/8)*8+1
3279 ELSE
3280 fvvisu(fvel2fa(eloff+nn))=-1
3281 fac=half
3282 ENDIF
3283 nn=fvel2fa(eloff+nn)
3284 fvmass(nn)=fvmass(nn)+fac*fvdata(i)%MPOLH(j)
3285 fvpres(nn)=fvpres(nn)+fac*fvdata(i)%PPOLH(j)
3286 IF (fvdata(i)%MPOLH(j)>zero) THEN
3287 fvqx(nn)=fvqx(nn)+fac*fvdata(i)%QPOLH(1,j)/
3288 . fvdata(i)%MPOLH(j)
3289 fvqy(nn)=fvqy(nn)+fac*fvdata(i)%QPOLH(2,j)/
3290 . fvdata(i)%MPOLH(j)
3291 fvqz(nn)=fvqz(nn)+fac*fvdata(i)%QPOLH(3,j)/
3292 . fvdata(i)%MPOLH(j)
3293 fvener(nn)=fvener(nn)+fac*fvdata(i)%EPOLH(j)/
3294 . fvdata(i)%MPOLH(j)
3295 ENDIF
3296 fvrho(nn)=fvrho(nn)+fac*fvdata(i)%RPOLH(j)
3297 fvcson(nn)=fvcson(nn)+fac*ssp
3298 fvgama(nn)=fvgama(nn)+fac*gama
3299 ENDDO
3300 ENDDO
3301 ENDDO
3302 eloff=eloff+fvdata(i)%NNTR
3303 ENDIF
3304 ENDDO
3305 ELSEIF(nfvtr>0) THEN
3306 IF (ispmd==0) THEN
3307 ALLOCATE(fvmass(nfvtr),fvpres(nfvtr), fvqx(nfvtr),
3308 . fvqy(nfvtr), fvqz(nfvtr), fvrho(nfvtr),
3309 . fvener(nfvtr), fvcson(nfvtr), fvgama(nfvtr),
3310 . fvvisu(nfvtr))
3311 DO i=1,nfvtr
3312 fvmass(i)=zero
3313 fvpres(i)=zero
3314 fvqx(i)=zero
3315 fvqy(i)=zero
3316 fvqz(i)=zero
3317 fvrho(i)=zero
3318 fvener(i)=zero
3319 fvcson(i)=zero
3320 fvgama(i)=zero
3321 fvvisu(i)=zero
3322 ENDDO
3323 ENDIF
3324C
3325 CALL spmd_fvb_aelf(fvmass, fvpres, fvqx, fvqy, fvqz,
3326 . fvrho, fvener, fvcson, fvgama, fvvisu,
3327 . fvel2fa)
3328 ENDIF
3329C In SPMD locally NBF = 0 but not the sum on PI!
3330 DO i = 1,mx_ani
3331 ifunc = i
3332 IF(anim_ce(i)==1)THEN
3333 IF(i<=2142 .OR. i==2155 .OR. i==2156 .OR. (i>=2239.AND.i<=10252) .OR.
3334 . (i>=10253.AND.i<=10675) .OR. (i >= 10676 .AND. i <= 1000000)) THEN
3335 CALL dfuncc(elbuf_tab ,waft ,ifunc ,iparg,geo ,
3336 . ixq ,ixc ,ixtg ,mas ,pm ,
3337 . el2fa ,nbf ,iad ,glob_therm%ITHERM ,
3338 . nbf_l ,eani ,output%DATA%SCAL_SPRING ,nbpart ,iadg ,
3339 . ipm ,igeo ,thke ,err_thk_sh4 ,err_thk_sh3,
3340 . invert ,x ,v ,w ,ale_connectivity,
3341 . nv46 ,nercvois ,nesdvois ,lercvois ,lesdvois ,
3342 . stack ,bufmat ,multi_fvm ,mat_param)
3343 IF(ncuts>0)
3344 . CALL cutfunce(icbuf,nelcut,elbuf_tab,ifunc,iparg,pm,ixs)
3345 IF (ispmd==0) THEN
3346 r4 = zero
3347 DO j=1,nesbw2
3348 CALL write_r_c(r4,1)
3349 ENDDO
3350 ENDIF
3351C ply xfem
3352C ply information
3353 IF (anim_ply > 0)THEN
3354 CALL dfuncc_ply(elbuf_tab, waft_ply, ifunc, iparg, geo,
3355 . ixc , ixtg , mas, pm, el2fa_ply,
3356 . nbf_pxfem,iad , plynumc,eani,output%DATA%SCAL_SPRING,
3357 . nplypart,iad_plyg,ipm ,igeo , thke,
3358 . err_thk_sh4, err_thk_sh3,mat_param,
3359 . nbf_pxfemg ,x , stack )
3360 ENDIF
3361 IF (anim_crk > 0)THEN
3362 CALL dfuncc_crk(
3363 . elbuf_tab ,len_crkx ,ifunc ,iparg,geo ,
3364 . ixc ,ixtg ,mas ,pm ,el2fa_crk ,
3365 . nbf_crkxfem ,iad ,nbf_crkxfem,eani ,output%DATA%SCAL_SPRING,
3366 . ncrkpart ,iad_crkg ,ipm ,igeo ,thke ,
3367 . err_thk_sh4 ,err_thk_sh3,xfem_tab ,iel_crk ,indx_crk,
3368 . nbf_crkxfemg,el2fa ,crkedge )
3369 ENDIF
3370C
3371
3372 IF (ispmd==0.AND.nfvtr>0) THEN
3373 r4=zero
3374 DO j=1,nfvtr
3375 CALL write_r_c(r4,1)
3376 ENDDO
3377 ENDIF
3378 ELSEIF (i==2143.OR.i==2144) THEN
3379 CALL animcale(i, monvol, volmon, nbf, el2fa,
3380 . nbpart, iadg, nbf_l ,
3381 . ispmd, nspmd, nimv, nrvolu, nvolu,
3382 . licbag, lrcbag,
3383 . libaghol, lrbaghol,lrbagjet, libagjet,
3384 . numelqg, numelcg, numeltgg)
3385
3386 IF (ispmd==0) THEN
3387 r4 = zero
3388 DO j=1,nesbw2
3389 CALL write_r_c(r4,1)
3390 ENDDO
3391 ENDIF
3392C
3393 IF(ispmd == 0 .AND. anim_ply > 0 ) THEN
3394 r4=zero
3395 DO j=1,nbf_pxfemg
3396 CALL write_r_c(r4,1)
3397 ENDDO
3398 ENDIF
3399C xfem crack for layered shells +++
3400 IF(ispmd==0 .AND. anim_crk > 0)THEN
3401 r4=zero
3402 DO j=1,nbf_crkxfemg
3403 CALL write_r_c(r4,1)
3404 ENDDO
3405 ENDIF
3406C xfem crack for layered shells ---
3407 IF (ispmd==0.AND.nfvtr>0) THEN
3408 r4=zero
3409 DO j=1,nfvtr
3410 CALL write_r_c(r4,1)
3411 ENDDO
3412 ENDIF
3413
3414 ELSEIF (i>=2145.AND.i<=2154) THEN
3415 IF (ispmd==0) THEN
3416 r4=zero
3417 DO j=1,nbf+nelcut+nesbw2+nbf_pxfemg+nbf_crkxfemg
3418 CALL write_r_c(r4,1)
3419 ENDDO
3420 ENDIF
3421 IF (ispmd==0.AND.nfvtr>0) THEN
3422 IF (i==2145) THEN
3423 DO j=1,nfvtr
3424 r4=fvmass(j)
3425 CALL write_r_c(r4,1)
3426 ENDDO
3427 ELSEIF (i==2146) THEN
3428 DO j=1,nfvtr
3429 r4=fvpres(j)
3430 CALL write_r_c(r4,1)
3431 ENDDO
3432 ELSEIF (i==2147) THEN
3433 DO j=1,nfvtr
3434 r4=fvqx(j)
3435 CALL write_r_c(r4,1)
3436 ENDDO
3437 ELSEIF (i==2148) THEN
3438 DO j=1,nfvtr
3439 r4=fvqy(j)
3440 CALL write_r_c(r4,1)
3441 ENDDO
3442 ELSEIF (i==2149) THEN
3443 DO j=1,nfvtr
3444 r4=fvqz(j)
3445 CALL write_r_c(r4,1)
3446 ENDDO
3447 ELSEIF (i==2150) THEN
3448 DO j=1,nfvtr
3449 r4=fvrho(j)
3450 CALL write_r_c(r4,1)
3451 ENDDO
3452 ELSEIF (i==2151) THEN
3453 DO j=1,nfvtr
3454 r4=fvener(j)
3455 CALL write_r_c(r4,1)
3456 ENDDO
3457 ELSEIF (i==2152) THEN
3458 DO j=1,nfvtr
3459 r4=fvcson(j)
3460 CALL write_r_c(r4,1)
3461 ENDDO
3462 ELSEIF (i==2153) THEN
3463 DO j=1,nfvtr
3464 r4=fvgama(j)
3465 CALL write_r_c(r4,1)
3466 ENDDO
3467 ELSEIF (i==2154) THEN
3468 DO j=1,nfvtr
3469 r4=fvvisu(j)
3470 CALL write_r_c(r4,1)
3471 ENDDO
3472 ENDIF
3473 ENDIF
3474 endif!I values
3475 ENDIF !IF(ANIM_CE(I)==1)THEN
3476 ENDDO !next I
3477 IF (ispmd==0.AND.nfvtr>0)
3478 . DEALLOCATE(fvmass, fvpres, fvqx, fvqy, fvqz, fvrho, fvener,
3479 . fvcson, fvgama)
3480C-----------------------------------------------
3481C VECT TEXT
3482C-----------------------------------------------
3483 IF (ispmd==0) THEN
3484 IF(anim_v(1)==1) CALL ani_txt('Velocity',8)
3485 IF(anim_v(2)==1) CALL ani_txt('Displacement',12)
3486 IF(anim_v(3)==1) CALL ani_txt('Acceleration',12)
3487 IF(anim_v(4)==1.AND.animcont==1) CALL ani_txt('Contact Forces',14)
3488 IF(anim_v(5)==1) CALL ani_txt('Internal Forces',15)
3489 IF(anim_v(6)==1) CALL ani_txt('External Forces',15)
3490 IF(anim_v(7)==1) CALL ani_txt('Sect.RBY,Wall F.',16)
3491 IF(anim_v(8)==1) CALL ani_txt('Sect.RBY Moments',16)
3492 IF(anim_v(9)==1) CALL ani_txt('Rotational Velocity',19)
3493 IF(anim_v(10)==1) CALL ani_txt('Fluid velocity',14)
3494 IF(anim_v(11)==1) CALL ani_txt('Residual Forces',15)
3495 IF(anim_v(12)==1) THEN
3496 CALL ani_txt('Contact Pressure / Normal',25)
3497 CALL ani_txt('Contact Pressure / Tangent',26)
3498 END IF
3499 IF(anim_v(13)==1) CALL ani_txt('Tied Contact Forces',19)
3500 IF(anim_v(14)==1) CALL ani_txt('Rotational DOF',14)
3501 IF(anim_v(16)==1) CALL ani_txt('Gaz Velocity',12)
3502 IF(anim_v(17)==1) CALL ani_txt('Reaction Forces',15)
3503 IF(anim_v(18)==1) CALL ani_txt('Reaction Moments',16)
3504 IF(anim_v(19)==1) CALL ani_txt('Cluster Forces',14)
3505 IF(anim_v(20)==1) CALL ani_txt('Cluster Moments',15)
3506 IF(anim_v(21)==1) CALL ani_txt('inter22 - Centroid Velocity',27) !inter22
3507 IF(anim_v(22)==1) CALL ani_txt('inter22 - Faces Velocity',24) !inter22
3508 IF(anim_v(23)==1)
3509 . CALL ani_txt('inter22 - Centroid Momentum Density',35) !inter22
3510 IF(anim_v(24)==1) CALL ani_txt('inter22 - Faces Pressure Forces',31) !inter22
3511 IF(anim_v(25)==1)
3512 . CALL ani_txt('inter22 - Centroid Internal Force',33) !inter22
3513 IF(anim_v(26)==1)
3514 . CALL ani_txt('Maximum Contact Forces Over Time',32)
3515 IF(anim_v(27)==1) THEN
3516 CALL ani_txt('Tied Contact Pressure / Normal',30)
3517 CALL ani_txt('Tied Contact Pressure / Tangent',31)
3518 END IF
3519 ENDIF
3520C-----------------------------------------------
3521C VECT
3522C-----------------------------------------------
3523 nnnsrg=nnsrg+nnsmd+nnsphg+2*numels16g
3524C IF(NCUTS == 0) THEN
3525 IF(.NOT. ALLOCATED(icbuf)) ALLOCATE(icbuf(1))
3526 IF(.NOT. ALLOCATED(cbuf)) ALLOCATE(cbuf(1))
3527C ENDIF
3528 IF(anim_v(1)==1) THEN
3529 CALL velvec(v,v_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3530 . nnnsrg,nodglob,weight,nfvnod,1,
3531 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3532 ENDIF
3533 IF(anim_v(2)==1)
3534 . CALL velvec(d,d_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3535 . nnnsrg,nodglob,weight,nfvnod,2,
3536 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3537 IF(anim_v(3)==1)
3538 . CALL velvec(a,a_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3539 . nnnsrg,nodglob,weight,nfvnod,3,
3540 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3541 IF(anim_v(4)==1.AND.animcont==1)THEN
3542 IF(nintstamp==0)THEN
3543 CALL velvecc(cont,cont_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3544 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3545 . nfnod_crkxfemg)
3546 ELSE
3547 CALL velvecc21(cont,cont_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3548 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3549 . fcontg,nfnod_crkxfemg)
3550 END IF
3551 END IF
3552 IF(anim_v(5)==1)
3553 . CALL velvec(fint,fint_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3554 . nnnsrg,nodglob,weight,nfvnod,5,
3555 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3556 IF(anim_v(6)==1)
3557 . CALL velvecc(fext,fext_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3558 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3559 . nfnod_crkxfemg)
3560
3561 IF(anim_v(7)==1) CALL velvec2(icbuf(mic2),bid_temp,cbuf(mac2),
3562 . nodcut,fopt(1,1),npby,nnwl,nnnsrg,
3563 . nodglob,weight,fr_sec,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3564 . nfnod_crkxfemg)
3565 IF(anim_v(8)==1) CALL velvec2(icbuf(mic2),bid_temp,cbuf(mac2),
3566 . nodcut,fopt(4,1),npby,nnwl,nnnsrg,
3567 . nodglob,weight,fr_sec,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3568 . nfnod_crkxfemg)
3569 IF(anim_v(9)==1 .AND. iroddl/=0) THEN
3570 CALL velvec(vr,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,
3571 . nnwl,nnnsrg,nodglob,weight,nfvnod,9,
3572 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3573 ELSEIF(anim_v(9)==1) THEN
3574 IF (nspmd == 1) THEN
3575 DO i=1,numnod
3576 r4 = zero
3577 CALL write_r_c(r4,1)
3578 CALL write_r_c(r4,1)
3579 CALL write_r_c(r4,1)
3580 ENDDO
3581 IF (numelig3d /= 0)THEN
3582 DO i=1,64*numelig3d
3583 r4 = bid_temp(1,i)
3584 CALL write_r_c(r4,1)
3585 r4 = bid_temp(2,i)
3586 CALL write_r_c(r4,1)
3587 r4 = bid_temp(3,i)
3588 CALL write_r_c(r4,1)
3589 ENDDO
3590 ENDIF
3591 ELSEIF (ispmd == 0) THEN
3592 DO i=1,numnodg
3593 r4 = zero
3594 CALL write_r_c(r4,1)
3595 CALL write_r_c(r4,1)
3596 CALL write_r_c(r4,1)
3597 ENDDO
3598 ENDIF
3599 ENDIF
3600 IF (anim_v(10)==1) THEN
3601cc CALL VELVEC(VFLU,BID_TEMP,ICBUF(MIC2),CBUF(MAC2),
3602c . NODCUT,NNWL,NNNSRG,NODGLOB,WEIGHT,0,ANIM_V(10),
3603c . NFNOD_PXFEM,NOD_PXFEM,INDX_PLY,VFLU_ALE)
3604C Have SPMD Anim Ply
3605 CALL velvec3(vflu,bid_temp,vflu_ale,icbuf(mic2),cbuf(mac2),
3606 . nodcut,nnwl,nnnsrg,nodglob,weight,0,nfnod_pxfem,
3607 . nfnod_pxfemg,nfnod_crkxfemg)
3608 IF (nfvnod>0) THEN
3609 IF (nspmd == 1) THEN
3610 CALL alevec()
3611 ELSE
3612 CALL spmd_fvb_avec()
3613 ENDIF
3614 ENDIF
3615 ENDIF
3616 IF (anim_v(11)==1) THEN
3617 IF(idtmins==0.AND.idtmins_int==0)THEN
3618 fac=one
3619 IF (impl_s>0.AND.idyna==0)fac=zero
3620 DO j=1,3
3621 DO n=1,numnod
3622 vflu(j,n)=fext(j,n)+fint(j,n)-fac*ms(n)*a(j,n)
3623 ENDDO
3624 ENDDO
3625 CALL velvec(vflu,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3626 . nnnsrg,nodglob,weight,nfvnod,11,
3627 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3628 ELSE
3629 CALL velvec(res_sms,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3630 . nnnsrg,nodglob,weight,nfvnod,11,
3631 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3632 END IF
3633 ENDIF
3634 IF(anim_v(12)==1) THEN
3635 IF(nintstamp==0)THEN
3636 CALL velvecc(fncont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3637 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3638 . nfnod_crkxfemg)
3639 CALL velvecc(ftcont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3640 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3641 . nfnod_crkxfemg)
3642 ELSE
3643 CALL velvecc21(fncont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3644 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3645 . fncontg,nfnod_crkxfemg)
3646 CALL velvecc21(ftcont,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3647 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3648 . ftcontg,nfnod_crkxfemg)
3649 END IF
3650 END IF
3651C
3652 IF(anim_v(13)==1) THEN
3653 CALL velvecc(fncont2,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3654 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3655 . nfnod_crkxfemg)
3656 ENDIF
3657C
3658 IF(anim_v(14)==1 .AND.(idrot == 1 .OR. isecut>0 .OR. iisrot>0 .OR. impose_dr>0 ) .AND. iroddl/=0) THEN
3659 CALL velvec(dr,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3660 . nnnsrg,nodglob,weight,nfvnod,14,
3661 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3662 ENDIF
3663C
3664 IF (anim_v(15) == 1) THEN
3665 CALL velvecc(dxancg,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3666 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,
3667 . nfnod_pxfemg,nfnod_crkxfemg)
3668 ENDIF
3669 IF(anim_v(16)==1 .AND. ialelag > 0 ) THEN
3670 CALL velvec(vgaz,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3671 . nnnsrg,nodglob,weight,nfvnod,16,
3672 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3673 ELSEIF(anim_v(16)==1 .AND. ialelag == 0 ) THEN
3674 IF (ispmd == 0) THEN
3675 DO i=1,numnodg
3676 r4 = zero
3677 CALL write_r_c(r4,1)
3678 CALL write_r_c(r4,1)
3679 CALL write_r_c(r4,1)
3680 ENDDO
3681 ENDIF
3682 ENDIF
3683 IF(anim_v(17)==1) THEN
3684 DO n=1,numnod
3685 fanreact(1,n)=fanreac(1,n)
3686 fanreact(2,n)=fanreac(2,n)
3687 fanreact(3,n)=fanreac(3,n)
3688 ENDDO
3689 CALL velvec(fanreact,fanreact_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3690 . nnnsrg,nodglob,weight,nfvnod,17,
3691 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3692 ENDIF
3693 IF(anim_v(18)==1) THEN
3694 DO n=1,numnod
3695 fanreacr(1,n)=fanreac(4,n)
3696 fanreacr(2,n)=fanreac(5,n)
3697 fanreacr(3,n)=fanreac(6,n)
3698 ENDDO
3699 CALL velvec(fanreacr,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3700 . nnnsrg,nodglob,weight,nfvnod,18,
3701 . nfnod_pxfem,nod_pxfem,indx_ply,nfnod_crkxfemg,itab)
3702
3703 ENDIF
3704c
3705 IF (anim_v(19) == 1) THEN
3706c Cluster forces
3707 CALL velvecc(fcluster,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3708 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,
3709 . nfnod_pxfemg,nfnod_crkxfemg)
3710 ENDIF
3711c
3712 IF (anim_v(20) == 1) THEN
3713c Motor cluster
3714 CALL velvecc(mcluster,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3715 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,
3716 . nfnod_pxfemg,nfnod_crkxfemg)
3717 ENDIF
3718
3719 IF (anim_v(21) == 1) THEN
3720c interface 22, centroid vel
3721 CALL velvecc22(elbuf_tab,iparg,1,ixs,ixq,itab)
3722 ENDIF
3723
3724 IF (anim_v(22) == 1) THEN
3725c interface 22
3726 CALL velvecz22(elbuf_tab,iparg ,ipari ,igrnod , x,
3727 . ixs ,ixq ,itab ,1 )
3728 ENDIF
3729
3730 IF (anim_v(23) == 1) THEN
3731c interface 22, centroid rho.vel
3732 CALL velvecc22(elbuf_tab,iparg,2,ixs,ixq,itab)
3733 ENDIF
3734
3735 IF (anim_v(24) == 1) THEN
3736c interface 22 / internal forces
3737 CALL velvecz22(elbuf_tab,iparg ,ipari ,igrnod , x,
3738 . ixs ,ixq ,itab ,2 )
3739 ENDIF
3740
3741 IF (anim_v(25) == 1) THEN
3742c interface 22, centroid rho.vel
3743 CALL velvecc22(elbuf_tab,iparg,3,ixs,ixq,itab)
3744 ENDIF
3745
3746 IF(anim_v(26)==1)THEN
3747
3748 IF(nintstamp==0)THEN
3749 CALL velvecc(fcont_max,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3750 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3751 . nfnod_crkxfemg)
3752 ELSE
3753 CALL velvecc_max(fcont_max,nodcut,nnwl,nnsrg,nfvnod,
3754 . nfnod_pxfemg,nfnod_crkxfemg)
3755 ENDIF
3756 END IF
3757
3758 IF(anim_v(27)==1) THEN
3759 CALL velvecc(fncontp2,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3760 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3761 . nfnod_crkxfemg)
3762 CALL velvecc(ftcontp2,bid_temp,icbuf(mic2),cbuf(mac2),nodcut,nnwl,
3763 . nnnsrg,nodglob,weight,nfvnod,nfnod_pxfem,nfnod_pxfemg,
3764 . nfnod_crkxfemg)
3765 ENDIF
3766C-----------------------------------------------
3767C 2D TENSOR TEXT
3768C-----------------------------------------------
3769C In SPMD locally NBF = 0 but not the sum on P0!
3770C on proc 0 global nbf
3771 IF (ispmd==0.AND.nbf+nelcut+nesbw2/=0)THEN
3772 IF(anim_ct(1)==1) CALL ani_txt('Stress (membrane)',17)
3773 IF(anim_ct(2)==1) CALL ani_txt('Stress (moment/t^2)',19)
3774 IF(anim_ct(3)==1) CALL ani_txt('Stress (upper)',14)
3775 IF(anim_ct(4)==1) CALL ani_txt('Stress (lower)',14)
3776 IF(anim_ct(5)==1) CALL ani_txt('Strain (membrane)',17)
3777 IF(anim_ct(6)==1) CALL ani_txt('Strain (Curvature)',18)
3778 IF(anim_ct(7)==1) CALL ani_txt('Strain (upper)',14)
3779 IF(anim_ct(8)==1) CALL ani_txt('Strain (lower)',14)
3780 IF(anim_ct(91)==1)CALL ani_txt('Strn rate (membrane)',20)
3781 IF(anim_ct(92)==1)CALL ani_txt('Strn rate (Curvature)',21)
3782 IF(anim_ct(93)==1)CALL ani_txt('Strn rate (upper)',17)
3783 IF(anim_ct(94)==1)CALL ani_txt('Strn rate (lower)',17)
3784 DO i=1,100
3785 IF(anim_ct(100+i)==1)THEN
3786 WRITE(mes,'(A,I3,A)')'Stress (layer',i,')'
3787 CALL ani_txt(mes,18)
3788 ENDIF
3789 ENDDO
3790 DO i=1,100
3791 IF(anim_ct(200+i)==1)THEN
3792 WRITE(mes,'(A,I3,A)')'Strain (layer',i,')'
3793 CALL ani_txt(mes,18)
3794 ENDIF
3795 ENDDO
3796 DO i=1,100
3797 IF(anim_ct(300+i)==1)THEN
3798 WRITE(mes,'(A,I3,A)')'Strn rate (layer',i,')'
3799 CALL ani_txt(mes,21)
3800 ENDIF
3801 ENDDO
3802C-----------------------------------------------
3803C stress TENS output (all NPTT) for new PID51 composite shell
3804C-----------------------------------------------
3805C
3806C Stress = UPPER =
3807C
3808 DO i=401,500
3809 IF (anim_ct(i) == 1) THEN
3810 ius = mod((i - 400), 100)
3811 IF(ius==0) ius = 100
3812 WRITE(mes,'(A,I3,A)')'Stress (UPPER/LAYER',ius,')'
3813 CALL ani_txt(mes,24)
3814 END IF
3815 END DO
3816C
3817C Stress = LOWER =
3818C
3819 DO i=501,600
3820 IF (anim_ct(i) == 1) THEN
3821 ius = mod((i - 500), 100)
3822 IF(ius==0) ius = 100
3823 WRITE(mes,'(A,I3,A)')'Stress (LOWER/LAYER',ius,')'
3824 CALL ani_txt(mes,24)
3825 END IF
3826 END DO
3827C
3828C Stress = all NPTT =
3829C
3830 DO i=1,100
3831 DO j=1,10
3832 ius = 10*i+j
3833 IF (anim_ct(ius + 600) == 1) THEN
3834 ilay = i
3835 ipt = j
3836 WRITE(mes,'(A,I3,I3,A)')
3837 . 'Stress (LAYER/IPT',ilay,ipt,')'
3838 CALL ani_txt(mes,25)
3839 END IF
3840 ENDDO
3841 ENDDO
3842C
3843C Stress /ANIM/SHELL/IDPLY/STRESS/KEY5/KEY6
3844C
3845 DO i=1,mx_ply_anim
3846 IF (anim_ct(1610 + i) == 1) THEN
3847 WRITE(mes,'(A,I10,X,I3,A)')
3848 . 'Stress (PLY/IPT',ply_anim_stress( 3 * (i - 1) + 1),
3849 . ply_anim_stress( 3 * (i - 1) + 3),')'
3850 CALL ani_txt(mes,30)
3851 END IF
3852 ENDDO
3853C
3854C Strain /ANIM/SHELL/IDPLY/STRAIN/KEY5/KEY6
3855C
3856 DO i=1,mx_ply_anim
3857 IF (anim_ct( (1610+ mx_ply_anim) + i) == 1) THEN
3858 WRITE(mes,'(A,I10,X,I3,A)')
3859 . 'Strain (PLY/IPT',ply_anim_strain( 3 * (i - 1) + 1),
3860 . ply_anim_strain( 3 * (i - 1) + 3),')'
3861 CALL ani_txt(mes,30)
3862 END IF
3863 ENDDO
3864C
3865C Strain /ANIM/SHELL/IDPLY/EPSDOT/KEY5/KEY6
3866C
3867 DO i=1,mx_ply_anim
3868 IF (anim_ct( (1610+ 2*mx_ply_anim) + i) == 1) THEN
3869 WRITE(mes,'(A,I10,X,I3,A)')
3870 . 'Epsdot (PLY/IPT',ply_anim_epsdot( 3 * (i - 1) + 1),
3871 . ply_anim_epsdot( 3 * (i - 1) + 3),')'
3872 CALL ani_txt(mes,30)
3873 END IF
3874 ENDDO
3875C-----------------------------------------------
3876C STRAIN TENSOR (PID51 + PID 52) /ANIM/SHELL/TENS/STRAIN/KEY5/KEY6
3877C-----------------------------------------------
3878! upper for PID_51, 52
3879 idx = 1610 + 3*mx_ply_anim
3880 DO i=idx+1,idx+100
3881 IF (anim_ct(i) == 1) THEN
3882 ius = mod((i - idx), 100)
3883 IF (ius == 0) ius = 100
3884 WRITE(mes,'(A,I3,A)')'Strain (UPPER/LAYER',ius,')'
3885 CALL ani_txt(mes,24)
3886 ENDIF
3887 ENDDO
3888! lower for PID_51, 52
3889 idx = 1710 + 3*mx_ply_anim
3890 DO i=idx+1,idx+100
3891 IF (anim_ct(i) == 1) THEN
3892 ius = mod((i - idx), 100)
3893 IF (ius == 0) ius = 100
3894 WRITE(mes,'(A,I3,A)')'Strain (LOWER/LAYER',ius,')'
3895 CALL ani_txt(mes,24)
3896 ENDIF
3897 ENDDO
3898! all NPTT through all layers for PID_51, 52
3899 idx = 1810 + 3*mx_ply_anim
3900 DO i=1,100
3901 DO j=1,10
3902 ius = 10*i+j
3903 IF (anim_ct(ius + idx) == 1) THEN
3904 ilay = i
3905 ipt = j
3906 WRITE(mes,'(A,I3,I3,A)')
3907 . 'Strain (LAYER/IPT',ilay,ipt,')'
3908 CALL ani_txt(mes,25)
3909 END IF
3910 ENDDO
3911 ENDDO
3912C-----------------------------------------------
3913C EPSDOT TENSOR (PID51 + PID 52) /ANIM/SHELL/TENS/EPSDOT/KEY5/KEY6
3914C-----------------------------------------------
3915! upper for PID_51, 52
3916 idx = 2820 + 3*mx_ply_anim
3917 DO i=idx+1,idx+100
3918 IF (anim_ct(i) == 1) THEN
3919 ius = mod((i - idx), 100)
3920 IF (ius == 0) ius = 100
3921 WRITE(mes,'(A,I3,A)')'Epsdot (UPPER/LAYER',ius,')'
3922 CALL ani_txt(mes,24)
3923 ENDIF
3924 ENDDO
3925! lower for PID_51, 52
3926 idx = 2920 + 3*mx_ply_anim
3927 DO i=idx+1,idx+100
3928 IF (anim_ct(i) == 1) THEN
3929 ius = mod((i - idx), 100)
3930 IF (ius == 0) ius = 100
3931 WRITE(mes,'(A,I3,A)')'Epsdot (LOWER/LAYER',ius,')'
3932 CALL ani_txt(mes,24)
3933 ENDIF
3934 ENDDO
3935! all NPTT through all layers for PID_51, 52
3936 idx = 3020 + 3*mx_ply_anim
3937 DO i=1,100
3938 DO j=1,10
3939 ius = 10*i+j
3940 IF (anim_ct(ius + idx) == 1) THEN
3941 ilay = i
3942 ipt = j
3943 WRITE(mes,'(A,I3,I3,A)')
3944 . 'Epsdot (LAYER/IPT',ilay,ipt,')'
3945 CALL ani_txt(mes,25)
3946 END IF
3947 ENDDO
3948 ENDDO
3949
3950c-----------------------------------------------------------
3951c Stress output in material (orthotropic) coordinates
3952c-----------------------------------------------------------
3953 idx = 3120 + 3*mx_ply_anim
3954
3955 IF (anim_ct(idx+1)==1) CALL ani_txt('Mstress (membrane)',18)
3956 IF (anim_ct(idx+2)==1) CALL ani_txt('Mstress (upper)',15)
3957 IF (anim_ct(idx+3)==1) CALL ani_txt('Mstress (lower)',15)
3958c
3959 idx = 3120 + 3*mx_ply_anim + 3
3960 DO i = idx+1,idx+100
3961 IF (anim_ct(i)==1) THEN
3962 WRITE(mes,'(A,I3,A)')'Mstress (layer',i,')'
3963 CALL ani_txt(mes,18)
3964 ENDIF
3965 ENDDO
3966c
3967c /ANIM/SHELL/IDPLY/MSTRESS/KEY5/KEY6 (prop type 17, 51 and 52 only)
3968c
3969 idx = 3120 + 3*mx_ply_anim + 103
3970 DO i = idx+1,idx + mx_ply_anim
3971 IF (anim_ct(i) == 1) THEN
3972 WRITE(mes,'(A,I10,X,I3,A)')
3973 . 'Mstress (PLY/IPT',ply_anim_stress( 3 * (i - 1) + 1),
3974 . ply_anim_stress(3 * (i - 1) + 3),')'
3975 CALL ani_txt(mes,30)
3976 END IF
3977 ENDDO
3978!
3979 ENDIF ! IF(ISPMD==0.AND.NBF+NELCUT+NESBW2/=0)
3980C-----------------------------------------------
3981C 2D TENSOR
3982C-----------------------------------------------
3983 DO i = 1,mx_ani
3984 ifunc = i
3985 IF (anim_ct(i) == 1) THEN
3986 CALL tensorc(elbuf_tab,iparg ,ifunc ,invert,nelcut,
3987 . el2fa ,nbf ,waft ,tani ,iad ,
3988 . nbf_l ,nbpart,iadg ,x ,ixc ,
3989 . igeo ,ixtg ,ipm ,stack ,mat_param,
3990 . geo ,drape_sh4n, drape_sh3n, drapeg)
3991 IF (ispmd==0) THEN
3992 r4 = zero
3993 DO j=1,nesbw2
3994 CALL write_r_c(r4,1)
3995 CALL write_r_c(r4,1)
3996 CALL write_r_c(r4,1)
3997 ENDDO
3998 ENDIF
3999C
4000 IF (anim_ply > 0) THEN ! prop type 17 only
4001 CALL tensorc_ply(iply, nel_ply, elbuf_tab ,iparg,
4002 . ifunc, invert, el2fa_ply ,nbf_pxfem,
4003 . waft_ply,tani, iad, plynumc,
4004 . nbpart, iad_plyg, x, ixc,mat_param,
4005 . igeo, ixtg, nbf_pxfemg,ipm, stack )
4006 ENDIF
4007C
4008 IF (anim_crk > 0) THEN
4009 CALL tensorc_crk(
4010 . elbuf_tab,xfem_tab ,iparg ,ipm ,
4011 . ifunc ,invert ,el2fa_crk,nbf_crkxfemg,
4012 . len_crkx ,tani ,iad ,nbf_crkxfem ,
4013 . nbpart ,iad_crkg ,x ,ixc ,
4014 . igeo ,ixtg ,iel_crk ,iadc_crk ,
4015 . crkedge ,indx_crk ,mat_param)
4016 ENDIF
4017C
4018 IF (ispmd==0.AND.nfvtr>0) THEN
4019 r4 = zero
4020 DO j=1,nfvtr
4021 CALL write_r_c(r4,1)
4022 CALL write_r_c(r4,1)
4023 CALL write_r_c(r4,1)
4024 ENDDO
4025 ENDIF
4026 ENDIF
4027 ENDDO
4028
4029C-----------------------------------------------
4030C ELEMENT MASS
4031C-----------------------------------------------
4032 IF(anim_m==1)THEN
4033C Monoproc Equivalent Treatment
4034 IF(nspmd == 1) THEN
4035 DO i=1,nbf
4036 r4 = mas(i)
4037 CALL write_r_c(r4,1)
4038 ENDDO
4039C xfem crack for layered shells +++
4040cc IF(NBF_CRKXFEM > 0) THEN
4041cc DO I=1,NBF_CRKXFEM
4042cc R4 = ZERO
4043cc CALL WRITE_R_C(R4,1)
4044cc ENDDO
4045cc ENDIF
4046C xfem crack for layered shells ---
4047 ELSE
4048 DO i = 1, nbf_l
4049 mas4(i) = mas(i)
4050 ENDDO
4051 IF(ispmd==0) THEN
4052 buf = (numelqg+numelcg+numeltgg)
4053 ELSE
4054 buf=1
4055 END IF
4056 CALL spmd_r4get_partn(1,nbf_l,nbpart,iadg,mas4,buf)
4057 ENDIF
4058
4059 IF (ispmd==0) THEN
4060 r4 = 0.
4061 DO j=1,nesbw2+nelcut
4062 CALL write_r_c(r4,1)
4063 ENDDO
4064 ENDIF
4065C add the mass if needed
4066 IF(ispmd == 0 .AND. anim_ply > 0 ) THEN
4067 r4 = zero
4068 DO i=1,nbf_pxfemg
4069 CALL write_r_c(r4,1)
4070 ENDDO
4071 ENDIF
4072C xfem crack for layered shells +++
4073 IF(ispmd == 0 .AND. anim_crk > 0)THEN
4074 r4 = zero
4075 DO i=1,nbf_crkxfemg
4076 CALL write_r_c(r4,1)
4077 ENDDO
4078 ENDIF
4079C xfem crack for layered shells ---
4080 IF (ispmd==0.AND.nfvtr>0) THEN
4081 r4=zero
4082 DO j=1,nfvtr
4083 CALL write_r_c(r4,1)
4084 ENDDO
4085 ENDIF
4086
4087C-----------------------------------------------
4088C NODAL MASS (FLUX FOR CUT)
4089C-----------------------------------------------
4090 DO i=1,numnod
4091 IF (weight_md(i)==1) THEN
4092 wa4(i)=ms(i)
4093 ELSE
4094 wa4(i)=zero
4095 END IF
4096 ENDDO
4097C
4098 DO n=1,nrbykin
4099 m=npby(1,n)
4100 IF (m>0) THEN
4101 wa4(m)=wa4(m)+(rby(15,n)-ms(m))* weight_md(m)
4102 ENDIF
4103 ENDDO
4104C Mono Equivalent Treatment
4105 IF (nspmd == 1) THEN
4106 DO k=1,numnod
4107 r4 = wa4(k)
4108 CALL write_r_c(r4,1)
4109 ENDDO
4110 ELSE
4111 IF (ispmd==0) THEN
4112 buf = numnodg
4113 ELSE
4114 buf = 1
4115 ENDIF
4116 CALL spmd_gatherf(wa4,weight,nodglob,buf)
4117 ENDIF
4118
4119 r4 = zero
4120 IF(nodcut>0)
4121 . CALL cutmass(icbuf,cbuf,cbuf(mac2),nodcut,nelcut,
4122 . v,cbuf(mac3),icbuf(mic2))
4123 IF (ispmd==0) THEN
4124 r4 = 0.
4125c SZ16 = NUMELS16
4126c SZNNSPH = NNSPH
4127 sz16 = numels16g
4128 sznnsph = nnsphg
4129 DO n=1,nsect+nrwall+nnwl+nnsrg+nnsmd+sznnsph+2*sz16
4130 CALL write_r_c(r4,1)
4131 ENDDO
4132 ENDIF
4133C nodal/ply mass is not computed for anim is always zero
4134 IF(ispmd==0 .AND. anim_ply > 0 ) THEN
4135 r4=zero
4136 DO i=1,nfnod_pxfemg
4137 CALL write_r_c(r4,1)
4138 ENDDO
4139 ENDIF
4140C xfem crack for layered shells +++
4141 IF(ispmd==0 .AND. anim_crk > 0)THEN
4142 r4=zero
4143 DO i=1,nfnod_crkxfemg
4144 CALL write_r_c(r4,1)
4145 ENDDO
4146 ENDIF
4147C xfem crack for layered shells ---
4148 IF (ispmd==0.AND.nfvnod>0) THEN
4149 r4=zero
4150 DO n=1,nfvnod+3
4151 CALL write_r_c(r4,1)
4152 ENDDO
4153 ENDIF
4154 ENDIF
4155C-----------------------------------------------
4156C NODAL and ELEMENT NUMBERING
4157C-----------------------------------------------
4158C Monoproc Equivalent Treatment
4159 IF (nspmd == 1) THEN
4160 CALL write_i_c(itab,numnod)
4161 IF (numelig3d>0) THEN
4162 DO i=1,64*numelig3d
4163 CALL write_i_c(first_node_ig3d+i,1)
4164 ENDDO
4165 ENDIF
4166 ELSE
4167 IF (ispmd==0) THEN
4168 buf = numnodg
4169 ELSE
4170 buf = 1
4171 ENDIF
4172 CALL spmd_gatheritab(itab,weight,nodglob,buf)
4173 ENDIF
4174
4175c SZ16 = NUMELS16
4176c SZNNSPH = NNSPH
4177 sz16 = numels16g
4178 sznnsph = nnsphg
4179
4180 IF (ispmd==0) THEN
4181 DO i=1,nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd+sznnsph+2*sz16
4182 CALL write_i_c(0,1)
4183 ENDDO
4184 ENDIF
4185C Idmax to review for vmbag
4186C ----
4187 IF(anim_ply > 0) THEN
4188 IF (nspmd == 1) THEN
4189 ii = 0
4190 ALLOCATE(itab_ply(nplyxfe))
4191 itab_ply =0
4192 DO j=1,nplypart
4193 iply = indx_ply(j)
4194 nn = plynod(iply)%PLYNUMNODS
4195 DO i=1,nn
4196 itab_ply(i) = idmax + ii + i
4197 ENDDO
4198 CALL write_i_c(itab_ply,nn)
4199 ii = ii + nn
4200 ENDDO
4201 DEALLOCATE(itab_ply)
4202 idmax = idmax + nfnod_pxfem
4203 ELSE
4204 IF (ispmd==0)THEN
4205 ALLOCATE(itab_ply(nfnod_pxfemg))
4206 ii = 0
4207 itab_ply =0
4208 DO j=1,nfnod_pxfemg
4209 itab_ply(j) = idmax + j
4210 ENDDO
4211c DO J=1,NPLYMAX
4212c NN = PLYNODG(J)%PLYNUMNODS
4213c DO I=1,NN
4214c ITAB_PLY(I) = IDMAX + II + I
4215 CALL write_i_c(itab_ply,nfnod_pxfemg)
4216c II = II + NN
4217 DEALLOCATE(itab_ply)
4218 idmax = idmax + nfnod_pxfemg
4219 ENDIF
4220 ENDIF
4221 ENDIF
4222C xfem crack for layerd shells +++
4223 IF(anim_crk > 0)THEN
4224 IF(nspmd == 1)THEN
4225 ii = 0
4226 ALLOCATE(itab_crk(nfnod_crkxfemg))
4227 itab_crk =0
4228 DO icrk=1,ncrkpart
4229 DO i=1,crknod(ilev)%CRKNUMNODS
4230 j = crknod(ilev)%CRKNUMNODS*(icrk-1)
4231 k = nodglobxfe(i+j)
4232 itab_crk(k) = crknod(icrk)%XFECRKNODID(i)+idmax
4233 CALL write_i_c(itab_crk(k),1)
4234 ENDDO
4235 ENDDO
4236 DEALLOCATE(itab_crk)
4237 ELSE
4238 IF(ispmd==0)THEN
4239 buf = nfnod_crkxfemg
4240 ELSE
4241 buf = 1
4242 END IF
4243 DO icrk=1,ncrkpart
4244 CALL spmd_gatheritab_crk(icrk,buf,idmaxnod,nodglobxfe)
4245 END DO
4246 ENDIF
4247 ELSE
4248 ALLOCATE(itab_crk(0))
4249 ENDIF
4250C xfem crack for layerd shells ---
4251C MONOPRIX Equivalent Treatment
4252 IF (nspmd == 1 .AND. nfvnod>0) THEN
4253 DO i=1,nfvbag
4254 IF (fvdata(i)%NPOLH_ANIM>0) THEN
4255 DO j=1,fvdata(i)%NNS_ANIM
4256 jj=fvoff(2,i)+j
4257 CALL write_i_c(jj,1)
4258 ENDDO
4259 ENDIF
4260 ENDDO
4261 CALL write_i_c(idmax+nfvnod+1,1)
4262 CALL write_i_c(idmax+nfvnod+2,1)
4263 CALL write_i_c(idmax+nfvnod+3,1)
4264 ELSEIF(nfvnod>0) THEN
4265 CALL spmd_fvb_anum(fvoff, idmax, nfvnod)
4266 ENDIF
4267C
4268 CALL delnumbc(iparg,ixq ,ixc ,ixtg ,invert,
4269 . el2fa,nbf ,waft ,nelcut,
4270 . dd_iad,iad ,nbf_l,
4271 . nbpart,iadg,nodglob,idcmax)
4272 IF (ispmd==0) THEN
4273 DO j=1,nesbw2
4274 CALL write_i_c(0,1)
4275 ENDDO
4276 ENDIF
4277C
4278
4279 IF(anim_ply > 0 ) THEN
4280 nel_ply= 0
4281 CALL delnumbc_ply(iply,nel_ply,iparg,
4282 . ixc ,ixtg ,invert,
4283 . el2fa_ply,nbf_pxfem ,waft_ply ,nelcut,
4284 . dd_iad,iad ,plynumc,
4285 . nbpart,iad_plyg,nodglob,idcmax,nbf_pxfemg)
4286 ENDIF
4287C
4288 IF (anim_crk > 0) THEN
4289 CALL delnumbc_crk(
4290 . iparg ,iel_crk ,waft_crk ,idcmax ,
4291 . el2fa_crk,iad_crkg ,nbf_crkxfem,nbf_crkxfemg,indx_crk)
4292 ENDIF
4293C
4294 IF (ispmd==0.AND.nfvtr>0) THEN
4295 DO i=1,nfvtr
4296 CALL write_i_c(idcmax+fvinum(i),1)
4297 ENDDO
4298 DEALLOCATE(fvel2fa, fvinum)
4299 ENDIF
4300C-----------------------------------------------
4301C HIERARCHY
4302C-----------------------------------------------
4303 IF (nfvpart>0) THEN
4304 IF (ispmd==0) ALLOCATE(fvpbuf(nfvpart))
4305 ii=nsubs
4306 . +min(1,nsect)+min(1,nrbody+ nrbe2t+nrbe3t)+min(1,nrwall)
4307 . +min(1,nsurg+nsmad) + min(1,nplypartw)
4308 . +min(1,ncrkpartw)-1
4309 IF(nspmd > 1) CALL spmd_fvb_asub1(ii, fvpbuf)
4310 ENDIF
4311C
4312 IF (ispmd==0) THEN
4313C Transmis a ANIM ::
4314clm Subset Rbodies == NSUBS
4315Cclm Subset Sections == NSUBS+MIN(1,NRBODY+NRBE2+NRBE3)
4316clm Subset Rwalls == NSUBS+MIN(1,NSECT)+MIN(1,NRBODY+NRBE2+NRBE3)
4317C Subset Surfaces == NSUBS+MIN(1,NSECT)+MIN(1,NRBODY+NRBE2+NRBE3)+MIN(1,NRWALL)
4318clm Subset global == NSUBS+MIN(1,NSECT)+MIN(1,NRBODY+NRBE2+NRBE3)+MIN(1,NRWALL)
4319C +MIN(1,NSURG+NSMAD) + MIN(1,NPLYPART)
4320 DO i=1,npart
4321 IF(mater(i)==1) THEN
4322 IF (ipart(3,i)<nsubs) THEN
4323 CALL write_i_c(ipart(3,i)-1,1)
4324 ELSE
4325 CALL write_i_c(nsubs
4326 . +min(1,nsect)+min(1,nrbody+ nrbe2t+nrbe3t)
4327 . +min(1,nrwall)+min(1,nsurg+nsmad)
4328 . +nfvsubs+min(1,nplypartw)
4329 . +min(1,ncrkpartw)-1,1)
4330 END IF
4331 END IF
4332 ENDDO
4333 DO i=1,ncuts
4334 CALL write_i_c(nsubs
4335 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
4336 . +min(1,nsurg+nsmad)+min(1,nplypartw)
4337 . +min(1,ncrkpartw)-1,1)
4338 ENDDO
4339 DO i=1,nsect
4340 CALL write_i_c(nsubs+min(1,nrbody+nrbe2t+nrbe3t)-1,1)
4341 END DO
4342 DO i=1,nrwall
4343 CALL write_i_c(nsubs+min(1,nsect)
4344 . +min(1,nrbody+nrbe2t+nrbe3t)-1,1)
4345 END DO
4346 DO i=1,nsurg
4347 CALL write_i_c(nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+
4348 . nrbe3t)+min(1,nrwall)-1,1)
4349 END DO
4350 DO i=1,nsmad
4351 CALL write_i_c(nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+
4352 . nrbe3t)+min(1,nrwall)-1,1)
4353 END DO
4354c plyxfem
4355 IF(anim_ply > 0) THEN
4356 IF (ispmd==0)THEN
4357 ii = nsubs + min(1,nsect) + min(1,nrbody+nrbe2t+nrbe3t)
4358 . + min(1,nrwall)+ min(1,nsurg+nsmad) - 1
4359c
4360 DO i= 1,nplypart
4361 CALL write_i_c(ii ,1)
4362 ENDDO
4363 ENDIF
4364 ENDIF
4365c xfem crack for layered shells +++
4366 IF(anim_crk > 0)THEN
4367 IF (ispmd==0)THEN
4368 ii = nsubs + min(1,nsect) + min(1,nrbody+nrbe2t+nrbe3t)
4369 . + min(1,nrwall)+ min(1,nsurg+nsmad) - 1
4370 DO i= 1,ncrkpartw
4371 CALL write_i_c(ii ,1)
4372 ENDDO
4373 ENDIF
4374 ENDIF
4375C xfem crack for layered shells ---
4376C Monoproc Equivalent Treatment
4377 IF (nspmd == 1.AND.nfvtr>0) THEN
4378 ii=nsubs
4379 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
4380 . +min(1,nsurg+nsmad) +min(nplypartw,1)
4381 . +min(1,ncrkpartw)-1
4382 DO i=1,nfvbag
4383 IF (fvdata(i)%NPOLH_ANIM>0) THEN
4384 ii=ii+1
4385 DO j=1,fvdata(i)%NPOLH_ANIM
4386 CALL write_i_c(ii-1,1)
4387 ENDDO
4388 ENDIF
4389 ENDDO
4390 ELSEIF (nfvpart>0) THEN
4391 CALL write_i_c(fvpbuf, nfvpart)
4392 DEALLOCATE(fvpbuf)
4393 ENDIF
4394 DO i=1,npart
4395 IF(mater(i)==1)CALL write_i_c(ipart(1,i),1)
4396 ENDDO
4397 DO i=1,ncuts+nrwall+nsect+nsurg+nsmad+nplypartw+ncrkpartw
4398 CALL write_i_c(0,1)
4399 ENDDO
4400C
4401 DO i=1,nfvpart
4402 CALL write_i_c(0,1)
4403 ENDDO
4404C
4405 DO i=1,npart
4406 IF(mater(i)==1)CALL write_i_c(ipart(2,i),1)
4407 ENDDO
4408 DO i=1,ncuts+nrwall+nsect+nsurg+nsmad+nplypartw+ncrkpartw
4409 CALL write_i_c(0,1)
4410 ENDDO
4411 DO i=1,nfvpart
4412 CALL write_i_c(0,1)
4413 ENDDO
4414 ENDIF
4415C=======================================================================
4416C
4417C BRICKS
4418C
4419C=======================================================================
4420 IF(numels_t+numels16_t+isph3d*(numsph_t+maxpjet)+numelig3d==0)
4421 . GOTO 400
4422C-----------------------------------------------
4423C PART COUNT
4424C-----------------------------------------------
4425 DO i=1,npart
4426 bufferp(i) = mater(i)
4427 mater(i) = 0
4428 ENDDO
4429C
4430C
4431 DO ng = 1, ngroup
4432 nel =iparg(2,ng)
4433 nft =iparg(3,ng)
4434 ity =iparg(5,ng)
4435 IF(ity==1)THEN
4436 DO i = 1, nel
4437 n = i + nft
4438 mater(iparts(n))=2
4439 ENDDO
4440C 3D geometry is not yet treated.
4441 ELSEIF (isph3d==1.AND.ity==51)THEN
4442 DO i = 1, nel
4443 n = i + nft
4444 mater(ipartsp(n))=2
4445 ENDDO
4446 ELSEIF (ity==101)THEN
4447 DO i = 1, nel
4448 n = i + nft
4449 mater(ipartig3d(n))=2
4450 ENDDO
4451 ENDIF
4452 ENDDO
4453C
4454 IF(nspmd > 1) CALL spmd_glob_isum9(mater,npart)
4455 DO i=1,npart
4456 IF(mater(i)>2) mater(i) = 2
4457 ENDDO
4458 IF(nspmd > 1) CALL spmd_ibcast(mater,mater,npart,1,0,2)
4459 DO i=1,npart
4460 mater(i) = mater(i)+bufferp(i)
4461 ENDDO
4462
4463C
4464 nbpart = 0
4465 DO i=1,npart
4466 nbpart = nbpart + mater(i)/2
4467 ENDDO
4468
4469C-----------------------------------------------
4470C WRITE CONTROL
4471C-----------------------------------------------
4472 IF (ispmd==0) THEN
4473 CALL write_i_c(numels_t+3*numels16g+isph3d*numsphg+27*numelig3d,1)
4474 CALL write_i_c(nbpart,1)
4475 CALL write_i_c(nse_ani,1)
4476 CALL write_i_c(nst_ani,1)
4477 ENDIF
4478
4479C-----------------------------------------------
4480C PART SORT
4481C-----------------------------------------------
4482 shftsph = numnodg+nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd
4483 shftsph = shftsph + sphshift
4484 shft16 = numnodg+nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd+nnsphg
4485 shft16 = shft16 + num16shift
4486C start index of node zone on SPH tetras
4487 insph=numnod+nodcut+nsect+nrwall+nnwl+nnsrg+nnsmd
4488
4489 CALL parsors(iad ,iparg ,ixs ,mater,iparts,
4490 2 el2fa , dd_iad,
4491 3 iadg ,insph ,kxsp ,ipartsp,
4492 4 ixs10 ,ixs20 ,ixs16 ,nnsph ,isph3d,
4493 5 nodglob,shft16 ,shftsph,nnsphg,ipartig3d,
4494 6 kxig3d,igeo,ig3dsolid)
4495C-----------------------------------------------
4496C OFF
4497C-----------------------------------------------
4498 nnn = numels+isph3d*(numsph+maxpjet)+3*numels16+27*numelig3d
4499 CALL anioffs(elbuf_tab,iparg,waft ,el2fa ,nnn ,
4500 . nbpart ,iadg ,isph3d )
4501C-----------------------------------------------
4502C PART ADD
4503C-----------------------------------------------
4504 IF (ispmd==0) THEN
4505 DO i = 1, nbpart
4506 bufferp(i) = 0
4507 DO k = 1, nspmd
4508 bufferp(i) = bufferp(i) + iadg(k,i)
4509 ENDDO
4510 ENDDO
4511 CALL write_i_c(bufferp,nbpart)
4512 ENDIF
4513
4514C-----------------------------------------------
4515C PART HEAD
4516C-----------------------------------------------
4517 IF (ispmd==0) THEN
4518 DO i=1,npart
4519 IF(mater(i)==2)THEN
4520 WRITE(str,'(I9,A1)')ipart(4,i),':'
4521 DO j=1,10
4522 ctext(j)=ichar(str(j:j))
4523 ENDDO
4524 ib = 10
4525 CALL fretitl2(titl,ipart(lipart1-ltitr+1,i),40)
4526 DO j=1,ltitl
4527 IF(titl(j:j)/=' ') ib = j+10
4528 ctext(j+10)=ichar(titl(j:j))
4529 END DO
4530 ctext(ib+1)=0
4531 CALL write_c_c(ctext,10+ltitl)
4532 ENDIF
4533 ENDDO
4534 ENDIF
4535
4536C-----------------------------------------------
4537C ELEMENT MASS FOR MAS & FUNC
4538C-----------------------------------------------
4539 IF(anim_m==1.OR.anim_se(3)==1.OR.anim_se(25)==1)THEN
4540 CALL dmasanis(elbuf_tab,x ,d ,geo ,iparg ,
4541 . ixs ,mas ,pm ,el2fa ,numels ,
4542 . ipart ,ipartsp ,isph3d )
4543 ENDIF
4544C-----------------------------------------------
4545C BRICK FUNC TEXT
4546C-----------------------------------------------
4547 IF (ispmd==0) THEN
4548 ctext(81)=0
4549 IF(anim_se(1)==1) CALL ani_txt('Plastic Strain',14)
4550 IF(anim_se(2)==1) CALL ani_txt('Density',7)
4551 IF(anim_se(3)==1) CALL ani_txt('Specific Energy',15)
4552 IF(anim_se(4)==1) CALL ani_txt('Temperature',11)
4553 IF(anim_se(6)==1) CALL ani_txt('Pressure',8)
4554 IF(anim_se(7)==1) CALL ani_txt('Von Mises',9)
4555 IF(anim_se(8)==1) CALL ani_txt('Turbulent Energy',16)
4556 IF(anim_se(9)==1) CALL ani_txt('Turbulent Viscosity',19)
4557 IF(anim_se(10)==1) CALL ani_txt('Vorticity-X',11)
4558 IF(anim_se(11)==1) CALL ani_txt('Damage 1',8)
4559 IF(anim_se(12)==1) CALL ani_txt('Damage 2',8)
4560 IF(anim_se(13)==1) CALL ani_txt('Damage 3',8)
4561 IF(anim_se(14)==1) CALL ani_txt('Stress X ',9)
4562 IF(anim_se(15)==1) CALL ani_txt('Stress Y ',9)
4563 IF(anim_se(16)==1) CALL ani_txt('Stress Z ',9)
4564 IF(anim_se(17)==1) CALL ani_txt('Stress XY',9)
4565 IF(anim_se(18)==1) CALL ani_txt('Stress YZ',9)
4566 IF(anim_se(19)==1) CALL ani_txt('Stress ZX',9)
4567 IF(anim_se(20)==1) CALL ani_txt('User Var 1',10)
4568 IF(anim_se(21)==1) CALL ani_txt('User Var 2',10)
4569 IF(anim_se(22)==1) CALL ani_txt('User Var 3',10)
4570 IF(anim_se(23)==1) CALL ani_txt('User Var 4',10)
4571 IF(anim_se(24)==1) CALL ani_txt('User Var 5',10)
4572 IF(anim_se(25)==1) CALL ani_txt('Hourglass Energy per unit mass',30)
4573 IF(anim_se(26)==1) CALL ani_txt('Strain Rate',11)
4574 IF(anim_se(27)==1) CALL ani_txt('User Var 6',10)
4575 IF(anim_se(28)==1) CALL ani_txt('User Var 7',10)
4576 IF(anim_se(29)==1) CALL ani_txt('User Var 8',10)
4577 IF(anim_se(30)==1) CALL ani_txt('User Var 9',10)
4578 IF(anim_se(31)==1) CALL ani_txt('User Var 10',11)
4579 IF(anim_se(32)==1) CALL ani_txt('User Var 11',11)
4580 IF(anim_se(33)==1) CALL ani_txt('User Var 12',11)
4581 IF(anim_se(34)==1) CALL ani_txt('User Var 13',11)
4582 IF(anim_se(35)==1) CALL ani_txt('User Var 14',11)
4583 IF(anim_se(36)==1) CALL ani_txt('User Var 15',11)
4584 IF(anim_se(37)==1) CALL ani_txt('User Var 16',11)
4585 IF(anim_se(38)==1) CALL ani_txt('User Var 17',11)
4586 IF(anim_se(39)==1) CALL ani_txt('User Var 18',11)
4587 IF(anim_se(40)==1) CALL ani_txt('User Var 19',11)
4588 IF(anim_se(41)==1) CALL ani_txt('User Var 20',11)
4589 IF(anim_se(42)==1) CALL ani_txt('User Var 21',11)
4590 IF(anim_se(43)==1) CALL ani_txt('User Var 22',11)
4591 IF(anim_se(44)==1) CALL ani_txt('User Var 23',11)
4592 IF(anim_se(45)==1) CALL ani_txt('User Var 24',11)
4593 IF(anim_se(46)==1) CALL ani_txt('User Var 25',11)
4594 IF(anim_se(47)==1) CALL ani_txt('User Var 26',11)
4595 IF(anim_se(48)==1) CALL ani_txt('User Var 27',11)
4596 IF(anim_se(49)==1) CALL ani_txt('User Var 28',11)
4597 IF(anim_se(50)==1) CALL ani_txt('User Var 29',11)
4598 IF(anim_se(51)==1) CALL ani_txt('User Var 30',11)
4599 IF(anim_se(52)==1) CALL ani_txt('User Var 31',11)
4600 IF(anim_se(53)==1) CALL ani_txt('User Var 32',11)
4601 IF(anim_se(54)==1) CALL ani_txt('User Var 33',11)
4602 IF(anim_se(55)==1) CALL ani_txt('User Var 34',11)
4603 IF(anim_se(56)==1) CALL ani_txt('User Var 35',11)
4604 IF(anim_se(57)==1) CALL ani_txt('User Var 36',11)
4605 IF(anim_se(58)==1) CALL ani_txt('User Var 37',11)
4606 IF(anim_se(59)==1) CALL ani_txt('User Var 38',11)
4607 IF(anim_se(60)==1) CALL ani_txt('User Var 39',11)
4608 IF(anim_se(61)==1) CALL ani_txt('User Var 40',11)
4609 IF(anim_se(62)==1) CALL ani_txt('User Var 41',11)
4610 IF(anim_se(63)==1) CALL ani_txt('User Var 42',11)
4611 IF(anim_se(64)==1) CALL ani_txt('User Var 43',11)
4612 IF(anim_se(65)==1) CALL ani_txt('User Var 44',11)
4613 IF(anim_se(66)==1) CALL ani_txt('User Var 45',11)
4614 IF(anim_se(67)==1) CALL ani_txt('User Var 46',11)
4615 IF(anim_se(68)==1) CALL ani_txt('User Var 47',11)
4616 IF(anim_se(69)==1) CALL ani_txt('User Var 48',11)
4617 IF(anim_se(70)==1) CALL ani_txt('User Var 49',11)
4618 IF(anim_se(71)==1) CALL ani_txt('User Var 50',11)
4619 IF(anim_se(72)==1) CALL ani_txt('User Var 51',11)
4620 IF(anim_se(73)==1) CALL ani_txt('user var 52',11)
4621 IF(ANIM_SE(74)==1) CALL ANI_TXT('user var 53',11)
4622 IF(ANIM_SE(75)==1) CALL ANI_TXT('user var 54',11)
4623 IF(ANIM_SE(76)==1) CALL ANI_TXT('user var 55',11)
4624 IF(ANIM_SE(77)==1) CALL ANI_TXT('user var 56',11)
4625 IF(ANIM_SE(78)==1) CALL ANI_TXT('user var 57',11)
4626 IF(ANIM_SE(79)==1) CALL ANI_TXT('user var 58',11)
4627 IF(ANIM_SE(80)==1) CALL ANI_TXT('user var 59',11)
4628 IF(ANIM_SE(81)==1) CALL ANI_TXT('user var 60',11)
4629 !-------------------------------------------------------------!
4630 DO I=82,281
4631 IF(ANIM_SE(I)==1)THEN
4632 II = I - 81
4633 WRITE(MES,'(a,i3)')
4634 . 'wpla layer',II
4635 CALL ANI_TXT(MES,20)
4636 ENDIF
4637 ENDDO
4638 !-------------------------------------------------------------!
4639 IF(ANIM_SE(282)==1) CALL ANI_TXT('failed layers',13)
4640 !-------------------------------------------------------------!
4641 !283 to 286 : VOLUMETRIC FRACTION FOR ALE MULTIMATERIAL LAWS
4642 ! radioss2.F: check consistency with engine keyword and occurrence material law. ANIM_SE(.) flag is enabled only if consistent
4643 ! dfunc6.F : corresponding value (in MBUF%VAR) is stored in this function according material law number
4644 IF(ANIM_SE(283)==1) CALL ANI_TXT('volumetric fraction 1',21) !law51 & law37 & law20
4645 IF(ANIM_SE(284)==1) CALL ANI_TXT('volumetric fraction 2',21) !law37 & law37 & law20
4646 IF(ANIM_SE(285)==1) CALL ANI_TXT('volumetric fraction 3',21) !law51
4647 IF(ANIM_SE(286)==1) CALL ANI_TXT('volumetric fraction 4',21) !law51
4648 !-------------------------------------------------------------!
4649
4650 DO I=1,200
4651 IF(ANIM_SE(286+3*(I-1)+1)==1)THEN
4652 WRITE(MES,'(a,i3,a)')'psi(layer',I,')'
4653 CALL ANI_TXT(MES,15)
4654 ENDIF
4655 IF(ANIM_SE(286+3*(I-1)+2)==1)THEN
4656 WRITE(MES,'(a,i3,a)')'teta(layer',I,')'
4657 CALL ANI_TXT(MES,16)
4658 ENDIF
4659 IF(ANIM_SE(286+3*(I-1)+3)==1)THEN
4660 WRITE(MES,'(a,i3,a)')'phi(layer',I,')'
4661 CALL ANI_TXT(MES,15)
4662 ENDIF
4663 ENDDO
4664
4665 IF(ANIM_SE(887)==1) CALL ANI_TXT('burn fraction',13) !law51
4666 IF(ANIM_SE(888)==1) CALL ANI_TXT('damage variable1',16)
4667 IF(ANIM_SE(889)==1) CALL ANI_TXT('damage variable2',16)
4668 IF(ANIM_SE(890)==1) CALL ANI_TXT('damage variable3',16)
4669 DO I=1, 999
4670 IF(ANIM_SE(890+I)==1)THEN
4671 WRITE(MES,'(a,i3,a)')'damage var1 intg point(',I,')'
4672 CALL ANI_TXT(MES,30)
4673 ENDIF
4674 ENDDO
4675 DO I=1, 999
4676 IF(ANIM_SE(1890+I)==1)THEN
4677 WRITE(MES,'(a,i3,a)')'damage var2 intg point(',I,')'
4678 CALL ANI_TXT(MES,30)
4679 ENDIF
4680 ENDDO
4681 DO I=1, 999
4682 IF(ANIM_SE(2890+I)==1)THEN
4683 WRITE(MES,'(a,i3,a)')'damage var3 intg point(',I,')'
4684 CALL ANI_TXT(MES,30)
4685 ENDIF
4686 ENDDO
4687 IF(ANIM_SE(3890)==1) CALL ANI_TXT('max damage element',18)
4688
4689 DO I=1, 999
4690 IF(ANIM_SE(3890+I)==1)THEN
4691 WRITE(MES,'(a,i3,a)')'max damage intg point(',I,')'
4692 CALL ANI_TXT(MES,30)
4693 ENDIF
4694 ENDDO
4695 DO I=1, 4010
4696 IF(ANIM_SE(5910+I)==1)THEN
4697 II = I +5910-3890
4698 WRITE(MES,'(a,3i3)')
4699 . 'max damage intg pt ',ABS(II)/2010,
4700 . MOD(ABS(II)/10,201),MOD(ABS(II),10)
4701 CALL ANI_TXT(MES,28)
4702 ENDIF
4703 ENDDO
4704 IF(ANIM_SE(4890)==1) CALL ANI_TXT('time deletion element',21)
4705 IF(ANIM_SE(4891)==1) CALL ANI_TXT('sound speed',11)
4706 IF(ANIM_SE(4892)==1) CALL ANI_TXT('schlieren',9)
4707 IF(ANIM_SE(4893)==1) CALL ANI_TXT('domain',6)
4708 IF(ANIM_SE(4894)==1) CALL ANI_TXT('filling percentage',18)
4709C-----------------------------------------------
4710C element equivalent stress criteria
4711C-----------------------------------------------
4712 IF(ANIM_SE(4895)==1)CALL ANI_TXT('equiv stress',12)
4713 IF(ANIM_SE(4896)==1)CALL ANI_TXT('artificial viscosity',20)
4714
4715C-----------------------------------------------
4716C LAW51 OUTPUTS
4717C-----------------------------------------------
4718 IF(ANIM_SE(4897)==1)CALL ANI_TXT('density-1',9)
4719 IF(ANIM_SE(4898)==1)CALL ANI_TXT('density-2',9)
4720 IF(ANIM_SE(4899)==1)CALL ANI_TXT('density-3',9)
4721 IF(ANIM_SE(4900)==1)CALL ANI_TXT('density-4',9)
4722
4723 IF(ANIM_SE(4901)==1)CALL ANI_TXT('specific energy-1',17)
4724 IF(ANIM_SE(4902)==1)CALL ANI_TXT('specific energy-2',17)
4725 IF(ANIM_SE(4903)==1)CALL ANI_TXT('specific energy-3',17)
4726 IF(ANIM_SE(4904)==1)CALL ANI_TXT('specific energy-4',17)
4727
4728 IF(ANIM_SE(4905)==1)CALL ANI_TXT('temperature-1',13)
4729 IF(ANIM_SE(4906)==1)CALL ANI_TXT('temperature-2',13)
4730 IF(ANIM_SE(4907)==1)CALL ANI_TXT('temperature-3',13)
4731 IF(ANIM_SE(4908)==1)CALL ANI_TXT('temperature-4',13)
4732
4733 IF(ANIM_SE(4909)==1)CALL ANI_TXT('pressure-1',10)
4734 IF(ANIM_SE(4910)==1)CALL ANI_TXT('pressure-2',10)
4735 IF(ANIM_SE(4911)==1)CALL ANI_TXT('pressure-3',10)
4736 IF(ANIM_SE(4912)==1)CALL ANI_TXT('pressure-4',10)
4737
4738 IF(ANIM_SE(4913)==1)CALL ANI_TXT('plastic strain-1',16)
4739 IF(ANIM_SE(4914)==1)CALL ANI_TXT('plastic strain-2',16)
4740 IF(ANIM_SE(4915)==1)CALL ANI_TXT('plastic strain-3',16)
4741 IF(ANIM_SE(4916)==1)CALL ANI_TXT('plastic strain-4',16)
4742
4743 IF(ANIM_SE(4917)==1)CALL ANI_TXT('sound speed-1',13)
4744 IF(ANIM_SE(4918)==1)CALL ANI_TXT('sound speed-2',13)
4745 IF(ANIM_SE(4919)==1)CALL ANI_TXT('sound speed-3',13)
4746 IF(ANIM_SE(4920)==1)CALL ANI_TXT('sound speed-4',13)
4747
4748 IF(ANIM_SE(4921)==1)CALL ANI_TXT('volume',6) !THIS ONE IS A GLOBAL OUTPUT
4749
4750 IF(ANIM_SE(4922)==1)CALL ANI_TXT('volume-1',8)
4751 IF(ANIM_SE(4923)==1)CALL ANI_TXT('volume-2',8)
4752 IF(ANIM_SE(4924)==1)CALL ANI_TXT('volume-3',8)
4753 IF(ANIM_SE(4925)==1)CALL ANI_TXT('volume-4',8)
4754
4755 IF(ANIM_SE(4926)==1)CALL ANI_TXT('mass-1',6)
4756 IF(ANIM_SE(4927)==1)CALL ANI_TXT('mass-2',6)
4757 IF(ANIM_SE(4928)==1)CALL ANI_TXT('mass-3',6)
4758 IF(ANIM_SE(4929)==1)CALL ANI_TXT('mass-4',6)
4759
4760 IF(ANIM_SE(4930)==1)CALL ANI_TXT('detonation time',15)
4761
4762 IF(ANIM_SE(4931)==1)CALL ANI_TXT('artificial viscosity-1',22)
4763 IF(ANIM_SE(4932)==1)CALL ANI_TXT('artificial viscosity-2',22)
4764 IF(ANIM_SE(4933)==1)CALL ANI_TXT('artificial viscosity-3',22)
4765 IF(ANIM_SE(4934)==1)CALL ANI_TXT('artificial viscosity-4',22)
4766
4767 IF(ANIM_SE(4935)==1)CALL ANI_TXT('density of liquid - (law37)',27)
4768 IF(ANIM_SE(4936)==1)CALL ANI_TXT('density of gas - (law37)',27)
4769
4770 IF(ANIM_SE(4937)==1)CALL ANI_TXT('element time step',17)
4771
4772 IF(ANIM_SE(4938)==1)CALL ANI_TXT('momentum density x ',20)
4773 IF(ANIM_SE(4939)==1)CALL ANI_TXT('momentum density y ',20)
4774 IF(ANIM_SE(4940)==1)CALL ANI_TXT('momentum density z ',20)
4775 IF(ANIM_SE(4941)==1)CALL ANI_TXT('momentum density xy ',20)
4776 IF(ANIM_SE(4942)==1)CALL ANI_TXT('momentum density yz ',20)
4777 IF(ANIM_SE(4943)==1)CALL ANI_TXT('momentum density xz ',20)
4778 IF(ANIM_SE(4944)==1)CALL ANI_TXT('momentum density abs',20)
4779
4780 IF(ANIM_SE(4945)==1)CALL ANI_TXT('velocity x ',12)
4781 IF(ANIM_SE(4946)==1)CALL ANI_TXT('velocity y ',12)
4782 IF(ANIM_SE(4947)==1)CALL ANI_TXT('velocity z ',12)
4783 IF(ANIM_SE(4948)==1)CALL ANI_TXT('velocity xy ',12)
4784 IF(ANIM_SE(4949)==1)CALL ANI_TXT('velocity yz ',12)
4785 IF(ANIM_SE(4950)==1)CALL ANI_TXT('velocity xz ',12)
4786 IF(ANIM_SE(4951)==1)CALL ANI_TXT('velocity abs',12)
4787
4788 IF(ANIM_SE(4952)==1)CALL ANI_TXT('internal force x ',18)
4789 IF(ANIM_SE(4953)==1)CALL ANI_TXT('internal force y ',18)
4790 IF(ANIM_SE(4954)==1)CALL ANI_TXT('internal force z ',18)
4791 IF(ANIM_SE(4955)==1)CALL ANI_TXT('internal force xy ',18)
4792 IF(ANIM_SE(4956)==1)CALL ANI_TXT('internal force yz ',18)
4793 IF(ANIM_SE(4957)==1)CALL ANI_TXT('internal force xy ',18)
4794 IF(ANIM_SE(4958)==1)CALL ANI_TXT('internal force abs',18)
4795C
4796 IF(ANIM_SE(4959)==1)CALL ANI_TXT('ams selection',13)
4797
4798 IF(ANIM_SE(4960)==1) CALL ANI_TXT('vorticity-y',11)
4799 IF(ANIM_SE(4961)==1) CALL ANI_TXT('vorticity-z',11)
4800 IF(ANIM_SE(4962)==1) CALL ANI_TXT('vorticity',9)
4801 IF(ANIM_SE(4963)==1) CALL ANI_TXT('internal energy',15)
4802 !/ANIM/ELEM/WPLA
4803 IF(ANIM_SE(4964)==1)CALL ANI_TXT('plastic work',12)
4804 IF(ANIM_SE(4965)==1)CALL ANI_TXT('element status',14)
4805 IF(ANIM_SE(4966)==1)CALL ANI_TXT('mach number',11)
4806 IF(ANIM_SE(4967)==1)CALL ANI_TXT('color function',14)
4807 IF(ANIM_SE(4968)==1)CALL ANI_TXT('damage',6)
4808 IF(ANIM_SE(4969)==1)CALL ANI_TXT('non-local plastic strain',24)
4809 IF(ANIM_SE(4970)==1)CALL ANI_TXT('non-local plastic strain rate',29)
4810 IF(ANIM_SE(4971)==1)CALL ANI_TXT('tsai-wu criterion',17)
4811 DO I=1,200
4812 IF(ANIM_SE(4971+I)==1)THEN
4813 WRITE(MES,'(a,i3)')
4814 . 'tsai-wu crit. layer',I
4815 CALL ANI_TXT(MES,22)
4816 ENDIF
4817 ENDDO
4818 IF(ANIM_SE(5172)==1)CALL ANI_TXT('region identifier in p,v diagram',32)
4819 IF(ANIM_SE(5173)==1)CALL ANI_TXT('volumetric strain',17)
4820 IF(ANIM_SE(5174)==1)CALL ANI_TXT('volumetric strain - 1',21)
4821 IF(ANIM_SE(5175)==1)CALL ANI_TXT('volumetric strain - 2',21)
4822 IF(ANIM_SE(5176)==1)CALL ANI_TXT('volumetric strain - 3',21)
4823 IF(ANIM_SE(5177)==1)CALL ANI_TXT('volumetric strain - 4',21)
4824 IF(ANIM_SE(5178)==1)CALL ANI_TXT('volumetric strain - 5',21)
4825 IF(ANIM_SE(5179)==1)CALL ANI_TXT('volumetric strain - 6',21)
4826 IF(ANIM_SE(5180)==1)CALL ANI_TXT('volumetric strain - 7',21)
4827 IF(ANIM_SE(5181)==1)CALL ANI_TXT('volumetric strain - 8',21)
4828 IF(ANIM_SE(5182)==1)CALL ANI_TXT('volumetric strain - 9',21)
4829 IF(ANIM_SE(5183)==1)CALL ANI_TXT('volumetric strain - 10',22)
4830
4831C-----------------------------------------------
4832 ENDIF !(ISPMD==0)
4833
4834C-----------------------------------------------
4835C ELEMENT FUNC (brick)
4836C-----------------------------------------------
4837 NDMA2= NUMNOD*(MIN(1,ANIM_N(1)+OUTP_N(1)+H3D_DATA%N_SCAL_DT)
4838 . +MIN(1,ANIM_N(2)+OUTP_N(2)+H3D_DATA%N_SCAL_DMAS)
4839 . +MIN(1,ANIM_N(12)+OUTP_N(3)+H3D_DATA%N_SCAL_DINER))
4840 NNN = NUMELS+ISPH3D*(NUMSPH+MAXPJET)+3*NUMELS16+27*NUMELIG3D
4841 DO I = 1,MX_ANI
4842 IFUNC = I
4843 IF(ANIM_SE(I)==1) THEN
4844 CALL DFUNCS(
4845 1 ELBUF_TAB ,WAFT ,IFUNC ,IPARG ,GEO ,
4846 2 IXS ,MAS ,PM ,EL2FA ,NNN ,
4847 3 IPM ,IGEO ,NBPART ,EANI ,OUTPUT%DATA%SCAL_SPRING,
4848 4 IADG ,SPBUF ,IPART ,IPARTSP ,ISPH3D ,
4849 5 X ,V ,W ,ALE_CONNECTIVITY,
4850 6 NERCVOIS ,NESDVOIS ,LERCVOIS ,LESDVOIS ,BUFMAT ,
4851 7 OUTPUT%DATA%FANI_CELL ,MULTI_FVM ,MAT_PARAM ,GLOB_THERM%ITHERM)
4852 ENDIF
4853 ENDDO
4854C-----------------------------------------------
4855C 3D TENSOR TEXT
4856C-----------------------------------------------
4857 IF (ISPMD==0) THEN
4858 IF(ANIM_ST(1)==1) CALL ANI_TXT('stress',6)
4859 IF(ANIM_ST(2)==1) CALL ANI_TXT('strain',6)
4860 IF(ANIM_ST(3)==1) CALL ANI_TXT('strn rate',9)
4861 IF(ANIM_ST(4)==1) CALL ANI_TXT('damage',6)
4862 IF(ANIM_ST(5)==1) CALL ANI_TXT('plastic strain tensor',21)
4863!
4864 DO I=10,1009
4865 IF(ANIM_ST(I)==1)THEN
4866 II = I - 10
4867 WRITE(MES,'(a,i3)')
4868 . 'strs intg point',II
4869 CALL ANI_TXT(MES,20)
4870 ENDIF
4871 ENDDO
4872 DO I=1010,2009
4873 IF(ANIM_ST(I)==1)THEN
4874 II = I - 1010
4875 WRITE(MES,'(a,i3)')
4876 . 'stra intg point',II
4877 CALL ANI_TXT(MES,20)
4878 ENDIF
4879 ENDDO
4880 DO I=2010,22109
4881 IF(ANIM_ST(I)==1)THEN
4882 II = I - 2010
4883 WRITE(MES,'(a,3i3)')
4884 . 'strs in pt',ABS(II)/2010,
4885 . MOD(ABS(II)/10,201),MOD(ABS(II),10)
4886 CALL ANI_TXT(MES,20)
4887 ENDIF
4888 ENDDO
4889 DO I=22110,42209
4890 IF(ANIM_ST(I)==1)THEN
4891 II = I - 22110
4892 WRITE(MES,'(a,3i3)')
4893 . 'stra in pt',ABS(II)/2010,
4894 . MOD(ABS(II)/10,201),MOD(ABS(II),10)
4895 CALL ANI_TXT(MES,20)
4896 ENDIF
4897 ENDDO
4898!
4899 DO I=42210,43209
4900 IF(ANIM_ST(I)==1)THEN
4901 II = I - 42210
4902 WRITE(MES,'(a,i3)')
4903 . 'plastic strn intg point',II
4904 CALL ANI_TXT(MES,30)
4905 ENDIF
4906 ENDDO
4907!
4908 DO I=43210,63309
4909 IF(ANIM_ST(I)==1)THEN
4910 II = I - 43210
4911 WRITE(MES,'(a,3i3)')
4912 . 'plastic strn in pt',ABS(II)/2010,
4913 . MOD(ABS(II)/10,201),MOD(ABS(II),10)
4914 CALL ANI_TXT(MES,30)
4915 ENDIF
4916 ENDDO
4917 ENDIF
4918C-----------------------------------------------
4919C 3D TENSOR
4920C-----------------------------------------------
4921
4922 DO I = 1,MX_ANI
4923 IFUNC = I
4924 IF(ANIM_ST(I)==1)THEN
4925 CALL TENSORS(ELBUF_TAB,IPARG ,IFUNC ,IXS ,PM ,
4926 2 EL2FA ,NNN ,WAFT ,TANI ,
4927 3 NBPART ,X ,IADG ,IPART ,
4928 4 IPARTSP ,ISPH3D ,IPM ,IGEO)
4929 ENDIF
4930 ENDDO
4931C-----------------------------------------------
4932C ELEMENT MASS
4933C-----------------------------------------------
4934 IF(ANIM_M==1)THEN
4935 IF(NSPMD == 1) THEN
4936 DO I=1,NNN
4937 R4 = MAS(I)
4938 CALL WRITE_R_C(R4,1)
4939 ENDDO
4940 ELSE
4941C---- Mass stored here only if sph particles are tetra - if not it's done later
4942 DO I = 1,NNN
4943 MAS4(I) = MAS(I)
4944 ENDDO
4945 IF(ISPMD==0) THEN
4946 BUF = NUMELSG+3*NUMELS16G+NUMSPHG+27*NUMELIG3D
4947 ELSE
4948 BUF=1
4949 END IF
4950 NNNG = NUMELS+3*NUMELS16+NUMSPH+27*NUMELIG3D
4951 CALL SPMD_R4GET_PARTN(1,NNNG,NBPART,IADG,MAS4,BUF)
4952 ENDIF
4953 ENDIF
4954C-----------------------------------------------
4955C BRICK NUMBERING
4956C-----------------------------------------------
4957 CALL DELNUMBS(IPARG ,IXS ,EL2FA ,NNN ,WAFT ,
4958 . DD_IAD,IAD ,NBPART,IADG ,KXSP ,
4959 . ISPH3D )
4960C-----------------------------------------------
4961C HIERARCHY
4962C-----------------------------------------------
4963 IF (ISPMD==0) THEN
4964 DO I=1,NPART
4965 IF(MATER(I)==2)THEN
4966 IF (IPART(3,I)<NSUBS) THEN
4967 CALL WRITE_I_C(IPART(3,I)-1,1)
4968 ELSE
4969 CALL WRITE_I_C(NSUBS
4970 . +MIN(1,NSECT)+MIN(1,NRBODY+NRBE2T+NRBE3T)
4971 . +MIN(1,NRWALL)+MIN(1,NSURG+NSMAD)-1,1)
4972 END IF
4973 END IF
4974 ENDDO
4975 DO I=1,NPART
4976 IF(MATER(I)==2)CALL WRITE_I_C(IPART(1,I),1)
4977 ENDDO
4978 DO I=1,NPART
4979 IF(MATER(I)==2)CALL WRITE_I_C(IPART(2,I),1)
4980 ENDDO
4981 ENDIF
4982C=======================================================================
4983 400 CONTINUE
4984C=======================================================================
4985C
4986C POUTRE TRUSS SPRING
4987C + RBODIES
4988C
4989C=======================================================================
4990 NERBY = 0
4991 IF (NRBODY>0)
4992 . CALL DRBYCNT(NERBY,NPBY,FR_RBY2)
4993 NERBE2 = 0
4994 IF (NRBE2T>0)
4995 . CALL DRBE2CNT(NERBE2,IRBE2,LRBE2,WEIGHT)
4996 NERBE3 = 0
4997
4998 IF (NRBE3T>0)
4999 . CALL DRBE3CNT(NERBE3,IRBE3,LRBE3,WEIGHT)
5000 NB1D_T = NB1DG
5001
5002 IF(NB1DG+NRBODY+NRBE2T+NRBE3T+NANIM1D==0) GOTO 600
5003C-----------------------------------------------
5004C PART COUNT
5005C-----------------------------------------------
5006 DO I=1,NPART
5007 BUFFERP(I) = MATER(I)
5008 MATER(I) = 0
5009 ENDDO
5010C
5011 DO NG = 1, NGROUP
5012 NEL =IPARG(2,NG)
5013 NFT =IPARG(3,NG)
5014 ITY =IPARG(5,NG)
5015 IF(ITY==4)THEN
5016 DO I = 1, NEL
5017 N = I + NFT
5018 MATER(IPARTT(N))=3
5019 ENDDO
5020 ELSEIF(ITY==5)THEN
5021 DO I = 1, NEL
5022 N = I + NFT
5023 MATER(IPARTP(N))=3
5024 ENDDO
5025 ELSEIF(ITY==6)THEN
5026 DO I = 1, NEL
5027 N = I + NFT
5028 MATER(IPARTR(N))=3
5029 ENDDO
5030 ELSEIF(ITY==100)THEN
5031 DO I=1,NEL
5032 N = I+NFT
5033 IPRT=IPARTX(N)
5034 IF (NFACPTX(1,IPRT)>0) THEN
5035 MATER(IPRT)=3
5036 ELSE
5037 MATER(IPRT)=0
5038 ENDIF
5039 ENDDO
5040 ENDIF
5041 ENDDO
5042C
5043 IF(NSPMD > 1) CALL SPMD_GLOB_ISUM9(MATER,NPART)
5044 DO I=1,NPART
5045 IF(MATER(I)>3) MATER(I) = 3
5046 ENDDO
5047 IF(NSPMD > 1)CALL SPMD_IBCAST(MATER,MATER,NPART,1,0,2)
5048 DO I=1,NPART
5049 MATER(I) = MATER(I) + BUFFERP(I)
5050 ENDDO
5051C
5052 NBPART = 0
5053 DO I=1,NPART
5054 NBPART = NBPART + MATER(I)/3
5055 ENDDO
5056C
5057 DO I=1,NB1D + 1
5058 EL2FA(I)=0
5059 ENDDO
5060C-----------------------------------------------
5061C WRITE CONTROL
5062C-----------------------------------------------
5063 IF(ISPMD==0) THEN
5064 CALL WRITE_I_C(NB1D_T+NANIM1D+NERBY+NERBE2+NERBE3,1)
5065 CALL WRITE_I_C(NBPART+NRBODY+NRBE2T+NRBE3T,1)
5066 CALL WRITE_I_C(NFE_ANI,1)
5067 CALL WRITE_I_C(NFT_ANI,1)
5068C flag for skew
5069 CALL WRITE_I_C(1,1)
5070 ENDIF
5071
5072C-----------------------------------------------
5073C PART SORT
5074C-----------------------------------------------
5075 CALL PARSORF(ELBUF_TAB,
5076 . X ,D ,IAD ,CDG ,IPARG ,
5077 . IXT ,IXP ,IXR ,MATER ,EL2FA ,
5078 . DD_IAD ,IADG ,IPARTT ,IPARTP,IPARTR ,
5079 . NFACPTX,IXEDGE,NODGLOB,NB1D ,NANIM1D_L,
5080 . IPART ,IGEO ,IADG_TPR,SIADG)
5081 IF(NRBODY>0) THEN
5082C Equivalent monoproc test
5083 IF (NSPMD > 1) THEN
5084 SBUFSPM=0
5085 SBUFRECVM=0
5086 SBUFSPO=0
5087 SPORBY=0
5088
5089 DO I=1,NSPMD
5090 SBUFSPM = SBUFSPM + IAD_RBY2(1,I)
5091 SBUFRECVM = SBUFRECVM + IAD_RBY2(2,I)+1
5092 ENDDO
5093 SBUFSPM = SBUFSPM + 2*NRBYKIN
5094 SBUFRECVM = SBUFRECVM + 2*NRBYKIN*NSPMD
5095 DO I=1,NRBYKIN
5096
5097 IF ((ISPMD+1)==ABS(FR_RBY2(3,I)))
5098 . SBUFSPO = SBUFSPO + FR_RBY2(2,I)
5099 ENDDO
5100 SBUFSPO = SBUFSPO + NRBYKIN*2
5101 IF (ISPMD==0) THEN
5102 SPORBY = NERBY+NRBYKIN*2
5103 ELSE
5104 SPORBY=1
5105 ENDIF
5106 CALL SPMD_DPARRBY(NPBY,LPBY,FR_RBY2,IAD_RBY2,
5107 . SBUFSPM,SBUFRECVM,SBUFSPO,SPORBY,
5108 . NODGLOB,WEIGHT,ITAB)
5109 ELSE
5110 CALL DPARRBY(LPBY ,NPBY )
5111 ENDIF
5112 ENDIF
5113 IF(NRBE2T>0) THEN
5114 IF (NSPMD>1) THEN
5115 CALL SPMD_DPARRBE2(LRBE2, IRBE2,NODGLOB,WEIGHT,NERBE2,
5116 * NERBE2T)
5117 ELSE
5118 CALL DPARRBE2(LRBE2 ,IRBE2 )
5119 ENDIF
5120 ENDIF
5121 IF(NRBE3T>0) THEN
5122 IF (NSPMD>1) THEN
5123 CALL SPMD_DPARRBE3(LRBE3, IRBE3,NODGLOB,WEIGHT,NERBE3,
5124 * NERBE3T)
5125 ELSE
5126 CALL DPARRBE3(LRBE3 ,IRBE3 )
5127 ENDIF
5128 ENDIF
5129C-----------------------------------------------
5130C OFF
5131C-----------------------------------------------
5132 CALL ANIOFFF(ELBUF_TAB, IPARG ,WAFT,EL2FA ,
5133 . NB1D ,IAD ,NBPART,IADG,IOFFX1,
5134 . NANIM1D_L)
5135 IF (ISPMD==0) THEN
5136 DO J=1,NERBY+NERBE2+NERBE3
5137 CALL WRITE_C_C(1,1)
5138 ENDDO
5139 ENDIF
5140C-----------------------------------------------
5141C PART ADD
5142C-----------------------------------------------
5143 IF (ISPMD==0) THEN
5144 DO I = 1, NBPART
5145 BUFFERP(I) = 0
5146 DO K = 1, NSPMD
5147 BUFFERP(I) = BUFFERP(I) + IADG(K,I)
5148 ENDDO
5149 ENDDO
5150 CALL WRITE_I_C(BUFFERP,NBPART)
5151 ENDIF
5152C a gather of all RB sizes is needed on proc 0
5153 DO I=1,NRBODY
5154 NERBT(I)=0
5155 ENDDO
5156 DO I=1,NRBODY
5157 PROC=ABS(FR_RBY2(3,I))
5158 IF (PROC==LOC_PROC) THEN
5159 NERBT(I)=FR_RBY2(2,I)
5160 ENDIF
5161 ENDDO
5162 IF(NSPMD > 1) CALL SPMD_GLOB_ISUM9(NERBT,NRBODY)
5163 IF (ISPMD==0) THEN
5164 NERBY1=0
5165 NERBE2_1 = 0
5166 NERBE3_1 = 0
5167 DO IRBY=1,NRBODY
5168 CALL DONERBY(IRBY,NERBY1,NPBY,NERBT)
5169 CALL WRITE_I_C(NB1D+NANIM1D+NERBY1,1)
5170 END DO
5171 DO I=1,NRBE2T
5172 CALL DONERBE2(I,NERBE2_1,IRBE2,NERBE2T)
5173 CALL WRITE_I_C(NB1D+NANIM1D+NERBY1+NERBE2_1,1)
5174 END DO
5175 DO I=1,NRBE3T
5176 CALL DONERBE3(I,NERBE3_1,IRBE3,NERBE3T)
5177 CALL WRITE_I_C(NB1D+NANIM1D+NERBY1+NERBE2_1+NERBE3_1,1)
5178 END DO
5179C-----------------------------------------------
5180C PART HEAD
5181C-----------------------------------------------
5182
5183
5184 DO I=1,NPART
5185 IF(MATER(I)==3)THEN
5186 WRITE(STR,'(i9,a1)')IPART(4,I),':'
5187 DO J=1,10
5188 CTEXT(J)=ICHAR(STR(J:J))
5189 ENDDO
5190 IB = 10
5191
5192 CALL FRETITL2(TITL,IPART(LIPART1-LTITR+1,I),40)
5193 DO J=1,LTITL
5194 IF(TITL(J:J)/=' ') IB = J+10
5195 CTEXT(J+10)=ICHAR(TITL(J:J))
5196 END DO
5197 CTEXT(IB+1)=0
5198 CALL WRITE_C_C(CTEXT,10+LTITL)
5199
5200 ENDIF
5201 ENDDO
5202
5203 IF (INVSTR<40) THEN
5204 DO IRBY=1,NRBODY
5205 WRITE(STR,'(i9,a2,a10)') IRBY,': ','rigid body'
5206 DO J=1,21
5207 CTEXT(J)=ICHAR(STR(J:J))
5208 ENDDO
5209 IB = 21
5210 CTEXT(IB+1)=0
5211
5212 CALL WRITE_C_C(CTEXT,10+LTITL)
5213 END DO
5214 DO I=1,NRBE2T
5215 WRITE(STR,'(i9,a2,a4)') I,': ','rbe2'
5216 DO J=1,15
5217 CTEXT(J)=ICHAR(STR(J:J))
5218 ENDDO
5219 IB = 15
5220 CTEXT(IB+1)=0
5221 END DO
5222 DO I=1,NRBE3T
5223 WRITE(STR,'(i9,a2,a4)') I,': ','rbe3'
5224 DO J=1,15
5225 CTEXT(J)=ICHAR(STR(J:J))
5226 ENDDO
5227 IB = 15
5228 CTEXT(IB+1)=0
5229
5230 CALL WRITE_C_C(CTEXT,10+LTITL)
5231 END DO
5232 ELSE
5233 DO IRBY=1,NRBODY
5234 WRITE(STR,'(i9,a2)') NOM_OPT(I161+LNOPT1*(IRBY-1)),': '
5235 DO J=1,11
5236 CTEXT(J)=ICHAR(STR(J:J))
5237 ENDDO
5238
5239 CALL FRETITL2(TITL,NOM_OPT(I161+LNOPT1*(IRBY-1)
5240 & +LNOPT1-LTITR),40)
5241 IB = LTITL+10
5242 DO J=1,LTITL
5243 CTEXT(J+11)=ICHAR(TITL(J:J))
5244 END DO
5245 CTEXT(IB+1)=0
5246 CALL WRITE_C_C(CTEXT,10+LTITL)
5247 END DO
5248 DO I=1,NRBE2T
5249 WRITE(STR,'(i9,a2)') NOM_OPT(I16L+LNOPT1*(I-1)),': '
5250 DO J=1,11
5251 CTEXT(J)=ICHAR(STR(J:J))
5252 ENDDO
5253
5254 CALL FRETITL2(TITL,NOM_OPT(I16L+LNOPT1*(I-1)
5255 & +LNOPT1-LTITR),40)
5256 IB = LTITL+10
5257 DO J=1,LTITL
5258 CTEXT(J+11)=ICHAR(TITL(J:J))
5259 END DO
5260 CTEXT(IB+1)=0
5261 CALL WRITE_C_C(CTEXT,10+LTITL)
5262 END DO
5263 DO I=1,NRBE3T
5264 WRITE(STR,'(i9,a2)') NOM_OPT(I16M+LNOPT1*(I-1)),': '
5265 DO J=1,11
5266 CTEXT(J)=ICHAR(STR(J:J))
5267 ENDDO
5268
5269 CALL FRETITL2(TITL,NOM_OPT(I16M+LNOPT1*(I-1)
5270 & +LNOPT1-LTITR),40)
5271 IB = LTITL+10
5272 DO J=1,LTITL
5273 CTEXT(J+11)=ICHAR(TITL(J:J))
5274 END DO
5275 CTEXT(IB+1)=0
5276 CALL WRITE_C_C(CTEXT,10+LTITL)
5277 END DO
5278 END IF
5279 ENDIF
5280C-----------------------------------------------
5281C ELEMENT MASS FOR MAS & FUNC
5282C-----------------------------------------------
5283.OR. IF(ANIM_M==1ANIM_FE(3)==1)THEN
5284 CALL DMASANIF(ELBUF_TAB, X ,D ,GEO ,IPARG,
5285 . IXT ,IXP ,IXR ,MAS ,PM ,
5286 . EL2FA ,NB1D )
5287 ENDIF
5288C-----------------------------------------------
5289C E(truss+..) FUNC TEXT
5290C-----------------------------------------------
5291 IF (ISPMD==0) THEN
5292 IF(ANIM_FE(1)==1) CALL ANI_TXT('plastic strain',14)
5293 IF(ANIM_FE(3)==1) CALL ANI_TXT('specific energy',15)
5294 IF(anim_fe(7)==1) CALL ani_txt('Von Mises',9)
5295 IF(anim_fe(11)==1) CALL ani_txt('Damage 1',8)
5296 IF(anim_fe(12)==1) CALL ani_txt('Damage 2',8)
5297 IF(anim_fe(13)==1) CALL ani_txt('Damage 3',8)
5298 IF(anim_fe(14)==1) CALL ani_txt('Stress X ',9)
5299 IF(anim_fe(15)==1) CALL ani_txt('Stress Y ',9)
5300 IF(anim_fe(16)==1) CALL ani_txt('Stress Z ',9)
5301 IF(anim_fe(17)==1) CALL ani_txt('Stress XY',9)
5302 IF(anim_fe(18)==1) CALL ani_txt('Stress YZ',9)
5303 IF(anim_fe(19)==1) CALL ani_txt('Stress ZX',9)
5304 IF(anim_fe(20)==1) CALL ani_txt('Element Time Step',17)
5305 IF(anim_fe(21)==1) CALL ani_txt('AMS selection',13)
5306 IF(anim_fe(22)==1) CALL ani_txt('Element status',14)
5307!
5308 DO i=23,122
5309 IF (anim_fe(i) == 1) THEN
5310 ius = mod((i - 22), 100)
5311 IF (ius==0) ius = 100
5312 WRITE(mes,'(A,I3,A)') 'Plast Strn IPT ',ius, ' '
5313 CALL ani_txt(mes,21)
5314 END IF
5315 ENDDO
5316!
5317 IF (anim_fe(123)==1) CALL ani_txt('Strain X ',9)! For TRUSS element only
5318 IF (anim_fe(124)==1) CALL ani_txt('Strain rate',11)
5319 IF (anim_fe(125)==1) CALL ani_txt('Damage ',7)
5320!
5321 ENDIF
5322C-----------------------------------------------
5323C ELEMENT FUNC (truss+..)
5324C-----------------------------------------------
5325 ndma2= numnod*(min(1,anim_n(1)+outp_n(1)+h3d_data%N_SCAL_DT)
5326 . +min(1,anim_n(2)+outp_n(2)+h3d_data%N_SCAL_DMAS)
5327 . +min(1,anim_n(12)+outp_n(3)+h3d_data%N_SCAL_DINER))
5328 DO i = 1,mx_ani
5329 ifunc = i
5330 IF(anim_fe(i)==1) THEN
5331
5332 CALL dfuncf(elbuf_tab ,waft ,ifunc ,iparg ,geo ,
5333 . ixt ,ixp ,ixr ,mas ,pm ,
5334 . el2fa ,nb1d ,iad ,nbpart ,eani ,
5335 . output%DATA%SCAL_SPRING,iadg ,xfunc1 ,nanim1d_l,igeo )
5336 IF (ispmd==0) THEN
5337 r4 = 0.
5338 DO j=1,nerby+nerbe2+nerbe3
5339 CALL write_r_c(r4,1)
5340 ENDDO
5341 ENDIF
5342 ENDIF
5343 ENDDO
5344C-----------------------------------------------
5345C TORSEUR TEXT
5346C-----------------------------------------------
5347 IF (ispmd==0) THEN
5348 IF(anim_ft(1)==1) CALL ani_txt('Force & Moment ',15)
5349 ENDIF
5350C-----------------------------------------------
5351C TORSEUR
5352C-----------------------------------------------
5353 DO i = 1,mx_ani
5354 ifunc = i
5355 IF(anim_ft(i)==1)THEN
5356 CALL torseur(iadg_tpr ,iparg,ifunc ,ixt ,ixp ,
5357 . ixr ,el2fa,nb1d ,waft ,tors ,
5358 . nbpart)
5359 IF (ispmd==0) THEN
5360 r4 = 0.
5361 DO j=1,nanim1d
5362 CALL write_r_c(r4,1)
5363 CALL write_r_c(r4,1)
5364 CALL write_r_c(r4,1)
5365 CALL write_r_c(r4,1)
5366 CALL write_r_c(r4,1)
5367 CALL write_r_c(r4,1)
5368 CALL write_r_c(r4,1)
5369 CALL write_r_c(r4,1)
5370 CALL write_r_c(r4,1)
5371 ENDDO
5372 ENDIF
5373C
5374 IF (ispmd==0) THEN
5375 r4 = 0.
5376 DO j=1,nerby+nerbe2+nerbe3
5377 CALL write_r_c(r4,1)
5378 CALL write_r_c(r4,1)
5379 CALL write_r_c(r4,1)
5380 CALL write_r_c(r4,1)
5381 CALL write_r_c(r4,1)
5382 CALL write_r_c(r4,1)
5383 CALL write_r_c(r4,1)
5384 CALL write_r_c(r4,1)
5385 CALL write_r_c(r4,1)
5386 ENDDO
5387 ENDIF
5388 ENDIF
5389 ENDDO
5390C-----------------------------------------------
5391C SKEW
5392C-----------------------------------------------
5393 CALL cntskew(iparg,lrbuf,lrbufg)
5394 IF (ispmd==0) lrbuf=lrbufg
5395c LRBUF = 0
5396
5397 CALL aniskewf(geo,skew,iparg,ixr,dd_iad,lrbuf)
5398 IF (ispmd==0) THEN
5399C GLOBAL SKEW FOR X-ELEMENTS.
5400 DO i=1,nanim1d
5401 CALL write_i_c(0,1)
5402 ENDDO
5403 ENDIF
5404 IF (ispmd==0) THEN
5405 DO j=1,nerby+nerbe2+nerbe3
5406 CALL write_i_c(0,1)
5407 ENDDO
5408 ENDIF
5409C-----------------------------------------------
5410C ELEMENT MASS
5411C-----------------------------------------------
5412 IF(anim_m==1)THEN
5413 IF(nspmd == 1) THEN
5414 DO i=1,nb1d
5415 r4 = mas(i)
5416 CALL write_r_c(r4,1)
5417 ENDDO
5418 DO i=1,nanim1d
5419 r4 = xmass1(i)
5420 CALL write_r_c(r4,1)
5421 ENDDO
5422 ELSE
5423 IF (ispmd==0) THEN
5424 buf = nb1dg+nanim1d
5425 ELSE
5426 buf = 1
5427 ENDIF
5428 DO i = 1, nb1d
5429 mas4(i) = mas(i)
5430 ENDDO
5431 DO i=1,nanim1d_l
5432 mas4(nb1d+i) = xmass1(i)
5433 ENDDO
5434 CALL spmd_r4get_partn(1,nb1d+nanim1d_l,nbpart,iadg,mas4,buf)
5435 ENDIF
5436 IF (ispmd==0) THEN
5437 r4 = 0.
5438 DO j=1,nerby+nerbe2+nerbe3
5439 CALL write_r_c(r4,1)
5440 ENDDO
5441 ENDIF
5442 ENDIF
5443C-----------------------------------------------
5444C ELEMENT NUMBERING
5445C-----------------------------------------------
5446 CALL delnumbf(iparg ,ixt ,ixp ,ixr ,el2fa ,
5447 . nb1d ,waft ,dd_iad ,iad ,nbpart,
5448 . iadg ,inumx1,nanim1d_l)
5449 IF (ispmd==0) THEN
5450 DO j=1,nerby+nerbe2+nerbe3
5451 CALL write_i_c(0,1)
5452 ENDDO
5453 ENDIF
5454C-----------------------------------------------
5455C HIERARCHY
5456C-----------------------------------------------
5457 IF (ispmd==0) THEN
5458 DO i=1,npart
5459 IF(mater(i)==3)THEN
5460 IF (ipart(3,i)<nsubs) THEN
5461 CALL write_i_c(ipart(3,i)-1,1)
5462 ELSE
5463 CALL write_i_c(nsubs
5464 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5465 . +min(1,nrwall)+min(1,nsurg+nsmad)-1,1)
5466 END IF
5467 END IF
5468 ENDDO
5469clm Subset Rbodies == NSUBS
5470 DO i=1,nrbody+nrbe2t+nrbe3t
5471 CALL write_i_c(nsubs-1,1)
5472 END DO
5473 DO i=1,npart
5474 IF(mater(i)==3)CALL write_i_c(ipart(1,i),1)
5475 ENDDO
5476 DO i=1,nrbody+nrbe2t+nrbe3t
5477 CALL write_i_c(0,1)
5478 ENDDO
5479 DO i=1,npart
5480 IF(mater(i)==3)CALL write_i_c(ipart(2,i),1)
5481 ENDDO
5482 DO i=1,nrbody+nrbe2t+nrbe3t
5483 CALL write_i_c(0,1)
5484 ENDDO
5485 ENDIF
5486C=======================================================================
5487 600 CONTINUE
5488C=======================================================================
5489C
5490C HIERARCHY
5491C
5492C=======================================================================
5493 IF (ispmd==0) THEN
5494 j=0
5495 DO i=1,npart
5496 IF(mater(i)==1)THEN
5497 j=j+1
5498 mater(i)=j
5499 ELSE
5500 mater(i)=-mater(i)
5501 ENDIF
5502 ENDDO
5503 m01=j
5504 j=j+ncuts+nrwall+nsect+nsurg+nsmad+nplypartw+ncrkpartw
5505 m1=j
5506 DO i=1,npart
5507 IF(mater(i)==-2)THEN
5508 j=j+1
5509 mater(i)=j
5510 ENDIF
5511 ENDDO
5512 m2=j
5513 DO i=1,npart
5514 IF(mater(i)==-3)THEN
5515 j=j+1
5516 mater(i)=j
5517 ENDIF
5518 ENDDO
5519 m3=j+nrbody+nrbe2t+nrbe3t
5520 ENDIF
5521C-----------------------------------------------
5522C WRITE CONTROL
5523C-----------------------------------------------
5524Cplyxfem
5525 IF (anim_ply > 0)THEN
5526 nplysubs = min(1,nplypart)
5527 ELSE
5528 nplysubs= 0
5529 ENDIF
5530C xfem crack for layered shells +++
5531 IF(anim_crk > 0)THEN
5532 ncrksubs = min(1,ncrkpart)
5533 ELSE
5534 ncrksubs= 0
5535 ENDIF
5536C xfem crack for layered shells ---
5537 IF (ispmd==0) THEN
5538 CALL write_i_c(nsubs
5539 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5540 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs+ nplysubs
5541 . +ncrksubs,1)
5542 ENDIF
5543C-----------------------------------------------
5544C SUBSET HEAD/PARENT/
5545C-----------------------------------------------
5546 IF (nfvsubs > 0 .AND. nspmd > 1) CALL spmd_fvb_asub2()
5547 IF (ispmd==0) THEN
5548 IF (nsubs==1) THEN
5549C ONE SEUL SUBSET OU INPUT V31
5550 mxsubs=1
5551C-----------------
5552C SUBSET RBODIES
5553C-----------------
5554 IF (nrbody+nrbe2t+nrbe3t>0) THEN
5555 WRITE(str,'(I8,A28)')mxsubs+1,':RBODIES & RBE2 & RBE3 MODEL'
5556 DO j=1,36
5557 ctext(j)=ichar(str(j:j))
5558 ENDDO
5559 ctext(37)=0
5560 CALL write_c_c(ctext,10+ltitl)
5561C SUBSET PARENT == GLOBAL
5562 CALL write_i_c(nsubs
5563 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5564 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5565 . +nplysubs+ncrksubs-1,1)
5566C #SUBSETS FILS
5567 CALL write_i_c(0,1)
5568C SUBSETS FILS
5569C #PARTS FILLES
5570 n1=0
5571 n2=0
5572 n3=nrbody+nrbe2t+nrbe3t
5573C PARTS FILLES 2D
5574 CALL write_i_c(n1,1)
5575C PARTS FILLES 3D
5576 CALL write_i_c(n2,1)
5577C PARTS FILLES 1D
5578 CALL write_i_c(n3,1)
5579 DO j=nrbody+nrbe2t+nrbe3t,1,-1
5580 CALL write_i_c(m3-j-m2,1)
5581 ENDDO
5582 END IF
5583C-----------------
5584C SUBSET SECTIONS
5585C-----------------
5586 IF (nsect>0) THEN
5587 WRITE(str,'(I8,A15)')mxsubs
5588 . +min(1,nrbody+nrbe2t+nrbe3t)+1,':SECTIONS MODEL'
5589 DO j=1,23
5590 ctext(j)=ichar(str(j:j))
5591 ENDDO
5592 ctext(24)=0
5593 CALL write_c_c(ctext,10+ltitl)
5594C SUBSET PARENT == GLOBAL
5595 CALL write_i_c(nsubs
5596 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5597 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5598 . +nplysubs+ncrksubs-1,1)
5599C #SUBSETS FILS
5600 CALL write_i_c(0,1)
5601C SUBSETS FILS
5602C #PARTS FILLES
5603 n1=nsect
5604 n2=0
5605 n3=0
5606C PARTS FILLES 2D
5607 CALL write_i_c(n1,1)
5608 DO j=nsect,1,-1
5609 CALL write_i_c(m1-nsurg-nsmad-nrwall-nplypartw
5610 . -ncrkpartw-j,1)
5611 ENDDO
5612C PARTS FILLES 3D
5613 CALL write_i_c(n2,1)
5614C PARTS FILLES 1D
5615 CALL write_i_c(n3,1)
5616 END IF
5617C-----------------
5618C SUBSET RWALLS
5619C-----------------
5620 IF (nrwall>0) THEN
5621 WRITE(str,'(I8,A13)')mxsubs
5622 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+1,
5623 . ':RWALLS MODEL'
5624 DO j=1,21
5625 ctext(j)=ichar(str(j:j))
5626 ENDDO
5627 ctext(22)=0
5628 CALL write_c_c(ctext,10+ltitl)
5629C SUBSET PARENT == GLOBAL
5630 CALL write_i_c(nsubs
5631 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5632 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5633 . +nplysubs+ncrksubs-1,1)
5634C #SUBSETS FILS
5635 CALL write_i_c(0,1)
5636C SUBSETS FILS
5637C #PARTS FILLES
5638 n1=nrwall
5639 n2=0
5640 n3=0
5641C PARTS FILLES 2D
5642 CALL write_i_c(n1,1)
5643 DO j=nrwall,1,-1
5644 CALL write_i_c(m1-nsurg-nsmad-nplypartw
5645 . -ncrkpartw-j,1)
5646 ENDDO
5647C PARTS FILLES 3D
5648 CALL write_i_c(n2,1)
5649C PARTS FILLES 1D
5650 CALL write_i_c(n3,1)
5651 END IF
5652C-----------------
5653C SUBSET SURFACES
5654C-----------------
5655 IF (nsurg+nsmad>0) THEN
5656 WRITE(str,'(I8,A15)')mxsubs
5657 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5658 . +min(1,nrwall)+1,':SURFACES MODEL'
5659 DO j=1,23
5660 ctext(j)=ichar(str(j:j))
5661 ENDDO
5662 ctext(24)=0
5663 CALL write_c_c(ctext,10+ltitl)
5664C SUBSET PARENT == GLOBAL
5665 CALL write_i_c(nsubs
5666 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5667 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5668 . +nplysubs+ncrksubs-1,1)
5669C #SUBSETS FILS
5670 CALL write_i_c(0,1)
5671C SUBSETS FILS
5672C #PARTS FILLES
5673 n1=nsurg+nsmad
5674 n2=0
5675 n3=0
5676C PARTS FILLES 2D
5677 CALL write_i_c(n1,1)
5678 DO j=nsurg+nsmad,1,-1
5679 CALL write_i_c(m1-nplypartw-ncrkpartw-j,1)
5680 ENDDO
5681C PARTS FILLES 3D
5682 CALL write_i_c(n2,1)
5683C PARTS FILLES 1D
5684 CALL write_i_c(n3,1)
5685 END IF
5686C-----------------
5687C SUBSETS ply
5688C-----------------
5689 IF (nplysubs>0) THEN
5690 ii= mxsubs
5691 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
5692 . +min(1,nsurg+nsmad) + 1
5693 WRITE(str,'(I8,A8)')
5694 . ii,': PLIES '
5695cc WRITE(STR,'(I8,A8,I8)')
5696cc . II,':PLY ID ',I
5697 DO j=1,24
5698 ctext(j)=ichar(str(j:j))
5699 ENDDO
5700 ctext(25)=0
5701 CALL write_c_c(ctext,10+ltitl)
5702C SUBSET PARENT == GLOBAL
5703 CALL write_i_c(nsubs
5704 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5705 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs
5706 . +nfvsubs-1,1)
5707C #SUBSETS FILS
5708 CALL write_i_c(0,1)
5709C PARTS FILLES 2D
5710 n1=nplypartw
5711 n2=0
5712 n3=0
5713 CALL write_i_c(n1,1)
5714cc
5715 DO j=nplypartw,1,-1
5716 CALL write_i_c(m1-j,1)
5717 ENDDO
5718C PARTS FILLES 3D
5719 CALL write_i_c(0,1)
5720C PARTS FILLES 1D
5721 CALL write_i_c(0,1)
5722 ENDIF
5723C xfem crack sor layered shells +++
5724C-----------------
5725C SUBSETS crk
5726C-----------------
5727 IF (ncrksubs>0) THEN
5728 ii= mxsubs
5729 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
5730 . +min(1,nsurg+nsmad) + 1
5731 WRITE(str,'(I8,A9)')
5732 . ii,': CRACKS '
5733C
5734 DO j=1,17
5735 ctext(j)=ichar(str(j:j))
5736 ENDDO
5737 ctext(18)=0
5738 CALL write_c_c(ctext,10+ltitl)
5739C SUBSET PARENT == GLOBAL
5740 CALL write_i_c(nsubs
5741 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5742 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs
5743 . +nfvsubs+ncrksubs-1,1)
5744C #SUBSETS FILS
5745 CALL write_i_c(0,1)
5746C PARTS FILLES 2D
5747 n1=ncrkpartw
5748 n2=0
5749 n3=0
5750 CALL write_i_c(n1,1)
5751cc
5752 DO j=ncrkpartw,1,-1
5753 CALL write_i_c(m1-j,1)
5754 ENDDO
5755C PARTS FILLES 3D
5756 CALL write_i_c(0,1)
5757C PARTS FILLES 1D
5758 CALL write_i_c(0,1)
5759 ENDIF
5760C xfem crack sor layered shells ---
5761C-----------------
5762C SUBSETS FVMBAG
5763C-----------------
5764 IF (nfvsubs>0) THEN
5765 ii=nsubs
5766 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5767 . +min(1,nrwall)+min(1,nsurg+nsmad)+ nplysubs
5768 . +ncrksubs-1
5769 offpart=nbpart2d + nplysubs + ncrksubs
5770 DO i=1,nfvbag
5771 IF (fvdata(i)%NPOLH_ANIM>0) THEN
5772 ii=ii+1
5773 WRITE(str,'(I8,A11,I8)')
5774 . ii,':FVMBAG ID ',fvdata(i)%ID
5775 DO j=1,27
5776 ctext(j)=ichar(str(j:j))
5777 ENDDO
5778 ctext(28)=0
5779 CALL write_c_c(ctext,10+ltitl)
5780C SUBSET PARENT == GLOBAL
5781 CALL write_i_c(nsubs
5782 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5783 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5784 . +nplysubs+ncrksubs-1,1)
5785C #SUBSETS FILS
5786 CALL write_i_c(0,1)
5787C PARTS FILLES 2D
5788 CALL write_i_c(fvdata(i)%NPOLH_ANIM,1)
5789 DO j=1,fvdata(i)%NPOLH_ANIM
5790 CALL write_i_c(offpart+j-1,1)
5791 ENDDO
5792 offpart=offpart+fvdata(i)%NPOLH_ANIM
5793C PARTS FILLES 3D
5794 CALL write_i_c(0,1)
5795C PARTS FILLES 1D
5796 CALL write_i_c(0,1)
5797 ENDIF
5798 ENDDO
5799 ENDIF
5800C--------------
5801C GLOBAL MODEL
5802C--------------
5803 WRITE(str,'(I8,A13)')1,':GLOBAL MODEL'
5804 DO j=1,21
5805 ctext(j)=ichar(str(j:j))
5806 ENDDO
5807 ctext(22)=0
5808 CALL write_c_c(ctext,10+ltitl)
5809C SUBSET PARENT
5810 CALL write_i_c(-1,1)
5811C #SUBSETS FILS
5812 CALL write_i_c(min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5813 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5814 . +nplysubs+ncrksubs,1)
5815C SUBSETS FILS
5816 IF (nrbody+nrbe2t+nrbe3t>0)
5817 . CALL write_i_c(nsubs-1,1)
5818 IF (nsect>0)
5819 . CALL write_i_c(nsubs+min(1,nrbody+nrbe2t+nrbe3t)-1,1)
5820 IF (nrwall>0)
5821 . CALL write_i_c(nsubs+min(1,nsect)
5822 . +min(1,nrbody+nrbe2t+nrbe3t)-1,1)
5823 IF (nsurg+nsmad>0)
5824 . CALL write_i_c(nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+
5825 . nrbe3t)+min(1,nrwall)-1,1)
5826 IF (ispmd==0 .AND.nplysubs > 0) THEN
5827 ii=nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5828 . +min(1,nrwall)+min(1,nsurg+nsmad) - 1
5829 CALL write_i_c(ii,1)
5830 ENDIF
5831C xfem crack for layered shells +++
5832 IF (ispmd==0 .AND.ncrksubs > 0) THEN
5833 ii=nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5834 . +min(1,nrwall)+min(1,nsurg+nsmad) - 1
5835 CALL write_i_c(ii,1)
5836 ENDIF
5837C xfem crack for layered shells ---
5838 IF (ispmd==0.AND.nfvsubs>0) THEN
5839 ii=min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
5840 . +min(1,nsurg+nsmad)+1
5841 DO i=1,nfvbag
5842 ii=ii+1
5843 CALL write_i_c(ii-1,1)
5844 ENDDO
5845 ENDIF
5846C #PARTS FILLES
5847 n1=0
5848 n2=0
5849 n3=0
5850 DO k=1,npart
5851 IF(mater(k)>0.AND.mater(k)<=m01)THEN
5852 n1=n1+1
5853 ELSEIF(mater(k)>m1.AND.mater(k)<=m2)THEN
5854 n2=n2+1
5855 ELSEIF(mater(k)>m2)THEN
5856 n3=n3+1
5857 ENDIF
5858 ENDDO
5859C cuts in the global subset
5860 n1=n1+ncuts
5861C PARTS FILLES 2D
5862 CALL write_i_c(n1,1)
5863 DO k=1,npart
5864 IF(mater(k)>0.AND.mater(k)<=m01)
5865 . CALL write_i_c(mater(k)-1,1)
5866 ENDDO
5867C cuts in the global subset
5868 DO j=1,ncuts
5869 CALL write_i_c(m1-nrwall-nsect-nsurg-nsmad-nplypartw
5870 . -ncrkpartw-j,1)
5871 ENDDO
5872C PARTS FILLES 3D
5873 CALL write_i_c(n2,1)
5874 DO k=1,npart
5875 IF(mater(k)>m1.AND.mater(k)<=m2)
5876 . CALL write_i_c(mater(k)-m1-1,1)
5877 ENDDO
5878C PARTS FILLES 1D
5879 CALL write_i_c(n3,1)
5880 DO k=1,npart
5881 IF(mater(k)>m2)CALL write_i_c(mater(k)-m2-1,1)
5882 ENDDO
5883 ELSE
5884C----------------
5885C +SIEURS SUBSET ET INPUT V4.X
5886C----------------
5887 mxsubs=0
5888 DO i=1,nsubs-1
5889 IF (subset(i)%ID > mxsubs) mxsubs=subset(i)%ID
5890 WRITE(str,'(I9,A1)') subset(i)%ID,':'
5891 DO j=1,10
5892 ctext(j)=ichar(str(j:j))
5893 ENDDO
5894 ib = 10
5895 titl(1:ltitl) = subset(i)%TITLE(1:ltitl)
5896 DO j=1,ltitl
5897 IF(titl(j:j)/=' ') ib = j+10
5898 ctext(j+10)=ichar(titl(j:j))
5899 ENDDO
5900 ctext(ib+1)=0
5901 CALL write_c_c(ctext,10+ltitl)
5902C SUBSET PARENT
5903 IF (subset(i)%PARENT < nsubs) THEN
5904 CALL write_i_c(subset(i)%PARENT-1,1)
5905 ELSE
5906 CALL write_i_c(subset(i)%PARENT
5907 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5908 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5909 . +nplysubs+ncrksubs-1,1)
5910 END IF
5911C #SUBSETS FILS
5912 CALL write_i_c(subset(i)%NCHILD,1)
5913C SUBSETS FILS
5914 DO j=1,subset(i)%NCHILD
5915 CALL write_i_c(subset(i)%CHILD(j)-1,1)
5916 ENDDO
5917C #PARTS FILLES
5918 n1=0
5919 n2=0
5920 n3=0
5921 DO j=1,subset(i)%NPART
5922 k = subset(i)%PART(j)
5923 IF(mater(k)>0.AND.mater(k)<=m01)THEN
5924 n1=n1+1
5925 ELSEIF(mater(k)>m1.AND.mater(k)<=m2)THEN
5926 n2=n2+1
5927 ELSEIF(mater(k)>m2)THEN
5928 n3=n3+1
5929 ENDIF
5930 ENDDO
5931C PARTS FILLES 2D
5932 CALL write_i_c(n1,1)
5933 DO j=1,subset(i)%NPART
5934 k = subset(i)%PART(j)
5935 IF(mater(k)>0.AND.mater(k)<=m01)
5936 . CALL write_i_c(mater(k)-1,1)
5937 ENDDO
5938C PARTS FILLES 3D
5939 CALL write_i_c(n2,1)
5940 DO j=1,subset(i)%NPART
5941 k = subset(i)%PART(j)
5942 IF(mater(k)>m1.AND.mater(k)<=m2)
5943 . CALL write_i_c(mater(k)-m1-1,1)
5944 ENDDO
5945C PARTS FILLES 1D
5946 CALL write_i_c(n3,1)
5947 DO j=1,subset(i)%NPART
5948 k = subset(i)%PART(j)
5949 IF(mater(k)>m2)CALL write_i_c(mater(k)-m2-1,1)
5950 ENDDO
5951 ENDDO
5952C-----------------
5953C SUBSET RBODIES
5954C-----------------
5955 IF (nrbody+nrbe2t+nrbe3t>0) THEN
5956 WRITE(str,'(I8,A14)')mxsubs+1,':RBODIES MODEL'
5957 DO j=1,22
5958 ctext(j)=ichar(str(j:j))
5959 ENDDO
5960 ctext(23)=0
5961 CALL write_c_c(ctext,10+ltitl)
5962C SUBSET PARENT == GLOBAL
5963 CALL write_i_c(nsubs
5964 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5965 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5966 . +nplysubs+ncrksubs-1,1)
5967C #SUBSETS FILS
5968 CALL write_i_c(0,1)
5969C SUBSETS FILS
5970C #PARTS FILLES
5971 n1=0
5972 n2=0
5973 n3=nrbody+nrbe2t+nrbe3t
5974C PARTS FILLES 2D
5975 CALL write_i_c(n1,1)
5976C PARTS FILLES 3D
5977 CALL write_i_c(n2,1)
5978C PARTS FILLES 1D
5979 CALL write_i_c(n3,1)
5980 DO j=nrbody+nrbe2t+nrbe3t,1,-1
5981 CALL write_i_c(m3-j-m2,1)
5982 ENDDO
5983 END IF
5984C-----------------
5985C SUBSET SECTIONS
5986C-----------------
5987 IF (nsect>0) THEN
5988 WRITE(str,'(I8,A15)')mxsubs+min(1,nrbody+nrbe2t+nrbe3t)
5989 . +1,':SECTIONS MODEL'
5990 DO j=1,23
5991 ctext(j)=ichar(str(j:j))
5992 ENDDO
5993 ctext(24)=0
5994 CALL write_c_c(ctext,10+ltitl)
5995C SUBSET PARENT == GLOBAL
5996 CALL write_i_c(nsubs
5997 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
5998 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
5999 . +nplysubs+ncrksubs-1,1)
6000C #SUBSETS FILS
6001 CALL write_i_c(0,1)
6002C SUBSETS FILS
6003C #PARTS FILLES
6004 n1=nsect
6005 n2=0
6006 n3=0
6007C PARTS FILLES 2D
6008 CALL write_i_c(n1,1)
6009 DO j=nsect,1,-1
6010 CALL write_i_c(m1-nsurg-nsmad-nrwall-nplypartw-
6011 . ncrkpartw-j,1)
6012 ENDDO
6013C PARTS FILLES 3D
6014 CALL write_i_c(n2,1)
6015C PARTS FILLES 1D
6016 CALL write_i_c(n3,1)
6017 END IF
6018C-----------------
6019C SUBSET RWALLS
6020C-----------------
6021 IF (nrwall>0) THEN
6022 WRITE(str,'(I8,A13)')mxsubs
6023 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6024 . +1,':RWALLS MODEL'
6025 DO j=1,21
6026 ctext(j)=ichar(str(j:j))
6027 ENDDO
6028 ctext(22)=0
6029 CALL write_c_c(ctext,10+ltitl)
6030C SUBSET PARENT == GLOBAL
6031 CALL write_i_c(nsubs
6032 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6033 . +min(1,nrwall)+min(1,nsurg+nsmad)+nfvsubs
6034 . +nplysubs+ncrksubs-1,1)
6035C #SUBSETS FILS
6036 CALL write_i_c(0,1)
6037C SUBSETS FILS
6038C #PARTS FILLES
6039 n1=nrwall
6040 n2=0
6041 n3=0
6042C PARTS FILLES 2D
6043 CALL write_i_c(n1,1)
6044 DO j=nrwall,1,-1
6045 CALL write_i_c(m1-nsurg-nsmad-nplypartw
6046 . -ncrkpartw-j,1)
6047 ENDDO
6048C PARTS FILLES 3D
6049 CALL write_i_c(n2,1)
6050C PARTS FILLES 1D
6051 CALL write_i_c(n3,1)
6052 END IF
6053C-----------------
6054C SUBSET SURFACES
6055C-----------------
6056 IF (nsurg+nsmad>0) THEN
6057 WRITE(str,'(I8,A15)')mxsubs
6058 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6059 . +min(1,nrwall)+1,':SURFACES MODEL'
6060 DO j=1,23
6061 ctext(j)=ichar(str(j:j))
6062 ENDDO
6063 ctext(24)=0
6064 CALL write_c_c(ctext,10+ltitl)
6065C SUBSET PARENT == GLOBAL
6066 CALL write_i_c(nsubs
6067 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6068 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs
6069 . +nfvsubs+ncrksubs-1,1)
6070C #SUBSETS FILS
6071 CALL write_i_c(0,1)
6072C SUBSETS FILS
6073C #PARTS FILLES
6074 n1=nsurg+nsmad
6075 n2=0
6076 n3=0
6077C PARTS FILLES 2D
6078 CALL write_i_c(n1,1)
6079 DO j=nsurg+nsmad,1,-1
6080 CALL write_i_c(m1-j-nplypartw-ncrkpartw,1)
6081 ENDDO
6082C PARTS FILLES 3D
6083 CALL write_i_c(n2,1)
6084C PARTS FILLES 1D
6085 CALL write_i_c(n3,1)
6086 END IF
6087C-----------------
6088C SUBSETS PLY
6089C-----------------
6090 IF (nplysubs>0) THEN
6091 ii=mxsubs
6092 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
6093 . +min(1,nsurg+nsmad)+1
6094cc OFFPART=NBPART2D
6095 WRITE(str,'(I8,A8)')
6096 . ii,': PLIES '
6097 DO j=1,24
6098 ctext(j)=ichar(str(j:j))
6099 ENDDO
6100 ctext(25)=0
6101 CALL write_c_c(ctext,10+ltitl)
6102C SUBSET PARENT == GLOBAL
6103 CALL write_i_c(nsubs
6104 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6105 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs
6106 . +nfvsubs-1,1)
6107C #SUBSETS FILS
6108 CALL write_i_c(0,1)
6109C PARTS FILLES 2D
6110 n1=nplypartw
6111 n2=0
6112 n3=0
6113 CALL write_i_c(n1,1)
6114cc
6115 DO j=nplypartw,1,-1
6116 CALL write_i_c(m1-j,1)
6117 ENDDO
6118C PARTS FILLES 3D
6119 CALL write_i_c(0,1)
6120C PARTS FILLES 1D
6121 CALL write_i_c(0,1)
6122 ENDIF
6123C xfem crack for layered shells +++
6124C-----------------
6125C SUBSETS CRK
6126C-----------------
6127 IF (ncrksubs>0) THEN
6128 ii=mxsubs
6129 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)+min(1,nrwall)
6130 . +min(1,nsurg+nsmad)+1
6131cc OFFPART=NBPART2D
6132 WRITE(str,'(I8,A9)')
6133 . ii,': CRACKS '
6134 DO j=1,17
6135 ctext(j)=ichar(str(j:j))
6136 ENDDO
6137 ctext(18)=0
6138 CALL write_c_c(ctext,10+ltitl)
6139C SUBSET PARENT == GLOBAL
6140 CALL write_i_c(nsubs
6141 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6142 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs
6143 . +nfvsubs+ncrksubs-1,1)
6144C #SUBSETS FILS
6145 CALL write_i_c(0,1)
6146C PARTS FILLES 2D
6147 n1=ncrkpartw
6148 n2=0
6149 n3=0
6150 CALL write_i_c(n1,1)
6151c
6152 DO j=ncrkpartw,1,-1
6153 CALL write_i_c(m1-j,1)
6154 ENDDO
6155C PARTS FILLES 3D
6156 CALL write_i_c(0,1)
6157C PARTS FILLES 1D
6158 CALL write_i_c(0,1)
6159 ENDIF
6160C xfem crack for layered shells ---
6161C-----------------
6162C SUBSETS FVMBAG
6163C-----------------
6164 IF (nfvsubs>0) THEN
6165 ii=nsubs
6166 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6167 . +min(1,nrwall)+min(1,nsurg+nsmad)+ nplysubs
6168 . +ncrksubs-1
6169 offpart=nbpart2d+ nplysubs+ncrksubs
6170 DO i=1,nfvbag
6171 IF (fvdata(i)%NPOLH_ANIM>0) THEN
6172 ii=ii+1
6173 WRITE(str,'(I8,A11,I8)')
6174 . ii,':FVMBAG ID ',fvdata(i)%ID
6175 DO j=1,27
6176 ctext(j)=ichar(str(j:j))
6177 ENDDO
6178 ctext(28)=0
6179 CALL write_c_c(ctext,10+ltitl)
6180C SUBSET PARENT == GLOBAL
6181 CALL write_i_c(nsubs
6182 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6183 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs
6184 . +nfvsubs+ncrksubs-1,1)
6185C #SUBSETS FILS
6186 CALL write_i_c(0,1)
6187C PARTS FILLES 2D
6188 CALL write_i_c(fvdata(i)%NPOLH_ANIM,1)
6189 DO j=1,fvdata(i)%NPOLH_ANIM
6190 CALL write_i_c(offpart+j-1,1)
6191 ENDDO
6192 offpart=offpart+fvdata(i)%NPOLH_ANIM
6193C PARTS FILLES 3D
6194 CALL write_i_c(0,1)
6195C PARTS FILLES 1D
6196 CALL write_i_c(0,1)
6197 ENDIF
6198 ENDDO
6199 ENDIF
6200C--------------
6201C GLOBAL MODEL
6202C--------------
6203 WRITE(str,'(I9,A1)') subset(nsubs)%ID,':'
6204 DO j=1,10
6205 ctext(j)=ichar(str(j:j))
6206 ENDDO
6207 ib = 10
6208 titl(1:ltitl) = subset(i)%TITLE(1:ltitl)
6209 DO j=1,ltitl
6210 IF(titl(j:j)/=' ') ib = j+10
6211 ctext(j+10)=ichar(titl(j:j))
6212 ENDDO
6213 ctext(ib+1)=0
6214 CALL write_c_c(ctext,10+ltitl)
6215C SUBSET PARENT
6216 CALL write_i_c(subset(nsubs)%PARENT-1,1)
6217C #SUBSETS FILS
6218 CALL write_i_c(subset(nsubs)%NCHILD
6219 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6220 . +min(1,nrwall)+min(1,nsurg+nsmad)+nplysubs+nfvsubs
6221 . +ncrksubs,1)
6222C SUBSETS FILS
6223 DO j=1,subset(nsubs)%NCHILD
6224 CALL write_i_c(subset(nsubs)%CHILD(j)-1,1)
6225 ENDDO
6226 IF (nrbody+nrbe2t+nrbe3t>0)
6227 . CALL write_i_c(nsubs-1,1)
6228 IF (nsect>0)
6229 . CALL write_i_c(nsubs+min(1,nrbody+nrbe2t+nrbe3t)-1,1)
6230 IF (nrwall>0)
6231 . CALL write_i_c(nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+
6232 . nrbe3t)-1,1)
6233 IF (nsurg+nsmad>0)
6234 . CALL write_i_c(nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+
6235 . nrbe3t)+min(1,nrwall)-1,1)
6236 IF (ispmd==0.AND.nplysubs>0) THEN
6237 ii=nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6238 . +min(1,nrwall)+min(1,nsurg+nsmad) - 1
6239 CALL write_i_c(ii,1)
6240 ENDIF
6241C xfem crack for layered shells +++
6242 IF (ispmd==0.AND.ncrksubs>0) THEN
6243 ii=nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6244 . +min(1,nrwall)+min(1,nsurg+nsmad) - 1
6245 CALL write_i_c(ii,1)
6246 ENDIF
6247C xfem crack for layered shells ---
6248 IF (ispmd==0.AND.nfvsubs>0) THEN
6249 ii=nsubs+min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6250 . +min(1,nrwall)+min(1,nsurg+nsmad)
6251 DO i=1,nfvbag
6252 CALL write_i_c(ii-1,1)
6253 ii=ii+1
6254 ENDDO
6255 ENDIF
6256C #PARTS FILLES
6257 n1=0
6258 n2=0
6259 n3=0
6260 DO j=1,subset(i)%NPART
6261 k = subset(i)%PART(j)
6262 IF(mater(k)>0.AND.mater(k)<=m01)THEN
6263 n1=n1+1
6264 ELSEIF(mater(k)>m1.AND.mater(k)<=m2)THEN
6265 n2=n2+1
6266 ELSEIF(mater(k)>m2)THEN
6267 n3=n3+1
6268 ENDIF
6269 ENDDO
6270C cuts in the global subset
6271 n1=n1+ncuts
6272C PARTS FILLES 2D
6273 CALL write_i_c(n1,1)
6274 DO j=1,subset(i)%NPART
6275 k = subset(i)%PART(j)
6276 IF(mater(k)>0.AND.mater(k)<=m01)
6277 . CALL write_i_c(mater(k)-1,1)
6278 ENDDO
6279C cuts in the global subset
6280 DO j=1,ncuts
6281 CALL write_i_c(m1-nrwall-nsect-nsurg-nsmad-nplypartw-
6282 . ncrkpartw-j,1)
6283 ENDDO
6284C PARTS FILLES 3D
6285 CALL write_i_c(n2,1)
6286 DO j=1,subset(i)%NPART
6287 k = subset(i)%PART(j)
6288 IF(mater(k)>m1.AND.mater(k)<=m2)
6289 . CALL write_i_c(mater(k)-m1-1,1)
6290 ENDDO
6291C PARTS FILLES 1D
6292 CALL write_i_c(n3,1)
6293 DO j=1,subset(i)%NPART
6294 k = subset(i)%PART(j)
6295 IF(mater(k)>m2)CALL write_i_c(mater(k)-m2-1,1)
6296 ENDDO
6297 ENDIF
6298 ENDIF
6299C-----------------------------------------------
6300C WRITE CONTROL
6301C-----------------------------------------------
6302 IF (ispmd==0) THEN
6303 CALL write_i_c(nummat+1,1)
6304 CALL write_i_c(numgeo+1,1)
6305 ENDIF
6306C-----------------------------------------------
6307C MAT HEAD
6308C-----------------------------------------------
6309 IF (ispmd==0) THEN
6310 CALL ani_txt50('Dummy Material',14)
6311 DO i=1,nummat
6312 WRITE(str,'(I9,A1)') ipm(1,i),':'
6313 DO j=1,10
6314 ctext(j)=ichar(str(j:j))
6315 ENDDO
6316 ib = 10
6317 CALL fretitl2(titl,ipm(npropmi-ltitr+1,i),40)
6318 DO j=1,ltitl
6319 IF(titl(j:j)/=' ') ib = j+10
6320 ctext(j+10)=ichar(titl(j:j))
6321 ENDDO
6322 ctext(ib+1)=0
6323 CALL write_c_c(ctext,10+ltitl)
6324 ENDDO
6325 ENDIF
6326C-----------------------------------------------
6327C MAT TYPE
6328C-----------------------------------------------
6329 IF (ispmd==0) THEN
6330 CALL write_i_c(0,1)
6331 DO i=1,nummat
6332 CALL write_i_c(nint(pm(19,i)),1)
6333 ENDDO
6334 ENDIF
6335C-----------------------------------------------
6336C PROP HEAD
6337C-----------------------------------------------
6338 IF (ispmd==0) THEN
6339 CALL ani_txt50('Dummy Property',14)
6340 DO i=1,numgeo
6341 WRITE(str,'(I9,A1)') igeo(1,i),':'
6342 DO j=1,10
6343 ctext(j)=ichar(str(j:j))
6344 ENDDO
6345 ib = 10
6346 CALL fretitl2(titl,igeo(npropgi-ltitr+1,i),40)
6347 DO j=1,ltitl
6348 IF(titl(j:j)/=' ') ib = j+10
6349 ctext(j+10)=ichar(titl(j:j))
6350 ENDDO
6351 ctext(ib+1)=0
6352 CALL write_c_c(ctext,10+ltitl)
6353 ENDDO
6354 ENDIF
6355C-----------------------------------------------
6356C PROP TYPE
6357C-----------------------------------------------
6358 IF (ispmd==0) THEN
6359 CALL write_i_c(0,1)
6360 DO i=1,numgeo
6361 CALL write_i_c(nint(geo(12,i)),1)
6362 ENDDO
6363 ENDIF
6364C=======================================================================
6365C
6366C Additional particles description, case of /ANIM/VERS/44 only.
6367C
6368C=======================================================================
6369 IF(isph3d==1.OR.numsph_t+maxpjet==0) GOTO 700
6370C-----------------------------------------------
6371C PREPARE Subset outings: Part girls meshless
6372C-----------------------------------------------
6373 IF (ispmd==0) THEN
6374 DO i=1,npart
6375 mater(i)=-mater(i)
6376 ENDDO
6377 ENDIF
6378C-----------------------------------------------
6379C PART COUNT
6380C-----------------------------------------------
6381 DO i=1,npart
6382 bufferp(i) = mater(i)
6383 mater(i) = 0
6384 ENDDO
6385
6386 DO ng = 1, ngroup
6387 nel =iparg(2,ng)
6388 nft =iparg(3,ng)
6389 ity =iparg(5,ng)
6390 IF(ity==51)THEN
6391 DO i = 1, nel
6392 n = i + nft
6393 mater(ipartsp(n))=4
6394 ENDDO
6395 ENDIF
6396 ENDDO
6397 IF(nspmd > 1) CALL spmd_glob_isum9(mater,npart)
6398 DO i=1,npart
6399 IF(mater(i)>4) mater(i) = 4
6400 ENDDO
6401 IF(nspmd > 1) CALL spmd_ibcast(mater,mater,npart,1,0,2)
6402 DO i=1,npart
6403 mater(i) = mater(i)+bufferp(i)
6404 ENDDO
6405C
6406 nbpart = 0
6407 DO i=1,npart
6408 IF(mater(i)==4)nbpart = nbpart + 1
6409 ENDDO
6410C-----------------------------------------------
6411C WRITE CONTROL
6412C-----------------------------------------------
6413 IF (ispmd==0) THEN
6414 CALL write_i_c(numsphg+maxpjet,1)
6415 CALL write_i_c(nbpart,1)
6416 CALL write_i_c(nse_ani+2,1)
6417 CALL write_i_c(nst_ani,1)
6418 ENDIF
6419C-----------------------------------------------
6420C PART SORT
6421C-----------------------------------------------
6422 CALL parsor0(iad ,iparg ,mater ,el2fa ,
6423 2 dd_iad ,iadg ,
6424 3 kxsp ,ipartsp ,nodglob)
6425C-----------------------------------------------
6426C OFF SPH
6427C-----------------------------------------------
6428 nnn = numsph+maxpjet
6429 CALL anioff0(elbuf_tab ,iparg ,waft ,el2fa ,
6430 . nnn ,nbpart ,iadg ,swaft,sph2sol)
6431C-----------------------------------------------
6432C PART ADD
6433C-----------------------------------------------
6434 IF (ispmd==0) THEN
6435 DO i = 1, nbpart
6436 bufferp(i) = 0
6437 DO k = 1, nspmd
6438 bufferp(i) = bufferp(i) + iadg(k,i)
6439 ENDDO
6440 ENDDO
6441 CALL write_i_c(bufferp,nbpart)
6442 ENDIF
6443C-----------------------------------------------
6444C PART HEAD
6445C-----------------------------------------------
6446 IF (ispmd==0) THEN
6447 DO i=1,npart
6448 IF(mater(i)==4)THEN
6449 WRITE(str,'(I9,A1)')ipart(4,i),':'
6450 DO j=1,10
6451 ctext(j)=ichar(str(j:j))
6452 ENDDO
6453 ib = 10
6454 CALL fretitl2(titl,ipart(lipart1-ltitr+1,i),40)
6455 DO j=1,ltitl
6456 IF(titl(j:j)/=' ') ib = j+10
6457 ctext(j+10)=ichar(titl(j:j))
6458 ENDDO
6459 ctext(ib+1)=0
6460 CALL write_c_c(ctext,10+ltitl)
6461 ENDIF
6462 ENDDO
6463 ENDIF
6464C-----------------------------------------------
6465C ELEMENT MASS FOR MAS & FUNC
6466C-----------------------------------------------
6467 IF(anim_m==1.OR.anim_se(3)==1.OR.
6468 . anim_se(25)==1)THEN
6469 CALL dmasani0(x ,d ,elbuf_tab,geo ,iparg ,
6470 2 mas ,pm ,el2fa ,ipart ,ipartsp )
6471 ENDIF
6472C-----------------------------------------------
6473C FUNC TEXT
6474C-----------------------------------------------
6475 IF (ispmd==0) THEN
6476 ctext(81)=0
6477C diameter and nb of neighbours are compulsory.
6478 CALL ani_txt('Diameter',8)
6479 CALL ani_txt('Number of neighbours',20)
6480C
6481 IF(anim_se(1)==1) CALL ani_txt('Plastic Strain',14)
6482 IF(anim_se(2)==1) CALL ani_txt('Density',7)
6483 IF(anim_se(3)==1) CALL ani_txt('Specific Energy',15)
6484 IF(anim_se(4)==1) CALL ani_txt('Temperature',11)
6485 IF(anim_se(6)==1) CALL ani_txt('Pressure',8)
6486 IF(anim_se(7)==1) CALL ani_txt('Von Mises',9)
6487 IF(anim_se(8)==1) CALL ani_txt('Turbulent Energy',16)
6488 IF(anim_se(9)==1) CALL ani_txt('Turbulent Viscosity',19)
6489 IF(anim_se(10)==1) CALL ani_txt('Vorticity',9)
6490 IF(anim_se(11)==1) CALL ani_txt('Damage 1',8)
6491 IF(anim_se(12)==1) CALL ani_txt('Damage 2',8)
6492 IF(anim_se(13)==1) CALL ani_txt('Damage 3',8)
6493 IF(anim_se(14)==1) CALL ani_txt('Stress X ',9)
6494 IF(anim_se(15)==1) CALL ani_txt('Stress Y ',9)
6495 IF(anim_se(16)==1) CALL ani_txt('Stress Z ',9)
6496 IF(anim_se(17)==1) CALL ani_txt('Stress XY',9)
6497 IF(anim_se(18)==1) CALL ani_txt('Stress YZ',9)
6498 IF(anim_se(19)==1) CALL ani_txt('Stress ZX',9)
6499 IF(anim_se(20)==1) CALL ani_txt('User Var 1',10)
6500 IF(anim_se(21)==1) CALL ani_txt('User Var 2',10)
6501 IF(anim_se(22)==1) CALL ani_txt('User Var 3',10)
6502 IF(anim_se(23)==1) CALL ani_txt('User Var 4',10)
6503 IF(anim_se(24)==1) CALL ani_txt('User Var 5',10)
6504 IF(anim_se(25)==1) CALL ani_txt('Hourglass Energy per unit mass',30)
6505 IF(anim_se(26)==1) CALL ani_txt('Strain Rate',11)
6506 IF(anim_se(27)==1) CALL ani_txt('User Var 6',10)
6507 IF(anim_se(28)==1) CALL ani_txt('User Var 7',10)
6508 IF(anim_se(29)==1) CALL ani_txt('User Var 8',10)
6509 IF(anim_se(30)==1) CALL ani_txt('User Var 9',10)
6510 IF(anim_se(31)==1) CALL ani_txt('User Var 10',11)
6511 IF(anim_se(32)==1) CALL ani_txt('User Var 11',11)
6512 IF(anim_se(33)==1) CALL ani_txt('User Var 12',11)
6513 IF(anim_se(34)==1) CALL ani_txt('User Var 13',11)
6514 IF(anim_se(35)==1) CALL ani_txt('User Var 14',11)
6515 IF(anim_se(36)==1) CALL ani_txt('User Var 15',11)
6516 IF(anim_se(37)==1) CALL ani_txt('User Var 16',11)
6517 IF(anim_se(38)==1) CALL ani_txt('User Var 17',11)
6518 IF(anim_se(39)==1) CALL ani_txt('User Var 18',11)
6519 IF(anim_se(40)==1) CALL ani_txt('User Var 19',11)
6520 IF(anim_se(41)==1) CALL ani_txt('User Var 20',11)
6521 IF(anim_se(42)==1) CALL ani_txt('User Var 21',11)
6522 IF(anim_se(43)==1) CALL ani_txt('User Var 22',11)
6523 IF(anim_se(44)==1) CALL ani_txt('User Var 23',11)
6524 IF(anim_se(45)==1) CALL ani_txt('User Var 24',11)
6525 IF(anim_se(46)==1) CALL ani_txt('User Var 25',11)
6526 IF(anim_se(47)==1) CALL ani_txt('User Var 26',11)
6527 IF(anim_se(48)==1) CALL ani_txt('User Var 27',11)
6528 IF(anim_se(49)==1) CALL ani_txt('User Var 28',11)
6529 IF(anim_se(50)==1) CALL ani_txt('User Var 29',11)
6530 IF(anim_se(51)==1) CALL ani_txt('User Var 30',11)
6531 IF(anim_se(52)==1) CALL ani_txt('User Var 31',11)
6532 IF(anim_se(53)==1) CALL ani_txt('User Var 32',11)
6533 IF(anim_se(54)==1) CALL ani_txt('User Var 33',11)
6534 IF(anim_se(55)==1) CALL ani_txt('User Var 34',11)
6535 IF(anim_se(56)==1) CALL ani_txt('User Var 35',11)
6536 IF(anim_se(57)==1) CALL ani_txt('User Var 36',11)
6537 IF(anim_se(58)==1) CALL ani_txt('User Var 37',11)
6538 IF(anim_se(59)==1) CALL ani_txt('User Var 38',11)
6539 IF(anim_se(60)==1) CALL ani_txt('User Var 39',11)
6540 IF(anim_se(61)==1) CALL ani_txt('User Var 40',11)
6541 IF(anim_se(62)==1) CALL ani_txt('User Var 41',11)
6542 IF(anim_se(63)==1) CALL ani_txt('User Var 42',11)
6543 IF(anim_se(64)==1) CALL ani_txt('User Var 43',11)
6544 IF(anim_se(65)==1) CALL ani_txt('User Var 44',11)
6545 IF(anim_se(66)==1) CALL ani_txt('User Var 45',11)
6546 IF(anim_se(67)==1) CALL ani_txt('User Var 46',11)
6547 IF(anim_se(68)==1) CALL ani_txt('User Var 47',11)
6548 IF(anim_se(69)==1) CALL ani_txt('User Var 48',11)
6549 IF(anim_se(70)==1) CALL ani_txt('User Var 49',11)
6550 IF(anim_se(71)==1) CALL ani_txt('User Var 50',11)
6551 IF(anim_se(72)==1) CALL ani_txt('User Var 51',11)
6552 IF(anim_se(73)==1) CALL ani_txt('User Var 52',11)
6553 IF(anim_se(74)==1) CALL ani_txt('User Var 53',11)
6554 IF(anim_se(75)==1) CALL ani_txt('User Var 54',11)
6555 IF(anim_se(76)==1) CALL ani_txt('User Var 55',11)
6556 IF(anim_se(77)==1) CALL ani_txt('User Var 56',11)
6557 IF(anim_se(78)==1) CALL ani_txt('User Var 57',11)
6558 IF(anim_se(79)==1) CALL ani_txt('User Var 58',11)
6559 IF(anim_se(80)==1) CALL ani_txt('User Var 59',11)
6560 IF(anim_se(81)==1) CALL ani_txt('User Var 60',11)
6561 DO i=82,281
6562 IF(anim_se(i)==1)THEN
6563 ii = i - 81
6564 WRITE(mes,'(A,I3)')
6565 . 'WPLA layer',ii
6566 CALL ani_txt(mes,20)
6567 ENDIF
6568 ENDDO
6569 DO i=1,200
6570 IF(anim_se(286+3*(i-1)+1)==1)THEN
6571 WRITE(mes,'(A,I3,A)')'Psi (layer',i,')'
6572 CALL ani_txt(mes,15)
6573 ENDIF
6574 IF(anim_se(286+3*(i-1)+2)==1)THEN
6575 WRITE(mes,'(A,I3,A)')'Teta (layer',i,')'
6576 CALL ani_txt(mes,16)
6577 ENDIF
6578 IF(anim_se(286+3*(i-1)+3)==1)THEN
6579 WRITE(mes,'(A,I3,A)')'Phi (layer',i,')'
6580 CALL ani_txt(mes,15)
6581 ENDIF
6582 ENDDO
6583 IF(anim_se(3890)==1) CALL ani_txt('MAX DAMAGE ELEMENT',18)
6584 IF(anim_se(4893)==1) CALL ani_txt('Domain',6)
6585 IF(anim_se(4937)==1) CALL ani_txt('Element Time Step',17)
6586 IF(anim_se(4959)==1) CALL ani_txt('AMS selection',13)
6587 IF(anim_se(4965)==1) CALL ani_txt('Element status',14)
6588 IF(anim_se(4895)==1) CALL ani_txt('Equiv stress',12)
6589 IF(anim_se(5172)==1) CALL ani_txt('Region identifier in p,v diagram',32)
6590 IF(anim_se(5173)==1) CALL ani_txt('Volumetric Strain',17)
6591 ENDIF
6592C-----------------------------------------------
6593C ELEMENT FUNC (SPH)
6594C-----------------------------------------------
6595 nnn = numsph+maxpjet
6596C
6597C Default output for SPH - diameter + nb of neignbours
6598 DO i = 1,2
6599 ifunc = 0
6600 default_output = i
6601 CALL dfunc0(elbuf_tab ,waft ,ifunc ,iparg ,
6602 2 mas ,pm ,el2fa ,nnn ,
6603 3 nbpart ,iadg ,spbuf ,ipart ,
6604 4 ipartsp ,ale_connectivity,ipm ,
6605 5 x ,v ,w ,glob_therm%ITHERM,
6606 6 nercvois ,nesdvois ,lercvois ,lesdvois,
6607 7 bufmat ,multi_fvm ,kxsp ,default_output,
6608 8 mat_param)
6609 ENDDO
6610C
6611C other output for SPH
6612 DO i = 1,mx_ani
6613 ifunc = i
6614 default_output = 0
6615 IF(anim_se(i) == 1) THEN
6616 CALL dfunc0(elbuf_tab ,waft ,ifunc ,iparg ,
6617 2 mas ,pm ,el2fa ,nnn ,
6618 3 nbpart ,iadg ,spbuf ,ipart ,
6619 4 ipartsp ,ale_connectivity,ipm ,
6620 5 x ,v ,w ,glob_therm%ITHERM,
6621 6 nercvois ,nesdvois ,lercvois ,lesdvois,
6622 7 bufmat ,multi_fvm ,kxsp ,default_output,
6623 8 mat_param)
6624 ENDIF
6625 ENDDO
6626C-----------------------------------------------
6627C 3D TENSOR TEXT
6628C-----------------------------------------------
6629 IF (ispmd==0) THEN
6630 IF(anim_st(1)==1) CALL ani_txt('Stress',6)
6631 IF(anim_st(2)==1) CALL ani_txt('Strain',6)
6632 IF(anim_st(3)==1) CALL ani_txt('Strn rate',9)
6633 IF(anim_st(4)==1) CALL ani_txt('Damage',6)
6634 IF(anim_st(5)==1) CALL ani_txt('Plastic Strain Tensor',21)
6635!
6636 DO i=10,1009
6637 IF(anim_st(i)==1)THEN
6638 ii = i - 10
6639 WRITE(mes,'(A,I3)')
6640 . 'Strs Intg Point',ii
6641 CALL ani_txt(mes,20)
6642 ENDIF
6643 ENDDO
6644 DO i=1010,2009
6645 IF(anim_st(i)==1)THEN
6646 ii = i - 1010
6647 WRITE(mes,'(A,I3)')
6648 . 'Stra Intg Point',ii
6649 CALL ani_txt(mes,20)
6650 ENDIF
6651 ENDDO
6652 DO i=2010,22109
6653 IF(anim_st(i)==1)THEN
6654 ii = i - 2010
6655 WRITE(mes,'(A,3I3)')
6656 . 'Strs In Pt',abs(ii)/2010,
6657 . mod(abs(ii)/10,201),mod(abs(ii),10)
6658 CALL ani_txt(mes,20)
6659 ENDIF
6660 ENDDO
6661 DO i=22110,42209
6662 IF(anim_st(i)==1)THEN
6663 ii = i - 22110
6664 WRITE(mes,'(A,3I3)')
6665 . 'Stra In Pt',abs(ii)/2010,
6666 . mod(abs(ii)/10,201),mod(abs(ii),10)
6667 CALL ani_txt(mes,20)
6668 ENDIF
6669 ENDDO
6670!
6671 DO i=42210,43209
6672 IF(anim_st(i)==1)THEN
6673 ii = i - 42210
6674 WRITE(mes,'(A,I3)')
6675 . 'Plastic Strn Intg Point',ii
6676 CALL ani_txt(mes,30)
6677 ENDIF
6678 ENDDO
6679!
6680 DO i=43210,63309
6681 IF(anim_st(i)==1)THEN
6682 ii = i - 43210
6683 WRITE(mes,'(A,3I3)')
6684 . 'Plastic Strn In Pt',abs(ii)/2010,
6685 . mod(abs(ii)/10,201),mod(abs(ii),10)
6686 CALL ani_txt(mes,30)
6687 ENDIF
6688 ENDDO
6689 ENDIF
6690C-----------------------------------------------
6691C 3D TENSOR (SPH)
6692C-----------------------------------------------
6693 DO i = 1,mx_ani
6694 ifunc = i
6695 IF(anim_st(i)==1)THEN
6696 CALL tensor0(elbuf_tab,iparg ,ifunc ,pm ,el2fa ,
6697 2 nnn ,waft ,tani ,iad ,
6698 3 nbpart ,x ,iadg ,ipart ,ipartsp ,
6699 4 ipm )
6700 ENDIF
6701 ENDDO
6702C-----------------------------------------------
6703C ELEMENT MASS (SPH)
6704C-----------------------------------------------
6705 IF(anim_m==1)THEN
6706 IF(nspmd == 1) THEN
6707 DO i=1,nnn
6708 r4 = mas(i)
6709 CALL write_r_c(r4,1)
6710 ENDDO
6711 ELSE
6712 DO i = 1,nnn
6713 mas4(i) = mas(i)
6714 ENDDO
6715 IF(ispmd==0) THEN
6716 buf = numsphg
6717 ELSE
6718 buf=1
6719 END IF
6720 CALL spmd_r4get_partn(1,nnn,nbpart,iadg,mas4,buf)
6721 ENDIF
6722 ENDIF
6723C-----------------------------------------------
6724C NUMBERING (SPH)
6725C-----------------------------------------------
6726 CALL delnumb0(iparg ,el2fa ,nnn ,waft ,dd_iad,
6727 . iad ,nbpart,iadg ,kxsp )
6728C-----------------------------------------------
6729C HIERARCHY
6730C-----------------------------------------------
6731 IF (ispmd==0) THEN
6732 DO i=1,npart
6733 IF(mater(i)==4)THEN
6734 IF (ipart(3,i)<nsubs) THEN
6735 CALL write_i_c(ipart(3,i)-1,1)
6736 ELSE
6737 CALL write_i_c(nsubs
6738 . +min(1,nsect)+min(1,nrbody+nrbe2t+nrbe3t)
6739 . +min(1,nrwall)+min(1,nsurg+nsmad)-1,1)
6740 END IF
6741 END IF
6742 ENDDO
6743 DO i=1,npart
6744 IF(mater(i)==4)CALL write_i_c(ipart(1,i),1)
6745 ENDDO
6746 DO i=1,npart
6747 IF(mater(i)==4)CALL write_i_c(ipart(2,i),1)
6748 ENDDO
6749 ENDIF
6750C-----------------------------------------------
6751C SUBSET : PART FILLES MESHLESS
6752C-----------------------------------------------
6753 IF (ispmd==0) THEN
6754 j=m3
6755 DO i=1,npart
6756 IF(mater(i)==4)THEN
6757 j=j+1
6758 mater(i)=j
6759 ENDIF
6760 ENDDO
6761 m4=j
6762 IF (nsubs==1) THEN
6763C #PARTS FILLES meshless
6764 n0=0
6765 DO k=1,npart
6766 IF(mater(k)>m3)THEN
6767 n0=n0+1
6768 ENDIF
6769 ENDDO
6770C PARTS FILLES meshless
6771 CALL write_i_c(n0,1)
6772 DO k=1,npart
6773 IF(mater(k)>m3)
6774 . CALL write_i_c(mater(k)-m3-1,1)
6775 ENDDO
6776 ELSE
6777C----------------
6778C +SIEURS SUBSET
6779C----------------
6780 DO i=1,nsubs-1
6781C #PARTS FILLES meshless
6782 n0=0
6783 DO j=1,subset(i)%NPART
6784 k = subset(i)%PART(j)
6785 IF(mater(k)>m3)THEN
6786 n0=n0+1
6787 ENDIF
6788 ENDDO
6789C PARTS FILLES meshless
6790 CALL write_i_c(n0,1)
6791 DO j=1,subset(i)%NPART
6792 k = subset(i)%PART(j)
6793 IF(mater(k)>m3)
6794 . CALL write_i_c(mater(k)-m3-1,1)
6795 ENDDO
6796 ENDDO
6797C--------------
6798C GLOBAL MODEL
6799C--------------
6800C #PARTS FILLES meshless
6801 n0=0
6802 DO j=1,subset(i)%NPART
6803 k = subset(i)%PART(j)
6804 IF(mater(k)>m3)THEN
6805 n0=n0+1
6806 ENDIF
6807 ENDDO
6808C PARTS FILLES meshless
6809 CALL write_i_c(n0,1)
6810 DO j=1,subset(i)%NPART
6811 k = subset(i)%PART(j)
6812 IF(mater(k)>m3)
6813 . CALL write_i_c(mater(k)-m3-1,1)
6814 ENDDO
6815 ENDIF
6816C--------------
6817 DO i=1,npart
6818 IF(mater(i)<0)mater(i)=-mater(i)
6819 ENDDO
6820 ENDIF
6821C=======================================================================
6822 700 CONTINUE
6823C=======================================================================
6824 IF (ispmd==0) THEN
6825
6826 CALL file_size(animsize)
6827 CALL close_c()
6828
6829 IF (output%checksum%checksum_count > 0) THEN
6830 CALL compute_binary_checksum(output%checksum%files_checksum,c_loc(tmp_name),len_tmp_name,izip)
6831 ENDIF
6832
6833 animtotalsize=animtotalsize+animsize
6834C-----------------------------------------------
6835 WRITE (iout,1000) filnam(1:filen)
6836 WRITE (istdo,1000) filnam(1:filen)
6837 1000 FORMAT (4x,' ANIMATION FILE:',1x,a,' WRITTEN')
6838 ENDIF
6839C
6840 IF(anim_ply > 0) THEN
6841 DEALLOCATE(waft_ply)
6842 DEALLOCATE(el2fa_ply)
6843 DEALLOCATE(iad_plyg)
6844 ENDIF
6845 IF(anim_crk > 0) THEN
6846 DEALLOCATE(el2fa_crk)
6847 DEALLOCATE(iad_crkg)
6848 DEALLOCATE(iad_crk)
6849 DEALLOCATE(iad_lay)
6850 DEALLOCATE(waft_crk)
6851 ENDIF
6852
6853 DEALLOCATE(waft,mas,xnorm,xmass1,xmass2,xmass3,
6854 . xfunc1,xfunc2,xfunc3,xusr)
6855
6856 DEALLOCATE(wa4,mas4)
6857 DEALLOCATE(wa4_fvm)
6858
6859 DEALLOCATE(vflu,vvar1,aflu,vflu_ale,fanreact,fanreacr)
6860
6861 DEALLOCATE(wgps,vgps,itagps)
6862 DEALLOCATE(is_written_node)
6863 DEALLOCATE(iad)
6864 DEALLOCATE(invert)
6865 DEALLOCATE(mater)
6866 DEALLOCATE(el2fa)
6867 DEALLOCATE(iadg)
6868 DEALLOCATE(iadg_tpr)
6869 DEALLOCATE(nfshsz)
6870 DEALLOCATE(nfnodsz)
6871 DEALLOCATE(uix)
6872 DEALLOCATE(nfacptx)
6873 DEALLOCATE(ixedge)
6874 DEALLOCATE(ixfacet)
6875 DEALLOCATE(ixsolid)
6876 DEALLOCATE(inumx1)
6877 DEALLOCATE(inumx2)
6878 DEALLOCATE(inumx3)
6879 DEALLOCATE(ioffx1)
6880 DEALLOCATE(ioffx2)
6881 DEALLOCATE(ioffx3)
6882 DEALLOCATE(ig3dsolid)
6883c-----------
6884 RETURN
6885 END SUBROUTINE genani
anioffs
subroutine anioffs(elbuf_tab, iparg, ioff, el2fa, nbf, nbpart, isph3d)
Definition anioffs.F:32
compute_binary_checksum
void compute_binary_checksum(checksum *cs_output_files, char *file, int len, int izip)
Definition checksum.cpp:78
cutfunc
subroutine cutfunc(func, ivois, al, nodcut)
Definition cutfunc.F:31
cutfunce
subroutine cutfunce(nc, numel, elbuf_tab, ifunc, iparg, pm, ixs)
Definition cutfunce.F:37
cutmain
subroutine cutmain(icut, xcut, ixs, xyz0, d, nodcut, nelcut, icbuf, cbuf, len, nbf)
Definition cutmain.F:34
cutmass
subroutine cutmass(nc, x, al, nodcut, nelcut, vel, v, ivois)
Definition cutmass.F:31
delnumbc_crk
subroutine delnumbc_crk(iparg, iel_crk, inum, idcmax, el2fa, iad_crkg, nbf_l, nbf, indx_crk)
Definition delnumbc_crk.F:36
delnumbc_ply
subroutine delnumbc_ply(iply, nel_ply, iparg, ixc, ixtg, invert, el2fa, nbf, inum, nelcut, dd_iad, iadd, nbf_l, nbpart, iadg, nodglob, idcmax, nbf_pxfemg)
Definition delnumbc_ply.F:41
dfuncc_crk
subroutine dfuncc_crk(elbuf_tab, len, ifunc, iparg, geo, ixc, ixtg, mass, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, xfem_tab, iel_crk, indx_crk, nbf_crkxfemg, el2fa0, crkedge)
Definition dfuncc_crk.F:45
dfuncc_ply
subroutine dfuncc_ply(elbuf_tab, func, ifunc, iparg, geo, ixc, ixtg, mass, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, mat_param, nbf_pxfemg, x, stack)
Definition dfuncc_ply.F:47
dmasanis
subroutine dmasanis(elbuf_tab, iparg, ixs, mas, pm, el2fa, nbf, ipart, ipartsp, isph3d)
Definition dmasanis.F:34
cntskew
subroutine cntskew(iparg, cnt, cntg)
Definition aniskewf.F:174
dfungps2
subroutine dfungps2(elbuf_tab, func, ifunc, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, vgps)
Definition dfuncf.F:798
dfungps1
subroutine dfungps1(elbuf_tab, func, ifunc, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, itagps)
Definition dfuncf.F:526
tencgps2
subroutine tencgps2(elbuf_tab, iparg, itens, tens1, tens2, x, ixc, igeo, ixtg, geo, vgps)
Definition tensorc.F:1655
tencgps1
subroutine tencgps1(elbuf_tab, iparg, itens, tens1, tens2, x, ixc, igeo, ixtg, itagps)
Definition tensorc.F:1491
velvecc
subroutine velvecc(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:491
velvecc_max
subroutine velvecc_max(vmax, nodcut, nnwl, nnsrg, nfvnod, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:801
velvecc22
subroutine velvecc22(elbuf_tab, iparg, iflg, ixs, ixq, itab)
Definition velvec.F:1067
velvec3
subroutine velvec3(v, v_temp, vale, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:928
velvecc21
subroutine velvecc21(v, v_temp, ivois, al, nodcut, nnwl, nnsrg, nodglob, weight, nfvnod, nfnod_pxfem, nfnod_pxfemg, vg21, nfnod_crkxfemg)
Definition velvec.F:646
velvec2
subroutine velvec2(ivois, v_temp, al, nodcut, fopt, npby, nnwl, nnsrg, nodglob, weight, fr_sec, nfvnod, nfnod_pxfem, nfnod_pxfemg, nfnod_crkxfemg)
Definition velvec.F:241
xyznor16
subroutine xyznor16(ixs, ixs10, ixs20, ixs16, x)
Definition genani1.F:2785
genani
subroutine genani(x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, swaft, smas, sxnorm, siad, iparg, pm, geo, ms, sinvert, cont, smater, icut, skew, xcut, fint, itab, sel2fa, fext, fopt, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, mat_param, dd_iad, weight, eani, ipart, cluster, iparts, ipartq, ipartc, ipartt, ipartp, ipartr, ipartur, iparttg, rby, swa4, tors, nom_opt, igrsurf, bufsf, idata, rdata, siadg, bufmat, bufgeo, kxx, ixx, ipartx, suix, sxusr, snfacptx, sixedge, sixfacet, sixsolid, snumx1, snumx2, snumx3, soffx1, soffx2, soffx3, smass1, smass2, smass3, sfunc1, sfunc2, sfunc3, kxsp, ixsp, nod2sp, ipartsp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, iflow, rflow, fncont, ftcont, temp, thke, err_thk_sh4, err_thk_sh3, diag_sms, ipari, fncont2, dr, ale_connectivity, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, dxancg, nod_pxfem, iel_pxfem, zi_ply, vgaz, fcontg, fncontg, ftcontg, fanreac, inod_crk, iel_crk, elcutc, iadc_crk, pdama2, res_sms, weight_md, nodglobxfe, nodedge, fcluster, mcluster, xfem_tab, w, nv46, ipartig3d, kxig3d, ixig3d, sig3dsolid, knot, wige, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, igrnod, h3d_data, subset, multi_fvm, knotlocpc, knotlocel, fcont_max, fncontp2, ftcontp2, glob_therm, drape_sh4n, drape_sh3n, drapeg, output)
Definition genani.F:240
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
ale_connectivity_mod
Definition ale_connectivity_mod.F:225
aleanim_mod
Definition aleanim_mod.F:39
cluster_mod
Definition cluster_mod.F:40
crackxfem_mod
Definition crackxfem_mod.F:121
crackxfem_mod::crknod
type(xfem_nodes_), dimension(:), allocatable crknod
Definition crackxfem_mod.F:218
drape_mod
Definition drape_mod.F:54
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvdata
type(fvbag_data), dimension(:), allocatable fvdata
Definition fvbag_mod.F:128
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
inoutfile_mod
Definition inoutfile_mod.F:96
message_mod
Definition message_mod.F:1257
plyxfem_mod
Definition plyxfem_mod.F:31
plyxfem_mod::plynod
type(plynods), dimension(:), allocatable plynod
Definition plyxfem_mod.F:44
plyxfem_mod::ply
type(ply_data), dimension(:), allocatable ply
Definition plyxfem_mod.F:92
plyxfem_mod::indx_ply
integer, dimension(:), allocatable indx_ply
Definition plyxfem_mod.F:60
plyxfem_mod::nplypart
integer nplypart
Definition plyxfem_mod.F:59
stack_mod
Definition stack_mod.F:75
nodal_schlieren
subroutine nodal_schlieren(wa4, x, ixs, ixq, itab, iparg, ibid, elbuf_tab, ale_connectivity)
Definition nodal_schlieren.F:40
nodald
subroutine nodald(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift)
Definition nodald.F:44
nodalp
subroutine nodalp(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift)
Definition nodalp.F:43
nodalssp
subroutine nodalssp(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift, multi_fvm)
Definition nodalssp.F:44
nodalt
subroutine nodalt(ifunc, wa4, wa4_fvm, iflow, rflow, iparg, elbuf_tab, ix, nix, numel, itab, nv46, monvol, volmon, airbags_total_fvm_in_h3d, is_written_node, is_written_node_fvm, ispmd, fvdata_p, swa4, airbags_node_id_shift)
Definition nodalt.F:44
nodalvfrac
subroutine nodalvfrac(ifunc, wa4, iflow, rflow, iparg, elbuf_tab, ix, nix, itab, nv46)
Definition nodalvfrac.F:37
nodalzvol
subroutine nodalzvol(ifunc, wa4, iflow, rflow, iparg, elbuf_tab, ix, nix, itab, nv46)
Definition nodalzvol.F:36
norcut
subroutine norcut(vn, lastn)
Definition norcut.F:31
radioss
program radioss
Definition radioss.F:34
section
subroutine section(nnod, n1, n2, n3, nstrf, x, v, vr, fsav, fopta, secfcum, ms, in, ifram, xsec)
Definition section.F:34
smass3
subroutine smass3(rho, ms, partsav, x, v, ipart, mss, volu, msnf, mssf, in, vr, ins, wma, rhocp, mcp, mcps, mssa, rhof, frac, fill, nc1, nc2, nc3, nc4, nc5, nc6, nc7, nc8)
Definition smass3.F:44
spmd_exch_nodarea2
subroutine spmd_exch_nodarea2(nodarea, iad_elem, fr_elem, lenr, weight, jj)
Definition spmd_exch_nodarea2.F:39
spmd_exch_nodarea
subroutine spmd_exch_nodarea(nodarea, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodarea.F:41
spmd_exch_nodareai
subroutine spmd_exch_nodareai(nodareai, iad_elem, fr_elem, lenr, weight)
Definition spmd_exch_nodareai.F:38
spmd_fvb_aelf
subroutine spmd_fvb_aelf(fvmass, fvpres, fvqx, fvqy, fvqz, fvrho, fvener, fvcson, fvgama, fvvisu, fvel2fa)
Definition spmd_fvb_aelf.F:35
spmd_fvb_anum
subroutine spmd_fvb_anum(fvoff, idmax, nfvnod)
Definition spmd_fvb_anum.F:34
spmd_fvb_asub1
subroutine spmd_fvb_asub1(ii, fvpbuf)
Definition spmd_fvb_asub1.F:33
spmd_fvb_asub2
subroutine spmd_fvb_asub2()
Definition spmd_fvb_asub2.F:33
spmd_fvb_atit
subroutine spmd_fvb_atit(ctext, str, titl, ltitl, maxpart)
Definition spmd_fvb_atit.F:34
spmd_fvb_avec
subroutine spmd_fvb_avec()
Definition spmd_fvb_avec.F:34
spmd_gatherf
subroutine spmd_gatherf(v, weight, nodglob, num)
Definition spmd_gatherf.F:33
spmd_gatheritab
subroutine spmd_gatheritab(v, weight, nodglob, num)
Definition spmd_gatheritab.F:33
spmd_gatheritab_crk
subroutine spmd_gatheritab_crk(icrk, num, idmaxnod, nodglobxfe)
Definition spmd_gatheritab_crk.F:34
spmd_ibcast
subroutine spmd_ibcast(tabi, tabr, n1, n2, from, add)
Definition spmd_ibcast.F:57
spmd_r4get_partn
subroutine spmd_r4get_partn(size, nbf_l, nbpart, iadg, wal, buf)
Definition spmd_r4get_partn.F:47
spmd_glob_isum9
subroutine spmd_glob_isum9(v, len)
Definition spmd_th.F:520
ani_txt50
subroutine ani_txt50(text, len)
Definition ani_txt.F:61
ani_txt
subroutine ani_txt(text, len)
Definition ani_txt.F:30
anioff0
subroutine anioff0(elbuf_tab, iparg, ioff, el2fa, nbf, sioff, sph2sol)
Definition anioff0.F:32
aniskewf
subroutine aniskewf(geo, skew, iparg, ixr, lrbuf)
Definition aniskewf.F:31
delnumb0
subroutine delnumb0(iparg, el2fa, nbf, inum, kxsp)
Definition delnumb0.F:30
delnumbc
subroutine delnumbc(iparg, ixq, ixc, ixtg, el2fa, nbf, inum, nelcut, nbpart, idcmax)
Definition delnumbc.F:33
delnumbf
subroutine delnumbf(iparg, ixt, ixp, ixr, el2fa, nbf, inum, inumx1)
Definition delnumbf.F:33
dfunc0
subroutine dfunc0(elbuf_tab, func, ifunc, iparg, pm, el2fa, nbf, spbuf, ipart, ipartsp)
Definition dfunc0.F:32
dfuncc
subroutine dfuncc(elbuf_tab, bufel, func, ifunc, iparg, ixq, ixc, ixtg, pm, el2fa, nbf)
Definition dfuncc.F:33
dfuncf
subroutine dfuncf(elbuf_tab, func, ifunc, iparg, geo, ixt, ixp, ixr, mass, pm, el2fa, nbf, iadp, nbpart, xfunc1)
Definition dfuncf.F:33
dmasani0
subroutine dmasani0(elbuf_tab, iparg, mas, pm, el2fa, ipart, ipartsp)
Definition dmasani0.F:31
dmasanic
subroutine dmasanic(elbuf_tab, x, d, geo, iparg, ixq, ixc, ixtg, mas, pm, el2fa, nbf)
Definition dmasanic.F:32
dseccnt
subroutine dseccnt(nesct, nerwl, nesbw, nstrf, rwbuf, nprw, nnwl, ixs)
Definition dseccnt.F:31
dsecnor
subroutine dsecnor(x, rwbuf, nprw)
Definition dsecnor.F:32
dsphnor
subroutine dsphnor(kxsp, x, spbuf, nnsph)
Definition dsphnor.F:30
dsrgnor
subroutine dsrgnor(igrsurf, bufsf)
Definition dsrgnor.F:31
parsor0
subroutine parsor0(iadd, iparg, mater, el2fa, kxsp, ipartsp)
Definition parsor0.F:31
parsors
subroutine parsors(iadd, iparg, ixs, mater, iparts, el2fa, insph, kxsp, ipartsp, ixs10, ixs20, ixs16, nnsph, isph3d, shft16, shftsph, nnsphg)
Definition parsors.F:35
tensor0
subroutine tensor0(elbuf_tab, iparg, itens, pm, el2fa, nbf, tens, ipart, ipartsp)
Definition tensor0.F:32
tensorc
subroutine tensorc(elbuf_tab, iparg, itens, invert, nelcut, el2fa, nbf, tens, iadp, nbf_l, nbpart, x, ixc, igeo, ixtg)
Definition tensorc.F:34
velvec
subroutine velvec(v, nnwl, nnsrg)
Definition velvec.F:30
xyznor
subroutine xyznor(xnorm)
Definition xyznor.F:31
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33
tensgpstrain
subroutine tensgpstrain(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensgpstrain.F:44
tensgps1
subroutine tensgps1(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, elbuf_tab)
Definition tensor6.F:3412
tensgps3
subroutine tensgps3(elbuf_tab, func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, itagps, pm)
Definition tensor6.F:3916
tensgps2
subroutine tensgps2(func1, func2, iparg, geo, ixs, ixs10, ixs16, ixs20, ixq, ixc, ixtg, ixt, ixp, ixr, x, vgps, elbuf_tab)
Definition tensor6.F:3658
tensorc_crk
subroutine tensorc_crk(elbuf_tab, xfem_tab, iparg, ipm, itens, invert, el2fa, nbf, len, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, igeo, ixtg, iel_crk, iadc_crk, crkedge, indx_crk, mat_param)
Definition tensorc_crk.F:45
tensorc_ply
subroutine tensorc_ply(iply, nel_ply, elbuf_tab, iparg, itens, invert, el2fa, nbf, tens, epsdot, iadp, nbf_l, nbpart, iadg, x, ixc, mat_param, igeo, ixtg, nbf_pxfemg, ipm, stack)
Definition tensorc_ply.F:45
torseur
subroutine torseur(iadg, iparg, itens, ixt, ixp, ixr, el2fa, nbf, tens, tors, nbpart)
Definition torseur.F:38
velocity
subroutine velocity(a, ar, v, vr, fzero, itab, nale)
Definition velocity.F:29
velvecz22
subroutine velvecz22(elbuf_tab, iparg, ipari, igrnod, x, ixs, ixq, itab, iflg)
Definition velvecz22.F:40
write_s_c
void write_s_c(int *w, int *len)
Definition write_routines.c:687
write_i_c
void write_i_c(int *w, int *len)
Definition write_routines.c:645
write_r_c
void write_r_c(float *w, int *len)
Definition write_routines.c:519
close_c
void close_c()
Definition write_routines.c:298
file_size
void file_size(int *filesize)
Definition write_routines.c:371
write_c_c
void write_c_c(int *w, int *len)
Definition write_routines.c:591
xyznor_crk
subroutine xyznor_crk(icrk, xnorm, nfnod_crkxfemg)
Definition xyznor_crk.F:34
xyznor_ply
subroutine xyznor_ply(iply, xnorm, nodglob, weight, empsizpl)
Definition xyznor_ply.F:34