94 SUBROUTINE genstat(X ,MS ,ELBUF_TAB,BUFEL ,SPBUF ,
95 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
96 3 IXR ,IXTG ,KXSP ,IPARG ,IPM ,
97 4 IGEO ,ITAB ,IPART ,PM ,GEO ,
98 5 IPARTS ,IPARTQ ,IPARTC ,IPARTT ,IPARTP ,
99 6 IPARTR ,IPARTUR ,IPARTTG ,IPARTX ,IPARTSP ,
100 7 DD_IAD ,WEIGHT ,NODGLOB ,LENG,IPART_STATE ,
101 8 LENGC ,LENGTG ,SH4TREE ,SH3TREE ,LENGS ,
102 9 SH4TRIM ,SH3TRIM ,TEMP ,IXS10 ,THKE ,
103 A IXS16 ,IXS20 ,ICODE ,LENGR ,LENGP ,
104 B LENGT ,ISKEW ,V ,VR ,LENGQ ,
105 C MULTI_FVM,BUFMAT ,NPBY ,LPBY ,STACK ,
106 D DRAPE_SH4N ,DRAPE_SH3N,DR,DRAPEG,MAT_PARAM ,
107 E IPARTSPH , OUTPUT ,LENGSPH ,NUMSPHG ,ITHERM_FE)
120 USE stat_sphcel_mp_mod
121 USE stat_sphcel_spmd_mod
122 USE stat_sphcel_full_mod
127#include "implicit_f.inc"
131#include "com01_c.inc"
132#include "com04_c.inc"
133#include "com09_c.inc"
134#include "param_c.inc"
135#include "units_c.inc"
136#include "scr03_c.inc"
137#include "scr14_c.inc"
138#include "scr16_c.inc"
139#include "scr17_c.inc"
140#include "chara_c.inc"
143#include "state_c.inc"
144#include "sysunit.inc"
145#include "tabsiz_c.inc"
150 . IXS(NIXS,NUMELS),IXQ(NIXQ,NUMELQ),IXC(NIXC,NUMELC),IXTG(NIXTG,NUMELTG),
155(*), DD_IAD(*), NODGLOB(*), IPART_STATE(*),
156 . SH4TREE(*), SH3TREE(*),
157 . SH4TRIM(*), SH3TRIM(*),IXS10(*),IXS16(*),IXS20(
159INTEGER LENG,LENGC,LENGTG,LENGS,LENGR,LENGP,LENGT,LENGQ
160 INTEGER ,
intent(in) :: ITHERM_FE
162 . x(*), ms(*), bufel(*), spbuf(*),
163 . pm(npropm,*), geo(npropg,*) ,temp(*),thke(*),
164 . v(3,*),vr(3,*),dr(sdr)
165 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET :: ELBUF_TAB
166 TYPE(MULTI_FVM_STRUCT),
INTENT(IN) :: MULTI_FVM
167 TYPE (STACK_PLY) :: STACK
168 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
170TYPE (MATPARAM_STRUCT_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
171 INTEGER,
DIMENSION(NUMSPH),
INTENT(IN) :: IPARTSPH
173 TYPE(output_),
INTENT(INOUT) :: OUTPUT
174 INTEGER,
INTENT(IN) :: LENGSPH
175 INTEGER,
INTENT(IN) :: NUMSPHG
179 CHARACTER CHSTAT*4,FILNAM*100,T10*10,MES*40
180 INTEGER FILEN,I,INNODA,IERR,J,N
181 INTEGER LENR,SIZLOC,SIZP0
182 INTEGER I161,I16A,I16B,I16C,I16D,I16E,I16F,I16G,I16H,I16I
183 INTEGER,
DIMENSION(:),
ALLOCATABLE :: ITABG
184 INTEGER,
DIMENSION(:),
ALLOCATABLE :: NODTAG
185 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXC
186 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXTG
187 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXQ
188 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXS
189 INTEGER,
DIMENSION(:),
ALLOCATABLE ::
190 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXP
191 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDX
192 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXT
193 INTEGER,
DIMENSION(:),
ALLOCATABLE :: STAT_INDXSPH
197 . ,
DIMENSION(:),
ALLOCATABLE :: wa,wap0
199 INTEGER :: LEN_TMP_NAME
200 CHARACTER(len=2148) :: TMP_NAME
201 LOGICAL IS_FILE_TO_BE_WRITTEN
206 CALL my_alloc(itabg,leng)
207 CALL my_alloc(nodtag,numnod)
208 CALL my_alloc(stat_indxc,2*lengc)
209 CALL my_alloc(stat_indxtg,2*lengtg)
210 CALL my_alloc(stat_indxq,2*lengq)
211 CALL my_alloc(stat_indxs,2*lengs)
212 CALL my_alloc(stat_indxr,2*lengr)
213 CALL my_alloc(stat_indxp,2*lengp)
214 CALL my_alloc(stat_indxt,2*lengt)
215 CALL my_alloc(stat_indxsph,2*lengsph)
221 IF(istatf>=10000)istatf=1
222 WRITE(chstat,
'(I4.4)')istatf
223 filnam=rootnam(1:rootlen)//
'_'//chstat//
'.sta'
228 IF(is_file_to_be_written)
THEN
229 OPEN(unit=iugeo,file=tmp_name(1:len_tmp_name),access=
'SEQUENTIAL',form=
'FORMATTED',status=
'UNKNOWN')
230 WRITE(iugeo,
'(2A)')
'#RADIOSS STATE FILE ',filnam(1:filen)
233 filnam=rootnam(1:rootlen)//
'_'//chstat//
'.str'
237 ctext(i)=ichar(tmp_name(i:i))
242 CALL open_c(ctext,len_tmp_name,0)
243 ELSEIF(izipstrs==2)
THEN
244 CALL open_c(ctext,len_tmp_name,6)
250 IF(is_file_to_be_written)
THEN
251 WRITE(iugeo,
'(A)')
'/BEGIN'
252 WRITE(iugeo,
'(A)') rootnam(1:rootlen)
253 WRITE(iugeo,
'(I10,I10)') st_invers, 0
254 WRITE(iugeo,
'(1P3E20.13)') fac_mass,fac_length,fac_time
255 WRITE(iugeo,
'(1P3E20.13)') fac_mass,fac_length,fac_time
256 IF(izipstrs > 0)
THEN
257 WRITE(line,
'(A)')
'/BEGIN'
259 WRITE(line,
'(A)') rootnam(1:rootlen)
261 WRITE(line,
'(I10,I10)') st_invers, 0
263 WRITE(line,
'(1P3E20.13)') fac_mass,fac_length,fac_time
265 WRITE(line,
'(1P3E20.13)') fac_mass,fac_length,fac_time
284 output%STATE%STAT_NUMELSPH = 0
289 . itab,itabg,leng,ipart,igeo,
290 . ixc,ixtg,ipartc,iparttg,ipart_state,
291 . nodtag,stat_indxc,stat_indxtg,sh4tree,sh3tree,
292 . iparg ,sh4trim ,sh3trim ,elbuf_tab,thke,
294 stat_numelc_g =stat_numelc
295 stat_numeltg_g =stat_numeltg
299 . ipart_state,nodtag,stat_indxq,
301 stat_numelq_g =stat_numelq
304 . itab,ipart,igeo,ixs,iparts,
305 . ipart_state,nodtag,stat_indxs,
306 . iparg ,ixs10,ixs16,ixs20
308 stat_numels_g =stat_numels
311 . itab ,ipart ,ixr ,ipartr ,ipart_state,
312 . nodtag ,stat_indxr,iparg ,elbuf_tab,stat_r(2) )
313 stat_numelr_g =stat_numelr
316 . itab ,ipart ,ixp ,ipartp ,ipart_state,
317 . nodtag ,stat_indxp,iparg ,elbuf_tab,stat_p(2) )
318 stat_numelp_g =stat_numelp
321 . itab ,ipart ,ixt ,ipartt ,ipart_state,
322 . nodtag ,stat_indxt,iparg ,elbuf_tab,stat_t(2) )
323 stat_numelt_g =stat_numelt
325 CALL stat_sphcel_mp( numnod , numsph ,nisp ,npart ,ngroup ,
326 . nparg , lipart1 ,output%STATE%STAT_NUMELSPH ,itab ,ipart ,
327 . kxsp , ipartsph ,ipart_state,nodtag ,stat_indxsph,
328 . iparg ,elbuf_tab ,output%STATE%STAT_SPH(2) )
330 output%STATE%STAT_NUMELSPH_G = output%STATE%STAT_NUMELSPH
335 . itab,itabg,leng,ipart,igeo,
336 . ixc,ixtg,ipartc,iparttg,ipart_state,
337 . nodtag,stat_indxc,stat_indxtg,lengc,lengtg,
338 . iparg ,elbuf_tab,thke,stat_c(9))
341 . itab,ipart,igeo,ixs,iparts,
342 . ipart_state,nodtag,stat_indxs,
343 . iparg, lengs,ixs10,ixs16,ixs20,
344 . elbuf_tab, stat_s(12))
345 ! - quads - (only taging nodes, quads are currently not exported in state files : 3d only)
347 . itab,ipart,igeo,ixq,ipartq,
348 . ipart_state,nodtag,stat_indxq,
349 . iparg, lengq, elbuf_tab)
353 . itab ,ipart ,ixr ,ipartr,ipart_state,
354 . nodtag ,stat_indxr,lengr ,iparg ,elbuf_tab ,
358 . itab ,ipart ,ixp ,ipartp,ipart_state,
359 . nodtag ,stat_indxp,lengp ,iparg ,elbuf_tab ,
363 . itab ,ipart ,ixt ,ipartt,ipart_state,
364 . nodtag ,stat_indxt,lengt ,iparg ,elbuf_tab ,
367 CALL stat_sphcel_spmd(
368 . numnod ,numsph ,numsphg ,nisp ,npart ,
369 . ngroup ,nparg ,lipart1 ,output%STATE%STAT_NUMELSPH ,output%STATE%STAT_NUMELSPH_G ,
370 . lengsph ,nspmd ,itab ,ipart ,kxsp ,
371 . ipartsph ,ipart_state ,nodtag ,stat_indxsph,iparg ,
372 . elbuf_tab ,output%STATE%STAT_SPH(2) )
376 IF(is_stat_inimap1d)
THEN
379 . x , v , itab , ipart_state, nodtag ,
380 . ipart , iparts , ipartq, iparttg , mat_param,
381 . igeo , iparg , ixs , ixq , ixtg ,
382 . elbuf_tab, multi_fvm, bufmat, ipm)
385 . x , v , itab , ipart_state, nodtag ,
386 . ipart , iparts , ipartq, iparttg , mat_param,
387 . igeo , iparg , ixs , ixq , ixtg ,
388 . elbuf_tab, multi_fvm, bufmat, ipm)
391 ELSEIF(is_stat_inimap2d)
THEN
394 . x , v , itab , ipart_state, nodtag ,
395 . ipart , iparts , ipartq, iparttg , mat_param,
396 . igeo , iparg , ixs , ixq , ixtg ,
397 . elbuf_tab, multi_fvm, bufmat, ipm)
400 . x , v , itab , ipart_state, nodtag ,
401 . ipart , iparts , ipartq, iparttg , mat_param,
402 . igeo , iparg , ixs , ixq , ixtg ,
403 . elbuf_tab, multi_fvm, bufmat, ipm)
410 IF(nstatall /= 0)
THEN
421 IF (nodtag(n)/=0)
THEN
422 nodtag(npby(1,i)) = 1
429 CALL stat_node(x,numnod,itab,itabg,leng,nodglob,weight,nodtag)
431 IF(izipstrs /= 0 .AND. is_file_to_be_written)
THEN
432 WRITE(iugeo,
'(A)')
'/STATE/STR_FILE'
433 WRITE(iugeo,
'(A)')
'# gzip (no:0: yes:1)'
434 WRITE(iugeo,
'(I10)')izipstrs-1
435 WRITE(iugeo,
'(A)')
'# file name'
436 IF (izipstrs == 1)
WRITE(iugeo,
'(A)')filnam(1:filen)
437 IF (izipstrs == 2)
WRITE(iugeo,
'(A)')filnam(1:filen)//
'.gz'
444 . nodglob,weight,nodtag,temp
447 .
CALL stat_n_bcs(icode,numnod,itab,itabg,leng,
451 .
CALL stat_n_vel(numnod ,itab ,itabg ,leng ,nodglob,
452 . weight ,nodtag ,v ,vr )
455 . sizp0 ,sizloc ,ixs ,geo ,elbuf_tab,
456 . ixr ,ixp ,ixt ,output,lipart1 ,
457 . npart ,ipart ,numsph,ipartsp )
463 ALLOCATE(wa(sizloc),stat=ierr)
468 CALL ancmsg(msgid=252,anmode=aninfo,
475 ALLOCATE(wap0(sizp0),stat=ierr)
477 CALL ancmsg(msgid=252,anmode=aninfo,
485 . elbuf_tab,iparg ,ipm ,igeo ,ixc ,
486 . ixtg ,wa,wap0,ipartc,iparttg,
487 . ipart_state,stat_indxc,stat_indxtg,sizp0)
491 . elbuf_tab,iparg ,ipm ,igeo,ixc ,
492 . ixtg ,wa,wap0 ,ipartc,iparttg,
493 . ipart_state,stat_indxc,stat_indxtg,
497 . elbuf_tab,iparg ,ipm ,igeo,ixc ,
498 . ixtg ,wa,wap0 ,ipartc,iparttg,
499 . ipart_state,stat_indxc,stat_indxtg,
503 . elbuf_tab,iparg ,ipm ,igeo,ixc ,
504 . ixtg ,wa,wap0 ,ipartc,iparttg,
505 . ipart_state,stat_indxc,stat_indxtg,
509 . elbuf_tab,x,iparg ,ipm ,igeo,ixc ,
510 . ixtg ,wa,wap0 ,ipartc,iparttg,
511 . ipart_state,stat_indxc,stat_indxtg,
512 . thke ,sizp0,geo ,stack,drape_sh4n,drape_sh3n,drapeg)
515 . elbuf_tab,iparg ,ipm ,igeo,ixc ,
516 . ixtg ,wa,wap0 ,ipartc,iparttg,
517 . ipart_state,stat_indxc,stat_indxtg,
521 . elbuf_tab,x,iparg ,ipm ,igeo,ixc ,
522 . ixtg ,wa,wap0 ,ipartc,iparttg,
523 . ipart_state,stat_indxc,stat_indxtg,
524 . thke ,sizp0,geo ,stack,drape_sh4n,drape_sh3n,drapeg)
527 . elbuf_tab,iparg ,ipm ,igeo,ixc ,
528 . ixtg ,wa,wap0 ,ipartc,iparttg,
529 . ipart_state,stat_indxc,stat_indxtg,sizp0)
533 . elbuf_tab,iparg ,ipm ,igeo
534 . ixtg ,wa,wap0 ,ipartc,iparttg,
535 . ipart_state,stat_indxc,stat_indxtg,x,stat_c(9),sizp0)
538 . elbuf_tab,iparg ,ipm ,igeo,ixc ,
539 . ixtg ,wa,wap0 ,ipartc,iparttg,
540 . ipart_state,stat_indxc,stat_indxtg,sizp0,
546 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
547 2 wa,wap0 ,iparts, ipart_state,
548 3 stat_indxs,x,0,ipart,sizp0)
551 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
552 2 wa,wap0 ,iparts, ipart_state,
553 3 stat_indxs,x,0,ipart,sizp0)
556 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
557 2 wa,wap0 ,iparts, ipart_state,
558 3 stat_indxs,ipart,sizp0)
560 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
561 2 wa,wap0 ,iparts, ipart_state,
562 3 stat_indxs,x,0,ipart,stat_s(12),sizp0)
564 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
565 2 wa,wap0 ,iparts, ipart_state,
566 3 stat_indxs,x,1,ipart,sizp0)
569 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
570 2 wa,wap0 ,iparts, ipart_state,
571 3 stat_indxs,x,1,ipart,sizp0)
573 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
574 2 wa,wap0 ,iparts, ipart_state,
575 3 stat_indxs,x,1,ipart,stat_s(12),sizp0)
577 1 elbuf_tab ,iparg ,ipm ,igeo ,ixs ,
578 2 wa,wap0 ,iparts, ipart_state,
579 3 stat_indxs,ipart,sizp0,nummat,mat_param)
581 1 elbuf_tab ,iparg ,ipm ,igeo ,
582 2 ixs ,ixs10,ixs16,ixs20,x ,
583 3 dr ,wa,wap0 ,iparts, ipart_state,
584 4 stat_indxs,ipart,sizp0)
590 1 elbuf_tab ,iparg ,geo ,igeo ,ixr ,
591 2 wa ,wap0 ,ipartr ,ipart_state ,stat_indxr,
598 1 elbuf_tab ,iparg ,geo ,igeo ,ixp ,
599 2 wa ,wap0 ,ipartp ,ipart_state ,stat_indxp,
603 1 elbuf_tab ,iparg ,ipm ,igeo ,ixp ,
604 2 wa ,wap0 ,ipartp ,ipart_state,stat_indxp,
611 1 elbuf_tab ,iparg ,geo ,igeo ,ixt ,
612 2 wa ,wap0 ,ipartt ,ipart_state ,stat_indxt,
618 IF(output%STATE%STAT_SPH(3) == 1)
CALL stat_sphcel_full(
619 1 numsph ,nisp ,ngroup ,nparg ,sizloc ,
620 2 npart ,sizp0 ,nspmd ,output%STATE%STAT_NUMELSPH ,output%STATE%STAT_NUMELSPH_G
621 2 nspbuf ,numnod ,npropmi ,nummat ,lipart1 ,
622 4 kxsp ,ipartsph ,ipart_state ,stat_indxsph ,iparg ,
623 5 elbuf_tab ,wa ,wap0 ,spbuf ,itab ,
624 6 ipm ,output%STATE%STAT_SPH(2),ipart )
626 IF(sizloc >= 1)
DEALLOCATE(wa)
627 IF(sizp0 >= 1)
DEALLOCATE(wap0)
631 IF(is_file_to_be_written)
THEN
632 WRITE(iugeo,
'(A)')
'#ENDDATA '
634 IF(izipstrs /= 0)
THEN
638 WRITE (iout,1000) filnam(1:filen)
639 WRITE (istdo,1000) filnam(1:filen)
644 DEALLOCATE(stat_indxc)
645 DEALLOCATE(stat_indxtg)
646 DEALLOCATE(stat_indxq)
647 DEALLOCATE(stat_indxs)
648 DEALLOCATE(stat_indxr)
649 DEALLOCATE(stat_indxp)
650 DEALLOCATE(stat_indxt)
651 DEALLOCATE(stat_indxsph)
653 1000
FORMAT (4x,
' STATE FILE:',1x,a,
' WRITTEN')