1 : C CHAUSS SOURCE CHAT 05/01/12 21:56:07 5004
2 : SUBROUTINE CHAUSS
3 : IMPLICIT INTEGER(I-N)
4 : IMPLICIT REAL*8(A-H,O-Z)
5 : C_______________________________________________________________________
6 : C
7 : C ENT1=CHAU 'SERVEUR' ('ATTENTE' ENT4);
8 : C ENT1=CHAU 'CLIENT' MOT1;
9 : C ENT1=CHAU 'ECRITURE' LREE1 ('ECHO') ('ATTENTE' ENT4);
10 : C ENT1=CHAU 'ECRITURE' MOT2 ('ECHO') ('ATTENTE' ENT4);
11 : C ENT1 LREE2=CHAU 'LECTLIST' ENT2 ('ECHO') ('ATTENTE' ENT4);
12 : C ENT1 MOT3=CHAU 'LECTUMOT' ENT3 ('ECHO') ('ATTENTE' ENT4);
13 : C ENT1=CHAU 'FERMETURE' ('COMPLETE');
14 : C
15 : C_______________________________________________________________________
16 : C
17 : C WARNING: il doit etre possible de dialoguer avec des programmes C.
18 : C ----> tout les objets transferes sont codes en ASCII ...
19 : C ----> ... sont completer par le caractere NULL ...
20 : C ----> ... et les flottants ont un exposant sur 3 digits
21 : C_______________________________________________________________________
22 : C P.PEGON 10-12/3/93 7/9/93
23 : C-----------------------------------------------------------------------
24 : C
25 : -INC SMLREEL
26 : -INC CCOPTIO
27 : LOGICAL LDUMM
28 : SEGMENT BUFFER
29 : CHARACTER*(L1) LBUFF
30 : ENDSEGMENT
31 : POINTEUR BUFFE1.BUFFER
32 : C
33 : CHARACTER NULL,CCC*3
34 : CHARACTER*500 BUFF1
35 : C
36 : PARAMETER(NCLE=6)
37 : CHARACTER MCLE(NCLE)*8,NOM*72,MMCLE(1)*8,macnam*20
38 : DATA MCLE/'SERVEUR ','CLIENT ','ECRITURE','LECTLIST','LECTUMOT',
39 : > 'FERMETUR'/
40 : DATA MMCLE(1)/'COMPLETE'/
41 : DATA LDUMM/.FALSE./
42 : C
43 : NULL=CHAR(0)
43 : CALL LIRMOT(MCLE,NCLE,ICLE,1)
44 : IF(ICLE.EQ.0)RETURN
45 : C
46 : GOTO(10,20,30,40,50,60),ICLE
47 : C
48 : C OUVERTURE SERVEUR
49 : C
49 : 10 CALL OPCHAU(JECHO,IWAIT,IENT)
50 : IF(IENT.EQ.0) GOTO 100
51 : C
51 : CALL initserver(IWAIT,IENT,macnam)
52 : IF(IENT.NE.1)THEN
53 : WRITE(IOIMP,*)'Chauss: Erreur en "OUVERTURE SERVEUR"'
54 : ENDIF
55 : GOTO 100
56 : C
57 : C OUVERTURE CLIENT
58 : C
58 : 20 CALL LIRCHA(NOM,1,IENT)
59 : IF(IENT.GT.0)THEN
60 : IENT=IENT+1
61 : NOM(IENT:IENT)=NULL
61 : CALL initclient(NOM(1:IENT),IENT)
62 : IF(IENT.NE.1)THEN
63 : WRITE(IOIMP,*)'Chauss: Erreur en "OUVERTURE CLIENT"'
64 : ENDIF
65 : ENDIF
66 : GOTO 100
67 : C
68 : C ECRITURE
69 : C
69 : 30 CALL LIROBJ('LISTREEL',MLREEL,0,IENT)
70 : C
71 : C 1) CAS DU LISTREEL
72 : C
73 : IF(IENT.NE.0)THEN
74 : C
74 : CALL OPCHAU(JECHO,IWAIT,IENT)
75 : IF(IENT.EQ.0) GOTO 100
76 : C
77 : SEGACT,MLREEL
78 : L1=PROG(/1)*23
79 : SEGINI,BUFFER
80 : DO IE1=1,PROG(/1)
81 : WRITE(LBUFF((IE1-1)*23+1:IE1*23-1),'(1PE21.14,A1)')
82 : > PROG(IE1),NULL
83 : C LBUFF((IE1-1)*23+21:IE1*23)=LBUFF((IE1-1)*23+20:IE1*23-1)
84 : CCC=LBUFF((IE1-1)*23+20:IE1*23-1)
85 : LBUFF((IE1-1)*23+21:IE1*23)=CCC
86 : LBUFF((IE1-1)*23+20:(IE1-1)*23+20)='0'
87 : IF(PROG(IE1).GE.0.D0)THEN
88 : LBUFF((IE1-1)*23+1:(IE1-1)*23+1)='+'
89 : ENDIF
90 : ENDDO
91 : IF(IIMPI.EQ.1789)THEN
92 : WRITE(IOIMP,*)'Echo transmission'
93 : DO IE1=1,PROG(/1)
94 : WRITE(IOIMP,*)IE1,':',LBUFF((IE1-1)*23+1:IE1*23)
95 : ENDDO
96 : ENDIF
97 : SEGDES,MLREEL
98 : C
99 : C 2) CAS DU MOT
100 : C
101 : ELSE
102 : C
102 : CALL LIRCHA(NOM,1,IENT)
103 : IF(IENT.EQ.0) GOTO 100
104 : C
104 : CALL OPCHAU(JECHO,IWAIT,IENT)
105 : IF(IENT.EQ.0) GOTO 100
106 : C
107 : L1=IENT+1
108 : SEGINI,BUFFER
109 : LBUFF(1:IENT)=NOM(1:IENT)
110 : LBUFF(L1:L1) =NULL
111 : IF(IIMPI.EQ.1789)THEN
112 : WRITE(IOIMP,*)'Echo transmission'
113 : WRITE(IOIMP,*)LBUFF(1:L1)
114 : ENDIF
115 : ENDIF
116 : C
117 : IF(JECHO.EQ.0)L1=1
118 : SEGINI,BUFFE1
119 : C
119 : CALL writesocket(LBUFF,BUFFE1.LBUFF,JECHO,IWAIT,IENT,JERNO)
120 : IF(IENT.NE.1)THEN
121 : WRITE(IOIMP,*)'Chauss: Erreur en "ECRITURE"'
122 : ENDIF
123 : C
124 : SEGSUP,BUFFER,BUFFE1
125 : C
126 : GOTO 100
127 : C
128 : C LECTURE D'UN LISTREEL
129 : C
129 : 40 CALL LIRENT(JG,1,IENT)
130 : IF(IENT.EQ.0)GOTO 100
131 : C
131 : CALL OPCHAU(JECHO,IWAIT,IENT)
132 : IF(IENT.EQ.0) GOTO 100
133 : C
134 : L1=JG*23
135 : SEGINI,BUFFER
135 : CALL readsocket(LBUFF,JECHO,IWAIT,IENT,JERNO)
136 : IF(IENT.NE.1)THEN
137 : WRITE(IOIMP,*)'Chauss: Erreur en "LECTURE LISTREEL"'
138 : GOTO 99
139 : ENDIF
140 : C
141 : IF(IIMPI.EQ.1789)THEN
142 : WRITE(IOIMP,*)'Echo reception'
143 : DO IE1=1,JG
144 : WRITE(IOIMP,*)IE1,':',LBUFF((IE1-1)*23+1:IE1*23)
145 : ENDDO
146 : ENDIF
147 : C
148 : SEGINI,MLREEL
149 : DO IE1=1,JG
150 : C LBUFF((IE1-1)*23+20:IE1*23-2)=LBUFF((IE1-1)*23+21:IE1*23-1)
151 : CCC=LBUFF((IE1-1)*23+21:IE1*23)
152 : LBUFF((IE1-1)*23+20:IE1*23-1)=CCC
153 : READ(LBUFF((IE1-1)*23+1:IE1*23-2),'(1PE21.14)')PROG(IE1)
154 : ENDDO
155 : SEGDES,MLREEL
155 : CALL ECROBJ('LISTREEL',MLREEL)
156 : SEGSUP,BUFFER
157 : C
158 : GOTO 100
159 : C
160 : C LECTURE D'UN MOT
161 : C
161 : 50 CALL LIRENT(L1,1,IENT)
162 : IF(IENT.EQ.0)GOTO 100
163 : C
163 : CALL OPCHAU(JECHO,IWAIT,IENT)
164 : IF(IENT.EQ.0) GOTO 100
165 : C
166 : L1=L1+1
167 : SEGINI,BUFFER
167 : CALL readsocket(LBUFF,JECHO,IWAIT,IENT,JERNO)
168 : IF(IENT.NE.1)THEN
169 : WRITE(IOIMP,*)'Chauss: Erreur en "LECTURE MOT"'
170 : GOTO 99
171 : ENDIF
172 : C
173 : IF(IIMPI.EQ.1789)THEN
174 : WRITE(IOIMP,*)'Echo reception'
175 : WRITE(IOIMP,*)LBUFF(1:L1)
176 : ENDIF
177 : C
178 : BUFF1(1:L1-1)=LBUFF(1:L1-1)
178 : CALL ECRCHA(BUFF1(1:L1-1))
179 : SEGSUP,BUFFER
180 : C
181 : GOTO 100
182 : C
183 : C FERMETURE DU PORT
184 : C
184 : 60 CALL LIRMOT(MMCLE,1,ICOMPL,0)
184 : CALL closesocket(ICOMPL,IENT)
185 : IF(IENT.NE.1)THEN
186 : WRITE(IOIMP,*)'Chauss: Erreur en "FERMETURE"'
187 : ENDIF
188 : C
189 : GOTO 100
190 : C
191 : C ERREUR LECTURE (TIME OUT ET AUTRES)
192 : C
192 : 99 CALL ECRLOG(LDUMM)
193 : C
194 : C ON SORT
195 : C
195 : 100 CALL ECRENT(IENT)
196 : RETURN
197 : END
198 :
© Cast3M 2003 - All rights reserved.
Disclaimer