OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dsrgnor.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!|| dsrgnor ../engine/source/output/anim/generate/dsrgnor.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| write_s_c ../common_source/tools/input_output/write_routines.c
29!||--- uses -----------------------------------------------------
30!|| groupdef_mod ../common_source/modules/groupdef_mod.F
31!||====================================================================
32 SUBROUTINE dsrgnor(IGRSURF,BUFSF)
33C-----------------------------------------------
34C M o d u l e s
35C-----------------------------------------------
36 USE groupdef_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "com04_c.inc"
45#include "task_c.inc"
46C-----------------------------------------------
47C D u m m y A r g u m e n t s
48C-----------------------------------------------
49 my_real
50 . bufsf(*)
51 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
52C-----------------------------------------------
53C L o c a l V a r i a b l e s
54C-----------------------------------------------
55 INTEGER I3000
56 INTEGER N,ADRBUF
57 INTEGER INOE, I, J, K, DGR
58 my_real xg,yg,zg,a,b,c,rot(9),
59 1 an,bn,cn
60 my_real
61 1 ncor(3,384),
62 2 nnor(3,384),
63 3
64 4 xl,yl,zl,e,
65 5 xln,yln,zln,nxl,nyl,nzl,nx,ny,nz,normn
66 my_real
67 1 xx0,yy0,zz0,
68 2 x0(6),y0(6),z0(6),dx0(6),dy0(6),dz0(6),dx1(6),dy1(6),dz1(6)
69 DATA dx0/ 0., 0., 0., 0., 0., 0./
70 DATA dy0/ 1.,-1., 0., 0., 0., 0./
71 DATA dz0/ 0., 0.,-1., 1., 1.,-1./
72 DATA dx1/ 1., 1., 1., 1., 0., 0./
73 DATA dy1/ 0., 0., 0., 0., 1., 1./
74 DATA dz1/ 0., 0., 0., 0., 0., 0./
75 DATA x0 /-3.5,-3.5,-3.5,-3.5,-3.5, 3.5/
76 DATA y0 /-3.5, 3.5,-3.5, 3.5,-3.5,-3.5/
77 DATA z0 /-3.5, 3.5, 3.5,-3.5,-3.5, 3.5/
78C-----------------------------------------------
79 i3000 = 3000
80 IF (ispmd/=0) GOTO 100
81C
82 DO 200 n=1,nsurf
83 IF (igrsurf(n)%TYPE/=101) GOTO 200
84 adrbuf=igrsurf(n)%IAD_BUFR
85C-------------------------------------------------------
86c ellipsoid parameters
87C-------------------------------------------------------
88 dgr=bufsf(adrbuf+36)
89 xg=bufsf(adrbuf+4)
90 yg=bufsf(adrbuf+5)
91 zg=bufsf(adrbuf+6)
92 a =bufsf(adrbuf+1)
93 b =bufsf(adrbuf+2)
94 c =bufsf(adrbuf+3)
95 DO i=1,9
96 rot(i)=bufsf(adrbuf+7+i-1)
97 END DO
98C-------------------------------------------------------
99C compute nodes on the A,B,C cube
100C-------------------------------------------------------
101 inoe=0
102 DO i = 1,6
103 xx0 = x0(i)
104 yy0 = y0(i)
105 zz0 = z0(i)
106 DO j = 1,8
107 xl = xx0
108 yl = yy0
109 zl = zz0
110 DO k = 1,8
111 inoe=inoe+1
112 ncor(1,inoe) = a*xl * third
113 ncor(2,inoe) = b*yl * third
114 ncor(3,inoe) = c*zl * third
115 xl = xl + dx0(i)
116 yl = yl + dy0(i)
117 zl = zl + dz0(i)
118 ENDDO
119 xx0 = xx0 + dx1(i)
120 yy0 = yy0 + dy1(i)
121 zz0 = zz0 + dz1(i)
122 ENDDO
123 ENDDO
124C-------------------------------------------------------
125C compute the normal: radial projection
126C-------------------------------------------------------
127 an=a**dgr
128 bn=b**dgr
129 cn=c**dgr
130 inoe=0
131 DO i=1,384
132 inoe=inoe+1
133 xl=ncor(1,inoe)
134 yl=ncor(2,inoe)
135 zl=ncor(3,inoe)
136C
137 xln=xl**dgr
138 yln=yl**dgr
139 zln=zl**dgr
140 e=abs(xln)/an+abs(yln)/bn+abs(zln)/cn
141 e=exp(log(e)/dgr)
142 xl=xl/e
143 yl=yl/e
144 zl=zl/e
145C
146 nxl=xl**(dgr-1)/an
147 IF (xl*nxl<zero) nxl=-nxl
148 nyl=yl**(dgr-1)/bn
149 IF (yl*nyl<zero) nyl=-nyl
150 nzl=zl**(dgr-1)/cn
151 IF (zl*nzl<zero) nzl=-nzl
152 nx =rot(1)*nxl+rot(4)*nyl+rot(7)*nzl
153 ny =rot(2)*nxl+rot(5)*nyl+rot(8)*nzl
154 nz =rot(3)*nxl+rot(6)*nyl+rot(9)*nzl
155 normn =sqrt(nx*nx+ny*ny+nz*nz)
156 nx =nx/normn
157 ny =ny/normn
158 nz =nz/normn
159 nnor(1,inoe)=three1000*nx
160 nnor(2,inoe)=three1000*ny
161 nnor(3,inoe)=three1000*nz
162 END DO
163C-------------------------------------------------------
164C Writing normal to nodes.
165C-------------------------------------------------------
166 inoe=0
167 DO i=1,384
168 inoe=inoe+1
169 nx = nnor(1,inoe)
170 CALL write_s_c(nint(nx),1)
171 ny = nnor(2,inoe)
172 CALL write_s_c(nint(ny),1)
173 nz = nnor(3,inoe)
174 CALL write_s_c(nint(nz),1)
175 END DO
176C-------------------------------------------------------
177 200 CONTINUE
178 100 CONTINUE
179 RETURN
180 END
my_real
#define my_real
Definition cppsort.cpp:32
dsrgnor
subroutine dsrgnor(igrsurf, bufsf)
Definition dsrgnor.F:33
groupdef_mod
Definition groupdef_mod.F:668
write_s_c
void write_s_c(int *w, int *len)
Definition write_routines.c:687