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 38 of file nodal_schlieren.F.

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