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