OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_constraints.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_constraints ../starter/source/output/qaprint/st_qaprint_constraints.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.f
27!||--- calls -----------------------------------------------------
28!|| fretitl2 ../starter/source/starter/freform.F
29!||--- uses -----------------------------------------------------
30!|| r2r_mod ../starter/share/modules1/r2r_mod.F
31!||====================================================================
32 SUBROUTINE st_qaprint_constraints(NOM_OPT ,INOM_OPT ,NPBY ,LPBY ,RBY ,
33 2 IBFTEMP ,FBFTEMP ,IBFFLUX ,FBFFLUX ,ITAB ,
34 3 ICODE ,ISKEW ,IBCSLAG ,IBFVEL ,FBFVEL ,
35 4 NIMPDISP ,NIMPVEL ,NIMPACC ,RWBUF ,NPRW ,
36 5 LPRW ,IBCSCYC ,IRBE3 ,LRBE3 ,FRBE3 ,
37 6 MGRBY ,ISPCOND ,IRBE2 ,LRBE2 ,NPBYL ,
38 7 LPBYL ,RBYL ,IBMPC ,IBMPC2 ,IBMPC3 ,
39 8 IBMPC4 ,RBMPC ,LJOINT ,NNLINK ,LNLINK,
40 9 LLINAL ,LINALE ,GJBUFI ,GJBUFR ,MS ,
41 9 IN ,FXBIPM ,FXBFILE_TAB,GLOB_THERM)
42C============================================================================
43C M o d u l e s
44C-----------------------------------------------
45 USE qa_out_mod
46 USE r2r_mod
47 USE bcs_mod
48 USE names_and_titles_mod , ONLY : nchartitle
49 use glob_therm_mod
50C-----------------------------------------------
51C I m p l i c i t T y p e s
52C-----------------------------------------------
53#include "implicit_f.inc"
54C-----------------------------------------------
55C C o m m o n B l o c k s
56C-----------------------------------------------
57#include "com04_c.inc"
58#include "lagmult.inc"
59#include "param_c.inc"
60#include "scr17_c.inc"
61#include "tabsiz_c.inc"
62#include "sphcom.inc"
63#include "fxbcom.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
68 INTEGER, INTENT(IN) :: ITAB(NUMNOD)
69 TYPE (glob_therm_) ,intent(in) :: glob_therm
70C-----------------------------------------------
71C NOM_OPT(LNOPT1,SNOM_OPT1)
72C * Possibly, NOM_OPT(1) = ID
73C NOM_OPT(LNOPT1-LTITL+1:LTITL) <=> TITLES of the OPTIONS
74C--------------------------------------------------
75C SNOM_OPT1= NRBODY+NACCELM+NVOLU+NINTER+NINTSUB+
76C + NRWALL+NJOINT+NSECT+NLINK+
77C + NUMSKW+1+NUMFRAM+1+NFXBODY+NFLOW+NRBE2+
78C + NRBE3+NSUBMOD+NFXVEL+NUMBCS+NUMMPC+
79C + NGJOINT+NUNIT0+NFUNCT+NADMESH+
80C + NSPHIO+NSPCOND+NRBYKIN+NEBCS+
81C + NINICRACK+NODMAS+NBGAUGE+NCLUSTER+NINTERFRIC+
82C + NRBMERGE
83C-----------------------------------------------
84C INOM_OPT(SINOM_OPT)
85C--------------------------------------------------
86C INOM_OPT(1) = NRBODY
87C INOM_OPT(2) = INOM_OPT(1) + NACCELM
88C INOM_OPT(3) = INOM_OPT(2) + NVOLU
89C INOM_OPT(4) = INOM_OPT(3) + NINTER
90C INOM_OPT(5) = INOM_OPT(4) + NINTSUB
91C INOM_OPT(6) = INOM_OPT(5) + NRWALL
92C INOM_OPT(7) = INOM_OPT(6)
93C INOM_OPT(8) = INOM_OPT(7) + NJOINT
94C INOM_OPT(9) = INOM_OPT(8) + NSECT
95C INOM_OPT(10)= INOM_OPT(9) + NLINK
96C INOM_OPT(11)= INOM_OPT(10)+ NUMSKW+1+NUMFRAM+1+NSUBMOD
97C INOM_OPT(12)= INOM_OPT(11)+ NFXBODY
98C INOM_OPT(13)= INOM_OPT(12)+ NFLOW
99C INOM_OPT(14)= INOM_OPT(13)+ NRBE2
100C INOM_OPT(15)= INOM_OPT(14)+ NRBE3
101C INOM_OPT(16)= INOM_OPT(15)+ NFXVEL
102C INOM_OPT(17)= INOM_OPT(16)+ NUMBCS
103C INOM_OPT(18)= INOM_OPT(17)+ NUMMPC
104C INOM_OPT(19)= INOM_OPT(18)+ NGJOINT
105C INOM_OPT(20)= INOM_OPT(19)+ NUNIT0
106C INOM_OPT(21)= INOM_OPT(20)+ NFUNCT
107C INOM_OPT(22)= INOM_OPT(21)+ NADMESH
108C INOM_OPT(23)= INOM_OPT(22)+ NSPHIO
109C INOM_OPT(24)= INOM_OPT(23)+ NSPCOND
110C INOM_OPT(25)= INOM_OPT(24)+ NEBCS
111C INOM_OPT(26)= INOM_OPT(25)+ NINICRACK
112C INOM_OPT(27)= INOM_OPT(26)+ NODMAS
113C INOM_OPT(28)= INOM_OPT(27)+ NBGAUGE
114C INOM_OPT(29)= INOM_OPT(28)+ NCLUSTER
115C INOM_OPT(30)= INOM_OPT(29)+ NINTERFRIC
116C INOM_OPT(31)= INOM_OPT(30)+ NRBMERGE
117C .. TO BE MAINTAINED (cf doc/inom_opt.txt) ..
118C-----------------------------------------------
119 INTEGER, INTENT(IN) :: NIMPDISP,NIMPVEL,NIMPACC
120 INTEGER, INTENT(IN) :: NPBY(NNPBY,NRBYKIN), NPBYL(NNPBY,NRBYLAG),
121 . LPBY(*), LPBYL(*), IBCSCYC(4,NBCSCYC)
122 INTEGER, INTENT(IN) :: IBFTEMP(GLOB_THERM%NIFT,GLOB_THERM%NFXTEMP)
123 INTEGER, INTENT(IN) :: IBFFLUX(GLOB_THERM%NITFLUX,GLOB_THERM%NFXFLUX)
124 INTEGER, INTENT(IN) :: ICODE(NUMNOD), ISKEW(NUMNOD),IBFVEL(NIFV,NFXVEL)
125 INTEGER, INTENT(IN) :: IBCSLAG(5,NBCSLAG),NPRW(NRWALL,NNPRW),LPRW(SLPRW)
126 INTEGER, INTENT(IN) :: IRBE3(NRBE3L,NRBE3), LRBE3(SLRBE3)
127 INTEGER, INTENT(IN) :: IRBE2(NRBE2L,NRBE2), LRBE2(SLRBE2)
128 INTEGER, INTENT(IN) :: NNLINK(10,SNNLINK), LNLINK(SLNLINK)
129 INTEGER, DIMENSION(NRWALL) :: IDX, IDS
130 INTEGER, DIMENSION(NFXBODY) :: IDXFX, IDSFX
131 INTEGER, INTENT(IN) :: MGRBY(NMGRBY,SMGRBY)
132 INTEGER, INTENT(IN) :: ISPCOND(NISPCOND,*),LJOINT(*),GJBUFI(LKJNI,*)
133 INTEGER, INTENT(IN) :: IBMPC(NUMMPC),IBMPC2(LMPC),IBMPC3(LMPC),IBMPC4(LMPC)
134 my_real, INTENT(IN) ::
135 . RBY(NRBY,NRBYKIN),RBYL(NRBY,NRBYLAG),FRBE3(6,*),GJBUFR(LKJNR,*),MS(*),IN(*)
136 my_real, INTENT(IN) :: FBFTEMP(GLOB_THERM%LFACTHER,GLOB_THERM%NFXTEMP)
137 my_real, INTENT(IN) :: FBFFLUX(GLOB_THERM%LFACTHER,GLOB_THERM%NFXFLUX)
138 my_real, INTENT(IN) :: FBFVEL(LFXVELR,NFXVEL)
139 my_real, INTENT(IN) ::
140 . RWBUF(NRWLP,NRWALL)
141 my_real, INTENT(IN) ::
142 . RBMPC(SRBMPC)
143 INTEGER, INTENT(IN) :: LLINAL
144 INTEGER, DIMENSION(LLINAL), INTENT(IN) :: LINALE
145 INTEGER, INTENT(IN) :: FXBIPM(NBIPM,NFXBODY)
146 CHARACTER, DIMENSION(NFXBODY) :: FXBFILE_TAB*2148
147C--------------------------------------------------
148C L o c a l V a r i a b l e s
149C-----------------------------------------------
150 INTEGER I, II, MY_ID, MY_RBODY, MY_CONSTRAINT, MY_NODE, MY_RWALL, POSI(NRWALL+1),
151 . MY_MERGE, TNSL, K, NS, MY_FXBODY
152 CHARACTER(LEN=NCHARTITLE) :: TITR
153 CHARACTER (LEN=255) :: VARNAME
154 DOUBLE PRECISION TEMP_DOUBLE
155 INTEGER TEMP_INTEGER
156 INTEGER IADS,ITMP
157C-----------------------------------------------
158C Rigid Bodies
159C-----------------------------------------------
160 IF (MYQAKEY('/RBODY')) THEN
161 DO MY_RBODY=1,NRBYKIN
162C
163 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,MY_RBODY),LTITR)
164 MY_ID = NPBY(6,MY_RBODY)
165 IF(LEN_TRIM(TITR)/=0)THEN
166 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
167 ELSE
168 CALL QAPRINT('A_RIGID_BODY_FAKE_NAME',MY_ID,0.0_8)
169 END IF
170C
171 DO I=1,NNPBY
172 IF(NPBY(I,MY_RBODY) /=0)THEN
173C
174C VARNAME: variable name in ref.extract (without blanks)
175 WRITE(VARNAME,'(A,I0)') 'NPBY_',I
176 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NPBY(I,MY_RBODY),0.0_8)
177 END IF
178 END DO
179C
180 DO I=NPBY(11,MY_RBODY)+1,NPBY(11,MY_RBODY)+NPBY(2,MY_RBODY)
181C
182C VARNAME: variable name in ref.extract (without blanks)
183 WRITE(VARNAME,'(A,I0)') 'LPBY_',I
184 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LPBY(I),0.0_8)
185 END DO
186C
187 DO I=1,NRBY
188 IF(RBY(I,MY_RBODY)/=ZERO)THEN
189C
190C VARNAME: variable name in ref.extract (without blanks)
191 WRITE(VARNAME,'(A,I0)') 'RBY_',I
192 TEMP_DOUBLE = RBY(I,MY_RBODY)
193 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
194 END IF
195 END DO
196C
197 END DO ! MY_RBODY=1,NRBYKIN
198C-------
199 TNSL=0
200 DO MY_RBODY=1,NRBYLAG
201C
202 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,NRBYKIN+MY_RBODY),LTITR)
203 MY_ID = NPBYL(6,MY_RBODY)
204 IF(LEN_TRIM(TITR)/=0)THEN
205 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
206 ELSE
207 CALL QAPRINT('A_RIGID_BODY_FAKE_NAME',MY_ID,0.0_8)
208 END IF
209C
210 DO I=1,NNPBY
211 IF(NPBYL(I,MY_RBODY) /=0)THEN
212C
213C VARNAME: variable name in ref.extract (without blanks)
214 WRITE(VARNAME,'(A,I0)') 'NPBYL_',I
215 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NPBYL(I,MY_RBODY),0.0_8)
216 END IF
217 END DO
218C
219 DO I=1,NPBYL(2,MY_RBODY)-1
220C
221C VARNAME: variable name in ref.extract (without blanks)
222 WRITE(VARNAME,'(A,I0)') 'LPBYL_',I
223 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(LPBYL(TNSL+I)),0.0_8)
224 END DO
225C
226 DO I=1,NRBY
227 IF(RBYL(I,MY_RBODY)/=ZERO)THEN
228C
229C VARNAME: variable name in ref.extract (without blanks)
230 WRITE(VARNAME,'(A,I0)') 'RBYL_',I
231 TEMP_DOUBLE = RBYL(I,MY_RBODY)
232 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
233 END IF
234 END DO
235C
236 TNSL=TNSL+3*NPBYL(2,MY_RBODY)
237 END DO ! MY_RBODY=1,NRBODY
238 END IF
239C-----------------------------------------------
240C BCS
241C-----------------------------------------------
242.OR. IF (MYQAKEY('/BCS') MYQAKEY('/ALE/BCS')) THEN
243 DO MY_NODE=1,NUMNOD
244C
245 MY_ID = ITAB(MY_NODE)
246C
247 IF(ICODE(MY_NODE)/=0)THEN
248C VARNAME: variable name in ref.extract (without blanks)
249 WRITE(VARNAME,'(A,I0,I0)') 'ICODE_',MY_ID
250 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ICODE(MY_NODE),0.0_8)
251 END IF
252C
253 IF(ISKEW(MY_NODE)/=0)THEN
254C
255C VARNAME: variable name in ref.extract (without blanks)
256 WRITE(VARNAME,'(A,I0,I0)') 'ISKEW_',MY_ID
257 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ISKEW(MY_NODE),0.0_8)
258 END IF
259C
260 END DO ! MY_NODE=1,NUMNOD
261 END IF
262C-----------------------------------------------
263C /IMPTEMP
264C-----------------------------------------------
265 IF (MYQAKEY('/IMPTEMP')) THEN
266 DO MY_CONSTRAINT=1,GLOB_THERM%NFXTEMP
267C
268C Title of the option was not stored in NOM_OPT ... TBD
269C and Imptemp ID is not stored
270 TITR(1:nchartitle)=''
271 IF(LEN_TRIM(TITR)/=0)THEN
272 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_CONSTRAINT,0.0_8)
273 ELSE
274 CALL QAPRINT('A_IMPTEMP_FAKE_NAME',MY_CONSTRAINT,0.0_8)
275 END IF
276C
277 DO I=1,GLOB_THERM%NIFT
278 IF(IBFTEMP(I,MY_CONSTRAINT) /=0)THEN
279C
280C VARNAME: variable name in ref.extract (without blanks)
281 WRITE(VARNAME,'(A,I0)') 'IBFTEMP_',I ! IBFTEMP(11) => 'IBFTEMP_11'
282 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBFTEMP(I,MY_CONSTRAINT),0.0_8)
283 END IF
284 END DO
285C
286 DO I=1,GLOB_THERM%LFACTHER
287 IF(FBFTEMP(I,MY_CONSTRAINT)/=ZERO)THEN
288C
289C VARNAME: variable name in ref.extract (without blanks)
290 WRITE(VARNAME,'(A,I0)') 'FBFTEMP_',I
291 TEMP_DOUBLE = FBFTEMP(I,MY_CONSTRAINT)
292 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
293 END IF
294 END DO
295C
296 END DO ! MY_CONSTRAINT=1,NFXTEMP
297 END IF
298C-----------------------------------------------
299C /IMPDISP
300C-----------------------------------------------
301 IF (MYQAKEY('/IMPDISP')) THEN
302 DO MY_CONSTRAINT=1,NIMPDISP
303C
304 TITR(1:nchartitle)=''
305 IF(LEN_TRIM(TITR)/=0)THEN
306 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_CONSTRAINT,0.0_8)
307 ELSE
308 CALL QAPRINT('A_IMPACC_FAKE_NAME',MY_CONSTRAINT,0.0_8)
309 END IF
310C
311 DO I=1,NIFV
312 IF (IBFVEL(I,MY_CONSTRAINT) /=0) THEN
313C
314C VARNAME: variable name in ref.extract (without blanks)
315 WRITE(VARNAME,'(A,I0)') 'IBFVEL_',I
316 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBFVEL(I,MY_CONSTRAINT),0.0_8)
317 END IF
318 END DO
319C
320 DO I=1,LFXVELR
321 IF(FBFVEL(I,MY_CONSTRAINT)/=ZERO)THEN
322C
323C VARNAME: variable name in ref.extract (without blanks)
324 WRITE(VARNAME,'(A,I0)') 'FBFVEL_',I
325 TEMP_DOUBLE = FBFVEL(I,MY_CONSTRAINT)
326 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
327 END IF
328 END DO
329C
330 END DO ! MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
331 END IF
332C-----------------------------------------------
333C /IMPVEL
334C-----------------------------------------------
335 IF (MYQAKEY('/IMPVEL')) THEN
336 DO MY_CONSTRAINT=NIMPDISP+1,NIMPDISP+NIMPVEL
337C
338 TITR(1:nchartitle)=''
339 IF(LEN_TRIM(TITR)/=0)THEN
340 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_CONSTRAINT,0.0_8)
341 ELSE
342 CALL QAPRINT('A_IMPACC_FAKE_NAME',MY_CONSTRAINT,0.0_8)
343 END IF
344C
345 DO I=1,NIFV
346 IF (IBFVEL(I,MY_CONSTRAINT) /=0) THEN
347C
348C VARNAME: variable name in ref.extract (without blanks)
349 WRITE(VARNAME,'(A,I0)') 'IBFVEL_',I
350 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBFVEL(I,MY_CONSTRAINT),0.0_8)
351 END IF
352 END DO
353C
354 DO I=1,LFXVELR
355 IF(FBFVEL(I,MY_CONSTRAINT)/=ZERO)THEN
356C
357C VARNAME: variable name in ref.extract (without blanks)
358 WRITE(VARNAME,'(A,I0)') 'FBFVEL_',I
359 TEMP_DOUBLE = FBFVEL(I,MY_CONSTRAINT)
360 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
361 END IF
362 END DO
363C
364 END DO ! MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
365 END IF
366C-----------------------------------------------
367C /IMPACC
368C-----------------------------------------------
369 IF (MYQAKEY('/IMPACC')) THEN
370 DO MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
371C
372C Title of the option was not stored in NOM_OPT ... TBD
373C and Impvel ID is not stored
374 TITR(1:nchartitle)=''
375 IF(LEN_TRIM(TITR)/=0)THEN
376 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_CONSTRAINT,0.0_8)
377 ELSE
378 CALL QAPRINT('A_IMPACC_FAKE_NAME',MY_CONSTRAINT,0.0_8)
379 END IF
380C
381 DO I=1,NIFV
382 IF (IBFVEL(I,MY_CONSTRAINT) /=0) THEN
383C
384C VARNAME: variable name in ref.extract (without blanks)
385 WRITE(VARNAME,'(A,I0)') 'IBFVEL_',I
386 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBFVEL(I,MY_CONSTRAINT),0.0_8)
387 END IF
388 END DO
389C
390 DO I=1,LFXVELR
391 IF(FBFVEL(I,MY_CONSTRAINT)/=ZERO)THEN
392C
393C VARNAME: variable name in ref.extract (without blanks)
394 WRITE(VARNAME,'(A,I0)') 'FBFVEL_',I
395 TEMP_DOUBLE = FBFVEL(I,MY_CONSTRAINT)
396 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
397 END IF
398 END DO
399C
400 END DO ! MY_CONSTRAINT=NFXVEL-NIMPACC+1,NFXVEL
401 END IF
402C-----------------------------------------------
403C /IMPFLUX
404C-----------------------------------------------
405 IF (MYQAKEY('/IMPFLUX')) THEN
406 DO MY_CONSTRAINT=1,GLOB_THERM%NFXFLUX
407C
408C Title of the option was not stored in NOM_OPT ... TBD
409C and Impflux ID is not stored
410 TITR(1:nchartitle)=''
411 IF(LEN_TRIM(TITR)/=0)THEN
412 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_CONSTRAINT,0.0_8)
413 ELSE
414 CALL QAPRINT('A_IMPFLUX_FAKE_NAME',MY_CONSTRAINT,0.0_8)
415 END IF
416C
417 DO I=1,GLOB_THERM%NITFLUX
418 IF(IBFFLUX(I,MY_CONSTRAINT) /=0)THEN
419C
420C VARNAME: variable name in ref.extract (without blanks)
421 WRITE(VARNAME,'(A,I0)') 'IBFFLUX_',I ! IBFFLUX(11) => 'IBFFLUX_11'
422 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBFFLUX(I,MY_CONSTRAINT),0.0_8)
423 END IF
424 END DO
425C
426 DO I=1,GLOB_THERM%LFACTHER
427 IF(FBFFLUX(I,MY_CONSTRAINT)/=ZERO)THEN
428C
429C VARNAME: variable name in ref.extract (without blanks)
430 WRITE(VARNAME,'(A,I0)') 'FBFFLUX_',I
431 TEMP_DOUBLE = FBFFLUX(I,MY_CONSTRAINT)
432 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
433 END IF
434 END DO
435C
436 END DO ! MY_CONSTRAINT=1,NFXFLUX
437 END IF
438C-----------------------------------------------
439C /BCS/LAGMUL
440C-----------------------------------------------
441 IF (MYQAKEY('/BCS/LAGMUL')) THEN
442 DO MY_CONSTRAINT=1,NBCSLAG
443C
444 TITR(1:nchartitle)=''
445 MY_ID = IBCSLAG(5,MY_CONSTRAINT)
446 IF(LEN_TRIM(TITR)/=0)THEN
447 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
448 ELSE
449 CALL QAPRINT('A_BCS_LAGMUL_FAKE_NAME',MY_ID,0.0_8)
450 END IF
451C
452 DO I=1,5
453C
454 IF(IBCSLAG(I,MY_CONSTRAINT)/=0)THEN
455C
456C VARNAME: variable name in ref.extract (without blanks)
457 WRITE(VARNAME,'(A,I0,I0)') 'IBCSLAG_',I ! IBCSLAG(11) => 'IBCSLAG_11'
458 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBCSLAG(I,MY_CONSTRAINT),0.0_8)
459 END IF
460C
461 END DO
462C
463 END DO ! MY_CONSTRAINT=1,NBCSLAG
464 END IF
465C-----------------------------------------------
466C /BCS/CYCLIC
467C-----------------------------------------------
468 IF (MYQAKEY('/BCS/CYCLIC')) THEN
469 DO MY_CONSTRAINT=1,NBCSCYC
470C
471 TITR(1:nchartitle)=''
472 MY_ID = IBCSCYC(4,MY_CONSTRAINT)
473 IF(LEN_TRIM(TITR)/=0)THEN
474 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
475 ELSE
476 CALL QAPRINT('A_BCS_CYCLIC_FAKE_NAME',MY_ID,0.0_8)
477 END IF
478C
479 DO I=1,4
480C
481 IF(IBCSCYC(I,MY_CONSTRAINT)/=0)THEN
482C
483C VARNAME: variable name in ref.extract (without blanks)
484 WRITE(VARNAME,'(A,I0,I0)') 'IBCSCYC_',I
485 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBCSCYC(I,MY_CONSTRAINT),0.0_8)
486 END IF
487C
488 END DO
489C
490 END DO ! MY_CONSTRAINT=1,NBCSCYC
491 END IF
492C-----------------------------------------------
493C /BCS/WALL
494C-----------------------------------------------
495 IF (MYQAKEY('/BCS/WALL')) THEN
496 DO MY_CONSTRAINT=1,BCS%NUM_WALL
497
498 TITR(1:nchartitle)=''
499 MY_ID = BCS%WALL(MY_CONSTRAINT)%user_id
500 IF(LEN_TRIM(TITR)/=0)THEN
501 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
502 ELSE
503 CALL QAPRINT('A_BCS_WALL_FAKE_NAME',MY_ID,0.0_8)
504 END IF
505 !
506 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__IS_DEPENDING_ON_TIME_'
507 TEMP_INTEGER = 0
508 IF(BCS%WALL(MY_CONSTRAINT)%IS_DEPENDING_ON_TIME)TEMP_INTEGER=1
509 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
510 !
511 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__IS_DEPENDING_ON_SENSOR_'
512 TEMP_INTEGER = 0
513 IF(BCS%WALL(MY_CONSTRAINT)%IS_DEPENDING_ON_SENSOR)TEMP_INTEGER=1
514 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
515 !
516 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__GRNOD_ID_'
517 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%GRNOD_ID
518 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
519 !
520 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__SENSOR_ID_'
521 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%SENSOR_ID
522 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
523 !
524 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__TSTART_'
525 TEMP_DOUBLE = BCS%WALL(MY_CONSTRAINT)%TSTART
526 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
527 !
528 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__TSTOP_'
529 TEMP_DOUBLE = BCS%WALL(MY_CONSTRAINT)%TSTOP
530 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
531 !
532 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__LIST__SIZE_'
533 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%SIZE
534 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
535 !
536 ITMP=TEMP_INTEGER
537 IF(ITMP == 1)THEN
538 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__LIST__ELEM_1_'
539 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%ELEM(1)
540 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
541 !
542 WRITE(VARNAME,'(A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__LIST__FACE_1_'
543 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%FACE(1)
544 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
545 ELSEIF(ITMP > 1)THEN
546 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%ELEM(1)
547 WRITE(VARNAME,'(A,I0,A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__LIST__ELEMS_ ',TEMP_INTEGER,' ...'
548 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%ELEM(ITMP)
549 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
550 !
551 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%FACE(1)
552 WRITE(VARNAME,'(A,I0,A,I0,A)') 'BCS_WALL_',MY_CONSTRAINT,'__LIST__FACES_ ',TEMP_INTEGER,' ...'
553 TEMP_INTEGER = BCS%WALL(MY_CONSTRAINT)%LIST%FACE(ITMP)
554 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INTEGER,0.0_8)
555 ENDIF
556
557 END DO ! MY_CONSTRAINT=1,BCS%NUM_WALL
558 END IF
559C-----------------------------------------------
560C /RWALL
561C-----------------------------------------------
562 IF (MYQAKEY('/RWALL')) THEN
563 IF (NRWALL > 0) THEN
564C
565! Sort by ID to ensure internal order independent output
566 POSI(1) = 1
567 DO I = 1, NRWALL
568 IDS(I) = NOM_OPT(LNOPT1*INOM_OPT(5)+1,I)
569 IDX(I) = I
570 POSI(I+1) = POSI(I) + NPRW(I,1)+INT(RWBUF(8,I))
571 ENDDO
572 CALL QUICKSORT_I2(IDS, IDX, 1, NRWALL)
573C
574! Loop over RWALLs
575 DO II = 1,NRWALL
576C
577 MY_RWALL = IDX(II)
578 TITR(1:nchartitle)=''
579 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,MY_RWALL),LTITR)
580 MY_ID = NOM_OPT(1,MY_RWALL + INOM_OPT(5))
581 IF (LEN_TRIM(TITR) /= 0) THEN
582 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
583 ELSE
584 CALL QAPRINT('A_RWALL_FAKE_NAME',MY_ID,0.0_8)
585 END IF
586C
587 DO I = 1,NNPRW
588 IF (NPRW(MY_RWALL,I) /= 0) THEN
589C
590C VARNAME: variable name in ref.extract (without blanks)
591 WRITE(VARNAME,'(A,I0)') 'NPRW_',I
592 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NPRW(MY_RWALL,I),0.0_8)
593 END IF
594 END DO
595C
596 DO I = 1,NRWLP
597 IF (RWBUF(I,MY_RWALL) /= ZERO) THEN
598C
599C VARNAME: variable name in ref.extract (without blanks)
600 WRITE(VARNAME,'(A,I0)') 'RWBUF_',I
601 TEMP_DOUBLE = RWBUF(I,MY_RWALL)
602 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
603 END IF
604 END DO
605C
606 DO I = POSI(MY_RWALL),POSI(MY_RWALL+1)-1
607 IF (LPRW(I) /= 0) THEN
608C
609C VARNAME: variable name in ref.extract (without blanks)
610 WRITE(VARNAME,'(A,I0)') 'LPRW_',I-POSI(MY_RWALL)+1
611 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LPRW(I),0.0_8)
612 END IF
613 END DO
614C
615 END DO
616C
617 ENDIF
618 ENDIF
619C-----------------------------------------------
620C RBE3
621C-----------------------------------------------
622 IF (MYQAKEY('/RBE3')) THEN
623 IADS = SLRBE3/2
624 DO MY_CONSTRAINT=1,NRBE3
625C
626 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,MY_CONSTRAINT + INOM_OPT(14)),LTITR)
627 MY_ID = IRBE3(2,MY_CONSTRAINT)
628 IF(LEN_TRIM(TITR)/=0)THEN
629 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
630 ELSE
631 CALL QAPRINT('A_RBE3_FAKE_NAME',MY_ID,0.0_8)
632 END IF
633C
634 DO I=1,NRBE3L
635 IF(IRBE3(I,MY_CONSTRAINT) /=0)THEN
636C
637C VARNAME: variable name in ref.extract (without blanks)
638 WRITE(VARNAME,'(A,I0)') 'IRBE3_',I
639 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IRBE3(I,MY_CONSTRAINT),0.0_8)
640 END IF
641 END DO
642C
643 DO I=IRBE3(1,MY_CONSTRAINT)+1,IRBE3(1,MY_CONSTRAINT)+IRBE3(5,MY_CONSTRAINT)
644C
645C VARNAME: variable name in ref.extract (without blanks)
646 WRITE(VARNAME,'(A,I0)') 'LRBE3_',I
647 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LRBE3(I),0.0_8)
648 END DO
649C
650 DO I=IRBE3(1,MY_CONSTRAINT)+1,IRBE3(1,MY_CONSTRAINT)+IRBE3(5,MY_CONSTRAINT)
651C
652C VARNAME: variable name in ref.extract (without blanks)
653 WRITE(VARNAME,'(A,I0)') 'LRBE3s_',I
654 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LRBE3(I+IADS),0.0_8)
655 END DO
656C
657 DO I=IRBE3(1,MY_CONSTRAINT)+1,IRBE3(1,MY_CONSTRAINT)+IRBE3(5,MY_CONSTRAINT)
658C
659 DO II = 1,6
660.AND. IF(FRBE3(II,I) /=ONEFRBE3(II,I) /=ZERO)THEN
661 WRITE(VARNAME,'(A,I1,A,I0)') 'FRBE3_',II,'_',I
662 TEMP_DOUBLE = FRBE3(II,I)
663 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
664 END IF
665 END DO !II = 1,6
666 END DO
667C
668 END DO ! MY_CONSTRAINT=1,NRBE3
669 END IF
670C-----------------------------------------------
671C Merge Rigid Bodies
672C-----------------------------------------------
673 IF (MYQAKEY('/MERGE')) THEN
674 II = 1
675 DO MY_CONSTRAINT=1,NRBMERGE
676C
677 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,INOM_OPT(30)+MY_CONSTRAINT),LTITR)
678 MY_ID = MGRBY(6,II)
679 IF(LEN_TRIM(TITR)/=0)THEN
680 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
681 ELSE
682 CALL QAPRINT('A_MERGE_FAKE_NAME',MY_ID,0.0_8)
683 END IF
684C
685 DO MY_MERGE=II,SMGRBY
686 IF(MGRBY(6,MY_MERGE) /= MY_ID) THEN
687 II = MY_MERGE
688 EXIT
689 ENDIF
690 DO I=1,NMGRBY
691 IF(MGRBY(I,MY_MERGE) /=0)THEN
692C VARNAME: variable name in ref.extract (without blanks)
693 WRITE(VARNAME,'(A,I0)') 'MGRBY_',I
694 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),MGRBY(I,MY_MERGE),0.0_8)
695 END IF
696 END DO
697 END DO ! MY_MERGE=II,SMGRBY
698
699 END DO ! MY_CONSTRAINT=1,NRBMERGE
700 END IF
701C-----------------------------------------------
702C /SPHBCS
703C-----------------------------------------------
704 IF (MYQAKEY('/SPHBCS')) THEN
705 DO MY_CONSTRAINT=1,NSPCOND
706CC
707 TITR(1:nchartitle)=''
708 MY_ID = ISPCOND(4,MY_CONSTRAINT)
709 IF(LEN_TRIM(TITR)/=0)THEN
710 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
711 ELSE
712 CALL QAPRINT('A_SPHBCS_FAKE_NAME',MY_ID,0.0_8)
713 END IF
714C
715 DO I=1,NISPCOND
716 IF(ISPCOND(I,MY_CONSTRAINT)/=0)THEN
717C VARNAME: variable name in ref.extract (without blanks)
718 WRITE(VARNAME,'(A,I0,I0)') 'ISPCOND_',I
719 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ISPCOND(I,MY_CONSTRAINT),0.0_8)
720 END IF
721C
722 END DO
723C
724 END DO ! MY_CONSTRAINT=1,NSPCOND
725 END IF
726C-----------------------------------------------
727C /RBE2
728C-----------------------------------------------
729 IF (MYQAKEY('/RBE2')) THEN
730 DO MY_CONSTRAINT=1,NRBE2
731C
732 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,MY_CONSTRAINT + INOM_OPT(13)),LTITR)
733 MY_ID = IRBE2(2,MY_CONSTRAINT)
734 IF(LEN_TRIM(TITR)/=0)THEN
735 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
736 ELSE
737 CALL QAPRINT('A_RBE2_FAKE_NAME',MY_ID,0.0_8)
738 END IF
739C
740 DO I=1,NRBE2L
741 IF(IRBE2(I,MY_CONSTRAINT) /=0)THEN
742C
743C VARNAME: variable name in ref.extract (without blanks)
744 WRITE(VARNAME,'(A,I0)') 'IRBE2_',I
745 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IRBE2(I,MY_CONSTRAINT),0.0_8)
746 END IF
747 END DO
748C
749 DO I=IRBE2(1,MY_CONSTRAINT)+1,IRBE2(1,MY_CONSTRAINT)+IRBE2(5,MY_CONSTRAINT)
750C
751C VARNAME: variable name in ref.extract (without blanks)
752 WRITE(VARNAME,'(A,I0)') 'LRBE2_',I
753 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LRBE2(I),0.0_8)
754 END DO
755C
756 END DO ! MY_CONSTRAINT=1,NRBE2
757 END IF
758C-----------------------------------------------
759C /MPC
760C-----------------------------------------------
761 IF (MYQAKEY('/MPC')) THEN
762 II=0
763 DO MY_CONSTRAINT=1,NUMMPC
764C
765 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,INOM_OPT(17) + MY_CONSTRAINT),LTITR)
766
767 MY_ID = NOM_OPT(1,INOM_OPT(17)+MY_CONSTRAINT)
768 IF(LEN_TRIM(TITR)/=0)THEN
769 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
770 ELSE
771 CALL QAPRINT('A_MPC_FAKE_NAME',MY_ID,0.0_8)
772 END IF
773C
774 DO I=1,IBMPC(MY_CONSTRAINT)
775
776 IF(IBMPC2(II+I) /=0)THEN
777C VARNAME: variable name in ref.extract (without blanks)
778 WRITE(VARNAME,'(A,I0)') 'NOD_',I
779 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBMPC2(II+I),0.0_8)
780 END IF
781
782 IF(IBMPC3(II+I) /=0)THEN
783C VARNAME: variable name in ref.extract (without blanks)
784 WRITE(VARNAME,'(A,I0)') 'IDOF_',I
785 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBMPC3(II+I),0.0_8)
786 END IF
787
788 IF(IBMPC4(II+I) /=0)THEN
789C VARNAME: variable name in ref.extract (without blanks)
790 WRITE(VARNAME,'(A,I0)') 'ISKEW_',I
791 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IBMPC4(II+I),0.0_8)
792 END IF
793
794 IF(RBMPC(II+I) /=0)THEN
795 WRITE(VARNAME,'(A,I1,A,I0)') 'ALPHA_',I
796 TEMP_DOUBLE = RBMPC(II+I)
797 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
798 END IF
799
800 END DO
801 II = II + IBMPC(MY_CONSTRAINT)
802C
803 END DO ! MY_CONSTRAINT=1,NUMMPC
804 END IF
805C-----------------------------------------------
806C /CYL_JOINT
807C-----------------------------------------------
808 IF (MYQAKEY('/CYL_JOINT')) THEN
809C
810 II = 1
811C
812 DO MY_CONSTRAINT=1,NJOINT
813C
814 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,INOM_OPT(7)+MY_CONSTRAINT),LTITR)
815 MY_ID = NOM_OPT(1,INOM_OPT(7)+MY_CONSTRAINT)
816 IF(LEN_TRIM(TITR)/=0)THEN
817 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
818 ELSE
819 CALL QAPRINT('A_CYLJOINT_FAKE_NAME',MY_ID,0.0_8)
820 END IF
821C
822 NS = LJOINT(II)
823C
824 DO I=1,NS
825 WRITE(VARNAME,'(A,I0)') 'NOD_',I
826 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),ITAB(LJOINT(II+I)),0.0_8)
827 ENDDO
828C
829 II=II+NS+1
830C
831 END DO
832 END IF
833C-----------------------------------------------
834C /GJOINT
835C-----------------------------------------------
836 IF (MYQAKEY('/GJOINT')) THEN
837C
838 DO MY_CONSTRAINT=1,NGJOINT
839C
840 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,INOM_OPT(18) + MY_CONSTRAINT),LTITR)
841 MY_ID = NOM_OPT(1,INOM_OPT(18)+MY_CONSTRAINT)
842 IF(LEN_TRIM(TITR)/=0)THEN
843 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
844 ELSE
845 CALL QAPRINT('A_GJOINT_FAKE_NAME',MY_ID,0.0_8)
846 END IF
847C
848 DO I=1,LKJNI
849 WRITE(VARNAME,'(A,I0)') 'GJBUFI_',I
850 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),GJBUFI(I,MY_CONSTRAINT),0.0_8)
851 ENDDO
852C
853 DO I=1,LKJNR
854 WRITE(VARNAME,'(A,I0)') 'GJBUFR_',I
855 TEMP_DOUBLE = GJBUFR(I,MY_CONSTRAINT)
856 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
857 ENDDO
858C
859 DO I=1,4
860 WRITE(VARNAME,'(A,I0)') 'MASS_',I
861 IF (GJBUFI(2+I,MY_CONSTRAINT) > 0) THEN
862 TEMP_DOUBLE = MS(GJBUFI(2+I,MY_CONSTRAINT))
863 ELSE
864 TEMP_DOUBLE = ZERO
865 ENDIF
866 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
867 ENDDO
868C
869 DO I=1,4
870 WRITE(VARNAME,'(A,I0)') 'INER_',I
871 IF (GJBUFI(2+I,MY_CONSTRAINT) > 0) THEN
872 TEMP_DOUBLE = IN(GJBUFI(2+I,MY_CONSTRAINT))
873 ELSE
874 TEMP_DOUBLE = ZERO
875 ENDIF
876 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
877 ENDDO
878C
879 END DO
880 END IF
881C-----------------------------------------------
882C RLINK
883C-----------------------------------------------
884 IF (MYQAKEY('/RLINK')) THEN
885C
886 IF (NLINK > 0) THEN
887C
888C
889 DO MY_CONSTRAINT = 1, NLINK
890c
891 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,INOM_OPT(9)+MY_CONSTRAINT),LTITR)
892 MY_ID = NOM_OPT(1,INOM_OPT(9)+MY_CONSTRAINT)
893 IF(LEN_TRIM(TITR)/=0)THEN
894 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
895 ELSE
896 CALL QAPRINT('A_RLINK_NAME',MY_ID,0.0_8)
897 END IF
898c
899 DO I = 1,10
900 IF(NNLINK(I,MY_CONSTRAINT) /=0)THEN
901 WRITE(VARNAME,'(A,I0)') 'NNLINK_',I
902 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NNLINK(I,MY_CONSTRAINT),0.0_8)
903 END IF
904 ENDDO
905c
906 ENDDO
907 DO I = 1,SLNLINK
908 IF(LNLINK(I) /=0)THEN
909 WRITE(VARNAME,'(A,I0)') 'LNLINK_',I
910 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LNLINK(I),0.0_8)
911 END IF
912 ENDDO
913
914
915 ENDIF
916 END IF
917C-----------------------------------------------
918C /ALE/LINK
919C-----------------------------------------------
920 IF (MYQAKEY('/ALE/LINK')) THEN
921 DO II = 1, LLINAL
922 WRITE(VARNAME,'(A,I0)') 'LINALE_', II
923 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),LINALE(II),0.0_8)
924 ENDDO
925 ENDIF
926C-----------------------------------------------
927C /FXBODY
928C-----------------------------------------------
929 IF (MYQAKEY('/FXBODY')) THEN
930 IF (NFXBODY > 0) THEN
931C
932! Sort by ID to ensure internal order independent output
933 DO I = 1, NFXBODY
934 IDSFX(I) = FXBIPM(1,I)
935 IDXFX(I) = I
936 ENDDO
937 CALL QUICKSORT_I2(IDSFX, IDXFX, 1, NFXBODY)
938C
939! Loop over FXBODY
940 DO II = 1,NFXBODY
941C
942 MY_FXBODY = IDXFX(II)
943 TITR(1:nchartitle)=''
944 CALL FRETITL2(TITR,NOM_OPT(LNOPT1-LTITR+1,INOM_OPT(11)+MY_FXBODY),LTITR)
945 MY_ID = NOM_OPT(1,INOM_OPT(11)+MY_FXBODY)
946 IF (LEN_TRIM(TITR) /= 0) THEN
947 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
948 ELSE
949 CALL QAPRINT('A_FXBODY_FAKE_NAME',MY_ID,0.0_8)
950 END IF
951C
952 DO I = 1,NBIPM
953 IF (FXBIPM(I,MY_FXBODY) /= 0) THEN
954 WRITE(VARNAME,'(A,I0)') 'FXBIPM_',I
955 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),FXBIPM(I,MY_FXBODY),0.0_8)
956 ENDIF
957 ENDDO
958C
959 CALL QAPRINT('FXBODY_FILE_NAME',0,0.0_8)
960 CALL QAPRINT(FXBFILE_TAB(MY_FXBODY)(1:LEN_TRIM(FXBFILE_TAB(MY_FXBODY))),0,0.0_8)
961C
962 ENDDO
963 ENDIF
964 ENDIF
965C-----------------------------------------------
966 RETURN
967 END
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
qa_out_mod
Definition qa_out_mod.F:78
r2r_mod
Definition r2r_mod.F:125
st_qaprint_constraints
subroutine st_qaprint_constraints(nom_opt, inom_opt, npby, lpby, rby, ibftemp, fbftemp, ibfflux, fbfflux, itab, icode, iskew, ibcslag, ibfvel, fbfvel, nimpdisp, nimpvel, nimpacc, rwbuf, nprw, lprw, ibcscyc, irbe3, lrbe3, frbe3, mgrby, ispcond, irbe2, lrbe2, npbyl, lpbyl, rbyl, ibmpc, ibmpc2, ibmpc3, ibmpc4, rbmpc, ljoint, nnlink, lnlink, llinal, linale, gjbufi, gjbufr, ms, in, fxbipm, fxbfile_tab, glob_therm)
Definition st_qaprint_constraints.F:42
st_qaprint_driver
subroutine st_qaprint_driver(igeo, geo, bufgeo, ipm, pm, bufmat, nom_opt, inom_opt, numloadp, iloadp, lloadp, loadp, ibcl, forc, ipres, pres, npby, lpby, rby, ibcr, fradia, ibcv, fconv, ibftemp, fbftemp, igrv, lgrv, agrv, ibfflux, fbfflux, itab, v, vr, w, icode, iskew, icfield, lcfield, cfield, dampr, temp, ibcslag, ipari, intbuf_tab, clusters, ibox, ipmas, ibfvel, fbfvel, nimpacc, laccelm, accelm, nom_sect, nstrf, secbuf, skew, iskwn, xframe, t_monvol, t_monvol_metadata, i2rupt, areasl, intbuf_fric_tab, npfricorth, mat_elem, pfricorth, irepforth, phiforth, vforth, xrefc, xreftg, xrefs, tagxref, ixs, ixc, ixtg, rwbuf, nprw, lprw, ithvar, ipart, subsets, ipartth, nthgrpmx, nimpdisp, nimpvel, detonators, ibcscyc, npc, pld, table, npts, irbe3, lrbe3, frbe3, mgrby, ixs10, isolnod, ixr, r_skew, ixp, ixt, x, thke, sh4ang, thkec, sh3ang, set, lsubmodel, igrnod, igrpart, igrbric, igrsh4n, igrsh3n, igrquad, igrbeam, igrtruss, igrspring, igrsurf, igrslin, ixq, ispcond, rtrans, irand, alea, xseed, xlas, las, irbe2, lrbe2, kxsp, ipartsp, drape, ixr_kj, iactiv, factiv, unitab, npbyl, lpbyl, rbyl, xyzref, sensors, func2d, inicrack, ipreload, preload, iflag_bpreload, ibmpc, ibmpc2, ibmpc3, ibmpc4, rbmpc, ljoint, nnlink, lnlink, bufsf, sbufsf_, pm_stack, geo_stack, igeo_stack, iparg, ipadmesh, padmesh, liflow, lrflow, iflow, rflow, sh4tree, sh3tree, sh4trim, sh3trim, qp_iperturb, qp_rperturb, llinal, linale, fvm_inivel, gjbufi, gjbufr, ms, in, lgauge, gauge, kxx, ixx, ipartx, ixri, ixs16, iexmad, fxbipm, fxbfile_tab, eigipm, eigrpm, isphio, vsphio, ebcs_tab, inimap1d, inimap2d, nsigsh, sigsh, nsigi, sigsp, nsigs, sigi, nsigbeam, sigbeam, nsigtruss, sigtruss, nsigrs, sigrs, merge_node_tab, merge_node_tol, imerge, nmerge_tot, iexlnk, drapeg, user_windows, output, defaults, glob_therm, pblast, ibeam_vector, rbeam_vector, damp_range_part)
Definition st_qaprint_driver.F:120
starter
program starter
Definition starter.F:39