OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_monvol.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!|| st_qaprint_monvol ../starter/source/output/qaprint/st_qaprint_monvol.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.f
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| monvol_struct_mod ../starter/share/modules1/monvol_struct_mod.F
30!||====================================================================
31 SUBROUTINE st_qaprint_monvol(T_MONVOL, T_MONVOL_METADATA)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45! NVOLU
46#include "com04_c.inc"
47! NIMV
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 TYPE(monvol_struct_), DIMENSION(NVOLU), INTENT(IN) :: T_MONVOL
53 TYPE(monvol_metadata_), INTENT(IN) :: T_MONVOL_METADATA
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 INTEGER :: NN, II, JJ, KK, ID
58 CHARACTER(LEN = nchartitle) :: TITLE
59 CHARACTER(LEN = 255) :: VARNAME
60 INTEGER :: NJET, NVENT
61 DOUBLE PRECISION :: FVALUE
62 INTEGER, DIMENSION(NVOLU) :: IDX, IDS
63 LOGICAL :: OK_QA
64C-----------------------------------------------
65C S o u r c e L i n e s
66C-----------------------------------------------
67 ok_qa = myqakey('/MONVOL')
68 IF (ok_qa) THEN
69 IF (nvolu > 0) THEN
70! Sort by ID to ensure internal order independnat output
71 DO ii = 1, nvolu
72 ids(ii) = t_monvol(ii)%ID
73 idx(ii) = ii
74 ENDDO
75 CALL quicksort_i2(ids, idx, 1, nvolu)
76! ICBAG
77 DO ii = 1, nicbag
78 DO jj = 1, nvolu * nvolu
79 WRITE(varname, '(A, I0, A, I0)') 'ICBAG_', ii, '_', jj
80 IF (t_monvol_metadata%ICBAG(ii, jj) /= 0) THEN
81 CALL qaprint(varname(1:len_trim(varname)),
82 . t_monvol_metadata%ICBAG(ii, jj), 0.0_8)
83 ENDIF
84 ENDDO
85 ENDDO
86! RCBAG
87 DO ii = 1, nicbag
88 DO jj = 1, nvolu * nvolu
89 WRITE(varname, '(A, I0, A, I0)') 'RCBAG_', ii, '_', jj
90 IF (t_monvol_metadata%RCBAG(ii, jj) /= zero) THEN
91 fvalue = t_monvol_metadata%RCBAG(ii, jj)
92 CALL qaprint(varname(1:len_trim(varname)),
93 . 0, fvalue)
94 ENDIF
95 ENDDO
96 ENDDO
97 ENDIF
98 DO kk = 1, nvolu
99 nn = idx(kk)
100 id = t_monvol(nn)%ID
101 title = t_monvol(nn)%TITLE
102 IF (len_trim(title) == 0) THEN
103 title = "MONVOL_FAKE_TITLE"
104 ENDIF
105 CALL qaprint(title(1:len_trim(title)), id, 0.0_8)
106! ivolu
107 DO ii = 1, nimv
108 WRITE(varname, '(A, I0)') 'IVOLU_', ii
109 IF (t_monvol(nn)%IVOLU(ii) /= 0) THEN
110 CALL qaprint(varname(1:len_trim(varname)), t_monvol(nn)%IVOLU(ii), 0.0_8)
111 ENDIF
112 ENDDO
113! IBAGJET
114 njet = t_monvol(nn)%NJET
115 IF (njet > 0) THEN
116 DO ii = 1, nibjet
117 DO jj = 1, njet
118 WRITE(varname, '(A, I0, A, I0)') 'IBAGJET_', ii, '_', jj
119 IF (t_monvol(nn)%IBAGJET(ii, jj) /= 0) THEN
120 CALL qaprint(varname(1:len_trim(varname)), t_monvol(nn)%IBAGJET(ii, jj), 0.0_8)
121 ENDIF
122 ENDDO
123 ENDDO
124 ENDIF
125! IBAGHOL
126 nvent = t_monvol(nn)%NVENT
127 IF (nvent > 0) THEN
128 DO ii = 1, nibhol
129 DO jj = 1, nvent
130 WRITE(varname, '(A, I0, A, I0)') 'IBAGHOL_', ii, '_', jj
131 IF (t_monvol(nn)%IBAGHOL(ii, jj) /= 0) THEN
132 CALL qaprint(varname(1:len_trim(varname)), t_monvol(nn)%IBAGHOL(ii, jj), 0.0_8)
133 ENDIF
134 ENDDO
135 ENDDO
136 ENDIF
137! RVOLU
138 DO ii = 1, nrvolu
139 WRITE(varname, '(A, I0)') 'RVOLU_', ii
140 IF (t_monvol(nn)%RVOLU(ii) /= zero) THEN
141 fvalue = t_monvol(nn)%RVOLU(ii)
142 CALL qaprint(varname(1:len_trim(varname)), 0, fvalue)
143 ENDIF
144 ENDDO
145! RBAGJET
146 IF (njet > 0) THEN
147 DO ii = 1, nrbjet
148 DO jj = 1, njet
149 WRITE(varname, '(A, I0, A, I0)') 'RBAGJET_', ii, '_', jj
150 IF (t_monvol(nn)%RBAGJET(ii, jj) /= zero) THEN
151 fvalue = t_monvol(nn)%RBAGJET(ii, jj)
152 CALL qaprint(varname(1:len_trim(varname)), 0, fvalue)
153 ENDIF
154 ENDDO
155 ENDDO
156 ENDIF
157! RBAGHOL
158 IF (nvent > 0) THEN
159 DO ii = 1, nrbhol
160 DO jj = 1, nvent
161 WRITE(varname, '(A, I0, A, I0)') 'RBAGHOL_', ii, '_', jj
162 IF (t_monvol(nn)%RBAGHOL(ii, jj) /= zero) THEN
163 fvalue = t_monvol(nn)%RBAGHOL(ii, jj)
164 CALL qaprint(varname(1:len_trim(varname)), 0, fvalue)
165 ENDIF
166 ENDDO
167 ENDDO
168 ENDIF
169 ENDDO
170 ENDIF
171C-----------------------------------------------
172C E n d o f S u b r o u t i n e
173C-----------------------------------------------
174 END SUBROUTINE st_qaprint_monvol
integer, parameter nchartitle
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
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
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
subroutine st_qaprint_driver(igeo, geo, bufgeo, ipm, pm, bufmat, nom_opt, inom_opt, numloadp, iloadp, lloadp, loadp, ibcl, forc, ipres, pres, npby, lpby, rby, ibcr, fradia, ibcv, fconv, ibftemp, fbftemp, igrv, lgrv, agrv, ibfflux, fbfflux, itab, v, vr, w, icode, iskew, icfield, lcfield, cfield, dampr, temp, ibcslag, ipari, intbuf_tab, clusters, ibox, ipmas, ibfvel, fbfvel, nimpacc, laccelm, accelm, nom_sect, nstrf, secbuf, skew, iskwn, xframe, t_monvol, t_monvol_metadata, i2rupt, areasl, intbuf_fric_tab, npfricorth, mat_elem, pfricorth, irepforth, phiforth, vforth, xrefc, xreftg, xrefs, tagxref, ixs, ixc, ixtg, rwbuf, nprw, lprw, ithvar, ipart, subsets, ipartth, nthgrpmx, nimpdisp, nimpvel, detonators, ibcscyc, npc, pld, table, npts, irbe3, lrbe3, frbe3, mgrby, ixs10, isolnod, ixr, r_skew, ixp, ixt, x, thke, sh4ang, thkec, sh3ang, set, lsubmodel, igrnod, igrpart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring, igrsurf, igrslin, ixq, ispcond, rtrans, irand, alea, xseed, xlas, las, irbe2, lrbe2, kxsp, ipartsp, drape, ixr_kj, iactiv, factiv, unitab, npbyl, lpbyl, rbyl, xyzref, sensors, func2d, inicrack, ipreload, preload, iflag_bpreload, ibmpc, ibmpc2, ibmpc3, ibmpc4, rbmpc, ljoint, nnlink, lnlink, bufsf, sbufsf_, pm_stack, geo_stack, igeo_stack, iparg, ipadmesh, padmesh, liflow, lrflow, iflow, rflow, sh4tree, sh3tree, sh4trim, sh3trim, qp_iperturb, qp_rperturb, llinal, linale, fvm_inivel, gjbufi, gjbufr, ms, in, lgauge, gauge, kxx, ixx, ipartx, ixri, ixs16, iexmad, fxbipm, fxbfile_tab, eigipm, eigrpm, isphio, vsphio, ebcs_tab, inimap1d, inimap2d, nsigsh, sigsh, nsigi, sigsp, nsigs, sigi, nsigbeam, sigbeam, nsigtruss, sigtruss, nsigrs, sigrs, merge_node_tab, merge_node_tol, imerge, nmerge_tot, iexlnk, drapeg, user_windows, output, defaults, glob_therm, pblast, ibeam_vector, rbeam_vector, damp_range_part)
subroutine st_qaprint_monvol(t_monvol, t_monvol_metadata)
program starter
Definition starter.F:39