Download lispst.eso

Back to the list

   1 : C LISPST    SOURCE    CHAT      05/01/13    01:23:52     5004           
   2 :       SUBROUTINE LISPST(XE,CAR,D,XDDL,WORK,NPOINT,MELE,XSTRS,I69,I70,           
   3 :      1 I195,I157)                                                               
   4 : C=======================================================================        
   5 : C                                                                               
   6 : C     CALCULE LES CONTRAINTES DU LINE SPRING                                    
   7 : C                                                                               
   8 : C     CODE EBERSOLT NOVEMBRE 84                                                 
   9 : C                                                                               
  10 : C  ENTREES                                                                      
  11 : C     XE(3,4)  =COORDONNEEES DU LINE SPRING                                     
  12 : C     CAR(10)  =STOCKE LES CARACTERISTIQUES DU LINESPRING                       
  13 : C                CAR(1)  =EPAISSEUR NOEUDS 1 4                                  
  14 : C                CAR(2)  =PROFONDEUR FISSURE NOEUDS 1 4                         
  15 : C                CAR(3,4,5) =VECTEU ORIENTANT LA FISSSURE NDS 1 4               
  16 : C                CAR(6)  =EPAISSEUR NOEUDS 2 3                                  
  17 : C                CAR(7)  =PROFONDEUR FISSURE NOEUDS 2 3                         
  18 : C                CAR(8,9,10)=VECTEU ORIENTANT LA FISSSURE NDS 2 3               
  19 : C    D(2,2)    =MATRICE DE HOOKE                                                
  20 : C    XDDL(24)  =D.D.L. REPERE GLOBAL                                            
  21 : C    NPOINT    = NOMBRE DE POINTS POUR LES CONTRAINTES                          
  22 : C    MELE      = NUMERO  DE L ELEMENT 30 SI LISP   50 LISP                      
  23 : C TRAVAIL                                                                       
  24 : C    WORK(42)  =TABLEAU DE TRAVAIL                                              
  25 : C SORTIES                                                                       
  26 : C    XSTRS(3*NPOINT)=  CONTRAINTES  DONT K I                                    
  27 : C                                                                               
  28 : C=======================================================================        
  29 :       IMPLICIT INTEGER(I-N)
  30 :       IMPLICIT REAL*8 (A-H,O-Z)                                                 
  31 :       DIMENSION XE(3,*),CAR(*),D(6,*),XDDL(*),WORK(*),XSTRS(*)                  
  32 :       DIMENSION V1(3),V2(3)                                                     
  33 :       EPA1 =CAR(1)                                                              
  34 :       FIS1 =CAR(2)                                                              
  35 :       V1(1)=CAR(3)                                                              
  36 :       V1(2)=CAR(4)                                                              
  37 :       V1(3)=CAR(5)                                                              
  38 :       EPA2 =CAR(6)                                                              
  39 :       FIS2 =CAR(7)                                                              
  40 :       V2(1)=CAR(8)                                                              
  41 :       V2(2)=CAR(9)                                                              
  42 :       V2(3)=CAR(10)                                                             
  43 : C                                                                               
  44 :       IF(MELE.EQ.30) THEN                                                       
  44 :       CALL LISPS2(XE,EPA1,FIS1,V1,EPA2,FIS2,V2,D,XDDL,                          
  45 :      1   WORK(1),WORK(10),WORK(19),NPOINT,XSTRS,I69,I70,I195,I157)              
  46 : C                                                                               
  47 :       ELSE IF(MELE.EQ.50) THEN                                                  
  47 :       CALL LISPS3(XE,EPA1,FIS1,V1,EPA2,FIS2,V2,D,XDDL,                          
  48 :      1   WORK(1),WORK(10),WORK(19),NPOINT,XSTRS,I69,I70,I195,I157)              
  49 :       ENDIF                                                                     
  50 : C                                                                               
  51 :       RETURN                                                                    
  52 :       END                                                                       
  53 :  

© Cast3M 2003 - All rights reserved.
Disclaimer