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: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
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:799