OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_groups.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_groups ../starter/source/output/qaprint/st_qaprint_groups.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!|| qa_print_groups ../starter/source/output/qaprint/st_qaprint_groups.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE st_qaprint_groups(IGRNOD ,IGRPART ,IGRBRIC ,IGRSH4N ,IGRSH3N ,
32 . IGRQUAD,IGRBEAM ,IGRTRUSS ,IGRSPRING )
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE qa_out_mod
37 USE groupdef_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 "com01_c.inc"
46#include "com04_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 TYPE (GROUP_) , TARGET, DIMENSION(NGRNOD) :: IGRNOD
51 TYPE (GROUP_) , TARGET, DIMENSION(NGRPART) :: IGRPART
52 TYPE (GROUP_) , TARGET, DIMENSION(NGRBRIC) :: IGRBRIC
53 TYPE (GROUP_) , TARGET, DIMENSION(NGRSHEL) :: IGRSH4N
54 TYPE (GROUP_) , TARGET, DIMENSION(NGRSH3N) :: IGRSH3N
55 TYPE (GROUP_) , TARGET, DIMENSION(NGRQUAD) :: IGRQUAD
56 TYPE (GROUP_) , TARGET, DIMENSION(NGRBEAM) :: IGRBEAM
57 TYPE (GROUP_) , TARGET, DIMENSION(NGRTRUS) :: IGRTRUSS
58 TYPE (GROUP_) , TARGET, DIMENSION(NGRSPRI) :: IGRSPRING
59C--------------------------------------------------
60C L o c a l V a r i a b l e s
61C-----------------------------------------------
62 LOGICAL :: OK_QA
63 CHARACTER (LEN=255) :: VARNAME
64 TYPE (GROUP_) , POINTER :: PTR_IGRELEM
65 INTEGER KK
66 CHARACTER :: GROUP_NAME*7
67C-----------------------------------------------
68C S o u r c e L i n e s
69C-----------------------------------------------
70
71 ok_qa = myqakey('GROUPS')
72
73 IF (ok_qa) THEN
74
75 DO kk = 1, ngrbric
76 ptr_igrelem => igrbric(kk)
77 group_name(1:7) = 'IGRBRIC'
78 CALL qa_print_groups(ptr_igrelem, group_name)
79 ENDDO
80
81 DO kk = 1, ngrpart
82 ptr_igrelem => igrpart(kk)
83 group_name(1:7) = 'IGRPART'
84 CALL qa_print_groups(ptr_igrelem, group_name)
85 ENDDO
86
87 DO kk = 1, ngrquad
88 ptr_igrelem => igrquad(kk)
89 group_name(1:7) = 'IGRQUAD'
90 CALL qa_print_groups(ptr_igrelem, group_name)
91 ENDDO
92
93 IF( n2d == 0)THEN
94 DO kk = 1, ngrsh3n
95 ptr_igrelem => igrsh3n(kk)
96 group_name(1:7) = 'IGRSH3N'
97 CALL qa_print_groups(ptr_igrelem, group_name)
98 ENDDO
99 ELSEIF( n2d /= 0)THEN
100 DO kk = 1, ngrsh3n
101 ptr_igrelem => igrsh3n(kk)
102 group_name(1:7) = 'IGRTRIA'
103 CALL qa_print_groups(ptr_igrelem, group_name)
104 ENDDO
105 ENDIF
106
107 DO kk = 1, ngrshel
108 ptr_igrelem => igrsh4n(kk)
109 group_name(1:7) = 'IGRSH4N'
110 CALL qa_print_groups(ptr_igrelem, group_name)
111 ENDDO
112
113 DO kk = 1, ngrspri
114 ptr_igrelem => igrspring(kk)
115 group_name(1:7) = 'IGRSPRI'
116 CALL qa_print_groups(ptr_igrelem, group_name)
117 ENDDO
118
119 DO kk = 1, ngrtrus
120 ptr_igrelem => igrtruss(kk)
121 group_name(1:7) = 'IGRTRUS'
122 CALL qa_print_groups(ptr_igrelem, group_name)
123 ENDDO
124
125 DO kk = 1, ngrbeam
126 ptr_igrelem => igrbeam(kk)
127 group_name(1:7) = 'IGRBEAM'
128 CALL qa_print_groups(ptr_igrelem, group_name)
129 ENDDO
130
131 DO kk = 1, ngrnod
132 ptr_igrelem => igrnod(kk)
133 group_name(1:7) = 'IGRNOD '
134 CALL qa_print_groups(ptr_igrelem, group_name)
135 ENDDO
136
137 ENDIF
138
139C-----------------------------------------------
140 RETURN
141 END
142
143
144!||====================================================================
145!|| qa_print_groups ../starter/source/output/qaprint/st_qaprint_groups.F
146!||--- called by ------------------------------------------------------
147!|| st_qaprint_groups ../starter/source/output/qaprint/st_qaprint_groups.F
148!||--- calls -----------------------------------------------------
149!||--- uses -----------------------------------------------------
150!||====================================================================
151 SUBROUTINE qa_print_groups(PTR_IGRELEM, GROUP_NAME)
152C-----------------------------------------------
153C M o d u l e s
154C-----------------------------------------------
155 USE qa_out_mod
156 USE groupdef_mod
157C-----------------------------------------------
158C I m p l i c i t T y p e s
159C-----------------------------------------------
160#include "implicit_f.inc"
161C-----------------------------------------------
162C D u m m y A r g u m e n t s
163C-----------------------------------------------
164 TYPE (GROUP_),INTENT(IN) :: PTR_IGRELEM
165 CHARACTER,INTENT(IN) :: GROUP_NAME*7
166C--------------------------------------------------
167C L o c a l V a r i a b l e s
168C-----------------------------------------------
169 CHARACTER (LEN=255) :: VARNAME
170 INTEGER KK,ID,LEN_
171C-----------------------------------------------
172C S o u r c e L i n e s
173C-----------------------------------------------
174
175 id = ptr_igrelem%ID
176 len_=len_trim(ptr_igrelem%TITLE)
177 WRITE(varname,'(A,I0,A,A)') group_name//'(',id,')%TITLE =',ptr_igrelem%TITLE(1:len_)
178 CALL qaprint(varname(1:len_trim(varname)),id,0.0_8)
179 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%NENTITY ='
180 CALL qaprint(varname(1:len_trim(varname)),ptr_igrelem%NENTITY,0.0_8)
181 WRITE(varname,'(A,I0,A)') group_name//'(',id,')%SET_GROUP ='
182 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%SET_GROUP,0.0_8)
183 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%GRTYPE ='
184 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%GRTYPE,0.0_8)
185 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%SORTED ='
186 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%SORTED,0.0_8)
187 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%GRPGRP ='
188 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%GRPGRP,0.0_8)
189 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%LEVEL ='
190 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%LEVEL,0.0_8)
191 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%R2R_ALL ='
192 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%R2R_ALL,0.0_8)
193 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%R2R_SHARE ='
194 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%R2R_SHARE,0.0_8)
195 WRITE(VARNAME,'(a,i0,a)') GROUP_NAME//'(',ID,')%GRTYPE ='
196 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%GRTYPE,0.0_8)
197 !output only first & last elem
198 DO KK=1,MIN(1,PTR_IGRELEM%NENTITY)
199 WRITE(VARNAME,'(a,a,i10,a,i10,a)') GROUP_NAME,'(',ID,')%ELEM(',KK,') ='
200 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%ENTITY(KK),0.0_8)
201 ENDDO
202 IF(PTR_IGRELEM%NENTITY > 1)THEN
203 WRITE(VARNAME,'(a,a,i10,a,i10,a)') GROUP_NAME,'(',ID,')%ELEM(',PTR_IGRELEM%NENTITY,') ='
204 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PTR_IGRELEM%ENTITY(PTR_IGRELEM%NENTITY),0.0_8)
205 ENDIF
206
207 END
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
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
subroutine qa_print_groups(ptr_igrelem, group_name)
subroutine st_qaprint_groups(igrnod, igrpart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring)