deplafakeige.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "ige3d_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	deplafakeige (x, v, intbuf_tab, kxig3d, ixig3d, igeo, knot, wige, knotlocpc, knotlocel)

Function/Subroutine Documentation

deplafakeige()

subroutine deplafakeige	(		x,
			v,
		type(intbuf_struct_), dimension(*)	intbuf_tab,
		integer, dimension(nixig3d,*)	kxig3d,
		integer, dimension(*)	ixig3d,
		integer, dimension(npropgi,*)	igeo,
			knot,
			wige,
			knotlocpc,
			knotlocel )

Definition at line 32 of file deplafakeige.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE intbufdef_mod
C-------------------------------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "ige3d_c.inc"
C-----------------------------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER KXIG3D(NIXIG3D,*),IGEO(NPROPGI,*), IXIG3D(*)
C     REAL
      my_real
     .   x(3,*) ,v(3,*), knot(*), wige(*),knotlocpc(deg_max,3,*),
     .   knotlocel(2,3,*)
      TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER  I,K,N,J,JS,NCTRL, IPID, N1, N2, N3,
     .         PX, PY, PZ, IDX, IDY, IDZ, IDX2, IDY2, IDZ2, IAD_KNOT
      my_real
     .   xi, yi, zi, vxi, vyi, vzi,zr, zs, zt
      INTEGER  NKNOT1,NKNOT2,NKNOT3
      my_real
     .   x_igeo(64),y_igeo(64),z_igeo(64),
     .   vx_igeo(64),vy_igeo(64),vz_igeo(64),
     .   w_igeo(64),r(64)
      my_real
     .   knotlocelx(2),
     .   knotlocely(2),knotlocelz(2)
      my_real, DIMENSION(:,:),ALLOCATABLE ::
     .   knotlocx,knotlocy,knotlocz
C-------------------------------------------------------------
C         CALCUL DES DEPLACEMENTS TRANSLATIONS DES POINTS FICTIFS IGEO
C-------------------------------------------------------------
c
      DO n=1,ninter
        DO i=1,intbuf_tab(n)%S_NIGE
 
          js=intbuf_tab(n)%NIGE(i)  ! numero local de l'element IGE
 
          knotlocelx(1) = knotlocel(1,1,js)
          knotlocely(1) = knotlocel(1,2,js)
          knotlocelz(1) = knotlocel(1,3,js)
          knotlocelx(2) = knotlocel(2,1,js)
          knotlocely(2) = knotlocel(2,2,js)
          knotlocelz(2) = knotlocel(2,3,js)
 
          nctrl = kxig3d(3,js)
          ipid=kxig3d(2,js)
          iad_knot = igeo(40,ipid)
          px = igeo(41,ipid)
          py = igeo(42,ipid)
          pz = igeo(43,ipid)
 
          ALLOCATE (knotlocx(px+1,nctrl),knotlocy(py+1,nctrl),knotlocz(pz+1,nctrl))
 
          DO j=1,nctrl
            x_igeo(j)=x(1,ixig3d(kxig3d(4,js)+j-1))
            y_igeo(j)=x(2,ixig3d(kxig3d(4,js)+j-1))
            z_igeo(j)=x(3,ixig3d(kxig3d(4,js)+j-1))
            vx_igeo(j)=v(1,ixig3d(kxig3d(4,js)+j-1))
            vy_igeo(j)=v(2,ixig3d(kxig3d(4,js)+j-1))
            vz_igeo(j)=v(3,ixig3d(kxig3d(4,js)+j-1))
            w_igeo(j)=wige(ixig3d(kxig3d(4,js)+j-1))
 
            DO k=1,px+1
              knotlocx(k,j)=knotlocpc(k,1,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
            ENDDO
            DO k=1,py+1
              knotlocy(k,j)=knotlocpc(k,2,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
            ENDDO
            DO k=1,pz+1
              knotlocz(k,j)=knotlocpc(k,3,(ipid-1)*numnod+ixig3d(kxig3d(4,js)+j-1))
            ENDDO
 
          ENDDO
          n1 = igeo(44,ipid)
          n2 = igeo(45,ipid)
          n3 = igeo(46,ipid)
          nknot1 = n1+px
          nknot2 = n2+py
          nknot3 = n3+pz
          idx = kxig3d(6,js)
          idy = kxig3d(7,js)
          idz = kxig3d(8,js)
          idx2 = kxig3d(9,js)
          idy2 = kxig3d(10,js)
          idz2 = kxig3d(11,js)
C
          xi = zero
          yi = zero
          zi = zero
          vxi = zero
          vyi = zero
          vzi = zero
          zr = intbuf_tab(n)%RIGE(3*(i-1)+1)
          zs = intbuf_tab(n)%RIGE(3*(i-1)+2)
          zt = intbuf_tab(n)%RIGE(3*(i-1)+3)
C
c         CALL IGE3DBASIS(
c     1        JS        ,N         ,X_IGEO    ,Y_IGEO  ,
c     2        Z_IGEO    ,W_IGEO    ,IDX       ,IDY     ,
c     3        IDZ       ,R         ,
c     4        NCTRL     ,ZR        ,ZS        ,ZT      ,
c     5        KNOT(IAD_KNOT+1) ,KNOT(IAD_KNOT+NKNOT1+1),
c     6        KNOT(IAD_KNOT+NKNOT1+NKNOT2+1)  ,PX-1    , 
c     7        PY-1      ,PZ-1      ,0)
 
          CALL ig3donebasis(
     1      js     ,n        ,x_igeo  ,y_igeo,
     2      z_igeo,w_igeo    ,idx   ,idy ,
     3      idz ,knotlocx ,knotlocy,knotlocz,
     4      r          ,nctrl  ,
     5      zr  ,zs      ,zt   ,knot(iad_knot+1),
     6      knot(iad_knot+nknot1+1),knot(iad_knot+nknot1+nknot2+1),px-1, 
     7      py-1   ,pz-1       ,0        ,
     8      idx2,idy2    ,idz2   ,
     9      knotlocelx,knotlocely,knotlocelz)
C
         DO j=1,nctrl
c           print*,'R', R(J)
           xi = xi + r(j)*x_igeo(j)
           yi = yi + r(j)*y_igeo(j)
           zi = zi + r(j)*z_igeo(j)
           vxi = vxi + r(j)*vx_igeo(j)
           vyi = vyi + r(j)*vy_igeo(j)
           vzi = vzi + r(j)*vz_igeo(j)
         ENDDO
         intbuf_tab(n)%XIGE(3*(i-1)+1)=xi
         intbuf_tab(n)%XIGE(3*(i-1)+2)=yi
         intbuf_tab(n)%XIGE(3*(i-1)+3)=zi
         intbuf_tab(n)%VIGE(3*(i-1)+1)=vxi
         intbuf_tab(n)%VIGE(3*(i-1)+2)=vyi
         intbuf_tab(n)%VIGE(3*(i-1)+3)=vzi
         DEALLOCATE (knotlocx,knotlocy,knotlocz)
         ENDDO
      ENDDO
C
      RETURN