1 : C GNFL1 SOURCE CHAT 11/03/16 21:24:08 6902 2 : SUBROUTINE GNFL1(IPMAIL,NDDL,NBPGAU,MELE,MFR,IVAVCO,IPMINT, 3 : & IVACAR,IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP) 4 : *---------------------------------------------------------------------* 5 : * * 6 : * ENTREES : * 7 : * ________ * 8 : * * 9 : * IPMAIL Pointeur sur un segment MELEME * 10 : * LRE Nombre de ddl dans la matrice de rigidite * 11 : * NDDL Nombre de degré de liberté * 12 : * NBPGAU Nombre de points d'integration * 13 : * MELE Numero de l'element fini * 14 : * MFR Numero de la formulation * 15 : * IVAVCO pointeur sur un segment MPTVAL contenant les * 16 : * les melvals de FORCES VOLUMIQUES * 17 : * IPMINT Pointeur sur un segment MINTE * 18 : * IVACAR Pointeur sur un melval de caractéristiques * 19 : * IPORE Nombre de fonctions de forme * 20 : * NCOMP Nombre de composantes de forces * 21 : * * 22 : * SORTIES : * 23 : * ________ * 24 : * * 25 : * IVAFOR pointeur sur un segment MPTVAL contenant les * 26 : * melvals * 27 : * * 28 : *---------------------------------------------------------------------* 29 : IMPLICIT INTEGER(I-N) 30 : IMPLICIT REAL*8(A-H,O-Z) 31 : * 32 : -INC CCOPTIO 33 : -INC CCHAMP 34 : -INC SMCHAML 35 : -INC SMCHPOI 36 : -INC SMELEME 37 : -INC SMCOORD 38 : -INC SMMODEL 39 : -INC SMINTE 40 : -INC CCGEOME 41 : -INC CCREEL 42 : -INC SMRIGID 43 : * 44 : SEGMENT WRK1 45 : REAL*8 XFORC(LRN),VECO(NDDL),XE(3,NBBB) 46 : ENDSEGMENT 47 : * 48 : SEGMENT WRK2 49 : REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE) 50 : ENDSEGMENT 51 : * 52 : SEGMENT WRK3 53 : REAL*8 BPSS(3,3),XEL(3,NBBB) 54 : REAL*8 XNTH(LRN,LRN),XNTB(LRN,LRN),XNTT(LRN) 55 : ENDSEGMENT 56 : * 57 : SEGMENT WRK5 58 : REAL*8 XGENE(NSTN,LRN) 59 : ENDSEGMENT 60 : * 61 : SEGMENT MPTVAL 62 : INTEGER IPOS(NS) , NSOF(NS) 63 : INTEGER IVAL(NCOSOU) 64 : CHARACTER*16 TYVAL(NCOSOU) 65 : ENDSEGMENT 66 : * 67 : * INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT 68 : * DE LA SECTION EN DEFO PLANE GENERALISEE 69 : * 70 : IF (IFOUR.EQ.-3)THEN 71 : IP=IIPDPG 72 : SEGACT MCOORD 73 : IREF=(IP-1)*(IDIM+1) 74 : XDPGE=XCOOR(IREF+1) 75 : YDPGE=XCOOR(IREF+2) 76 : ELSE 77 : XDPGE=0.D0 78 : YDPGE=0.D0 79 : ENDIF 80 : * 81 : MELEME=IPMAIL 82 : NBNN=NUM(/1) 83 : NBELEM=NUM(/2) 84 : NHRM=NIFOUR 85 : MINTE=IPMINT 86 : IELE=NUMGEO(MELE) 87 : * 88 : IF(MELE.GE.79.AND.MELE.LE.83) GO TO 79 89 : IF(MELE.GE.173.AND.MELE.LE.182) GO TO 79 90 : IF(MELE.GE.108.AND.MELE.LE.110) GO TO 80 91 : * 92 : * 93 : GOTO 99 94 : * 95 : * 96 : C_______________________________________________________________________ 97 : C 98 : C MILIEUX POREUX 99 : C_______________________________________________________________________ 100 : C 101 : 79 CONTINUE 102 : C 103 : C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS 104 : C NBNO = NOMBRE DE FONCTIONS DE FORME 105 : C 106 : DIM3=1.D0 107 : NBNO=IPORE 108 : NBBB=NBNN 109 : LPP=NBNO-NBBB 110 : LRN =IDECAP*LPP 111 : LRE=NBNN*IDECAP 112 : NSTBE=2 113 : IF(IFOUR.GT.0) NSTBE=3 114 : NSTB=NSTBE*IDECAP 115 : NSTN=1 116 : 117 : * PRINT *,'NSTBE=',NSTBE 118 : * PRINT *,'NSTB=',NSTB 119 : * PRINT *,'IDECAP=',IDECAP 120 : * PRINT *,'LRN =',LRN 121 : * PRINT *,'LRE =',LRE 122 : * PRINT *,'NDDL =',NDDL 123 : * PRINT *,'NBNO =',NBNO 124 : * PRINT *,'NSTN =',NSTN 125 : * PRINT *,'IFOUR =',IFOUR 126 : 127 : SEGINI WRK1,WRK2,WRK5 128 : I195=0 129 : I259=0 130 : C 131 : DO 3079 IB=1,NBELEM 132 : C 133 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 134 : C 134 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 135 : C 136 : C MISE A 0 DES FORCES NODALES 137 : C 137 : CALL ZERO(XFORC,1,LRN) 138 : C 139 : C BOUCLE SUR LES POINTS DE GAUSS 140 : C 141 : ISDJC=0 142 : DO 5079 IGAU=1,NBPGAU 143 : C 144 : C RECUPERATION DE L'EPAISSEUR 145 : C 146 : IF (IFOUR.EQ.-2)THEN 147 : MPTVAL=IVACAR 148 : IF (IVACAR.NE.0) THEN 149 : MELVAL=IVAL(1) 150 : IF (MELVAL.NE.0) THEN 151 : IGMN=MIN(IGAU,VELCHE(/1)) 152 : IBMN=MIN(IB,VELCHE(/2)) 153 : DIM3=VELCHE(IGMN,IBMN) 154 : ELSE 155 : DIM3=1.D0 156 : ENDIF 157 : ENDIF 158 : ENDIF 159 : C 159 : CALL BNQORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3, 160 : . XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,2) 161 : 162 : IF(DJAC.LT.0.D0) ISDJC=ISDJC+1 163 : IF(DJAC.EQ.0.D0) I259=IB 164 : DJAC=ABS(DJAC)*POIGAU(IGAU) 165 : C 166 : C ON RECUPERE LES VE_CO 167 : C 168 : MPTVAL=IVAVCO 169 : NCOSOU=IVAL(/1) 170 : 171 : DO 8079 I=1,NCOSOU 172 : IF (IVAL(I).NE.0) THEN 173 : MELVAL=IVAL(I) 174 : IGMN=MIN(IGAU,VELCHE(/1)) 175 : IBMN=MIN(IB ,VELCHE(/2)) 176 : VECO(I)=VELCHE(IGMN,IBMN) 177 : ELSE 178 : VECO(I)=0.D0 179 : ENDIF 180 : 8079 CONTINUE 181 : 182 : * 183 : * CALCUL DES FORCES NODALES EQUIVALENTES 184 : * 185 : DO 9179 IPR=1,IDECAP 186 : LPPDEC=(IPR-1)*LPP 187 : NSTDEC=(IPR-1)*NSTBE 188 : NBBDEC=(IPR-1)*NBBB 189 : DO 9079 J=1,LPP 190 : DO 9079 I=1,NSTBE 191 : XFORC(J+LPPDEC)=XFORC(J+LPPDEC)+ 192 : . BGENE(I+NSTDEC,J+NBBDEC)*VECO(I+NSTDEC)*DJAC 193 : 9079 CONTINUE 194 : 9179 CONTINUE 195 : * 196 : 5079 CONTINUE 197 : * 198 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 199 : * 200 : C 201 : C ON RANGE XFORC DANS MELVAL 202 : C 203 : IE=0 204 : MPTVAL=IVAFOR 205 : C 206 : DO 4179 IPR=1,IDECAP 207 : MELVAL=IVAL(IPR) 208 : DO 4079 IGAU=1,NBSOM(IELE) 209 : IE=IE+1 210 : IGAV = IBSOM(NSPOS(IELE)+IGAU-1) 211 : VELCHE(IGAV,IB)=XFORC(IE) 212 : 4079 CONTINUE 213 : 4179 CONTINUE 214 : C 215 : 3079 CONTINUE 216 : IF(I195.NE.0) INTERR(1)=I195 216 : IF(I195.NE.0) CALL ERREUR(195) 217 : IF(I259.NE.0) INTERR(1)=I259 217 : IF(I259.NE.0) CALL ERREUR(259) 218 : SEGSUP WRK1,WRK2,WRK5 219 : GOTO 510 220 : C 221 : C_______________________________________________________________________ 222 : C 223 : C JOINTS POREUX 224 : C_______________________________________________________________________ 225 : C 226 : 80 CONTINUE 227 : C 228 : C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS 229 : C NBNO = NOMBRE DE FONCTIONS DE FORME 230 : C 231 : C ON GARDE LE IDECAP MAIS IL VAUT 1 ( AUTRES VALEURS : A VOIR ) 232 : C 233 : DIM3=1.D0 234 : NBNO=IPORE 235 : NBBB=NBNN 236 : LPP=(NBNO-NBBB)*3/2 237 : LRN =LPP*IDECAP 238 : LRE=LRN 239 : NSTBE=3 240 : IF(IFOUR.EQ.2) NSTBE=4 241 : NSTB=NSTBE*IDECAP 242 : NSTN=1 243 : NMIL=LRN-NBSOM(IELE) 244 : 245 : * PRINT *,'NSTBE=',NSTBE 246 : * PRINT *,'NSTB=',NSTB 247 : * PRINT *,'IDECAP=',IDECAP 248 : * PRINT *,'LPP =',LPP 249 : * PRINT *,'LRN =',LRN 250 : * PRINT *,'LRE =',LRE 251 : * PRINT *,'NDDL =',NDDL 252 : * PRINT *,'NBNO =',NBNO 253 : * PRINT *,'NBBB =',NBBB 254 : * PRINT *,'NSTN =',NSTN 255 : * PRINT *,'IFOUR =',IFOUR 256 : * PRINT *,'NMIL =',NMIL 257 : 258 : SEGINI WRK1,WRK2,WRK3,WRK5 259 : I195=0 260 : I259=0 261 : C 262 : DO 3080 IB=1,NBELEM 263 : C 264 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB 265 : C 265 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) 266 : C 267 : C CALCUL DES AXES LOCAUX ET DES CORDONNES LOCALES 268 : C 268 : CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS) 269 : C 270 : C MISE A 0 DES FORCES NODALES 271 : C 271 : CALL ZERO(XFORC,1,LRN) 272 : C 273 : C BOUCLE SUR LES POINTS DE GAUSS 274 : C 275 : ISDJC=0 276 : DO 5080 IGAU=1,NBPGAU 277 : C 278 : C RECUPERATION DE L'EPAISSEUR 279 : C 280 : * IF (IFOUR.EQ.-2)THEN 281 : * MPTVAL=IVACAR 282 : * IF (IVACAR.NE.0) THEN 283 : * MELVAL=IVAL(1) 284 : * IF (MELVAL.NE.0) THEN 285 : * IGMN=MIN(IGAU,VELCHE(/1)) 286 : * IBMN=MIN(IB,VELCHE(/2)) 287 : * DIM3=VELCHE(IGMN,IBMN) 288 : * ELSE 289 : * DIM3=1.D0 290 : * ENDIF 291 : * ENDIF 292 : * ENDIF 293 : C 293 : CALL BNQORJ(IGAU,NBNO,NBBB,LRE,IFOUR,NSTB,NSTN,XE,XEL, 294 : . SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,1) 295 : 296 : IF(DJAC.LT.0.D0) ISDJC=ISDJC+1 297 : IF(DJAC.EQ.0.D0) I259=IB 298 : DJAC=ABS(DJAC)*POIGAU(IGAU) 299 : 300 : C 301 : C ON RECUPERE LES VE_CO 302 : C 303 : MPTVAL=IVAVCO 304 : NCOSOU=IVAL(/1) 305 : 306 : DO 8080 I=1,NCOSOU 307 : IF (IVAL(I).NE.0) THEN 308 : MELVAL=IVAL(I) 309 : IGMN=MIN(IGAU,VELCHE(/1)) 310 : IBMN=MIN(IB ,VELCHE(/2)) 311 : VECO(I)=VELCHE(IGMN,IBMN) 312 : ELSE 313 : VECO(I)=0.D0 314 : ENDIF 315 : 8080 CONTINUE 316 : 317 : * 318 : * CALCUL DES FORCES NODALES EQUIVALENTES 319 : * 320 : DO 9080 J=1,LPP 321 : DO 9080 K=1,NSTBE 322 : XFORC(J)=XFORC(J)+ DJAC*BGENE(K,J)*VECO(K) 323 : 9080 CONTINUE 324 : * 325 : 5080 CONTINUE 326 : * 327 : 328 : * WRITE(6,78655) (VECO(IE),IE=1,NSTBE) 329 : *78655 FORMAT( 2X, 'VECTEUR VECO' /(4(1X,1PE12.5)/)) 330 : 331 : * WRITE(6,78654) (XFORC(IE),IE=1,LPP) 332 : *78654 FORMAT( 2X, 'VECTEUR XFORC' /(4(1X,1PE12.5)/)) 333 : 334 : 335 : 336 : 337 : 338 : IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB 339 : * 340 : C 341 : C ON RANGE XFORC DANS MELVAL 342 : C 343 : IE=0 344 : MPTVAL=IVAFOR 345 : C 346 : 347 : * PRINT *, 'NBSOM(IELE) =', NBSOM(IELE) 348 : 349 : DO 4180 IPR=1,IDECAP 350 : MELVAL=IVAL(IPR) 351 : DO 4080 I=1,NBSOM(IELE) 352 : IE=IE+1 353 : IGAV = IBSOM(NSPOS(IELE)+I-1) 354 : VELCHE(IGAV,IB)=XFORC(IE) 355 : 4080 CONTINUE 356 : * 357 : DO 4081 IGAU=1,NMIL 358 : IE=IE+1 359 : IGAV = NBBB - NMIL + IGAU 360 : VELCHE(IGAV,IB)=XFORC(IE) 361 : 4081 CONTINUE 362 : * 363 : 4180 CONTINUE 364 : C 365 : 3080 CONTINUE 366 : IF(I195.NE.0) INTERR(1)=I195 366 : IF(I195.NE.0) CALL ERREUR(195) 367 : IF(I259.NE.0) INTERR(1)=I259 367 : IF(I259.NE.0) CALL ERREUR(259) 368 : SEGSUP WRK1,WRK2,WRK3,WRK5 369 : GOTO 510 370 : C 371 : C_______________________________________________________________________ 372 : C 373 : C 374 : 99 CONTINUE 375 : MOTERR(1:4)=NOMTP(MELE) 376 : MOTERR(5:8)='GNFL' 376 : CALL ERREUR(86) 377 : C 378 : 510 CONTINUE 379 : RETURN 380 : END 381 : 382 : 383 : 384 : 385 : 386 : 387 : 388 : 389 : 390 : 391 : 392 : 393 : 394 : 395 : 396 : 397 : 398 : 399 : 400 : 401 : 402 : 403 : 404 : 405 :
© Cast3M 2003 - All rights reserved.
Disclaimer