1 : C FSCOQ8 SOURCE FANDEUR 12/07/18 21:15:39 7434 2 : 3 : SUBROUTINE FSCOQ8(IPT,IPMAIL,IPTINT,IPVECT,VEC,IVACAR, 4 : & IPTNOE,IVAFOR) 5 : *______________________________________________________________________ 6 : * 7 : * CALCULE LES FORCES SURFACIQUES AUX NOEUDS DES COQUES COQ8, COQ6 8 : * 9 : * 10 : * ENTREES : 11 : * --------- 12 : * 13 : * IPT TABLEAU DE POINTEURS SUR MPTVAL CONTENANT LES FORCES 14 : * APPLIQUEES 15 : * IPMAIL POINTEUR SUR LE MAILLAGE 16 : * IPTINT POINTEUR SUR LE CHAMELEM DE L'INTEGRATION 17 : * IPVECT POINTEUR SUR LE VECTEUR REPRESENTANT LA FORCE 18 : * VEC VECTEUR REPRESENTANT LA FORCE 19 : * IVACAR POINTEUR SUR UN SEGMENT MPTVAL CONCERNANT LES CARAC- 20 : * TERISTIQUES (EPAISSEUR AUX NOEUDS) 21 : * IPTNOE POINTEUR SUR L'ALIAS DU CHAMELEM D'INTEGRATION CONTENANT 22 : * LES FONCTIONS DE FORME AUX NOEUDS 23 : * IVAFOR POINTEUR SUR UN MPTVAL ET MELVALS ASSOCIEES AUX FORCES 24 : * ET MOMENTS AUX NOEUDS 25 : * 26 : *_______________________________________________________________________ 27 : * 28 : IMPLICIT INTEGER(I-N) 29 : IMPLICIT REAL*8(A-H,O-Z) 30 : * 31 : -INC CCOPTIO 32 : * 33 : -INC SMCHAML 34 : -INC SMELEME 35 : -INC SMINTE 36 : -INC SMCOORD 37 : * 38 : SEGMENT MPTVAL 39 : INTEGER IPOS(NS) ,NSOF(NS) 40 : INTEGER IVAL(NCOSOU) 41 : CHARACTER*16 TYVAL(NCOSOU) 42 : ENDSEGMENT 43 : * 44 : DIMENSION IPT(*),VEC(*) 45 : * 46 : DIMENSION TH(8),XJ(3,3),TXR(3,3,8),XE(3,8) 47 : * 48 : MELVA1 = IPT(1) 49 : MELVA2 = IPT(2) 50 : MELVA3 = IPT(3) 51 : IF (IPVECT.EQ.0) THEN 52 : IBM1 = 0 53 : IF (MELVA1.NE.0) THEN 54 : SEGACT,MELVA1 55 : IGM1 = MELVA1.VELCHE(/1) 56 : IBM1 = MELVA1.VELCHE(/2) 57 : ENDIF 58 : IBM2 = 0 59 : IF (MELVA2.NE.0) THEN 60 : SEGACT,MELVA2 61 : IGM2 = MELVA2.VELCHE(/1) 62 : IBM2 = MELVA2.VELCHE(/2) 63 : ENDIF 64 : IBM3 = 0 65 : IF (MELVA3.NE.0) THEN 66 : SEGACT,MELVA3 67 : IGM3 = MELVA3.VELCHE(/1) 68 : IBM3 = MELVA3.VELCHE(/2) 69 : ENDIF 70 : F1 = 0.D0 71 : F2 = 0.D0 72 : F3 = 0.D0 73 : ELSE 74 : F1 = VEC(1) 75 : F2 = VEC(2) 76 : F3 = VEC(3) 77 : ENDIF 78 : * 79 : MINTE=IPTINT 80 : C* SEGACT,MINTE <- ACTIF EN E/S 81 : NBPGAU=POIGAU(/1) 82 : NBGAU2=NBPGAU/2 83 : * 84 : MINTE1=IPTNOE 85 : SEGACT,MINTE1 86 : * 87 : MELEME=IPMAIL 88 : C* SEGACT,MELEME <- ACTIF EN E/S 89 : NBNN = NUM(/1) 90 : NBELEM= NUM(/2) 91 : C* 92 : C* PREPARATION DE DONNEES POUR LE CALCUL DE L'EPAISSEUR D'UN ELEMENT 93 : C* 94 : MPTVAL = IVACAR 95 : MELVEP = IVAL(1) 96 : MELVAL = MELVEP 97 : C* SEGACT,MELVAL <- ACTIF EN E/S 98 : IGEP = VELCHE(/1) 99 : IBEP = VELCHE(/2) 100 : C* IF (IGEP.LT.1) THEN 101 : C* WRITE(IOMP,*) 'ERREUR : FSCOQ8 - IGEP' 101 : C* CALL ERREUR(5) 102 : C* RETURN 103 : C* ENDIF 104 : * 105 : MPTVAL = IVAFOR 106 : * 107 : * BOUCLE SUR LES ELEMENTS 108 : * 109 : DO 1 IB = 1, NBELEM 110 : * 111 : * CALCUL DE L EPAISSEUR MOYENNE 112 : * CALCUL DE TH(IPTELE) 113 : * 114 : MELVAL = MELVEP 115 : IBMN = MIN(IB,IBEP) 116 : EPAI = VELCHE(1,IBMN) 117 : IF (IGEP.GT.1) THEN 118 : DO i = 2, IGEP 119 : EPAI = EPAI + VELCHE(i,IBMN) 120 : ENDDO 121 : EPAI = EPAI / IGEP 122 : ENDIF 123 : * ON STOCKE L'EPAISSEUR MOYENNE A CHAQUE NOEUD (UTILE POUR LES CALCULS) 124 : DO i = 1, NBNN 125 : TH(i) = EPAI 126 : ENDDO 127 : * 128 : * DETERMINATION DES REPERES LOCAUX AUX NOEUDS 129 : * 129 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 129 : CALL CQ8LOC(XE,NBNN,MINTE1.SHPTOT,TXR,irr) 130 : * 131 : IF (IPVECT.EQ.0) THEN 132 : IF (MELVA1.NE.0) IBMN1 = MIN(IB,IBM1) 133 : IF (MELVA2.NE.0) IBMN2 = MIN(IB,IBM2) 134 : IF (MELVA3.NE.0) IBMN3 = MIN(IB,IBM3) 135 : ENDIF 136 : * 137 : * BOUCLE SUR LES POINTS DE GAUSS 138 : * 139 : DO 10 IGAU = 1, NBGAU2 140 : * 141 : IF (IPVECT.EQ.0) THEN 142 : IF (MELVA1.NE.0) THEN 143 : IGMN = MIN(IGAU,IGM1) 144 : F1 = MELVA1.VELCHE(IGMN,IBMN1) 145 : ENDIF 146 : IF (MELVA2.NE.0) THEN 147 : IGMN = MIN(IGAU,IGM2) 148 : F2 = MELVA2.VELCHE(IGMN,IBMN2) 149 : ENDIF 150 : IF (MELVA3.NE.0) THEN 151 : IGMN = MIN(IGAU,IGM3) 152 : F3 = MELVA3.VELCHE(IGMN,IBMN3) 153 : ENDIF 154 : ENDIF 155 : * 156 : * VECTEUR NORMAL A LA SURFACE DE L ELEMENT AU PT DE GAUSS IGAU 157 : * 157 : CALL COQ8JC(IGAU,NBNN,1.D0,XE,TH,TXR,SHPTOT,XJ,DET,irr) 158 : * 159 : VG_1 = XJ(1,2)*XJ(2,3) - XJ(2,2)*XJ(1,3) 160 : VG_2 = XJ(1,3)*XJ(2,1) - XJ(2,3)*XJ(1,1) 161 : VG_3 = XJ(1,1)*XJ(2,2) - XJ(2,1)*XJ(1,2) 162 : VN = SQRT( VG_1*VG_1 + VG_2*VG_2 + VG_3*VG_3 ) 163 : VG_1 = VG_1 / VN 164 : VG_2 = VG_2 / VN 165 : VG_3 = VG_3 / VN 166 : * 167 : SURFP = VN * POIGAU(IGAU) 168 : POI2P = 0.5D0 * POIGAU(IGAU) 169 : * 170 : * BOUCLE SUR NOEUDS DE L'ELEMENT 171 : * 172 : * 173 : DO 20 J = 1, NBNN 174 : * 175 : VQ_1 = TXR(1,1,J) 176 : VQ_2 = TXR(2,1,J) 177 : VQ_3 = TXR(3,1,J) 178 : VE_1 = TXR(1,2,J) 179 : VE_2 = TXR(2,2,J) 180 : VE_3 = TXR(3,2,J) 181 : * 182 : * Matrice de changement de repere : XJij 183 : * 184 : XJ11 = 0.D0 185 : XJ12 = VQ_1*VE_2 - VQ_2*VE_1 186 : XJ13 = VQ_1*VE_3 - VE_1*VQ_3 187 : XJ21 = -XJ12 188 : XJ22 = 0.D0 189 : XJ23 = VQ_2*VE_3 - VE_2*VQ_3 190 : XJ31 = -XJ13 191 : XJ32 = -XJ23 192 : XJ33 = 0.D0 193 : * 194 : * Chgt de repere du vecteur force (F1,F2,F3) : global -> local 195 : * 196 : F1L = VQ_1*F1 + VQ_2*F2 + VQ_3*F3 197 : F2L = VE_1*F1 + VE_2*F2 + VE_3*F3 198 : F3L = VG_1*F1 + VG_2*F2 + VG_3*F3 199 : * 200 : * FORCES AUX NOEUDS 201 : * 202 : WGTM = SURFP * SHPTOT(1,J,IGAU) 203 : * 204 : MELVAL = IVAL(1) 205 : VELCHE(J,IB) = VELCHE(J,IB) 206 : & + WGTM * (VG_1*F3L + VQ_1*F1L + VE_1*F2L) 207 : 208 : MELVAL = IVAL(2) 209 : VELCHE(J,IB) = VELCHE(J,IB) 210 : & + WGTM * (VG_2*F3L + VQ_2*F1L + VE_2*F2L) 211 : 212 : MELVAL = IVAL(3) 213 : VELCHE(J,IB) = VELCHE(J,IB) 214 : & + WGTM * (VG_3*F3L + VQ_3*F1L + VE_3*F2L) 215 : * 216 : * (V2JT) 217 : * MOMENTS AUX NDS = WT*P*TH(J)* (V1J,-V2J)(V1JT) *(VNGAU) 218 : * VALEURS DES MOMENTS AUX NOEUDS 219 : * Chgt de repere : local -> global 220 : * 221 : WGTM = POI2P * TH(J) * SHPTOT(1,J,IGAU) 222 : * 223 : MELVAL = IVAL(4) 224 : VGG = XJ11*VG_1 + XJ21*VG_2 + XJ31*VG_3 225 : VQG = XJ11*VQ_1 + XJ21*VQ_2 + XJ31*VQ_3 226 : VEG = XJ11*VE_1 + XJ21*VE_2 + XJ31*VE_3 227 : VELCHE(J,IB) = VELCHE(J,IB) 228 : & + WGTM * (VGG*F3L + VQG*F1L + VEG*F2L) 229 : MELVAL=IVAL(5) 230 : VGG = XJ12*VG_1 + XJ22*VG_2 + XJ32*VG_3 231 : VQG = XJ12*VQ_1 + XJ22*VQ_2 + XJ32*VQ_3 232 : VEG = XJ12*VE_1 + XJ22*VE_2 + XJ32*VE_3 233 : VELCHE(J,IB) = VELCHE(J,IB) 234 : & + WGTM * (VGG*F3L+ VQG*F1L + VEG*F2L) 235 : 236 : MELVAL=IVAL(6) 237 : VGG = XJ13*VG_1 + XJ23*VG_2 + XJ33*VG_3 238 : VQG = XJ13*VQ_1 + XJ23*VQ_2 + XJ33*VQ_3 239 : VEG = XJ13*VE_1 + XJ23*VE_2 + XJ33*VE_3 240 : VELCHE(J,IB) = VELCHE(J,IB) 241 : & + WGTM * (VGG*F3L + VQG*F1L + VEG*F2L) 242 : 20 CONTINUE 243 : 244 : 10 CONTINUE 245 : 246 : 1 CONTINUE 247 : 248 : C* SEGDES,MELEME <- ACTIF EN E/S 249 : C* SEGDES,MINTE <- ACTIF EN E/S 250 : SEGDES,MINTE1 251 : IF (IPVECT.EQ.0) THEN 252 : IF (MELVA1.NE.0) SEGDES,MELVA1 253 : IF (MELVA2.NE.0) SEGDES,MELVA2 254 : IF (MELVA3.NE.0) SEGDES,MELVA3 255 : ENDIF 256 : 257 : RETURN 258 : END 259 : 260 :
© Cast3M 2003 - All rights reserved.
Disclaimer