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_routtines.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,NXX,NYY,NZZ
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 xa,xb,xc,la,lb,lc,
64 4 xl,yl,zl,e,d,
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 REAL R4
70 DATA dx0/ 0., 0., 0., 0., 0., 0./
71 DATA dy0/ 1.,-1., 0., 0., 0., 0./
72 DATA dz0/ 0., 0.,-1., 1., 1.,-1./
73 DATA dx1/ 1., 1., 1., 1., 0., 0./
74 DATA dy1/ 0., 0., 0., 0., 1., 1./
75 DATA dz1/ 0., 0., 0., 0., 0., 0./
76 DATA x0 /-3.5,-3.5,-3.5,-3.5,-3.5, 3.5/
77 DATA y0 /-3.5, 3.5,-3.5, 3.5,-3.5,-3.5/
78 DATA z0 /-3.5, 3.5, 3.5,-3.5,-3.5, 3.5/
79C-----------------------------------------------
80 i3000 = 3000
81 IF (ispmd/=0) GOTO 100
82C
83 DO 200 n=1,nsurf
84 IF (igrsurf(n)%TYPE/=101) GOTO 200
85 adrbuf=igrsurf(n)%IAD_BUFR
86C-------------------------------------------------------
87c Parametres de l'ellipsoide.
88C-------------------------------------------------------
89 dgr=bufsf(adrbuf+36)
90 xg=bufsf(adrbuf+4)
91 yg=bufsf(adrbuf+5)
92 zg=bufsf(adrbuf+6)
93 a =bufsf(adrbuf+1)
94 b =bufsf(adrbuf+2)
95 c =bufsf(adrbuf+3)
96 DO i=1,9
97 rot(i)=bufsf(adrbuf+7+i-1)
98 END DO
99C-------------------------------------------------------
100C - Calcul des noeuds sur le cube A,B,C.
101C-------------------------------------------------------
102 inoe=0
103 DO i = 1,6
104 xx0 = x0(i)
105 yy0 = y0(i)
106 zz0 = z0(i)
107 DO j = 1,8
108 xl = xx0
109 yl = yy0
110 zl = zz0
111 DO k = 1,8
112 inoe=inoe+1
113 ncor(1,inoe) = a*xl * third
114 ncor(2,inoe) = b*yl * third
115 ncor(3,inoe) = c*zl * third
116 xl = xl + dx0(i)
117 yl = yl + dy0(i)
118 zl = zl + dz0(i)
119 ENDDO
120 xx0 = xx0 + dx1(i)
121 yy0 = yy0 + dy1(i)
122 zz0 = zz0 + dz1(i)
123 ENDDO
124 ENDDO
125C-------------------------------------------------------
126C - Calcul de la normale : projection radiale.
127C-------------------------------------------------------
128 an=a**dgr
129 bn=b**dgr
130 cn=c**dgr
131 inoe=0
132 DO i=1,384
133 inoe=inoe+1
134 xl=ncor(1,inoe)
135 yl=ncor(2,inoe)
136 zl=ncor(3,inoe)
137C
138 xln=xl**dgr
139 yln=yl**dgr
140 zln=zl**dgr
141 e=abs(xln)/an+abs(yln)/bn+abs(zln)/cn
142 e=exp(log(e)/dgr)
143 xl=xl/e
144 yl=yl/e
145 zl=zl/e
146C
147 nxl=xl**(dgr-1)/an
148 IF (xl*nxl<zero) nxl=-nxl
149 nyl=yl**(dgr-1)/bn
150 IF (yl*nyl<zero) nyl=-nyl
151 nzl=zl**(dgr-1)/cn
152 IF (zl*nzl<zero) nzl=-nzl
153 nx =rot(1)*nxl+rot(4)*nyl+rot(7)*nzl
154 ny =rot(2)*nxl+rot(5)*nyl+rot(8)*nzl
155 nz =rot(3)*nxl+rot(6)*nyl+rot(9)*nzl
156 normn =sqrt(nx*nx+ny*ny+nz*nz)
157 nx =nx/normn
158 ny =ny/normn
159 nz =nz/normn
160 nnor(1,inoe)=three1000*nx
161 nnor(2,inoe)=three1000*ny
162 nnor(3,inoe)=three1000*nz
163 END DO
164C-------------------------------------------------------
165C Ecriture des normales aux noeuds.
166C-------------------------------------------------------
167 inoe=0
168 DO i=1,384
169 inoe=inoe+1
170 nx = nnor(1,inoe)
171 CALL write_s_c(nint(nx),1)
172 ny = nnor(2,inoe)
173 CALL write_s_c(nint(ny),1)
174 nz = nnor(3,inoe)
175 CALL write_s_c(nint(nz),1)
176 END DO
177C-------------------------------------------------------
178 200 CONTINUE
179 100 CONTINUE
180 RETURN
181 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:662
write_s_c
void write_s_c(int *w, int *len)
Definition write_routtines.c:687