Download lispep.eso

Back to the list

   1 : C LISPEP    SOURCE    CHAT      05/01/13    01:22:41     5004           
   2 :       SUBROUTINE LISPEP(XE,CAR,XDDL,XEL,BPSS,XDDLOC,NPOINT,EPS)                                   
   3 : C=======================================================================        
   4 : C                                                                               
   5 : C  ENTREES                                                                      
   6 : C    XE(3,4)     = COORDONNEES DE LA POUTRE LINESPRING                          
   7 : C    CAR         = STOCKE LES CARACTERISTIQUES 
   8 : C                  CAR(3,4,5)  = VECTEUR ORIENTANT LES NOEUDS 1 4                             
   9 : C                  CAR(8,9,10) = VECTEUR ORIENTANT LES NOEUDS 2 3                             
  10 : C    XDDL(24)    = D.D.L. DU LINESPRING                                         
  11 : C    NPOINT      = NOMBRE DE POINTS DE CONTRAINTES                              
  12 : C  TABLEAU DE TRAVAIL                                                           
  13 : C    XEL(3,3)    = COORDONNEES LOCALES                                          
  14 : C    BPSS(3,3)   = MATRICE DE PASSAGE                                           
  15 : C    XDDLOC(24)  = D.D.L. LOCAUX                                                
  16 : C  SORTIES                                                                      
  17 : C    EPS(NPOINT*6)= CONTRAINTES LINESPRING                                    
  18 : C=======================================================================        
  19 :       IMPLICIT INTEGER(I-N)
  20 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  21 :       PARAMETER(XZER=0.D0,UNDEMI=.5D0)                       
  22 :       PARAMETER(X774=.774596669241483D0)                                        
  23 : C                                                                               
  24 :       DIMENSION XE(3,*),EPS(*),V1(3),V2(3),BPSS(3,*),XEL(3,*)          
  25 :       DIMENSION S(3),XDDL(*),XDDLOC(*),CAR(*)                                          
  26 : C 
  27 :       V1(1)=CAR(3)
  28 :       V1(2)=CAR(4)
  29 :       V1(3)=CAR(5)
  30 :       V2(1)=CAR(8) 
  31 :       V2(2)=CAR(9) 
  32 :       V2(3)=CAR(10) 
  33 : C                                                                                
  34 :       IF(NPOINT.EQ.1) THEN                                                      
  35 :       S(1)= XZER                                                                
  36 :       ELSE IF(NPOINT.EQ.3) THEN                                                 
  37 :       S(1)=-X774                                                                
  38 :       S(2)= XZER                                                                
  39 :       S(3)= X774                                                                
  40 :       ENDIF                                                                     
  41 : C                                                                               
  42 :       NPOIN6=6*NPOINT                                                           
  43 : C                                                                               
  44 : C     MISE A ZERO DES DEFORMATIONS  DES INDICATEURS D ERREURS ET DES D.D.        
  45 : C                                                                               
  46 :       DO  90 IA=1,NPOIN6                                                        
  47 :       EPS(IA)=XZER                                                            
  48 :    90 CONTINUE                                                                  
  49 : C                                                                               
  50 : C                                                                               
  51 : C     EXTRACTION DE LA MATRICE DE PASSAGE                                       
  52 : C                                                                               
  53 :       DO 100 IA=1,3                                                             
  54 :       XEL(IA,1)=XE(IA,1)                                                        
  55 :       XEL(IA,2)=XE(IA,2)                                                        
  56 :       XEL(IA,3)=XE(IA,1)+(V1(IA)+V2(IA))*UNDEMI                                 
  57 :  100  CONTINUE                                                                  
  57 :       CALL VPAST(XEL,BPSS)                                                      
  57 :       CALL MATVEC(XDDL,XDDLOC,BPSS,8)                                           
  58 : C                                                                               
  59 : C     BOUCLE SUR LES POINTS                                   
  60 : C 
  61 :       DO 200 IA=1,NPOINT                                                        
  62 :       H1=UNDEMI-UNDEMI*S(IA)                                                    
  63 :       H2=UNDEMI+UNDEMI*S(IA)                                                    
  64 : C                                                                               
  65 : C     REMPLISSAGE DES DEFORMATIONS                                               
  66 : C                                                                               
  67 :       EPXZ =(XDDLOC(1 )-XDDLOC(19))*H1+(XDDLOC(7 )-XDDLOC(13))*H2               
  68 :       EPYZ =(XDDLOC(2 )-XDDLOC(20))*H1+(XDDLOC(8 )-XDDLOC(14))*H2               
  69 :       DD   =(XDDLOC(3 )-XDDLOC(21))*H1+(XDDLOC(9 )-XDDLOC(15))*H2               
  70 :       RT   =(XDDLOC(4 )-XDDLOC(22))*H1+(XDDLOC(10)-XDDLOC(16))*H2 
  71 :       RTZZ =(XDDLOC(6 )-XDDLOC(24))*H1+(XDDLOC(12)-XDDLOC(18))*H2               
  72 :       IX=6*(IA-1)                                                               
  73 :       EPS(IX+1)=DD
  74 :       EPS(IX+2)=EPXZ 
  75 :       EPS(IX+3)=EPYZ  
  76 :       EPS(IX+4)=RT
  77 :       EPS(IX+5)=RTZZ  
  78 :   200 CONTINUE                                                                  
  79 : *
  80 :       RETURN                                                                    
  81 :       END                                                                       
  82 :  

© Cast3M 2003 - All rights reserved.
Disclaimer