1 : C BNPORE SOURCE CHAT 05/01/12 21:41:47 5004 2 : SUBROUTINE BNPORE(IGAU,NBNO,NBBB,LRE,IFOU,NSTB,NSTN,NN, 3 : . DIM3,XEL,SHPTOT,SHP,BGENE,XGENE,DJAC,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 : LRN =NBNO-NBBB 52 : NB1=NBBB+1 53 : IF(ICLE.EQ.1) THEN 54 : JCLE1=1 55 : JCLE4=1 56 : ENDIF 57 : IF(ICLE.EQ.2) THEN 58 : JCLE3=1 59 : ENDIF 60 : IF(ICLE.EQ.3) THEN 61 : JCLE1=1 62 : ENDIF 63 : IF(ICLE.EQ.4) THEN 64 : JCLE2=1 65 : ENDIF 66 : IF(ICLE.EQ.5) THEN 67 : JCLE2=1 68 : JCLE4=1 69 : ENDIF 70 : C 70 : CALL ZERO(BGENE,NSTB,LRE) 70 : CALL ZERO(XGENE,NSTN,LRN) 71 : C 72 : IFR=IFOU+4 73 : GOTO (666,10,10,20,30,40) ,IFR 74 : GOTO 666 75 : C 76 : C ELEMENTS MASSIFS BIDIM CONT OU DEF PLANES 77 : C 78 : 10 CONTINUE 79 : DO 101 NP=1,NBNO 80 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 81 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 82 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 83 : 101 CONTINUE 83 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 84 : C 85 : IF(JCLE1.NE.0) THEN 86 : K=1 87 : DO 102 NP=1,NBBB 88 : BGENE(1,K )=SHP(2,NP) 89 : BGENE(2,K+1)=SHP(3,NP) 90 : BGENE(4,K+1)=SHP(2,NP) 91 : BGENE(4,K )=SHP(3,NP) 92 : 102 K=K+2 93 : ENDIF 94 : C 95 : IF(JCLE2.NE.0) THEN 96 : K=0 97 : DO 1102 NP=1,NBBB 98 : DO 1103 INST=1,NSTB 99 : BGENE(INST,K+INST)=SHP(1,NP) 100 : 1103 CONTINUE 101 : 1102 K=K+NSTB 102 : ENDIF 103 : C 104 : IF(JCLE3.NE.0) THEN 105 : K=1 106 : DO 3102 NP=NB1,NBNO 107 : BGENE(1,K)=SHP(2,NP) 108 : BGENE(2,K)=SHP(3,NP) 109 : 3102 K=K+1 110 : ENDIF 111 : C 112 : IF(JCLE4.NE.0) THEN 113 : K=1 114 : DO 4102 NP=NB1,NBNO 115 : XGENE(1,K)=SHP(1,NP) 116 : 4102 K=K+1 117 : ENDIF 118 : GOTO 666 119 : C 120 : C ELEMENTS MASSIFS BIDIM AXISYMETRIQUE 121 : C 122 : 20 CONTINUE 123 : DO 201 NP=1,NBNO 124 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 125 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 126 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 127 : 201 CONTINUE 127 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 128 : C 129 : IF(JCLE1.NE.0) THEN 130 : K=1 131 : DO 202 NP=1,NBBB 132 : BGENE(1,K )=SHP(2,NP) 133 : BGENE(2,K+1)=SHP(3,NP) 134 : BGENE(3,K )=SHP(1,NP)/RR 135 : BGENE(4,K+1)=SHP(2,NP) 136 : BGENE(4,K )=SHP(3,NP) 137 : 202 K=K+2 138 : ENDIF 139 : C 140 : IF(JCLE2.NE.0) THEN 141 : K=0 142 : DO 1202 NP=1,NBBB 143 : DO 1203 INST=1,NSTB 144 : BGENE(INST,K+INST)=SHP(1,NP) 145 : 1203 CONTINUE 146 : 1202 K=K+NSTB 147 : ENDIF 148 : C 149 : IF(JCLE3.NE.0) THEN 150 : K=1 151 : DO 3202 NP=NB1,NBNO 152 : BGENE(1,K)=SHP(2,NP) 153 : BGENE(2,K)=SHP(3,NP) 154 : 3202 K=K+1 155 : ENDIF 156 : C 157 : IF(JCLE4.NE.0) THEN 158 : K=1 159 : DO 4202 NP=NB1,NBNO 160 : XGENE(1,K)=SHP(1,NP) 161 : 4202 K=K+1 162 : ENDIF 163 : GOTO 666 164 : C 165 : C ELEMENTS MASSIFS BIDIM FOURIER 166 : C 167 : 30 CONTINUE 168 : DO 301 NP=1,NBNO 169 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 170 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 171 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 172 : 301 CONTINUE 172 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 173 : C 174 : IF(JCLE1.NE.0) THEN 175 : XNSUR=DBLE(NN)/RR 176 : K=1 177 : DO 302 NP=1,NBBB 178 : BGENE(1,K )= SHP(2,NP) 179 : BGENE(2,K+1)= SHP(3,NP) 180 : BGENE(3,K )= SHP(1,NP)/RR 181 : BGENE(3,K+2)=-SHP(1,NP)*XNSUR 182 : BGENE(4,K )= SHP(3,NP) 183 : BGENE(4,K+1)= SHP(2,NP) 184 : BGENE(5,K )= SHP(1,NP)*XNSUR 185 : BGENE(5,K+2)= SHP(2,NP)-SHP(1,NP)/RR 186 : BGENE(6,K+1)= SHP(1,NP)*XNSUR 187 : BGENE(6,K+2)= SHP(3,NP) 188 : 302 K=K+3 189 : ENDIF 190 : C 191 : IF(JCLE2.NE.0) THEN 192 : K=0 193 : DO 1302 NP=1,NBBB 194 : DO 1303 INST=1,NSTB 195 : BGENE(INST,K+INST)=SHP(1,NP) 196 : 1303 CONTINUE 197 : 1302 K=K+NSTB 198 : ENDIF 199 : C 200 : IF(JCLE3.NE.0) THEN 201 : XNSUR=DBLE(NN)/RR 202 : K=1 203 : DO 3302 NP=NB1,NBNO 204 : BGENE(1,K)= SHP(2,NP) 205 : BGENE(2,K)= SHP(3,NP) 206 : BGENE(3,K)=-SHP(1,NP)*XNSUR 207 : 3302 K=K+1 208 : ENDIF 209 : C 210 : IF(JCLE4.NE.0) THEN 211 : K=1 212 : DO 4302 NP=NB1,NBNO 213 : XGENE(1,K)=SHP(1,NP) 214 : 4302 K=K+1 215 : ENDIF 216 : GOTO 666 217 : C 218 : C ELEMENTS MASSIFS TRIDIM 219 : C 220 : 40 CONTINUE 221 : DO 401 NP=1,NBNO 222 : SHP(1,NP)=SHPTOT(1,NP,IGAU) 223 : SHP(2,NP)=SHPTOT(2,NP,IGAU) 224 : SHP(3,NP)=SHPTOT(3,NP,IGAU) 225 : SHP(4,NP)=SHPTOT(4,NP,IGAU) 226 : 401 CONTINUE 226 : CALL DEVOLP(XEL,SHP,MFR,NBBB,NBNO,IFOU,NN,DIM3,RR,DJAC) 227 : C 228 : IF(JCLE1.NE.0) THEN 229 : K=1 230 : DO 402 NP=1,NBBB 231 : BGENE(1,K )=SHP(2,NP) 232 : BGENE(2,K+1)=SHP(3,NP) 233 : BGENE(3,K+2)=SHP(4,NP) 234 : BGENE(4,K )=SHP(3,NP) 235 : BGENE(4,K+1)=SHP(2,NP) 236 : BGENE(5,K )=SHP(4,NP) 237 : BGENE(5,K+2)=SHP(2,NP) 238 : BGENE(6,K+1)=SHP(4,NP) 239 : BGENE(6,K+2)=SHP(3,NP) 240 : 402 K=K+3 241 : ENDIF 242 : C 243 : IF(JCLE2.NE.0) THEN 244 : K=0 245 : DO 1402 NP=1,NBBB 246 : DO 1403 INST=1,NSTB 247 : BGENE(INST,K+INST)=SHP(1,NP) 248 : 1403 CONTINUE 249 : 1402 K=K+NSTB 250 : ENDIF 251 : C 252 : IF(JCLE3.NE.0) THEN 253 : K=1 254 : DO 3402 NP=NB1,NBNO 255 : BGENE(1,K)=SHP(2,NP) 256 : BGENE(2,K)=SHP(3,NP) 257 : BGENE(3,K)=SHP(4,NP) 258 : 3402 K=K+1 259 : ENDIF 260 : C 261 : IF(JCLE4.NE.0) THEN 262 : K=1 263 : DO 4402 NP=NB1,NBNO 264 : XGENE(1,K)=SHP(1,NP) 265 : 4402 K=K+1 266 : ENDIF 267 : GO TO 666 268 : C 269 : 666 RETURN 270 : END 271 : 272 : 273 :
© Cast3M 2003 - All rights reserved.
Disclaimer