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. -INC CCOPTIO
  17. C
  18. I=IFAT(JF)
  19. IF (I.EQ.0) GOTO 190
  20. 20 IFUT(I)=IFUT(NFACET)
  21. IFAT(IFUT(I))=I
  22. IFAT(JF)=0
  23. NFACET=NFACET-1
  24. C
  25. DO 30 I=1,4
  26. JP=NFC(I,JF)
  27. IF (JP.EQ.0) GOTO 30
  28. DO 40 J=1,40
  29. IF (NPF(J,JP).EQ.JF) GOTO 50
  30. 40 CONTINUE
  31. IF (IVERB.EQ.1) write (6,*) ' REPSUB ',' incoherente ',jf
  32. k=100000000
  33. nfc(1,k)=1
  34. 50 DO 60 K=J,39
  35. NPF(K,JP)=NPF(K+1,JP)
  36. 60 CONTINUE
  37. NPF(40,JP)=0
  38. 30 CONTINUE
  39. C
  40. * WRITE(6,1000)JF,NFACET
  41. 1000 FORMAT(' SUBF:',I3,' NFACET=',I2)
  42. C
  43. RETURN
  44. C FIN DE LA PARTIE SUPPRESSION DE FACETTE
  45. 190 CONTINUE
  46. C LA FACETTE N'ETAIT PAS LA ON LA REPERTORIE
  47. C
  48. NFTOT=IFUT(/1)
  49. NFACET=NFACET+1
  50. IF (JF.GE.NFTOT.AND.IVERB.EQ.1)
  51. # WRITE (6,*) ' REP NOMBRE MAXI DE ',
  52. # 'FACETTES ATTEINT => JF,NFTOT ',JF,NFTOT
  53. C
  54. C
  55. DO 200 I=1,4
  56. IP=NFC(I,JF)
  57. IF (IP.EQ.0) GOTO 200
  58. DO 210 J=1,40
  59. if (NPF(J,IP).eq.jf) then
  60. IF (IVERB.EQ.1) THEN
  61. write (6,*) ' REPSUB ',' incoherent-2 ',jf
  62. write (6,*) ' liste des facettes restantes '
  63. ENDIF
  64. DO 444 k=1,NFCMAX
  65. IF (IFAT(k).EQ.1) GOTO 444
  66. IF (IVERB.EQ.1)
  67. & WRITE (6,*) k,NFC(1,k),NFC(2,k),NFC(3,k),NFC(4,k)
  68. 444 CONTINUE
  69. IF (IVERB.EQ.1) write (6,*) ' liste de NPF '
  70. DO 445 k=1,Nptmax
  71. IF (IVERB.EQ.1) WRITE (6,*) k,(npf(l,k),l=1,40)
  72. 445 CONTINUE
  73. IF (IVERB.EQ.1) write (6,*) ' liste de ifat et ifut'
  74. DO 446 k=1,ifat(/1)
  75. IF (IVERB.EQ.1) WRITE (6,*) k,ifat(k),ifut(k)
  76. 446 CONTINUE
  77. k=100000000
  78. nfc(1,k)=1
  79. endif
  80. IF (NPF(J,IP).NE.0) GOTO 210
  81. NPF(J,IP)=JF
  82. GOTO 200
  83. 210 CONTINUE
  84. IF (IVERB.EQ.1) WRITE (6,*) ' REP NOMBRE MAXIMUM DE ',
  85. # 'FACETTES TOUCHANT UN POINT ATTEINT '
  86. 200 CONTINUE
  87. C
  88. IFUT(NFACET)=JF
  89. IFAT(JF)=NFACET
  90. C
  91. C
  92. * WRITE(6,1200)JF,(NFC(I,JF),I=1,4)
  93. 1200 FORMAT(' REP:',I3,' ::',4I4)
  94. C
  95. RETURN
  96. END
  97.  
  98.  
  99.  
  100.  

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