C PICAF2    SOURCE    CHAT      05/02/25    21:16:16     5035           
       SUBROUTINE PICAF2(NBNN,IDIM,TAB1,NCOELE,NBPTEL,SHP,XE1,                   
     1                   XE2,SH1,TAB,IFOU,KCAS,KERRE)
C=======================================================================        
C                                                                               
C    TRANSFORME LES CONTRAINTES DE PIOLA KIRCHHOFF EN CONTRAINTES DE            
C                             CAUCHY                                            
C  ENTREE                                                                       
C -------                                                                       
C   NBNN             = NOMBRE DE POINTS PAR ELEMENTS                            
C   IDIM             = DIMENSION DE L ESPACE SUPPORT                            
C                                                                               
C   TAB1(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE PIOLA KIRCHHOFF             
C                                                                               
C   NCOELE           = NOMBRE DE COMPOSTS TABLEAU DES CONTRAINTES               
C                                                                               
C   NBPTEL           = NOMBRE DE POINTS DE GAUSS                                
C   SHP(6,NBNN,NBPTEL)= FONCTIONS DE FORME                                      
C
C   KCAS = 1 SI CONTRAINTES, 2 SI DEFORMATIONS
C                                                                               
C TABLEAUX DE TRAVAIL                                                           
C--------------------                                                           
C   XE1(3,NBNN)    = COORDONNEES CORRESPONDANT A LA CONFIGURATION DEPART        
C                                                                               
C   XE2(3,NBNN)    = COORDONNEES CORRESPONDANT A LA CONFIGURATION ACTUEL        
C                                                                               
C   SH1(6,NBNN)    = FONCTIONS DE FORME EN UN POINT DE GAUSS                    
C                                                                               
C  SORTIES                                                                      
C---------                                                                      
C   TAB(NBPTEL,NCOELE) =TABLEAU DES CONTRAINTES DE CAUCHY                       
C                                                                               
C                                                                               
C     AOUT 85
C     MODIF PEGON FEV 90  CAS BIDIM                                             
C     PASSAGE AUX NOUVEAUX CHAMELEMS PAR P.DOWLATYARI 12/4/91                   
C                                                                               
C=======================================================================        
      IMPLICIT REAL*8(A-H,O-Z)                                                  
C                                                                               
      DIMENSION TAB1(NBPTEL,*)                                                  
      DIMENSION TAB(NBPTEL,*)                                                   
      DIMENSION SHP(6,NBNN,*)                                                   
      DIMENSION XE1(3,*),XE2(3,*),SH1(6,*)                                      
C                                                                               
C     TABLEAUX DE TRAVAIL DIMENSIONNES ICI                                      
C                                                                               
      DIMENSION XJAC(3,3),FAC(6)
C                                                                               
C     TABLEAUX INDIQUANT LA CORRESPONDANCE ENTRE INDICES I,J ET NUMERO          
C     DE LA COMPOSANTE DE CONTRAINTES OU DE DEFORMATIONS
C                                                                               
      DIMENSION IN(3),JN(3),ITAB(2,2)                                           
C                                                                               
      DATA IN/1,2,1/                                                      
      DATA JN/1,2,2/                                                      
C                                                                               
      DATA ITAB(1,1),ITAB(1,2)/1,3/                                 
      DATA ITAB(2,1),ITAB(2,2)/3,2/                                                                  
C                                                                               
C                                                                               
      KERRE=0                                                                               
C
C     MISE A ZERO DES CONTRAINTES OU DES DEFORMATIONS
C                                                                               
      DO 50 IA=1,NBPTEL                                                         
      DO 50 IB=1,NCOELE                                                         
      TAB(IA,IB)=0.D0
  50  CONTINUE                                                                  
C                                                                               
C     BOUCLE SUR LES POINTS DE GAUSS                                            
C                                                                               
      DO 130 IC=1,NBPTEL                                                        
        CALL ZERO(XJAC,3,3)
        CALL HPRIME(XE1,NBNN,2,SHP,IC,SH1,DJAC)
C                                                                               
C       CALCUL DE LA MATRICE  F
C                                                                               
        DO 140 ID=1,NBNN
        DO 140 IE=1,2
        DO 140 IF=1,2
          XJAC(IE,IF)=SH1(IF+1,ID)*XE2(IE,ID)+XJAC(IE,IF)
  140   CONTINUE
           XJAC(3,3)=1.D0
                                                                               
C     CALCUL DE DETERMINANT DE F                                        
C                                                                               
        DETF=XJAC(1,1)*XJAC(2,2)-XJAC(1,2)*XJAC(2,1)
        DETF = DETF * XJAC (3,3)
        DETF=1./(DETF+1.E-20)
C                                                                               
C     CALCUL DES CONTRAINTES DE CAUCHY                                          
C                                                                       
        DO 160 ID=1,3
         IND=IN(ID)
         JND=JN(ID)
         DO 170 IE=1,2
         DO 170 IF=1,2
           ICO=ITAB(IE,IF)
           TAB(IC,ID)=TAB1(IC,ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF
     1             +TAB(IC,ID)                                                  
 170     CONTINUE
 160    CONTINUE

        DO 180 ID=1,3
         IND=IN(ID)
         JND=JN(ID)
         DO 190 IE=1,2
         DO 190 IF=1,2
           ICO=ITAB(IE,IF)
           TAB(IC,3+ID)=TAB1(IC,3+ICO)*XJAC(IND,IE)*XJAC(JND,IF)*DETF
     1             +TAB(IC,3+ID)                                                  
 190     CONTINUE
 180    CONTINUE
 130    CONTINUE                 
C                                                                               
      RETURN                                                                    
      END