Download mapaex.eso

Back to the list

   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