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