1 : C RTENS6 SOURCE BP208322 10/09/22 21:15:19 6761 2 : SUBROUTINE RTENS6(IPCHE1,IFOMEM,IELEME,IVAVEC,IVACOM, 3 : & IVARES,IDEFO,IINTE,MELE,NPINT,NVEC,KMOT) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8(A-H,O-Z) 6 : *-----------------------------------------------------------------------* 7 : * Operateur RTENS : cas de la formulation massive * 8 : * * 9 : * IPCHE1 (e) pointeur sur un MCHAML de caracteristiques * 10 : * = 0 si isotropie * 11 : * IFOMEM (e) = IFOUR de CCOPTIO * 12 : * IELEME (e) pointeur sur le segment MELEME (actif) * 13 : * IVAVEC (e/s) pointeur sur un segment MPTVAL (actif) * 14 : * IVACOM (e/s) pointeur sur un segment MPTVAL (actif) * 15 : * IVARES (e/s) pointeur sur un segment MPTVAL (actif) * 16 : * IDEFO (e) =1 : tenseur de deformations (contraintes sinon) * 17 : * IINTE (e) pointeur sur le segment MINTE (actif) * 18 : * MELE (e) numero de l'element-fini dans NOMTP * 19 : * NPINT (e) nombre de points d'integration (coques) * 20 : * NVEC (e) nombre de composantes du MCHAML IPCHE1 21 : * KMOT (e) 1 : transformation RT*A*R 22 : * 2 : transformation R*A*RT 23 : *-----------------------------------------------------------------------* 24 : -INC CCOPTIO 25 : -INC CCHAMP 26 : -INC SMCHAML 27 : -INC SMINTE 28 : -INC SMCOORD 29 : -INC SMELEME 30 : * 31 : SEGMENT MWRK3 32 : REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM) 33 : REAL*8 VALVEC(NV) 34 : ENDSEGMENT 35 : * 36 : * Les MPTVAL recueillent les donnees pour le MCHAML resultat 37 : * IVAL contient les pointeurs des MELVAL du nouveau MCHAML 38 : * 39 : SEGMENT MPTVAL 40 : INTEGER IPOS(NS) , NSOF(NS) 41 : INTEGER IVAL(NCOSOU) 42 : CHARACTER*16 TYVAL(NCOSOU) 43 : ENDSEGMENT 44 : * 45 : DIMENSION VECWRK(3),V1(4),V2(4),W2(3),W3(3) 46 : DIMENSION CENTR1(3),CENTR2(3),AXEI1(3),VECX(3),VECY(3) 47 : DIMENSION UR(3),UTHETA(3),UPHI(3),UN(3),UT(3),XIGAU(3) 48 : * 49 : MELEME = IELEME 50 : NBNN = NUM(/1) 51 : NBELEM = NUM(/2) 52 : MINTE = IINTE 53 : NBPGAU = POIGAU(/1) 54 : * 55 : NDIM=IDIM 56 : IF (IFOMEM.EQ.1) NDIM=IDIM+1 57 : NV=NVEC 58 : NV2=2 59 : IF(NV.EQ.9) NV2=3 60 : SEGINI MWRK3 61 : * 62 : * Boucle sur les elements 63 : * 64 : DO 1010 IB=1,NBELEM 65 : * 66 : * Boucle sur les points de Gauss 67 : * 68 : DO 1010 IGAU=1,NBPGAU 69 : * 70 : MPTVAL=IVAVEC 71 : DO 1011 IV=1,NVEC 72 : IF (IVAL(IV).NE.0) THEN 73 : MELVAL=IVAL(IV) 74 : cbp IBMN=MIN(IB,VELCHE(/2)) 75 : cbp VALVEC(IV)=VELCHE(1,IBMN) 76 : IGMN = MIN(IGAU,VELCHE(/1)) 77 : IBMN = MIN(IB, VELCHE(/2)) 78 : VALVEC(IV) = VELCHE(IGMN,IBMN) 79 : ELSE 80 : VALVEC(IV)=0.D0 81 : ENDIF 82 : 1011 CONTINUE 83 : * 84 : * remplissage de la matrice de rotation 85 : * 85 : CALL ZERO(R,NDIM,NDIM) 86 : IF (IDIM.EQ.2.AND.IFOMEM.NE.1) THEN 87 : R(1,1)=VALVEC(1) 88 : R(1,2)=VALVEC(2) 89 : R(2,1)=VALVEC(NV2+1) 90 : R(2,2)=VALVEC(NV2+2) 91 : ELSE 92 : DO 1012 I=1,NDIM 93 : IN=(I-1)*NDIM 94 : DO 1012 J=1,NDIM 95 : IJ=IN+J 96 : R(I,J)=VALVEC(IJ) 97 : 1012 CONTINUE 98 : ENDIF 99 : * 99 : CALL TRSPOD (R,NDIM,NDIM,RT) 100 : * 101 : * Sous-zones du MCHAML avant rotation 102 : * 103 : MPTVAL=IVACOM 104 : * 105 : * Tenseur avant changement de repere 106 : * 107 : MELVAL=IVAL(1) 108 : IGMN = MIN(IGAU,VELCHE(/1)) 109 : IBMN = MIN(IB, VELCHE(/2)) 110 : A(1,1) = VELCHE(IGMN,IBMN) 111 : * 112 : MELVAL=IVAL(2) 113 : IGMN = MIN(IGAU,VELCHE(/1)) 114 : IBMN = MIN(IB, VELCHE(/2)) 115 : A(2,2) = VELCHE(IGMN,IBMN) 116 : * 117 : MELVAL=IVAL(4) 118 : IGMN = MIN(IGAU,VELCHE(/1)) 119 : IBMN = MIN(IB, VELCHE(/2)) 120 : A(1,2) = VELCHE(IGMN,IBMN) 121 : * 122 : IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0 123 : A(2,1)=A(1,2) 124 : * 125 : IF (IFOMEM.LT.1) GOTO 6610 126 : * 127 : MELVAL=IVAL(3) 128 : IGMN = MIN(IGAU,VELCHE(/1)) 129 : IBMN = MIN(IB, VELCHE(/2)) 130 : A(3,3) = VELCHE(IGMN,IBMN) 131 : * 132 : MELVAL=IVAL(5) 133 : IGMN = MIN(IGAU,VELCHE(/1)) 134 : IBMN = MIN(IB, VELCHE(/2)) 135 : A(3,1) = VELCHE(IGMN,IBMN) 136 : * 137 : MELVAL=IVAL(6) 138 : IGMN = MIN(IGAU,VELCHE(/1)) 139 : IBMN = MIN(IB, VELCHE(/2)) 140 : A(3,2) = VELCHE(IGMN,IBMN) 141 : * 142 : IF (IDEFO.EQ.1) A(3,1)=A(3,1)/2.D0 143 : IF (IDEFO.EQ.1) A(3,2)=A(3,2)/2.D0 144 : A(1,3)=A(3,1) 145 : A(2,3)=A(3,2) 146 : * 147 : MELVAL=IVAL(3) 148 : IGMN = MIN(IGAU,VELCHE(/1)) 149 : IBMN = MIN(IB, VELCHE(/2)) 150 : A(3,3) = VELCHE(IGMN,IBMN) 151 : * 152 : 6610 CONTINUE 153 : * 154 : MELVAL=IVAL(3) 155 : IGMN = MIN(IGAU,VELCHE(/1)) 156 : IBMN = MIN(IB, VELCHE(/2)) 157 : AUX = VELCHE(IGMN,IBMN) 158 : * 159 : IF(KMOT.EQ.1) THEN 160 : * t 161 : * >>> Rotation du tenseur : A = R A R <<< 162 : * 162 : CALL MULMAT(TRAV,A,R,NDIM,NDIM,NDIM) 162 : CALL MULMAT(A,RT,TRAV,NDIM,NDIM,NDIM) 163 : * 164 : ELSE 165 : * t 166 : * >>> Rotation du tenseur : A = R A R <<< 167 : * 167 : CALL MULMAT(TRAV,A,RT,NDIM,NDIM,NDIM) 167 : CALL MULMAT(A,R,TRAV,NDIM,NDIM,NDIM) 168 : ENDIF 169 : * 170 : * Tenseur apres changement de repere 171 : * Sous-zones du MCHAML resultat 172 : * 173 : MPTVAL=IVARES 174 : * 175 : MELVAL=IVAL(1) 176 : VELCHE(IGAU,IB) = A(1,1) 177 : * 178 : MELVAL=IVAL(2) 179 : VELCHE(IGAU,IB) = A(2,2) 180 : * 181 : IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0 182 : * 183 : MELVAL=IVAL(4) 184 : VELCHE(IGAU,IB) = A(1,2) 185 : * 186 : IF (IFOMEM.LT.1) THEN 187 : * 188 : MELVAL=IVAL(3) 189 : VELCHE(IGAU,IB)= AUX 190 : * 191 : ELSE 192 : * 193 : MELVAL=IVAL(3) 194 : VELCHE(IGAU,IB)=A(3,3) 195 : * 196 : IF (IDEFO.EQ.1) A(3,1)=A(3,1)*2.D0 197 : IF (IDEFO.EQ.1) A(3,2)=A(3,2)*2.D0 198 : * 199 : MELVAL=IVAL(5) 200 : VELCHE(IGAU,IB)= A(3,1) 201 : * 202 : MELVAL=IVAL(6) 203 : VELCHE(IGAU,IB)=A(3,2) 204 : * 205 : ENDIF 206 : * 207 : 1010 CONTINUE 208 : SEGSUP MWRK3 209 : * 210 : RETURN 211 : END 212 : 213 : 214 : 215 : 216 : 217 : 218 :
© Cast3M 2003 - All rights reserved.
Disclaimer