Télécharger renoeu.eso

Retour à la liste

Numérotation des lignes :

  1. C RENOEU SOURCE BP208322 16/11/18 21:20:56 9177
  2. SUBROUTINE RENOEU(IELE,MELE,NBSH,IPT,IRET)
  3. C=======================================================================
  4. C
  5. C MET LES VALEURS DES FONCTIONS DE FORMES DANS SHPTOT
  6. C ET LES COORDOONEES REDUITES LES POIDS D INTEGRATION
  7. C DANS QSIGAU ETAGAU DZEGAU POIGAU ; LE TOUT EST
  8. C MIS DANS LE POINTEUR MINTE SON POINTEUR EST IPT
  9. C IELE =NUMERO DE L ELEMENT DANS NOMS (VOIR CCGEOME )
  10. C MELE =NUMERO DE L ELEMENT DANS NOMTP
  11. C NBSH =NOMBRE DE FONCTIONS D'INTERPOLATION
  12. C IPT = POINTEUR SUR MINTE
  13. C IRET=1 OU 0 SUIVANT QUE MINTE A ETE CREEE OU PAS
  14. C
  15. C CETTE ROUTINE GERE LES MESSAGES D ERREURS
  16. C PROVENANT DE L INCOMPATIBILTE ENTRE NOMS
  17. C D ELEMENTS,NOMBRE DE POINTS DE GAUSS,ET FONCTIONS DE FORME
  18. C
  19. C=======================================================================
  20. IMPLICIT INTEGER(I-N)
  21. IMPLICIT REAL*8(A-H,O-Z)
  22. -INC CCGEOME
  23. -INC SMINTE
  24. -INC CCOPTIO
  25. SEGMENT/SHXX/(SHPXXX(6,NBB)*D)
  26. DIMENSION IMIPOR(5)
  27. C
  28. DATA IMIPOR/4,8,14,23,16/
  29. C
  30. IRET=1
  31. NBBB=NBNNE(IELE)
  32. *
  33. * CAS PARTICULIER ELEMENT TUYO
  34. *
  35. IF(MELE.EQ.96) NBBB=24
  36. *
  37. *
  38. * CAS PARTICULIER ELEMENT POLYGONE
  39. *
  40. IF(MELE.GE.111.AND.MELE.LE.122) NBBB=NBSH
  41. *
  42. NBNO=NBSH
  43. CALL DONOEU(IELE,MELE,NBSH,NBBB,IPT1,IRT1)
  44. IF (IRT1.EQ.1) GOTO 10
  45. C
  46. C MESSAGE D ERREUR ELEMENT IELE NON IMPLEMENTE DANS DONOEU
  47. C
  48. MOTERR(1:4)=NOMS(IELE)
  49. CALL ERREUR(74)
  50. IRET=0
  51. GOTO 666
  52. 10 CONTINUE
  53. MINTE=IPT1
  54. SEGACT MINTE*MOD
  55. C
  56. DO 110 IA=1,NBBB
  57. DO 110 IB=1,6
  58. DO 110 IC=1,NBNO
  59. SHPTOT(IB,IC,IA)=0.D0
  60. 110 CONTINUE
  61. NBB=NBNO
  62. SEGINI SHXX
  63. DO 100 II=1,NBBB
  64. C INSERER EVENTUELLEMENT UN INDICATEUR DE SUCCES
  65. XX=QSIGAU(II)
  66. YY=ETAGAU(II)
  67. ZZ=DZEGAU(II)
  68. IF(MELE.EQ.96) THEN
  69. CALL SHAP96(XX,YY,ZZ,IELE,SHPXXX,IRT2)
  70. ELSEIF ((MELE.GE.111).AND.(MELE.LE.122)) THEN
  71. CALL SHPOLY(XX,YY,ZZ,II,MELE,SHPXXX,IRT2)
  72. ELSEIF(mele.eq.260) then
  73. call shshb8(xx,shpxxx)
  74. irt2=1
  75. ELSE
  76. CALL SHAPE(XX,YY,ZZ,IELE,SHPXXX,IRT2)
  77. ENDIF
  78. C
  79. C TRAITEMENT SPECIAL MILIEU POREUX
  80. C
  81. IF(MELE.GE.79.AND.MELE.LE.83) THEN
  82. CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-78),
  83. . SHPXXX(1,NBBB+1),IRT2)
  84. *
  85. ELSE IF(MELE.GE.173.AND.MELE.LE.177) THEN
  86. CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-172),
  87. . SHPXXX(1,NBBB+1),IRT2)
  88. *
  89. ELSE IF(MELE.GE.178.AND.MELE.LE.182) THEN
  90. CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-177),
  91. . SHPXXX(1,NBBB+1),IRT2)
  92. *
  93. ENDIF
  94. C
  95. DO 200 ID=1,6
  96. DO 200 NO=1,NBNO
  97. SHPTOT(ID,NO,II)=SHPXXX(ID,NO)
  98. 200 CONTINUE
  99. 100 CONTINUE
  100. C
  101. C APPEL AU CALCULE DES FONCTIONS D EXTRAPOLATIONS
  102. C
  103. if(mele.ne.260) CALL EXTRAP(SHPTOT,NBBB,NBBB,NBNO)
  104. C
  105. SEGSUP SHXX
  106. IF (IRT2.EQ.1) GOTO 20
  107. C
  108. C ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES
  109. C
  110. MOTERR(1:4)=NOMS(IELE)
  111. CALL ERREUR(68)
  112. IRET=0
  113. SEGSUP MINTE
  114. GOTO 666
  115. 20 IPT=IPT1
  116. SEGDES MINTE
  117. 666 CONTINUE
  118. RETURN
  119. END
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  

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