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