Sources Esope | Cast3M

oooac1
C OOOAC1    SOURCE    PV090527  26/04/24    08:22:58     12524          
      SUBROUTINE OOOAC1 (LRET,ID2,ID1)
C--------------------------------------------------------------------
C
C                         SEGACT , IPP2=IPP1
C
C   ->LRET  1  PLUS DE PLACE MEMOIRE
C           2  OK
C
C   ->ID2      POINTEUR DU SEGMENT RECEPTEUR (ACTIF)
C     ID1      POINTEUR DU SEGMENT EMETEUR   (ETAT INCHANGE)
C
C              LES DEUX SEGMENTS DOIVENT AVOIR LA MEME LONGUEUR
C
C PROGRAMMEUR : MOUGIN
C       CREE  : 19/12/88    POURLA FAMILLE : OOOW..
C
C--------------------------------------------------------------------
C
%INC IOOADR
%INC IOOADZ
%INC IOODES
%INC IOOSGM
      POINTEUR ID1.ID1 , ID2.ID2
C
      ITYP1  = MDTYP(ID1)
      IETAT1 = MDETAT(ITYP1)
      IQUEU1 = MDQUEU(ITYP1)
      IMEM1  = MDDISK(ITYP1)
      LRET=2
      IF(IETAT1.NE.MDACT) CALL OOOACT (LRET,ID1,1)
      IF (LRET.EQ.1)                                RETURN
      CALL OOOACT (LRET,ID2,1)
      IF (LRET.EQ.1)                                RETURN
      IS1=MDISG(ID1)
      IS2=MDISG(ID2)
      LS =MSLS1(IS1)
      IF (MSLS1(IS2).NE.LS)                         GO TO 901
      CALL OOOZMV(JSG(IS1+MSLZ1+1),JSG(IS2+MSLZ1+1),LS-(MSLCZ))
      MZJSS(DEPLACES)=MZJSS(DEPLACES)+1
      MZJSM(DEPLACES)=MZJSM(DEPLACES)+LS-(MSLCZ)
      IF ((IMEM1.NE.MDMEM) .OR. (IETAT1.NE.MDACT)) THEN
        IF (IQUEU1.EQ.MDLRU)                       THEN
          NDES=LNOMOD
        ELSE
          NDES=MNOMOD
        ENDIF
        CALL OOODES (LRET,ID1,NDES-1)
        IF (LRET.EQ.1)                              RETURN
      ENDIF
 
      LRET = 2
                                                    RETURN
C-----------------------------------------------------------------------
C
C                         MESSAGES D'ERREUR
C
 901  CALL OOOERR (ID1,-1,'SEGACT , P=Q : AVEC LONGUEURS DIFFERENTES')
                                                   STOP 16
      END