Télécharger chauss.eso

Retour à la liste

Numérotation des lignes :

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

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