C BSIGDI SOURCE OF166741 23/06/30 21:15:03 11695 SUBROUTINE BSIGDI (IPMAIL,IPMINT,NBPGAU,IVASTR,NSTRS,LRE,LDIFF, & IVAFOR,NFOR) *----------------------------------------------------------------------* * CALCUL DES FLUX DE DIFFUSION NODAUX EQUIVALENTS * * Formulation 'DIFFUSION' (MFR=73) - Elements MASSIFs * *----------------------------------------------------------------------* * IPMAIL (E) Pointeur sur un segment MELEME (ACTIF) * * IPMINT (E) Pointeur sur un segment MINTE (ACTIF) * * NBPGAU (E) Nombre de points d'integration pour les "contraintes" * * IVASTR (E) pointeur sur un segment MPTVAL contenant les * * melvals de contraintes * * NSTRS (E) Nombre de composantes de "contraintes/deformations" * * LRE (E) Nombre de DDL dans la matrice de "rigidite" * * LDIFF (E) Nombre de composantes de "deformations" = NSTRS * * IVAFOR (E) pointeur sur un segment MPTVAL contenant les * * melvals de forces * * NFOR (E) Nombre de composantes de "flux" LRE = NBNN * NFOR * *----------------------------------------------------------------------* IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL -INC SMCHAML -INC SMELEME -INC SMCOORD -INC SMINTE SEGMENT MWRK1 REAL*8 XFORC(LRE), XFLUD(NSTRS), XEL(3,NBNN) REAL*8 SHP(6,NBNN), BGRDIF(LDIFF,LRE) ENDSEGMENT SEGMENT MPTVAL INTEGER IPOS(NS) ,NSOF(NS) INTEGER IVAL(NCOSOU) CHARACTER*16 TYVAL(NCOSOU) ENDSEGMENT MELEME = IPMAIL NBNN = meleme.NUM(/1) NBELEM = meleme.NUM(/2) MINTE = IPMINT ** NBPGAU = minte.POIGAU(/1) SEGINI,MWRK1 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 - Initialisation des flux nodaux equivalents DO ICOMP = 1, LRE XFORC(ICOMP) = XZero ENDDO C MPTVAL = IVASTR C-- -- -- -- -- -- -- -- -- C - Boucle sur les points de Gauss C-- -- -- -- -- -- -- -- -- ISDJC = 0 DO IGAU = 1, NBPGAU C -- Calcul de la matrice Bdif et du jacobien au point de Gauss IGAU CALL BDIFF(XEL,SHPTOT(1,1,IGAU),NBNN,LDIFF,1, & SHP,BGRDIF,DJAC) IF (DJAC.EQ.XZero) THEN INTERR(1) = IEL CALL ERREUR(259) GOTO 999 ENDIF IF (DJAC.LT.XZero) ISDJC = ISDJC+1 DJAC = ABS(DJAC)*POIGAU(IGAU) C -- Recuperation des flux au point d'integration (IGAU) DO ICOMP = 1, NSTRS MELVAL = IVAL(ICOMP) IGMN = MIN(IGAU,VELCHE(/1)) IEMN = MIN(IEL ,VELCHE(/2)) XFLUD(ICOMP) = VELCHE(IGMN,IEMN) ENDDO C -- Calcul du terme Bdif * Flux et de la contribution du point IGAU DO ICOMP = 1, LRE r_z = XZero DO JCOMP = 1, NSTRS r_z = r_z + BGRDIF(JCOMP,ICOMP) * XFLUD(JCOMP) ENDDO XFORC(ICOMP) = XFORC(ICOMP) + r_z*DJAC ENDDO C-- -- -- -- -- -- -- -- -- ENDDO C-- -- -- -- -- -- -- -- -- IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN INTERR(1) = IEL CALL ERREUR(195) GOTO 999 ENDIF C - Stockage de XFORC dans le MELVAL IVAFOR MPTVAL = IVAFOR IE = 0 DO IGAU = 1, NBNN DO ICOMP = 1, NFOR IE = IE + 1 MELVAL = IVAL(ICOMP) IEMN = MIN(IEL,VELCHE(/2)) VELCHE(IGAU,IEMN) = XFORC(IE) ENDDO ENDDO C------------------------- ENDDO C------------------------- 999 CONTINUE SEGSUP,MWRK1 RETURN END