1 : C BSIGEL SOURCE FANDEUR 10/12/17 21:15:41 6427 2 : 3 : SUBROUTINE BSIGEL (IPMAIL,IPMINT,NBPGAU,IVASTR,NSTRS,LRE,LPERM, 4 : & IVAFOR,NFOR) 5 : 6 : *----------------------------------------------------------------------* 7 : * CALCUL DES INDUCTIONS (FLUX) ELECTRIQUES NODAUX EQUIVALENTES * 8 : * Formulation 'ELECTROSTATIQUE' (MFR=71) - Elements MASSIFs * 9 : *----------------------------------------------------------------------* 10 : * IPMAIL (E) Pointeur sur un segment MELEME * 11 : * IPMINT (E) Pointeur sur un segment MINTE (ACTIF) * 12 : * NBPGAU (E) Nombre de points d'integration pour les "contraintes" * 13 : * IVASTR (E) pointeur sur un segment MPTVAL contenant les * 14 : * les melvals de contraints * 15 : * NSTRS (E) Nombre de composantes de "contraintes/deformations" * 16 : * LRE (E) Nombre de DDL dans la matrice de "rigidite" * 17 : * LPERM (E) Nombre de composantes de "deformations" = NSTRS * 18 : * IVAFOR (E) pointeur sur un segment MPTVAL contenant les * 19 : * les melvals de forces * 20 : * NFOR (E) Nombre de composantes de "flux" LRE = NBNN * NFOR * 21 : *----------------------------------------------------------------------* 22 : IMPLICIT INTEGER(I-N) 23 : IMPLICIT REAL*8(A-H,O-Z) 24 : 25 : -INC CCOPTIO 26 : -INC CCREEL 27 : 28 : -INC SMCHAML 29 : -INC SMELEME 30 : -INC SMCOORD 31 : -INC SMINTE 32 : 33 : SEGMENT MWRK1 34 : REAL*8 XFORC(LRE), XFLUE(NSTRS), XEL(3,NBNN) 35 : REAL*8 SHP(6,NBNN), BGRELE(LPERM,LRE) 36 : ENDSEGMENT 37 : 38 : SEGMENT MPTVAL 39 : INTEGER IPOS(NS) ,NSOF(NS) 40 : INTEGER IVAL(NCOSOU) 41 : CHARACTER*16 TYVAL(NCOSOU) 42 : ENDSEGMENT 43 : 44 : MELEME = IPMAIL 45 : SEGACT,MELEME 46 : NBNN = NUM(/1) 47 : NBELEM = NUM(/2) 48 : 49 : MINTE = IPMINT 50 : SEGACT,MINTE 51 : 52 : SEGINI,MWRK1 53 : 54 : C------------------------- 55 : C Boucle sur les elements 56 : C------------------------- 57 : DO IEL = 1, NBELEM 58 : 59 : C - Recuperation des coordonnees des noeuds de l element IEL 59 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL) 60 : 61 : C - Initialisation des flux nodaux equivalents 62 : DO ICOMP = 1, LRE 63 : XFORC(ICOMP) = XZero 64 : ENDDO 65 : C 66 : MPTVAL = IVASTR 67 : C-- -- -- -- -- -- -- -- -- 68 : C - Boucle sur les points de Gauss 69 : C-- -- -- -- -- -- -- -- -- 70 : ISDJC = 0 71 : DO IGAU = 1, NBPGAU 72 : C -- Calcul de la matrice Bel et du jacobien au point de Gauss IGAU 72 : CALL BELEC(XEL,SHPTOT(1,1,IGAU),NBNN,LPERM,1, 73 : & SHP,BGRELE,DJAC) 74 : IF (DJAC.EQ.XZero) THEN 75 : INTERR(1) = IEL 75 : CALL ERREUR(259) 76 : GOTO 999 77 : ENDIF 78 : IF (DJAC.LT.XZero) ISDJC = ISDJC+1 79 : DJAC = ABS(DJAC)*POIGAU(IGAU) 80 : C -- Recuperation des inductions Del au point d'integration (IGAU) 81 : DO ICOMP = 1, NSTRS 82 : MELVAL = IVAL(ICOMP) 83 : IGMN = MIN(IGAU,VELCHE(/1)) 84 : IEMN = MIN(IEL ,VELCHE(/2)) 85 : XFLUE(ICOMP) = VELCHE(IGMN,IEMN) 86 : ENDDO 87 : C -- Calcul du terme Bel * Del et de la contribution du point IGAU 88 : DO ICOMP = 1, LRE 89 : r_z = XZero 90 : DO JCOMP = 1, NSTRS 91 : r_z = r_z + BGRELE(JCOMP,ICOMP) * XFLUE(JCOMP) 92 : ENDDO 93 : XFORC(ICOMP) = XFORC(ICOMP) + r_z*DJAC 94 : ENDDO 95 : C-- -- -- -- -- -- -- -- -- 96 : ENDDO 97 : C-- -- -- -- -- -- -- -- -- 98 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN 99 : INTERR(1) = IEL 99 : CALL ERREUR(195) 100 : GOTO 999 101 : ENDIF 102 : C - Stockage de XFORC dans le MELVAL IVAFOR 103 : MPTVAL = IVAFOR 104 : IE = 0 105 : DO IGAU = 1, NBNN 106 : DO ICOMP = 1, NFOR 107 : IE = IE + 1 108 : MELVAL = IVAL(ICOMP) 109 : IEMN = MIN(IEL,VELCHE(/2)) 110 : VELCHE(IGAU,IEMN) = XFORC(IE) 111 : ENDDO 112 : ENDDO 113 : C------------------------- 114 : ENDDO 115 : C------------------------- 116 : 117 : 999 CONTINUE 118 : SEGSUP,MWRK1 119 : SEGDES,MINTE,MELEME 120 : 121 : RETURN 122 : END 123 : 124 :
© Cast3M 2003 - All rights reserved.
Disclaimer