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    CB215821  26/08/24    21:17:13     12622          
  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 1002 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.  1002 CONTINUE
  47.       SEGSUP ILECB1
  48. 1000  SEGDES MVECTE
  49. 1001  IRETOU=IRET
  50.       RETURN
  51.       END
  52.  
  53.  
  54.  
  55.  
  56.  

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