OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
ssurftagigeo.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!|| ssurftagigeo ../starter/source/groups/ssurftagigeo.F
25!||--- called by ------------------------------------------------------
26!|| hm_read_surf ../starter/source/groups/hm_read_surf.F
27!||--- calls -----------------------------------------------------
28!|| ssurfigeo ../starter/source/groups/ssurftagigeo.F
29!||--- uses -----------------------------------------------------
30!||====================================================================
31 SUBROUTINE ssurftagigeo(IXIG3D,IPARTIG3D,KXIG3D,
32 . TAGBUF,NSEG ,
33 . IEXT ,FLAG ,IFRE ,KEY ,
34 . NSEGIGE,KNOT ,IGEO ,WIGE ,
35 . X,V,KNOD2ELIG3D,NOD2ELIG3D ,
36 . NIGE,RIGE,XIGE,VIGE,IADTABIGE,DECALIGEO,
37 . IGRSURF,KNOTLOCPC,KNOTLOCEL)
38C-----------------------------------------------
39C M o d u l e s
40C-----------------------------------------------
41 USE groupdef_mod
42 USE names_and_titles_mod , ONLY : ncharkey
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46#include "implicit_f.inc"
47#include "com04_c.inc"
48#include "param_c.inc"
49C-----------------------------------------------
50C D u m m y A r g u m e n t s
51C-----------------------------------------------
52 INTEGER TAGBUF(*),
53 . KXIG3D(NIXIG3D,*),IPARTIG3D(*),IXIG3D(*),
54 . KNOD2ELIG3D(*),NOD2ELIG3D(*),NIGE(*)
55 INTEGER IEXT,NSEG,FLAG,IFRE,NSEGIGE,IGEO(NPROPGI,*),IADTABIGE,DECALIGEO
56 CHARACTER(LEN=NCHARKEY) :: KEY
57 my_real
58 . x(3,*),v(3,*),wige(*),knot(*),rige(3,*),xige(3,*),vige(3,*),
59 . knotlocpc(*),knotlocel(2,3,*)
60!
61 TYPE (SURF_) :: IGRSURF
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER N,J,K,JS,KS,II,JJ,K1,K2,LL,NN,KK,I1,
66 . NI(4),NS(4),MI(4),MI2(4),MS(4),NMIN,MMIN,
67 . mf,nf,iperm,n1,n2,i,iseg
68 INTEGER NODTAG(NUMNOD),FACEIGEO(4,6),PWR(7),CROSSFACEIGEO(4,6),
69 . NNS,NCTRL,IPID,PX,PY,PZ,
70 . FASTAGIGEO(NUMELIG3D)
71 my_real
72 . knotlocelx(2),knotlocely(2),knotlocelz(2)
73 DATA pwr/1,2,4,8,16,32,64/
74C=======================================================================
75 fastagigeo=0
76C
77 IF(iext==1)THEN
78
79 mf=4
80 nf=4
81C
82C External surface only.
83 DO js=1,numelig3d
84
85 IF(key(1:6)=='GRBRIC')THEN
86 IF (tagbuf(js)==0) cycle !case of tagged elems
87 ELSE
88 IF (tagbuf(ipartig3d(js))==0) cycle !case of tagged parts
89 END IF
90
91 ipid = kxig3d(2,js)
92 px = igeo(41,ipid)-1
93 py = igeo(42,ipid)-1
94 pz = igeo(43,ipid)-1
95
96 faceigeo(1,1) = (px+1)*(py+1)*pz+px+1
97 faceigeo(2,1) = (px+1)*(py+1)*pz+1
98 faceigeo(3,1) = (px+1)*(py+1)*pz+(px+1)*py+1
99 faceigeo(4,1) = (px+1)*(py+1)*(pz+1)
100
101 faceigeo(1,2) = (px+1)*(py+1)
102 faceigeo(2,2) = (px+1)*py+1
103 faceigeo(3,2) = 1
104 faceigeo(4,2) = px+1
105
106 faceigeo(1,3) = (px+1)*(py+1)*(pz+1)
107 faceigeo(2,3) = (px+1)*(py+1)*pz+(px+1)*py+1
108 faceigeo(3,3) = (px+1)*py+1
109 faceigeo(4,3) = (px+1)*(py+1)
110
111 faceigeo(1,4) = (px+1)*(py+1)*pz+1
112 faceigeo(2,4) = (px+1)*(py+1)*pz+px+1
113 faceigeo(3,4) = px+1
114 faceigeo(4,4) = 1
115
116 faceigeo(1,5) = (px+1)*(py+1)*pz+(px+1)*py+1
117 faceigeo(2,5) = (px+1)*(py+1)*pz+1
118 faceigeo(3,5) = 1
119 faceigeo(4,5) = (px+1)*py+1
120
121 faceigeo(1,6) = (px+1)*(py+1)*(pz+1)
122 faceigeo(2,6) = (px+1)*(py+1)
123 faceigeo(3,6) = px+1
124 faceigeo(4,6) = (px+1)*(py+1)*pz+px+1
125
126 crossfaceigeo=0
127C
128 IF(px==2) THEN
129 crossfaceigeo(1,5) = (px+1)*(py+1)*pz+(px+1)*py+px ! milieu - devant
130 crossfaceigeo(2,5) = (px+1)*(py+1)*pz+px
131 crossfaceigeo(3,5) = px
132 crossfaceigeo(4,5) = (px+1)*py+px
133
134 crossfaceigeo(1,6) = (px+1)*(py+1)*pz+(px+1)*py+px ! milieu - derriere
135 crossfaceigeo(2,6) = (px+1)*py+px
136 crossfaceigeo(3,6) = px
137 crossfaceigeo(4,6) = (px+1)*(py+1)*pz+px
138 ENDIF
139
140 IF(py==2) THEN
141 crossfaceigeo(1,3) = (px+1)*(py+1)*pz+(px+1)*py ! milieu - gauche
142 crossfaceigeo(2,3) = (px+1)*(py+1)*pz+(px+1)+1
143 crossfaceigeo(3,3) = (px+1)+1
144 crossfaceigeo(4,3) = (px+1)*py
145
146 crossfaceigeo(1,4) = (px+1)*(py+1)*pz+(px+1)+1 ! milieu - droit
147 crossfaceigeo(2,4) = (px+1)*(py+1)*pz+(px+1)*py
148 crossfaceigeo(3,4) = (px+1)*py
149 crossfaceigeo(4,4) = (px+1)+1
150 ENDIF
151
152 IF(pz==2) THEN
153 crossfaceigeo(1,1) = (px+1)*(py+1)+px+1 ! milieu - bas
154 crossfaceigeo(2,1) = (px+1)*(py+1)+1
155 crossfaceigeo(3,1) = (px+1)*(py+1)+(px+1)*py+1
156 crossfaceigeo(4,1) = (px+1)*(py+1)*pz
157
158 crossfaceigeo(1,2) = (px+1)*(py+1)*pz ! milieu - haut
159 crossfaceigeo(2,2) = (px+1)*(py+1)+(px+1)*py+1
160 crossfaceigeo(3,2) = (px+1)*(py+1)+1
161 crossfaceigeo(4,2) = (px+1)*(py+1)+px+1
162 ENDIF
163
164CC positionnement des faces crees ici verifiees : ok
165
166 DO jj=1,6
167 DO ii=1,4 ! on va chercher les 4 coins de chaque face
168 ns(ii)=ixig3d(kxig3d(4,js)+faceigeo(ii,jj)-1)
169 END DO
170C
171C permute
172 nmin=ns(1)
173 DO ii=2,nf
174 nmin=min(nmin,ns(ii))
175 END DO
176 DO iperm=1,nf
177 IF(nmin==ns(iperm).AND.
178 . ns(mod(iperm,nf)+1)/=ns(iperm))THEN
179 DO ii=1,nf
180 ni(ii)=ns(mod(ii+iperm-2,nf)+1)
181 END DO
182 EXIT
183 END IF
184 END DO
185C
186C looks for an elt sharing the face.
187 DO k=knod2elig3d(ni(1))+1,knod2elig3d(ni(1)+1)
188 ks=nod2elig3d(k)
189 IF(ks==js)cycle
190 IF (key(1:6)=='GRBRIC'.AND.tagbuf(ks)==0.AND.ifre==0)cycle ! if IFRE=0 on cherche la connectivite uniquement avec les elements du marques du groupe (cycle), sinon si IFRE=1 on cherche la connectivite avec tout le monde
191 IF (key(1:6)/='GRBRIC'.AND.tagbuf(ipartig3d(ks))==0)cycle
192 DO ii=1,nf
193 nodtag(ni(ii))=0
194 END DO
195 nctrl = kxig3d(3,js)
196 DO ii=1,nctrl
197 nodtag(ixig3d(kxig3d(4,ks)+ii-1))=1
198 END DO
199 nn=0
200 DO ii=1,nf
201 nn=nn+nodtag(ni(ii))
202 END DO
203 IF(nn==nf)THEN ! il faut que la face ait 4 points en commun avec uen autre pour eventuellement etre exclue
204 DO kk=1,6
205 DO ii=1,4
206 ms(ii)=ixig3d(kxig3d(4,ks)+faceigeo(ii,kk)-1)
207 END DO
208C
209C permute
210 mmin=ms(1)
211 DO ii=2,mf
212 mmin=min(mmin,ms(ii))
213 END DO
214 DO iperm=1,mf
215 IF(mmin==ms(iperm).AND.
216 . ms(mod(iperm,mf)+1)/=ms(iperm))THEN
217 DO ii=1,mf
218 mi(ii)=ms(mod(ii+iperm-2,mf)+1)
219 END DO
220 EXIT
221 END IF
222 END DO
223C
224 IF(crossfaceigeo(1,kk)/=0) THEN
225 DO ii=1,4
226 ms(ii)=ixig3d(kxig3d(4,ks)+crossfaceigeo(ii,kk)-1)
227 END DO
228C
229C permute
230 mmin=ms(1)
231 DO ii=2,mf
232 mmin=min(mmin,ms(ii))
233 END DO
234 DO iperm=1,mf
235 IF(mmin==ms(iperm).AND.
236 . ms(mod(iperm,mf)+1)/=ms(iperm))THEN
237 DO ii=1,mf
238 mi2(ii)=ms(mod(ii+iperm-2,mf)+1)
239 END DO
240 EXIT
241 END IF
242 END DO
243 ENDIF
244C
245 IF((mi(1)==ni(1).AND.mi(nf)==ni(2)).OR.
246 . (mi2(1)==ni(1).AND.mi2(nf)==ni(2)))THEN
247C FACTAGIGEO(JS) moins face jj
248 fastagigeo(js)=fastagigeo(js)+pwr(jj) ! lorsqu'on ajoute PWR(JJ), on exclue la face JJ
249 GO TO 400
250 END IF
251 END DO
252 END IF
253 END DO
254 400 CONTINUE
255 END DO
256 END DO
257
258 END IF
259
260C-----------
261 DO j=1,numelig3d
262 IF (iabs(tagbuf(ipartig3d(j))) == 1) THEN
263 ll=fastagigeo(j)
264 ipid = kxig3d(2,j)
265 knotlocelx(1) = knotlocel(1,1,j)
266 knotlocely(1) = knotlocel(1,2,j)
267 knotlocelz(1) = knotlocel(1,3,j)
268 knotlocelx(2) = knotlocel(2,1,j)
269 knotlocely(2) = knotlocel(2,2,j)
270 knotlocelz(2) = knotlocel(2,3,j)
271 DO jj=1,6
272 IF(mod(ll,pwr(jj+1))/pwr(jj) /= 0)cycle
273 nctrl = kxig3d(3,j)
274 px = igeo(41,ipid)
275 py = igeo(42,ipid)
276 pz = igeo(43,ipid)
277!! IF(FLAG == 0) THEN
278!! ELSEIF(FLAG == 1)THEN
279 IF(flag == 1)THEN
280 CALL ssurfigeo(j,101,
281 . kxig3d,ixig3d,nctrl,x,v,wige,
282 . knot,igeo,decaligeo,jj,nige,rige,xige,vige,iadtabige,
283 . igrsurf,nsegige,px,py,pz,knotlocpc,knotlocelx,
284 . knotlocely,knotlocelz)
285 decaligeo=decaligeo+16
286 ELSE
287 nsegige = nsegige + 9 ! 9 = Anciennement NIGEOCUT
288 ENDIF
289 ENDDO
290 ENDIF
291 ENDDO
292C-----------
293 RETURN
294 END
295
296!||====================================================================
297!|| ssurfigeo ../starter/source/groups/ssurftagigeo.F
298!||--- called by ------------------------------------------------------
299!|| ssurftagigeo ../starter/source/groups/ssurftagigeo.F
300!||--- calls -----------------------------------------------------
301!|| ig3donebasis ../starter/source/elements/ige3d/ig3donebasis.F
302!||--- uses -----------------------------------------------------
303!||====================================================================
304 SUBROUTINE ssurfigeo(JS,IELTYP,
305 . KXIG3D,IXIG3D,NCTRL,X,V,WIGE,
306 . KNOT,IGEO,DECALIGEO,JJ,NIGE,RIGE,XIGE,VIGE,IADTABIGE,
307 . IGRSURF,NSEGIGE,PX,PY,PZ,KNOTLOCPC,KNOTLOCELX,
308 . KNOTLOCELY,KNOTLOCELZ)
309C-----------------------------------------------
310C M o d u l e s
311C-----------------------------------------------
312 USE groupdef_mod
313C-----------------------------------------------
314C I m p l i c i t T y p e s
315C-----------------------------------------------
316#include "implicit_f.inc"
317C-----------------------------------------------
318C C o m m o n B l o c k s
319C-----------------------------------------------
320#include "param_c.inc"
321#include "com04_c.inc"
322#include "ige3d_c.inc"
323C-----------------------------------------------
324C D u m m y A r g u m e n t s
325C-----------------------------------------------
326 INTEGER JJ,IELTYP,NCTRL,DECALIGEO,
327 1 IADPART,IADTABIGE,
328 2 KXIG3D(NIXIG3D,*),JS,IXIG3D(*),IGEO(NPROPGI,*),NIGE(*),
329 3 NSEGIGE,PX,PY,PZ
330 my_real
331 . X(3,*),V(3,*),WIGE(*),KNOT(*),RIGE(3,*),XIGE(3,*),VIGE(3,*),
332 . KNOTLOCPC(DEG_MAX,3,*),KNOTLOCELX(2),KNOTLOCELY(2),KNOTLOCELZ(2)
333!
334 TYPE (SURF_) :: IGRSURF
335C-----------------------------------------------
336C L o c a l V a r i a b l e s
337C-----------------------------------------------
338 INTEGER J,K,L,M,N,IAD_KNOT,N1,N2,N3,
339 . NKNOT1,NKNOT2,NKNOT3,IDX,IDY,IDZ,IPID,ISEG,ITNCTRL,
340 . idfrstlocknt, idpc,idx2,idy2,idz2
341 my_real
342 . x_igeo(nctrl),y_igeo(nctrl),z_igeo(nctrl),
343 . vx_igeo(nctrl),vy_igeo(nctrl),vz_igeo(nctrl),
344 . w_igeo(nctrl),xi,yi,zi,zr,zs,zt,
345 . pasx,pasy,pasz,r(nctrl),vxi,vyi,vzi,
346 . knotlocx(px+1,nctrl),
347 . knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl)
348C=======================================================================
349
350 DO n=1,3
351 DO m=1,3
352!---
353 nsegige = nsegige + 1
354 iseg = nsegige
355 igrsurf%NODES_IGE(iseg,1) = numnod + decaligeo + 1 +(m-1)+4*(n-1)
356 igrsurf%NODES_IGE(iseg,2) = numnod + decaligeo + 1 + m +4*(n-1)
357 igrsurf%NODES_IGE(iseg,3) = numnod + decaligeo + 1 + m +4*n
358 igrsurf%NODES_IGE(iseg,4) = numnod + decaligeo + 1 +(m-1)+4*n
359!
360 igrsurf%ELTYP_IGE(iseg) = ieltyp
361 igrsurf%ELEM_IGE(iseg) = js
362!---
363 ENDDO
364 ENDDO
365
366 DO j=1,nctrl
367 x_igeo(j)=x(1,ixig3d(kxig3d(4,js)+j-1))
368 y_igeo(j)=x(2,ixig3d(kxig3d(4,js)+j-1))
369 z_igeo(j)=x(3,ixig3d(kxig3d(4,js)+j-1))
370 vx_igeo(j)=v(1,ixig3d(kxig3d(4,js)+j-1))
371 vy_igeo(j)=v(2,ixig3d(kxig3d(4,js)+j-1))
372 vz_igeo(j)=v(3,ixig3d(kxig3d(4,js)+j-1))
373 w_igeo(j)=1!WIGE(IXIG3D(KXIG3D(4,JS)+J-1))
374 ENDDO
375
376 ipid=kxig3d(2,js)
377 iad_knot = igeo(40,ipid)
378 n1 = igeo(44,ipid)
379 n2 = igeo(45,ipid)
380 n3 = igeo(46,ipid)
381 idfrstlocknt = igeo(47,ipid)
382 nknot1 = n1+px
383 nknot2 = n2+py
384 nknot3 = n3+pz
385 idx = kxig3d(6,js)
386 idy = kxig3d(7,js)
387 idz = kxig3d(8,js)
388 idx2 = kxig3d(9,js)
389 idy2 = kxig3d(10,js)
390 idz2 = kxig3d(11,js)
391
392 DO j=1,nctrl
393 DO k=1,px+1
394 knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
395 ENDDO
396 DO k=1,py+1
397 knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
398 ENDDO
399 DO k=1,pz+1
400 knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
401 ENDDO
402 ENDDO
403
404cc PASX = (KNOT(IAD_KNOT+IDX+1) - KNOT(IAD_KNOT+IDX)) / THREE
405cc PASY = (KNOT(IAD_KNOT+NKNOT1+1+IDY) - KNOT(IAD_KNOT+NKNOT1+IDY)) / THREE
406cc PASZ = (KNOT(IAD_KNOT+NKNOT1+NKNOT2+1+IDZ) - KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ)) / THREE
407c PASX = (KNOT(IAD_KNOT+IDX2) - KNOT(IAD_KNOT+IDX)) / THREE
408c PASY = (KNOT(IAD_KNOT+NKNOT1+IDY2) - KNOT(IAD_KNOT+NKNOT1+IDY)) / THREE
409c PASZ = (KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ2) - KNOT(IAD_KNOT+NKNOT1+NKNOT2+IDZ)) / THREE
410 pasx = (knotlocelx(2) - knotlocelx(1)) / three
411 pasy = (knotlocely(2) - knotlocely(1)) / three
412 pasz = (knotlocelz(2) - knotlocelz(1)) / three
413
414 IF (jj==1) THEN
415
416 DO m=1,4
417 DO l=1,4
418
419 xi = zero
420 yi = zero
421 zi = zero
422 vxi = zero
423 vyi = zero
424 vzi = zero
425
426 zr = knotlocelx(1) + (l-1)*pasx
427 zs = knotlocely(1) + (m-1)*pasy
428 zt = knotlocelz(1)
429
430c CALL IG3DBASIS(
431c 1 JS ,N ,X_IGEO ,Y_IGEO , !! N NE VEUT RIEN DIRE ICI
432c 2 Z_IGEO ,W_IGEO ,IDX ,IDY ,
433c 3 IDZ ,R ,
434c 4 NCTRL ,ZR ,ZS ,ZT ,
435c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
436c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
437c 7 PY-1 ,PZ-1 ,0)
438
439 CALL ig3donebasis(
440 1 js ,n ,x_igeo ,y_igeo,
441 2 z_igeo,w_igeo ,idx ,idy ,
442 3 idz ,knotlocx ,knotlocy,knotlocz,
443 4 r ,nctrl ,
444 5 zr ,zs ,zt ,knot(iad_knot+1),
445 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
446 7 py-1 ,pz-1 ,0 ,
447 8 idx2,idy2 ,idz2 ,
448 9 knotlocelx,knotlocely,knotlocelz)
449
450 DO j=1,nctrl
451 xi = xi + r(j)*x_igeo(j)
452 yi = yi + r(j)*y_igeo(j)
453 zi = zi + r(j)*z_igeo(j)
454 vxi = vxi + r(j)*vx_igeo(j)
455 vyi = vyi + r(j)*vy_igeo(j)
456 vzi = vzi + r(j)*vz_igeo(j)
457 ENDDO
458
459 iadtabige=iadtabige+1
460
461 nige(iadtabige)=js
462
463 rige(1,iadtabige)=zr
464 rige(2,iadtabige)=zs
465 rige(3,iadtabige)=zt
466
467 xige(1,iadtabige)=xi
468 xige(2,iadtabige)=yi
469 xige(3,iadtabige)=zi
470
471 vige(1,iadtabige)=vxi
472 vige(2,iadtabige)=vyi
473 vige(3,iadtabige)=vzi
474
475 ENDDO
476 ENDDO
477
478 ELSEIF (jj==2) THEN
479
480 DO m=1,4
481 DO l=1,4
482
483 xi = zero
484 yi = zero
485 zi = zero
486 vxi = zero
487 vyi = zero
488 vzi = zero
489
490 zr = knotlocelx(1) + (l-1)*pasx
491 zs = knotlocely(1) + (m-1)*pasy
492 zt = knotlocelz(2)
493
494c CALL IG3DBASIS(
495c 1 JS ,N ,X_IGEO ,Y_IGEO ,
496c 2 Z_IGEO ,W_IGEO ,IDX ,IDY ,
497c 3 IDZ ,R ,
498c 4 NCTRL ,ZR ,ZS ,ZT ,
499c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
500c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
501c 7 PY-1 ,PZ-1 ,0)
502
503 CALL ig3donebasis(
504 1 js ,n ,x_igeo ,y_igeo,
505 2 z_igeo,w_igeo ,idx ,idy ,
506 3 idz ,knotlocx ,knotlocy,knotlocz,
507 4 r ,nctrl ,
508 5 zr ,zs ,zt ,knot(iad_knot+1),
509 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
510 7 py-1 ,pz-1 ,0 ,
511 8 idx2,idy2 ,idz2 ,
512 9 knotlocelx,knotlocely,knotlocelz)
513
514 DO j=1,nctrl
515 xi = xi + r(j)*x_igeo(j)
516 yi = yi + r(j)*y_igeo(j)
517 zi = zi + r(j)*z_igeo(j)
518 vxi = vxi + r(j)*vx_igeo(j)
519 vyi = vyi + r(j)*vy_igeo(j)
520 vzi = vzi + r(j)*vz_igeo(j)
521 ENDDO
522
523 iadtabige=iadtabige+1
524
525 nige(iadtabige)=js
526
527 rige(1,iadtabige)=zr
528 rige(2,iadtabige)=zs
529 rige(3,iadtabige)=zt
530
531 xige(1,iadtabige)=xi
532 xige(2,iadtabige)=yi
533 xige(3,iadtabige)=zi
534
535 vige(1,iadtabige)=vxi
536 vige(2,iadtabige)=vyi
537 vige(3,iadtabige)=vzi
538
539 ENDDO
540 ENDDO
541
542 ELSEIF (jj==3) THEN
543
544 DO n=1,4
545 DO l=1,4
546
547 xi = zero
548 yi = zero
549 zi = zero
550 vxi = zero
551 vyi = zero
552 vzi = zero
553
554 zr = knotlocelx(1) + (l-1)*pasx
555 zs = knotlocely(1)
556 zt = knotlocelz(1) + (n-1)*pasz
557
558c CALL IG3DBASIS(
559c 1 JS ,N ,X_IGEO ,Y_IGEO ,
560c 2 Z_IGEO ,W_IGEO ,IDX ,IDY ,
561c 3 IDZ ,R ,
562c 4 NCTRL ,ZR ,ZS ,ZT ,
563c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
564c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
565c 7 PY-1 ,PZ-1 ,0)
566
567 CALL ig3donebasis(
568 1 js ,n ,x_igeo ,y_igeo,
569 2 z_igeo,w_igeo ,idx ,idy ,
570 3 idz ,knotlocx ,knotlocy,knotlocz,
571 4 r ,nctrl ,
572 5 zr ,zs ,zt ,knot(iad_knot+1),
573 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
574 7 py-1 ,pz-1 ,0 ,
575 8 idx2,idy2 ,idz2 ,
576 9 knotlocelx,knotlocely,knotlocelz)
577
578 DO j=1,nctrl
579 xi = xi + r(j)*x_igeo(j)
580 yi = yi + r(j)*y_igeo(j)
581 zi = zi + r(j)*z_igeo(j)
582 vxi = vxi + r(j)*vx_igeo(j)
583 vyi = vyi + r(j)*vy_igeo(j)
584 vzi = vzi + r(j)*vz_igeo(j)
585 ENDDO
586
587 iadtabige=iadtabige+1
588
589 nige(iadtabige)=js
590
591 rige(1,iadtabige)=zr
592 rige(2,iadtabige)=zs
593 rige(3,iadtabige)=zt
594
595 xige(1,iadtabige)=xi
596 xige(2,iadtabige)=yi
597 xige(3,iadtabige)=zi
598
599 vige(1,iadtabige)=vxi
600 vige(2,iadtabige)=vyi
601 vige(3,iadtabige)=vzi
602
603 ENDDO
604 ENDDO
605
606 ELSEIF (jj==4) THEN
607
608 DO n=1,4
609 DO l=1,4
610
611 xi = zero
612 yi = zero
613 zi = zero
614 vxi = zero
615 vyi = zero
616 vzi = zero
617
618 zr = knotlocelx(1) + (l-1)*pasx
619 zs = knotlocely(2)
620 zt = knotlocelz(1) + (n-1)*pasz
621
622c CALL IG3DBASIS(
623c 1 JS ,N ,X_IGEO ,Y_IGEO ,
624c 2 Z_IGEO ,W_IGEO ,IDX ,IDY ,
625c 3 IDZ ,R ,
626c 4 NCTRL ,ZR ,ZS ,ZT ,
627c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
628c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
629c 7 PY-1 ,PZ-1 ,0)
630
631 CALL ig3donebasis(
632 1 js ,n ,x_igeo ,y_igeo,
633 2 z_igeo,w_igeo ,idx ,idy ,
634 3 idz ,knotlocx ,knotlocy,knotlocz,
635 4 r ,nctrl ,
636 5 zr ,zs ,zt ,knot(iad_knot+1),
637 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
638 7 py-1 ,pz-1 ,0 ,
639 8 idx2,idy2 ,idz2 ,
640 9 knotlocelx,knotlocely,knotlocelz)
641
642 DO j=1,nctrl
643 xi = xi + r(j)*x_igeo(j)
644 yi = yi + r(j)*y_igeo(j)
645 zi = zi + r(j)*z_igeo(j)
646 vxi = vxi + r(j)*vx_igeo(j)
647 vyi = vyi + r(j)*vy_igeo(j)
648 vzi = vzi + r(j)*vz_igeo(j)
649 ENDDO
650
651 iadtabige=iadtabige+1
652
653 nige(iadtabige)=js
654
655 rige(1,iadtabige)=zr
656 rige(2,iadtabige)=zs
657 rige(3,iadtabige)=zt
658
659 xige(1,iadtabige)=xi
660 xige(2,iadtabige)=yi
661 xige(3,iadtabige)=zi
662
663 vige(1,iadtabige)=vxi
664 vige(2,iadtabige)=vyi
665 vige(3,iadtabige)=vzi
666
667 ENDDO
668 ENDDO
669
670 ELSEIF (jj==5) THEN
671
672 DO n=1,4
673 DO m=1,4
674
675 xi = zero
676 yi = zero
677 zi = zero
678 vxi = zero
679 vyi = zero
680 vzi = zero
681
682 zr = knotlocelx(2)
683 zs = knotlocely(1) + (m-1)*pasy
684 zt = knotlocelz(1) + (n-1)*pasz
685
686c CALL IG3DBASIS(
687c 1 JS ,N ,X_IGEO ,Y_IGEO ,
688c 2 Z_IGEO ,W_IGEO ,IDX ,IDY ,
689c 3 IDZ ,R ,
690c 4 NCTRL ,ZR ,ZS ,ZT ,
691c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
692c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
693c 7 PY-1 ,PZ-1 ,0)
694
695 CALL ig3donebasis(
696 1 js ,n ,x_igeo ,y_igeo,
697 2 z_igeo,w_igeo ,idx ,idy ,
698 3 idz ,knotlocx ,knotlocy,knotlocz,
699 4 r ,nctrl ,
700 5 zr ,zs ,zt ,knot(iad_knot+1),
701 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
702 7 py-1 ,pz-1 ,0 ,
703 8 idx2,idy2 ,idz2 ,
704 9 knotlocelx,knotlocely,knotlocelz)
705
706 DO j=1,nctrl
707 xi = xi + r(j)*x_igeo(j)
708 yi = yi + r(j)*y_igeo(j)
709 zi = zi + r(j)*z_igeo(j)
710 vxi = vxi + r(j)*vx_igeo(j)
711 vyi = vyi + r(j)*vy_igeo(j)
712 vzi = vzi + r(j)*vz_igeo(j)
713 ENDDO
714
715 iadtabige=iadtabige+1
716
717 nige(iadtabige)=js
718
719 rige(1,iadtabige)=zr
720 rige(2,iadtabige)=zs
721 rige(3,iadtabige)=zt
722
723 xige(1,iadtabige)=xi
724 xige(2,iadtabige)=yi
725 xige(3,iadtabige)=zi
726
727 vige(1,iadtabige)=vxi
728 vige(2,iadtabige)=vyi
729 vige(3,iadtabige)=vzi
730
731 ENDDO
732 ENDDO
733
734 ELSEIF (jj==6) THEN
735
736 DO n=1,4
737 DO m=1,4
738
739 xi = zero
740 yi = zero
741 zi = zero
742 vxi = zero
743 vyi = zero
744 vzi = zero
745
746 zr = knotlocelx(1)
747 zs = knotlocely(1) + (m-1)*pasy
748 zt = knotlocelz(1) + (n-1)*pasz
749
750c CALL IG3DBASIS(
751c 1 JS ,N ,X_IGEO ,Y_IGEO ,
752c 2 Z_IGEO ,W_IGEO ,IDX ,IDY ,
753c 3 IDZ ,R ,
754c 4 NCTRL ,ZR ,ZS ,ZT ,
755c 5 KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
756c 6 KNOT(IAD_KNOT+NKNOT1+NKNOT2+1) ,PX-1 ,
757c 7 PY-1 ,PZ-1 ,0)
758
759 CALL ig3donebasis(
760 1 js ,n ,x_igeo ,y_igeo,
761 2 z_igeo,w_igeo ,idx ,idy ,
762 3 idz ,knotlocx ,knotlocy,knotlocz,
763 4 r ,nctrl ,
764 5 zr ,zs ,zt ,knot(iad_knot+1),
765 6 knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1,
766 7 py-1 ,pz-1 ,0 ,
767 8 idx2,idy2 ,idz2 ,
768 9 knotlocelx,knotlocely,knotlocelz)
769
770 DO j=1,nctrl
771 xi = xi + r(j)*x_igeo(j)
772 yi = yi + r(j)*y_igeo(j)
773 zi = zi + r(j)*z_igeo(j)
774 vxi = vxi + r(j)*vx_igeo(j)
775 vyi = vyi + r(j)*vy_igeo(j)
776 vzi = vzi + r(j)*vz_igeo(j)
777 ENDDO
778
779 iadtabige=iadtabige+1
780
781 nige(iadtabige)=js
782
783 rige(1,iadtabige)=zr
784 rige(2,iadtabige)=zs
785 rige(3,iadtabige)=zt
786
787 xige(1,iadtabige)=xi
788 xige(2,iadtabige)=yi
789 xige(3,iadtabige)=zi
790
791 vige(1,iadtabige)=vxi
792 vige(2,iadtabige)=vyi
793 vige(3,iadtabige)=vzi
794
795 ENDDO
796 ENDDO
797
798 ENDIF
799C-----------
800 RETURN
801 END
802C
803!||====================================================================
804!|| fictivmassigeo ../starter/source/groups/ssurftagigeo.F
805!||--- called by ------------------------------------------------------
806!|| lectur ../starter/source/starter/lectur.F
807!||--- uses -----------------------------------------------------
808!||====================================================================
809 SUBROUTINE fictivmassigeo(INTBUF_TAB,NCTRLMAX,MSIG3D,KXIG3D)
810C-----------------------------------------------
811C M o d u l e s
812C-----------------------------------------------
813 USE intbufdef_mod
814C-----------------------------------------------
815C I m p l i c i t T y p e s
816C-----------------------------------------------
817#include "implicit_f.inc"
818C-----------------------------------------------
819C C o m m o n B l o c k s
820C-----------------------------------------------
821#include "param_c.inc"
822#include "com04_c.inc"
823C-----------------------------------------------
824C D u m m y A r g u m e n t s
825C-----------------------------------------------
826 INTEGER KXIG3D(NIXIG3D,*),NCTRLMAX
827 my_real
828 . MSIG3D(NUMELIG3D,*)
829 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
830C-----------------------------------------------
831C L o c a l V a r i a b l e s
832C-----------------------------------------------
833 INTEGER N,I,J,NUMEL,NUMPT
834 my_real
835 . MASSELIG3D(NUMELIG3D)
836C=======================================================================
837C
838 DO n=1,ninter
839 intbuf_tab(n)%MASSIGE(:)=0
840 ENDDO
841 masselig3d(:)=0
842C
843 DO i=1,numelig3d
844 DO j=1,nctrlmax
845 masselig3d(i)=masselig3d(i)+msig3d(i,j) !! num locale ici et pas globale I a la place de kxigi3D(I)
846 ENDDO
847 ENDDO
848C
849 DO n=1,ninter !!! regarder la repartition de la masse sur les points fictifs (masse + importante sur les coins et les arretes)
850 DO i=1,intbuf_tab(n)%S_NIGE
851 numel = intbuf_tab(n)%NIGE(i)
852 intbuf_tab(n)%MASSIGE(i)=intbuf_tab(n)%MASSIGE(i)+
853 + masselig3d(numel)/(27*4)
854 ENDDO
855 ENDDO
856
857c TEST=0
858c DO N=1,NINTER
859c DO I=1,INTBUF_TAB(N)%S_NIGE
860c TEST = TEST + INTBUF_TAB(N)%MASSIGE(I)
861c ENDDO
862c ENDDO
863c PRINT*, 'masse totale', TEST
864
865C-----------
866 RETURN
867 END
min
#define min(a, b)
Definition macros.h:20
groupdef_mod
Definition groupdef_mod.F:662
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
fictivmassigeo
subroutine fictivmassigeo(intbuf_tab, nctrlmax, msig3d, kxig3d)
Definition ssurftagigeo.F:810
ssurfigeo
subroutine ssurfigeo(js, ieltyp, kxig3d, ixig3d, nctrl, x, v, wige, knot, igeo, decaligeo, jj, nige, rige, xige, vige, iadtabige, igrsurf, nsegige, px, py, pz, knotlocpc, knotlocelx, knotlocely, knotlocelz)
Definition ssurftagigeo.F:309
ssurftagigeo
subroutine ssurftagigeo(ixig3d, ipartig3d, kxig3d, tagbuf, nseg, iext, flag, ifre, key, nsegige, knot, igeo, wige, x, v, knod2elig3d, nod2elig3d, nige, rige, xige, vige, iadtabige, decaligeo, igrsurf, knotlocpc, knotlocel)
Definition ssurftagigeo.F:38
ig3donebasis
subroutine ig3donebasis(itel, n, xxi, yyi, zzi, wwi, idx, idy, idz, knotlocx, knotlocy, knotlocz, r, nctrl, gaussx, gaussy, gaussz, kx, ky, kz, px, py, pz, boolg, idx2, idy2, idz2, knotlocelx, knotlocely, knotlocelz)
Definition ig3donebasis.F:42