OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_time_histories.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "com10_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_time_histories (th, ithvar, ipart, subsets, ipartth, nthgrpmx)
subroutine st_qaprint_thgrou (nthgroup, ithgrp, ithbuf, ithvar, ipart, ipartth, nthgrpmx, subsets, isubvar, sithgrp, sithbuf)

Function/Subroutine Documentation

◆ st_qaprint_thgrou()

subroutine st_qaprint_thgrou ( integer, intent(in) nthgroup,
integer, dimension(nithgr,*), intent(in) ithgrp,
integer, dimension(sithbuf), intent(in) ithbuf,
integer, dimension(sithvar), intent(in) ithvar,
integer, dimension(lipart1,npart+nthpart), intent(in) ipart,
integer, dimension(2,npart+nthpart), intent(in) ipartth,
integer, intent(in) nthgrpmx,
type(subset_), dimension(nsubs), intent(in) subsets,
integer, intent(in) isubvar,
integer, intent(in) sithgrp,
integer, intent(in) sithbuf )

Definition at line 134 of file st_qaprint_time_histories.F.

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
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
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
qa_out_mod
Definition qa_out_mod.F:78
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
nvar
integer function nvar(text)
Definition nvar.F:32
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804

◆ st_qaprint_time_histories()

subroutine st_qaprint_time_histories ( type(th_) th,
integer, dimension(sithvar), intent(in) ithvar,
integer, dimension(lipart1,npart+nthpart), intent(in), target ipart,
type(subset_), dimension(nsubs), intent(in) subsets,
integer, dimension(18*(npart+nthpart)), intent(in), target ipartth,
integer, intent(in) nthgrpmx )

Definition at line 31 of file st_qaprint_time_histories.F.

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
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
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