1 : C RTENS4 SOURCE PV 09/03/12 21:34:06 6325 2 : SUBROUTINE RTENS4(IPCHE1,IFOMEM,IMOT,IPTV2,IELEME,IVAVEC,IVACOM, 3 : & IVARES,IDEFO,IINTE,MELE,NPINT,NVEC,V1,V2,W2,W3, 4 : & CENTR1,CENTR2,AXEI1,ICAS,IER1) 5 : IMPLICIT INTEGER(I-N) 6 : IMPLICIT REAL*8(A-H,O-Z) 7 : *-----------------------------------------------------------------------* 8 : * Operateur RTENS : cas de la formulation coque avec * 9 : * cisaillement transverse (DST, COQ4) * 10 : * * 11 : * IPCHE1 (e) pointeur sur un MCHAML de caracteristiques * 12 : * = 0 si isotropie * 13 : * IFOMEM (e) = IFOUR de CCOPTIO * 14 : * IMOT (e) indique le type de repere desire (cf RTENS) * 15 : * IPTV2 (e) pointeur sur le 2nd point repere * 16 : * IELEME (e) pointeur sur le segment MELEME (actif) * 17 : * IVAVEC (e/s) pointeur sur un segment MPTVAL (actif) * 18 : * IVACOM (e/s) pointeur sur un segment MPTVAL (actif) * 19 : * IVARES (e/s) pointeur sur un segment MPTVAL (actif) * 20 : * IDEFO (e) =1 : tenseur de deformations (contraintes sinon) * 21 : * IINTE (e) pointeur sur le segment MINTE (actif) * 22 : * MELE (e) numero de l'element-fini dans NOMTP * 23 : * NPINT (e) nombre de points d'integration (coques) * 24 : * NVEC (e) nombre de composantes du futur MCHAML * 25 : * V1 (e) coordonnees et norme du 1er vecteur * 26 : * V2 (e) coordonnees et norme du 2nd vecteur * 27 : * W2 (e) coordonnees d'un 1er vecteur de travail * 28 : * W3 (e) coordonnees d'un 2nd vecteur de travail * 29 : * CENTR1 (e) coordonnees du 1er point repere * 30 : * CENTR2 (e) coordonnees du 2nd point repere * 31 : * AXEI1 (e) coordonnees du vecteur de l'axe de symetrie * 32 : * ICAS (e) distingue les differentes syntaxes d'appel * 33 : * IER1 (s) code d'erreur pour desactivation dans RTENS * 34 : * D.R.-M. le 18/3/94 * 35 : *-----------------------------------------------------------------------* 36 : -INC CCOPTIO 37 : -INC CCHAMP 38 : -INC SMCHAML 39 : -INC SMINTE 40 : -INC SMCOORD 41 : -INC SMELEME 42 : * 43 : * MWRK1,3 initialises dans RTENS4 44 : * 45 : SEGMENT MWRK1 46 : REAL*8 XEL(3,NBNN),XEL2(3,NBNN) 47 : ENDSEGMENT 48 : * 49 : SEGMENT MWRK3 50 : REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM) 51 : ENDSEGMENT 52 : * 53 : * Les MPTVAL recueillent les donnees pour le MCHAML resultat 54 : * IVAL contient les pointeurs des MELVAL du nouveau MCHAML 55 : * 56 : SEGMENT MPTVAL 57 : INTEGER IPOS(NS) , NSOF(NS) 58 : INTEGER IVAL(NCOSOU) 59 : CHARACTER*16 TYVAL(NCOSOU) 60 : ENDSEGMENT 61 : * 62 : DIMENSION BPSS(3,3),T(9),VECWRK(3),V1(4),V2(4),W2(3),W3(3) 63 : DIMENSION CENTR1(3),CENTR2(3),AXEI1(3),VECX(3),VECY(3) 64 : DIMENSION UR(3),UTHETA(3),UPHI(3),UN(3),UT(3),XIGAU(3) 65 : * 66 : NDIM=3 67 : IER1 = 0 68 : MELEME = IELEME 69 : NBNN = NUM(/1) 70 : NBELEM = NUM(/2) 71 : MINTE = IINTE 72 : NBPGAU = POIGAU(/1) 73 : * 74 : SEGINI MWRK3 75 : IF (ICAS.NE.1) SEGINI MWRK1 75 : CALL ZERO(R,3,3) 76 : * 77 : * Boucle sur les elements 78 : * 79 : DO 1090 IB=1,NBELEM 80 : * 81 : IF (ICAS.NE.1) THEN 81 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL) 82 : IF (MELE.EQ.49) THEN 82 : CALL CQ4LOC (XEL,XEL2,BPSS,IRRT,0) 83 : ELSE IF (MELE.EQ.93) THEN 83 : CALL VPAST(XEL,BPSS) 84 : ENDIF 85 : ENDIF 86 : * 87 : IF (ICAS.EQ.2) THEN 88 : * 89 : * On veut le tenseur dans un repere defini par 90 : * un ou deux vecteurs 91 : * 92 : VL11=BPSS(1,1)*V1(1)+BPSS(1,2)*V1(2)+BPSS(1,3)*V1(3) 93 : VL12=BPSS(2,1)*V1(1)+BPSS(2,2)*V1(2)+BPSS(2,3)*V1(3) 94 : VL1N=SQRT(VL11**2+VL12**2) 95 : IF (VL1N.EQ.0.) THEN 95 : CALL ERREUR(344) 96 : IER1 = 1 97 : GOTO 1100 98 : ENDIF 99 : IF (IPTV2.NE.0) THEN 100 : VL21=BPSS(1,1)*V2(1)+BPSS(1,2)*V2(2)+BPSS(1,3)*V2(3) 101 : VL22=BPSS(2,1)*V2(1)+BPSS(2,2)*V2(2)+BPSS(2,3)*V2(3) 102 : VL2N=SQRT(VL21**2+VL22**2) 103 : IF (VL2N.EQ.0.) THEN 103 : CALL ERREUR(344) 104 : IER1 = 1 105 : GOTO 1100 106 : ENDIF 107 : WL33=(VL11*VL22-VL12*VL21)/(VL1N*VL2N) 108 : WL21=(-WL33*VL12)/VL1N 109 : WL22=(WL33*VL11)/VL1N 110 : ENDIF 111 : * 112 : * Construction de la matrice de rotation qui fait 113 : * passer du repere local a la coque au nouveau repere 114 : * local defini a partir de la projection des vecteurs 115 : * V1 et V2 sur la coque 116 : * 117 : IF (IPTV2.EQ.0) THEN 118 : R(1,1)= VL11/VL1N 119 : R(2,1)= VL12/VL1N 120 : R(1,2)= -VL12/VL1N 121 : R(2,2)= VL11/VL1N 122 : R(3,3)= 1.D0 123 : ELSE 124 : R(1,1)= VL11/VL1N 125 : R(2,1)= VL12/VL1N 126 : R(1,2)= WL21 127 : R(2,2)= WL22 128 : R(3,3)= WL33 129 : ENDIF 130 : SIGFLX=R(3,3) 130 : CALL TRSPOD(R,NDIM,NDIM,RT) 131 : ENDIF 132 : * 133 : * Boucle sur les points de Gauss 134 : * 135 : DO 1090 IGAU=1,NBPGAU 136 : * 137 : IF (ICAS.EQ.1) THEN 138 : * 139 : * On veut le tenseur dans le repere d'orthotropie 140 : * 141 : MPTVAL=IVAVEC 142 : * 143 : MELVAL=IVAL(1) 144 : IGMN=MIN(IGAU,VELCHE(/1)) 145 : IBMN=MIN(IB,VELCHE(/2)) 146 : R(1,1)=VELCHE(IGMN,IBMN) 147 : * 148 : MELVAL=IVAL(2) 149 : IGMN=MIN(IGAU,VELCHE(/1)) 150 : IBMN=MIN(IB,VELCHE(/2)) 151 : R(2,1)=VELCHE(IGMN,IBMN) 152 : * 153 : RN=R(1,1)*R(1,1)+R(2,1)*R(2,1) 154 : IF (RN.EQ.0.D0) THEN 154 : CALL ERREUR(344) 155 : IER1 = 1 156 : GOTO 1100 157 : ENDIF 158 : * 159 : R(1,2)=-R(2,1) 160 : R(2,2)= R(1,1) 161 : R(3,3)= 1.D0 162 : SIGFLX= 1.D0 162 : CALL TRSPOD(R,NDIM,NDIM,RT) 163 : ENDIF 164 : * 165 : IF (ICAS.EQ.3) THEN 166 : * 167 : * Matrice de passage entre le repere local de la coque 168 : * et la projection sur celle-ci du repere global choisi 169 : * 169 : CALL RTENS5(IMOT,4,IGAU,NDIM,V1,CENTR1,CENTR2,BPSS, 170 : & SHPTOT,XEL,NBNN,NBPGAU,R,SIGFLX,IER1) 171 : IF (IER1.NE.0) THEN 171 : IF (IER1.EQ.1) CALL ERREUR(344) 171 : IF (IER1.EQ.2) CALL ERREUR(642) 172 : GOTO 1100 173 : ENDIF 173 : CALL TRSPOD(R,NDIM,NDIM,RT) 174 : ENDIF 175 : * 176 : * Rotation du tenseur pour les termes de membrane 177 : * 177 : CALL ZERO(A,3,3) 178 : * 179 : MPTVAL=IVACOM 180 : 181 : MELVAL=IVAL(1) 182 : IGMN=MIN(IGAU,VELCHE(/1)) 183 : IBMN=MIN(IB ,VELCHE(/2)) 184 : A(1,1) = VELCHE(IGMN,IBMN) 185 : * 186 : MELVAL=IVAL(2) 187 : IGMN=MIN(IGAU,VELCHE(/1)) 188 : IBMN=MIN(IB ,VELCHE(/2)) 189 : A(2,2) = VELCHE(IGMN,IBMN) 190 : * 191 : MELVAL=IVAL(3) 192 : IGMN=MIN(IGAU,VELCHE(/1)) 193 : IBMN=MIN(IB ,VELCHE(/2)) 194 : A(1,2) = VELCHE(IGMN,IBMN) 195 : * 196 : MELVAL=IVAL(7) 197 : IGMN=MIN(IGAU,VELCHE(/1)) 198 : IBMN=MIN(IB ,VELCHE(/2)) 199 : A(1,3) = VELCHE(IGMN,IBMN) 200 : * 201 : MELVAL=IVAL(8) 202 : IGMN=MIN(IGAU,VELCHE(/1)) 203 : IBMN=MIN(IB ,VELCHE(/2)) 204 : A(2,3) = VELCHE(IGMN,IBMN) 205 : * 206 : MELVAL=IVAL(4) 207 : IGMN=MIN(IGAU,VELCHE(/1)) 208 : IBMN=MIN(IB ,VELCHE(/2)) 209 : AUX4=VELCHE(IGMN,IBMN) 210 : * 211 : MELVAL=IVAL(5) 212 : IGMN=MIN(IGAU,VELCHE(/1)) 213 : IBMN=MIN(IB ,VELCHE(/2)) 214 : AUX5 = VELCHE(IGMN,IBMN) 215 : * 216 : MELVAL=IVAL(6) 217 : IGMN=MIN(IGAU,VELCHE(/1)) 218 : IBMN=MIN(IB ,VELCHE(/2)) 219 : AUX6 = VELCHE(IGMN,IBMN) 220 : * 221 : IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0 222 : IF (IDEFO.EQ.1) A(1,3)=A(1,3)/2.D0 223 : IF (IDEFO.EQ.1) A(2,3)=A(2,3)/2.D0 224 : A(2,1)=A(1,2) 225 : A(3,1)=A(1,3) 226 : A(3,2)=A(2,3) 227 : * t 228 : * >>> Changement de repere : A = R A R <<< 229 : * 229 : CALL MULMAT(TRAV,A,R,3,3,3) 229 : CALL MULMAT(A,RT,TRAV,3,3,3) 230 : * 231 : MPTVAL=IVARES 232 : * 233 : MELVAL=IVAL(1) 234 : VELCHE(IGAU,IB)=A(1,1) 235 : * 236 : MELVAL=IVAL(2) 237 : VELCHE(IGAU,IB)=A(2,2) 238 : * 239 : IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0 240 : IF (IDEFO.EQ.1) A(1,3)=A(1,3)*2.D0 241 : IF (IDEFO.EQ.1) A(2,3)=A(2,3)*2.D0 242 : * 243 : MELVAL=IVAL(3) 244 : VELCHE(IGAU,IB) = A(1,2) 245 : * 246 : MELVAL=IVAL(7) 247 : VELCHE(IGAU,IB)=A(1,3) 248 : * 249 : MELVAL=IVAL(8) 250 : VELCHE(IGAU,IB)=A(2,3) 251 : * 252 : * Rotation du tenseur pour les termes de flexion 253 : * 253 : CALL ZERO(A,3,3) 254 : * 255 : A(1,1)=SIGFLX*AUX4 256 : A(2,2)=SIGFLX*AUX5 257 : A(1,2)=SIGFLX*AUX6 258 : IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0 259 : A(2,1)=A(1,2) 260 : * t 261 : * >>> Changement de repere : A = R A R <<< 262 : * 262 : CALL MULMAT(TRAV,A,R,3,3,3) 262 : CALL MULMAT(A,RT,TRAV,3,3,3) 263 : * 264 : MELVAL=IVAL(4) 265 : VELCHE(IGAU,IB)=A(1,1) 266 : * 267 : MELVAL=IVAL(5) 268 : VELCHE(IGAU,IB)=A(2,2) 269 : * 270 : IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0 271 : * 272 : MELVAL=IVAL(6) 273 : VELCHE(IGAU,IB)=A(1,2) 274 : * 275 : * Fin des deux boucles 276 : * 277 : 1090 CONTINUE 278 : 1100 CONTINUE 279 : SEGSUP MWRK3 280 : IF (ICAS.NE.1) SEGSUP MWRK1 281 : RETURN 282 : END 283 : 284 : 285 : 286 : 287 : 288 : 289 :
© Cast3M 2003 - All rights reserved.
Disclaimer