Télécharger la plaquette Cast3M


fr en

Télécharger isoval.eso

Retour à la liste

Numérotation des lignes : 

isoval

  1. C ISOVAL    SOURCE    CB215821  23/11/02    21:15:06     11779          
  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.       CALL ACTOBJ(MCHA,MCHELM,1)
  58. *  37 2
  59. * On ne trouve pas d'objet de type %m1:8
  60.       IF (IRETOU.NE.1) THEN
  61.          MOTERR(1:8)=MCHA
  62.          CALL ERREUR(37)
  63.          RETURN
  64.       ENDIF
  65. *
  66. * Lecture de l'option
  67. * IOPT=-1 EGIN
  68. * IOPT=0  EGAL (par défaut)
  69. * IOPT=1  EGSU
  70. *
  71.       IOPT=0
  72.       CALL LIRMOT(LOPT,NOPT,IOPT,0)
  73.       IF (IOPT.EQ.0) IOPT=2
  74.       IOPT=IOPT-2
  75.       IF (IERR.NE.0) RETURN
  76. *
  77.       CALL LIRREE(XISO,1,IRETOU)
  78. *  37 2
  79. * On ne trouve pas d'objet de type %m1:8
  80.       IF (IRETOU.NE.1) THEN
  81.          MOTERR(1:8)='FLOTTANT'
  82.          CALL ERREUR(37)
  83.          RETURN
  84.       ENDIF
  85. *
  86. * Recherche du maximum
  87. *
  88.       IPLMOT=0
  89.       IPLACE=0
  90.       KPLUS=1
  91.       LABSO=1
  92.       CALL MAXICH(MCHELM,IPLMOT,MCHA,IPLACE,XMAX,KPLUS,LABSO)
  93.       XTOL=MAX(XMAX*XZPREC,XPETIT)
  94. * Marge car sinon plantage sur semt2 sur un cas simple mis dans
  95. * isov.dgibi, suite a la fiche 8625
  96. *
  97.       XTOL=XTOL*10.D0
  98.  
  99. *dbg      WRITE(IOIMP,*) 'XMAX=',XMAX
  100. *dbg      WRITE(IOIMP,*) 'XZPREC=',XZPREC
  101. *dbg      WRITE(IOIMP,*) 'XPETIT=',XPETIT
  102. *dbg      WRITE(IOIMP,*) 'XTOL=',XTOL
  103.  
  104.  
  105. *
  106. * Calcul de l'isovaleur
  107. *
  108.       CALL ISOVA1(MCHELM,XISO,XTOL,IOPT,MELEME)
  109.       IF (IERR.NE.0) RETURN
  110. *
  111. * On renvoie le résultat
  112. *
  113.       CALL ACTOBJ('MAILLAGE',MELEME,1)
  114.       CALL ECROBJ('MAILLAGE',MELEME)
  115.       RETURN
  116. *
  117. * End of subroutine ISOVAL
  118. *
  119.       END
  120.  
  121.  

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