qrcoor2.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	qrcoor2 (x, ncp, y1, y2, y3, y4, z1, z2, z3, z4, nc1, nc2, nc3, nc4, ngl, mat, ngeo, vd2, r11, r12, r13, r21, r22, r23, r31, r32, r33, gama, y234, y124, vis, nel, isorth)

Function/Subroutine Documentation

qrcoor2()

subroutine qrcoor2	(		x,
		integer, dimension(7,*)	ncp,
			y1,
			y2,
			y3,
			y4,
			z1,
			z2,
			z3,
			z4,
		integer, dimension(*)	nc1,
		integer, dimension(*)	nc2,
		integer, dimension(*)	nc3,
		integer, dimension(*)	nc4,
		integer, dimension(*)	ngl,
		integer, dimension(*)	mat,
		integer, dimension(*)	ngeo,
			vd2,
			r11,
			r12,
			r13,
			r21,
			r22,
			r23,
			r31,
			r32,
			r33,
			gama,
			y234,
			y124,
			vis,
		integer, intent(in)	nel,
		integer, intent(in)	isorth )

Definition at line 29 of file qrcoor2.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN) :: NEL
      INTEGER, INTENT(IN) :: ISORTH
      INTEGER NC1(*), NC2(*), NC3(*), NC4(*), MAT(*), NGL(*), NGEO(*),
     .        NCP(7,*)
C     REAL
      my_real
     .   x(3,*),y1(*),y2(*),y3(*),y4(*),z1(*),z2(*),z3(*),z4(*),vd2(*),
     .   r11(*),r12(*),r13(*),
     .   r21(*),r22(*),r23(*),
     .   r31(*),r32(*),r33(*),gama(mvsiz,6),
     .   y234(*),y124(*),vis(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,II,IV
      my_real
     .   sy(mvsiz) , sz(mvsiz) ,
     .   ty(mvsiz) , tz(mvsiz) , 
     .   yl , zl , suma,
     .   g22,g23,g32,g33,
     .   t22,t23,t32,t33,cs,ct
C-----------------------------------------------
      DO i=1,nel
        ngeo(i)=ncp(6,i)
        ngl(i)=ncp(7,i)
        mat(i)=ncp(1,i)
        nc1(i)=ncp(2,i)
        nc2(i)=ncp(3,i)
        nc3(i)=ncp(4,i)
        nc4(i)=ncp(5,i)
      END DO
C
C----------------------------
C     COORDONNEES NODALES
C----------------------------
      DO i=1,nel
        y1(i)=x(2,nc1(i))
        z1(i)=x(3,nc1(i))
        y2(i)=x(2,nc2(i))
        z2(i)=x(3,nc2(i))
        y3(i)=x(2,nc3(i))
        z3(i)=x(3,nc3(i))
        y4(i)=x(2,nc4(i))
        z4(i)=x(3,nc4(i))
      END DO
C----------------------------
      IF(n2d==1)THEN
        DO i=1,nel
          y234(i)=y2(i)+y3(i)+y4(i)
          y124(i)=y1(i)+y2(i)+y4(i)
        END DO
      END IF
C---------------------------------------
C     REPERE LOCAL
C---------------------------------------
      DO i=1,nel
        sy(i)=half*(y2(i)+y3(i)-y1(i)-y4(i))
        sz(i)=half*(z2(i)+z3(i)-z1(i)-z4(i))
        ty(i)=half*(y3(i)+y4(i)-y1(i)-y2(i))
        tz(i)=half*(z3(i)+z4(i)-z1(i)-z2(i))
      END DO
C-----------
C     REPERE CONVECTE : Same than the shell
C-----------
      DO i=1,nel
        ct = ty(i)*ty(i)+tz(i)*tz(i)
        cs = sy(i)*sy(i)+sz(i)*sz(i)
        IF(cs /= zero) THEN
          suma = sqrt(ct/max(em20,cs))
          sy(i) = sy(i)*suma + tz(i)
          sz(i) = sz(i)*suma - ty(i)
        ELSEIF(ct /= zero)THEN
          suma = sqrt(cs/max(em20,ct))
          sy(i) = sy(i) + tz(i)*suma
          sz(i) = sz(i) - ty(i)*suma
        END IF 
      ENDDO
 
      DO i=1,nel
        suma=one/max(sqrt(sy(i)*sy(i)+sz(i)*sz(i)),em20)
        sy(i)=sy(i)*suma
        sz(i)=sz(i)*suma
      ENDDO
 
      DO i=1,nel
        r11(i)= one
        r21(i)= zero
        r31(i)= zero
        r12(i)= zero
        r22(i)= sy(i)
        r32(i)= sz(i)
        r13(i)= zero
        r23(i)=-sz(i)
        r33(i)= sy(i)
      END DO
C-----------
      DO i=1,nel
        yl=r22(i)*y1(i)+r32(i)*z1(i)
        zl=r23(i)*y1(i)+r33(i)*z1(i)
        y1(i)=yl
        z1(i)=zl
        yl=r22(i)*y2(i)+r32(i)*z2(i)
        zl=r23(i)*y2(i)+r33(i)*z2(i)
        y2(i)=yl
        z2(i)=zl
        yl=r22(i)*y3(i)+r32(i)*z3(i)
        zl=r23(i)*y3(i)+r33(i)*z3(i)
        y3(i)=yl
        z3(i)=zl
        yl=r22(i)*y4(i)+r32(i)*z4(i)
        zl=r23(i)*y4(i)+r33(i)*z4(i)
        y4(i)=yl
        z4(i)=zl
      END DO
C-----------
C     PASSAGE AU REPERE ORTHOTROPE.
C-----------
      IF (isorth /= 0)THEN
        DO i=1,nel
C         Extration de G tq Xortho=Transpose(G) Xcvt
C                                 =Transpose(G) Transpose(R) Xglobal.
          g22=gama(i,2)
          g32=gama(i,3)
          g23=gama(i,5)
          g33=gama(i,6)
C
          yl=g22*y1(i)+g32*z1(i)
          zl=g23*y1(i)+g33*z1(i)
          y1(i)=yl
          z1(i)=zl
          yl=g22*y2(i)+g32*z2(i)
          zl=g23*y2(i)+g33*z2(i)
          y2(i)=yl
          z2(i)=zl
          yl=g22*y3(i)+g32*z3(i)
          zl=g23*y3(i)+g33*z3(i)
          y3(i)=yl
          z3(i)=zl
          yl=g22*y4(i)+g32*z4(i)
          zl=g23*y4(i)+g33*z4(i)
          y4(i)=yl
          z4(i)=zl
C         MATRICE DE PASSAGE GLOBAL -> ORTHOTROPE.
          t22=r22(i)*g22+r23(i)*g32
          t23=r22(i)*g23+r23(i)*g33
          t32=r32(i)*g22+r33(i)*g32
          t33=r32(i)*g23+r33(i)*g33
          r22(i)=t22
          r23(i)=t23
          r32(i)=t32
          r33(i)=t33
        ENDDO
      ENDIF
C-----------
      DO i=1,nel
        vd2(i)=zero
        vis(i)=zero
      END DO
C
      RETURN