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