	PROGRAM RECEIVE
C
C
C***************************************************************C
C								C
C								C
C	   reseau interne TELEMECANIQUE VNET niveau 6 		C
C	   ******************************************		C
C								C
C								C
C	module : EMISSION SUR VAX/VMS DE FICHIERS A 		C
C		 DESTINATION D'UN OUTIL DE DEVELOPPEMENT	C
C								C
C		necessite VMS 4.0 au moins			C
C								C
C								C
C								C
C	V2.0 5 decembre 1984	T.DUQUESNAY (DRD Meylan)	C
C	V2.1 13 juin 1985	T.D.				C
C								C
C***************************************************************C
C
C
C la version V2 peut dialoguer avec une station INTEL serie III-II
C				    une station INTEL MDS 800
C				    une station ZILOG MCZ
C				    une station INTEL 86-310 sous RMX-86
C
C nouveautes V2.0 par rapport a V1.3 
C		modification de la longueur du nom de fichier
C		nouveau parametre : /E=nom_fichier_VAX
C
C V2.1 adaptation a VMS V4.0 (surtout IONET6)
C
C
	INCLUDE 'PARAMV6.INC/LIST'
C++
	COMMON /BUFNET/OUVERT,BUFICH,CPTFIC,LONGLU
	LOGICAL*1 OUVERT
	BYTE BUFICH(1024)
	INTEGER*2 CPTFIC,LONGLU
C--
C++
	COMMON /IO/CHAN,IFUNC1,IFUNC2,BUFIN,BUFOUT,STATUS,BUFCHAR
	INTEGER*2 CHAN,STATUS(4)
	INTEGER*4 IFUNC1,IFUNC2,BUFCHAR(3)
	BYTE BUFIN(134),BUFOUT(256)
C--
C++
	COMMON /ERRLOG/OUVLOG,FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL,COMMANDE,
     1		       LGMAX
	LOGICAL*1 OUVLOG
	BYTE COMMANDE(LONG_NETV6)
	INTEGER*4 FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL
	INTEGER*4 LGMAX
C--
C++	
	COMMON /ANALYSE/OK,TEXT,SPOOL,KEEP,LONG_NFICH,NFICH
	LOGICAL*1 OK,TEXT,SPOOL,KEEP
	INTEGER LONG_NFICH
	BYTE NFICH(LONG_NETV6)
C--
C
C
C
	BYTE ACK,NAK,STX,EOT,DLE,SOH
C
	LOGICAL*1 FIN,FINFICH
C
	BYTE BCC
	INTEGER*2 I,NBINCID,IND,NBCAR,LGOUT
	INTEGER*4 ERREUR
C   type des fonctions
	BYTE CARACT,PREMIER
C
C
C   codes de controle de la transmission
	DATA ACK/06/
	DATA NAK/21/
	DATA STX/02/
	DATA EOT/04/
	DATA SOH/01/
	DATA DLE/16/
C
C
C
Cbegin
C+++++
C
C  initialisations
C
	CALL ERRSNS (FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL)
	OUVERT = .FALSE.
	OUVLOG = .FALSE.
C
	CALL INITIO
C
C
C  emission START et attente de la reponse contenant le nom de fichier
C
	BUFOUT(1) = SOH
	LGMAX = LONG_NETV6
	CALL DIALOGUE (LGMAX,1)
	DO I=1,LONG_NETV6
C	 sauvegarde de la ligne de commande pour afficher en cas d'erreur
	    COMMANDE(I) = BUFIN(I)
	END DO
C
C  analyse reponse
C
	CALL ANALYSE_CDE (BUFIN)
C
C	traitement erreur eventuelle dans la commande
	IF (.NOT.OK) CALL ERRFAT(4,0)
C
C	verification presence du nom de fichier
	IF (LONG_NFICH .LE. 1) CALL ERRFAT(4,0)
	IF (LONG_NFICH .GT. LONG_NETV6) CALL ERRFAT(4,0)
C
C	insertion d'un caractere nul pour indiquer la fin du
C	 nom du fichier dans NFICH
	NFICH(LONG_NFICH) = 0
C
C   ouverture du fichier
C
	OPEN (UNIT=2,FILE=NFICH,ACCESS='SEQUENTIAL',STATUS='OLD',
     1	      READONLY,DEFAULTFILE='.',ERR=299,IOSTAT=ERREUR)
	IF (ERREUR .NE. 0) THEN
	    CALL ERRFAT (5,ERREUR)
	ELSE
	    OUVERT=.TRUE.
C	      lecture 1 er enregistrement pour verifier l'etat 
C		du fichier ouvert
	    FINFICH = .FALSE.
	    BCC = PREMIER (FINFICH,TEXT)
C	      emission ACK
	    BUFOUT(1) = ACK
	    CALL EMIS (1)
	END IF
C
C
C   emission du fichier
C
	FIN = .FALSE.
	DO WHILE (.NOT.FIN)
C
C	     constitution du buffer d'emission courant : 130 caract
C		<STX>,<127>,<...127 oct...>,<bcc>  nb oct= 127
C	     constitution du dernier buffer d'emission : 130 caract
C		<EOT>,<nb oct>,<..oct..>,<bcc>,<....>
C
	    NBCAR = 127
	    BCC = 0
	    BUFOUT(1) = STX
	    IND = 3
	    DO WHILE (IND.LE.129 .AND. .NOT.FIN)
		BUFOUT(IND) = CARACT (FINFICH,TEXT)
		IF (FINFICH) THEN
		    NBCAR = IND - 3
		    FIN = .TRUE.
		ELSE
		    BCC = BCC .XOR. BUFOUT(IND)
		END IF
		IND = IND + 1
	    END DO
	    BUFOUT(2) = NBCAR
	    BUFOUT(NBCAR+3) = BCC
C		si NBCAR = 0 alors c'est le dernier bloc et
C		il ne faut pas envoyer de bloc vide au MDS !
	    IF (NBCAR.EQ.0) GOTO 235
C
C	   emission du buffer
C
	    NBINCID = 0
230	    CONTINUE
	    LGMAX = 1
	    CALL DIALOGUE (LGMAX,130)
C
C	   analyse reponse
C
	    IF (BUFIN(1).NE.ACK) THEN
		IF (BUFIN(1).EQ.NAK) THEN
C		    incident de transmission,on repete
		    NBINCID = NBINCID + 1
		    CALL INCIDE (1,NBINCID)
		    IF (NBINCID .GE. 6) CALL ERRFAT (14,0)
		    GOTO 230
		ELSE
		    ERREUR = BUFIN(1)
		    CALL ERRFAT(8,ERREUR)
		END IF
	    END IF
C
	END DO
C
C   emission dernier bloc avec EOT
C
235	CONTINUE
	BUFOUT(1) = EOT
	CALL EMIS(130)
C
C   fermeture fichier
C
	CLOSE (2,ERR=399,IOSTAT=ERREUR)
C
C   fin
	CALL FINIO
	CALL EXIT
	STOP
C
C
299	CONTINUE
	CALL ERRFAT (12,ERREUR)
	STOP
C
399	CONTINUE
	CALL ERRFAT (13,ERREUR)
	STOP
C
	END
C
C
	SUBROUTINE INCIDE (N1,N2)
C
C
	INTEGER*2 N1,N2
C
	INCLUDE 'PARAMV6.INC/LIST'
C++
	COMMON /ERRLOG/OUVLOG,FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL,COMMANDE,
     1		       LGMAX
	LOGICAL*1 OUVLOG,COMMANDE(LONG_NETV6)
	INTEGER*4 FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL
	INTEGER*4 LGMAX
C--	
C++
	COMMON /IO/CHAN,IFUNC1,IFUNC2,BUFIN,BUFOUT,STATUS,BUFCHAR
	INTEGER*2 CHAN,STATUS(4)
	INTEGER*4 IFUNC1,IFUNC2,BUFCHAR
	BYTE BUFIN(134),BUFOUT(256)
C--
	INTEGER*2 K
	BYTE DAT(9),TIM(8)
C
	IF (.NOT.OUVLOG) THEN
	    OPEN (UNIT=3,FILE='ERREURNET.LOG',ACCESS='APPEND',
     1		STATUS='UNKNOWN',ERR=399)
	    OUVLOG = .TRUE.
	END IF
C
	CALL DATE (DAT)
	CALL TIME (TIM)
	WRITE (3,1000) (DAT(K),K=1,9),(TIM(K),K=1,8),N1,N2,LGMAX,
     1			(STATUS(K),K=1,4)
1000	FORMAT(/1X,9A1,1X,8A1,' incident transmission RECEIVE V2.1',I2,1X,I6,
     1	    /,5X,'LGMAX =',I9,3X,'IOSB(1:4) =',4(1X,I6))
	RETURN
C
399	CONTINUE
	RETURN
C
	END
C
C
	SUBROUTINE ERRFAT (N1,N2)
C	-------------------------
C
	INTEGER*2 N1
	INTEGER*4 N2
C
	INCLUDE 'PARAMV6.INC/LIST'
C++
	COMMON /BUFNET/OUVERT,BUFICH,CPTFIC
	LOGICAL*1 OUVERT
	BYTE BUFICH(1024)
	INTEGER*2 CPTFIC
C--
C++
	COMMON /IO/CHAN,IFUNC1,IFUNC2,BUFIN,BUFOUT,STATUS,BUFCHAR
	INTEGER*2 CHAN,STATUS(4)
	INTEGER*4 IFUNC1,IFUNC2,BUFCHAR(3)
	BYTE BUFIN(134),BUFOUT(256)
C--
C++
	COMMON /ERRLOG/OUVLOG,FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL,COMMANDE,
     1		       LGMAX
	LOGICAL*1 OUVLOG,COMMANDE(LONG_NETV6)
	INTEGER*4 FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL
	INTEGER*4 LGMAX
C--
C++
	COMMON /ANALYSE/OK,TEXT,SPOOL,KEEP,LONG_NFICH,NFICH
	LOGICAL*1 OK,TEXT,SPOOL,KEEP
	INTEGER LONG_NFICH
	BYTE NFICH(LONG_NETV6)
C--
C
	EXTERNAL SYS$GETMSG
	INTEGER K
	BYTE DAT(9),TIM(8)
	CHARACTER MESSAGE*256
	EQUIVALENCE (BUFOUT(1),MESSAGE(1:1))
	INTEGER*4 MSGLEN,ERROR
	BYTE DLE
C
	DATA DLE/16/
C
C
C  interruption de la transmission
C
	CALL ERRSNS (FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL)
	IF (FNUM .NE. 0) THEN
	    ERROR = SYS$GETMSG(%VAL(CONDVAL),%REF(MSGLEN),MESSAGE,%VAL(15),)
	ELSE
	    ERROR = SYS$GETMSG(%VAL(N2),%REF(MSGLEN),MESSAGE,%VAL(15),)
	END IF
	BUFOUT(1) = DLE
	DO I = MSGLEN,130
		BUFOUT(I) = 0
	END DO
	CALL EMIS (130)
	GOTO 500
C
C
	ENTRY ERRFAT2 (N1,N2)
C	---------------------
C
	CALL ERRSNS (FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL)
C
500	CONTINUE
C
C  rangement information (numero d'erreur)
C 
	IF (.NOT.OUVLOG) THEN
	    OPEN (UNIT=3,FILE='ERREURNET.LOG',ACCESS='APPEND',
     1		STATUS='UNKNOWN',ERR=399)
	    OUVLOG = .TRUE.
	END IF
C
	CALL DATE (DAT)
	CALL TIME (TIM)
	WRITE (3,1000) (DAT(K),K=1,9),(TIM(K),K=1,8),N1
1000	FORMAT (/,1X,9A1,2X,8A1,'  erreur fatale RECEIVE V2.1   ',
     1		'numero : ',I2)
	GOTO (101,102,102,104,105,106,107,108,170,170,111,105,113,114)
     1		N1
C
101	CONTINUE
	WRITE (3,1201)
1201	FORMAT (10X,'erreur rendue par SYS$ASSIGN')
	GOTO 170
102	CONTINUE
	WRITE (3,1202) LGMAX,(STATUS(K),K=1,4)
1202	FORMAT (10X,'erreur SYS$QIOW emission message, attente reponse',
     1		/,5X,'LGMAX =',I9,3X,'IOSB(1:4) =',4(1X,I6))
	GOTO 170
104	CONTINUE
	WRITE (3,1204) (COMMANDE(K),K=1,LONG_NETV6)
1204	FORMAT (10X,'erreur de syntaxe dans la commande',
     1          /3X,'Commande: ',100A1)
	GOTO 180
105	CONTINUE
	WRITE (3,1205) (NFICH(K),K=1,LONG_NFICH)
1205	FORMAT (10X,'erreur sur OPEN',/,3X,'Nom fichier : ',100A1)
	GOTO 170
106	CONTINUE
	WRITE (3,1206)
1206	FORMAT (10X,'erreur SYS$QIOW IO$_SENSEMODE ou IO$_SETMODE')
	GOTO 170
107	CONTINUE
	WRITE (3,1206)
	GOTO 175
108	CONTINUE
	WRITE (3,1208)
1208	FORMAT (10X,'compte rendu ni ACK,ni NAK !')
	GOTO 180
111	CONTINUE
	WRITE (3,1211)
1211	FORMAT (10X,'erreur lecture fichier sur disque')
	GOTO 170
113	CONTINUE
	WRITE (3,1213)
1213	FORMAT (10X,'erreur sur CLOSE')
	GOTO 170
114	CONTINUE
	WRITE (3,1214)
1214	FORMAT (10X,'trop d''incidents de transmission successifs')
	GOTO 180
C
175	CONTINUE
	WRITE (3,1006) N2
1006	FORMAT (5X,'IOSB(1) =',I9)
C
170	CONTINUE
	IF (FNUM .NE. 0) THEN
	    ERROR = SYS$GETMSG(%VAL(CONDVAL),%REF(MSGLEN),MESSAGE,%VAL(15),)
	ELSE
	    ERROR = SYS$GETMSG(%VAL(N2),%REF(MSGLEN),MESSAGE,%VAL(15),)
	END IF
	WRITE (3,7070) MESSAGE(1:MSGLEN)
7070	FORMAT (1X,A)
C
178	CONTINUE
	WRITE (3,1002) FNUM,RMSSTS,RMSSTV,IUNIT,CONDVAL
1002	FORMAT (5X,'FORTRAN run-time error number :',I9,/,
     1		5X,'RMS completion status code (STS):',I9,/,
     2		5X,'RMS status value (STV):',I9,/,
     3		5X,'logical unit number :',I9,/,
     4	        5X,'actual VAX-11 condition value :',I9)
C
180	CONTINUE
	WRITE (3,1001)
1001	FORMAT (/,1X,20(H-),' reseau interne TELEMECANIQUE DRD Meylan ',
     1		19(H-))
C
399	CONTINUE
	CALL FINIO
	CALL EXIT
	END
C
	BYTE FUNCTION CARACT (FINFICH,TEXT)
C	              ------
C
	LOGICAL*1 FINFICH,TEXT
C
C
	COMMON /BUFNET/OUVERT,BUFICH,CPTFIC,LONGLU
	LOGICAL*1 OUVERT
	BYTE BUFICH(1024)
	INTEGER*2 CPTFIC,LONGLU
C
	BYTE PREMIER
C
	INTEGER*4 ERREUR
	INTEGER*2 I
C
C
C
	IF (CPTFIC.GT.LONGLU) THEN
C
C	     lecture d'un article
	    READ (2,100,END=400,ERR=499,IOSTAT=ERREUR)
     1		    LONGLU,(BUFICH(I),I=1,LONGLU)
100	    FORMAT (Q,1024A1)
	    CPTFIC = 1
	    IF (TEXT) THEN
		BUFICH(LONGLU+1) = 13
		BUFICH(LONGLU+2) = 10
		LONGLU = LONGLU + 2
	    END IF
	END IF
C
	CARACT = BUFICH(CPTFIC)
	CPTFIC = CPTFIC + 1
	RETURN
C
400	CONTINUE
C	   fin de fichier
	FINFICH = .TRUE.
	CARACT = 0
	RETURN
C
C
C
	ENTRY PREMIER (FINFICH,TEXT)
C
C
	READ (2,100,END=401,ERR=499,IOSTAT=ERREUR)
     1		LONGLU,(BUFICH(I),I=1,LONGLU)
	CPTFIC = 1
	IF (TEXT) THEN
	    BUFICH(LONGLU+1) = 13
	    BUFICH(LONGLU+2) = 10
	    LONGLU = LONGLU + 2
	END IF
C
	FINFICH = .FALSE.
	PREMIER = 0
	RETURN
C
C
401	CONTINUE
	FINFICH = .TRUE.
	PREMIER = 0
	RETURN
C
499	CONTINUE
	CALL ERRFAT (11,ERREUR)
	STOP
C
	END
