C BNQORE SOURCE AM 15/08/21 21:15:02 8599 SUBROUTINE BNQORE(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,NN, . DIM3,XEL,SHPTOT,SHP,BGENE,XGENE,DJAC,IDECAP,LHOOK,ICLE) C----------------------------------------------------------------------- C C CALCULE LES MATRICES B ET N DU MILIEU 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 B C IFOU=IFOUR DE CCOPTIO C NSTB=NOMBRE DE LIGNES DE LA MATRICE B C NSTN=NOMBRE DE LIGNES DE LA MATRICE N C DIM3=EPAISSEUR DE L'ELEMENT (CONTRAINTES PLANES) C NN =NUMERO DU MODE DE FOURIER C XEL =COORDONNEES DE L ELEMENT C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES C ICLE INDICATEUR DE CALCUL C = 1 ON CALCULE B ET NP C = 2 ON CALCULE BP C = 3 ON CALCULE B C = 4 ON CALCULE N C = 5 ON CALCULE N ET NP C ON MET ALORS N DANS BGENE ET NP DANS XGENE C AUTRES VALEURS : COMBINAISONS DES CAS PRECEDENTS C SHP(6,NBNO)=TABLEAU DE TRAVAIL C SORTIE : C DJAC=JACOBIEN C BGENE(LHOOK,LRE)=MATRICE B C XGENE(NSTN,LRN)=MATRICE N 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,*) DIMENSION BB(3,9),GEOM(20),XX(3),YY(3) DATA XX/.5D0,.0D0,.5D0/ DATA YY/.0D0,.5D0,.5D0/ C JCLE1=0 JCLE2=0 JCLE3=0 JCLE4=0 LPP = NBNO-NBBB LRN=IDECAP*LPP NB1=NBBB+1 IF(ICLE.EQ.1) THEN JCLE1=1 JCLE4=1 ENDIF IF(ICLE.EQ.2) THEN JCLE3=1 ENDIF IF(ICLE.EQ.3) THEN JCLE1=1 ENDIF IF(ICLE.EQ.4) THEN JCLE2=1 ENDIF IF(ICLE.EQ.5) THEN JCLE2=1 JCLE4=1 ENDIF CALL ZERO(BGENE,LHOOK,LRE) CALL ZERO(XGENE,NSTN,LRN) C IFR=IFOU+4 GOTO (666,10,10,20,30,40) ,IFR GOTO 666 C C ELEMENTS MASSIFS BIDIM CONT OU DEF PLANES C 10 CONTINUE DO 101 NP=1,NBNO SHP(1,NP)=SHPTOT(1,NP,IGAU) SHP(2,NP)=SHPTOT(2,NP,IGAU) SHP(3,NP)=SHPTOT(3,NP,IGAU) 101 CONTINUE CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) C IF(JCLE1.NE.0) THEN K=1 DO 102 NP=1,NBBB BGENE(1,K )=SHP(2,NP) BGENE(2,K+1)=SHP(3,NP) BGENE(4,K+1)=SHP(2,NP) BGENE(4,K )=SHP(3,NP) 102 K=K+2 ENDIF C IF(JCLE2.NE.0) THEN K=0 DO 1102 NP=1,NBBB DO 1103 INST=1,NSTB BGENE(INST,K+INST)=SHP(1,NP) 1103 CONTINUE 1102 K=K+NSTB ENDIF C IF(JCLE3.NE.0) THEN DO 3122 IPR=1,IDECAP K=(IPR-1)*NBBB +1 IPR2=2*IPR DO 3102 NP=NB1,NBNO BGENE(IPR2-1,K)=SHP(2,NP) BGENE(IPR2 ,K)=SHP(3,NP) 3102 K=K+1 3122 CONTINUE ENDIF C IF(JCLE4.NE.0) THEN K=1 DO 4122 IPR=1,IDECAP DO 4102 NP=NB1,NBNO XGENE(IPR,K)=SHP(1,NP) 4102 K=K+1 4122 CONTINUE ENDIF GOTO 666 C C ELEMENTS MASSIFS BIDIM AXISYMETRIQUE C 20 CONTINUE 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 CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) C IF(JCLE1.NE.0) THEN K=1 DO 202 NP=1,NBBB BGENE(1,K )=SHP(2,NP) BGENE(2,K+1)=SHP(3,NP) BGENE(3,K )=SHP(1,NP)/RR BGENE(4,K+1)=SHP(2,NP) BGENE(4,K )=SHP(3,NP) 202 K=K+2 ENDIF C IF(JCLE2.NE.0) THEN K=0 DO 1202 NP=1,NBBB DO 1203 INST=1,NSTB BGENE(INST,K+INST)=SHP(1,NP) 1203 CONTINUE 1202 K=K+NSTB ENDIF C IF(JCLE3.NE.0) THEN DO 3222 IPR=1,IDECAP K=(IPR-1)*NBBB +1 IPR2=2*IPR DO 3202 NP=NB1,NBNO BGENE(IPR2-1,K)=SHP(2,NP) BGENE(IPR2 ,K)=SHP(3,NP) 3202 K=K+1 3222 CONTINUE ENDIF C IF(JCLE4.NE.0) THEN K=1 DO 4222 IPR=1,IDECAP DO 4202 NP=NB1,NBNO XGENE(IPR,K)=SHP(1,NP) 4202 K=K+1 4222 CONTINUE ENDIF GOTO 666 C C ELEMENTS MASSIFS BIDIM FOURIER C 30 CONTINUE DO 301 NP=1,NBNO SHP(1,NP)=SHPTOT(1,NP,IGAU) SHP(2,NP)=SHPTOT(2,NP,IGAU) SHP(3,NP)=SHPTOT(3,NP,IGAU) 301 CONTINUE CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) C IF(JCLE1.NE.0) THEN XNSUR=DBLE(NN)/RR K=1 DO 302 NP=1,NBBB BGENE(1,K )= SHP(2,NP) BGENE(2,K+1)= SHP(3,NP) BGENE(3,K )= SHP(1,NP)/RR BGENE(3,K+2)=-SHP(1,NP)*XNSUR BGENE(4,K )= SHP(3,NP) BGENE(4,K+1)= SHP(2,NP) BGENE(5,K )= SHP(1,NP)*XNSUR BGENE(5,K+2)= SHP(2,NP)-SHP(1,NP)/RR BGENE(6,K+1)= SHP(1,NP)*XNSUR BGENE(6,K+2)= SHP(3,NP) 302 K=K+3 ENDIF C IF(JCLE2.NE.0) THEN K=0 DO 1302 NP=1,NBBB DO 1303 INST=1,NSTB BGENE(INST,K+INST)=SHP(1,NP) 1303 CONTINUE 1302 K=K+NSTB ENDIF C IF(JCLE3.NE.0) THEN XNSUR=DBLE(NN)/RR DO 3322 IPR=1,IDECAP K=(IPR-1)*NBBB +1 IPR3=3*IPR DO 3302 NP=NB1,NBNO BGENE(IPR3-2,K)= SHP(2,NP) BGENE(IPR3-1,K)= SHP(3,NP) BGENE(IPR3 ,K)=-SHP(1,NP)*XNSUR 3302 K=K+1 3322 CONTINUE ENDIF C IF(JCLE4.NE.0) THEN K=1 DO 4322 IPR=1,IDECAP DO 4302 NP=NB1,NBNO XGENE(IPR,K)=SHP(1,NP) 4302 K=K+1 4322 CONTINUE ENDIF GOTO 666 C C ELEMENTS MASSIFS TRIDIM C 40 CONTINUE DO 401 NP=1,NBNO SHP(1,NP)=SHPTOT(1,NP,IGAU) SHP(2,NP)=SHPTOT(2,NP,IGAU) SHP(3,NP)=SHPTOT(3,NP,IGAU) SHP(4,NP)=SHPTOT(4,NP,IGAU) 401 CONTINUE CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) C IF(JCLE1.NE.0) THEN K=1 DO 402 NP=1,NBBB BGENE(1,K )=SHP(2,NP) BGENE(2,K+1)=SHP(3,NP) BGENE(3,K+2)=SHP(4,NP) BGENE(4,K )=SHP(3,NP) BGENE(4,K+1)=SHP(2,NP) BGENE(5,K )=SHP(4,NP) BGENE(5,K+2)=SHP(2,NP) BGENE(6,K+1)=SHP(4,NP) BGENE(6,K+2)=SHP(3,NP) 402 K=K+3 ENDIF C IF(JCLE2.NE.0) THEN K=0 DO 1402 NP=1,NBBB DO 1403 INST=1,NSTB BGENE(INST,K+INST)=SHP(1,NP) 1403 CONTINUE 1402 K=K+NSTB ENDIF C IF(JCLE3.NE.0) THEN DO 3422 IPR=1,IDECAP K=(IPR-1)*NBBB +1 IPR3=3*IPR DO 3402 NP=NB1,NBNO BGENE(IPR3-2,K)=SHP(2,NP) BGENE(IPR3-1,K)=SHP(3,NP) BGENE(IPR3 ,K)=SHP(4,NP) 3402 K=K+1 3422 CONTINUE ENDIF C IF(JCLE4.NE.0) THEN K=1 DO 4422 IPR=1,IDECAP DO 4402 NP=NB1,NBNO XGENE(IPR,K)=SHP(1,NP) 4402 K=K+1 4422 CONTINUE ENDIF GO TO 666 C 666 RETURN END