C BNQORJ    SOURCE    CHAT      05/01/12    21:41:59     5004           
      SUBROUTINE BNQORJ(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,XE,XEL,
     .                  SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,ICLE)
C-----------------------------------------------------------------------
C            BGENE(NSTB,LRE)     XGENE(NSTN,LRN)
C-----------------------------------------------------------------------
C  ENTREE :                                                             
C     IGAU =NUMERO DU POINT DE GAUSS                                    
C     NBNO =NOMBRE DE FONCTIONS DE FORME                                
C     NBBB =NOMBRE DE NOEUDS                                            
C     LRE  =NOMBRE DE COLONNES DE LA MATRICE N                          
C     IFOU =IFOUR DE CCOPTIO 
C     NSTB =NOMBRE DE LIGNES DE LA MATRICE N          
C     NSTN =NOMBRE DE LIGNES DE LA MATRICE NP 
C     XE   =COORDONNEES GLOBALES DE L ELEMENT
C     XEL  =COORDONNEES LOCALES DE L ELEMENT
C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES           
C     SHP(6,NBNO)         =TABLEAU DE TRAVAIL
C     BPSS=MATRICE DE PASSAGE REPERE GLOBAL/REPERE LOCAL   
C     ICLE  INDICATEUR DE CALCUL                                     
C         = 1    ON CALCULE  dNP (bgene)
C  SORTIE :                                                        
C     BGENE(NSTB,LRE)=MATRICE dNP
C     XGENE(NSTN,LRN)=MATRICE NP 
C     DJAC=JACOBIEN                                                
C-----------------------------------------------------------------------   
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)                                             
      DIMENSION XEL(3,*),BGENE(NSTB,*),SHP(6,*),SHPTOT(6,NBNO,*)           
      DIMENSION XGENE(NSTN,*),BPSS(3,3),XE(3,*)
C
      LRN=(NBNO-NBBB)*3/2
      LNAP=LRN / 3
      NBNB=(3*NBBB-NBNO)/2
      NFAC=NBNB/2
      NB1=NBNB+1                                                       
C                                                                      
      CALL ZERO(BGENE,NSTB,LRE)                                        
C                                                                      
      IFR=IFOU+4                                                       
      GOTO (666,10,10,10,666,40) ,IFR                                  
      GOTO 666                                                         
C
C   CONT PLANES, DEF PLANES OU AXISYMETRIQUE                               
C
  10  CONTINUE
C                                                                   
      DO 101 NP=1,NBNO
      SHP(1,NP)=SHPTOT(1,NP,IGAU)                                       
      SHP(2,NP)=SHPTOT(2,NP,IGAU)
  101 CONTINUE                                                           
C
      CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
C                                                                        
C                                                                            
      IF(ICLE.EQ.1)  THEN
      DO 200 IP1=1,LNAP
      IP2 = IP1 + LNAP
      IP3 = IP2 + LNAP
***** JP2 = 2*LNAP + 1 - IP1
* LIGNE 1
      BGENE(1,IP1)= SHP(1,NBNB+IP1)
      BGENE(1,IP3)=-SHP(1,NBNB+IP3)
* LIGNE 2
****  BGENE(2,IP2)=-SHP(1,NBNB+JP2)
      BGENE(2,IP2)=-SHP(1,NBNB+IP2)
      BGENE(2,IP3)= SHP(1,NBNB+IP3)
* LIGNE 3
      BGENE(3,IP3)= SHP(2,NBNB+IP3)
200   CONTINUE
      ENDIF
      GOTO  666
C                                                                        
C   TRIDIMMENSIONNEL
C
  40  CONTINUE
C                                                                       
      DO 201 NP=1,NBNO
      SHP(1,NP)=SHPTOT(1,NP,IGAU)                                          
      SHP(2,NP)=SHPTOT(2,NP,IGAU)                                          
      SHP(3,NP)=SHPTOT(3,NP,IGAU)
  201 CONTINUE                                                            
C
      CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
C                                                                          
C                                                                           
      IF(ICLE.EQ.1)  THEN
      DO 300 IP1=1,LNAP
      IP2 = IP1 + LNAP
      IP3 = IP2 + LNAP
* LIGNE 1
      BGENE(1,IP1)= SHP(1,NBNB+IP1)
      BGENE(1,IP3)=-SHP(1,NBNB+IP3)
* LIGNE 2
      BGENE(2,IP2)=-SHP(1,NBNB+IP2)
      BGENE(2,IP3)= SHP(1,NBNB+IP3)
* LIGNE 3
      BGENE(3,IP3)= SHP(2,NBNB+IP3)
* LIGNE 4
      BGENE(4,IP3)= SHP(3,NBNB+IP3)
300   CONTINUE
      ENDIF
      GOTO  666
C
  666 CONTINUE                                                         
      RETURN                                                           
      END