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,J,IPERT,MY_ID, MY_DAMP, MY_CONSTRAINT,TEMP_INT,
78 . MY_RAND, MY_UNIT, MY_DEFAULTINTER,LENRNOISE,
79 . ids(nperturb),idx(nperturb),idseig(neig),idxeig(neig),my_eig
80 CHARACTER(LEN=NCHARTITLE) :: TITR
81 INTEGER IHBE_DS,ISST_DS,IPLA_DS,IFRAME_DS,ITET4_D,ITET10_D,ICPRE_D,IMAS_DS,
82 . ihbe_d,ipla_d,istr_d,ithk_d,ishea_d,isst_d,
83 . ish3n_d, istra_d,npts_d,idril_d,ioffset,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
ale_mod
Definition ale_mod.F:149
ale_mod::ale
type(ale_) ale
Definition ale_mod.F:249
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
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:513
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153
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