Télécharger la plaquette Cast3M


fr en

Télécharger livect.eso

Retour à la liste

Numérotation des lignes : 

livect

  1. C LIVECT    SOURCE    PV        22/01/18    21:15:06     11267          
  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 PPARAM
  14. -INC SMVECTE
  15. C=======================================================================
  16. C
  17.       SEGMENT/ILECB1/(ILECB2(L))
  18.       DIMENSION ILENA(10)
  19. C
  20.  
  21.       IRETOU=0
  22.       ITOTO=2
  23.       CALL LFCDIE (IORES,ITOTO,ILENA,IRET,IFORM)
  24.       IF (IRET.NE.0) GO TO 1001
  25.       NVEC    = ILENA(1)
  26.       ID      = ILENA(2)
  27.       SEGINI MVECTE
  28.       CALL LFCDIE (IORES,NVEC,IGEOV,IRET,IFORM)
  29.       IF (IRET.NE.0) GO TO 1000
  30.       CALL LFCDI2 (IORES,NVEC,AMPF ,IRET,IFORM)
  31.       IF (IRET.NE.0) GO TO 1000
  32.       CALL LFCDIE (IORES,NVEC,NOCOUL,IRET,IFORM)
  33.       IF (IRET.NE.0) GO TO 1000
  34.       CALL LFCDIE (IORES,NVEC,ICHPO,IRET,IFORM)
  35.       IF (IRET.NE.0) GO TO 1000
  36.       L=NVEC*ID
  37.       SEGINI ILECB1
  38.       CALL LFCDIM (IORES,L,ILECB2,IRET,IFORM)
  39.       IF (IRET.NE.0) GO TO 1000
  40.       L=0
  41.       DO 32 IU=1,ID
  42.       DO 32 IY=1,NVEC
  43.       L=L+1
  44.       WRITE(NOCOVE(IY,IU),FMT='(A4)') ILECB2(L)
  45.   32  CONTINUE
  46.       SEGSUP ILECB1
  47. 1000  SEGDES MVECTE
  48. 1001  IRETOU=IRET
  49.       RETURN
  50.       END
  51.  
  52.  
  53.  
  54.  

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