OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_friction.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_friction ../starter/source/output/qaprint/st_qaprint_friction.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_friction(NOM_OPT ,INOM_OPT ,INTBUF_FRIC_TAB,NPFRICORTH,
32 2 PFRICORTH , IREPFORTH, PHIFORTH,VFORTH)
33C============================================================================
34C M o d u l e s
35C-----------------------------------------------
36 USE qa_out_mod
37 USE intbuf_fric_mod
38 USE names_and_titles_mod , ONLY : nchartitle
39C-----------------------------------------------
40C I m p l i c i t T y p e s
41C-----------------------------------------------
42#include "implicit_f.inc"
43C-----------------------------------------------
44C C o m m o n B l o c k s
45C-----------------------------------------------
46#include "com04_c.inc"
47#include "scr17_c.inc"
48#include "tabsiz_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER, INTENT(IN) :: NOM_OPT(LNOPT1,SNOM_OPT1), INOM_OPT(SINOM_OPT)
53 INTEGER, INTENT(IN) :: NPFRICORTH , PFRICORTH(*) , IREPFORTH(*)
54 my_real, INTENT(IN) :: phiforth(*), vforth(*)
55C
56 TYPE(intbuf_fric_struct_) INTBUF_FRIC_TAB(*)
57C--------------------------------------------------
58C L o c a l V a r i a b l e s
59C-----------------------------------------------
60 INTEGER I, MY_ID, MY_FRIC, LENI, LENC,IORTH ,NSET,J
61 CHARACTER(LEN=NCHARTITLE) :: TITR
62 CHARACTER (LEN=255) :: VARNAME
63 DOUBLE PRECISION TEMP_DOUBLE
64C-----------------------------------------------
65C /FRICTION /FRIC_ORIENT
66C-----------------------------------------------
67 IF (myqakey('FRICTION')) THEN
68 DO my_fric=1,ninterfric
69C
70 titr(1:nchartitle)=''
71
72 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,my_fric),ltitr)
73
74 my_id = nom_opt(1,inom_opt(29)+ my_fric)
75
76
77 IF(len_trim(titr)/=0)THEN
78 CALL qaprint('FRICTION',my_id,0.0_8)
79 ELSE
80 CALL qaprint('A_FRIC_FAKE_NAME', my_id,0.0_8)
81 END IF
82C
83 nset = intbuf_fric_tab(my_fric)%NSETPRTS
84
85 WRITE(varname,'(A)') 'NSETPRTS'
86 CALL qaprint(varname(1:len_trim(varname)),intbuf_fric_tab(my_fric)%NSETPRTS,0.0_8)
87
88 WRITE(varname,'(A)') 'FRICMOD'
89 CALL qaprint(varname(1:len_trim(varname)),intbuf_fric_tab(my_fric)%FRICMOD,0.0_8)
90
91 WRITE(varname,'(A)') 'FRICFORM'
92 CALL qaprint(varname(1:len_trim(varname)),intbuf_fric_tab(my_fric)%FRICFORM,0.0_8)
93
94 WRITE(varname,'(A)') 'IFFILTER'
95 CALL qaprint(varname(1:len_trim(varname)),intbuf_fric_tab(my_fric)%IFFILTER,0.0_8)
96
97 WRITE(varname,'(A)') 'S_TABPARTS_FRIC'
98 CALL qaprint(varname(1:len_trim(varname)),intbuf_fric_tab(my_fric)%S_TABPARTS_FRIC,0.0_8)
99
100 iorth = intbuf_fric_tab(my_fric)%IORTHFRIC
101
102 WRITE(varname,'(A)') 'IORTHFRIC'
103 CALL qaprint(varname(1:len_trim(varname)),intbuf_fric_tab(my_fric)%IORTHFRIC,0.0_8)
104
105 WRITE(varname,'(A)') 'xfiltr_fric'
106 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%XFILTR_FRIC
107 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
108
109 IF(NSET > 0) THEN
110 DO I=1,NSET
111 WRITE(VARNAME,'(a,i0)') 'part_couple',I
112 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INTBUF_FRIC_TAB(MY_FRIC)%TABCOUPLEPARTS_FRIC(I),0.0_8)
113 ENDDO
114
115 DO I=1,INTBUF_FRIC_TAB(MY_FRIC)%S_TABPARTS_FRIC
116 WRITE(VARNAME,'(a,i0)') 'part_fric',I
117 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INTBUF_FRIC_TAB(MY_FRIC)%TABPARTS_FRIC(I),0.0_8)
118 ENDDO
119
120 DO I=1,INTBUF_FRIC_TAB(MY_FRIC)%S_TABPARTS_FRIC
121 WRITE(VARNAME,'(a,i0)') 'ad_part_fric',I
122 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INTBUF_FRIC_TAB(MY_FRIC)%ADPARTS_FRIC(I),0.0_8)
123 ENDDO
124
125 DO I=1,NSET
126 WRITE(VARNAME,'(a,i0)') 'ifricorth',I
127 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),INTBUF_FRIC_TAB(MY_FRIC)%IFRICORTH(I),0.0_8)
128 ENDDO
129
130 ENDIF
131
132 IF(INTBUF_FRIC_TAB(MY_FRIC)%FRICMOD ==0 ) THEN
133 LENC =2
134 ELSE
135 LENC = 8
136 ENDIF
137
138 IF (IORTH == 0 ) THEN
139 LENI = 1
140 ELSE
141 LENI = 2
142 ENDIF
143
144 IF(NSET > 0) THEN
145C default values
146 WRITE(VARNAME,'(a,i0)') 'mu_def'
147 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(1)
148 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
149
150 WRITE(VARNAME,'(a,i0)') 'viscf_def'
151 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(2)
152 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
153
154 IF(INTBUF_FRIC_TAB(MY_FRIC)%FRICMOD > 0 ) THEN
155 DO J=1,6
156 WRITE(VARNAME,'(a,i0,i0)') 'fric_coef_def_',J,I
157 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(2+J)
158 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
159 ENDDO
160 ENDIF
161
162 DO I=1,NSET
163C VARNAME: variable name in ref.extract (without blanks)
164 IORTH = INTBUF_FRIC_TAB(MY_FRIC)%IFRICORTH(I)
165 IF(IORTH == 0 ) THEN
166 WRITE(VARNAME,'(a,i0)') 'mu_',I
167 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+LENC+1)
168 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
169
170 WRITE(VARNAME,'(a,i0)') 'viscf_',I
171 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+LENC+2)
172 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
173
174 IF(INTBUF_FRIC_TAB(MY_FRIC)%FRICMOD > 0 ) THEN
175 DO J=1,6
176 WRITE(VARNAME,'(a,i0,i0)') 'fric_coef_',J,I
177 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+LENC+2+J)
178 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
179 ENDDO
180 ENDIF
181 ELSE
182 WRITE(VARNAME,'(a,i0)') 'mu_orth_1_',I
183 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+LENC+1)
184 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
185
186 WRITE(VARNAME,'(a,i0)') 'viscf_orth_1_',I
187 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+LENC+2)
188 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
189
190 WRITE(VARNAME,'(a,i0)') 'mu_orth_2_',I
191 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+2*LENC+1)
192 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
193
194 WRITE(VARNAME,'(a,i0)') 'viscf_orth_2_',I
195 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+2*LENC+2)
196 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
197
198 IF(INTBUF_FRIC_TAB(MY_FRIC)%FRICMOD > 0 ) THEN
199 DO J=1,6
200 WRITE(VARNAME,'(a,i0,i0)') 'fric_coef_orth_1_',J,I
201 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+LENC+2+J)
202 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
203
204 WRITE(VARNAME,'(a,i0,i0)') 'fric_coef_orth_2_',J,I
205 TEMP_DOUBLE = INTBUF_FRIC_TAB(MY_FRIC)%TABCOEF_FRIC(LENI*LENC*(I-1)+2*LENC+2+J)
206 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
207 ENDDO
208 ENDIF
209 ENDIF
210
211 END DO
212 ENDIF
213C
214 END DO ! MY_FRIC=1,NINTERFRIC
215
216 IF(NPFRICORTH /=0) THEN
217
218 WRITE(VARNAME,'(a)') 'npfricorth'
219 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),NPFRICORTH,0.0_8)
220
221 DO I=1,NPART
222 WRITE(VARNAME,'(a,i0)') 'pfricorth',I
223 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),PFRICORTH(I),0.0_8)
224 ENDDO
225
226 DO I=1,NPFRICORTH
227 WRITE(VARNAME,'(a,i0)') 'irepforth',I
228 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),IREPFORTH(I),0.0_8)
229 ENDDO
230 DO I=1,3*NPFRICORTH
231 WRITE(VARNAME,'(a,i0)') 'vforth',I
232 TEMP_DOUBLE = VFORTH(I)
233 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
234 ENDDO
235 DO I=1,NPFRICORTH
236 WRITE(VARNAME,'(a,i0)') 'phiforth',I
237 TEMP_DOUBLE = PHIFORTH(I)
238 CALL QAPRINT(VARNAME(1:LEN_TRIM(VARNAME)),0,TEMP_DOUBLE)
239 ENDDO
240 ENDIF
241
242 ENDIF
243C-----------------------------------------------
244 RETURN
245 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_friction
subroutine st_qaprint_friction(nom_opt, inom_opt, intbuf_fric_tab, npfricorth, pfricorth, irepforth, phiforth, vforth)
Definition st_qaprint_friction.F:33
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804