1 : C MAPAEX SOURCE CHAT 05/01/13 01:30:34 5004 2 : C MAPAEX SOURCE DJ 93/01/12 21:20:55 781 3 : SUBROUTINE MAPAEX(XE,NBNN,WORK,AL,TGL,LRE,KERRE) 4 : C======================================================================= 5 : C RECHERCHE DU REPERE LOCAL DE BAEX ( barre 3D excentre) 6 : C======================================================================= 7 : IMPLICIT INTEGER(I-N) 8 : IMPLICIT REAL*8(A-H,O-Z) 9 : DIMENSION XE(3,NBNN),B(3,3),TGL(2,LRE),WORK(6) 10 : * --------------------------------------------------- 11 : EXCZ=WORK(2) 12 : EXCY=WORK(3) 13 : VX3P=WORK(4) 14 : VY3P=WORK(5) 15 : VZ3P=WORK(6) 16 : C 17 : DO 13 I=1,2 18 : DO 13 J=1,LRE 19 : TGL(I,J)=0.D0 20 : 13 CONTINUE 21 : C 22 : VX1=XE(1,2)-XE(1,1) 23 : VY1=XE(2,2)-XE(2,1) 24 : VZ1=XE(3,2)-XE(3,1) 25 : VL1=DSQRT(VX1*VX1+VY1*VY1+VZ1*VZ1) 26 : AL=VL1 27 : C 28 : KERRE=0 29 : IF(AL.EQ.0.D0) THEN 30 : KERRE=1 31 : GO TO 999 32 : ENDIF 33 : C 34 : VX2=VY3P*VZ1-VY1*VZ3P 35 : VY2=VX1*VZ3P-VX3P*VZ1 36 : VZ2=VX3P*VY1-VX1*VY3P 37 : VL2=DSQRT(VX2*VX2+VY2*VY2+VZ2*VZ2) 38 : C 39 : B(1,1)=VX1/VL1 40 : B(1,2)=VY1/VL1 41 : B(1,3)=VZ1/VL1 42 : B(2,1)=VX2/VL2 43 : B(2,2)=VY2/VL2 44 : B(2,3)=VZ2/VL2 45 : B(3,1)=B(1,2)*B(2,3)-B(2,2)*B(1,3) 46 : B(3,2)=B(2,1)*B(1,3)-B(1,1)*B(2,3) 47 : B(3,3)=B(1,1)*B(2,2)-B(2,1)*B(1,2) 48 : C 49 : LIB=6 50 : C 51 : DO 20 I=1,2 52 : DO 10 J=1,3 53 : L1=(I-1)*LIB+J 54 : TGL(I,L1)=B(1,J) 55 : IF(LIB.EQ.6) THEN 56 : L2=I*LIB-2 57 : L3=I*LIB-1 58 : L4=I*LIB 59 : TGL(I,L2)= B(2,1)*EXCZ 60 : TGL(I,L3)= B(2,2)*EXCZ 61 : TGL(I,L4)= B(2,3)*EXCZ 62 : ELSE 63 : L2=I*LIB-1 64 : L3=I*LIB 65 : TGL(I,L2)= B(2,1)*EXCZ 66 : TGL(I,L3)= B(2,2)*EXCZ 67 : ENDIF 68 : 10 CONTINUE 69 : 20 CONTINUE 70 : 999 CONTINUE 71 : C 72 : * WRITE(*,*) ' matrice B elem =',IB 73 : * WRITE(*,1190) ((B(IA,IC),IA=1,3),IC=1,3) 74 : * WRITE(*,*) ' XGENE passage' 75 : * DO 110 I =1,2 76 : * WRITE(*,1199) (TGL(I,IC),IC=1,LRE) 77 : * 110 CONTINUE 78 : *1190 FORMAT(3(3(2X,E10.4),/)) 79 : *1199 FORMAT(12(1X,E8.2)) 80 : RETURN 81 : END 82 : 83 :
© Cast3M 2003 - All rights reserved.
Disclaimer