OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
nodal_schlieren.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine nodal_schlieren (wa4, x, ixs, ixq, itab, iparg, ibid, elbuf_tab, ale_connectivity)

Function/Subroutine Documentation

◆ nodal_schlieren()

subroutine nodal_schlieren ( real, dimension(*) wa4,
x,
integer, dimension(nixs,*) ixs,
integer, dimension(nixq,*) ixq,
integer, dimension(*) itab,
integer, dimension(nparg,*) iparg,
integer ibid,
type (elbuf_struct_), dimension(ngroup), target elbuf_tab,
type(t_ale_connectivity), intent(in) ale_connectivity )

Definition at line 39 of file nodal_schlieren.F.

40C-----------------------------------------------
41C D e s c r i p t i o n
42C-----------------------------------------------
43C This subroutine outputs data for schlieren.
44C schlieren is eta = exp (-C ||grad(rho)||)
45C C is a constant which help user to adjust "brightness"
46C RADIOSS outputs density gradient which is recuired to output schlieren.
47C 'C' cosntant must be tuned during post-treatment then
48C is it introduced with HV result math.
49C-----------------------------------------------
50C P r e - C o n d i t i o n s
51C-----------------------------------------------
52C IALEL > 0
53C where IALEL =IPARG(7,NG)+IPARG(11,NG)
54C-----------------------------------------------
55C M o d u l e s
56C-----------------------------------------------
57 USE initbuf_mod
58 USE elbufdef_mod
60 USE i22edge_mod
61 USE i22tri_mod
63 use element_mod , only : nixs,nixq
64C-----------------------------------------------
65C I m p l i c i t T y p e s
66C-----------------------------------------------
67#include "implicit_f.inc"
68C-----------------------------------------------
69C C o m m o n B l o c k s
70C-----------------------------------------------
71#include "com01_c.inc"
72#include "com04_c.inc"
73#include "vect01_c.inc"
74#include "param_c.inc"
75#include "mvsiz_p.inc"
76C-----------------------------------------------
77C D u m m y A r g u m e n t s
78C-----------------------------------------------
79 INTEGER IXQ(NIXQ,*),IXS(NIXS,*),ITAB(*),IPARG(NPARG,*)
80 REAL WA4(*)
81 my_real :: x(3,*)
82 INTEGER :: IBID
83 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
84 TYPE(t_ale_connectivity), INTENT(IN) :: ALE_CONNECTIVITY
85C-----------------------------------------------
86C L o c a l V a r i a b l e s
87C-----------------------------------------------
88 INTEGER I, ITYP, NEL,
89 . IR1, IR2, J, JJ, NNO_L, NNI_L, II3, II4, JJJ, NNI,
90 . IALEL,NNOD,IPOS,NGv,IDLOCv,K, IAD2
91 INTEGER IV(6), IE
92 INTEGER NG
93 TYPE(G_BUFEL_) ,POINTER :: GBUF
94 my_real, ALLOCATABLE, DIMENSION(:) :: count_vol
95 my_real d,v, dphi(mvsiz)
96
97 my_real :: grad(6,mvsiz)
98C-----------------------------------------------
99C D e s c r i p t i o n
100C-----------------------------------------------
101C This subroutine write nodal shadowgraph (schlieren)
102C-----------------------------------------------
103C S o u r c e L i n e s
104C-----------------------------------------------
105
106 wa4(1:numnod) = zero
107
108 RETURN
109
110 !TODO : 2D,3D, QUAD, HEXA,TETRA
111
112
113
114
115
116 nnod = nixs-3 !8-node brick or 4-node quad
117
118 !---------------------------------------------------------!
119 ! ALE STANDARD FORMULATION : 3D !
120 !---------------------------------------------------------!
121 ALLOCATE(count_vol(numnod))
122 count_vol(:) = 0
123 DO ng = 1, ngroup
124 nel =iparg(2,ng)
125 nft =iparg(3,ng)
126 ityp =iparg(5,ng)
127 ialel =iparg(7,ng)+iparg(11,ng)
128 IF(ityp/=1 .AND. ityp/=2)cycle
129 IF(ialel==0)cycle
130 gbuf => elbuf_tab(ng)%GBUF
131 DO i=1,nel
132 j = i+nft
133! PHI(J) = GBUF%RHO(I)
134 ENDDO
135 ENDDO
136
137 DO ng = 1, ngroup
138 nel =iparg(2,ng)
139 nft =iparg(3,ng)
140 ityp =iparg(5,ng)
141 ialel =iparg(7,ng)+iparg(11,ng)
142 IF(ityp/=1 .AND. ityp/=2)cycle
143 IF(ialel==0)cycle
144 gbuf => elbuf_tab(ng)%GBUF
145 DO i=1,nel
146 lft = 1
147 llt = nel
148 CALL agrad3(
149 1 ixs, x, ale_connectivity,grad)
150 ie =nft+i
151 iad2 = ale_connectivity%ee_connect%iad_connect(ie)
152 iv(1)=ale_connectivity%ee_connect%connected(iad2 + 1 - 1)
153 iv(2)=ale_connectivity%ee_connect%connected(iad2 + 2 - 1)
154 iv(3)=ale_connectivity%ee_connect%connected(iad2 + 3 - 1)
155 iv(4)=ale_connectivity%ee_connect%connected(iad2 + 4 - 1)
156 iv(5)=ale_connectivity%ee_connect%connected(iad2 + 5 - 1)
157 iv(6)=ale_connectivity%ee_connect%connected(iad2 + 6 - 1)
158 IF(iv(1)<=0)iv(1)=ie
159 IF(iv(2)<=0)iv(2)=ie
160 IF(iv(3)<=0)iv(3)=ie
161 IF(iv(4)<=0)iv(4)=ie
162 IF(iv(5)<=0)iv(5)=ie
163 IF(iv(6)<=0)iv(6)=ie
164 dphi(i) = zero
165! . (PHI(IV(1))-PHI(IE))*GRAD(1,I)
166! . +(PHI(IV(2))-PHI(IE))*GRAD(2,I)
167! . +(PHI(IV(3))-PHI(IE))*GRAD(3,I)
168! . +(PHI(IV(4))-PHI(IE))*GRAD(4,I)
169! . +(PHI(IV(5))-PHI(IE))*GRAD(5,I)
170! . +(PHI(IV(6))-PHI(IE))*GRAD(6,I)
171 DO j=2,nnod+1
172 jj=ixs(j,nft+i)
173 k = j-1
174 wa4(jj) = wa4(jj)+ dphi(i)
175 count_vol(jj) = count_vol(jj) + 1
176 ENDDO
177 ENDDO
178 enddo!next NG
179
180 !applying weight factor
181 DO i=1,numnod
182 IF(count_vol(i)/=zero)THEN
183 wa4(i)=wa4(i)/count_vol(i)
184 ENDIF
185 ENDDO
186 DEALLOCATE(count_vol)
187
#define my_real
Definition cppsort.cpp:32
subroutine agrad3(ixs, x, ale_connectivity, grad, nel)
Definition agrad3.F:30