Télécharger chauss.eso

Retour à la liste

Numérotation des lignes :

  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)
  44. CALL LIRMOT(MCLE,NCLE,ICLE,1)
  45. IF(ICLE.EQ.0)RETURN
  46. C
  47. GOTO(10,20,30,40,50,60),ICLE
  48. C
  49. C OUVERTURE SERVEUR
  50. C
  51. 10 CALL OPCHAU(JECHO,IWAIT,IENT)
  52. IF(IENT.EQ.0) GOTO 100
  53. C
  54. CALL initserver(IWAIT,IENT,macnam)
  55. IF(IENT.NE.1)THEN
  56. WRITE(IOIMP,*)'Chauss: Erreur en "OUVERTURE SERVEUR"'
  57. ENDIF
  58. GOTO 100
  59. C
  60. C OUVERTURE CLIENT
  61. C
  62. 20 CALL LIRCHA(NOM,1,IENT)
  63. IF(IENT.GT.0)THEN
  64. IENT=IENT+1
  65. NOM(IENT:IENT)=NULL
  66. CALL initclient(NOM(1:IENT),IENT)
  67. IF(IENT.NE.1)THEN
  68. WRITE(IOIMP,*)'Chauss: Erreur en "OUVERTURE CLIENT"'
  69. ENDIF
  70. ENDIF
  71. GOTO 100
  72. C
  73. C ECRITURE
  74. C
  75. 30 CALL LIROBJ('LISTREEL',MLREEL,0,IENT)
  76. C
  77. C 1) CAS DU LISTREEL
  78. C
  79. IF(IENT.NE.0)THEN
  80. C
  81. CALL OPCHAU(JECHO,IWAIT,IENT)
  82. IF(IENT.EQ.0) GOTO 100
  83. C
  84. SEGACT,MLREEL
  85. L1=PROG(/1)*23
  86. SEGINI,BUFFER
  87. DO IE1=1,PROG(/1)
  88. WRITE(LBUFF((IE1-1)*23+1:IE1*23-1),'(1PE21.14,A1)')
  89. > PROG(IE1),NULL
  90. C LBUFF((IE1-1)*23+21:IE1*23)=LBUFF((IE1-1)*23+20:IE1*23-1)
  91. CCC=LBUFF((IE1-1)*23+20:IE1*23-1)
  92. LBUFF((IE1-1)*23+21:IE1*23)=CCC
  93. LBUFF((IE1-1)*23+20:(IE1-1)*23+20)='0'
  94. IF(PROG(IE1).GE.0.D0)THEN
  95. LBUFF((IE1-1)*23+1:(IE1-1)*23+1)='+'
  96. ENDIF
  97. ENDDO
  98. IF(IIMPI.EQ.1789)THEN
  99. WRITE(IOIMP,*)'Echo transmission'
  100. DO IE1=1,PROG(/1)
  101. WRITE(IOIMP,*)IE1,':',LBUFF((IE1-1)*23+1:IE1*23)
  102. ENDDO
  103. ENDIF
  104. SEGDES,MLREEL
  105. C
  106. C 2) CAS DU MOT
  107. C
  108. ELSE
  109. C
  110. CALL LIRCHA(NOM,1,IENT)
  111. IF(IENT.EQ.0) GOTO 100
  112. C
  113. CALL OPCHAU(JECHO,IWAIT,IENT)
  114. IF(IENT.EQ.0) GOTO 100
  115. C
  116. L1=IENT+1
  117. SEGINI,BUFFER
  118. LBUFF(1:IENT)=NOM(1:IENT)
  119. LBUFF(L1:L1) =NULL
  120. IF(IIMPI.EQ.1789)THEN
  121. WRITE(IOIMP,*)'Echo transmission'
  122. WRITE(IOIMP,*)LBUFF(1:L1)
  123. ENDIF
  124. ENDIF
  125. C
  126. IF(JECHO.EQ.0)L1=1
  127. SEGINI,BUFFE1
  128. C
  129. CALL writesocket(LBUFF,BUFFE1.LBUFF,JECHO,IWAIT,IENT,JERNO)
  130. IF(IENT.NE.1)THEN
  131. WRITE(IOIMP,*)'Chauss: Erreur en "ECRITURE"'
  132. ENDIF
  133. C
  134. SEGSUP,BUFFER,BUFFE1
  135. C
  136. GOTO 100
  137. C
  138. C LECTURE D'UN LISTREEL
  139. C
  140. 40 CALL LIRENT(JG,1,IENT)
  141. IF(IENT.EQ.0)GOTO 100
  142. C
  143. CALL OPCHAU(JECHO,IWAIT,IENT)
  144. IF(IENT.EQ.0) GOTO 100
  145. C
  146. L1=JG*23
  147. SEGINI,BUFFER
  148. CALL readsocket(LBUFF,JECHO,IWAIT,IENT,JERNO)
  149. IF(IENT.NE.1)THEN
  150. WRITE(IOIMP,*)'Chauss: Erreur en "LECTURE LISTREEL"'
  151. GOTO 99
  152. ENDIF
  153. C
  154. IF(IIMPI.EQ.1789)THEN
  155. WRITE(IOIMP,*)'Echo reception'
  156. DO IE1=1,JG
  157. WRITE(IOIMP,*)IE1,':',LBUFF((IE1-1)*23+1:IE1*23)
  158. ENDDO
  159. ENDIF
  160. C
  161. SEGINI,MLREEL
  162. DO IE1=1,JG
  163. C LBUFF((IE1-1)*23+20:IE1*23-2)=LBUFF((IE1-1)*23+21:IE1*23-1)
  164. CCC=LBUFF((IE1-1)*23+21:IE1*23)
  165. LBUFF((IE1-1)*23+20:IE1*23-1)=CCC
  166. READ(LBUFF((IE1-1)*23+1:IE1*23-2),'(1PE21.14)')PROG(IE1)
  167. ENDDO
  168. SEGDES,MLREEL
  169. CALL ECROBJ('LISTREEL',MLREEL)
  170. SEGSUP,BUFFER
  171. C
  172. GOTO 100
  173. C
  174. C LECTURE D'UN MOT
  175. C
  176. 50 CALL LIRENT(L1,1,IENT)
  177. IF(IENT.EQ.0)GOTO 100
  178. C
  179. CALL OPCHAU(JECHO,IWAIT,IENT)
  180. IF(IENT.EQ.0) GOTO 100
  181. C
  182. L1=L1+1
  183. SEGINI,BUFFER
  184. CALL readsocket(LBUFF,JECHO,IWAIT,IENT,JERNO)
  185. IF(IENT.NE.1)THEN
  186. WRITE(IOIMP,*)'Chauss: Erreur en "LECTURE MOT"'
  187. GOTO 99
  188. ENDIF
  189. C
  190. IF(IIMPI.EQ.1789)THEN
  191. WRITE(IOIMP,*)'Echo reception'
  192. WRITE(IOIMP,*)LBUFF(1:L1)
  193. ENDIF
  194. C
  195. BUFF1(1:L1-1)=LBUFF(1:L1-1)
  196. CALL ECRCHA(BUFF1(1:L1-1))
  197. SEGSUP,BUFFER
  198. C
  199. GOTO 100
  200. C
  201. C FERMETURE DU PORT
  202. C
  203. 60 CALL LIRMOT(MMCLE,1,ICOMPL,0)
  204. CALL closesocket(ICOMPL,IENT)
  205. IF(IENT.NE.1)THEN
  206. WRITE(IOIMP,*)'Chauss: Erreur en "FERMETURE"'
  207. ENDIF
  208. C
  209. GOTO 100
  210. C
  211. C ERREUR LECTURE (TIME OUT ET AUTRES)
  212. C
  213. 99 CALL ECRLOG(LDUMM)
  214. C
  215. C ON SORT
  216. C
  217. 100 CALL ECRENT(IENT)
  218. RETURN
  219. END
  220.  
  221.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales