Télécharger isova3.eso

Retour à la liste

Numérotation des lignes :

  1. C ISOVA3 SOURCE GOUNAND 15/09/16 21:15:03 8625
  2. SUBROUTINE ISOVA3(XISO,VAL1,VAL2,NUM1,NUM2,MLENTI,NEWNOD)
  3. IMPLICIT REAL*8 (A-H,O-Z)
  4. IMPLICIT INTEGER (I-N)
  5. C***********************************************************************
  6. C NOM : ISOVA3
  7. C DESCRIPTION : Construit le noeud correspondant à l'intersection
  8. C d'une isovaleur sur un segment.
  9. C Ajoute
  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 VERSION : v1.1, 29/07/2014, modifie la pile des nouveaux noeuds
  17. C VERSION : v1, 17/12/2008, version initiale
  18. C HISTORIQUE : v1, 17/12/2008, création
  19. C HISTORIQUE :
  20. C HISTORIQUE :
  21. C***********************************************************************
  22. -INC CCOPTIO
  23. *-INC SMCOORD
  24. -INC CCREEL
  25. -INC SMLENTI
  26. *
  27. SEGMENT NEWNOD
  28. INTEGER NNOD
  29. INTEGER NOEINF(MAXNOD)
  30. INTEGER NOESUP(MAXNOD)
  31. REAL*8 COEINF(MAXNOD)
  32. ENDSEGMENT
  33. *
  34. DVAL=VAL2-VAL1
  35. XBAR=(XISO-VAL1)/DVAL
  36. XMBAR=1.D0-XBAR
  37. *dbg WRITE(IOIMP,*) ' XBAR=',XBAR,' DVAL=', DVAL
  38. * On a rajoute ce test suite a la fiche 8625
  39. * On met xzprec*10.D0 pour mimer le XTOL mis dans isoval.eso
  40. if ((xbar.lt.-xzprec*10.D0).or.(xmbar.lt.-xzprec*10.D0)) then
  41. MOTERR(1:8)='ISOVA3 '
  42. CALL ERREUR(349)
  43. RETURN
  44. endif
  45. *
  46. * On adopte une logique différente : on ajoute des noeuds
  47. * dans la pile NEWNOD au lieu d'incrémenter directement MCOORD.
  48. * En effet, on va éliminer les noeuds de NEWNOD géométriquement
  49. * confondus avant de les ajouter à MCOORD. L'intérêt est que comme les
  50. * coefficients barycentriques sont compris entre 0. et 1., il est
  51. * plus facile de trouver un critère d'élimination pertinent
  52. * (XZPREC*10.D0 doit à peu près convenir)
  53. *
  54. * Tous les noeuds créés sont des barycentres de deux noeuds existants
  55. * Par convention, on met le noeud existant de numéro le plus petit
  56. * dans NOEINF et l'autre dans NOESUP. Ceci facilitera les recherches
  57. * pour l'élimination ultérieure
  58. *
  59. * On stocke le coefficient
  60. * barycentrique de NOEINF dans COEINF. L'autre coefficient se retrouve
  61. * en faisant 1-COEINF (on perd peut-être un peu en précision ?)
  62. *
  63. NNOD=NNOD+1
  64. IF (NUM1.LE.NUM2) THEN
  65. NOEINF(NNOD)=NUM1
  66. NOESUP(NNOD)=NUM2
  67. COEINF(NNOD)=XMBAR
  68. ELSE
  69. NOEINF(NNOD)=NUM2
  70. NOESUP(NNOD)=NUM1
  71. COEINF(NNOD)=XBAR
  72. ENDIF
  73. * Par convention, un noeud de la pile NEWNOD est mis en négatif dans
  74. * LECT pour le distinguer des noeuds usuels de MCOORD
  75. LECT(**)=-NNOD
  76. * IDIM1=IDIM+1
  77. * NBPTS=XCOOR(/1)/IDIM1
  78. * NBPTS=NBPTS+1
  79. * SEGADJ,MCOORD
  80. * DO II=1,IDIM+1
  81. * XCOOR((NBPTS-1)*IDIM1+II)=
  82. * $ (XCOOR((NUM2-1)*IDIM1+II)*XBAR)+
  83. * $ (XCOOR((NUM1-1)*IDIM1+II)*XMBAR)
  84. * ENDDO
  85. * LECT(**)=NBPTS
  86. RETURN
  87. *
  88. * End of subroutine ISOVA3
  89. *
  90. END
  91.  
  92.  
  93.  
  94.  
  95.  

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