Télécharger livect.eso

Retour à la liste

Numérotation des lignes :

  1. C LIVECT SOURCE CHAT 05/01/13 01:24:28 5004
  2. SUBROUTINE LIVECT (MVECTE,IORES,IRETOU,IFORM)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5. C=======================================================================
  6. C
  7. C LECTUREE DE 1 VECTEUR SUR LA BANDE IORES
  8. C
  9. C ECRIT PAR LENA
  10. C APPELE PAR WRPIL
  11. C APPELLE : ECDIF2 ECDIFE ECDIFMP
  12. C=======================================================================
  13. -INC SMVECTE
  14. C=======================================================================
  15. C
  16. SEGMENT/ILECB1/(ILECB2(L))
  17. DIMENSION ILENA(10)
  18. C
  19.  
  20. IRETOU=0
  21. ITOTO=2
  22. CALL LFCDIE (IORES,ITOTO,ILENA,IRET,IFORM)
  23. IF (IRET.NE.0) GO TO 1001
  24. NVEC = ILENA(1)
  25. ID = ILENA(2)
  26. SEGINI MVECTE
  27. CALL LFCDIE (IORES,NVEC,IGEOV,IRET,IFORM)
  28. IF (IRET.NE.0) GO TO 1000
  29. CALL LFCDI2 (IORES,NVEC,AMPF ,IRET,IFORM)
  30. IF (IRET.NE.0) GO TO 1000
  31. CALL LFCDIE (IORES,NVEC,NOCOUL,IRET,IFORM)
  32. IF (IRET.NE.0) GO TO 1000
  33. CALL LFCDIE (IORES,NVEC,ICHPO,IRET,IFORM)
  34. IF (IRET.NE.0) GO TO 1000
  35. L=NVEC*ID
  36. SEGINI ILECB1
  37. CALL LFCDIM (IORES,L,ILECB2,IRET,IFORM)
  38. IF (IRET.NE.0) GO TO 1000
  39. L=0
  40. DO 32 IU=1,ID
  41. DO 32 IY=1,NVEC
  42. L=L+1
  43. WRITE(NOCOVE(IY,IU),FMT='(A4)') ILECB2(L)
  44. 32 CONTINUE
  45. SEGSUP ILECB1
  46. 1000 SEGDES MVECTE
  47. 1001 IRETOU=IRET
  48. RETURN
  49. END
  50.  
  51.  
  52.  

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