1 : C POUREA SOURCE CHAT 05/01/13 02:19:34 5004 2 : SUBROUTINE POUREA(XX,YY,ZZ,XDDL,WORK,P,VECT,KERRE) 3 : C----------------------------------------------------------------------- 4 : C ROUTINE DE REACTUALISATION DU VECTEUR VECT 5 : C----------------------------------------------------------------------- 6 : C ENTREE 7 : C XX,YY,ZZ LES COORDONNEES DES 2 NOEUDS 8 : C XDDL LES DEPLACEMENTS EN AXES GLOBAUX 9 : C WORK TABLEAU DE TRAVAIL 10 : C P MATRICE DE PASSAGE 11 : C 12 : C SORTIE 13 : C VECT NOUVEAU VECTEUR 14 : C KERRE INDICE D'ERREUR ( 0 SI TOUT EST OK ) 15 : C 16 : C----------------------------------------------------------------------- 17 : IMPLICIT INTEGER(I-N) 18 : IMPLICIT REAL*8(A-H,O-Z) 19 : DIMENSION WORK(*),P(3,*),VECT(*),VN(3),VNP(3),XDDL(*) 20 : DIMENSION OMEG(3),PP(3,3),XX(*),YY(*),ZZ(*) 21 : C 22 : C CALCUL DE VNP 23 : C 24 : VNP(1)=XX(2)+XDDL(7)-XX(1)-XDDL(1) 25 : VNP(2)=YY(2)+XDDL(8)-YY(1)-XDDL(2) 26 : VNP(3)=ZZ(2)+XDDL(9)-ZZ(1)-XDDL(3) 27 : RLVNP=SQRT(VNP(1)*VNP(1)+VNP(2)*VNP(2)+VNP(3)*VNP(3)) 28 : IF(RLVNP.EQ.0.D0) THEN 29 : KERRE=1 30 : RETURN 31 : ENDIF 32 : DO 1 I=1,3 33 : VNP(I)=VNP(I)/RLVNP 34 : 1 OMEG(I)=VNP(I) 35 : C 36 : C CALCUL DE LA MATRICE DE PASSAGE 37 : C 37 : CALL POUPAS(XX,YY,ZZ,OMEG,PP,KERRE) 38 : IOMEG=KERRE 39 : KERRE=0 40 : C 41 : C PASSAGE DES DEPLACEMENTS EN AXES LOCAUX - ROTATION PSI 42 : C 42 : CALL POUVEC(XDDL,WORK,P,1) 43 : PSI=(WORK(4)+WORK(10))*0.5D0 44 : C2=PP(1,1)*VNP(1)+PP(1,2)*VNP(2)+PP(1,3)*VNP(3) 45 : S2=PP(2,1)*VNP(1)+PP(2,2)*VNP(2)+PP(2,3)*VNP(3) 46 : C3=COS(PSI) 47 : S3=SIN(PSI) 48 : C 49 : C REACTUALISATION DU VECTEUR 50 : C 51 : IF(IOMEG.EQ.0) THEN 52 : DO 2 I=1,3 53 : VN(I)=0.D0 54 : DO 2 J=1,3 55 : 2 VN(I)=VN(I)+PP(I,J)*VECT(J) 56 : OMEG(1)=C2*VN(1)-S2*C3*VN(2)+S2*S3*VN(3) 57 : OMEG(2)=S2*VN(1)+C2*C3*VN(2)-C2*S3*VN(3) 58 : OMEG(3)=S3*VN(2)+C3*VN(3) 59 : DO 3 I=1,3 60 : VECT(I)=0.D0 61 : DO 3 J=1,3 62 : 3 VECT(I)=VECT(I)+PP(J,I)*OMEG(J) 63 : ELSE 64 : VN(1)=0.D0 65 : VN(2)=C3 66 : VN(3)=S3 67 : DO 6 I=1,3 68 : VECT(I)=0.D0 69 : DO 6 J=1,3 70 : 6 VECT(I)=VECT(I)+P(J,I)*VN(J) 71 : ENDIF 72 : RETURN 73 : END 74 :
© Cast3M 2003 - All rights reserved.
Disclaimer