C RTENS6 SOURCE OF166741 25/02/21 21:18:29 12166 SUBROUTINE RTENS6(IPCHE1,IFOMEM,IELEME,IVAVEC,IVACOM, & IVARES,IDEFO,IINTE,MELE,NPINT,NVEC,KMOT) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *-----------------------------------------------------------------------* * Operateur RTENS : cas de la formulation massive * * * * IPCHE1 (e) pointeur sur un MCHAML de caracteristiques * * = 0 si isotropie * * IFOMEM (e) = IFOUR de CCOPTIO * * IELEME (e) pointeur sur le segment MELEME (actif) * * IVAVEC (e/s) pointeur sur un segment MPTVAL (actif) * * IVACOM (e/s) pointeur sur un segment MPTVAL (actif) * * IVARES (e/s) pointeur sur un segment MPTVAL (actif) * * IDEFO (e) =1 : tenseur de deformations (contraintes sinon) * * IINTE (e) pointeur sur le segment MINTE (actif) * * MELE (e) numero de l'element-fini dans NOMTP * * NPINT (e) nombre de points d'integration (coques) * * NVEC (e) nombre de composantes du MCHAML IPCHE1 * KMOT (e) 1 : transformation RT*A*R * 2 : transformation R*A*RT *-----------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMINTE -INC SMCOORD -INC SMELEME -INC TMPTVAL SEGMENT MWRK3 REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM) REAL*8 VALVEC(NV) ENDSEGMENT * DIMENSION VECWRK(3),V1(4),V2(4),W2(3),W3(3) DIMENSION CENTR1(3),CENTR2(3),AXEI1(3),VECX(3),VECY(3) DIMENSION UR(3),UTHETA(3),UPHI(3),UN(3),UT(3),XIGAU(3) * MELEME = IELEME NBNN = NUM(/1) NBELEM = NUM(/2) MINTE = IINTE NBPGAU = POIGAU(/1) * NDIM=IDIM IF (IFOMEM.EQ.1) NDIM=IDIM+1 NV=NVEC NV2=2 IF(NV.EQ.9) NV2=3 SEGINI MWRK3 * * Boucle sur les elements * DO 1010 IB=1,NBELEM * * Boucle sur les points de Gauss * DO 1010 IGAU=1,NBPGAU * MPTVAL=IVAVEC DO 1011 IV=1,NVEC IF (IVAL(IV).NE.0) THEN MELVAL=IVAL(IV) cbp IBMN=MIN(IB,VELCHE(/2)) cbp VALVEC(IV)=VELCHE(1,IBMN) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) VALVEC(IV) = VELCHE(IGMN,IBMN) ELSE VALVEC(IV)=0.D0 ENDIF 1011 CONTINUE * * remplissage de la matrice de rotation * CALL ZERO(R,NDIM,NDIM) IF (IDIM.EQ.2.AND.IFOMEM.NE.1) THEN R(1,1)=VALVEC(1) R(1,2)=VALVEC(2) R(2,1)=VALVEC(NV2+1) R(2,2)=VALVEC(NV2+2) ELSE DO 1012 I=1,NDIM IN=(I-1)*NDIM DO 1012 J=1,NDIM IJ=IN+J R(I,J)=VALVEC(IJ) 1012 CONTINUE ENDIF * CALL TRSPOD (R,NDIM,NDIM,RT) * * Sous-zones du MCHAML avant rotation * MPTVAL=IVACOM * * Tenseur avant changement de repere * MELVAL=IVAL(1) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(1,1) = VELCHE(IGMN,IBMN) * MELVAL=IVAL(2) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(2,2) = VELCHE(IGMN,IBMN) * MELVAL=IVAL(4) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(1,2) = VELCHE(IGMN,IBMN) * IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0 A(2,1)=A(1,2) * IF (IFOMEM.LT.1) GOTO 6610 * MELVAL=IVAL(3) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(3,3) = VELCHE(IGMN,IBMN) * MELVAL=IVAL(5) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(3,1) = VELCHE(IGMN,IBMN) * MELVAL=IVAL(6) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(3,2) = VELCHE(IGMN,IBMN) * IF (IDEFO.EQ.1) A(3,1)=A(3,1)/2.D0 IF (IDEFO.EQ.1) A(3,2)=A(3,2)/2.D0 A(1,3)=A(3,1) A(2,3)=A(3,2) * MELVAL=IVAL(3) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) A(3,3) = VELCHE(IGMN,IBMN) * 6610 CONTINUE * MELVAL=IVAL(3) IGMN = MIN(IGAU,VELCHE(/1)) IBMN = MIN(IB, VELCHE(/2)) AUX = VELCHE(IGMN,IBMN) * IF(KMOT.EQ.1) THEN * t * >>> Rotation du tenseur : A = R A R <<< * CALL MULMAT(TRAV,A,R,NDIM,NDIM,NDIM) CALL MULMAT(A,RT,TRAV,NDIM,NDIM,NDIM) * ELSE * t * >>> Rotation du tenseur : A = R A R <<< * CALL MULMAT(TRAV,A,RT,NDIM,NDIM,NDIM) CALL MULMAT(A,R,TRAV,NDIM,NDIM,NDIM) ENDIF * * Tenseur apres changement de repere * Sous-zones du MCHAML resultat * MPTVAL=IVARES * MELVAL=IVAL(1) VELCHE(IGAU,IB) = A(1,1) * MELVAL=IVAL(2) VELCHE(IGAU,IB) = A(2,2) * IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0 * MELVAL=IVAL(4) VELCHE(IGAU,IB) = A(1,2) * IF (IFOMEM.LT.1) THEN * MELVAL=IVAL(3) VELCHE(IGAU,IB)= AUX * ELSE * MELVAL=IVAL(3) VELCHE(IGAU,IB)=A(3,3) * IF (IDEFO.EQ.1) A(3,1)=A(3,1)*2.D0 IF (IDEFO.EQ.1) A(3,2)=A(3,2)*2.D0 * MELVAL=IVAL(5) VELCHE(IGAU,IB)= A(3,1) * MELVAL=IVAL(6) VELCHE(IGAU,IB)=A(3,2) * ENDIF * 1010 CONTINUE SEGSUP MWRK3 RETURN END