C RIGELE SOURCE BP208322 17/03/01 21:18:08 9325 SUBROUTINE RIGELE (MATE,MELE,NBPGAU,LPERM,LRE,IPMAIL,IPMINT1, & IVAMAT,NVMAT, IPMATR) *----------------------------------------------------------------------* * CALCUL DE LA RIGIDITE POUR LA FORMULATION 'ELECTROSTATIQUE' * *----------------------------------------------------------------------* * ENTREES : * * ________ * * MATE Numero du materiau * * MELE Numero de l'element fini * * IPMAIL Pointeur sur un segment MELEME * * IPMINT Pointeur sur un segment MINTE * * NBPGAU Nombre de point d'integration pour la rigidite * * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou * * NVMAT Nombre de composante de materiau (IMAT=1) * * * * SORTIES : * * ________ * * IPMATR pointeur sur la rigidite de la sous-zone * *----------------------------------------------------------------------* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCHAML -INC SMCOORD -INC SMELEME -INC SMINTE -INC SMRIGID SEGMENT MWKELT REAL*8 DPERM(LPERM,LPERM),BGRELE(LPERM,LRE) REAL*8 XEL(3,NBNN),SHP(6,NBNN) REAL*8 VALMAT(NVMAT) ENDSEGMENT SEGMENT MWKMAT REAL*8 XLOC(3,3),XGLOB(3,3),TXR(IDIM,IDIM) REAL*8 DPERM1(LPERM,LPERM) ENDSEGMENT SEGMENT MPTVAL INTEGER IPOS(NS),NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT MINTE = IPMINT1 MELEME = IPMAIL NBNN = NUM(/1) NBELEM = NUM(/2) XMATRI = IPMATR MPTVAL = IVAMAT SEGINI,MWKELT IWKELT = MWKELT MWKMAT = 0 IF (MATE.EQ.2.OR.MATE.EQ.3) THEN NLG = NUMGEO(MELE) CALL RESHPT(1,NBNN,NLG,MELE,0,IPMINT2,IRT1) MINTE2 = IPMINT2 SEGACT,MINTE2 NBSH = MINTE2.SHPTOT(/2) SEGINI,MWKMAT ENDIF IWKMAT = MWKMAT C------------------------- C Boucle sur les elements C------------------------- DO IEL = 1,NBELEM C - Recuperation des coordonnees des noeuds de l element IEL CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL) C - Calcul des axes locaux dans les cas orthotrope et anisotrope IF (MATE.EQ.2.OR.MATE.EQ.3) THEN CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR) IF (NBSH.EQ.-1) THEN CALL ERREUR(525) GOTO 999 ENDIF ENDIF C-- -- -- -- -- -- -- -- -- C - Boucle sur les points de Gauss C-- -- -- -- -- -- -- -- -- ISDJC = 0 DO IGAU = 1, NBPGAU C -- Calcul de la matrice Bel et du jacobien au point de Gauss IGAU CALL BELEC(XEL,SHPTOT(1,1,IGAU),NBNN,LPERM,1, SHP,BGRELE,DJAC) IF (DJAC.LT.0.) ISDJC = ISDJC+1 IF (DJAC.EQ.0.) THEN INTERR(1) = IEL CALL ERREUR(259) GOTO 999 ENDIF DJAC = ABS(DJAC)*POIGAU(IGAU) C -- Recuperation des proprietes materielles (IGAU) DO i = 1, NVMAT MELVAL = IVAL(i) IEMN = MIN(IEL ,VELCHE(/2)) IGMN = MIN(IGAU,VELCHE(/1)) VALMAT(i) = VELCHE(IGMN,IEMN) ENDDO C -- Calcul de la matrice de permittivite dielectrique (IGAU) CALL PERMEL(MATE,IDIM, IWKELT,IWKMAT) C -- Contribution a la matrice de rigidite elementaire (IGAU - IEL) CALL BDBST(BGRELE,DJAC,DPERM,LRE,LPERM,RE(1,1,IEL)) C-- -- -- -- -- -- -- -- -- ENDDO C-- -- -- -- -- -- -- -- -- IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN INTERR(1) = IEL CALL ERREUR(195) GOTO 999 ENDIF C------------------------- ENDDO C------------------------- 999 CONTINUE IF (MATE.EQ.2.OR.MATE.EQ.3) THEN SEGDES,MINTE2 SEGSUP,MWKMAT ENDIF SEGSUP,MWKELT RETURN END