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
36 USE monvol_struct_mod
37 USE names_and_titles_mod , ONLY : nchartitle
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
monvol_struct_mod
Definition monvol_struct_mod.F:66
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
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
st_qaprint_monvol
subroutine st_qaprint_monvol(t_monvol, t_monvol_metadata)
Definition st_qaprint_monvol.F:32
monvol_struct_mod::monvol_metadata_
Definition monvol_struct_mod.F:76
monvol_struct_mod::monvol_struct_
Definition monvol_struct_mod.F:84