Télécharger lekmif.eso

Retour à la liste

Numérotation des lignes :

  1. C LEKMIF SOURCE BP208322 16/11/18 21:18:41 9177
  2. SUBROUTINE LEKMIF(NUCOEF,MTABD,IHV,MCHELM,KPOIND)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. C***********************************************************************
  6. C
  7. C Ce sous programme lit un coefficient dans la pile des objets GIBIANE
  8. C Le coefficient attendu peut etre de type ENTIER, FLOTTANT, POINT, ou
  9. C CHPOINT.
  10. C Ce SP rend un MCHAML quoi qu'il arrive
  11. C Le MCHAML en retour est jetable et est calcule aux pts d'integrations
  12. C----------------------------------------------------------------------
  13. C HISTORIQUE : 20/10/01 : Création
  14. C
  15. C HISTORIQUE :
  16. C
  17. C---------------------------
  18. C Paramètres Entrée/Sortie :
  19. C---------------------------
  20. C
  21. C E/ NUCOEF : Rang du coefficient à aller chercher (ENTIER)
  22. C E/ MTABD : Objet model de la zone
  23. C E/ IHV=0 CHPOINT SCALAIRE ou FLOTTANT
  24. C IHV=1 CHPOINT VECTEUR ou POINT
  25. C /S MCHELM : Chamelem pts d'intégration pour le COEF
  26. C E/ KPOIND : ENTIER type du support GÉométrique DUAL du shéma
  27. C d'intégration => pour la création du Chamelem
  28. C----------------------------------------------------------------------
  29. C KPOIN = 0->SOMMET 1-> FACE 2-> CENTRE 3-> CENTREP0 4-> CENTREP1 5-> MSOMMET
  30. C----------------------------------------------------------------------
  31. C************************************************************************
  32.  
  33. -INC SMCHAML
  34. -INC SMCHPOI
  35. -INC SMELEME
  36. -INC SMCOORD
  37. -INC CCOPTIO
  38. -INC CCGEOME
  39. CHARACTER*8 TYPE,TYPM
  40. DIMENSION XPOI(3)
  41. C*****************************************************************************
  42. CLEKMIF
  43. C write(6,*)' DEBUT LEKMIF NUCOEF=',NUCOEF,
  44. C &'MTABD=',MTABD
  45. XPETI=1.D-30
  46. IAXI=0
  47. IF(IFOMOD.EQ.0)IAXI=2
  48. TYPE=' '
  49. CALL QUETYP(TYPE,0,IRET)
  50. IF(IRET.EQ.0)THEN
  51. C Tache impossible. Probablement données erronées
  52. C CALL ERREUR(26)
  53. C Il manque la donnee du CHPOINT , MCHAML ou de la TABLE.
  54. C CALL ERREUR(686)
  55. C Il manque une donnée
  56. CALL ERREUR(641)
  57. RETURN
  58. ENDIF
  59. C write(6,*)' LEKMIF TYPE=',TYPE,ihv
  60.  
  61. IF(TYPE.NE.'FLOTTANT'.AND.TYPE.NE.'ENTIER'.AND.
  62. & TYPE.NE.'CHPOINT '.AND.IHV.EQ.0)THEN
  63. C On ne veut pas d'objet de type %m1:8
  64. MOTERR(1: 8) = TYPE
  65. CALL ERREUR(39)
  66. RETURN
  67. ENDIF
  68.  
  69. IF(TYPE.NE.'POINT'.AND.
  70. & TYPE.NE.'CHPOINT '.AND.IHV.EQ.1)THEN
  71. C On ne veut pas d'objet de type %m1:8
  72. MOTERR(1: 8) = TYPE
  73. CALL ERREUR(39)
  74. RETURN
  75. ENDIF
  76.  
  77. C-------------------------------------------------------------------------
  78. C__FLOTTANT
  79. IF(TYPE.EQ.'FLOTTANT'.OR.TYPE.EQ.'ENTIER'.OR.
  80. & TYPE.EQ.'POINT' )THEN
  81.  
  82. IF(TYPE.EQ.'FLOTTANT')THEN
  83. CALL LIRREE(COEF,0,IRET)
  84. ELSEIF(TYPE.EQ.'ENTIER')THEN
  85. CALL LIRENT(IVAL,0,IRET)
  86. COEF=FLOAT(IVAL)
  87. ELSEIF(TYPE.EQ.'POINT')THEN
  88. CALL LIROBJ(TYPE,IP,0,IRET)
  89. XPOI(1) = XCOOR((IP-1)*(IDIM+1) +1)
  90. XPOI(2) = XCOOR((IP-1)*(IDIM+1) +2)
  91. IF (IDIM.EQ.3) XPOI(3) = XCOOR((IP-1)*(IDIM+1) +3)
  92. ENDIF
  93.  
  94. C__CHPOINT
  95. ELSEIF(TYPE.EQ.'CHPOINT')THEN
  96. CALL LIROBJ(TYPE,MCHPOI,0,IRET)
  97. SEGACT MCHPOI
  98. ENDIF
  99.  
  100. IMDL=0
  101. CALL MELMOF(IMDL,MTABD,IHV,TYPE,COEF,XPOI,MCHPOI,MCHELM,KPOIND,
  102. & 0,MCHELG)
  103.  
  104.  
  105. C write(6,*)' FIN LEKMIF '
  106. RETURN
  107. 1001 FORMAT(20(1X,I5))
  108. 1002 FORMAT(10(1X,1PE11.4))
  109. END
  110.  
  111.  
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  

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