Sources Esope | Cast3M

dstgr2
C DSTGR2    SOURCE    CHAT      05/01/12    22:56:47     5004
       SUBROUTINE DSTGR2(XE,NGRA,NSTRS,DDHOMU,HS4,HS5,HS6,BGR)
*
*       CALCUL LA MATRICE BGR RELATIVE
*       AUX CISAILLEMENTS TRANSVERSES
*
************************************************************************
*
* ENTREES :
*
*     XE : COORDONNEES DES NOEUDS
* NSTRS  :NOMBRE DE COMPOSANTES DE CONTRAINTES
* NGRA   :NOMBRE DE COMPOSANTES DE GRADIENT
* DDHOMU :MATRICE DE HOOKE
*
* SORTIES :
*
*  HS4,HS5,HS6 : LES FONCTIONS QUI RELIE LES TERMES (BETA)SK A {U}
*  BGR         : MATRICE DE BGR
*
* AUTEUR : X.Z. SUO FEVRIER 96
************************************************************************
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      DIMENSION XE(3,*),DDHOMU(NSTRS,*),HS4(*),HS5(*),HS6(*)
      DIMENSION BGR(NGRA,*),SX(3),SY(3),RL(3),EXX(3),EYY(3)
      DIMENSION BCISA(2,9),HFX(9),HFY(9)
      DIMENSION ASS(6),BSS(6),AXX(3),BXX(3),AYY(3),BYY(3)
*
      DO 10 K=4,6
       IF(K.EQ.4)THEN
         IJ=1
         I=2
         J=3
       ELSEIF(K.EQ.5)THEN
         IJ=2
          I=3
          J=1
        ELSE
         IJ=3
          I=1
          J=2
        ENDIF
       SX(IJ)=XE(1,I)-XE(1,J)
       SY(IJ)=XE(2,I)-XE(2,J)
       RL(IJ)=SQRT(SX(IJ)*SX(IJ)+SY(IJ)*SY(IJ))
       EXX(IJ)=-SX(IJ)/RL(IJ)
       EYY(IJ)=-SY(IJ)/RL(IJ)
  10   CONTINUE
       AIR=ABS(0.5D0*(SX(1)*SY(2)-SX(2)*SY(1)))
       SOMM=SX(IJ)+SY(IJ)+RL(IJ)+EXX(IJ)+EYY(IJ)
*
       CALL CISAF(XE,EXX,EYY,DDHOMU,AIR,ASS,AXX,
     1            AYY,BSS,BXX,BYY)
*
       CALL CISAR(ASS,BSS,AXX,AYY,BXX,BYY,RL,EXX,EYY,
     1            HS4,HS5,HS6,HFX,HFY)
*
       DO 20 IC=1,9
          BCISA(1,IC)=HFX(IC)
          BCISA(2,IC)=HFY(IC)
  20   CONTINUE
*
*     REMPLISSAGE DANS BGR
*
       DO 40 IL=1,2
          IL1=IL+6
          IL2=IL*3
          DO 40 IA=1,3
             IC1=3*(2*IA-1)
             IC2=3*IA-2
             BGR(IL1,IC1)=BCISA(IL,IC2)
             BGR(IL2,IC1+1)=BCISA(IL,IC2+1)
             BGR(IL2,IC1+2)=BCISA(IL,IC2+2)
 40    CONTINUE
*
       RETURN
       END