Esope source files

   1 : C BJO2GN    SOURCE    CHAT      05/01/12    21:40:25     5004           
   2 :        SUBROUTINE BJO2GN(IGAU,MFR,IFOU,NIFOU,XE,XEL,BPSS,SHPTOT,SHP,
   3 :      .                            EPAIST,BGENE,DJAC,XDPGE,YDPGE,IRRT)
   4 : C=======================================================================
   5 : C
   6 : C PPj POUR LES JOINT GENERALISE 
   7 : C     CALCUL DE LA MATRICE B = TETA * ( N , -N )
   8 : C     ET DU JACOBIEN EN IGAU POUR UN JOINT 2D
   9 : C          ROUTINE FORTRAN PUR
  10 : C          P. PEGON 2001 d'apres CODE S. FELIX MAI 92
  11 : C=======================================================================
  12 : C  INPUT
  13 : C     IGAU  = NUMERO DU POINT DE GAUSS
  14 : C     MFR   = NUMERO DE LA FORMULATION
  15 : C     XEL   = COORDONNEES DES NOEUDS DE L'ELEMENT
  16 : C     BPSS  = MATRICE DE PASSAGE
  17 : C             BPSS(,) = AXE S1
  18 : C             BPSS(,) = AXE SN
  19 : C     SHPTOT= FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE DE REFERENCE
  20 : C             SHPTOT(1, ) = FONCTION DE FORME
  21 : C             SHPTOT(2, ) = DERIVEES PAR RAPPORT A QSI
  22 : C             SHPTOT(3, ) = DERIVEES PAR RAPPORT A ETA
  23 : C  OUTPUT
  24 : C     SHP   = FONCTIONS DE FORME ET DERIVEES DANS L'ESPACE GEOMETRIQUE
  25 : C             SHP(1, ) = FONCTION DE FORME
  26 : C             SHP(2, ) = DERIVEES PAR RAPPORT A X LOCAL
  27 : C             SHP(3, ) = DERIVEES PAR RAPPORT A Y LOCAL
  28 : C     DJAC  = JACOBIEN AU POINT D'INTEGRATION IGAU
  29 : C     BGENE = MATRICE B AU POINT D'INTEGRATION IGAU
  30 : C     IRRT  = DIFFERENT DE ZERO SI ERREUR
  31 : C  CONSTANTES
  32 : C     NBNO  = NOMBRE DE NOEUDS
  33 : C     LRE   = NOMBRE DE COLONNES DE LA MATRICE B
  34 : C     NST   = NOMBRE DE COMPOSANTES DE CONTRAINTES
  35 : C
  36 : C  REMARQUE : CE SOUS-PROGRAMME EST VALABLE EN CONTRAINTES PLANES,
  37 : C             DEFORMATIONS PLANES ET AXISYMETRIQUES. LA MATRICE
  38 : C                     BGENE = TETA ( Ntop , - Nbot )
  39 : C             EST UNE MATRICE (2x8). EN EFFET, TETA EST UNE MATRICE
  40 : C             (2x2), ET ( Ntop , - Nbot ) EST UNE MATRICE (2x8).
  41 : C             LA MATRICE TETA EST ICI APPELEE BPSS.
  42 : C
  43 : C=======================================================================
  44 :       IMPLICIT INTEGER(I-N)
  45 :       IMPLICIT REAL*8(A-H,O-Z)
  46 :       PARAMETER (NST=4,NBNO=4)
  47 : CcPPj DIMENSION XEL(3,*),BGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
  48 :       DIMENSION XE(3,*),XEL(3,*),BGENE(NST,*),SHP(6,*),SHPTOT(6,NBNO,*)
  49 :       DIMENSION BPSS(3,3)
  50 : C
  51 :       LRE=2*NBNO
  52 :       IF(IFOU.EQ.-3)LRE=LRE+3
  52 :       CALL ZERO(BGENE,NST,LRE)
  53 : C
  54 :       IRRT = 0
  55 : C
  56 : C     MATRICE JACOBIENNE
  57 : C
  58 :       DO 1 I=1,NBNO
  59 :        SHP(1,I) = SHPTOT(1,I,IGAU)
  60 :        SHP(2,I) = SHPTOT(2,I,IGAU)
  61 :     1 CONTINUE
  62 : C
  63 :       NBNONN=NBNO/2
  63 :       CALL DEVOLU(XEL,SHP,MFR,NBNONN,IFOU,NIFOU,1,1.D0,RR,DJAC)
  64 : 
  65 :       IF (DJAC.LT.0.0D0) THEN
  66 :          IRRT = 1
  67 :       ELSE IF (DJAC.EQ.0.0D0) THEN
  68 :          IRRT = 2
  69 :       ENDIF
  70 : C
  71 : C     MATRICE B ---> joint "standard"
  72 : C
  73 : C PP ATTENTION: IL FAUT PEUT-ETRE RESPECTER LA NUMEROTATION LOCALE DES
  74 : C               NOEUDS
  75 : C
  75 :       CALL ZERO(BGENE,NST,LRE)
  76 :       DO 2 I=1,2
  77 :        DO 3 J=1,2
  78 :         DO 4 K=1,2
  79 :          L=2*(J-1)+K
  80 : C PP     M=L+4
  81 :          M=L+2*(2*(2-J)+1)
  82 :          BGENE(I,L)=BPSS(I,K)*SHP(1,J)
  83 :          BGENE(I,M)=-BGENE(I,L)
  84 :     4   CONTINUE
  85 :     3  CONTINUE
  86 :     2 CONTINUE
  87 : CpPPj
  88 : C
  89 : C     DETERMINATION DE L'EPAISSEUR EN CAS DE BESOIN 
  90 : C     (on utilise BGENE(2,.) pour l'ouverture)
  91 : C
  92 :       IF(EPAIST.EQ.0.D+0)THEN
  93 :         DO I=1,NBNO
  94 :           J=2*(I-1)
  95 :           DO K=1,2
  96 :             EPAIST=EPAIST+BGENE(2,J+K)*XE(K,I)
  97 :           ENDDO
  98 :         ENDDO
  99 :       ENDIF
 100 :       IF(EPAIST.LE.0.D+0)THEN
 101 :         IRRT = 10
 102 :       ENDIF
 103 : CpPPj
 104 : 
 105 : C
 106 : C     MATRICE B ---> complement pour le cisaillement
 107 : C
 108 :       DO J=1,2
 109 :         DO K=1,2
 110 :           L=2*(J-1)+K
 111 :           M=L+2*(2*(2-J)+1)
 112 :           AAAA=0.5D0*BPSS(2,K)*SHP(2,J)*EPAIST     
 113 :           BGENE(1,L)=BGENE(1,L)+AAAA
 114 :           BGENE(1,M)=BGENE(1,M)+AAAA
 115 :         ENDDO
 116 :       ENDDO
 117 : C
 118 : C     MATRICE B ---> composante de deformation dans le plan EPTT
 119 : C
 120 :       DO J=1,2
 121 :         DO K=1,2
 122 :           L=2*(J-1)+K
 123 :           M=L+2*(2*(2-J)+1)      
 124 :           BGENE(3,L)=0.5D0*BPSS(1,K)*SHP(2,J)
 125 :           BGENE(3,M)=BGENE(3,L)
 126 :         ENDDO
 127 :       ENDDO
 128 : C
 129 : C     MATRICE B ---> Deformation plane generalisee
 130 : C                    (utilisation de la seconde partie de XEL)
 131 : C
 132 :       IF(IFOU.EQ.-3)THEN
 133 :         XXX=0.D0
 134 :         YYY=0.D0
 135 : C PPj   DO NP=1,NBNO
 136 :         DO NP=1,NBNONN
 137 : C PPj     XXX=XXX+SHP(1,NP)*XEL(1,NP)
 138 :           XXX=XXX+SHP(1,NP)*XEL(1,NP+NBNONN)
 139 : C PPj     YYY=YYY+SHP(1,NP)*XEL(2,NP)
 140 :           YYY=YYY+SHP(1,NP)*XEL(2,NP+NBNONN)
 141 :         ENDDO
 142 : C
 143 :         K=2*NBNO+1
 144 :         BGENE(4,K  )=1.D0
 145 :         BGENE(4,K+1)=XDPGE-XXX
 146 :         BGENE(4,K+2)=YYY-YDPGE
 147 :       ENDIF
 148 : C
 149 :       RETURN
 150 :       END
 151 : 
 152 :  
 153 :