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

Go to the source code of this file.

Functions/Subroutines

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)

Function/Subroutine Documentation

◆ st_qaprint_set()

subroutine st_qaprint_set ( type (set_), dimension(nsets) set,
type (submodel_data), dimension(*), intent(in) lsubmodel,
integer, dimension(*), intent(in) itab,
type (group_), dimension(ngrnod), intent(in) igrnod,
type (group_), dimension(ngrpart), intent(in) igrpart,
integer, dimension(lipart1,*), intent(in) ipart,
type (group_), dimension(ngrbric), intent(in) igrbric,
type (group_), dimension(ngrshel), intent(in) igrsh4n,
type (group_), dimension(ngrsh3n), intent(in) igrsh3n,
type (group_), dimension(ngrquad), intent(in) igrquad,
type (group_), dimension(ngrbeam), intent(in) igrbeam,
type (group_), dimension(ngrtrus), intent(in) igrtruss,
type (group_), dimension(ngrspri), intent(in) igrspring,
type (surf_), dimension(nsurf), intent(in) igrsurf,
type (surf_), dimension(nslin), intent(in) igrslin,
integer, dimension(nixc,*), intent(in) ixc,
integer, dimension(nixtg,*), intent(in) ixtg,
integer, dimension(nixq,*), intent(in) ixq,
integer, dimension(nixp,*), intent(in) ixp,
integer, dimension(nixt,*), intent(in) ixt,
integer, dimension(nixr,*), intent(in) ixr,
integer, dimension(nixs,*), intent(in) ixs )

Definition at line 39 of file st_qaprint_set.F.

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 IF(set(igs)%NB_ELLIPSE == 0 .AND. 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
the
end diagonal values have been computed in the(sparse) matrix id.SOL
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_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
id
initmumps id
Definition multiplerhs_example.m:4
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::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
submodel_mod
Definition submodel_mod.F:717
setdef_mod::set_
Definition setdef_mod.F:123