34 1 NOM_OPT ,INOM_OPT ,ITAB ,V ,VR ,
35 2 W ,TEMP ,INICRACK ,FVM_INIVEL,
50#include "implicit_f.inc"
58#include "tabsiz_c.inc"
59#include "com_xfem1.inc"
63 INTEGER,
INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
64 INTEGER,
INTENT(IN) :: ITAB(NUMNOD)
65 TYPE (FVM_INIVEL_STRUCT),
DIMENSION(NINVEL),
INTENT(IN) :: FVM_INIVEL
118 . v(3,numnod), vr(svr),
122 TYPE (INICRACK_) ,
DIMENSION(NINICRACK) :: INICRACK
126 INTEGER I,II,JJ,MY_ID,MY_NODE,POSI(NINIGRAV+1),IDS(),IDX(NINIGRAV),
127 . IDS2(NINICRACK),IDX2(NINICRACK)
128 CHARACTER(LEN=NCHARTITLE) :: TITR
129 CHARACTER (LEN=255) :: VARNAME
139 my_id = itab(my_node)
142 IF(v(i,my_node)/=zero)
THEN
145 WRITE(varname,
'(A,I0,A,I0)')
'V_',my_id,
'_',i
146 temp_double = v(i,my_node)
147 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
153 IF(vr(3*(my_node-1)+i)/=zero)
THEN
156 WRITE(varname,
'(A,I0,A,I0)')
'VR_',my_id,
'_',i
157 temp_double = vr(3*(my_node-1)+i)
158 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
165 IF (fvm_inivel(ii)%FLAG)
THEN
166 WRITE(varname,
'(A, I0)')
"FVM_INIVEL_", ii
167 CALL qaprint(varname(1:len_trim(varname)),0,0.0_8)
168 WRITE(varname,
'(A)')
'VX_'
169 temp_double = fvm_inivel(ii)%VX
170 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
171 WRITE(varname,
'(A)')
'VY_'
172 temp_double = fvm_inivel(ii)%VY
173 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
174 WRITE(varname,
'(A)')
'VZ_'
175 temp_double = fvm_inivel(ii)%VZ
176 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
177 WRITE(varname,
'(A)')
'GRBRIC_'
178 CALL qaprint(varname(1:len_trim(varname)),fvm_inivel(ii)%GRBRICID,0.0_8)
179 WRITE(varname,
'(A)')
'GRQUAD_'
180 CALL qaprint(varname(1:len_trim(varname)),fvm_inivel(ii)%GRQUADID,0.0_8)
181 WRITE(varname,
'(A)')
'GRTRIA_'
182 CALL qaprint(varname(1:len_trim(varname)),fvm_inivel(ii)%GRSH3NID,0.0_8)
187 IF (sw /= 0 .AND.
myqakey(
'GRID_VELOCITIES'))
THEN
190 my_id = itab(my_node)
193 IF(w(3*(my_node-1)+i)/=zero)
THEN
196 WRITE(varname,
'(A,I0,A,I0)')
'W_',my_id,
'_',i
197 temp_double = w(3*(my_node-1)+i)
198 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
210 MY_ID = ITAB(MY_NODE)
212 IF(TEMP(MY_NODE)/=ZERO)THEN
215 WRITE(VARNAME,'(a,i0)
') 'temp_
',MY_ID ! Specific format for THIS option !
216 TEMP_DOUBLE = TEMP(MY_NODE)
217 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
220 END DO ! MY_NODE=1,NUMNOD
227 IF (NINIGRAV > 0) THEN
229! Sort by ID to ensure internal order independent output
234 CALL QUICKSORT_I2(IDS, IDX, 1, NINIGRAV)
240 CALL QAPRINT('a_inigrav_fake_name
',II,0.0_8)
244 WRITE(VARNAME,'(a,i0)
') 'inigrv_
',I
245 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INIGRV(I,MY_ID),0.0_8)
250 WRITE(VARNAME,'(a,i0)
') 'linigrav_
',I
251 TEMP_DOUBLE = LINIGRAV(I,MY_ID)
252 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
260 IF (MYQAKEY('/inista
')) THEN
263 CALL QAPRINT('inista_file_name
',0,0.0_8)
264 CALL QAPRINT(S0FILE(1:LEN_TRIM(S0FILE)),0,0.0_8)
266 ! Inista initial balance
267 WRITE(VARNAME,'(a)
') 'isigi_
'
268 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ISIGI,0.0_8)
270 ! Inista output format
271 WRITE(VARNAME,'(a)
') 'ioutp_fmt_
'
272 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IOUTP_FMT,0.0_8)
274 ! Inista file format reading
275 WRITE(VARNAME,'(a)
') 'irootyy_r_
'
276 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IROOTYY_R,0.0_8)
282 IF (MYQAKEY('/inicrack
')) THEN
284 IF (NINICRACK > 0) THEN
286! Sort by ID to ensure internal order independent output
288 IDS2(I) = INICRACK(I)%ID
291 CALL QUICKSORT_I2(IDS2, IDX2, 1, NINICRACK)
297 TITR = INICRACK(MY_ID)%TITLE
298 IF (LEN_TRIM(TITR) /= 0) THEN
299 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),II,0.0_8)
301 CALL QAPRINT('a_inicrack_fake_name
',II,0.0_8)
304 WRITE(VARNAME,'(a,i0,a)
') 'inicrack_',II,'_id_
'
305 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INICRACK(MY_ID)%ID,0.0_8)
307 DO I = 1,INICRACK(MY_ID)%NSEG
309 WRITE(VARNAME,'(a,i0,a,i0,a)
') 'inicrack_',II,'_seg_
',I,'_node1_
'
310 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INICRACK(MY_ID)%SEG(I)%NODES(1),0.0_8)
312 WRITE(VARNAME,'(a,i0,a,i0,a)
') 'inicrack_',II,'_seg_
',I,'_node2_
'
313 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INICRACK(MY_ID)%SEG(I)%NODES(2),0.0_8)
315 WRITE(VARNAME,'(a,i0,a,i0,a)
') 'inicrack_',II,'_seg_
',I,'_ratio_
'
316 TEMP_DOUBLE = INICRACK(MY_ID)%SEG(I)%RATIO
317 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
326! /INIMAP1D and /INIMAP2D options
327 DO_QA = MYQAKEY('inimap
')
329 IF (NINIMAP1D > 0) THEN
331 WRITE(VARNAME, '(a)') inimap1d(ii)%TITLE(1:255)
332 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%ID, 0.0_8)
333 WRITE(varname,
'(A)')
'FORMULATION '
334 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%FORMULATION, 0.0_8)
335 WRITE(varname,
'(A)')
'PROJECTION TYPE '
336 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%PROJ, 0.0_8)
337 WRITE(varname,
'(A)')
'GRBRIC '
338 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%GRBRICID, 0.0_8)
339 WRITE(varname,
'(A)')
'GRQUAD '
340 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%GRQUADID, 0.0_8)
341 WRITE(varname,
'(A)')
'GRTRIA '
342 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%GRSH3NID, 0.0_8)
343 WRITE(varname,
'(A)')
'NDOE1 '
344 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%NODEID1, 0.0_8)
345 WRITE(varname,
'(A)')
'NDOE2 '
346 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%NODEID2, 0.0_8)
347 WRITE(varname,
'(A)')
'FUNC_VEL '
348 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%FUNC_VEL, 0.0_8)
349 temp_double = inimap1d(ii)%FAC_VEL
350 WRITE(varname,
'(A)')
'FAC_VEL '
351 CALL qaprint(varname(1:len_trim(varname)), 0, temp_double)
352 DO jj = 1, inimap1d(ii)%NBMAT
353 WRITE(varname,
'(A)')
'FUNC_ALPHA '
354 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%FUNC_ALPHA(jj), 0.0_8)
355 WRITE(varname,
'(A)')
'FUNC_RHO '
356 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%FUNC_RHO(jj), 0.0_8)
357 WRITE(varname,
'(A)')
'FUNC_PRES '
358 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%FUNC_PRES(jj), 0.0_8)
359 WRITE(varname,
'(A)')
'FUNC_ENER '
360 CALL qaprint(varname(1:len_trim(varname)), inimap1d(ii)%FUNC_ENER(jj), 0.0_8)
361 temp_double = inimap1d(ii)%FAC_RHO(jj)
362 WRITE(varname,
'(A)')
'FAC_RHO '
363 CALL qaprint(varname(1:len_trim(varname)), 0, temp_double)
364 temp_double = inimap1d(ii)%FAC_PRES_ENER(jj)
365 WRITE(varname,
'(A)')
'FAC_PRES_ENER '
366 CALL qaprint(varname(1:len_trim(varname)), 0, temp_double)
370 IF (ninimap2d > 0)
THEN
372 WRITE(varname,
'(A)') inimap2d(ii)%TITLE(1:255)
373 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%ID, 0.0_8)
374 WRITE(varname,
'(A)')
'FORMULATION '
375 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%FORMULATION, 0.0_8)
376 WRITE(varname,
'(A)')
'GRBRIC '
377 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%GRBRICID, 0.0_8)
378 WRITE(varname,
'(A)')
'GRQUAD '
379 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%GRQUADID, 0.0_8)
380 WRITE(varname,
'(A)')
'GRTRIA '
381 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%GRSH3NID
382 WRITE(varname,
'(A)')
'NDOE1 '
383 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%NODEID1, 0.0_8)
384 WRITE(varname,
'(A)')
'NDOE2 '
385 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%NODEID2, 0.0_8)
386 WRITE(varname,
'(A)')
'NDOE3 '
387 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%NODEID3, 0.0_8)
388 WRITE(varname,
'(A)')
'FUNC_VEL '
389 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%FUNC_VEL, 0.0_8)
390 temp_double = inimap2d(ii)%FAC_VEL
391 WRITE(varname,
'(A)')
'FAC_VEL '
392 CALL qaprint(varname(1:len_trim(varname)), 0, temp_double)
393 DO jj = 1, inimap2d(ii)%NBMAT
394 WRITE(varname,
'(A)')
'FUNC_ALPHA '
395 CALL qaprint(varname(1:len_trim
396 WRITE(varname,
'(A)')
'FUNC_RHO '
397 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%FUNC_RHO(jj), 0.0_8)
398 WRITE(varname,
'(A)')
'FUNC_PRES '
399 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%FUNC_PRES(jj), 0.0_8
400 WRITE(varname,
'(A)')
'FUNC_ENER '
401 CALL qaprint(varname(1:len_trim(varname)), inimap2d(ii)%FUNC_ENER(jj), 0.0_8)
402 temp_double = inimap2d(ii)%FAC_RHO(jj)
403 WRITE(varname,
'(A)')
'FAC_RHO '
404 CALL qaprint(varname(1:len_trim(varname)), 0, temp_double)
405 temp_double = inimap2d(ii)%FAC_PRES_ENER(jj)
406 WRITE(varname,
'(A)')
'FAC_PRES_ENER '
407 CALL qaprint(varname(1:len_trim(varname)), 0, temp_double)