1 : C BPRIMA SOURCE CHAT 05/01/12 21:42:30 5004 2 : SUBROUTINE BPRIMA(IGAU,ITEL,MFR,NBNO,LRE,IFOU,NST,NN,DIM3, 3 : 1 XEL,SHPTOT,SHP,GRAD,BPRIM,DJAC) 4 : C======================================================================= 5 : C 6 : C CALCULE LA MATRICE BPRIM 7 : C 8 : C ROUTINE FORTRAN PUR 9 : C CODE SUO X.Z JUILLET 1987 10 : C======================================================================= 11 : C INPUT 12 : C IGAU=NUMERO DU POINT DE GAUSS 13 : C ITEL=NUMERO DE L ELEMENT DANS NOMTP 14 : C MFR =NUMERO DE LA FORMULATION 15 : C NBNO=NOMBRE DE NOEUDS 16 : C LRE =NOMBRE DE COLONNES DE LA MATRICE B 17 : C IFOU=IFOUR DE CCOPTIO 18 : C NST =NOMBRE DE COMPOSANTES DE CONTRAINTES 19 : C NN =NUMERO DU MODE DE FOURIER 20 : C DIM3=EPAISSEUR (MASSIF CONTRAINTES PLANES) 21 : C XEL =COORDONNEES DE L ELEMENT 22 : C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES 23 : C GRAD(9)=GRADIENTS DE THETA 24 : C ZONE DE TRAVAIL 25 : C SHP(6,NBNO)=TABLEAU DE TRAVAIL 26 : C OUTPUT 27 : C DJAC=JACOBIEN 28 : C BPRIM(6,LRE)=MATRICE B 29 : C======================================================================= 30 : IMPLICIT INTEGER(I-N) 31 : IMPLICIT REAL*8(A-H,O-Z) 32 : DIMENSION XEL(3,*),BPRIM(NST,*),SHP(6,*),SHPTOT(6,NBNO,*) 33 : DIMENSION BB(3,9),GEOM(20),XX(3),YY(3),GRAD(*) 34 : DATA XX/.5D0,.0D0,.5D0/ 35 : DATA YY/.0D0,.5D0,.5D0/ 36 : C 36 : CALL ZERO(BPRIM,NST,LRE) 37 : C 38 : IFR=IFOU+4 39 : IF (ITEL.EQ.28.OR.ITEL.EQ.45) GOTO 28 40 : GOTO (666,10,10,20,30,40) ,IFR 41 : GOTO 666 42 : C 43 : C ELEMENTS MASSIFS BIDIM CONTRAINTES PLANES OU DEFRMTNS PLANES 44 : C 45 : 10 CONTINUE 46 : DO 101 NP=1,NBNO 47 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 48 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 49 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 50 : 101 CONTINUE 50 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) 51 : K=1 52 : DO 102 NP=1,NBNO 53 : BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4) 54 : BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5) 55 : BPRIM(4,K+1)=BPRIM(1,K) 56 : BPRIM(4,K )=BPRIM(2,K+1) 57 : 102 K=K+2 58 : GOTO 666 59 : C 60 : C ELEMENTS MASSIFS BIDIM AXISYMETRIQUE 61 : C 62 : 20 CONTINUE 63 : DO 201 NP=1,NBNO 64 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 65 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 66 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 67 : 201 CONTINUE 67 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) 68 : K=1 69 : DO 202 NP=1,NBNO 70 : BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4) 71 : BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5) 72 : BPRIM(3,K)=SHP(1,NP)/RR*GRAD(9) 73 : BPRIM(4,K+1)=BPRIM(1,K) 74 : BPRIM(4,K )=BPRIM(2,K+1) 75 : 202 K=K+2 76 : GOTO 666 77 : C 78 : C ELEMENTS MASSIFS BIDIM FOURIER 79 : C 80 : 30 CONTINUE 81 : DO 301 NP=1,NBNO 82 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 83 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 84 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 85 : 301 CONTINUE 85 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) 86 : XNSUR=DBLE(NN)/RR 87 : K=1 88 : DO 302 NP=1,NBNO 89 : BPRIM(1,K )= SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)- 90 : 1 XNSUR*SHP(1,NP)*GRAD(7) 91 : BPRIM(1,K+2)= -SHP(1,NP)*GRAD(7)/RR 92 : BPRIM(2,K+1)= SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)- 93 : 1 XNSUR*SHP(1,NP)*GRAD(8) 94 : BPRIM(3,K )= SHP(1,NP)/RR*GRAD(9) 95 : BPRIM(3,K+2)= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)+ 96 : 1 XNSUR*SHP(1,NP)*GRAD(9) 97 : BPRIM(4,K )= BPRIM(2,K+1) 98 : BPRIM(4,K+1)= BPRIM(1,K ) 99 : BPRIM(4,K+2)=-SHP(1,NP)*GRAD(8)/RR 100 : BPRIM(5,K )= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)- 101 : 1 XNSUR*SHP(1,NP)*GRAD(9)+SHP(1,NP)*GRAD(7)/RR 102 : BPRIM(5,K+2)= SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)+ 103 : 1 XNSUR*SHP(1,NP)*GRAD(7)-SHP(1,NP)*GRAD(9)/RR 104 : BPRIM(6,K )= SHP(1,NP)*GRAD(8)/RR 105 : BPRIM(6,K+1)= SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)- 106 : 1 XNSUR*SHP(1,NP)*GRAD(9) 107 : BPRIM(6,K+2)= SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)+ 108 : 1 XNSUR*SHP(1,NP)*GRAD(8) 109 : 302 K=K+3 110 : GOTO 666 111 : C 112 : C ELEMENTS MASSIFS TRIDIM 113 : C 114 : 40 CONTINUE 115 : DO 401 NP=1,NBNO 116 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 117 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 118 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 119 : SHP(4,NP)=SHPTOT(4,NP,IGAU) 120 : 401 CONTINUE 120 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,3,DIM3,RR,DJAC) 121 : K=1 122 : DO 402 NP=1,NBNO 123 : BPRIM(1,K )=SHP(2,NP)*GRAD(1)+SHP(3,NP)*GRAD(4)+ 124 : 1 SHP(4,NP)*GRAD(7) 125 : BPRIM(2,K+1)=SHP(2,NP)*GRAD(2)+SHP(3,NP)*GRAD(5)+ 126 : 1 SHP(4,NP)*GRAD(8) 127 : BPRIM(3,K+2)=SHP(2,NP)*GRAD(3)+SHP(3,NP)*GRAD(6)+ 128 : 1 SHP(4,NP)*GRAD(9) 129 : BPRIM(4,K )=BPRIM(2,1+K) 130 : BPRIM(4,K+1)=BPRIM(1,K ) 131 : BPRIM(5,K )=BPRIM(3,2+K) 132 : BPRIM(5,K+2)=BPRIM(1,K ) 133 : BPRIM(6,K+1)=BPRIM(3,2+K) 134 : BPRIM(6,K+2)=BPRIM(2,1+K) 135 : 402 K=K+3 136 : GOTO 666 137 : C 138 : C 28 IEME ELEMENT : DKT ( N'EXISTER PAS ) 139 : C 140 : 28 CONTINUE 141 : DO 127 NPOI=1,NBNO 142 : SHP(1,NPOI)=SHPTOT(1,NPOI,IGAU) 143 : SHP(2,NPOI)=SHPTOT(2,NPOI,IGAU) 144 : SHP(3,NPOI)=SHPTOT(3,NPOI,IGAU) 145 : 127 CONTINUE 145 : CALL DEVOLU(XEL,SHP,MFR,NBNO,IFOU,NN,2,DIM3,RR,DJAC) 146 : K=1 147 : DO 227 NPOI=1,NBNO 148 : BPRIM(1,K )=SHP(2,NPOI) 149 : BPRIM(1,K+1)=0.D0 150 : BPRIM(2,K )=0.D0 151 : BPRIM(2,K+1)=SHP(3,NPOI) 152 : BPRIM(3,K )=SHP(3,NPOI) 153 : BPRIM(3,K+1)=SHP(2,NPOI) 154 : 227 K=K+6 154 : CALL GEOCST(XEL,GEOM) 154 : CALL BFDKT(XX(IGAU),YY(IGAU),GEOM,BB) 155 : DJAC=GEOM(17) 156 : K=2 157 : KK=0 158 : DO 327 NPOI=1,3 159 : DO 427 IX=1,3 160 : DO 527 IY=1,3 161 : BPRIM(3+IX,K+IY)=BB(IX,IY+KK) 162 : 527 CONTINUE 163 : 427 CONTINUE 164 : KK=KK+3 165 : 327 K=K+6 166 : 666 CONTINUE 167 : RETURN 168 : END 169 : 170 : 171 :
© Cast3M 2003 - All rights reserved.
Disclaimer