1 : C FROA2D SOURCE FANDEUR 11/07/19 21:16:05 7042 2 : 3 : SUBROUTINE FROA2D(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 2D pour les * 11 : C massifs de face SEG2 ou SEG3. * 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 CCREEL 36 : *- 37 : -INC CCOPTIO 38 : -INC SMRIGID 39 : -INC SMELEME 40 : -INC SMCOORD 41 : -INC SMCHAML 42 : -INC SMINTE 43 : C 44 : SEGMENT MWORK 45 : REAL*8 XE(3,NBNN) 46 : REAL*8 REL(LRE,LRE) 47 : REAL*8 SHPWRK(6,NBNN),BGENE(NDDL,LRE) 48 : REAL*8 VALMAT(NV1) 49 : REAL*8 VECN(NDDL),VECT1(NDDL),VECT2(NDDL) 50 : REAL*8 XNNT(NDDL,NDDL),XTTT1(NDDL,NDDL),XTTT2(NDDL,NDDL) 51 : ENDSEGMENT 52 : C 53 : SEGMENT MPTVAL 54 : INTEGER IPOS(NS),NSOF(NS) 55 : INTEGER IVAL(NCOSOU) 56 : CHARACTER*16 TYVAL(NCOSOU) 57 : ENDSEGMENT 58 : C 59 : MELEME=IPOGEO 60 : c* SEGACT,MELEME 61 : NBNN=NUM(/1) 62 : NBELEM=NUM(/2) 63 : * 64 : MINTE=IPMINT 65 : c* SEGACT,MINTE 66 : NBPGAU=POIGAU(/1) 67 : C 68 : NV1=3 69 : C 70 : DIM3=1.D0 71 : C 72 : xMATRI=IPMATR 73 : c* SEGACT,xMATRI*MOD 74 : c* NLIGRD=LRE 75 : c* NLIGRP=LRE 76 : * 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 de l'épaisseur 91 : C 92 : IF (IFOUR.EQ.-2) THEN 93 : MPTVAL=IVACAR 94 : IF (IVACAR.NE.0) THEN 95 : MELVAL=IVAL(1) 96 : IF (MELVAL.NE.0) THEN 97 : IGMN=MIN(IGAU,VELCHE(/1)) 98 : IBMN=MIN(IB,VELCHE(/2)) 99 : DIM3=VELCHE(IGMN,IBMN) 100 : ELSE 101 : DIM3=1.D0 102 : ENDIF 103 : ENDIF 104 : ENDIF 105 : C 106 : C récupération des données matériau 107 : C 108 : MPTVAL=IVAMAT 109 : DO 11 J=1,3 110 : MELVAL=IVAL(J) 111 : IGMN=MIN(IGAU,VELCHE(/1)) 112 : IBMN=MIN(IB,VELCHE(/2)) 113 : VALMAT(J)=VELCHE(IGMN,IBMN) 114 : 11 CONTINUE 115 : C 116 : RHO=VALMAT(1) 117 : E=VALMAT(2) 118 : XNU=VALMAT(3) 119 : CS=E/(2*(1+XNU)*RHO) 120 : IF (IFOUR.EQ.-2) THEN 121 : CP=SQRT(E/(RHO*(1-XNU*XNU))) 122 : ELSE 123 : CP=SQRT(2*CS*(1-XNU)/(1-2*XNU)) 124 : ENDIF 125 : CS=SQRT(CS) 126 : C 127 : C coefficients d'amortissement 128 : C 129 : RCP=RHO*CP 130 : RCS=RHO*CS 131 : C 132 : C calcul de la tangente locale normalisée 133 : C 134 : VNQSI1=0.D0 135 : VNQSI2=0.D0 136 : DO 20 I=1,NBNN 137 : VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) 138 : VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) 139 : 20 CONTINUE 140 : XNORM=SQRT(VNQSI1*VNQSI1+VNQSI2*VNQSI2) 141 : VECT1(1)=VNQSI1/XNORM 142 : VECT1(2)=VNQSI2/XNORM 143 : IF(IFOUR.EQ.1) VECT1(3)=0.D0 144 : C 145 : C calcul de la normale 146 : C 147 : VECN(1)=-VECT1(2) 148 : VECN(2)=VECT1(1) 149 : IF(IFOUR.EQ.1) VECN(3)=0.D0 150 : C 151 : C calcul des matrices nnT et ttT1 152 : C 153 : DO 30 I=1,NDDL 154 : DO 31 J=1,NDDL 155 : XNNT(I,J)=VECN(I)*VECN(J) 156 : XTTT1(I,J)=VECT1(I)*VECT1(J) 157 : 31 CONTINUE 158 : 30 CONTINUE 159 : C 160 : C calcul du deuxième vecteur tangent dans le cas du mode Fourier 161 : C et de la matrice ttT2 associee 162 : C 163 : IF (IFOUR.EQ.1) THEN 164 : VECT2(1)=0.D0 165 : VECT2(2)=0.D0 166 : VECT2(3)=1.D0 167 : DO I=1,NDDL 168 : DO J=1,NDDL 169 : XTTT2(I,J)=VECT2(I)*VECT2(J) 170 : ENDDO 171 : ENDDO 172 : ENDIF 173 : C 174 : C calcul de la matrice N des fonctions de forme 175 : C 176 : XDPGE=0.D0 177 : YDPGE=0.D0 177 : CALL NMATST(IGAU,MELE,MFR,NBNN,LRE,IFOUR,NIFOUR,NDDL, 178 : 1 DIM3,XE,SHPTOT,SHPWRK,BGENE,DJAC,XDPGE,YDPGE) 179 : C 180 : C calcul du jacobien 181 : C 182 : DXDQSI=0.D0 183 : DYDQSI=0.D0 184 : DO 40 I=1,NBNN 185 : DXDQSI=DXDQSI+SHPTOT(2,I,IGAU)*XE(1,I) 186 : DYDQSI=DYDQSI+SHPTOT(2,I,IGAU)*XE(2,I) 187 : 40 CONTINUE 188 : DJAC=SQRT(DXDQSI*DXDQSI+DYDQSI*DYDQSI) 189 : C 190 : C calcul de l'élément de volume 191 : C 192 : IF (IFOUR.LT.0) THEN 193 : R=1.D0 194 : IF (IFOUR.EQ.-2) R=DIM3 195 : ELSE 196 : R=0.D0 197 : DO I=1,NBNN 198 : R=R+SHPTOT(1,I,IGAU)*XE(1,I) 199 : ENDDO 200 : IF (IFOUR.EQ.0.OR.(IFOUR.EQ.1 201 : & .AND.NIFOUR.EQ.0)) THEN 202 : R=2*XPI*R 203 : ELSEIF (IFOUR.EQ.1.AND.NIFOUR.NE.0) THEN 204 : R=XPI*R 205 : ENDIF 206 : ENDIF 207 : C 208 : C construction de la matrice d'amortissement 209 : C 210 : DJACN=ABS(DJAC)*RCP*POIGAU(IGAU)*R 210 : CALL BDBST(BGENE,DJACN,XNNT,LRE,NDDL,REL) 211 : 212 : DJACT=ABS(DJAC)*RCS*POIGAU(IGAU)*R 212 : CALL BDBST(BGENE,DJACT,XTTT1,LRE,NDDL,REL) 213 : C 214 : C cas du mode Fourier 215 : C 216 : IF (IFOUR.EQ.1) THEN 216 : CALL BDBST(BGENE,DJACT,XTTT2,LRE,NDDL,REL) 217 : ENDIF 218 : C 219 : 10 CONTINUE 220 : C 221 : C remplissage de XMATRI 222 : C 222 : CALL REMPMT(REL,LRE,RE(1,1,ib)) 223 : C 224 : 1 CONTINUE 225 : 226 : SEGSUP,MWORK 227 : c* SEGDES,xMATRI,MINTE,MELEME 228 : 229 : RETURN 230 : END 231 : 232 :
© Cast3M 2003 - All rights reserved.
Disclaimer