1 : C FSCO3D SOURCE FANDEUR 12/07/18 21:15:38 7434 2 : 3 : SUBROUTINE FSCO3D(IPT,IPMAIL,IPVECT,VEC, IVAFOR) 4 : 5 : C____________________________________________________________________ 6 : C 7 : C CALCULE LES FORCES SURFACIQUES POUR LES COQUES 3D 8 : C 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 OBJET GEOMETRIQUE 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 MELVALS ASSOCIEES AUX FORCES 20 : C NODALE RESULTANTES 21 : C____________________________________________________________________ 22 : C 23 : IMPLICIT INTEGER(I-N) 24 : IMPLICIT REAL*8(A-H,O-Z) 25 : C 26 : -INC CCOPTIO 27 : C 28 : -INC SMCHAML 29 : -INC SMELEME 30 : -INC SMCOORD 31 : C 32 : SEGMENT MPTVAL 33 : INTEGER IPOS(NS) ,NSOF(NS) 34 : INTEGER IVAL(NCOSOU) 35 : CHARACTER*16 TYVAL(NCOSOU) 36 : ENDSEGMENT 37 : C 38 : DIMENSION VEC(*),IPT(*) 39 : 40 : DIMENSION XE(3,3),XEL(3,3),BPSS(3,3),BB(9),FT(18),F(6) 41 : DIMENSION XX(3),YY(3) 42 : C 43 : DATA XX/0.5D0,0.5D0,0.0D0/ 44 : DATA YY/0.0D0,0.5D0,0.5D0/ 45 : PARAMETER (X1s3 = 0.333333333333333333333333333333333333333333D0 , 46 : & X1s6 = 0.166666666666666666666666666666666666666667D0 ) 47 : C 48 : MELVA1 = IPT(1) 49 : MELVA2 = IPT(2) 50 : MELVA3 = IPT(3) 51 : IF (IPVECT.EQ.0) THEN 52 : V1 = 0.D0 53 : V2 = 0.D0 54 : V3 = 0.D0 55 : IF (MELVA1.NE.0) THEN 56 : SEGACT,MELVA1 57 : IGM1 = MIN(3,MELVA1.VELCHE(/1)) 58 : IBM1 = MELVA1.VELCHE(/2) 59 : ENDIF 60 : IF (MELVA2.NE.0) THEN 61 : SEGACT,MELVA2 62 : IGM2 = MIN(3,MELVA2.VELCHE(/1)) 63 : IBM2 = MELVA2.VELCHE(/2) 64 : ENDIF 65 : IF (MELVA3.NE.0) THEN 66 : SEGACT,MELVA3 67 : IGM3 = MIN(3,MELVA3.VELCHE(/1)) 68 : IBM3 = MELVA3.VELCHE(/2) 69 : ENDIF 70 : ELSE 71 : V1 = VEC(1) 72 : V2 = VEC(2) 73 : V3 = VEC(3) 74 : ENDIF 75 : C 76 : MELEME=IPMAIL 77 : C* SEGACT,MELEME (<- actif en E/S et non modifie) 78 : NBELEM = NUM(/2) 79 : C 80 : C BOUCLE SUR LES ELEMENTS 81 : C 82 : DO 1000 IB = 1, NBELEM 83 : 84 : C Force moyenne sur l'element 85 : IF (IPVECT.EQ.0) THEN 86 : IF (MELVA1.NE.0) THEN 87 : IBMN = MIN(IB,IBM1) 88 : IF (IGM1.GT.1) THEN 89 : V1 = ( MELVA1.VELCHE(1,IBMN) + MELVA1.VELCHE(2,IBMN) 90 : & + MELVA1.VELCHE(3,IBMN) ) * X1s3 91 : ELSE 92 : V1 = MELVA1.VELCHE(1,IBMN) 93 : ENDIF 94 : ENDIF 95 : IF (MELVA2.NE.0) THEN 96 : IBMN = MIN(IB,IBM2) 97 : IF (IGM2.GT.1) THEN 98 : V2 = ( MELVA2.VELCHE(1,IBMN) + MELVA2.VELCHE(2,IBMN) 99 : & + MELVA2.VELCHE(3,IBMN) ) * X1s3 100 : ELSE 101 : V2 = MELVA2.VELCHE(1,IBMN) 102 : ENDIF 103 : ENDIF 104 : IF (MELVA3.NE.0) THEN 105 : IBMN = MIN(IB,IBM3) 106 : IF (IGM3.GT.1) THEN 107 : V3 = ( MELVA3.VELCHE(1,IBMN) + MELVA3.VELCHE(2,IBMN) 108 : & + MELVA3.VELCHE(3,IBMN) ) * X1s3 109 : ELSE 110 : V3 = MELVA3.VELCHE(1,IBMN) 111 : ENDIF 112 : ENDIF 113 : ENDIF 114 : C 114 : CALL DOXE(XCOOR,IDIM,3,NUM,IB,XE) 115 : C 116 : C MATRICE DE PASSAGE 117 : C 117 : CALL VPAST(XE,BPSS) 118 : C 119 : C COORDONNEES LOCALES 120 : C 120 : CALL VCORLC(XE,XEL,BPSS) 121 : C 122 : C chgt de repere des forces appliquees 123 : C 124 : VL1 = BPSS(1,1)*V1 + BPSS(1,2)*V2 + BPSS(1,3)*V3 125 : VL2 = BPSS(2,1)*V1 + BPSS(2,2)*V2 + BPSS(2,3)*V3 126 : VL3 = BPSS(3,1)*V1 + BPSS(3,2)*V2 + BPSS(3,3)*V3 127 : C 128 : X21 = XEL(1,2) - XEL(1,1) 129 : Y31 = XEL(2,3) - XEL(2,1) 130 : r_z = X21 * Y31 * X1s6 131 : FXT = r_z * VL1 132 : FYT = r_z * VL2 133 : SURFZ = r_z * VL3 134 : C 135 : C MISE A 0 DU VECTEUR FORCE 136 : C 137 : DO I = 1, 18 138 : FT(I) = 0.D0 139 : ENDDO 140 : C 141 : C INTEGRATION NUMERIQUE : IGAU NUMERO DU POINT DE GAUSS 142 : C IA NUMERO D UN NOEUD 143 : C 144 : DO 200 IGAU = 1, 3 144 : CALL MFDKT(XX(IGAU),YY(IGAU),XEL,BB) 145 : DO 210 IA = 1, 3 146 : IK = (IA-1)*3 147 : IP = IK*2+2 148 : FT(IP-1) = FXT 149 : FT(IP ) = FYT 150 : FT(IP+1) = FT(IP+1) + SURFZ*BB(IK+1) 151 : FT(IP+2) = FT(IP+2) + SURFZ*BB(IK+2) 152 : FT(IP+3) = FT(IP+3) + SURFZ*BB(IK+3) 153 : 210 CONTINUE 154 : 200 CONTINUE 155 : C 156 : C CHANGEMENT DE REPERE 157 : C 158 : MPTVAL = IVAFOR 159 : DO 400 I = 1, 3 160 : KP = 6 * (I-1) 161 : DO 402 J = 1,3 162 : MELVAL = IVAL(J) 163 : VELCHE(I,IB) = BPSS(1,J)*FT(1+KP) + BPSS(2,J)*FT(2+KP) 164 : & + BPSS(3,J)*FT(3+KP) 165 : MELVAL = IVAL(J+3) 166 : VELCHE(I,IB) = BPSS(1,J)*FT(4+KP) + BPSS(2,J)*FT(5+KP) 167 : & + BPSS(3,J)*FT(6+KP) 168 : 402 CONTINUE 169 : 400 CONTINUE 170 : 171 : 1000 CONTINUE 172 : 173 : IF (IPVECT.EQ.0) THEN 174 : IF (MELVA1.NE.0) SEGDES,MELVA1 175 : IF (MELVA2.NE.0) SEGDES,MELVA2 176 : IF (MELVA3.NE.0) SEGDES,MELVA3 177 : ENDIF 178 : C* SEGDES,MELEME (<- actif en E/S et non modifie) 179 : 180 : RETURN 181 : END 182 : 183 :
© Cast3M 2003 - All rights reserved.
Disclaimer