Esope source files

   1 : C JT3LOC    SOURCE    CHAT      05/01/13    00:50:10     5004           
   2 :       SUBROUTINE JT3LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
   3 : C=======================================================================
   4 : C
   5 : C    -TEST DE VOISINAGE DES NOEUDS D'UN ELEMENT JOT3
   6 : C    -TEST DE PLANEITE DES FACES DE L'ELEMENT
   7 : C    -CALCUL DE LA MATRICE DE PASSAGE BPSS
   8 : C    -CALCUL DES COORDONNEES LOCALES XEL
   9 : C          ROUTINE FORTRAN PUR
  10 : C          DERIVEE DE LA ROUTINE JO4LOC PAR S. FELIX
  11 : C=======================================================================
  12 : C  INPUT
  13 : C     XE     = COORDONNEES  DE L ELEMENT
  14 : C     SHPTOT = FONCTIONS DE FORME
  15 : C            = SHPTOT(1,...) = FONCTIONS DE FORME
  16 : C            = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI
  17 : C            = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA
  18 : C     NBNO   = NOMBRE DE NOEUDS DE L'ELEMENT
  19 : C     IVRF   = DEMANDE DE VERIFICATION DE L 'ELEMENT
  20 : C  OUTPUT
  21 : C     XEL    = COORDONNEES LOCALES
  22 : C     BPSS   = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL
  23 : C     NOQUAL = INDICE DE QUALITE
  24 : C            = 0 SI OK
  25 : C            = 1 SI NOEUD TROP VOISINS
  26 : C            = 2 SI NOEUD NON COPLANAIRES
  27 : C
  28 : C  REMARQUE : ATTENTION : DANS LES CAS CONTRAINTES PLANES, DEFO. PLANES
  29 : C             AXISYMETRIQUE, LA MATRICE TETA SERA UNE MATRICE DE
  30 : C             DIMENSION (2X2), ET SERA CONSTITUEE PAR LES VECTEURS
  31 : C             S1 ET SN. LES CAS CONT.PLANES,DEF.PLANES ET AXISYMETRIQUE
  32 : C             SERONT DONC SIMILAIRES AU CAS D'UN JOINT BIDIMENSIONNEL
  33 : C
  34 : C=======================================================================
  35 :       IMPLICIT INTEGER(I-N)
  36 :       IMPLICIT REAL*8(A-H,O-Z)
  37 :       INTEGER IND4(0:4)
  38 :       DIMENSION XE(3,6),XEL(3,6),BPSS(3,3),SHPTOT(6,NBNO,*)
  39 :       DIMENSION U1(3),V1(3),XD(3,6),V2(3)
  40 :       DIMENSION S1(3),S2(3),SN(3)
  41 :       DIMENSION XX(3,6)
  42 :       DATA IND4/3,1,2,3,1/
  43 : C
  44 :       NOQUAL = 0
  45 :       C1 = 0.0D0
  46 :       C2 = 0.0D0
  47 :       C3 = 0.0D0
  48 : C
  49 : C----------     VERIFICATION DE LA DISTANCE MINIMALE ENTRE LES POINTS
  50 : C----------     PAR COMPARAISON AVEC LE POURTOUR DU JOINT
  51 : C
  52 :       PP = 0.0D0
  53 :       DO 1 I=1,3
  54 :        II = I+1
  55 :        IF (II.EQ.4) II=1
  56 :        C1 = ABS(XE(1,I)-XE(1,II))
  57 :        C2 = ABS(XE(2,I)-XE(2,II))
  58 :        C3 = ABS(XE(3,I)-XE(3,II))
  59 :        C1 = C1*C1 + C2*C2 + C3*C3
  60 :        PP = PP + SQRT(C1)
  61 :     1 CONTINUE
  62 : C
  63 :       DMIN=PP/50.0D0
  64 :       DO 2 I=1,2
  65 :        I1 = I+1
  66 :        DO 2 N=I1,3
  67 :         IF ( ABS(XE(1,I)-XE(1,N)).LE.DMIN.AND.
  68 :      &       ABS(XE(2,I)-XE(2,N)).LE.DMIN.AND.
  69 :      &       ABS(XE(3,I)-XE(3,N)).LE.DMIN ) THEN
  70 : C                          NOEUDS TROP VOISINS
  71 :             NOQUAL=1
  72 :         ENDIF
  73 :     2 CONTINUE
  74 : C
  75 : C----------     CALCUL DE LA MATRICE DE  PASSAGE
  76 : C
  77 :       DO 6 I=1,3
  78 :          S1(I)=0.0D0
  79 :          S2(I)=0.0D0
  80 :          SN(I)=0.0D0
  81 :          V2(I)=0.0D0
  82 :     6 CONTINUE
  83 : C
  84 :       DO 7 I=1,NBNO
  85 : C
  86 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  87 : C
  88 :          S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  89 :          S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  90 :          S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) )
  91 : C
  92 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA
  93 : C
  94 :          V2(1) = V2(1) + ( SHPTOT(3,I,1)*XE(1,I) )
  95 :          V2(2) = V2(2) + ( SHPTOT(3,I,1)*XE(2,I) )
  96 :          V2(3) = V2(3) + ( SHPTOT(3,I,1)*XE(3,I) )
  97 :     7  CONTINUE
  98 : C
  98 :        CALL NORMER(S1)
  98 :        CALL NORMER(V2)
  99 : C-------------------NORMALE AU PLAN DU JOINT
 100 : C
 101 :        SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
 102 :        SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
 103 :        SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
 103 :        CALL NORMER(SN)
 104 : C
 105 : C-------------------ORTHOGONALISATION DE S2
 106 : C
 107 :        S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
 108 :        S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
 109 :        S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
 109 :        CALL NORMER(S2)
 110 : C
 111 : C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
 112 : C
 113 :        DO 10 I=1,3
 114 :           BPSS(1,I) = S1(I)
 115 :           BPSS(2,I) = S2(I)
 116 :           BPSS(3,I) = SN(I)
 117 :    10  CONTINUE
 118 : C
 119 : C----------     CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
 120 : C
 121 : C
 122 : C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
 123 : C
 124 : *      DO 8 J=1,NBNO
 125 : *         DO 8 I=1,3
 126 : *            XD(I,J) = XE(I,J) - XE(I,1)
 127 : *   8  CONTINUE
 128 : C
 129 : C-------------------PROJECTION SUR LE PLAN DU JOINT
 130 : C
 131 : *      DO 9 J=1,NBNO
 132 : *       XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
 133 : *       XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3))
 134 : *       XEL(3,J)=0.0D0
 135 : *   9  CONTINUE
 136 : C+PPj
 137 : C
 138 : C----------    CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT
 139 : C              QUE L'ON STOCKE DANS LA FIN DE XEL
 140 : C
 141 :        NBNOS2=NBNO/2
 142 :        DO J=1,NBNOS2
 143 :          DO I=1,3
 144 :            XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNOS2+J))/2
 145 :          ENDDO
 146 :        ENDDO
 147 : C
 148 : C-----------   CHANGEMENT D'ORIGINE DU PLAN MOYEN DU JOINT 
 149 : C              (ORIGINE AU NOEUD 1)
 150 : C
 151 :        DO J=1,NBNOS2
 152 :          DO I=1,3
 153 :            XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2)
 154 :          ENDDO
 155 :        ENDDO
 156 : C
 157 : C-----------   PROJECTION SUR LE PLAN DU JOINT ET STOCKAGE DANS LE
 158 : C              DEBUT DE XEL
 159 : C
 160 :        DO J=1,NBNOS2
 161 :          XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))+(XD(3,J)*S1(3))
 162 :          XEL(2,J)=(XD(1,J)*S2(1))+(XD(2,J)*S2(2))+(XD(3,J)*S2(3))
 163 :          XEL(3,J)=0.0D0
 164 :        ENDDO
 165 : C
 166 : C+PPj
 167 : C
 168 : C----------     TEST DE PLANEITE
 169 : C
 170 : C     CALCUL DES 4 NORMALES LOCALES
 171 : C
 172 :       DO 3 K=1,3
 173 :        KP1 = IND4(K+1)
 174 :        KM1 = IND4(K-1)
 175 :        DO 4  J=1,3
 176 :         U1(J) = XE(J,KP1) - XE(J,K)
 177 :         V1(J) = XE(J,KM1) - XE(J,K)
 178 :     4  CONTINUE
 179 : C
 180 :        XD(1,K) = U1(2)*V1(3) - U1(3)*V1(2)
 181 :        XD(2,K) = U1(3)*V1(1) - U1(1)*V1(3)
 182 :        XD(3,K) = U1(1)*V1(2) - U1(2)*V1(1)
 183 : C
 184 :        XXD = (XD(1,K)**2) + (XD(2,K)**2) + (XD(3,K)**2)
 185 :        XXD = SQRT(XXD)
 186 : C
 187 :       IF (XXD.GT.0.0D0) THEN
 188 :         DO 5 J=1,3
 189 :          XD(J,K) = XD(J,K)/XXD
 190 :     5   CONTINUE
 191 :       ENDIF
 192 :     3 CONTINUE
 193 : C
 194 : C     CALCUL DE LA NON PLANEITE
 195 : C
 196 :       COS12 = XD(1,2)*XD(1,1) + XD(2,2)*XD(2,1) + XD(3,2)*XD(3,1)
 197 :       COS23 = XD(1,3)*XD(1,2) + XD(2,3)*XD(2,2) + XD(3,3)*XD(3,2)
 198 :       IF (MIN(COS12,COS23).LT.0.99999) THEN
 199 : C            NON PLANEITE DE 0.25 DEGRE OU PLUS
 200 : C            0.99999, QUI EQUIVAUT A 1 DEGRE, EST INSUFFISANT
 201 :        NOQUAL = 2
 202 :       ENDIF
 203 : C
 204 :       RETURN
 205 :       END
 206 : 
 207 :  
 208 :