section_skew.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	section_skew (n1, n2, n3, x, xxc, yyc, zzc, xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6, xxn, yyn, zzn, ifram, nnod, nod, ms)

Function/Subroutine Documentation

section_skew()

subroutine section_skew	(	integer	n1,
		integer	n2,
		integer	n3,
			x,
			xxc,
			yyc,
			zzc,
			xx4,
			yy4,
			zz4,
			xx5,
			yy5,
			zz5,
			xx6,
			yy6,
			zz6,
			xxn,
			yyn,
			zzn,
		integer	ifram,
		integer	nnod,
		integer, dimension(*)	nod,
			ms )

Definition at line 36 of file section_skew.F.

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      "comlock.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER N1, N2, N3, NNOD,IFRAM, NOD(*)
      my_real x(3,*),xxc, yyc, zzc,
     .        xx4, yy4, zz4, xx5, yy5, zz5, xx6, yy6, zz6,
     .        xxn, yyn, zzn, ms(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I, N
      my_real xx1, yy1, zz1, xx2, yy2, zz2, xx3, yy3, zz3, al4, al6, al5, d13, mas, x1n, y1n, z1n
C-----------------------------------------------
C   B o d y
C-----------------------------------------------
      IF(ifram<10)THEN
C      MOMENTUM (SKEW N1 N2 N3)
       xx1=x(1,n1)
       yy1=x(2,n1)
       zz1=x(3,n1)
       xx2=x(1,n2)
       yy2=x(2,n2)
       zz2=x(3,n2)
       xx3=x(1,n3)
       yy3=x(2,n3)
       zz3=x(3,n3)
       xx4=xx2-xx1
       yy4=yy2-yy1
       zz4=zz2-zz1
       al4=sqrt(xx4**2+yy4**2+zz4**2)
       xx4=xx4/max(al4,em20)
       yy4=yy4/max(al4,em20)
       zz4=zz4/max(al4,em20)
       xx5=xx3-xx1
       yy5=yy3-yy1
       zz5=zz3-zz1
       xx6=yy4*zz5-zz4*yy5
       yy6=zz4*xx5-xx4*zz5
       zz6=xx4*yy5-yy4*xx5
       al6=sqrt(xx6**2+yy6**2+zz6**2)
       xx6=xx6/max(al6,em20)
       yy6=yy6/max(al6,em20)
       zz6=zz6/max(al6,em20)
       xx5=yy6*zz4-zz6*yy4
       yy5=zz6*xx4-xx6*zz4
       zz5=xx6*yy4-yy6*xx4
       al5=sqrt(xx5**2+yy5**2+zz5**2)
       xx5=xx5/max(al5,em20)
       yy5=yy5/max(al5,em20)
       zz5=zz5/max(al5,em20)
C
       xxn=xx6
       yyn=yy6
       zzn=zz6
C
       ELSEIF (n1/=0) THEN
C      MOMENTUM / GLOBAL SYSTEM
       xx4=x(1,n2)-x(1,n1)
       yy4=x(2,n2)-x(2,n1)
       zz4=x(3,n2)-x(3,n1)
       xx5=x(1,n3)-x(1,n1)
       yy5=x(2,n3)-x(2,n1)
       zz5=x(3,n3)-x(3,n1)
       xxn=yy4*zz5-zz4*yy5
       yyn=zz4*xx5-xx4*zz5
       zzn=xx4*yy5-yy4*xx5
       al6=sqrt(xxn**2+yyn**2+zzn**2)
       xxn=xxn/max(al6,em20)
       yyn=yyn/max(al6,em20)
       zzn=zzn/max(al6,em20)
C
       xx4=one
       yy4=zero
       zz4=zero
       xx5=zero
       yy5=one
       zz5=zero
       xx6=zero
       yy6=zero
       zz6=one
       ELSE
       xxn=zero
       yyn=zero
       zzn=one
       xx4=one
       yy4=zero
       zz4=zero
       xx5=zero
       yy5=one
       zz5=zero
       xx6=zero
       yy6=zero
       zz6=one
C
      ENDIF
C
C     ORIGIN CALCULATION
C
      IF(ifram==0)THEN
        d13=(xx3-xx1)*xx4+(yy3-yy1)*yy4+(zz3-zz1)*zz4
        xxc=xx1+d13*xx4
        yyc=yy1+d13*yy4
        zzc=zz1+d13*zz4
      ELSEIF(ifram==10)THEN
        x1n=x(1,n2)-x(1,n1)
        y1n=x(2,n2)-x(2,n1)
        z1n=x(3,n2)-x(3,n1)
        al4=sqrt(x1n**2+y1n**2+z1n**2)
        x1n=x1n/max(al4,em20)
        y1n=y1n/max(al4,em20)
        z1n=z1n/max(al4,em20)
        d13=(x(1,n3)-x(1,n1))*x1n
     .     +(x(2,n3)-x(2,n1))*y1n
     .     +(x(3,n3)-x(3,n1))*z1n
        xxc=x(1,n1)+d13*x1n
        yyc=x(2,n1)+d13*y1n
        zzc=x(3,n1)+d13*z1n
      ELSEIF(mod(ifram,10)==1)THEN
        xxc=0.
        yyc=0.
        zzc=0.
C   attention : il faut penser a maj de X avant forint
        DO i=1,nnod
          n=nod(i)
          xxc=xxc+x(1,n)
          yyc=yyc+x(2,n)
          zzc=zzc+x(3,n)
        ENDDO
        xxc=xxc/nnod
        yyc=yyc/nnod
        zzc=zzc/nnod
      ELSEIF(mod(ifram,10)==2)THEN
        xxc=0.
        yyc=0.
        zzc=0.
        mas=1.e-30
C   attention : il faut penser a maj de X & M avant forint
        DO i=1,nnod
          n=nod(i)
          xxc=xxc+x(1,n)*ms(n)
          yyc=yyc+x(2,n)*ms(n)
          zzc=zzc+x(3,n)*ms(n)
          mas=mas+ms(n)
        ENDDO
        xxc=xxc/mas
        yyc=yyc/mas
        zzc=zzc/mas
      ELSEIF(mod(ifram,10)==3)THEN
        xxc=0.
        yyc=0.
        zzc=0.
      ENDIF
C
      RETURN