OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_general_controls.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_general_controls ../starter/source/output/qaprint/st_qaprint_general_controls.F
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!|| defaults_mod ../starter/source/modules/defaults_mod.F90
30!||====================================================================
31 SUBROUTINE st_qaprint_general_controls(NOM_OPT ,INOM_OPT ,DAMPR , IRAND, ALEA,
32 1 XSEED ,UNITAB ,QP_IPERTURB,QP_RPERTURB,
33 2 EIGIPM , EIGRPM ,DEFAULTS,DAMP_RANGE_PART)
34C============================================================================
35C M o d u l e s
36C-----------------------------------------------
37 USE qa_out_mod
38 USE unitab_mod
39 USE ale_mod
40 USE defaults_mod
41 USE names_and_titles_mod , ONLY : nchartitle
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46C-----------------------------------------------
47C C o m m o n B l o c k s
48C-----------------------------------------------
49#include "com01_c.inc"
50#include "com04_c.inc"
51#include "param_c.inc"
52#include "scr03_c.inc"
53#include "scr05_c.inc"
54#include "scr06_c.inc"
55#include "scr12_c.inc"
56#include "scr14_c.inc"
57#include "scr16_c.inc"
58#include "scr17_c.inc"
59#include "tabsiz_c.inc"
60#include "random_c.inc"
61#include "sphcom.inc"
62#include "sms_c.inc"
63#include "eigcom.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 . IRAND(*),QP_IPERTURB(NPERTURB,6),EIGIPM(NEIPM,*)
69 my_real, INTENT(IN) :: dampr(nrdamp,*),alea(*),xseed(*),eigrpm(nerpm,*)
70 my_real, INTENT(IN) :: qp_rperturb(nperturb,4)
71 INTEGER, INTENT(IN) :: DAMP_RANGE_PART(NPART) !< flag to compute the damping range
72 TYPE (UNIT_TYPE_) ::UNITAB
73 TYPE(defaults_) , INTENT(IN) :: DEFAULTS
74C--------------------------------------------------
75C L o c a l V a r i a b l e s
76C-----------------------------------------------
77 INTEGER I,II,MY_ID, MY_DAMP,TEMP_INT,
78 . MY_RAND, MY_UNIT, MY_DEFAULTINTER,
79 . ids(nperturb),idx(nperturb),idseig(neig),idxeig(neig),my_eig
80 CHARACTER(LEN=NCHARTITLE) :: TITR
81 INTEGER IHBE_DS,ISST_DS,IFRAME_DS,ITET4_D,ITET10_D,ICPRE_D,IMAS_DS,
82 . ihbe_d,ipla_d,ithk_d,ishea_d,isst_d,
83 . ish3n_d, istra_d,npts_d,idril_d,def_inter(100)
84 CHARACTER (LEN=255) :: VARNAME
85 DOUBLE PRECISION TEMP_DOUBLE
86 LOGICAL :: OK_QA
87C-----------------------------------------------
88!--- defaults values
89C-----------------------------------------------
90 ihbe_ds= defaults%SOLID%ISOLID
91 isst_ds= defaults%SOLID%ISMSTR
92 icpre_d= defaults%SOLID%ICPRE
93 itet4_d= defaults%SOLID%ITETRA4
94 itet10_d= defaults%SOLID%ITETRA10
95 imas_ds= defaults%SOLID%IMAS
96 iframe_ds= defaults%SOLID%IFRAME
97 istra_d = 1
98 ihbe_d = defaults%SHELL%ishell
99 ish3n_d= defaults%SHELL%ish3n
100 isst_d = defaults%SHELL%ismstr
101 ipla_d = defaults%SHELL%iplas
102 ithk_d = defaults%SHELL%ithick
103 idril_d= defaults%SHELL%idrill
104 ishea_d = 0
105 npts_d = 0
106!
107C-----------------------------------------------
108C /DAMP
109C-----------------------------------------------
110 IF (myqakey('/DAMP')) THEN
111 DO my_damp=1,ndamp
112C
113 titr(1:nchartitle)=''
114 my_id = nint(dampr(1,my_damp))
115 IF(len_trim(titr)/=0)THEN
116 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
117 ELSE
118 CALL qaprint('A_DAMP_FAKE_NAME', my_id,0.0_8)
119 END IF
120C
121 DO i=1,nrdamp
122 IF(dampr(i,my_damp)/=zero)THEN
123C
124C VARNAME: variable name in ref.extract (without blanks)
125 WRITE(varname,'(A,I0)') 'DAMPR_',i
126 temp_double = dampr(i,my_damp)
127 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
128 END IF
129 END DO
130C
131 END DO ! MY_DAMP=1,NDAMP
132 END IF
133C-----------------------------------------------
134C /DAMP/INTER
135C-----------------------------------------------
136 IF (myqakey('/DAMP/INTER')) THEN
137 DO my_damp=1,ndamp
138C
139 titr(1:nchartitle)=''
140 my_id = nint(dampr(1,my_damp))
141 IF(len_trim(titr)/=0)THEN
142 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
143 ELSE
144 CALL qaprint('A_DAMP_INTER_FAKE_NAME', my_id,0.0_8)
145 END IF
146C
147 DO i=1,nrdamp
148 IF(dampr(i,my_damp)/=zero)THEN
149C
150C VARNAME: variable name in ref.extract (without blanks)
151 WRITE(varname,'(A,I0)') 'DAMPR_',i
152 temp_double = dampr(i,my_damp)
153 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
154 END IF
155 END DO
156C
157 IF(idamp_rdof/=zero)THEN
158 WRITE(varname,'(A)') 'IDAMP_RDOF_'
159 temp_double = idamp_rdof
160 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
161 ENDIF
162C
163 END DO ! MY_DAMP=1,NDAMP
164 END IF
165C-----------------------------------------------
166C /DAMP/FREQ_RANGE
167C-----------------------------------------------
168 IF (myqakey('/DAMP/FREQ_RANGE')) THEN
169 DO my_damp=1,ndamp
170C
171 IF (nint(dampr(31,my_damp))==1) THEN
172 titr(1:nchartitle)=''
173 my_id = nint(dampr(1,my_damp))
174 IF(len_trim(titr)/=0)THEN
175 CALL qaprint(titr(1:len_trim(titr)),my_id,0.0_8)
176 ELSE
177 CALL qaprint('A_DAMP_INTER_FAKE_NAME', my_id,0.0_8)
178 END IF
179C
180 DO i=1,nrdamp
181 IF(dampr(i,my_damp)/=zero)THEN
182C
183C VARNAME: variable name in ref.extract (without blanks)
184 WRITE(varname,'(A,I0)') 'DAMPR_',i
185 temp_double = dampr(i,my_damp)
186 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
187 END IF
188 END DO
189C
190 DO i=1,npart
191 IF (damp_range_part(i) == my_damp) THEN
192 WRITE(varname,'(A)') 'PART_'
193 temp_int = i
194 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
195 ENDIF
196 ENDDO
197C
198 ENDIF
199C
200 END DO ! MY_DAMP=1,NDAMP
201 END IF
202C-----------------------------------------------
203C /ANALY
204C-----------------------------------------------
205 IF (myqakey('/ANALY')) THEN
206C
207 CALL qaprint('ANALY', 0,0.0_8)
208C
209 WRITE(varname,'(A)') 'NANALY'
210 temp_int = nanaly
211 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
212C
213 WRITE(varname,'(A)') 'IPARI0'
214 temp_int = ipari0
215 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
216C
217 END IF
218C-----------------------------------------------
219C /DEF_SOLID
220C-----------------------------------------------
221 IF (myqakey('/DEF_SOLID')) THEN
222C
223 CALL qaprint('DEF_SOLID', 0,0.0_8)
224C
225 WRITE(varname,'(A)') 'Isolid'
226 temp_int = ihbe_ds
227 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
228C
229 WRITE(varname,'(A)') 'Ismstr'
230 temp_int = isst_ds
231 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
232C
233 WRITE(varname,'(A)') 'Icpre'
234 temp_int = icpre_d
235 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
236C
237 WRITE(varname,'(A)') 'Istrain'
238 temp_int = istra_d
239 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
240C
241 WRITE(varname,'(A)') 'Itetra4'
242 temp_int = itet4_d
243 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
244C
245 WRITE(varname,'(A)') 'Itetra10'
246 temp_int = itet10_d
247 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
248C
249 WRITE(varname,'(A)') 'Imas'
250 temp_int = imas_ds
251 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
252C
253 WRITE(varname,'(A)') 'Iframe'
254 temp_int = iframe_ds
255 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
256 END IF
257C-----------------------------------------------
258C /DEF_SHELL
259C-----------------------------------------------
260 IF (myqakey('/DEF_SHELL')) THEN
261C
262 CALL qaprint('DEF_SHELL', 0,0.0_8)
263C
264 WRITE(varname,'(A)') 'Ishell'
265 temp_int = ihbe_d
266 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
267C
268 WRITE(varname,'(A)') 'Ismstr'
269 temp_int = isst_d
270 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
271C
272 WRITE(varname,'(A)') 'Ithick'
273 temp_int = ithk_d
274 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
275C
276 WRITE(varname,'(A)') 'Iplas'
277 temp_int = ipla_d
278 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
279C
280 WRITE(varname,'(A)') 'Istrain'
281 temp_int = istra_d
282 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
283C
284 WRITE(varname,'(A)') 'Ish3n'
285 temp_int = ish3n_d
286 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
287C
288 WRITE(varname,'(A)') 'Idrill'
289 temp_int = idril_d
290 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
291 END IF
292C-----------------------------------------------
293C /RANDOM
294C-----------------------------------------------
295 IF (myqakey('/RANDOM')) THEN
296C
297 CALL qaprint('RANDOM',0,0.0_8)
298
299 DO my_rand=1,nrand
300C
301 WRITE(varname,'(A,I0)') 'IRAND_',my_rand
302 temp_int = irand(my_rand)
303 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
304C
305 IF(alea(my_rand)/=zero)THEN
306C VARNAME: variable name in ref.extract (without blanks)
307 WRITE(varname,'(A,I0)') 'ALEA_',my_rand
308 temp_double = alea(my_rand)
309 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
310 END IF
311C
312 IF(xseed(my_rand)/=zero)THEN
313C VARNAME: variable name in ref.extract (without blanks)
314 WRITE(varname,'(A,I0)') 'XSEED_',my_rand
315 temp_double = xseed(my_rand)
316 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
317 END IF
318C
319 END DO ! MY_RAND=1,NRAND
320C
321 END IF
322C-----------------------------------------------
323C /IMPLICIT
324C-----------------------------------------------
325 IF (myqakey('/IMPLICIT')) THEN
326C
327 CALL qaprint('IMPLICIT',0,0.0_8)
328
329 WRITE(varname,'(A,I0)') 'IIMPLICIT'
330 temp_int = iimplicit
331 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
332C
333 WRITE(varname,'(A,I0)') 'IPLA_D'
334 temp_int = ipla_d
335 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
336C
337 WRITE(varname,'(A,I0)') 'IHBE_DS'
338 temp_int = ihbe_ds
339 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
340C
341 WRITE(varname,'(A,I0)') 'IHBE_D'
342 temp_int = ihbe_d
343 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
344C
345 WRITE(varname,'(A,I0)') 'IDRIL_D'
346 temp_int = idril_d
347 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
348C
349 END IF
350C-----------------------------------------------
351C /SPMD
352C-----------------------------------------------
353 IF (myqakey('/SPMD')) THEN
354C
355 CALL qaprint('SPMD',0,0.0_8)
356
357 WRITE(varname,'(A,I0)') 'DECTYP'
358 temp_int = dectyp
359 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
360C
361 WRITE(varname,'(a,i0)') 'nspmd'
362 TEMP_INT = NSPMD
363 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
364C
365 WRITE(VARNAME,'(a,i0)') 'decani'
366 TEMP_INT = DECANI
367 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
368C
369 WRITE(VARNAME,'(a,i0)') 'decmot'
370 TEMP_INT = DECMOT
371 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
372C
373 WRITE(VARNAME,'(a,i0)') 'decneq'
374 TEMP_INT = DECNEQ
375 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
376C
377 WRITE(VARNAME,'(a,i0)') 'nthread'
378 TEMP_INT = NTHREAD
379 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
380C
381 END IF
382C-----------------------------------------------
383C /SPHGLO
384C-----------------------------------------------
385 IF (MYQAKEY('/sphglo')) THEN
386C
387 CALL QAPRINT('sphglo',0,0.0_8)
388
389 IF(SPASORT/=ZERO)THEN
390C VARNAME: variable name in ref.extract (without blanks)
391 WRITE(VARNAME,'(a,i0)') 'spasort'
392 TEMP_DOUBLE = SPASORT
393 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
394 END IF
395C
396 WRITE(VARNAME,'(a,i0)') 'lvoisph'
397 TEMP_INT = LVOISPH
398 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
399C
400 WRITE(VARNAME,'(a,i0)') 'kvoisph'
401 TEMP_INT = KVOISPH
402 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
403C
404 WRITE(VARNAME,'(a,i0)') 'itsol2sph'
405 TEMP_INT = ITSOL2SPH
406 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
407C
408 END IF
409C-----------------------------------------------
410C /CAA
411C-----------------------------------------------
412 IF (MYQAKEY('/caa')) THEN
413C
414 CALL QAPRINT('caa',0,0.0_8)
415
416 WRITE(VARNAME,'(a,i0)') 'icaa'
417 TEMP_INT = ALE%GLOBAL%ICAA
418 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
419C
420 END IF
421C-----------------------------------------------
422C /IOFLAG
423C-----------------------------------------------
424 IF (MYQAKEY('/ioflag')) THEN
425C
426 CALL QAPRINT('ioflag',0,0.0_8)
427C
428 WRITE(VARNAME,'(a,i0)') 'ipri'
429 TEMP_INT = IPRI
430 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
431C
432 WRITE(VARNAME,'(a,i0)') 'ioutput'
433 TEMP_INT = IOUTPUT
434 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
435C
436 WRITE(VARNAME,'(a,i0)') 'outyy_fmt'
437 TEMP_INT = OUTYY_FMT
438 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
439C
440 WRITE(VARNAME,'(a,i0)') 'irootyy'
441 TEMP_INT = IROOTYY
442 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
443C
444 WRITE(VARNAME,'(a,i0)') 'idrot'
445 TEMP_INT = IDROT
446 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
447C
448 WRITE(VARNAME,'(a,i0)') 'irform'
449 TEMP_INT = IRFORM
450 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
451C
452 END IF
453C-----------------------------------------------
454C /AMS
455C-----------------------------------------------
456 IF (MYQAKEY('/ams')) THEN
457C
458 CALL QAPRINT('ams',0,0.0_8)
459C
460 WRITE(VARNAME,'(a,i0)') 'isms'
461 TEMP_INT = ISMS
462 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
463C
464 WRITE(VARNAME,'(a,i0)') 'idtgrs'
465 TEMP_INT = IDTGRS
466 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
467C
468 WRITE(VARNAME,'(a,i0)') 'isms_selec'
469 TEMP_INT = ISMS_SELEC
470 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
471C
472 WRITE(VARNAME,'(a,i0)') 'irest_mselt'
473 TEMP_INT = IREST_MSELT
474 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
475C
476 IF(DT_SMS_SWITCH/=ZERO)THEN
477C VARNAME: variable name in ref.extract (without blanks)
478 WRITE(VARNAME,'(a,i0)') 'dt_sms_switch'
479 TEMP_DOUBLE = DT_SMS_SWITCH
480 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
481 END IF
482C
483 END IF
484C-----------------------------------------------
485C /UNIT
486C-----------------------------------------------
487 IF (MYQAKEY('/unit')) THEN
488C
489 DO MY_UNIT=1,UNITAB%NUNITS
490C
491 TITR(1:nchartitle)=''
492 MY_ID = UNITAB%UNIT_ID(MY_UNIT)
493 IF(LEN_TRIM(TITR)/=0)THEN
494 CALL QAPRINT(TITR(1:LEN_TRIM(TITR)),MY_ID,0.0_8)
495 ELSE
496 CALL QAPRINT('a_unit_fake_name', MY_ID,0.0_8)
497 END IF
498C
499 IF(UNITAB%FAC_M(MY_UNIT)/=ZERO)THEN
500C VARNAME: variable name in ref.extract (without blanks)
501 WRITE(VARNAME,'(a,i0)') 'fac_m_',MY_UNIT
502 TEMP_DOUBLE = UNITAB%FAC_M(MY_UNIT)
503 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
504 END IF
505C
506 IF(UNITAB%FAC_L(MY_UNIT)/=ZERO)THEN
507C VARNAME: variable name in ref.extract (without blanks)
508 WRITE(VARNAME,'(a,i0)') 'fac_l_',MY_UNIT
509 TEMP_DOUBLE = UNITAB%FAC_L(MY_UNIT)
510 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
511 END IF
512
513 IF(UNITAB%FAC_T(MY_UNIT)/=ZERO)THEN
514C VARNAME: variable name in ref.extract (without blanks)
515 WRITE(VARNAME,'(a,i0)') 'fac_t_',MY_UNIT
516 TEMP_DOUBLE = UNITAB%FAC_T(MY_UNIT)
517 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
518 END IF
519C
520 END DO ! MY_UNIT=1,UNITAB%NUNITS
521C
522 END IF
523C-----------------------------------------------
524C /DEFAULT/INTER
525C----------------------------------------------
526 IF (MYQAKEY('/default/inter')) THEN
527C
528 DEF_INTER(1:100) = DEFAULTS%interface%DEF_INTER(1:100)
529 CALL QAPRINT('/default/inter', 0,0.0_8)
530
531 DO MY_DEFAULTINTER=1,100
532C
533 IF(DEF_INTER(MY_DEFAULTINTER) /= 0) THEN
534 WRITE(VARNAME,'(a,i0)') 'def_inter_',MY_DEFAULTINTER
535 TEMP_INT = DEF_INTER(MY_DEFAULTINTER)
536 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
537 ENDIF
538C
539 ENDDO ! MY_DEFAULTINTER=1,100
540
541 END IF
542C-----------------------------------------------
543C /INTTHICK
544C----------------------------------------------
545 IF (MYQAKEY('/intthick')) THEN
546C
547 IF (IINTTHICK > 0) THEN
548 CALL QAPRINT('/intthick',0,0.0_8)
549 WRITE(VARNAME,'(a)') 'intthick_'
550 TEMP_INT = IINTTHICK
551 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
552 ENDIF
553
554 END IF
555C-----------------------------------------------
556C /ALE/GRID/ *
557C----------------------------------------------
558 OK_QA = MYQAKEY('/ale/grid')
559 IF (OK_QA) THEN
560 TEMP_DOUBLE = ALE%GRID%ALPHA
561 WRITE(VARNAME,'(a)') 'alpha_'
562 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
563 TEMP_DOUBLE = ALE%GRID%GAMMA
564 WRITE(VARNAME,'(a)') 'gamma_'
565 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
566 TEMP_DOUBLE = ALE%GRID%VGX
567 WRITE(VARNAME,'(a)') 'vgx_'
568 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
569 TEMP_DOUBLE = ALE%GRID%VGY
570 WRITE(VARNAME,'(a)') 'vgy_'
571 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
572 TEMP_DOUBLE = ALE%GRID%VGZ
573 WRITE(VARNAME,'(a)') 'vgz_'
574 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
575 ENDIF
576C-----------------------------------------------
577C /SHFRA
578C----------------------------------------------
579 IF (MYQAKEY('/shfra')) THEN
580C
581 IF (ISHFRAM > 0) THEN
582 CALL QAPRINT('/ishfra',0,0.0_8)
583 WRITE(VARNAME,'(a)') 'ishfram_'
584 TEMP_INT = ISHFRAM
585 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
586 ENDIF
587
588 END IF
589C-----------------------------------------------
590C /UPWIND
591C----------------------------------------------
592 OK_QA = MYQAKEY('/upwind')
593 IF (OK_QA) THEN
594 TEMP_DOUBLE = ALE%UPWIND%UPWMG
595 WRITE(VARNAME,'(a)') 'upcoef1_'
596 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
597 TEMP_DOUBLE = ALE%UPWIND%UPWOG
598 WRITE(VARNAME,'(a)') 'upcoef2_'
599 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
600 TEMP_DOUBLE = ALE%UPWIND%UPWSM
601 WRITE(VARNAME,'(a)') 'upcoef3_'
602 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
603 ENDIF
604C-----------------------------------------------
605C /PERTURB
606C----------------------------------------------
607
608 IF (MYQAKEY('/perturb')) THEN
609C
610 IF (NPERTURB > 0) THEN
611C
612! Sort by ID to ensure internal order independent output
613 DO I = 1,NPERTURB
614 IDS(I) = QP_IPERTURB(I,1)
615 IDX(I) = I
616 ENDDO
617 CALL QUICKSORT_I2(IDS, IDX, 1, NPERTURB)
618C
619! Loop over INIGRAVs
620 DO II = 1, NPERTURB
621C
622 MY_ID = IDX(II)
623 CALL QAPRINT('/perturb_fake_name',II,0.0_8)
624C
625 DO I = 1,6
626 WRITE(VARNAME,'(a,i0)') 'qp_iperturb_',I
627 TEMP_INT = QP_IPERTURB(MY_ID,I)
628 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
629 ENDDO
630C
631 DO I = 1,4
632 WRITE(VARNAME,'(a,i0)') 'qp_rperturb_',I
633 TEMP_DOUBLE = QP_RPERTURB(MY_ID,I)
634 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
635 ENDDO
636C
637 ENDDO
638C
639 ENDIF
640C
641 END IF
642C-----------------------------------------------
643C /STAMPING
644C-----------------------------------------------
645 IF (MYQAKEY('/stamping')) THEN
646C
647 CALL QAPRINT('stamping',0,0.0_8)
648
649 WRITE(VARNAME,'(a,i0)') 'istamping'
650 TEMP_INT = ISTAMPING
651 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
652 ENDIF
653C-----------------------------------------------
654C /EIG
655C-----------------------------------------------
656 IF (MYQAKEY('/eig')) THEN
657C
658! Sort by ID to ensure internal order independent output
659 DO I = 1, NEIG
660 IDSEIG(I) = EIGIPM(1,I)
661 IDXEIG(I) = I
662 ENDDO
663 IF (NEIG>0) CALL QUICKSORT_I2(IDSEIG, IDXEIG, 1, NEIG)
664
665 DO II=1,NEIG
666C
667 MY_EIG = IDXEIG(II)
668 WRITE(VARNAME,'(a,i0)') 'eigid_',MY_EIG
669 TEMP_INT = EIGIPM(1,MY_EIG)
670 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
671C
672 DO I=1,NEIPM
673 IF(EIGIPM(I,MY_EIG) /=0)THEN
674C VARNAME: variable name in ref.extract (without blanks)
675 WRITE(VARNAME,'(a,i0)') 'eigipm_',I
676 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),EIGIPM(I,MY_EIG),0.0_8)
677 END IF
678 END DO
679C
680 DO I=1,NERPM
681 IF(EIGRPM(I,MY_EIG) /=ZERO)THEN
682 WRITE(VARNAME,'(a,i0)') 'eigrpm_',I
683 TEMP_DOUBLE = EIGRPM(I,MY_EIG)
684 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
685 END IF
686 END DO
687C
688 END DO ! II=1,NEIG
689C
690 END IF
691C-----------------------------------------------
692C /ANIM/VERS
693C-----------------------------------------------
694 IF (MYQAKEY('/anim/vers')) THEN
695C
696 WRITE(VARNAME,'(a)') 'anim_vers'
697 TEMP_INT = ANIM_VERS
698 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),TEMP_INT,0.0_8)
699C
700 END IF
701c----------------------------------------------------------------------
702 RETURN
703 END
my_real
#define my_real
Definition cppsort.cpp:32
eig
subroutine eig(k_diag, k_lt, iadk, jdik, ms, in, nddl, ndof, nnzl, x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, pm, geo, cont, icut, skew, xcut, fint, itab, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, matparam_tab, dd_iad, fr_iad, dd_front, cluster, weight, eani, ipart, rby, nom_opt, igrsurf, bufsf, idata, rdata, bufmat, bufgeo, kxx, ixx, kxsp, ixsp, nod2sp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, iparg, eigipm, eigibuf, eigrpm, ldiag, ljdik, ljdik2, ikc, maxncv, thke, nms, nint2, iint2, ipari, intbuf_tab, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, inloc, iddl, partsav, fncont, ftcont, temp, err_thk_sh4, err_thk_sh3, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, weight_md, fcluster, mcluster, xfem_tab, w, nv46, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, drape_q4, drape_t3, h3d_data, subset, igrnod, fcont_max, fncontp2, ftcontp2, ale_connectivity, glob_therm)
Definition eig.F:73
ale_mod
Definition ale_mod.F:150
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:253
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
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
unitab_mod
Definition unitab_mod.F:517
st_qaprint_general_controls
subroutine st_qaprint_general_controls(nom_opt, inom_opt, dampr, irand, alea, xseed, unitab, qp_iperturb, qp_rperturb, eigipm, eigrpm, defaults, damp_range_part)
Definition st_qaprint_general_controls.F:34
upwind
subroutine upwind(rho, vis, vdx, vdy, vdz, r, s, t, deltax, gam, nel)
Definition upwind.F:35