OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_initial_state.F File Reference
#include "implicit_f.inc"
#include "scry_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_initial_state (nsigsh, sigsh, nsigi, sigsp, nsigs, sigi, nsigbeam, sigbeam, nsigtruss, sigtruss, nsigrs, sigrs)

Function/Subroutine Documentation

◆ st_qaprint_initial_state()

subroutine st_qaprint_initial_state ( integer, intent(in) nsigsh,
dimension(max(1,nsigsh),*), intent(in) sigsh,
integer, intent(in) nsigi,
dimension(nsigi,*), intent(in) sigsp,
integer, intent(in) nsigs,
dimension(nsigs,*), intent(in) sigi,
integer, intent(in) nsigbeam,
dimension(nsigbeam,*), intent(in) sigbeam,
integer, intent(in) nsigtruss,
dimension(nsigtruss,*), intent(in) sigtruss,
integer, intent(in) nsigrs,
dimension(nsigrs,*), intent(in) sigrs )

Definition at line 30 of file st_qaprint_initial_state.F.

34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 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#include "scry_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 INTEGER, INTENT(IN) :: NSIGSH,NSIGI,NSIGS,NSIGBEAM,NSIGTRUSS,NSIGRS
50 my_real, INTENT(IN) :: sigsh(max(1,nsigsh),*),sigsp(nsigi,*),sigi(nsigs,*),
51 . sigbeam(nsigbeam,*),sigtruss(nsigtruss,*),
52 . sigrs(nsigrs,*)
53C--------------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 LOGICAL :: OK_QA
57 CHARACTER (LEN=255) :: VARNAME
58 INTEGER I,J,ELEM_ID
59 DOUBLE PRECISION TEMP_DOUBLE
60C-----------------------------------------------
61C S o u r c e L i n e s
62C-----------------------------------------------
63
64
65C------------------------------------
66C /INIBRI
67C------------------------------------
68
69 ok_qa = myqakey('/INIBRI')
70
71 IF (ok_qa) THEN
72
73 DO i=1,numsol
74
75 !!! ATTENTION no element ID storage in "SIGI" or "SIGSP" arrays
76 !!! for /INIBRI, or /INIQUA
77!
78!! ELEM_ID = NINT(SIGSP(1,I))
79!! WRITE(VARNAME,'(A)') 'ELEM_ID = '
80!! CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), ELEM_ID,0.0_8)
81 ! print for : 'FILL','EPSP','ENER','DENS','STRESS'
82 DO j=1,nsigs
83 temp_double = sigi(j,i)
84 WRITE(varname,'(A)') 'VALUE = '
85 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
86 ENDDO
87 ! print for all the rest, except above
88 DO j=1,nsigi
89 temp_double = sigsp(j,i)
90 WRITE(varname,'(A)') 'VALUE = '
91 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
92 ENDDO
93
94 ENDDO ! DO I=1,NUMSOL
95
96 ENDIF ! IF (OK_QA) THEN
97
98
99C------------------------------------
100C /INIHE3
101C------------------------------------
102
103 ok_qa = myqakey('/INISHE')
104
105 IF (ok_qa) THEN
106
107 DO i=1,numshel
108
109 elem_id = nint(sigsh(1,i))
110 WRITE(varname,'(A)') 'ELEM_ID = '
111 CALL qaprint(varname(1:len_trim(varname)), elem_id,0.0_8)
112
113 DO j=2,nsigsh
114 temp_double = sigsh(j,i)
115 WRITE(varname,'(A)') 'VALUE = '
116 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
117 ENDDO
118
119 ENDDO ! DO I=1,NUMSHEL
120
121 ENDIF ! IF (OK_QA) THEN
122
123
124C------------------------------------
125C /INIHE3
126C------------------------------------
127
128 ok_qa = myqakey('/INISH3')
129
130 IF (ok_qa) THEN
131
132 DO i=numshel+1,numshel+numsh3n
133
134 elem_id = nint(sigsh(1,i))
135 WRITE(varname,'(A)') 'ELEM_ID = '
136 CALL qaprint(varname(1:len_trim(varname)), elem_id,0.0_8)
137
138 DO j=2,nsigsh
139 temp_double = sigsh(j,i)
140 WRITE(varname,'(A)') 'VALUE = '
141 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
142 ENDDO
143
144 ENDDO ! DO I=1,NUMSHEL+1,NUMSHEL+NUMSH3N
145
146 ENDIF ! IF (OK_QA) THEN
147
148
149C------------------------------------
150C /INIQUA
151C------------------------------------
152
153 ok_qa = myqakey('/INIQUA')
154
155 IF (ok_qa) THEN
156
157 DO i=1,numquad
158
159 !!! ATTENTION no element storage in "SIGI" or "SIGSP" arrays
160 !!! for /INIBRI, or /INIQUA
161!
162!! ELEM_ID = NINT(SIGI(1,I))
163!! WRITE(VARNAME,'(A)') 'ELEM_ID = '
164!! CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)), ELEM_ID,0.0_8)
165
166 DO j=1,nsigs
167 temp_double = sigi(j,i)
168 WRITE(varname,'(A)') 'VALUE = '
169 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
170 ENDDO
171
172 ENDDO ! DO I=1,NUMQUAD
173
174 ENDIF ! IF (OK_QA) THEN
175
176
177C------------------------------------
178C /INIBEAM
179C------------------------------------
180
181 ok_qa = myqakey('/INIBEAM')
182
183 IF (ok_qa) THEN
184
185 DO i=1,numbeam
186
187 elem_id = nint(sigbeam(1,i))
188 WRITE(varname,'(A)') 'ELEM_ID = '
189 CALL qaprint(varname(1:len_trim(varname)), elem_id,0.0_8)
190
191 DO j=2,nsigbeam
192 temp_double = sigbeam(j,i)
193 WRITE(varname,'(A)') 'VALUE = '
194 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
195 ENDDO
196
197 ENDDO ! DO I=1,NUMBEAM
198
199 ENDIF ! IF (OK_QA) THEN
200
201
202
203C------------------------------------
204C /INITRUSS
205C------------------------------------
206
207 ok_qa = myqakey('/INITRUSS')
208
209 IF (ok_qa) THEN
210
211 DO i=1,numtrus
212
213 elem_id = nint(sigtruss(1,i))
214 WRITE(varname,'(A)') 'ELEM_ID = '
215 CALL qaprint(varname(1:len_trim(varname)), elem_id,0.0_8)
216
217 DO j=2,nsigtruss
218 temp_double = sigtruss(j,i)
219 WRITE(varname,'(A)') 'VALUE = '
220 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
221 ENDDO
222
223 ENDDO ! DO I=1,NUMTRUS
224
225 ENDIF ! IF (OK_QA) THEN
226
227
228C------------------------------------
229C /INISPRING
230C------------------------------------
231
232 ok_qa = myqakey('/INISPRING')
233
234 IF (ok_qa) THEN
235
236 DO i=1,numspri
237
238 elem_id = nint(sigrs(1,i))
239 WRITE(varname,'(A)') 'ELEM_ID = '
240 CALL qaprint(varname(1:len_trim(varname)), elem_id,0.0_8)
241
242 DO j=2,nsigrs
243 temp_double = sigrs(j,i)
244 WRITE(varname,'(A)') 'VALUE = '
245 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
246 ENDDO
247
248 ENDDO ! DO I=1,NUMSPRI
249
250 ENDIF ! IF (OK_QA) THEN
251C------------------------------------
252 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
max
#define max(a, b)
Definition macros.h:21
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