Télécharger la plaquette Cast3M


fr en

Télécharger cneqel.eso

Retour à la liste

Numérotation des lignes : 

cneqel

  1. C CNEQEL    SOURCE    OF166741  25/02/21    21:15:34     12166          
  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.  
  29. -INC PPARAM
  30. -INC CCOPTIO
  31. -INC CCREEL
  32.  
  33. -INC SMCHAML
  34. -INC SMELEME
  35. -INC SMCOORD
  36. -INC SMINTE
  37.  
  38. -INC TMPTVAL
  39.  
  40.       SEGMENT MWKELT
  41.         REAL*8 XFORC(NBNN),FOVOL(NCOMP),XEL(3,NBNN)
  42.         REAL*8 SHPWRK(6,NBNN),XFORM(NBNN)
  43.       ENDSEGMENT
  44.  
  45.       MELEME=IPMAIL
  46.       NBNN  =NUM(/1)
  47.       NBELEM=NUM(/2)
  48.  
  49.       MINTE=IPMINT
  50.  
  51.       SEGINI,MWKELT
  52.  
  53.       DO 3004 IEL = 1, NBELEM
  54.  
  55. C     ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IEL
  56.         CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  57.  
  58. C     MISE A ZERO DES FORCES NODALES
  59.         DO j = 1, NBNN
  60.           XFORC(j) = XZERO
  61.         ENDDO
  62. C
  63. C     ON RECUPERE LES FORCES VOLUMIQUES
  64. C
  65.         MPTVAL = IVAFVO
  66.         MELVAL = IVAL(1)
  67.         IF (MELVAL.NE.0) THEN
  68.           IEMN = MIN(IEL ,VELCHE(/2))
  69.  
  70. C     BOUCLE SUR LES POINTS DE GAUSS
  71.           ISDJC=0
  72.           DO 5004 IGAU=1,NBPGAU
  73.  
  74.             CALL NELEC (NBNN,XEL,SHPTOT(1,1,IGAU), SHPWRK,XFORM,DJAC)
  75.             IF (DJAC.EQ.XZERO) THEN
  76.               INTERR(1) = IEL
  77.               CALL ERREUR(259)
  78.               GOTO 999
  79.             ENDIF
  80.             IF (DJAC.LT.XZERO) ISDJC=ISDJC+1
  81.             DJAC = ABS(DJAC)*POIGAU(IGAU)
  82. *
  83. *     CALCUL DES FORCES NODALES EQUIVALENTES
  84. *
  85.             IGMN = MIN(IGAU,VELCHE(/1))
  86.             FOVOL(1) = VELCHE(IGMN,IEMN)
  87.             r_z = FOVOL(1)*DJAC
  88.             DO j = 1, NBNN
  89.               XFORC(j) = XFORC(j) + XFORM(j)*r_z
  90.             ENDDO
  91. *
  92.  5004     CONTINUE
  93. *
  94.           IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  95.             INTERR(1) = IEL
  96.             CALL ERREUR(195)
  97.             GOTO 999
  98.           ENDIF
  99. C
  100.         ENDIF
  101. C
  102. C     ON RANGE XFORC DANS IVAFOR
  103. C
  104.         MPTVAL=IVAFOR
  105.         MELVAL=IVAL(1)
  106.         DO j = 1, NBNN
  107.           VELCHE(j,IEL) = XFORC(j)
  108.         ENDDO
  109.  3004 CONTINUE
  110.  
  111.  999  CONTINUE
  112.       SEGSUP,MWKELT
  113.  
  114.       RETURN
  115.       END
  116.  
  117.  
  118.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales