OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_output_databases.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_output_databases ../starter/source/output/qaprint/st_qaprint_output_databases.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!||====================================================================
31 SUBROUTINE st_qaprint_output_databases(NOM_OPT, INOM_OPT, LACCELM, ACCELM,LGAUGE,GAUGE)
32C============================================================================
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "param_c.inc"
46#include "scr17_c.inc"
47#include "tabsiz_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
52 INTEGER, INTENT(IN) :: LACCELM(3, NACCELM)
53 my_real, INTENT(IN) :: accelm(llaccelm, naccelm)
54 INTEGER, INTENT(IN) :: LGAUGE(3,NBGAUGE)
55 my_real, INTENT(IN) :: gauge(llgauge,nbgauge)
56C--------------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, ID, II, TEMP_INT
60 CHARACTER(LEN=NCHARTITLE) :: TITR
61 CHARACTER (LEN=255) :: VARNAME
62 DOUBLE PRECISION TEMP_DOUBLE
63 LOGICAL :: OK_QA
64C-----------------------------------------------
65C /DAMP
66C-----------------------------------------------
67 ok_qa = myqakey('/ACCEL')
68 IF (ok_qa) THEN
69 DO ii = 1, naccelm
70C
71 titr(1:nchartitle)=''
72 id = nom_opt(1, inom_opt(1) + ii)
73 CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1, inom_opt(1) + ii), ltitr)
74 IF(len_trim(titr)/=0)THEN
75 CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
76 ELSE
77 CALL qaprint('A_ACCEL_FAKE_NAME', id,0.0_8)
78 END IF
79C
80 DO i = 1, 3
81 WRITE(varname,'(A,I0,A,I0)') 'IACCEL_',id,'_',i
82 temp_int = laccelm(i,ii)
83 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
84 ENDDO
85 DO i = 1, llaccelm
86 WRITE(varname,'(A,I0,A,I0)') 'RACCEL_',id,'_',i
87 temp_double = accelm(i,ii)
88 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
89 END DO
90C
91 END DO
92 END IF
93C-----------------------------------------------
94C /GAUGE
95C-----------------------------------------------
96 IF (myqakey('/GAUGE')) THEN
97C
98 IF (nbgauge > 0) THEN
99 DO ii = 1, nbgauge
100 titr(1:nchartitle)=''
101 id = nom_opt(1, inom_opt(27) + ii)
102 CALL fretitl2(titr, nom_opt(lnopt1-ltitr+1, inom_opt(27) + ii), ltitr)
103 IF(len_trim(titr)/=0)THEN
104 CALL qaprint(titr(1:len_trim(titr)),id,0.0_8)
105 ELSE
106 CALL qaprint('A_GAUGE_FAKE_NAME', id,0.0_8)
107 END IF
108 DO i = 1, 3
109 IF(lgauge(i,ii) /=0)THEN
110 WRITE(varname,'(A,I0,A,I0)') 'LGAUGE_',i,'_',ii
111 temp_int = lgauge(i,ii)
112 CALL qaprint(varname(1:len_trim(varname)),temp_int,0.0_8)
113 ENDIF
114 ENDDO
115 DO i = 1, llgauge
116 IF(gauge(i,ii) /=0)THEN
117 WRITE(varname,'(A,I0,A,I0)') 'GAUGE_',i,'_',ii
118 temp_double = gauge(i,ii)
119 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
120 ENDIF
121 END DO
122 END DO
123 END IF
124 END IF
125
126C-----------------------------------------------
127 RETURN
128 END
#define my_real
Definition cppsort.cpp:32
integer, parameter nchartitle
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
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
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)
subroutine st_qaprint_output_databases(nom_opt, inom_opt, laccelm, accelm, lgauge, gauge)
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
program starter
Definition starter.F:39