Télécharger isoval.eso

Retour à la liste

Numérotation des lignes :

  1. C ISOVAL SOURCE GOUNAND 15/09/16 21:15:05 8625
  2. SUBROUTINE ISOVAL
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : ISOVAL
  7. C DESCRIPTION : Construit le maillage de l'isovaleur d'un champ par
  8. C éléments
  9. C
  10. C
  11. C
  12. C LANGAGE : ESOPE
  13. C AUTEUR : Stéphane GOUNAND (CEA/DEN/DM2S/SFME/LTMF)
  14. C mél : gounand@semt2.smts.cea.fr
  15. C***********************************************************************
  16. C APPELES :
  17. C APPELES (E/S) :
  18. C APPELES (BLAS) :
  19. C APPELES (CALCUL) :
  20. C APPELE PAR :
  21. C***********************************************************************
  22. C SYNTAXE GIBIANE :
  23. C ENTREES :
  24. C ENTREES/SORTIES :
  25. C SORTIES :
  26. C CODE RETOUR (IRET) : = 0 si tout s'est bien passé
  27. C***********************************************************************
  28. C VERSION : v1, 15/12/2008, version initiale
  29. C HISTORIQUE : v1, 15/12/2008, création
  30. C HISTORIQUE :
  31. C HISTORIQUE :
  32. C***********************************************************************
  33. C Prière de PRENDRE LE TEMPS de compléter les commentaires
  34. C en cas de modification de ce sous-programme afin de faciliter
  35. C la maintenance !
  36. C***********************************************************************
  37. -INC CCOPTIO
  38. -INC CCREEL
  39. -INC SMCHAML
  40. CHARACTER*8 MCHA
  41. PARAMETER(NOPT=3)
  42. CHARACTER*4 LOPT(NOPT)
  43.  
  44. INTEGER IMPR,IRET
  45. DATA LOPT/'EGIN','EGAL','EGSU'/
  46.  
  47. *
  48. * Executable statements
  49. *
  50. IMPR=0
  51. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans isoval.eso'
  52. *
  53. MCHA='MCHAML '
  54. CALL LIROBJ(MCHA,MCHELM,1,IRETOU)
  55. * 37 2
  56. * On ne trouve pas d'objet de type %m1:8
  57. IF (IRETOU.NE.1) THEN
  58. MOTERR(1:8)=MCHA
  59. CALL ERREUR(37)
  60. RETURN
  61. ENDIF
  62. *
  63. * Lecture de l'option
  64. * IOPT=-1 EGIN
  65. * IOPT=0 EGAL (par défaut)
  66. * IOPT=1 EGSU
  67. *
  68. IOPT=0
  69. CALL LIRMOT(LOPT,NOPT,IOPT,0)
  70. IF (IOPT.EQ.0) IOPT=2
  71. IOPT=IOPT-2
  72. IF (IERR.NE.0) RETURN
  73. *
  74. CALL LIRREE(XISO,1,IRETOU)
  75. * 37 2
  76. * On ne trouve pas d'objet de type %m1:8
  77. IF (IRETOU.NE.1) THEN
  78. MOTERR(1:8)='FLOTTANT'
  79. CALL ERREUR(37)
  80. RETURN
  81. ENDIF
  82. *
  83. * Recherche du maximum
  84. *
  85. IPLMOT=0
  86. IPLACE=0
  87. KPLUS=1
  88. LABSO=1
  89. CALL MAXICH(MCHELM,IPLMOT,MCHA,IPLACE,XMAX,KPLUS,LABSO)
  90. XTOL=MAX(XMAX*XZPREC,XPETIT)
  91. * Marge car sinon plantage sur semt2 sur un cas simple mis dans
  92. * isov.dgibi, suite a la fiche 8625
  93. *
  94. XTOL=XTOL*10.D0
  95.  
  96. *dbg WRITE(IOIMP,*) 'XMAX=',XMAX
  97. *dbg WRITE(IOIMP,*) 'XZPREC=',XZPREC
  98. *dbg WRITE(IOIMP,*) 'XPETIT=',XPETIT
  99. *dbg WRITE(IOIMP,*) 'XTOL=',XTOL
  100.  
  101.  
  102. *
  103. * Calcul de l'isovaleur
  104. *
  105. CALL ISOVA1(MCHELM,XISO,XTOL,IOPT,MELEME)
  106. IF (IERR.NE.0) RETURN
  107. *
  108. * On renvoie le résultat
  109. *
  110. CALL ECROBJ('MAILLAGE',MELEME)
  111. RETURN
  112. *
  113. * End of subroutine ISOVAL
  114. *
  115. END
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  

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