Esope source files

   1 : C POUPA2    SOURCE    CHAT      05/01/13    02:19:26     5004           
   2 : C POUPA2    SOURCE    CHAT      89/06/01    22:43:22                            
   3 :       SUBROUTINE POUPA2(XE,YE,P,KERRE)                                  
   4 : C-----------------------------------------------------------------------        
   5 : C  ROUTINE DE CALCUL DE LA MATRICE DE PASSAGE P DES AXES LOCAUX AUX AXES        
   6 : C  GLOBAUX :       DEPLOC= P * DEPGLO                                           
   7 : C                                                                               
   8 : C  ENTREE                                                                       
   9 : C         XE YE  COORDONNEES DES 2 NOEUDS                                               
  10 : C                                                                               
  11 : C  SORTIE                                                                       
  12 : C         P      MATRICE DE CHANGEMENT DE BASE                                  
  13 : C         KERRE  = 0 SI PAS DE PB                                               
  14 : C                = 1 SI POINTS CONFONDUS                                        
  15 : C                = 2 SI LE VECTEUR LOCAL EST COLINEAIRE A L'ELEMENT             
  16 : C                                                                               
  17 : C-----------------------------------------------------------------------        
  18 :       IMPLICIT INTEGER(I-N)
  19 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  20 :       DIMENSION XE(*),YE(*),P(2,*),A(2)                           
  21 : C                                                                               
  22 :       KERRE=0                                                                   
  23 :       A(1)=XE(2)-XE(1)                                                          
  24 :       A(2)=YE(2)-YE(1)                                                                                                                  
  25 :       XL=SQRT(A(1)**2+A(2)**2)                                          
  26 :       IF(XL.EQ.0.D0) THEN                                                       
  27 :       KERRE=1                                                                   
  28 :       RETURN                                                                    
  29 :       ENDIF                                                                     
  30 :       RL=1.D00/XL                                                               
  31 : C
  32 :       P(1,1) = A(1)*RL
  33 :       P(1,2) = A(2)*RL
  34 :       P(2,1) = ((-1.D0)*A(2)*RL)
  35 :       P(2,2) = A(1)*RL                         
  36 :       RETURN                                                                    
  37 :       END                                                                       
  38 :  
  39 :