Sources Esope | Cast3M

co2loc
C CO2LOC    SOURCE    LJ1       14/11/13    21:15:12     8249
 
      SUBROUTINE CO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL,IDIM)
C=======================================================================
C
C    -TEST DE VOISINAGE DES NOEUDS D'UN ELEMENT COA2
C    -TEST DE PLANEITE DES FACES DE L'ELEMENT
C    -CALCUL DE LA MATRICE DE PASSAGE BPSS
C    -CALCUL DES COORDONNEES LOCALES XEL
C          ROUTINE FORTRAN PUR
C          DERIVEE DE LA ROUTINE JO4LOC PAR S. FELIX
C=======================================================================
C  INPUT
C     XE     = COORDONNEES  DE L ELEMENT
C     SHPTOT = FONCTIONS DE FORME
C            = SHPTOT(1,...) = FONCTIONS DE FORME
C            = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI
C            = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA
C     NBNO   = NOMBRE DE NOEUDS DE L ELEMENT
C     IVRF   = DEMANDE DE VERIFICATION DE L ELEMENT
C  OUTPUT
C     XEL    = COORDONNEES LOCALES
C     BPSS   = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL
C     NOQUAL = INDICE DE QUALITE
C            = 0 SI OK
C            = 1 SI NOEUD TROP VOISINS
C            = 2 SI NOEUD NON COPLANAIRES
C
C  REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES, DEFO. PLANES
C             AXISYMETRIQUE, LA MATRICE TETA SERA UNE MATRICE DE
C             DIMENSION (2X2), ET SERA CONSTITUEE PAR LES VECTEURS
C             S1 ET SN. LES CAS CONT.PLANES,DEF.PLANES ET AXISYMETRIQUE
C             SERONT DONC SIMILAIRES AU CAS D UN JOINT BIDIMENSIONNEL
C
C=======================================================================
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      INTEGER IND4(0:4)
      DIMENSION XE(3,6),XEL(3,6),BPSS(3,3),SHPTOT(6,NBNO,*)
      DIMENSION U1(3),V1(3),XD(3,6),V2(3)
      DIMENSION S1(3),S2(3),SN(3)
      DIMENSION XX(3,6)
      DATA IND4/3,1,2,3,1/
C
      NOQUAL = 0
C
C----------     CALCUL DE LA MATRICE DE  PASSAGE
C
      DO 6 I=1,IDIM
         S1(I)=0.0D0
         SN(I)=0.0D0
         IF (IDIM.EQ.3) THEN
          S2(I)=0.0D0
          V2(I)=0.0D0
         END IF
    6 CONTINUE
 
C
      DO 7 I=1,NBNO
C
C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
C
         S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
         S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
         IF (IDIM.EQ.3) S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) )
C
C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA
C
ccccccccc
       IF (IDIM.EQ.2) THEN
          XNORME = SQRT((S1(1)**2) + (S1(2)**2))
          S1(1) = S1(1) / XNORME
          S1(2) = S1(2) / XNORME
          SN(1) = -S1(2)
          SN(2) =  S1(1)
       ELSE IF (IDIM.EQ.3) THEN
          IF (S1(1).EQ.0.0D0.AND.S1(2).EQ.0.0D0) THEN
            V2(1) = 1.0D0
            V2(2) = 0.0D0
            V2(3) = 0.0D0
          ELSE IF (S1(2).EQ.0.0D0.AND.S1(3).EQ.0.0D0) THEN
            V2(1) = 0.0D0
            V2(2) = 1.D0
            V2(3) = 0.D0
          ELSE IF (S1(1).EQ.0.0D0.AND.S1(3).EQ.0.0D0) THEN
            V2(1) = 1.0D0
            V2(2) = 0.D0
            V2(3) = 0.0D0
          ELSE IF (S1(2).NE.0.0D0.AND.S1(3).NE.0.0D0) THEN
            V2(1) = 0.0D0
            V2(2) = -S1(3)
            V2(3) = S1(2)
          ELSE IF (S1(1).NE.0.0D0.AND.S1(3).NE.0.0D0) THEN
            V2(1) = -S1(3)
            V2(2) = 0.0D0
            V2(3) = S1(1)
          ELSE IF (S1(1).NE.0.0D0.AND.S1(2).NE.0.0D0) THEN
            V2(1) = -S1(2)
            V2(2) = S1(1)
            V2(3) = 0.0D0
          END IF
       END IF
ccccccccc
    7  CONTINUE
C
       IF (IDIM.EQ.3) THEN
          CALL NORMER(S1)
          CALL NORMER(V2)
 
C-------------------NORMALE AU PLAN DU JOINT
C
          SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
          SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
          SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
          CALL NORMER(SN)
C
C-------------------ORTHOGONALISATION DE S2
C
          S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
          S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
          S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
          CALL NORMER(S2)
       END IF
C
C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
C
       DO 10 I=1,IDIM
          BPSS(1,I) = S1(I)
          IF (IDIM.EQ.2) THEN
              BPSS(2,I) = SN(I)
          ELSE IF (IDIM.EQ.3) THEN
              BPSS(2,I) = S2(I)
              BPSS(3,I) = SN(I)
          END IF
   10  CONTINUE
C
C----------     CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
C
C
C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
C
      DO 8 J=1,NBNO
         DO 8 I=1,IDIM
            XD(I,J) = XE(I,J) - XE(I,1)
   8  CONTINUE
C
C-------------------PROJECTION SUR LE PLAN DU JOINT
C
      DO 9 J=1,NBNO
        XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))
        XEL(2,J)=0.0d0
        IF (IDIM.EQ.3) THEN
            XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
            XEL(3,J)=0.0D0
        END IF
   9  CONTINUE
C+PPj
C
C----------    CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT
C              QUE L ON STOCKE DANS LA FIN DE XEL
 
       NBNOS2=NBNO/2
       DO J=1,NBNOS2
         DO I=1,IDIM
           XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2
         ENDDO
       ENDDO
C
C-----------   CHANGEMENT D ORIGINE DU PLAN MOYEN DU JOINT
C              (ORIGINE AU NOEUD 1)
       DO J=1,NBNOS2
         DO I=1,IDIM
           XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2)
         ENDDO
       ENDDO
      RETURN
      END