Télécharger repsub.eso

Retour à la liste

Numérotation des lignes :

  1. C REPSUB SOURCE JC220346 16/11/29 21:15:33 9221
  2. C---------------------------------------------------------------------|
  3. C |
  4. SUBROUTINE REPSUB(JF)
  5. C |
  6. C CETTE SUBROUTINE ENLEVE LA FACETTE JF DU MAILLAGE DE |
  7. C SURFACE (TABLEAU NPF) SI ELLE Y APPARTIENT ET L'Y AJOUTE |
  8. C DANS LE CAS CONTRAIRE |
  9. C ELLE MET EGALEMENT A JOUR LE TABLEAU IFUT DES FACETTES UTILES |
  10. C |
  11. C---------------------------------------------------------------------|
  12. C
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15. -INC TDEMAIT
  16.  
  17. -INC PPARAM
  18. -INC CCOPTIO
  19. C
  20. I=IFAT(JF)
  21. IF (I.EQ.0) GOTO 190
  22. 20 IFUT(I)=IFUT(NFACET)
  23. IFAT(IFUT(I))=I
  24. IFAT(JF)=0
  25. NFACET=NFACET-1
  26. C
  27. DO 30 I=1,4
  28. JP=NFC(I,JF)
  29. IF (JP.EQ.0) GOTO 30
  30. DO 40 J=1,40
  31. IF (NPF(J,JP).EQ.JF) GOTO 50
  32. 40 CONTINUE
  33. IF (IVERB.EQ.1) write (6,*) ' REPSUB ',' incoherente ',jf
  34. k=100000000
  35. nfc(1,k)=1
  36. 50 DO 60 K=J,39
  37. NPF(K,JP)=NPF(K+1,JP)
  38. 60 CONTINUE
  39. NPF(40,JP)=0
  40. 30 CONTINUE
  41. C
  42. * WRITE(6,1000)JF,NFACET
  43. 1000 FORMAT(' SUBF:',I3,' NFACET=',I2)
  44. C
  45. RETURN
  46. C FIN DE LA PARTIE SUPPRESSION DE FACETTE
  47. 190 CONTINUE
  48. C LA FACETTE N'ETAIT PAS LA ON LA REPERTORIE
  49. C
  50. NFTOT=IFUT(/1)
  51. NFACET=NFACET+1
  52. IF (JF.GE.NFTOT.AND.IVERB.EQ.1)
  53. # WRITE (6,*) ' REP NOMBRE MAXI DE ',
  54. # 'FACETTES ATTEINT => JF,NFTOT ',JF,NFTOT
  55. C
  56. C
  57. DO 200 I=1,4
  58. IP=NFC(I,JF)
  59. IF (IP.EQ.0) GOTO 200
  60. DO 210 J=1,40
  61. if (NPF(J,IP).eq.jf) then
  62. IF (IVERB.EQ.1) THEN
  63. write (6,*) ' REPSUB ',' incoherent-2 ',jf
  64. write (6,*) ' liste des facettes restantes '
  65. ENDIF
  66. DO 444 k=1,NFCMAX
  67. IF (IFAT(k).EQ.1) GOTO 444
  68. IF (IVERB.EQ.1)
  69. & WRITE (6,*) k,NFC(1,k),NFC(2,k),NFC(3,k),NFC(4,k)
  70. 444 CONTINUE
  71. IF (IVERB.EQ.1) write (6,*) ' liste de NPF '
  72. DO 445 k=1,Nptmax
  73. IF (IVERB.EQ.1) WRITE (6,*) k,(npf(l,k),l=1,40)
  74. 445 CONTINUE
  75. IF (IVERB.EQ.1) write (6,*) ' liste de ifat et ifut'
  76. DO 446 k=1,ifat(/1)
  77. IF (IVERB.EQ.1) WRITE (6,*) k,ifat(k),ifut(k)
  78. 446 CONTINUE
  79. k=100000000
  80. nfc(1,k)=1
  81. endif
  82. IF (NPF(J,IP).NE.0) GOTO 210
  83. NPF(J,IP)=JF
  84. GOTO 200
  85. 210 CONTINUE
  86. IF (IVERB.EQ.1) WRITE (6,*) ' REP NOMBRE MAXIMUM DE ',
  87. # 'FACETTES TOUCHANT UN POINT ATTEINT '
  88. 200 CONTINUE
  89. C
  90. IFUT(NFACET)=JF
  91. IFAT(JF)=NFACET
  92. C
  93. C
  94. * WRITE(6,1200)JF,(NFC(I,JF),I=1,4)
  95. 1200 FORMAT(' REP:',I3,' ::',4I4)
  96. C
  97. RETURN
  98. END
  99.  
  100.  
  101.  
  102.  

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