Esope source files

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