1 : C RIGELE SOURCE FANDEUR 10/12/17 21:18:34 6427 2 : 3 : SUBROUTINE RIGELE (MATE,MELE,NBPGAU,LPERM,LRE,IPMAIL,IPMINT1, 4 : & IVAMAT,NVMAT, IPMATR) 5 : 6 : *----------------------------------------------------------------------* 7 : * CALCUL DE LA RIGIDITE POUR LA FORMULATION 'ELECTROSTATIQUE' * 8 : *----------------------------------------------------------------------* 9 : * ENTREES : * 10 : * ________ * 11 : * MATE Numero du materiau * 12 : * MELE Numero de l'element fini * 13 : * IPMAIL Pointeur sur un segment MELEME * 14 : * IPMINT Pointeur sur un segment MINTE * 15 : * NBPGAU Nombre de point d'integration pour la rigidite * 16 : * IVAMAT Pointeur sur un segment MPTVAL pour le materiau ou * 17 : * NVMAT Nombre de composante de materiau (IMAT=1) * 18 : * * 19 : * SORTIES : * 20 : * ________ * 21 : * IPMATR pointeur sur la rigidite de la sous-zone * 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 : -INC SMRIGID 35 : 36 : SEGMENT MWKELT 37 : REAL*8 DPERM(LPERM,LPERM),BGRELE(LPERM,LRE) 38 : REAL*8 XEL(3,NBNN),SHP(6,NBNN) 39 : REAL*8 VALMAT(NVMAT) 40 : ENDSEGMENT 41 : 42 : SEGMENT MWKMAT 43 : REAL*8 XLOC(IDIM,IDIM),XGLOB(IDIM,IDIM),TXR(IDIM,IDIM) 44 : REAL*8 DPERM1(LPERM,LPERM) 45 : ENDSEGMENT 46 : 47 : SEGMENT MPTVAL 48 : INTEGER IPOS(NS),NSOF(NS) 49 : INTEGER IVAL(NCOSOU) 50 : CHARACTER*16 TYVAL(NCOSOU) 51 : ENDSEGMENT 52 : 53 : MINTE = IPMINT1 54 : MELEME = IPMAIL 55 : NBNN = NUM(/1) 56 : NBELEM = NUM(/2) 57 : XMATRI = IPMATR 58 : MPTVAL = IVAMAT 59 : 60 : SEGINI,MWKELT 61 : IWKELT = MWKELT 62 : 63 : MWKMAT = 0 64 : IF (MATE.EQ.2.OR.MATE.EQ.3) THEN 65 : NLG = NUMGEO(MELE) 65 : CALL RESHPT(1,NBNN,NLG,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 : C------------------------- 74 : C Boucle sur les elements 75 : C------------------------- 76 : DO IEL = 1,NBELEM 77 : C - Recuperation des coordonnees des noeuds de l element IEL 77 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL) 78 : C - Calcul des axes locaux dans les cas orthotrope et anisotrope 79 : IF (MATE.EQ.2.OR.MATE.EQ.3) THEN 79 : CALL RLOCAL(XEL,MINTE2.SHPTOT,NBSH,NBNN,TXR) 80 : IF (NBSH.EQ.-1) THEN 80 : CALL ERREUR(525) 81 : GOTO 999 82 : ENDIF 83 : ENDIF 84 : C-- -- -- -- -- -- -- -- -- 85 : C - Boucle sur les points de Gauss 86 : C-- -- -- -- -- -- -- -- -- 87 : ISDJC = 0 88 : DO IGAU = 1, NBPGAU 89 : C -- Calcul de la matrice Bel et du jacobien au point de Gauss IGAU 89 : CALL BELEC(XEL,SHPTOT(1,1,IGAU),NBNN,LPERM,1, SHP,BGRELE,DJAC) 90 : IF (DJAC.LT.0.) ISDJC = ISDJC+1 91 : IF (DJAC.EQ.0.) THEN 92 : INTERR(1) = IEL 92 : CALL ERREUR(259) 93 : GOTO 999 94 : ENDIF 95 : DJAC = ABS(DJAC)*POIGAU(IGAU) 96 : C -- Recuperation des proprietes materielles (IGAU) 97 : DO i = 1, NVMAT 98 : MELVAL = IVAL(i) 99 : IEMN = MIN(IEL ,VELCHE(/2)) 100 : IGMN = MIN(IGAU,VELCHE(/1)) 101 : VALMAT(i) = VELCHE(IGMN,IEMN) 102 : ENDDO 103 : C -- Calcul de la matrice de permittivite dielectrique (IGAU) 103 : CALL PERMEL(MATE,IDIM, IWKELT,IWKMAT) 104 : C -- Contribution a la matrice de rigidite elementaire (IGAU - IEL) 104 : CALL BDBST(BGRELE,DJAC,DPERM,LRE,LPERM,RE(1,1,IEL)) 105 : C-- -- -- -- -- -- -- -- -- 106 : ENDDO 107 : C-- -- -- -- -- -- -- -- -- 108 : IF (ISDJC.NE.0 .AND. ISDJC.NE.NBPGAU) THEN 109 : INTERR(1) = IEL 109 : CALL ERREUR(195) 110 : GOTO 999 111 : ENDIF 112 : C------------------------- 113 : ENDDO 114 : C------------------------- 115 : 116 : 999 CONTINUE 117 : IF (MATE.EQ.2.OR.MATE.EQ.3) THEN 118 : SEGDES,MINTE2 119 : SEGSUP,MWKMAT 120 : ENDIF 121 : SEGSUP,MWKELT 122 : 123 : RETURN 124 : END 125 : 126 :
© Cast3M 2003 - All rights reserved.
Disclaimer