1 : C SIGELE SOURCE FANDEUR 10/12/17 21:18:49 6427 2 : 3 : SUBROUTINE SIGELE (MELE,IELE,IPMAIL,NBPGAU,IPMINT1,NDEP,IVADEP, 4 : & LPERM,LRE,MATE,IVAMAT,NVMAT, IVASTR) 5 : 6 : *----------------------------------------------------------------------* 7 : * CALCUL DES INDUCTIONS ELECTRIQUES (FORMULATION 'ELECTROSTATIQUE') * 8 : *----------------------------------------------------------------------* 9 : * ENTREES : * 10 : * ________ * 11 : * MELE Numero de l'element fini * 12 : * IPMAIL Pointeur sur un segment MELEME * 13 : * IPMINT1 Pointeur sur un segment MINTE * 14 : * NBPGAU Nombre de point d'integration pour la rigidite * 15 : * MATE Numero du materiau * 16 : * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou * 17 : * NVMAT Nombre de composantes de materiau * 18 : * * 19 : * SORTIES : * 20 : * ________ * 21 : * IVASTR Pointeur sur * 22 : *----------------------------------------------------------------------* 23 : 24 : IMPLICIT INTEGER(I-N) 25 : IMPLICIT REAL*8(A-H,O-Z) 26 : 27 : -INC CCOPTIO 28 : -INC CCREEL 29 : 30 : -INC SMCHAML 31 : -INC SMCOORD 32 : -INC SMELEME 33 : -INC SMINTE 34 : 35 : SEGMENT MWKELT 36 : REAL*8 DPERM(LPERM,LPERM),BGRELE(LPERM,LRE) 37 : REAL*8 XEL(3,NBNN),SHP(6,NBNN) 38 : REAL*8 VALMAT(NVMAT) 39 : ENDSEGMENT 40 : 41 : SEGMENT MWKMAT 42 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM),TXR(IDIM,IDIM) 43 : REAL*8 DPERM1(LPERM,LPERM) 44 : ENDSEGMENT 45 : 46 : SEGMENT MWKELE 47 : REAL*8 DDLELE(LRE),FLUELE(LPERM) 48 : ENDSEGMENT 49 : 50 : SEGMENT MPTVAL 51 : INTEGER IPOS(NS),NSOF(NS) 52 : INTEGER IVAL(NCOSOU) 53 : CHARACTER*16 TYVAL(NCOSOU) 54 : ENDSEGMENT 55 : 56 : MINTE = IPMINT1 57 : MELEME = IPMAIL 58 : NBNN = NUM(/1) 59 : NBELEM = NUM(/2) 60 : 61 : SEGINI,MWKELT 62 : IWKELT = MWKELT 63 : 64 : MWKMAT = 0 65 : IF (MATE.EQ.2.OR.MATE.EQ.3) THEN 65 : CALL RESHPT(1,NBNN,IELE,MELE,0,IPMINT2,IRT1) 66 : MINTE2 = IPMINT2 67 : SEGACT,MINTE2 68 : NBSH = MINTE2.SHPTOT(/2) 69 : SEGINI,MWKMAT 70 : ENDIF 71 : IWKMAT = MWKMAT 72 : 73 : SEGINI,MWKELE 74 : 75 : C------------------------- 76 : C Boucle sur les elements 77 : C------------------------- 78 : DO IEL = 1,NBELEM 79 : C - Recuperation des coordonnees des noeuds de l element IEL 79 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL) 80 : C - Calcul des axes locaux dans les cas orthotrope et anisotrope 81 : IF (MATE.EQ.2.OR.MATE.EQ.3) THEN 81 : CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR) 82 : IF (NBSH.EQ.-1) THEN 82 : CALL ERREUR(525) 83 : GOTO 999 84 : ENDIF 85 : ENDIF 86 : C - Recuperation des potentiels electriques aux noeuds de l element IEL 87 : MPTVAL = IVADEP 88 : IE = 1 89 : DO IGAU = 1, NBNN 90 : DO ICOMP = 1, NDEP 91 : MELVAL = IVAL(ICOMP) 92 : IGMN = MIN(IGAU,VELCHE(/1)) 93 : IEMN = MIN(IEL ,VELCHE(/2)) 94 : DDLELE(IE) = VELCHE(IGMN,IEMN) 95 : IE = IE+1 96 : ENDDO 97 : ENDDO 98 : C-- -- -- -- -- -- -- -- -- 99 : C - Boucle sur les points de Gauss 100 : C-- -- -- -- -- -- -- -- -- 101 : ISDJC = 0 102 : DO IGAU = 1, NBPGAU 103 : C -- Calcul de la matrice Bel et du jacobien au point de Gauss IGAU 103 : CALL BELEC(XEL,SHPTOT(1,1,IGAU),NBNN,LPERM,-1, 104 : & SHP,BGRELE,DJAC) 105 : IF (DJAC.LT.0.) ISDJC = ISDJC+1 106 : IF (DJAC.EQ.0.) THEN 107 : INTERR(1) = IEL 107 : CALL ERREUR(259) 108 : GOTO 999 109 : ENDIF 110 : C -- Recuperation des proprietes materielles (IGAU) 111 : MPTVAL = IVAMAT 112 : DO i = 1, NVMAT 113 : MELVAL = IVAL(i) 114 : IEMN = MIN(IEL ,VELCHE(/2)) 115 : IGMN = MIN(IGAU,VELCHE(/1)) 116 : VALMAT(i) = VELCHE(IGMN,IEMN) 117 : ENDDO 118 : C -- Calcul de la matrice de permittivite dielectrique (IGAU) 118 : CALL PERMEL(MATE,IDIM, IWKELT,IWKMAT) 119 : C -- Calcul de l'induction electrique Del (IGAU) 119 : CALL DBST(BGRELE,DPERM,DDLELE,LRE,LPERM,FLUELE) 120 : C -- Remplissage du segment contenant Del = "contraintes" 121 : MPTVAL = IVASTR 122 : DO ICOMP = 1, LPERM 123 : MELVAL = IVAL(ICOMP) 124 : IEMN = MIN(IEL,VELCHE(/2)) 125 : VELCHE(IGAU,IEMN) = FLUELE(ICOMP) 126 : ENDDO 127 : C-- -- -- -- -- -- -- -- -- 128 : ENDDO 129 : C-- -- -- -- -- -- -- -- -- 130 : IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN 131 : INTERR(1) = IEL 131 : CALL ERREUR(195) 132 : GOTO 999 133 : ENDIF 134 : C------------------------- 135 : ENDDO 136 : C------------------------- 137 : 138 : 999 CONTINUE 139 : IF (MATE.EQ.2.OR.MATE.EQ.3) THEN 140 : SEGDES,MINTE2 141 : SEGSUP,MWKMAT 142 : ENDIF 143 : SEGSUP,MWKELT 144 : SEGSUP,MWKELE 145 : 146 : RETURN 147 : END 148 : 149 :
© Cast3M 2003 - All rights reserved.
Disclaimer