48 . X , V , ITAB , IPART_STATE, NODTAG ,
49 . IPART , IPARTS , IPARTQ, IPARTTG , MAT_PARAM,
50 . IGEO , IPARG , IXS , IXQ , IXTG ,
51 . ELBUF_TAB, MULTI_FVM, BUFMAT, IPM)
68 USE multimat_param_mod ,
ONLY : m51_n0phas, m51_nvphas
69 USE matparam_def_mod,
ONLY : matparam_struct_
73#include "implicit_f.inc"
89 INTEGER,
INTENT(IN) :: ITAB(NUMNOD), IPART(LIPART1,*),IGEO(NPROPGI,NUMGEO), IXS(NIXS,NUMELS), IPART_STATE(NPART)
91INTEGER,
INTENT(INOUT) :: NODTAG(NUMNOD),
93 INTEGER,
TARGET :: IPARTS(*),IPARTQ(*),IPARTTG(*)
94 my_real,
INTENT(IN) :: X(3,NUMNOD),V(3,NUMNOD)
95 my_real,
INTENT(IN),
TARGET :: bufmat(*)
96 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET,
INTENT(IN) :: ELBUF_TAB
97 TYPE(multi_fvm_struct),
INTENT(IN) :: MULTI_FVM
98 TYPE(matparam_struct_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
102 INTEGER I, N, JJ,J, IPRT0, IPRT, K, STAT_NUMELS_1, KK, INOD
103 INTEGER NG, NEL, NFT, LFT, LLT, ITY, ISOLNOD, IOFF,NPT
104 INTEGER NUM_CENTROIDS, MLW,IFORM,NBMAT,NB2,ISUBMAT,NNOD,NNOD2
106 TYPE(g_bufel_) ,
POINTER :: GBUF
107 my_real min_x,min_y,min_z,max_x,max_y,max_z,p0(3),p0_inf(3),p0_sup(3),length
108 my_real shift_cy,shift_cz
109 my_real shift_ny,shift_nz
112 my_real dotprod,tol,xyz(3),vel(3),dist,vect(3)
113 CHARACTER FILNAM*2048, SHORTNAME*128, CHSTAT*4
114 INTEGER XMIN_CELL_ID,YMIN_CELL_ID,ZMIN_CELL_ID,XMAX_CELL_ID,YMAX_CELL_ID,ZMAX_CELL_ID
115 INTEGER IS_ITY_1, IS_ITY_2, IS_ITY_7, LAST_CELL,FIRST_CELL,IMAT,NPAR,
116 INTEGER,
POINTER,
DIMENSION(:) :: IPART_PTR
117 my_real,
POINTER,
DIMENSION(:) :: uparam
118 TYPE(buf_mat_) ,
POINTER :: MBUF
119 INTEGER,
ALLOCATABLE,
DIMENSION(:,:) :: GET_CELL_FOM_CENTROID
120 INTEGER NPTS(NSPMD),NCELL(NSPMD),NPTS_TOT,NCELL_TOT
121 my_real,
DIMENSION(:,:),
ALLOCATABLE :: work
122 my_real :: len_(nspmd),len_tot
123 my_real :: shift_cy_min, shift_ny_min, shift_cz_min, shift_nz_min
124 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: IDX, NODTAG_G
126 INTEGER :: LEN, LEN_TMP_NAME
128 INTEGER :: IFILNAM(2048)
168 isolnod = iparg(28,ng)
171 gbuf => elbuf_tab(ng)%GBUF
180 ipart_ptr => iparts(1:numels)
185 ipart_ptr => ipartq(1:numelq)
186 ELSEIF(ity == 7 .AND. n2d /= 0)
THEN
190 ipart_ptr => iparttg(1:numeltg)
197 IF(ipart_state(iprt)==0)cycle
198 num_centroids = num_centroids +1
200 IF(is_ity_1==1)inod=ixs(1+k,n)
201 IF(is_ity_2==1)inod=ixq(1+k,n)
202 IF(is_ity_7==1)inod=ixtg(1+k,n)
203 IF(is_ity_1==1)nodtag(ixs(1+k,n)) = 1
204 IF(is_ity_2==1)nodtag(ixq(1+k,n)) = 1
205 IF(is_ity_7==1)nodtag(ixtg(1+k,n)) = 1
206 IF(x(1,inod)<min_x)
THEN
210 IF(x(2,inod)<min_y)
THEN
214 IF(x(3,inod)<min_z)
THEN
218 IF(x(1,inod)>max_x)
THEN
222 IF(x(2,inod)>max_y)
THEN
226 IF(x(3,inod)>max_z)
THEN
239 state_inimap_buf(1)%NUM_CENTROIDS = num_centroids
240 state_inimap_buf(1)%NUM_POINTS = 0
244 IF(nodtag(i) == 1)
THEN
251 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%CELL_IDS))
ALLOCATE(state_inimap_buf(1)%CELL_IDS(num_centroids))
252 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))
ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(num_centroids))
253 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS2_CENTROIDS))
ALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS(num_centroids))
254 IF(.NOT.
ALLOCATED(get_cell_fom_centroid))
THEN
255 ALLOCATE(get_cell_fom_centroid(2,num_centroids))
258 IF(num_centroids > 0)
THEN
264 vect(1:3)=(/lx,ly,lz/)
265 length = sqrt(vect(2)*vect(2) + vect(3)*vect(3))
267 p0_inf(2) = sum( x(2,ixs(2:9,ymin_cell_id)) ) / npt
268 p0_inf(3) = sum( x(3,ixs(2:9,zmin_cell_id)) ) / npt
269 ELSEIF(is_ity_2==1)
THEN
270 p0_inf(2) = sum( x(2,ixq(2:5,ymin_cell_id)) ) / npt
271 p0_inf(3) = sum( x(3,ixq(2:5,zmin_cell_id)) ) / npt
272 ELSEIF(is_ity_7==1)
THEN
273 p0_inf(2) = sum( x(2,ixtg(2:4,ymin_cell_id)) ) / npt
274 p0_inf(3) = sum( x(3,ixtg(2:4,zmin_cell_id)) ) / npt
278 state_inimap_buf(1)%SHIFT_Cy = shift_cy
279 state_inimap_buf(1)%SHIFT_Cz = shift_cz
280 state_inimap_buf(1)%LENGTH = length
282 state_inimap_buf(1)%SHIFT_Cy = zero
283 state_inimap_buf(1)%SHIFT_Cz = zero
284 state_inimap_buf(1)%LENGTH = zero
294 state_inimap_buf(1)%SHIFT_Ny = shift_ny
295 state_inimap_buf(1)%SHIFT_Nz = shift_nz
299 ALLOCATE(work(num_centroids,3))
303 isolnod = iparg(28,ng)
306 gbuf => elbuf_tab(ng)%GBUF
314 IF(ipart_state(iprt)==0)cycle
317 p0(2) = sum( x(2,ixs(2:9,n)) ) / npt
318 p0(3) = sum( x(3,ixs(2:9,n)) ) / npt
319 cell_id = ixs(nixs,n)
320 ELSEIF(is_ity_2==1)
THEN
321 p0(2) = sum( x(2,ixq(2:5,n)) ) / npt
322 p0(3) = sum( x(3,ixq(2:5,n)) ) / npt
323 cell_id = ixq(nixq,n)
324 ELSEIF(is_ity_7==1)
THEN
325 p0(2) = sum( x(2,ixtg(2:4,n)) ) / npt
326 p0(3) = sum( x(3,ixtg(2:4,n)) ) / npt
327 cell_id = ixtg(nixtg,n)
335 get_cell_fom_centroid(1,k) = ng
336 get_cell_fom_centroid(2,k) = i
344 IF(.NOT.
ALLOCATED(idx))
ALLOCATE(idx(num_centroids))
345 DO k=1,num_centroids ; idx(k)=k;
ENDDO
346 IF(num_centroids>0)
CALL quicksort(work(:,3), idx, 1, num_centroids)
349 state_inimap_buf(1)%POS_CENTROIDS(k) = work(idx(k),1)
350 state_inimap_buf(1)%POS2_CENTROIDS(k) = work(idx(k),2)
351 state_inimap_buf(1)%CELL_IDS(k) = work(k,3)
353 IF(
ALLOCATED(work))
DEALLOCATE(work)
359 IF(num_centroids > 0)
THEN
361 nbmat = multi_fvm%NBMAT
367 state_inimap_buf(1)%MLW = mlw
368 state_inimap_buf(1)%NSUBMAT = nbmat
369 ALLOCATE(state_inimap_buf(1)%SUBMAT(nbmat))
371 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%VFRAC(num_centroids))
372 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%RHO(num_centroids))
373 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%E(num_centroids))
374 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%PRES(num_centroids))
378 state_inimap_buf(1)%NUM_POINTS = num_centroids
379 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_NODES))
ALLOCATE(state_inimap_buf(1)%POS_NODES
380 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS2_NODES))
ALLOCATE(state_inimap_buf(1)%POS2_NODES(num_centroids))
381 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
ALLOCATE(state_inimap_buf(1)%VEL_NODES(num_centroids))
382 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL2_NODES))
ALLOCATE(state_inimap_buf
383 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%NODE_IDS))
ALLOCATE(state_inimap_buf
385 DO k=1, num_centroids
386 ng = get_cell_fom_centroid(1,idx(k))
387 i = get_cell_fom_centroid(2,idx(k))
389 state_inimap_buf(1)%POS_NODES(k) = state_inimap_buf
390 state_inimap_buf(1)%POS2_NODES(k) = state_inimap_buf(1)%POS2_CENTROIDS(k)
391 state_inimap_buf(1)%VEL_NODES(k) = multi_fvm%VEL(2,i+nft)
392 state_inimap_buf(1)%VEL2_NODES(k) = multi_fvm%VEL(3,i+nft)
393 state_inimap_buf(1)%NODE_IDS(k) = state_inimap_buf(1)%CELL_IDS(k)
397 DO k=1, num_centroids
398 ng = get_cell_fom_centroid(1,idx(k))
399 i = get_cell_fom_centroid(2,idx(k))
401 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = multi_fvm%PHASE_ALPHA(isubmat,i+nft
402 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = multi_fvm%PHASE_RHO(isubmat,i+nft)
403 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = multi_fvm%PHASE_EINT(isubmat,i+nft
404 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = multi_fvm%PRES(i+nft)
410 DO k=1, num_centroids
411 ng = get_cell_fom_centroid(1,idx(k))
412 i = get_cell_fom_centroid(2,idx(k))
418 IF(mat_param(imat)%MULTIMAT%MID(isubmat) == 0)
EXIT
419 nb2=
max(nb2,ipm(5,imat))
423 uparam => bufmat(iadbuf:iadbuf+npar)
424 kk = m51_n0phas + (uparam(276+isubmat)-1)*m51_nvphas
426 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC
427 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = mbuf%VAR(nel*(12+kk
428 state_inimap_buf(1)%SUBMAT(isubmat)%E
429 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = mbuf%VAR
432 state_inimap_buf(1)%NSUBMAT = nb2
434 DO k=1, num_centroids
435 ng = get_cell_fom_centroid(1,idx(k))
436 i = get_cell_fom_centroid(2,idx(k))
437 gbuf => elbuf_tab(ng)%GBUF
439 state_inimap_buf(1)%SUBMAT(1)%VFRAC(k) = 1.d00
440 state_inimap_buf(1)%SUBMAT(1)%RHO(k) = gbuf%RHO(i)
441 state_inimap_buf(1)%SUBMAT(1)%E(k) = gbuf%EINT(i)
442 state_inimap_buf(1)%SUBMAT(1)%PRES(k) = -third * (gbuf%SIG(i) + gbuf%SIG(i + nel) + gbuf%SIG(i + 2 * nel))
449 IF(num_centroids > 0)
THEN
451 ALLOCATE(work(numnod,4))
453 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_NODES))
ALLOCATE(state_inimap_buf(1)%POS_NODES(nnod))
454 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS2_NODES))
ALLOCATE(state_inimap_buf(1)%POS2_NODES(nnod))
455 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
ALLOCATE(state_inimap_buf(1)%VEL_NODES(nnod))
456 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL2_NODES))
ALLOCATE(state_inimap_buf(1)%VEL2_NODES(nnod))
457 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%NODE_IDS))
ALLOCATE(state_inimap_buf(1)%NODE_IDS(nnod))
460 IF(nodtag(i) == 1)
THEN
466 work(nnod,1) = x(2,i)
467 work(nnod,2) = x(3,i)
468 work(nnod,3) = v(2,i)
469 work(nnod,4) = v(3,i)
470 state_inimap_buf(1)%NODE_IDS(nnod) = itab(i)
473 state_inimap_buf(1)%NUM_POINTS=nnod
475 IF(
ALLOCATED(idx))
DEALLOCATE(idx)
476 IF(.NOT.
ALLOCATED(idx))
ALLOCATE(idx(nnod))
477 DO k=1,nnod ; idx(k)=k;
ENDDO
478 CALL quicksort_i2(state_inimap_buf(1)%NODE_IDS(:), idx, 1, nnod)
480 state_inimap_buf(1)%POS_NODES(k) = work(idx(k),1)
481 state_inimap_buf(1)%POS2_NODES(k) = work(idx(k),2)
482 state_inimap_buf(1)%VEL_NODES(k) = work(idx(k),3)
483 state_inimap_buf(1)%VEL2_NODES(k) = work(idx(k),4)
485 IF(
ALLOCATED(work))
DEALLOCATE(work)
502 shift_cy_min = state_inimap_buf(1)%SHIFT_Cy
503 shift_ny_min = state_inimap_buf(1)%SHIFT_Ny
504 shift_cz_min = state_inimap_buf(1)%SHIFT_Cz
505 shift_nz_min = state_inimap_buf(1)%SHIFT_Nz
507 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)cycle
508 shift_cy_min =
min(shift_cy_min
509 shift_ny_min =
min(shift_ny_min, state_inimap_buf(i)%SHIFT_Ny)
510 shift_cz_min =
min(shift_cz_min, state_inimap_buf(i)%SHIFT_Cz)
511 shift_nz_min =
min(shift_nz_min, state_inimap_buf(i)%SHIFT_Nz)
513 state_inimap_buf(1)%SHIFT_Cy = shift_cy_min
514 state_inimap_buf(1)%SHIFT_Ny
515 state_inimap_buf(1)%SHIFT_Cz = shift_cz_min
516 state_inimap_buf(1)%SHIFT_Nz = shift_nz_min
523 len_tot=state_inimap_buf(1)%LENGTH ;
524 ncell_tot = state_inimap_buf(1)%NUM_CENTROIDS ;
525 IF(ispmd == 0 .AND. nspmd > 1)
THEN
532 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)
THEN
538 npts(i)= state_inimap_buf(i)%NUM_POINTS ;
539 npts_tot=npts_tot+npts(i)
540 len_(i)=state_inimap_buf(i)%LENGTH ;
541 len_tot=len_tot+len_(i)
542 ncell(i)= state_inimap_buf(i)%NUM_CENTROIDS ;
543 ncell_tot = ncell_tot + ncell(i)
545 ALLOCATE(work(npts_tot,5))
553 work(j,1) = state_inimap_buf(i)%POS_NODES(k)
554 work(j,2) = state_inimap_buf(i)%POS2_NODES(k)
555 work(j,3) = state_inimap_buf(i)%VEL_NODES(k)
556 work(j,4) = state_inimap_buf(i)%VEL2_NODES(k)
557 work(j,5) = state_inimap_buf(i)%NODE_IDS(k)
562 IF(
ALLOCATED(idx))
DEALLOCATE(idx
563 IF(.NOT.
ALLOCATED(idx))
ALLOCATE(idx(npts_tot))
564 DO k=1,npts_tot ; idx(k)=k;
ENDDO
565 CALL quicksort(work(:,5), idx, 1, npts_tot)
572 ALLOCATE(nodtag_g(npts_tot))
573 nodtag_g(1:npts_tot)=1
576 IF(work(j,5) == work(j-1,5))
THEN
587 state_inimap_buf(1)%NUM_POINTS=k
588 IF(
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
DEALLOCATE(state_inimap_buf
589 IF(
ALLOCATED(state_inimap_buf(1)%VEL2_NODES))
DEALLOCATE(state_inimap_buf(1)%VEL2_NODES)
590 IF(
ALLOCATED(state_inimap_buf(1)%POS_NODES))
DEALLOCATE(state_inimap_buf(1)%POS_NODES)
591 IF(
ALLOCATED(state_inimap_buf(1)%POS2_NODES))
DEALLOCATE(state_inimap_buf(1)%POS2_NODES)
592 IF(
ALLOCATED(state_inimap_buf(1)%NODE_IDS))
DEALLOCATE(state_inimap_buf(1)%NODE_IDS)
593 ALLOCATE(state_inimap_buf(1)%VEL_NODES(npts_tot), state_inimap_buf(1)%VEL2_NODES(npts_tot))
594 ALLOCATE(state_inimap_buf(1)%POS_NODES(npts_tot), state_inimap_buf(1)%POS2_NODES(npts_tot))
595 ALLOCATE(state_inimap_buf(1)%NODE_IDS(npts_tot))
599 IF(nodtag_g(k)==0)cycle
602 state_inimap_buf(1)%POS_NODES(j)=work(idx(k),1)
603 state_inimap_buf(1)%POS2_NODES(j)=work
604 state_inimap_buf(1)%VEL_NODES(j)=work(idx(k
605 state_inimap_buf(1)%VEL2_NODES(j)=work(idx(k),4)
606 state_inimap_buf(1)%NODE_IDS(j)=work(k,5)
609 state_inimap_buf(1)%NUM_POINTS=npts_tot
610 IF(
ALLOCATED(work))
DEALLOCATE(work)
611 IF(
ALLOCATED(nodtag_g
DEALLOCATE
613 nbmat=state_inimap_buf(1
614 ALLOCATE(work(ncell_tot,3+4*nbmat))
622 work(j,1) = state_inimap_buf(i)%POS_CENTROIDS(k)
623 work(j,2) = state_inimap_buf(i)%POS2_CENTROIDS(k)
624 work(j,3) = float(state_inimap_buf(i)%CELL_IDS(k))
625 nbmat = state_inimap_buf(i)%NSUBMAT
627 work(j,3+ 4*(jj-1)+1) = state_inimap_buf(i)%SUBMAT(jj)%VFRAC(k)
628 work(j,3+ 4*(jj-1)+2) = state_inimap_buf(i)%SUBMAT(jj)%RHO(k)
629 work(j,3+ 4*(jj-1)+3) = state_inimap_buf(i)%SUBMAT(jj)%E(k)
630 work(j,3+ 4*(jj-1)+4) = state_inimap_buf(i)%SUBMAT(jj)%PRES(k)
637 IF(
ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))
DEALLOCATE(state_inimap_buf(1)%POS_CENTROIDS)
638 IF(
ALLOCATED(state_inimap_buf(1)%POS2_CENTROIDS))
DEALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS)
639 IF(
ALLOCATED(state_inimap_buf(1)%CELL_IDS))
DEALLOCATE(state_inimap_buf(1)%CELL_IDS)
640 nbmat = state_inimap_buf(1)%NSUBMAT
642 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%VFRAC))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC)
643 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%RHO ))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO)
644 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%E ))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E)
645 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%PRES))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES)
647 ALLOCATE(state_inimap_buf(1)%CELL_IDS(ncell_tot))
648 ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(ncell_tot))
649 ALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS(ncell_tot))
651 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC(ncell_tot))
652 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO(ncell_tot))
653 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E(ncell_tot))
654 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES(ncell_tot))
657 IF(
ALLOCATED(idx))
DEALLOCATE(idx)
658 IF(.NOT.
ALLOCATED(idx))
ALLOCATE(idx(ncell_tot))
659 DO k=1,ncell_tot ; idx(k)=k;
ENDDO
660 CALL quicksort(work(:,3), idx, 1, ncell_tot)
663 state_inimap_buf(1)%POS_CENTROIDS(j)=work(idx(j),1)
664 state_inimap_buf(1)%POS2_CENTROIDS(j)=work(idx(j),2)
665 state_inimap_buf(1)%CELL_IDS(j)=int(work(j,3))
666 nbmat = state_inimap_buf(1)%NSUBMAT
668 state_inimap_buf(1)%SUBMAT(jj)%VFRAC(j)=work(idx(j),3+ 4*(jj-1)+1)
669 state_inimap_buf(1)%SUBMAT(jj)%RHO(j)=work(idx(j),3+ 4*(jj-1)+2)
670 state_inimap_buf(1)%SUBMAT(jj)%E(j)=work(idx(j),3+ 4*(jj-1)+3)
671 state_inimap_buf(1)%SUBMAT(jj)%PRES(j)=work(idx(j),3+ 4*(jj-1)+4)
674 state_inimap_buf(1)%NUM_CENTROIDS = ncell_tot
675 state_inimap_buf(1)%LENGTH = len_tot
680 IF(ncell_tot == 0 .OR. len_tot == zero)
THEN
681 CALL ancmsg(msgid=284,anmode=aninfo,c1=
" -- 2D DOMAIN IS NOT DETECTED : CHECK X-PROJECTION")
683 ELSEIF(len_tot > 0 .AND. ncell_tot > 0)
THEN
684 IF(lx/len_tot > em06)
THEN
685 CALL ancmsg(msgid=284,anmode=aninfo,c1=
" -- 2D DOMAIN IS NOT DETECTED.")
698 nbmat = state_inimap_buf(1)%NSUBMAT
699 WRITE(chstat,
'(I4.4)')state_inimap_call_number
701 filnam=rootnam(1:rootlen)//
'_2D_'//chstat//
'.inimap'
702 shortname=rootnam(1:rootlen)//
'_2D_'//chstat//'.inimap
'
704 LEN_TMP_NAME = OUTFILE_NAME_LEN + LEN
705 TMP_NAME=OUTFILE_NAME(1:OUTFILE_NAME_LEN)//FILNAM(1:LEN)
707 IFILNAM(I)=ICHAR(TMP_NAME(I:I))
709 CALL CUR_FIL_C(IUINIMAP)
710 CALL OPEN_C(IFILNAM,LEN_TMP_NAME,6)
712 CALL WRITE_I_C(INVERS,1)
714 CALL WRITE_I_C(NCYCLE,1)
715 CALL WRITE_I_C(NCELL_TOT,1)
716 CALL WRITE_I_C(STATE_INIMAP_BUF(1)%NUM_POINTS,1)
717 CALL WRITE_I_C(NBMAT,1)
721 !--- OUTPUT FUNCTION FROM CELL DATA BUFFER ---!
722 NBMAT = STATE_INIMAP_BUF(1)%NSUBMAT
723 SHIFT_Cy = STATE_INIMAP_BUF(1)%SHIFT_Cy
724 SHIFT_Ny = STATE_INIMAP_BUF(1)%SHIFT_Ny
725 SHIFT_Cz = STATE_INIMAP_BUF(1)%SHIFT_Cz
726 SHIFT_Nz = STATE_INIMAP_BUF(1)%SHIFT_Nz
727 NUM_CENTROIDS = STATE_INIMAP_BUF(1)%NUM_CENTROIDS
730 CALL WRITE_DB(STATE_INIMAP_BUF(1)%POS_CENTROIDS(1) ,NUM_CENTROIDS)
731 CALL WRITE_DB(STATE_INIMAP_BUF(1)%POS2_CENTROIDS(1) ,NUM_CENTROIDS)
735 CALL WRITE_DB(STATE_INIMAP_BUF(1)%SUBMAT(ISUBMAT)%VFRAC(1) ,NUM_CENTROIDS)
740 CALL WRITE_DB(STATE_INIMAP_BUF(1)%SUBMAT(ISUBMAT)%RHO(1) ,NUM_CENTROIDS)
743 !---pressure fraction
745 CALL WRITE_DB(STATE_INIMAP_BUF(1)%SUBMAT(ISUBMAT)%PRES(1) ,NUM_CENTROIDS)
748 !--- OUTPUT VELOCITY FUNCTION ---!
750 IF(STATE_INIMAP_BUF(1)%NUM_POINTS == STATE_INIMAP_BUF(1)%NUM_CENTROIDS)THEN
751 CALL WRITE_DB(STATE_INIMAP_BUF(1)%VEL_NODES(1) ,STATE_INIMAP_BUF(1)%NUM_POINTS)
752 CALL WRITE_DB(STATE_INIMAP_BUF(1)%VEL2_NODES(1) ,STATE_INIMAP_BUF(1)%NUM_POINTS)
754 CALL WRITE_DB(STATE_INIMAP_BUF(1)%POS_NODES(1) ,STATE_INIMAP_BUF(1)%NUM_POINTS)
755 CALL WRITE_DB(STATE_INIMAP_BUF(1)%POS2_NODES(1) ,STATE_INIMAP_BUF(1)%NUM_POINTS)
756 CALL WRITE_DB(STATE_INIMAP_BUF(1)%VEL_NODES(1) ,STATE_INIMAP_BUF(1)%NUM_POINTS)
757 CALL WRITE_DB(STATE_INIMAP_BUF(1)%VEL2_NODES(1) ,STATE_INIMAP_BUF(1)%NUM_POINTS)
766 !---OUTPUT FILE : FOOTER & CLOSE
767 SHORTNAME=SHORTNAME//'.gz
'
768 WRITE (IOUT,500) SHORTNAME(1:LEN_TRIM(TRIM(SHORTNAME)))
769 WRITE (ISTDO,500) SHORTNAME(1:LEN_TRIM(TRIM(SHORTNAME)))
773 IF(ALLOCATED(GET_CELL_FOM_CENTROID))DEALLOCATE(GET_CELL_FOM_CENTROID)
775 NBMAT = STATE_INIMAP_BUF(JJ)%NSUBMAT
776 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%SUBMAT))THEN
778 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%SUBMAT(I)%VFRAC))DEALLOCATE(STATE_INIMAP_BUF(JJ)%SUBMAT(I)%VFRAC)
779 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%SUBMAT(I)%RHO)) DEALLOCATE(STATE_INIMAP_BUF(JJ)%SUBMAT(I)%RHO)
780 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%SUBMAT(I)%E)) DEALLOCATE(STATE_INIMAP_BUF(JJ)%SUBMAT(I)%E)
783 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%SUBMAT ))DEALLOCATE(STATE_INIMAP_BUF(JJ)%SUBMAT)
784 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%POS_NODES ))DEALLOCATE(STATE_INIMAP_BUF(JJ)%POS_NODES)
785 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%VEL_NODES ))DEALLOCATE(STATE_INIMAP_BUF(JJ)%VEL_NODES)
786 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%POS2_NODES ))DEALLOCATE(STATE_INIMAP_BUF(JJ)%POS2_NODES)
787 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%VEL2_NODES ))DEALLOCATE(STATE_INIMAP_BUF(JJ)%VEL2_NODES)
788 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%NODE_IDS ))DEALLOCATE(STATE_INIMAP_BUF(JJ)%NODE_IDS)
789 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%POS_CENTROIDS))DEALLOCATE(STATE_INIMAP_BUF(JJ)%POS_CENTROIDS)
790 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%POS_CENTROIDS))DEALLOCATE(STATE_INIMAP_BUF(JJ)%POS2_CENTROIDS)
791 IF(ALLOCATED(STATE_INIMAP_BUF(JJ)%CELL_IDS))DEALLOCATE(STATE_INIMAP_BUF(JJ)%CELL_IDS)
796 IF(ALLOCATED(STATE_INIMAP_BUF))DEALLOCATE(STATE_INIMAP_BUF)
801 500 FORMAT (4X,' state file:
',1X,A,' written
')