Sources Esope | Cast3M

bnpqrj
C BNPQRJ    SOURCE    AM        15/08/21    21:15:00     8599
      SUBROUTINE BNPQRJ(IGAU,NBNO,NBBB,LRE,IFOU,LHOOK,NSTN,XE,XEL,
     .          SHPTOT,SHP,BPSS,BGENE,XGENE,DJAC,IDECAP,NSTB,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(LHOOK,LRE)=MATRICE N  OU dNP   (NSTB LIGNES UTILES)
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(LHOOK,*),SHP(6,*),SHPTOT(6,NBNO,*)
      DIMENSION XGENE(NSTN,*),BPSS(3,3),XE(3,*)
C
      JCLE1=0
      JCLE2=0
      JCLE3=0
 
      LPP=(NBNO-NBBB)*3/2
      LRN= IDECAP * LPP
      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,LHOOK,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 4113 IPR=1,IDECAP
        DO 113 NP=NB1,NBNO
        XGENE(IPR,K)=SHP(1,NP)
        K=K+1
  113   CONTINUE
 4113 CONTINUE
      ENDIF
C
      IF(JCLE3.NE.0) THEN
      K=1
      DO 4114 IPR=1,IDECAP
        DO 114 NP=NB1,NBNO
        BGENE(IPR,K)=SHP(2,NP)
        K=K+1
  114   CONTINUE
 4114 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 4213 IPR=1,IDECAP
        DO 213 NP=NB1,NBNO
        XGENE(IPR,K)=SHP(1,NP)
        K=K+1
  213   CONTINUE
 4213   CONTINUE
      ENDIF
C
      IF(JCLE3.NE.0) THEN
      DO 4214 IPR=1,IDECAP
        K=(IPR-1)*NBBB +1
        IPR2=2*IPR
        DO 214 NP=NB1,NBNO
        BGENE(IPR2-1,K)=SHP(2,NP)
        BGENE(IPR2  ,K)=SHP(3,NP)
        K=K+1
  214   CONTINUE
 4214 CONTINUE
      ENDIF
      GOTO  666
C
  666 CONTINUE
      RETURN
      END