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

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_groups (igrnod, igrpart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring)
subroutine qa_print_groups (ptr_igrelem, group_name)

Function/Subroutine Documentation

◆ qa_print_groups()

subroutine qa_print_groups ( type (group_), intent(in) ptr_igrelem,
character, intent(in) group_name )

Definition at line 151 of file st_qaprint_groups.F.

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
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
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_groups()

subroutine st_qaprint_groups ( type (group_), dimension(ngrnod), target igrnod,
type (group_), dimension(ngrpart), target igrpart,
type (group_), dimension(ngrbric), target igrbric,
type (group_), dimension(ngrshel), target igrsh4n,
type (group_), dimension(ngrsh3n), target igrsh3n,
type (group_), dimension(ngrquad), target igrquad,
type (group_), dimension(ngrbeam), target igrbeam,
type (group_), dimension(ngrtrus), target igrtruss,
type (group_), dimension(ngrspri), target igrspring )

Definition at line 31 of file st_qaprint_groups.F.

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
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_groups
subroutine qa_print_groups(ptr_igrelem, group_name)
Definition st_qaprint_groups.F:152