C GNFL1 SOURCE PV090527 26/04/30 21:15:36 12529 SUBROUTINE GNFL1(IPMAIL,NDDL,NBPGAU,MELE,MFR,IVAVCO,IPMINT, & IVACAR,IPORE,NCOMP,IVAFOR,IIPDPG,IDECAP) *---------------------------------------------------------------------* * * * ENTREES : * * ________ * * * * IPMAIL Pointeur sur un segment MELEME * * LRE Nombre de ddl dans la matrice de rigidite * * NDDL Nombre de degré de liberté * * NBPGAU Nombre de points d'integration * * MELE Numero de l'element fini * * MFR Numero de la formulation * * IVAVCO pointeur sur un segment MPTVAL contenant les * * les melvals de FORCES VOLUMIQUES * * IPMINT Pointeur sur un segment MINTE * * IVACAR Pointeur sur un melval de caractéristiques * * IPORE Nombre de fonctions de forme * * NCOMP Nombre de composantes de forces * * * * SORTIES : * * ________ * * * * IVAFOR pointeur sur un segment MPTVAL contenant les * * melvals * * * *---------------------------------------------------------------------* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCHAMP -INC CCGEOME -INC CCREEL -INC SMCHAML -INC SMCHPOI -INC SMELEME -INC SMCOORD -INC SMMODEL -INC SMINTE -INC SMRIGID -INC TMPTVAL SEGMENT WRK1 REAL*8 XFORC(LRN),VECO(NDDL),XE(3,NBBB) ENDSEGMENT * SEGMENT WRK2 REAL*8 SHPWRK(6,NBNO),BGENE(NSTB,LRE) ENDSEGMENT * SEGMENT WRK3 REAL*8 BPSS(3,3),XEL(3,NBBB) REAL*8 XNTH(LRN,LRN),XNTB(LRN,LRN),XNTT(LRN) ENDSEGMENT * SEGMENT WRK5 REAL*8 XGENE(NSTN,LRN) ENDSEGMENT * * INTRODUCTION DU POINT AUTOUR DUQUEL SE FAIT LE MOUVEMENT * DE LA SECTION EN DEFO PLANE GENERALISEE * IF (IFOUR.EQ.-3)THEN IREF=(IIPDPG-1)*(IDIM+1) XDPGE=XCOOR(IREF+1) YDPGE=XCOOR(IREF+2) ELSE XDPGE=0.D0 YDPGE=0.D0 ENDIF * MELEME=IPMAIL NBNN=NUM(/1) NBELEM=NUM(/2) NHRM=NIFOUR MINTE=IPMINT IELE=NUMGEO(MELE) * IF(MELE.GE.79.AND.MELE.LE.83) GO TO 79 IF(MELE.GE.173.AND.MELE.LE.182) GO TO 79 IF(MELE.GE.108.AND.MELE.LE.110) GO TO 80 IF(MELE.GE.185.AND.MELE.LE.190) GO TO 80 GOTO 99 * C_______________________________________________________________________ C C MILIEUX POREUX C_______________________________________________________________________ C 79 CONTINUE C C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS C NBNO = NOMBRE DE FONCTIONS DE FORME C DIM3=1.D0 NBNO=IPORE NBBB=NBNN LPP=NBNO-NBBB LRN =IDECAP*LPP LRE=NBNN*IDECAP NSTBE=2 IF(IFOUR.GT.0) NSTBE=3 NSTB=NSTBE*IDECAP NSTN=1 * PRINT *,'NSTBE=',NSTBE * PRINT *,'NSTB=',NSTB * PRINT *,'IDECAP=',IDECAP * PRINT *,'LRN =',LRN * PRINT *,'LRE =',LRE * PRINT *,'NDDL =',NDDL * PRINT *,'NBNO =',NBNO * PRINT *,'NSTN =',NSTN * PRINT *,'IFOUR =',IFOUR SEGINI WRK1,WRK2,WRK5 I195=0 I259=0 C DO 3079 IB=1,NBELEM C C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB C CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) C C MISE A 0 DES FORCES NODALES C CALL ZERO(XFORC,1,LRN) C C BOUCLE SUR LES POINTS DE GAUSS C ISDJC=0 DO 5079 IGAU=1,NBPGAU C C RECUPERATION DE L'EPAISSEUR C IF (IFOUR.EQ.-2)THEN MPTVAL=IVACAR IF (IVACAR.NE.0) THEN MELVAL=IVAL(1) IF (MELVAL.NE.0) THEN IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB,VELCHE(/2)) DIM3=VELCHE(IGMN,IBMN) ELSE DIM3=1.D0 ENDIF ENDIF ENDIF C LHOO = NSTB CALL BNQORE(IGAU,NBNO,NBNN,LRE,IFOUR,NSTB,NSTN,NHRM,DIM3, . XE,SHPTOT,SHPWRK,BGENE,XGENE,DJAC,IDECAP,LHOO,2) IF(DJAC.LT.0.D0) ISDJC=ISDJC+1 IF(DJAC.EQ.0.D0) I259=IB DJAC=ABS(DJAC)*POIGAU(IGAU) C C ON RECUPERE LES VE_CO C MPTVAL=IVAVCO NCOSOU=IVAL(/1) DO 8079 I=1,NCOSOU MELVAL=IVAL(I) IF (MELVAL.NE.0) THEN IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) VECO(I)=VELCHE(IGMN,IBMN) ELSE VECO(I)=0.D0 ENDIF 8079 CONTINUE * * CALCUL DES FORCES NODALES EQUIVALENTES * DO 9179 IPR=1,IDECAP LPPDEC=(IPR-1)*LPP NSTDEC=(IPR-1)*NSTBE NBBDEC=(IPR-1)*NBBB DO J=1,LPP JX = J + LPPDEC JB = J + NBBDEC DO K=1,NSTBE KB = K + NSTDEC XFORC(JX)=XFORC(JX)+ DJAC*BGENE(KB,JB)*VECO(KB) enddo enddo 9179 CONTINUE * 5079 CONTINUE * IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB * C C ON RANGE XFORC DANS MELVAL C IE=0 MPTVAL=IVAFOR C DO 4179 IPR=1,IDECAP MELVAL=IVAL(IPR) DO 4079 IGAU=1,NBSOM(IELE) IE=IE+1 IGAV = IBSOM(NSPOS(IELE)+IGAU-1) VELCHE(IGAV,IB)=XFORC(IE) 4079 CONTINUE 4179 CONTINUE C 3079 CONTINUE IF(I195.NE.0) INTERR(1)=I195 IF(I195.NE.0) CALL ERREUR(195) IF(I259.NE.0) INTERR(1)=I259 IF(I259.NE.0) CALL ERREUR(259) SEGSUP WRK1,WRK2,WRK5 GOTO 510 C C_______________________________________________________________________ C C JOINTS POREUX C_______________________________________________________________________ C 80 CONTINUE C C POUR CES ELEMENTS NBBB = NOMBRE DE NOEUDS C NBNO = NOMBRE DE FONCTIONS DE FORME C DIM3=1.D0 NBNO=IPORE NBBB=NBNN LPP=(NBNO-NBBB)*3/2 LRN =LPP*IDECAP LRE=LRN NSTBE=3 IF(IFOUR.EQ.2) NSTBE=4 NSTB=NSTBE*IDECAP NSTN=1 NMIL=LPP-NBSOM(IELE) * PRINT *,'NSTBE=',NSTBE * PRINT *,'NSTB=',NSTB * PRINT *,'IDECAP=',IDECAP * PRINT *,'LPP =',LPP * PRINT *,'LRN =',LRN * PRINT *,'LRE =',LRE * PRINT *,'NDDL =',NDDL * PRINT *,'NBNO =',NBNO * PRINT *,'NBBB =',NBBB * PRINT *,'NSTN =',NSTN * PRINT *,'IFOUR =',IFOUR * PRINT *,'NMIL =',NMIL SEGINI WRK1,WRK2,WRK3,WRK5 I195=0 I259=0 C DO 3080 IB=1,NBELEM C C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB C CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE) C C CALCUL DES AXES LOCAUX ET DES CORDONNES LOCALES C CALL JOPLOC(XE,SHPTOT,NBBB,NBNO,IFOUR,XEL,BPSS) C C MISE A 0 DES FORCES NODALES C CALL ZERO(XFORC,1,LRN) C C BOUCLE SUR LES POINTS DE GAUSS C ISDJC=0 DO 5080 IGAU=1,NBPGAU C C RECUPERATION DE L'EPAISSEUR C * IF (IFOUR.EQ.-2)THEN * MPTVAL=IVACAR * IF (IVACAR.NE.0) THEN * MELVAL=IVAL(1) * IF (MELVAL.NE.0) THEN * IGMN=MIN(IGAU,VELCHE(/1)) * IBMN=MIN(IB,VELCHE(/2)) * DIM3=VELCHE(IGMN,IBMN) * ELSE * DIM3=1.D0 * ENDIF * ENDIF * ENDIF C CALL BNQORJ(IGAU,NBNO,NBBB,LRE,IFOUR,NSTB,NSTN,XE,XEL, . SHPTOT,SHPWRK,BPSS,BGENE,XGENE,DJAC,IDECAP,1) IF(DJAC.LT.0.D0) ISDJC=ISDJC+1 IF(DJAC.EQ.0.D0) I259=IB DJAC=ABS(DJAC)*POIGAU(IGAU) C C ON RECUPERE LES VE_CO C MPTVAL=IVAVCO NCOSOU=IVAL(/1) DO 8080 I=1,NCOSOU IF (IVAL(I).NE.0) THEN MELVAL=IVAL(I) IGMN=MIN(IGAU,VELCHE(/1)) IBMN=MIN(IB ,VELCHE(/2)) VECO(I)=VELCHE(IGMN,IBMN) ELSE VECO(I)=0.D0 ENDIF 8080 CONTINUE * * CALCUL DES FORCES NODALES EQUIVALENTES * DO 9180 IPR=1,IDECAP LPPDEC=(IPR-1)*LPP NSTDEC=(IPR-1)*NSTBE DO J=1,LPP JJ = J + LPPDEC DO K=1,NSTBE KB = K + NSTDEC XFORC(JJ)=XFORC(JJ)+ DJAC*BGENE(KB,JJ)*VECO(KB) enddo enddo 9180 CONTINUE * 5080 CONTINUE * * WRITE(6,78655) (VECO(IE),IE=1,NSTBE) *78655 FORMAT( 2X, 'VECTEUR VECO' /(4(1X,1PE12.5)/)) * WRITE(6,78654) (XFORC(IE),IE=1,LPP) *78654 FORMAT( 2X, 'VECTEUR XFORC' /(4(1X,1PE12.5)/)) IF(ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) I195=IB C C ON RANGE XFORC DANS MELVAL C * PRINT *, 'NBSOM(IELE) =', NBSOM(IELE) IE=0 MPTVAL=IVAFOR DO 4180 IPR=1,IDECAP MELVAL=IVAL(IPR) DO 4080 I=1,NBSOM(IELE) IE=IE+1 IGAV = IBSOM(NSPOS(IELE)+I-1) VELCHE(IGAV,IB)=XFORC(IE) 4080 CONTINUE * DO 4081 IGAU=1,NMIL IE=IE+1 IGAV = NBBB - NMIL + IGAU VELCHE(IGAV,IB)=XFORC(IE) 4081 CONTINUE * 4180 CONTINUE C 3080 CONTINUE IF(I195.NE.0) INTERR(1)=I195 IF(I195.NE.0) CALL ERREUR(195) IF(I259.NE.0) INTERR(1)=I259 IF(I259.NE.0) CALL ERREUR(259) SEGSUP WRK1,WRK2,WRK3,WRK5 GOTO 510 C_______________________________________________________________________ C 99 CONTINUE MOTERR(1:4)=NOMTP(MELE) MOTERR(5:8)='GNFL' CALL ERREUR(86) C 510 CONTINUE RETURN END