1 : C FROA3D SOURCE FANDEUR 11/07/19 21:16:06 7042 2 : 3 : SUBROUTINE FROA3D(IPOGEO,IPMATR,IPMINT,IVAMAT, 4 : 1 IVACAR,MELE,MFR,LRE,NDDL) 5 : C 6 : C*********************************************************************** 7 : C * 8 : C Routine appelée par FRVISQ. * 9 : C * 10 : C Calcule l'amortissement de frontière dans le cas 3D pour les * 11 : C massifs de face FAC3, FAC4, FAC6 ou FAC8. * 12 : C * 13 : C Entrées : * 14 : C -------- * 15 : C * 16 : C IPOGEO : pointeur sur le maillage de l'enveloppe des massifs, * 17 : C type MELEME * 18 : C IPMATR : pointeur sur le segment IMATRI, chapeau des rigidités * 19 : C élémentaires * 20 : C IPMINT : pointeur sur le segment d'intégration, type MINTE * 21 : C IVAMAT : pointeur sur un segment MPTVAL de données matériau * 22 : C IVACAR : pointeur sur un segment MPTVAL de caractéristiques * 23 : C (épaisseur dans le cas contraintes planes) * 24 : C MELE : numéro de l'élément fini associé à la face du massif * 25 : C MFR : numéro de la formulation * 26 : C LRE : taille de la matrice d'amortissement à construire * 27 : C NDDL : nombre de degrés de liberté * 28 : C * 29 : C Remplit le segment XMATRI pour chaque élément de la sous-zone. * 30 : C*********************************************************************** 31 : C 32 : IMPLICIT INTEGER(I-N) 33 : IMPLICIT REAL*8(A-H,O-Z) 34 : C 35 : -INC CCOPTIO 36 : C 37 : -INC SMRIGID 38 : -INC SMELEME 39 : -INC SMCOORD 40 : -INC SMCHAML 41 : -INC SMINTE 42 : C 43 : SEGMENT,MWORK 44 : REAL*8 XE(3,NBNN) 45 : REAL*8 REL(LRE,LRE) 46 : REAL*8 SHPWRK(6,NBNN),BGENE(NDDL,LRE) 47 : REAL*8 VALMAT(NV1) 48 : REAL*8 VECN(NDDL),VECT1(NDDL),VECT2(NDDL) 49 : REAL*8 XNNT(NDDL,NDDL),XTTT1(NDDL,NDDL),XTTT2(NDDL,NDDL) 50 : ENDSEGMENT 51 : C 52 : SEGMENT MPTVAL 53 : INTEGER IPOS(NS),NSOF(NS) 54 : INTEGER IVAL(NCOSOU) 55 : CHARACTER*16 TYVAL(NCOSOU) 56 : ENDSEGMENT 57 : 58 : IF (IFOUR.NE.2) THEN 58 : CALL ERREUR(21) 59 : RETURN 60 : ENDIF 61 : C 62 : MELEME=IPOGEO 63 : c* SEGACT MELEME 64 : NBNN=NUM(/1) 65 : NBELEM=NUM(/2) 66 : C 67 : MINTE=IPMINT 68 : c* SEGACT,MINTE 69 : NBPGAU=POIGAU(/1) 70 : C 71 : xMATRI=IPMATR 72 : c* SEGACT,xMATRI*MOD 73 : c* NLIGRD=LRE 74 : c* NLIGRP=LRE 75 : c* 76 : NV1=3 77 : SEGINI,MWORK 78 : C 79 : C boucle sur les éléments 80 : C 81 : DO 1 IB=1,NBELEM 82 : C 83 : C on cherche les coordonnées de l'élément IB 84 : C 84 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 84 : CALL ZERO(REL,LRE,LRE) 85 : C 86 : C boucle sur les points de Gauss 87 : C 88 : DO 10 IGAU=1,NBPGAU 89 : C 90 : C récupération des données matériau 91 : C 92 : MPTVAL=IVAMAT 93 : DO 11 J=1,3 94 : MELVAL=IVAL(J) 95 : IGMN=MIN(IGAU,VELCHE(/1)) 96 : IBMN=MIN(IB,VELCHE(/2)) 97 : VALMAT(J)=VELCHE(IGMN,IBMN) 98 : 11 CONTINUE 99 : C 100 : RHO=VALMAT(1) 101 : E=VALMAT(2) 102 : XNU=VALMAT(3) 103 : CS=E/(RHO*2.*(1+XNU)) 104 : CP=2*CS*(1-XNU)/(1-2*XNU) 105 : CP=SQRT(CP) 106 : CS=SQRT(CS) 107 : C 108 : C coefficients d'amortissement 109 : C 110 : RCP=RHO*CP 111 : RCS=RHO*CS 112 : C 113 : C calcul des vecteurs du plan tangent 114 : C 115 : VNQSI1=0.D0 116 : VNQSI2=0.D0 117 : VNQSI3=0.D0 118 : VNETA1=0.D0 119 : VNETA2=0.D0 120 : VNETA3=0.D0 121 : C 122 : DO 20 I=1,NBNN 123 : VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) 124 : VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) 125 : VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I) 126 : VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I) 127 : VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I) 128 : VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I) 129 : 20 CONTINUE 130 : C 131 : C calcul de VECN,VECT1,VECT2 et du jacobien 132 : C 133 : VECN(1)=VNQSI2*VNETA3-VNQSI3*VNETA2 134 : VECN(2)=VNQSI3*VNETA1-VNQSI1*VNETA3 135 : VECN(3)=VNQSI1*VNETA2-VNQSI2*VNETA1 136 : XNORM=VECN(1)**2+VECN(2)**2+VECN(3)**2 137 : XNORM=SQRT(XNORM) 138 : C 139 : DJAC0=XNORM*POIGAU(IGAU) 140 : C 141 : VECN(1)=VECN(1)/XNORM 142 : VECN(2)=VECN(2)/XNORM 143 : VECN(3)=VECN(3)/XNORM 144 : C 145 : XNORM1=VNQSI1**2+VNQSI2**2+VNQSI3**2 146 : XNORM1=SQRT(XNORM1) 147 : VECT1(1)=VNQSI1/XNORM1 148 : VECT1(2)=VNQSI2/XNORM1 149 : VECT1(3)=VNQSI3/XNORM1 150 : C 151 : VECT2(1)=VECT1(2)*VECN(3)-VECT1(3)*VECN(2) 152 : VECT2(2)=VECT1(3)*VECN(1)-VECT1(1)*VECN(3) 153 : VECT2(3)=VECT1(1)*VECN(2)-VECT1(2)*VECN(1) 154 : C 155 : C calcul des matrices nnT, ttT1, et ttT2 156 : C 157 : DO 30 I=1,NDDL 158 : DO 31 J=1,NDDL 159 : XNNT(I,J)=VECN(I)*VECN(J) 160 : XTTT1(I,J)=VECT1(I)*VECT1(J) 161 : XTTT2(I,J)=VECT2(I)*VECT2(J) 162 : 31 CONTINUE 163 : 30 CONTINUE 164 : C 165 : C calcul de la matrice N des fonctions de forme 166 : C 167 : XDPGE=0.D0 168 : YDPGE=0.D0 168 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 169 : & DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 170 : C 171 : C construction de la matrice d'amortissement 172 : C 173 : DJACN=DJAC0*RCP 173 : CALL BDBST(BGENE,DJACN,XNNT,LRE,NDDL,REL) 174 : 175 : DJACT=DJAC0*RCS 175 : CALL BDBST(BGENE,DJACT,XTTT1,LRE,NDDL,REL) 175 : CALL BDBST(BGENE,DJACT,XTTT2,LRE,NDDL,REL) 176 : C 177 : 10 CONTINUE 178 : C 179 : C remplissage de XMATRI 180 : C 180 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 181 : C 182 : 1 CONTINUE 183 : C 184 : SEGSUP,MWORK 185 : 186 : c* SEGDES MELEME,MINTE,xMATRI 187 : 188 : RETURN 189 : END 190 : 191 :
© Cast3M 2003 - All rights reserved.
Disclaimer