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.  
  38. -INC PPARAM
  39. -INC CCOPTIO
  40. -INC CCREEL
  41. -INC SMCHAML
  42. CHARACTER*8 MCHA
  43. PARAMETER(NOPT=3)
  44. CHARACTER*4 LOPT(NOPT)
  45.  
  46. INTEGER IMPR,IRET
  47. DATA LOPT/'EGIN','EGAL','EGSU'/
  48.  
  49. *
  50. * Executable statements
  51. *
  52. IMPR=0
  53. IF (IMPR.GT.2) WRITE(IOIMP,*) 'Entrée dans isoval.eso'
  54. *
  55. MCHA='MCHAML '
  56. CALL LIROBJ(MCHA,MCHELM,1,IRETOU)
  57. * 37 2
  58. * On ne trouve pas d'objet de type %m1:8
  59. IF (IRETOU.NE.1) THEN
  60. MOTERR(1:8)=MCHA
  61. CALL ERREUR(37)
  62. RETURN
  63. ENDIF
  64. *
  65. * Lecture de l'option
  66. * IOPT=-1 EGIN
  67. * IOPT=0 EGAL (par défaut)
  68. * IOPT=1 EGSU
  69. *
  70. IOPT=0
  71. CALL LIRMOT(LOPT,NOPT,IOPT,0)
  72. IF (IOPT.EQ.0) IOPT=2
  73. IOPT=IOPT-2
  74. IF (IERR.NE.0) RETURN
  75. *
  76. CALL LIRREE(XISO,1,IRETOU)
  77. * 37 2
  78. * On ne trouve pas d'objet de type %m1:8
  79. IF (IRETOU.NE.1) THEN
  80. MOTERR(1:8)='FLOTTANT'
  81. CALL ERREUR(37)
  82. RETURN
  83. ENDIF
  84. *
  85. * Recherche du maximum
  86. *
  87. IPLMOT=0
  88. IPLACE=0
  89. KPLUS=1
  90. LABSO=1
  91. CALL MAXICH(MCHELM,IPLMOT,MCHA,IPLACE,XMAX,KPLUS,LABSO)
  92. XTOL=MAX(XMAX*XZPREC,XPETIT)
  93. * Marge car sinon plantage sur semt2 sur un cas simple mis dans
  94. * isov.dgibi, suite a la fiche 8625
  95. *
  96. XTOL=XTOL*10.D0
  97.  
  98. *dbg WRITE(IOIMP,*) 'XMAX=',XMAX
  99. *dbg WRITE(IOIMP,*) 'XZPREC=',XZPREC
  100. *dbg WRITE(IOIMP,*) 'XPETIT=',XPETIT
  101. *dbg WRITE(IOIMP,*) 'XTOL=',XTOL
  102.  
  103.  
  104. *
  105. * Calcul de l'isovaleur
  106. *
  107. CALL ISOVA1(MCHELM,XISO,XTOL,IOPT,MELEME)
  108. IF (IERR.NE.0) RETURN
  109. *
  110. * On renvoie le résultat
  111. *
  112. CALL ECROBJ('MAILLAGE',MELEME)
  113. RETURN
  114. *
  115. * End of subroutine ISOVAL
  116. *
  117. END
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  

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