1 : C FRIGI2 SOURCE CHAT 12/04/06 21:15:16 7348 2 : SUBROUTINE FRIGI2(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 : ************************************************************************ 27 : * Pierre Pegon (ISPRA) Juillet/Aout 1993 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 : ZZ=ZZ+XE(2,IE1)*CGAUSS 92 : END DO 93 : YY2=YY*YY 94 : ZZ2=ZZ*ZZ 95 : * 96 : * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN 97 : * 98 : DO IE1=1,6 99 : DO IE2=1,NBNN 100 : SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU) 101 : END DO 102 : END DO 102 : C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC) 103 : * 104 : * ON RECUPERE LES CONSTANTES DU MATERIAU 105 : * 106 : MPTVAL=IVAMAT 107 : DO IC=1,NMATT 108 : MELVAL=IVAL(IC) 109 : IF(IC.LT.3)THEN 110 : IIC=IC 111 : ELSEIF(IC.LT.(NMATT-2))THEN 112 : IIC=IC+3 113 : ELSEIF(IC.LE.(NMATT))THEN 114 : IIC=5+IC-NMATT 115 : ELSE 116 : ENDIF 117 : IF(MELVAL.NE.0)THEN 118 : IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN 119 : IBMN=MIN(IB,VELCHE(/2)) 120 : IGMN=MIN(IGAU,VELCHE(/1)) 121 : XMAT(IIC)=VELCHE(IGMN,IBMN) 122 : ELSE 123 : IBMN=MIN(IB,IELCHE(/2)) 124 : IGMN=MIN(IGAU,IELCHE(/1)) 125 : XMAT(IIC)=IELCHE(IGMN,IBMN) 126 : ENDIF 127 : ELSE 128 : XMAT(IIC)=0.D0 129 : IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN 130 : XMAT(IIC)=0.D0 131 : END IF 132 : ENDIF 133 : END DO 134 : * 135 : * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES 136 : * 137 : MPTVAL=IVACAR 138 : DO IC=1,NCARR 139 : MELVAL=IVAL(IC) 140 : IF(MELVAL.NE.0)THEN 141 : IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN 142 : IBMN=MIN(IB,VELCHE(/2)) 143 : IGMN=MIN(IGAU,VELCHE(/1)) 144 : XCAR(IC)=VELCHE(IGMN,IBMN) 145 : ELSE 146 : IBMN=MIN(IB,IELCHE(/2)) 147 : IGMN=MIN(IGAU,IELCHE(/1)) 148 : XCAR(IC)=IELCHE(IGMN,IBMN) 149 : ENDIF 150 : ELSE 151 : XCAR(IC)=0.D0 152 : IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN 153 : XCAR(IC)=0.D0 154 : END IF 155 : ENDIF 156 : * 157 : END DO 158 : C+PPf 159 : C 160 : C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167) 161 : C 162 : IF(MELE.EQ.167)THEN 163 : DJAC=XCAR(3) 164 : ELSEIF(MELE.EQ.166)THEN 165 : C+DC on utilise le cas joi3 165 : CALL JACOBI(XE,SHP,86,NBNN,DJAC) 166 : DJAC= DJAC*XCAR(3) 167 : ELSE 167 : CALL JACOBI(XE,SHP,2,NBNN,DJAC) 168 : ENDIF 169 : 170 : C+PPf 171 : * 172 : * CONTRIBUTION A CRIGI 173 : * 174 : PGAUSS=POIGAU(IGAU)*ABS(DJAC) 175 : * 176 : YOUNG=XMAT(1) 177 : GAMMA=XMAT(1)/2.D0/(1.D0+XMAT(2)) 178 : ALPH1=XCAR(1) 179 : ALPH2=XCAR(2) 180 : CRIGI( 1)=CRIGI( 1)+YOUNG*PGAUSS 181 : CRIGI( 2)=CRIGI( 2)+YOUNG*YY*PGAUSS 182 : CRIGI( 3)=CRIGI( 3)+YOUNG*ZZ*PGAUSS 183 : CRIGI( 4)=CRIGI( 4)+YOUNG*YY2*PGAUSS 184 : CRIGI( 5)=CRIGI( 5)+YOUNG*YY*ZZ*PGAUSS 185 : CRIGI( 6)=CRIGI( 6)+YOUNG*ZZ2*PGAUSS 186 : * 187 : CRIGI( 7)=CRIGI( 7)+ALPH2*GAMMA*PGAUSS 188 : CRIGI( 8)=CRIGI( 8)+ALPH1*GAMMA*PGAUSS 189 : CRIGI( 9)=CRIGI( 9)+ALPH2*GAMMA*YY*PGAUSS 190 : CRIGI(10)=CRIGI(10)+ALPH1*GAMMA*ZZ*PGAUSS 191 : CRIGI(11)=CRIGI(11)+ALPH2*GAMMA*YY2*PGAUSS 192 : CRIGI(12)=CRIGI(12)+ALPH1*GAMMA*ZZ2*PGAUSS 193 : * 194 : * CONTRIBUTION A CMASS 195 : * 196 : * 197 : RHO=XMAT(3) 198 : C 199 : C 200 : C RHO=XMAT(NMATT) 201 : C 202 : CMASS( 1)=CMASS( 1)+RHO*PGAUSS 203 : CMASS( 2)=CMASS( 2)+RHO*YY*PGAUSS 204 : CMASS( 3)=CMASS( 3)+RHO*ZZ*PGAUSS 205 : CMASS( 4)=CMASS( 4)+RHO*YY2*PGAUSS 206 : CMASS( 5)=CMASS( 5)+RHO*YY*ZZ*PGAUSS 207 : CMASS( 6)=CMASS( 6)+RHO*ZZ2*PGAUSS 208 : * 209 : CMASS( 7)=CMASS( 7)+RHO*PGAUSS 210 : CMASS( 8)=CMASS( 8)+RHO*PGAUSS 211 : CMASS( 9)=CMASS( 9)+RHO*YY*PGAUSS 212 : CMASS(10)=CMASS(10)+RHO*ZZ*PGAUSS 213 : CMASS(11)=CMASS(11)+RHO*YY2*PGAUSS 214 : CMASS(12)=CMASS(12)+RHO*ZZ2*PGAUSS 215 : C 216 : C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS 217 : C 218 : 1100 CONTINUE 219 : C 220 : C FIN DE LA BOUCLE SUR LES ELEMENTS 221 : C 222 : 1000 CONTINUE 223 : * 224 : SEGDES,MINTE 225 : SEGSUP WRK0,WRK2 226 : * 227 : RETURN 228 : END 229 : 230 : 231 : 232 : 233 : 234 : 235 : 236 : 237 : 238 : 239 : 240 : 241 : 242 : 243 : 244 : 245 : 246 : 247 :
© Cast3M 2003 - All rights reserved.
Disclaimer