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