Esope source files

   1 : C BNQORJ    SOURCE    CHAT      05/01/12    21:41:59     5004           
   2 :       SUBROUTINE BNQORJ(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,XE,XEL,
   3 :      .                  SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,ICLE)
   4 : C-----------------------------------------------------------------------
   5 : C            BGENE(NSTB,LRE)     XGENE(NSTN,LRN)
   6 : C-----------------------------------------------------------------------
   7 : C  ENTREE :                                                             
   8 : C     IGAU =NUMERO DU POINT DE GAUSS                                    
   9 : C     NBNO =NOMBRE DE FONCTIONS DE FORME                                
  10 : C     NBBB =NOMBRE DE NOEUDS                                            
  11 : C     LRE  =NOMBRE DE COLONNES DE LA MATRICE N                          
  12 : C     IFOU =IFOUR DE CCOPTIO 
  13 : C     NSTB =NOMBRE DE LIGNES DE LA MATRICE N          
  14 : C     NSTN =NOMBRE DE LIGNES DE LA MATRICE NP 
  15 : C     XE   =COORDONNEES GLOBALES DE L ELEMENT
  16 : C     XEL  =COORDONNEES LOCALES DE L ELEMENT
  17 : C     SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES           
  18 : C     SHP(6,NBNO)         =TABLEAU DE TRAVAIL
  19 : C     BPSS=MATRICE DE PASSAGE REPERE GLOBAL/REPERE LOCAL   
  20 : C     ICLE  INDICATEUR DE CALCUL                                     
  21 : C         = 1    ON CALCULE  dNP (bgene)
  22 : C  SORTIE :                                                        
  23 : C     BGENE(NSTB,LRE)=MATRICE dNP
  24 : C     XGENE(NSTN,LRN)=MATRICE NP 
  25 : C     DJAC=JACOBIEN                                                
  26 : C-----------------------------------------------------------------------   
  27 :       IMPLICIT INTEGER(I-N)
  28 :       IMPLICIT REAL*8(A-H,O-Z)                                             
  29 :       DIMENSION XEL(3,*),BGENE(NSTB,*),SHP(6,*),SHPTOT(6,NBNO,*)           
  30 :       DIMENSION XGENE(NSTN,*),BPSS(3,3),XE(3,*)
  31 : C
  32 :       LRN=(NBNO-NBBB)*3/2
  33 :       LNAP=LRN / 3
  34 :       NBNB=(3*NBBB-NBNO)/2
  35 :       NFAC=NBNB/2
  36 :       NB1=NBNB+1                                                       
  37 : C                                                                      
  37 :       CALL ZERO(BGENE,NSTB,LRE)                                        
  38 : C                                                                      
  39 :       IFR=IFOU+4                                                       
  40 :       GOTO (666,10,10,10,666,40) ,IFR                                  
  41 :       GOTO 666                                                         
  42 : C
  43 : C   CONT PLANES, DEF PLANES OU AXISYMETRIQUE                               
  44 : C
  45 :   10  CONTINUE
  46 : C                                                                   
  47 :       DO 101 NP=1,NBNO
  48 :       SHP(1,NP)=SHPTOT(1,NP,IGAU)                                       
  49 :       SHP(2,NP)=SHPTOT(2,NP,IGAU)
  50 :   101 CONTINUE                                                           
  51 : C
  51 :       CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  52 : C                                                                        
  53 : C                                                                            
  54 :       IF(ICLE.EQ.1)  THEN
  55 :       DO 200 IP1=1,LNAP
  56 :       IP2 = IP1 + LNAP
  57 :       IP3 = IP2 + LNAP
  58 : ***** JP2 = 2*LNAP + 1 - IP1
  59 : * LIGNE 1
  60 :       BGENE(1,IP1)= SHP(1,NBNB+IP1)
  61 :       BGENE(1,IP3)=-SHP(1,NBNB+IP3)
  62 : * LIGNE 2
  63 : ****  BGENE(2,IP2)=-SHP(1,NBNB+JP2)
  64 :       BGENE(2,IP2)=-SHP(1,NBNB+IP2)
  65 :       BGENE(2,IP3)= SHP(1,NBNB+IP3)
  66 : * LIGNE 3
  67 :       BGENE(3,IP3)= SHP(2,NBNB+IP3)
  68 : 200   CONTINUE
  69 :       ENDIF
  70 :       GOTO  666
  71 : C                                                                        
  72 : C   TRIDIMMENSIONNEL
  73 : C
  74 :   40  CONTINUE
  75 : C                                                                       
  76 :       DO 201 NP=1,NBNO
  77 :       SHP(1,NP)=SHPTOT(1,NP,IGAU)                                          
  78 :       SHP(2,NP)=SHPTOT(2,NP,IGAU)                                          
  79 :       SHP(3,NP)=SHPTOT(3,NP,IGAU)
  80 :   201 CONTINUE                                                            
  81 : C
  81 :       CALL DEVOLJ(XE,XEL,SHP,NBBB,NBNO,IFOU,DJAC)
  82 : C                                                                          
  83 : C                                                                           
  84 :       IF(ICLE.EQ.1)  THEN
  85 :       DO 300 IP1=1,LNAP
  86 :       IP2 = IP1 + LNAP
  87 :       IP3 = IP2 + LNAP
  88 : * LIGNE 1
  89 :       BGENE(1,IP1)= SHP(1,NBNB+IP1)
  90 :       BGENE(1,IP3)=-SHP(1,NBNB+IP3)
  91 : * LIGNE 2
  92 :       BGENE(2,IP2)=-SHP(1,NBNB+IP2)
  93 :       BGENE(2,IP3)= SHP(1,NBNB+IP3)
  94 : * LIGNE 3
  95 :       BGENE(3,IP3)= SHP(2,NBNB+IP3)
  96 : * LIGNE 4
  97 :       BGENE(4,IP3)= SHP(3,NBNB+IP3)
  98 : 300   CONTINUE
  99 :       ENDIF
 100 :       GOTO  666
 101 : C
 102 :   666 CONTINUE                                                         
 103 :       RETURN                                                           
 104 :       END                                                              
 105 :  
 106 :  
 107 :  
 108 :