Esope source files

   1 : C LISPBS    SOURCE    CHAT      05/01/13    01:22:33     5004           
   2 :       SUBROUTINE LISPBS(WORK,VELA,POIGAU,SHPTOT,                                
   3 :      1   NBPGAU,NBNO,XE,XFOLO,BPSS,XFORC)                                       
   4 : C=====================================================================          
   5 : C  ENTREES                                                                      
   6 : C                                                                               
   7 : C    WORK(NSTRS*NBPGAU) = CONTIEND LES CONTRAINTES DU LINESPRING                
   8 : C    VELA(5*NBPGAU) = CARACTERISTIQUES                                          
   9 : C    POIGAU(NBPGAU) = POIDS D INTEGRATION                                       
  10 : C    SHPTOT(6,NBNO,NBPGAU) = FONCTIONS DE FORME                                 
  11 : C    NBPGAU         = NOMBRE DE POINT D INTEGRATION                             
  12 : C    NBNO           = NOMBRE DE POINT DE L ELEMENT                              
  13 : C    XE(3,4)        = CORRDONEES DE L ELEMENT                                   
  14 : C  TRAVAIL                                                                      
  15 : C    XFOLO(LRE)     =     FORCES LOCALES                                        
  16 : C    BPSS(3,3)      =     MATRICE DE PASSAGE                                    
  17 : C  SORTIES                                                                      
  18 : C    XFORC(LRE)     = FORCE NODALES                                             
  19 : C       EBERSOLT AVRIL 86      ON SUPPOSE L EPAISSEUR CONSTANTE                 
  20 : C====================================================================           
  21 :       IMPLICIT INTEGER(I-N)
  22 :       IMPLICIT REAL*8(A-H,O-Z)                                                  
  23 :       PARAMETER(UNSIX=.166666666666666D0,XZER=0.D0,DEUX=2.D0)                   
  24 :       PARAMETER(UN=1.D0)                                                        
  25 :       DIMENSION WORK(*),POIGAU(*),SHPTOT(6,NBNO,*)                              
  26 :       DIMENSION XFORC(*),XE(3,*),BPSS(3,*),XFOLO(*),VELA(*)                     
  27 :       DIMENSION XEP(6),XEL(3,3),IL(6)                                           
  28 : C                                                                               
  29 :       DATA IL/2,3,1,4,1,5/                                                      
  30 : C                                                                               
  31 :       XEP(1)= UN                                                                
  32 :       XEP(2)= UN                                                                
  33 :       XEP(3)= UN                                                                
  34 :       XEP(4)= UN                                                                
  35 :       XEP(5)= XZER                                                              
  36 :       XEP(6)= UN                                                                
  37 : C                                                                               
  38 : C    ON CALCULE LA MATRICE DE PASSAGE                                           
  39 : C                                                                               
  40 :       XEL(1,1)=XE(1,1)                                                          
  41 :       XEL(2,1)=XE(2,1)                                                          
  42 :       XEL(3,1)=XE(3,1)                                                          
  43 :       XX=(XE(1,1)-XE(1,2))*(XE(1,1)-XE(1,2))                                    
  44 :      1  +(XE(2,1)-XE(2,2))*(XE(2,1)-XE(2,2))                                    
  45 :      1  +(XE(3,1)-XE(3,2))*(XE(3,1)-XE(3,2))                                    
  46 :       XX=SQRT(XX)                                                               
  47 : C                                                                               
  48 :       XEL(1,2)=XE(1,2)                                                          
  49 :       XEL(2,2)=XE(2,2)                                                          
  50 :       XEL(3,2)=XE(3,2)                                                          
  51 : C                                                                               
  52 :       XEL(1,3)=XE(1,1)+VELA(3)                                                  
  53 :       XEL(2,3)=XE(2,1)+VELA(4)                                                  
  54 :       XEL(3,3)=XE(3,1)+VELA(5)                                                  
  55 : C                                                                               
  55 :       CALL VPAST(XEL,BPSS)                                                      
  56 : C                                                                               
  57 :       DO 500 IA=1,6                                                             
  58 :       XEP(IA)=XEP(IA)*XX                                                        
  59 :   500 CONTINUE                                                                  
  60 : C                                                                               
  61 :       DO 100 IA=1,NBNO                                                          
  62 :       IF(IA.EQ.1.OR.IA.EQ.2) YY= UN                                             
  63 :       IF(IA.EQ.3.OR.IA.EQ.4) YY=-UN                                             
  64 :       DO 300 IC=1,6                                                             
  65 :       CC=XZER                                                                   
  66 :       IX=IC+(IA-1)*6                                                            
  67 :       DO 200 IB=1,NBPGAU                                                        
  68 :       IJ=IL(IC)+(IB-1)*6                                                        
  69 :       CC=CC+SHPTOT(1,IA,IB)*WORK(IJ)*POIGAU(IB)*XEP(IC)*YY                      
  70 :   200 CONTINUE                                                                  
  71 :       XFOLO(IX)=CC                                                              
  72 :   300 CONTINUE                                                                  
  73 :   100 CONTINUE                                                                  
  74 : C                                                                               
  74 :       CALL TRPOSE(BPSS)                                                         
  74 :       CALL MATVEC(XFOLO,XFORC,BPSS,8)                                           
  75 : C                                                                               
  76 :       RETURN                                                                    
  77 :       END                                                                       
  78 :