Download wrmail.eso

Back to the list

   1 : C WRMAIL    SOURCE    PV        13/04/11    21:16:20     7755           
   2 :       SUBROUTINE WRMAIL (MELEME,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 MELEME SUR LA BANDE IOSAU
   8 : C
   9 : C    ECRIT PAR FARVACQUE -REPRIS PAR LENA
  10 : C    APPELE PAR WRPIL
  11 : C    APPELLE      :  ECDIFR ECDIFE ECDES ECDIFP
  12 : C    APPELLE PAR  :  WRPIL
  13 : C=======================================================================
  14 : -INC SMELEME
  15 : -INC TMCOLAC
  16 :       DIMENSION ILENA(10)
  17 : C
  18 : C******************************************ECRITURE
  19 : C
  20 :       IRETOU=0
  21 :       ITOTO    = 5
  22 :       IF (MELEME.EQ.0) THEN
  23 :          ILENA(1) = -100
  24 :          ILENA(2) = 0
  25 :          ILENA(3) = 0
  26 :          ILENA(4) = 0
  27 :          ILENA(5) = 0
  27 :          CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
  28 :       ELSE
  29 :          SEGACT MELEME
  30 :          ILENA(1) = ITYPEL
  31 :          ILENA(2) = LISOUS(/1)
  32 :          ILENA(3) = LISREF(/1)
  33 :          ILENA(4) = NUM(/1)
  34 :          ILENA(5) = NUM(/2)
  34 :          CALL ECDIFE (IOSAU,ITOTO,ILENA,IFORM)
  35 :          NTOTO=ILENA(2)
  35 :          CALL ECDIFE (IOSAU,NTOTO,LISOUS,IFORM)
  36 :          NTOTO=ILENA(3)
  36 :          CALL ECDIFE (IOSAU,NTOTO,LISREF,IFORM)
  37 :          NBELEM=ILENA(5)
  38 :          NBNN=ILENA(4)
  39 :          L=NBELEM*NBNN
  39 : CCCCC    IF (IONIVE.GT.0) CALL ECDIFE(IOSAU,NBELEM,ICOLOR,IFORM)
  39 :          CALL ECDIFE(IOSAU,NBELEM,ICOLOR,IFORM)
  39 :          if (l.ne.0) CALL ECDIFE(IOSAU,L,NUM(1,1),IFORM)
  40 : C ---    WRITE(IOSAU,8000)((NUM(II,JJ),II=1,NBNN),JJ=1,NBELEM)
  41 :          IF (MELEME.NE.0)  SEGDES MELEME
  42 :       ENDIF
  43 :       RETURN
  44 :       END
  45 :  
  46 :  
  47 :  
  48 :  
  49 :  
  50 :  
  51 :  

© Cast3M 2003 - All rights reserved.
Disclaimer