Esope source files

   1 : C JOPLOC    SOURCE    CHAT      05/01/13    00:50:04     5004           
   2 :       SUBROUTINE JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOU,XEL,BPSS)                                
   3 : C
   4 : C=======================================================================        
   5 : C                                                                       
   6 : C    -CALCUL DE LA MATRICE DE PASSAGE BPSS                              
   7 : C    -CALCUL DES COORDONNEES LOCALES XEL                                                                                                                             
   8 : C          ROUTINE FORTRAN PUR POUR LES ELEMENTS JOINTS POREUX (BALD)                                                
   9 : C
  10 : C=======================================================================        
  11 : C
  12 : C  INPUT                                                                                                                                                                                                        
  13 : C     XE     = COORDONNEES GLOBALES DE L ELEMENT                                
  14 : C     SHPTOT = FONCTIONS DE FORME                                       
  15 : C     NBBB   = NOMBRE DE NOEUDS DE L'ELEMENT
  16 : C     NBNO   = NOMBRE DE FONCTIONS DE FORME
  17 : C     IFOU   = IFOUR DE COPTIO
  18 : C  OUTPUT                                                               
  19 : C     XEL    = COORDONNEES LOCALES DE L ELEMENT                                        
  20 : C     BPSS   = MATRICE DE PASAGE REPERE GLOBAL/REPERE LOCAL             
  21 : C
  22 : C=======================================================================        
  23 :       IMPLICIT INTEGER(I-N)
  24 :       IMPLICIT REAL*8(A-H,O-Z)
  25 :       DIMENSION XE(3,NBBB),XEL(3,NBBB),BPSS(3,3),SHPTOT(6,NBNO,*)
  26 :       DIMENSION V2(3),XD(3,20)  
  27 :       DIMENSION S1(3),S2(3),SN(3)
  28 : C
  29 :       NBNB=(3*NBBB-NBNO)/2
  30 :       NNNN=NBNB/2
  31 : C
  32 :       DO 1 I=1,3
  33 :          S1(I)=0.0D0
  34 :          S2(I)=0.0D0
  35 :          SN(I)=0.0D0
  36 :          V2(I)=0.0D0
  37 :    1  CONTINUE
  38 : C
  38 :       CALL ZERO(BPSS,3,3)
  38 :       CALL ZERO(XD,3,20)
  38 :       CALL ZERO(XEL,3,NBBB)
  39 : C
  40 :       IF (IFOU.EQ.2) THEN
  41 : C
  42 : C----------     CALCUL DE LA MATRICE DE  PASSAGE
  43 : C
  44 :       DO 2 I=1,NNNN
  45 : C
  46 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
  47 : C
  48 :          S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
  49 :          S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
  50 :          S1(3) = S1(3) + ( SHPTOT(2,I,1)*XE(3,I) )
  51 : C
  52 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON ETA
  53 : C
  54 :          V2(1) = V2(1) + ( SHPTOT(3,I,1)*XE(1,I) )
  55 :          V2(2) = V2(2) + ( SHPTOT(3,I,1)*XE(2,I) )
  56 :          V2(3) = V2(3) + ( SHPTOT(3,I,1)*XE(3,I) )
  57 :     2  CONTINUE
  57 :        CALL NORMER(S1)
  57 :        CALL NORMER(V2)  
  58 : C
  59 : C-------------------NORMALE AU PLAN DU JOINT
  60 : C
  61 :        SN(1) = (S1(2)*V2(3)) - (S1(3)*V2(2))
  62 :        SN(2) = (S1(3)*V2(1)) - (S1(1)*V2(3))
  63 :        SN(3) = (S1(1)*V2(2)) - (S1(2)*V2(1))
  63 :        CALL NORMER(SN) 
  64 : C
  65 : C-------------------ORTHOGONALISATION DE S2
  66 : C
  67 :        S2(1) = (SN(2)*S1(3)) - (SN(3)*S1(2))
  68 :        S2(2) = (SN(3)*S1(1)) - (SN(1)*S1(3))
  69 :        S2(3) = (SN(1)*S1(2)) - (SN(2)*S1(1))
  69 :        CALL NORMER(S2)
  70 : C
  71 : C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
  72 : C
  73 :        DO 3 I=1,3
  74 :           BPSS(1,I) = S1(I)
  75 :           BPSS(2,I) = S2(I)
  76 :           BPSS(3,I) = SN(I)
  77 :     3  CONTINUE   
  78 : C
  79 : C----------     CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
  80 : C
  81 : C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1 )
  82 : C
  83 :        DO 4 J=1,NBBB
  84 :           DO 5 I=1,3
  85 :              XD(I,J) = XE(I,J) - XE(I,1)
  86 :     5  CONTINUE
  87 :     4  CONTINUE
  88 : C
  89 : C-------------------PROJECTION SUR LE PLAN DU JOINT
  90 : C
  91 :        DO 6 J=1,NBBB
  92 :         XEL(1,J)=XD(1,J)*S1(1)+XD(2,J)*S1(2)+XD(3,J)*S1(3)
  93 :         XEL(2,J)=XD(1,J)*S2(1)+XD(2,J)*S2(2)+XD(3,J)*S2(3)
  94 :         XEL(3,J)=0.0D0
  95 :     6  CONTINUE
  96 : C
  97 :       ELSE IF(IFOU.EQ.-2.OR.IFOU.EQ.-1.OR.IFOU.EQ.0)THEN
  98 : C
  99 : C----------     CALCUL DE LA MATRICE DE  PASSAGE
 100 : C
 101 :        DO 7 I=1,NNNN
 102 : C
 103 : C-------------------TANGENTE AU POINT DE GAUSS 1 SELON QSI
 104 : C
 105 :          S1(1) = S1(1) + ( SHPTOT(2,I,1)*XE(1,I) )
 106 :          S1(2) = S1(2) + ( SHPTOT(2,I,1)*XE(2,I) )
 107 :     7  CONTINUE
 108 : C
 109 : C-------------------NORMALISATION DE S1
 110 : C
 111 :        XNORME = SQRT((S1(1)**2) + (S1(2)**2))
 112 :        S1(1) = S1(1) / XNORME
 113 :        S1(2) = S1(2) / XNORME
 114 : C
 115 : C-------------------NORMALE AU JOINT (PAR ROTATION DE 90 DEGRES)
 116 : C
 117 :        SN(1) =-S1(2)
 118 :        SN(2) = S1(1)
 119 : C
 120 : C-------------------STOCKAGE DE LA MATRICE DE PASSAGE
 121 : C
 122 :        DO 8 I=1,2
 123 :           BPSS(1,I) = S1(I)
 124 :           BPSS(2,I) = SN(I)
 125 :     8  CONTINUE
 126 : C
 127 : C----------     CALCUL DES COORDONNEES LOCALES DE L'ELEMENT
 128 : C
 129 : C-------------------CHANGEMENT D'ORIGINE ( ORIGINE AU NOEUD 1)
 130 : C
 131 :        DO 9 J=1,NBBB
 132 :           DO 10 I=1,2
 133 :              XD(I,J) = XE(I,J) - XE(I,1)
 134 :    10  CONTINUE
 135 :     9  CONTINUE
 136 : C
 137 : C-------------------PROJECTION SUR LE PLAN DU JOINT
 138 : C
 139 :        DO 11 J=1,NBBB
 140 :         XEL(1,J)=XD(1,J)*S1(1)+XD(2,J)*S1(2)
 141 :         XEL(2,J)=0.0D0
 142 :    11  CONTINUE
 143 : C
 144 :       END IF
 145 : C
 146 :       RETURN
 147 :       END
 148 : 
 149 : 
 150 : 
 151 :  
 152 :