Télécharger intva6.eso

Retour à la liste

Numérotation des lignes :

  1. C INTVA6 SOURCE JC220346 14/12/11 21:15:00 8318
  2. SUBROUTINE INTVA6 (NONVID)
  3. ************************************************************************
  4. *
  5. * I N T V A 6
  6. * -----------
  7. *
  8. * FONCTION:
  9. * ---------
  10. *
  11. * ON A LA PARTITION D'INTERVALLE:
  12. * ( ... , W(N-2), W2A, W2B)
  13. * ON CREE LA PARTITION D'INTERVALLE:
  14. * ( ... , W(N-2), W2A)
  15. *
  16. * "W(N-2)" PREND LE ROLE DE "W2A", "W2A" CELUI DE "W2B" ET
  17. * L'INTERVALLE EST REDUIT.
  18. *
  19. * MODE D'APPEL:
  20. * -------------
  21. *
  22. * CALL INTVA6 (NONVID)
  23. *
  24. * PARAMETRES: (E)=ENTREE (S)=SORTIE
  25. * -----------
  26. *
  27. * NONVID LOGIQUE (S) = .TRUE. SI L'INTERVALLE RESULTANT EST
  28. * NON VIDE,
  29. * = .FALSE. SINON.
  30. *
  31. * VOIR EGALEMENT LE COMMUN "CINTVA" DANS LE SOUS-PROGRAMME "INTVA2".
  32. *
  33. * SOUS-PROGRAMMES APPELES:
  34. * ------------------------
  35. *
  36. * ENLEV1, ENLEV2, EXTRA1, EXTRA2, DTLENT, DTLREE.
  37. *
  38. * AUTEUR, DATE DE CREATION:
  39. * -------------------------
  40. *
  41. * PASCAL MANIGOT 24 DECEMBRE 1984
  42. *
  43. * LANGAGE:
  44. * --------
  45. *
  46. * FORTRAN77
  47. *
  48. ************************************************************************
  49. *
  50. IMPLICIT INTEGER(I-N)
  51. IMPLICIT REAL*8 (A-H,O-Z)
  52. -INC CCOPTIO
  53. *
  54. * REGROUPEMENT DES INFORMATIONS SUR LA SUITE DE PULSATIONS AU CARRE:
  55. COMMON/CINTVA/IMULTP,IPW2,W2A,W2I,W2B,NBW2,IPNUM,NUMW2A,NUMW2I,
  56. & NUMW2B ,IUN
  57. *
  58. LOGICAL NONVID
  59. *
  60. CALL ENLEV1 (IPW2,NBW2,IPOINT,0)
  61. IF (IERR .NE. 0) RETURN
  62. CALL DTLREE (IPW2)
  63. IPW2 = IPOINT
  64. *
  65. CALL ENLEV2 (IPNUM,NBW2,IPOINT,0)
  66. IF (IERR .NE. 0) RETURN
  67. CALL DTLENT (IPNUM)
  68. IPNUM = IPOINT
  69. *
  70. NBW2 = NBW2 - 1
  71. *
  72. IF (NBW2 .LT. 2) THEN
  73. *
  74. NONVID = .FALSE.
  75. *
  76. ELSE
  77. *
  78. NONVID = .TRUE.
  79. W2B = W2A
  80. NUMW2B = NUMW2A
  81. *
  82. NBW2M1 = NBW2 - 1
  83. CALL EXTRA1 (IPW2,NBW2M1, W2A)
  84. IF (IERR .NE. 0) RETURN
  85. CALL EXTRA2 (IPNUM,NBW2M1, NUMW2A)
  86. IF (IERR .NE. 0) RETURN
  87. *
  88. END IF
  89. *
  90. END
  91.  
  92.  
  93.  

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