C SIGELE SOURCE BP208322 17/03/01 21:18:19 9325 SUBROUTINE SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT1,NDEP,IVADEP, & LPERM,LRE,MATE,IVAMAT,NVMAT, IVASTR) *----------------------------------------------------------------------* * CALCUL DES INDUCTIONS ELECTRIQUES (FORMULATION 'ELECTROSTATIQUE') * *----------------------------------------------------------------------* * ENTREES : * * ________ * * MELE Numero de l'element fini * * IPMAIL Pointeur sur un segment MELEME * * IPMINT1 Pointeur sur un segment MINTE * * NBPGAU Nombre de point d'integration pour la rigidite * * MATE Numero du materiau * * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou * * NVMAT Nombre de composantes de materiau * * * * SORTIES : * * ________ * * IVASTR Pointeur sur * *----------------------------------------------------------------------* 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 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 MWKELE REAL*8 DDLELE(LRE),FLUELE(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) SEGINI,MWKELT IWKELT = MWKELT MWKMAT = 0 IF (MATE.EQ.2.OR.MATE.EQ.3) THEN CALL RESHPT(1,NBNN,IELE,MELE,0,IPMINT2,IRT1) MINTE2 = IPMINT2 SEGACT,MINTE2 NBSH = MINTE2.SHPTOT(/2) SEGINI,MWKMAT ENDIF IWKMAT = MWKMAT SEGINI,MWKELE 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 - Recuperation des potentiels electriques aux noeuds de l element IEL MPTVAL = IVADEP IE = 1 DO IGAU = 1, NBNN DO ICOMP = 1, NDEP MELVAL = IVAL(ICOMP) IGMN = MIN(IGAU,VELCHE(/1)) IEMN = MIN(IEL ,VELCHE(/2)) DDLELE(IE) = VELCHE(IGMN,IEMN) IE = IE+1 ENDDO ENDDO 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 C -- Recuperation des proprietes materielles (IGAU) MPTVAL = IVAMAT 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 -- Calcul de l'induction electrique Del (IGAU) CALL DBST(BGRELE,DPERM,DDLELE,LRE,LPERM,FLUELE) C -- Remplissage du segment contenant Del = "contraintes" MPTVAL = IVASTR DO ICOMP = 1, LPERM MELVAL = IVAL(ICOMP) IEMN = MIN(IEL,VELCHE(/2)) VELCHE(IGAU,IEMN) = FLUELE(ICOMP) ENDDO 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 SEGSUP,MWKELE RETURN END