OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_general_controls.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scr03_c.inc"
#include "scr05_c.inc"
#include "scr06_c.inc"
#include "scr12_c.inc"
#include "scr14_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"
#include "random_c.inc"
#include "sphcom.inc"
#include "sms_c.inc"
#include "eigcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_general_controls (nom_opt, inom_opt, dampr, irand, alea, xseed, unitab, qp_iperturb, qp_rperturb, eigipm, eigrpm, defaults, damp_range_part)

Function/Subroutine Documentation

◆ st_qaprint_general_controls()

subroutine st_qaprint_general_controls ( integer, dimension(lnopt1,snom_opt1), intent(in) nom_opt,
integer, dimension(sinom_opt), intent(in) inom_opt,
dimension(nrdamp,*), intent(in) dampr,
integer, dimension(*), intent(in) irand,
dimension(*), intent(in) alea,
dimension(*), intent(in) xseed,
type (unit_type_) unitab,
integer, dimension(nperturb,6), intent(in) qp_iperturb,
dimension(nperturb,4), intent(in) qp_rperturb,
integer, dimension(neipm,*), intent(in) eigipm,
dimension(nerpm,*), intent(in) eigrpm,
type(defaults_), intent(in) defaults,
integer, dimension(npart), intent(in) damp_range_part )
Parameters
[in]damp_range_partflag to compute the damping range

Definition at line 31 of file st_qaprint_general_controls.F.

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
my_real
#define my_real
Definition cppsort.cpp:32
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
quicksort_i2
recursive subroutine quicksort_i2(a, idx, first, last)
Definition quicksort.F:153