Sources Esope | Cast3M

bnporj
C BNPORJ    SOURCE    CHAT      05/01/12    21:41:52     5004
      SUBROUTINE BNPORJ(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,XE,XEL,
     .                  SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,ICLE)
C-----------------------------------------------------------------------
C
C            CALCULE LES MATRICES N, NP ET dNP DU JOINT POREUX
C
C            LE RESULTAT EST DANS BGENE ET / OU XGENE
C
C            BGENE(NSTB,LRE)     XGENE(NSTN,LRN)
C
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  N  (bgene) ET  NP (xgene)
C         = 2    ON CALCULE  N  (bgene)
C         = 3    ON CALCULE  NP (xgene) ET dNP (bgene)
C  SORTIE :
C     BGENE(NSTB,LRE)=MATRICE N  OU 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
      JCLE1=0
      JCLE2=0
      JCLE3=0
      LRN=(NBNO-NBBB)*3/2
      NBNB=(3*NBBB-NBNO)/2
      NFAC=NBNB/2
      NB1=NBNB+1
      IF(ICLE.EQ.1) THEN
       JCLE1=1
       JCLE2=1
      ENDIF
      IF(ICLE.EQ.2) THEN
       JCLE1=1
      ENDIF
      IF(ICLE.EQ.3) THEN
       JCLE2=1
       JCLE3=1
      ENDIF
C
      CALL ZERO(BGENE,NSTB,LRE)
      CALL ZERO(XGENE,NSTN,LRN)
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
      IF(JCLE1.NE.0) THEN
      DO 110 I=1,NSTB
      DO 111 J=1,NFAC
      DO 112 K=1,NSTB
      L=NSTB*(J-1)+K
      M=L+NSTB*(2*(NFAC-J)+1)
      BGENE(I,L)=BPSS(I,K)*SHP(1,J)
      BGENE(I,M)=-BGENE(I,L)
  112 CONTINUE
  111 CONTINUE
  110 CONTINUE
      ENDIF
C
      IF(JCLE2.NE.0) THEN
      K=1
      DO 113 NP=NB1,NBNO
      XGENE(1,K)=SHP(1,NP)
      K=K+1
  113 CONTINUE
      ENDIF
C
      IF(JCLE3.NE.0) THEN
      K=1
      DO 114 NP=NB1,NBNO
      BGENE(1,K)=SHP(2,NP)
      K=K+1
  114 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
      IF(JCLE1.NE.0) THEN
      DO 210 I=1,NSTB
      DO 211 J=1,NFAC
      DO 212 K=1,NSTB
         L=NSTB*(J-1)+K
         M=L+NFAC*NSTB
         BGENE(I,L)=BPSS(I,K)*SHP(1,J)
         BGENE(I,M)=-BGENE(I,L)
  212 CONTINUE
  211 CONTINUE
  210 CONTINUE
      ENDIF
C
      IF(JCLE2.NE.0) THEN
      K=1
      DO 213 NP=NB1,NBNO
      XGENE(1,K)=SHP(1,NP)
      K=K+1
  213 CONTINUE
      ENDIF
C
      IF(JCLE3.NE.0) THEN
      K=1
      DO 214 NP=NB1,NBNO
      BGENE(1,K)=SHP(2,NP)
      BGENE(2,K)=SHP(3,NP)
      K=K+1
  214 CONTINUE
      ENDIF
      GOTO  666
C
  666 CONTINUE
      RETURN
      END