OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_time_histories.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_time_histories ../starter/source/output/qaprint/st_qaprint_time_histories.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!|| st_qaprint_thgrou ../starter/source/output/qaprint/st_qaprint_time_histories.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE st_qaprint_time_histories(TH , ITHVAR , IPART , SUBSETS,
32 . IPARTTH, NTHGRPMX)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE qa_out_mod
37 USE groupdef_mod
38 USE output_mod
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com04_c.inc"
47#include "com10_c.inc"
48#include "param_c.inc"
49#include "scr17_c.inc"
50#include "tabsiz_c.inc"
51C-----------------------------------------------
52C D u m m y A r g u m e n t s
53C-----------------------------------------------
54 TYPE(th_) :: TH
55 INTEGER, INTENT(IN) :: ITHVAR(SITHVAR) , NTHGRPMX
56 INTEGER, INTENT(IN), TARGET :: IPART(LIPART1,NPART+NTHPART),IPARTTH(18*(NPART+NTHPART))
57 TYPE(subset_), DIMENSION(NSUBS), INTENT(IN) :: SUBSETS
58C-----------------------------------------------
59C L o c a l V a r i a b l e s
60C-----------------------------------------------
61 INTEGER, DIMENSION(:,:), POINTER :: IPARTTHI
62 LOGICAL :: OK_QA
63C-----------------------------------------------
64C /TH
65C-----------------------------------------------
66 ok_qa = myqakey('/TH')
67 IF (ok_qa) THEN
68C
69 !/TH
70 ipartthi => ipart(8:9,1:npart+nthpart)
71 CALL st_qaprint_thgrou(nthgrp ,th%ITHGRP ,th%ITHBUF ,ithvar ,ipart ,
72 . ipartthi ,nthgrpmx ,subsets ,10 ,th%SITHGRP ,th%SITHBUF)
73
74 !/ATH
75 ipartthi(1:2,1:npart+nthpart) => ipartth(1:2*(npart+nthpart))
76 CALL st_qaprint_thgrou(nthgrp1(1) ,th%ITHGRPA ,th%ITHBUFA ,ithvar ,ipart ,
77 . ipartthi ,nthgrpmx ,subsets ,1 ,th%SITHGRPA,th%SITHBUFA )
78
79 !/BTH
80 ipartthi(1:2,1:npart+nthpart) => ipartth(2*(npart+nthpart)+1:4*(npart+nthpart))
81 CALL st_qaprint_thgrou(nthgrp1(2) ,th%ITHGRPB ,th%ITHBUFB ,ithvar ,ipart ,
82 . ipartthi ,nthgrpmx ,subsets ,2 ,th%SITHGRPB,th%SITHBUFB )
83
84 !/CTH
85 ipartthi(1:2,1:npart+nthpart) => ipartth(4*(npart+nthpart)+1:6*(npart+nthpart))
86 CALL st_qaprint_thgrou(nthgrp1(3) ,th%ITHGRPC ,th%ITHBUFC ,ithvar ,ipart ,
87 . ipartthi ,nthgrpmx ,subsets ,3 ,th%SITHGRPC,th%SITHBUFC )
88
89 !/DTH
90 ipartthi(1:2,1:npart+nthpart) => ipartth(6*(npart+nthpart)+1:8*(npart+nthpart))
91 CALL st_qaprint_thgrou(nthgrp1(4) ,th%ITHGRPD , th%ITHBUFD ,ithvar ,ipart ,
92 . ipartthi ,nthgrpmx ,subsets ,4 ,th%SITHGRPD,th%SITHBUFD )
93
94 !/ETH
95 ipartthi(1:2,1:npart+nthpart) => ipartth(8*(npart+nthpart)+1:10*(npart+nthpart))
96 CALL st_qaprint_thgrou(nthgrp1(5) ,th%ITHGRPE ,th%ITHBUFE ,ithvar ,ipart ,
97 . ipartthi ,nthgrpmx ,subsets ,5 ,th%SITHGRPE,th%SITHBUFE )
98
99 !/FTH
100 ipartthi(1:2,1:npart+nthpart) => ipartth(10*(npart+nthpart)+1:12*(npart+nthpart))
101 CALL st_qaprint_thgrou(nthgrp1(6) ,th%ITHGRPF ,th%ITHBUFF ,ithvar ,ipart ,
102 . ipartthi ,nthgrpmx ,subsets ,6 ,th%SITHGRPF,th%SITHBUFF )
103
104 !/GTH
105 ipartthi(1:2,1:npart+nthpart) => ipartth(12*(npart+nthpart)+1:14*(npart+nthpart))
106 CALL st_qaprint_thgrou(nthgrp1(7) ,th%ITHGRPG ,th%ITHBUFG ,ithvar ,ipart ,
107 . ipartthi ,nthgrpmx ,subsets ,7 ,th%SITHGRPG,th%SITHBUFG )
108
109 !/HTH
110 ipartthi(1:2,1:npart+nthpart) => ipartth(14*(npart+nthpart)+1:16*(npart+nthpart))
111 CALL st_qaprint_thgrou(nthgrp1(8) ,th%ITHGRPH ,th%ITHBUFH ,ithvar ,ipart ,
112 . ipartthi ,nthgrpmx ,subsets ,8 ,th%SITHGRPH,th%SITHBUFH )
113
114 !/ITH
115 ipartthi(1:2,1:npart+nthpart) => ipartth(16*(npart+nthpart)+1:18*(npart+nthpart))
116 CALL st_qaprint_thgrou(nthgrp1(9) ,th%ITHGRPI ,th%ITHBUFI ,ithvar ,ipart ,
117 . ipartthi ,nthgrpmx ,subsets ,9 ,th%SITHGRPI,th%SITHBUFI )
118C
119 ENDIF
120C-----------------------------------------------
121 RETURN
122 END
123! QA_PRINT for the THGROU
124
125
126!||====================================================================
127!|| st_qaprint_thgrou ../starter/source/output/qaprint/st_qaprint_time_histories.F
128!||--- called by ------------------------------------------------------
129!|| st_qaprint_time_histories ../starter/source/output/qaprint/st_qaprint_time_histories.F
130!||--- calls -----------------------------------------------------
131!|| fretitl2 ../starter/source/starter/freform.F
132!||--- uses -----------------------------------------------------
133!||====================================================================
134 SUBROUTINE st_qaprint_thgrou(NTHGROUP ,ITHGRP ,ITHBUF ,ITHVAR ,IPART ,
135 . IPARTTH ,NTHGRPMX ,SUBSETS ,ISUBVAR ,SITHGRP,SITHBUF)
136C-----------------------------------------------
137C M o d u l e s
138C-----------------------------------------------
139 USE qa_out_mod
140 USE groupdef_mod
141 USE names_and_titles_mod , ONLY : nchartitle
142C-----------------------------------------------
143C I m p l i c i t T y p e s
144C-----------------------------------------------
145#include "implicit_f.inc"
146C-----------------------------------------------
147C C o m m o n B l o c k s
148C-----------------------------------------------
149#include "com04_c.inc"
150#include "param_c.inc"
151#include "scr17_c.inc"
152#include "tabsiz_c.inc"
153C-----------------------------------------------
154C D u m m y A r g u m e n t s
155C-----------------------------------------------
156 INTEGER, INTENT(IN) :: SITHGRP,SITHBUF
157 INTEGER, INTENT(IN) :: ITHGRP(NITHGR,*),ITHBUF(SITHBUF),ITHVAR(SITHVAR),
158 . ipart(lipart1,npart+nthpart),nthgrpmx,isubvar ,
159 . ipartth(2,npart+nthpart),nthgroup
160 TYPE(subset_), DIMENSION(NSUBS), INTENT(IN) :: SUBSETS
161C--------------------------------------------------
162C L o c a l V a r i a b l e s
163C-----------------------------------------------
164 INTEGER I, ID, II, TEMP_INT, MY_TH, NVAR, IAD, K, NNE
165 INTEGER, DIMENSION(NTHGROUP) :: IDX, IDS
166 CHARACTER(LEN=NCHARTITLE)::TITR
167 CHARACTER (LEN=255) :: VARNAME
168C
169C
170 IF(nthgroup > 0)THEN
171 ! Sort with user IDs
172 DO i = 1, nthgroup
173 ids(i) = ithgrp(1,i)
174 idx(i) = i
175 ENDDO
176 CALL quicksort_i2(ids, idx, 1, nthgroup)
177 ENDIF
178
179 !-------------------------------------!
180 ! All /TH expect !
181 ! /TH/SUBS and /TH/PART and /THPART !
182 !-------------------------------------!
183 DO ii = 1, nthgroup
184C
185 ! Sorted ID users
186 my_th = idx(ii)
187 id = ithgrp(1,my_th)
188C
189 ! Printing only if ID is stored
190 IF (id /= 0) THEN
191C
192 ! Time history title
193 titr(1:nchartitle)=''
194 CALL fretitl2(titr, ithgrp(nithgr-ltitr+1,my_th), ltitr)
195 IF (len_trim(titr) /= 0) THEN
196 CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
197 ELSE
198 CALL qaprint('A_TH_FAKE_NAME', id,0.0_8)
199 ENDIF
200C
201 ! Time history group table
202 DO i = 1, nithgr-ltitr
203 WRITE(varname,'(A,I0,A,I0)') 'ITHGRP_',i,'_',my_th
204 temp_int = ithgrp(i,my_th)
205 IF ((temp_int /= 0).OR.(i == 2)) THEN
206 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
207 ENDIF
208 ENDDO
209C
210 ! Time history buffer
211 DO i = ithgrp(5,my_th), ithgrp(8,my_th)-1
212 WRITE(varname,'(A,I0,A,I0)') 'ITHBUF_',i
213 temp_int = ithbuf(i)
214 IF (temp_int /= 0) THEN
215 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
216 ENDIF
217 ENDDO
218C
219 nne=ithgrp(4,my_th)
220 k=0
221 DO i=1,nne
222 ! Title of the object of the time history
223 titr(1:nchartitle)=''
224 CALL fretitl2(titr, ithbuf(ithgrp(8,my_th)+k), 39)
225 IF (len_trim(titr) /= 0) THEN
226 CALL qaprint(titr(1:len_trim(titr)),0,0.0_8)
227 ELSE
228 CALL qaprint('A_TH_OBJECT_FAKE_NAME',0,0.0_8)
229 END IF
230 k=k+40
231 ENDDO
232C
233 ! Time history saved variable
234 DO i = 0, ithgrp(6,my_th)-1
235 DO k = 1,10
236 WRITE(varname,'(A,I0,A,I0)') 'ITHVAR_',(ithgrp(9,my_th)+i-1)*10+k
237 temp_int = ithvar((ithgrp(9,my_th)+i-1)*10+k)
238 IF (temp_int /= ichar(' ')) THEN
239 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
240 ENDIF
241 ENDDO
242 ENDDO
243 ENDIF
244 ENDDO !next /TH (expect /TH/SUBS, /TH/PART, /THPART)
245C
246 !--------------------!
247 ! Loop over /PART !
248 ! and /THPART !
249 !--------------------!
250 DO ii = 1, npart+nthpart
251C
252 ! ID of the part
253 id = ipart(4,ii)
254 ! Number of variable
255 nvar = ipartth(1,ii)
256 ! IAD in the buffer table
257 iad = ipartth(2,ii)
258C
259 ! Printing only is the number of variables is higher than 0
260 IF (nvar > 0) THEN
261C
262 ! ID of the part
263 WRITE(varname,'(A,I0,A,I0)') 'PART_ID_',id
264 temp_int = id
265 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
266C
267 ! Title of the part
268 titr(1:nchartitle)=''
269 CALL fretitl2(titr,ipart(lipart1-ltitr+1,ii),40)
270 IF (len_trim(titr) /= 0) THEN
271 CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
272 ELSE
273 CALL qaprint('A_PART_FAKE_NAME', id,0.0_8)
274 END IF
275C
276 ! Number of variables
277 WRITE(varname,'(A,I0,A,I0)') 'IPARTTH_',1,'_',ii
278 temp_int = nvar
279 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
280C
281 ! IAD in the buffer table
282 WRITE(varname,'(A,I0,A,I0)') 'IPARTTH_',2,'_',ii
283 temp_int = iad
284 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
285C
286 ! Printing the corresponding buffer
287 DO i = iad,nvar+iad-1
288 WRITE(varname,'(A,I0,A,I0)') 'ITHBUF_',i
289 temp_int = ithbuf(i)
290 IF (temp_int /= 0) THEN
291 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
292 ENDIF
293 ENDDO
294C
295 ENDIF
296 ENDDO !next /TH/PART or /THPART
297
298 !--------------------!
299 ! /TH/SUBS !
300 !--------------------!
301 DO ii = 1, nsubs
302C
303 ! ID of the subset
304 id = subsets(ii)%ID
305 ! Number of variables
306 nvar = subsets(ii)%NVARTH(isubvar)
307 ! IAD in the buffer table
308 iad = subsets(ii)%THIAD
309C
310 ! Printing only is the number of variables is higher than 0
311 IF (nvar>0) THEN
312C
313 ! ID of the part
314 WRITE(varname,'(A,I0,A,I0)') 'SUBSET_ID_',id
315 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
316C
317 ! Title of the subset
318 titr = subsets(ii)%TITLE
319 IF (len_trim(titr) /= 0) THEN
320 CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
321 ELSE
322 CALL qaprint('A_SUBSET_FAKE_NAME', id,0.0_8)
323 ENDIF
324C
325 ! Number of variable
326 WRITE(varname,'(A,I0,A,I0)') 'SUBSET_NVARTH_',ii
327 temp_int = nvar
328 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
329C
330 ! IAD in the buffer table
331 WRITE(varname,'(A,I0,A,I0)') 'SUBSET_THIAD_',ii
332 temp_int = iad
333 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
334C
335 ! Printing the corresponding buffer table
336 DO i = iad,nvar+iad-1
337 WRITE(varname,'(A,I0,A,I0)') 'ITHBUF_',i
338 temp_int = ithbuf(i)
339 IF (temp_int /= 0) THEN
340 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
341 ENDIF
342 ENDDO
343C
344 ENDIF
345 ENDDO !next /TH/SUBS
346
347C
348 END SUBROUTINE
groupdef_mod
Definition groupdef_mod.F:668
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_thgrou
subroutine st_qaprint_thgrou(nthgroup, ithgrp, ithbuf, ithvar, ipart, ipartth, nthgrpmx, subsets, isubvar, sithgrp, sithbuf)
Definition st_qaprint_time_histories.F:136
st_qaprint_time_histories
subroutine st_qaprint_time_histories(th, ithvar, ipart, subsets, ipartth, nthgrpmx)
Definition st_qaprint_time_histories.F:33
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
groupdef_mod::subset_
Definition groupdef_mod.F:680