OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_initial_state.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_initial_state ../starter/source/output/qaprint/st_qaprint_initial_state.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE st_qaprint_initial_state(
31 . NSIGSH ,SIGSH ,NSIGI ,SIGSP ,NSIGS ,
32 . SIGI ,NSIGBEAM ,SIGBEAM ,NSIGTRUSS,SIGTRUSS,
33 . NSIGRS ,SIGRS )
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
253 END
254
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
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_initial_state
subroutine st_qaprint_initial_state(nsigsh, sigsh, nsigi, sigsp, nsigs, sigi, nsigbeam, sigbeam, nsigtruss, sigtruss, nsigrs, sigrs)
Definition st_qaprint_initial_state.F:34