Télécharger renoeu.eso

Retour à la liste

Numérotation des lignes :

  1. C RENOEU SOURCE CB215821 19/08/20 21:21:37 10287
  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.  
  25. -INC PPARAM
  26. -INC CCOPTIO
  27. SEGMENT/SHXX/(SHPXXX(6,NBB)*D)
  28. DIMENSION IMIPOR(5)
  29. C
  30. DATA IMIPOR/4,8,14,23,16/
  31. C
  32. IRET=1
  33. NBBB=NBNNE(IELE)
  34. *
  35. * CAS PARTICULIER ELEMENT TUYO
  36. *
  37. IF(MELE.EQ.96) NBBB=24
  38. *
  39. *
  40. * CAS PARTICULIER ELEMENT POLYGONE
  41. *
  42. IF(MELE.GE.111.AND.MELE.LE.122) NBBB=NBSH
  43. *
  44. NBNO=NBSH
  45. CALL DONOEU(IELE,MELE,NBSH,NBBB,IPT1,IRT1)
  46. IF (IRT1.EQ.1) GOTO 10
  47. C
  48. C MESSAGE D ERREUR ELEMENT IELE NON IMPLEMENTE DANS DONOEU
  49. C
  50. MOTERR(1:4)=NOMS(IELE)
  51. CALL ERREUR(74)
  52. IRET=0
  53. GOTO 666
  54. 10 CONTINUE
  55. MINTE=IPT1
  56. SEGACT MINTE*MOD
  57. C
  58. DO 110 IA=1,NBBB
  59. DO 110 IB=1,6
  60. DO 110 IC=1,NBNO
  61. SHPTOT(IB,IC,IA)=0.D0
  62. 110 CONTINUE
  63. NBB=NBNO
  64. SEGINI SHXX
  65. DO 100 II=1,NBBB
  66. C INSERER EVENTUELLEMENT UN INDICATEUR DE SUCCES
  67. XX=QSIGAU(II)
  68. YY=ETAGAU(II)
  69. ZZ=DZEGAU(II)
  70. IF(MELE.EQ.96) THEN
  71. CALL SHAP96(XX,YY,ZZ,IELE,SHPXXX,IRT2)
  72. ELSEIF ((MELE.GE.111).AND.(MELE.LE.122)) THEN
  73. CALL SHPOLY(XX,YY,ZZ,II,MELE,SHPXXX,IRT2)
  74. ELSEIF(mele.eq.260) then
  75. call shshb8(xx,shpxxx)
  76. irt2=1
  77. ELSE
  78. CALL SHAPE(XX,YY,ZZ,IELE,SHPXXX,IRT2)
  79. ENDIF
  80. C
  81. C TRAITEMENT SPECIAL MILIEU POREUX
  82. C
  83. IF(MELE.GE.79.AND.MELE.LE.83) THEN
  84. CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-78),
  85. . SHPXXX(1,NBBB+1),IRT2)
  86. *
  87. ELSE IF(MELE.GE.173.AND.MELE.LE.177) THEN
  88. CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-172),
  89. . SHPXXX(1,NBBB+1),IRT2)
  90. *
  91. ELSE IF(MELE.GE.178.AND.MELE.LE.182) THEN
  92. CALL SHAPE(XX,YY,ZZ,IMIPOR(MELE-177),
  93. . SHPXXX(1,NBBB+1),IRT2)
  94. *
  95. ENDIF
  96. C
  97. DO 200 ID=1,6
  98. DO 200 NO=1,NBNO
  99. SHPTOT(ID,NO,II)=SHPXXX(ID,NO)
  100. 200 CONTINUE
  101. 100 CONTINUE
  102. C
  103. C APPEL AU CALCULE DES FONCTIONS D EXTRAPOLATIONS
  104. C
  105. if(mele.ne.260) CALL EXTRAP(SHPTOT,NBBB,NBBB,NBNO)
  106. C
  107. SEGSUP SHXX
  108. IF (IRT2.EQ.1) GOTO 20
  109. C
  110. C ERREUR LES FONCTIONS DE FORME PAS ENCORE IMPLEMENTEES
  111. C
  112. MOTERR(1:4)=NOMS(IELE)
  113. CALL ERREUR(68)
  114. IRET=0
  115. SEGSUP MINTE
  116. GOTO 666
  117. 20 IPT=IPT1
  118. 666 CONTINUE
  119. END
  120.  
  121.  
  122.  

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