Esope source files

   1 : C BZCO      SOURCE    FANDEUR   13/01/16    21:15:00     7666           
   2 :        SUBROUTINE BZCO(IGAU,MFR,IFOU,NIFOU,XEL,BPSS,SHPTOT,
   3 :      .                NST,NBNO,LRE,MELE,SHP,BGENE,DJAC,IRRT)
   4 : C=======================================================================        
   5 : C     CALCUL DE LA MATRICE B 
   6 : C     ET DU JACOBIEN EN IGAU POUR UN ELEMENT DE ZONE COHESIVE
   7 : C=======================================================================        
   8 : C  INPUT                                                                                                                                                                                                        
   9 : C     IGAU  = NUMERO DU POINT DE GAUSS
  10 : C     MFR   = NUMERO DE LA FORMULATION 
  11 : C     XEL   = COORDONNEES DES NOEUDS DE L'ELEMENT
  12 : C     BPSS  = MATRICE DE PASSAGE
  13 : C     SHPTOT= FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE DE REFERENCE
  14 : C             SHPTOT(1, ) = FONCTION DE FORME
  15 : C             SHPTOT(2, ) = DERIVEES PAR RAPPORT A QSI
  16 : C             SHPTOT(3, ) = DERIVEES PAR RAPPORT A ETA
  17 : C     NBNO  = NOMBRE DE NOEUDS
  18 : C     LRE   = NOMBRE DE COLONNES DE LA MATRICE B
  19 : C     NST   = NOMBRE DE COMPOSANTES DE CONTRAINTES   
  20 : C  OUTPUT
  21 : C     SHP   = FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE GEOMETRIQUE
  22 : C             SHP(1, ) = FONCTION DE FORME
  23 : C             SHP(2, ) = DERIVEES PAR RAPPORT A X LOCAL
  24 : C             SHP(3, ) = DERIVEES PAR RAPPORT A Y LOCAL
  25 : C     DJAC  = JACOBIEN AU POINT D'INTEGRATION IGAU
  26 : C     BGENE = MATRICE B AU POINT D'INTEGRATION IGAU
  27 : C     IRRT  = DIFFERENT DE ZERO SI ERREUR
  28 : C=======================================================================        
  29 :       IMPLICIT INTEGER(I-N)
  30 :       IMPLICIT REAL*8(A-H,O-Z)
  31 : C
  32 :       DIMENSION XEL(3,*),BGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
  33 :       DIMENSION BPSS(3,3)  
  34 : C
  35 :       IRRT = 0
  36 :       NDIM = 2
  37 :       IF(IFOU .GT. 0) NDIM = 3
  38 :       IDIM = NDIM - 1
  39 : C
  40 : C     MATRICE JACOBIENNE
  41 : C
  42 :       DO 1 I=1,NBNO
  43 :        SHP(1,I) = SHPTOT(1,I,IGAU)
  44 :        SHP(2,I) = SHPTOT(2,I,IGAU)
  45 :     1 CONTINUE
  46 : C
  47 : C     TRAITEMENT PARTICULIER POUR LE CAS 2D
  48 : C     SINON, APPEL A DEVOLU
  49 : C
  50 :       IF(NDIM.EQ.2) THEN
  51 :         dXdQsi=0.D0
  52 :         dYdQsi=0.D0
  53 :         DO i=1,NBNO
  54 :           dXdQsi=dXdQsi+SHP(2,i)*XEL(1,i)
  55 :           dYdQsi=dYdQsi+SHP(2,i)*XEL(2,i)
  56 :         ENDDO
  57 :         DJAC=SQRT(dXdQsi*dXdQsi+dYdQsi*dYdQsi)
  58 : C
  59 : C  ON MULTIPLIE PAR LE RAYON EN AXI
  60 : C
  61 :        IF (IFOU .EQ.0) THEN
  62 :         RAYON=0.D0
  63 :         DO IRAY=1,NBNO
  64 :          RAYON=RAYON+SHPTOT(1,IRAY,IGAU)*XEL(1,IRAY)
  65 :         ENDDO
  66 :         DJAC=DJAC*RAYON
  67 :        ENDIF
  68 : 
  69 :       ELSE
  69 :         CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NIFOU,IDIM,1.D0,RR,DJAC)
  70 :       ENDIF
  71 :        
  72 :       IF (DJAC.LT.0.0D0) THEN
  73 :          IRRT = 1
  74 :       ELSE IF (DJAC.EQ.0.0D0) THEN
  75 :          IRRT = 2
  76 :       ENDIF 
  77 : C
  78 : C     MATRICE B
  79 : C
  79 :       CALL ZERO(BGENE,NST,LRE)
  80 : C
  81 :       DO 2 I=1,NST
  82 :        DO 3 J=1,NBNO
  83 :         r_z = 2.D0 * SHP(1,J)
  84 :         L = NDIM*(J-1)
  85 :         DO 4 K=1,NDIM
  86 :          BGENE(I,L+K) = BPSS(I,K) * r_z
  87 :     4   CONTINUE
  88 :     3  CONTINUE
  89 :     2 CONTINUE
  90 : C
  91 :       RETURN
  92 :       END
  93 : 
  94 :