Download wrvect.eso

Back to the list

   1 : C WRVECT    SOURCE    CHAT      05/01/13    04:12:58     5004           
   2 :       SUBROUTINE WRVECT (MVECTE,IOSAU,IRETOU,IFORM)
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : C=======================================================================
   6 : C
   7 : C        ECRITURE DE 1 VECTEUR SUR LA BANDE IOSAU
   8 : C
   9 : C    ECRIT  PAR LENA
  10 : C    APPELE PAR WRPIL
  11 : C    APPELLE      :  ECDIFR ECDIFE  ECDIFMP
  12 : C=======================================================================
  13 : -INC SMVECTE
  14 : C=======================================================================
  15 : C
  16 :       DIMENSION ILENA(40)
  17 : C
  18 : C******************************************ECRITURE
  19 : C
  20 :       IRETOU=0
  21 :       SEGACT MVECTE
  22 :       NVEC    = NOCOVE(/2)
  23 :       ID      =  NOCOVE(/3)
  24 :       ILENA(1)= NVEC
  25 :       ILENA(2)=  ID
  26 :       ITOTO    = 2
  26 :       CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
  26 :       CALL ECDIFE (IOSAU,NVEC,IGEOV,IFORM)
  26 :       CALL ECDIFR (IOSAU,NVEC,AMPF ,IFORM)
  26 :       CALL ECDIFE (IOSAU,NVEC,NOCOUL,IFORM)
  26 :       CALL ECDIFE (IOSAU,NVEC,ICHPO,IFORM)
  27 :       L=NVEC*ID
  28 :       DO 10 J=1,ID
  29 :          DO 10 I=1,NVEC
  30 :             READ (NOCOVE(I,J),FMT='(A4)') ILENA((J-1)*NVEC+I)
  31 :   10  CONTINUE
  31 :       CALL ECDIFM (IOSAU,L,ILENA      ,IFORM)
  32 :       SEGDES MVECTE
  33 :    1  RETURN
  34 :       END
  35 :  

© Cast3M 2003 - All rights reserved.
Disclaimer