Download lspfrm.eso

Back to the list

   1 : C LSPFRM    SOURCE    CHAT      05/01/13    01:25:38     5004           
   2 :       SUBROUTINE LSPFRM(IWRK,KERRE,VECT,ICAS)                                   
   3 : C-----------------------------------------------------------------------        
   4 : C  ROUTINE DE REMISE A JOUR DU VECTEUR DEFINISSANT LE REPERE LOCAL              
   5 : C                     POUR LE LINESPRING                                        
   6 : C                HYPOTHESE DES PETITES ROTATIONS                                
   7 : C-----------------------------------------------------------------------        
   8 : C  ENTREE                                                                       
   9 : C          IWRK    POINTEUR SUR SEGMENT DE TRAVAIL                              
  10 : C          VECT    LE VECTEUR A REACTUALISER                                    
  11 : C          ICAS    INDICE DU POINT A TRAITER                                    
  12 : C  SORTIE                                                                       
  13 : C          KERRE   INDICE D'ERREUR  ( 0 SI TOUT EST OK )                        
  14 : C-----------------------------------------------------------------------        
  15 :       IMPLICIT INTEGER(I-N)
  16 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  17 : -INC CCOPTIO                                                                    
  18 :       SEGMENT/IWRK/(XDDL(LRE)*D,XE(3,NBNN)*D,WORK(LW)*D)                        
  19 :       DIMENSION OMEG(3),VECT(*)                                                 
  20 : C                                                                               
  21 :       KERRE=0                                                                   
  22 : C                                                                               
  23 :       IF(ICAS.EQ.1) THEN                                                        
  24 :       OMEG(1)=0.5D0*(XDDL(4)+XDDL(22))                                          
  25 :       OMEG(2)=0.5D0*(XDDL(5)+XDDL(23))                                          
  26 :       OMEG(3)=0.5D0*(XDDL(6)+XDDL(24))                                          
  27 :       ELSE IF(ICAS.EQ.2) THEN                                                   
  28 :       OMEG(1)=0.5D0*(XDDL(10)+XDDL(16))                                         
  29 :       OMEG(2)=0.5D0*(XDDL(11)+XDDL(17))                                         
  30 :       OMEG(3)=0.5D0*(XDDL(12)+XDDL(18))                                         
  31 :       ENDIF                                                                     
  31 :       CALL ROTVEC(VECT,OMEG,IDIM,KERRE)                                         
  32 :       RETURN                                                                    
  33 :       END                                                                       
  34 :  

© Cast3M 2003 - All rights reserved.
Disclaimer