C FPLISP    SOURCE    PV        09/03/12    21:23:12     6325           
      SUBROUTINE FPLISP(IPTVPR,IPTGEO,IPTINT,IVACAR,IVAFOR)                     
C_____________________________________________________________________          
C                                                                               
C     CALCULE LES FORCES DE PRESSION DANS LE LINESPRING                         
C                                                                               
C    ENTREES :                                                                  
C    ---------                                                                  
C                                                                               
C   IPTVPR   POINTEUR SUR LE MELVAL CONTENANT LES PRESSIONS                     
C   IPTGEO   POINTEUR SUR LE MAILLAGE                                           
C   IPTINT   POINTEUR SUR MINTE                                                 
C   IVACAR   POINTEUR SUR MPTVAL DE CARACTERISTIQUE                             
C   IVAFOR   POINTEUR SUR MPTVAL DE FORCE                                       
C                                                                               
C    EBERSOLT MAI 85   J UTILISE DFLOAT ET SQRT                                 
C    PASSAGE AUX NOUVEAUX CHAMELEM PAR JM CAMPENON LE 21 09 90                  
C                                                                               
C_____________________________________________________________________          
C                                                                               
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                                  
-INC SMINTE                                                                     
-INC SMCHAML                                                                    
-INC SMELEME                                                                    
-INC SMCOORD                                                                    
-INC CCOPTIO                                                                    
C                                                                               
      SEGMENT MPTVAL                                                            
        INTEGER IPOS(NS)    ,NSOF(NS)                                           
        INTEGER      IVAL(NCOSOU)                                               
        CHARACTER*16 TYVAL(NCOSOU)                                              
      ENDSEGMENT                                                                
C                                                                               
      DIMENSION BPSS(3,3),XE(3,4),XEL(3,3),V1(3),V2(3),H1(3),H2(3)              
C                                                                               
      DATA X774/.774596669241483D0/                                             
      DATA UN,UNDEMI,ZERO/1.D0,.5D0,0.D0/                                       
C                                                                               
C     ON INITIALISE LES FONCTIONS DE FORME                                      
C                                                                               
      H1(1) =(UN-X774)*UNDEMI                                                   
      H1(2) = UNDEMI                                                            
      H1(3) =(UN+X774)*UNDEMI                                                   
      H2(1) = H1(3)                                                             
      H2(2) = UNDEMI                                                            
      H2(3) = H1(1)                                                             
C                                                                               
      MELVA1=IPTVPR                                                             
C                                                                               
      MELEME=IPTGEO                                                             
      NBNN  =NUM(/1)                                                            
      NBELEM=NUM(/2)                                                            
C                                                                               
      MINTE =IPTINT                                                             
      SEGACT MINTE                                                              
      NBNO  =SHPTOT(/2)                                                         
      NBPGAU=SHPTOT(/3)                                                         
C                                                                               
C     BOUCLE SUR LES ELEMENTS                                                   
C                                                                               
      DO 100   IA=1,NBELEM                                                      
C                                                                               
C        ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB                  
C                                                                               
         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IA,XE)                                   
C                                                                               
C        ON RECUPERE LES VECTEURS ORIENTANT LE LINESPRING                       
C        AINSI QUE LA LONGUEUR DU LINESPRING                                    
C                                                                               
         XLONG= ZERO                                                            
         MPTVAL=IVACAR                                                          
         DO 110 IB=1,3                                                          
            MELVAL=IVAL(2+IB)                                                   
            IBMN=MIN(IA,VELCHE(/2))                                             
            V1(IB)=VELCHE(1,IBMN)                                               
            V2(IB)=VELCHE(1,IBMN)                                               
            XLONG =XLONG +(XE(IB,1)-XE(IB,2))*(XE(IB,1)-XE(IB,2))               
 110     CONTINUE                                                               
         XLONG = SQRT(XLONG)                                                    
C                                                                               
C        AINSI QUE L EPAISSEUR                                                  
C                                                                               
         EPAISS=ZERO                                                            
         DO 120 IB=1,NBPGAU                                                     
            MELVAL=IVAL(1)                                                      
            IGMN=MIN(IB,VELCHE(/1))                                             
            IBMN=MIN(IA,VELCHE(/2))                                             
            EPAISS=VELCHE(IGMN,IBMN)+EPAISS                                     
 120     CONTINUE                                                               
         EPAISS=EPAISS/DBLE(NBPGAU)                                             
C                                                                               
C        EXTRACTION DE LA MATRICE DE PASSAGE                                    
C                                                                               
         DO 130 IB=1,3                                                          
            XEL(IB,1)=XE(IB,1)                                                  
            XEL(IB,2)=XE(IB,2)                                                  
            XEL(IB,3)=XE(IB,1)+(V1(IB)+V2(IB))*UNDEMI                           
 130     CONTINUE                                                               
              DO 97 II=1,3                                                      
              DO 97 JJ=1,3                                                      
 97           CONTINUE                                                          
         CALL VPAST(XEL,BPSS)                                                   
C                                                                               
C     ON INTEGRE LES FORCES DU  A LA PRESSION DANS LA FISSURE                   
C                                                                               
         FZ1= ZERO                                                              
         CX1= ZERO                                                              
         FZ2= ZERO                                                              
         CX2= ZERO                                                              
C                                                                               
C        BOUCLE SUR LES POINTS DE GAUSS                                         
C                                                                               
         MPTVAL=IVACAR                                                          
         DO 200 IB=1,NBPGAU                                                     
            MELVAL=IVAL(2)                                                      
            IGMN=MIN(IB,VELCHE(/1))                                             
            IBMN=MIN(IA,VELCHE(/2))                                             
            FISS=VELCHE(IGMN,IBMN)                                              
            IGMN=MIN(IB,MELVA1.VELCHE(/1))                                      
            IBMN=MIN(IA,MELVA1.VELCHE(/2))                                      
            PRES=MELVA1.VELCHE(IGMN,IBMN)                                       
            XX=FISS*PRES*POIGAU(IB)*XLONG*UNDEMI                                
            FZ1= FZ1+ XX*H1(IB)                                                 
            CX1= CX1+ XX*(EPAISS-FISS)*H1(IB)*UNDEMI                            
            FZ2= FZ2+ XX*H2(IB)                                                 
            CX2= CX2+ XX*(EPAISS-FISS)*H2(IB)*UNDEMI                            
  200    CONTINUE                                                               
C                                                                               
C        CHANGEMENT DE REPERE                                                   
C                                                                               
         MPTVAL=IVAFOR                                                          
         MELVAL=IVAL(1)                                                         
         VELCHE(1,IA)=FZ1*BPSS(3,1)                                             
         VELCHE(2,IA)=FZ2*BPSS(3,1)                                             
C                                                                               
         MELVAL=IVAL(2)                                                         
         VELCHE(1,IA)=FZ1*BPSS(3,2)                                             
         VELCHE(2,IA)=FZ2*BPSS(3,2)                                             
C                                                                               
         MELVAL=IVAL(3)                                                         
         VELCHE(1,IA)=FZ1*BPSS(3,3)                                             
         VELCHE(2,IA)=FZ2*BPSS(3,3)                                             
C                                                                               
         MELVAL=IVAL(4)                                                         
         VELCHE(1,IA)=CX1*BPSS(1,1)                                             
         VELCHE(2,IA)=CX2*BPSS(1,1)                                             
C                                                                               
         MELVAL=IVAL(5)                                                         
         VELCHE(1,IA)=CX1*BPSS(1,2)                                             
         VELCHE(2,IA)=CX2*BPSS(1,2)                                             
C                                                                               
         MELVAL=IVAL(6)                                                         
         VELCHE(1,IA)=CX1*BPSS(1,3)                                             
         VELCHE(2,IA)=CX2*BPSS(1,3)                                             
C                                                                               
         MPTVAL=IVAFOR                                                          
         DO 300 IB=1,6                                                          
            MELVAL=IVAL(IB)                                                     
            VELCHE(3,IA)=-VELCHE(2,IA)                                          
            VELCHE(4,IA)=-VELCHE(1,IA)                                          
  300    CONTINUE                                                               
C                                                                               
  100 CONTINUE                                                                  
C                                                                               
  666 CONTINUE                                                                  
      SEGDES MINTE                                                              
      RETURN                                                                    
      END