C BPRIMA SOURCE CHAT 05/01/12 21:42:30 5004 SUBROUTINE BPRIMA(IGAU,ITEL,MFR,NBNO,LRE,IFOU,NST,NN,DIM3, 1 XEL,SHPTOT,SHP,GRAD,BPRIM,DJAC) C======================================================================= C C CALCULE LA MATRICE BPRIM C C ROUTINE FORTRAN PUR C CODE SUO X.Z JUILLET 1987 C======================================================================= C INPUT C IGAU=NUMERO DU POINT DE GAUSS C ITEL=NUMERO DE L ELEMENT DANS NOMTP C MFR =NUMERO DE LA FORMULATION C NBNO=NOMBRE DE NOEUDS C LRE =NOMBRE DE COLONNES DE LA MATRICE B C IFOU=IFOUR DE CCOPTIO C NST =NOMBRE DE COMPOSANTES DE CONTRAINTES C NN =NUMERO DU MODE DE FOURIER C DIM3=EPAISSEUR (MASSIF CONTRAINTES PLANES) C XEL =COORDONNEES DE L ELEMENT C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES C GRAD(9)=GRADIENTS DE THETA C ZONE DE TRAVAIL C SHP(6,NBNO)=TABLEAU DE TRAVAIL C OUTPUT C DJAC=JACOBIEN C BPRIM(6,LRE)=MATRICE B C======================================================================= IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) DIMENSION XEL(3,*),BPRIM(NST,*),SHP(6,*),SHPTOT(6,NBNO,*) DIMENSION BB(3,9),GEOM(20),XX(3),YY(3),GRAD(*) DATA XX/.5D0,.0D0,.5D0/ DATA YY/.0D0,.5D0,.5D0/ C CALL ZERO(BPRIM,NST,LRE) C IFR=IFOU+4 IF (ITEL.EQ.28.OR.ITEL.EQ.45) GOTO 28 GOTO (666,10,10,20,30,40) ,IFR GOTO 666 C C ELEMENTS MASSIFS BIDIM CONTRAINTES PLANES OU DEFRMTNS 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 DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) K=1 DO 102 NP=1,NBNO BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4) BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5) BPRIM(4,K+1)=BPRIM(1,K) BPRIM(4,K )=BPRIM(2,K+1) 102 K=K+2 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 DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) K=1 DO 202 NP=1,NBNO BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4) BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5) BPRIM(3,K)=SHP(1,NP)/RR*GRAD(9) BPRIM(4,K+1)=BPRIM(1,K) BPRIM(4,K )=BPRIM(2,K+1) 202 K=K+2 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 DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) XNSUR=DBLE(NN)/RR K=1 DO 302 NP=1,NBNO BPRIM(1,K )= SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)- 1 XNSUR*SHP(1,NP)*GRAD(7) BPRIM(1,K+2)= -SHP(1,NP)*GRAD(7)/RR BPRIM(2,K+1)= SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)- 1 XNSUR*SHP(1,NP)*GRAD(8) BPRIM(3,K )= SHP(1,NP)/RR*GRAD(9) BPRIM(3,K+2)= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)+ 1 XNSUR*SHP(1,NP)*GRAD(9) BPRIM(4,K )= BPRIM(2,K+1) BPRIM(4,K+1)= BPRIM(1,K ) BPRIM(4,K+2)=-SHP(1,NP)*GRAD(8)/RR BPRIM(5,K )= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)- 1 XNSUR*SHP(1,NP)*GRAD(9)+SHP(1,NP)*GRAD(7)/RR BPRIM(5,K+2)= SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)+ 1 XNSUR*SHP(1,NP)*GRAD(7)-SHP(1,NP)*GRAD(9)/RR BPRIM(6,K )= SHP(1,NP)*GRAD(8)/RR BPRIM(6,K+1)= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)- 1 XNSUR*SHP(1,NP)*GRAD(9) BPRIM(6,K+2)= SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)+ 1 XNSUR*SHP(1,NP)*GRAD(8) 302 K=K+3 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 DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,3,DIM3,RR,DJAC) K=1 DO 402 NP=1,NBNO BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)+ 1 SHP(4,NP)*GRAD(7) BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)+ 1 SHP(4,NP)*GRAD(8) BPRIM(3,K+2)=SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)+ 1 SHP(4,NP)*GRAD(9) BPRIM(4,K )=BPRIM(2,1+K) BPRIM(4,K+1)=BPRIM(1,K ) BPRIM(5,K )=BPRIM(3,2+K) BPRIM(5,K+2)=BPRIM(1,K ) BPRIM(6,K+1)=BPRIM(3,2+K) BPRIM(6,K+2)=BPRIM(2,1+K) 402 K=K+3 GOTO 666 C C 28 IEME ELEMENT : DKT ( N'EXISTER PAS ) C 28 CONTINUE DO 127 NPOI=1,NBNO SHP(1,NPOI)=SHPTOT(1,NPOI,IGAU) SHP(2,NPOI)=SHPTOT(2,NPOI,IGAU) SHP(3,NPOI)=SHPTOT(3,NPOI,IGAU) 127 CONTINUE CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) K=1 DO 227 NPOI=1,NBNO BPRIM(1,K )=SHP(2,NPOI) BPRIM(1,K+1)=0.D0 BPRIM(2,K )=0.D0 BPRIM(2,K+1)=SHP(3,NPOI) BPRIM(3,K )=SHP(3,NPOI) BPRIM(3,K+1)=SHP(2,NPOI) 227 K=K+6 CALL GEOCST(XEL,GEOM) CALL BFDKT(XX(IGAU),YY(IGAU),GEOM,BB) DJAC=GEOM(17) K=2 KK=0 DO 327 NPOI=1,3 DO 427 IX=1,3 DO 527 IY=1,3 BPRIM(3+IX,K+IY)=BB(IX,IY+KK) 527 CONTINUE 427 CONTINUE KK=KK+3 327 K=K+6 666 CONTINUE RETURN END