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