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

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_surf (igrsurf, igrslin, bufsf, sbufsf)
subroutine qa_print_surf (ptr_igrsurf, group_name, bufsf, sbufsf, iad_prev, nnod)

Function/Subroutine Documentation

◆ qa_print_surf()

subroutine qa_print_surf ( type (surf_), intent(in) ptr_igrsurf,
character, intent(in) group_name,
bufsf,
integer, intent(in) sbufsf,
integer, intent(in) iad_prev,
integer, intent(in) nnod )

Definition at line 98 of file st_qaprint_surf.F.

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 IF (ALLOCATED(ptr_igrsurf%ELEM) .AND. 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.OR..OR. IF (PTR_IGRSURF%TYPE == 100 PTR_IGRSURF%TYPE == 101 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
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
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

◆ st_qaprint_surf()

subroutine st_qaprint_surf ( type (surf_), dimension(nsurf), intent(in), target igrsurf,
type (surf_), dimension(nslin), intent(in), target igrslin,
bufsf,
integer, intent(in) sbufsf )

Definition at line 31 of file st_qaprint_surf.F.

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
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_print_surf
subroutine qa_print_surf(ptr_igrsurf, group_name, bufsf, sbufsf, iad_prev, nnod)
Definition st_qaprint_surf.F:99