Sources Esope | Cast3M

chauss
C CHAUSS    SOURCE    CHAT      05/01/12    21:56:07     5004
      SUBROUTINE CHAUSS
      IMPLICIT INTEGER(I-N)
      IMPLICIT  REAL*8(A-H,O-Z)
C_______________________________________________________________________
C
C     ENT1=CHAU 'SERVEUR'                      ('ATTENTE' ENT4);
C     ENT1=CHAU 'CLIENT' MOT1;
C     ENT1=CHAU 'ECRITURE' LREE1      ('ECHO') ('ATTENTE' ENT4);
C     ENT1=CHAU 'ECRITURE' MOT2       ('ECHO') ('ATTENTE' ENT4);
C     ENT1 LREE2=CHAU 'LECTLIST' ENT2 ('ECHO') ('ATTENTE' ENT4);
C     ENT1 MOT3=CHAU 'LECTUMOT' ENT3  ('ECHO') ('ATTENTE' ENT4);
C     ENT1=CHAU 'FERMETURE' ('COMPLETE');
C
C_______________________________________________________________________
C
C     WARNING: il doit etre possible de dialoguer avec des programmes C.
C         ----> tout les objets transferes sont codes en ASCII ...
C         ----> ... sont completer par le caractere NULL ...
C         ----> ... et les flottants ont un exposant sur 3 digits
C_______________________________________________________________________
C     P.PEGON 10-12/3/93 7/9/93
C-----------------------------------------------------------------------
C
-INC SMLREEL
 
-INC PPARAM
-INC CCOPTIO
      LOGICAL LDUMM
      SEGMENT BUFFER
          CHARACTER*(L1) LBUFF
      ENDSEGMENT
      POINTEUR BUFFE1.BUFFER
C
      CHARACTER NULL,CCC*3
      CHARACTER*500 BUFF1
C
      PARAMETER(NCLE=6)
      CHARACTER MCLE(NCLE)*8,NOM*72,MMCLE(1)*8,macnam*20
      DATA MCLE/'SERVEUR ','CLIENT  ','ECRITURE','LECTLIST','LECTUMOT',
     >          'FERMETUR'/
      DATA MMCLE(1)/'COMPLETE'/
      DATA LDUMM/.FALSE./
C
      NULL=CHAR(0)
      CALL LIRMOT(MCLE,NCLE,ICLE,1)
      IF(ICLE.EQ.0)RETURN
C
      GOTO(10,20,30,40,50,60),ICLE
C
C     OUVERTURE SERVEUR
C
 10   CALL OPCHAU(JECHO,IWAIT,IENT)
      IF(IENT.EQ.0) GOTO 100
C
      CALL initserver(IWAIT,IENT,macnam)
      IF(IENT.NE.1)THEN
        WRITE(IOIMP,*)'Chauss: Erreur en "OUVERTURE SERVEUR"'
      ENDIF
      GOTO 100
C
C     OUVERTURE CLIENT
C
 20   CALL LIRCHA(NOM,1,IENT)
      IF(IENT.GT.0)THEN
        IENT=IENT+1
        NOM(IENT:IENT)=NULL
        CALL initclient(NOM(1:IENT),IENT)
        IF(IENT.NE.1)THEN
          WRITE(IOIMP,*)'Chauss: Erreur en "OUVERTURE CLIENT"'
        ENDIF
      ENDIF
      GOTO 100
C
C     ECRITURE
C
 30   CALL LIROBJ('LISTREEL',MLREEL,0,IENT)
C
C     1) CAS DU LISTREEL
C
      IF(IENT.NE.0)THEN
C
        CALL OPCHAU(JECHO,IWAIT,IENT)
        IF(IENT.EQ.0) GOTO 100
C
        SEGACT,MLREEL
        L1=PROG(/1)*23
        SEGINI,BUFFER
        DO IE1=1,PROG(/1)
          WRITE(LBUFF((IE1-1)*23+1:IE1*23-1),'(1PE21.14,A1)')
     >         PROG(IE1),NULL
C         LBUFF((IE1-1)*23+21:IE1*23)=LBUFF((IE1-1)*23+20:IE1*23-1)
          CCC=LBUFF((IE1-1)*23+20:IE1*23-1)
          LBUFF((IE1-1)*23+21:IE1*23)=CCC
          LBUFF((IE1-1)*23+20:(IE1-1)*23+20)='0'
          IF(PROG(IE1).GE.0.D0)THEN
            LBUFF((IE1-1)*23+1:(IE1-1)*23+1)='+'
          ENDIF
        ENDDO
        IF(IIMPI.EQ.1789)THEN
          WRITE(IOIMP,*)'Echo transmission'
          DO IE1=1,PROG(/1)
            WRITE(IOIMP,*)IE1,':',LBUFF((IE1-1)*23+1:IE1*23)
          ENDDO
        ENDIF
        SEGDES,MLREEL
C
C     2) CAS DU MOT
C
      ELSE
C
        CALL LIRCHA(NOM,1,IENT)
        IF(IENT.EQ.0) GOTO 100
C
        CALL OPCHAU(JECHO,IWAIT,IENT)
        IF(IENT.EQ.0) GOTO 100
C
        L1=IENT+1
        SEGINI,BUFFER
        LBUFF(1:IENT)=NOM(1:IENT)
        LBUFF(L1:L1) =NULL
        IF(IIMPI.EQ.1789)THEN
          WRITE(IOIMP,*)'Echo transmission'
          WRITE(IOIMP,*)LBUFF(1:L1)
        ENDIF
      ENDIF
C
      IF(JECHO.EQ.0)L1=1
      SEGINI,BUFFE1
C
      CALL writesocket(LBUFF,BUFFE1.LBUFF,JECHO,IWAIT,IENT,JERNO)
      IF(IENT.NE.1)THEN
        WRITE(IOIMP,*)'Chauss: Erreur en "ECRITURE"'
      ENDIF
C
      SEGSUP,BUFFER,BUFFE1
C
      GOTO 100
C
C     LECTURE D'UN LISTREEL
C
 40   CALL LIRENT(JG,1,IENT)
      IF(IENT.EQ.0)GOTO 100
C
      CALL OPCHAU(JECHO,IWAIT,IENT)
      IF(IENT.EQ.0) GOTO 100
C
      L1=JG*23
      SEGINI,BUFFER
      CALL readsocket(LBUFF,JECHO,IWAIT,IENT,JERNO)
      IF(IENT.NE.1)THEN
        WRITE(IOIMP,*)'Chauss: Erreur en "LECTURE LISTREEL"'
        GOTO 99
      ENDIF
C
      IF(IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'Echo reception'
        DO IE1=1,JG
          WRITE(IOIMP,*)IE1,':',LBUFF((IE1-1)*23+1:IE1*23)
        ENDDO
      ENDIF
C
      SEGINI,MLREEL
      DO IE1=1,JG
C       LBUFF((IE1-1)*23+20:IE1*23-2)=LBUFF((IE1-1)*23+21:IE1*23-1)
        CCC=LBUFF((IE1-1)*23+21:IE1*23)
        LBUFF((IE1-1)*23+20:IE1*23-1)=CCC
        READ(LBUFF((IE1-1)*23+1:IE1*23-2),'(1PE21.14)')PROG(IE1)
      ENDDO
      SEGDES,MLREEL
      CALL ECROBJ('LISTREEL',MLREEL)
      SEGSUP,BUFFER
C
      GOTO 100
C
C     LECTURE D'UN MOT
C
 50   CALL LIRENT(L1,1,IENT)
      IF(IENT.EQ.0)GOTO 100
C
      CALL OPCHAU(JECHO,IWAIT,IENT)
      IF(IENT.EQ.0) GOTO 100
C
      L1=L1+1
      SEGINI,BUFFER
      CALL readsocket(LBUFF,JECHO,IWAIT,IENT,JERNO)
      IF(IENT.NE.1)THEN
        WRITE(IOIMP,*)'Chauss: Erreur en "LECTURE MOT"'
        GOTO 99
      ENDIF
C
      IF(IIMPI.EQ.1789)THEN
        WRITE(IOIMP,*)'Echo reception'
        WRITE(IOIMP,*)LBUFF(1:L1)
      ENDIF
C
      BUFF1(1:L1-1)=LBUFF(1:L1-1)
      CALL ECRCHA(BUFF1(1:L1-1))
      SEGSUP,BUFFER
C
      GOTO 100
C
C     FERMETURE DU PORT
C
 60   CALL LIRMOT(MMCLE,1,ICOMPL,0)
      CALL closesocket(ICOMPL,IENT)
      IF(IENT.NE.1)THEN
        WRITE(IOIMP,*)'Chauss: Erreur en "FERMETURE"'
      ENDIF
C
      GOTO 100
C
C     ERREUR LECTURE (TIME OUT ET AUTRES)
C
 99   CALL ECRLOG(LDUMM)
C
C     ON SORT
C
 100  CALL ECRENT(IENT)
      RETURN
      END