Download mapalu.eso

Back to the list

   1 : C MAPALU    SOURCE    AM        11/06/08    21:15:45     6998           
   2 :       SUBROUTINE MAPALU(NMATT,WORK,B,IDIM)
   3 : C=======================================================================        
   4 : C     RECUPERATION DU REPERE LOCAL DE JOI1 ( element de liaison a 2 noeuds)
   5 : C=======================================================================
   6 :       IMPLICIT INTEGER (I-N)
   7 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
   8 :       DIMENSION B(3,3),WORK(NMATT)
   9 : * ---------------------------------------------------
  10 : C
  11 :       IF(IDIM.EQ.3) THEN
  12 :        VX1=WORK(1)
  13 :        VY1=WORK(2)
  14 :        VZ1=WORK(3)
  15 :        VL1=DSQRT(VX1*VX1+VY1*VY1+VZ1*VZ1)
  16 : C
  17 :        VX2=WORK(4)
  18 :        VY2=WORK(5)
  19 :        VZ2=WORK(6)
  20 :        VL2=DSQRT(VX2*VX2+VY2*VY2+VZ2*VZ2)
  21 : *
  22 :        B(1,1)=VX1/VL1
  23 :        B(1,2)=VY1/VL1
  24 :        B(1,3)=VZ1/VL1
  25 :        B(2,1)=VX2/VL2
  26 :        B(2,2)=VY2/VL2
  27 :        B(2,3)=VZ2/VL2
  28 :        B(3,1)=B(1,2)*B(2,3)-B(1,3)*B(2,2)
  29 :        B(3,2)=B(1,3)*B(2,1)-B(1,1)*B(2,3)
  30 :        B(3,3)=B(1,1)*B(2,2)-B(1,2)*B(2,1)
  31 : *
  32 :       ELSE IF (IDIM.EQ.2) THEN
  33 :        VX1=WORK(1)
  34 :        VY1=WORK(2)
  35 :        VL1=DSQRT(VX1*VX1+VY1*VY1)
  36 : *
  37 :        B(1,1)=VX1/VL1
  38 :        B(1,2)=VY1/VL1
  39 :        B(1,3)=0
  40 :        B(2,1)=B(1,2)*(-1.D0)
  41 :        B(2,2)=B(1,1)
  42 :        B(2,3)=0
  43 :        B(3,1)=0
  44 :        B(3,2)=0
  45 :        B(3,3)=1
  46 :       ENDIF
  47 : *     
  48 : C
  49 : *      WRITE(*,*) ' matrice  BPSS  '
  50 : *      WRITE(*,1190) ((B(IA,IC),IA=1,3),IC=1,3)
  51 : *1199  FORMAT(12(1X,E8.2))
  52 :       RETURN                                                                    
  53 :       END                                                                       
  54 :  
  55 :  
  56 :  
  57 :  

© Cast3M 2003 - All rights reserved.
Disclaimer