1 : C CNEQEL SOURCE FANDEUR 10/12/17 21:16:08 6427
2 :
3 : SUBROUTINE CNEQEL (IPMAIL,IVAFVO,IPMINT,NBPGAU,IVAFOR,NCOMP)
4 :
5 : *----------------------------------------------------------------------*
6 : * CALCUL DES FLUX EXLECTRIQUES ("FORCES") NODAUX EQUIVALENTS *
7 : *----------------------------------------------------------------------*
8 : * ENTREES : *
9 : * ________ *
10 : * IPMAIL Pointeur sur un segment MELEME *
11 : * NBPGAU Nombre de points d'integration pour les contraintes *
12 : * IVAFVO pointeur sur un segment MPTVAL contenant les *
13 : * les melvals de FORCES VOLUMIQUES *
14 : * IPMINT Pointeur sur un segment MINTE *
15 : * IVACAR Pointeur sur un melval de caractéristiques *
16 : * NCOMP Nombre de composantes de forces *
17 : * *
18 : * SORTIES : *
19 : * ________ *
20 : * *
21 : * IVAFOR pointeur sur un segment MPTVAL contenant les *
22 : * les melvals de forces NODALES *
23 : *----------------------------------------------------------------------*
24 :
25 : IMPLICIT INTEGER(I-N)
26 : IMPLICIT REAL*8(A-H,O-Z)
27 :
28 : -INC CCOPTIO
29 : -INC CCREEL
30 :
31 : -INC SMCHAML
32 : -INC SMELEME
33 : -INC SMCOORD
34 : -INC SMINTE
35 :
36 : SEGMENT MWKELT
37 : REAL*8 XFORC(NBNN),FOVOL(NCOMP),XEL(3,NBNN)
38 : REAL*8 SHPWRK(6,NBNN),XFORM(NBNN)
39 : ENDSEGMENT
40 :
41 : SEGMENT MPTVAL
42 : INTEGER IPOS(NS) , NSOF(NS)
43 : INTEGER IVAL(NCOSOU)
44 : CHARACTER*16 TYVAL(NCOSOU)
45 : ENDSEGMENT
46 :
47 : MELEME=IPMAIL
48 : NBNN =NUM(/1)
49 : NBELEM=NUM(/2)
50 :
51 : MINTE=IPMINT
52 :
53 : SEGINI,MWKELT
54 :
55 : DO 3004 IEL = 1, NBELEM
56 :
57 : C ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IEL
57 : CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
58 :
59 : C MISE A ZERO DES FORCES NODALES
60 : DO j = 1, NBNN
61 : XFORC(j) = XZERO
62 : ENDDO
63 : C
64 : C ON RECUPERE LES FORCES VOLUMIQUES
65 : C
66 : MPTVAL = IVAFVO
67 : IF (IVAL(1).NE.0) THEN
68 : MELVAL = IVAL(1)
69 : IEMN = MIN(IEL ,VELCHE(/2))
70 :
71 : C BOUCLE SUR LES POINTS DE GAUSS
72 : ISDJC=0
73 : DO 5004 IGAU=1,NBPGAU
74 :
74 : CALL NELEC (NBNN,XEL,SHPTOT(1,1,IGAU), SHPWRK,XFORM,DJAC)
75 : IF (DJAC.EQ.XZERO) THEN
76 : INTERR(1) = IEL
76 : CALL ERREUR(259)
77 : GOTO 999
78 : ENDIF
79 : IF (DJAC.LT.XZERO) ISDJC=ISDJC+1
80 : DJAC = ABS(DJAC)*POIGAU(IGAU)
81 : *
82 : * CALCUL DES FORCES NODALES EQUIVALENTES
83 : *
84 : IGMN = MIN(IGAU,VELCHE(/1))
85 : FOVOL(1) = VELCHE(IGMN,IEMN)
86 : r_z = FOVOL(1)*DJAC
87 : DO j = 1, NBNN
88 : XFORC(j) = XFORC(j) + XFORM(j)*r_z
89 : ENDDO
90 : *
91 : 5004 CONTINUE
92 : *
93 : IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
94 : INTERR(1) = IEL
94 : CALL ERREUR(195)
95 : GOTO 999
96 : ENDIF
97 : C
98 : ENDIF
99 : C
100 : C ON RANGE XFORC DANS IVAFOR
101 : C
102 : MPTVAL=IVAFOR
103 : MELVAL=IVAL(1)
104 : DO j = 1, NBNN
105 : VELCHE(j,IEL) = XFORC(j)
106 : ENDDO
107 : 3004 CONTINUE
108 :
109 : 999 CONTINUE
110 : SEGSUP,MWKELT
111 :
112 : RETURN
113 : END
114 :
115 :
© Cast3M 2003 - All rights reserved.
Disclaimer