Esope source files

   1 : C FAMO22    SOURCE    CHAT      11/03/16    21:22:01     6902           
   2 :       SUBROUTINE FAMO22(MELE,IPMAIL,MINTE,NBPTEL,
   3 :      1     IVAMAT,IVACAR,NMATT,NCARR,
   4 :      2     CRIGI,CMASS)
   5 : ***********************************************************************
   6 : *     CALCUL DES COMPOSANTES DE LA RIGIDITE (HOOK) ELASTIQUE
   7 : *     CALCUL DES COMPOSANTES DE LA MATRICE (HOOK) DE MASSE
   8 : *     .... AU SIGNE PRES
   9 : *     BOUCLE SUR LES SS-ZONES DU MODELE DE SECTION
  10 : **********************************************************************
  11 : * ENTREES :
  12 : *
  13 : * MELE    = NUMERO  ELEMENT FINI
  14 : * IPMAIL = POINTEUR DU MAILLAGE
  15 : * NBPTEL =NOMBRE DE POINTS PAR ELEMENT
  16 : * IVAMAT =POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  17 : * IVACAR =POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  18 : * NVARI  =NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  19 : * NMATT  =NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  20 : * NCARR  =NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  21 : *
  22 : * SORTIES :
  23 : * CRIGI(12) RIGIDITE SUR LA FIBRE MOYENNE
  24 : * CMASS(12) MASSE SUR LA FIBRE MOYENNE
  25 : *
  26 : *  D'APRES FRIGI2 DC 98
  27 : ************************************************************************
  28 :       IMPLICIT INTEGER(I-N)
  29 :       IMPLICIT REAL*8(A-H,O-Z)
  30 : *
  31 : -INC CCOPTIO
  32 : -INC SMCHAML
  33 : -INC SMELEME
  34 : -INC SMCOORD
  35 : -INC SMMODEL
  36 : -INC SMINTE
  37 : -INC CCHAMP
  38 : *
  39 :       SEGMENT MPTVAL
  40 :         INTEGER IPOS(NS)    ,NSOF(NS)
  41 :         INTEGER      IVAL(NCOSOU)
  42 :         CHARACTER*16 TYVAL(NCOSOU)
  43 :       ENDSEGMENT
  44 : *
  45 :       SEGMENT WRK0
  46 :        REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  47 :       ENDSEGMENT
  48 : *
  49 :       SEGMENT WRK2
  50 :         REAL*8 XE(3,NBBB),SHP(6,NBBB)
  51 :       ENDSEGMENT
  52 : *
  53 :       DIMENSION CRIGI(12),CMASS(12)
  54 : *
  55 :       MFR =NUMMFR(MELE)
  56 :       MELEME=IPMAIL
  57 :       NBNN=NUM(/1)
  58 :       NBELEM=NUM(/2)
  59 : *
  60 : *    SEGMENT D'INTEGRATION
  61 : *
  62 : C*    SEGACT,MINTE           <- ACTIF EN E/S
  63 : *
  64 : *    INITIALISATION DES SEGMENTS DE TRAVAIL
  65 : *
  66 :       NCXMAT=NMATT
  67 :       NCXCAR=NCARR
  68 :       NBBB=NBNN
  69 :       SEGINI WRK0,WRK2
  70 : *
  71 : *       BOUCLE SUR LES ELEMENTS
  72 : *
  73 :       DO 1000 IB=1,NBELEM
  74 : *
  75 : *       ON CHERCHE  LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  76 : *
  76 :          CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  77 : *
  78 : *       BOUCLE SUR LES POINTS DE GAUSS
  79 : *
  80 :          DO 1100 IGAU=1,NBPTEL
  81 : *
  82 : *       ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  83 : *
  84 :            YY=0.D0
  85 :            DO IE1=1,NBNN
  86 :              CGAUSS=SHPTOT(1,IE1,IGAU)
  87 :              YY=YY+XE(1,IE1)*CGAUSS
  88 :            END DO
  89 :            YY2=YY*YY
  90 : *
  91 : *       ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  92 : *
  93 :            DO IE2=1,NBNN
  94 :              DO IE1=1,6
  95 :                SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  96 :              END DO
  97 :            END DO
  97 : C PPf      CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  98 : *
  99 : *     ON RECUPERE LES CONSTANTES DU MATERIAU
 100 : *
 101 :            MPTVAL=IVAMAT
 102 :            DO IC=1,NMATT
 103 :                  MELVAL=IVAL(IC)
 104 :                  IF(IC.LT.3)THEN
 105 :                    IIC=IC
 106 :                  ELSEIF(IC.LT.(NMATT-2))THEN
 107 :                    IIC=IC+3
 108 :                  ELSEIF(IC.LE.(NMATT))THEN
 109 :                    IIC=5+IC-NMATT
 110 :                  ELSE
 111 :                  ENDIF
 112 :                  IF(MELVAL.NE.0)THEN
 113 :                     IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
 114 :                        IBMN=MIN(IB,VELCHE(/2))
 115 :                       IGMN=MIN(IGAU,VELCHE(/1))
 116 :                        XMAT(IIC)=VELCHE(IGMN,IBMN)
 117 :                     ELSE
 118 :                       IBMN=MIN(IB,IELCHE(/2))
 119 :                      IGMN=MIN(IGAU,IELCHE(/1))
 120 :                       XMAT(IIC)=IELCHE(IGMN,IBMN)
 121 :                     ENDIF
 122 :                  ELSE
 123 :                     XMAT(IIC)=0.D0
 124 :                     IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
 125 :                        XMAT(IIC)=0
 126 :                     END IF
 127 :                  ENDIF
 128 :            END DO
 129 : *
 130 : *     ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
 131 : *
 132 :            MPTVAL=IVACAR
 133 :            DO IC=1,NCARR
 134 :               MELVAL=IVAL(IC)
 135 :               IBMN=MIN(IB,VELCHE(/2))
 136 :               IGMN=MIN(IGAU,VELCHE(/1))
 137 :               XCAR(IC)=VELCHE(IGMN,IBMN)
 138 :            END DO
 139 : C+PPf
 140 : C
 141 : C     TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
 142 : C
 143 :            IF(MELE.EQ.167)THEN
 144 :              DJAC=XCAR(2)
 145 :            ELSEIF(MELE.EQ.166)THEN
 146 : C+DC on utilise le cas joi3
 146 :              CALL JACOBI(XE,SHP,86,NBNN,DJAC)
 147 :              DJAC=DJAC*XCAR(2)
 148 :            ELSE
 148 :              CALL JACOBI(XE,SHP,2,NBNN,DJAC)
 149 :            ENDIF
 150 : C+PPf
 151 : *
 152 : *     CONTRIBUTION A CRIGI
 153 : *
 154 :            PGAUSS=POIGAU(IGAU)*ABS(DJAC)
 155 : *
 156 :            YOUNG=XMAT(5)
 157 :            GAMMA=XMAT(5)/(2.*(1.+XMAT(2)))
 158 :            ALPH1=XCAR(1)
 159 :            CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS
 160 :            CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS
 161 :            CRIGI( 3)=CRIGI( 3)+YOUNG*YY2*PGAUSS
 162 : *
 163 :            CRIGI( 4)=CRIGI( 4)+ALPH1*GAMMA*PGAUSS
 164 : *
 165 : *     CONTRIBUTION A CMASS
 166 : *
 167 :            RHO=XMAT(3)
 168 : C
 169 :            CMASS( 1)=CMASS( 1)+RHO*PGAUSS
 170 :            CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS
 171 :            CMASS( 3)=CMASS( 3)+RHO*YY2*PGAUSS
 172 : *
 173 :            CMASS( 4)=CMASS( 4)+RHO*PGAUSS
 174 : C
 175 : C    FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
 176 : C
 177 : 1100     CONTINUE
 178 : C
 179 : C     FIN DE LA BOUCLE SUR LES ELEMENTS
 180 : C
 181 : 1000  CONTINUE
 182 : *
 183 : C*    SEGDES,MINTE           <- ACTIF EN E/S (NON MODIFIE)
 184 :       SEGSUP WRK0,WRK2
 185 : *
 186 :       RETURN
 187 :       END
 188 : 
 189 :  
 190 :