OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
st_qaprint_friction.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr17_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine st_qaprint_friction (nom_opt, inom_opt, intbuf_fric_tab, npfricorth, pfricorth, irepforth, phiforth, vforth)

Function/Subroutine Documentation

◆ st_qaprint_friction()

subroutine st_qaprint_friction ( integer, dimension(lnopt1,snom_opt1), intent(in) nom_opt,
integer, dimension(sinom_opt), intent(in) inom_opt,
type(intbuf_fric_struct_), dimension(*) intbuf_fric_tab,
integer, intent(in) npfricorth,
integer, dimension(*), intent(in) pfricorth,
integer, dimension(*), intent(in) irepforth,
dimension(*), intent(in) phiforth,
dimension(*), intent(in) vforth )

Definition at line 31 of file st_qaprint_friction.F.

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
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804