OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dxyzsrg.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!|| dxyzsrg ../engine/source/output/anim/generate/dxyzsrg.F
25!||--- called by ------------------------------------------------------
26!|| genani ../engine/source/output/anim/generate/genani.F
27!||--- calls -----------------------------------------------------
28!|| write_r_c ../common_source/tools/input_output/write_routtines.c
29!||--- uses -----------------------------------------------------
30!|| groupdef_mod ../common_source/modules/groupdef_mod.F
31!||====================================================================
32 SUBROUTINE dxyzsrg(NESRG,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 INTEGER NESRG
50 my_real
51 . bufsf(*)
52 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
53C-----------------------------------------------
54C L o c a l V a r i a b l e s
55C-----------------------------------------------
56 INTEGER N, ADRBUF
57 INTEGER INOE, I, J, K, IDG, ITER
58 my_real xg,yg,zg,a,b,c,rot(9),
59 1 dgr,an,bn,cn,
60 2 xln,yln,zln,nxl,nyl,nzl,normn
61 my_real
62 1 ncor(3,384),
63 2 xa,xb,xc,la,lb,lc,
64 3 xx,yy,zz,xl,yl,zl,e,d
65 my_real
66 1 xx0,yy0,zz0,
67 2 x0(6),y0(6),z0(6),dx0(6),dy0(6),dz0(6),dx1(6),dy1(6),dz1(6)
68 REAL R4
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 IF (ispmd/=0) GOTO 100
80C-----------------------------------------------
81 DO 200 n=1,nsurf
82 IF (igrsurf(n)%TYPE/=101) GOTO 200
83 adrbuf=igrsurf(n)%IAD_BUFR
84C-------------------------------------------------------
85c Parametres de l'ellipsoide.
86C-------------------------------------------------------
87 dgr=bufsf(adrbuf+36)
88 idg=dgr
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 - Calcul des noeuds sur le cube A,B,C
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 - Projection radiale sur l'ellipsoide.
126C - Passage au repere global.
127C-------------------------------------------------------
128 an=a**idg
129 bn=b**idg
130 cn=c**idg
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**idg
139 yln=yl**idg
140 zln=zl**idg
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 xx =rot(1)*xl+rot(4)*yl+rot(7)*zl
148 yy =rot(2)*xl+rot(5)*yl+rot(8)*zl
149 zz =rot(3)*xl+rot(6)*yl+rot(9)*zl
150 ncor(1,inoe)=xx+xg
151 ncor(2,inoe)=yy+yg
152 ncor(3,inoe)=zz+zg
153 END DO
154C-------------------------------------------------------
155C Ecriture des noeuds.
156C-------------------------------------------------------
157 inoe=0
158 DO i=1,384
159 inoe=inoe+1
160 r4 = ncor(1,inoe)
161 CALL write_r_c(r4,1)
162 r4 = ncor(2,inoe)
163 CALL write_r_c(r4,1)
164 r4 = ncor(3,inoe)
165 CALL write_r_c(r4,1)
166 END DO
167C-------------------------------------------------------
168 200 CONTINUE
169 100 CONTINUE
170C-------------------------------------------------------
171 RETURN
172 END
my_real
#define my_real
Definition cppsort.cpp:32
dxyzsrg
subroutine dxyzsrg(nesrg, igrsurf, bufsf)
Definition dxyzsrg.F:33
groupdef_mod
Definition groupdef_mod.F:662
write_r_c
void write_r_c(float *w, int *len)
Definition write_routtines.c:519