41 . X , V , ITAB , IPART_STATE, NODTAG ,
42 . IPART , IPARTS , IPARTQ, IPARTTG , MAT_PARAM,
43 . IGEO , IPARG , IXS , IXQ , IXTG ,
44 . ELBUF_TAB, MULTI_FVM, BUFMAT, IPM)
60 USE multimat_param_mod ,
ONLY : m51_n0phas, m51_nvphas
61 USE matparam_def_mod,
ONLY : matparam_struct_
65#include "implicit_f.inc"
81 INTEGER,
INTENT(IN) :: ITAB(NUMNOD), IPART(LIPART1,*),IGEO(NPROPGI,NUMGEO),IXS(NIXS,NUMELS), IPART_STATE(NPART)
82 INTEGER,
INTENT(IN) :: IPARG(NPARG,*),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG)
83 INTEGER,
INTENT(INOUT) :: NODTAG(NUMNOD),IPM(NPROPMI,*)
84 INTEGER,
TARGET :: IPARTS(*),IPARTQ(*),IPARTTG(*)
85 my_real,
INTENT(IN) :: x(3,numnod),v(3,numnod)
86 my_real,
INTENT(IN),
TARGET :: bufmat(*)
87 TYPE (ELBUF_STRUCT_),
DIMENSION(NGROUP),
TARGET,
INTENT(IN) ::
88 TYPE(multi_fvm_struct),
INTENT(IN) :: MULTI_FVM
89 TYPE(matparam_struct_) ,
DIMENSION(NUMMAT) ,
INTENT(IN) :: MAT_PARAM
93 INTEGER I, N, JJ,J, IPRT0, IPRT, K, STAT_NUMELS_1, KK,
94 INTEGER NG, NEL, NFT, LFT, LLT, ITY, ISOLNOD, IOFF,NPT
95 INTEGER NUM_CENTROIDS, IPOS,MLW,IFORM,NBMAT,NB2,ISUBMAT,NNOD,NNOD2
96 INTEGER NUVAR,NUM_CELL
97 TYPE(g_bufel_) ,
POINTER :: GBUF
98 my_real p0(3),p0_inf(3),p0_sup(3),shift_c,shift_n,length
99 my_real max_xc,max_yc,max_zc,min_xc,min_yc,min_zc
102 my_real dotprod,tol,xyz(3),vel(3),dist,vect(3)
103 CHARACTER FILNAM*100, CHSTAT*4
104 INTEGER XMIN_CELL_ID,YMIN_CELL_ID,ZMIN_CELL_ID,XMAX_CELL_ID,YMAX_CELL_ID,ZMAX_CELL_ID
105 INTEGER IS_ITY_1, IS_ITY_2, IS_ITY_7, LAST_CELL,FIRST_CELL,IMAT,NPAR,IADBUF
106 INTEGER,
ALLOCATABLE,
DIMENSION(:) :: IDX
107 INTEGER,
POINTER,
DIMENSION(:) :: IPART_PTR
108 my_real,
POINTER,
DIMENSION(:) :: uparam
109 TYPE(buf_mat_) ,
POINTER :: MBUF
110 my_real,
ALLOCATABLE,
DIMENSION(:,:) :: map_nodes
111 INTEGER,
ALLOCATABLE,
DIMENSION(:,:) :: GET_CELL_FOM_CENTROID
112 INTEGER NPTS(NSPMD),NCELL(NSPMD),NPTS_TOT,NCELL_TOT
113 my_real,
DIMENSION(:,:),
ALLOCATABLE :: work
114 INTEGER,
DIMENSION(:),
ALLOCATABLE :: WORK_INDX
115 my_real :: len_(nspmd),len_tot,shift_c_min,shift_n_min
116 INTEGER :: IDX1(21),IDX2(21),IDX3(21)
152 isolnod = iparg(28,ng)
155 gbuf => elbuf_tab(ng)%GBUF
164 ipart_ptr => iparts(1:numels)
169 ipart_ptr => ipartq(1:numelq)
170 ELSEIF(ity == 7 .AND. n2d /= 0)
THEN
174 ipart_ptr => iparttg(1:numeltg)
181 IF(ipart_state(iprt)==0)cycle
182 num_centroids = num_centroids +1
184 p0(1) = sum( x(1,ixs(2:9,n)) ) / npt
185 p0(2) = sum( x(2,ixs(2:9,n)) ) / npt
186 p0(3) = sum( x(3,ixs(2:9,n)) ) / npt
187 ELSEIF(is_ity_2==1)
THEN
188 p0(1) = sum( x(1,ixq(2:5,n)) ) / npt
189 p0(2) = sum( x(2,ixq(2:5,n)) ) / npt
190 p0(3) = sum( x(3,ixq(2:5,n)) ) / npt
224 state_inimap_buf(1)%NUM_CENTROIDS = num_centroids
225 state_inimap_buf(1)%NUM_POINTS = 0
229 IF(nodtag(i) == 1)
THEN
236 IF(.NOT.
ALLOCATED(map_nodes))
ALLOCATE(map_nodes(3,nnod))
237 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))
ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS
238 IF(.NOT.
ALLOCATED(get_cell_fom_centroid))
THEN
239 ALLOCATE(get_cell_fom_centroid(2,num_centroids))
245 IF(num_centroids > 0)
THEN
251 vect(1:3)=(/lx,ly,lz/)
253 ipos = maxloc(vect(1:3),1)
256 first_cell = xmin_cell_id
257 last_cell = xmax_cell_id
259 first_cell = ymin_cell_id
260 last_cell = ymax_cell_id
262 first_cell = zmin_cell_id
263 last_cell = zmax_cell_id
267 p0_inf(1) = sum( x(1,ixs(2:9,first_cell)) ) / npt
268 p0_inf(2) = sum( x(2,ixs(2:9,first_cell)) ) / npt
269 p0_inf(3) = sum( x(3,ixs(2:9,first_cell)) ) / npt
270 p0_sup(1) = sum( x(1,ixs(2:9,last_cell)) ) / npt
271 p0_sup(2) = sum( x(2,ixs(2:9,last_cell)) ) / npt
272 p0_sup(3) = sum( x(3,ixs(2:9,last_cell)) ) / npt
273 ELSEIF(is_ity_2==1)
THEN
274 p0_inf(1) = sum( x(1,ixq(2:5,first_cell)) ) / npt
275 p0_inf(2) = sum( x(2,ixq(2:5,first_cell)) ) / npt
276 p0_inf(3) = sum( x(3,ixq(2:5,first_cell)) ) / npt
277 p0_sup(1) = sum( x(1,ixq(2:5,last_cell)) ) / npt
278 p0_sup(2) = sum( x(2,ixq(2:5,last_cell)) ) / npt
279 p0_sup(3) = sum( x(3,ixq(2:5,last_cell)) ) / npt
282 vect(1:3)=(/p0_sup(1)-p0_inf(1),p0_sup(2)-p0_inf(2),p0_sup(3)-p0_inf(3)/)
286 length = sqrt(vect(1)*vect(1) + vect(2)*vect(2) + vect(3)*vect(3))
288 IF(length > zero)shift_c = (p0_inf(1)*lx + p0_inf(2)*ly + p0_inf(3)*lz) / length
289 state_inimap_buf(1)%SHIFT_Cy = shift_c
290 state_inimap_buf(1)%SHIFT_Cz = zero
291 state_inimap_buf(1)%LENGTH = length
293 state_inimap_buf(1)%SHIFT_Cy = zero
294 state_inimap_buf(1)%SHIFT_Cz = zero
295 state_inimap_buf(1)%LENGTH = zero
300 CALL ancmsg(msgid=284,anmode=aninfo,c1=
" -- 1D DOMAIN MUST BE MESHED WITH BRICKS OR QUADS ONLY")
310 dx = x(1,ixs(2,first_cell))
311 dy = x(2,ixs(2,first_cell))
312 dz = x(3,ixs(2,first_cell))
314 IF(x(1,ixs(jj,first_cell)) < dx)dx=x(1,ixs(jj,first_cell))
315 IF(x(2,ixs(jj,first_cell)) < dy)dy=x(2,ixs(jj,first_cell))
316 IF(x(3,ixs(jj,first_cell)) < dz)dz=x(3,ixs(jj,first_cell))
318 ELSEIF(is_ity_2==1)
THEN
319 dx = x(1,ixq(2,first_cell))
320 dy = x(2,ixq(2,first_cell))
321 dz = x(3,ixq(2,first_cell))
323 IF(x(1,ixq(jj,first_cell)) < dx)dx=x(1,ixq(jj,first_cell))
324 IF(x(2,ixq(jj,first_cell)) < dx)dy=x(2,ixq(jj,first_cell))
325 IF(x(3,ixq(jj,first_cell)) < dx)dz=x(3,ixq(jj,first_cell))
330 IF(length > zero)shift_n=(dx*lx + dy*ly + dz*lz) / length
331 state_inimap_buf(1)%SHIFT_Ny = shift_n
332 state_inimap_buf(1)%SHIFT_Nz = zero
339 isolnod = iparg(28,ng)
342 gbuf => elbuf_tab(ng)%GBUF
350 IF(ipart_state(iprt)==0)cycle
352 p0(1) = sum( x(1,ixs(2:9,n)) ) / npt
353 p0(2) = sum( x(2,ixs(2:9,n)) ) / npt
354 p0(3) = sum( x(3,ixs(2:9,n)) ) / npt
355 ELSEIF(is_ity_2==1)
THEN
356 p0(1) = sum( x(1,ixq(2:5,n)) ) / npt
357 p0(2) = sum( x(2,ixq(2:5,n)) ) / npt
358 p0(3) = sum( x(3,ixq(2:5,n)) )
365 IF(length > zero)dotprod = (lx*dx + ly*dy + lz*dz) / length
366 state_inimap_buf(1)%POS_CENTROIDS(k) = dotprod + state_inimap_buf(1)%SHIFT_Cy
367 get_cell_fom_centroid(1,k) = ng
368 get_cell_fom_centroid(2,k) = i
374 IF(.NOT.
ALLOCATED(idx))
ALLOCATE(idx(num_centroids))
375 DO k=1,num_centroids ; idx(k)=k;
ENDDO
376 IF(num_centroids>0)
CALL quicksort(state_inimap_buf(1)%POS_CENTROIDS(:), idx, 1, num_centroids)
381 IF(num_centroids > 0)
THEN
383 nbmat = multi_fvm%NBMAT
389 state_inimap_buf(1)%MLW = mlw
390 state_inimap_buf(1)%NSUBMAT = nbmat
391 ALLOCATE(state_inimap_buf(1)%SUBMAT(nbmat))
393 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%VFRAC(num_centroids))
394 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%RHO(num_centroids))
395 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%E(num_centroids))
396 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%PRES(num_centroids))
400 state_inimap_buf(1)%NUM_POINTS = num_centroids
401 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%POS_NODES))
ALLOCATE(state_inimap_buf(1)%POS_NODES(num_centroids))
402 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
ALLOCATE(state_inimap_buf(1)%VEL_NODES(num_centroids))
403 DO k=1, num_centroids
404 ng = get_cell_fom_centroid(1,idx(k))
405 i = get_cell_fom_centroid(2,idx(k))
407 state_inimap_buf(1)%POS_NODES(k) = state_inimap_buf(1)%POS_CENTROIDS(k)
408 xyz(1:3) = multi_fvm%VEL(1:3,i+nft)
410 IF(length > zero)dotprod = (lx*xyz(1) + ly*xyz(2) + lz*xyz(3))
411 state_inimap_buf(1)%VEL_NODES(k) = dotprod
415 DO k=1, num_centroids
416 ng = get_cell_fom_centroid(1,idx(k))
417 i = get_cell_fom_centroid(2,idx(k))
419 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = multi_fvm%PHASE_ALPHA(isubmat,i+nft)
420 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = multi_fvm%PHASE_RHO(isubmat,i+nft)
421 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = multi_fvm%PHASE_EINT(isubmat,i+nft)
422 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = multi_fvm%PRES(i+nft)
428 DO k=1, num_centroids
429 ng = get_cell_fom_centroid(1,idx(k))
430 i = get_cell_fom_centroid(2,idx(k))
436 IF(mat_param(imat)%MULTIMAT%MID(isubmat) == 0)
EXIT
437 nb2=
max(nb2,ipm(5,imat))
441 uparam => bufmat(iadbuf:iadbuf+npar)
442 kk = m51_n0phas + (uparam(276+isubmat)-1)*m51_nvphas
443 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
444 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = mbuf%VAR(nel*(01+kk-1)+i)
445 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = mbuf%VAR(nel*(12+kk-1)+i)
446 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = mbuf%VAR(nel*(08+kk-1)+i)
447 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = mbuf%VAR(nel*(18+kk-1)+i)
450 state_inimap_buf(1)%NSUBMAT = nb2
452 DO k=1, num_centroids
453 ng = get_cell_fom_centroid(1,idx(k))
455 i = get_cell_fom_centroid(2,idx(k))
456 gbuf => elbuf_tab(ng)%GBUF
457 state_inimap_buf(1)%SUBMAT(1)%VFRAC(k) = 1.d00
458 state_inimap_buf(1)%SUBMAT(1)%RHO(k) = gbuf%RHO(i)
459 state_inimap_buf(1)%SUBMAT(1)%E(k) = gbuf%EINT(i)
460 state_inimap_buf(1)%SUBMAT(1)%PRES(k) = -third * (gbuf%SIG(i) + gbuf%SIG(i + nel) + gbuf%SIG(i + 2 * nel))
472 IF(num_centroids > 0)
THEN
476 IF(nodtag(i) == 1)
THEN
480 IF(length > zero)dotprod = (lx*xyz(1) + ly*xyz(2) + lz*xyz(3)) / length
481 map_nodes(2,k)=dotprod
485 IF(
ALLOCATED(idx))
DEALLOCATE(idx)
487 DO k=1,nnod ; idx(k)=k;
ENDDO
488 CALL quicksort(map_nodes(2,:), idx, 1, nnod)
493 dist = abs(map_nodes(2,i)-map_nodes(2,i-1))
494 IF(dist <= tol) map_nodes(1,idx(i)) = zero
498 IF(map_nodes(1,idx(i)) /= zero)
THEN
503 IF(.NOT.
ALLOCATEDALLOCATE(state_inimap_buf(1)%POS_NODES(k))
504 IF(.NOT.
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
ALLOCATE(state_inimap_buf(1)%VEL_NODES(k))
507 IF(map_nodes(1,idx(i)) /= zero)
THEN
509 state_inimap_buf(1)%POS_NODES(k) = map_nodes(2,i)
510 vel(1:3)=v(1:3,int(map_nodes(1,idx(i))))
512 IF(length > zero)dotprod
513 state_inimap_buf(1)%VEL_NODES(k)=dotprod
516 state_inimap_buf(1)%NUM_POINTS=k
530 shift_c_min = state_inimap_buf(1)%SHIFT_Cy
531 shift_n_min = state_inimap_buf(1)%SHIFT_Ny
533 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)cycle
534 shift_c_min =
min(shift_c_min, state_inimap_buf(i)%SHIFT_Cy)
535 shift_n_min =
min(shift_n_min, state_inimap_buf(i)%SHIFT_Ny)
537 state_inimap_buf(1)%SHIFT_Cy = shift_c_min
538 state_inimap_buf(1)%SHIFT_Ny = shift_n_min
545 ncell_tot = state_inimap_buf(1)%NUM_CENTROIDS
546 len_tot = state_inimap_buf(1)%LENGTH
547 IF(ispmd == 0 .AND. nspmd > 1)
THEN
554 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)
THEN
560 npts(i)= state_inimap_buf(i)%NUM_POINTS ;
561 npts_tot=npts_tot+npts(i)
562 len_(i)=state_inimap_buf(i)%LENGTH ;
563 len_tot=len_tot+len_(i)
564 ncell(i)= state_inimap_buf(i)%NUM_CENTROIDS ;
565 ncell_tot = ncell_tot + ncell(i)
567 ALLOCATE(work(npts_tot,3),work_indx(npts_tot))
575 work(j,1) = state_inimap_buf(i)%POS_NODES(k)
576 work(j,3) = state_inimap_buf(i)%VEL_NODES(k)
582 work_indx(1:npts_tot) = (/(j,j=1,npts_tot)/)
583 CALL quicksort(work(:,1), work_indx, 1, npts_tot)
586 work(i,2)=work(work_indx(i),3)
589 work_indx(1:npts_tot) = 0
603 IF(work_indx(i) ==0 )
THEN
609 DO i=k+1,npts_tot ; work(i,1:2)=zero ;
ENDDO
615 IF(
ALLOCATED(state_inimap_buf(1)%VEL_NODES))
DEALLOCATE(state_inimap_buf(1)%VEL_NODES)
616 IF(
ALLOCATED(state_inimap_buf(1)%POS_NODES))
DEALLOCATE(state_inimap_buf(1)%POS_NODES)
617 ALLOCATE(state_inimap_buf(1)%VEL_NODES(npts_tot))
618 ALLOCATE(state_inimap_buf(1)%POS_NODES(npts_tot))
619 state_inimap_buf(1)%NUM_POINTS=npts_tot
620 state_inimap_buf(1)%POS_NODES(1:npts_tot)=work(1:npts_tot,1)
621 state_inimap_buf(1)%VEL_NODES(1:npts_tot)=work(1:npts_tot,2)
622 IF(
ALLOCATED(work))
DEALLOCATE(work)
623 IF(
ALLOCATED(work_indx))
DEALLOCATE(work_indx)
628 nbmat=
max(nbmat,state_inimap_buf(i)%NSUBMAT)
630 ALLOCATE(work(ncell_tot,1+4*nbmat))
631 ALLOCATE(work_indx(ncell_tot))
639 work(j,1) = state_inimap_buf(i)%POS_CENTROIDS(k)
640 nbmat = state_inimap_buf(i)%NSUBMAT
642 work(j,1+ 4*(jj-1)+1) = state_inimap_buf
643 work(j,1+ 4*(jj-1)+2) = state_inimap_buf(i)%SUBMAT(jj)%RHO(k)
644 work(j,1+ 4*(jj-1)+3) = state_inimap_buf(i)%SUBMAT(jj)%E(k)
645 work(j,1+ 4*(jj-1)+4) = state_inimap_buf(i)%SUBMAT(jj)%PRES(k)
652 work_indx(1:ncell_tot) = (/(j,j=1,ncell_tot)/)
653 CALL quicksort(work(:,1), work_indx, 1, ncell_tot)
657 IF(
ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))
DEALLOCATE(state_inimap_buf(1)%POS_CENTROIDS)
658 nbmat = state_inimap_buf(1)%NSUBMAT
660 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%VFRAC))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC)
661 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%RHO))
DEALLOCATE(state_inimap_buf(1)%SUBMAT
662 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%E))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E)
663 IF(
ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%PRES))
DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES)
665 ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(ncell_tot))
667 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC(ncell_tot))
668 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO(ncell_tot))
669 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E(ncell_tot))
670 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES(ncell_tot))
673 state_inimap_buf(1)%POS_CENTROIDS(j)=work(j,1)
675 state_inimap_buf(1)%SUBMAT(jj)%VFRAC(j)=work(work_indx(j),1+ 4*(jj-1)+1)
676 state_inimap_buf(1)%SUBMAT(jj)%RHO(j) =work(work_indx(j),1+ 4*(jj-1)+2)
677 state_inimap_buf(1)%SUBMAT(jj)%E(j) =work(work_indx(j),1+ 4*(jj-1)+3)
678 state_inimap_buf(1)%SUBMAT(jj)%PRES(j)=work(work_indx(j),1+ 4*(jj-1)+4)
681 state_inimap_buf(1)%NUM_CENTROIDS = ncell_tot
682 state_inimap_buf(1)%LENGTH = len_tot
688 IF(ncell_tot == 0 .OR. len_tot == zero)
THEN
689 print *,
"** ERROR WITH /STATE/INIMAP"
690 print *,
" -- SITUATION NOT EXPECTED"
691 print *,
" -- 1D DOMAIN IS NOT DETECTED."
701 WRITE(chstat,
'(I4.4)')state_inimap_call_number
702 filnam=rootnam(1:rootlen)//
'_1D_'//chstat//
'.inimap'
703 OPEN(unit=220582,file=filnam(1:len(trim(filnam))),access=
'SEQUENTIAL',form=
'FORMATTED',status=
'UNKNOWN')
704 WRITE(unit=220582,fmt=
'(A,I10)')
'#state file for mappgin with /INIMAP1D, iteration = ',state_inimap_call_number
705 WRITE(unit=220582,fmt=
'(A,A)')
'# ROOTNAME = ',rootnam(1:rootlen)
706 WRITE(unit=220582,fmt=
'(A,I0)')
'# VERSION = ',st_invers
707 WRITE(unit=220582,fmt=
'(A,F20.13)')
'# TIME = ',tt
708 WRITE(unit=220582,fmt=
'(A,I10)')
'# NCYCLE = ',ncycle
709 WRITE(unit=220582,fmt=
'(A,I10)')
'# NCELL = ',ncell_tot
718 nbmat = state_inimap_buf(1)%NSUBMAT
719 shift_c = state_inimap_buf(1)%SHIFT_Cy
720 shift_n = state_inimap_buf(1)%SHIFT_Ny
721 num_centroids = state_inimap_buf(1)%NUM_CENTROIDS
725 WRITE(unit=220582,fmt=2001)ipos+isubmat,isubmat
726 DO k=1, num_centroids
727 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
728 . ,state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k)
730 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.0
735 WRITE(unit=220582,fmt=2002)ipos+isubmat,isubmat
736 DO k=1, num_centroids
737 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
738 . ,state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k)
740 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.0
745 WRITE(unit=220582,fmt=2003)ipos+isubmat,isubmat
746 DO k=1, num_centroids
747 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
748 . ,state_inimap_buf(1)%SUBMAT(isubmat)%E(k)
750 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.00
755 WRITE(unit=220582,fmt=2004)ipos+isubmat,isubmat
756 DO k=1, num_centroids
757 WRITE(unit=220582,fmt=
'(2E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
758 . ,state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k)
760 WRITE(unit=220582,fmt=1500)ipos+isubmat,ipos+isubmat,1.00,1.00,-shift_n,0.00
764 WRITE(unit=220582,fmt=3000)
765 DO jj=1,state_inimap_buf(1)%NUM_POINTS
766 WRITE(unit=220582,fmt=
'(2E20.12)')state_inimap_buf(1)%POS_NODES(jj) , state_inimap_buf(1)%VEL_NODES(jj)
768 WRITE(unit=220582,fmt=1500)400,400,1.00,1.00,-shift_n,0.00
776 IF(
ALLOCATED(map_nodes))
DEALLOCATE(map_nodes)
777 IF(
ALLOCATED(get_cell_fom_centroid))
DEALLOCATE(get_cell_fom_centroid)
778 IF(
ALLOCATED(idx))
DEALLOCATE(idx)
780 nbmat = state_inimap_buf(jj)%NSUBMAT
781 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT))
THEN
783 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i
DEALLOCATE
784 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%RHO))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%RHO)
785 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%E))
DEALLOCATE(state_inimap_buf(jj
786 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%PRES))
DEALLOCATE(state_inimap_buf
789 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT ))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT)
790 IF(
ALLOCATED(state_inimap_buf(jj)%POS_NODES ))
DEALLOCATE(state_inimap_buf(jj)%POS_NODES)
791 IF(
ALLOCATED(state_inimap_buf(jj)%VEL_NODES ))
DEALLOCATE(state_inimap_buf(jj)%VEL_NODES)
792 IF(
ALLOCATED(state_inimap_buf(jj)%POS_CENTROIDS))
DEALLOCATE(state_inimap_buf
793 IF(
ALLOCATED(state_inimap_buf(jj)%SUBMAT))
DEALLOCATE(state_inimap_buf(jj)%SUBMAT)
798 WRITE(unit=220582,fmt=1000)
801 idx1=(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21/)
804 IF(is_stat_inimap_vp)
THEN
805 WRITE(unit=220582,fmt=
'(A)')
'#/INIMAP1D/VP/1'
807 WRITE(unit=220582,fmt=
'(A)')
'#/INIMAP1D/VE/1'
809 WRITE(unit=220582,fmt=
'(A)')
'#default input to update from /STATE/INIMAP1D'
810 WRITE(unit=220582,fmt=
'(A)')
'## Type'
811 WRITE(unit=220582,fmt=
'(A)')
'# 1'
812 WRITE(unit=220582,fmt=
'(A)')
'## Node1 Node2'
813 WRITE(unit=220582,fmt=
'(A)')
'# 0 0'
814 WRITE(unit=220582,fmt=
'(A)')
'## Grbric Grquad Grtria'
815 WRITE(unit=220582,fmt=
'(A)')
'# 0 0 0'
816 WRITE(unit=220582,fmt=
'(A)')
'## Fct_v Fscale_v'
817 WRITE(unit=220582,fmt=
'(A)')
'# 400 1.0'
818 DO imat=1,
min(21,nbmat)
819 WRITE(unit=220582,fmt=
'(A)')
'## Fct_vf Fct_rho Fscale_rho Fct_p Fscale_p'
820 WRITE(unit=220582,fmt=
'(A1,I10,2(I10,F20.0))')
'#', idx1(imat),idx2(imat),1.0,idx3(imat),1.0
822 WRITE(unit=220582,fmt=1000)
824 WRITE (iout,500) filnam(1:len(trim(filnam)))
825 WRITE (istdo,500) filnam(1:len(trim(filnam)))
831 IF(
ALLOCATED(state_inimap_buf))
DEALLOCATE(state_inimap_buf)
841 500
FORMAT (4x,
' STATE FILE:',1x,a,
' WRITTEN')
843 1000
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
845 1500
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
846 .
'/MOVE_FUNCT/',i0,/,
847 .
'move_function__',i0,/,
848 .
'# ASCALEx FSCALEy ASHIFTx FSHIFTy',/,
851 2001
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
853 .
'volume fraction submaterial_',i0,/,
854 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
855 2002
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
857 .
'mass density submaterial_',i0,/,
858 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|'
859 2003
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|'
861 .
'energy density submaterial_',i0,/,
862 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|'
863 2004
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|'
865 .
'pressure submaterial_',i0,/,
866 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|'
868 3000
FORMAT(
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
870 .
'velocity_function'/,
871 .
'#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')