1 : C BNQORE SOURCE CHAT 05/01/12 21:41:55 5004 2 : SUBROUTINE BNQORE(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,NN, 3 : . DIM3,XEL,SHPTOT,SHP,BGENE,XGENE,DJAC,IDECAP,ICLE) 4 : C----------------------------------------------------------------------- 5 : C 6 : C CALCULE LES MATRICES B ET N DU MILIEU POREUX 7 : C 8 : C LE RESULTAT EST DANS BGENE ET / OU XGENE 9 : C 10 : C BGENE(NSTB,LRE) XGENE(NSTN,LRN) 11 : C 12 : C----------------------------------------------------------------------- 13 : C ENTREE : 14 : C IGAU=NUMERO DU POINT DE GAUSS 15 : C NBNO=NOMBRE DE FONCTIONS DE FORME 16 : C NBBB=NOMBRE DE NOEUDS 17 : C LRE =NOMBRE DE COLONNES DE LA MATRICE B 18 : C IFOU=IFOUR DE CCOPTIO 19 : C NSTB=NOMBRE DE LIGNES DE LA MATRICE B 20 : C NSTN=NOMBRE DE LIGNES DE LA MATRICE N 21 : C DIM3=EPAISSEUR DE L'ELEMENT (CONTRAINTES PLANES) 22 : C NN =NUMERO DU MODE DE FOURIER 23 : C XEL =COORDONNEES DE L ELEMENT 24 : C SHPTOT(6,NBNO,NBGAU)=FONCTIONS DE FORMES ET DERIVEES 25 : C ICLE INDICATEUR DE CALCUL 26 : C = 1 ON CALCULE B ET NP 27 : C = 2 ON CALCULE BP 28 : C = 3 ON CALCULE B 29 : C = 4 ON CALCULE N 30 : C = 5 ON CALCULE N ET NP 31 : C ON MET ALORS N DANS BGENE ET NP DANS XGENE 32 : C AUTRES VALEURS : COMBINAISONS DES CAS PRECEDENTS 33 : C SHP(6,NBNO)=TABLEAU DE TRAVAIL 34 : C SORTIE : 35 : C DJAC=JACOBIEN 36 : C BGENE(6,LRE)=MATRICE B 37 : C XGENE(6,LRE)=MATRICE N 38 : C----------------------------------------------------------------------- 39 : IMPLICIT INTEGER(I-N) 40 : IMPLICIT REAL*8(A-H,O-Z) 41 : DIMENSION XEL(3,*),BGENE(NSTB,*),SHP(6,*),SHPTOT(6,NBNO,*) 42 : DIMENSION XGENE(NSTN,*) 43 : DIMENSION BB(3,9),GEOM(20),XX(3),YY(3) 44 : DATA XX/.5D0,.0D0,.5D0/ 45 : DATA YY/.0D0,.5D0,.5D0/ 46 : C 47 : JCLE1=0 48 : JCLE2=0 49 : JCLE3=0 50 : JCLE4=0 51 : 52 : LPP = NBNO-NBBB 53 : LRN=IDECAP*LPP 54 : NB1=NBBB+1 55 : IF(ICLE.EQ.1) THEN 56 : JCLE1=1 57 : JCLE4=1 58 : ENDIF 59 : IF(ICLE.EQ.2) THEN 60 : JCLE3=1 61 : ENDIF 62 : IF(ICLE.EQ.3) THEN 63 : JCLE1=1 64 : ENDIF 65 : IF(ICLE.EQ.4) THEN 66 : JCLE2=1 67 : ENDIF 68 : IF(ICLE.EQ.5) THEN 69 : JCLE2=1 70 : JCLE4=1 71 : ENDIF 72 : 72 : CALL ZERO(BGENE,NSTB,LRE) 72 : CALL ZERO(XGENE,NSTN,LRN) 73 : C 74 : IFR=IFOU+4 75 : GOTO (666,10,10,20,30,40) ,IFR 76 : GOTO 666 77 : C 78 : C ELEMENTS MASSIFS BIDIM CONT OU DEF PLANES 79 : C 80 : 10 CONTINUE 81 : DO 101 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 : 101 CONTINUE 85 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 86 : C 87 : IF(JCLE1.NE.0) THEN 88 : K=1 89 : DO 102 NP=1,NBBB 90 : BGENE(1,K )=SHP(2,NP) 91 : BGENE(2,K+1)=SHP(3,NP) 92 : BGENE(4,K+1)=SHP(2,NP) 93 : BGENE(4,K )=SHP(3,NP) 94 : 102 K=K+2 95 : ENDIF 96 : C 97 : IF(JCLE2.NE.0) THEN 98 : K=0 99 : DO 1102 NP=1,NBBB 100 : DO 1103 INST=1,NSTB 101 : BGENE(INST,K+INST)=SHP(1,NP) 102 : 1103 CONTINUE 103 : 1102 K=K+NSTB 104 : ENDIF 105 : C 106 : IF(JCLE3.NE.0) THEN 107 : DO 3122 IPR=1,IDECAP 108 : K=(IPR-1)*NBBB +1 109 : IPR2=2*IPR 110 : DO 3102 NP=NB1,NBNO 111 : BGENE(IPR2-1,K)=SHP(2,NP) 112 : BGENE(IPR2 ,K)=SHP(3,NP) 113 : 3102 K=K+1 114 : 3122 CONTINUE 115 : ENDIF 116 : C 117 : IF(JCLE4.NE.0) THEN 118 : K=1 119 : DO 4122 IPR=1,IDECAP 120 : DO 4102 NP=NB1,NBNO 121 : XGENE(IPR,K)=SHP(1,NP) 122 : 4102 K=K+1 123 : 4122 CONTINUE 124 : ENDIF 125 : GOTO 666 126 : C 127 : C ELEMENTS MASSIFS BIDIM AXISYMETRIQUE 128 : C 129 : 20 CONTINUE 130 : DO 201 NP=1,NBNO 131 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 132 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 133 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 134 : 201 CONTINUE 134 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 135 : C 136 : IF(JCLE1.NE.0) THEN 137 : K=1 138 : DO 202 NP=1,NBBB 139 : BGENE(1,K )=SHP(2,NP) 140 : BGENE(2,K+1)=SHP(3,NP) 141 : BGENE(3,K )=SHP(1,NP)/RR 142 : BGENE(4,K+1)=SHP(2,NP) 143 : BGENE(4,K )=SHP(3,NP) 144 : 202 K=K+2 145 : ENDIF 146 : C 147 : IF(JCLE2.NE.0) THEN 148 : K=0 149 : DO 1202 NP=1,NBBB 150 : DO 1203 INST=1,NSTB 151 : BGENE(INST,K+INST)=SHP(1,NP) 152 : 1203 CONTINUE 153 : 1202 K=K+NSTB 154 : ENDIF 155 : C 156 : IF(JCLE3.NE.0) THEN 157 : DO 3222 IPR=1,IDECAP 158 : K=(IPR-1)*NBBB +1 159 : IPR2=2*IPR 160 : DO 3202 NP=NB1,NBNO 161 : BGENE(IPR2-1,K)=SHP(2,NP) 162 : BGENE(IPR2 ,K)=SHP(3,NP) 163 : 3202 K=K+1 164 : 3222 CONTINUE 165 : ENDIF 166 : C 167 : IF(JCLE4.NE.0) THEN 168 : K=1 169 : DO 4222 IPR=1,IDECAP 170 : DO 4202 NP=NB1,NBNO 171 : XGENE(IPR,K)=SHP(1,NP) 172 : 4202 K=K+1 173 : 4222 CONTINUE 174 : ENDIF 175 : GOTO 666 176 : C 177 : C ELEMENTS MASSIFS BIDIM FOURIER 178 : C 179 : 30 CONTINUE 180 : DO 301 NP=1,NBNO 181 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 182 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 183 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 184 : 301 CONTINUE 184 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 185 : C 186 : IF(JCLE1.NE.0) THEN 187 : XNSUR=DBLE(NN)/RR 188 : K=1 189 : DO 302 NP=1,NBBB 190 : BGENE(1,K )= SHP(2,NP) 191 : BGENE(2,K+1)= SHP(3,NP) 192 : BGENE(3,K )= SHP(1,NP)/RR 193 : BGENE(3,K+2)=-SHP(1,NP)*XNSUR 194 : BGENE(4,K )= SHP(3,NP) 195 : BGENE(4,K+1)= SHP(2,NP) 196 : BGENE(5,K )= SHP(1,NP)*XNSUR 197 : BGENE(5,K+2)= SHP(2,NP)-SHP(1,NP)/RR 198 : BGENE(6,K+1)= SHP(1,NP)*XNSUR 199 : BGENE(6,K+2)= SHP(3,NP) 200 : 302 K=K+3 201 : ENDIF 202 : C 203 : IF(JCLE2.NE.0) THEN 204 : K=0 205 : DO 1302 NP=1,NBBB 206 : DO 1303 INST=1,NSTB 207 : BGENE(INST,K+INST)=SHP(1,NP) 208 : 1303 CONTINUE 209 : 1302 K=K+NSTB 210 : ENDIF 211 : C 212 : IF(JCLE3.NE.0) THEN 213 : XNSUR=DBLE(NN)/RR 214 : DO 3322 IPR=1,IDECAP 215 : K=(IPR-1)*NBBB +1 216 : IPR3=3*IPR 217 : DO 3302 NP=NB1,NBNO 218 : BGENE(IPR3-2,K)= SHP(2,NP) 219 : BGENE(IPR3-1,K)= SHP(3,NP) 220 : BGENE(IPR3 ,K)=-SHP(1,NP)*XNSUR 221 : 3302 K=K+1 222 : 3322 CONTINUE 223 : ENDIF 224 : C 225 : IF(JCLE4.NE.0) THEN 226 : K=1 227 : DO 4322 IPR=1,IDECAP 228 : DO 4302 NP=NB1,NBNO 229 : XGENE(IPR,K)=SHP(1,NP) 230 : 4302 K=K+1 231 : 4322 CONTINUE 232 : ENDIF 233 : GOTO 666 234 : C 235 : C ELEMENTS MASSIFS TRIDIM 236 : C 237 : 40 CONTINUE 238 : DO 401 NP=1,NBNO 239 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 240 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 241 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 242 : SHP(4,NP)=SHPTOT(4,NP,IGAU) 243 : 401 CONTINUE 243 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 244 : C 245 : IF(JCLE1.NE.0) THEN 246 : K=1 247 : DO 402 NP=1,NBBB 248 : BGENE(1,K )=SHP(2,NP) 249 : BGENE(2,K+1)=SHP(3,NP) 250 : BGENE(3,K+2)=SHP(4,NP) 251 : BGENE(4,K )=SHP(3,NP) 252 : BGENE(4,K+1)=SHP(2,NP) 253 : BGENE(5,K )=SHP(4,NP) 254 : BGENE(5,K+2)=SHP(2,NP) 255 : BGENE(6,K+1)=SHP(4,NP) 256 : BGENE(6,K+2)=SHP(3,NP) 257 : 402 K=K+3 258 : ENDIF 259 : C 260 : IF(JCLE2.NE.0) THEN 261 : K=0 262 : DO 1402 NP=1,NBBB 263 : DO 1403 INST=1,NSTB 264 : BGENE(INST,K+INST)=SHP(1,NP) 265 : 1403 CONTINUE 266 : 1402 K=K+NSTB 267 : ENDIF 268 : C 269 : IF(JCLE3.NE.0) THEN 270 : DO 3422 IPR=1,IDECAP 271 : K=(IPR-1)*NBBB +1 272 : IPR3=3*IPR 273 : DO 3402 NP=NB1,NBNO 274 : BGENE(IPR3-2,K)=SHP(2,NP) 275 : BGENE(IPR3-1,K)=SHP(3,NP) 276 : BGENE(IPR3 ,K)=SHP(4,NP) 277 : 3402 K=K+1 278 : 3422 CONTINUE 279 : ENDIF 280 : C 281 : IF(JCLE4.NE.0) THEN 282 : K=1 283 : DO 4422 IPR=1,IDECAP 284 : DO 4402 NP=NB1,NBNO 285 : XGENE(IPR,K)=SHP(1,NP) 286 : 4402 K=K+1 287 : 4422 CONTINUE 288 : ENDIF 289 : GO TO 666 290 : C 291 : 666 RETURN 292 : END 293 : 294 : 295 : 296 :
© Cast3M 2003 - All rights reserved.
Disclaimer