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