1 : C FSMA3D SOURCE FANDEUR 12/07/18 21:15:41 7434 2 : 3 : SUBROUTINE FSMA3D(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVAFOR) 4 : C 5 : C____________________________________________________________________ 6 : C 7 : C CALCULE LES FORCES SURFACIQUES SUR LES FACES D ELEMENTS 8 : C MASSIFS TRIDIMENSIONNELS 9 : C 10 : C ENTREES : 11 : C --------- 12 : C 13 : C IPT TABLEAU DE POINTEUR SUR UN MPTVAL CONTENANT LES FORCES 14 : C APPLIQUEES 15 : C 0 SI ON A DONNE UNE FORCE CONSTANTE 16 : C IPMAIL POINTEUR SUR UN OBJET GEOMETRIQUE 17 : C IPTINT POINTEUR SUR UN MINTE CONTENANT LES POINTS D INTEGRATION 18 : C IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE 19 : C VEC VECTEUR REPRESENTANT LA FORCE 20 : C IVAFOR POINTEUR SUR UN MPTVAL ET LES MELVAL CONTENANT LES FORCES 21 : C NODALES RESUL 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 : 30 : -INC SMCHAML 31 : -INC SMELEME 32 : -INC SMINTE 33 : -INC SMCOORD 34 : C 35 : SEGMENT MPTVAL 36 : INTEGER IPOS(NS) ,NSOF(NS) 37 : INTEGER IVAL(NCOSOU) 38 : CHARACTER*16 TYVAL(NCOSOU) 39 : ENDSEGMENT 40 : C 41 : SEGMENT WORK 42 : REAL*8 XE(3,NBNN) 43 : ENDSEGMENT 44 : C 45 : DIMENSION VEC(*),IPT(*) 46 : C 47 : MELVA1 = IPT(1) 48 : MELVA2 = IPT(2) 49 : MELVA3 = IPT(3) 50 : IF (IPVECT.EQ.0) THEN 51 : IF (MELVA1.NE.0) THEN 52 : SEGACT,MELVA1 53 : IGM1 = MELVA1.VELCHE(/1) 54 : IBM1 = MELVA1.VELCHE(/2) 55 : ENDIF 56 : IF (MELVA2.NE.0) THEN 57 : SEGACT,MELVA2 58 : IGM2 = MELVA2.VELCHE(/1) 59 : IBM2 = MELVA2.VELCHE(/2) 60 : ENDIF 61 : IF (MELVA3.NE.0) THEN 62 : SEGACT,MELVA3 63 : IGM3 = MELVA3.VELCHE(/1) 64 : IBM3 = MELVA3.VELCHE(/2) 65 : ENDIF 66 : AUX1 = 0.D0 67 : AUX2 = 0.D0 68 : AUX3 = 0.D0 69 : ELSE 70 : AUX1 = VEC(1) 71 : AUX2 = VEC(2) 72 : AUX3 = VEC(3) 73 : ENDIF 74 : C 75 : MINTE=IPTINT 76 : C* SEGACT,MINTE <- ACTIF EN E/S (NON MODIFIE) 77 : NBPGAU=POIGAU(/1) 78 : C 79 : MELEME=IPMAIL 80 : C* SEGACT,MELEME <- ACTIF EN E/S (NON MODIFIE) 81 : NBNN =NUM(/1) 82 : NBELEM=NUM(/2) 83 : C 84 : SEGINI,WORK 85 : C 86 : C BOUCLE SUR LES ELEMENTS 87 : C 88 : DO 1 IB = 1, NBELEM 89 : C 89 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 90 : 91 : IF (IPVECT.EQ.0) THEN 92 : IF (MELVA1.NE.0) IB1 = MIN(IB,IBM1) 93 : IF (MELVA2.NE.0) IB2 = MIN(IB,IBM2) 94 : IF (MELVA3.NE.0) IB3 = MIN(IB,IBM3) 95 : ENDIF 96 : C 97 : C BOUCLE SUR LES POINTS DE GAUSS 98 : C 99 : DO 10 IGAU=1,NBPGAU 100 : C 101 : C 102 : C BOUCLE SUR LES NOEUDS 103 : C 104 : VNQSI1 = 0.D0 105 : VNQSI2 = 0.D0 106 : VNQSI3 = 0.D0 107 : VNETA1 = 0.D0 108 : VNETA2 = 0.D0 109 : VNETA3 = 0.D0 110 : DO 20 I = 1,NBNN 111 : VNQSI1=VNQSI1+SHPTOT(2,I,IGAU)*XE(1,I) 112 : VNQSI2=VNQSI2+SHPTOT(2,I,IGAU)*XE(2,I) 113 : VNQSI3=VNQSI3+SHPTOT(2,I,IGAU)*XE(3,I) 114 : VNETA1=VNETA1+SHPTOT(3,I,IGAU)*XE(1,I) 115 : VNETA2=VNETA2+SHPTOT(3,I,IGAU)*XE(2,I) 116 : VNETA3=VNETA3+SHPTOT(3,I,IGAU)*XE(3,I) 117 : 20 CONTINUE 118 : VNOR1 = VNQSI2*VNETA3-VNQSI3*VNETA2 119 : VNOR2 = VNQSI3*VNETA1-VNQSI1*VNETA3 120 : VNOR3 = VNQSI1*VNETA2-VNQSI2*VNETA1 121 : r_z = POIGAU(IGAU) * SQRT(VNOR1*VNOR1+VNOR2*VNOR2+VNOR3*VNOR3) 122 : C 123 : IF (IPVECT.EQ.0) THEN 124 : IF (MELVA1.NE.0) THEN 125 : IGMN = MIN(IGAU,IGM1) 126 : AUX1 = MELVA1.VELCHE(IGMN,IB1) 127 : ENDIF 128 : IF (MELVA2.NE.0) THEN 129 : IGMN = MIN(IGAU,IGM2) 130 : AUX2 = MELVA2.VELCHE(IGMN,IB2) 131 : ENDIF 132 : IF (MELVA3.NE.0) THEN 133 : IGMN = MIN(IGAU,IGM3) 134 : AUX3 = MELVA3.VELCHE(IGMN,IB3) 135 : ENDIF 136 : ENDIF 137 : * 138 : T1 = r_z * AUX1 139 : T2 = r_z * AUX2 140 : T3 = r_z * AUX3 141 : C 142 : MPTVAL=IVAFOR 143 : DO 30 J=1,NBNN 144 : r_z = SHPTOT(1,J,IGAU) 145 : MELVAL = IVAL(1) 146 : VELCHE(J,IB) = VELCHE(J,IB) + r_z * T1 147 : MELVAL = IVAL(2) 148 : VELCHE(J,IB) = VELCHE(J,IB) + r_z * T2 149 : MELVAL = IVAL(3) 150 : VELCHE(J,IB) = VELCHE(J,IB) + r_z * T3 151 : 30 CONTINUE 152 : 153 : 10 CONTINUE 154 : 155 : 1 CONTINUE 156 : 157 : SEGSUP WORK 158 : 159 : IF (IPVECT.EQ.0) THEN 160 : IF (MELVA1.NE.0) SEGDES,MELVA1 161 : IF (MELVA2.NE.0) SEGDES,MELVA2 162 : IF (MELVA3.NE.0) SEGDES,MELVA3 163 : ENDIF 164 : C* SEGDES,MELEME <- ACTIF EN E/S (NON MODIFIE) 165 : C* SEGDES,MINTE <- ACTIF EN E/S (NON MODIFIE) 166 : 167 : RETURN 168 : END 169 : 170 :
© Cast3M 2003 - All rights reserved.
Disclaimer