OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
stat_inimap2d_spmd.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!|| stat_inimap2d_spmd ../engine/source/output/sta/stat_inimap2d_spmd.F
25!||--- called by ------------------------------------------------------
26!|| genstat ../engine/source/output/sta/genstat.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| quicksort ../common_source/tools/sort/quicksort.F
30!|| quicksort_i2 ../common_source/tools/sort/quicksort.F
31!|| spmd_state_inimap2d_exch_data ../engine/source/output/sta/spmd_state_inimap2d_exch_data.f
32!|| spmd_state_inimap_exch_siz ../engine/source/output/sta/spmd_state_inimap_exch_siz.F
33!||--- uses -----------------------------------------------------
34!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
35!|| element_mod ../common_source/modules/elements/element_mod.f90
36!|| matparam_def_mod ../common_source/modules/mat_elem/matparam_def_mod.F90
37!|| message_mod ../engine/share/message_module/message_mod.F
38!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
39!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
40!|| state_inimap_mod ../engine/share/modules/state_inimap_mod.F
41!||====================================================================
42 SUBROUTINE stat_inimap2d_spmd(
43 . X , V , ITAB , IPART_STATE, NODTAG ,
44 . IPART , IPARTS , IPARTQ, IPARTTG , MAT_PARAM,
45 . IGEO , IPARG , IXS , IXQ , IXTG ,
46 . ELBUF_TAB, MULTI_FVM, BUFMAT, IPM)
47C-----------------------------------------------
48C Description
49C-----------------------------------------------
50C This subroutine is generating mapping data to be used with /INIMAP2D option.
51C include file is incremented starting from ROOT_2D_0001.inimap
52C It contains 2D fonctions for submaterial data (volume fraction, mass density, energy density)
53C and also function for global velocity
54C User can use the generated file in a second run using #include command in the new Starter input file (target mesh)
55C-----------------------------------------------
56C M o d u l e s
57C-----------------------------------------------
58 USE message_mod
59 USE state_inimap_mod
60 USE elbufdef_mod
61 USE state_inimap_mod
62 USE multi_fvm_mod
63 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
64 USE matparam_def_mod, ONLY : matparam_struct_
65 use element_mod , only : nixs,nixq,nixtg
66C-----------------------------------------------
67C I m p l i c i t T y p e s
68C-----------------------------------------------
69#include "implicit_f.inc"
70C-----------------------------------------------
71C C o m m o n B l o c k s
72C-----------------------------------------------
73#include "com01_c.inc"
74#include "com04_c.inc"
75#include "com08_c.inc"
76#include "param_c.inc"
77#include "scr03_c.inc"
78#include "scr17_c.inc"
79#include "task_c.inc"
80#include "units_c.inc"
81#include "chara_c.inc"
82C-----------------------------------------------
83C D u m m y A r g u m e n t s
84C-----------------------------------------------
85 INTEGER,INTENT(IN) :: ITAB(NUMNOD), IPART(LIPART1,*),IGEO(NPROPGI,NUMGEO), IXS(NIXS,NUMELS), IPART_STATE(NPART),
86 . IPARG(NPARG,*),IXQ(NIXQ,NUMELQ),IXTG(NIXTG,NUMELTG)
87 INTEGER, INTENT(INOUT) :: NODTAG(NUMNOD), IPM(NPROPMI,*)
88 INTEGER, TARGET :: IPARTS(*),IPARTQ(*),IPARTTG(*)
89 my_real,INTENT(IN) :: x(3,numnod),v(3,numnod)
90 my_real, INTENT(IN), TARGET :: bufmat(*)
91 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET, INTENT(IN) :: ELBUF_TAB
92 TYPE(multi_fvm_struct), INTENT(IN) :: MULTI_FVM
93 TYPE(matparam_struct_) ,DIMENSION(NUMMAT) ,INTENT(IN) :: MAT_PARAM
94C-----------------------------------------------
95C L o c a l V a r i a b l e s
96C-----------------------------------------------
97 INTEGER I, N, JJ, J, IPRT, K, KK, INOD
98 INTEGER NG, NEL, NFT, LFT, LLT, ITY, ISOLNOD, NPT
99 INTEGER NUM_CENTROIDS, IPOS, MLW, NBMAT, NB2, ISUBMAT, NNOD
100 INTEGER NUVAR
101 TYPE(g_bufel_) ,POINTER :: GBUF
102 my_real min_x,min_y,min_z,max_x,max_y,max_z,p0(3),p0_inf(3),p0_sup(3),length
103 my_real shift_cy,shift_cz
104 my_real shift_ny,shift_nz
105 my_real lx,ly,lz
106 my_real dx,dy,dz
107 my_real dotprod,tol,xyz(3),vel(3),dist,vect(3)
108 CHARACTER FILNAM*100, CHSTAT*4
109 INTEGER XMIN_CELL_ID,YMIN_CELL_ID,ZMIN_CELL_ID,XMAX_CELL_ID,YMAX_CELL_ID,ZMAX_CELL_ID
110 INTEGER IS_ITY_1, IS_ITY_2, IS_ITY_7, IMAT, NPAR, IADBUF
111 INTEGER, POINTER,DIMENSION(:) :: IPART_PTR
112 my_real, POINTER,DIMENSION(:) :: uparam
113 TYPE(buf_mat_) ,POINTER :: MBUF
114 INTEGER, ALLOCATABLE, DIMENSION(:,:) :: GET_CELL_FOM_CENTROID !(NG,I+NFT)
115 INTEGER NPTS(NSPMD),NCELL(NSPMD),NPTS_TOT,NCELL_TOT
116 my_real, DIMENSION(:,:), ALLOCATABLE :: work
117 my_real :: len_(nspmd),len_tot
118 my_real :: shift_cy_min, shift_ny_min, shift_cz_min, shift_nz_min
119 INTEGER, ALLOCATABLE, DIMENSION(:) :: IDX, NODTAG_G
120 INTEGER :: CELL_ID,IDX1(21),IDX2(21),IDX3(21)
121C-----------------------------------------------
122C P r e - C o n d i t i o n
123C-----------------------------------------------
124 !IF(NUMELS+NUMELQ+NUMELTG == 0)RETURN
125
126 IF(n2d == 0)THEN
127 !N2D not yet set when running frestat.F ; check must be done later, here.
128 IF(.NOT.is_stat_inimap_msg_already_displayed)THEN
129 IF(ispmd == 0)THEN
130 CALL ancmsg(msgid=288,anmode=aninfo)
131 is_stat_inimap_msg_already_displayed = .true.
132 ENDIF
133 ENDIF
134 RETURN
135 ENDIF
136
137C-----------------------------------------------
138C S o u r c e L i n e s
139C-----------------------------------------------
140
141 !---INITIALIZATION
142 !
143 state_inimap_call_number = state_inimap_call_number +1 !number of written files ROOT_INIMAP_00**.rad
144 num_centroids = 0
145 mlw=0
146 !box containing user domain :
147 min_x = ep20
148 min_y = ep20
149 min_z = ep20
150 max_x = -ep20
151 max_y = -ep20
152 max_z = -ep20
153 !detecting elem types to manager error messages :
154 is_ity_1 = 0
155 is_ity_2 = 0
156 is_ity_7 = 0
157
158 !---ALLOCATIONS
159 !
160 IF(.NOT.(ALLOCATED(state_inimap_buf))) THEN
161 IF(ispmd/=0)THEN
162 ALLOCATE(state_inimap_buf(1))
163 ELSE
164 ALLOCATE(state_inimap_buf(nspmd)) !process 0 will gather all data
165 ENDIF
166 ENDIF
167
168 !---ENUMARATION : ELEM TYPES AND BOX DIMENSION
169 !
170 DO ng=1,ngroup
171 ity =iparg(5,ng)
172 isolnod = iparg(28,ng)
173 nel =iparg(2,ng)
174 nft =iparg(3,ng)
175 gbuf => elbuf_tab(ng)%GBUF
176 mlw = iparg(1,ng)
177 lft=1
178 llt=nel
179 npt=0
180 IF(ity == 1) THEN
181 !---bricks
182 is_ity_1=1
183 npt=isolnod
184 ipart_ptr => iparts(1:numels)
185 ELSEIF(ity == 2)THEN
186 !---quads
187 is_ity_2=1
188 npt=4
189 ipart_ptr => ipartq(1:numelq)
190 ELSEIF(ity == 7 .AND. n2d /= 0)THEN
191 !---Triangles
192 is_ity_7=1
193 npt=3
194 ipart_ptr => iparttg(1:numeltg)
195 ENDIF
196 IF(npt /= 0)THEN
197 DO i=lft,llt
198 n = i + nft
199 iprt=ipart_ptr(n)
200 imat =ipart(1,iprt)
201 IF(ipart_state(iprt)==0)cycle
202 num_centroids = num_centroids +1
203 DO k=1,npt
204 IF(is_ity_1==1)inod=ixs(1+k,n)
205 IF(is_ity_2==1)inod=ixq(1+k,n) !pass IX (pointer, argument) and nix => generic routine
206 IF(is_ity_7==1)inod=ixtg(1+k,n) !pass IX (pointer, argument) and nix => generic routine
207 IF(is_ity_1==1)nodtag(ixs(1+k,n)) = 1
208 IF(is_ity_2==1)nodtag(ixq(1+k,n)) = 1
209 IF(is_ity_7==1)nodtag(ixtg(1+k,n)) = 1
210 IF(x(1,inod)<min_x)THEN
211 min_x=x(1,inod)
212 xmin_cell_id = n
213 ENDIF
214 IF(x(2,inod)<min_y)THEN
215 min_y=x(2,inod)
216 ymin_cell_id = n
217 ENDIF
218 IF(x(3,inod)<min_z)THEN
219 min_z=x(3,inod)
220 zmin_cell_id = n
221 ENDIF
222 IF(x(1,inod)>max_x)THEN
223 max_x=x(1,inod)
224 xmax_cell_id = n
225 ENDIF
226 IF(x(2,inod)>max_y)THEN
227 max_y=x(2,inod)
228 ymax_cell_id = n
229 ENDIF
230 IF(x(3,inod)>max_z)THEN
231 max_z=x(3,inod)
232 zmax_cell_id = n
233 ENDIF
234 ENDDO
235 END DO
236 ELSE
237 !no related cells: bricks, quads, and triangles only
238 END IF
239 END do! next NG
240
241 !---NUMBERING :
242 ! +--CENTROIDS
243 state_inimap_buf(1)%NUM_CENTROIDS = num_centroids
244 state_inimap_buf(1)%NUM_POINTS = 0
245 ! +--FIRST ESTIMATION OF NODE NUMBER (DUPLICATED PROJECTIONS AT THIS STEP)
246 nnod=0
247 DO i=1,numnod
248 IF(nodtag(i) == 1)THEN
249 nnod=nnod+1
250 ENDIF
251 ENDDO
252
253 !---ANOTHER ALLOCATIONS
254 !
255 IF(.NOT.ALLOCATED(state_inimap_buf(1)%CELL_IDS))ALLOCATE(state_inimap_buf(1)%CELL_IDS(num_centroids))
256 IF(.NOT.ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(num_centroids))
257 IF(.NOT.ALLOCATED(state_inimap_buf(1)%POS2_CENTROIDS))ALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS(num_centroids))
258 IF(.NOT.ALLOCATED(get_cell_fom_centroid))THEN
259 ALLOCATE(get_cell_fom_centroid(2,num_centroids))
260 ENDIF
261
262 lx=zero
263 ly=zero
264 lz=zero
265 IF(num_centroids > 0)THEN
266 !---BOX CONTAINING USER-2D-DOMAIN
267 !
268 lx=max_x-min_x
269 ly=max_y-min_y
270 lz=max_z-min_z
271 vect(1:3)=(/lx,ly,lz/)
272 length = sqrt(vect(2)*vect(2) + vect(3)*vect(3)) !1d axis length (needed to normalize following dot products)
273 IF(is_ity_1==1)THEN
274 p0_inf(2) = sum( x(2,ixs(2:9,ymin_cell_id)) ) / npt
275 p0_inf(3) = sum( x(3,ixs(2:9,zmin_cell_id)) ) / npt
276 ELSEIF(is_ity_2==1)THEN
277 p0_inf(2) = sum( x(2,ixq(2:5,ymin_cell_id)) ) / npt
278 p0_inf(3) = sum( x(3,ixq(2:5,zmin_cell_id)) ) / npt
279 ELSEIF(is_ity_7==1)THEN
280 p0_inf(2) = sum( x(2,ixtg(2:4,ymin_cell_id)) ) / npt
281 p0_inf(3) = sum( x(3,ixtg(2:4,zmin_cell_id)) ) / npt
282 ENDIF
283 shift_cy = p0_inf(2)
284 shift_cz = p0_inf(3)
285 state_inimap_buf(1)%SHIFT_Cy = shift_cy
286 state_inimap_buf(1)%SHIFT_Cz = shift_cz
287 state_inimap_buf(1)%LENGTH = length
288 ELSE
289 state_inimap_buf(1)%SHIFT_Cy = zero
290 state_inimap_buf(1)%SHIFT_Cz = zero
291 state_inimap_buf(1)%LENGTH = zero
292 ENDIF
293
294 !---STARTING POINT OF FIRST NODE IN GENERAL FRAME (SHIFT_N)
295 ! SHIFT_N : nodal posisiton (first node along axis)
296 ! SHIFT_C : cell centroid position (first centroid along axis)
297 ! by nature : SHIFT_N < SHIFT_C
298 !
299 shift_ny=min_y
300 shift_nz=min_z
301 state_inimap_buf(1)%SHIFT_Ny = shift_ny
302 state_inimap_buf(1)%SHIFT_Nz = shift_nz
303
304 !---ABSCISSA : CENTROIDS POSITION LIST ( STATE_INIMAP_BUF(1)%POS_CENTROIDS(1:NUM_CENTROIDS) )
305 !
306 ALLOCATE(work(num_centroids,3))
307 k=1
308 DO ng=1,ngroup
309 ity =iparg(5,ng)
310 isolnod = iparg(28,ng)
311 nel =iparg(2,ng)
312 nft =iparg(3,ng)
313 gbuf => elbuf_tab(ng)%GBUF
314 mlw = iparg(1,ng)
315 lft=1
316 llt=nel
317 IF(npt /= 0)THEN
318 DO i=lft,llt
319 n = i + nft
320 iprt=ipart_ptr(n)
321 IF(ipart_state(iprt)==0)cycle
322 !pointer here
323 IF(is_ity_1==1)THEN
324 p0(2) = sum( x(2,ixs(2:9,n)) ) / npt
325 p0(3) = sum( x(3,ixs(2:9,n)) ) / npt
326 cell_id = ixs(nixs,n)
327 ELSEIF(is_ity_2==1)THEN
328 p0(2) = sum( x(2,ixq(2:5,n)) ) / npt
329 p0(3) = sum( x(3,ixq(2:5,n)) ) / npt
330 cell_id = ixq(nixq,n)
331 ELSEIF(is_ity_7==1)THEN
332 p0(2) = sum( x(2,ixtg(2:4,n)) ) / npt
333 p0(3) = sum( x(3,ixtg(2:4,n)) ) / npt
334 cell_id = ixtg(nixtg,n)
335 ENDIF
336 !STATE_INIMAP_BUF(1)%POS_CENTROIDS(K) = P0(2)
337 !STATE_INIMAP_BUF(1)%POS2_CENTROIDS(K) = P0(3)
338 !STATE_INIMAP_BUF(1)%CELL_IDS(K) = CELL_ID
339 work(k,1) = p0(2)
340 work(k,2) = p0(3)
341 work(k,3) = cell_id ! bug in sp if CELL_ID > 16M
342 get_cell_fom_centroid(1,k) = ng
343 get_cell_fom_centroid(2,k) = i
344 k=k+1
345 END DO
346 END IF
347 END do! next NG
348
349
350 !---SORTING : UNIQUE OUTPUT NOT DEPENDING ON DOMAIN DECOMPOSITION (by cell_ids)
351 IF(.NOT.ALLOCATED(idx))ALLOCATE(idx(num_centroids))
352 DO k=1,num_centroids ; idx(k)=k; ENDDO
353 IF(num_centroids>0) CALL quicksort(work(:,3), idx, 1, num_centroids)
354
355 DO k=1,num_centroids
356 state_inimap_buf(1)%POS_CENTROIDS(k) = work(idx(k),1)
357 state_inimap_buf(1)%POS2_CENTROIDS(k) = work(idx(k),2)
358 state_inimap_buf(1)%CELL_IDS(k) = work(k,3) ! bug in SP if WORK(K,3) > 16M
359 ENDDO
360 IF(ALLOCATED(work))DEALLOCATE(work)
361
362
363 !---CELL DATA TREATMENT
364 ! storing submaterial data : vfrac,rho,E
365 !
366 IF(num_centroids > 0)THEN
367 IF(mlw==151)THEN
368 nbmat = multi_fvm%NBMAT
369 ELSEIF(mlw==51)THEN
370 nbmat = 4
371 ELSE
372 nbmat = 1
373 ENDIF
374 state_inimap_buf(1)%MLW = mlw
375 state_inimap_buf(1)%NSUBMAT = nbmat
376 ALLOCATE(state_inimap_buf(1)%SUBMAT(nbmat))
377 DO i=1,nbmat
378 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%VFRAC(num_centroids))
379 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%RHO(num_centroids))
380 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%E(num_centroids))
381 ALLOCATE(state_inimap_buf(1)%SUBMAT(i)%PRES(num_centroids))
382 ENDDO
383 IF(mlw==151)THEN
384 !velocities
385 state_inimap_buf(1)%NUM_POINTS = num_centroids
386 IF(.NOT.ALLOCATED(state_inimap_buf(1)%POS_NODES))ALLOCATE(state_inimap_buf(1)%POS_NODES(num_centroids))
387 IF(.NOT.ALLOCATED(state_inimap_buf(1)%POS2_NODES))ALLOCATE(state_inimap_buf(1)%POS2_NODES(num_centroids))
388 IF(.NOT.ALLOCATED(state_inimap_buf(1)%VEL_NODES))ALLOCATE(state_inimap_buf(1)%VEL_NODES(num_centroids))
389 IF(.NOT.ALLOCATED(state_inimap_buf(1)%VEL2_NODES))ALLOCATE(state_inimap_buf(1)%VEL2_NODES(num_centroids))
390 IF(.NOT.ALLOCATED(state_inimap_buf(1)%NODE_IDS))ALLOCATE(state_inimap_buf(1)%NODE_IDS(num_centroids))
391
392 DO k=1, num_centroids
393 ng = get_cell_fom_centroid(1,idx(k))
394 i = get_cell_fom_centroid(2,idx(k))
395 nft = iparg(3,ng)
396 state_inimap_buf(1)%POS_NODES(k) = state_inimap_buf(1)%POS_CENTROIDS(k)
397 state_inimap_buf(1)%POS2_NODES(k) = state_inimap_buf(1)%POS2_CENTROIDS(k)
398 state_inimap_buf(1)%VEL_NODES(k) = multi_fvm%VEL(2,i+nft)
399 state_inimap_buf(1)%VEL2_NODES(k) = multi_fvm%VEL(3,i+nft)
400 state_inimap_buf(1)%NODE_IDS(k) = state_inimap_buf(1)%CELL_IDS(k)
401 ENDDO
402 !submat
403 DO isubmat=1,nbmat
404 DO k=1, num_centroids
405 ng = get_cell_fom_centroid(1,idx(k))
406 i = get_cell_fom_centroid(2,idx(k))
407 nft = iparg(3,ng)
408 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = multi_fvm%PHASE_ALPHA(isubmat,i+nft)
409 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = multi_fvm%PHASE_RHO(isubmat,i+nft)
410 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = multi_fvm%PHASE_EINT(isubmat,i+nft)
411 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = multi_fvm%PRES(i+nft)
412 ENDDO
413 ENDDO
414 ELSEIF(mlw==51)THEN
415 nb2=0
416 DO isubmat=1,nbmat
417 DO k=1, num_centroids
418 ng = get_cell_fom_centroid(1,idx(k))
419 i = get_cell_fom_centroid(2,idx(k))
420 nft = iparg(3,ng)
421 nel = iparg(2,ng)
422 n = i + nft
423 iprt=ipart_ptr(n)
424 imat =ipart(1,iprt)
425 IF(mat_param(imat)%MULTIMAT%MID(isubmat) == 0)EXIT !submaterial not defined.
426 nb2=max(nb2,ipm(5,imat))
427 iadbuf = ipm(7,imat)
428 npar = ipm(9,imat)
429 nuvar = ipm(8,imat)
430 uparam => bufmat(iadbuf:iadbuf+npar-1)
431 kk = m51_n0phas + (uparam(276+isubmat)-1)*m51_nvphas ! bug in SP if (UPARAM(276+ISUBMAT)-1)*M51_NVPHAS > 16M
432 mbuf => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)
433 state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k) = mbuf%VAR(nel*(01+kk-1)+i)
434 state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k) = mbuf%VAR(nel*(12+kk-1)+i)
435 state_inimap_buf(1)%SUBMAT(isubmat)%E(k) = mbuf%VAR(nel*(08+kk-1)+i)
436 state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k) = mbuf%VAR(nel*(18+kk-1)+i)
437 ENDDO
438 ENDDO
439 state_inimap_buf(1)%NSUBMAT = nb2
440 ELSE !---mono-material laws
441 DO k=1, num_centroids
442 ng = get_cell_fom_centroid(1,idx(k))
443 i = get_cell_fom_centroid(2,idx(k))
444 gbuf => elbuf_tab(ng)%GBUF
445 nel =iparg(2,ng)
446 state_inimap_buf(1)%SUBMAT(1)%VFRAC(k) = 1.d00
447 state_inimap_buf(1)%SUBMAT(1)%RHO(k) = gbuf%RHO(i)
448 state_inimap_buf(1)%SUBMAT(1)%E(k) = gbuf%EINT(i)
449 state_inimap_buf(1)%SUBMAT(1)%PRES(k) = -third * (gbuf%SIG(i) + gbuf%SIG(i + nel) + gbuf%SIG(i + 2 * nel))
450 ENDDO
451 ENDIF
452 ENDIF
453
454 !---VELOCITY TREATMENT FOR STAGGERED SCHEME
455 !
456 IF(num_centroids > 0)THEN
457 IF(mlw /= 151)THEN
458 ALLOCATE(work(numnod,4))
459 !---VELOCITY : WRITE IN DOMAIN BUFFER (SORTED)
460 IF(.NOT.ALLOCATED(state_inimap_buf(1)%POS_NODES))ALLOCATE(state_inimap_buf(1)%POS_NODES(nnod))
461 IF(.NOT.ALLOCATED(state_inimap_buf(1)%POS2_NODES))ALLOCATE(state_inimap_buf(1)%POS2_NODES(nnod))
462 IF(.NOT.ALLOCATED(state_inimap_buf(1)%VEL_NODES))ALLOCATE(state_inimap_buf(1)%VEL_NODES(nnod))
463 IF(.NOT.ALLOCATED(state_inimap_buf(1)%VEL2_NODES))ALLOCATE(state_inimap_buf(1)%VEL2_NODES(nnod))
464 IF(.NOT.ALLOCATED(state_inimap_buf(1)%NODE_IDS))ALLOCATE(state_inimap_buf(1)%NODE_IDS(nnod))
465 nnod=0
466 DO i=1,numnod
467 IF(nodtag(i) == 1)THEN
468 nnod=nnod+1
469 !STATE_INIMAP_BUF(1)%POS_NODES(NNOD) = X(2,I)
470 !STATE_INIMAP_BUF(1)%POS2_NODES(NNOD) = X(3,I)
471 !STATE_INIMAP_BUF(1)%VEL_NODES(NNOD) = V(2,I)
472 !STATE_INIMAP_BUF(1)%VEL2_NODES(NNOD) = V(3,I)
473 work(nnod,1) = x(2,i)
474 work(nnod,2) = x(3,i)
475 work(nnod,3) = v(2,i)
476 work(nnod,4) = v(3,i)
477 state_inimap_buf(1)%NODE_IDS(nnod) = itab(i)
478 ENDIF
479 ENDDO
480 state_inimap_buf(1)%NUM_POINTS=nnod
481 !---SORTING : UNIQUE OUTPUT NOT DEPENDING ON DOMAIN DECOMPOSITION
482 IF(ALLOCATED(idx))DEALLOCATE(idx)
483 IF(.NOT.ALLOCATED(idx))ALLOCATE(idx(nnod))
484 DO k=1,nnod ; idx(k)=k; ENDDO
485 CALL quicksort_i2(state_inimap_buf(1)%NODE_IDS(:), idx, 1, nnod)
486 DO k=1,nnod
487 state_inimap_buf(1)%POS_NODES(k) = work(idx(k),1)
488 state_inimap_buf(1)%POS2_NODES(k) = work(idx(k),2)
489 state_inimap_buf(1)%VEL_NODES(k) = work(idx(k),3)
490 state_inimap_buf(1)%VEL2_NODES(k) = work(idx(k),4)
491 ENDDO
492 IF(ALLOCATED(work))DEALLOCATE(work)
493
494
495 ELSE
496 !LAW 151 (colocated)
497 !already doneabove
498 ENDIF
499 ENDIF
500
501C-----------------------------------------------
502C S P M D E x c h a n g e
503C-----------------------------------------------
504 IF(nspmd > 1)THEN
505 CALL spmd_state_inimap_exch_siz()
506 CALL spmd_state_inimap2d_exch_data()
507 !
508 IF(ispmd == 0)THEN
509 shift_cy_min = state_inimap_buf(1)%SHIFT_Cy
510 shift_ny_min = state_inimap_buf(1)%SHIFT_Ny
511 shift_cz_min = state_inimap_buf(1)%SHIFT_Cz
512 shift_nz_min = state_inimap_buf(1)%SHIFT_Nz
513 DO i=2,nspmd
514 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)cycle
515 shift_cy_min =min(shift_cy_min, state_inimap_buf(i)%SHIFT_Cy)
516 shift_ny_min =min(shift_ny_min, state_inimap_buf(i)%SHIFT_Ny)
517 shift_cz_min =min(shift_cz_min, state_inimap_buf(i)%SHIFT_Cz)
518 shift_nz_min =min(shift_nz_min, state_inimap_buf(i)%SHIFT_Nz)
519 ENDDO
520 state_inimap_buf(1)%SHIFT_Cy = shift_cy_min
521 state_inimap_buf(1)%SHIFT_Ny = shift_ny_min
522 state_inimap_buf(1)%SHIFT_Cz = shift_cz_min
523 state_inimap_buf(1)%SHIFT_Nz = shift_nz_min
524 ENDIF
525 ENDIF
526
527C-----------------------------------------------
528C S P M D - G a t h e r i n g & S o r t i n g
529C-----------------------------------------------
530 len_tot=state_inimap_buf(1)%LENGTH ;
531 ncell_tot = state_inimap_buf(1)%NUM_CENTROIDS ;
532 IF(ispmd == 0 .AND. nspmd > 1)THEN
533 !--cumulated dimensions
534 !
535 npts_tot = 0
536 ncell_tot = 0
537 len_tot = zero
538 DO i=1,nspmd
539 IF(state_inimap_buf(i)%NUM_CENTROIDS==0)THEN
540 npts(i)=0
541 len_(i)=zero
542 ncell(i)=0
543 cycle
544 ENDIF
545 npts(i)= state_inimap_buf(i)%NUM_POINTS ;
546 npts_tot=npts_tot+npts(i)
547 len_(i)=state_inimap_buf(i)%LENGTH ;
548 len_tot=len_tot+len_(i)
549 ncell(i)= state_inimap_buf(i)%NUM_CENTROIDS ;
550 ncell_tot = ncell_tot + ncell(i)
551 ENDDO
552 ALLOCATE(work(npts_tot,5))
553 !stat_inimap1d_mp.F
554 !--gathering velocity into working_array
555 !
556 j=0
557 DO i=1,nspmd
558 DO k=1,npts(i)
559 j=j+1
560 work(j,1) = state_inimap_buf(i)%POS_NODES(k)
561 work(j,2) = state_inimap_buf(i)%POS2_NODES(k)
562 work(j,3) = state_inimap_buf(i)%VEL_NODES(k)
563 work(j,4) = state_inimap_buf(i)%VEL2_NODES(k)
564 work(j,5) = state_inimap_buf(i)%NODE_IDS(k)
565 ENDDO
566 ENDDO
567
568 !---SORTING : UNIQUE OUTPUT NOT DEPENDING ON DOMAIN DECOMPOSITION
569 IF(ALLOCATED(idx))DEALLOCATE(idx)
570 IF(.NOT.ALLOCATED(idx))ALLOCATE(idx(npts_tot))
571 DO k=1,npts_tot ; idx(k)=k; ENDDO
572 CALL quicksort(work(:,5), idx, 1, npts_tot)
573
574
575 !--- Remove duplicates (possible Common Nodes on Adjacent Domains)
576 ! STAGGERED SCHEME ONLY
577 !
578 IF(mlw /= 151)THEN
579 ALLOCATE(nodtag_g(npts_tot))
580 nodtag_g(1:npts_tot)=1
581 k=0
582 DO j=2,npts_tot
583 IF(work(j,5) == work(j-1,5))THEN
584 nodtag_g(j)=0
585 k=k+1
586 ENDIF
587 ENDDO
588 ELSE
589 k=npts_tot
590 ENDIF
591 !
592 !---store in relevant buffer (reallocate)
593 !
594 state_inimap_buf(1)%NUM_POINTS=k
595 IF(ALLOCATED(state_inimap_buf(1)%VEL_NODES))DEALLOCATE(state_inimap_buf(1)%VEL_NODES)
596 IF(ALLOCATED(state_inimap_buf(1)%VEL2_NODES))DEALLOCATE(state_inimap_buf(1)%VEL2_NODES)
597 IF(ALLOCATED(state_inimap_buf(1)%POS_NODES))DEALLOCATE(state_inimap_buf(1)%POS_NODES)
598 IF(ALLOCATED(state_inimap_buf(1)%POS2_NODES))DEALLOCATE(state_inimap_buf(1)%POS2_NODES)
599 IF(ALLOCATED(state_inimap_buf(1)%NODE_IDS))DEALLOCATE(state_inimap_buf(1)%NODE_IDS)
600 ALLOCATE(state_inimap_buf(1)%VEL_NODES(npts_tot), state_inimap_buf(1)%VEL2_NODES(npts_tot)) !k : npt_tot without duplicated
601 ALLOCATE(state_inimap_buf(1)%POS_NODES(npts_tot), state_inimap_buf(1)%POS2_NODES(npts_tot))
602 ALLOCATE(state_inimap_buf(1)%NODE_IDS(npts_tot))
603 j=0
604 DO k=1,npts_tot
605 IF(mlw /= 151)THEN
606 IF(nodtag_g(k)==0)cycle
607 ENDIF
608 j=j+1
609 state_inimap_buf(1)%POS_NODES(j)=work(idx(k),1)
610 state_inimap_buf(1)%POS2_NODES(j)=work(idx(k),2)
611 state_inimap_buf(1)%VEL_NODES(j)=work(idx(k),3)
612 state_inimap_buf(1)%VEL2_NODES(j)=work(idx(k),4)
613 state_inimap_buf(1)%NODE_IDS(j)=work(k,5) !already sorted
614 ENDDO
615 npts_tot = j
616 state_inimap_buf(1)%NUM_POINTS=npts_tot
617 IF(ALLOCATED(work))DEALLOCATE(work)
618 IF(ALLOCATED(nodtag_g))DEALLOCATE(nodtag_g)
619
620 nbmat=1
621 DO i=1,nspmd
622 nbmat=max(nbmat,state_inimap_buf(i)%NSUBMAT)
623 ENDDO
624 ALLOCATE(work(ncell_tot,3+4*nbmat))
625 !
626 !--gathering submaterial data into working_array (duplicates are not possible with centroids)
627 !
628 j=0
629 DO i=1,nspmd
630 DO k=1,ncell(i)
631 j=j+1
632 work(j,1) = state_inimap_buf(i)%POS_CENTROIDS(k)
633 work(j,2) = state_inimap_buf(i)%POS2_CENTROIDS(k)
634 work(j,3) = float(state_inimap_buf(i)%CELL_IDS(k))
635 nbmat = state_inimap_buf(i)%NSUBMAT
636 DO jj=1,nbmat
637 work(j,3+ 4*(jj-1)+1) = state_inimap_buf(i)%SUBMAT(jj)%VFRAC(k)
638 work(j,3+ 4*(jj-1)+2) = state_inimap_buf(i)%SUBMAT(jj)%RHO(k)
639 work(j,3+ 4*(jj-1)+3) = state_inimap_buf(i)%SUBMAT(jj)%E(k)
640 work(j,3+ 4*(jj-1)+4) = state_inimap_buf(i)%SUBMAT(jj)%PRES(k)
641 ENDDO
642 ENDDO
643 ENDDO
644 !
645 !---store in relevant buffer (reallocate)
646 !
647 IF(ALLOCATED(state_inimap_buf(1)%POS_CENTROIDS))DEALLOCATE(state_inimap_buf(1)%POS_CENTROIDS)
648 IF(ALLOCATED(state_inimap_buf(1)%POS2_CENTROIDS))DEALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS)
649 IF(ALLOCATED(state_inimap_buf(1)%CELL_IDS))DEALLOCATE(state_inimap_buf(1)%CELL_IDS)
650 nbmat = state_inimap_buf(1)%NSUBMAT
651 DO jj=1,nbmat
652 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%VFRAC))DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC)
653 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%RHO ))DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO)
654 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%E ))DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E)
655 IF(ALLOCATED(state_inimap_buf(1)%SUBMAT(jj)%PRES))DEALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES)
656 ENDDO
657 ALLOCATE(state_inimap_buf(1)%CELL_IDS(ncell_tot))
658 ALLOCATE(state_inimap_buf(1)%POS_CENTROIDS(ncell_tot))
659 ALLOCATE(state_inimap_buf(1)%POS2_CENTROIDS(ncell_tot))
660 DO jj=1,nbmat
661 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%VFRAC(ncell_tot))
662 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%RHO(ncell_tot))
663 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%E(ncell_tot))
664 ALLOCATE(state_inimap_buf(1)%SUBMAT(jj)%PRES(ncell_tot))
665 ENDDO
666 !---SORTING : UNIQUE OUTPUT NOT DEPENDING ON DOMAIN DECOMPOSITION
667 IF(ALLOCATED(idx))DEALLOCATE(idx)
668 IF(.NOT.ALLOCATED(idx))ALLOCATE(idx(ncell_tot))
669 DO k=1,ncell_tot ; idx(k)=k; ENDDO
670 CALL quicksort(work(:,3), idx, 1, ncell_tot)
671
672 DO j=1,ncell_tot
673 state_inimap_buf(1)%POS_CENTROIDS(j)=work(idx(j),1)
674 state_inimap_buf(1)%POS2_CENTROIDS(j)=work(idx(j),2)
675 state_inimap_buf(1)%CELL_IDS(j)=int(work(j,3))
676 nbmat = state_inimap_buf(1)%NSUBMAT
677 DO jj=1,nbmat
678 state_inimap_buf(1)%SUBMAT(jj)%VFRAC(j)=work(idx(j),3+ 4*(jj-1)+1)
679 state_inimap_buf(1)%SUBMAT(jj)%RHO(j)=work(idx(j),3+ 4*(jj-1)+2)
680 state_inimap_buf(1)%SUBMAT(jj)%E(j)=work(idx(j),3+ 4*(jj-1)+3)
681 state_inimap_buf(1)%SUBMAT(jj)%PRES(j)=work(idx(j),3+ 4*(jj-1)+4)
682 ENDDO
683 ENDDO
684 state_inimap_buf(1)%NUM_CENTROIDS = ncell_tot
685 state_inimap_buf(1)%LENGTH = len_tot
686
687 endif! IF(ISPMD == 0 .AND. NSPMD > 1)THEN
688
689 IF(ispmd == 0)THEN
690 IF(ncell_tot == 0 .OR. len_tot == zero)THEN
691 CALL ancmsg(msgid=284,anmode=aninfo,c1=" -- 2D DOMAIN IS NOT DETECTED : CHECK X-PROJECTION")
692 return
693 ELSEIF(len_tot > 0 .AND. ncell_tot > 0)THEN
694 IF(lx/len_tot > em06)THEN
695 CALL ancmsg(msgid=284,anmode=aninfo,c1=" -- 2D DOMAIN IS NOT DETECTED.")
696 return
697 ENDIF
698 ENDIF
699 ENDIF
700
701C-----------------------------------------------
702C O u t p u t F i l e
703C-----------------------------------------------
704
705 !---OUTPUT FILE HEADER
706 !
707 IF(ispmd == 0)THEN
708 WRITE(chstat,'(I4.4)')state_inimap_call_number
709 filnam=rootnam(1:rootlen)//'_2D_'//chstat//'.inimap'
710 OPEN(unit=220582,file=filnam(1:len(trim(filnam))),access='SEQUENTIAL',form='FORMATTED',status='UNKNOWN')
711 WRITE(unit=220582,fmt='(A,I10)') '#state file for mappgin with /INIMAP2D, iteration = ',state_inimap_call_number
712 WRITE(unit=220582,fmt='(A,A)') '# ROOTNAME = ',rootnam(1:rootlen)
713 WRITE(unit=220582,fmt='(A,I0)') '# VERSION = ',st_invers
714 WRITE(unit=220582,fmt='(A,F20.13)')'# TIME = ',tt
715 WRITE(unit=220582,fmt='(A,I10)') '# NCYCLE = ',ncycle
716 WRITE(unit=220582,fmt='(A,I10)') '# NCELL = ',ncell_tot
717 !WRITE(UNIT=220582,FMT='(A)')'#//SUBMODEL/1'
718 !WRITE(UNIT=220582,FMT='(A)')'#MAPPING DATA (FUNCTIONS)'
719 !WRITE(UNIT=220582,FMT='(A)')"## off_def off_nod off_ele off_part off_mat off_type off_sub"
720 !WRITE(UNIT=220582,FMT='(A1,7I10)')'#',1000, 0, 0, 0, 0, 0, 0
721 ENDIF
722
723 IF(ispmd == 0)THEN
724 !--- OUTPUT FUNCTION FROM CELL DATA BUFFER ---!
725 nbmat = state_inimap_buf(1)%NSUBMAT
726 shift_cy = state_inimap_buf(1)%SHIFT_Cy
727 shift_ny = state_inimap_buf(1)%SHIFT_Ny
728 shift_cz = state_inimap_buf(1)%SHIFT_Cz
729 shift_nz = state_inimap_buf(1)%SHIFT_Nz
730 num_centroids = state_inimap_buf(1)%NUM_CENTROIDS
731 !---volume fractions
732 ipos=0 !1:1+21
733 DO isubmat = 1,nbmat
734 WRITE(unit=220582,fmt=2001)ipos+isubmat,isubmat
735 DO k=1, num_centroids
736 WRITE(unit=220582,fmt='(3E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
737 . ,state_inimap_buf(1)%POS2_CENTROIDS(k)
738 . ,state_inimap_buf(1)%SUBMAT(isubmat)%VFRAC(k)
739 ENDDO
740 !WRITE(UNIT=220582,FMT=1500)IPOS+ISUBMAT,IPOS+ISUBMAT,1.00,1.00,-SHIFT_Ny,-SHIFT_Nz
741 ENDDO
742 !---mass densities
743 ipos=100 !31:31+21
744 DO isubmat = 1,nbmat
745 WRITE(unit=220582,fmt=2002)ipos+isubmat,isubmat
746 DO k=1, num_centroids
747 WRITE(unit=220582,fmt='(3E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
748 . ,state_inimap_buf(1)%POS2_CENTROIDS(k)
749 . ,state_inimap_buf(1)%SUBMAT(isubmat)%RHO(k)
750 ENDDO
751 !WRITE(UNIT=220582,FMT=1500)IPOS+ISUBMAT,IPOS+ISUBMAT,1.00,1.00,-SHIFT_Ny,-SHIFT_Nz
752 ENDDO
753 !---energy density
754 ipos=200 !31:31+21
755 DO isubmat = 1,nbmat
756 WRITE(unit=220582,fmt=2003)ipos+isubmat,isubmat
757 DO k=1, num_centroids
758 WRITE(unit=220582,fmt='(3E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
759 . ,state_inimap_buf(1)%POS2_CENTROIDS(k)
760 . ,state_inimap_buf(1)%SUBMAT(isubmat)%E(k)
761 ENDDO
762 !WRITE(UNIT=220582,FMT=1500)IPOS+ISUBMAT,IPOS+ISUBMAT,1.00,1.00,-SHIFT_Ny,-SHIFT_Nz
763 ENDDO
764 !---pressure fraction
765 ipos=300 !91:91+21
766 DO isubmat = 1,nbmat
767 WRITE(unit=220582,fmt=2004)ipos+isubmat,isubmat
768 DO k=1, num_centroids
769 WRITE(unit=220582,fmt='(3E20.12)') state_inimap_buf(1)%POS_CENTROIDS(k)
770 . ,state_inimap_buf(1)%POS2_CENTROIDS(k)
771 . ,state_inimap_buf(1)%SUBMAT(isubmat)%PRES(k)
772 ENDDO
773 !WRITE(UNIT=220582,FMT=1500)IPOS+ISUBMAT,IPOS+ISUBMAT,1.00,1.00,-SHIFT_Ny,-SHIFT_Nz
774 ENDDO
775 !--- OUTPUT VELOCITY FUNCTION ---!
776 !
777 WRITE(unit=220582,fmt=3000)
778 DO jj=1,state_inimap_buf(1)%NUM_POINTS
779 WRITE(unit=220582,fmt='(4E20.12,I10)')
780 . state_inimap_buf(1)%POS_NODES(jj) ,state_inimap_buf(1)%POS2_NODES(jj),
781 . state_inimap_buf(1)%VEL_NODES(jj), state_inimap_buf(1)%VEL2_NODES(jj)
782 ENDDO
783 !WRITE(UNIT=220582,FMT=1500)400,400,1.00,1.00,-SHIFT_Ny,-SHIFT_Nz
784 ENDIF
785
786C-----------------------------------------------
787C D e a l l o c a t e & C l o s e
788C-----------------------------------------------
789 IF(ispmd == 0)THEN
790 !---DEALLOCATE
791 IF(ALLOCATED(get_cell_fom_centroid))DEALLOCATE(get_cell_fom_centroid)
792 DO jj=1,nspmd
793 nbmat = state_inimap_buf(jj)%NSUBMAT
794 IF(ALLOCATED(state_inimap_buf(jj)%SUBMAT))THEN
795 DO i=1,nbmat
796 IF(ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%VFRAC))DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%VFRAC)
797 IF(ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%RHO)) DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%RHO)
798 IF(ALLOCATED(state_inimap_buf(jj)%SUBMAT(i)%E)) DEALLOCATE(state_inimap_buf(jj)%SUBMAT(i)%E)
799 ENDDO
800 ENDIF
801 IF(ALLOCATED(state_inimap_buf(jj)%SUBMAT ))DEALLOCATE(state_inimap_buf(jj)%SUBMAT)
802 IF(ALLOCATED(state_inimap_buf(jj)%POS_NODES ))DEALLOCATE(state_inimap_buf(jj)%POS_NODES)
803 IF(ALLOCATED(state_inimap_buf(jj)%VEL_NODES ))DEALLOCATE(state_inimap_buf(jj)%VEL_NODES)
804 IF(ALLOCATED(state_inimap_buf(jj)%POS2_NODES ))DEALLOCATE(state_inimap_buf(jj)%POS2_NODES)
805 IF(ALLOCATED(state_inimap_buf(jj)%VEL2_NODES ))DEALLOCATE(state_inimap_buf(jj)%VEL2_NODES)
806 IF(ALLOCATED(state_inimap_buf(jj)%NODE_IDS ))DEALLOCATE(state_inimap_buf(jj)%NODE_IDS)
807 IF(ALLOCATED(state_inimap_buf(jj)%POS_CENTROIDS))DEALLOCATE(state_inimap_buf(jj)%POS_CENTROIDS)
808 IF(ALLOCATED(state_inimap_buf(jj)%POS_CENTROIDS))DEALLOCATE(state_inimap_buf(jj)%POS2_CENTROIDS)
809 IF(ALLOCATED(state_inimap_buf(jj)%CELL_IDS))DEALLOCATE(state_inimap_buf(jj)%CELL_IDS)
810 ENDDO
811
812 !---OUTPUT FILE : FOOTER & CLOSE
813 WRITE(unit=220582,fmt=1000)
814 !WRITE(UNIT=220582,FMT='(A)')'#//ENDSUB'
815
816
817 idx1=(/1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21/) !vfrac
818 idx2=100+idx1 !rho
819 idx3=300+idx1 !pressure
820 IF(is_stat_inimap_vp)THEN
821 WRITE(unit=220582,fmt='(A)') '#/INIMAP2D/VP/1'
822 ELSE
823 WRITE(unit=220582,fmt='(A)') '#/INIMAP2D/VE/1'
824 ENDIF
825 WRITE(unit=220582,fmt='(A)') '#default input to update from /STATE/INIMAP2D'
826 WRITE(unit=220582,fmt='(A)') '## Node1 Node2 Node3'
827 WRITE(unit=220582,fmt='(A)') '# 0 0 0'
828 WRITE(unit=220582,fmt='(A)') '## Grbric Grquad Grtria'
829 WRITE(unit=220582,fmt='(A)') '# 0 0 0'
830 WRITE(unit=220582,fmt='(A)') '## Fct_v Fscale_v'
831 WRITE(unit=220582,fmt='(A)') '# 400 1.0'
832 DO imat=1,min(21,nbmat)
833 WRITE(unit=220582,fmt='(A)') '## Fct_vf Fct_rho Fscale_rho Fct_p Fscale_p'
834 WRITE(unit=220582,fmt='(A1,I10,2(I10,F20.0))')'#', idx1(imat),idx2(imat),1.0,idx3(imat),1.0
835 ENDDO
836 WRITE(unit=220582,fmt=1000)
837
838 WRITE (iout,500) filnam(1:len(trim(filnam)))
839 WRITE (istdo,500) filnam(1:len(trim(filnam)))
840
841 CLOSE(unit=220582)
842
843 ENDIF
844
845 IF(ALLOCATED(state_inimap_buf))DEALLOCATE(state_inimap_buf)
846
847
848
849
850
851C-----------------------------------------------
852C O u t p u t F o r m a t
853C-----------------------------------------------
854
855 500 FORMAT (4x,' STATE FILE:',1x,a,' WRITTEN')
856
857 1000 FORMAT('#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
858
859 2001 FORMAT('#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
860 . '/FUNC_2D/',i0,/,
861 . 'volume fraction submaterial_',i0,/,
862 . ' 1',/,
863 . '#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
864 2002 FORMAT('#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
865 . '/FUNC_2D/',i0,/,
866 . 'mass density submaterial_',i0,/,
867 . ' 1',/,
868 . '#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
869 2003 FORMAT('#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
870 . '/FUNC_2D/',i0,/,
871 . 'energy density submaterial_',i0,/,
872 . ' 1',/,
873 . '#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
874 2004 FORMAT('#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
875 . '/FUNC_2D/',i0,/,
876 . 'pressure submaterial_',i0,/,
877 . ' 1',/,
878 . '#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
879
880 3000 FORMAT('#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|',/,
881 . '/FUNC_2D/400',/,
882 . 'velocity_function'/,
883 . ' 2',/,
884 . '#---1----|----2----|----3----|----4----|----5----|----6----|----7----|----8----|----9----|---10----|')
885C-----------------------------------------------
886 RETURN
887 END SUBROUTINE stat_inimap2d_spmd
888
889
890
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
message_mod
Definition message_mod.F:1257
state_inimap_mod
Definition state_inimap_mod.F:38
state_inimap_mod::state_inimap_call_number
integer state_inimap_call_number
Definition state_inimap_mod.F:40
state_inimap_mod::state_inimap_buf
type(map_struct), dimension(:), allocatable state_inimap_buf
Definition state_inimap_mod.F:84
state_inimap_mod::is_stat_inimap_msg_already_displayed
logical is_stat_inimap_msg_already_displayed
Definition state_inimap_mod.F:90
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
quicksort
recursive subroutine quicksort(a, idx, first, last)
Definition quicksort.F:34
spmd_state_inimap2d_exch_data
subroutine spmd_state_inimap2d_exch_data()
Definition spmd_state_inimap2d_exch_data.F:34
spmd_state_inimap_exch_siz
subroutine spmd_state_inimap_exch_siz()
Definition spmd_state_inimap_exch_siz.F:36
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:895
stat_inimap2d_spmd
subroutine stat_inimap2d_spmd(x, v, itab, ipart_state, nodtag, ipart, iparts, ipartq, iparttg, mat_param, igeo, iparg, ixs, ixq, ixtg, elbuf_tab, multi_fvm, bufmat, ipm)
Definition stat_inimap2d_spmd.F:47