Télécharger savseg.eso

Retour à la liste

Numérotation des lignes :

  1. C SAVSEG SOURCE PV 11/04/15 21:15:18 6945
  2. C SIGNALE A MENAGE QU'IL FAUT GARDER UN SEGMENT
  3. C
  4. SUBROUTINE SAVSEG(IPOINT)
  5. *
  6. * LE BUT DE CE S-P EST DE RAJOUTER A LA LISTE DES SEGMENTS
  7. * PREEXISTANT UN SEGMENT
  8. IMPLICIT INTEGER(I-N)
  9. -INC CCNOYAU
  10. SEGMENT ISLIS(NBS)
  11. ISLIS=NOYSEG
  12. SEGACT ISLIS*mod
  13. * TRI
  14. NBS=ISLIS(/1)
  15. DO 10 I=1,NBS
  16. if (islis(i).eq.0) goto 15
  17. IF (IPOINT.GT.ISLIS(I)) GOTO 10
  18. IF (IPOINT.EQ.ISLIS(I)) GOTO 20
  19. IF (IPOINT.LT.ISLIS(I)) GOTO 30
  20. 10 CONTINUE
  21. I=NBS+1
  22. 30 CONTINUE
  23. if (islis(nbs).ne.0) then
  24. NBS=NBS+1
  25. SEGADJ ISLIS
  26. endif
  27. DO 40 J=NBS,I+1,-1
  28. ISLIS(J)=ISLIS(J-1)
  29. 40 CONTINUE
  30. 15 continue
  31. ISLIS(I)=IPOINT
  32. 20 CONTINUE
  33. SEGDES ISLIS
  34. * write (6,*) ' savseg longueur, insertion ',nbs,i
  35. END
  36.  
  37.  
  38.  

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