OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_surf.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_surf ../starter/source/output/qaprint/st_qaprint_surf.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!|| qa_print_surf ../starter/source/output/qaprint/st_qaprint_surf.f
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE st_qaprint_surf(IGRSURF,IGRSLIN, BUFSF, SBUFSF)
32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE groupdef_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45C-----------------------------------------------
46C D u m m y A r g u m e n t s
47C-----------------------------------------------
48 TYPE (SURF_) , INTENT(IN), TARGET, DIMENSION(NSURF) :: IGRSURF
49 TYPE (SURF_) , INTENT(IN), TARGET, DIMENSION(NSLIN) :: IGRSLIN
50 INTEGER,INTENT(IN) :: SBUFSF
51 my_real :: bufsf(sbufsf)
52C--------------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 LOGICAL :: OK_QA
56 CHARACTER (LEN=255) :: VARNAME
57 TYPE (SURF_) , POINTER :: PTR_IGRSURF
58 INTEGER KK ,NN, IAD_PREV
59 CHARACTER :: GROUP_NAME*7
60C-----------------------------------------------
61C S o u r c e L i n e s
62C-----------------------------------------------
63
64 ok_qa = myqakey('/SURF')
65 iad_prev=1
66 IF (ok_qa) THEN
67 DO kk = 1, nsurf
68 ptr_igrsurf => igrsurf(kk)
69 IF(kk>1)iad_prev=igrsurf(kk-1)%IAD_BUFR
70 group_name(1:7) = 'IGRSURF'
71 CALL qa_print_surf(ptr_igrsurf, group_name, bufsf,sbufsf, iad_prev, 4)
72 ENDDO
73 ENDIF
74
75 ok_qa = myqakey('/LINE')
76 iad_prev=1
77 IF (ok_qa) THEN
78 DO kk = 1, nslin
79 ptr_igrsurf => igrslin(kk)
80 IF(kk>1)iad_prev=igrsurf(kk-1)%IAD_BUFR
81 group_name(1:7) = 'IGRSLIN'
82 CALL qa_print_surf(ptr_igrsurf, group_name, bufsf,sbufsf, iad_prev, 2)
83 ENDDO
84 ENDIF
85
86C-----------------------------------------------
87 RETURN
88 END
89
90
91!||====================================================================
92!|| qa_print_surf ../starter/source/output/qaprint/st_qaprint_surf.F
93!||--- called by ------------------------------------------------------
94!|| st_qaprint_surf ../starter/source/output/qaprint/st_qaprint_surf.F
95!||--- calls -----------------------------------------------------
96!||--- uses -----------------------------------------------------
97!||====================================================================
98 SUBROUTINE qa_print_surf(PTR_IGRSURF, GROUP_NAME, BUFSF, SBUFSF, IAD_PREV, NNOD)
99C-----------------------------------------------
100C M o d u l e s
101C-----------------------------------------------
102 USE qa_out_mod
103 USE groupdef_mod
104C-----------------------------------------------
105C I m p l i c i t T y p e s
106C-----------------------------------------------
107#include "implicit_f.inc"
108C-----------------------------------------------
109C D u m m y A r g u m e n t s
110C-----------------------------------------------
111 TYPE (SURF_),INTENT(IN) :: PTR_IGRSURF
112 CHARACTER,INTENT(IN) :: GROUP_NAME*7
113 INTEGER, INTENT(IN) :: SBUFSF, IAD_PREV,NNOD
114 my_real :: bufsf(sbufsf)
115C--------------------------------------------------
116C L o c a l V a r i a b l e s
117C-----------------------------------------------
118 CHARACTER (LEN=255) :: VARNAME
119 INTEGER KK,ID,LEN_,NEL,NEL_IGE,NN,TMP, IAD_CUR,LEN_BUFSF
120 DOUBLE PRECISION :: RTMP
121C-----------------------------------------------
122C S o u r c e L i n e s
123C-----------------------------------------------
124
125 id = ptr_igrsurf%ID
126 len_=len_trim(ptr_igrsurf%TITLE)
127 WRITE(varname,'(A,I0,A,A)') group_name//'(',id,')%TITLE=',ptr_igrsurf%TITLE(1:len_)
128 CALL qaprint(varname(1:len_trim(varname)),id,0.0_8)
129
130 tmp=ptr_igrsurf%NSEG
131 IF(tmp/=0)THEN
132 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%NSEG='
133 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
134 ENDIF
135
136 tmp=ptr_igrsurf%NSEG_IGE
137 IF(tmp/=0)THEN
138 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%NSEG_IGE='
139 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
140 ENDIF
141
142 tmp=ptr_igrsurf%IAD_IGE
143 IF(tmp/=0)THEN
144 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%IAD_IGE='
145 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
146 ENDIF
147
148 tmp=ptr_igrsurf%SET_GROUP
149 IF(tmp/=0)THEN
150 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%SET_GROUP='
151 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
152 ENDIF
153
154 tmp=ptr_igrsurf%TYPE
155 IF(tmp/=0)THEN
156 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%TYPE='
157 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
158 ENDIF
159
160 tmp=ptr_igrsurf%SET_GROUP
161 IF(tmp/=0)THEN
162 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%SET_GROUP='
163 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
164 ENDIF
165
166 tmp=ptr_igrsurf%ID_MADYMO
167 IF(tmp/=0)THEN
168 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%ID_MADYMO='
169 CALL qaprint(varname(1:len_trim(varname)),tmp,0.0_8)
170 ENDIF
171
172 tmp=ptr_igrsurf%IAD_BUFR
173 IF(tmp/=0)THEN
174 WRITE(varname,'(A,I0,A)') group_name//'(',ID,')%IAD_BUFR='
175 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
176 ENDIF
177
178 TMP=PTR_IGRSURF%NB_MADYMO
179 IF(TMP/=0)THEN
180 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%NB_MADYMO='
181 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
182 ENDIF
183
184 TMP=PTR_IGRSURF%TYPE_MADYMO
185 IF(TMP/=0)THEN
186 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%TYPE_MADYMO='
187 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
188 ENDIF
189
190 TMP=PTR_IGRSURF%LEVEL
191 IF(TMP/=0)THEN
192 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%LEVEL='
193 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
194 ENDIF
195
196 TMP=PTR_IGRSURF%TH_SURF
197 IF(TMP/=0)THEN
198 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%TH_SURF='
199 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
200 ENDIF
201
202 TMP=PTR_IGRSURF%ISH4N3N
203 IF(TMP/=0)THEN
204 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%ISH4N3N='
205 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
206 ENDIF
207
208 TMP=PTR_IGRSURF%NSEG_R2R_ALL
209 IF(TMP/=0)THEN
210 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%NSEG_R2R_ALL='
211 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
212 ENDIF
213
214 TMP=PTR_IGRSURF%NSEG_R2R_SHARE
215 IF(TMP/=0)THEN
216 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%NSEG_R2R_SHARE='
217 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
218 ENDIF
219
220
221 NEL=PTR_IGRSURF%NSEG
222 NEL_IGE=PTR_IGRSURF%NSEG_IGE
223
224 IF (ALLOCATED(PTR_IGRSURF%REVERSED)) THEN
225 DO KK=1,MIN(3,NEL)
226 TMP=PTR_IGRSURF%REVERSED(KK)
227 IF(TMP/=0)THEN
228 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%REVERSED(',KK,')='
229 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
230 ENDIF
231 ENDDO
232 ENDIF
233
234 IF (ALLOCATED(PTR_IGRSURF%ELTYP)) THEN
235 DO KK=1,MIN(3,NEL)
236 TMP=PTR_IGRSURF%ELTYP(KK)
237 IF(TMP/=0)THEN
238 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%ELTYP(',KK,')='
239 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
240 ENDIF
241 ENDDO
242 ENDIF
243
244.AND. IF (ALLOCATED(PTR_IGRSURF%ELEM) ALLOCATED(PTR_IGRSURF%NODES)) THEN
245 DO KK=1,MIN(3,NEL)
246 TMP=PTR_IGRSURF%ELEM(KK)
247 IF(TMP/=0)THEN
248 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%ELEM(',KK,')='
249 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
250 ENDIF
251 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a,i0,a,i0)') GROUP_NAME//'(',ID,')%ELEM(1:4)=',PTR_IGRSURF%NODES(KK,1),
252 . ',',PTR_IGRSURF%NODES(KK,2),',',PTR_IGRSURF%NODES(KK,3),',',PTR_IGRSURF%NODES(KK,4)
253 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,1.D0)
254 ENDDO
255 ENDIF
256
257 IF (ALLOCATED(PTR_IGRSURF%PROC)) THEN
258 DO KK=1,MIN(3,NEL)
259 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%PROC(',KK,')='
260 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRSURF%PROC(KK),0.0_8)
261 ENDDO
262 ENDIF
263
264 IF (ALLOCATED(PTR_IGRSURF%ELTYP_IGE)) THEN
265 DO KK=1,MIN(3,NEL_IGE)
266 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%ELTYP_IGE(',KK,')='
267 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRSURF%ELTYP_IGE(KK),0.0_8)
268 ENDDO
269 ENDIF
270
271 IF (ALLOCATED(PTR_IGRSURF%ELEM_IGE)) THEN
272 DO KK=1,MIN(3,NEL_IGE)
273 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%ELEM_IGE(',KK,')='
274 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRSURF%ELEM_IGE(KK),0.0_8)
275 ENDDO
276 ENDIF
277
278.AND. IF (ALLOCATED(PTR_IGRSURF%ELEM_IGE) ALLOCATED(PTR_IGRSURF%NODES_IGE)) THEN
279 DO KK=1,MIN(3,NEL_IGE)
280 TMP=PTR_IGRSURF%ELEM_IGE(KK)
281 IF(TMP/=0)THEN
282 WRITE(VARNAME,'(a,i0,a,i0,a)') GROUP_NAME//'(',ID,')%ELEM_IGE(',KK,')='
283 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TMP,0.0_8)
284 IF(NNOD==2)THEN
285 WRITE(VARNAME,'(a,i0,a,i0,a,i0)') GROUP_NAME//'(',ID,')%ELEM(1:4)=',PTR_IGRSURF%NODES_IGE(KK,1),
286 . ',',PTR_IGRSURF%NODES_IGE(KK,2)
287 ELSEIF(NNOD==4)THEN
288 WRITE(VARNAME,'(a,i0,a,i0,a,i0,a,i0,a,i0)') GROUP_NAME//'(',ID,')%ELEM(1:4)=',PTR_IGRSURF%NODES_IGE(KK,1),
289 . ',',ptr_igrsurf%NODES_IGE(kk,2),',',ptr_igrsurf%NODES_IGE(kk,3),',',ptr_igrsurf%NODES_IGE(kk,4)
290 ENDIF
291 CALL qaprint(varname(1:len_trim(varname)),1,0.0_8)
292 ENDIF
293 ENDDO
294 ENDIF
295
296 iad_cur=ptr_igrsurf%IAD_BUFR
297 len_bufsf = 0
298 IF(ptr_igrsurf%TYPE == 100) len_bufsf = 43 ! mad ellipse
299 IF(ptr_igrsurf%TYPE == 101) len_bufsf = 36 ! radioss ellipse
300 IF(ptr_igrsurf%TYPE == 200) len_bufsf = 6 ! radioss plane
301 !DO KK=MAX(1,IAD_PREV),IAD_CUR
302 IF (ptr_igrsurf%TYPE == 100 .OR. ptr_igrsurf%TYPE == 101 .OR. ptr_igrsurf%TYPE == 200) THEN
303 DO kk=iad_cur+1,iad_cur+len_bufsf
304 rtmp = bufsf(kk)
305 IF(rtmp /= zero)THEN
306 WRITE(varname,'(A,I0,A,I0,A)') group_name//'(',id,')--->BUFSF(',kk-iad_cur,')='
307 CALL qaprint(varname(1:len_trim(varname)),0,rtmp)
308 ENDIF
309 ENDDO
310 ENDIF
311
312
313 END
314
my_real
#define my_real
Definition cppsort.cpp:32
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
qa_print_surf
subroutine qa_print_surf(ptr_igrsurf, group_name, bufsf, sbufsf, iad_prev, nnod)
Definition st_qaprint_surf.F:99
st_qaprint_surf
subroutine st_qaprint_surf(igrsurf, igrslin, bufsf, sbufsf)
Definition st_qaprint_surf.F:32
starter
program starter
Definition starter.F:39