42 . X , V , ITAB , IPART_STATE, NODTAG ,
43 . IPART , IPARTS , IPARTQ, IPARTTG , MAT_PARAM,
44 . IGEO , IPARG , IXS , IXQ , IXTG ,
45 . ELBUF_TAB, MULTI_FVM, BUFMAT, IPM)
61 USE multimat_param_mod ,
ONLY : m51_n0phas, m51_nvphas
62 USE matparam_def_mod,
ONLY : matparam_struct_
63 use element_mod ,
only : nixs,nixq,nixtg
67#include "implicit_f.inc"
83 INTEGER,
INTENT(IN) :: ITAB(NUMNOD), IPART(LIPART1,*),IGEO(NPROPGI,NUMGEO),IXS(NIXS,NUMELS), IPART_STATE(NPART)
84 INTEGER,
INTENT(IN) :: IPARG(NPARG,*),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG)
85 INTEGER,
INTENT(INOUT) :: NODTAG(NUMNOD),IPM(NPROPMI,*)
86 INTEGER,
TARGET :: IPARTS(*),IPARTQ(*),IPARTTG(*)
87 my_real,
INTENT(IN) :: x(3,numnod),v(3,numnod)
88 my_real,
INTENT(IN),
TARGET :: bufmat(*)
89 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET,
INTENT(IN) :: ELBUF_TAB
90 TYPE(multi_fvm_struct),
INTENT(IN) :: MULTI_FVM
91 TYPE(matparam_struct_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
95 INTEGER I, N, JJ,J, IPRT, K, KK
96 INTEGER NG, NEL, NFT, LFT, LLT, ITY, ISOLNOD,NPT
97 INTEGER NUM_CENTROIDS, IPOS,MLW,NBMAT,NB2,ISUBMAT,NNOD,NNOD2
99 TYPE(g_bufel_) ,
POINTER :: GBUF
100 my_real p0(3),p0_inf(3),p0_sup(3),shift_c,shift_n,length
101 my_real max_xc,max_yc,max_zc,min_xc,min_yc,min_zc
104 my_real dotprod,tol,xyz(3),vel(3),dist,vect(3)
105 CHARACTER FILNAM*100, CHSTAT*4
106 INTEGER XMIN_CELL_ID,YMIN_CELL_ID,ZMIN_CELL_ID,XMAX_CELL_ID,YMAX_CELL_ID,ZMAX_CELL_ID
107 INTEGER IS_ITY_1, IS_ITY_2, , LAST_CELL,FIRST_CELL,IMAT,NPAR,IADBUF
108 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: IDX
109 INTEGER,
POINTER,
DIMENSION(:) :: IPART_PTR
110 my_real,
POINTER,
DIMENSION(:) :: uparam
111 TYPE(buf_mat_) ,
POINTER :: MBUF
112 my_real,
ALLOCATABLE,
DIMENSION(:,:) :: map_nodes
113 INTEGER,
ALLOCATABLE,
DIMENSION(:,:) :: GET_CELL_FOM_CENTROID
114 INTEGER NPTS(NSPMD),NCELL(NSPMD),NPTS_TOT,NCELL_TOT
115 my_real,
DIMENSION(:,:),
ALLOCATABLE :: work
116 INTEGER,
DIMENSION(:),
ALLOCATABLE :: WORK_INDX
117 my_real :: len_(nspmd),len_tot,shift_c_min,shift_n_min
118 INTEGER :: IDX1(21),IDX2(21),IDX3(21)
154 isolnod = iparg(28,ng)
157 gbuf => elbuf_tab(ng)%GBUF
166 ipart_ptr => iparts(1:numels)
171 ipart_ptr => ipartq(1:numelq)
172 ELSEIF(ity == 7 .AND. n2d /= 0)
THEN
183 IF(ipart_state(iprt)==0)cycle
184 num_centroids = num_centroids +1
186 p0(1) = sum( x(1,ixs(2:9,n)) ) / npt
187 p0(2) = sum( x(2,ixs(2:9,n)) ) / npt
188 p0(3) = sum( x(3,ixs(2:9,n)) ) / npt
189 ELSEIF(is_ity_2==1)
THEN
190 p0(1) = sum( x(1,ixq(2:5,n)) ) / npt
191 p0(2) = sum( x(2,ixq(2:5,n)) ) / npt
192 p0(3) = sum( x(3,ixq(2:5,n)) ) / npt
226 state_inimap_buf(1)%NUM_CENTROIDS = num_centroids
227 state_inimap_buf(1)%NUM_POINTS = 0
231 IF(nodtag(i) == 1)
THEN
238 IF(.NOT.
ALLOCATED(map_nodes))
ALLOCATE(map_nodes(3,nnod))
239 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))
ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(num_centroids))
240 IF(.NOT.
ALLOCATED(get_cell_fom_centroid))
THEN
241 ALLOCATE(get_cell_fom_centroid(2,num_centroids))
247 IF(num_centroids > 0)
THEN
253 vect(1:3)=(/lx,ly,lz/)
255 ipos = maxloc(vect(1:3),1)
258 first_cell = xmin_cell_id
259 last_cell = xmax_cell_id
261 first_cell = ymin_cell_id
262 last_cell = ymax_cell_id
264 first_cell = zmin_cell_id
265 last_cell = zmax_cell_id
269 p0_inf(1) = sum( x(1,ixs(2:9,first_cell)) ) / npt
270 p0_inf(2) = sum( x(2,ixs(2:9,first_cell)) ) /
271 p0_inf(3) = sum( x(3,ixs(2:9,first_cell)) ) / npt
272 p0_sup(1) = sum( x(1,ixs(2:9,last_cell)) ) / npt
273 p0_sup(2) = sum( x(2,ixs(2:9,last_cell)) ) / npt
274 p0_sup(3) = sum( x(3,ixs(2:9,last_cell)) ) / npt
275 ELSEIF(is_ity_2==1)
THEN
276 p0_inf(1) = sum( x(1,ixq(2:5,first_cell)) ) / npt
277 p0_inf(2) = sum( x(2,ixq(2:5,first_cell)) ) / npt
278 p0_inf(3) = sum( x(3,ixq(2:5,first_cell)) ) / npt
279 p0_sup(1) = sum( x(1,ixq(2:5,last_cell)) ) / npt
280 p0_sup(2) = sum( x(2,ixq(2:5,last_cell)) ) / npt
281 p0_sup(3) = sum( x(3,ixq(2:5,last_cell)) ) / npt
284 vect(1:3)=(/p0_sup(1)-p0_inf(1),p0_sup(2)-p0_inf(2),p0_sup(3)-p0_inf(3)/)
288 length = sqrt(vect(1)*vect(1) + vect(2)*vect(2) + vect(3)*vect(3))
290 IF(length > zero)shift_c = (p0_inf(1)*lx + p0_inf(2)*ly + p0_inf(3)*lz) / length
291 state_inimap_buf(1)%SHIFT_Cy = shift_c
292 state_inimap_buf(1)%SHIFT_Cz = zero
293 state_inimap_buf(1)%LENGTH = length
295 state_inimap_buf(1)%SHIFT_Cy = zero
296 state_inimap_buf(1)%SHIFT_Cz = zero
297 state_inimap_buf(1)%LENGTH = zero
302 CALL ancmsg(msgid=284,anmode=aninfo,c1=
" -- 1D DOMAIN MUST BE MESHED WITH BRICKS OR QUADS ONLY")
312 dx = x(1,ixs(2,first_cell))
313 dy = x(2,ixs(2,first_cell))
314 dz = x(3,ixs(2,first_cell))
316 IF(x(1,ixs(jj,first_cell)) < dx)dx=x(1,ixs(jj,first_cell))
317 IF(x(2,ixs(jj,first_cell)) < dy)dy=x(2,ixs(jj,first_cell))
318 IF(x(3,ixs(jj,first_cell)) < dz)dz=x(3,ixs(jj,first_cell))
320 ELSEIF(is_ity_2==1)
THEN
321 dx = x(1,ixq(2,first_cell))
322 dy = x(2,ixq(2,first_cell))
323 dz = x(3,ixq(2,first_cell))
325 IF(x(1,ixq(jj,first_cell)) < dx)dx=x(1,ixq(jj,first_cell))
326 IF(x(2,ixq(jj,first_cell)) < dx)dy=x(2,ixq(jj,first_cell))
327 IF(x(3,ixq(jj,first_cell)) < dx)dz
332 IF(length > zero)shift_n=(dx*lx + dy*ly + dz*lz) / length
333 state_inimap_buf(1)%SHIFT_Ny = shift_n
334 state_inimap_buf(1)%SHIFT_Nz = zero
341 isolnod = iparg(28,ng)
344 gbuf => elbuf_tab(ng)%GBUF
352 IF(ipart_state(iprt)==0)cycle
355 p0(2) = sum( x(2,ixs(2:9,n)) ) / npt
356 p0(3) = sum( x(3,ixs(2:9,n)) ) / npt
357 ELSEIF(is_ity_2==1)
THEN
358 p0(1) = sum( x(1,ixq(2:5,n)) ) / npt
359 p0(2) = sum( x(2,ixq(2:5,n)) ) / npt
360 p0(3) = sum( x(3,ixq(2:5,n)) ) / npt
367 IF(length > zero)dotprod = (lx*dx + ly*dy + lz*dz) / length
368 state_inimap_buf(1)%POS_CENTROIDS(k) = dotprod + state_inimap_buf(1)%SHIFT_Cy
369 get_cell_fom_centroid(1,k) = ng
370 get_cell_fom_centroid(2,k) = i
376 IF(.NOT.
ALLOCATED(idx))
ALLOCATE(idx(num_centroids))
377 DO k=1,num_centroids ; idx(k
ENDDO
378 IF(num_centroids>0)
CALL quicksort(state_inimap_buf(1)%POS_CENTROIDS(:), idx, 1, num_centroids)
383 IF(num_centroids > 0)
THEN
385 nbmat = multi_fvm%NBMAT
391 state_inimap_buf(1)%MLW = mlw
392 state_inimap_buf(1)%NSUBMAT = nbmat
393 ALLOCATE(state_inimap_buf(1)%SUBMAT(nbmat))
395 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%VFRAC(num_centroids))
396 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%RHO(num_centroids))
397 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%E(num_centroids))
398 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%PRES(num_centroids))
402 state_inimap_buf(1)%NUM_POINTS = num_centroids
403 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_NODES))
ALLOCATE(state_inimap_buf(1)%POS_NODES(num_centroids))
404 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
ALLOCATE(state_inimap_buf(1)%VEL_NODES(num_centroids))
405 DO k=1, num_centroids
406 ng = get_cell_fom_centroid(1,idx(k))
407 i = get_cell_fom_centroid(2,idx(k))
409 state_inimap_buf(1)%POS_NODES(k) = state_inimap_buf(1)%POS_CENTROIDS(k)
410 xyz(1:3) = multi_fvm%VEL(1:3,i+nft)
412 IF(length > zero)dotprod = (lx*xyz(1) + ly*xyz(2) + lz*xyz(3)) / length
413 state_inimap_buf(1)%VEL_NODES(k) = dotprod
417 DO k=1, num_centroids
418 ng = get_cell_fom_centroid(1,idx(k))
419 i = get_cell_fom_centroid(2,idx(k))
421 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = multi_fvm%PHASE_ALPHA(isubmat,i+nft)
422 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = multi_fvm%PHASE_RHO(isubmat,i+nft
423 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = multi_fvm%PHASE_EINT(isubmat,i+nft
424 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = multi_fvm%PRES(i+nft)
430 DO k=1, num_centroids
431 ng = get_cell_fom_centroid(1,idx(k))
432 i = get_cell_fom_centroid(2,idx(k))
438 IF(mat_param(imat)%MULTIMAT%MID(isubmat) == 0)
EXIT
439 nb2=
max(nb2,ipm(5,imat))
443 uparam => bufmat(iadbuf:iadbuf+npar-1)
444 kk = m51_n0phas + (uparam(276+isubmat)-1)*m51_nvphas
445 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
446 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = mbuf%VAR(nel
447 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = mbuf%VAR(nel
448 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = mbuf%VAR(nel*(08+kk-1)+i)
449 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = mbuf%VAR(nel*(18+kk-1)+i)
452 state_inimap_buf(1)%NSUBMAT = nb2
454 DO k=1, num_centroids
455 ng = get_cell_fom_centroid(1,idx(k))
457 i = get_cell_fom_centroid(2,idx(k))
458 gbuf => elbuf_tab(ng)%GBUF
459 state_inimap_buf(1)%SUBMAT(1)%VFRAC(k) = 1.d00
460 state_inimap_buf(1)%SUBMAT(1)%RHO(k) = gbuf%RHO(i)
461 state_inimap_buf(1)%SUBMAT(1)%E(k) = gbuf%EINT(i)
462 state_inimap_buf(1)%SUBMAT(1)%PRES(k) = -third
474 IF(num_centroids > 0)
THEN
478 IF(nodtag(i) == 1)
THEN
482 IF(length > zero)dotprod = (lx*xyz(1) + ly*xyz(2) + lz*xyz(3)) / length
483 map_nodes(2,k)=dotprod
487 IF(
ALLOCATED(idx))
DEALLOCATE(idx)
489 DO k=1,nnod ; idx(k)=k;
ENDDO
496 IF(dist <= tol) map_nodes
500 IF(map_nodes(1,idx(i)) /= zero)
THEN
505 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_NODES))
ALLOCATE(state_inimap_buf(1)%POS_NODES(k))
506 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
ALLOCATE(state_inimap_buf(1)%VEL_NODES(k))
509 IF(map_nodes(1,idx(i)) /= zero)
THEN
511 state_inimap_buf(1)%POS_NODES(k) = map_nodes(2,i)
512 vel(1:3)=v(1:3,int(map_nodes(1,idx(i))))
514 IF(length > zero)dotprod = (lx*vel(1) + ly*vel(2) + lz*vel(3)) / length
515 state_inimap_buf(1)%VEL_NODES(k)=dotprod
518 state_inimap_buf(1)%NUM_POINTS=k
532 shift_c_min = state_inimap_buf(1)%SHIFT_Cy
533 shift_n_min = state_inimap_buf(1)%SHIFT_Ny
535 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)cycle
536 shift_c_min =
min(shift_c_min, state_inimap_buf(i)%SHIFT_Cy)
537 shift_n_min =
min(shift_n_min, state_inimap_buf(i)%SHIFT_Ny)
539 state_inimap_buf(1)%SHIFT_Cy = shift_c_min
540 state_inimap_buf(1)%SHIFT_Ny = shift_n_min
547 ncell_tot = state_inimap_buf(1)%NUM_CENTROIDS
548 len_tot = state_inimap_buf(1)%LENGTH
549 IF(ispmd == 0 .AND. nspmd > 1)
THEN
556 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)
THEN
562 npts(i)= state_inimap_buf(i)%NUM_POINTS ;
563 npts_tot=npts_tot+npts(i)
564 len_(i)=state_inimap_buf(i)%LENGTH ;
565 len_tot=len_tot+len_(i)
566 ncell(i)= state_inimap_buf(i)%NUM_CENTROIDS ;
567 ncell_tot = ncell_tot + ncell(i)
569 ALLOCATE(work(npts_tot,3),work_indx(npts_tot))
577 work(j,1) = state_inimap_buf(i)%POS_NODES(k)
578 work(j,3) = state_inimap_buf(i)%VEL_NODES(k)
584 work_indx(1:npts_tot) = (/(j,j=1,npts_tot)/)
585 CALL quicksort(work(:,1), work_indx, 1, npts_tot
588 work(i,2)=work(work_indx(i),3)
591 work_indx(1:npts_tot) = 0
598 dist = abs(work(i,1)-work(i-1,1))
605 IF(work_indx(i) ==0 )
THEN
611 DO i=k+1,npts_tot ; work(i,1:2)=zero ;
ENDDO
617 IF(
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
DEALLOCATE(state_inimap_buf
618 IF(
ALLOCATED(state_inimap_buf(1)%POS_NODES))
DEALLOCATE(state_inimap_buf(1)%POS_NODES)
619 ALLOCATE(state_inimap_buf(1)%VEL_NODES(npts_tot))
620 ALLOCATE(state_inimap_buf(1)%POS_NODES(npts_tot))
621 state_inimap_buf(1)%NUM_POINTS=npts_tot
622 state_inimap_buf(1)%POS_NODES(1:npts_tot)=work(1:npts_tot,1)
623 state_inimap_buf(1)%VEL_NODES(1:npts_tot)=work(1:npts_tot,2)
624 IF(
ALLOCATED(work))
DEALLOCATE(work)
625 IF(
ALLOCATED(work_indx))
DEALLOCATE(work_indx)
630 nbmat=
max(nbmat,state_inimap_buf(i)%NSUBMAT)
632 ALLOCATE(work(ncell_tot,1+4*nbmat))
633 ALLOCATE(work_indx(ncell_tot))
641 work(j,1) = state_inimap_buf(i)%POS_CENTROIDS(k)
642 nbmat = state_inimap_buf(i)%NSUBMAT
644 work(j,1+ 4*(jj-1)+1) = state_inimap_buf(i)%SUBMAT(jj)%VFRAC(k)
645 work(j,1+ 4*(jj-1)+2) = state_inimap_buf(i)%SUBMAT(jj)%RHO(k)
646 work(j,1+ 4*(jj-1)+3) = state_inimap_buf(i)%SUBMAT(jj)%E(k)
647 work(j,1+ 4*(jj-1)+4) = state_inimap_buf(i)%SUBMAT(jj)%PRES(k)
654 work_indx(1:ncell_tot) = (/(j,j=1,ncell_tot)/)
655 CALL quicksort(work(:,1), work_indx, 1, ncell_tot)
659 IF(
ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))
DEALLOCATE(state_inimap_buf
660 nbmat = state_inimap_buf(1)%NSUBMAT
662 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%VFRAC))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC)
663 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%RHO))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO)
664 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%E))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E)
665 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%PRES))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES)
667 ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(ncell_tot))
669 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC(ncell_tot))
670 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO(ncell_tot))
671 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E(ncell_tot))
672 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES(ncell_tot))
675 state_inimap_buf(1)%POS_CENTROIDS(j)=work(j,1)
677 state_inimap_buf(1)%SUBMAT(jj)%VFRAC(j)=work(work_indx(j),1+ 4*(jj
678 state_inimap_buf(1)%SUBMAT(jj)%RHO(j) =work
679 state_inimap_buf(1)%SUBMAT(jj)%E(j) =work(work_indx
680 state_inimap_buf(1)%SUBMAT(jj)%PRES(j)=work(work_indx(j),1+ 4*(jj
683 state_inimap_buf(1)%NUM_CENTROIDS = ncell_tot
684 state_inimap_buf(1)%LENGTH = len_tot
690 IF(ncell_tot == 0 .OR. len_tot == zero)
THEN
691 print *,
"** ERROR WITH /STATE/INIMAP"
692 print *,
" -- SITUATION NOT EXPECTED"
693 print *,
" -- 1D DOMAIN IS NOT DETECTED."
703 WRITE(chstat,
'(I4.4)')state_inimap_call_number
704 filnam=rootnam(1:rootlen)//
'_1D_'//chstat//
'.inimap'
705 OPEN(unit=220582,file=filnam
'SEQUENTIAL',form=
'FORMATTED',status=
'UNKNOWN'
706 WRITE(unit=220582,fmt=
'(A,I10)')
'#state file for mappgin with /INIMAP1D, iteration = ',state_inimap_call_number
707 WRITE(unit=220582,fmt=
'(A,A)')
'# ROOTNAME = ',rootnam(1:rootlen)
708 WRITE(unit=220582,fmt=
'(A,I0)')
'# VERSION = ',st_invers
709 WRITE(unit=220582,fmt=
'(A,F20.13)')
'# TIME = ',tt
710 WRITE(unit=220582,fmt=
'(A,I10)')
'# NCYCLE = ',ncycle
711 WRITE(unit=220582,fmt=
'(A,I10)')
'# NCELL = ',ncell_tot
720 nbmat = state_inimap_buf(1)%NSUBMAT
721 shift_c = state_inimap_buf(1)%SHIFT_Cy
722 shift_n = state_inimap_buf
723 num_centroids = state_inimap_buf
727 WRITE(unit=220582,fmt=2001)ipos+isubmat,isubmat
728 DO k=1, num_centroids
729 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
730 . ,state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k)
732 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.00
737 WRITE(unit=220582,fmt=2002)ipos+isubmat,isubmat
738 DO k=1, num_centroids
739 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
740 . ,state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k)
742 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.00
747 WRITE(unit=220582,fmt=2003)ipos+isubmat,isubmat
748 DO k=1, num_centroids
749 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
750 . ,state_inimap_buf(1)%SUBMAT(isubmat)%E(k)
752 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.00
757 WRITE(unit=220582,fmt=2004)ipos+isubmat,isubmat
758 DO k=1, num_centroids
759 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
760 . ,state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k)
762 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.00
766 WRITE(unit=220582,fmt=3000)
767 DO jj=1,state_inimap_buf(1)%NUM_POINTS
768 WRITE(unit=220582,fmt=
'(2E20.12)')state_inimap_buf(1)%POS_NODES(jj) , state_inimap_buf(1)%VEL_NODES(jj)
770 WRITE(unit=220582,fmt=1500)400,400,1.00,1.00,-shift_n,0.00
778 IF(
ALLOCATED(map_nodes))
DEALLOCATE(map_nodes)
779 IF(
ALLOCATED(get_cell_fom_centroid))
DEALLOCATE(get_cell_fom_centroid)
780 IF(
ALLOCATED(idx))
DEALLOCATE(idx)
782 nbmat = state_inimap_buf(jj)%NSUBMAT
783 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT))
THEN
785 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%VFRAC))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%VFRAC)
786 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%RHO))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%RHO)
787 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%E))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%E)
788 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%PRES))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%PRES)
791 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT ))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT)
792 IF(
ALLOCATED(state_inimap_buf(jj)%POS_NODES ))
DEALLOCATE(state_inimap_buf(jj)%POS_NODES)
793 IF(
ALLOCATED(state_inimap_buf(jj)%VEL_NODES ))
DEALLOCATE(state_inimap_buf(jj)%VEL_NODES)
794 IF(
ALLOCATED(state_inimap_buf(jj)%POS_CENTROIDS))
DEALLOCATE(state_inimap_buf(jj)%POS_CENTROIDS)
795 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT)
800 WRITE(unit=220582,fmt=1000)
803 idx1=(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21/)
806 IF(is_stat_inimap_vp)
THEN
807 WRITE(unit=220582,fmt=
'(A)')
'#/INIMAP1D/VP/1'
809 WRITE(unit=220582,fmt=
'(A)')
'#/INIMAP1D/VE/1'
811 WRITE(unit=220582,fmt=
'(A)')
'#default input to update from /STATE/INIMAP1D'
812 WRITE(unit=220582,fmt=
'(A)')
'## Type'
813 WRITE(unit=220582,fmt=
'(A)')
'# 1'
814 WRITE(unit=220582,fmt=
'(A)')
'## Node1 Node2'
815 WRITE(unit=220582,fmt=
'(A)')
'# 0 0'
816 WRITE(unit=220582,fmt=
'(A)')
'## Grbric Grquad Grtria'
817 WRITE(unit=220582,fmt=
'(A)')
'# 0 0 0'
818 WRITE(unit=220582,fmt=
'(A)')
'## Fct_v Fscale_v'
819 WRITE(unit=220582,fmt='(a)
') '# 400 1.0'
820 DO imat=1,
min(21,nbmat)
821 WRITE(unit=220582,fmt=
'(A)')
'## Fct_vf Fct_rho Fscale_rho Fct_p Fscale_p'
822 WRITE(unit=220582,fmt=
'(A1,I10,2(I10,F20.0))')
'#', idx1(imat),idx2(imat),1.0,idx3(imat),1.0
824 WRITE(unit=220582,fmt=1000)
826 WRITE (iout,500) filnam(1:len(trim(filnam)))
827 WRITE (istdo,500) filnam(1:len(trim(filnam)))
833 IF(
ALLOCATED(state_inimap_buf))
DEALLOCATE(state_inimap_buf)
843 500
FORMAT (4x,
' STATE FILE:',1x,a,
' WRITTEN')
845 1000
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
847 1500
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
848 .
'/MOVE_FUNCT/',i0,/,
849 .
'move_function__',i0,/,
850 .
'# ASCALEx FSCALEy ASHIFTx FSHIFTy',/,
853 2001
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
855 .
'volume fraction submaterial_',i0,/,
856 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
857 2002
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
859 .
'mass density submaterial_',i0,/,
860 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
861 2003
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
863 .
'energy density submaterial_',i0,/,
864 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
865 2004
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
867 .
'pressure submaterial_',i0,/,
868 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
870 3000
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
872 .
'velocity_function'/,
873 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')