Télécharger renoeu.eso

Retour à la liste

Numérotation des lignes :

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

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