OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_admesh.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_admesh ../starter/source/output/qaprint/st_qaprint_admesh.f
25!||--- called by ------------------------------------------------------
26!|| st_qaprint_driver ../starter/source/output/qaprint/st_qaprint_driver.F
27!||--- calls -----------------------------------------------------
28!||--- uses -----------------------------------------------------
29!||====================================================================
30 SUBROUTINE st_qaprint_admesh(IPART ,IPADMESH,PADMESH,SH4TREE,SH3TREE,
31 2 IXC ,IXTG ,SH4TRIM,SH3TRIM )
32C============================================================================
33C M o d u l e s
34C-----------------------------------------------
35 USE qa_out_mod
36 USE names_and_titles_mod , ONLY : nchartitle
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 "remesh_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER, INTENT(IN) :: IPART(LIPART1,*), IPADMESH(KIPADMESH,*)
52 INTEGER, INTENT(IN) :: SH4TREE(KSH4TREE,*), SH3TREE(KSH3TREE,*),
53 . sh4trim(*),sh3trim(*) ,ixc(nixc,*), ixtg(nixtg,*)
54 my_real, INTENT(IN) :: padmesh(kpadmesh,*)
55
56C--------------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, MY_ID, N , IP
60 CHARACTER (LEN=255) :: VARNAME
61 DOUBLE PRECISION TEMP_DOUBLE
62C-----------------------------------------------
63C /ADMESH
64C-----------------------------------------------
65 IF (myqakey('ADMESH')) THEN
66
67 IF (nadmesh > 0) THEN
68
69 WRITE(varname,'(A)') 'NADMESH'
70 CALL qaprint(varname(1:len_trim(varname)),nadmesh,0.0_8)
71
72 IF(levelmax /= 0) THEN
73 WRITE(varname,'(A)') 'LEVELMAX'
74 CALL qaprint(varname(1:len_trim(varname)),levelmax,0.0_8)
75 ENDIF
76
77 IF(iadmrule /= 0) THEN
78 WRITE(varname,'(A)') 'IADMRULE'
79 CALL qaprint(varname(1:len_trim(varname)),iadmrule,0.0_8)
80 ENDIF
81
82 IF(iadmstat /= 0) THEN
83 WRITE(varname,'(A)') 'IADMSTAT'
84 CALL qaprint(varname(1:len_trim(varname)),iadmstat,0.0_8)
85 ENDIF
86
87 IF(istatcnd /= 0) THEN
88 WRITE(varname,'(A)') 'ISTATCND'
89 CALL qaprint(varname(1:len_trim(varname)),istatcnd,0.0_8)
90 ENDIF
91
92 IF(iadmerrt /= 0) THEN
93 WRITE(varname,'(A)') 'IADMERRT'
94 CALL qaprint(varname(1:len_trim(varname)),iadmerrt,0.0_8)
95 ENDIF
96
97 IF(dtadmesh /= zero) THEN
98 WRITE(varname,'(A)') 'DTADMESH'
99 temp_double = dtadmesh
100 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
101 ENDIF
102
103 IF(tadmesh /= zero) THEN
104 WRITE(varname,'(A)') 'TADMESH'
105 temp_double = tadmesh
106 CALL qaprint(varname(1:len_trim(varname)),0,temp_double)
107 ENDIF
108
109
110 DO ip=1,npart
111C
112 my_id = ipart(4,ip)
113 IF(ipart(10,ip) /= 0) THEN
114C
115 CALL qaprint('PART_ID_ADMESH_', my_id,0.0_8)
116C
117 CALL qaprint('levelmax',IPART(10,IP),0.0_8)
118C
119 DO I=1,KIPADMESH
120 WRITE(VARNAME,'(a,i0)') 'ipadmesh_',I
121 IF(IPADMESH(I,IP)/= 0) CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IPADMESH(I,IP),0.0_8)
122 ENDDO
123C
124 DO I=1,KPADMESH
125 WRITE(VARNAME,'(a,i0)') 'padmesh_',I
126 TEMP_DOUBLE = PADMESH(I,IP)
127 IF(TEMP_DOUBLE/= ZERO) CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
128 ENDDO
129 ENDIF
130C
131 ENDDO
132C
133 DO N=1,NUMELC
134 CALL QAPRINT('elem_admesh_4n_id_', IXC(NIXC,N),0.0_8)
135 DO I=1,KSH4TREE
136 WRITE(VARNAME,'(a,i0)') 'sh4tree_',I
137 IF(SH4TREE(I,N)/= 0)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),SH4TREE(I,N),0.0_8)
138 ENDDO
139 ENDDO
140C
141 DO N=1,NUMELTG
142 CALL QAPRINT('elem_admesh_3n_id_', IXTG(NIXTG,N),0.0_8)
143 DO I=1,KSH3TREE
144 WRITE(VARNAME,'(a,i0)') 'sh3tree_',I
145 IF(SH3TREE(I,N)/= 0)CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),SH3TREE(I,N),0.0_8)
146 ENDDO
147 ENDDO
148
149 IF(IADMSTAT/=0)THEN
150
151 DO N=1,LSH4TRIM
152 IF(SH4TRIM(N)/= 0) THEN
153 CALL QAPRINT('elem_admesh_stat_4n_id_', IXC(NIXC,N),0.0_8)
154 WRITE(VARNAME,'(a,i0)') 'sh4trim_',N
155 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),SH4TRIM(N),0.0_8)
156 ENDIF
157 ENDDO
158
159 DO N=1,LSH3TRIM
160 IF(SH3TRIM(N)/= 0) THEN
161 CALL QAPRINT('elem_admesh_stat_3n_id_', IXTG(NIXTG,N),0.0_8)
162 WRITE(VARNAME,'(a,i0)') 'sh3trim_',N
163 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),SH3TRIM(N),0.0_8)
164 ENDIF
165 ENDDO
166
167 ENDIF
168
169 ENDIF
170
171 ENDIF
172C-----------------------------------------------
173 RETURN
174 END
my_real
#define my_real
Definition cppsort.cpp:32
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
st_qaprint_admesh
subroutine st_qaprint_admesh(ipart, ipadmesh, padmesh, sh4tree, sh3tree, ixc, ixtg, sh4trim, sh3trim)
Definition st_qaprint_admesh.F:32
starter
program starter
Definition starter.F:39