iniebcsp.F File Reference

#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	iniebcsp (nseg, nod, iseg, ielem, irect, liste, la, iparg, elbuf_str, p0, x)

Function/Subroutine Documentation

iniebcsp()

subroutine iniebcsp	(	integer	nseg,
		integer	nod,
		integer, dimension(nseg)	iseg,
		integer, dimension(nseg)	ielem,
		integer, dimension(4,nseg)	irect,
		integer, dimension(nod)	liste,
			la,
		integer, dimension(nparg,*)	iparg,
		type (elbuf_struct_), target	elbuf_str,
			p0,
			x )

Definition at line 29 of file iniebcsp.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_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      "param_c.inc"
#include      "com01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NSEG,NOD,ISEG(NSEG),IRECT(4,NSEG),LISTE(NOD),IPARG(NPARG,*), IELEM(NSEG)
      my_real la(3,nod),p0(nod),x(3,*)
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N1,N2,N3,N4,I,N,IS,KSEG,NG1,NG2,NG3,NG4,ESEG,EAD,KTY,KLT,MFT,II(6)
      my_real  orient, fac, x13,y13,z13,x24,y24,z24, nx,ny,nz,p
      TYPE(G_BUFEL_)  ,POINTER :: GBUF     
C-----------------------------------------------
      gbuf => elbuf_str%GBUF
C   Initialisation de la surface nodale
          DO i=1,nod
            la(1,i)=zero
            la(2,i)=zero
            la(3,i)=zero
          ENDDO
C
          DO is=1,nseg
            
            kseg = abs(iseg(is))
            orient = zero
            IF(kseg /= 0)orient=float(iseg(is)/kseg)
 
            n1=irect(1,is)
            n2=irect(2,is)
            n3=irect(3,is)
            n4=irect(4,is)
 
            IF(n4==0 .OR. n4==n3) THEN
              fac=one_over_6*orient
              n4=n3
            ELSE
              fac=one_over_8*orient
            ENDIF
C   
            ng1=liste(n1)
            ng2=liste(n2)
            ng3=liste(n3)
            ng4=liste(n4)
            x13=x(1,ng3)-x(1,ng1)
            y13=x(2,ng3)-x(2,ng1)
            z13=x(3,ng3)-x(3,ng1)
            x24=x(1,ng4)-x(1,ng2)
            y24=x(2,ng4)-x(2,ng2)
            z24=x(3,ng4)-x(3,ng2)
c 
            nx=(y13*z24-z13*y24)*fac
            ny=(z13*x24-x13*z24)*fac
            nz=(x13*y24-y13*x24)*fac
c 
            la(1,n1)=la(1,n1)+nx
            la(2,n1)=la(2,n1)+ny
            la(3,n1)=la(3,n1)+nz
            la(1,n2)=la(1,n2)+nx
            la(2,n2)=la(2,n2)+ny
            la(3,n2)=la(3,n2)+nz
            la(1,n3)=la(1,n3)+nx
            la(2,n3)=la(2,n3)+ny
            la(3,n3)=la(3,n3)+nz 
C 
            IF(n4/=n3) THEN
              la(1,n4)=la(1,n4)+nx
              la(2,n4)=la(2,n4)+ny
              la(3,n4)=la(3,n4)+nz
            ENDIF
          ENDDO
C
C Calcul pression initiale nodale
C
          DO i=1,nod
            p0(i)=zero
          ENDDO
 
        mft = 0
        klt = 0
        kty = 0
        DO is=1,nseg
          kseg=abs(iseg(is))
          orient=zero
          IF(kseg /= 0)orient=float(iseg(is)/kseg)
c         pression voisin
          eseg=ielem(is)
          DO n=1,ngroup
            kty = iparg(5,n)
            klt = iparg(2,n)
            mft = iparg(3,n)
            IF (kty==1 .AND. eseg<=klt+mft) GOTO 60
          ENDDO
 60       CONTINUE
!
          DO i=1,6
            ii(i) = klt*(i-1)
          ENDDO
!
          ead = eseg-mft
          p = -(gbuf%SIG(ii(1)+ead)+gbuf%SIG(ii(2)+ead)+gbuf%SIG(ii(3)+ead))*third
 
c          write(6,*)'NG',N,KTY,KLT,MFT,IPARG(4,N)
c          write (6,*)'voisin',IS,KSEG,ESEG,P
c          write(6,*)'sig',(GBUF%SIG(EAD+I),I=1,3)
c
          n1=irect(1,is)
          n2=irect(2,is)
          n3=irect(3,is)
          n4=irect(4,is)
          IF(n4==0 .OR. n4==n3) THEN
            fac=one_over_6*orient
            n4=n3
          ELSE
            fac=one_over_8*orient
          ENDIF
c
          ng1=liste(n1)
          ng2=liste(n2)
          ng3=liste(n3)
          ng4=liste(n4)
          x13=x(1,ng3)-x(1,ng1)
          y13=x(2,ng3)-x(2,ng1)
          z13=x(3,ng3)-x(3,ng1)
          x24=x(1,ng4)-x(1,ng2)
          y24=x(2,ng4)-x(2,ng2)
          z24=x(3,ng4)-x(3,ng2)
c
          nx=(y13*z24-z13*y24)*fac
          ny=(z13*x24-x13*z24)*fac
          nz=(x13*y24-y13*x24)*fac
c
          p0(n1)=p0(n1)+p*(nx*la(1,n1)+ny*la(2,n1)+nz*la(3,n1))
          p0(n2)=p0(n2)+p*(nx*la(1,n2)+ny*la(2,n2)+nz*la(3,n2))
          p0(n3)=p0(n3)+p*(nx*la(1,n3)+ny*la(2,n3)+nz*la(3,n3))
          IF(n4/=n3) THEN
            p0(n4)=p0(n4)+p*(nx*la(1,n4)+ny*la(2,n4)+nz*la(3,n4))
          ENDIF
        ENDDO