OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_initial_conditions.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"
#include "com_xfem1.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_initial_conditions (nom_opt, inom_opt, itab, v, vr, w, temp, inicrack, fvm_inivel, inimap1d, inimap2d)

Function/Subroutine Documentation

◆ st_qaprint_initial_conditions()

subroutine st_qaprint_initial_conditions ( integer, dimension(lnopt1,snom_opt1), intent(in) nom_opt,
integer, dimension(sinom_opt), intent(in) inom_opt,
integer, dimension(numnod), intent(in) itab,
dimension(3,numnod), intent(in) v,
dimension(svr), intent(in) vr,
dimension(sw), intent(in) w,
dimension(numnod), intent(in) temp,
type (inicrack_), dimension(ninicrack) inicrack,
type (fvm_inivel_struct), dimension(ninvel), intent(in) fvm_inivel,
type(inimap1d_struct), dimension(ninimap1d), intent(in) inimap1d,
type(inimap2d_struct), dimension(ninimap2d), intent(in) inimap2d )

Definition at line 33 of file st_qaprint_initial_conditions.F.

37C============================================================================
38C M o d u l e s
39C-----------------------------------------------
40 USE qa_out_mod
41 USE inigrav
42 USE optiondef_mod
43 USE multi_fvm_mod
44 USE inimap1d_mod
45 USE inimap2d_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com01_c.inc"
55#include "com04_c.inc"
56#include "scr16_c.inc"
57#include "scr17_c.inc"
58#include "tabsiz_c.inc"
59#include "com_xfem1.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
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
66 TYPE(INIMAP1D_STRUCT), DIMENSION(NINIMAP1D), INTENT(IN) :: INIMAP1D
67 TYPE(INIMAP2D_STRUCT), DIMENSION(NINIMAP2D), INTENT(IN) :: INIMAP2D
68C-----------------------------------------------
69C NOM_OPT(LNOPT1,SNOM_OPT1)
70C * Possibly, NOM_OPT(1) = ID
71C NOM_OPT(LNOPT1-LTITL+1:LTITL) <=> TITLES of the OPTIONS
72C--------------------------------------------------
73C SNOM_OPT1= NRBODY+NACCELM+NVOLU+NINTER+NINTSUB+
74C + NRWALL+NJOINT+NSECT+NLINK+
75C + NUMSKW+1+NUMFRAM+1+NFXBODY+NFLOW+NRBE2+
76C + NRBE3+NSUBMOD+NFXVEL+NUMBCS+NUMMPC+
77C + NGJOINT+NUNIT0+NFUNCT+NADMESH+
78C + NSPHIO+NSPCOND+NRBYKIN+NEBCS+
79C + NINICRACK+NODMAS+NBGAUGE+NCLUSTER+NINTERFRIC+
80C + NRBMERGE
81C-----------------------------------------------
82C INOM_OPT(SINOM_OPT)
83C--------------------------------------------------
84C INOM_OPT(1) = NRBODY
85C INOM_OPT(2) = INOM_OPT(1) + NACCELM
86C INOM_OPT(3) = INOM_OPT(2) + NVOLU
87C INOM_OPT(4) = INOM_OPT(3) + NINTER
88C INOM_OPT(5) = INOM_OPT(4) + NINTSUB
89C INOM_OPT(6) = INOM_OPT(5) + NRWALL
90C INOM_OPT(7) = INOM_OPT(6)
91C INOM_OPT(8) = INOM_OPT(7) + NJOINT
92C INOM_OPT(9) = INOM_OPT(8) + NSECT
93C INOM_OPT(10)= INOM_OPT(9) + NLINK
94C INOM_OPT(11)= INOM_OPT(10)+ NUMSKW+1+NUMFRAM+1+NSUBMOD
95C INOM_OPT(12)= INOM_OPT(11)+ NFXBODY
96C INOM_OPT(13)= INOM_OPT(12)+ NFLOW
97C INOM_OPT(14)= INOM_OPT(13)+ NRBE2
98C INOM_OPT(15)= INOM_OPT(14)+ NRBE3
99C INOM_OPT(16)= INOM_OPT(15)+ NFXVEL
100C INOM_OPT(17)= INOM_OPT(16)+ NUMBCS
101C INOM_OPT(18)= INOM_OPT(17)+ NUMMPC
102C INOM_OPT(19)= INOM_OPT(18)+ NGJOINT
103C INOM_OPT(20)= INOM_OPT(19)+ NUNIT0
104C INOM_OPT(21)= INOM_OPT(20)+ NFUNCT
105C INOM_OPT(22)= INOM_OPT(21)+ NADMESH
106C INOM_OPT(23)= INOM_OPT(22)+ NSPHIO
107C INOM_OPT(24)= INOM_OPT(23)+ NSPCOND
108C INOM_OPT(25)= INOM_OPT(24)+ NEBCS
109C INOM_OPT(26)= INOM_OPT(25)+ NINICRACK
110C INOM_OPT(27)= INOM_OPT(26)+ NODMAS
111C INOM_OPT(28)= INOM_OPT(27)+ NBGAUGE
112C INOM_OPT(29)= INOM_OPT(28)+ NCLUSTER
113C INOM_OPT(30)= INOM_OPT(29)+ NINTERFRIC
114C INOM_OPT(31)= INOM_OPT(30)+ NRBMERGE
115C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
116C-----------------------------------------------
117 my_real, INTENT(IN) ::
118 . v(3,numnod), vr(svr), ! SVR=3*NUMNOD*IRODDL
119 . w(sw) ! SW=3*NUMNOD*IALE
120 my_real, INTENT(IN) ::
121 . temp(numnod)
122 TYPE (INICRACK_) , DIMENSION(NINICRACK) :: INICRACK
123C--------------------------------------------------
124C L o c a l V a r i a b l e s
125C-----------------------------------------------
126 INTEGER I,II,JJ,MY_ID,MY_NODE,POSI(NINIGRAV+1),IDS(NINIGRAV),IDX(NINIGRAV),
127 . IDS2(NINICRACK),IDX2(NINICRACK)
128 CHARACTER(LEN=NCHARTITLE) :: TITR
129 CHARACTER (LEN=255) :: VARNAME
130 DOUBLE PRECISION TEMP_DOUBLE
131 LOGICAL :: DO_QA
132C-----------------------------------------------
133C INIVEL
134C-----------------------------------------------
135 do_qa = myqakey('VELOCITIES')
136 IF (do_qa) THEN
137 DO my_node=1,numnod
138C
139 my_id = itab(my_node)
140C
141 DO i=1,3
142 IF(v(i,my_node)/=zero)THEN
143C
144C VARNAME: variable name in ref.extract (without blanks)
145 WRITE(varname,'(A,I0,A,I0)') 'V_',my_id,'_',i ! Specific format for THIS option !
146 temp_double = v(i,my_node)
147 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
148 END IF
149 END DO
150C
151 IF(svr/=0)THEN
152 DO i=1,3
153 IF(vr(3*(my_node-1)+i)/=zero)THEN
154C
155C VARNAME: variable name in ref.extract (without blanks)
156 WRITE(varname,'(A,I0,A,I0)') 'VR_',my_id,'_',i ! Specific format for THIS option !
157 temp_double = vr(3*(my_node-1)+i)
158 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
159 END IF
160 END DO
161 END IF
162C
163 END DO ! MY_NODE=1,NUMNOD
164 DO ii = 1, ninvel
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)
183 ENDIF
184 ENDDO
185 END IF
186C-----------------------------------------------
187 IF (sw /= 0 .AND. myqakey('GRID_VELOCITIES')) THEN
188 DO my_node=1,numnod
189C
190 my_id = itab(my_node)
191C
192 DO i=1,3
193 IF(w(3*(my_node-1)+i)/=zero)THEN
194C
195C VARNAME: variable name in ref.extract (without blanks)
196 WRITE(varname,'(a,i0,a,i0)') 'w_',MY_ID,'_',I ! Specific format for THIS option !
197 TEMP_DOUBLE = W(3*(MY_NODE-1)+I)
198 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
199 END IF
200 END DO
201C
202 END DO ! MY_NODE=1,NUMNOD
203 END IF
204C-----------------------------------------------
205C INITEMP
206C-----------------------------------------------
207 IF (MYQAKEY('/initemp')) THEN
208 DO MY_NODE=1,NUMNOD
209C
210 MY_ID = ITAB(MY_NODE)
211C
212 IF(TEMP(MY_NODE)/=ZERO)THEN
213C
214C VARNAME: variable name in ref.extract (without blanks)
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)
218 END IF
219C
220 END DO ! MY_NODE=1,NUMNOD
221 END IF
222C-----------------------------------------------
223C INITEMP
224C-----------------------------------------------
225 IF (MYQAKEY('/inigrav')) THEN
226C
227 IF (NINIGRAV > 0) THEN
228C
229! Sort by ID to ensure internal order independent output
230 DO I = 1, NINIGRAV
231 IDS(I) = INIGRV(4,I)
232 IDX(I) = I
233 ENDDO
234 CALL QUICKSORT_I2(IDS, IDX, 1, NINIGRAV)
235C
236! Loop over INIGRAVs
237 DO II = 1, NINIGRAV
238C
239 MY_ID = IDX(II)
240 CALL QAPRINT('a_inigrav_fake_name',II,0.0_8)
241C
242 ! INIGRV table
243 DO I = 1,4
244 WRITE(VARNAME,'(a,i0)') 'inigrv_',I
245 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INIGRV(I,MY_ID),0.0_8)
246 ENDDO
247C
248 ! LINIGRAV table
249 DO I = 1,11
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)
253 ENDDO
254 ENDDO
255 ENDIF
256 END IF
257C-----------------------------------------------
258C INISTA
259C-----------------------------------------------
260 IF (myqakey('/INISTA')) THEN
261C
262 ! Inista file name
263 CALL qaprint('INISTA_FILE_NAME',0,0.0_8)
264 CALL qaprint(s0file(1:len_trim(s0file)),0,0.0_8)
265C
266 ! Inista initial balance
267 WRITE(varname,'(A)') 'ISIGI_'
268 CALL qaprint(varname(1:len_trim(varname)),isigi,0.0_8)
269C
270 ! Inista output format
271 WRITE(varname,'(A)') 'IOUTP_FMT_'
272 CALL qaprint(varname(1:len_trim(varname)),ioutp_fmt,0.0_8)
273C
274 ! Inista file format reading
275 WRITE(varname,'(A)') 'IROOTYY_R_'
276 CALL qaprint(varname(1:len_trim(varname)),irootyy_r,0.0_8)
277C
278 END IF
279C-----------------------------------------------
280C INICRACK
281C-----------------------------------------------
282 IF (myqakey('/INICRACK')) THEN
283C
284 IF (ninicrack > 0) THEN
285C
286! Sort by ID to ensure internal order independent output
287 DO i = 1, ninicrack
288 ids2(i) = inicrack(i)%ID
289 idx2(i) = i
290 ENDDO
291 CALL quicksort_i2(ids2, idx2, 1, ninicrack)
292C
293! Loop over INICRACKs
294 DO ii = 1, ninicrack
295C
296 my_id = idx2(ii)
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)
300 ELSE
301 CALL qaprint('A_INICRACK_FAKE_NAME',ii,0.0_8)
302 END IF
303C
304 WRITE(varname,'(A,I0,A)') 'INICRACK_',ii,'_ID_'
305 CALL qaprint(varname(1:len_trim(varname)),inicrack(my_id)%ID,0.0_8)
306C
307 DO i = 1,inicrack(my_id)%NSEG
308
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)
311C
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)
314C
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)
318C
319 ENDDO
320 ENDDO
321C
322 ENDIF
323C
324 END IF
325
326! /INIMAP1D and /INIMAP2D options
327 do_qa = myqakey('INIMAP')
328 IF (do_qa) THEN
329 IF (ninimap1d > 0) THEN
330 DO ii = 1, ninimap1d
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)
367 ENDDO
368 ENDDO
369 ENDIF
370 IF (NINIMAP2D > 0) THEN
371 DO II = 1, NINIMAP2D
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, 0.0_8)
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(VARNAME)), INIMAP2D(II)%FUNC_ALPHA(JJ), 0.0_8)
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)
408 ENDDO
409 ENDDO
410 ENDIF
411 ENDIF
412C-----------------------------------------------
413
414C-----------------------------------------------
415 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
inimap1d_mod
Definition inimap1d_mod.F:35
inimap2d_mod
Definition inimap2d_mod.F:35
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
optiondef_mod
Definition optiondef_mod.F:90
qa_out_mod
Definition qa_out_mod.F:78
qa_out_mod::myqakey
logical function myqakey(value)
@purpose Check if a given value is part of the values set by env variable Useful to make a condition ...
Definition qa_out_mod.F:694
qa_out_mod::qaprint
subroutine qaprint(name, idin, value)
@purpose print one entry to QA extract file example of call for real print CALL QAPRINT('MY_LABEL',...
Definition qa_out_mod.F:390
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153