Télécharger surfp7.eso

Retour à la liste

Numérotation des lignes :

surfp7
  1. C SURFP7 SOURCE PV 07/11/23 21:19:40 5978
  2. SUBROUTINE SURFP7 (PT1,PT2,LIGNE1,LIGNE2,LIGNE3,LIGNE4,NOMB1,
  3. $ msurfp)
  4. ************************************************************************
  5. *
  6. * S U R F P 7
  7. * -----------
  8. *
  9. * FONCTION:
  10. * ---------
  11. *
  12. * SOUS-PROGRAMME SPECIFIQUE APPELE PAR LE SOUS-PROGRAMME "SURFP3".
  13. *
  14. * ACTION EFFECTUEE SI LE COTE FOURNI EN DONNEE EST DE LONGUEUR
  15. * NULLE.
  16. *
  17. * MODULES UTILISES:
  18. * -----------------
  19. *
  20. IMPLICIT REAL*8(A-H,O-Z)
  21. IMPLICIT INTEGER(I-N)
  22. -INC SMELEME
  23. -INC TMSURFP
  24. *
  25. * PARAMETRES: (E)=ENTREE (S)=SORTIE (+ = CONTENU DANS UN COMMUN)
  26. * -----------
  27. *
  28. * PT1 (E) PREMIER POINT DU COTE (I).
  29. * PT2 (E) DERNIER POINT DU COTE (I).
  30. * (S) EVENTUELLEMENT MODIFIE EN SORTIE.
  31. * LIGNE1 (E) POINTEUR DU MAILLAGE DU COTE (I).
  32. * SEGMENT SUPPOSE ACTIF.
  33. * LIGNE2 (E) POINTEUR DU MAILLAGE DU COTE (I+1).
  34. * SEGMENT SUPPOSE ACTIF.
  35. * LIGNE3 (E) POINTEUR DU MAILLAGE DU COTE (I+2).
  36. * SEGMENT SUPPOSE ACTIF.
  37. * LIGNE4 (E) POINTEUR DU MAILLAGE DU COTE (I+3).
  38. * SEGMENT SUPPOSE ACTIF.
  39. * +MSURFP (E) POINTEUR DE LA SURFACE PARAMETREE.
  40. * SEGMENT SUPPOSE ACTIF.
  41. * (S) MODIFICATIONS EVENTUELLES DE "USUR" ET "VSUR".
  42. * NOMB1 (S) NOMBRE D'ELEMENTS QUI ONT ETE RETENUS POUR LE COTE.
  43. * (= NOMBRE INITIAL OU BIEN "0")
  44. *
  45. INTEGER PT1,PT2,LIGNE1,LIGNE2,LIGNE3,LIGNE4,NOMB1
  46. *
  47. *>>>>> P.M. 21/09/90
  48. * VARIABLES:
  49. * ----------
  50. *
  51. REAL*8 EPS1
  52. *
  53. *<<<<<
  54. * FONCTIONS:
  55. * ----------
  56. *
  57. LOGICAL EGA1
  58. *
  59. * REMARQUES:
  60. * ----------
  61. *
  62. * LA METHODE DE FUSION DE 2 SOMMETS TRES PROCHES QUI A ETE CHOISIE
  63. * PRESENTE POUR SEUL INCONVENIENT DE LAISSER TRAINER UN POINT
  64. * INUTILE.
  65. * EN CONTRE-PARTIE, ELLE CONSERVE LA CORRESPONDANCE ENTRE LES
  66. * NUMEROS DES POINTS ET LES TABLEAUX "USUR" ET "VSUR" DE LA SURFACE
  67. * PARAMETREE, MEME SI LES POINTS-SOMMETS ONT ETE FOURNIS EN DONNEE
  68. * ET NON PAS CALCULES (CE QUI SERA PEUT-ETRE AUTORISE UN JOUR).
  69. * LES METHODES PAR APPEL A "CONFON", APPEL A "TASSP2" OU REMODELAGE
  70. * DIRECT DE "XCOOR" N'ASSURENT PAS LA CONSERVATION DE CETTE
  71. * CORRESPONDANCE.
  72. *
  73. * AUTEUR, DATE DE CREATION:
  74. * -------------------------
  75. *
  76. * PASCAL MANIGOT 03 MARS 1987
  77. *
  78. * LANGAGE:
  79. * --------
  80. *
  81. * ESOPE77 FORTRAN77
  82. *
  83. ************************************************************************
  84. *
  85. IPT1 = LIGNE1
  86. IPT2 = LIGNE2
  87. IPT3 = LIGNE3
  88. IPT4 = LIGNE4
  89. *
  90. NOMB1 = IPT1.NUM(/2)
  91. NBNN = IPT1.NUM(/1)
  92. *
  93. IF (NOMB1 .LE. 1) THEN
  94. * CE COTE NE SERAIT-IL PAS DE LONGUEUR NULLE ?
  95. EPS1 = -1.
  96. IF (EGA1(PT1,PT2,EPS1)) THEN
  97. *
  98. * ON CONFOND LES POINTS ET ON SUPPRIME LE COTE CORRESPONDANT:
  99. MUVSUR = IUVSUR
  100. SEGACT,MUVSUR
  101. N0 = NU0SUR
  102. USUR(PT1-N0) = (USUR(PT1-N0) + USUR(PT2-N0)) / 2.D0
  103. VSUR(PT1-N0) = (VSUR(PT1-N0) + VSUR(PT2-N0)) / 2.D0
  104. USUR(PT2-N0) = 0.D0
  105. VSUR(PT2-N0) = 0.D0
  106. SEGDES,MUVSUR
  107. * LA MANIP. CI-DESSUS N'EST PAS BONNE SI L'ON TOMBE SUR UNE
  108. * SURFACE A 2 COTES ADJACENTS DEGENERES: LE POINT FINAL NE
  109. * SERA PAS, DANS LE REPERE DES COORDONNEES INTRINSEQUES,
  110. * L'ISOBARYCENTRE DES 3 POINTS CONFONDUS. MAIS, DE TOUTES
  111. * FACONS, C'EST UN CAS TRES TORDU.
  112. IF (IPT2.NUM(1,1) .EQ. PT2) IPT2.NUM(1,1) = PT1
  113. NOMB2 = IPT2.NUM(/2)
  114. IF (IPT2.NUM(NBNN,NOMB2) .EQ. PT2)
  115. & IPT2.NUM(NBNN,NOMB2) = PT1
  116. IF (IPT3.NUM(1,1) .EQ. PT2) IPT3.NUM(1,1) = PT1
  117. NOMB3 = IPT3.NUM(/2)
  118. IF (IPT3.NUM(NBNN,NOMB3) .EQ. PT2)
  119. & IPT3.NUM(NBNN,NOMB3) = PT1
  120. IF (IPT4.NUM(1,1) .EQ. PT2) IPT4.NUM(1,1) = PT1
  121. NOMB4 = IPT4.NUM(/2)
  122. IF (IPT4.NUM(NBNN,NOMB4) .EQ. PT2)
  123. & IPT4.NUM(NBNN,NOMB4) = PT1
  124. *
  125. PT2 = PT1
  126. NOMB1 = 0
  127. *
  128. END IF
  129. END IF
  130. *
  131. END
  132.  
  133.  
  134.  
  135.  
  136.  

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