OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_set.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_set ../starter/source/output/qaprint/st_qaprint_set.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!|| hm_get_int_array_2indexes ../starter/source/devtools/hm_reader/hm_get_int_array_2indexes.F
29!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
30!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
31!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
32!|| hm_get_string_index ../starter/source/devtools/hm_reader/hm_get_string_index.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!||--- uses -----------------------------------------------------
36!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
37!|| submodel_mod ../starter/share/modules1/submodel_mod.F
38!||====================================================================
39 SUBROUTINE st_qaprint_set(SET ,LSUBMODEL,ITAB ,IGRNOD ,IGRPART,
40 . IPART ,IGRBRIC ,IGRSH4N ,IGRSH3N,IGRQUAD,
41 . IGRBEAM,IGRTRUSS ,IGRSPRING,IGRSURF,IGRSLIN,
42 . IXC ,IXTG ,IXQ ,IXP ,IXT ,
43 . IXR ,IXS )
44C=======================================================================
45C M o d u l e s
46C-----------------------------------------------
47 USE qa_out_mod
48 USE setdef_mod
49 USE groupdef_mod
50 USE submodel_mod
51 USE hm_option_read_mod
52 USE names_and_titles_mod , ONLY : nchartitle, ncharfield, ncharkey, ncharline
53C-----------------------------------------------
54C I m p l i c i t T y p e s
55C-----------------------------------------------
56#include "implicit_f.inc"
57C-----------------------------------------------
58C C o m m o n B l o c k s
59C-----------------------------------------------
60#include "com04_c.inc"
61#include "scr17_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 INTEGER, INTENT(IN) :: ITAB(*),IPART(LIPART1,*),IXC(NIXC,*),
66 . IXTG(NIXTG,*),IXQ(NIXQ,*),IXP(NIXP,*),IXT(NIXT,*),IXR(NIXR,*),
67 . IXS(NIXS,*)
68!
69 TYPE (SET_) , DIMENSION(NSETS) :: SET
70 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
71 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRNOD) :: IGRNOD
72 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRPART) :: IGRPART
73 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRBRIC) :: IGRBRIC
74 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRSHEL) :: IGRSH4N
75 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRSH3N) :: IGRSH3N
76 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRQUAD) :: IGRQUAD
77 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRBEAM) :: IGRBEAM
78 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRTRUS) :: IGRTRUSS
79 TYPE (GROUP_) , INTENT(IN), DIMENSION(NGRSPRI) :: IGRSPRING
80 TYPE (SURF_) , INTENT(IN), DIMENSION(NSURF) :: IGRSURF
81 TYPE (SURF_) , INTENT(IN), DIMENSION(NSLIN) :: IGRSLIN
82C--------------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 INTEGER I,J,K,N,ID,IGS,CLAUSES_MAX,ISET_TYPE,ITMP,ICODE,IDS_MAX,IDS,
86 . OPT_,OPT_D,OPT_O,OPT_G,OPT_B,OPT_A,OPT_E,OPT_I,OPT_C,
87 . IGR,NOD,NB_NODE,NB_PART,IP,IE,NB_SOLID,NB_SH4N,NB_SH3N,
88 . NB_QUAD,NB_TRIA,NB_BEAM,NB_TRUSS,NB_SPRING,NB_SURF_SEG,
89 . nb_line_seg,iseg,nb_nodens
90 CHARACTER(LEN = nchartitle) :: TITLE
91 CHARACTER(LEN = ncharfield) :: KEYSET,SET_TYPE
92 CHARACTER(LEN = ncharkey) :: KEY
93 CHARACTER (LEN=255) :: VARNAME
94 DOUBLE PRECISION TEMP_DOUBLE
95 LOGICAL IS_AVAILABLE
96C-----------------------------------------------
97 is_available = .false.
98!
99! not calling regularly
100!! CALL HM_DEBUG_PRINT_OPTION('/SET')
101!
102 CALL hm_option_start('/SET')
103!
104 IF (myqakey('/SET')) THEN
105!
106 IF (nsets > 0) THEN
107!
108 DO igs = 1, nsets
109!---
110 CALL hm_option_read_key(lsubmodel,option_id=id,option_titr=title,keyword2=key)
111 WRITE(varname,'(A)') trim(title)
112 CALL qaprint(title(1:len_trim(varname)), id, 0.0_8)
113!---
114 CALL hm_get_string('set_Type', set_type ,ncharfield, is_available)
115!-----------------------
116! issue 'SET_TYPE' ---> read one more character than the SET_TYPE
117! ===> workaround
118 itmp = len(trim(set_type))
119 IF (itmp > 0) THEN
120 icode = iachar(set_type(itmp:itmp))
121 IF (icode == 0) set_type(itmp:itmp)=' '
122 ENDIF
123!-----------------------
124 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//trim(set_type)
125 CALL qaprint(varname(1:len_trim(varname)), id, 0.0_8)
126!---
127 CALL hm_get_intv('iset_Type', iset_type,is_available,lsubmodel)
128 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'iset_Type'
129 CALL qaprint(varname(1:len_trim(varname)), iset_type, 0.0_8)
130!---
131 CALL hm_get_intv('clausesmax',clauses_max,is_available,lsubmodel)
132!
133 DO j=1,clauses_max ! max KEY's of the current /SET
134 CALL hm_get_string_index('KEY_type', keyset, j, ncharline, is_available)
135!-----------------------
136! issue 'KEYSET' ---> read one more character than the KEYSET
137! ===> workaround
138 itmp = len(trim(keyset))
139 icode = iachar(keyset(itmp:itmp))
140 IF (icode == 0) keyset(itmp:itmp)=' '
141!-----------------------
142!---
143!! CALL HM_GET_INT_ARRAY_INDEX('opt_' ,OPT_ ,J,IS_AVAILABLE,LSUBMODEL)
144 CALL hm_get_int_array_index('opt_D',opt_d,j,is_available,lsubmodel)
145 CALL hm_get_int_array_index('opt_O',opt_o,j,is_available,lsubmodel)
146 CALL hm_get_int_array_index('opt_G',opt_g,j,is_available,lsubmodel)
147 CALL hm_get_int_array_index('opt_B',opt_b,j,is_available,lsubmodel)
148 CALL hm_get_int_array_index('opt_A',opt_a,j,is_available,lsubmodel)
149 CALL hm_get_int_array_index('opt_E',opt_e,j,is_available,lsubmodel)
150 CALL hm_get_int_array_index('opt_I',opt_i,j,is_available,lsubmodel)
151 CALL hm_get_int_array_index('opt_C',opt_c,j,is_available,lsubmodel)
152!---
153!! IF (OPT_ == 1) THEN
154!! WRITE(VARNAME,'(A,I0,A)') 'SET_',ID,'_'//'opt_'
155!! CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),OPT_,0.0_8)
156!! ENDIF ! IF (OPT_ == 1)
157 IF (opt_d == 1) THEN
158 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_D'
159 CALL qaprint(varname(1:len_trim(varname)),opt_d,0.0_8)
160 ENDIF ! IF (OPT_D == 1)
161 IF (opt_o == 1) THEN
162 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_O'
163 CALL qaprint(varname(1:len_trim(varname)),opt_o,0.0_8)
164 ENDIF ! IF (OPT_O == 1)
165 IF (opt_g == 1) THEN
166 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_G'
167 CALL qaprint(varname(1:len_trim(varname)),opt_g,0.0_8)
168 ENDIF ! IF (OPT_G == 1)
169 IF (opt_b == 1) THEN
170 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_B'
171 CALL qaprint(varname(1:len_trim(varname)),opt_b,0.0_8)
172 ENDIF ! IF (OPT_B == 1)
173 IF (opt_a == 1) THEN
174 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_A'
175 CALL qaprint(varname(1:len_trim(varname)),opt_a,0.0_8)
176 ENDIF ! IF (opt_A == 1)
177 IF (opt_e == 1) THEN
178 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_E'
179 CALL qaprint(varname(1:len_trim(varname)),opt_e,0.0_8)
180 ENDIF ! IF (OPT_E == 1)
181 IF (opt_i == 1) THEN
182 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_I'
183 CALL qaprint(varname(1:len_trim(varname)),opt_i,0.0_8)
184 ENDIF ! IF (OPT_I == 1)
185 IF (opt_c == 1) THEN
186 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'opt_C'
187 CALL qaprint(varname(1:len_trim(varname)),opt_c,0.0_8)
188 ENDIF ! IF (OPT_C == 1)
189!---
190 CALL hm_get_int_array_index('idsmax' ,ids_max ,j,is_available,lsubmodel)
191 DO k=1,ids_max
192 CALL hm_get_int_array_2indexes('ids',ids,j,k,is_available,lsubmodel)
193 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//trim(keyset)//'_',k
194 CALL qaprint(varname(1:len_trim(varname)),ids,0.0_8)
195 ENDDO ! DO K=1,IDS_MAX
196!---
197 ENDDO ! DO J=1,CLAUSES_MAX
198!---
199! printout new groupes (grnod, grpart, grelem, ...) generated by /SET
200!---
201!
202!---
203! --- New /SET grnod of NODES--
204!---
205 IF( set(igs)%SET_ACTIV == 0 ) cycle
206
207 nb_node = set(igs)%NB_NODE
208
209 IF (nb_node > 0) THEN
210 igr = set(igs)%SET_GRNOD_ID
211 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRNOD'
212 CALL qaprint(varname(1:len_trim(varname)),igrnod(igr)%ID,0.0_8)
213 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRNOD_NB_NODE'
214 CALL qaprint(varname(1:len_trim(varname)),nb_node,0.0_8)
215 DO n = 1,nb_node
216 nod = igrnod(igr)%ENTITY(n)
217 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'NODE'//'_',n
218 CALL qaprint(varname(1:len_trim(varname)),itab(nod),0.0_8)
219 ENDDO
220 ENDIF ! IF (NB_NODE > 0)
221!---
222! --- New /SET grnod of NODENS --
223!---
224 IF( set(igs)%SET_ACTIV == 0 ) cycle
225
226 nb_nodens = set(igs)%NB_NODENS
227
228 IF (nb_nodens > 0) THEN
229 igr = set(igs)%SET_GRNOD_ID
230 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRNOD'
231 CALL qaprint(varname(1:len_trim(varname)),igrnod(igr)%ID,0.0_8)
232 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRNOD_NB_NODENS'
233 CALL qaprint(varname(1:len_trim(varname)),nb_nodens,0.0_8)
234 DO n = 1,nb_nodens
235 nod = igrnod(igr)%ENTITY(n)
236 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'NODENS'//'_',n
237 CALL qaprint(varname(1:len_trim(varname)),itab(nod),0.0_8)
238 ENDDO
239 ENDIF ! IF (NB_NODENS > 0)
240!---
241! --- New /SET grpart --
242!---
243 nb_part = set(igs)%NB_PART
244 IF (nb_part > 0) THEN
245 igr = set(igs)%SET_GRPART_ID
246 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRPART'
247 CALL qaprint(varname(1:len_trim(varname)),igrpart(igr)%ID,0.0_8)
248 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRPART_NB_PART'
249 CALL qaprint(varname(1:len_trim(varname)),nb_part,0.0_8)
250 DO n = 1,nb_part
251 ip = igrpart(igr)%ENTITY(n)
252 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'PART'//'_',n
253 CALL qaprint(varname(1:len_trim(varname)),ipart(4,ip),0.0_8)
254 ENDDO
255 ENDIF ! IF (NB_PART > 0)
256!---
257! --- New /SET grelem --
258!---
259 ! solid
260 nb_solid = set(igs)%NB_SOLID
261 IF (nb_solid > 0) THEN
262 igr = set(igs)%SET_GRSOLID_ID
263 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRBRIC'
264 CALL qaprint(varname(1:len_trim(varname)),igrbric(igr)%ID,0.0_8)
265 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRBRIC_NB_SOLID'
266 CALL qaprint(varname(1:len_trim(varname)),nb_solid,0.0_8)
267 DO n = 1,nb_solid
268 ie = igrbric(igr)%ENTITY(n)
269 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'SOLID'//'_',n
270 CALL qaprint(varname(1:len_trim(varname)),ixs(nixs,ie),0.0_8)
271 ENDDO
272 ENDIF ! IF (NB_SOLID > 0)
273!
274 ! sh4n
275 nb_sh4n = set(igs)%NB_SH4N
276 IF (nb_sh4n > 0) THEN
277 igr = set(igs)%SET_GRSH4N_ID
278 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRSH4N'
279 CALL qaprint(varname(1:len_trim(varname)),igrsh4n(igr)%ID,0.0_8)
280 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRSH4N_NB_SH4N'
281 CALL qaprint(varname(1:len_trim(varname)),nb_sh4n,0.0_8)
282 DO n = 1,nb_sh4n
283 ie = igrsh4n(igr)%ENTITY(n)
284 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'SHELL'//'_',n
285 CALL qaprint(varname(1:len_trim(varname)),ixc(nixc,ie),0.0_8)
286 ENDDO
287 ENDIF ! IF (NB_SH4N > 0)
288!
289 ! sh3n
290 nb_sh3n = set(igs)%NB_SH3N
291 IF (nb_sh3n > 0) THEN
292 igr = set(igs)%SET_GRSH3N_ID
293 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRSH3N'
294 CALL qaprint(varname(1:len_trim(varname)),igrsh3n(igr)%ID,0.0_8)
295 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRSH3N_NB_SH3N'
296 CALL qaprint(varname(1:len_trim(varname)),nb_sh3n,0.0_8)
297 DO n = 1,nb_sh3n
298 ie = igrsh3n(igr)%ENTITY(n)
299 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'SH3N'//'_',n
300 CALL qaprint(varname(1:len_trim(varname)),ixtg(nixtg,ie),0.0_8)
301 ENDDO
302 ENDIF ! IF (NB_SH3N > 0)
303!
304 ! quad
305 nb_quad = set(igs)%NB_QUAD
306 IF (nb_quad > 0) THEN
307 igr = set(igs)%SET_GRQUAD_ID
308 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRQUAD'
309 CALL qaprint(varname(1:len_trim(varname)),igrquad(igr)%ID,0.0_8)
310 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRQUAD_NB_QUAD'
311 CALL qaprint(varname(1:len_trim(varname)),nb_quad,0.0_8)
312 DO n = 1,nb_quad
313 ie = igrquad(igr)%ENTITY(n)
314 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'QUAD'//'_',n
315 CALL qaprint(varname(1:len_trim(varname)),ixq(nixq,ie),0.0_8)
316 ENDDO
317 ENDIF ! IF (NB_QUAD > 0)
318!
319 ! tria
320 nb_tria = set(igs)%NB_TRIA
321 IF (nb_tria > 0) THEN
322 igr = set(igs)%SET_GRTRIA_ID
323 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRTRIA'
324 CALL qaprint(varname(1:len_trim(varname)),igrsh3n(igr)%ID,0.0_8)
325 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRTRIA_NB_TRIA'
326 CALL qaprint(varname(1:len_trim(varname)),nb_tria,0.0_8)
327 DO n = 1,nb_tria
328 ie = igrsh3n(igr)%ENTITY(n)
329 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'TRIA'//'_',n
330 CALL qaprint(varname(1:len_trim(varname)),ixtg(nixtg,ie),0.0_8)
331 ENDDO
332 ENDIF ! IF (NB_TRIA > 0)
333!
334 ! beam
335 nb_beam = set(igs)%NB_BEAM
336 IF (nb_beam > 0) THEN
337 igr = set(igs)%SET_GRBEAM_ID
338 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRBEAM'
339 CALL qaprint(varname(1:len_trim(varname)),igrbeam(igr)%ID,0.0_8)
340 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRBEAM_NB_BEAM'
341 CALL qaprint(varname(1:len_trim(varname)),nb_beam,0.0_8)
342 DO n = 1,nb_beam
343 ie = igrbeam(igr)%ENTITY(n)
344 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'BEAM'//'_',n
345 CALL qaprint(varname(1:len_trim(varname)),ixp(nixp,ie),0.0_8)
346 ENDDO
347 ENDIF ! IF (NB_BEAM > 0)
348!
349 ! truss
350 nb_truss = set(igs)%NB_TRUSS
351 IF (nb_truss > 0) THEN
352 igr = set(igs)%SET_GRTRUSS_ID
353 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRTRUSS'
354 CALL qaprint(varname(1:len_trim(varname)),igrtruss(igr)%ID,0.0_8)
355 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRTRUSS_NB_TRUSS'
356 CALL qaprint(varname(1:len_trim(varname)),nb_truss,0.0_8)
357 DO n = 1,nb_truss
358 ie = igrtruss(igr)%ENTITY(n)
359 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'TRUSS'//'_',n
360 CALL qaprint(varname(1:len_trim(varname)),ixt(nixt,ie),0.0_8)
361 ENDDO
362 ENDIF ! IF (NB_TRUSS > 0)
363!
364 ! spring
365 nb_spring = set(igs)%NB_SPRING
366 IF (nb_spring > 0) THEN
367 igr = set(igs)%SET_GRSPRING_ID
368 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRSPRING'
369 CALL qaprint(varname(1:len_trim(varname)),igrspring(igr)%ID,0.0_8)
370 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'GRSPRING_NB_SPRING'
371 CALL qaprint(varname(1:len_trim(varname)),nb_spring,0.0_8)
372 DO n = 1,nb_spring
373 ie = igrspring(igr)%ENTITY(n)
374 WRITE(varname,'(A,I0,A,I0)') 'SET_',id,'_'//'SPRING'//'_',n
375 CALL qaprint(varname(1:len_trim(varname)),ixr(nixr,ie),0.0_8)
376 ENDDO
377 ENDIF ! IF (NB_SPRING > 0)
378!---
379! --- New /SET grsurf --
380!---
381 ! surface segments
382 nb_surf_seg = set(igs)%HAS_SURF_SEG
383 IF (nb_surf_seg > 0) THEN
384 igr = set(igs)%SET_NSURF_ID
385 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'SURFACE'
386 CALL qaprint(varname(1:len_trim(varname)),igrsurf(igr)%ID,0.0_8)
387 WRITE(varname,'(a,i0,a)') 'set_',ID,'_'//'surface_nb_seg'
388 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NB_SURF_SEG,0.0_8)
389 DO N = 1,NB_SURF_SEG
390.AND. IF(SET(IGS)%NB_ELLIPSE == 0 SET(IGS)%NB_PLANE== 0)THEN
391 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'surface_seg_',N,'_node_1'
392 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(IGRSURF(IGR)%NODES(N,1)),0.0_8)
393 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'surface_seg_',N,'_node_2'
394 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(IGRSURF(IGR)%NODES(N,2)),0.0_8)
395 IF(IGRSURF(IGR)%NODES(N,3) > 0)THEN
396 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'surface_seg_',N,'_node_3'
397 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(IGRSURF(IGR)%NODES(N,3)),0.0_8)
398 ENDIF
399 IF(IGRSURF(IGR)%NODES(N,4) > 0)THEN
400 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'surface_seg_',N,'_node_4'
401 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(IGRSURF(IGR)%NODES(N,4)),0.0_8)
402 ENDIF
403 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'surface_seg_',N,'_eltyp'
404 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IGRSURF(IGR)%ELTYP(N),0.0_8)
405 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'surface_seg_',N,'_elem'
406 IF (IGRSURF(IGR)%ELTYP(N) == 3 ) THEN ! SH4N
407 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IXC(NIXC,IGRSURF(IGR)%ELEM(N)),0.0_8)
408 ELSEIF (IGRSURF(IGR)%ELTYP(N) == 7 ) THEN ! SH3N
409 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IXTG(NIXTG,IGRSURF(IGR)%ELEM(N)),0.0_8)
410 ELSEIF (IGRSURF(IGR)%ELTYP(N) == 1 ) THEN ! SOLID
411 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IXS(NIXS,IGRSURF(IGR)%ELEM(N)),0.0_8)
412 ENDIF ! IF (IGRSURF(IGR)%ELTYP(N) == 3 )
413
414 ELSE IF(SET(IGS)%NB_ELLIPSE == 1)THEN
415 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_xc = '
416 TEMP_DOUBLE = SET(IGS)%ELLIPSE_XC
417 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
418 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_yc = '
419 TEMP_DOUBLE = SET(IGS)%ELLIPSE_YC
420 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
421 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_zc = '
422 TEMP_DOUBLE = SET(IGS)%ELLIPSE_ZC
423 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
424 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_a = '
425 TEMP_DOUBLE = SET(IGS)%ELLIPSE_A
426 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
427 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_b = '
428 TEMP_DOUBLE = SET(IGS)%ELLIPSE_B
429 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
430 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_c = '
431 TEMP_DOUBLE = SET(IGS)%ELLIPSE_C
432 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
433 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_n'
434 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),SET(IGS)%ELLIPSE_N,0.0_8)
435 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'ellipse_skew_id'
436 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),SET(IGS)%ELLIPSE_ID_MADYMO,0.0_8)
437 ELSE IF(SET(IGS)%NB_PLANE == 1)THEN
438 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'plane_xm = '
439 TEMP_DOUBLE = SET(IGS)%PLANE_XM
440 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
441 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'plane_ym = '
442 TEMP_DOUBLE = SET(IGS)%PLANE_YM
443 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
444 WRITE(VARNAME,'(a,i0,a)') 'set_',ID,'_'//'plane_zm = '
445 temp_double = set(igs)%PLANE_ZM
446 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
447 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'PLANE_XM1 = '
448 temp_double = set(igs)%PLANE_XM1
449 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
450 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'PLANE_YM1 = '
451 temp_double = set(igs)%PLANE_YM1
452 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
453 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'PLANE_ZM1 = '
454 temp_double = set(igs)%PLANE_ZM1
455 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
456 ENDIF
457
458 ENDDO
459 ENDIF ! IF (NB_SURF_SEG > 0)
460!---
461! --- New /SET grline --
462!---
463 ! line segments
464 nb_line_seg = set(igs)%HAS_LINE_SEG
465 IF (nb_line_seg > 0) THEN
466 igr = set(igs)%SET_NSLIN_ID
467 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'LINE'
468 CALL qaprint(varname(1:len_trim(varname)),igrslin(igr)%ID,0.0_8)
469 WRITE(varname,'(A,I0,A)') 'SET_',id,'_'//'LINE_NB_SEG'
470 CALL qaprint(varname(1:len_trim(varname)),nb_line_seg,0.0_8)
471 DO n = 1,nb_line_seg
472 WRITE(varname,'(A,I0,A,I0,A)') 'SET_',id,'_'//'LINE_SEG_',n,'_NODE_1'
473 CALL qaprint(varname(1:len_trim(varname)),itab(igrslin(igr)%NODES(n,1)),0.0_8)
474 WRITE(varname,'(A,I0,A,I0,A)') 'SET_',id,'_'//'line_seg_',N,'_node_2'
475 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(IGRSLIN(IGR)%NODES(N,2)),0.0_8)
476 WRITE(VARNAME,'(a,i0,a,i0,a)') 'set_',ID,'_'//'line_seg_',N,'_eltyp'
477 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IGRSLIN(IGR)%ELTYP(N),0.0_8)
478 WRITE(VARNAME,'(a,i0,a,i0,a)') 'SET_',id,'_'//'LINE_SEG_',n,'_ELEM'
479 IF (igrslin(igr)%ELTYP(n) == 3 ) THEN ! SH4N
480 CALL qaprint(varname(1:len_trim(varname)),ixc(nixc,igrslin(igr)%ELEM(n)),0.0_8)
481 ELSEIF (igrslin(igr)%ELTYP(n) == 7 ) THEN ! SH3N
482 CALL qaprint(varname(1:len_trim(varname)),ixtg(nixtg,igrslin(igr)%ELEM(n)),0.0_8)
483 ELSEIF (igrslin(igr)%ELTYP(n) == 1 ) THEN ! SOLID
484 CALL qaprint(varname(1:len_trim(varname)),ixs(nixs,igrslin(igr)%ELEM(n)),0.0_8)
485 ELSEIF (igrslin(igr)%ELTYP(n) == 2 ) THEN ! QUAD
486 CALL qaprint(varname(1:len_trim(varname)),ixq(nixq,igrslin(igr)%ELEM(n)),0.0_8)
487 ENDIF ! IF (IGRSLIN(IGR)%ELTYP(N) == 3 )
488 ENDDO
489 ENDIF ! IF (NB_LINE_SEG > 0)
490!---
491 ENDDO ! DO KK = 1, NSETS
492 ENDIF ! IF (NSETS > 0)
493 ENDIF ! IF (MYQAKEY('/SET'))
494C-----------------------------------------------------------------------
495 RETURN
496 END
hm_get_int_array_2indexes
subroutine hm_get_int_array_2indexes(name, ival, index1, index2, is_available, lsubmodel)
Definition hm_get_int_array_2indexes.F:57
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
hm_get_string_index
subroutine hm_get_string_index(name, sval, index, size, is_available)
Definition hm_get_string_index.F:53
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
names_and_titles_mod::ncharline
integer, parameter ncharline
Definition names_and_titles_mod.F:1001
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
setdef_mod
Definition setdef_mod.F:107
setdef_mod::nsets
integer nsets
Definition setdef_mod.F:120
submodel_mod
Definition submodel_mod.F:712
st_qaprint_set
subroutine st_qaprint_set(set, lsubmodel, itab, igrnod, igrpart, ipart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring, igrsurf, igrslin, ixc, ixtg, ixq, ixp, ixt, ixr, ixs)
Definition st_qaprint_set.F:44
setdef_mod::set_
Definition setdef_mod.F:123