Esope source files

   1 : C JO2LOC    SOURCE    CHAT      05/01/13    00:49:42     5004           
   2 :       SUBROUTINE JO2LOC(XE,SHPTOT,NBNO,XEL,BPSS,NOQUAL)
   3 : C=======================================================================
   4 : C
   5 : C    -TEST DE PLANEITE DES FACES DE L'ELEMENT JOI2
   6 : C    -CALCUL DE LA MATRICE DE PASSAGE BPSS
   7 : C    -CALCUL DES COORDONNEES LOCALES XEL
   8 : C          ROUTINE FORTRAN PUR
   9 : C          CODE S. FELIX SEPTEMBRE 92
  10 : C=======================================================================
  11 : C  INPUT
  12 : C     XE     = COORDONNEES  DE L ELEMENT
  13 : C     SHPTOT = FONCTIONS DE FORME
  14 : C            = SHPTOT(1,...) = FONCTIONS DE FORME
  15 : C            = SHPTOT(2,...) = DERIVEE PAR RAPPORT A QSI
  16 : C            = SHPTOT(3,...) = DERIVEE PAR RAPPORT A ETA
  17 : C     NBNO   = NOMBRE DE NOEUDS DE L'ELEMENT
  18 : C  OUTPUT
  19 : C     XEL    = COORDONNEES LOCALES
  20 : C     BPSS   = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL
  21 : C     NOQUAL = INDICE DE QUALITE
  22 : C            = 0 SI OK
  23 : C            = 2 SI NOEUD NON COPLANAIRES
  24 : C
  25 : C=======================================================================
  26 :       IMPLICIT INTEGER(I-N)
  27 :       IMPLICIT REAL*8(A-H,O-Z)
  28 :       DIMENSION XE(3,*),XEL(3,*),BPSS(3,3),SHPTOT(6,NBNO,*)
  29 :       DIMENSION XD(2,4)
  30 :       DIMENSION S1(2),SN(2)
  31 : C
  32 :       NOQUAL = 0
  33 : C
  34 : C----------     CALCUL DE LA MATRICE DE  PASSAGE
  35 : C
  36 :       DO 6 I=1,2
  37 :          S1(I)=0.0D0
  38 :          SN(I)=0.0D0
  39 :     6 CONTINUE
  40 : C
  41 :       DO 7 I=1,NBNO
  42 : C
  43 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  44 : C
  45 :          S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  46 :          S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  47 :     7  CONTINUE
  48 : C
  49 : C-------------------NORMALISATION DE S1
  50 : C
  51 :        XNORME = SQRT((S1(1)**2) + (S1(2)**2))
  52 :        S1(1) = S1(1) / XNORME
  53 :        S1(2) = S1(2) / XNORME
  54 : C
  55 : C-------------------NORMALE AU JOINT (PAR ROTATION DE 90 DEGRES
  56 : C
  57 :        SN(1) = -S1(2)
  58 :        SN(2) =  S1(1)
  59 : C
  60 : C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  61 : C
  62 :        DO 10 I=1,2
  63 :           BPSS(1,I) = S1(I)
  64 :           BPSS(2,I) = SN(I)
  65 :    10  CONTINUE
  66 : C
  67 : C----------    CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  68 : C
  69 : C
  70 : C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
  71 : C
  72 : *      DO 8 J=1,NBNO
  73 : *         DO 8 I=1,2
  74 : *            XD(I,J) = XE(I,J) - XE(I,1)
  75 : *   8  CONTINUE
  76 : C
  77 : C-------------------PROJECTION SUR LE PLAN DU JOINT
  78 : C
  79 : *      DO 9 J=1,NBNO
  80 : *       XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))
  81 : *       XEL(2,J)=0.0D0
  82 : *   9  CONTINUE
  83 : C+PPj
  84 : C
  85 : C----------    CALCUL DES COORDONNEES GLOBALES DU PLAN MOYEN DU JOINT
  86 : C              QUE L'ON STOCKE DANS LA FIN DE XEL
  87 : C
  88 :        NBNOS2=NBNO/2
  89 :        DO J=1,NBNOS2
  90 :          DO I=1,2
  91 :            XEL(I,J+NBNOS2) = (XE(I,J) + XE(I,NBNO+1-J))/2
  92 :          ENDDO
  93 :        ENDDO
  94 : C
  95 : C-----------   CHANGEMENT D'ORIGINE DU PLAN MOYEN DU JOINT 
  96 : C              (ORIGINE AU NOEUD 1)
  97 : C
  98 :        DO J=1,NBNOS2
  99 :          DO I=1,2
 100 :            XD(I,J) = XEL(I,J+NBNOS2) - XEL(I,1+NBNOS2)
 101 :          ENDDO
 102 :        ENDDO
 103 : C
 104 : C-----------   PROJECTION SUR LE PLAN DU JOINT ET STOCKAGE DANS LE
 105 : C              DEBUT DE XEL
 106 : C
 107 :        DO J=1,NBNOS2
 108 :          XEL(1,J)=(XD(1,J)*S1(1))+(XD(2,J)*S1(2))
 109 :          XEL(2,J)=0.0D0
 110 :        ENDDO
 111 : C
 112 : C+PPj
 113 : C
 114 : C-------------------VERIFIER S'IL FAUT FAIRE UN TEST DE PLANEITE
 115 : C
 116 :       RETURN
 117 :       END
 118 :  
 119 :  
 120 :