Télécharger cneqel.eso

Retour à la liste

Numérotation des lignes :

  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
  58. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IEL,XEL)
  59.  
  60. C MISE A ZERO DES FORCES NODALES
  61. DO j = 1, NBNN
  62. XFORC(j) = XZERO
  63. ENDDO
  64. C
  65. C ON RECUPERE LES FORCES VOLUMIQUES
  66. C
  67. MPTVAL = IVAFVO
  68. IF (IVAL(1).NE.0) THEN
  69. MELVAL = IVAL(1)
  70. IEMN = MIN(IEL ,VELCHE(/2))
  71.  
  72. C BOUCLE SUR LES POINTS DE GAUSS
  73. ISDJC=0
  74. DO 5004 IGAU=1,NBPGAU
  75.  
  76. CALL NELEC (NBNN,XEL,SHPTOT(1,1,IGAU), SHPWRK,XFORM,DJAC)
  77. IF (DJAC.EQ.XZERO) THEN
  78. INTERR(1) = IEL
  79. CALL ERREUR(259)
  80. GOTO 999
  81. ENDIF
  82. IF (DJAC.LT.XZERO) ISDJC=ISDJC+1
  83. DJAC = ABS(DJAC)*POIGAU(IGAU)
  84. *
  85. * CALCUL DES FORCES NODALES EQUIVALENTES
  86. *
  87. IGMN = MIN(IGAU,VELCHE(/1))
  88. FOVOL(1) = VELCHE(IGMN,IEMN)
  89. r_z = FOVOL(1)*DJAC
  90. DO j = 1, NBNN
  91. XFORC(j) = XFORC(j) + XFORM(j)*r_z
  92. ENDDO
  93. *
  94. 5004 CONTINUE
  95. *
  96. IF (ISDJC.NE.0.AND.ISDJC.NE.NBPGAU) THEN
  97. INTERR(1) = IEL
  98. CALL ERREUR(195)
  99. GOTO 999
  100. ENDIF
  101. C
  102. ENDIF
  103. C
  104. C ON RANGE XFORC DANS IVAFOR
  105. C
  106. MPTVAL=IVAFOR
  107. MELVAL=IVAL(1)
  108. DO j = 1, NBNN
  109. VELCHE(j,IEL) = XFORC(j)
  110. ENDDO
  111. 3004 CONTINUE
  112.  
  113. 999 CONTINUE
  114. SEGSUP,MWKELT
  115.  
  116. RETURN
  117. END
  118.  
  119.  
  120.  

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