1 : C FSMA2D SOURCE FANDEUR 12/07/18 21:15:40 7434 2 : 3 : SUBROUTINE FSMA2D(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVAFOR,IVACAR) 4 : C 5 : C____________________________________________________________________ 6 : C CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS 7 : C MASSIFS BIDIMENSIONNELS 8 : C 9 : C ENTREES : 10 : C --------- 11 : C 12 : C IPT TABLEAU DE POINTEUR SUR UN MELVAL CONTENANT LES FORCES 13 : C APPLIQUEES 14 : C 0 SI ON A DONNE UN VECTEUR CONSTANT 15 : C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE 16 : C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION 17 : C IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE 18 : C VEC VECTEUR REPRESENTANT LA FORCE 19 : C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVALS CONTENANT LES FORCES 20 : C NODALES RESULTANTES 21 : C IVACAR POINTEUR SUR UN MELVAL DE CARACTERISTIQUES 22 : C 23 : C____________________________________________________________________ 24 : C 25 : IMPLICIT INTEGER(I-N) 26 : IMPLICIT REAL*8(A-H,O-Z) 27 : C 28 : -INC CCOPTIO 29 : -INC CCREEL 30 : 31 : -INC SMCHAML 32 : -INC SMELEME 33 : -INC SMINTE 34 : -INC SMCOORD 35 : C 36 : SEGMENT WORK 37 : REAL*8 XE(3,NBNN) 38 : ENDSEGMENT 39 : C 40 : SEGMENT MPTVAL 41 : INTEGER IPOS(NS) ,NSOF(NS) 42 : INTEGER IVAL(NCOSOU) 43 : CHARACTER*16 TYVAL(NCOSOU) 44 : ENDSEGMENT 45 : C 46 : DIMENSION VEC(*),IPT(*) 47 : C 48 : C= Quelques constantes (2.Pi) 49 : PARAMETER (X2Pi=6.283185307179586476925286766559D0) 50 : C 51 : MELVA1 = IPT(1) 52 : MELVA2 = IPT(2) 53 : IF (IPVECT.EQ.0) THEN 54 : IF (MELVA1.NE.0) THEN 55 : SEGACT,MELVA1 56 : IGM1 = MELVA1.VELCHE(/1) 57 : IBM1 = MELVA1.VELCHE(/2) 58 : ENDIF 59 : IF (MELVA2.NE.0) THEN 60 : SEGACT,MELVA2 61 : IGM2 = MELVA2.VELCHE(/1) 62 : IBM2 = MELVA2.VELCHE(/2) 63 : ENDIF 64 : V1 = XZero 65 : V2 = XZero 66 : ELSE 67 : V1 = VEC(1) 68 : V2 = VEC(2) 69 : ENDIF 70 : C 71 : MINTE=IPTINT 72 : C* SEGACT MINTE <- ACTIF EN E/S (NON MODIFIE) 73 : NBPGAU=POIGAU(/1) 74 : C 75 : MELEME=IPMAIL 76 : C* SEGACT,MELEME <- ACTIF EN E/S (NON MODIFIE) 77 : NBNN =NUM(/1) 78 : NBELEM=NUM(/2) 79 : C 80 : SEGINI,WORK 81 : C 82 : C RECUPERATION DE L'EPAISSEUR (CONTRAINTES PLANES) : 83 : C 84 : DIM3 = 1.D0 85 : MELVA6 = 0 86 : IF (IFOUR.EQ.-2) THEN 87 : IF (IVACAR.NE.0) THEN 88 : MPTVAL = IVACAR 89 : MELVA6 = IVAL(1) 90 : IF (MELVA6.NE.0) THEN 91 : IGEP = MELVA6.VELCHE(/1) 92 : IBEP = MELVA6.VELCHE(/2) 93 : ENDIF 94 : ENDIF 95 : ENDIF 96 : C 97 : C BOUCLE SUR LES ELEMENTS 98 : C 99 : DO 1 IB=1,NBELEM 100 : C 100 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 101 : C 102 : IF (MELVA6.NE.0) IBME = MIN(IB,IBEP) 103 : IF (IPVECT.EQ.0) THEN 104 : IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1) 105 : IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2) 106 : ENDIF 107 : C 108 : C BOUCLE SUR LES POINTS DE GAUSS 109 : C 110 : DO 10 IGAU=1,NBPGAU 111 : C 112 : C RECUPERATION DE L'EPAISSEUR 113 : C 114 : IF (MELVA6.NE.0) THEN 115 : IGMN = MIN(IGAU,IGEP) 116 : DIM3 = MELVA6.VELCHE(IGMN,IBME) 117 : ENDIF 118 : C 119 : VNQSI1=0.D0 120 : VNQSI2=0.D0 121 : DO 20 I=1,NBNN 122 : VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) 123 : VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) 124 : 20 CONTINUE 125 : ZN = SQRT(VNQSI1*VNQSI1 + VNQSI2*VNQSI2) 126 : X = VNQSI1 / ZN 127 : Y = VNQSI2 / ZN 128 : 129 : IF (IFOUR.LT.0) THEN 130 : IF (IFOUR.EQ.-2) THEN 131 : R = DIM3 132 : ELSE 133 : R = 1.D0 134 : ENDIF 135 : ELSE 136 : R=0.D0 137 : DO 21 I=1,NBNN 138 : R = R + SHPTOT(1,I,IGAU)*XE(1,I) 139 : 21 CONTINUE 140 : IF (IFOUR.EQ.0) THEN 141 : R = X2Pi*R 142 : C* ELSE IF (IFOUR.EQ.1) THEN 143 : ELSE 144 : IF (NIFOUR.EQ.0) THEN 145 : R = X2Pi*R 146 : ELSE 147 : R = XPI*R 148 : ENDIF 149 : ENDIF 150 : ENDIF 151 : WGPGAU = POIGAU(IGAU)*R 152 : * 153 : IF (IPVECT.EQ.0) THEN 154 : IF (MELVA1.NE.0) THEN 155 : IGMN = MIN(IGAU,IGM1) 156 : V1 = MELVA1.VELCHE(IGMN,IB1) 157 : ENDIF 158 : IF (MELVA2.NE.0) THEN 159 : IGMN = MIN(IGAU,IGM2) 160 : V2 = MELVA2.VELCHE(IGMN,IB2) 161 : ENDIF 162 : ENDIF 163 : 164 : * changement de repere du vecteur force 165 : VECT = X*V1 + Y*V2 166 : VECN = X*V2 - Y*V1 167 : T1 = WGPGAU * ( VNQSI1*VECT - VNQSI2*VECN ) 168 : T2 = WGPGAU * ( VNQSI1*VECN + VNQSI2*VECT ) 169 : C 170 : MPTVAL = IVAFOR 171 : DO 30 J = 1, NBNN 172 : MELVAL=IVAL(1) 173 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T1 174 : MELVAL=IVAL(2) 175 : VELCHE(J,IB)=VELCHE(J,IB)+SHPTOT(1,J,IGAU)*T2 176 : 30 CONTINUE 177 : C 178 : 10 CONTINUE 179 : 180 : 1 CONTINUE 181 : 182 : C* SEGDES,MELEME <- ACTIF EN E/S (NON MODIFIE) 183 : C* SEGDES MINTE <- ACTIF EN E/S (NON MODIFIE) 184 : SEGSUP,WORK 185 : IF (IPVECT.EQ.0) THEN 186 : IF (MELVA1.NE.0) SEGDES,MELVA1 187 : IF (MELVA2.NE.0) SEGDES,MELVA2 188 : ENDIF 189 : 190 : RETURN 191 : END 192 : 193 :
© Cast3M 2003 - All rights reserved.
Disclaimer