C RTENS2 SOURCE OF166741 25/02/21 21:18:25 12166 SUBROUTINE RTENS2(IPCHE1,IFOMEM,IMOT,IPTV2,IELEME,IVAVEC,IVACOM, & IVARES,IDEFO,IINTE,MELE,NPINT,NVEC,V1,V2,W2,W3, & CENTR1,CENTR2,AXEI1,IER1) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) *-----------------------------------------------------------------------* * Operateur RTENS : cas de la formulation coque (COQ2, COQ3, DKT) * * * * IPCHE1 (e) pointeur sur un MCHAML de caracteristiques * * = 0 si isotropie * * IFOMEM (e) = IFOUR de CCOPTIO * * IMOT (e) indique le type de repere desire (cf RTENS) * * IPTV2 (e) pointeur sur le 2nd point repere * * 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 futur MCHAML * * V1 (e) coordonnees et norme du 1er vecteur * * V2 (e) coordonnees et norme du 2nd vecteur * * W2 (e) coordonnees d'un 1er vecteur de travail * * W3 (e) coordonnees d'un 2nd vecteur de travail * * CENTR1 (e) coordonnees du 1er point repere * * CENTR2 (e) coordonnees du 2nd point repere * * AXEI1 (e) coordonnees du vecteur de l'axe de symetrie * * IER1 (s) =1 : erreur puis desactivation dans RTENS * * D.R.-M. le 18/3/94 * *-----------------------------------------------------------------------* -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC SMCHAML -INC SMINTE -INC SMCOORD -INC SMELEME -INC TMPTVAL * * MWRK1,3 initialises dans RTENS2 * SEGMENT MWRK1 REAL*8 XEL(3,NBNN),XEL2(3,NBNN) ENDSEGMENT * SEGMENT MWRK3 REAL*8 A(NDIM,NDIM),R(NDIM,NDIM),RT(NDIM,NDIM),TRAV(NDIM,NDIM) ENDSEGMENT * DIMENSION BPSS(3,3),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) * IER1 = 0 NDIM = 2 MELEME = IELEME NBNN = NUM(/1) NBELEM = NUM(/2) MINTE = IINTE NBPGAU = POIGAU(/1) SEGINI MWRK3 IF (IPCHE1.EQ.0) SEGINI MWRK1 * * Boucle sur les elements * DO 1030 IB=1,NBELEM * IF (IPCHE1.EQ.0) THEN * * Matrice de passage repere global -> repere local * CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XEL) CALL VPAST(XEL,BPSS) * IF (IMOT.EQ.0) THEN * * Passage du tenseur dans un autre repere cartesien defini * par le(s) vecteur(s) V1 (et V2) * VL11=BPSS(1,1)*V1(1)+BPSS(1,2)*V1(2)+BPSS(1,3)*V1(3) VL12=BPSS(2,1)*V1(1)+BPSS(2,2)*V1(2)+BPSS(2,3)*V1(3) VL1N=SQRT(VL11**2+VL12**2) IF (VL1N.EQ.0.D0) THEN CALL ERREUR(344) IER1 = 1 GOTO 1040 ENDIF IF (IPTV2.NE.0) THEN VL21=BPSS(1,1)*V2(1)+BPSS(1,2)*V2(2)+BPSS(1,3)*V2(3) VL22=BPSS(2,1)*V2(1)+BPSS(2,2)*V2(2)+BPSS(2,3)*V2(3) VL2N=SQRT(VL21**2+VL22**2) IF (VL2N.EQ.0.) THEN CALL ERREUR(344) IER1 = 1 GOTO 1040 ENDIF WL33=( VL11*VL22-VL12*VL21)/(VL1N*VL2N) WL21=(-WL33*VL12)/VL1N WL22=( WL33*VL11)/VL1N ENDIF * * Matrice de rotation : repere local de la coque ---> * nouveau repere defini a partir de la projection du * vecteur V1 (et event. de V2) sur la coque * IF (IPTV2.EQ.0) THEN R(1,1)= VL11/VL1N R(2,1)= VL12/VL1N R(1,2)= -VL12/VL1N R(2,2)= VL11/VL1N SIGFLX= 1.D0 ELSE R(1,1)= VL11/VL1N R(2,1)= VL12/VL1N R(1,2)= WL21 R(2,2)= WL22 SIGFLX= WL33 ENDIF CALL TRSPOD(R,NDIM,NDIM,RT) ENDIF ENDIF * * Boucle sur les points de Gauss * DO 1030 IGAU=1,NBPGAU * IF (IPCHE1.NE.0) THEN * * On veut le tenseur dans le repere d'orthotropie * MPTVAL=IVAVEC * MELVAL=IVAL(1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) R(1,1)=VELCHE(IGMN,IBMN) * MELVAL=IVAL(2) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) R(2,1)=VELCHE(IGMN,IBMN) R(1,2)=-R(2,1) R(2,2)= R(1,1) RN=R(1,1)*R(1,1)+R(2,1)*R(2,1) IF (RN.EQ.0.D0) THEN CALL ERREUR(344) IER1 = 1 GOTO 1040 ENDIF SIGFLX=1.D0 CALL TRSPOD(R,NDIM,NDIM,RT) ENDIF * IF (IMOT.NE.0) THEN * * Matrice de passage entre le repere local de la coque * et la projection sur celle-ci du repere global choisi * CALL RTENS5(IMOT,2,IGAU,NDIM,V1,CENTR1,CENTR2,BPSS, & SHPTOT,XEL,NBNN,NBPGAU,R,SIGFLX,IER1) IF (IER1.NE.0) THEN IF (IER1.EQ.1) CALL ERREUR(344) IF (IER1.EQ.2) CALL ERREUR(642) GOTO 1040 ENDIF CALL TRSPOD(R,NDIM,NDIM,RT) ENDIF * IF (NPINT.EQ.0) THEN KN=2 ELSE KN=1 ENDIF * * Boucle sur les points d'integration * DO 1030 K=1,KN * NF=(K-1)*3 * MPTVAL=IVACOM * MELVAL=IVAL(NF+1) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) A(1,1) = VELCHE(IGMN,IBMN) * MELVAL=IVAL(NF+2) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) A(2,2) = VELCHE(IGMN,IBMN) * IF (NPINT.EQ.0) THEN MELVAL=IVAL(NF+3) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) A(1,2) = VELCHE(IGMN,IBMN) ELSE MELVAL=IVAL(NF+4) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) A(1,2) = VELCHE(IGMN,IBMN) * MELVAL=IVAL(NF+3) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) COMP3 = VELCHE(IGMN,IBMN) ENDIF * IF (K.EQ.2) THEN A(1,1)=SIGFLX*A(1,1) A(2,2)=SIGFLX*A(2,2) A(1,2)=SIGFLX*A(1,2) ENDIF * IF (IDEFO.EQ.1) A(1,2)=A(1,2)/2.D0 * A(2,1)=A(1,2) * t * >>> Rotation du tenseur : A = R A R <<< * CALL MULMAT(TRAV,A,R,2,2,2) CALL MULMAT(A,RT,TRAV,2,2,2) * MPTVAL=IVARES * MELVAL=IVAL(NF+1) VELCHE(IGAU,IB)=A(1,1) * MELVAL=IVAL(NF+2) VELCHE(IGAU,IB)=A(2,2) * IF (IDEFO.EQ.1) A(1,2)=A(1,2)*2.D0 * IF (NPINT.EQ.0) THEN MELVAL=IVAL(NF+3) VELCHE(IGAU,IB) = A(1,2) ELSE MELVAL=IVAL(NF+4) VELCHE(IGAU,IB) = A(1,2) * MELVAL=IVAL(NF+3) VELCHE(IGAU,IB) = COMP3 ENDIF * * Fin des trois boucles * 1030 CONTINUE 1040 CONTINUE SEGSUP MWRK3 IF (IPCHE1.EQ.0) SEGSUP MWRK1 RETURN END