OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_dfs_detonators.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_dfs_detonators ../starter/source/output/qaprint/st_qaprint_dfs_detonators.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| detonators_mod ../starter/share/modules1/detonators_mod.F
30!||====================================================================
31 SUBROUTINE st_qaprint_dfs_detonators(DETONATORS)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE groupdef_mod
37 USE detonators_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C D u m m y A r g u m e n t s
44C-----------------------------------------------
45 TYPE(detonators_struct_), INTENT(IN) :: DETONATORS
46C--------------------------------------------------
47C L o c a l V a r i a b l e s
48C-----------------------------------------------
49 LOGICAL :: OK_QA
50 CHARACTER (LEN=255) :: VARNAME
51 INTEGER K,J,DET_IID
52 DOUBLE PRECISION TEMP_DOUBLE
53 INTEGER TEMP_INTEGER
54 INTEGER :: NDETPS,NDETSG,NECRAN,NDETPL,NDETCORD
55C-----------------------------------------------
56C S o u r c e L i n e s
57C-----------------------------------------------
58 ok_qa = myqakey('DETONATORS')
59
60 ndetps = detonators%N_DET_POINT
61 ndetsg = detonators%N_DET_LINE
62 necran = detonators%N_DET_WAVE_SHAPER
63 ndetpl = detonators%N_DET_PLANE
64 ndetcord = detonators%N_DET_CORD
65
66 IF (ok_qa) THEN
67
68 !/DFS/DETPOINT
69 DO k=1,ndetps
70 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__ISHADOW_'
71 temp_integer = detonators%POINT(k)%SHADOW
72 IF(temp_integer > 0)CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
73
74 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__MAT_'
75 temp_integer = detonators%POINT(k)%MAT
76 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
77
78 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__TDET_'
79 temp_double = detonators%POINT(k)%TDET
80 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
81
82 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__XDET_'
83 temp_double = detonators%POINT(k)%XDET
84 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
85
86 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__YDET_'
87 temp_double = detonators%POINT(k)%YDET
88 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
89
90 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__ZDET_'
91 temp_double = detonators%POINT(k)%ZDET
92 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
93
94 WRITE(varname,'(A,I0,A)') 'DFS_DETPOINT_',k ,'__GRNOD_ID_'
95 temp_integer = detonators%POINT(k)%GRNOD_ID
96 IF(temp_integer > 0)CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
97
98 ENDDO !next K
99
100 !/DFS/DETLINE
101 DO k=1,ndetsg
102 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__MAT_'
103 temp_integer = detonators%LINE(k)%MAT
104 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
105
106 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__TDET_'
107 temp_double = detonators%LINE(k)%TDET
108 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
109
110 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__XDET_1_'
111 temp_double = detonators%LINE(k)%XDET_1
112 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
113
114 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__YDET_1_'
115 temp_double = detonators%LINE(k)%YDET_1
116 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
117
118 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__ZDET_1_'
119 temp_double = detonators%LINE(k)%ZDET_1
120 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
121
122 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__XDET_2_'
123 temp_double = detonators%LINE(k)%XDET_2
124 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
125
126 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__YDET_2_'
127 temp_double = detonators%LINE(k)%YDET_2
128 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
129
130 WRITE(varname,'(A,I0,A)') 'DFS_DETLINE_',k ,'__ZDET_2_'
131 temp_double = detonators%LINE(k)%ZDET_2
132 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
133 ENDDO !next K
134
135 !/DFS/WAV_SHA
136 DO k=1,necran
137 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__MAT_'
138 temp_integer = detonators%WAVE_SHAPER(k)%MAT
139 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
140
141 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__NUMNOD_'
142 temp_integer = detonators%WAVE_SHAPER(k)%NUMNOD
143 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
144
145 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__VDET_'
146 temp_double = detonators%WAVE_SHAPER(k)%VDET
147 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
148
149 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__TDET_'
150 temp_double = detonators%WAVE_SHAPER(k)%TDET
151 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
152
153 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__XDET_'
154 temp_double = detonators%WAVE_SHAPER(k)%XDET
155 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
156
157 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__YDET_'
158 temp_double = detonators%WAVE_SHAPER(k)%YDET
159 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
160
161 WRITE(varname,'(A,I0,A)') 'DFS_WAVSHA_',k ,'__ZDET_'
162 temp_double = detonators%WAVE_SHAPER(k)%ZDET
163 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
164 ENDDO !next K
165
166 !/DFS/DETPLAN
167 DO k=1,ndetpl
168 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__MAT_'
169 temp_integer = detonators%PLANE(k)%MAT
170 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
171
172 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__TDET_'
173 temp_double = detonators%PLANE(k)%TDET
174 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
175
176 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__XDET_'
177 temp_double = detonators%PLANE(k)%XDET
178 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
179
180 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__YDET_'
181 temp_double = detonators%PLANE(k)%YDET
182 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
183
184 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__ZDET_'
185 temp_double = detonators%PLANE(k)%ZDET
186 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
187
188 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__NX_'
189 temp_double = detonators%PLANE(k)%NX
190 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
191
192 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__NY_'
193 temp_double = detonators%PLANE(k)%NY
194 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
195
196 WRITE(varname,'(A,I0,A)') 'DFS_DETPLANE_',k ,'__NZ_'
197 temp_double = detonators%PLANE(k)%NZ
198 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
199 ENDDO !next K
200
201 !/DFS/DETCORD
202 DO k=1,ndetcord
203 WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__MAT_'
204 temp_integer = detonators%CORD(k)%MAT
205 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
206
207 WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__IOPT_'
208 temp_integer = detonators%CORD(k)%IOPT
209 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
210
211 WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__NUMNOD_'
212 temp_integer = detonators%CORD(k)%NUMNOD
213 CALL qaprint(varname(1:len_trim(varname)),temp_integer,0.0_8)
214
215 WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__TDET_'
216 temp_double = detonators%CORD(k)%TDET
217 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
218
219 WRITE(varname,'(A,I0,A)') 'DFS_DETCORD_',k ,'__VDET_'
220 temp_double = detonators%CORD(k)%VDET
221 IF(temp_double/=zero)CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
222 ENDDO !next K
223
224 ENDIF
225C-----------------------------------------------
226 RETURN
227 END
228
detonators_mod
Definition detonators_mod.F:79
groupdef_mod
Definition groupdef_mod.F:662
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
st_qaprint_dfs_detonators
subroutine st_qaprint_dfs_detonators(detonators)
Definition st_qaprint_dfs_detonators.F:32
detonators_mod::detonators_struct_
Definition detonators_mod.F:154